forked from Github/emacs
Merge from mainline.
This commit is contained in:
commit
762f8d9671
59 changed files with 2273 additions and 1904 deletions
|
|
@ -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
4
autogen/aclocal.m4
vendored
|
|
@ -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
142
autogen/config.guess
vendored
|
|
@ -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}
|
||||
|
|
|
|||
|
|
@ -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
30
autogen/config.sub
vendored
|
|
@ -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
1205
autogen/configure
vendored
File diff suppressed because it is too large
Load diff
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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'.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
6
etc/NEWS
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
118
lisp/ChangeLog
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
355
lisp/emacs-lisp/tabulated-list.el
Normal 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
|
||||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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?)
|
||||
|
||||
|
|
|
|||
|
|
@ -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>
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
"!" ":"))
|
||||
|
|
|
|||
|
|
@ -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"))))))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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("
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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'.")
|
||||
|
|
|
|||
|
|
@ -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)))))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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"))))
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
95
src/coding.c
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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
207
src/keyboard.c
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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
23
src/print.c
|
|
@ -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
245
src/process.c
|
|
@ -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
28
src/search.c
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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
22
src/xdisp.c
|
|
@ -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
34
src/xmenu.c
|
|
@ -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 ();
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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");
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
Loading…
Reference in a new issue