Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

Merge from mainline.

Browse source
This commit is contained in:
Paul Eggert 2011-04-09 11:42:31 -07:00
commit 762f8d9671
59 changed files with 2273 additions and 1904 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
ChangeLog
View file

@ -1,7 +1,11 @@
2011-04-08 Paul Eggert <eggert@cs.ucla.edu>
2011-04-09 Paul Eggert <eggert@cs.ucla.edu>
* lib/allocator.c: New file, automatically generated by gnulib.
2011-04-07 Glenn Morris <rgm@gnu.org>
* autogen/update_autogen: Ignore comment diffs in ldefs-boot.el.
2011-04-06 Eli Zaretskii <eliz@gnu.org>
* lib/makefile.w32-in ($(BLD)/careadlinkat.$(O), GNULIBOBJS):

4
autogen/aclocal.m4 vendored
View file

@ -13,8 +13,8 @@
m4_ifndef([AC_AUTOCONF_VERSION],
[m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl
m4_if(m4_defn([AC_AUTOCONF_VERSION]), [2.68],,
[m4_warning([this file was generated for autoconf 2.68.
m4_if(m4_defn([AC_AUTOCONF_VERSION]), [2.65],,
[m4_warning([this file was generated for autoconf 2.65.
You have another version of autoconf. It may work, but is not guaranteed to.
If you have problems, you may need to regenerate the build system entirely.
To do so, use the procedure documented by the package, typically `autoreconf'.])])

142
autogen/config.guess vendored
View file

@ -4,7 +4,7 @@
# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
# Free Software Foundation, Inc.
timestamp='2009-11-20'
timestamp='2009-06-10'
# This file is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
@ -27,16 +27,16 @@ timestamp='2009-11-20'
# the same distribution terms that you use for the rest of that program.
# Originally written by Per Bothner. Please send patches (context
# diff format) to <config-patches@gnu.org> and include a ChangeLog
# entry.
# Originally written by Per Bothner <per@bothner.com>.
# Please send patches to <config-patches@gnu.org>. Submit a context
# diff and a properly formatted ChangeLog entry.
#
# This script attempts to guess a canonical system name similar to
# config.sub. If it succeeds, it prints the system name on stdout, and
# exits with 0. Otherwise, it exits with 1.
#
# You can get the latest version of this script from:
# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD
# The plan is that this can be called by configure scripts if you
# don't specify an explicit build system type.
me=`echo "$0" | sed -e 's,.*/,,'`
@ -333,9 +333,6 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*)
echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
exit ;;
i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*)
echo i386-pc-auroraux${UNAME_RELEASE}
exit ;;
i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*)
eval $set_cc_for_build
SUN_ARCH="i386"
@ -810,12 +807,12 @@ EOF
i*:PW*:*)
echo ${UNAME_MACHINE}-pc-pw32
exit ;;
*:Interix*:*)
*:Interix*:[3456]*)
case ${UNAME_MACHINE} in
x86)
echo i586-pc-interix${UNAME_RELEASE}
exit ;;
authenticamd | genuineintel | EM64T)
EM64T | authenticamd | genuineintel)
echo x86_64-unknown-interix${UNAME_RELEASE}
exit ;;
IA64)
@ -857,20 +854,6 @@ EOF
i*86:Minix:*:*)
echo ${UNAME_MACHINE}-pc-minix
exit ;;
alpha:Linux:*:*)
case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in
EV5) UNAME_MACHINE=alphaev5 ;;
EV56) UNAME_MACHINE=alphaev56 ;;
PCA56) UNAME_MACHINE=alphapca56 ;;
PCA57) UNAME_MACHINE=alphapca56 ;;
EV6) UNAME_MACHINE=alphaev6 ;;
EV67) UNAME_MACHINE=alphaev67 ;;
EV68*) UNAME_MACHINE=alphaev68 ;;
esac
objdump --private-headers /bin/sh | grep -q ld.so.1
if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi
echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC}
exit ;;
arm*:Linux:*:*)
eval $set_cc_for_build
if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \
@ -893,17 +876,6 @@ EOF
frv:Linux:*:*)
echo frv-unknown-linux-gnu
exit ;;
i*86:Linux:*:*)
LIBC=gnu
eval $set_cc_for_build
sed 's/^ //' << EOF >$dummy.c
#ifdef __dietlibc__
LIBC=dietlibc
#endif
EOF
eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'`
echo "${UNAME_MACHINE}-pc-linux-${LIBC}"
exit ;;
ia64:Linux:*:*)
echo ${UNAME_MACHINE}-unknown-linux-gnu
exit ;;
@ -929,18 +901,39 @@ EOF
#endif
#endif
EOF
eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'`
eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '
/^CPU/{
s: ::g
p
}'`"
test x"${CPU}" != x && { echo "${CPU}-unknown-linux-gnu"; exit; }
;;
or32:Linux:*:*)
echo or32-unknown-linux-gnu
exit ;;
ppc:Linux:*:*)
echo powerpc-unknown-linux-gnu
exit ;;
ppc64:Linux:*:*)
echo powerpc64-unknown-linux-gnu
exit ;;
alpha:Linux:*:*)
case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in
EV5) UNAME_MACHINE=alphaev5 ;;
EV56) UNAME_MACHINE=alphaev56 ;;
PCA56) UNAME_MACHINE=alphapca56 ;;
PCA57) UNAME_MACHINE=alphapca56 ;;
EV6) UNAME_MACHINE=alphaev6 ;;
EV67) UNAME_MACHINE=alphaev67 ;;
EV68*) UNAME_MACHINE=alphaev68 ;;
esac
objdump --private-headers /bin/sh | grep -q ld.so.1
if test "$?" = 0 ; then LIBC="libc1" ; else LIBC="" ; fi
echo ${UNAME_MACHINE}-unknown-linux-gnu${LIBC}
exit ;;
padre:Linux:*:*)
echo sparc-unknown-linux-gnu
exit ;;
parisc64:Linux:*:* | hppa64:Linux:*:*)
echo hppa64-unknown-linux-gnu
exit ;;
parisc:Linux:*:* | hppa:Linux:*:*)
# Look for CPU level
case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in
@ -949,11 +942,8 @@ EOF
*) echo hppa-unknown-linux-gnu ;;
esac
exit ;;
ppc64:Linux:*:*)
echo powerpc64-unknown-linux-gnu
exit ;;
ppc:Linux:*:*)
echo powerpc-unknown-linux-gnu
parisc64:Linux:*:* | hppa64:Linux:*:*)
echo hppa64-unknown-linux-gnu
exit ;;
s390:Linux:*:* | s390x:Linux:*:*)
echo ${UNAME_MACHINE}-ibm-linux
@ -976,6 +966,58 @@ EOF
xtensa*:Linux:*:*)
echo ${UNAME_MACHINE}-unknown-linux-gnu
exit ;;
i*86:Linux:*:*)
# The BFD linker knows what the default object file format is, so
# first see if it will tell us. cd to the root directory to prevent
# problems with other programs or directories called `ld' in the path.
# Set LC_ALL=C to ensure ld outputs messages in English.
ld_supported_targets=`cd /; LC_ALL=C ld --help 2>&1 \
| sed -ne '/supported targets:/!d
s/[ ][ ]*/ /g
s/.*supported targets: *//
s/ .*//
p'`
case "$ld_supported_targets" in
elf32-i386)
TENTATIVE="${UNAME_MACHINE}-pc-linux-gnu"
;;
esac
# Determine whether the default compiler is a.out or elf
eval $set_cc_for_build
sed 's/^ //' << EOF >$dummy.c
#include <features.h>
#ifdef __ELF__
# ifdef __GLIBC__
# if __GLIBC__ >= 2
LIBC=gnu
# else
LIBC=gnulibc1
# endif
# else
LIBC=gnulibc1
# endif
#else
#if defined(__INTEL_COMPILER) || defined(__PGI) || defined(__SUNPRO_C) || defined(__SUNPRO_CC)
LIBC=gnu
#else
LIBC=gnuaout
#endif
#endif
#ifdef __dietlibc__
LIBC=dietlibc
#endif
EOF
eval "`$CC_FOR_BUILD -E $dummy.c 2>/dev/null | sed -n '
/^LIBC/{
s: ::g
p
}'`"
test x"${LIBC}" != x && {
echo "${UNAME_MACHINE}-pc-linux-${LIBC}"
exit
}
test x"${TENTATIVE}" != x && { echo "${TENTATIVE}"; exit; }
;;
i*86:DYNIX/ptx:4*:*)
# ptx 4.0 does uname -s correctly, with DYNIX/ptx in there.
# earlier versions are messed up and put the nodename in both
@ -1205,16 +1247,6 @@ EOF
*:Darwin:*:*)
UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown
case $UNAME_PROCESSOR in
i386)
eval $set_cc_for_build
if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then
if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \
(CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \
grep IS_64BIT_ARCH >/dev/null
then
UNAME_PROCESSOR="x86_64"
fi
fi ;;
unknown) UNAME_PROCESSOR=powerpc ;;
esac
echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE}

3
autogen/config.in
View file

@ -1209,9 +1209,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
# define __restrict__
#endif
/* Define to `unsigned int' if <sys/types.h> does not define. */
#undef size_t
/* type to use in place of socklen_t if not defined */
#undef socklen_t

30
autogen/config.sub vendored
View file

@ -4,7 +4,7 @@
# 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
# Free Software Foundation, Inc.
timestamp='2009-11-20'
timestamp='2009-06-11'
# This file is (in principle) common to ALL GNU software.
# The presence of a machine in this file suggests that SOME GNU software
@ -32,16 +32,13 @@ timestamp='2009-11-20'
# Please send patches to <config-patches@gnu.org>. Submit a context
# diff and a properly formatted GNU ChangeLog entry.
# diff and a properly formatted ChangeLog entry.
#
# Configuration subroutine to validate and canonicalize a configuration type.
# Supply the specified configuration type as an argument.
# If it is invalid, we print an error message on stderr and exit with code 1.
# Otherwise, we print the canonical config type on stdout and succeed.
# You can get the latest version of this script from:
# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD
# This file is supposed to be the same for all GNU packages
# and recognize all the CPU types, system types and aliases
# that are meaningful with *any* GNU software.
@ -152,7 +149,7 @@ case $os in
-convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\
-c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \
-harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \
-apple | -axis | -knuth | -cray | -microblaze)
-apple | -axis | -knuth | -cray)
os=
basic_machine=$1
;;
@ -287,7 +284,6 @@ case $basic_machine in
| pdp10 | pdp11 | pj | pjl \
| powerpc | powerpc64 | powerpc64le | powerpcle | ppcbe \
| pyramid \
| rx \
| score \
| sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \
| sh64 | sh64le \
@ -295,14 +291,13 @@ case $basic_machine in
| sparcv8 | sparcv9 | sparcv9b | sparcv9v \
| spu | strongarm \
| tahoe | thumb | tic4x | tic80 | tron \
| ubicom32 \
| v850 | v850e \
| we32k \
| x86 | xc16x | xscale | xscalee[bl] | xstormy16 | xtensa \
| z8k | z80)
basic_machine=$basic_machine-unknown
;;
m6811 | m68hc11 | m6812 | m68hc12 | picochip)
m6811 | m68hc11 | m6812 | m68hc12)
# Motorola 68HC11/12.
basic_machine=$basic_machine-unknown
os=-none
@ -345,7 +340,7 @@ case $basic_machine in
| lm32-* \
| m32c-* | m32r-* | m32rle-* \
| m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \
| m88110-* | m88k-* | maxq-* | mcore-* | metag-* | microblaze-* \
| m88110-* | m88k-* | maxq-* | mcore-* | metag-* \
| mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \
| mips16-* \
| mips64-* | mips64el-* \
@ -373,7 +368,7 @@ case $basic_machine in
| pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \
| powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* | ppcbe-* \
| pyramid-* \
| romp-* | rs6000-* | rx-* \
| romp-* | rs6000-* \
| sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \
| shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \
| sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \
@ -382,7 +377,6 @@ case $basic_machine in
| tahoe-* | thumb-* \
| tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* | tile-* \
| tron-* \
| ubicom32-* \
| v850-* | v850e-* | vax-* \
| we32k-* \
| x86-* | x86_64-* | xc16x-* | xps100-* | xscale-* | xscalee[bl]-* \
@ -732,9 +726,6 @@ case $basic_machine in
basic_machine=ns32k-utek
os=-sysv
;;
microblaze)
basic_machine=microblaze-xilinx
;;
mingw32)
basic_machine=i386-pc
os=-mingw32
@ -1256,9 +1247,6 @@ case $os in
# First match some system type aliases
# that might get confused with valid system types.
# -solaris* is a basic system type, with this one exception.
-auroraux)
os=-auroraux
;;
-solaris1 | -solaris1.*)
os=`echo $os | sed -e 's|solaris1|sunos4|'`
;;
@ -1280,8 +1268,8 @@ case $os in
# -sysv* is not here because it comes later, after sysvr4.
-gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \
| -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\
| -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \
| -sym* | -kopensolaris* \
| -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \
| -kopensolaris* \
| -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \
| -aos* | -aros* \
| -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \
@ -1302,7 +1290,7 @@ case $os in
| -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \
| -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \
| -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \
| -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*)
| -skyos* | -haiku* | -rdos* | -toppers* | -drops*)
# Remember, each alternative MUST END IN *, to match a version number.
;;
-qnx*)

1205
autogen/configure vendored
View file

File diff suppressed because it is too large Load diff

5
autogen/update_autogen
View file

@ -268,7 +268,10 @@ echo "Running lisp/ make..."
make -C lisp "$@" autoloads EMACS=../src/bootstrap-emacs || die "make src error"
[ ! "$lboot_flag" ] || cp $ldefs_in $ldefs_out || die "cp ldefs_boot error"
## Ignore comment differences.
[ ! "$lboot_flag" ] || \
diff -q -I '^;' $ldefs_in $ldefs_out || \
cp $ldefs_in $ldefs_out || die "cp ldefs_boot error"
cd lisp

4
doc/emacs/ChangeLog
View file

@ -1,3 +1,7 @@
2011-03-26 Chong Yidong <cyd@stupidchicken.com>
* display.texi (Auto Scrolling): Fix scroll-up/scroll-down confusion.
2011-03-30 Eli Zaretskii <eliz@gnu.org>
* display.texi (Auto Scrolling): Document the limit of 100 lines

16
doc/emacs/display.texi
View file

@ -206,16 +206,18 @@ how aggressively it scrolls by setting the variables
@code{scroll-up-aggressively} and @code{scroll-down-aggressively}.
The value of @code{scroll-up-aggressively} should be either
@code{nil}, or a fraction @var{f} between 0 and 1. A fraction
specifies where on the screen to put point when scrolling upward: when
a window scrolls up because point is above the window start, the new
specifies where on the screen to put point when scrolling upward,
i.e.@: when point moves forward in the buffer, and therefore text
scrolls up in the window. When point goes off the window end, the new
start position is chosen to put point @var{f} parts of the window
height from the top. Thus, larger @var{f} means more aggressive
scrolling. The default value, @code{nil}, is equivalent to 0.5.
height from the bottom. Thus, larger @var{f} means more aggressive
scrolling: more new text is brought into view. The default value,
@code{nil}, is equivalent to 0.5.
Likewise, @code{scroll-down-aggressively} is used for scrolling
down. The value specifies how far point should be placed from the
bottom of the window; thus, as with @code{scroll-up-aggressively}, a
larger value is more aggressive.
down, i.e.@: moving point back in the buffer. The value specifies how
far point should be placed from the top of the window; thus, as with
@code{scroll-up-aggressively}, a larger value is more aggressive.
These two variables are ignored if either @code{scroll-step} or
@code{scroll-conservatively} are set to a non-zero value.

15
doc/lispref/ChangeLog
View file

@ -1,3 +1,18 @@
2011-03-21 Stefan Monnier <monnier@iro.umontreal.ca>
* minibuf.texi (Basic Completion): Be a bit more precise about the
valid kinds of completion tables.
(Programmed Completion): Remove obsolete text about lambda expressions
not being valid completion tables.
2011-03-19 Chong Yidong <cyd@stupidchicken.com>
* positions.texi (Excursions): Explain the "save-excursion
defeated by set-buffer" warning.
* buffers.texi (Current Buffer): Copyedits. Don't recommend using
save-excursion. Suggested by Uday S Reddy.
2011-04-01 Stefan Monnier <monnier@iro.umontreal.ca>
* variables.texi (Defining Variables): Mention the new meaning of `defvar'.

177
doc/lispref/buffers.texi
View file

@ -85,91 +85,17 @@ This function returns @code{t} if @var{object} is a buffer,
@cindex changing to another buffer
@cindex current buffer
There are, in general, many buffers in an Emacs session. At any time,
one of them is designated as the @dfn{current buffer}. This is the
buffer in which most editing takes place, because most of the primitives
for examining or changing text in a buffer operate implicitly on the
current buffer (@pxref{Text}). Normally the buffer that is displayed on
the screen in the selected window is the current buffer, but this is not
always so: a Lisp program can temporarily designate any buffer as
current in order to operate on its contents, without changing what is
displayed on the screen.
There are, in general, many buffers in an Emacs session. At any
time, one of them is designated the @dfn{current buffer}---the buffer
in which most editing takes place. Most of the primitives for
examining or changing text operate implicitly on the current buffer
(@pxref{Text}).
The way to designate a current buffer in a Lisp program is by calling
@code{set-buffer}. The specified buffer remains current until a new one
is designated.
When an editing command returns to the editor command loop, the
command loop designates the buffer displayed in the selected window as
current, to prevent confusion: the buffer that the cursor is in when
Emacs reads a command is the buffer that the command will apply to.
(@xref{Command Loop}.) Therefore, @code{set-buffer} is not the way to
switch visibly to a different buffer so that the user can edit it. For
that, you must use the functions described in @ref{Displaying Buffers}.
@strong{Warning:} Lisp functions that change to a different current buffer
should not depend on the command loop to set it back afterwards.
Editing commands written in Emacs Lisp can be called from other programs
as well as from the command loop; it is convenient for the caller if
the subroutine does not change which buffer is current (unless, of
course, that is the subroutine's purpose). Therefore, you should
normally use @code{set-buffer} within a @code{save-current-buffer} or
@code{save-excursion} (@pxref{Excursions}) form that will restore the
current buffer when your function is done. Here, as an example, is a
simplified version of the command @code{append-to-buffer}:
@example
@group
(defun append-to-buffer (buffer start end)
"Append to specified buffer the text of the region."
(interactive "BAppend to buffer: \nr")
(let ((oldbuf (current-buffer)))
(save-current-buffer
(set-buffer (get-buffer-create buffer))
(insert-buffer-substring oldbuf start end))))
@end group
@end example
@noindent
This function binds a local variable to record the current buffer, and
then @code{save-current-buffer} arranges to make it current again.
Next, @code{set-buffer} makes the specified buffer current. Finally,
@code{insert-buffer-substring} copies the string from the original
current buffer to the specified (and now current) buffer.
If the buffer appended to happens to be displayed in some window,
the next redisplay will show how its text has changed. Otherwise, you
will not see the change immediately on the screen. The buffer becomes
current temporarily during the execution of the command, but this does
not cause it to be displayed.
If you make local bindings (with @code{let} or function arguments) for
a variable that may also have buffer-local bindings, make sure that the
same buffer is current at the beginning and at the end of the local
binding's scope. Otherwise you might bind it in one buffer and unbind
it in another! There are two ways to do this. In simple cases, you may
see that nothing ever changes the current buffer within the scope of the
binding. Otherwise, use @code{save-current-buffer} or
@code{save-excursion} to make sure that the buffer current at the
beginning is current again whenever the variable is unbound.
Do not rely on using @code{set-buffer} to change the current buffer
back, because that won't do the job if a quit happens while the wrong
buffer is current. For instance, in the previous example, it would
have been wrong to do this:
@example
@group
(let ((oldbuf (current-buffer)))
(set-buffer (get-buffer-create buffer))
(insert-buffer-substring oldbuf start end)
(set-buffer oldbuf))
@end group
@end example
@noindent
Using @code{save-current-buffer}, as we did, handles quitting, errors,
and @code{throw}, as well as ordinary evaluation.
Normally, the buffer displayed in the selected window is the current
buffer, but this is not always so: a Lisp program can temporarily
designate any buffer as current in order to operate on its contents,
without changing what is displayed on the screen. The most basic
function for designating a current buffer is @code{set-buffer}.
@defun current-buffer
This function returns the current buffer.
@ -192,6 +118,89 @@ cannot necessarily see the buffer. But Lisp programs will now operate
on it.
@end defun
When an editing command returns to the editor command loop, Emacs
automatically calls @code{set-buffer} on the buffer shown in the
selected window. This is to prevent confusion: it ensures that the
buffer that the cursor is in, when Emacs reads a command, is the
buffer to which that command applies (@pxref{Command Loop}). Thus,
you should not use @code{set-buffer} to switch visibly to a different
buffer; for that, use the functions described in @ref{Displaying
Buffers}.
When writing a Lisp function, do @emph{not} rely on this behavior of
the command loop to restore the current buffer after an operation.
Editing commands can also be called as Lisp functions by other
programs, not just from the command loop; it is convenient for the
caller if the subroutine does not change which buffer is current
(unless, of course, that is the subroutine's purpose).
To operate temporarily on another buffer, put the @code{set-buffer}
within a @code{save-current-buffer} form. Here, as an example, is a
simplified version of the command @code{append-to-buffer}:
@example
@group
(defun append-to-buffer (buffer start end)
"Append the text of the region to BUFFER."
(interactive "BAppend to buffer: \nr")
(let ((oldbuf (current-buffer)))
(save-current-buffer
(set-buffer (get-buffer-create buffer))
(insert-buffer-substring oldbuf start end))))
@end group
@end example
@noindent
Here, we bind a local variable to record the current buffer, and then
@code{save-current-buffer} arranges to make it current again later.
Next, @code{set-buffer} makes the specified buffer current, and
@code{insert-buffer-substring} copies the string from the original
buffer to the specified (and now current) buffer.
Alternatively, we can use the @code{with-current-buffer} macro:
@example
@group
(defun append-to-buffer (buffer start end)
"Append the text of the region to BUFFER."
(interactive "BAppend to buffer: \nr")
(let ((oldbuf (current-buffer)))
(with-current-buffer (get-buffer-create buffer)
(insert-buffer-substring oldbuf start end))))
@end group
@end example
In either case, if the buffer appended to happens to be displayed in
some window, the next redisplay will show how its text has changed.
If it is not displayed in any window, you will not see the change
immediately on the screen. The command causes the buffer to become
current temporarily, but does not cause it to be displayed.
If you make local bindings (with @code{let} or function arguments)
for a variable that may also have buffer-local bindings, make sure
that the same buffer is current at the beginning and at the end of the
local binding's scope. Otherwise you might bind it in one buffer and
unbind it in another!
Do not rely on using @code{set-buffer} to change the current buffer
back, because that won't do the job if a quit happens while the wrong
buffer is current. For instance, in the previous example, it would
have been wrong to do this:
@example
@group
(let ((oldbuf (current-buffer)))
(set-buffer (get-buffer-create buffer))
(insert-buffer-substring oldbuf start end)
(set-buffer oldbuf))
@end group
@end example
@noindent
Using @code{save-current-buffer} or @code{with-current-buffer}, as we
did, correctly handles quitting, errors, and @code{throw}, as well as
ordinary evaluation.
@defspec save-current-buffer body@dots{}
The @code{save-current-buffer} special form saves the identity of the
current buffer, evaluates the @var{body} forms, and finally restores

34
doc/lispref/minibuf.texi
View file

@ -645,9 +645,9 @@ higher-level completion features that do use the minibuffer.
@defun try-completion string collection &optional predicate
This function returns the longest common substring of all possible
completions of @var{string} in @var{collection}. The value of
@var{collection} must be a list of strings or symbols, an alist, an
obarray, a hash table, or a completion function (@pxref{Programmed
Completion}).
@var{collection} must be a list of strings, an alist whose keys are
strings or symbols, an obarray, a hash table, or a completion function
(@pxref{Programmed Completion}).
Completion compares @var{string} against each of the permissible
completions specified by @var{collection}. If no permissible
@ -658,11 +658,11 @@ to all possible matching completions.
If @var{collection} is an alist (@pxref{Association Lists}), the
permissible completions are the elements of the alist that are either
strings, symbols, or conses whose @sc{car} is a string or symbol.
strings, or conses whose @sc{car} is a string or symbol.
Symbols are converted to strings using @code{symbol-name}. Other
elements of the alist are ignored. (Remember that in Emacs Lisp, the
elements of alists do not @emph{have} to be conses.) In particular, a
list of strings or symbols is allowed, even though we usually do not
list of strings is allowed, even though we usually do not
think of such lists as alists.
@cindex obarray in completion
@ -678,7 +678,7 @@ Also, you cannot intern a given symbol in more than one obarray.
If @var{collection} is a hash table, then the keys that are strings
are the possible completions. Other keys are ignored.
You can also use a symbol that is a function as @var{collection}.
You can also use a function as @var{collection}.
Then the function is solely responsible for performing completion;
@code{try-completion} returns whatever this function returns. The
function is called with three arguments: @var{string}, @var{predicate}
@ -1632,12 +1632,12 @@ which performs completion according to the rules used in Emacs 21; and
@subsection Programmed Completion
@cindex programmed completion
Sometimes it is not possible to create an alist or an obarray
containing all the intended possible completions. In such a case, you
can supply your own function to compute the completion of a given
string. This is called @dfn{programmed completion}. Emacs uses
programmed completion when completing file names (@pxref{File Name
Completion}), among many other cases.
Sometimes it is not possible or convenient to create an alist or
an obarray containing all the intended possible completions ahead
of time. In such a case, you can supply your own function to compute
the completion of a given string. This is called @dfn{programmed
completion}. Emacs uses programmed completion when completing file
names (@pxref{File Name Completion}), among many other cases.
To use this feature, pass a function as the @var{collection}
argument to @code{completing-read}. The function
@ -1665,7 +1665,7 @@ specifies which method to run.
@end itemize
There are currently four methods, i.e. four flag values, one for
each of the four different basic operations:
each of the four different basic operations:
@itemize @bullet
@item
@ -1696,14 +1696,6 @@ in the string to complete, and END is the position of the end boundary
in SUFFIX.
@end itemize
It would be consistent and clean for completion functions to allow
lambda expressions (lists that are functions) as well as function
symbols as @var{collection}, but this is impossible. Lists as
completion tables already have other meanings, and it would be
unreliable to treat one differently just because it is also a possible
function. So you must arrange for any function you wish to use for
completion to be encapsulated in a symbol.
@defun completion-table-dynamic function
This function is a convenient way to write a function that can act as
programmed completion function. The argument @var{function} should be

99
doc/lispref/positions.texi
View file

@ -797,69 +797,72 @@ is zero or less.
@cindex excursion
It is often useful to move point ``temporarily'' within a localized
portion of the program, or to switch buffers temporarily. This is
called an @dfn{excursion}, and it is done with the @code{save-excursion}
special form. This construct initially remembers the identity of the
current buffer, and its values of point and the mark, and restores them
after the completion of the excursion.
portion of the program. This is called an @dfn{excursion}, and it is
done with the @code{save-excursion} special form. This construct
remembers the initial identity of the current buffer, and its values
of point and the mark, and restores them after the excursion
completes. It is the standard way to move point within one part of a
program and avoid affecting the rest of the program, and is used
thousands of times in the Lisp sources of Emacs.
The forms for saving and restoring the configuration of windows are
described elsewhere (see @ref{Window Configurations}, and @pxref{Frame
Configurations}). When only the identity of the current buffer needs
to be saved and restored, it is preferable to use
@code{save-current-buffer} instead.
If you only need to save and restore the identity of the current
buffer, use @code{save-current-buffer} or @code{with-current-buffer}
instead (@pxref{Current Buffer}). If you need to save or restore
window configurations, see the forms described in @ref{Window
Configurations} and in @ref{Frame Configurations}.
@defspec save-excursion body@dots{}
@cindex mark excursion
@cindex point excursion
The @code{save-excursion} special form saves the identity of the current
buffer and the values of point and the mark in it, evaluates
@var{body}, and finally restores the buffer and its saved values of
point and the mark. All three saved values are restored even in case of
an abnormal exit via @code{throw} or error (@pxref{Nonlocal Exits}).
This special form saves the identity of the current buffer and the
values of point and the mark in it, evaluates @var{body}, and finally
restores the buffer and its saved values of point and the mark. All
three saved values are restored even in case of an abnormal exit via
@code{throw} or error (@pxref{Nonlocal Exits}).
The @code{save-excursion} special form is the standard way to move
point within one part of a program and avoid affecting the rest of the
program. It is used more than 4000 times in the Lisp sources
of Emacs.
The value returned by @code{save-excursion} is the result of the last
form in @var{body}, or @code{nil} if no body forms were given.
@end defspec
@code{save-excursion} does not save the values of point and the mark for
other buffers, so changes in other buffers remain in effect after
@code{save-excursion} exits.
Because @code{save-excursion} only saves point and mark for the
buffer that was current at the start of the excursion, any changes
made to point and/or mark in other buffers, during the excursion, will
remain in effect afterward. This frequently leads to unintended
consequences, so the byte compiler warns if you call @code{set-buffer}
during an excursion:
@example
Warning: @code{save-excursion} defeated by @code{set-buffer}
@end example
@noindent
To avoid such problems, you should call @code{save-excursion} only
after setting the desired current buffer, as in the following example:
@example
@group
(defun append-string-to-buffer (string buffer)
"Append STRING to the end of BUFFER."
(with-current-buffer buffer
(save-excursion
(goto-char (point-max))
(insert string))))
@end group
@end example
@cindex window excursions
Likewise, @code{save-excursion} does not restore window-buffer
Likewise, @code{save-excursion} does not restore window-buffer
correspondences altered by functions such as @code{switch-to-buffer}.
One way to restore these correspondences, and the selected window, is to
use @code{save-window-excursion} inside @code{save-excursion}
(@pxref{Window Configurations}).
The value returned by @code{save-excursion} is the result of the last
form in @var{body}, or @code{nil} if no body forms were given.
@example
@group
(save-excursion @var{forms})
@equiv{}
(let ((old-buf (current-buffer))
(old-pnt (point-marker))
@end group
(old-mark (copy-marker (mark-marker))))
(unwind-protect
(progn @var{forms})
(set-buffer old-buf)
@group
(goto-char old-pnt)
(set-marker (mark-marker) old-mark)))
@end group
@end example
@end defspec
@strong{Warning:} Ordinary insertion of text adjacent to the saved
point value relocates the saved value, just as it relocates all markers.
More precisely, the saved value is a marker with insertion type
@code{nil}. @xref{Marker Insertion Types}. Therefore, when the saved
point value is restored, it normally comes before the inserted text.
point value relocates the saved value, just as it relocates all
markers. More precisely, the saved value is a marker with insertion
type @code{nil}. @xref{Marker Insertion Types}. Therefore, when the
saved point value is restored, it normally comes before the inserted
text.
Although @code{save-excursion} saves the location of the mark, it does
not prevent functions which modify the buffer from setting

4
etc/ChangeLog
View file

@ -1,3 +1,7 @@
2011-04-06 Juanma Barranquero <lekktu@gmail.com>
* NEWS: New variable `revert-buffer-in-progress-p'.
2011-03-22 Sebastian Hermida <sebas00@gmail.com>
* themes/misterioso-theme.el: New file.

6
etc/NEWS
View file

@ -691,6 +691,9 @@ consult.
** New global minor modes electric-pair-mode, electric-indent-mode,
and electric-layout-mode.
** tabulated-list.el provides a generic major mode for tabulated data,
from which other modes can be derived.
** pcase.el provides the ML-style pattern matching macro `pcase'.
** secrets.el is an implementation of the Secret Service API, an
@ -886,6 +889,9 @@ time you call `progress-reporter-update' on that progress reporter,
with a nil or omitted VALUE argument, the reporter message is
displayed with a "spinning bar".
** New variable `revert-buffer-in-progress-p' is true while a buffer is
being reverted, even if the buffer has a local `revert-buffer-function'.
* Changes in Emacs 24.1 on non-free operating systems

7
etc/NEWS.23
View file

@ -21,6 +21,13 @@ with a prefix argument or by typing C-u C-h C-n.
crt*.o files, if they are in a non-standard location. This is only
used on x86-64 and s390x GNU/Linux architectures.
** The MS-Windows build prefers libpng version 1.14 or later.
Versions of libpng before 1.14 had security issues, so we now
recommend to use version 1.14 or later. Precompiled Windows binaries
require version 1.14 or later. See README.W32 and nt/INSTALL for
details and pointers to URLs where the latest libpng can be
downloaded.
* Changes in Emacs 23.3
** The last-resort backup file `%backup%~' is now written to

118
lisp/ChangeLog
View file

@ -1,8 +1,122 @@
2011-04-07 Paul Eggert <eggert@cs.ucla.edu>
2011-04-09 Paul Eggert <eggert@cs.ucla.edu>
Remove the doprnt implementation, as Emacs now uses vsnprintf.
* emacs-lisp/find-gc.el (find-gc-source-files): Remove doprnt.c.
2011-04-08 Sho Nakatani <lay.sakura@gmail.com>
* doc-view.el (doc-view-fit-width-to-window)
(doc-view-fit-height-to-window, doc-view-fit-page-to-window): New
functions for fitting the shown image to the Emacs window size.
(doc-view-mode-map): Add bindings for the new functions.
2011-03-24 Juanma Barranquero <lekktu@gmail.com>
* vc-annotate.el (vc-annotate-show-log-revision-at-line):
Fix typo in docstring.
2011-04-08 Eli Zaretskii <eliz@gnu.org>
* files.el (file-size-human-readable): Produce one digit after
decimal, like "ls -lh" does.
* ls-lisp.el (ls-lisp-format-file-size): Allow for 7 characters in
the file size representation.
* simple.el (list-processes): If async subprocesses are not
available, error out with a clear error message.
2011-04-08 Chong Yidong <cyd@stupidchicken.com>
* help.el (help-form-show): New function, to be called from C.
Put help-form output in a buffer named differently than *Help*.
2011-04-08 Eli Zaretskii <eliz@gnu.org>
* files.el (file-size-human-readable): New function.
* ls-lisp.el (ls-lisp-format-file-size): Use it, instead of
computing the representation inline. Don't require `cl'.
2011-04-08 Glenn Morris <rgm@gnu.org>
* man.el (Man-page-header-regexp): Solaris < 2.6 no longer supported.
* net/browse-url.el (browse-url-firefox):
Test system-type, not system-configuration.
* vc/log-edit.el (log-edit-empty-buffer-p): New function.
(log-edit-insert-cvs-template, log-edit-insert-cvs-rcstemplate):
Use log-edit-empty-buffer-p. (Bug#7598)
* net/rlogin.el (rlogin-process-connection-type): Simplify.
(rlogin-mode-map): Initialize in the defvar.
(rlogin): Use ignore-errors.
* replace.el (occur-mode-map): Some fixes for menu items.
2011-04-07 Aaron S. Hawley <aaron.s.hawley@gmail.com>
* play/morse.el (denato-region): Handle varying case. (Bug#8386)
2011-04-06 Chong Yidong <cyd@stupidchicken.com>
* emacs-lisp/cconv.el (cconv--analyse-use): Ignore "ignored" when
issuing unused warnings.
* emacs-lisp/tabulated-list.el (tabulated-list-print): Use lambda
macro directly.
* simple.el: Lisp reimplement of list-processes. Based on an
earlier reimplementation by Leo Liu, but using tabulated-list.el.
(process-menu-mode): New major mode.
(list-processes--refresh, list-processes):
(process-menu-visit-buffer): New functions.
* files.el (save-buffers-kill-emacs): Don't assume any return
value of list-processes, which is undocumented anyway.
2011-04-06 Chong Yidong <cyd@stupidchicken.com>
* emacs-lisp/tabulated-list.el: New file.
* emacs-lisp/package.el: Use Tabulated List mode.
(package-menu-mode-map): Inherit from tabulated-list-mode-map.
(package-menu-mode): Derive from tabulated-list-mode. Set up the
table format using Tabulated List mode variables.
(package--push): New macro, replacing package-list-maybe-add.
(package-menu--generate): Use package--push. Renamed from
package--generate-package-list.
(package-menu-refresh, list-packages): Use it.
(package-menu--print-info): Renamed from package-print-package.
Return insertion data instead of inserting it directly.
(package-menu-describe-package, package-menu-execute): Use
tabulated-list-get-id.
(package-menu-mark-delete, package-menu-mark-install)
(package-menu-mark-unmark, package-menu-backup-unmark)
(package-menu-mark-obsolete-for-deletion): Use
tabulated-list-put-tag.
(package--list-packages, package-menu-revert)
(package-menu-get-package, package-menu-get-version)
(package-menu-sort-by-column): Functions deleted.
(package-menu-package-list, package-menu-sort-key): Vars deleted.
(package-menu--status-predicate, package-menu--version-predicate)
(package-menu--name-predicate)
(package-menu--description-predicate): Handle arguments in the
Tabulated List format.
(package-list-packages-no-fetch): Call list-packages.
2011-04-06 Juanma Barranquero <lekktu@gmail.com>
* files.el (after-find-file-from-revert-buffer): Remove variable.
(after-find-file): Dont' bind it.
(revert-buffer-in-progress-p): New variable.
(revert-buffer): Bind it.
Pass nil for `after-find-file-from-revert-buffer'.
* saveplace.el (save-place-find-file-hook): Use new variable
`rever-buffer-in-progress-p', not `after-find-file-from-revert-buffer'.
2011-04-06 Glenn Morris <rgm@gnu.org>
* Makefile.in (AUTOGEN_VCS): New variable.
@ -575,7 +689,7 @@
(emerge-protect-metachars): Quote correctly for ms-dos and
windows-nt systems.
2011-03-19 Ralph Schleicher <rs@ralph-schleicher.de>
2011-03-19 Ralph Schleicher <rs@ralph-schleicher.de> (tiny change)
* info.el (info-initialize): Replace all uses of `:' with
path-separator for compatibility with non-Unix systems.

4
lisp/bs.el
View file

@ -40,7 +40,7 @@
;; | % vc-hooks.el 43605 Emacs-Lisp /usr/share/emacs/19.34/lisp$|
;; -----------------------------------------------------------------------
;;; Quick Installation und Customization:
;;; Quick Installation and Customization:
;; To display the bs menu, do
;; M-x bs-show
@ -1083,7 +1083,7 @@ configuration."
bs-dont-show-regexp (nth 3 list)
bs-dont-show-function (nth 4 list)
bs-buffer-sort-function (nth 5 list))
;; for backward compability
;; for backward compatibility
(funcall (cdr list)))
;; else
(ding)

2
lisp/cus-face.el
View file

@ -348,7 +348,7 @@ FACE's list property `theme-face' \(using `custom-push-theme')."
(put face 'face-override-spec nil)
(face-spec-set face spec t))))))))
;; XEmacs compability function. In XEmacs, when you reset a Custom
;; XEmacs compatibility function. In XEmacs, when you reset a Custom
;; Theme, you have to specify the theme to reset it to. We just apply
;; the next theme.
(defun custom-theme-reset-faces (theme &rest args)

76
lisp/doc-view.el
View file

@ -328,6 +328,10 @@ Can be `dvi', `pdf', or `ps'.")
;; Zoom in/out.
(define-key map "+" 'doc-view-enlarge)
(define-key map "-" 'doc-view-shrink)
;; Fit the image to the window
(define-key map "W" 'doc-view-fit-width-to-window)
(define-key map "H" 'doc-view-fit-height-to-window)
(define-key map "P" 'doc-view-fit-page-to-window)
;; Killing the buffer (and the process)
(define-key map (kbd "k") 'doc-view-kill-proc-and-buffer)
(define-key map (kbd "K") 'doc-view-kill-proc)
@ -664,6 +668,78 @@ OpenDocument format)."
(interactive (list doc-view-shrink-factor))
(doc-view-enlarge (/ 1.0 factor)))
(defun doc-view-fit-width-to-window ()
"Fit the image width to the window width."
(interactive)
(let ((win-width (- (nth 2 (window-inside-pixel-edges))
(nth 0 (window-inside-pixel-edges))))
(slice (doc-view-current-slice)))
(if (not slice)
(let ((img-width (car (image-display-size
(image-get-display-property) t))))
(doc-view-enlarge (/ (float win-width) (float img-width))))
;; If slice is set
(let* ((slice-width (nth 2 slice))
(scale-factor (/ (float win-width) (float slice-width)))
(new-slice (mapcar (lambda (x) (ceiling (* scale-factor x))) slice)))
(doc-view-enlarge scale-factor)
(setf (doc-view-current-slice) new-slice)
(doc-view-goto-page (doc-view-current-page))))))
(defun doc-view-fit-height-to-window ()
"Fit the image height to the window height."
(interactive)
(let ((win-height (- (nth 3 (window-inside-pixel-edges))
(nth 1 (window-inside-pixel-edges))))
(slice (doc-view-current-slice)))
(if (not slice)
(let ((img-height (cdr (image-display-size
(image-get-display-property) t))))
;; When users call 'doc-view-fit-height-to-window',
;; they might want to go to next page by typing SPC
;; ONLY once. So I used '(- win-height 1)' instead of
;; 'win-height'
(doc-view-enlarge (/ (float (- win-height 1)) (float img-height))))
;; If slice is set
(let* ((slice-height (nth 3 slice))
(scale-factor (/ (float (- win-height 1)) (float slice-height)))
(new-slice (mapcar (lambda (x) (ceiling (* scale-factor x))) slice)))
(doc-view-enlarge scale-factor)
(setf (doc-view-current-slice) new-slice)
(doc-view-goto-page (doc-view-current-page))))))
(defun doc-view-fit-page-to-window ()
"Fit the image to the window.
More specifically, this function enlarges image by:
min {(window-width / image-width), (window-height / image-height)} times."
(interactive)
(let ((win-width (- (nth 2 (window-inside-pixel-edges))
(nth 0 (window-inside-pixel-edges))))
(win-height (- (nth 3 (window-inside-pixel-edges))
(nth 1 (window-inside-pixel-edges))))
(slice (doc-view-current-slice)))
(if (not slice)
(let ((img-width (car (image-display-size
(image-get-display-property) t)))
(img-height (cdr (image-display-size
(image-get-display-property) t))))
(doc-view-enlarge (min (/ (float win-width) (float img-width))
(/ (float (- win-height 1)) (float img-height)))))
;; If slice is set
(let* ((slice-width (nth 2 slice))
(slice-height (nth 3 slice))
(scale-factor (min (/ (float win-width) (float slice-width))
(/ (float (- win-height 1)) (float slice-height))))
(new-slice (mapcar (lambda (x) (ceiling (* scale-factor x))) slice)))
(doc-view-enlarge scale-factor)
(setf (doc-view-current-slice) new-slice)
(doc-view-goto-page (doc-view-current-page))))))
(defun doc-view-reconvert-doc ()
"Reconvert the current document.
Should be invoked when the cached images aren't up-to-date."

4
lisp/emacs-lisp/cconv.el
View file

@ -536,7 +536,9 @@ FORM is the parent form that binds this var."
;; it is often non-trivial for the programmer to avoid such
;; unused vars.
(not (intern-soft var))
(eq ?_ (aref (symbol-name var) 0)))
(eq ?_ (aref (symbol-name var) 0))
;; As a special exception, ignore "ignore".
(eq var 'ignored))
(byte-compile-log-warning (format "Unused lexical %s `%S'"
varkind var))))
;; If it's unused, there's no point converting it into a cons-cell, even if

454
lisp/emacs-lisp/package.el
View file

@ -173,6 +173,8 @@
;;; Code:
(require 'tabulated-list)
(defgroup package nil
"Manager for Emacs Lisp packages."
:group 'applications
@ -1249,12 +1251,10 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
;;;; Package menu mode.
(defvar package-menu-mode-map
(let ((map (copy-keymap special-mode-map))
(let ((map (make-sparse-keymap))
(menu-map (make-sparse-keymap "Package")))
(set-keymap-parent map button-buffer-map)
(set-keymap-parent map tabulated-list-mode-map)
(define-key map "\C-m" 'package-menu-describe-package)
(define-key map "n" 'next-line)
(define-key map "p" 'previous-line)
(define-key map "u" 'package-menu-mark-unmark)
(define-key map "\177" 'package-menu-backup-unmark)
(define-key map "d" 'package-menu-mark-delete)
@ -1264,8 +1264,6 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
(define-key map "x" 'package-menu-execute)
(define-key map "h" 'package-menu-quick-help)
(define-key map "?" 'package-menu-describe-package)
(define-key map [follow-link] 'mouse-face)
(define-key map [mouse-2] 'mouse-select-window)
(define-key map [menu-bar package-menu] (cons "Package" menu-map))
(define-key menu-map [mq]
'(menu-item "Quit" quit-window
@ -1314,49 +1312,93 @@ If optional arg NO-ACTIVATE is non-nil, don't activate packages."
map)
"Local keymap for `package-menu-mode' buffers.")
(defvar package-menu-sort-button-map
(let ((map (make-sparse-keymap)))
(define-key map [header-line mouse-1] 'package-menu-sort-by-column)
(define-key map [header-line mouse-2] 'package-menu-sort-by-column)
(define-key map [follow-link] 'mouse-face)
map)
"Local keymap for package menu sort buttons.")
(put 'package-menu-mode 'mode-class 'special)
(define-derived-mode package-menu-mode special-mode "Package Menu"
(define-derived-mode package-menu-mode tabulated-list-mode "Package Menu"
"Major mode for browsing a list of packages.
Letters do not insert themselves; instead, they are commands.
\\<package-menu-mode-map>
\\{package-menu-mode-map}"
(setq truncate-lines t)
(setq buffer-read-only t)
(set (make-local-variable 'revert-buffer-function) 'package-menu-revert)
(setq header-line-format
(mapconcat
(lambda (pair)
(let ((column (car pair))
(name (cdr pair)))
(concat
;; Insert a space that aligns the button properly.
(propertize " " 'display (list 'space :align-to column)
'face 'fixed-pitch)
;; Set up the column button.
(propertize name
'column-name name
'help-echo "mouse-1: sort by column"
'mouse-face 'highlight
'keymap package-menu-sort-button-map))))
;; We take a trick from buff-menu and have a dummy leading
;; space to align the header line with the beginning of the
;; text. This doesn't really work properly on Emacs 21, but
;; it is close enough.
'((0 . "")
(2 . "Package")
(20 . "Version")
(32 . "Status")
(43 . "Description"))
"")))
(setq tabulated-list-format [("Package" 18 package-menu--name-predicate)
("Version" 12 nil)
("Status" 10 package-menu--status-predicate)
("Description" 0 nil)])
(setq tabulated-list-padding 2)
(setq tabulated-list-sort-key (cons "Status" nil))
(tabulated-list-init-header))
(defmacro package--push (package desc status listname)
"Convenience macro for `package-menu--generate'.
If the alist stored in the symbol LISTNAME lacks an entry for a
package PACKAGE with descriptor DESC, add one. The alist is
keyed with cons cells (PACKAGE . VERSION), where PACKAGE is a
symbol and VERSION is a version list."
`(let* ((version (package-desc-vers ,desc))
(key (cons ,package version)))
(unless (assoc key ,listname)
(push (list key ,status (package-desc-doc ,desc)) ,listname))))
(defun package-menu--generate (&optional remember-pos)
"Populate the Package Menu.
Optional argument REMEMBER-POS, if non-nil, means to move point
to the entry as before."
;; Construct list of ((PACKAGE . VERSION) STATUS DESCRIPTION).
(let (info-list name builtin)
;; Installed packages:
(dolist (elt package-alist)
(setq name (car elt))
(package--push name (cdr elt)
(if (stringp (cadr (assq name package-load-list)))
"held" "installed")
info-list))
;; Built-in packages:
(dolist (elt package--builtins)
(setq name (car elt))
(unless (eq name 'emacs) ; Hide the `emacs' package.
(package--push name (cdr elt) "built-in" info-list)))
;; Available and disabled packages:
(dolist (elt package-archive-contents)
(setq name (car elt))
(let ((hold (assq name package-load-list)))
(package--push name (cdr elt)
(if (and hold (null (cadr hold))) "disabled" "available")
info-list)))
;; Obsolete packages:
(dolist (elt package-obsolete-alist)
(dolist (inner-elt (cdr elt))
(package--push (car elt) (cdr inner-elt) "obsolete" info-list)))
;; Print the result.
(setq tabulated-list-entries (mapcar 'package-menu--print-info info-list))
(tabulated-list-print remember-pos)))
(defun package-menu--print-info (pkg)
"Return a package entry suitable for `tabulated-list-entries'.
PKG has the form ((PACKAGE . VERSION) STATUS DOC).
Return (KEY [NAME VERSION STATUS DOC]), where KEY is the
identifier (NAME . VERSION-LIST)."
(let* ((package (caar pkg))
(version (cdr (car pkg)))
(status (nth 1 pkg))
(doc (or (nth 2 pkg) ""))
(face (cond
((string= status "built-in") 'font-lock-builtin-face)
((string= status "available") 'default)
((string= status "held") 'font-lock-constant-face)
((string= status "disabled") 'font-lock-warning-face)
((string= status "installed") 'font-lock-comment-face)
(t 'font-lock-warning-face)))) ; obsolete.
(list (cons package version)
(vector (list (symbol-name package)
'face 'link
'follow-link t
'package-symbol package
'action 'package-menu-describe-package)
(propertize (package-version-join version)
'font-lock-face face)
(propertize status 'font-lock-face face)
(propertize doc 'font-lock-face face)))))
(defun package-menu-refresh ()
"Download the Emacs Lisp package archive.
@ -1366,59 +1408,42 @@ This fetches the contents of each archive specified in
(unless (eq major-mode 'package-menu-mode)
(error "The current buffer is not a Package Menu"))
(package-refresh-contents)
(package--generate-package-list))
(package-menu--generate t))
(defun package-menu-revert (&optional arg noconfirm)
"Update the list of packages.
This function is the `revert-buffer-function' for Package Menu
buffers. The arguments are ignored."
(defun package-menu-describe-package (&optional button)
"Describe the current package.
If optional arg BUTTON is non-nil, describe its associated package."
(interactive)
(unless (eq major-mode 'package-menu-mode)
(error "The current buffer is not a Package Menu"))
(package--generate-package-list))
(defun package-menu-describe-package ()
"Describe the package in the current line."
(interactive)
(let ((name (package-menu-get-package)))
(if name
(describe-package (intern name))
(message "No package on this line"))))
(defun package-menu-mark-internal (what)
(unless (eobp)
(let ((buffer-read-only nil))
(beginning-of-line)
(delete-char 1)
(insert what)
(forward-line))))
(let ((package (if button (button-get button 'package-symbol)
(car (tabulated-list-get-id)))))
(if package
(describe-package package))))
;; fixme numeric argument
(defun package-menu-mark-delete (num)
"Mark a package for deletion and move to the next line."
(interactive "p")
(if (string-equal (package-menu-get-status) "installed")
(package-menu-mark-internal "D")
(tabulated-list-put-tag "D" t)
(forward-line)))
(defun package-menu-mark-install (num)
"Mark a package for installation and move to the next line."
(interactive "p")
(if (string-equal (package-menu-get-status) "available")
(package-menu-mark-internal "I")
(tabulated-list-put-tag "I" t)
(forward-line)))
(defun package-menu-mark-unmark (num)
"Clear any marks on a package and move to the next line."
(interactive "p")
(package-menu-mark-internal " "))
(tabulated-list-put-tag " " t))
(defun package-menu-backup-unmark ()
"Back up one line and clear any marks on that package."
(interactive)
(forward-line -1)
(package-menu-mark-internal " ")
(forward-line -1))
(tabulated-list-put-tag " "))
(defun package-menu-mark-obsolete-for-deletion ()
"Mark all obsolete packages for deletion."
@ -1428,7 +1453,7 @@ buffers. The arguments are ignored."
(forward-line 2)
(while (not (eobp))
(if (looking-at ".*\\s obsolete\\s ")
(package-menu-mark-internal "D")
(tabulated-list-put-tag "D" t)
(forward-line 1)))))
(defun package-menu-quick-help ()
@ -1439,20 +1464,6 @@ buffers. The arguments are ignored."
(define-obsolete-function-alias
'package-menu-view-commentary 'package-menu-describe-package "24.1")
;; Return the name of the package on the current line.
(defun package-menu-get-package ()
(save-excursion
(beginning-of-line)
(if (looking-at ". \\([^ \t]*\\)")
(match-string-no-properties 1))))
;; Return the version of the package on the current line.
(defun package-menu-get-version ()
(save-excursion
(beginning-of-line)
(if (looking-at ". [^ \t]*[ \t]*\\([0-9.]*\\)")
(match-string 1))))
(defun package-menu-get-status ()
(save-excursion
(if (looking-at ". [^ \t]*[ \t]*[^ \t]*[ \t]*\\([^ \t]*\\)")
@ -1464,19 +1475,22 @@ buffers. The arguments are ignored."
Packages marked for installation are downloaded and installed;
packages marked for deletion are removed."
(interactive)
(let (install-list delete-list cmd)
(unless (eq major-mode 'package-menu-mode)
(error "The current buffer is not in Package Menu mode"))
(let (install-list delete-list cmd id)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(setq cmd (char-after))
(cond
((eq cmd ?\s) t)
((eq cmd ?D)
(push (cons (package-menu-get-package)
(package-menu-get-version))
delete-list))
((eq cmd ?I)
(push (package-menu-get-package) install-list)))
(unless (eq cmd ?\s)
;; This is the key (PACKAGE . VERSION-LIST).
(setq id (tabulated-list-get-id))
(cond ((eq cmd ?D)
(push (cons (symbol-name (car id))
(package-version-join (cdr id)))
delete-list))
((eq cmd ?I)
(push (car id) install-list))))
(forward-line)))
;; Delete packages, prompting if necessary.
(when delete-list
@ -1502,217 +1516,71 @@ packages marked for deletion are removed."
(format "Install package `%s'? " (car install-list))
(format "Install these %d packages (%s)? "
(length install-list)
(mapconcat 'identity install-list ", "))))
(dolist (elt install-list)
(package-install (intern elt)))))
(mapconcat 'symbol-name install-list ", "))))
(mapc 'package-install install-list)))
;; If we deleted anything, regenerate `package-alist'. This is done
;; automatically if we installed a package.
(and delete-list (null install-list)
(package-initialize))
(if (or delete-list install-list)
(package-menu-revert)
(package-menu--generate t)
(message "No operations specified."))))
(defun package-print-package (package version key desc)
(let ((face
(cond ((string= key "built-in") 'font-lock-builtin-face)
((string= key "available") 'default)
((string= key "held") 'font-lock-constant-face)
((string= key "disabled") 'font-lock-warning-face)
((string= key "installed") 'font-lock-comment-face)
(t ; obsolete, but also the default.
'font-lock-warning-face))))
(insert (propertize " " 'font-lock-face face))
(insert-text-button (symbol-name package)
'face 'link
'follow-link t
'package-symbol package
'action (lambda (button)
(describe-package
(button-get button 'package-symbol))))
(indent-to 20 1)
(insert (propertize (package-version-join version) 'font-lock-face face))
(indent-to 32 1)
(insert (propertize key 'font-lock-face face))
;; FIXME: this 'when' is bogus...
(when desc
(indent-to 43 1)
(let ((opoint (point)))
(insert (propertize desc 'font-lock-face face))
(upcase-region opoint (min (point) (1+ opoint)))))
(insert "\n")))
(defun package-menu--version-predicate (A B)
(let ((vA (or (aref (cadr A) 1) '(0)))
(vB (or (aref (cadr B) 1) '(0))))
(if (version-list-= vA vB)
(package-menu--name-predicate A B)
(version-list-< vA vB))))
(defun package-list-maybe-add (package version status description result)
(unless (assoc (cons package version) result)
(push (list (cons package version) status description) result))
result)
(defun package-menu--status-predicate (A B)
(let ((sA (aref (cadr A) 2))
(sB (aref (cadr B) 2)))
(cond ((string= sA sB)
(package-menu--name-predicate A B))
((string= sA "available") t)
((string= sB "available") nil)
((string= sA "installed") t)
((string= sB "installed") nil)
((string= sA "held") t)
((string= sB "held") nil)
((string= sA "built-in") t)
((string= sB "built-in") nil)
((string= sA "obsolete") t)
((string= sB "obsolete") nil)
(t (string< sA sB)))))
(defvar package-menu-package-list nil
"List of packages to display in the Package Menu buffer.
A value of nil means to display all packages.")
(defun package-menu--description-predicate (A B)
(let ((dA (aref (cadr A) 3))
(dB (aref (cadr B) 3)))
(if (string= dA dB)
(package-menu--name-predicate A B)
(string< dA dB))))
(defvar package-menu-sort-key nil
"Sort key for the current Package Menu buffer.")
(defun package--generate-package-list ()
"Populate the current Package Menu buffer."
(let ((inhibit-read-only t)
info-list name desc hold builtin)
(erase-buffer)
;; List installed packages
(dolist (elt package-alist)
(setq name (car elt))
(when (or (null package-menu-package-list)
(memq name package-menu-package-list))
(setq desc (cdr elt)
hold (cadr (assq name package-load-list)))
(setq info-list
(package-list-maybe-add
name (package-desc-vers desc)
;; FIXME: it turns out to be tricky to see if this
;; package is presently activated.
(if (stringp hold) "held" "installed")
(package-desc-doc desc)
info-list))))
;; List built-in packages
(dolist (elt package--builtins)
(setq name (car elt))
(when (and (not (eq name 'emacs)) ; Hide the `emacs' package.
(or (null package-menu-package-list)
(memq name package-menu-package-list)))
(setq desc (cdr elt))
(setq info-list
(package-list-maybe-add
name (package-desc-vers desc)
"built-in"
(package-desc-doc desc)
info-list))))
;; List available and disabled packages
(dolist (elt package-archive-contents)
(setq name (car elt)
desc (cdr elt)
hold (assq name package-load-list))
(when (or (null package-menu-package-list)
(memq name package-menu-package-list))
(setq info-list
(package-list-maybe-add name
(package-desc-vers desc)
(if (and hold (null (cadr hold)))
"disabled"
"available")
(package-desc-doc (cdr elt))
info-list))))
;; List obsolete packages
(mapc (lambda (elt)
(mapc (lambda (inner-elt)
(setq info-list
(package-list-maybe-add (car elt)
(package-desc-vers
(cdr inner-elt))
"obsolete"
(package-desc-doc
(cdr inner-elt))
info-list)))
(cdr elt)))
package-obsolete-alist)
(setq info-list
(sort info-list
(cond ((string= package-menu-sort-key "Package")
'package-menu--name-predicate)
((string= package-menu-sort-key "Version")
'package-menu--version-predicate)
((string= package-menu-sort-key "Description")
'package-menu--description-predicate)
(t ; By default, sort by package status
'package-menu--status-predicate))))
(dolist (elt info-list)
(package-print-package (car (car elt))
(cdr (car elt))
(car (cdr elt))
(car (cdr (cdr elt)))))
(goto-char (point-min))
(set-buffer-modified-p nil)
(current-buffer)))
(defun package-menu--version-predicate (left right)
(let ((vleft (or (cdr (car left)) '(0)))
(vright (or (cdr (car right)) '(0))))
(if (version-list-= vleft vright)
(package-menu--name-predicate left right)
(version-list-< vleft vright))))
(defun package-menu--status-predicate (left right)
(let ((sleft (cadr left))
(sright (cadr right)))
(cond ((string= sleft sright)
(package-menu--name-predicate left right))
((string= sleft "available") t)
((string= sright "available") nil)
((string= sleft "installed") t)
((string= sright "installed") nil)
((string= sleft "held") t)
((string= sright "held") nil)
((string= sleft "built-in") t)
((string= sright "built-in") nil)
((string= sleft "obsolete") t)
((string= sright "obsolete") nil)
(t (string< sleft sright)))))
(defun package-menu--description-predicate (left right)
(let ((sleft (car (cddr left)))
(sright (car (cddr right))))
(if (string= sleft sright)
(package-menu--name-predicate left right)
(string< sleft sright))))
(defun package-menu--name-predicate (left right)
(string< (symbol-name (caar left))
(symbol-name (caar right))))
(defun package-menu-sort-by-column (&optional e)
"Sort the package menu by the column of the mouse click E."
(interactive "e")
(let* ((pos (event-start e))
(obj (posn-object pos))
(col (if obj
(get-text-property (cdr obj) 'column-name (car obj))
(get-text-property (posn-point pos) 'column-name)))
(buf (window-buffer (posn-window (event-start e)))))
(with-current-buffer buf
(when (eq major-mode 'package-menu-mode)
(setq package-menu-sort-key col)
(package--generate-package-list)))))
(defun package--list-packages (&optional packages)
"Generate and pop to the *Packages* buffer.
Optional PACKAGES is a list of names of packages (symbols) to
list; the default is to display everything in `package-alist'."
(require 'finder-inf nil t)
(let ((buf (get-buffer-create "*Packages*")))
(with-current-buffer buf
(package-menu-mode)
(set (make-local-variable 'package-menu-package-list) packages)
(set (make-local-variable 'package-menu-sort-key) nil)
(package--generate-package-list))
;; The package menu buffer has keybindings. If the user types
;; `M-x list-packages', that suggests it should become current.
(switch-to-buffer buf)))
(defun package-menu--name-predicate (A B)
(string< (symbol-name (caar A))
(symbol-name (caar B))))
;;;###autoload
(defun list-packages ()
(defun list-packages (&optional no-fetch)
"Display a list of packages.
Fetches the updated list of packages before displaying.
This first fetches the updated list of packages before
displaying, unless a prefix argument NO-FETCH is specified.
The list is displayed in a buffer named `*Packages*'."
(interactive)
(interactive "P")
(require 'finder-inf nil t)
;; Initialize the package system if necessary.
(unless package--initialized
(package-initialize t))
(package-refresh-contents)
(package--list-packages))
(unless no-fetch
(package-refresh-contents))
(let ((buf (get-buffer-create "*Packages*")))
(with-current-buffer buf
(package-menu-mode)
(package-menu--generate))
;; The package menu buffer has keybindings. If the user types
;; `M-x list-packages', that suggests it should become current.
(switch-to-buffer buf)))
;;;###autoload
(defalias 'package-list-packages 'list-packages)
@ -1722,7 +1590,7 @@ The list is displayed in a buffer named `*Packages*'."
Does not fetch the updated list of packages before displaying.
The list is displayed in a buffer named `*Packages*'."
(interactive)
(package--list-packages))
(list-packages t))
(provide 'package)

355
lisp/emacs-lisp/tabulated-list.el Normal file
View file

@ -0,0 +1,355 @@
;;; tabulated-list.el --- generic major mode for tabulated lists.
;; Copyright (C) 2011 Free Software Foundation, Inc.
;; Author: Chong Yidong <cyd@stupidchicken.com>
;; Keywords: extensions, lisp
;; This file is part of GNU Emacs.
;; GNU Emacs 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 3, or (at your option)
;; any later version.
;; GNU Emacs 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This file defines `tabulated-list-mode', a generic major mode for displaying
;; lists of tabulated data, intended for other major modes to inherit from. It
;; provides several utility routines, e.g. for pretty-printing lines of
;; tabulated data to fit into the appropriate columns.
;; For usage information, see the documentation of `tabulated-list-mode'.
;; This package originated from Tom Tromey's Package Menu mode, extended and
;; generalized to be used by other modes.
;;; Code:
(defvar tabulated-list-format nil
"The format of the current Tabulated List mode buffer.
This should be a vector of elements (NAME WIDTH SORT), where:
- NAME is a string describing the column.
- WIDTH is the width to reserve for the column.
For the final element, its numerical value is ignored.
- SORT specifies how to sort entries by this column.
If nil, this column cannot be used for sorting.
If t, sort by comparing the string value printed in the column.
Otherwise, it should be a predicate function suitable for
`sort', accepting arguments with the same form as the elements
of `tabulated-list-entries'.")
(make-variable-buffer-local 'tabulated-list-format)
(defvar tabulated-list-entries nil
"Entries displayed in the current Tabulated List buffer.
This should be either a function, or a list.
If a list, each element has the form (ID [DESC1 ... DESCN]),
where:
- ID is nil, or a Lisp object uniquely identifying this entry,
which is used to keep the cursor on the \"same\" entry when
rearranging the list. Comparison is done with `equal'.
- Each DESC is a column descriptor, one for each column
specified in `tabulated-list-format'. A descriptor is either
a string, which is printed as-is, or a list (LABEL . PROPS),
which means to use `insert-text-button' to insert a text
button with label LABEL and button properties PROPS.
The string, or button label, must not contain any newline.
If `tabulated-list-entries' is a function, it is called with no
arguments and must return a list of the above form.")
(make-variable-buffer-local 'tabulated-list-entries)
(defvar tabulated-list-padding 0
"Number of characters preceding each Tabulated List mode entry.
By default, lines are padded with spaces, but you can use the
function `tabulated-list-put-tag' to change this.")
(make-variable-buffer-local 'tabulated-list-padding)
(defvar tabulated-list-revert-hook nil
"Hook run before reverting a Tabulated List buffer.
This is commonly used to recompute `tabulated-list-entries'.")
(defvar tabulated-list-printer 'tabulated-list-print-entry
"Function for inserting a Tabulated List entry at point.
It is called with two arguments, ID and COLS. ID is a Lisp
object identifying the entry, and COLS is a vector of column
descriptors, as documented in `tabulated-list-entries'.")
(make-variable-buffer-local 'tabulated-list-printer)
(defvar tabulated-list-sort-key nil
"Sort key for the current Tabulated List mode buffer.
If nil, no additional sorting is performed.
Otherwise, this should be a cons cell (NAME . FLIP).
NAME is a string matching one of the column names in
`tabulated-list-format' (the corresponding SORT entry in
`tabulated-list-format' then specifies how to sort). FLIP, if
non-nil, means to invert the resulting sort.")
(make-variable-buffer-local 'tabulated-list-sort-key)
(defun tabulated-list-get-id (&optional pos)
"Obtain the entry ID of the Tabulated List mode entry at POS.
This is an ID object from `tabulated-list-entries', or nil.
POS, if omitted or nil, defaults to point."
(get-text-property (or pos (point)) 'tabulated-list-id))
(defun tabulated-list-put-tag (tag &optional advance)
"Put TAG in the padding area of the current line.
TAG should be a string, with length <= `tabulated-list-padding'.
If ADVANCE is non-nil, move forward by one line afterwards."
(unless (stringp tag)
(error "Invalid argument to `tabulated-list-put-tag'"))
(unless (> tabulated-list-padding 0)
(error "Unable to tag the current line"))
(save-excursion
(beginning-of-line)
(when (get-text-property (point) 'tabulated-list-id)
(let ((beg (point))
(inhibit-read-only t))
(forward-char tabulated-list-padding)
(insert-and-inherit
(if (<= (length tag) tabulated-list-padding)
(concat tag
(make-string (- tabulated-list-padding (length tag))
?\s))
(substring tag 0 tabulated-list-padding)))
(delete-region beg (+ beg tabulated-list-padding)))))
(if advance
(forward-line)))
(defvar tabulated-list-mode-map
(let ((map (copy-keymap special-mode-map)))
(set-keymap-parent map button-buffer-map)
(define-key map "n" 'next-line)
(define-key map "p" 'previous-line)
(define-key map [follow-link] 'mouse-face)
(define-key map [mouse-2] 'mouse-select-window)
map)
"Local keymap for `tabulated-list-mode' buffers.")
(defvar tabulated-list-sort-button-map
(let ((map (make-sparse-keymap)))
(define-key map [header-line mouse-1] 'tabulated-list-col-sort)
(define-key map [header-line mouse-2] 'tabulated-list-col-sort)
(define-key map [follow-link] 'mouse-face)
map)
"Local keymap for `tabulated-list-mode' sort buttons.")
(defun tabulated-list-init-header ()
"Set up header line for the Tabulated List buffer."
(let ((x tabulated-list-padding)
(button-props `(help-echo "Click to sort by column"
mouse-face highlight
keymap ,tabulated-list-sort-button-map))
(cols nil))
(if (> tabulated-list-padding 0)
(push (propertize " " 'display `(space :align-to ,x)) cols))
(dotimes (n (length tabulated-list-format))
(let* ((col (aref tabulated-list-format n))
(width (nth 1 col))
(label (car col)))
(setq x (+ x 1 width))
(and (<= tabulated-list-padding 0)
(= n 0)
(setq label (concat " " label)))
(push
(cond
;; An unsortable column
((not (nth 2 col)) label)
;; The selected sort column
((equal (car col) (car tabulated-list-sort-key))
(apply 'propertize
(concat label
(cond
((> (+ 2 (length label)) width)
"")
((cdr tabulated-list-sort-key)
" ▲")
(t " ▼")))
'face 'bold
'tabulated-list-column-name (car col)
button-props))
;; Unselected sortable column.
(t (apply 'propertize label
'tabulated-list-column-name (car col)
button-props)))
cols))
(push (propertize " "
'display (list 'space :align-to x)
'face 'fixed-pitch)
cols))
(setq header-line-format (mapconcat 'identity (nreverse cols) ""))))
(defun tabulated-list-revert (&rest ignored)
"The `revert-buffer-function' for `tabulated-list-mode'.
It runs `tabulated-list-revert-hook', then calls `tabulated-list-print'."
(interactive)
(unless (derived-mode-p 'tabulated-list-mode)
(error "The current buffer is not in Tabulated List mode"))
(run-hooks 'tabulated-list-revert-hook)
(tabulated-list-print t))
(defun tabulated-list-print (&optional remember-pos)
"Populate the current Tabulated List mode buffer.
This sorts the `tabulated-list-entries' list if sorting is
specified by `tabulated-list-sort-key'. It then erases the
buffer and inserts the entries with `tabulated-list-printer'.
Optional argument REMEMBER-POS, if non-nil, means to move point
to the entry with the same ID element as the current line."
(let ((inhibit-read-only t)
(entries (if (functionp 'tabulated-list-entries)
(funcall tabulated-list-entries)
tabulated-list-entries))
entry-id saved-pt saved-col)
(and remember-pos
(setq entry-id (tabulated-list-get-id))
(setq saved-col (current-column)))
(erase-buffer)
;; Sort the buffers, if necessary.
(when tabulated-list-sort-key
(let ((sort-column (car tabulated-list-sort-key))
(len (length tabulated-list-format))
(n 0)
sorter)
;; Which column is to be sorted?
(while (and (< n len)
(not (equal (car (aref tabulated-list-format n))
sort-column)))
(setq n (1+ n)))
(when (< n len)
(setq sorter (nth 2 (aref tabulated-list-format n)))
(when (eq sorter t)
(setq sorter ; Default sorter checks column N:
(lambda (A B)
(setq A (aref (cadr A) n))
(setq B (aref (cadr B) n))
(string< (if (stringp A) A (car A))
(if (stringp B) B (car B))))))
(setq entries (sort entries sorter))
(if (cdr tabulated-list-sort-key)
(setq entries (nreverse entries)))
(unless (functionp 'tabulated-list-entries)
(setq tabulated-list-entries entries)))))
;; Print the resulting list.
(dolist (elt entries)
(and entry-id
(equal entry-id (car elt))
(setq saved-pt (point)))
(apply tabulated-list-printer elt))
(set-buffer-modified-p nil)
;; If REMEMBER-POS was specified, move to the "old" location.
(if saved-pt
(progn (goto-char saved-pt)
(move-to-column saved-col))
(goto-char (point-min)))))
(defun tabulated-list-print-entry (id cols)
"Insert a Tabulated List entry at point.
This is the default `tabulated-list-printer' function. ID is a
Lisp object identifying the entry to print, and COLS is a vector
of column descriptors."
(let ((beg (point))
(x (max tabulated-list-padding 0))
(len (length tabulated-list-format)))
(if (> tabulated-list-padding 0)
(insert (make-string x ?\s)))
(dotimes (n len)
(let* ((format (aref tabulated-list-format n))
(desc (aref cols n))
(width (nth 1 format))
(label (if (stringp desc) desc (car desc)))
(help-echo (concat (car format) ": " label)))
;; Truncate labels if necessary.
(and (> width 6)
(> (length label) width)
(setq label (concat (substring desc 0 (- width 3))
"...")))
(if (stringp desc)
(insert (propertize label 'help-echo help-echo))
(apply 'insert-text-button label (cdr desc)))
(setq x (+ x 1 width)))
;; No need to append any spaces if this is the last column.
(if (< (1+ n) len)
(indent-to x 1)))
(insert ?\n)
(put-text-property beg (point) 'tabulated-list-id id)))
(defun tabulated-list-col-sort (&optional e)
"Sort Tabulated List entries by the column of the mouse click E."
(interactive "e")
(let* ((pos (event-start e))
(obj (posn-object pos))
(name (get-text-property (if obj (cdr obj) (posn-point pos))
'tabulated-list-column-name
(car obj))))
(with-current-buffer (window-buffer (posn-window pos))
(when (derived-mode-p 'tabulated-list-mode)
;; Flip the sort order on a second click.
(if (equal name (car tabulated-list-sort-key))
(setcdr tabulated-list-sort-key
(not (cdr tabulated-list-sort-key)))
(setq tabulated-list-sort-key (cons name nil)))
(tabulated-list-init-header)
(tabulated-list-print t)))))
;;; The mode definition:
;;;###autoload
(define-derived-mode tabulated-list-mode special-mode "Tabulated"
"Generic major mode for browsing a list of items.
This mode is usually not used directly; instead, other major
modes are derived from it, using `define-derived-mode'.
In this major mode, the buffer is divided into multiple columns,
which are labelled using the header line. Each non-empty line
belongs to one \"entry\", and the entries can be sorted according
to their column values.
An inheriting mode should usually do the following in their body:
- Set `tabulated-list-format', specifying the column format.
- Set `tabulated-list-revert-hook', if the buffer contents need
to be specially recomputed prior to `revert-buffer'.
- Maybe set a `tabulated-list-entries' function (see below).
- Maybe set `tabulated-list-printer' (see below).
- Maybe set `tabulated-list-padding'.
- Call `tabulated-list-init-header' to initialize `header-line-format'
according to `tabulated-list-format'.
An inheriting mode is usually accompanied by a \"list-FOO\"
command (e.g. `list-packages', `list-processes'). This command
creates or switches to a buffer and enables the major mode in
that buffer. If `tabulated-list-entries' is not a function, the
command should initialize it to a list of entries for displaying.
Finally, it should call `tabulated-list-print'.
`tabulated-list-print' calls the printer function specified by
`tabulated-list-printer', once for each entry. The default
printer is `tabulated-list-print-entry', but a mode that keeps
data in an ewoc may instead specify a printer function (e.g., one
that calls `ewoc-enter-last'), with `tabulated-list-print-entry'
as the ewoc pretty-printer."
(setq truncate-lines t)
(setq buffer-read-only t)
(set (make-local-variable 'revert-buffer-function)
'tabulated-list-revert))
(put 'tabulated-list-mode 'mode-class 'special)
(provide 'tabulated-list)
;; Local Variables:
;; coding: utf-8
;; lexical-binding: t
;; End:
;;; tabulated-list.el ends here

55
lisp/files.el
View file

@ -1140,6 +1140,37 @@ it means chase no more than that many links and then stop."
(setq count (1+ count))))
newname))
;; A handy function to display file sizes in human-readable form.
;; See http://en.wikipedia.org/wiki/Kibibyte for the reference.
(defun file-size-human-readable (file-size &optional flavor)
"Produce a string showing FILE-SIZE in human-readable form.
Optional second argument FLAVOR controls the units and the display format:
If FLAVOR is nil or omitted, each kilobyte is 1024 bytes and the produced
suffixes are \"k\", \"M\", \"G\", \"T\", etc.
If FLAVOR is `si', each kilobyte is 1000 bytes and the produced suffixes
are \"k\", \"M\", \"G\", \"T\", etc.
If FLAVOR is `iec', each kilobyte is 1024 bytes and the produced suffixes
are \"KiB\", \"MiB\", \"GiB\", \"TiB\", etc."
(let ((power (if (or (null flavor) (eq flavor 'iec))
1024.0
1000.0))
(post-fixes
;; none, kilo, mega, giga, tera, peta, exa, zetta, yotta
(list "" "k" "M" "G" "T" "P" "E" "Z" "Y")))
(while (and (>= file-size power) (cdr post-fixes))
(setq file-size (/ file-size power)
post-fixes (cdr post-fixes)))
(format (if (> (mod file-size 1.0) 0.05)
"%.1f%s%s"
"%.0f%s%s")
file-size
(if (and (eq flavor 'iec) (string= (car post-fixes) "k"))
"K"
(car post-fixes))
(if (eq flavor 'iec) "iB" ""))))
(defun make-temp-file (prefix &optional dir-flag suffix)
"Create a temporary file.
The returned file name (created by appending some random characters at the end
@ -2100,10 +2131,8 @@ the file contents into it using `insert-file-contents-literally'."
(confirm-nonexistent-file-or-buffer))))
(switch-to-buffer (find-file-noselect filename nil t)))
(defvar after-find-file-from-revert-buffer nil)
(defun after-find-file (&optional error warn noauto
after-find-file-from-revert-buffer
_after-find-file-from-revert-buffer
nomodes)
"Called after finding a file and by the default revert function.
Sets buffer mode, parses local variables.
@ -2111,8 +2140,8 @@ Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an
error in reading the file. WARN non-nil means warn if there
exists an auto-save file more recent than the visited file.
NOAUTO means don't mess with auto-save mode.
Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil
means this call was from `revert-buffer'.
Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER is ignored
\(see `revert-buffer-in-progress-p' for similar functionality).
Fifth arg NOMODES non-nil means don't alter the file's modes.
Finishes by calling the functions in `find-file-hook'
unless NOMODES is non-nil."
@ -5004,6 +5033,10 @@ hook functions.
If `revert-buffer-function' is used to override the normal revert
mechanism, this hook is not used.")
(defvar revert-buffer-in-progress-p nil
"Non-nil if a `revert-buffer' operation is in progress, nil otherwise.
This is true even if a `revert-buffer-function' is being used.")
(defvar revert-buffer-internal-hook)
(defun revert-buffer (&optional ignore-auto noconfirm preserve-modes)
@ -5046,10 +5079,12 @@ non-nil, it is called instead of rereading visited file contents."
;; interface, but leaving the programmatic interface the same.
(interactive (list (not current-prefix-arg)))
(if revert-buffer-function
(funcall revert-buffer-function ignore-auto noconfirm)
(let ((revert-buffer-in-progress-p t))
(funcall revert-buffer-function ignore-auto noconfirm))
(with-current-buffer (or (buffer-base-buffer (current-buffer))
(current-buffer))
(let* ((auto-save-p (and (not ignore-auto)
(let* ((revert-buffer-in-progress-p t)
(auto-save-p (and (not ignore-auto)
(recent-auto-save-p)
buffer-auto-save-file-name
(file-readable-p buffer-auto-save-file-name)
@ -5140,7 +5175,7 @@ non-nil, it is called instead of rereading visited file contents."
;; have changed the truename.
(setq buffer-file-truename
(abbreviate-file-name (file-truename buffer-file-name)))
(after-find-file nil nil t t preserve-modes)
(after-find-file nil nil t nil preserve-modes)
;; Run after-revert-hook as it was before we reverted.
(setq-default revert-buffer-internal-hook global-hook)
(if local-hook
@ -6142,8 +6177,8 @@ With prefix ARG, silently save all file-visiting buffers, then kill."
(setq active t))
(setq processes (cdr processes)))
(or (not active)
(list-processes t)
(yes-or-no-p "Active processes exist; kill them and exit anyway? "))))
(progn (list-processes t)
(yes-or-no-p "Active processes exist; kill them and exit anyway? ")))))
;; Query the user for other things, perhaps.
(run-hook-with-args-until-failure 'kill-emacs-query-functions)
(or (null confirm-kill-emacs)

2
lisp/follow.el
View file

@ -1061,7 +1061,7 @@ Return the selected window."
;; it wasn't just moved here. (i.e. M-> shall not unconditionally place
;; the point in the selected window.)
;;
;; (Compability cludge: in Emacs `window-end' is equal to `point-max';
;; (Compatibility cludge: in Emacs `window-end' is equal to `point-max';
;; in XEmacs, it is equal to `point-max + 1'. Should I really bother
;; checking `window-end' now when I check `end-of-buffer' explicitly?)

49
lisp/gnus/ChangeLog
View file

@ -1,10 +1,53 @@
2011-04-07 Teodor Zlatanov <tzz@lifelogs.com>
* gnus-registry.el (gnus-registry-handle-action): More debugging.
* gnus-start.el (gnus-gnus-to-newsrc-format): Add a way to run
interactively so the newsrc file can contain foreign groups too.
Useful for debugging but not much for users.
2011-04-07 David Engster <dengste@eml.cc>
* registry.el (registry-usage-test): Only do
`registry-lookup-breaks-before-lexbind' testing for Emacs24 with
lexical binding.
2011-04-06 David Engster <dengste@eml.cc>
* registry.el, gnus-registry.el: Use `ignore-errors' instead of third
argument NOERROR for `require', since XEmacs 21.4 does not support it.
2011-04-06 David Engster <dengste@eml.cc>
* registry.el (initialize-instance): Change :after to :AFTER to be
compatible with old EIEIO version in XEmacs.
2011-04-06 Teodor Zlatanov <tzz@lifelogs.com>
* gnus-registry.el: Don't use ERT if it's not available.
* gnus-registry.el (gnus-registry-post-process-groups)
(gnus-registry--split-fancy-with-parent-internal): Fix splitting bugs
and provide better messaging.
2011-04-06 David Engster <dengste@eml.cc>
* Makefile.in (fail-on-warning): New rule to compile with warnings as
errors.
* dgnushack.el (dgnushack-compile-error-on-warn): New function to call
dgnushack-compile with error-on-warn enabled, and to signal an error if
clean compilation failed.
(dgnushack-compile): New argument 'error-on-warn'. If non-nil, compile
with `byte-compile-error-on-warn'. Return nil if errors occured.
2011-04-06 Teodor Zlatanov <tzz@lifelogs.com>
* gnus-registry.el: Don't use ERT if it's not available. Load it
unconditionally anyway, discarding errors.
(gnus-registry-delete-entries): New convenience function.
(gnus-registry-import-eld): Import from old .eld registry.
* registry.el: Don't use ERT if it's not available.
* registry.el: Don't use ERT if it's not available. Load it
unconditionally anyway, discarding errors.
* proto-stream.el (gnutls-negotiate): Revert inadvertent commit of the
version from the Claudio Bley GnuTLS patch (extra optional parameters
@ -15171,7 +15214,7 @@
* smime-ldap.el (smime-ldap-search): Add compatibility for XEmacs.
* smime.el (smime-cert-by-ldap-1): Handle certificates distributed
in PEM format. Adjust to the XEmacs compability.
in PEM format. Adjust to the XEmacs compatibility.
2005-05-30 Reiner Steib <Reiner.Steib@gmx.de>

194
lisp/gnus/gnus-registry.el
View file

@ -58,9 +58,11 @@
(eval-when-compile (require 'cl))
(eval-when-compile
(when (null (require 'ert nil t))
(when (null (ignore-errors (require 'ert)))
(defmacro* ert-deftest (name () &body docstring-keys-and-body))))
(ignore-errors
(require 'ert))
(require 'gnus)
(require 'gnus-int)
(require 'gnus-sum)
@ -319,6 +321,9 @@ This is not required after changing `gnus-registry-cache-file'."
(gnus-registry-handle-action id nil to subject sender)))
(defun gnus-registry-handle-action (id from to subject sender)
(gnus-message
10
"gnus-registry-handle-action %S" (list id from to subject sender))
(let ((db gnus-registry-db)
;; safe if not found
(entry (gnus-registry-get-or-make-entry id)))
@ -394,85 +399,83 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details."
&allow-other-keys)
(gnus-message
10
"gnus-registry--split-fancy-with-parent-internal: %S" spec)
"gnus-registry--split-fancy-with-parent-internal %S" spec)
(let ((db gnus-registry-db)
found)
;; this is a big if-else statement. it uses
;; this is a big chain of statements. it uses
;; gnus-registry-post-process-groups to filter the results after
;; every step.
(cond
;; the references string must be valid and parse to valid references
(references
;; the references string must be valid and parse to valid references
(when references
(gnus-message
9
"%s is tracing references %s"
log-agent refstr)
(dolist (reference (nreverse references))
(gnus-message
9
"%s is looking for matches for reference %s from [%s]"
log-agent reference refstr)
(setq found
(loop for group in (gnus-registry-get-id-key reference 'group)
when (gnus-registry-follow-group-p group)
do (gnus-message
7
"%s traced the reference %s from [%s] to group %s"
log-agent reference refstr group)
collect group)))
(gnus-message 9 "%s is looking up %s" log-agent reference)
(loop for group in (gnus-registry-get-id-key reference 'group)
when (gnus-registry-follow-group-p group)
do (gnus-message 7 "%s traced %s to %s" log-agent reference group)
do (push group found)))
;; filter the found groups and return them
;; the found groups are the full groups
(setq found (gnus-registry-post-process-groups
"references" refstr found)))
;; else: there were no matches, try the extra tracking by sender
((and (memq 'sender gnus-registry-track-extra)
sender
(gnus-grep-in-list
sender
gnus-registry-unfollowed-addresses))
(let ((groups (apply
'append
(mapcar
(lambda (reference)
(gnus-registry-get-id-key reference 'group))
(registry-lookup-secondary-value db 'sender sender)))))
(setq found
(loop for group in groups
when (gnus-registry-follow-group-p group)
do (gnus-message
;; raise level of messaging if gnus-registry-track-extra
(if gnus-registry-track-extra 7 9)
"%s (extra tracking) traced sender '%s' to groups %s"
log-agent sender found)
collect group)))
(when (and (null found)
(memq 'sender gnus-registry-track-extra)
sender
(gnus-grep-in-list
sender
gnus-registry-unfollowed-addresses))
(let ((groups (apply
'append
(mapcar
(lambda (reference)
(gnus-registry-get-id-key reference 'group))
(registry-lookup-secondary-value db 'sender sender)))))
(setq found
(loop for group in groups
when (gnus-registry-follow-group-p group)
do (gnus-message
;; warn more if gnus-registry-track-extra
(if gnus-registry-track-extra 7 9)
"%s (extra tracking) traced sender '%s' to %s"
log-agent sender group)
collect group)))
;; filter the found groups and return them
;; the found groups are NOT the full groups
(setq found (gnus-registry-post-process-groups
"sender" sender found)))
;; filter the found groups and return them
;; the found groups are NOT the full groups
(setq found (gnus-registry-post-process-groups
"sender" sender found)))
;; else: there were no matches, now try the extra tracking by subject
((and (memq 'subject gnus-registry-track-extra)
subject
(< gnus-registry-minimum-subject-length (length subject)))
(let ((groups (apply
'append
(mapcar
(lambda (reference)
(gnus-registry-get-id-key reference 'group))
(registry-lookup-secondary-value db 'subject subject)))))
(setq found
(loop for group in groups
when (gnus-registry-follow-group-p group)
do (gnus-message
;; raise level of messaging if gnus-registry-track-extra
(if gnus-registry-track-extra 7 9)
"%s (extra tracking) traced subject '%s' to groups %s"
log-agent subject found)
collect group))
;; filter the found groups and return them
;; the found groups are NOT the full groups
(setq found (gnus-registry-post-process-groups
"subject" subject found)))))
;; after the (cond) we extract the actual value safely
(car-safe found)))
(when (and (null found)
(memq 'subject gnus-registry-track-extra)
subject
(< gnus-registry-minimum-subject-length (length subject)))
(let ((groups (apply
'append
(mapcar
(lambda (reference)
(gnus-registry-get-id-key reference 'group))
(registry-lookup-secondary-value db 'subject subject)))))
(setq found
(loop for group in groups
when (gnus-registry-follow-group-p group)
do (gnus-message
;; warn more if gnus-registry-track-extra
(if gnus-registry-track-extra 7 9)
"%s (extra tracking) traced subject '%s' to %s"
log-agent subject group)
collect group))
;; filter the found groups and return them
;; the found groups are NOT the full groups
(setq found (gnus-registry-post-process-groups
"subject" subject found))))
;; after the (cond) we extract the actual value safely
(car-safe found)))
(defun gnus-registry-post-process-groups (mode key groups)
"Inspects GROUPS found by MODE for KEY to determine which ones to follow.
@ -489,25 +492,48 @@ Foreign methods are not supported so they are rejected.
Reduces the list to a single group, or complains if that's not
possible. Uses `gnus-registry-split-strategy'."
(let ((log-agent "gnus-registry-post-process-group")
out)
;; the strategy can be nil, in which case groups is nil
(setq groups
(desc (format "%d groups" (length groups)))
out chosen)
;; the strategy can be nil, in which case chosen is nil
(setq chosen
(case gnus-registry-split-strategy
;; first strategy
;; default, take only one-element lists into chosen
((nil)
(and (= (length groups) 1)
(car-safe groups)))
((first)
(and groups (list (car-safe groups))))
(car-safe groups))
((majority)
(let ((freq (make-hash-table
:size 256
:test 'equal)))
(mapc (lambda (x) (puthash x (1+ (gethash x freq 0)) freq))
(mapc (lambda (x) (let ((x (gnus-group-short-name x)))
(puthash x (1+ (gethash x freq 0)) freq)))
groups)
(list (car-safe
(sort groups (lambda (a b)
(> (gethash a freq 0)
(gethash b freq 0))))))))))
(setq desc (format "%d groups, %d unique"
(length groups)
(hash-table-count freq)))
(car-safe
(sort groups
(lambda (a b)
(> (gethash (gnus-group-short-name a) freq 0)
(gethash (gnus-group-short-name b) freq 0)))))))))
(if chosen
(gnus-message
9
"%s: strategy %s on %s produced %s"
log-agent gnus-registry-split-strategy desc chosen)
(gnus-message
9
"%s: strategy %s on %s did not produce an answer"
log-agent
(or gnus-registry-split-strategy "default")
desc))
(setq groups (and chosen (list chosen)))
(dolist (group groups)
(let ((m1 (gnus-find-method-for-group group))
@ -517,18 +543,20 @@ possible. Uses `gnus-registry-split-strategy'."
(if (gnus-methods-equal-p m1 m2)
(progn
;; this is REALLY just for debugging
(gnus-message
10
"%s stripped group %s to %s"
log-agent group short-name)
(when (not (equal group short-name))
(gnus-message
10
"%s: stripped group %s to %s"
log-agent group short-name))
(add-to-list 'out short-name))
;; else...
(gnus-message
7
"%s ignored foreign group %s"
"%s: ignored foreign group %s"
log-agent group))))
;; is there just one group?
(setq out (delq nil out))
(cond
((= (length out) 1) out)
((null out)

6
lisp/gnus/gnus-start.el
View file

@ -2873,7 +2873,8 @@ If FORCE is non-nil, the .newsrc file is read."
(pop list))
(nreverse olist)))
(defun gnus-gnus-to-newsrc-format ()
(defun gnus-gnus-to-newsrc-format (&optional foreign-ok)
(interactive (list (gnus-y-or-n-p "write foreign groups too? ")))
;; Generate and save the .newsrc file.
(with-current-buffer (create-file-buffer gnus-current-startup-file)
(let ((newsrc (cdr gnus-newsrc-alist))
@ -2895,7 +2896,8 @@ If FORCE is non-nil, the .newsrc file is read."
;; Don't write foreign groups to .newsrc.
(when (or (null (setq method (gnus-info-method info)))
(equal method "native")
(inline (gnus-server-equal method gnus-select-method)))
(inline (gnus-server-equal method gnus-select-method))
foreign-ok)
(insert (gnus-info-group info)
(if (> (gnus-info-level info) gnus-level-subscribed)
"!" ":"))

20
lisp/gnus/registry.el
View file

@ -78,9 +78,12 @@
;;; Code:
(eval-when-compile
(when (null (require 'ert nil t))
(when (null (ignore-errors (require 'ert)))
(defmacro* ert-deftest (name () &body docstring-keys-and-body))))
(ignore-errors
(require 'ert))
(eval-when-compile (require 'cl))
(eval-and-compile
(or (ignore-errors (progn
@ -128,7 +131,7 @@
:type hash-table
:documentation "The data hashtable.")))
(defmethod initialize-instance :after ((this registry-db) slots)
(defmethod initialize-instance :AFTER ((this registry-db) slots)
"Set value of data slot of THIS after initialization."
(with-slots (data tracker) this
(unless (member :data slots)
@ -354,12 +357,13 @@ Removes only entries without the :precious keys."
(should (= 58 (caadr (registry-lookup db '(1 58 99)))))
(message "Grouped individual lookup")
(should (= 3 (length (registry-lookup db '(1 58 99)))))
(message "Individual lookup (breaks before lexbind)")
(should (= 58
(caadr (registry-lookup-breaks-before-lexbind db '(1 58 99)))))
(message "Grouped individual lookup (breaks before lexbind)")
(should (= 3
(length (registry-lookup-breaks-before-lexbind db '(1 58 99)))))
(when (boundp 'lexical-binding)
(message "Individual lookup (breaks before lexbind)")
(should (= 58
(caadr (registry-lookup-breaks-before-lexbind db '(1 58 99)))))
(message "Grouped individual lookup (breaks before lexbind)")
(should (= 3
(length (registry-lookup-breaks-before-lexbind db '(1 58 99))))))
(message "Search")
(should (= n (length (registry-search db :all t))))
(should (= n (length (registry-search db :member '((sender "me"))))))

9
lisp/help.el
View file

@ -1256,6 +1256,15 @@ Select help window if the actual value of the user option
;; Reset `help-window' to nil to avoid confusing future calls of
;; `help-mode-finish' with plain `with-output-to-temp-buffer'.
(setq help-window nil))))
;; Called from C, on encountering `help-char' when reading a char.
;; Don't print to *Help*; that would clobber Help history.
(defun help-form-show ()
"Display the output of a non-nil `help-form'."
(let ((msg (eval help-form)))
(if (stringp msg)
(with-output-to-temp-buffer " *Char Help*"
(princ msg)))))
(provide 'help)

10
lisp/ls-lisp.el
View file

@ -62,8 +62,6 @@
;;; Code:
(eval-when-compile (require 'cl))
(defgroup ls-lisp nil
"Emulate the ls program completely in Emacs Lisp."
:version "21.1"
@ -726,13 +724,7 @@ All ls time options, namely c, t and u, are handled."
ls-lisp-filesize-f-fmt
ls-lisp-filesize-d-fmt)
file-size)
(if (< file-size 1024)
(format " %4d" file-size)
(do ((file-size (/ file-size 1024.0) (/ file-size 1024.0))
;; kilo, mega, giga, tera, peta, exa
(post-fixes (list "k" "M" "G" "T" "P" "E") (cdr post-fixes)))
((< file-size 1024)
(format " %3.0f%s" file-size (car post-fixes)))))))
(format " %7s" (file-size-human-readable file-size))))
(provide 'ls-lisp)

3
lisp/man.el
View file

@ -254,8 +254,7 @@ Used in `bookmark-set' to get the default bookmark name."
"Regular expression describing a manpage section within parentheses.")
(defvar Man-page-header-regexp
(if (and (string-match "-solaris2\\." system-configuration)
(not (string-match "-solaris2\\.[123435]$" system-configuration)))
(if (string-match "-solaris2\\." system-configuration)
(concat "^[-A-Za-z0-9_].*[ \t]\\(" Man-name-regexp
"(\\(" Man-section-regexp "\\))\\)$")
(concat "^[ \t]*\\(" Man-name-regexp

3
lisp/net/browse-url.el
View file

@ -1111,8 +1111,7 @@ URL in a new window."
browse-url-firefox-program
(append
browse-url-firefox-arguments
(if (or (featurep 'dos-w32)
(string-match "win32" system-configuration))
(if (memq system-type '(windows-nt ms-dos))
(list url)
(list "-remote"
(concat "openURL("

70
lisp/net/rlogin.el
View file

@ -60,14 +60,9 @@
:group 'rlogin)
(defcustom rlogin-process-connection-type
(save-match-data
;; Solaris 2.x `rlogin' will spew a bunch of ioctl error messages if
;; stdin isn't a tty.
(cond ((and (boundp 'system-configuration)
(stringp system-configuration)
(string-match "-solaris2" system-configuration))
t)
(t nil)))
;; Solaris 2.x `rlogin' will spew a bunch of ioctl error messages if
;; stdin isn't a tty.
(and (string-match-p "-solaris2" system-configuration) t)
"If non-nil, use a pty for the local rlogin process.
If nil, use a pipe (if pipes are supported on the local system).
@ -115,19 +110,19 @@ this variable is set from that."
:type '(choice (const nil) string)
:group 'rlogin)
;; Initialize rlogin mode map.
(defvar rlogin-mode-map '())
(cond
((null rlogin-mode-map)
(setq rlogin-mode-map (if (consp shell-mode-map)
(cons 'keymap shell-mode-map)
(copy-keymap shell-mode-map)))
(define-key rlogin-mode-map "\C-c\C-c" 'rlogin-send-Ctrl-C)
(define-key rlogin-mode-map "\C-c\C-d" 'rlogin-send-Ctrl-D)
(define-key rlogin-mode-map "\C-c\C-z" 'rlogin-send-Ctrl-Z)
(define-key rlogin-mode-map "\C-c\C-\\" 'rlogin-send-Ctrl-backslash)
(define-key rlogin-mode-map "\C-d" 'rlogin-delchar-or-send-Ctrl-D)
(define-key rlogin-mode-map "\C-i" 'rlogin-tab-or-complete)))
(defvar rlogin-mode-map
(let ((map (if (consp shell-mode-map)
(cons 'keymap shell-mode-map)
(copy-keymap shell-mode-map))))
(define-key rlogin-mode-map "\C-c\C-c" 'rlogin-send-Ctrl-C)
(define-key rlogin-mode-map "\C-c\C-d" 'rlogin-send-Ctrl-D)
(define-key rlogin-mode-map "\C-c\C-z" 'rlogin-send-Ctrl-Z)
(define-key rlogin-mode-map "\C-c\C-\\" 'rlogin-send-Ctrl-backslash)
(define-key rlogin-mode-map "\C-d" 'rlogin-delchar-or-send-Ctrl-D)
(define-key rlogin-mode-map "\C-i" 'rlogin-tab-or-complete)
map)
"Keymap for `rlogin-mode'.")
;;;###autoload (add-hook 'same-window-regexps (purecopy "^\\*rlogin-.*\\*\\(\\|<[0-9]+>\\)"))
@ -175,7 +170,6 @@ variable."
(read-from-minibuffer "rlogin arguments (hostname first): "
nil nil nil 'rlogin-history)
current-prefix-arg))
(let* ((process-connection-type rlogin-process-connection-type)
(args (if rlogin-explicit-args
(append (split-string input-args)
@ -192,7 +186,6 @@ variable."
(buffer-name (if (string= user (user-login-name))
(format "*rlogin-%s*" host)
(format "*rlogin-%s@%s*" user host))))
(cond ((null buffer))
((stringp buffer)
(setq buffer-name buffer))
@ -202,32 +195,26 @@ variable."
(setq buffer-name (format "%s<%d>" buffer-name buffer)))
(t
(setq buffer-name (generate-new-buffer-name buffer-name))))
(setq buffer (get-buffer-create buffer-name))
(pop-to-buffer buffer-name)
(unless (comint-check-proc buffer-name)
(comint-exec buffer buffer-name rlogin-program nil args)
(rlogin-mode)
(make-local-variable 'rlogin-host)
(setq rlogin-host host)
(make-local-variable 'rlogin-remote-user)
(setq rlogin-remote-user user)
(condition-case ()
(cond ((eq rlogin-directory-tracking-mode t)
;; Do this here, rather than calling the tracking mode
;; function, to avoid a gratuitous resync check; the default
;; should be the user's home directory, be it local or remote.
(setq comint-file-name-prefix
(concat "/" rlogin-remote-user "@" rlogin-host ":"))
(cd-absolute comint-file-name-prefix))
((null rlogin-directory-tracking-mode))
(t
(cd-absolute (concat comint-file-name-prefix "~/"))))
(error nil)))))
(ignore-errors
(cond ((eq rlogin-directory-tracking-mode t)
;; Do this here, rather than calling the tracking mode
;; function, to avoid a gratuitous resync check; the default
;; should be the user's home directory, be it local or remote.
(setq comint-file-name-prefix
(concat "/" rlogin-remote-user "@" rlogin-host ":"))
(cd-absolute comint-file-name-prefix))
((null rlogin-directory-tracking-mode))
(t
(cd-absolute (concat comint-file-name-prefix "~/"))))))))
(put 'rlogin-mode 'mode-class 'special)
@ -302,8 +289,7 @@ local one share the same directories (e.g. through NFS)."
(process-send-string nil "\C-\\"))
(defun rlogin-delchar-or-send-Ctrl-D (arg)
"\
Delete ARG characters forward, or send a C-d to process if at end of buffer."
"Delete ARG characters forward, or send a C-d to process if at end of buffer."
(interactive "p")
(if (eobp)
(rlogin-send-Ctrl-D)

2
lisp/play/morse.el
View file

@ -231,7 +231,7 @@ Geospatial-Intelligence Agency at http://www.nga.mil/")
(if (null (looking-at "[a-z]+"))
(forward-char 1)
(setq str (buffer-substring (match-beginning 0) (match-end 0)))
(if (null (setq nato (rassoc str nato-alphabet)))
(if (null (setq nato (rassoc (capitalize str) nato-alphabet)))
(goto-char (match-end 0))
(replace-match
(if (string-equal "(" (car nato))

25
lisp/replace.el
View file

@ -772,26 +772,29 @@ a previously found match."
(define-key map "\C-c\C-f" 'next-error-follow-minor-mode)
(define-key map [menu-bar] (make-sparse-keymap))
(define-key map [menu-bar occur]
`(cons ,(purecopy "Occur") map))
(cons (purecopy "Occur") map))
(define-key map [next-error-follow-minor-mode]
(menu-bar-make-mm-toggle next-error-follow-minor-mode
"Auto Occurrence Display"
"Display another occurrence when moving the cursor"))
`(menu-item ,(purecopy "Auto Occurrence Display")
next-error-follow-minor-mode
:help ,(purecopy
"Display another occurrence when moving the cursor")
:button (:toggle . (and (boundp 'next-error-follow-minor-mode)
next-error-follow-minor-mode))))
(define-key map [separator-1] menu-bar-separator)
(define-key map [kill-this-buffer]
`(menu-item ,(purecopy "Kill occur buffer") kill-this-buffer
`(menu-item ,(purecopy "Kill Occur Buffer") kill-this-buffer
:help ,(purecopy "Kill the current *Occur* buffer")))
(define-key map [quit-window]
`(menu-item ,(purecopy "Quit occur window") quit-window
`(menu-item ,(purecopy "Quit Occur Window") quit-window
:help ,(purecopy "Quit the current *Occur* buffer. Bury it, and maybe delete the selected frame")))
(define-key map [revert-buffer]
`(menu-item ,(purecopy "Revert occur buffer") revert-buffer
`(menu-item ,(purecopy "Revert Occur Buffer") revert-buffer
:help ,(purecopy "Replace the text in the *Occur* buffer with the results of rerunning occur")))
(define-key map [clone-buffer]
`(menu-item ,(purecopy "Clone occur buffer") clone-buffer
`(menu-item ,(purecopy "Clone Occur Buffer") clone-buffer
:help ,(purecopy "Create and return a twin copy of the current *Occur* buffer")))
(define-key map [occur-rename-buffer]
`(menu-item ,(purecopy "Rename occur buffer") occur-rename-buffer
`(menu-item ,(purecopy "Rename Occur Buffer") occur-rename-buffer
:help ,(purecopy "Rename the current *Occur* buffer to *Occur: original-buffer-name*.")))
(define-key map [separator-2] menu-bar-separator)
(define-key map [occur-mode-goto-occurrence-other-window]
@ -804,10 +807,10 @@ a previously found match."
`(menu-item ,(purecopy "Display Occurrence") occur-mode-display-occurrence
:help ,(purecopy "Display in another window the occurrence the current line describes")))
(define-key map [occur-next]
`(menu-item ,(purecopy "Move to next match") occur-next
`(menu-item ,(purecopy "Move to Next Match") occur-next
:help ,(purecopy "Move to the Nth (default 1) next match in an Occur mode buffer")))
(define-key map [occur-prev]
`(menu-item ,(purecopy "Move to previous match") occur-prev
`(menu-item ,(purecopy "Move to Previous Match") occur-prev
:help ,(purecopy "Move to the Nth (default 1) previous match in an Occur mode buffer")))
map)
"Keymap for `occur-mode'.")

2
lisp/saveplace.el
View file

@ -285,7 +285,7 @@ may have changed\) back to `save-place-alist'."
(let ((cell (assoc buffer-file-name save-place-alist)))
(if cell
(progn
(or after-find-file-from-revert-buffer
(or revert-buffer-in-progress-p
(goto-char (cdr cell)))
;; and make sure it will be saved again for later
(setq save-place t)))))

88
lisp/simple.el
View file

@ -2690,7 +2690,95 @@ support pty association, if PROGRAM is nil."
(let ((fh (find-file-name-handler default-directory 'start-file-process)))
(if fh (apply fh 'start-file-process name buffer program program-args)
(apply 'start-process name buffer program program-args))))
;;;; Process menu
(defvar tabulated-list-format)
(defvar tabulated-list-entries)
(defvar tabulated-list-sort-key)
(declare-function tabulated-list-init-header "tabulated-list" ())
(declare-function tabulated-list-print "tabulated-list" ())
(defvar process-menu-query-only nil)
(define-derived-mode process-menu-mode tabulated-list-mode "Process Menu"
"Major mode for listing the processes called by Emacs."
(setq tabulated-list-format [("Process" 15 t)
("Status" 7 t)
("Buffer" 15 t)
("TTY" 12 t)
("Command" 0 t)])
(make-local-variable 'process-menu-query-only)
(setq tabulated-list-sort-key (cons "Process" nil))
(add-hook 'tabulated-list-revert-hook 'list-processes--refresh nil t)
(tabulated-list-init-header))
(defun list-processes--refresh ()
"Recompute the list of processes for the Process List buffer."
(setq tabulated-list-entries nil)
(dolist (p (process-list))
(when (or (not process-menu-query-only)
(process-query-on-exit-flag p))
(let* ((buf (process-buffer p))
(type (process-type p))
(name (process-name p))
(status (symbol-name (process-status p)))
(buf-label (if (buffer-live-p buf)
`(,(buffer-name buf)
face link
help-echo ,(concat "Visit buffer `"
(buffer-name buf) "'")
follow-link t
process-buffer ,buf
action process-menu-visit-buffer)
"--"))
(tty (or (process-tty-name p) "--"))
(cmd
(if (memq type '(network serial))
(let ((contact (process-contact p t)))
(if (eq type 'network)
(format "(%s %s)"
(if (plist-get contact :type)
"datagram"
"network")
(if (plist-get contact :server)
(format "server on %s"
(plist-get contact :server))
(format "connection to %s"
(plist-get contact :host))))
(format "(serial port %s%s)"
(or (plist-get contact :port) "?")
(let ((speed (plist-get contact :speed)))
(if speed
(format " at %s b/s" speed)
"")))))
(mapconcat 'identity (process-command p) " "))))
(push (list p (vector name status buf-label tty cmd))
tabulated-list-entries)))))
(defun process-menu-visit-buffer (button)
(display-buffer (button-get button 'process-buffer)))
(defun list-processes (&optional query-only buffer)
"Display a list of all processes.
If optional argument QUERY-ONLY is non-nil, only processes with
the query-on-exit flag set are listed.
Any process listed as exited or signaled is actually eliminated
after the listing is made.
Optional argument BUFFER specifies a buffer to use, instead of
\"*Process List\".
The return value is always nil."
(interactive)
(or (fboundp 'process-list)
(error "Asynchronous subprocesses are not supported on this system"))
(unless (bufferp buffer)
(setq buffer (get-buffer-create "*Process List*")))
(with-current-buffer buffer
(process-menu-mode)
(setq process-menu-query-only query-only)
(list-processes--refresh)
(tabulated-list-print))
(display-buffer buffer))
(defvar universal-argument-map
(let ((map (make-sparse-keymap)))

17
lisp/vc/log-edit.el
View file

@ -531,13 +531,25 @@ If you want to abort the commit, simply delete the buffer."
(shrink-window-if-larger-than-buffer)
(selected-window)))))
(defun log-edit-empty-buffer-p ()
"Return non-nil if the buffer is \"empty\"."
(or (= (point-min) (point-max))
(save-excursion
(goto-char (point-min))
(while (and (looking-at "^\\(Summary: \\)?$")
(zerop (forward-line 1))))
(eobp))))
(defun log-edit-insert-cvs-template ()
"Insert the template specified by the CVS administrator, if any.
This simply uses the local CVS/Template file."
(interactive)
(when (or (called-interactively-p 'interactive)
(= (point-min) (point-max)))
(log-edit-empty-buffer-p))
;; Should the template take precedence over an empty Summary:,
;; ie should we first erase the buffer?
(when (file-readable-p "CVS/Template")
(goto-char (point-max))
(insert-file-contents "CVS/Template"))))
(defun log-edit-insert-cvs-rcstemplate ()
@ -546,8 +558,9 @@ This contacts the repository to get the rcstemplate file and
can thus take some time."
(interactive)
(when (or (called-interactively-p 'interactive)
(= (point-min) (point-max)))
(log-edit-empty-buffer-p))
(when (file-readable-p "CVS/Root")
(goto-char (point-max))
;; Ignore the stderr stuff, even if it's an error.
(call-process "cvs" nil '(t nil) nil
"checkout" "-p" "CVSROOT/rcstemplate"))))

2
lisp/vc/vc-annotate.el
View file

@ -489,7 +489,7 @@ Return a cons (REV . FILENAME)."
"Visit the log of the revision at line.
If the VC backend supports it, only show the log entry for the revision.
If a *vc-change-log* buffer exists and already shows a log for
the file in question, search for the log entry required and move point ."
the file in question, search for the log entry required and move point."
(interactive)
(if (not (equal major-mode 'vc-annotate-mode))
(message "Cannot be invoked outside of a vc annotate buffer")

85
src/ChangeLog
View file

@ -1,4 +1,4 @@
2011-04-08 Paul Eggert <eggert@cs.ucla.edu>
2011-04-09 Paul Eggert <eggert@cs.ucla.edu>
* eval.c: Port to Windows vsnprintf (Bug#8435).
Include <limits.h>.
@ -9,8 +9,6 @@
Also, simplify the allocation scheme, by avoiding the need for
calling realloc, and removing the ALLOCATED variable.
2011-04-07 Paul Eggert <eggert@cs.ucla.edu>
* eval.c (verror): Initial buffer size is 4000 (not 200) bytes.
Remove the doprnt implementation, as Emacs now uses vsnprintf.
@ -45,8 +43,6 @@
* keyboard.c (access_keymap_keyremap): Print func name, not garbage.
2011-04-06 Paul Eggert <eggert@cs.ucla.edu>
* coding.c (Fdecode_sjis_char): Don't assume CODE fits in int.
* xterm.c (x_catch_errors): Remove duplicate declaration.
@ -55,6 +51,85 @@
* xdisp.c, lisp.h (message_nolog): Remove; unused.
2011-04-09 Chong Yidong <cyd@stupidchicken.com>
* ftfont.c (get_adstyle_property, ftfont_pattern_entity): Use
unsigned char, to match FcChar8 type definition.
* xterm.c (handle_one_xevent):
* xmenu.c (create_and_show_popup_menu):
* xselect.c (x_decline_selection_request)
(x_reply_selection_request): Avoid type-punned deref of X events.
2011-04-09 Eli Zaretskii <eliz@emacstest.gnu.org>
Fix some uses of `int' instead of EMACS_INT.
* search.c (string_match_1, fast_string_match)
(fast_c_string_match_ignore_case, fast_string_match_ignore_case)
(scan_buffer, find_next_newline_no_quit)
(find_before_next_newline, search_command, Freplace_match)
(Fmatch_data): Make some `int' variables be EMACS_INT.
* xdisp.c (display_count_lines): 3rd argument and return value now
EMACS_INT. All callers changed.
(pint2hrstr): Last argument is now EMACS_INT.
* coding.c (detect_coding_utf_8, detect_coding_emacs_mule)
(detect_coding_iso_2022, detect_coding_sjis, detect_coding_big5)
(detect_coding_ccl, detect_coding_charset, decode_coding_utf_8)
(decode_coding_utf_16, decode_coding_emacs_mule)
(decode_coding_iso_2022, decode_coding_sjis, decode_coding_big5)
(decode_coding_ccl, decode_coding_charset)
<consumed_chars, consumed_chars_base>: Declare EMACS_INT.
(decode_coding_iso_2022, decode_coding_emacs_mule)
(decode_coding_sjis, decode_coding_big5, decode_coding_charset)
<char_offset, last_offset>: Declare EMACS_INT.
(encode_coding_utf_8, encode_coding_utf_16)
(encode_coding_emacs_mule, encode_invocation_designation)
(encode_designation_at_bol, encode_coding_iso_2022)
(encode_coding_sjis, encode_coding_big5, encode_coding_ccl)
(encode_coding_raw_text, encode_coding_charset) <produced_chars>:
Declare EMACS_INT.
(ASSURE_DESTINATION): Declare more_bytes EMACS_INT.
(encode_invocation_designation): Last argument P_NCHARS is now
EMACS_INT.
(decode_eol): Declare pos_byte, pos, and pos_end EMACS_INT.
(produce_chars): from_nchars and to_nchars are now EMACS_INT.
* coding.h (struct coding_system) <head_ascii>: Declare EMACS_INT.
All users changed.
* ccl.c (Fccl_execute_on_string): Declare some variables
EMACS_INT.
2011-04-08 Samuel Thibault <sthibault@debian.org> (tiny change)
* term.c (init_tty): Fix incorrect ifdef placement (Bug#8450).
2011-03-19 Christoph Scholtes <cschol2112@googlemail.com>
* process.c (Fformat_network_address): Doc fix.
2011-04-08 T.V. Raman <tv.raman.tv@gmail.com> (tiny change)
* xml.c (parse_region): Avoid creating spurious whiespace nodes.
2011-04-08 Chong Yidong <cyd@stupidchicken.com>
* keyboard.c (read_char): Call Lisp function help-form-show,
instead of using internal_with_output_to_temp_buffer.
(Qhelp_form_show): New var.
(syms_of_keyboard): Use DEFSYM macro.
* print.c (internal_with_output_to_temp_buffer): Function deleted.
* lisp.h (internal_with_output_to_temp_buffer): Remove prototype.
2011-04-06 Chong Yidong <cyd@stupidchicken.com>
* process.c (Flist_processes): Removed to Lisp.
(list_processes_1): Deleted.
2011-04-06 Eli Zaretskii <eliz@gnu.org>
* msdos.c (careadlinkat, careadlinkatcwd): MS-DOS replacements.

2
src/ccl.c
View file

@ -2049,7 +2049,7 @@ usage: (ccl-execute-on-string CCL-PROGRAM STATUS STRING &optional CONTINUE UNIBY
Lisp_Object val;
struct ccl_program ccl;
int i;
int outbufsize;
EMACS_INT outbufsize;
unsigned char *outbuf, *outp;
EMACS_INT str_chars, str_bytes;
#define CCL_EXECUTE_BUF_SIZE 1024

95
src/coding.c
View file

@ -159,7 +159,7 @@ detect_coding_XXX (struct coding_system *coding,
const unsigned char *src = coding->source;
const unsigned char *src_end = coding->source + coding->src_bytes;
int multibytep = coding->src_multibyte;
int consumed_chars = 0;
EMACS_INT consumed_chars = 0;
int found = 0;
...;
@ -266,7 +266,7 @@ encode_coding_XXX (struct coding_system *coding)
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
unsigned char *adjusted_dst_end = dst_end - _MAX_BYTES_PRODUCED_IN_LOOP_;
int produced_chars = 0;
EMACS_INT produced_chars = 0;
for (; charbuf < charbuf_end && dst < adjusted_dst_end; charbuf++)
{
@ -943,7 +943,7 @@ record_conversion_result (struct coding_system *coding,
do { \
if (dst + (bytes) >= dst_end) \
{ \
int more_bytes = charbuf_end - charbuf + (bytes); \
EMACS_INT more_bytes = charbuf_end - charbuf + (bytes); \
\
dst = alloc_destination (coding, more_bytes, dst); \
dst_end = coding->destination + coding->dst_bytes; \
@ -1208,7 +1208,7 @@ detect_coding_utf_8 (struct coding_system *coding,
const unsigned char *src = coding->source, *src_base;
const unsigned char *src_end = coding->source + coding->src_bytes;
int multibytep = coding->src_multibyte;
int consumed_chars = 0;
EMACS_INT consumed_chars = 0;
int bom_found = 0;
int found = 0;
@ -1293,7 +1293,7 @@ decode_coding_utf_8 (struct coding_system *coding)
const unsigned char *src_base;
int *charbuf = coding->charbuf + coding->charbuf_used;
int *charbuf_end = coding->charbuf + coding->charbuf_size;
int consumed_chars = 0, consumed_chars_base = 0;
EMACS_INT consumed_chars = 0, consumed_chars_base = 0;
int multibytep = coding->src_multibyte;
enum utf_bom_type bom = CODING_UTF_8_BOM (coding);
int eol_dos =
@ -1444,7 +1444,7 @@ encode_coding_utf_8 (struct coding_system *coding)
int *charbuf_end = charbuf + coding->charbuf_used;
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
int produced_chars = 0;
EMACS_INT produced_chars = 0;
int c;
if (CODING_UTF_8_BOM (coding) == utf_with_bom)
@ -1602,7 +1602,7 @@ decode_coding_utf_16 (struct coding_system *coding)
int *charbuf = coding->charbuf + coding->charbuf_used;
/* We may produces at most 3 chars in one loop. */
int *charbuf_end = coding->charbuf + coding->charbuf_size - 2;
int consumed_chars = 0, consumed_chars_base = 0;
EMACS_INT consumed_chars = 0, consumed_chars_base = 0;
int multibytep = coding->src_multibyte;
enum utf_bom_type bom = CODING_UTF_16_BOM (coding);
enum utf_16_endian_type endian = CODING_UTF_16_ENDIAN (coding);
@ -1729,7 +1729,7 @@ encode_coding_utf_16 (struct coding_system *coding)
int safe_room = 8;
enum utf_bom_type bom = CODING_UTF_16_BOM (coding);
int big_endian = CODING_UTF_16_ENDIAN (coding) == utf_16_big_endian;
int produced_chars = 0;
EMACS_INT produced_chars = 0;
int c;
if (bom != utf_without_bom)
@ -1863,7 +1863,7 @@ detect_coding_emacs_mule (struct coding_system *coding,
const unsigned char *src = coding->source, *src_base;
const unsigned char *src_end = coding->source + coding->src_bytes;
int multibytep = coding->src_multibyte;
int consumed_chars = 0;
EMACS_INT consumed_chars = 0;
int c;
int found = 0;
@ -2331,10 +2331,10 @@ decode_coding_emacs_mule (struct coding_system *coding)
loop and one more charset annotation at the end. */
int *charbuf_end
= coding->charbuf + coding->charbuf_size - (MAX_ANNOTATION_LENGTH * 3);
int consumed_chars = 0, consumed_chars_base;
EMACS_INT consumed_chars = 0, consumed_chars_base;
int multibytep = coding->src_multibyte;
int char_offset = coding->produced_char;
int last_offset = char_offset;
EMACS_INT char_offset = coding->produced_char;
EMACS_INT last_offset = char_offset;
int last_id = charset_ascii;
int eol_dos =
!inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
@ -2585,7 +2585,7 @@ encode_coding_emacs_mule (struct coding_system *coding)
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
int safe_room = 8;
int produced_chars = 0;
EMACS_INT produced_chars = 0;
Lisp_Object attrs, charset_list;
int c;
int preferred_charset_id = -1;
@ -2943,7 +2943,7 @@ detect_coding_iso_2022 (struct coding_system *coding,
int single_shifting = 0;
int id;
int c, c1;
int consumed_chars = 0;
EMACS_INT consumed_chars = 0;
int i;
int rejected = 0;
int found = 0;
@ -3453,7 +3453,7 @@ decode_coding_iso_2022 (struct coding_system *coding)
loop and one more charset annotation at the end. */
int *charbuf_end
= coding->charbuf + coding->charbuf_size - (MAX_ANNOTATION_LENGTH * 3);
int consumed_chars = 0, consumed_chars_base;
EMACS_INT consumed_chars = 0, consumed_chars_base;
int multibytep = coding->src_multibyte;
/* Charsets invoked to graphic plane 0 and 1 respectively. */
int charset_id_0 = CODING_ISO_INVOKED_CHARSET (coding, 0);
@ -3463,8 +3463,8 @@ decode_coding_iso_2022 (struct coding_system *coding)
int c;
struct composition_status *cmp_status = CODING_ISO_CMP_STATUS (coding);
Lisp_Object attrs = CODING_ID_ATTRS (coding->id);
int char_offset = coding->produced_char;
int last_offset = char_offset;
EMACS_INT char_offset = coding->produced_char;
EMACS_INT last_offset = char_offset;
int last_id = charset_ascii;
int eol_dos =
!inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
@ -4190,10 +4190,10 @@ decode_coding_iso_2022 (struct coding_system *coding)
static unsigned char *
encode_invocation_designation (struct charset *charset,
struct coding_system *coding,
unsigned char *dst, int *p_nchars)
unsigned char *dst, EMACS_INT *p_nchars)
{
int multibytep = coding->dst_multibyte;
int produced_chars = *p_nchars;
EMACS_INT produced_chars = *p_nchars;
int reg; /* graphic register number */
int id = CHARSET_ID (charset);
@ -4285,7 +4285,7 @@ encode_designation_at_bol (struct coding_system *coding, int *charbuf,
/* Table of charsets to be designated to each graphic register. */
int r[4];
int c, found = 0, reg;
int produced_chars = 0;
EMACS_INT produced_chars = 0;
int multibytep = coding->dst_multibyte;
Lisp_Object attrs;
Lisp_Object charset_list;
@ -4340,7 +4340,7 @@ encode_coding_iso_2022 (struct coding_system *coding)
int bol_designation
= (CODING_ISO_FLAGS (coding) & CODING_ISO_FLAG_DESIGNATE_AT_BOL
&& CODING_ISO_BOL (coding));
int produced_chars = 0;
EMACS_INT produced_chars = 0;
Lisp_Object attrs, eol_type, charset_list;
int ascii_compatible;
int c;
@ -4528,7 +4528,7 @@ detect_coding_sjis (struct coding_system *coding,
const unsigned char *src = coding->source, *src_base;
const unsigned char *src_end = coding->source + coding->src_bytes;
int multibytep = coding->src_multibyte;
int consumed_chars = 0;
EMACS_INT consumed_chars = 0;
int found = 0;
int c;
Lisp_Object attrs, charset_list;
@ -4585,7 +4585,7 @@ detect_coding_big5 (struct coding_system *coding,
const unsigned char *src = coding->source, *src_base;
const unsigned char *src_end = coding->source + coding->src_bytes;
int multibytep = coding->src_multibyte;
int consumed_chars = 0;
EMACS_INT consumed_chars = 0;
int found = 0;
int c;
@ -4636,13 +4636,13 @@ decode_coding_sjis (struct coding_system *coding)
the end. */
int *charbuf_end
= coding->charbuf + coding->charbuf_size - (MAX_ANNOTATION_LENGTH * 2);
int consumed_chars = 0, consumed_chars_base;
EMACS_INT consumed_chars = 0, consumed_chars_base;
int multibytep = coding->src_multibyte;
struct charset *charset_roman, *charset_kanji, *charset_kana;
struct charset *charset_kanji2;
Lisp_Object attrs, charset_list, val;
int char_offset = coding->produced_char;
int last_offset = char_offset;
EMACS_INT char_offset = coding->produced_char;
EMACS_INT last_offset = char_offset;
int last_id = charset_ascii;
int eol_dos =
!inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
@ -4754,12 +4754,12 @@ decode_coding_big5 (struct coding_system *coding)
the end. */
int *charbuf_end
= coding->charbuf + coding->charbuf_size - (MAX_ANNOTATION_LENGTH * 2);
int consumed_chars = 0, consumed_chars_base;
EMACS_INT consumed_chars = 0, consumed_chars_base;
int multibytep = coding->src_multibyte;
struct charset *charset_roman, *charset_big5;
Lisp_Object attrs, charset_list, val;
int char_offset = coding->produced_char;
int last_offset = char_offset;
EMACS_INT char_offset = coding->produced_char;
EMACS_INT last_offset = char_offset;
int last_id = charset_ascii;
int eol_dos =
!inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
@ -4856,7 +4856,7 @@ encode_coding_sjis (struct coding_system *coding)
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
int safe_room = 4;
int produced_chars = 0;
EMACS_INT produced_chars = 0;
Lisp_Object attrs, charset_list, val;
int ascii_compatible;
struct charset *charset_kanji, *charset_kana;
@ -4947,7 +4947,7 @@ encode_coding_big5 (struct coding_system *coding)
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
int safe_room = 4;
int produced_chars = 0;
EMACS_INT produced_chars = 0;
Lisp_Object attrs, charset_list, val;
int ascii_compatible;
struct charset *charset_big5;
@ -5022,10 +5022,10 @@ detect_coding_ccl (struct coding_system *coding,
const unsigned char *src = coding->source, *src_base;
const unsigned char *src_end = coding->source + coding->src_bytes;
int multibytep = coding->src_multibyte;
int consumed_chars = 0;
EMACS_INT consumed_chars = 0;
int found = 0;
unsigned char *valids;
int head_ascii = coding->head_ascii;
EMACS_INT head_ascii = coding->head_ascii;
Lisp_Object attrs;
detect_info->checked |= CATEGORY_MASK_CCL;
@ -5062,7 +5062,7 @@ decode_coding_ccl (struct coding_system *coding)
const unsigned char *src_end = coding->source + coding->src_bytes;
int *charbuf = coding->charbuf + coding->charbuf_used;
int *charbuf_end = coding->charbuf + coding->charbuf_size;
int consumed_chars = 0;
EMACS_INT consumed_chars = 0;
int multibytep = coding->src_multibyte;
struct ccl_program *ccl = &coding->spec.ccl->ccl;
int source_charbuf[1024];
@ -5134,7 +5134,8 @@ encode_coding_ccl (struct coding_system *coding)
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
int destination_charbuf[1024];
int i, produced_chars = 0;
EMACS_INT produced_chars = 0;
int i;
Lisp_Object attrs, charset_list;
CODING_GET_INFO (coding, attrs, charset_list);
@ -5220,7 +5221,7 @@ encode_coding_raw_text (struct coding_system *coding)
int *charbuf_end = coding->charbuf + coding->charbuf_used;
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
int produced_chars = 0;
EMACS_INT produced_chars = 0;
int c;
if (multibytep)
@ -5303,10 +5304,10 @@ detect_coding_charset (struct coding_system *coding,
const unsigned char *src = coding->source, *src_base;
const unsigned char *src_end = coding->source + coding->src_bytes;
int multibytep = coding->src_multibyte;
int consumed_chars = 0;
EMACS_INT consumed_chars = 0;
Lisp_Object attrs, valids, name;
int found = 0;
int head_ascii = coding->head_ascii;
EMACS_INT head_ascii = coding->head_ascii;
int check_latin_extra = 0;
detect_info->checked |= CATEGORY_MASK_CHARSET;
@ -5410,12 +5411,12 @@ decode_coding_charset (struct coding_system *coding)
the end. */
int *charbuf_end
= coding->charbuf + coding->charbuf_size - (MAX_ANNOTATION_LENGTH * 2);
int consumed_chars = 0, consumed_chars_base;
EMACS_INT consumed_chars = 0, consumed_chars_base;
int multibytep = coding->src_multibyte;
Lisp_Object attrs = CODING_ID_ATTRS (coding->id);
Lisp_Object valids;
int char_offset = coding->produced_char;
int last_offset = char_offset;
EMACS_INT char_offset = coding->produced_char;
EMACS_INT last_offset = char_offset;
int last_id = charset_ascii;
int eol_dos =
!inhibit_eol_conversion && EQ (CODING_ID_EOL_TYPE (coding->id), Qdos);
@ -5536,7 +5537,7 @@ encode_coding_charset (struct coding_system *coding)
unsigned char *dst = coding->destination + coding->produced;
unsigned char *dst_end = coding->destination + coding->dst_bytes;
int safe_room = MAX_MULTIBYTE_LENGTH;
int produced_chars = 0;
EMACS_INT produced_chars = 0;
Lisp_Object attrs, charset_list;
int ascii_compatible;
int c;
@ -6444,7 +6445,7 @@ decode_eol (struct coding_system *coding)
}
else if (EQ (eol_type, Qdos))
{
int n = 0;
EMACS_INT n = 0;
if (NILP (coding->dst_object))
{
@ -6459,9 +6460,9 @@ decode_eol (struct coding_system *coding)
}
else
{
int pos_byte = coding->dst_pos_byte;
int pos = coding->dst_pos;
int pos_end = pos + coding->produced_char - 1;
EMACS_INT pos_byte = coding->dst_pos_byte;
EMACS_INT pos = coding->dst_pos;
EMACS_INT pos_end = pos + coding->produced_char - 1;
while (pos < pos_end)
{
@ -6646,7 +6647,7 @@ produce_chars (struct coding_system *coding, Lisp_Object translation_table,
if (c >= 0)
{
int from_nchars = 1, to_nchars = 1;
EMACS_INT from_nchars = 1, to_nchars = 1;
Lisp_Object trans = Qnil;
LOOKUP_TRANSLATION_TABLE (translation_table, c, trans);

2
src/coding.h
View file

@ -449,7 +449,7 @@ struct coding_system
-1 in setup_coding_system, and updated by detect_coding. So,
when this is equal to the byte length of the text being
converted, we can skip the actual conversion process. */
int head_ascii;
EMACS_INT head_ascii;
/* The following members are set by encoding/decoding routine. */
EMACS_INT produced, produced_char, consumed, consumed_char;

2
src/editfns.c
View file

@ -750,7 +750,7 @@ Field boundaries are not noticed if `inhibit-field-text-motion' is non-nil. */)
/* It is possible that NEW_POS is not within the same field as
OLD_POS; try to move NEW_POS so that it is. */
{
int shortage;
EMACS_INT shortage;
Lisp_Object field_bound;
if (fwd)

2
src/fileio.c
View file

@ -271,7 +271,7 @@ use the standard functions without calling themselves recursively. */)
if (CONSP (elt))
{
Lisp_Object string = XCAR (elt);
int match_pos;
EMACS_INT match_pos;
Lisp_Object handler = XCDR (elt);
Lisp_Object operations = Qnil;

4
src/ftfont.c
View file

@ -160,7 +160,7 @@ static struct
static Lisp_Object
get_adstyle_property (FcPattern *p)
{
char *str, *end;
unsigned char *str, *end;
Lisp_Object adstyle;
if (FcPatternGetString (p, FC_STYLE, 0, (FcChar8 **) &str) != FcResultMatch)
@ -189,7 +189,7 @@ static Lisp_Object
ftfont_pattern_entity (FcPattern *p, Lisp_Object extra)
{
Lisp_Object key, cache, entity;
char *file, *str;
unsigned char *file, *str;
int idx;
int numeric;
double dbl;

207
src/keyboard.c
View file

@ -260,6 +260,8 @@ Lisp_Object Qdeferred_action_function;
Lisp_Object Qinput_method_exit_on_first_char;
Lisp_Object Qinput_method_use_echo_area;
Lisp_Object Qhelp_form_show;
/* File in which we write all commands we read. */
FILE *dribble;
@ -3095,10 +3097,7 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event
= Fcons (Fcurrent_window_configuration (Qnil),
help_form_saved_window_configs);
record_unwind_protect (read_char_help_form_unwind, Qnil);
tem0 = Feval (Vhelp_form, Qnil);
if (STRINGP (tem0))
internal_with_output_to_temp_buffer ("*Help*", print_help, tem0);
call0 (Qhelp_form_show);
cancel_echoing ();
do
@ -11441,14 +11440,9 @@ syms_of_keyboard (void)
staticpro (&Vlispy_mouse_stem);
/* Tool-bars. */
QCimage = intern_c_string (":image");
staticpro (&QCimage);
staticpro (&Qhelp_echo);
Qhelp_echo = intern_c_string ("help-echo");
staticpro (&Qrtl);
Qrtl = intern_c_string (":rtl");
DEFSYM (QCimage, ":image");
DEFSYM (Qhelp_echo, "help-echo");
DEFSYM (Qrtl, ":rtl");
staticpro (&item_properties);
item_properties = Qnil;
@ -11461,147 +11455,81 @@ syms_of_keyboard (void)
staticpro (&real_this_command);
real_this_command = Qnil;
Qtimer_event_handler = intern_c_string ("timer-event-handler");
staticpro (&Qtimer_event_handler);
DEFSYM (Qtimer_event_handler, "timer-event-handler");
DEFSYM (Qdisabled_command_function, "disabled-command-function");
DEFSYM (Qself_insert_command, "self-insert-command");
DEFSYM (Qforward_char, "forward-char");
DEFSYM (Qbackward_char, "backward-char");
DEFSYM (Qdisabled, "disabled");
DEFSYM (Qundefined, "undefined");
DEFSYM (Qpre_command_hook, "pre-command-hook");
DEFSYM (Qpost_command_hook, "post-command-hook");
DEFSYM (Qdeferred_action_function, "deferred-action-function");
DEFSYM (Qfunction_key, "function-key");
DEFSYM (Qmouse_click, "mouse-click");
DEFSYM (Qdrag_n_drop, "drag-n-drop");
DEFSYM (Qsave_session, "save-session");
DEFSYM (Qconfig_changed_event, "config-changed-event");
DEFSYM (Qmenu_enable, "menu-enable");
Qdisabled_command_function = intern_c_string ("disabled-command-function");
staticpro (&Qdisabled_command_function);
Qself_insert_command = intern_c_string ("self-insert-command");
staticpro (&Qself_insert_command);
Qforward_char = intern_c_string ("forward-char");
staticpro (&Qforward_char);
Qbackward_char = intern_c_string ("backward-char");
staticpro (&Qbackward_char);
Qdisabled = intern_c_string ("disabled");
staticpro (&Qdisabled);
Qundefined = intern_c_string ("undefined");
staticpro (&Qundefined);
Qpre_command_hook = intern_c_string ("pre-command-hook");
staticpro (&Qpre_command_hook);
Qpost_command_hook = intern_c_string ("post-command-hook");
staticpro (&Qpost_command_hook);
Qdeferred_action_function = intern_c_string ("deferred-action-function");
staticpro (&Qdeferred_action_function);
Qfunction_key = intern_c_string ("function-key");
staticpro (&Qfunction_key);
Qmouse_click = intern_c_string ("mouse-click");
staticpro (&Qmouse_click);
#if defined (WINDOWSNT)
Qlanguage_change = intern_c_string ("language-change");
staticpro (&Qlanguage_change);
DEFSYM (Qlanguage_change, "language-change");
#endif
Qdrag_n_drop = intern_c_string ("drag-n-drop");
staticpro (&Qdrag_n_drop);
Qsave_session = intern_c_string ("save-session");
staticpro (&Qsave_session);
#ifdef HAVE_DBUS
Qdbus_event = intern_c_string ("dbus-event");
staticpro (&Qdbus_event);
DEFSYM (Qdbus_event, "dbus-event");
#endif
Qconfig_changed_event = intern_c_string ("config-changed-event");
staticpro (&Qconfig_changed_event);
DEFSYM (QCenable, ":enable");
DEFSYM (QCvisible, ":visible");
DEFSYM (QChelp, ":help");
DEFSYM (QCfilter, ":filter");
DEFSYM (QCbutton, ":button");
DEFSYM (QCkeys, ":keys");
DEFSYM (QCkey_sequence, ":key-sequence");
DEFSYM (QCtoggle, ":toggle");
DEFSYM (QCradio, ":radio");
DEFSYM (QClabel, ":label");
DEFSYM (QCvert_only, ":vert-only");
Qmenu_enable = intern_c_string ("menu-enable");
staticpro (&Qmenu_enable);
QCenable = intern_c_string (":enable");
staticpro (&QCenable);
QCvisible = intern_c_string (":visible");
staticpro (&QCvisible);
QChelp = intern_c_string (":help");
staticpro (&QChelp);
QCfilter = intern_c_string (":filter");
staticpro (&QCfilter);
QCbutton = intern_c_string (":button");
staticpro (&QCbutton);
QCkeys = intern_c_string (":keys");
staticpro (&QCkeys);
QCkey_sequence = intern_c_string (":key-sequence");
staticpro (&QCkey_sequence);
QCtoggle = intern_c_string (":toggle");
staticpro (&QCtoggle);
QCradio = intern_c_string (":radio");
staticpro (&QCradio);
QClabel = intern_c_string (":label");
staticpro (&QClabel);
QCvert_only = intern_c_string (":vert-only");
staticpro (&QCvert_only);
Qmode_line = intern_c_string ("mode-line");
staticpro (&Qmode_line);
Qvertical_line = intern_c_string ("vertical-line");
staticpro (&Qvertical_line);
Qvertical_scroll_bar = intern_c_string ("vertical-scroll-bar");
staticpro (&Qvertical_scroll_bar);
Qmenu_bar = intern_c_string ("menu-bar");
staticpro (&Qmenu_bar);
DEFSYM (Qmode_line, "mode-line");
DEFSYM (Qvertical_line, "vertical-line");
DEFSYM (Qvertical_scroll_bar, "vertical-scroll-bar");
DEFSYM (Qmenu_bar, "menu-bar");
#if defined (HAVE_MOUSE) || defined (HAVE_GPM)
Qmouse_fixup_help_message = intern_c_string ("mouse-fixup-help-message");
staticpro (&Qmouse_fixup_help_message);
DEFSYM (Qmouse_fixup_help_message, "mouse-fixup-help-message");
#endif
Qabove_handle = intern_c_string ("above-handle");
staticpro (&Qabove_handle);
Qhandle = intern_c_string ("handle");
staticpro (&Qhandle);
Qbelow_handle = intern_c_string ("below-handle");
staticpro (&Qbelow_handle);
Qup = intern_c_string ("up");
staticpro (&Qup);
Qdown = intern_c_string ("down");
staticpro (&Qdown);
Qtop = intern_c_string ("top");
staticpro (&Qtop);
Qbottom = intern_c_string ("bottom");
staticpro (&Qbottom);
Qend_scroll = intern_c_string ("end-scroll");
staticpro (&Qend_scroll);
Qratio = intern_c_string ("ratio");
staticpro (&Qratio);
DEFSYM (Qabove_handle, "above-handle");
DEFSYM (Qhandle, "handle");
DEFSYM (Qbelow_handle, "below-handle");
DEFSYM (Qup, "up");
DEFSYM (Qdown, "down");
DEFSYM (Qtop, "top");
DEFSYM (Qbottom, "bottom");
DEFSYM (Qend_scroll, "end-scroll");
DEFSYM (Qratio, "ratio");
Qevent_kind = intern_c_string ("event-kind");
staticpro (&Qevent_kind);
Qevent_symbol_elements = intern_c_string ("event-symbol-elements");
staticpro (&Qevent_symbol_elements);
Qevent_symbol_element_mask = intern_c_string ("event-symbol-element-mask");
staticpro (&Qevent_symbol_element_mask);
Qmodifier_cache = intern_c_string ("modifier-cache");
staticpro (&Qmodifier_cache);
DEFSYM (Qevent_kind, "event-kind");
DEFSYM (Qevent_symbol_elements, "event-symbol-elements");
DEFSYM (Qevent_symbol_element_mask, "event-symbol-element-mask");
DEFSYM (Qmodifier_cache, "modifier-cache");
Qrecompute_lucid_menubar = intern_c_string ("recompute-lucid-menubar");
staticpro (&Qrecompute_lucid_menubar);
Qactivate_menubar_hook = intern_c_string ("activate-menubar-hook");
staticpro (&Qactivate_menubar_hook);
DEFSYM (Qrecompute_lucid_menubar, "recompute-lucid-menubar");
DEFSYM (Qactivate_menubar_hook, "activate-menubar-hook");
Qpolling_period = intern_c_string ("polling-period");
staticpro (&Qpolling_period);
DEFSYM (Qpolling_period, "polling-period");
Qinput_method_function = intern_c_string ("input-method-function");
staticpro (&Qinput_method_function);
DEFSYM (Qx_set_selection, "x-set-selection");
DEFSYM (QPRIMARY, "PRIMARY");
DEFSYM (Qhandle_switch_frame, "handle-switch-frame");
Qx_set_selection = intern_c_string ("x-set-selection");
staticpro (&Qx_set_selection);
QPRIMARY = intern_c_string ("PRIMARY");
staticpro (&QPRIMARY);
Qhandle_switch_frame = intern_c_string ("handle-switch-frame");
staticpro (&Qhandle_switch_frame);
DEFSYM (Qinput_method_function, "input-method-function");
DEFSYM (Qinput_method_exit_on_first_char, "input-method-exit-on-first-char");
DEFSYM (Qinput_method_use_echo_area, "input-method-use-echo-area");
Qinput_method_exit_on_first_char = intern_c_string ("input-method-exit-on-first-char");
staticpro (&Qinput_method_exit_on_first_char);
Qinput_method_use_echo_area = intern_c_string ("input-method-use-echo-area");
staticpro (&Qinput_method_use_echo_area);
DEFSYM (Qhelp_form_show, "help-form-show");
Fset (Qinput_method_exit_on_first_char, Qnil);
Fset (Qinput_method_use_echo_area, Qnil);
@ -11652,9 +11580,8 @@ syms_of_keyboard (void)
raw_keybuf = Fmake_vector (make_number (30), Qnil);
staticpro (&raw_keybuf);
Qextended_command_history = intern_c_string ("extended-command-history");
DEFSYM (Qextended_command_history, "extended-command-history");
Fset (Qextended_command_history, Qnil);
staticpro (&Qextended_command_history);
accent_key_syms = Qnil;
staticpro (&accent_key_syms);
@ -11955,8 +11882,7 @@ The command loop sets this to nil before each command,
and tests the value when the command returns.
Buffer modification stores t in this variable. */);
Vdeactivate_mark = Qnil;
Qdeactivate_mark = intern_c_string ("deactivate-mark");
staticpro (&Qdeactivate_mark);
DEFSYM (Qdeactivate_mark, "deactivate-mark");
DEFVAR_LISP ("pre-command-hook", Vpre_command_hook,
doc: /* Normal hook run before each command is executed.
@ -11976,8 +11902,7 @@ otherwise the error might happen repeatedly and make Emacs nonfunctional. */);
DEFVAR_LISP ("echo-area-clear-hook", ...,
doc: /* Normal hook run when clearing the echo area. */);
#endif
Qecho_area_clear_hook = intern_c_string ("echo-area-clear-hook");
staticpro (&Qecho_area_clear_hook);
DEFSYM (Qecho_area_clear_hook, "echo-area-clear-hook");
Fset (Qecho_area_clear_hook, Qnil);
DEFVAR_LISP ("lucid-menu-bar-dirty-flag", Vlucid_menu_bar_dirty_flag,

8
src/lisp.h
View file

@ -3046,13 +3046,13 @@ struct re_registers;
extern struct re_pattern_buffer *compile_pattern (Lisp_Object,
struct re_registers *,
Lisp_Object, int, int);
extern int fast_string_match (Lisp_Object, Lisp_Object);
extern int fast_c_string_match_ignore_case (Lisp_Object, const char *);
extern int fast_string_match_ignore_case (Lisp_Object, Lisp_Object);
extern EMACS_INT fast_string_match (Lisp_Object, Lisp_Object);
extern EMACS_INT fast_c_string_match_ignore_case (Lisp_Object, const char *);
extern EMACS_INT fast_string_match_ignore_case (Lisp_Object, Lisp_Object);
extern EMACS_INT fast_looking_at (Lisp_Object, EMACS_INT, EMACS_INT,
EMACS_INT, EMACS_INT, Lisp_Object);
extern EMACS_INT scan_buffer (int, EMACS_INT, EMACS_INT, EMACS_INT,
int *, int);
EMACS_INT *, int);
extern EMACS_INT scan_newline (EMACS_INT, EMACS_INT, EMACS_INT, EMACS_INT,
EMACS_INT, int);
extern EMACS_INT find_next_newline (EMACS_INT, int);

23
src/print.c
View file

@ -520,29 +520,6 @@ temp_output_buffer_setup (const char *bufname)
specbind (Qstandard_output, buf);
}
/* FIXME: Use Lisp's with-output-to-temp-buffer instead! */
Lisp_Object
internal_with_output_to_temp_buffer (const char *bufname, Lisp_Object (*function) (Lisp_Object), Lisp_Object args)
{
int count = SPECPDL_INDEX ();
Lisp_Object buf, val;
struct gcpro gcpro1;
GCPRO1 (args);
record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
temp_output_buffer_setup (bufname);
buf = Vstandard_output;
UNGCPRO;
val = (*function) (args);
GCPRO1 (val);
temp_output_buffer_show (buf);
UNGCPRO;
return unbind_to (count, val);
}
static void print (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag);
static void print_preprocess (Lisp_Object obj);

245
src/process.c
View file

@ -1239,244 +1239,6 @@ Returns nil if format of ADDRESS is invalid. */)
return Qnil;
}
static Lisp_Object
list_processes_1 (Lisp_Object query_only)
{
register Lisp_Object tail;
Lisp_Object proc, minspace;
register struct Lisp_Process *p;
char tembuf[300];
int w_proc, w_buffer, w_tty;
int exited = 0;
Lisp_Object i_status, i_buffer, i_tty, i_command;
w_proc = 4; /* Proc */
w_buffer = 6; /* Buffer */
w_tty = 0; /* Omit if no ttys */
for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
{
int i;
proc = Fcdr (XCAR (tail));
p = XPROCESS (proc);
if (NILP (p->type))
continue;
if (!NILP (query_only) && p->kill_without_query)
continue;
if (STRINGP (p->name)
&& ( i = SCHARS (p->name), (i > w_proc)))
w_proc = i;
if (!NILP (p->buffer))
{
if (NILP (BVAR (XBUFFER (p->buffer), name)))
{
if (w_buffer < 8)
w_buffer = 8; /* (Killed) */
}
else if ((i = SCHARS (BVAR (XBUFFER (p->buffer), name)), (i > w_buffer)))
w_buffer = i;
}
if (STRINGP (p->tty_name)
&& (i = SCHARS (p->tty_name), (i > w_tty)))
w_tty = i;
}
XSETFASTINT (i_status, w_proc + 1);
XSETFASTINT (i_buffer, XFASTINT (i_status) + 9);
if (w_tty)
{
XSETFASTINT (i_tty, XFASTINT (i_buffer) + w_buffer + 1);
XSETFASTINT (i_command, XFASTINT (i_tty) + w_tty + 1);
}
else
{
i_tty = Qnil;
XSETFASTINT (i_command, XFASTINT (i_buffer) + w_buffer + 1);
}
XSETFASTINT (minspace, 1);
set_buffer_internal (XBUFFER (Vstandard_output));
BVAR (current_buffer, undo_list) = Qt;
BVAR (current_buffer, truncate_lines) = Qt;
write_string ("Proc", -1);
Findent_to (i_status, minspace); write_string ("Status", -1);
Findent_to (i_buffer, minspace); write_string ("Buffer", -1);
if (!NILP (i_tty))
{
Findent_to (i_tty, minspace); write_string ("Tty", -1);
}
Findent_to (i_command, minspace); write_string ("Command", -1);
write_string ("\n", -1);
write_string ("----", -1);
Findent_to (i_status, minspace); write_string ("------", -1);
Findent_to (i_buffer, minspace); write_string ("------", -1);
if (!NILP (i_tty))
{
Findent_to (i_tty, minspace); write_string ("---", -1);
}
Findent_to (i_command, minspace); write_string ("-------", -1);
write_string ("\n", -1);
for (tail = Vprocess_alist; CONSP (tail); tail = XCDR (tail))
{
Lisp_Object symbol;
proc = Fcdr (XCAR (tail));
p = XPROCESS (proc);
if (NILP (p->type))
continue;
if (!NILP (query_only) && p->kill_without_query)
continue;
Finsert (1, &p->name);
Findent_to (i_status, minspace);
if (p->raw_status_new)
update_status (p);
symbol = p->status;
if (CONSP (p->status))
symbol = XCAR (p->status);
if (EQ (symbol, Qsignal))
Fprinc (symbol, Qnil);
else if (NETCONN1_P (p) || SERIALCONN1_P (p))
{
if (EQ (symbol, Qexit))
write_string ("closed", -1);
else if (EQ (p->command, Qt))
write_string ("stopped", -1);
else if (EQ (symbol, Qrun))
write_string ("open", -1);
else
Fprinc (symbol, Qnil);
}
else if (SERIALCONN1_P (p))
{
write_string ("running", -1);
}
else
Fprinc (symbol, Qnil);
if (EQ (symbol, Qexit))
{
Lisp_Object tem;
tem = Fcar (Fcdr (p->status));
if (XFASTINT (tem))
{
sprintf (tembuf, " %d", (int) XFASTINT (tem));
write_string (tembuf, -1);
}
}
if (EQ (symbol, Qsignal) || EQ (symbol, Qexit) || EQ (symbol, Qclosed))
exited++;
Findent_to (i_buffer, minspace);
if (NILP (p->buffer))
insert_string ("(none)");
else if (NILP (BVAR (XBUFFER (p->buffer), name)))
insert_string ("(Killed)");
else
Finsert (1, &BVAR (XBUFFER (p->buffer), name));
if (!NILP (i_tty))
{
Findent_to (i_tty, minspace);
if (STRINGP (p->tty_name))
Finsert (1, &p->tty_name);
}
Findent_to (i_command, minspace);
if (EQ (p->status, Qlisten))
{
Lisp_Object port = Fplist_get (p->childp, QCservice);
if (INTEGERP (port))
port = Fnumber_to_string (port);
if (NILP (port))
port = Fformat_network_address (Fplist_get (p->childp, QClocal), Qnil);
sprintf (tembuf, "(network %s server on %s)\n",
(DATAGRAM_CHAN_P (p->infd) ? "datagram" : "stream"),
(STRINGP (port) ? SSDATA (port) : "?"));
insert_string (tembuf);
}
else if (NETCONN1_P (p))
{
/* For a local socket, there is no host name,
so display service instead. */
Lisp_Object host = Fplist_get (p->childp, QChost);
if (!STRINGP (host))
{
host = Fplist_get (p->childp, QCservice);
if (INTEGERP (host))
host = Fnumber_to_string (host);
}
if (NILP (host))
host = Fformat_network_address (Fplist_get (p->childp, QCremote), Qnil);
sprintf (tembuf, "(network %s connection to %s)\n",
(DATAGRAM_CHAN_P (p->infd) ? "datagram" : "stream"),
(STRINGP (host) ? SSDATA (host) : "?"));
insert_string (tembuf);
}
else if (SERIALCONN1_P (p))
{
Lisp_Object port = Fplist_get (p->childp, QCport);
Lisp_Object speed = Fplist_get (p->childp, QCspeed);
insert_string ("(serial port ");
if (STRINGP (port))
insert_string (SSDATA (port));
else
insert_string ("?");
if (INTEGERP (speed))
{
sprintf (tembuf, " at %ld b/s", (long) XINT (speed));
insert_string (tembuf);
}
insert_string (")\n");
}
else
{
Lisp_Object tem = p->command;
while (1)
{
Lisp_Object tem1 = Fcar (tem);
if (NILP (tem1))
break;
Finsert (1, &tem1);
tem = Fcdr (tem);
if (NILP (tem))
break;
insert_string (" ");
}
insert_string ("\n");
}
}
if (exited)
{
status_notify (NULL);
redisplay_preserve_echo_area (13);
}
return Qnil;
}
DEFUN ("list-processes", Flist_processes, Slist_processes, 0, 1, "P",
doc: /* Display a list of all processes.
If optional argument QUERY-ONLY is non-nil, only processes with
the query-on-exit flag set will be listed.
Any process listed as exited or signaled is actually eliminated
after the listing is made. */)
(Lisp_Object query_only)
{
internal_with_output_to_temp_buffer ("*Process List*",
list_processes_1, query_only);
return Qnil;
}
DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
doc: /* Return a list of all processes. */)
@ -1499,9 +1261,9 @@ at end of BUFFER, unless you specify an output stream or filter
function to handle the output. BUFFER may also be nil, meaning that
this process is not associated with any buffer.
PROGRAM is the program file name. It is searched for in PATH. If
nil, just associate a pty with the buffer. Remaining arguments are
strings to give program as arguments.
PROGRAM is the program file name. It is searched for in `exec-path'
(which see). If nil, just associate a pty with the buffer. Remaining
arguments are strings to give program as arguments.
If you want to separate standard output from standard error, invoke
the command through a shell and redirect one of them using the shell
@ -7668,7 +7430,6 @@ The variable takes effect when `start-process' is called. */);
defsubr (&Sprocess_contact);
defsubr (&Sprocess_plist);
defsubr (&Sset_process_plist);
defsubr (&Slist_processes);
defsubr (&Sprocess_list);
defsubr (&Sstart_process);
defsubr (&Sserial_process_configure);

28
src/search.c
View file

@ -368,7 +368,7 @@ data if you want to preserve them. */)
static Lisp_Object
string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, int posix)
{
int val;
EMACS_INT val;
struct re_pattern_buffer *bufp;
EMACS_INT pos, pos_byte;
int i;
@ -468,10 +468,10 @@ matched by parenthesis constructs in the pattern. */)
and return the index of the match, or negative on failure.
This does not clobber the match data. */
int
EMACS_INT
fast_string_match (Lisp_Object regexp, Lisp_Object string)
{
int val;
EMACS_INT val;
struct re_pattern_buffer *bufp;
bufp = compile_pattern (regexp, 0, Qnil,
@ -491,10 +491,10 @@ fast_string_match (Lisp_Object regexp, Lisp_Object string)
This does not clobber the match data.
We assume that STRING contains single-byte characters. */
int
EMACS_INT
fast_c_string_match_ignore_case (Lisp_Object regexp, const char *string)
{
int val;
EMACS_INT val;
struct re_pattern_buffer *bufp;
size_t len = strlen (string);
@ -511,10 +511,10 @@ fast_c_string_match_ignore_case (Lisp_Object regexp, const char *string)
/* Like fast_string_match but ignore case. */
int
EMACS_INT
fast_string_match_ignore_case (Lisp_Object regexp, Lisp_Object string)
{
int val;
EMACS_INT val;
struct re_pattern_buffer *bufp;
bufp = compile_pattern (regexp, 0, Vascii_canon_table,
@ -643,7 +643,7 @@ newline_cache_on_off (struct buffer *buf)
EMACS_INT
scan_buffer (register int target, EMACS_INT start, EMACS_INT end,
EMACS_INT count, int *shortage, int allow_quit)
EMACS_INT count, EMACS_INT *shortage, int allow_quit)
{
struct region_cache *newline_cache;
int direction;
@ -933,7 +933,7 @@ scan_newline (EMACS_INT start, EMACS_INT start_byte,
EMACS_INT
find_next_newline_no_quit (EMACS_INT from, EMACS_INT cnt)
{
return scan_buffer ('\n', from, 0, cnt, (int *) 0, 0);
return scan_buffer ('\n', from, 0, cnt, (EMACS_INT *) 0, 0);
}
/* Like find_next_newline, but returns position before the newline,
@ -943,7 +943,7 @@ find_next_newline_no_quit (EMACS_INT from, EMACS_INT cnt)
EMACS_INT
find_before_next_newline (EMACS_INT from, EMACS_INT to, EMACS_INT cnt)
{
int shortage;
EMACS_INT shortage;
EMACS_INT pos = scan_buffer ('\n', from, to, cnt, &shortage, 1);
if (shortage == 0)
@ -958,9 +958,9 @@ static Lisp_Object
search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror,
Lisp_Object count, int direction, int RE, int posix)
{
register int np;
register EMACS_INT np;
EMACS_INT lim, lim_byte;
int n = direction;
EMACS_INT n = direction;
if (!NILP (count))
{
@ -2524,7 +2524,7 @@ since only regular expressions have distinguished subexpressions. */)
/* We build up the substituted string in ACCUM. */
Lisp_Object accum;
Lisp_Object middle;
int length = SBYTES (newtext);
EMACS_INT length = SBYTES (newtext);
accum = Qnil;
@ -2880,7 +2880,7 @@ Return value is undefined if the last search failed. */)
len = 0;
for (i = 0; i < search_regs.num_regs; i++)
{
int start = search_regs.start[i];
EMACS_INT start = search_regs.start[i];
if (start >= 0)
{
if (EQ (last_thing_searched, Qt)

3
src/term.c
View file

@ -3155,13 +3155,12 @@ init_tty (const char *name, const char *terminal_type, int must_succeed)
if we don't have one at the moment. */
fd = emacs_open (name, O_RDWR | O_IGNORE_CTTY | O_NOCTTY, 0);
else
#else
#endif /* O_IGNORE_CTTY */
/* Alas, O_IGNORE_CTTY is a GNU extension that seems to be only
defined on Hurd. On other systems, we need to explicitly
dissociate ourselves from the controlling tty when we want to
open a frame on the same terminal. */
fd = emacs_open (name, O_RDWR | O_NOCTTY, 0);
#endif /* O_IGNORE_CTTY */
tty->name = xstrdup (name);
terminal->name = xstrdup (name);

3
src/window.c
View file

@ -3664,9 +3664,6 @@ temp_output_buffer_show (register Lisp_Object buf)
BEGV = BEG;
ZV = Z;
SET_PT (BEG);
#if 0 /* rms: there should be no reason for this. */
XBUFFER (buf)->prevent_redisplay_optimizations_p = 1;
#endif
set_buffer_internal (old);
if (!NILP (Vtemp_buffer_show_function))

22
src/xdisp.c
View file

@ -763,7 +763,7 @@ static Lisp_Object get_it_property (struct it *it, Lisp_Object prop);
static void handle_line_prefix (struct it *);
static void pint2str (char *, int, EMACS_INT);
static void pint2hrstr (char *, int, int);
static void pint2hrstr (char *, int, EMACS_INT);
static struct text_pos run_window_scroll_functions (Lisp_Object,
struct text_pos);
static void reconsider_clip_changes (struct window *, struct buffer *);
@ -825,7 +825,8 @@ static int display_mode_element (struct it *, int, int, int, Lisp_Object, Lisp_O
static int store_mode_line_string (const char *, Lisp_Object, int, int, int, Lisp_Object);
static const char *decode_mode_spec (struct window *, int, int, Lisp_Object *);
static void display_menu_bar (struct window *);
static int display_count_lines (EMACS_INT, EMACS_INT, int, EMACS_INT *);
static EMACS_INT display_count_lines (EMACS_INT, EMACS_INT, EMACS_INT,
EMACS_INT *);
static int display_string (const char *, Lisp_Object, Lisp_Object,
EMACS_INT, EMACS_INT, struct it *, int, int, int, int);
static void compute_line_metrics (struct it *);
@ -19099,11 +19100,11 @@ static const char power_letter[] =
};
static void
pint2hrstr (char *buf, int width, int d)
pint2hrstr (char *buf, int width, EMACS_INT d)
{
/* We aim to represent the nonnegative integer D as
QUOTIENT.TENTHS * 10 ^ (3 * EXPONENT). */
int quotient = d;
EMACS_INT quotient = d;
int remainder = 0;
/* -1 means: do not use TENTHS. */
int tenths = -1;
@ -19429,7 +19430,7 @@ decode_mode_spec (struct window *w, register int c, int field_width,
case 'l':
{
EMACS_INT startpos, startpos_byte, line, linepos, linepos_byte;
int topline, nlines, height;
EMACS_INT topline, nlines, height;
EMACS_INT junk;
/* %c and %l are ignored in `frame-title-format'. */
@ -19494,7 +19495,8 @@ decode_mode_spec (struct window *w, register int c, int field_width,
EMACS_INT limit = BUF_BEGV (b);
EMACS_INT limit_byte = BUF_BEGV_BYTE (b);
EMACS_INT position;
int distance = (height * 2 + 30) * line_number_display_limit_width;
EMACS_INT distance =
(height * 2 + 30) * line_number_display_limit_width;
if (startpos - distance > limit)
{
@ -19697,17 +19699,17 @@ decode_mode_spec (struct window *w, register int c, int field_width,
Set *BYTE_POS_PTR to 1 if we found COUNT lines, 0 if we hit LIMIT. */
static int
static EMACS_INT
display_count_lines (EMACS_INT start_byte,
EMACS_INT limit_byte, int count,
EMACS_INT limit_byte, EMACS_INT count,
EMACS_INT *byte_pos_ptr)
{
register unsigned char *cursor;
unsigned char *base;
register int ceiling;
register EMACS_INT ceiling;
register unsigned char *ceiling_addr;
int orig_count = count;
EMACS_INT orig_count = count;
/* If we are not in selective display mode,
check only for newlines. */

34
src/xmenu.c
View file

@ -1529,7 +1529,8 @@ create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv,
int i;
Arg av[2];
int ac = 0;
XButtonPressedEvent dummy;
XEvent dummy;
XButtonPressedEvent *event = &(dummy.xbutton);
LWLIB_ID menu_id;
Widget menu;
@ -1547,36 +1548,35 @@ create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv,
popup_deactivate_callback,
menu_highlight_callback);
dummy.type = ButtonPress;
dummy.serial = 0;
dummy.send_event = 0;
dummy.display = FRAME_X_DISPLAY (f);
dummy.time = CurrentTime;
dummy.root = FRAME_X_DISPLAY_INFO (f)->root_window;
dummy.window = dummy.root;
dummy.subwindow = dummy.root;
dummy.x = x;
dummy.y = y;
event->type = ButtonPress;
event->serial = 0;
event->send_event = 0;
event->display = FRAME_X_DISPLAY (f);
event->time = CurrentTime;
event->root = FRAME_X_DISPLAY_INFO (f)->root_window;
event->window = event->subwindow = event->root;
event->x = x;
event->y = y;
/* Adjust coordinates to be root-window-relative. */
x += f->left_pos + FRAME_OUTER_TO_INNER_DIFF_X (f);
y += f->top_pos + FRAME_OUTER_TO_INNER_DIFF_Y (f);
dummy.x_root = x;
dummy.y_root = y;
event->x_root = x;
event->y_root = y;
dummy.state = 0;
dummy.button = 0;
event->state = 0;
event->button = 0;
for (i = 0; i < 5; i++)
if (FRAME_X_DISPLAY_INFO (f)->grabbed & (1 << i))
dummy.button = i;
event->button = i;
/* Don't allow any geometry request from the user. */
XtSetArg (av[ac], XtNgeometry, 0); ac++;
XtSetValues (menu, av, ac);
/* Display the menu. */
lw_popup_menu (menu, (XEvent *) &dummy);
lw_popup_menu (menu, &dummy);
popup_activated_flag = 1;
x_activate_timeout_atimer ();

2
src/xml.c
View file

@ -113,7 +113,7 @@ parse_region (Lisp_Object start, Lisp_Object end, Lisp_Object base_url, int html
doc = xmlReadMemory ((char *) BYTE_POS_ADDR (CHAR_TO_BYTE (istart)),
bytes, burl, "utf-8",
XML_PARSE_NONET|XML_PARSE_NOWARNING|
XML_PARSE_NOERROR);
XML_PARSE_NOBLANKS |XML_PARSE_NOERROR);
if (doc != NULL)
{

76
src/xselect.c
View file

@ -499,22 +499,23 @@ x_get_local_selection (Lisp_Object selection_symbol, Lisp_Object target_type, in
static void
x_decline_selection_request (struct input_event *event)
{
XSelectionEvent reply;
XEvent reply_base;
XSelectionEvent *reply = &(reply_base.xselection);
reply.type = SelectionNotify;
reply.display = SELECTION_EVENT_DISPLAY (event);
reply.requestor = SELECTION_EVENT_REQUESTOR (event);
reply.selection = SELECTION_EVENT_SELECTION (event);
reply.time = SELECTION_EVENT_TIME (event);
reply.target = SELECTION_EVENT_TARGET (event);
reply.property = None;
reply->type = SelectionNotify;
reply->display = SELECTION_EVENT_DISPLAY (event);
reply->requestor = SELECTION_EVENT_REQUESTOR (event);
reply->selection = SELECTION_EVENT_SELECTION (event);
reply->time = SELECTION_EVENT_TIME (event);
reply->target = SELECTION_EVENT_TARGET (event);
reply->property = None;
/* The reason for the error may be that the receiver has
died in the meantime. Handle that case. */
BLOCK_INPUT;
x_catch_errors (reply.display);
XSendEvent (reply.display, reply.requestor, False, 0L, (XEvent *) &reply);
XFlush (reply.display);
x_catch_errors (reply->display);
XSendEvent (reply->display, reply->requestor, False, 0L, &reply_base);
XFlush (reply->display);
x_uncatch_errors ();
UNBLOCK_INPUT;
}
@ -617,7 +618,8 @@ static int x_reply_selection_request_cnt;
static void
x_reply_selection_request (struct input_event *event, int format, unsigned char *data, int size, Atom type)
{
XSelectionEvent reply;
XEvent reply_base;
XSelectionEvent *reply = &(reply_base.xselection);
Display *display = SELECTION_EVENT_DISPLAY (event);
Window window = SELECTION_EVENT_REQUESTOR (event);
int bytes_remaining;
@ -629,15 +631,15 @@ x_reply_selection_request (struct input_event *event, int format, unsigned char
if (max_bytes > MAX_SELECTION_QUANTUM)
max_bytes = MAX_SELECTION_QUANTUM;
reply.type = SelectionNotify;
reply.display = display;
reply.requestor = window;
reply.selection = SELECTION_EVENT_SELECTION (event);
reply.time = SELECTION_EVENT_TIME (event);
reply.target = SELECTION_EVENT_TARGET (event);
reply.property = SELECTION_EVENT_PROPERTY (event);
if (reply.property == None)
reply.property = reply.target;
reply->type = SelectionNotify;
reply->display = display;
reply->requestor = window;
reply->selection = SELECTION_EVENT_SELECTION (event);
reply->time = SELECTION_EVENT_TIME (event);
reply->target = SELECTION_EVENT_TARGET (event);
reply->property = SELECTION_EVENT_PROPERTY (event);
if (reply->property == None)
reply->property = reply->target;
BLOCK_INPUT;
/* The protected block contains wait_for_property_change, which can
@ -648,8 +650,8 @@ x_reply_selection_request (struct input_event *event, int format, unsigned char
#ifdef TRACE_SELECTION
{
char *sel = XGetAtomName (display, reply.selection);
char *tgt = XGetAtomName (display, reply.target);
char *sel = XGetAtomName (display, reply->selection);
char *tgt = XGetAtomName (display, reply->target);
TRACE3 ("%s, target %s (%d)", sel, tgt, ++x_reply_selection_request_cnt);
if (sel) XFree (sel);
if (tgt) XFree (tgt);
@ -664,10 +666,10 @@ x_reply_selection_request (struct input_event *event, int format, unsigned char
{
/* Send all the data at once, with minimal handshaking. */
TRACE1 ("Sending all %d bytes", bytes_remaining);
XChangeProperty (display, window, reply.property, type, format,
XChangeProperty (display, window, reply->property, type, format,
PropModeReplace, data, size);
/* At this point, the selection was successfully stored; ack it. */
XSendEvent (display, window, False, 0L, (XEvent *) &reply);
XSendEvent (display, window, False, 0L, &reply_base);
}
else
{
@ -693,19 +695,19 @@ x_reply_selection_request (struct input_event *event, int format, unsigned char
error ("Attempt to transfer an INCR to ourself!");
TRACE2 ("Start sending %d bytes incrementally (%s)",
bytes_remaining, XGetAtomName (display, reply.property));
wait_object = expect_property_change (display, window, reply.property,
bytes_remaining, XGetAtomName (display, reply->property));
wait_object = expect_property_change (display, window, reply->property,
PropertyDelete);
TRACE1 ("Set %s to number of bytes to send",
XGetAtomName (display, reply.property));
XGetAtomName (display, reply->property));
{
/* XChangeProperty expects an array of long even if long is more than
32 bits. */
long value[1];
value[0] = bytes_remaining;
XChangeProperty (display, window, reply.property, dpyinfo->Xatom_INCR,
XChangeProperty (display, window, reply->property, dpyinfo->Xatom_INCR,
32, PropModeReplace,
(unsigned char *) value, 1);
}
@ -714,7 +716,7 @@ x_reply_selection_request (struct input_event *event, int format, unsigned char
/* Tell 'em the INCR data is there... */
TRACE0 ("Send SelectionNotify event");
XSendEvent (display, window, False, 0L, (XEvent *) &reply);
XSendEvent (display, window, False, 0L, &reply_base);
XFlush (display);
had_errors = x_had_errors_p (display);
@ -725,7 +727,7 @@ x_reply_selection_request (struct input_event *event, int format, unsigned char
if (! had_errors)
{
TRACE1 ("Waiting for ACK (deletion of %s)",
XGetAtomName (display, reply.property));
XGetAtomName (display, reply->property));
wait_for_property_change (wait_object);
}
else
@ -741,15 +743,15 @@ x_reply_selection_request (struct input_event *event, int format, unsigned char
BLOCK_INPUT;
wait_object
= expect_property_change (display, window, reply.property,
= expect_property_change (display, window, reply->property,
PropertyDelete);
TRACE1 ("Sending increment of %d elements", i);
TRACE1 ("Set %s to increment data",
XGetAtomName (display, reply.property));
XGetAtomName (display, reply->property));
/* Append the next chunk of data to the property. */
XChangeProperty (display, window, reply.property, type, format,
XChangeProperty (display, window, reply->property, type, format,
PropModeAppend, data, i);
bytes_remaining -= i * format_bytes;
if (format == 32)
@ -766,7 +768,7 @@ x_reply_selection_request (struct input_event *event, int format, unsigned char
/* Now wait for the requester to ack this chunk by deleting the
property. This can run random lisp code or signal. */
TRACE1 ("Waiting for increment ACK (deletion of %s)",
XGetAtomName (display, reply.property));
XGetAtomName (display, reply->property));
wait_for_property_change (wait_object);
}
@ -777,8 +779,8 @@ x_reply_selection_request (struct input_event *event, int format, unsigned char
XSelectInput (display, window, 0L);
TRACE1 ("Set %s to a 0-length chunk to indicate EOF",
XGetAtomName (display, reply.property));
XChangeProperty (display, window, reply.property, type, format,
XGetAtomName (display, reply->property));
XChangeProperty (display, window, reply->property, type, format,
PropModeReplace, data, 0);
TRACE0 ("Done sending incrementally");
}

7
src/xterm.c
View file

@ -4045,7 +4045,7 @@ x_window_to_scroll_bar (Display *display, Window window_id)
return XSCROLL_BAR (bar);
}
return 0;
return NULL;
}
@ -6008,7 +6008,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr,
goto OTHER;
#endif /* USE_X_TOOLKIT */
{
XSelectionClearEvent *eventp = (XSelectionClearEvent *) &event;
XSelectionClearEvent *eventp = &(event.xselectionclear);
inev.ie.kind = SELECTION_CLEAR_EVENT;
SELECTION_EVENT_DISPLAY (&inev.sie) = eventp->display;
@ -6025,8 +6025,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent *eventptr,
goto OTHER;
#endif /* USE_X_TOOLKIT */
{
XSelectionRequestEvent *eventp
= (XSelectionRequestEvent *) &event;
XSelectionRequestEvent *eventp = &(event.xselectionrequest);
inev.ie.kind = SELECTION_REQUEST_EVENT;
SELECTION_EVENT_DISPLAY (&inev.sie) = eventp->display;