mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-24 10:38:38 +00:00
Code Issues Releases Activity

Merge from emacs--devo--0

Browse Source 
Patches applied:

 * emacs--devo--0  (patch 793-802)

   - Update from CVS
   - Remove RCS keywords
   - Merge from emacs--rel--22

 * emacs--rel--22  (patch 42-50)

   - Update from CVS
   - Merge from gnus--rel--5.10
   - Gnus ChangeLog tweaks

 * gnus--rel--5.10  (patch 229-232)

   - Merge from emacs--devo--0, emacs--rel--22
   - ChangeLog tweak
   - Update from CVS

Revision: emacs@sv.gnu.org/emacs--multi-tty--0--patch-23
This commit is contained in:
Miles Bader 2007-06-16 22:33:42 +00:00
commit 262d5ce7c2
106 changed files with 6607 additions and 2322 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
ChangeLog
View File

@ -1,3 +1,30 @@
2007-06-14 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* configure.in: Check for all image libraries before exiting.
2007-06-13 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* configure.in: Exit with error if image libraries aren't found.
2007-06-13 Michael Kifer <kifer@cs.stonybrook.edu>
* ediff-ptch.el (ediff-context-diff-label-regexp): partially undid
previous patch
2007-06-13 Chong Yidong <cyd@stupidchicken.com>
* configure.in: Merge xaw3d and libXaw checks. Check xaw3d even
when compiling without scrollbars.
2007-06-12 Glenn Morris <rgm@gnu.org>
* configure.in (HAVE_GIF): If -lungif fails, try -lgif.
2007-06-11 Jan Dj,Ad(Brv <jan.h.d@swipnet.se>
* configure.in: Change wording about yes/gtk and lucid/athena being
synonyms.
2007-06-08 Glenn Morris <rgm@gnu.org>
* configure.in: Make gtk the default toolkit.

357
configure vendored
View File

@ -1337,7 +1337,7 @@ Optional Packages:
--with-xpm use -lXpm for displaying XPM images
--with-jpeg use -ljpeg for displaying JPEG images
--with-tiff use -ltiff for displaying TIFF images
--with-gif use -lungif for displaying GIF images
--with-gif use -lungif (or -lgif) for displaying GIF images
--with-png use -lpng for displaying PNG images
--with-gpm use -lgpm for mouse support on a GNU/Linux console
--with-gtk use GTK (same as --with-x-toolkit=gtk)
@ -1898,12 +1898,12 @@ if test "${with_x_toolkit+set}" = set; then
m | mo | mot | moti | motif ) val=motif ;;
g | gt | gtk ) val=gtk ;;
* )
{ { echo "$as_me:$LINENO: error: \`--with-x-toolkit=$withval' is invalid\;
{ { echo "$as_me:$LINENO: error: \`--with-x-toolkit=$withval' is invalid;
this option's value should be \`yes', \`no', \`lucid', \`athena', \`motif' or \`gtk'.
Currently, \`yes' and \`gtk', and \`athena' and \`lucid' are synonyms." >&5
echo "$as_me: error: \`--with-x-toolkit=$withval' is invalid\;
\`yes' and \`gtk' are synonyms. \`athena' and \`lucid' are synonyms." >&5
echo "$as_me: error: \`--with-x-toolkit=$withval' is invalid;
this option's value should be \`yes', \`no', \`lucid', \`athena', \`motif' or \`gtk'.
Currently, \`yes' and \`gtk', and \`athena' and \`lucid' are synonyms." >&2;}
\`yes' and \`gtk' are synonyms. \`athena' and \`lucid' are synonyms." >&2;}
{ (exit 1); exit 1; }; }
;;
esac
@ -12098,11 +12098,79 @@ _ACEOF
fi
fi
HAVE_XAW3D=no
if test x"${USE_X_TOOLKIT}" = xmaybe || test x"${USE_X_TOOLKIT}" = xLUCID; then
if test x"${HAVE_X11R5}" = xyes; then
{ echo "$as_me:$LINENO: checking X11 version 5 with Xaw" >&5
echo $ECHO_N "checking X11 version 5 with Xaw... $ECHO_C" >&6; }
if test "${emacs_cv_x11_version_5_with_xaw+set}" = set; then
if test x"${HAVE_X11R5}" != xyes; then
USE_X_TOOLKIT=none
else
{ echo "$as_me:$LINENO: checking for xaw3d" >&5
echo $ECHO_N "checking for xaw3d... $ECHO_C" >&6; }
if test "${emacs_cv_xaw3d+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
#include <X11/Intrinsic.h>
#include <X11/Xaw3d/Simple.h>
int
main ()
{
;
return 0;
}
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (ac_try="$ac_link"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
(eval "$ac_link") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } && {
test -z "$ac_c_werror_flag" ||
test ! -s conftest.err
} && test -s conftest$ac_exeext &&
$as_test_x conftest$ac_exeext; then
emacs_cv_xaw3d=yes
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
emacs_cv_xaw3d=no
fi
rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
conftest$ac_exeext conftest.$ac_ext
fi
if test $emacs_cv_xaw3d = yes; then
{ echo "$as_me:$LINENO: result: yes; using Lucid toolkit" >&5
echo "${ECHO_T}yes; using Lucid toolkit" >&6; }
USE_X_TOOLKIT=LUCID
HAVE_XAW3D=yes
cat >>confdefs.h <<\_ACEOF
#define HAVE_XAW3D 1
_ACEOF
else
{ echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6; }
{ echo "$as_me:$LINENO: checking for libXaw" >&5
echo $ECHO_N "checking for libXaw... $ECHO_C" >&6; }
if test "${emacs_cv_xaw+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
cat >conftest.$ac_ext <<_ACEOF
@ -12140,35 +12208,32 @@ eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
test ! -s conftest.err
} && test -s conftest$ac_exeext &&
$as_test_x conftest$ac_exeext; then
emacs_cv_x11_version_5_with_xaw=yes
emacs_cv_xaw=yes
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
emacs_cv_x11_version_5_with_xaw=no
emacs_cv_xaw=no
fi
rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
conftest$ac_exeext conftest.$ac_ext
fi
if test $emacs_cv_x11_version_5_with_xaw = yes; then
{ echo "$as_me:$LINENO: result: 5 or newer, with Xaw; use toolkit by default" >&5
echo "${ECHO_T}5 or newer, with Xaw; use toolkit by default" >&6; }
USE_X_TOOLKIT=LUCID
else
if test x"${USE_X_TOOLKIT}" = xLUCID; then
if test $emacs_cv_xaw = yes; then
{ echo "$as_me:$LINENO: result: yes; using Lucid toolkit" >&5
echo "${ECHO_T}yes; using Lucid toolkit" >&6; }
USE_X_TOOLKIT=LUCID
elif test x"${USE_X_TOOLKIT}" = xLUCID; then
{ { echo "$as_me:$LINENO: error: Lucid toolkit requires X11/Xaw include files" >&5
echo "$as_me: error: Lucid toolkit requires X11/Xaw include files" >&2;}
{ (exit 1); exit 1; }; }
else
{ echo "$as_me:$LINENO: result: before 5 or no Xaw; do not use toolkit by default" >&5
echo "${ECHO_T}before 5 or no Xaw; do not use toolkit by default" >&6; }
{ echo "$as_me:$LINENO: result: no; do not use toolkit by default" >&5
echo "${ECHO_T}no; do not use toolkit by default" >&6; }
USE_X_TOOLKIT=none
fi
fi
else
USE_X_TOOLKIT=none
fi
fi
@ -12605,130 +12670,6 @@ echo "${ECHO_T}$emacs_cv_lesstif" >&6; }
fi
fi
### Is -lXaw3d available?
HAVE_XAW3D=no
if test "${HAVE_X11}" = "yes"; then
if test "${USE_X_TOOLKIT}" != "none" && test "${with_toolkit_scroll_bars}" != "no"; then
{ echo "$as_me:$LINENO: checking for X11/Xaw3d/Scrollbar.h" >&5
echo $ECHO_N "checking for X11/Xaw3d/Scrollbar.h... $ECHO_C" >&6; }
if test "${ac_cv_header_X11_Xaw3d_Scrollbar_h+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
#include <X11/Xaw3d/Scrollbar.h>
_ACEOF
if { (ac_try="$ac_cpp conftest.$ac_ext"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
(eval "$ac_cpp conftest.$ac_ext") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } >/dev/null && {
test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" ||
test ! -s conftest.err
}; then
ac_cv_header_X11_Xaw3d_Scrollbar_h=yes
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
ac_cv_header_X11_Xaw3d_Scrollbar_h=no
fi
rm -f conftest.err conftest.$ac_ext
fi
{ echo "$as_me:$LINENO: result: $ac_cv_header_X11_Xaw3d_Scrollbar_h" >&5
echo "${ECHO_T}$ac_cv_header_X11_Xaw3d_Scrollbar_h" >&6; }
if test $ac_cv_header_X11_Xaw3d_Scrollbar_h = yes; then
{ echo "$as_me:$LINENO: checking for XawScrollbarSetThumb in -lXaw3d" >&5
echo $ECHO_N "checking for XawScrollbarSetThumb in -lXaw3d... $ECHO_C" >&6; }
if test "${ac_cv_lib_Xaw3d_XawScrollbarSetThumb+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lXaw3d $LIBS"
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char XawScrollbarSetThumb ();
int
main ()
{
return XawScrollbarSetThumb ();
;
return 0;
}
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (ac_try="$ac_link"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
(eval "$ac_link") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } && {
test -z "$ac_c_werror_flag" ||
test ! -s conftest.err
} && test -s conftest$ac_exeext &&
$as_test_x conftest$ac_exeext; then
ac_cv_lib_Xaw3d_XawScrollbarSetThumb=yes
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
ac_cv_lib_Xaw3d_XawScrollbarSetThumb=no
fi
rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ echo "$as_me:$LINENO: result: $ac_cv_lib_Xaw3d_XawScrollbarSetThumb" >&5
echo "${ECHO_T}$ac_cv_lib_Xaw3d_XawScrollbarSetThumb" >&6; }
if test $ac_cv_lib_Xaw3d_XawScrollbarSetThumb = yes; then
HAVE_XAW3D=yes
fi
fi
if test "${HAVE_XAW3D}" = "yes"; then
cat >>confdefs.h <<\_ACEOF
#define HAVE_XAW3D 1
_ACEOF
fi
fi
fi
USE_TOOLKIT_SCROLL_BARS=no
@ -13808,11 +13749,10 @@ _ACEOF
fi
fi
### Use -lgif if available, unless `--with-gif=no'.
### Use -lgif or -lungif if available, unless `--with-gif=no'.
HAVE_GIF=no
if test "${HAVE_X11}" = "yes"; then
if test "${with_gif}" != "no"; then
if test "${ac_cv_header_gif_lib_h+set}" = set; then
if test "${HAVE_X11}" = "yes" && test "${with_gif}" != "no"; then
if test "${ac_cv_header_gif_lib_h+set}" = set; then
{ echo "$as_me:$LINENO: checking for gif_lib.h" >&5
echo $ECHO_N "checking for gif_lib.h... $ECHO_C" >&6; }
if test "${ac_cv_header_gif_lib_h+set}" = set; then
@ -13940,7 +13880,7 @@ fi
if test $ac_cv_header_gif_lib_h = yes; then
# EGifPutExtensionLast only exists from version libungif-4.1.0b1.
# Earlier versions can crash Emacs.
{ echo "$as_me:$LINENO: checking for EGifPutExtensionLast in -lungif" >&5
{ echo "$as_me:$LINENO: checking for EGifPutExtensionLast in -lungif" >&5
echo $ECHO_N "checking for EGifPutExtensionLast in -lungif... $ECHO_C" >&6; }
if test "${ac_cv_lib_ungif_EGifPutExtensionLast+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
@ -14003,11 +13943,94 @@ fi
echo "${ECHO_T}$ac_cv_lib_ungif_EGifPutExtensionLast" >&6; }
if test $ac_cv_lib_ungif_EGifPutExtensionLast = yes; then
HAVE_GIF=yes
else
try_libgif=yes
fi
fi
if test "$HAVE_GIF" = yes; then
ac_gif_lib_name="-lungif"
fi
# If gif_lib.h but no libungif, try libgif.
if test x"$try_libgif" = xyes; then
{ echo "$as_me:$LINENO: checking for EGifPutExtensionLast in -lgif" >&5
echo $ECHO_N "checking for EGifPutExtensionLast in -lgif... $ECHO_C" >&6; }
if test "${ac_cv_lib_gif_EGifPutExtensionLast+set}" = set; then
echo $ECHO_N "(cached) $ECHO_C" >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lgif $LIBS"
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char EGifPutExtensionLast ();
int
main ()
{
return EGifPutExtensionLast ();
;
return 0;
}
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (ac_try="$ac_link"
case "(($ac_try" in
*\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;
*) ac_try_echo=$ac_try;;
esac
eval "echo \"\$as_me:$LINENO: $ac_try_echo\"") >&5
(eval "$ac_link") 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } && {
test -z "$ac_c_werror_flag" ||
test ! -s conftest.err
} && test -s conftest$ac_exeext &&
$as_test_x conftest$ac_exeext; then
ac_cv_lib_gif_EGifPutExtensionLast=yes
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
ac_cv_lib_gif_EGifPutExtensionLast=no
fi
rm -f core conftest.err conftest.$ac_objext conftest_ipa8_conftest.oo \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ echo "$as_me:$LINENO: result: $ac_cv_lib_gif_EGifPutExtensionLast" >&5
echo "${ECHO_T}$ac_cv_lib_gif_EGifPutExtensionLast" >&6; }
if test $ac_cv_lib_gif_EGifPutExtensionLast = yes; then
HAVE_GIF=yes
fi
if test "$HAVE_GIF" = yes; then
cat >>confdefs.h <<\_ACEOF
#define LIBGIF -lgif
_ACEOF
ac_gif_lib_name="-lgif"
fi
fi
if test "${HAVE_GIF}" = "yes"; then
@ -14019,6 +14042,37 @@ _ACEOF
fi
fi
if test "${HAVE_X11}" = "yes"; then
MISSING=""
WITH_NO=""
test "${with_xpm}" != "no" && test "${HAVE_XPM}" != "yes" &&
MISSING="libXpm" && WITH_NO="--with-xpm=no"
test "${with_jpeg}" != "no" && test "${HAVE_JPEG}" != "yes" &&
MISSING="$MISSING libjpeg" && WITH_NO="$WITH_NO --with-jpeg=no"
test "${with_png}" != "no" && test "${HAVE_PNG}" != "yes" &&
MISSING="$MISSING libpng" && WITH_NO="$WITH_NO --with-png=no"
test "${with_gif}" != "no" && test "${HAVE_GIF}" != "yes" &&
MISSING="$MISSING libgif/libungif" && WITH_NO="$WITH_NO --with-gif=no"
test "${with_tiff}" != "no" && test "${HAVE_TIFF}" != "yes" &&
MISSING="$MISSING libtiff" && WITH_NO="$WITH_NO --with-tiff=no"
if test "X${MISSING}" != X; then
{ { echo "$as_me:$LINENO: error: The following required libraries was not found:
$MISSING
Maybe some development libraries/packages are missing?
If you don't want to link with them give
$WITH_NO
as options to configure" >&5
echo "$as_me: error: The following required libraries was not found:
$MISSING
Maybe some development libraries/packages are missing?
If you don't want to link with them give
$WITH_NO
as options to configure" >&2;}
{ (exit 1); exit 1; }; }
fi
fi
### Use -lgpm if available, unless `--with-gpm=no'.
HAVE_GPM=no
if test "${with_gpm}" != "no"; then
@ -23362,6 +23416,7 @@ fi
#### Report on what we decided to do.
#### Report GTK as a toolkit, even if it doesn't use Xt.
#### It makes printing result more understandable as using GTK sets
@ -23398,7 +23453,7 @@ echo " Does Emacs use -lXaw3d? ${HAVE_XAW3D}"
echo " Does Emacs use -lXpm? ${HAVE_XPM}"
echo " Does Emacs use -ljpeg? ${HAVE_JPEG}"
echo " Does Emacs use -ltiff? ${HAVE_TIFF}"
echo " Does Emacs use -lungif? ${HAVE_GIF}"
echo " Does Emacs use a gif library? ${HAVE_GIF} $ac_gif_lib_name"
echo " Does Emacs use -lpng? ${HAVE_PNG}"
echo " Does Emacs use -lgpm? ${HAVE_GPM}"
echo " Does Emacs use X toolkit scroll bars? ${USE_TOOLKIT_SCROLL_BARS}"

119
configure.in
View File

@ -90,15 +90,10 @@ AC_ARG_WITH(x-toolkit,
a | at | ath | athe | athen | athena ) val=athena ;;
m | mo | mot | moti | motif ) val=motif ;;
g | gt | gtk ) val=gtk ;;
dnl These don't currently work.
dnl o | op | ope | open | open- | open-l | open-lo \
dnl | open-loo | open-look ) val=open-look ;;
* )
dnl AC_MSG_ERROR([the `--with-x-toolkit' option is supposed to have a value
dnl which is `yes', `no', `lucid', `athena', `motif' or `open-look'.])
AC_MSG_ERROR([`--with-x-toolkit=$withval' is invalid\;
AC_MSG_ERROR([`--with-x-toolkit=$withval' is invalid;
this option's value should be `yes', `no', `lucid', `athena', `motif' or `gtk'.
Currently, `yes' and `gtk', and `athena' and `lucid' are synonyms.])
`yes' and `gtk' are synonyms. `athena' and `lucid' are synonyms.])
;;
esac
with_x_toolkit=$val
@ -110,7 +105,7 @@ AC_ARG_WITH(jpeg,
AC_ARG_WITH(tiff,
[ --with-tiff use -ltiff for displaying TIFF images])
AC_ARG_WITH(gif,
[ --with-gif use -lungif for displaying GIF images])
[ --with-gif use -lungif (or -lgif) for displaying GIF images])
AC_ARG_WITH(png,
[ --with-png use -lpng for displaying PNG images])
AC_ARG_WITH(gpm,
@ -1874,7 +1869,6 @@ case "${window_system}" in
case "${with_x_toolkit}" in
athena | lucid ) USE_X_TOOLKIT=LUCID ;;
motif ) USE_X_TOOLKIT=MOTIF ;;
dnl open-look ) USE_X_TOOLKIT=OPEN_LOOK ;;
gtk ) with_gtk=yes
dnl Dont set this for GTK. A lot of tests below assumes Xt when
dnl USE_X_TOOLKIT is set.
@ -2241,29 +2235,45 @@ fi
dnl Do not put whitespace before the #include statements below.
dnl Older compilers (eg sunos4 cc) choke on it.
HAVE_XAW3D=no
if test x"${USE_X_TOOLKIT}" = xmaybe || test x"${USE_X_TOOLKIT}" = xLUCID; then
if test x"${HAVE_X11R5}" = xyes; then
AC_MSG_CHECKING(X11 version 5 with Xaw)
AC_CACHE_VAL(emacs_cv_x11_version_5_with_xaw,
if test x"${HAVE_X11R5}" != xyes; then
USE_X_TOOLKIT=none
else
AC_MSG_CHECKING(for xaw3d)
AC_CACHE_VAL(emacs_cv_xaw3d,
[AC_TRY_LINK([
#include <X11/Intrinsic.h>
#include <X11/Xaw/Simple.h>],
#include <X11/Xaw3d/Simple.h>],
[],
emacs_cv_x11_version_5_with_xaw=yes,
emacs_cv_x11_version_5_with_xaw=no)])
if test $emacs_cv_x11_version_5_with_xaw = yes; then
AC_MSG_RESULT([5 or newer, with Xaw; use toolkit by default])
emacs_cv_xaw3d=yes,
emacs_cv_xaw3d=no)])
if test $emacs_cv_xaw3d = yes; then
AC_MSG_RESULT([yes; using Lucid toolkit])
USE_X_TOOLKIT=LUCID
HAVE_XAW3D=yes
AC_DEFINE(HAVE_XAW3D, 1,
[Define to 1 if you have the Xaw3d library (-lXaw3d).])
else
if test x"${USE_X_TOOLKIT}" = xLUCID; then
AC_MSG_RESULT(no)
AC_MSG_CHECKING(for libXaw)
AC_CACHE_VAL(emacs_cv_xaw,
[AC_TRY_LINK([
#include <X11/Intrinsic.h>
#include <X11/Xaw/Simple.h>],
[],
emacs_cv_xaw=yes,
emacs_cv_xaw=no)])
if test $emacs_cv_xaw = yes; then
AC_MSG_RESULT([yes; using Lucid toolkit])
USE_X_TOOLKIT=LUCID
elif test x"${USE_X_TOOLKIT}" = xLUCID; then
AC_MSG_ERROR([Lucid toolkit requires X11/Xaw include files])
else
AC_MSG_RESULT(before 5 or no Xaw; do not use toolkit by default)
AC_MSG_RESULT([no; do not use toolkit by default])
USE_X_TOOLKIT=none
fi
fi
else
USE_X_TOOLKIT=none
fi
fi
@ -2351,21 +2361,6 @@ Motif version prior to 2.1.
fi
fi
### Is -lXaw3d available?
HAVE_XAW3D=no
if test "${HAVE_X11}" = "yes"; then
if test "${USE_X_TOOLKIT}" != "none" && test "${with_toolkit_scroll_bars}" != "no"; then
dnl Fixme: determine what Scrollbar.h needs to avoid compilation
dnl errors from the test without the `-'.
AC_CHECK_HEADER(X11/Xaw3d/Scrollbar.h,
[AC_CHECK_LIB(Xaw3d, XawScrollbarSetThumb, HAVE_XAW3D=yes)], , -)
if test "${HAVE_XAW3D}" = "yes"; then
AC_DEFINE(HAVE_XAW3D, 1,
[Define to 1 if you have the Xaw3d library (-lXaw3d).])
fi
fi
fi
dnl Use toolkit scroll bars if configured for GTK or X toolkit and either
dnl using Motif or Xaw3d is available, and unless
dnl --with-toolkit-scroll-bars=no was specified.
@ -2527,18 +2522,55 @@ if test "${HAVE_X11}" = "yes"; then
fi
fi
### Use -lgif if available, unless `--with-gif=no'.
### Use -lgif or -lungif if available, unless `--with-gif=no'.
HAVE_GIF=no
if test "${HAVE_X11}" = "yes"; then
if test "${with_gif}" != "no"; then
AC_CHECK_HEADER(gif_lib.h,
if test "${HAVE_X11}" = "yes" && test "${with_gif}" != "no"; then
AC_CHECK_HEADER(gif_lib.h,
# EGifPutExtensionLast only exists from version libungif-4.1.0b1.
# Earlier versions can crash Emacs.
AC_CHECK_LIB(ungif, EGifPutExtensionLast, HAVE_GIF=yes))
AC_CHECK_LIB(ungif, EGifPutExtensionLast, HAVE_GIF=yes, try_libgif=yes))
if test "$HAVE_GIF" = yes; then
ac_gif_lib_name="-lungif"
fi
# If gif_lib.h but no libungif, try libgif.
if test x"$try_libgif" = xyes; then
AC_CHECK_LIB(gif, EGifPutExtensionLast, HAVE_GIF=yes)
if test "$HAVE_GIF" = yes; then
AC_DEFINE(LIBGIF, -lgif, [Compiler option to link with the gif library (if not -lungif).])
ac_gif_lib_name="-lgif"
fi
fi
if test "${HAVE_GIF}" = "yes"; then
AC_DEFINE(HAVE_GIF, 1, [Define to 1 if you have the ungif library (-lungif).])
AC_DEFINE(HAVE_GIF, 1, [Define to 1 if you have a gif library (default -lungif; otherwise specify with LIBGIF).])
fi
fi
dnl Check for required libraries.
if test "${HAVE_X11}" = "yes"; then
MISSING=""
WITH_NO=""
test "${with_xpm}" != "no" && test "${HAVE_XPM}" != "yes" &&
MISSING="libXpm" && WITH_NO="--with-xpm=no"
test "${with_jpeg}" != "no" && test "${HAVE_JPEG}" != "yes" &&
MISSING="$MISSING libjpeg" && WITH_NO="$WITH_NO --with-jpeg=no"
test "${with_png}" != "no" && test "${HAVE_PNG}" != "yes" &&
MISSING="$MISSING libpng" && WITH_NO="$WITH_NO --with-png=no"
test "${with_gif}" != "no" && test "${HAVE_GIF}" != "yes" &&
MISSING="$MISSING libgif/libungif" && WITH_NO="$WITH_NO --with-gif=no"
test "${with_tiff}" != "no" && test "${HAVE_TIFF}" != "yes" &&
MISSING="$MISSING libtiff" && WITH_NO="$WITH_NO --with-tiff=no"
if test "X${MISSING}" != X; then
AC_MSG_ERROR([The following required libraries was not found:
$MISSING
Maybe some development libraries/packages are missing?
If you don't want to link with them give
$WITH_NO
as options to configure])
fi
fi
@ -2984,6 +3016,7 @@ if test "${REL_ALLOC}" = "yes" ; then
buffer space.])
fi
AH_TOP([/* GNU Emacs site configuration template file.
Copyright (C) 1988, 1993, 1994, 1999, 2000, 2001, 2002, 2004, 2005, 2006, 2007
Free Software Foundation, Inc.
@ -3311,7 +3344,7 @@ echo " Does Emacs use -lXaw3d? ${HAVE_XAW3D}"
echo " Does Emacs use -lXpm? ${HAVE_XPM}"
echo " Does Emacs use -ljpeg? ${HAVE_JPEG}"
echo " Does Emacs use -ltiff? ${HAVE_TIFF}"
echo " Does Emacs use -lungif? ${HAVE_GIF}"
echo " Does Emacs use a gif library? ${HAVE_GIF} $ac_gif_lib_name"
echo " Does Emacs use -lpng? ${HAVE_PNG}"
echo " Does Emacs use -lgpm? ${HAVE_GPM}"
echo " Does Emacs use X toolkit scroll bars? ${USE_TOOLKIT_SCROLL_BARS}"

15
etc/ChangeLog
View File

@ -1,3 +1,18 @@
2007-06-14 Nick Roberts <nickrob@snap.net.nz>
* NEWS: Mention mouse highlighting in a GNU/Linux console.
2007-06-14 Werner Lemberg <wl@gnu.org>
* emacs.1: Completely revised.
Fix many typographical glitches.
Updated to handle current state of options and resources.
2007-06-12 Glenn Morris <rgm@gnu.org>
* NEWS: Change bug address. Add back +++/--- note.
Use present tense for X-toolkit entry. Mention libgif.
2007-06-07 Mark H. Weaver <mhw@netris.org> (tiny change)
* NEWS (set-mark-command-repeat-pop): Fix duplicate entry.

40
etc/NEWS
View File

@ -3,7 +3,7 @@ GNU Emacs NEWS -- history of user-visible changes.
Copyright (C) 2007 Free Software Foundation, Inc.
See the end of the file for license conditions.
Please send Emacs bug reports to bug-gnu-emacs@gnu.org.
Please send Emacs bug reports to emacs-pretest-bug@gnu.org.
If possible, use M-x report-emacs-bug.
This file is about changes in Emacs version 23.
@ -13,13 +13,31 @@ for changes in older Emacs versions.
You can narrow news to a specific version by calling `view-emacs-news'
with a prefix argument or by typing C-u C-h C-n.
Temporary note:
+++ indicates that the appropriate manual has already been updated.
--- means no change in the manuals is called for.
When you add a new item, please add it without either +++ or ---
so we will look at it and add it to the manual.
* About external Lisp packages
* Installation Changes in Emacs 23.1
** The default X toolkit has changed from Lucid to Gtk+.
** The default X toolkit is now Gtk+, rather than Lucid.
** configure now checks for libgif (as well as libungif) when
searching for a GIF library.
* Changes in Emacs 23.1
** If the gpm mouse server is running and t-mouse-mode enabled, Emacs uses a
Unix socket in a GNU/Linux console to talk to server, rather than faking events
using the client program mev. This C level approach provides mouse
highlighting, and help echoing in the minibuffer.
* Startup Changes in Emacs 23.1
@ -37,8 +55,12 @@ with a prefix argument or by typing C-u C-h C-n.
** css-mode to edit Cascading Style Sheets.
** bibtex-style-mode helps you write BibTeX's *.bst files.
** socks.el (which had been part of W3) is now part of Emacs.
** minibuffer-indicate-depth-mode shows the minibuffer depth in the prompt.
* Changes in Specialized Modes and Packages in Emacs 23.1
@ -46,6 +68,9 @@ with a prefix argument or by typing C-u C-h C-n.
Only copyright lines with holders matching copyright-names-regexp will be
considered for update.
** VC has some support for Bazaar (bzr).
* Changes in Emacs 23.1 on non-free operating systems
@ -55,6 +80,17 @@ considered for update.
* Lisp Changes in Emacs 23.1
+++
** The regexp form \(?<num>:<regexp>\) specifies the group number explicitly.
+++
** New variable `user-emacs-directory'.
Use this instead of "~/.emacs.d".
+++
** The new function `image-refresh' refreshes all images associated
with a given image specification.
* New Packages for Lisp Programming in Emacs 23.1

3
etc/PROBLEMS
View File

@ -2180,6 +2180,9 @@ Files larger than 4GB cause overflow in the size (represented as a
well, since the Windows port uses a Lisp emulation of `ls' that relies
on `file-attributes'.
Sound playing is not supported with the `:data DATA' key-value pair.
You _must_ use the `:file FILE' method.
** Typing Alt-Shift has strange effects on MS-Windows.
This combination of keys is a command to change keyboard layout. If

8
etc/TODO
View File

@ -14,14 +14,6 @@ to the FSF.
* Small but important fixes needed in existing features:
** Fix compilation when Xaw3d libraries are present but libxaw is not.
In new X11 versions, xaw3dg-dev does not depend on libxaw-dev, so the
latter need not be installed. As a result, all the source files that
look for include files in X11/Xaw should look in X11/Xaw3d if we are
using Xaw3d.
http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-04/msg00396.html
http://lists.gnu.org/archive/html/emacs-devel/2006-03/msg01150.html ?
** Compute the list of active keymaps *after* reading the first event.
** Avoid using "iff" in doc strings.

613
etc/emacs.1
View File

@ -1,3 +1,4 @@
'\" t
.\" Copyright (C) 1995, 1999, 2000, 2001, 2002, 2003, 2004,
.\" 2005, 2006, 2007 Free Software Foundation, Inc.
.\"
@ -20,27 +21,33 @@
.\"
'\" t
.TH EMACS 1 "2007 April 13" "GNU Emacs 22.1"
.
.
.SH NAME
emacs \- GNU project Emacs
.
.
.SH SYNOPSIS
.B emacs
[
.I command-line switches
] [
.I files ...
.I files ...\&
]
.br
.
.
.SH DESCRIPTION
.I GNU Emacs
is a version of
.I Emacs,
.IR Emacs ,
written by the author of the original (PDP-10)
.I Emacs,
.IR Emacs ,
Richard Stallman.
.br
The primary documentation of GNU Emacs is in the GNU Emacs Manual,
which you can read using Info, either from Emacs or as a standalone
program. Please look there for complete and up-to-date documentation.
program.
Please look there for complete and up-to-date documentation.
This man page is updated only when someone volunteers to do so; the
Emacs maintainers' priority goal is to minimize the amount of time
this man page takes away from other more useful projects.
@ -56,9 +63,9 @@ has an extensive interactive help facility,
but the facility assumes that you know how to manipulate
.I Emacs
windows and buffers.
CTRL-h or F1 enters the Help facility. Help Tutorial (CTRL-h t)
starts an interactive tutorial which can teach beginners the fundamentals
of
CTRL-h or F1 enters the Help facility.
Help Tutorial (CTRL-h t) starts an interactive tutorial which can
teach beginners the fundamentals of
.I Emacs
in a few minutes.
Help Apropos (CTRL-h a) helps you
@ -66,11 +73,11 @@ find a command given its functionality, Help Character (CTRL-h c)
describes a given character's effect, and Help Function (CTRL-h f)
describes a given Lisp function specified by name.
.PP
.I Emacs's
.IR Emacs 's
Undo can undo several steps of modification to your buffers, so it is
easy to recover from editing mistakes.
.PP
.I GNU Emacs's
.IR "GNU Emacs" 's
many special packages handle mail reading (RMail) and sending (Mail),
outline editing (Outline), compiling (Compile), running subshells
within
@ -81,130 +88,176 @@ windows (Shell), running a Lisp read-eval-print loop
There is an extensive reference manual, but
users of other Emacses
should have little trouble adapting even
without a copy. Users new to
without a copy.
Users new to
.I Emacs
will be able
to use basic features fairly rapidly by studying the tutorial and
using the self-documentation features.
.PP
.SM Emacs Options
.PP
.
.SS Emacs Options
The following options are of general interest:
.RS
.TP 8
.I file
Edit
.I file.
.IR file .
.TP
.BI \+ number
.BI \-\-file " file\fR,\fP " \-\-find-file " file\fR,\fP " \-\-visit " file"
The same as specifying
.I file
directly as an argument.
.TP
.BI + number
Go to the line specified by
.I number
(do not insert a space between the "+" sign and
the number). This applies only to the next file specified.
the number).
This applies only to the next file specified.
.TP
.BI \+ line:column
.BI + line:column
Go to the specified
.I line
and
.I column
.IR column .
.TP
.B \-q
.BR \-q ", " \-\-no\-init\-file
Do not load an init file.
.TP
.B \-no-site-file
.B \-\-no\-site\-file
Do not load the site-wide startup file.
.TP
.BI \-debug-init
.B \-\-no\-desktop
Do not load a saved desktop.
.TP
.BR \-nl ", " \-\-no\-shared\-memory
Do not use shared memory.
.TP
.BR \-Q ", " \-\-quick
Equivalent to "\-q \-\-no\-site\-file \-\-no\-splash".
.TP
.B \-\-no\-splash
Do not display a splash screen during start-up.
.TP
.B \-\-debug\-init
Enable
.I Emacs
Lisp debugger during the processing of the user init file
.BI ~/.emacs.
.BR ~/.emacs .
This is useful for debugging problems in the init file.
.TP
.BI \-u " user"
.BI \-u " user\fR,\fP " \-\-user " user"
Load
.I user's
.IR user 's
init file.
.TP
.BI \-t " file"
.BI \-t " file\fR,\fP " \-\-terminal " file"
Use specified
.I file
as the terminal instead of using stdin/stdout.
This must be the first argument specified in the command line.
.TP
.B \-version
.BR \-\-multibyte ", " \-\-no-unibyte
Enable multibyte mode (enabled by default).
.TP
.BR \-\-unibyte ", " \-\-no-multibyte
Enable unibyte mode.
.TP
.B \-\-version
Display
.I Emacs
version information and exit.
.TP
.B \-\-help
Display this help and exit.
.RE
.PP
The following options are lisp-oriented
(these options are processed in the order encountered):
.RS
.TP 8
.BI \-f " function"
.BI \-f " function\fR,\fP " \-\-funcall " function"
Execute the lisp function
.I function.
.IR function .
.TP
.BI \-l " file"
.BI \-l " file\fR,\fP " \-\-load " file"
Load the lisp code in the file
.I file.
.IR file .
.TP
.BI \-eval " expr"
.BI \-\-eval " expr\fR,\fP " \-\-execute " expr"
Evaluate the Lisp expression
.I expr.
.IR expr .
.RE
.PP
The following options are useful when running
.I Emacs
as a batch editor:
.RS
.TP 8
.BI \-batch
Edit in batch mode. The editor will send messages to stderr. This
option must be the first in the argument list. You must use \-l and \-f
options to specify files to execute and functions to call.
.B \-\-batch
Edit in batch mode.
The editor will send messages to stderr.
This option must be the first in the argument list.
You must use \-l and \-f options to specify files to execute
and functions to call.
.TP
.B \-kill
.BI \-\-script " file"
Run
.I file
as an Emacs Lisp script.
.TP
.BI \-\-insert " file"
Insert contents of
.I file
into the current buffer.
.TP
.B \-\-kill
Exit
.I Emacs
while in batch mode.
.TP
.BI \-L " directory"
.BI \-L " dir\fR,\fP " \-\-directory " dir"
Add
.I directory
.I dir
to the list of directories
.I Emacs
searches for Lisp files.
.RE
.
.\" START DELETING HERE IF YOU'RE NOT USING X
.PP
.SM Using Emacs with X
.PP
.SS Using Emacs with X
.I Emacs
has been tailored to work well with the X window system.
If you run
.I Emacs
from under X windows, it will create its own X window to
display in. You will probably want to start the editor
as a background process
so that you can continue using your original window.
display in.
You will probably want to start the editor as a background
process so that you can continue using your original window.
.PP
.I Emacs
can be started with the following X switches:
.RS
.TP 8
.BI \-name " name"
Specifies the name which should be assigned to the initial
.BI \-\-name " name"
Specify the name which should be assigned to the initial
.I Emacs
window. This controls looking up X resources as well as the window title.
.TP 8
.BI \-title " name"
Specifies the title for the initial X window.
.TP 8
.B \-r
window.
This controls looking up X resources as well as the window title.
.TP
.BI \-T " name\fR,\fP " \-\-title " name"
Specify the title for the initial X window.
.TP
.BR \-r ", " \-rv ", " \-\-reverse\-video
Display the
.I Emacs
window in reverse video.
.TP
.BI \-font " font, " \-fn " font"
.BI \-fn " font\fR,\fP " \-\-font " font"
Set the
.I Emacs
window's font to that specified by
.I font.
.IR font .
You will find the various
.I X
fonts in the
@ -215,84 +268,119 @@ Note that
will only accept fixed width fonts.
Under the X11 Release 4 font-naming conventions, any font with the
value "m" or "c" in the eleventh field of the font name is a fixed
width font. Furthermore, fonts whose name are of the form
width font.
Furthermore, fonts whose name are of the form
.IR width x height
are generally fixed width, as is the font
.IR fixed .
See
.IR xlsfonts (1)
.BR xlsfonts (1)
for more information.
When you specify a font, be sure to put a space between the
switch and the font name.
.TP
.BI \-bw " pixels"
.BI \-\-xrm " resources"
Set additional X resources.
.TP
.BI "\-\-color\fR,\fP \-\-color=" mode
Override color mode for character terminals;
.I mode
defaults to `auto', and can also be `never', `auto', `always',
or a mode name like `ansi8'.
.TP
.BI \-bw " pixels\fR,\fP " \-\-border\-width " pixels"
Set the
.I Emacs
window's border width to the number of pixels specified by
.I pixels.
.IR pixels .
Defaults to one pixel on each side of the window.
.TP
.BI \-ib " pixels"
.BI \-ib " pixels\fR,\fP " \-\-internal\-border " pixels"
Set the window's internal border width to the number of pixels specified
by
.I pixels.
.IR pixels .
Defaults to one pixel of padding on each side of the window.
.PP
.TP 8
.BI \-\-geometry " geometry"
.TP
.BI \-g " geometry\fR,\fP " \-\-geometry " geometry"
Set the
.I Emacs
window's width, height, and position as specified. The geometry
specification is in the standard X format; see
.IR X (1)
window's width, height, and position as specified.
The geometry specification is in the standard X format; see
.BR X (7)
for more information.
The width and height are specified in characters; the default is 80 by
24. See the Emacs manual, section "Options for Window Size and Position",
The width and height are specified in characters; the default is
80 by 24.
See the Emacs manual, section "Options for Window Size and Position",
for information on how window sizes interact
with selecting or deselecting the tool bar and menu bar.
.PP
.TP 8
.BI \-fg " color"
On color displays, sets the color of the text.
.TP
.BI \-lsp " pixels\fR,\fP " \-\-line\-spacing " pixels"
Additional space to put between lines.
.TP
.BR \-vb ", " \-\-vertical\-scroll\-bars
Enable vertical scrollbars.
.TP
.BR \-fh ", " \-\-fullheight
Make the first frame as high as the screen.
.TP
.BR \-fs ", " \-\-fullscreen
Make the first frame fullscreen.
.TP
.BR \-fw ", " \-\-fullwidth
Make the first frame as wide as the screen.
.TP
.BI \-fg " color\fR,\fP " \-\-foreground\-color " color"
On color displays, set the color of the text.
Use the command
.I M-x list-colors-display
for a list of valid
color names.
.I M\-x list\-colors\-display
for a list of valid color names.
.TP
.BI \-bg " color"
On color displays,
sets the color of the window's background.
.BI \-bg " color\fR,\fP " \-\-background\-color " color"
On color displays, set the color of the window's background.
.TP
.BI \-bd " color"
On color displays,
sets the color of the window's border.
.BI \-bd " color\fR,\fP " \-\-border\-color " color"
On color displays, set the color of the window's border.
.TP
.BI \-cr " color"
On color displays,
sets the color of the window's text cursor.
.BI \-cr " color\fR,\fP " \-\-cursor\-color " color"
On color displays, set the color of the window's text cursor.
.TP
.BI \-ms " color"
On color displays,
sets the color of the window's mouse cursor.
.BI \-ms " color\fR,\fP " \-\-mouse\-color " color"
On color displays, set the color of the window's mouse cursor.
.TP
.BI \-d " displayname, " \-display " displayname"
.BI \-d " displayname\fR,\fP " \-\-display " displayname"
Create the
.I Emacs
window on the display specified by
.IR displayname .
Must be the first option specified in the command line.
.TP
.B \-nw
Tells
.BR \-nbi ", " \-\-no\-bitmap\-icon
Do not use picture of gnu for Emacs icon.
.TP
.B \-\-iconic
Start
.I Emacs
not to use its special interface to X. If you use this
switch when invoking
in iconified state.
.TP
.BR \-nbc ", " \-\-no\-blinking\-cursor
Disable blinking cursor.
.TP
.BR \-nw ", " \-\-no\-window\-system
Tell
.I Emacs
not to use its special interface to X.
If you use this switch when invoking
.I Emacs
from an
.IR xterm (1)
.BR xterm (1)
window, display is done in that window.
.TP
.BR \-D ", " \-\-basic\-display
This option disables many display features; use it for
debugging Emacs.
.RE
.PP
You can set
.I X
@ -301,75 +389,185 @@ default values for your
windows in your
.I \.Xresources
file (see
.IR xrdb (1)).
.BR xrdb (1)).
Use the following format:
.IP
emacs.keyword:value
.RI emacs. keyword : value
.PP
where
.I value
specifies the default value of
.I keyword.
.IR keyword .
.I Emacs
lets you set default values for the following keywords:
.RS
.TP 8
.B font (\fPclass\fB Font)
Sets the window's text font.
.TP
.B reverseVideo (\fPclass\fB ReverseVideo)
If
.I reverseVideo's
value is set to
.I on,
the window will be displayed in reverse video.
.TP
.B bitmapIcon (\fPclass\fB BitmapIcon)
If
.I bitmapIcon's
value is set to
.I on,
the window will iconify into the "kitchen sink."
.TP
.B borderWidth (\fPclass\fB BorderWidth)
Sets the window's border width in pixels.
.TP
.B internalBorder (\fPclass\fB BorderWidth)
Sets the window's internal border width in pixels.
.TP
.B foreground (\fPclass\fB Foreground)
For color displays,
sets the window's text color.
.TP
.B background (\fPclass\fB Background)
.BR background " (class " Background )
For color displays,
sets the window's background color.
.TP
.B borderColor (\fPclass\fB BorderColor)
.BR bitmapIcon " (class " BitmapIcon )
If
.BR bitmapIcon 's
value is set to
.IR on ,
the window will iconify into the "kitchen sink."
.TP
.BR borderColor " (class " BorderColor )
For color displays,
sets the color of the window's border.
.TP
.B cursorColor (\fPclass\fB Foreground)
.BR borderWidth " (class " BorderWidth )
Sets the window's border width in pixels.
.TP
.BR cursorColor " (class " Foreground )
For color displays,
sets the color of the window's text cursor.
.TP
.B pointerColor (\fPclass\fB Foreground)
For color displays,
sets the color of the window's mouse cursor.
.BR cursorBlink " (class " CursorBlink )
Specifies whether to make the cursor blink.
The default is
.IR on .
Use
.I off
or
.I false
to turn cursor blinking off.
.TP
.B geometry (\fPclass\fB Geometry)
.BR font " (class " Font )
Sets the window's text font.
.TP
.BR foreground " (class " Foreground )
For color displays,
sets the window's text color.
.TP
.BR fullscreen " (class " Fullscreen )
The desired fullscreen size.
The value can be one of
.IR fullboth ,
.IR fullwidth ,
or
.IR fullheight ,
which correspond to the command-line options `\-fs', `\-fw', and
`\-fh', respectively.
Note that this applies to the initial frame only.
.TP
.BR geometry " (class " Geometry )
Sets the geometry of the
.I Emacs
window (as described above).
.TP
.B title (\fPclass\fB Title)
.BR iconName " (class " Title )
Sets the icon name for the
.I Emacs
window icon.
.TP
.BR internalBorder " (class " BorderWidth )
Sets the window's internal border width in pixels.
.TP
.BR lineSpacing " (class " LineSpacing )
Additional space ("leading") between lines, in pixels.
.TP
.BR menuBar " (class " MenuBar )
Gives frames menu bars if
.IR on ;
don't have menu bars if
.IR off .
See the Emacs manual, sections "Lucid Resources" and "LessTif
Resources", for how to control the appearance of the menu bar
if you have one.
.TP
.BR minibuffer " (class " Minibuffer )
If
.IR none ,
don't make a minibuffer in this frame.
It will use a separate minibuffer frame instead.
.TP
.BR paneFont " (class " Font )
Font name for menu pane titles, in non-toolkit versions of
.IR Emacs .
.TP
.BR pointerColor " (class " Foreground )
For color displays,
sets the color of the window's mouse cursor.
.TP
.BR privateColormap " (class " PrivateColormap )
If
.IR on ,
use a private color map, in the case where the "default
visual" of class
.B PseudoColor
and
.B Emacs
is using it.
.TP
.BR reverseVideo " (class " ReverseVideo )
If
.BR reverseVideo 's
value is set to
.IR on ,
the window will be displayed in reverse video.
.TP
.BR screenGamma " (class "ScreenGamma )
Gamma correction for colors, equivalent to the frame parameter
`screen\-gamma'.
.TP
.BR scrollBarWidth " (class "ScrollBarWidth )
The scroll bar width in pixels, equivalent to the frame parameter
`scroll\-bar\-width'.
.TP
.BR selectionFont " (class " SelectionFont )
Font name for pop-up menu items, in non-toolkit versions of
.IR Emacs .
(For toolkit versions, see the Emacs manual, sections
"Lucid Resources" and "LessTif Resources".)
.TP
.BR selectionTimeout " (class " SelectionTimeout )
Number of milliseconds to wait for a selection reply.
A value of 0 means wait as long as necessary.
.TP
.BR synchronous " (class " Synchronous )
Run Emacs in synchronous mode if
.IR on .
Synchronous mode is useful for debugging X problems.
.TP
.BR title " (class " Title )
Sets the title of the
.I Emacs
window.
.TP
.B iconName (\fPclass\fB Title)
Sets the icon name for the
.I Emacs
window icon.
.BR toolBar " (class " ToolBar )
Number of lines to reserve for the tool bar.
.TP
.BR useXIM " (class " UseXIM )
Turns off use of X input methods (XIM) if
.I false
or
.IR off .
.TP
.BR verticalScrollBars " (class " ScrollBars )
Gives frames scroll bars if
.IR on ;
suppresses scroll bars if
.IR off .
.TP
.BR visualClass " (class " VisualClass )
Specify the "visual" that X should use.
This tells X how to handle colors.
The value should start with one of
.IR TrueColor ,
.IR PseudoColor ,
.IR DirectColor ,
.IR StaticColor ,
.IR GrayScale ,
and
.IR StaticGray ,
followed by
.BI \- depth\fR,\fP
where
.I depth
is the number of color planes.
.RE
.PP
If you try to set color values while using a black and white display,
the window's characteristics will default as follows:
@ -377,14 +575,17 @@ the foreground color will be set to black,
the background color will be set to white,
the border color will be set to grey,
and the text and mouse cursors will be set to black.
.
.SS Using the Mouse
.PP
.SM Using the Mouse
.PP
The following lists the mouse button bindings for the
The following lists some of the mouse button bindings for the
.I Emacs
window under X11.
.
.RS
.TS
l l
- -
l l.
MOUSE BUTTON FUNCTION
left Set point.
@ -394,83 +595,93 @@ SHIFT-middle Cut text into X cut buffer.
SHIFT-right Paste text.
CTRL-middle Cut text into X cut buffer and kill it.
CTRL-right T{
Select this window, then split it into
two windows. Same as typing CTRL-x 2.
Select this window, then split it into two windows.
Same as typing CTRL\-x 2.
T}
.\" START DELETING HERE IF YOU'RE NOT USING X MENUS
CTRL-SHIFT-left T{
X buffer menu \(em hold the buttons and keys
down, wait for menu to appear, select
buffer, and release. Move mouse out of
menu and release to cancel.
down, wait for menu to appear, select buffer, and release.
Move mouse out of menu and release to cancel.
T}
CTRL-SHIFT-middle T{
X help menu \(em pop up index card menu for Emacs help.
T}
CTRL-SHIFT-middle X help menu \(em pop up index card menu for Emacs help.
.\" STOP DELETING HERE IF YOU'RE NOT USING X MENUS
CTRL-SHIFT-right T{
Select window with mouse, and delete all
other windows. Same as typing CTRL-x 1.
Select window with mouse, and delete all other windows.
Same as typing CTRL\-x 1.
T}
.\" STOP DELETING HERE IF YOU'RE NOT USING X
.TE
.PP
.RE
.
.
.SH MANUALS
You can order printed copies of the GNU Emacs Manual from the Free
Software Foundation, which develops GNU software. See the file ORDERS
for ordering information.
Software Foundation, which develops GNU software.
See the file ORDERS for ordering information.
.br
Your local Emacs maintainer might also have copies available. As
with all software and publications from FSF, everyone is permitted to
make and distribute copies of the Emacs manual. The TeX source to the
manual is also included in the Emacs source distribution.
.PP
Your local Emacs maintainer might also have copies available.
As with all software and publications from FSF, everyone is permitted
to make and distribute copies of the Emacs manual.
The TeX source to the manual is also included in the Emacs source
distribution.
.
.
.SH FILES
/usr/local/share/info - files for the Info documentation browser.
/usr/local/share/info \(em files for the Info documentation browser.
The complete text of the Emacs reference manual is included in a
convenient tree structured form. Also includes the Emacs Lisp
Reference Manual, useful to anyone wishing to write programs in the
Emacs Lisp extension language.
convenient tree structured form.
Also includes the Emacs Lisp Reference Manual, useful to anyone
wishing to write programs in the Emacs Lisp extension language.
/usr/local/share/emacs/$VERSION/lisp - Lisp source files and compiled files
that define most editing commands. Some are preloaded;
others are autoloaded from this directory when used.
/usr/local/share/emacs/$VERSION/lisp \(em Lisp source files and
compiled files that define most editing commands.
Some are preloaded; others are autoloaded from this directory when
used.
/usr/local/libexec/emacs/$VERSION/$ARCH - various programs that are
/usr/local/libexec/emacs/$VERSION/$ARCH \(em various programs that are
used with GNU Emacs.
/usr/local/share/emacs/$VERSION/etc - various files of information.
/usr/local/share/emacs/$VERSION/etc \(em various files of information.
/usr/local/share/emacs/$VERSION/etc/DOC.* - contains the documentation
/usr/local/share/emacs/$VERSION/etc/DOC.* \(em contains the documentation
strings for the Lisp primitives and preloaded Lisp functions
of GNU Emacs. They are stored here to reduce the size of
Emacs proper.
of GNU Emacs.
They are stored here to reduce the size of Emacs proper.
.br
/usr/local/share/emacs/$VERSION/etc/SERVICE lists people offering
various services to assist users of GNU Emacs, including education,
troubleshooting, porting and customization.
.PP
.
.
.SH BUGS
There is a mailing list, bug-gnu-emacs@gnu.org, for reporting Emacs
bugs and fixes. But before reporting something as a bug, please try
to be sure that it really is a bug, not a misunderstanding or a
deliberate feature. We ask you to read the section ``Reporting Emacs
Bugs'' near the end of the reference manual (or Info system) for hints
on how and when to report bugs. Also, include the version number of
the Emacs you are running in \fIevery\fR bug report that you send in.
bugs and fixes.
But before reporting something as a bug, please try to be sure that
it really is a bug, not a misunderstanding or a deliberate feature.
We ask you to read the section ``Reporting Emacs Bugs'' near the
end of the reference manual (or Info system) for hints on how and
when to report bugs.
Also, include the version number of the Emacs you are running in
\fIevery\fR bug report that you send in.
Do not expect a personal answer to a bug report. The purpose of reporting
bugs is to get them fixed for everyone in the next release, if possible.
Do not expect a personal answer to a bug report.
The purpose of reporting bugs is to get them fixed for everyone
in the next release, if possible.
For personal assistance, look in the SERVICE file (see above) for
a list of people who offer it.
Please do not send anything but bug reports to this mailing list.
For more information about Emacs mailing lists, see the
file /usr/local/emacs/etc/MAILINGLISTS. Bugs tend actually to be
fixed if they can be isolated, so it is in your interest to report
them in such a way that they can be easily reproduced.
file /usr/local/emacs/etc/MAILINGLISTS.
Bugs tend actually to be fixed if they can be isolated, so it is
in your interest to report them in such a way that they can be
easily reproduced.
.
.
.SH UNRESTRICTIONS
.PP
.I Emacs
is free; anyone may redistribute copies of
.I Emacs
@ -487,25 +698,37 @@ Copies of
.I Emacs
may sometimes be received packaged with distributions of Unix systems,
but it is never included in the scope of any license covering those
systems. Such inclusion violates the terms on which distribution
is permitted. In fact, the primary purpose of the General Public
License is to prohibit anyone from attaching any other restrictions
to redistribution of
.I Emacs.
systems.
Such inclusion violates the terms on which distribution is permitted.
In fact, the primary purpose of the General Public License is to
prohibit anyone from attaching any other restrictions to
redistribution of
.IR Emacs .
.PP
Richard Stallman encourages you to improve and extend
.I Emacs,
.IR Emacs ,
and urges that
you contribute your extensions to the GNU library. Eventually GNU
(Gnu's Not Unix) will be a complete replacement for Unix.
you contribute your extensions to the GNU library.
Eventually GNU (Gnu's Not Unix) will be a complete replacement
for Unix.
Everyone will be free to use, copy, study and change the GNU system.
.
.
.SH SEE ALSO
emacsclient(1), etags(1), X(1), xlsfonts(1), xterm(1), xrdb(1)
.BR emacsclient (1),
.BR etags (1),
.BR X (7),
.BR xlsfonts (1),
.BR xterm (1),
.BR xrdb (1)
.
.
.SH AUTHORS
.PP
.I Emacs
was written by Richard Stallman and the Free Software Foundation.
Joachim Martillo and Robert Krawitz added the X features.
.
.
.SH COPYING
Copyright
.if t \(co
@ -526,5 +749,5 @@ Permission is granted to copy and distribute translations of this
document into another language, under the above conditions for
modified versions, except that this permission notice may be stated
in a translation approved by the Free Software Foundation.
.
.\" arch-tag: 04dfd376-b46e-4924-919a-cecc3b257eaa

315
lisp/ChangeLog
View File

@ -1,7 +1,318 @@
2007-06-16 Karl Fogel <kfogel@red-bean.com>
* thingatpt.el (thing-at-point-email-regexp): Don't require two
chars before the "@" in an email address. Andreas Roehler noticed
this problem.
2007-06-15 Karl Fogel <kfogel@red-bean.com>
* thingatpt.el: Add support for email addresses (`email').
(thing-at-point, bounds-of-thing-at-point): Document `email' support.
(thing-at-point-email-regexp): New variable.
(`email'): Put `bounds-of-thing-at-point' and `thing-at-point'
properties on this symbol, with lambda forms for values.
2007-06-15 Masatake YAMATO <jet@gyve.org>
* vc-bzr.el (vc-bzr-root): Cache the output of shell command
execution.
* vc.el (vc-dired-hook): Check the backend returned from
`vc-responsible-backend' can really handle `subdir'.
2007-06-15 Chong Yidong <cyd@stupidchicken.com>
* wid-edit.el (widget-add-documentation-string-button): Fix
handling of documentation indent.
2007-06-15 Miles Bader <miles@fencepost.gnu.org>
* mb-depth.el: New file.
2007-06-15 Masatake YAMATO <jet@gyve.org>
* vc.el (vc-dired-mode): Show backend name as part of mode name.
2007-06-14 Chong Yidong <cyd@stupidchicken.com>
* wid-edit.el (widget-default-create): Move ?h handling here...
(widget-default-format-handler): ...from here.
(widget-docstring, widget-add-documentation-string-button): New funs.
(documentation-string): Add :visibility-widget property.
(widget-documentation-string-value-create): Use it.
* cus-edit.el (custom-split-regexp-maybe): Simplify.
(custom-buffer-create-internal): Simplify message.
(custom-variable-tag): Reduce height to normal.
(custom-variable-value-create, custom-face-value-create)
(custom-visibility): New widget.
(custom-visibility): New face.
(custom-group-value-create): Call
widget-add-documentation-string-button, using `custom-visibility'.
2007-06-14 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/bytecomp.el (byte-compile-current-group)
(byte-compile-nogroup-warn, byte-compile-file): Revert part of last
change. Apparently the "warning even if the group is implicit" is
a feature rather than a bug.
2007-06-14 Michael Kifer <kifer@cs.stonybrook.edu>
* viper.el (viper-describe-key-ad, viper-describe-key-briefly-ad):
different advices for Emacs and XEmacs. Compile them conditionally.
(viper-version): belated version change.
2007-06-14 Juanma Barranquero <lekktu@gmail.com>
* follow.el (follow-all-followers, follow-generic-filter):
* pcomplete.el (pcomplete-restore-windows):
* x-dnd.el (x-dnd-maybe-call-test-function, x-dnd-save-state)
(x-dnd-drop-data):
* emacs-lisp/edebug.el (edebug-pop-to-buffer, edebug-display):
* progmodes/python.el (python-complete-symbol):
* term/mac-win.el (mac-dnd-drop-data): Remove redundant check.
2007-06-13 Ryan Yeske <rcyeske@gmail.com>
* rcirc.el (rcirc-format-response-string): Use rcirc-nick-syntax
around bright and dim regexps. Make sure bright and dim matches
use word anchors. Send text through rcirc-markup functions.
(rcirc-url-regexp): Add single quote character.
(rcirc-connect): Write logs to disk on auto-save-hook.
Make server a non-optional argument.
(rcirc-log-alist): New variable.
(rcirc-log-directory): Make customizable.
(rcirc-log-flag): New customizable variable.
(rcirc-log): New function.
(rcirc-print): Use above function.
(rcirc-log-write): New function.
(rcirc-generate-new-buffer-name): Strip text properties.
(rcirc-switch-to-buffer-function): Remove variable.
(rcirc-last-non-irc-buffer): Remove variable.
(rcirc-non-irc-buffer): Add function.
(rcirc-next-active-buffer): Use above function.
(rcirc-keepalive): Send KEEPALIVE ctcp instead of a PING.
(rcirc-handler-ctcp-KEEPALIVE): Add handler.
(rcirc-handler-CTCP): Don't print KEEPALIVE responses.
(rcirc-omit-mode): Add minor-mode.
(rcirc-mode-map): Change C-c C-o binding.
(rcirc-mode): Clear mode-line-process. Use a custom
fill-paragraph-function. Set up buffer-invisibility-spec.
(rcirc-response-formats): Remove timestamp code.
(rcirc-omit-responses): Add variable.
(rcirc-print): Don't put the overlay arrow on potentially omitted
lines. Log line to disk. Record activity for private messages
from /dim nicks. Facify the fill-prefix with rcirc-timestamp face.
(rcirc-jump-to-first-unread-line): Print message if there is no
unread text.
(rcirc-clear-unread): New function.
(rcirc-markup-text-functions): Add variable.
(rcirc-markup-timestamp, rcirc-markup-fill): Add functions.
(rcirc-debug): Don't mess with window configuration.
(rcirc-send-message): Send message before printing locally.
Add SILENT argument, do not print message if non-nil.
(rcirc-visible-buffers): New function and variable.
(rcirc-window-configuration-change-1): Add function.
(rcirc-target-buffer): Make sure ACTIONs don't get sent to the
server buffer.
(rcirc-clean-up-buffer): Set rcirc-target to nil when finished.
(rcirc-fill-paragraph): Add function.
(rcirc-record-activity, rcirc-window-configuration-change-1):
Only update the activity string if it has actually changed.
(rcirc-update-activity-string): Remove padding characters from the
mode-line string.
(rcirc-disconnect-buffer): New function to be called when a
channel is parted or the user quits.
(rcirc-server-name): Warn when the server-name hasn't been set.
(rcirc-window-configuration-change): Postpone work until
post-command-hook.
(rcirc-window-configuration-change-1): Update mode-line and
overlay arrows here.
(rcirc-authenticate): Fix chanserv identification.
(rcirc-default-server): Remove variable.
(rcirc): Connect according to rcirc-connections.
(rcirc-connections): Add variable.
(rcirc-startup-channels-alist): Remove variable.
(rcirc-startup-channels): Remove function.
2007-06-13 Stefan Monnier <monnier@iro.umontreal.ca>
* diff-mode.el (diff-font-lock-keywords): Fix M. Kifer's last change.
2007-06-13 Johan Bockg,Ae(Brd <bojohan@dd.chalmers.se> (tiny change)
* term/xterm.el (terminal-init-xterm): Escape parens in character
constants.
2007-06-13 Stefan Monnier <monnier@iro.umontreal.ca>
* progmodes/sh-script.el: Remove unneeded * from docstrings.
Use [:alpha:] and [:alnum:] where applicable.
(sh-quoted-subshell): Rewrite to correctly
handle nested mixes of `...` and $(...).
(sh-apply-quoted-subshell): Remove.
(sh-font-lock-syntactic-keywords): Adjust call to sh-quoted-subshell.
* vc-arch.el (vc-arch-command): Remove bzr. It's a different program.
2007-06-12 Tom Tromey <tromey@redhat.com>
* subr.el (user-emacs-directory): New defconst.
* cmuscheme.el (scheme-start-file):
* shell.el (shell):
* completion.el (save-completions-file-name):
* custom.el (custom-theme-directory):
* term/x-win.el (emacs-session-filename):
* filesets.el (filesets-menu-cache-file):
* thumbs.el (thumbs-thumbsdir):
* server.el (server-auth-dir):
* image-dired.el (image-dired-dir):
(image-dired-db-file):
(image-dired-temp-image-file):
(image-dired-gallery-dir):
(image-dired-temp-rotate-image-file):
* play/gamegrid.el (gamegrid-user-score-file-directory):
* savehist.el (savehist-file):
* tutorial.el (tutorial--saved-dir):
* startup.el (auto-save-list-file-prefix): Use user-emacs-directory.
2007-06-12 Ralf Angeli <angeli@caeruleus.net>
* scroll-lock.el (scroll-lock-mode): Doc fix.
2007-06-12 Michael Kifer <kifer@cs.stonybrook.edu>
* ediff-ptch.el (ediff-context-diff-label-regexp): Spurious parenthesis.
* ediff-init.el: Doc strings.
2007-06-12 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/bytecomp.el (byte-compile-current-group): New var.
(byte-compile-file): Bind it.
(byte-compile-nogroup-warn): Use it to avoid spurious warnings when the
group argument is provided implicitly.
(byte-compile-format-warn, byte-compile-from-buffer)
(byte-compile-insert-header): Don't hardcode point-min==1.
(byte-compile-file-form-require): Remove unused var old-load-list.
(byte-compile-eval): Remove unused vars old-autoloads and hist-nil-new.
2007-06-12 Michael Kifer <kifer@cs.stonybrook.edu>
* emulation/viper-cmd.el (viper-prefix-arg-com, viper-prefix-arg-value):
Display error messages.
(viper-prev-destructive-command, viper-insert-prev-from-insertion-ring):
Get rid of cl.el dependencies.
* emulation/viper-init.el (viper-suppress-input-method-change-message):
New variable.
(viper-activate-input-method-action)
(viper-inactivate-input-method-action):
Use viper-suppress-input-method-change-message.
* emulation/viper-kem.el (viper-vi-basic-map): Disable the bindings
for C-s, C-r.
* emulation/viper-util.el (viper-set-cursor-color-according-to-state):
Use viper-replace-overlay-cursor-color instead of
viper-replace-overlay-cursor-color.
(viper-sit-for-short): Use sit-for with 3 arguments.
* emulation/viper.el (viper-insert-state-mode-list): Add gud-mode.
(viper-major-mode-modifier-list): Add viper-comint-mode-modifier-map
to gud-mode.
* ediff-mult.el (ediff-meta-buffer-brief-message)
(ediff-meta-buffer-verbose-message): New variables.
(ediff-meta-buffer-message): Variable deleted.
(ediff-verbose-help-enabled): New variable.
(ediff-toggle-verbose-help-meta-buffer): New function.
(ediff-redraw-directory-group-buffer): Made aware of short/verbose
message options
* ediff-ptch.el (ediff-context-diff-label-regexp): Better regexp.
(ediff-fixup-patch-map): Improve heuristic.
2007-06-12 Stefan Monnier <monnier@iro.umontreal.ca>
* log-view.el (log-view-file-re, log-view-message-re): Use \(?1:...\).
(log-view-font-lock-keywords): Simplify.
(log-view-current-file, log-view-current-tag): Simplify.
2007-06-12 Sam Steingold <sds@gnu.org>
* vc-arch.el (vc-arch-command): Also try "baz" and "bzr".
2007-06-12 Juanma Barranquero <lekktu@gmail.com>
* desktop.el (desktop-load-locked-desktop): New option.
(desktop-read): Use it.
(desktop-truncate, desktop-outvar, desktop-restore-file-buffer):
Use `when'.
2007-06-12 Davis Herring <herring@lanl.gov>
* desktop.el (desktop-save-mode-off): New function.
(desktop-base-lock-name, desktop-not-loaded-hook): New variables.
(desktop-full-lock-name, desktop-file-modtime, desktop-owner)
(desktop-claim-lock, desktop-release-lock): New functions.
(desktop-kill): Tell `desktop-save' that this is the last save.
Release the lock afterwards.
(desktop-buffer-info): New function.
(desktop-save): Use it. Run `desktop-save-hook' where the doc
says to. Detect conflicts, and manage the lock.
(desktop-read): Detect conflicts. Manage the lock.
2007-06-12 Stefan Monnier <monnier@iro.umontreal.ca>
* emulation/tpu-mapper.el (tpu-emacs-map-key): Use new keymap names.
* emulation/tpu-edt.el (tpu-gold-map): Rename from GOLD-map.
(tpu-lucid-emacs-p): Remove. Use (featurep 'xemacs) instead.
(CSI-map, GOLD-CSI-map, GOLD-SS3-map, SS3-map): Delete vars.
(tpu-gold-map, tpu-global-map): Add all the SS3 and CSI bindings, using
keysyms rather than byte sequences.
(tpu-copy-keyfile): Don't force the user to use tpu-mapper.el.
2007-06-11 Stefan Monnier <monnier@iro.umontreal.ca>
* font-lock.el (font-lock-add-keywords): In case font-lock was only
half-activated, forcefully activate it completely.
2007-06-11 Richard Stallman <rms@gnu.org>
* cus-edit.el (custom-variable-type): Doc fix.
2007-06-11 Stefan Monnier <monnier@iro.umontreal.ca>
* progmodes/sh-script.el (sh-font-lock-backslash-quote)
(sh-font-lock-flush-syntax-ppss-cache): New functions.
(sh-font-lock-syntactic-keywords): Use them to distinguish the
different possible cases for \'.
* complete.el (PC-bindings): Don't bind things already bound in the
parent keymap.
* textmodes/bibtex-style.el: New file.
2007-06-11 Riccardo Murri <riccardo.murri@gmail.com>
* vc-bzr.el: New file.
2007-06-11 Stefan Monnier <monnier@iro.umontreal.ca>
* vc-svn.el (vc-svn-program): New var.
(vc-svn-command): Use it.
2007-06-11 Juanma Barranquero <lekktu@gmail.com>
* server.el (server-switch-buffer): Remove redundant check.
2007-06-10 Martin Rudalics <rudalics@gmx.at>
* emacs-lisp/bytecomp.el (byte-compile-find-cl-functions): Match
against file-name-nondirectory.
* emacs-lisp/bytecomp.el (byte-compile-find-cl-functions):
Match against file-name-nondirectory.
Fix text on user customization variables.
Reported by Johan Bockg,Ae(Brd <bojohan@dd.chalmers.se>.

2
lisp/cmuscheme.el
View File

@ -271,7 +271,7 @@ Search in the directories \"~\" and \"~/.emacs.d\", in this
order. Return nil if no start file found."
(let* ((progname (file-name-nondirectory prog))
(start-file (concat "~/.emacs_" progname))
(alt-start-file (concat "~/.emacs.d/init_" progname ".scm")))
(alt-start-file (concat user-emacs-directory "init_" progname ".scm")))
(if (file-exists-p start-file)
start-file
(and (file-exists-p alt-start-file) alt-start-file))))

9
lisp/complete.el
View File

@ -153,11 +153,8 @@ If nil, means use the colon-separated path in the variable $INCPATH instead."
(define-key completion-map " " 'minibuffer-complete-word)
(define-key completion-map "?" 'minibuffer-completion-help)
(define-key must-match-map "\t" 'minibuffer-complete)
(define-key must-match-map " " 'minibuffer-complete-word)
(define-key must-match-map "\r" 'minibuffer-complete-and-exit)
(define-key must-match-map "\n" 'minibuffer-complete-and-exit)
(define-key must-match-map "?" 'minibuffer-completion-help)
(define-key global-map [remap lisp-complete-symbol] nil))
(PC-default-bindings
@ -173,17 +170,11 @@ If nil, means use the colon-separated path in the variable $INCPATH instead."
(define-key completion-map "\e\n" 'PC-force-complete-and-exit)
(define-key completion-map "\e?" 'PC-completion-help)
(define-key must-match-map "\t" 'PC-complete)
(define-key must-match-map " " 'PC-complete-word)
(define-key must-match-map "\r" 'PC-complete-and-exit)
(define-key must-match-map "\n" 'PC-complete-and-exit)
(define-key must-match-map "?" 'PC-completion-help)
(define-key must-match-map "\e\t" 'PC-complete)
(define-key must-match-map "\e " 'PC-complete-word)
(define-key must-match-map "\e\r" 'PC-complete-and-exit)
(define-key must-match-map "\e\n" 'PC-complete-and-exit)
(define-key must-match-map "\e?" 'PC-completion-help)
(define-key global-map [remap lisp-complete-symbol] 'PC-lisp-complete-symbol)))))

4
lisp/completion.el
View File

@ -301,9 +301,9 @@ See also `save-completions-retention-time'."
(let ((olddef (convert-standard-filename "~/.completions")))
(cond
((file-readable-p olddef) olddef)
((file-directory-p (convert-standard-filename "~/.emacs.d/"))
((file-directory-p user-emacs-directory)
(convert-standard-filename
(expand-file-name "completions" "~/.emacs.d/")))
(expand-file-name "completions" user-emacs-directory)))
(t olddef)))
"The filename to save completions to."
:type 'file

72
lisp/cus-edit.el
View File

@ -501,17 +501,12 @@
(defun custom-split-regexp-maybe (regexp)
"If REGEXP is a string, split it to a list at `\\|'.
You can get the original back with from the result with:
You can get the original back from the result with:
(mapconcat 'identity result \"\\|\")
IF REGEXP is not a string, return it unchanged."
(if (stringp regexp)
(let ((start 0)
all)
(while (string-match "\\\\|" regexp start)
(setq all (cons (substring regexp start (match-beginning 0)) all)
start (match-end 0)))
(nreverse (cons (substring regexp start) all)))
(split-string regexp "\\\\|")
regexp))
(defun custom-variable-prompt ()
@ -1559,18 +1554,15 @@ Editing a setting changes only the text in the buffer."
"Square brackets indicate")))
(if init-file-user
(widget-insert "
Use the setting's State button to set it or save changes in it.
Saving a change normally works by editing your Emacs init file.")
(widget-insert "
\nSince you started Emacs with `-q', which inhibits use of the
Emacs init file, you cannot save settings into the Emacs init file."))
(widget-insert "\nSee ")
Use the Save or Set buttons to set apply your changes.
Saving a change normally works by editing your Emacs ")
(widget-insert "
\nSince you started Emacs with `-q', you cannot save settings into
the Emacs "))
(widget-create 'custom-manual
:tag "Custom file"
:tag "init file"
"(emacs)Saving Customizations")
(widget-insert
" for information on how to save in a different file.\n
See ")
(widget-insert ".\nSee ")
(widget-create 'custom-manual
:tag "Help"
:help-echo "Read the online help."
@ -2439,13 +2431,13 @@ If INITIAL-STRING is non-nil, use that rather than \"Parent groups:\"."
(defface custom-variable-tag
`((((class color)
(background dark))
(:foreground "light blue" :weight bold :height 1.2 :inherit variable-pitch))
(:foreground "light blue" :weight bold :inherit variable-pitch))
(((min-colors 88) (class color)
(background light))
(:foreground "blue1" :weight bold :height 1.2 :inherit variable-pitch))
(:foreground "blue1" :weight bold :inherit variable-pitch))
(((class color)
(background light))
(:foreground "blue" :weight bold :height 1.2 :inherit variable-pitch))
(:foreground "blue" :weight bold :inherit variable-pitch))
(t (:weight bold)))
"Face used for unpushable variable tags."
:group 'custom-faces)
@ -2500,7 +2492,8 @@ However, setting it through Custom sets the default value.")
(defun custom-variable-type (symbol)
"Return a widget suitable for editing the value of SYMBOL.
If SYMBOL has a `custom-type' property, use that.
Otherwise, look up symbol in `custom-guess-type-alist'."
Otherwise, try matching SYMBOL against `custom-guess-name-alist' and
try matching its doc string against `custom-guess-doc-alist'."
(let* ((type (or (get symbol 'custom-type)
(and (not (get symbol 'standard-value))
(custom-guess-type symbol))
@ -2635,15 +2628,11 @@ Otherwise, look up symbol in `custom-guess-type-alist'."
widget 'custom-magic nil)))
(widget-put widget :custom-magic magic)
(push magic buttons))
;; ### NOTE: this is ugly!!!! I need to update the :buttons property
;; before the call to `widget-default-format-handler'. Otherwise, I
;; loose my current `buttons'. This function shouldn't be called like
;; this anyway. The doc string widget should be added like the others.
;; --dv
(widget-put widget :buttons buttons)
(insert "\n")
;; Insert documentation.
(widget-default-format-handler widget ?h)
(widget-add-documentation-string-button
widget :visibility-widget 'custom-visibility)
;; The comment field
(unless (eq state 'hidden)
@ -2983,6 +2972,21 @@ to switch between two values."
;; This call will possibly make the comment invisible
(custom-redraw widget)))
;;; The `custom-visibility' Widget
(define-widget 'custom-visibility 'visibility
"Show or hide a documentation string."
:button-face 'custom-visibility
:pressed-face 'custom-visibility
:mouse-face 'highlight
:pressed-face 'highlight)
(defface custom-visibility
'((t :height 0.8 :inherit link))
"Face for the `custom-visibility' widget."
:version "23.1"
:group 'custom-faces)
;;; The `custom-face-edit' Widget.
(define-widget 'custom-face-edit 'checklist
@ -3354,7 +3358,9 @@ SPEC must be a full face spec."
;; Update buttons.
(widget-put widget :buttons buttons)
;; Insert documentation.
(widget-default-format-handler widget ?h)
(widget-add-documentation-string-button
widget :visibility-widget 'custom-visibility)
;; The comment field
(unless (eq state 'hidden)
(let* ((comment (get symbol 'face-comment))
@ -3926,7 +3932,9 @@ If GROUPS-ONLY non-nil, return only those members that are groups."
;; Insert documentation.
(if (and (eq custom-buffer-style 'links) (> level 1))
(widget-put widget :documentation-indent 0))
(widget-default-format-handler widget ?h))
(widget-add-documentation-string-button
widget :visibility-widget 'custom-visibility))
;; Nested style.
(t ;Visible.
;; Add parent groups references above the group.
@ -3934,7 +3942,7 @@ If GROUPS-ONLY non-nil, return only those members that are groups."
;;; was made to display a group.
(when (eq level 1)
(if (custom-add-parent-links widget
"Go to parent group:")
"Parent group:")
(insert "\n"))))
;; Create level indicator.
(insert-char ?\ (* custom-buffer-indent (1- level)))
@ -3970,7 +3978,9 @@ If GROUPS-ONLY non-nil, return only those members that are groups."
;; Update buttons.
(widget-put widget :buttons buttons)
;; Insert documentation.
(widget-default-format-handler widget ?h)
(widget-add-documentation-string-button
widget :visibility-widget 'custom-visibility)
;; Parent groups.
(if nil ;;; This should test that the buffer
;;; was not made to display a group.

5
lisp/custom.el
View File

@ -1009,10 +1009,7 @@ Every theme X has a property `provide-theme' whose value is \"X-theme\".
;;; Loading themes.
(defcustom custom-theme-directory
(if (eq system-type 'ms-dos)
;; MS-DOS cannot have initial dot.
"~/_emacs.d/"
"~/.emacs.d/")
user-emacs-directory
"Directory in which Custom theme files should be written.
`load-theme' searches this directory in addition to load-path.
The command `customize-create-theme' writes the files it produces

564
lisp/desktop.el
View File

@ -162,6 +162,10 @@ and function `desktop-read' for details."
(define-obsolete-variable-alias 'desktop-enable
'desktop-save-mode "22.1")
(defun desktop-save-mode-off ()
"Disable `desktop-save-mode'. Provided for use in hooks."
(desktop-save-mode 0))
(defcustom desktop-save 'ask-if-new
"*Specifies whether the desktop should be saved when it is killed.
A desktop is killed when the user changes desktop or quits Emacs.
@ -186,6 +190,22 @@ determine where the desktop is saved."
:group 'desktop
:version "22.1")
(defcustom desktop-load-locked-desktop 'ask
"Specifies whether the desktop should be loaded if locked.
Possible values are:
t -- load anyway.
nil -- don't load.
ask -- ask the user.
If the value is nil, or `ask' and the user chooses not to load the desktop,
the normal hook `desktop-not-loaded-hook' is run."
:type
'(choice
(const :tag "Load anyway" t)
(const :tag "Don't load" nil)
(const :tag "Ask the user" ask))
:group 'desktop
:version "23.1")
(defcustom desktop-base-file-name
(convert-standard-filename ".emacs.desktop")
"Name of file for Emacs desktop, excluding the directory part."
@ -194,6 +214,13 @@ determine where the desktop is saved."
(define-obsolete-variable-alias 'desktop-basefilename
'desktop-base-file-name "22.1")
(defcustom desktop-base-lock-name
(convert-standard-filename ".emacs.desktop.lock")
"Name of lock file for Emacs desktop, excluding the directory part."
:type 'file
:group 'desktop
:version "23.1")
(defcustom desktop-path '("." "~")
"List of directories to search for the desktop file.
The base name of the file is specified in `desktop-base-file-name'."
@ -219,6 +246,15 @@ May be used to show a dired buffer."
:group 'desktop
:version "22.1")
(defcustom desktop-not-loaded-hook nil
"Normal hook run when the user declines to re-use a desktop file.
Run in the directory in which the desktop file was found.
May be used to deal with accidental multiple Emacs jobs."
:type 'hook
:group 'desktop
:options '(desktop-save-mode-off save-buffers-kill-emacs)
:version "23.1")
(defcustom desktop-after-read-hook nil
"Normal hook run after a successful `desktop-read'.
May be used to show a buffer list."
@ -486,6 +522,11 @@ See also `desktop-minor-mode-table'.")
DIRNAME omitted or nil means use `desktop-dirname'."
(expand-file-name desktop-base-file-name (or dirname desktop-dirname)))
(defun desktop-full-lock-name (&optional dirname)
"Return the full name of the desktop lock file in DIRNAME.
DIRNAME omitted or nil means use `desktop-dirname'."
(expand-file-name desktop-base-lock-name (or dirname desktop-dirname)))
(defconst desktop-header
";; --------------------------------------------------------------------------
;; Desktop File for Emacs
@ -495,12 +536,45 @@ DIRNAME omitted or nil means use `desktop-dirname'."
(defvar desktop-delay-hook nil
"Hooks run after all buffers are loaded; intended for internal use.")
;; ----------------------------------------------------------------------------
;; Desktop file conflict detection
(defvar desktop-file-modtime nil
"When the desktop file was last modified to the knowledge of this Emacs.
Used to detect desktop file conflicts.")
(defun desktop-owner (&optional dirname)
"Return the PID of the Emacs process that owns the desktop file in DIRNAME.
Return nil if no desktop file found or no Emacs process is using it.
DIRNAME omitted or nil means use `desktop-dirname'."
(let (owner)
(and (file-exists-p (desktop-full-lock-name dirname))
(condition-case nil
(with-temp-buffer
(insert-file-contents-literally (desktop-full-lock-name dirname))
(goto-char (point-min))
(setq owner (read (current-buffer)))
(integerp owner))
(error nil))
owner)))
(defun desktop-claim-lock (&optional dirname)
"Record this Emacs process as the owner of the desktop file in DIRNAME.
DIRNAME omitted or nil means use `desktop-dirname'."
(write-region (number-to-string (emacs-pid)) nil
(desktop-full-lock-name dirname)))
(defun desktop-release-lock (&optional dirname)
"Remove the lock file for the desktop in DIRNAME.
DIRNAME omitted or nil means use `desktop-dirname'."
(let ((file (desktop-full-lock-name dirname)))
(when (file-exists-p file) (delete-file file))))
;; ----------------------------------------------------------------------------
(defun desktop-truncate (list n)
"Truncate LIST to at most N elements destructively."
(let ((here (nthcdr (1- n) list)))
(if (consp here)
(setcdr here nil))))
(when (consp here)
(setcdr here nil))))
;; ----------------------------------------------------------------------------
;;;###autoload
@ -513,7 +587,7 @@ Furthermore, it clears the variables listed in `desktop-globals-to-clear'."
(desktop-lazy-abort)
(dolist (var desktop-globals-to-clear)
(if (symbolp var)
(eval `(setq-default ,var nil))
(eval `(setq-default ,var nil))
(eval `(setq-default ,(car var) ,(cdr var)))))
(let ((buffers (buffer-list))
(preserve-regexp (concat "^\\("
@ -556,10 +630,12 @@ is nil, ask the user where to save the desktop."
(lambda (dir)
(interactive "DDirectory for desktop file: ") dir))))))
(condition-case err
(desktop-save desktop-dirname)
(desktop-save desktop-dirname t)
(file-error
(unless (yes-or-no-p "Error while saving the desktop. Ignore? ")
(signal (car err) (cdr err)))))))
(signal (car err) (cdr err))))))
;; If we own it, we don't anymore.
(when (eq (emacs-pid) (desktop-owner)) (desktop-release-lock)))
;; ----------------------------------------------------------------------------
(defun desktop-list* (&rest args)
@ -573,6 +649,46 @@ is nil, ask the user where to save the desktop."
(setq args (cdr args)))
value)))
;; ----------------------------------------------------------------------------
(defun desktop-buffer-info (buffer)
(set-buffer buffer)
(list
;; basic information
(desktop-file-name (buffer-file-name) dirname)
(buffer-name)
major-mode
;; minor modes
(let (ret)
(mapc
#'(lambda (minor-mode)
(and (boundp minor-mode)
(symbol-value minor-mode)
(let* ((special (assq minor-mode desktop-minor-mode-table))
(value (cond (special (cadr special))
((functionp minor-mode) minor-mode))))
(when value (add-to-list 'ret value)))))
(mapcar #'car minor-mode-alist))
ret)
;; point and mark, and read-only status
(point)
(list (mark t) mark-active)
buffer-read-only
;; auxiliary information
(when (functionp desktop-save-buffer)
(funcall desktop-save-buffer dirname))
;; local variables
(let ((locals desktop-locals-to-save)
(loclist (buffer-local-variables))
(ll))
(while locals
(let ((here (assq (car locals) loclist)))
(if here
(setq ll (cons here ll))
(when (member (car locals) loclist)
(setq ll (cons (car locals) ll)))))
(setq locals (cdr locals)))
ll)))
;; ----------------------------------------------------------------------------
(defun desktop-internal-v2s (value)
"Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE.
@ -580,77 +696,77 @@ TXT is a string that when read and evaluated yields value.
QUOTE may be `may' (value may be quoted),
`must' (values must be quoted), or nil (value may not be quoted)."
(cond
((or (numberp value) (null value) (eq t value) (keywordp value))
(cons 'may (prin1-to-string value)))
((stringp value)
(let ((copy (copy-sequence value)))
(set-text-properties 0 (length copy) nil copy)
;; Get rid of text properties because we cannot read them
(cons 'may (prin1-to-string copy))))
((symbolp value)
(cons 'must (prin1-to-string value)))
((vectorp value)
(let* ((special nil)
(pass1 (mapcar
(lambda (el)
(let ((res (desktop-internal-v2s el)))
(if (null (car res))
(setq special t))
res))
value)))
(if special
(cons nil (concat "(vector "
(mapconcat (lambda (el)
(if (eq (car el) 'must)
(concat "'" (cdr el))
(cdr el)))
pass1
" ")
")"))
(cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]")))))
((consp value)
(let ((p value)
newlist
use-list*
anynil)
(while (consp p)
(let ((q.txt (desktop-internal-v2s (car p))))
(or anynil (setq anynil (null (car q.txt))))
(setq newlist (cons q.txt newlist)))
(setq p (cdr p)))
(if p
(let ((last (desktop-internal-v2s p)))
(or anynil (setq anynil (null (car last))))
(or anynil
(setq newlist (cons '(must . ".") newlist)))
(setq use-list* t)
(setq newlist (cons last newlist))))
(setq newlist (nreverse newlist))
(if anynil
(cons nil
(concat (if use-list* "(desktop-list* " "(list ")
(mapconcat (lambda (el)
(if (eq (car el) 'must)
(concat "'" (cdr el))
(cdr el)))
newlist
" ")
")"))
(cons 'must
(concat "(" (mapconcat 'cdr newlist " ") ")")))))
((subrp value)
(cons nil (concat "(symbol-function '"
(substring (prin1-to-string value) 7 -1)
")")))
((markerp value)
(let ((pos (prin1-to-string (marker-position value)))
(buf (prin1-to-string (buffer-name (marker-buffer value)))))
(cons nil (concat "(let ((mk (make-marker)))"
" (add-hook 'desktop-delay-hook"
" (list 'lambda '() (list 'set-marker mk "
pos " (get-buffer " buf ")))) mk)"))))
(t ; save as text
(cons 'may "\"Unprintable entity\""))))
((or (numberp value) (null value) (eq t value) (keywordp value))
(cons 'may (prin1-to-string value)))
((stringp value)
(let ((copy (copy-sequence value)))
(set-text-properties 0 (length copy) nil copy)
;; Get rid of text properties because we cannot read them
(cons 'may (prin1-to-string copy))))
((symbolp value)
(cons 'must (prin1-to-string value)))
((vectorp value)
(let* ((special nil)
(pass1 (mapcar
(lambda (el)
(let ((res (desktop-internal-v2s el)))
(if (null (car res))
(setq special t))
res))
value)))
(if special
(cons nil (concat "(vector "
(mapconcat (lambda (el)
(if (eq (car el) 'must)
(concat "'" (cdr el))
(cdr el)))
pass1
" ")
")"))
(cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]")))))
((consp value)
(let ((p value)
newlist
use-list*
anynil)
(while (consp p)
(let ((q.txt (desktop-internal-v2s (car p))))
(or anynil (setq anynil (null (car q.txt))))
(setq newlist (cons q.txt newlist)))
(setq p (cdr p)))
(if p
(let ((last (desktop-internal-v2s p)))
(or anynil (setq anynil (null (car last))))
(or anynil
(setq newlist (cons '(must . ".") newlist)))
(setq use-list* t)
(setq newlist (cons last newlist))))
(setq newlist (nreverse newlist))
(if anynil
(cons nil
(concat (if use-list* "(desktop-list* " "(list ")
(mapconcat (lambda (el)
(if (eq (car el) 'must)
(concat "'" (cdr el))
(cdr el)))
newlist
" ")
")"))
(cons 'must
(concat "(" (mapconcat 'cdr newlist " ") ")")))))
((subrp value)
(cons nil (concat "(symbol-function '"
(substring (prin1-to-string value) 7 -1)
")")))
((markerp value)
(let ((pos (prin1-to-string (marker-position value)))
(buf (prin1-to-string (buffer-name (marker-buffer value)))))
(cons nil (concat "(let ((mk (make-marker)))"
" (add-hook 'desktop-delay-hook"
" (list 'lambda '() (list 'set-marker mk "
pos " (get-buffer " buf ")))) mk)"))))
(t ; save as text
(cons 'may "\"Unprintable entity\""))))
;; ----------------------------------------------------------------------------
(defun desktop-value-to-string (value)
@ -676,17 +792,16 @@ which means to truncate VAR's value to at most MAX-SIZE elements
(if (consp varspec)
(setq var (car varspec) size (cdr varspec))
(setq var varspec))
(if (boundp var)
(progn
(if (and (integerp size)
(> size 0)
(listp (eval var)))
(desktop-truncate (eval var) size))
(insert "(setq "
(symbol-name var)
" "
(desktop-value-to-string (symbol-value var))
")\n")))))
(when (boundp var)
(when (and (integerp size)
(> size 0)
(listp (eval var)))
(desktop-truncate (eval var) size))
(insert "(setq "
(symbol-name var)
" "
(desktop-value-to-string (symbol-value var))
")\n"))))
;; ----------------------------------------------------------------------------
(defun desktop-save-buffer-p (filename bufname mode &rest dummy)
@ -724,90 +839,70 @@ DIRNAME must be the directory in which the desktop file will be saved."
;; ----------------------------------------------------------------------------
;;;###autoload
(defun desktop-save (dirname)
(defun desktop-save (dirname &optional release)
"Save the desktop in a desktop file.
Parameter DIRNAME specifies where to save the desktop file.
Optional parameter RELEASE says whether we're done with this desktop.
See also `desktop-base-file-name'."
(interactive "DDirectory to save desktop file in: ")
(run-hooks 'desktop-save-hook)
(setq dirname (file-name-as-directory (expand-file-name dirname)))
(setq desktop-dirname (file-name-as-directory (expand-file-name dirname)))
(save-excursion
(let ((filename (desktop-full-file-name dirname))
(info
(mapcar
#'(lambda (b)
(set-buffer b)
(list
(desktop-file-name (buffer-file-name) dirname)
(buffer-name)
major-mode
;; minor modes
(let (ret)
(mapc
#'(lambda (minor-mode)
(and
(boundp minor-mode)
(symbol-value minor-mode)
(let* ((special (assq minor-mode desktop-minor-mode-table))
(value (cond (special (cadr special))
((functionp minor-mode) minor-mode))))
(when value (add-to-list 'ret value)))))
(mapcar #'car minor-mode-alist))
ret)
(point)
(list (mark t) mark-active)
buffer-read-only
;; Auxiliary information
(when (functionp desktop-save-buffer)
(funcall desktop-save-buffer dirname))
(let ((locals desktop-locals-to-save)
(loclist (buffer-local-variables))
(ll))
(while locals
(let ((here (assq (car locals) loclist)))
(if here
(setq ll (cons here ll))
(when (member (car locals) loclist)
(setq ll (cons (car locals) ll)))))
(setq locals (cdr locals)))
ll)))
(buffer-list)))
(eager desktop-restore-eager))
(with-temp-buffer
(insert
";; -*- mode: emacs-lisp; coding: emacs-mule; -*-\n"
desktop-header
";; Created " (current-time-string) "\n"
";; Desktop file format version " desktop-file-version "\n"
";; Emacs version " emacs-version "\n\n"
";; Global section:\n")
(dolist (varspec desktop-globals-to-save)
(desktop-outvar varspec))
(if (memq 'kill-ring desktop-globals-to-save)
(insert
"(setq kill-ring-yank-pointer (nthcdr "
(int-to-string (- (length kill-ring) (length kill-ring-yank-pointer)))
" kill-ring))\n"))
(let ((eager desktop-restore-eager)
(new-modtime (nth 5 (file-attributes (desktop-full-file-name)))))
(when
(or (not new-modtime) ; nothing to overwrite
(equal desktop-file-modtime new-modtime)
(yes-or-no-p (if desktop-file-modtime
(if (> (float-time new-modtime) (float-time desktop-file-modtime))
"Desktop file is more recent than the one loaded. Save anyway? "
"Desktop file isn't the one loaded. Overwrite it? ")
"Current desktop was not loaded from a file. Overwrite this desktop file? "))
(unless release (error "Desktop file conflict")))
(insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n")
(dolist (l info)
(when (apply 'desktop-save-buffer-p l)
(insert "("
(if (or (not (integerp eager))
(unless (zerop eager)
(setq eager (1- eager))
t))
"desktop-create-buffer"
"desktop-append-buffer-args")
" "
desktop-file-version)
(dolist (e l)
(insert "\n " (desktop-value-to-string e)))
(insert ")\n\n")))
(setq default-directory dirname)
(let ((coding-system-for-write 'emacs-mule))
(write-region (point-min) (point-max) filename nil 'nomessage)))))
(setq desktop-dirname dirname))
;; If we're done with it, release the lock.
;; Otherwise, claim it if it's unclaimed or if we created it.
(if release
(desktop-release-lock)
(unless (and new-modtime (desktop-owner)) (desktop-claim-lock)))
(with-temp-buffer
(insert
";; -*- mode: emacs-lisp; coding: emacs-mule; -*-\n"
desktop-header
";; Created " (current-time-string) "\n"
";; Desktop file format version " desktop-file-version "\n"
";; Emacs version " emacs-version "\n")
(save-excursion (run-hooks 'desktop-save-hook))
(goto-char (point-max))
(insert "\n;; Global section:\n")
(mapc (function desktop-outvar) desktop-globals-to-save)
(when (memq 'kill-ring desktop-globals-to-save)
(insert
"(setq kill-ring-yank-pointer (nthcdr "
(int-to-string (- (length kill-ring) (length kill-ring-yank-pointer)))
" kill-ring))\n"))
(insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n")
(dolist (l (mapcar 'desktop-buffer-info (buffer-list)))
(when (apply 'desktop-save-buffer-p l)
(insert "("
(if (or (not (integerp eager))
(if (zerop eager)
nil
(setq eager (1- eager))))
"desktop-create-buffer"
"desktop-append-buffer-args")
" "
desktop-file-version)
(dolist (e l)
(insert "\n " (desktop-value-to-string e)))
(insert ")\n\n")))
(setq default-directory dirname)
(let ((coding-system-for-write 'emacs-mule))
(write-region (point-min) (point-max) (desktop-full-file-name) nil 'nomessage))
;; We remember when it was modified (which is presumably just now).
(setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name)))))))))
;; ----------------------------------------------------------------------------
;;;###autoload
@ -856,35 +951,56 @@ It returns t if a desktop file was loaded, nil otherwise."
;; Default: Home directory.
"~"))))
(if (file-exists-p (desktop-full-file-name))
;; Desktop file found, process it.
(let ((desktop-first-buffer nil)
(desktop-buffer-ok-count 0)
(desktop-buffer-fail-count 0)
;; Avoid desktop saving during evaluation of desktop buffer.
(desktop-save nil))
(desktop-lazy-abort)
;; Evaluate desktop buffer.
(load (desktop-full-file-name) t t t)
;; `desktop-create-buffer' puts buffers at end of the buffer list.
;; We want buffers existing prior to evaluating the desktop (and not reused)
;; to be placed at the end of the buffer list, so we move them here.
(mapc 'bury-buffer
(nreverse (cdr (memq desktop-first-buffer (nreverse (buffer-list))))))
(switch-to-buffer (car (buffer-list)))
(run-hooks 'desktop-delay-hook)
(setq desktop-delay-hook nil)
(run-hooks 'desktop-after-read-hook)
(message "Desktop: %d buffer%s restored%s%s."
desktop-buffer-ok-count
(if (= 1 desktop-buffer-ok-count) "" "s")
(if (< 0 desktop-buffer-fail-count)
(format ", %d failed to restore" desktop-buffer-fail-count)
"")
(if desktop-buffer-args-list
(format ", %d to restore lazily"
(length desktop-buffer-args-list))
""))
t)
;; Desktop file found, but is it already in use?
(let ((desktop-first-buffer nil)
(desktop-buffer-ok-count 0)
(desktop-buffer-fail-count 0)
(owner (desktop-owner))
;; Avoid desktop saving during evaluation of desktop buffer.
(desktop-save nil))
(if (and owner
(memq desktop-load-locked-desktop '(nil ask))
(or (null desktop-load-locked-desktop)
(not (y-or-n-p (format "Warning: desktop file appears to be in use by PID %s.\n\
Using it may cause conflicts. Use it anyway? " owner)))))
(progn
(setq desktop-dirname nil)
(let ((default-directory desktop-dirname))
(run-hooks 'desktop-not-loaded-hook))
(message "Desktop file in use; not loaded."))
(desktop-lazy-abort)
;; Evaluate desktop buffer and remember when it was modified.
(load (desktop-full-file-name) t t t)
(setq desktop-file-modtime (nth 5 (file-attributes (desktop-full-file-name))))
;; If it wasn't already, mark it as in-use, to bother other
;; desktop instances.
(unless owner
(condition-case nil
(desktop-claim-lock)
(file-error (message "Couldn't record use of desktop file")
(sit-for 1))))
;; `desktop-create-buffer' puts buffers at end of the buffer list.
;; We want buffers existing prior to evaluating the desktop (and
;; not reused) to be placed at the end of the buffer list, so we
;; move them here.
(mapc 'bury-buffer
(nreverse (cdr (memq desktop-first-buffer (nreverse (buffer-list))))))
(switch-to-buffer (car (buffer-list)))
(run-hooks 'desktop-delay-hook)
(setq desktop-delay-hook nil)
(run-hooks 'desktop-after-read-hook)
(message "Desktop: %d buffer%s restored%s%s."
desktop-buffer-ok-count
(if (= 1 desktop-buffer-ok-count) "" "s")
(if (< 0 desktop-buffer-fail-count)
(format ", %d failed to restore" desktop-buffer-fail-count)
"")
(if desktop-buffer-args-list
(format ", %d to restore lazily"
(length desktop-buffer-args-list))
""))
t))
;; No desktop file found.
(desktop-clear)
(let ((default-directory desktop-dirname))
@ -946,28 +1062,28 @@ directory DIRNAME."
desktop-buffer-name
desktop-buffer-misc)
"Restore a file buffer."
(if desktop-buffer-file-name
(if (or (file-exists-p desktop-buffer-file-name)
(let ((msg (format "Desktop: File \"%s\" no longer exists."
desktop-buffer-file-name)))
(if desktop-missing-file-warning
(y-or-n-p (concat msg " Re-create buffer? "))
(message "%s" msg)
nil)))
(let* ((auto-insert nil) ; Disable auto insertion
(coding-system-for-read
(or coding-system-for-read
(cdr (assq 'buffer-file-coding-system
desktop-buffer-locals))))
(buf (find-file-noselect desktop-buffer-file-name)))
(condition-case nil
(switch-to-buffer buf)
(error (pop-to-buffer buf)))
(and (not (eq major-mode desktop-buffer-major-mode))
(functionp desktop-buffer-major-mode)
(funcall desktop-buffer-major-mode))
buf)
nil)))
(when desktop-buffer-file-name
(if (or (file-exists-p desktop-buffer-file-name)
(let ((msg (format "Desktop: File \"%s\" no longer exists."
desktop-buffer-file-name)))
(if desktop-missing-file-warning
(y-or-n-p (concat msg " Re-create buffer? "))
(message "%s" msg)
nil)))
(let* ((auto-insert nil) ; Disable auto insertion
(coding-system-for-read
(or coding-system-for-read
(cdr (assq 'buffer-file-coding-system
desktop-buffer-locals))))
(buf (find-file-noselect desktop-buffer-file-name)))
(condition-case nil
(switch-to-buffer buf)
(error (pop-to-buffer buf)))
(and (not (eq major-mode desktop-buffer-major-mode))
(functionp desktop-buffer-major-mode)
(funcall desktop-buffer-major-mode))
buf)
nil)))
(defun desktop-load-file (function)
"Load the file where auto loaded FUNCTION is defined."
@ -1062,19 +1178,19 @@ directory DIRNAME."
(error (message "%s" (error-message-string err)) 1))))
(when desktop-buffer-mark
(if (consp desktop-buffer-mark)
(progn
(set-mark (car desktop-buffer-mark))
(setq mark-active (car (cdr desktop-buffer-mark))))
(progn
(set-mark (car desktop-buffer-mark))
(setq mark-active (car (cdr desktop-buffer-mark))))
(set-mark desktop-buffer-mark)))
;; Never override file system if the file really is read-only marked.
(if desktop-buffer-read-only (setq buffer-read-only desktop-buffer-read-only))
(when desktop-buffer-read-only (setq buffer-read-only desktop-buffer-read-only))
(while desktop-buffer-locals
(let ((this (car desktop-buffer-locals)))
(if (consp this)
;; an entry of this form `(symbol . value)'
(progn
(make-local-variable (car this))
(set (car this) (cdr this)))
;; an entry of this form `(symbol . value)'
(progn
(make-local-variable (car this))
(set (car this) (cdr this)))
;; an entry of the form `symbol'
(make-local-variable this)
(makunbound this)))

2
lisp/diff-mode.el
View File

@ -338,7 +338,7 @@ when editing big diffs)."
("^--- .+ ----$" . diff-hunk-header-face) ;context
("^[0-9,]+[acd][0-9,]+$" . diff-hunk-header-face) ;normal
("^---$" . diff-hunk-header-face) ;normal
("^\\(---\\|\\+\\+\\+\\|\\*\\*\\*\\) \\(\\S-+\\)\\(.*[^*-]\\)?\n"
("^\\(---\\|\\+\\+\\+\\|\\*\\*\\*\\) \\([^ \t]+\\)\\(.*[^*-]\\)?\n"
(0 diff-header-face) (2 diff-file-header-face prepend))
("^\\([-<]\\)\\(.*\n\\)"
(1 diff-indicator-removed-face) (2 diff-removed-face))

4
lisp/ediff-init.el
View File

@ -102,7 +102,7 @@ that Ediff doesn't know about.")
(boundp 'ediff-use-toolbar-p)
ediff-use-toolbar-p)) ;Does the user want it ?
;; Defines SYMBOL as an advertised local variable.
;; Defines VAR as an advertised local variable.
;; Performs a defvar, then executes `make-variable-buffer-local' on
;; the variable. Also sets the `permanent-local' property,
;; so that `kill-all-local-variables' (called by major-mode setting
@ -110,6 +110,7 @@ that Ediff doesn't know about.")
;;
;; Plagiarised from `emerge-defvar-local' for XEmacs.
(defmacro ediff-defvar-local (var value doc)
"Defines VAR as a local variable."
(declare (indent defun))
`(progn
(defvar ,var ,value ,doc)
@ -259,6 +260,7 @@ It needs to be killed when we quit the session.")
;; Doesn't save the point and mark.
;; This is `with-current-buffer' with the added test for live buffers."
(defmacro ediff-with-current-buffer (buffer &rest body)
"Evaluates BODY in BUFFER."
(declare (indent 1) (debug (form body)))
`(if (ediff-buffer-live-p ,buffer)
(save-current-buffer

62
lisp/ediff-mult.el
View File

@ -129,9 +129,15 @@
;; the registry buffer
(defvar ediff-registry-buffer nil)
(defconst ediff-meta-buffer-message "This is an Ediff Session Group Panel: %s
(defconst ediff-meta-buffer-brief-message "Ediff Session Group Panel: %s
Useful commands:
Type ? to show useful commands in this buffer
")
(defconst ediff-meta-buffer-verbose-message "Ediff Session Group Panel: %s
Useful commands (type ? to hide them and free up screen):
button2, v, or RET over session record: start that Ediff session
M:\tin sessions invoked from here, brings back this group panel
R:\tdisplay the registry of active Ediff sessions
@ -360,10 +366,24 @@ buffers."
(if (stringp (ediff-get-session-objC-name session-info))
(file-directory-p (ediff-get-session-objC-name session-info)) t)))
(ediff-defvar-local ediff-verbose-help-enabled nil
"If t, display redundant help in ediff-directories and other meta buffers.
Toggled by ediff-toggle-verbose-help-meta-buffer" )
;; Toggle verbose help in meta-buffers
;; TODO: Someone who understands all this can make it better.
(defun ediff-toggle-verbose-help-meta-buffer ()
"Toggle showing tediously verbose help in meta buffers."
(interactive)
(setq ediff-verbose-help-enabled (not ediff-verbose-help-enabled))
(ediff-update-meta-buffer (current-buffer) 'must-redraw))
;; set up the keymap in the meta buffer
(defun ediff-setup-meta-map ()
(setq ediff-meta-buffer-map (make-sparse-keymap))
(suppress-keymap ediff-meta-buffer-map)
(define-key ediff-meta-buffer-map "?" 'ediff-toggle-verbose-help-meta-buffer)
(define-key ediff-meta-buffer-map "q" 'ediff-quit-meta-buffer)
(define-key ediff-meta-buffer-map "T" 'ediff-toggle-filename-truncation)
(define-key ediff-meta-buffer-map "R" 'ediff-show-registry)
@ -924,27 +944,31 @@ behavior."
(mapcar 'delete-overlay (overlays-in 1 1)) ; emacs
)
(insert (format ediff-meta-buffer-message
(ediff-abbrev-jobname ediff-metajob-name)))
(setq regexp (ediff-get-group-regexp meta-list)
merge-autostore-dir
(ediff-get-group-merge-autostore-dir meta-list))
(cond ((ediff-collect-diffs-metajob)
(insert
" P:\tcollect custom diffs of all marked sessions\n"))
((ediff-patch-metajob)
(insert
" P:\tshow patch appropriately for the context (session or group)\n")))
(insert
" ^:\tshow parent session group\n")
(or (ediff-one-filegroup-metajob)
(insert
" D:\tshow differences among directories\n"
" ==:\tfor each session, show which files are identical\n"
" =h:\tlike ==, but also marks those sessions for hiding\n"
" =m:\tlike ==, but also marks those sessions for operation\n\n"))
(if ediff-verbose-help-enabled
(progn
(insert (format ediff-meta-buffer-verbose-message
(ediff-abbrev-jobname ediff-metajob-name)))
(cond ((ediff-collect-diffs-metajob)
(insert
" P:\tcollect custom diffs of all marked sessions\n"))
((ediff-patch-metajob)
(insert
" P:\tshow patch appropriately for the context (session or group)\n")))
(insert
" ^:\tshow parent session group\n")
(or (ediff-one-filegroup-metajob)
(insert
" D:\tshow differences among directories\n"
" ==:\tfor each session, show which files are identical\n"
" =h:\tlike ==, but also marks sessions for hiding\n"
" =m:\tlike ==, but also marks sessions for operation\n\n")))
(insert (format ediff-meta-buffer-brief-message
(ediff-abbrev-jobname ediff-metajob-name))))
(insert "\n")
(if (and (stringp regexp) (> (length regexp) 0))

21
lisp/ediff-ptch.el
View File

@ -134,11 +134,13 @@ patch. So, don't change these variables, unless the default doesn't work."
:type '(choice (const nil) string)
:group 'ediff-ptch)
;; This context diff does not recognize spaces inside files, but removing ' '
;; from [^ \t] breaks normal patches for some reason
(defcustom ediff-context-diff-label-regexp
(concat "\\(" ; context diff 2-liner
"^\\*\\*\\* \\([^ \t]+\\)[^*]+[\t ]*\n--- \\([^ \t]+\\)"
"^\\*\\*\\* +\\([^ \t]+\\)[^*]+[\t ]*\n--- +\\([^ \t]+\\)"
"\\|" ; GNU unified format diff 2-liner
"^--- \\([^ \t]+\\)[\t ]+.*\n\\+\\+\\+ \\([^ \t]+\\)"
"^--- +\\([^ \t]+\\)[\t ]+.*\n\\+\\+\\+ +\\([^ \t]+\\)"
"\\)")
"*Regexp matching filename 2-liners at the start of each context diff.
You probably don't want to change that, unless you are using an obscure patch
@ -231,7 +233,7 @@ program."
;; possible-file-names is holding the new file names until we
;; insert the old file name in the patch map
;; It is a pair
;; (filename-from-1st-header-line . fn from 2nd line)
;; (filename-from-1st-header-line . filename-from-2nd-line)
(setq possible-file-names
(cons (if (and beg1 end1)
(buffer-substring beg1 end1)
@ -309,12 +311,13 @@ program."
;; these dirs lead to the actual files starting at the present
;; directory. So, we don't strip these relative dirs from the
;; file names. This is a heuristic intended to improve guessing
(unless (or (file-name-absolute-p base-dir1)
(file-name-absolute-p base-dir2)
(not (file-exists-p base-dir1))
(not (file-exists-p base-dir2)))
(setq base-dir1 ""
base-dir2 ""))
(let ((default-directory (file-name-directory filename)))
(unless (or (file-name-absolute-p base-dir1)
(file-name-absolute-p base-dir2)
(not (file-exists-p base-dir1))
(not (file-exists-p base-dir2)))
(setq base-dir1 ""
base-dir2 "")))
(or (string= (car proposed-file-names) "/dev/null")
(setcar proposed-file-names
(ediff-file-name-sans-prefix

4
lisp/ediff.el
View File

@ -7,8 +7,8 @@
;; Created: February 2, 1994
;; Keywords: comparing, merging, patching, tools, unix
(defconst ediff-version "2.81.1" "The current version of Ediff")
(defconst ediff-date "October 23, 2006" "Date of last update")
(defconst ediff-version "2.81.2" "The current version of Ediff")
(defconst ediff-date "June 13, 2007" "Date of last update")
;; This file is part of GNU Emacs.

47
lisp/emacs-lisp/bytecomp.el
View File

@ -853,13 +853,11 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'."
(when (and (consp s) (eq t (car s)))
(push (cdr s) old-autoloads)))))))
(when (memq 'cl-functions byte-compile-warnings)
(let ((hist-new load-history)
(hist-nil-new current-load-list))
(let ((hist-new load-history))
;; Go through load-history, look for newly loaded files
;; and mark all the functions defined therein.
(while (and hist-new (not (eq hist-new hist-orig)))
(let ((xs (pop hist-new))
old-autoloads)
(let ((xs (pop hist-new)))
;; Make sure the file was not already loaded before.
(when (and (equal (car xs) "cl") (not (assoc (car xs) hist-orig)))
(byte-compile-find-cl-functions)))))))))
@ -1265,7 +1263,7 @@ extra args."
(get (car form) 'byte-compile-format-like))
(let ((nfields (with-temp-buffer
(insert (nth 1 form))
(goto-char 1)
(goto-char (point-min))
(let ((n 0))
(while (re-search-forward "%." nil t)
(unless (eq ?% (char-after (1+ (match-beginning 0))))
@ -1283,19 +1281,19 @@ extra args."
;; Warn if a custom definition fails to specify :group.
(defun byte-compile-nogroup-warn (form)
(let ((keyword-args (cdr (cdr (cdr (cdr form)))))
(name (cadr form)))
(name (cadr form)))
(or (not (eq (car-safe name) 'quote))
(and (eq (car form) 'custom-declare-group)
(equal name ''emacs))
(plist-get keyword-args :group)
(not (and (consp name) (eq (car name) 'quote)))
(byte-compile-warn
"%s for `%s' fails to specify containing group"
(cdr (assq (car form)
'((custom-declare-group . defgroup)
(custom-declare-face . defface)
(custom-declare-variable . defcustom))))
(cadr name)))))
(and (eq (car form) 'custom-declare-group)
(equal name ''emacs))
(plist-get keyword-args :group)
(not (and (consp name) (eq (car name) 'quote)))
(byte-compile-warn
"%s for `%s' fails to specify containing group"
(cdr (assq (car form)
'((custom-declare-group . defgroup)
(custom-declare-face . defface)
(custom-declare-variable . defcustom))))
(cadr name)))))
;; Warn if the function or macro is being redefined with a different
;; number of arguments.
@ -1834,9 +1832,8 @@ With argument, insert value in current buffer after the form."
;; byte-compile-warnings))
)
(byte-compile-close-variables
(save-excursion
(setq outbuffer
(set-buffer (get-buffer-create " *Compiler Output*")))
(with-current-buffer
(setq outbuffer (get-buffer-create " *Compiler Output*"))
(set-buffer-multibyte t)
(erase-buffer)
;; (emacs-lisp-mode)
@ -1850,9 +1847,8 @@ With argument, insert value in current buffer after the form."
(setq overwrite-mode 'overwrite-mode-binary))
(displaying-byte-compile-warnings
(and filename (byte-compile-insert-header filename inbuffer outbuffer))
(save-excursion
(set-buffer inbuffer)
(goto-char 1)
(with-current-buffer inbuffer
(goto-char (point-min))
;; Compile the forms from the input buffer.
(while (progn
@ -1920,7 +1916,7 @@ With argument, insert value in current buffer after the form."
(let ((dynamic-docstrings byte-compile-dynamic-docstrings)
(dynamic byte-compile-dynamic))
(set-buffer outbuffer)
(goto-char 1)
(goto-char (point-min))
;; The magic number of .elc files is ";ELC", or 0x3B454C43. After
;; that is the file-format version number (18, 19 or 20) as a
;; byte, followed by some nulls. The primary motivation for doing
@ -2241,8 +2237,7 @@ list that represents a doc string reference.
(put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
(defun byte-compile-file-form-require (form)
(let ((old-load-list current-load-list)
(args (mapcar 'eval (cdr form))))
(let ((args (mapcar 'eval (cdr form))))
(apply 'require args)
;; Detect (require 'cl) in a way that works even if cl is already loaded.
(if (member (car args) '("cl" cl))

4
lisp/emacs-lisp/edebug.el
View File

@ -369,7 +369,7 @@ Return the result of the last expression in BODY."
;; Otherwise, find a new window, possibly splitting one.
(setq window
(cond
((and (windowp window) (edebug-window-live-p window)
((and (edebug-window-live-p window)
(eq (window-buffer window) buffer))
window)
((eq (window-buffer (selected-window)) buffer)
@ -2739,7 +2739,7 @@ MSG is printed after `::::} '."
;; Unrestore edebug-buffer's window-start, if displayed.
(let ((window (car edebug-window-data)))
(if (and window (edebug-window-live-p window)
(if (and (edebug-window-live-p window)
(eq (window-buffer) edebug-buffer))
(progn
(set-window-start window (cdr edebug-window-data)

323
lisp/emulation/tpu-edt.el
View File

@ -207,16 +207,16 @@
;; ; The emacs universal-argument function is very useful.
;; ; This line maps universal-argument to Gold-PF1.
;; (define-key GOLD-SS3-map "P" 'universal-argument) ; Gold-PF1
;; (define-key tpu-gold-map [kp_f1] 'universal-argument) ; Gold-PF1
;; ; Make KP7 move by paragraphs, instead of pages.
;; (define-key SS3-map "w" 'tpu-paragraph) ; KP7
;; (define-key tpu-global-map [kf_7] 'tpu-paragraph) ; KP7
;; ; Repeat the preceding mappings for X-windows.
;; (cond
;; (window-system
;; (global-set-key [kp_7] 'tpu-paragraph) ; KP7
;; (define-key GOLD-map [kp_f1] 'universal-argument))) ; GOLD-PF1
;; (define-key tpu-global-map [kp_7] 'tpu-paragraph) ; KP7
;; (define-key tpu-gold-map [kp_f1] 'universal-argument))) ; GOLD-PF1
;; ; Display the TPU-edt version.
;; (tpu-version)
@ -292,146 +292,88 @@
;;; User Configurable Variables
;;;
(defcustom tpu-have-ispell t
"*If non-nil (default), TPU-edt uses ispell for spell checking."
"If non-nil (default), TPU-edt uses ispell for spell checking."
:type 'boolean
:group 'tpu)
(defcustom tpu-kill-buffers-silently nil
"*If non-nil, TPU-edt kills modified buffers without asking."
"If non-nil, TPU-edt kills modified buffers without asking."
:type 'boolean
:group 'tpu)
(defcustom tpu-percent-scroll 75
"*Percentage of the screen to scroll for next/previous screen commands."
"Percentage of the screen to scroll for next/previous screen commands."
:type 'integer
:group 'tpu)
(defcustom tpu-pan-columns 16
"*Number of columns the tpu-pan functions scroll left or right."
"Number of columns the tpu-pan functions scroll left or right."
:type 'integer
:group 'tpu)
;;;
;;; Emacs version identifiers - currently referenced by
;;;
;;; o tpu-mark o tpu-set-mark
;;; o mode line section o tpu-load-xkeys
;;;
(defconst tpu-lucid-emacs-p
(string-match "Lucid" emacs-version)
"Non-nil if we are running Lucid Emacs.")
;;;
;;; Global Keymaps
;;;
(defvar CSI-map
(let ((map (make-sparse-keymap)))
(define-key map "A" 'tpu-previous-line) ; up
(define-key map "B" 'tpu-next-line) ; down
(define-key map "D" 'tpu-backward-char) ; left
(define-key map "C" 'tpu-forward-char) ; right
(define-key map "1~" 'tpu-search) ; Find
(define-key map "2~" 'tpu-paste) ; Insert Here
(define-key map "3~" 'tpu-cut) ; Remove
(define-key map "4~" 'tpu-select) ; Select
(define-key map "5~" 'tpu-scroll-window-down) ; Prev Screen
(define-key map "6~" 'tpu-scroll-window-up) ; Next Screen
(define-key map "11~" 'nil) ; F1
(define-key map "12~" 'nil) ; F2
(define-key map "13~" 'nil) ; F3
(define-key map "14~" 'nil) ; F4
(define-key map "15~" 'nil) ; F5
(define-key map "17~" 'nil) ; F6
(define-key map "18~" 'nil) ; F7
(define-key map "19~" 'nil) ; F8
(define-key map "20~" 'nil) ; F9
(define-key map "21~" 'tpu-exit) ; F10
(define-key map "23~" 'tpu-insert-escape) ; F11 (ESC)
(define-key map "24~" 'tpu-next-beginning-of-line) ; F12 (BS)
(define-key map "25~" 'tpu-delete-previous-word) ; F13 (LF)
(define-key map "26~" 'tpu-toggle-overwrite-mode) ; F14
(define-key map "28~" 'tpu-help) ; HELP
(define-key map "29~" 'execute-extended-command) ; DO
(define-key map "31~" 'tpu-goto-breadcrumb) ; F17
(define-key map "32~" 'nil) ; F18
(define-key map "33~" 'nil) ; F19
(define-key map "34~" 'nil) ; F20
map)
"Maps the CSI function keys on the VT100 keyboard.
CSI is DEC's name for the sequence <ESC>[.")
(defvar GOLD-CSI-map
(let ((map (make-sparse-keymap)))
(define-key map "A" 'tpu-move-to-beginning) ; up-arrow
(define-key map "B" 'tpu-move-to-end) ; down-arrow
(define-key map "C" 'end-of-line) ; right-arrow
(define-key map "D" 'beginning-of-line) ; left-arrow
(define-key map "1~" 'nil) ; Find
(define-key map "2~" 'nil) ; Insert Here
(define-key map "3~" 'tpu-store-text) ; Remove
(define-key map "4~" 'tpu-unselect) ; Select
(define-key map "5~" 'tpu-previous-window) ; Prev Screen
(define-key map "6~" 'tpu-next-window) ; Next Screen
(define-key map "11~" 'nil) ; F1
(define-key map "12~" 'nil) ; F2
(define-key map "13~" 'nil) ; F3
(define-key map "14~" 'nil) ; F4
(define-key map "16~" 'nil) ; F5
(define-key map "17~" 'nil) ; F6
(define-key map "18~" 'nil) ; F7
(define-key map "19~" 'nil) ; F8
(define-key map "20~" 'nil) ; F9
(define-key map "21~" 'nil) ; F10
(define-key map "23~" 'nil) ; F11
(define-key map "24~" 'nil) ; F12
(define-key map "25~" 'nil) ; F13
(define-key map "26~" 'nil) ; F14
(define-key map "28~" 'describe-bindings) ; HELP
(define-key map "29~" 'nil) ; DO
(define-key map "31~" 'tpu-drop-breadcrumb) ; F17
(define-key map "32~" 'nil) ; F18
(define-key map "33~" 'nil) ; F19
(define-key map "34~" 'nil) ; F20
map)
"Maps the function keys on the VT100 keyboard preceded by GOLD-CSI.")
(defvar GOLD-SS3-map
(let ((map (make-sparse-keymap)))
(define-key map "A" 'tpu-move-to-beginning) ; up-arrow
(define-key map "B" 'tpu-move-to-end) ; down-arrow
(define-key map "C" 'end-of-line) ; right-arrow
(define-key map "D" 'beginning-of-line) ; left-arrow
(define-key map "P" 'keyboard-quit) ; PF1
(define-key map "Q" 'help-for-help) ; PF2
(define-key map "R" 'tpu-search) ; PF3
(define-key map "S" 'tpu-undelete-lines) ; PF4
(define-key map "p" 'open-line) ; KP0
(define-key map "q" 'tpu-change-case) ; KP1
(define-key map "r" 'tpu-delete-to-eol) ; KP2
(define-key map "s" 'tpu-special-insert) ; KP3
(define-key map "t" 'tpu-move-to-end) ; KP4
(define-key map "u" 'tpu-move-to-beginning) ; KP5
(define-key map "v" 'tpu-paste) ; KP6
(define-key map "w" 'execute-extended-command) ; KP7
(define-key map "x" 'tpu-fill) ; KP8
(define-key map "y" 'tpu-replace) ; KP9
(define-key map "m" 'tpu-undelete-words) ; KP-
(define-key map "l" 'tpu-undelete-char) ; KP,
(define-key map "n" 'tpu-unselect) ; KP.
(define-key map "M" 'tpu-substitute) ; KPenter
map)
"Maps the function keys on the VT100 keyboard preceded by GOLD-SS3.")
(defvar GOLD-map
(defvar tpu-gold-map
(let ((map (make-keymap)))
(define-key map "\e[" GOLD-CSI-map) ; GOLD-CSI map
(define-key map "\eO" GOLD-SS3-map) ; GOLD-SS3 map
;; Previously we used escape sequences here. We now instead presume
;; that term/*.el does its job to map the escape sequence to the right
;; key-symbol.
(define-key map [up] 'tpu-move-to-beginning) ; up-arrow
(define-key map [down] 'tpu-move-to-end) ; down-arrow
(define-key map [right] 'end-of-line) ; right-arrow
(define-key map [left] 'beginning-of-line) ; left-arrow
(define-key map [find] 'nil) ; Find
(define-key map [insert] 'nil) ; Insert Here
(define-key map [delete] 'tpu-store-text) ; Remove
(define-key map [select] 'tpu-unselect) ; Select
(define-key map [prior] 'tpu-previous-window) ; Prev Screen
(define-key map [next] 'tpu-next-window) ; Next Screen
(define-key map [f1] 'nil) ; F1
(define-key map [f2] 'nil) ; F2
(define-key map [f3] 'nil) ; F3
(define-key map [f4] 'nil) ; F4
(define-key map [f5] 'nil) ; F5
(define-key map [f6] 'nil) ; F6
(define-key map [f7] 'nil) ; F7
(define-key map [f8] 'nil) ; F8
(define-key map [f9] 'nil) ; F9
(define-key map [f10] 'nil) ; F10
(define-key map [f11] 'nil) ; F11
(define-key map [f12] 'nil) ; F12
(define-key map [f13] 'nil) ; F13
(define-key map [f14] 'nil) ; F14
(define-key map [help] 'describe-bindings) ; HELP
(define-key map [menu] 'nil) ; DO
(define-key map [f17] 'tpu-drop-breadcrumb) ; F17
(define-key map [f18] 'nil) ; F18
(define-key map [f19] 'nil) ; F19
(define-key map [f20] 'nil) ; F20
(define-key map [kp-f1] 'keyboard-quit) ; PF1
(define-key map [kp-f2] 'help-for-help) ; PF2
(define-key map [kp-f3] 'tpu-search) ; PF3
(define-key map [kp-f4] 'tpu-undelete-lines) ; PF4
(define-key map [kp-0] 'open-line) ; KP0
(define-key map [kp-1] 'tpu-change-case) ; KP1
(define-key map [kp-2] 'tpu-delete-to-eol) ; KP2
(define-key map [kp-3] 'tpu-special-insert) ; KP3
(define-key map [kp-4] 'tpu-move-to-end) ; KP4
(define-key map [kp-5] 'tpu-move-to-beginning) ; KP5
(define-key map [kp-6] 'tpu-paste) ; KP6
(define-key map [kp-7] 'execute-extended-command) ; KP7
(define-key map [kp-8] 'tpu-fill) ; KP8
(define-key map [kp-9] 'tpu-replace) ; KP9
(define-key map [kp-subtract] 'tpu-undelete-words) ; KP-
(define-key map [kp-separator] 'tpu-undelete-char) ; KP,
(define-key map [kp-decimal] 'tpu-unselect) ; KP.
(define-key map [kp-enter] 'tpu-substitute) ; KPenter
;;
(define-key map "\C-A" 'tpu-toggle-overwrite-mode) ; ^A
(define-key map "\C-B" 'nil) ; ^B
@ -553,48 +495,72 @@ CSI is DEC's name for the sequence <ESC>[.")
map)
"Maps the function keys on the VT100 keyboard preceded by PF1.
GOLD is the ASCII 7-bit escape sequence <ESC>OP.")
(defvar SS3-map
(let ((map (make-sparse-keymap)))
(define-key map "P" GOLD-map) ; GOLD map
;;
(define-key map "A" 'tpu-previous-line) ; up
(define-key map "B" 'tpu-next-line) ; down
(define-key map "C" 'tpu-forward-char) ; right
(define-key map "D" 'tpu-backward-char) ; left
(define-key map "Q" 'tpu-help) ; PF2
(define-key map "R" 'tpu-search-again) ; PF3
(define-key map "S" 'tpu-delete-current-line) ; PF4
(define-key map "p" 'tpu-line) ; KP0
(define-key map "q" 'tpu-word) ; KP1
(define-key map "r" 'tpu-end-of-line) ; KP2
(define-key map "s" 'tpu-char) ; KP3
(define-key map "t" 'tpu-advance-direction) ; KP4
(define-key map "u" 'tpu-backup-direction) ; KP5
(define-key map "v" 'tpu-cut) ; KP6
(define-key map "w" 'tpu-page) ; KP7
(define-key map "x" 'tpu-scroll-window) ; KP8
(define-key map "y" 'tpu-append-region) ; KP9
(define-key map "m" 'tpu-delete-current-word) ; KP-
(define-key map "l" 'tpu-delete-current-char) ; KP,
(define-key map "n" 'tpu-select) ; KP.
(define-key map "M" 'newline) ; KPenter
map)
"Maps the SS3 function keys on the VT100 keyboard.
SS3 is DEC's name for the sequence <ESC>O.")
(define-obsolete-variable-alias 'GOLD-map 'tpu-gold-map "23.1")
(defvar tpu-global-map
(let ((map (make-sparse-keymap)))
(define-key map "\e[" CSI-map)
(define-key map "\eO" SS3-map)
;; Previously defined in CSI-map. We now presume that term/*.el does
;; its job to map the escape sequence to the right key-symbol.
(define-key map [find] 'tpu-search) ; Find
(define-key map [insert] 'tpu-paste) ; Insert Here
(define-key map [delete] 'tpu-cut) ; Remove
(define-key map [select] 'tpu-select) ; Select
(define-key map [prior] 'tpu-scroll-window-down) ; Prev Screen
(define-key map [next] 'tpu-scroll-window-up) ; Next Screen
(define-key map [f1] 'nil) ; F1
(define-key map [f2] 'nil) ; F2
(define-key map [f3] 'nil) ; F3
(define-key map [f4] 'nil) ; F4
(define-key map [f5] 'nil) ; F5
(define-key map [f6] 'nil) ; F6
(define-key map [f7] 'nil) ; F7
(define-key map [f8] 'nil) ; F8
(define-key map [f9] 'nil) ; F9
(define-key map [f10] 'tpu-exit) ; F10
(define-key map [f11] 'tpu-insert-escape) ; F11 (ESC)
(define-key map [f12] 'tpu-next-beginning-of-line) ; F12 (BS)
(define-key map [f13] 'tpu-delete-previous-word) ; F13 (LF)
(define-key map [f14] 'tpu-toggle-overwrite-mode) ; F14
(define-key map [help] 'tpu-help) ; HELP
(define-key map [menu] 'execute-extended-command) ; DO
(define-key map [f17] 'tpu-goto-breadcrumb) ; F17
(define-key map [f18] 'nil) ; F18
(define-key map [f19] 'nil) ; F19
(define-key map [f20] 'nil) ; F20
;; Previously defined in SS3-map. We now presume that term/*.el does
;; its job to map the escape sequence to the right key-symbol.
(define-key map [kp-f1] tpu-gold-map) ; GOLD map
;;
(define-key map [up] 'tpu-previous-line) ; up
(define-key map [down] 'tpu-next-line) ; down
(define-key map [right] 'tpu-forward-char) ; right
(define-key map [left] 'tpu-backward-char) ; left
(define-key map [kp-f2] 'tpu-help) ; PF2
(define-key map [kp-f3] 'tpu-search-again) ; PF3
(define-key map [kp-f4] 'tpu-delete-current-line) ; PF4
(define-key map [kp-0] 'tpu-line) ; KP0
(define-key map [kp-1] 'tpu-word) ; KP1
(define-key map [kp-2] 'tpu-end-of-line) ; KP2
(define-key map [kp-3] 'tpu-char) ; KP3
(define-key map [kp-4] 'tpu-advance-direction) ; KP4
(define-key map [kp-5] 'tpu-backup-direction) ; KP5
(define-key map [kp-6] 'tpu-cut) ; KP6
(define-key map [kp-7] 'tpu-page) ; KP7
(define-key map [kp-8] 'tpu-scroll-window) ; KP8
(define-key map [kp-9] 'tpu-append-region) ; KP9
(define-key map [kp-subtract] 'tpu-delete-current-word) ; KP-
(define-key map [kp-separator] 'tpu-delete-current-char) ; KP,
(define-key map [kp-decimal] 'tpu-select) ; KP.
(define-key map [kp-enter] 'newline) ; KPenter
map)
"TPU-edt global keymap.")
(and (not (boundp 'minibuffer-local-ns-map))
(defvar minibuffer-local-ns-map (make-sparse-keymap)
"Hack to give Lucid Emacs the same maps as ordinary Emacs."))
;;;
;;; Global Variables
@ -697,7 +663,7 @@ SS3 is DEC's name for the sequence <ESC>O.")
(setq tpu-mark-flag (if transient-mark-mode "" (if (tpu-mark) " @" " ")))
(force-mode-line-update))
(cond (tpu-lucid-emacs-p
(cond ((featurep 'xemacs)
(add-hook 'zmacs-deactivate-region-hook 'tpu-update-mode-line)
(add-hook 'zmacs-activate-region-hook 'tpu-update-mode-line))
(t
@ -778,7 +744,7 @@ Otherwise sets the tpu-match markers to nil and returns nil."
"TPU-edt version of the mark function.
Return the appropriate value of the mark for the current
version of Emacs."
(cond (tpu-lucid-emacs-p (mark (not zmacs-regions)))
(cond ((featurep 'xemacs) (mark (not zmacs-regions)))
(t (and mark-active (mark (not transient-mark-mode))))))
(defun tpu-set-mark (pos)
@ -2366,7 +2332,7 @@ If FILE is nil, try to load a default file. The default file names are
(setq file (expand-file-name file)))
(tpu-xkeys-file
(setq file (expand-file-name tpu-xkeys-file)))
(tpu-lucid-emacs-p
((featurep 'xemacs)
(setq file (convert-standard-filename
(expand-file-name "~/.tpu-lucid-keys"))))
(t
@ -2382,34 +2348,11 @@ If FILE is nil, try to load a default file. The default file names are
(cond ((file-readable-p file)
(load-file file))
(t
(switch-to-buffer "*scratch*")
(erase-buffer)
(insert "
Ack!! You're running TPU-edt under X-windows without loading an
X key definition file. To create a TPU-edt X key definition
file, run the tpu-mapper.el program. It came with TPU-edt. It
even includes directions on how to use it! Perhaps it's lying
around here someplace. ")
(let ((file "tpu-mapper.el")
(found nil)
(path nil)
(search-list (append (list (expand-file-name ".")) load-path)))
(while (and (not found) search-list)
(setq path (concat (car search-list)
(if (string-match "/$" (car search-list)) "" "/")
file))
(if (and (file-exists-p path) (not (file-directory-p path)))
(setq found t))
(setq search-list (cdr search-list)))
(cond (found
(insert (format
"Ah yes, there it is, in \n\n %s \n\n" path))
(if (tpu-y-or-n-p "Do you want to run it now? ")
(load-file path)))
(t
(insert "Nope, I can't seem to find it. :-(\n\n")
(sit-for 120)))))))
;; FIXME: This used to force the user to build `file'. With the
;; new code, such a file is not even necessary, but we'll keep
;; a warning message.
(message "%s not found: use tpu-mapper.el to create it"
(abbreviate-file-name file)))))
(defun tpu-copy-keyfile (oldname newname)
"Copy the TPU-edt X key definitions file to the new default name."

6
lisp/emulation/tpu-mapper.el
View File

@ -202,9 +202,9 @@
(setq tpu-key (concat "[" (format "%s" tpu-key-seq) "]"))
(cond ((not (equal tpu-key tpu-return))
(set-buffer "Keys")
(insert (format"(global-set-key %s %s)\n" tpu-key func))
(insert (format"(define-key tpu-global-map %s %s)\n" tpu-key func))
(set-buffer "Gold-Keys")
(insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func))
(insert (format "(define-key tpu-gold-map %s %s)\n" tpu-key gold-func))
(set-buffer "Directions"))
;; bogosity to get next prompt to come up, if the user hits <CR>!
;; check periodically to see if this is still needed...
@ -393,5 +393,5 @@
")
(goto-char (point-min))
;;; arch-tag: bab5872f-cd3a-4c1c-aedb-047b67646f6c
;; arch-tag: bab5872f-cd3a-4c1c-aedb-047b67646f6c
;;; tpu-mapper.el ends here

10
lisp/emulation/viper-cmd.el
View File

@ -106,7 +106,7 @@
;; define viper-charpair-command-p
(viper-test-com-defun viper-charpair-command)
(defconst viper-movement-commands '(?b ?B ?e ?E ?f ?F ?G ?h ?H ?j ?k ?l
(defconst viper-movement-commands '(?b ?B ?e ?E ?f ?F ?G ?h ?j ?k ?l
?H ?M ?L ?n ?t ?T ?w ?W ?$ ?%
?^ ?( ?) ?- ?+ ?| ?{ ?} ?[ ?] ?' ?`
?\; ?, ?0 ?? ?/ ?\ ?\C-m
@ -1321,10 +1321,10 @@ as a Meta key and any number of multiple escapes is allowed."
(setq last-command-event
(viper-copy-event
(if viper-xemacs-p (character-to-event char) char)))
(condition-case nil
(condition-case err
(funcall cmd-to-exec-at-end cmd-info)
(error
(error "")))))
(error "%s" (error-message-string err))))))
))
(defun viper-describe-arg (arg)
@ -1902,7 +1902,7 @@ With prefix argument, find next destructive command."
(setq viper-intermediate-command
'repeating-display-destructive-command)
;; first search through command history--set temp ring
(setq viper-temp-command-ring (copy-list viper-command-ring)))
(setq viper-temp-command-ring (copy-sequence viper-command-ring)))
(setq cmd (if next
(viper-special-ring-rotate1 viper-temp-command-ring 1)
(viper-special-ring-rotate1 viper-temp-command-ring -1)))
@ -1936,7 +1936,7 @@ to in the global map, instead of cycling through the insertion ring."
(length viper-last-inserted-string-from-insertion-ring))))
)
;;first search through insertion history
(setq viper-temp-insertion-ring (copy-list viper-insertion-ring)))
(setq viper-temp-insertion-ring (copy-sequence viper-insertion-ring)))
(setq this-command 'viper-insert-from-insertion-ring)
;; so that things will be undone properly
(setq buffer-undo-list (cons nil buffer-undo-list))

15
lisp/emulation/viper-init.el
View File

@ -97,6 +97,13 @@
:tag "Is it VMS?"
:group 'viper-misc)
(defcustom viper-suppress-input-method-change-message nil
"If t, the message notifying about changes in the input method is not displayed.
Normally, a message is displayed each time on enters the vi, insert or replace
state."
:type 'boolean
:group 'viper-misc)
(defcustom viper-force-faces nil
"If t, Viper will think that it is running on a display that supports faces.
This is provided as a temporary relief for users of graphics-capable terminals
@ -326,7 +333,8 @@ Use `M-x viper-set-expert-level' to change this.")
;; turn off special input methods in vi-state
(if (eq viper-current-state 'vi-state)
(viper-set-input-method nil))
(if (memq viper-current-state '(vi-state insert-state replace-state))
(if (and (memq viper-current-state '(vi-state insert-state replace-state))
(not viper-suppress-input-method-change-message))
(message "Viper special input method%s: on"
(if (or current-input-method default-input-method)
(format " %S"
@ -339,7 +347,8 @@ Use `M-x viper-set-expert-level' to change this.")
(if (null viper-mule-hook-flag)
()
(setq viper-special-input-method nil)
(if (memq viper-current-state '(vi-state insert-state replace-state))
(if (and (memq viper-current-state '(vi-state insert-state replace-state))
(not viper-suppress-input-method-change-message))
(message "Viper special input method%s: off"
(if (or current-input-method default-input-method)
(format " %S"
@ -369,7 +378,7 @@ Use `M-x viper-set-expert-level' to change this.")
;; Set quail-mode to ARG
(defun viper-set-input-method (arg)
(setq viper-mule-hook-flag t) ; just a precaution
(let (viper-mule-hook-flag) ; temporarily inactivate viper mule hooks
(let (viper-mule-hook-flag) ; temporarily deactivate viper mule hooks
(cond ((and arg (> (prefix-numeric-value arg) 0) default-input-method)
;; activate input method
(viper-activate-input-method))

4
lisp/emulation/viper-keym.el
View File

@ -339,8 +339,8 @@ If running in a terminal, [(escape)] is not understood, so must use \"\\e\"."
(define-key viper-vi-basic-map "\C-m" 'viper-next-line-at-bol)
(define-key viper-vi-basic-map "\C-u" 'viper-scroll-down)
(define-key viper-vi-basic-map "\C-y" 'viper-scroll-down-one)
(define-key viper-vi-basic-map "\C-s" 'viper-isearch-forward)
(define-key viper-vi-basic-map "\C-r" 'viper-isearch-backward)
;;(define-key viper-vi-basic-map "\C-s" 'viper-isearch-forward)
;;(define-key viper-vi-basic-map "\C-r" 'viper-isearch-backward)
(define-key viper-vi-basic-map "\C-c/" 'viper-toggle-search-style)
(define-key viper-vi-basic-map "\C-c\C-g" 'viper-info-on-file)

6
lisp/emulation/viper-util.el
View File

@ -168,7 +168,7 @@
(defun viper-set-cursor-color-according-to-state (&optional frame)
(cond ((eq viper-current-state 'replace-state)
(viper-change-cursor-color viper-replace-state-cursor-color frame))
(viper-change-cursor-color viper-replace-overlay-cursor-color frame))
((and (eq viper-current-state 'emacs-state)
viper-emacs-state-cursor-color)
(viper-change-cursor-color viper-emacs-state-cursor-color frame))
@ -889,9 +889,7 @@
;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg
;; in sit-for, so this function smoothes out the differences.
(defsubst viper-sit-for-short (val &optional nodisp)
(if viper-xemacs-p
(sit-for (/ val 1000.0) nodisp)
(sit-for 0 val nodisp)))
(sit-for (/ val 1000.0) nodisp))
;; EVENT may be a single event of a sequence of events
(defsubst viper-ESC-event-p (event)

102
lisp/emulation/viper.el
View File

@ -9,7 +9,7 @@
;; Author: Michael Kifer <kifer@cs.stonybrook.edu>
;; Keywords: emulations
(defconst viper-version "3.13.1 of October 23, 2006"
(defconst viper-version "3.14 of June 14, 2007"
"The current version of Viper")
;; This file is part of GNU Emacs.
@ -298,7 +298,6 @@
;;; Code:
(require 'advice)
(require 'cl)
(require 'ring)
;; compiler pacifier
@ -457,6 +456,7 @@ unless it is coming up in a wrong Viper state."
(defcustom viper-insert-state-mode-list
'(internal-ange-ftp-mode
comint-mode
gud-mode
inferior-emacs-lisp-mode
erc-mode
eshell-mode
@ -481,6 +481,7 @@ unless it is coming up in a wrong Viper state."
'((help-mode emacs-state viper-slash-and-colon-map)
(comint-mode insert-state viper-comint-mode-modifier-map)
(comint-mode vi-state viper-comint-mode-modifier-map)
(gud-mode insert-state viper-comint-mode-modifier-map)
(shell-mode insert-state viper-comint-mode-modifier-map)
(inferior-emacs-lisp-mode insert-state viper-comint-mode-modifier-map)
(shell-mode vi-state viper-comint-mode-modifier-map)
@ -1025,48 +1026,63 @@ It also can't undo some Viper settings."
(setq global-mode-string
(append '("" viper-mode-string) (cdr global-mode-string))))
(defadvice describe-key (before viper-describe-key-ad protect activate)
"Force to read key via `viper-read-key-sequence'."
(interactive (let (key)
(setq key (viper-read-key-sequence
"Describe key (or click or menu item): "))
(list key
(prefix-numeric-value current-prefix-arg)
;; If KEY is a down-event, read also the
;; corresponding up-event.
(and (vectorp key)
(let ((last-idx (1- (length key))))
(and (eventp (aref key last-idx))
(memq 'down (event-modifiers
(aref key last-idx)))))
(or (and (eventp (aref key 0))
(memq 'down (event-modifiers
(aref key 0)))
;; For the C-down-mouse-2 popup
;; menu, there is no subsequent up-event.
(= (length key) 1))
(and (> (length key) 1)
(eventp (aref key 1))
(memq 'down (event-modifiers (aref key 1)))))
(read-event))))))
(viper-cond-compile-for-xemacs-or-emacs
;; XEmacs
(defadvice describe-key (before viper-describe-key-ad protect activate)
"Force to read key via `viper-read-key-sequence'."
(interactive (list (viper-read-key-sequence "Describe key: "))))
;; Emacs
(defadvice describe-key (before viper-describe-key-ad protect activate)
"Force to read key via `viper-read-key-sequence'."
(interactive (let (key)
(setq key (viper-read-key-sequence
"Describe key (or click or menu item): "))
(list key
(prefix-numeric-value current-prefix-arg)
;; If KEY is a down-event, read also the
;; corresponding up-event.
(and (vectorp key)
(let ((last-idx (1- (length key))))
(and (eventp (aref key last-idx))
(memq 'down (event-modifiers
(aref key last-idx)))))
(or (and (eventp (aref key 0))
(memq 'down (event-modifiers
(aref key 0)))
;; For the C-down-mouse-2 popup menu,
;; there is no subsequent up-event
(= (length key) 1))
(and (> (length key) 1)
(eventp (aref key 1))
(memq 'down (event-modifiers (aref key 1)))))
(read-event))))))
) ; viper-cond-compile-for-xemacs-or-emacs
(defadvice describe-key-briefly
(before viper-describe-key-briefly-ad protect activate)
"Force to read key via `viper-read-key-sequence'."
(interactive (let (key)
(setq key (viper-read-key-sequence
"Describe key (or click or menu item): "))
;; If KEY is a down-event, read and discard the
;; corresponding up-event.
(and (vectorp key)
(let ((last-idx (1- (length key))))
(and (eventp (aref key last-idx))
(memq 'down (event-modifiers (aref key last-idx)))))
(read-event))
(list key
(if current-prefix-arg
(prefix-numeric-value current-prefix-arg))
1))))
(viper-cond-compile-for-xemacs-or-emacs
;; XEmacs
(defadvice describe-key-briefly
(before viper-describe-key-briefly-ad protect activate)
"Force to read key via `viper-read-key-sequence'."
(interactive (list (viper-read-key-sequence "Describe key briefly: "))))
;; Emacs
(defadvice describe-key-briefly
(before viper-describe-key-briefly-ad protect activate)
"Force to read key via `viper-read-key-sequence'."
(interactive (let (key)
(setq key (viper-read-key-sequence
"Describe key (or click or menu item): "))
;; If KEY is a down-event, read and discard the
;; corresponding up-event.
(and (vectorp key)
(let ((last-idx (1- (length key))))
(and (eventp (aref key last-idx))
(memq 'down (event-modifiers (aref key last-idx)))))
(read-event))
(list key
(if current-prefix-arg
(prefix-numeric-value current-prefix-arg))
1))))
) ;; viper-cond-compile-for-xemacs-or-emacs
(defadvice find-file (before viper-add-suffix-advice activate)
"Use `read-file-name' for reading arguments."

4
lisp/erc/ChangeLog
View File

@ -1,3 +1,7 @@
2007-06-14 Juanma Barranquero <lekktu@gmail.com>
* erc-goodies.el (erc-scroll-to-bottom): Remove redundant check.
2007-06-06 Juanma Barranquero <lekktu@gmail.com>
* erc.el (erc-show-channel-key-p, erc-startup-file-list):

2
lisp/erc/erc-goodies.el
View File

@ -77,7 +77,7 @@ You can control which line is recentered to by customizing the
variable `erc-input-line-position'.
DISPLAY-START is ignored."
(if (and window (window-live-p window))
(if (window-live-p window)
;; Temporarily bind resize-mini-windows to nil so that users who have it
;; set to a non-nil value will not suffer from premature minibuffer
;; shrinkage due to the below recenter call. I have no idea why this

2
lisp/filesets.el
View File

@ -354,7 +354,7 @@ See `add-submenu' for documentation."
(defcustom filesets-menu-cache-file
(if filesets-running-xemacs
"~/.xemacs/filesets-cache.el"
"~/.emacs.d/filesets-cache.el")
(concat user-emacs-directory "filesets-cache.el"))
"*File to be used for saving the filesets menu between sessions.
Set this to \"\", to disable caching of menus.
Don't forget to check out `filesets-menu-ensure-use-cached'."

4
lisp/follow.el
View File

@ -912,7 +912,7 @@ of the way from the true end."
"Return all windows displaying the same buffer as the TESTWIN.
The list contains only windows displayed in the same frame as TESTWIN.
If TESTWIN is nil the selected window is used."
(or (and testwin (window-live-p testwin))
(or (window-live-p testwin)
(setq testwin (selected-window)))
(let* ((top (frame-first-window (window-frame testwin)))
(win top)
@ -1968,7 +1968,7 @@ report this using the `report-emacs-bug' function."
;; If we're in follow mode, do our stuff. Select a new window and
;; redisplay. (Actually, it is redundant to check `buf', but I
;; feel it's more correct.)
(if (and buf win (window-live-p win))
(if (and buf (window-live-p win))
(progn
(set-buffer buf)
(if (and (boundp 'follow-mode) follow-mode)

8
lisp/font-lock.el
View File

@ -698,6 +698,14 @@ see the variables `c-font-lock-extra-types', `c++-font-lock-extra-types',
;; contain the new keywords.
(font-lock-update-removed-keyword-alist mode keywords how))
(t
(when (and font-lock-mode
(not (or font-lock-keywords font-lock-defaults)))
;; The major mode has not set any keywords, so when we enabled
;; font-lock-mode it only enabled the font-core.el part, not the
;; font-lock-mode-internal. Try again.
(font-lock-mode -1)
(set (make-local-variable 'font-lock-defaults) '(nil t))
(font-lock-mode 1))
;; Otherwise set or add the keywords now.
;; This is a no-op if it has been done already in this buffer
;; for the correct major mode.

11
lisp/gnus/ChangeLog
View File

@ -1,3 +1,14 @@
2007-06-14 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-agent.el (gnus-agent-fetch-headers)
(gnus-agent-retrieve-headers): Bind
gnus-decode-encoded-address-function to identity.
* nntp.el (nntp-send-xover-command): Recognize an xover command is
available also when the server returns simply a dot.
* gnus-ems.el (gnus-x-splash): Redisplay window before measuring it.
2007-06-08 Katsumi Yamaoka <yamaoka@jpl.org>
* gnus-ems.el (gnus-x-splash): Make it work.

26
lisp/gnus/ChangeLog.2
View File

@ -6370,8 +6370,7 @@
* message.el (message-required-headers): Add From.
2003-01-02 Katsumi Yamaoka <yamaoka@jpl.org>
Trivial patch from Norbert Koch <nk@viteno.net>.
2003-01-02 Norbert Koch <nk@viteno.net> (tiny change)
* gnus-msg.el (gnus-gcc-externalize-attachments): Fix typo.
@ -6984,8 +6983,7 @@
* nnmaildir.el (nnmaildir-request-group): bugfix: don't erase
nntp-server-buffer if we aren't going to write to it.
2002-12-04 Katsumi Yamaoka <yamaoka@jpl.org>
Trivial patch from Itai Zukerman <zukerman@math-hat.com>.
2002-12-04 Itai Zukerman <zukerman@math-hat.com> (tiny change)
* mm-decode.el (mm-w3m-safe-url-regexp): Fix parenthesis.
@ -7233,8 +7231,7 @@
* nnimap.el (nnimap-request-expire-articles): Compress sequence
before storing \Deleted mark on expired articles.
2002-11-17 Shenghuo Zhu <zsh@cs.rochester.edu>
Trivial patch from Markus Rost <rost@math.ohio-state.edu>
2002-11-17 Markus Rost <rost@math.ohio-state.edu> (tiny change)
* gnus-sum.el (gnus-summary-goto-unread): Doc fix - escape open
parens in column 0.
@ -7906,10 +7903,12 @@
(mml1991-pgg-sign, mml1991-pgg-encrypt): New functions.
(mml1991-pgg-encrypt): Fix recipients querying.
2002-09-28 <dme@dme.org> (tiny change)
* mml2015.el (autoload): Autoload correct files.
2002-09-28 Simon Josefsson <jas@extundo.com>
* mml2015.el (autoload): Autoload correct files. Trivial patch
from dme@dme.org.
(mml2015-pgg-decrypt, mml2015-pgg-verify): Make sure either nil or
handle is returned.
@ -8486,12 +8485,10 @@
* imap.el (imap-shell-open): Allow non-list `imap-shell-program'.
(imap-shell-open): Skip initial junk before IMAP greeting.
2002-08-11 Simon Josefsson <jas@extundo.com>
2002-08-11 Reiner Steib <Reiner.Steib@gmx.de>
* message-utils.el (message-xpost-default,
message-xpost-fup2-header, message-xpost-fup2): Fixed
Typos. Trivial changes from Reiner Steib
<4uce.02.r.steib@gmx.net>.
* message-utils.el (message-xpost-default)
(message-xpost-fup2-header, message-xpost-fup2): Fixed Typos.
2002-08-09 Simon Josefsson <jas@extundo.com>
@ -9915,10 +9912,9 @@
(mm-inline-wash-with-file): New function.
(mm-inline-wash-with-stdin): New function.
2002-02-17 ShengHuo ZHU <zsh@cs.rochester.edu>
2002-02-17 Reiner Steib <Reiner.Steib@gmx.de>
* message-utils.el: Fix installation doc.
From: Reiner Steib <4uce.02.r.steib@gmx.net>
2002-02-16 ShengHuo ZHU <zsh@cs.rochester.edu>

2
lisp/gnus/gnus-agent.el
View File

@ -1768,6 +1768,7 @@ article numbers will be returned."
(gnus-uncompress-range (gnus-active group))
(gnus-list-of-unread-articles group)))
(gnus-decode-encoded-word-function 'identity)
(gnus-decode-encoded-address-function 'identity)
(file (gnus-agent-article-name ".overview" group)))
(unless fetch-all
@ -3571,6 +3572,7 @@ has been fetched."
(save-excursion
(gnus-agent-create-buffer)
(let ((gnus-decode-encoded-word-function 'identity)
(gnus-decode-encoded-address-function 'identity)
(file (gnus-agent-article-name ".overview" group))
cached-articles uncached-articles)
(gnus-make-directory (nnheader-translate-file-chars

1
lisp/gnus/gnus-ems.el
View File

@ -183,6 +183,7 @@
(file (nnheader-find-etc-directory "images/gnus/x-splash" t))
pixmap fcw fch width height fringes sbars left yoffset top ls)
(erase-buffer)
(sit-for 0) ;; Necessary for measuring the window size correctly.
(when (and file
(ignore-errors
(let ((coding-system-for-read 'raw-text)

3
lisp/gnus/nntp.el
View File

@ -1580,7 +1580,8 @@ password contained in '~/.nntp-authinfo'."
;; article number. How... helpful.
(progn
(forward-line 1)
(looking-at "[0-9]+\t...")) ; More text after number.
;; More text after number, or a dot.
(looking-at "[0-9]+\t...\\|\\.\r?\n"))
(setq nntp-server-xover (car commands))))
(setq commands (cdr commands)))
;; If none of the commands worked, we disable XOVER.

13
lisp/image-dired.el
View File

@ -166,7 +166,7 @@
:prefix "image-dired-"
:group 'multimedia)
(defcustom image-dired-dir "~/.emacs.d/image-dired/"
(defcustom image-dired-dir (concat user-emacs-directory "image-dired/")
"Directory where thumbnail images are stored."
:type 'string
:group 'image-dired)
@ -187,17 +187,20 @@ that allows sharing of thumbnails across different programs."
(const :tag "Per-directory" per-directory))
:group 'image-dired)
(defcustom image-dired-db-file "~/.emacs.d/image-dired/.image-dired_db"
(defcustom image-dired-db-file
(concat user-emacs-directory "image-dired/.image-dired_db")
"Database file where file names and their associated tags are stored."
:type 'string
:group 'image-dired)
(defcustom image-dired-temp-image-file "~/.emacs.d/image-dired/.image-dired_temp"
(defcustom image-dired-temp-image-file
(concat user-emacs-directory "image-dired/.image-dired_temp")
"Name of temporary image file used by various commands."
:type 'string
:group 'image-dired)
(defcustom image-dired-gallery-dir "~/.emacs.d/image-dired/.image-dired_gallery"
(defcustom image-dired-gallery-dir
(concat user-emacs-directory "image-dired/.image-dired_gallery")
"Directory to store generated gallery html pages.
This path needs to be \"shared\" to the public so that it can access
the index.html page that image-dired creates."
@ -342,7 +345,7 @@ original image file name and %t which is replaced by
:group 'image-dired)
(defcustom image-dired-temp-rotate-image-file
"~/.emacs.d/image-dired/.image-dired_rotate_temp"
(concat user-emacs-directory "image-dired/.image-dired_rotate_temp")
"Temporary file for rotate operations."
:type 'string
:group 'image-dired)

4
lisp/indent.el
View File

@ -50,8 +50,8 @@ Don't rebind TAB unless you really need to.")
"*Controls the operation of the TAB key.
If t, hitting TAB always just indents the current line.
If nil, hitting TAB indents the current line if point is at the left margin
or in the line's indentation, otherwise it insert a \"real\" TAB character.
Most programming language modes have their own variable to control this,
or in the line's indentation, otherwise it inserts a \"real\" TAB character.
Some programming language modes have their own variable to control this,
e.g., `c-tab-always-indent', and do not respect this variable."
:group 'indent
:type '(choice (const nil) (const t) (const always)))

23
lisp/log-view.el
View File

@ -129,14 +129,15 @@
(defvar log-view-message-face 'log-view-message)
(defconst log-view-file-re
(concat "^\\(?:Working file: \\(.+\\)" ;RCS and CVS.
"\\|\\(?:SCCS/s\\.\\|Changes to \\)\\(.+\\):" ;SCCS and Darcs.
(concat "^\\(?:Working file: \\(?1:.+\\)" ;RCS and CVS.
;; Subversion has no such thing??
"\\|\\(?:SCCS/s\\.\\|Changes to \\)\\(?1:.+\\):" ;SCCS and Darcs.
"\\)\n")) ;Include the \n for font-lock reasons.
(defconst log-view-message-re
(concat "^\\(?:revision \\([.0-9]+\\)\\(?:\t.*\\)?" ; RCS and CVS.
"\\|r\\([0-9]+\\) | .* | .*" ; Subversion.
"\\|D \\([.0-9]+\\) .*" ; SCCS.
(concat "^\\(?:revision \\(?1:[.0-9]+\\)\\(?:\t.*\\)?" ; RCS and CVS.
"\\|r\\(?1:[0-9]+\\) | .* | .*" ; Subversion.
"\\|D \\(?1:[.0-9]+\\) .*" ; SCCS.
;; Darcs doesn't have revision names. VC-darcs uses patch names
;; instead. Darcs patch names are hashcodes, which do not appear
;; in the log output :-(, but darcs accepts any prefix of the log
@ -145,13 +146,12 @@
;; First loosely match the date format.
(concat "\\|[^ \n].*[^0-9\n][0-9][0-9]:[0-9][0-9][^0-9\n].*[^ \n]"
;;Email of user and finally Msg, used as revision name.
" .*@.*\n\\(?: \\* \\(.*\\)\\)?")
" .*@.*\n\\(?: \\* \\(?1:.*\\)\\)?")
"\\)$"))
(defconst log-view-font-lock-keywords
`((,log-view-file-re
(1 (if (boundp 'cvs-filename-face) cvs-filename-face) nil t)
(2 (if (boundp 'cvs-filename-face) cvs-filename-face) nil t)
(1 (if (boundp 'cvs-filename-face) cvs-filename-face))
(0 log-view-file-face append))
(,log-view-message-re . log-view-message-face)))
(defconst log-view-font-lock-defaults
@ -194,7 +194,7 @@
(forward-line 1)
(or (re-search-backward log-view-file-re nil t)
(re-search-forward log-view-file-re))
(let* ((file (or (match-string 1) (match-string 2)))
(let* ((file (match-string 1))
(cvsdir (and (re-search-backward log-view-dir-re nil t)
(match-string 1)))
(pcldir (and (boundp 'cvs-pcl-cvs-dirchange-re)
@ -212,10 +212,7 @@
(forward-line 1)
(let ((pt (point)))
(when (re-search-backward log-view-message-re nil t)
(let (rev)
;; Find the subgroup that matched.
(dotimes (i (/ (length (match-data 'integers)) 2))
(setq rev (or rev (match-string (1+ i)))))
(let ((rev (match-string 1)))
(unless (re-search-forward log-view-file-re pt t)
rev))))))

72
lisp/mb-depth.el Normal file
View File

@ -0,0 +1,72 @@
;;; mb-depth.el --- Indicate minibuffer-depth in prompt
;;
;; Copyright (C) 2006, 2007 Free Software Foundation, Inc.
;;
;; Author: Miles Bader <miles@gnu.org>
;; Keywords: convenience
;; 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 2, 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; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;;
;; Defines the minor mode `minibuffer-indicate-depth-mode'.
;;
;; When active, any recursive use of the minibuffer will show
;; the recursion depth in the minibuffer prompt. This is only
;; useful if `enable-recursive-minibuffers' is non-nil.
;;; Code:
;; An overlay covering the prompt. This is a buffer-local variable in
;; each affected minibuffer.
;;
(defvar minibuf-depth-overlay)
(make-variable-buffer-local 'minibuf-depth-overlay)
;; This function goes on minibuffer-setup-hook
(defun minibuf-depth-setup-minibuffer ()
"Set up a minibuffer for `minibuffer-indicate-depth-mode'.
The prompt should already have been inserted."
(when (> (minibuffer-depth) 1)
(setq minibuf-depth-overlay (make-overlay (point-min) (1+ (point-min))))
(overlay-put minibuf-depth-overlay 'before-string
(propertize (format "[%d]" (minibuffer-depth))
'face 'highlight))
(overlay-put minibuf-depth-overlay 'evaporate t)))
;;;###autoload
(define-minor-mode minibuffer-indicate-depth-mode
"Toggle Minibuffer Indicate Depth mode.
When active, any recursive use of the minibuffer will show
the recursion depth in the minibuffer prompt. This is only
useful if `enable-recursive-minibuffers' is non-nil.
With prefix argument ARG, turn on if positive, otherwise off.
Returns non-nil if the new state is enabled."
:global t
:group 'minibuffer
(if minibuffer-indicate-depth-mode
;; Enable the mode
(add-hook 'minibuffer-setup-hook 'minibuf-depth-setup-minibuffer)
;; Disable the mode
(remove-hook 'minibuffer-setup-hook 'minibuf-depth-setup-minibuffer)))
(provide 'mb-depth)
;; arch-tag: 50224089-5bf5-46f8-803d-18f018c5eacf
;;; mb-depth.el ends here

781
lisp/net/rcirc.el
View File

File diff suppressed because it is too large Load Diff

2
lisp/pcomplete.el
View File

@ -934,7 +934,7 @@ generate the completions list. This means that the hook
(if pcomplete-last-window-config
(let* ((cbuf (get-buffer "*Completions*"))
(cwin (and cbuf (get-buffer-window cbuf))))
(when (and cwin (window-live-p cwin))
(when (window-live-p cwin)
(bury-buffer cbuf)
(set-window-configuration pcomplete-last-window-config))))
(setq pcomplete-last-window-config nil

3
lisp/play/gamegrid.el
View File

@ -66,7 +66,8 @@
(defvar gamegrid-score-file-length 50
"Number of high scores to keep")
(defvar gamegrid-user-score-file-directory "~/.emacs.d/games"
(defvar gamegrid-user-score-file-directory
(concat user-emacs-directory "games")
"A directory for game scores which can't be shared.
If Emacs was built without support for shared game scores, then this
directory will be used.")

2
lisp/progmodes/python.el
View File

@ -1925,7 +1925,7 @@ Repeating the command scrolls the completion window."
(interactive)
(let ((window (get-buffer-window "*Completions*")))
(if (and (eq last-command this-command)
window (window-live-p window) (window-buffer window)
(window-live-p window) (window-buffer window)
(buffer-name (window-buffer window)))
(with-current-buffer (window-buffer window)
(if (pos-visible-in-window-p (point-max) window)

217
lisp/progmodes/sh-script.el
View File

@ -235,7 +235,7 @@
(wsh . sh)
(zsh . ksh88)
(rpm . sh))
"*Alist showing the direct ancestor of various shells.
"Alist showing the direct ancestor of various shells.
This is the basis for `sh-feature'. See also `sh-alias-alist'.
By default we have the following three hierarchies:
@ -270,7 +270,7 @@ sh Bourne Shell
'((ksh . ksh88)
(bash2 . bash)
(sh5 . sh)))
"*Alist for transforming shell names to what they really are.
"Alist for transforming shell names to what they really are.
Use this where the name of the executable doesn't correspond to the type of
shell it really is."
:type '(repeat (cons symbol symbol))
@ -296,7 +296,7 @@ shell it really is."
(file-name-sans-extension (downcase shell)))))
(getenv "SHELL")
"/bin/sh")
"*The executable file name for the shell being programmed."
"The executable file name for the shell being programmed."
:type 'string
:group 'sh-script)
@ -315,7 +315,7 @@ shell it really is."
(wksh)
;; -f means don't run .zshrc.
(zsh . "-f"))
"*Single argument string for the magic number. See `sh-feature'."
"Single argument string for the magic number. See `sh-feature'."
:type '(repeat (cons (symbol :tag "Shell")
(choice (const :tag "No Arguments" nil)
(string :tag "Arguments")
@ -324,8 +324,8 @@ shell it really is."
(defcustom sh-imenu-generic-expression
`((sh
. ((nil "^\\s-*\\(function\\s-+\\)?\\([A-Za-z_][A-Za-z_0-9]+\\)\\s-*()" 2))))
"*Alist of regular expressions for recognizing shell function definitions.
. ((nil "^\\s-*\\(function\\s-+\\)?\\([[:alpha:]_][[:alnum:]_]+\\)\\s-*()" 2))))
"Alist of regular expressions for recognizing shell function definitions.
See `sh-feature' and `imenu-generic-expression'."
:type '(alist :key-type (symbol :tag "Shell")
:value-type (alist :key-type (choice :tag "Title"
@ -501,7 +501,7 @@ This is buffer-local in every such buffer.")
'(shell-dynamic-complete-environment-variable
shell-dynamic-complete-command
comint-dynamic-complete-filename)
"*Functions for doing TAB dynamic completion."
"Functions for doing TAB dynamic completion."
:type '(repeat function)
:group 'sh-script)
@ -509,7 +509,7 @@ This is buffer-local in every such buffer.")
(defcustom sh-require-final-newline
'((csh . t)
(pdksh . t))
"*Value of `require-final-newline' in Shell-Script mode buffers.
"Value of `require-final-newline' in Shell-Script mode buffers.
\(SHELL . t) means use the value of `mode-require-final-newline' for SHELL.
See `sh-feature'."
:type '(repeat (cons (symbol :tag "Shell")
@ -519,12 +519,12 @@ See `sh-feature'."
(defcustom sh-assignment-regexp
'((csh . "\\<\\([a-zA-Z0-9_]+\\)\\(\\[.+\\]\\)?[ \t]*[-+*/%^]?=")
'((csh . "\\<\\([[:alnum:]_]+\\)\\(\\[.+\\]\\)?[ \t]*[-+*/%^]?=")
;; actually spaces are only supported in let/(( ... ))
(ksh88 . "\\<\\([a-zA-Z0-9_]+\\)\\(\\[.+\\]\\)?[ \t]*\\([-+*/%&|~^]\\|<<\\|>>\\)?=")
(rc . "\\<\\([a-zA-Z0-9_*]+\\)[ \t]*=")
(sh . "\\<\\([a-zA-Z0-9_]+\\)="))
"*Regexp for the variable name and what may follow in an assignment.
(ksh88 . "\\<\\([[:alnum:]_]+\\)\\(\\[.+\\]\\)?[ \t]*\\([-+*/%&|~^]\\|<<\\|>>\\)?=")
(rc . "\\<\\([[:alnum:]_*]+\\)[ \t]*=")
(sh . "\\<\\([[:alnum:]_]+\\)="))
"Regexp for the variable name and what may follow in an assignment.
First grouping matches the variable name. This is upto and including the `='
sign. See `sh-feature'."
:type '(repeat (cons (symbol :tag "Shell")
@ -540,7 +540,7 @@ sign. See `sh-feature'."
(defcustom sh-remember-variable-min 3
"*Don't remember variables less than this length for completing reads."
"Don't remember variables less than this length for completing reads."
:type 'integer
:group 'sh-script)
@ -551,16 +551,16 @@ That command is also used for setting this variable.")
(defcustom sh-beginning-of-command
"\\([;({`|&]\\|\\`\\|[^\\]\n\\)[ \t]*\\([/~a-zA-Z0-9:]\\)"
"*Regexp to determine the beginning of a shell command.
"\\([;({`|&]\\|\\`\\|[^\\]\n\\)[ \t]*\\([/~[:alnum:]:]\\)"
"Regexp to determine the beginning of a shell command.
The actual command starts at the beginning of the second \\(grouping\\)."
:type 'regexp
:group 'sh-script)
(defcustom sh-end-of-command
"\\([/~a-zA-Z0-9:]\\)[ \t]*\\([;#)}`|&]\\|$\\)"
"*Regexp to determine the end of a shell command.
"\\([/~[:alnum:]:]\\)[ \t]*\\([;#)}`|&]\\|$\\)"
"Regexp to determine the end of a shell command.
The actual command ends at the end of the first \\(grouping\\)."
:type 'regexp
:group 'sh-script)
@ -647,6 +647,7 @@ removed when closing the here document."
(shell "cd" "echo" "eval" "set" "shift" "umask" "unset" "wait")
(wksh sh-append ksh88
;; FIXME: This looks too much like a regexp. --Stef
"Xt[A-Z][A-Za-z]*")
(zsh sh-append ksh88
@ -656,7 +657,7 @@ removed when closing the here document."
"readonly" "rehash" "sched" "setopt" "source" "suspend" "true"
"ttyctl" "type" "unfunction" "unhash" "unlimit" "unsetopt" "vared"
"which"))
"*List of all shell builtins for completing read and fontification.
"List of all shell builtins for completing read and fontification.
Note that on some systems not all builtins are available or some are
implemented as aliases. See `sh-feature'."
:type '(repeat (cons (symbol :tag "Shell")
@ -677,7 +678,7 @@ implemented as aliases. See `sh-feature'."
(rc "else")
(sh "!" "do" "elif" "else" "if" "then" "trap" "type" "until" "while"))
"*List of keywords that may be immediately followed by a builtin or keyword.
"List of keywords that may be immediately followed by a builtin or keyword.
Given some confusion between keywords and builtins depending on shell and
system, the distinction here has been based on whether they influence the
flow of control or syntax. See `sh-feature'."
@ -716,7 +717,7 @@ flow of control or syntax. See `sh-feature'."
(zsh sh-append bash
"select"))
"*List of keywords not in `sh-leading-keywords'.
"List of keywords not in `sh-leading-keywords'.
See `sh-feature'."
:type '(repeat (cons (symbol :tag "Shell")
(choice (repeat string)
@ -837,18 +838,18 @@ See `sh-feature'.")
(defvar sh-font-lock-keywords-var
'((csh sh-append shell
("\\${?[#?]?\\([A-Za-z_][A-Za-z0-9_]*\\|0\\)" 1
("\\${?[#?]?\\([[:alpha:]_][[:alnum:]_]*\\|0\\)" 1
font-lock-variable-name-face))
(es sh-append executable-font-lock-keywords
("\\$#?\\([A-Za-z_][A-Za-z0-9_]*\\|[0-9]+\\)" 1
("\\$#?\\([[:alpha:]_][[:alnum:]_]*\\|[0-9]+\\)" 1
font-lock-variable-name-face))
(rc sh-append es)
(bash sh-append shell ("\\$(\\(\\sw+\\)" (1 'sh-quoted-exec t) ))
(sh sh-append shell
;; Variable names.
("\\$\\({#?\\)?\\([A-Za-z_][A-Za-z0-9_]*\\|[-#?@!]\\)" 2
("\\$\\({#?\\)?\\([[:alpha:]_][[:alnum:]_]*\\|[-#?@!]\\)" 2
font-lock-variable-name-face)
;; Function names.
("^\\(\\sw+\\)[ \t]*(" 1 font-lock-function-name-face)
@ -861,8 +862,8 @@ See `sh-feature'.")
(shell
;; Using font-lock-string-face here confuses sh-get-indent-info.
("\\(^\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\\\)$" 3 'sh-escaped-newline)
("\\\\[^A-Za-z0-9]" 0 font-lock-string-face)
("\\${?\\([A-Za-z_][A-Za-z0-9_]*\\|[0-9]+\\|[$*_]\\)" 1
("\\\\[^[:alnum:]]" 0 font-lock-string-face)
("\\${?\\([[:alpha:]_][[:alnum:]_]*\\|[0-9]+\\|[$*_]\\)" 1
font-lock-variable-name-face))
(rpm sh-append rpm2
("%{?\\(\\sw+\\)" 1 font-lock-keyword-face))
@ -884,7 +885,7 @@ See `sh-feature'.")
(defconst sh-here-doc-syntax (string-to-syntax "|")) ;; generic string
(defconst sh-escaped-line-re
;; Should match until the real end-of-continued line, but if that is not
;; Should match until the real end-of-continued-line, but if that is not
;; possible (because we bump into EOB or the search bound), then we should
;; match until the search bound.
"\\(?:\\(?:.*[^\\\n]\\)?\\(?:\\\\\\\\\\)*\\\\\n\\)*.*")
@ -991,46 +992,38 @@ subshells can nest."
(eq ?\" (nth 3 (syntax-ppss))))
;; bingo we have a $( or a ` inside a ""
(let ((char (char-after (point)))
(continue t)
(pos (point))
(data nil) ;; value to put into match-data (and return)
(last nil) ;; last char seen
(bq (equal (match-string 1) "`")) ;; ` state flip-flop
(seen nil) ;; list of important positions
(nest 1)) ;; subshell nesting level
(while (and continue char (<= pos limit))
;; unescaped " inside a $( ... ) construct.
;; state machine time...
;; \ => ignore next char;
;; ` => increase or decrease nesting level based on bq flag
;; ) [where nesting > 0] => decrease nesting
;; ( [where nesting > 0] => increase nesting
;; ( [preceeded by $ ] => increase nesting
;; " [nesting <= 0 ] => terminate, we're done.
;; " [nesting > 0 ] => remember this, it's not a proper "
;; FIXME: don't count parens that appear within quotes.
(cond
((eq ?\\ last) nil)
((eq ?\` char) (setq nest (+ nest (if bq -1 1)) bq (not bq)))
((and (> nest 0) (eq ?\) char)) (setq nest (1- nest)))
((and (eq ?$ last) (eq ?\( char)) (setq nest (1+ nest)))
((and (> nest 0) (eq ?\( char)) (setq nest (1+ nest)))
((eq char ?\")
(if (>= 0 nest) (setq continue nil) (push pos seen))))
;;(message "POS: %d [%d]" pos nest)
(setq last char
pos (1+ pos)
char (char-after pos)) )
;; FIXME: why construct a costly match data to pass to
;; sh-apply-quoted-subshell rather than apply the highlight
;; directly here? -- Stef
(when seen
;;(message "SEEN: %S" seen)
(setq data (list (current-buffer)))
(dolist(P seen)
(setq data (cons P (cons (1+ P) data))))
(store-match-data data))
data) ))
;; `state' can be: double-quote, backquote, code.
(state (if (eq (char-before) ?`) 'backquote 'code))
;; Stacked states in the context.
(states '(double-quote)))
(while (and state (progn (skip-chars-forward "^'\\\"`$()" limit)
(< (point) limit)))
;; unescape " inside a $( ... ) construct.
(case (char-after)
(?\' (skip-chars-forward "^'" limit))
(?\\ (forward-char 1))
(?\" (case state
(double-quote (setq state (pop states)))
(t (push state states) (setq state 'double-quote)))
(if state (put-text-property (point) (1+ (point))
'syntax-table '(1))))
(?\` (case state
(backquote (setq state (pop states)))
(t (push state states) (setq state 'backquote))))
(?\$ (if (not (eq (char-after (1+ (point))) ?\())
nil
(case state
(t (push state states) (setq state 'code)))))
(?\( (case state
(double-quote nil)
(t (push state states) (setq state 'code))))
(?\) (case state
(double-quote nil)
(t (setq state (pop states)))))
(t (error "Internal error in sh-quoted-subshell")))
(forward-char 1)))
t))
(defun sh-is-quoted-p (pos)
(and (eq (char-before pos) ?\\)
@ -1062,16 +1055,18 @@ subshells can nest."
(when (save-excursion (backward-char 2) (looking-at ";;\\|in"))
sh-st-punc)))
(defun sh-apply-quoted-subshell ()
"Apply the `sh-st-punc' syntax to all the matches in `match-data'.
This is used to flag quote characters in subshell constructs inside strings
\(which should therefore not be treated as normal quote characters\)"
(let ((m (match-data)) a b)
(while m
(setq a (car m)
b (cadr m)
m (cddr m))
(put-text-property a b 'syntax-table sh-st-punc))) sh-st-punc)
(defun sh-font-lock-backslash-quote ()
(if (eq (save-excursion (nth 3 (syntax-ppss (match-beginning 0)))) ?\')
;; In a '...' the backslash is not escaping.
sh-st-punc
nil))
(defun sh-font-lock-flush-syntax-ppss-cache (limit)
;; This should probably be a standard function provided by font-lock.el
;; (or syntax.el).
(syntax-ppss-flush-cache (point))
(goto-char limit)
nil)
(defconst sh-font-lock-syntactic-keywords
;; A `#' begins a comment when it is unquoted and at the beginning of a
@ -1080,7 +1075,11 @@ This is used to flag quote characters in subshell constructs inside strings
;; of the shell command language (under `quoting') but with `$' removed.
`(("[^|&;<>()`\\\"' \t\n]\\(#+\\)" 1 ,sh-st-symbol)
;; In a '...' the backslash is not escaping.
("\\(\\\\\\)'" 1 ,sh-st-punc)
("\\(\\\\\\)'" (1 (sh-font-lock-backslash-quote)))
;; The previous rule uses syntax-ppss, but the subsequent rules may
;; change the syntax, so we have to tell syntax-ppss that the states it
;; has just computed will need to be recomputed.
(sh-font-lock-flush-syntax-ppss-cache)
;; Make sure $@ and @? are correctly recognized as sexps.
("\\$\\([?@]\\)" 1 ,sh-st-symbol)
;; Find HEREDOC starters and add a corresponding rule for the ender.
@ -1095,8 +1094,7 @@ This is used to flag quote characters in subshell constructs inside strings
(")" 0 (sh-font-lock-paren (match-beginning 0)))
;; highlight (possibly nested) subshells inside "" quoted regions correctly.
;; This should be at the very end because it uses syntax-ppss.
(sh-quoted-subshell
(1 (sh-apply-quoted-subshell) t t))))
(sh-quoted-subshell)))
(defun sh-font-lock-syntactic-face-function (state)
(let ((q (nth 3 state)))
@ -1117,17 +1115,17 @@ and command `sh-reset-indent-vars-to-global-values'."
(defcustom sh-set-shell-hook nil
"*Hook run by `sh-set-shell'."
"Hook run by `sh-set-shell'."
:type 'hook
:group 'sh-script)
(defcustom sh-mode-hook nil
"*Hook run by `sh-mode'."
"Hook run by `sh-mode'."
:type 'hook
:group 'sh-script)
(defcustom sh-learn-basic-offset nil
"*When `sh-guess-basic-offset' should learn `sh-basic-offset'.
"When `sh-guess-basic-offset' should learn `sh-basic-offset'.
nil mean: never.
t means: only if there seems to be an obvious value.
@ -1139,7 +1137,7 @@ Anything else means: whenever we have a \"good guess\" as to the value."
:group 'sh-indentation)
(defcustom sh-popup-occur-buffer nil
"*Controls when `sh-learn-buffer-indent' pops the `*indent*' buffer.
"Controls when `sh-learn-buffer-indent' pops the `*indent*' buffer.
If t it is always shown. If nil, it is shown only when there
are conflicts."
:type '(choice
@ -1148,7 +1146,7 @@ are conflicts."
:group 'sh-indentation)
(defcustom sh-blink t
"*If non-nil, `sh-show-indent' shows the line indentation is relative to.
"If non-nil, `sh-show-indent' shows the line indentation is relative to.
The position on the line is not necessarily meaningful.
In some cases the line will be the matching keyword, but this is not
always the case."
@ -1156,7 +1154,7 @@ always the case."
:group 'sh-indentation)
(defcustom sh-first-lines-indent 0
"*The indentation of the first non-blank non-comment line.
"The indentation of the first non-blank non-comment line.
Usually 0 meaning first column.
Can be set to a number, or to nil which means leave it as is."
:type '(choice
@ -1167,13 +1165,13 @@ Can be set to a number, or to nil which means leave it as is."
(defcustom sh-basic-offset 4
"*The default indentation increment.
"The default indentation increment.
This value is used for the `+' and `-' symbols in an indentation variable."
:type 'integer
:group 'sh-indentation)
(defcustom sh-indent-comment nil
"*How a comment line is to be indented.
"How a comment line is to be indented.
nil means leave it as it is;
t means indent it as a normal line, aligning it to previous non-blank
non-comment line;
@ -1212,7 +1210,7 @@ a number means align to that column, e.g. 0 means fist column."
:menu-tag "/ Indent left half sh-basic-offset")))
(defcustom sh-indent-for-else 0
"*How much to indent an `else' relative to its `if'. Usually 0."
"How much to indent an `else' relative to its `if'. Usually 0."
:type `(choice
(integer :menu-tag "A number (positive=>indent right)"
:tag "A number")
@ -1228,41 +1226,41 @@ a number means align to that column, e.g. 0 means fist column."
sh-symbol-list))
(defcustom sh-indent-for-fi 0
"*How much to indent a `fi' relative to its `if'. Usually 0."
"How much to indent a `fi' relative to its `if'. Usually 0."
:type `(choice ,@ sh-number-or-symbol-list )
:group 'sh-indentation)
(defcustom sh-indent-for-done 0
"*How much to indent a `done' relative to its matching stmt. Usually 0."
"How much to indent a `done' relative to its matching stmt. Usually 0."
:type `(choice ,@ sh-number-or-symbol-list )
:group 'sh-indentation)
(defcustom sh-indent-after-else '+
"*How much to indent a statement after an `else' statement."
"How much to indent a statement after an `else' statement."
:type `(choice ,@ sh-number-or-symbol-list )
:group 'sh-indentation)
(defcustom sh-indent-after-if '+
"*How much to indent a statement after an `if' statement.
"How much to indent a statement after an `if' statement.
This includes lines after `else' and `elif' statements, too, but
does not affect the `else', `elif' or `fi' statements themselves."
:type `(choice ,@ sh-number-or-symbol-list )
:group 'sh-indentation)
(defcustom sh-indent-for-then 0
"*How much to indent a `then' relative to its `if'."
"How much to indent a `then' relative to its `if'."
:type `(choice ,@ sh-number-or-symbol-list )
:group 'sh-indentation)
(defcustom sh-indent-for-do 0
"*How much to indent a `do' statement.
"How much to indent a `do' statement.
This is relative to the statement before the `do', typically a
`while', `until', `for', `repeat' or `select' statement."
:type `(choice ,@ sh-number-or-symbol-list)
:group 'sh-indentation)
(defcustom sh-indent-after-do '+
"*How much to indent a line after a `do' statement.
"How much to indent a line after a `do' statement.
This is used when the `do' is the first word of the line.
This is relative to the statement before the `do', typically a
`while', `until', `for', `repeat' or `select' statement."
@ -1270,7 +1268,7 @@ This is relative to the statement before the `do', typically a
:group 'sh-indentation)
(defcustom sh-indent-after-loop-construct '+
"*How much to indent a statement after a loop construct.
"How much to indent a statement after a loop construct.
This variable is used when the keyword `do' is on the same line as the
loop statement (e.g., `until', `while' or `for').
@ -1280,7 +1278,7 @@ If the `do' is on a line by itself, then `sh-indent-after-do' is used instead."
(defcustom sh-indent-after-done 0
"*How much to indent a statement after a `done' keyword.
"How much to indent a statement after a `done' keyword.
Normally this is 0, which aligns the `done' to the matching
looping construct line.
Setting it non-zero allows you to have the `do' statement on a line
@ -1289,55 +1287,55 @@ by itself and align the done under to do."
:group 'sh-indentation)
(defcustom sh-indent-for-case-label '+
"*How much to indent a case label statement.
"How much to indent a case label statement.
This is relative to the line containing the `case' statement."
:type `(choice ,@ sh-number-or-symbol-list)
:group 'sh-indentation)
(defcustom sh-indent-for-case-alt '++
"*How much to indent statements after the case label.
"How much to indent statements after the case label.
This is relative to the line containing the `case' statement."
:type `(choice ,@ sh-number-or-symbol-list)
:group 'sh-indentation)
(defcustom sh-indent-for-continuation '+
"*How much to indent for a continuation statement."
"How much to indent for a continuation statement."
:type `(choice ,@ sh-number-or-symbol-list)
:group 'sh-indentation)
(defcustom sh-indent-after-open '+
"*How much to indent after a line with an opening parenthesis or brace.
"How much to indent after a line with an opening parenthesis or brace.
For an open paren after a function, `sh-indent-after-function' is used."
:type `(choice ,@ sh-number-or-symbol-list)
:group 'sh-indentation)
(defcustom sh-indent-after-function '+
"*How much to indent after a function line."
"How much to indent after a function line."
:type `(choice ,@ sh-number-or-symbol-list)
:group 'sh-indentation)
;; These 2 are for the rc shell:
(defcustom sh-indent-after-switch '+
"*How much to indent a `case' statement relative to the `switch' statement.
"How much to indent a `case' statement relative to the `switch' statement.
This is for the rc shell."
:type `(choice ,@ sh-number-or-symbol-list)
:group 'sh-indentation)
(defcustom sh-indent-after-case '+
"*How much to indent a statement relative to the `case' statement.
"How much to indent a statement relative to the `case' statement.
This is for the rc shell."
:type `(choice ,@ sh-number-or-symbol-list)
:group 'sh-indentation)
(defcustom sh-backslash-column 48
"*Column in which `sh-backslash-region' inserts backslashes."
"Column in which `sh-backslash-region' inserts backslashes."
:type 'integer
:group 'sh)
(defcustom sh-backslash-align t
"*If non-nil, `sh-backslash-region' will align backslashes."
"If non-nil, `sh-backslash-region' will align backslashes."
:type 'boolean
:group 'sh)
@ -1347,7 +1345,7 @@ This is for the rc shell."
"Make a regexp which matches WORD as a word.
This specifically excludes an occurrence of WORD followed by
punctuation characters like '-'."
(concat word "\\([^-a-z0-9_]\\|$\\)"))
(concat word "\\([^-[:alnum:]_]\\|$\\)"))
(defconst sh-re-done (sh-mkword-regexpr "done"))
@ -2234,6 +2232,7 @@ STRING This is ignored for the purposes of calculating
(setq align-point (point))))
(or (bobp)
(forward-char -1))
;; FIXME: This charset looks too much like a regexp. --Stef
(skip-chars-forward "[a-z0-9]*?")
)
((string-match "[])}]" x)
@ -2442,7 +2441,7 @@ we go to the end of the previous line and do not check for continuations."
(if (looking-at "[\"'`]")
(sh-safe-forward-sexp)
;; (> (skip-chars-forward "^ \t\n\"'`") 0)
(> (skip-chars-forward "-_a-zA-Z$0-9") 0)
(> (skip-chars-forward "-_$[:alnum:]") 0)
))
(buffer-substring start (point))
))

4
lisp/savehist.el
View File

@ -101,8 +101,8 @@ minibuffer histories, such as `compile-command' or `kill-ring'."
(cond
;; Backward compatibility with previous versions of savehist.
((file-exists-p "~/.emacs-history") "~/.emacs-history")
((and (not (featurep 'xemacs)) (file-directory-p "~/.emacs.d/"))
"~/.emacs.d/history")
((and (not (featurep 'xemacs)) (file-directory-p user-emacs-directory))
(concat user-emacs-directory "history"))
((and (featurep 'xemacs) (file-directory-p "~/.xemacs/"))
"~/.xemacs/history")
;; For users without `~/.emacs.d/' or `~/.xemacs/'.

2
lisp/scroll-lock.el
View File

@ -50,7 +50,7 @@
;;;###autoload
(define-minor-mode scroll-lock-mode
"Minor mode for pager-like scrolling.
"Buffer-local minor mode for pager-like scrolling.
Keys which normally move point by line or paragraph will scroll
the buffer by the respective amount of lines instead and point
will be kept vertically fixed relative to window boundaries

5
lisp/server.el
View File

@ -106,7 +106,7 @@ If set, the server accepts remote connections; otherwise it is local."
:version "22.1")
(put 'server-host 'risky-local-variable t)
(defcustom server-auth-dir "~/.emacs.d/server/"
(defcustom server-auth-dir (concat user-emacs-directory "server/")
"Directory for server authentication files."
:group 'server
:type 'directory
@ -1183,8 +1183,7 @@ done that."
(select-window win)
(set-buffer next-buffer))
;; Otherwise, let's find an appropriate window.
(cond ((and (windowp server-window)
(window-live-p server-window))
(cond ((window-live-p server-window)
(select-window server-window))
((framep server-window)
(unless (frame-live-p server-window)

2
lisp/shell.el
View File

@ -557,7 +557,7 @@ Otherwise, one argument `-i' is passed to the shell.
(startfile (concat "~/.emacs_" name))
(xargs-name (intern-soft (concat "explicit-" name "-args"))))
(unless (file-exists-p startfile)
(setq startfile (concat "~/.emacs.d/init_" name ".sh")))
(setq startfile (concat user-emacs-directory "init_" name ".sh")))
(apply 'make-comint-in-buffer "shell" buffer prog
(if (file-exists-p startfile) startfile)
(if (and xargs-name (boundp xargs-name))

4
lisp/startup.el
View File

@ -270,9 +270,9 @@ init file is read, in case it sets `mail-host-address'."
(defcustom auto-save-list-file-prefix
(cond ((eq system-type 'ms-dos)
;; MS-DOS cannot have initial dot, and allows only 8.3 names
"~/_emacs.d/auto-save.list/_s")
(concat user-emacs-directory "auto-save.list/_s"))
(t
"~/.emacs.d/auto-save-list/.saves-"))
(concat user-emacs-directory "auto-save-list/.saves-")))
"Prefix for generating `auto-save-list-file-name'.
This is used after reading your `.emacs' file to initialize
`auto-save-list-file-name', by appending Emacs's pid and the system name,

9
lisp/subr.el
View File

@ -2041,6 +2041,15 @@ On other systems, this variable is normally always nil.")
(put 'cl-assertion-failed 'error-conditions '(error))
(put 'cl-assertion-failed 'error-message "Assertion failed")
(defconst user-emacs-directory
(if (eq system-type 'ms-dos)
;; MS-DOS cannot have initial dot.
"~/_emacs.d/"
"~/.emacs.d/")
"Directory beneath which additional per-user Emacs-specific files are placed.
Various programs in Emacs store information in this directory.
Note that this should end with a directory separator.")
;;;; Misc. useful functions.

2
lisp/term/mac-win.el
View File

@ -2255,7 +2255,7 @@ See also `mac-dnd-known-types'."
(handler (cdr type-info))
(w (posn-window (event-start event))))
(when handler
(if (and (windowp w) (window-live-p w)
(if (and (window-live-p w)
(not (window-minibuffer-p w))
(not (window-dedicated-p w)))
;; If dropping in an ordinary window which we could use,

2
lisp/term/x-win.el
View File

@ -269,7 +269,7 @@ See also `emacs-session-save'.")
If the directory ~/.emacs.d exists, we make a filename in there, otherwise
a file in the home directory."
(let ((basename (concat "session." session-id))
(emacs-dir "~/.emacs.d/"))
(emacs-dir user-emacs-directory))
(expand-file-name (if (file-directory-p emacs-dir)
(concat emacs-dir basename)
(concat "~/.emacs-" basename)))))

305
lisp/term/xterm.el
View File

@ -391,12 +391,305 @@
(substitute-key-definition [f59] [A-f11] local-function-key-map)
(substitute-key-definition [f60] [A-f12] local-function-key-map)
;; Use inheritance to let the main keymap override those defaults.
;; This way we don't override terminfo-derived settings or settings
;; made in the .emacs file.
(let ((m (copy-keymap xterm-function-map)))
(set-keymap-parent m (keymap-parent local-function-key-map))
(set-keymap-parent local-function-key-map m)))
(let ((map (make-sparse-keymap)))
;; Use inheritance to let the main keymap override those defaults.
;; This way we don't override terminfo-derived settings or settings
;; made in the .emacs file.
(set-keymap-parent map (keymap-parent local-function-key-map))
(set-keymap-parent local-function-key-map map)
;; xterm from X.org 6.8.2 uses these key definitions.
(define-key map "\eOP" [f1])
(define-key map "\eOQ" [f2])
(define-key map "\eOR" [f3])
(define-key map "\eOS" [f4])
(define-key map "\e[15~" [f5])
(define-key map "\e[17~" [f6])
(define-key map "\e[18~" [f7])
(define-key map "\e[19~" [f8])
(define-key map "\e[20~" [f9])
(define-key map "\e[21~" [f10])
(define-key map "\e[23~" [f11])
(define-key map "\e[24~" [f12])
(define-key map "\eO2P" [S-f1])
(define-key map "\eO2Q" [S-f2])
(define-key map "\eO2R" [S-f3])
(define-key map "\eO2S" [S-f4])
(define-key map "\e[1;2P" [S-f1])
(define-key map "\e[1;2Q" [S-f2])
(define-key map "\e[1;2R" [S-f3])
(define-key map "\e[1;2S" [S-f4])
(define-key map "\e[15;2~" [S-f5])
(define-key map "\e[17;2~" [S-f6])
(define-key map "\e[18;2~" [S-f7])
(define-key map "\e[19;2~" [S-f8])
(define-key map "\e[20;2~" [S-f9])
(define-key map "\e[21;2~" [S-f10])
(define-key map "\e[23;2~" [S-f11])
(define-key map "\e[24;2~" [S-f12])
(define-key map "\eO5P" [C-f1])
(define-key map "\eO5Q" [C-f2])
(define-key map "\eO5R" [C-f3])
(define-key map "\eO5S" [C-f4])
(define-key map "\e[15;5~" [C-f5])
(define-key map "\e[17;5~" [C-f6])
(define-key map "\e[18;5~" [C-f7])
(define-key map "\e[19;5~" [C-f8])
(define-key map "\e[20;5~" [C-f9])
(define-key map "\e[21;5~" [C-f10])
(define-key map "\e[23;5~" [C-f11])
(define-key map "\e[24;5~" [C-f12])
(define-key map "\eO6P" [C-S-f1])
(define-key map "\eO6Q" [C-S-f2])
(define-key map "\eO6R" [C-S-f3])
(define-key map "\eO6S" [C-S-f4])
(define-key map "\e[15;6~" [C-S-f5])
(define-key map "\e[17;6~" [C-S-f6])
(define-key map "\e[18;6~" [C-S-f7])
(define-key map "\e[19;6~" [C-S-f8])
(define-key map "\e[20;6~" [C-S-f9])
(define-key map "\e[21;6~" [C-S-f10])
(define-key map "\e[23;6~" [C-S-f11])
(define-key map "\e[24;6~" [C-S-f12])
(define-key map "\eO3P" [A-f1])
(define-key map "\eO3Q" [A-f2])
(define-key map "\eO3R" [A-f3])
(define-key map "\eO3S" [A-f4])
(define-key map "\e[15;3~" [A-f5])
(define-key map "\e[17;3~" [A-f6])
(define-key map "\e[18;3~" [A-f7])
(define-key map "\e[19;3~" [A-f8])
(define-key map "\e[20;3~" [A-f9])
(define-key map "\e[21;3~" [A-f10])
(define-key map "\e[23;3~" [A-f11])
(define-key map "\e[24;3~" [A-f12])
(define-key map "\eOA" [up])
(define-key map "\eOB" [down])
(define-key map "\eOC" [right])
(define-key map "\eOD" [left])
(define-key map "\eOF" [end])
(define-key map "\eOH" [home])
(define-key map "\e[1;2A" [S-up])
(define-key map "\e[1;2B" [S-down])
(define-key map "\e[1;2C" [S-right])
(define-key map "\e[1;2D" [S-left])
(define-key map "\e[1;2F" [S-end])
(define-key map "\e[1;2H" [S-home])
(define-key map "\e[1;5A" [C-up])
(define-key map "\e[1;5B" [C-down])
(define-key map "\e[1;5C" [C-right])
(define-key map "\e[1;5D" [C-left])
(define-key map "\e[1;5F" [C-end])
(define-key map "\e[1;5H" [C-home])
(define-key map "\e[1;6A" [C-S-up])
(define-key map "\e[1;6B" [C-S-down])
(define-key map "\e[1;6C" [C-S-right])
(define-key map "\e[1;6D" [C-S-left])
(define-key map "\e[1;6F" [C-S-end])
(define-key map "\e[1;6H" [C-S-home])
(define-key map "\e[1;3A" [A-up])
(define-key map "\e[1;3B" [A-down])
(define-key map "\e[1;3C" [A-right])
(define-key map "\e[1;3D" [A-left])
(define-key map "\e[1;3F" [A-end])
(define-key map "\e[1;3H" [A-home])
(define-key map "\e[2~" [insert])
(define-key map "\e[3~" [delete])
(define-key map "\e[5~" [prior])
(define-key map "\e[6~" [next])
(define-key map "\e[2;2~" [S-insert])
(define-key map "\e[3;2~" [S-delete])
(define-key map "\e[5;2~" [S-prior])
(define-key map "\e[6;2~" [S-next])
(define-key map "\e[2;5~" [C-insert])
(define-key map "\e[3;5~" [C-delete])
(define-key map "\e[5;5~" [C-prior])
(define-key map "\e[6;5~" [C-next])
(define-key map "\e[2;6~" [C-S-insert])
(define-key map "\e[3;6~" [C-S-delete])
(define-key map "\e[5;6~" [C-S-prior])
(define-key map "\e[6;6~" [C-S-next])
(define-key map "\e[2;3~" [A-insert])
(define-key map "\e[3;3~" [A-delete])
(define-key map "\e[5;3~" [A-prior])
(define-key map "\e[6;3~" [A-next])
(define-key map "\e[4~" [select])
(define-key map "\e[29~" [print])
(define-key map "\eOj" [kp-multiply])
(define-key map "\eOk" [kp-add])
(define-key map "\eOl" [kp-separator])
(define-key map "\eOm" [kp-subtract])
(define-key map "\eOo" [kp-divide])
(define-key map "\eOp" [kp-0])
(define-key map "\eOq" [kp-1])
(define-key map "\eOr" [kp-2])
(define-key map "\eOs" [kp-3])
(define-key map "\eOt" [kp-4])
(define-key map "\eOu" [kp-5])
(define-key map "\eOv" [kp-6])
(define-key map "\eOw" [kp-7])
(define-key map "\eOx" [kp-8])
(define-key map "\eOy" [kp-9])
;; These keys are available in xterm starting from version 216
;; if the modifyOtherKeys resource is set to 1.
(define-key map "\e[27;5;9~" [C-tab])
(define-key map "\e[27;5;13~" [C-return])
(define-key map "\e[27;5;39~" [?\C-\'])
(define-key map "\e[27;5;44~" [?\C-,])
(define-key map "\e[27;5;45~" [?\C--])
(define-key map "\e[27;5;46~" [?\C-.])
(define-key map "\e[27;5;47~" [?\C-/])
(define-key map "\e[27;5;48~" [?\C-0])
(define-key map "\e[27;5;49~" [?\C-1])
;; Not all C-DIGIT keys have a distinct binding.
(define-key map "\e[27;5;57~" [?\C-9])
(define-key map "\e[27;5;59~" [?\C-\;])
(define-key map "\e[27;5;61~" [?\C-=])
(define-key map "\e[27;5;92~" [?\C-\\])
(define-key map "\e[27;6;33~" [?\C-!])
(define-key map "\e[27;6;34~" [?\C-\"])
(define-key map "\e[27;6;35~" [?\C-#])
(define-key map "\e[27;6;36~" [?\C-$])
(define-key map "\e[27;6;37~" [?\C-%])
(define-key map "\e[27;6;38~" [?\C-&])
(define-key map "\e[27;6;40~" [?\C-\(])
(define-key map "\e[27;6;41~" [?\C-\)])
(define-key map "\e[27;6;42~" [?\C-*])
(define-key map "\e[27;6;43~" [?\C-+])
(define-key map "\e[27;6;58~" [?\C-:])
(define-key map "\e[27;6;60~" [?\C-<])
(define-key map "\e[27;6;62~" [?\C->])
(define-key map "\e[27;6;63~" [(control ??)])
;; These are the strings emitted for various C-M- combinations
;; for keyboards that the Meta and Alt modifiers are on the same
;; key (usually labeled "Alt").
(define-key map "\e[27;13;9~" [C-M-tab])
(define-key map "\e[27;13;13~" [C-M-return])
(define-key map "\e[27;13;39~" [?\C-\M-\'])
(define-key map "\e[27;13;44~" [?\C-\M-,])
(define-key map "\e[27;13;45~" [?\C-\M--])
(define-key map "\e[27;13;46~" [?\C-\M-.])
(define-key map "\e[27;13;47~" [?\C-\M-/])
(define-key map "\e[27;13;48~" [?\C-\M-0])
(define-key map "\e[27;13;49~" [?\C-\M-1])
(define-key map "\e[27;13;50~" [?\C-\M-2])
(define-key map "\e[27;13;51~" [?\C-\M-3])
(define-key map "\e[27;13;52~" [?\C-\M-4])
(define-key map "\e[27;13;53~" [?\C-\M-5])
(define-key map "\e[27;13;54~" [?\C-\M-6])
(define-key map "\e[27;13;55~" [?\C-\M-7])
(define-key map "\e[27;13;56~" [?\C-\M-8])
(define-key map "\e[27;13;57~" [?\C-\M-9])
(define-key map "\e[27;13;59~" [?\C-\M-\;])
(define-key map "\e[27;13;61~" [?\C-\M-=])
(define-key map "\e[27;13;92~" [?\C-\M-\\])
(define-key map "\e[27;14;33~" [?\C-\M-!])
(define-key map "\e[27;14;34~" [?\C-\M-\"])
(define-key map "\e[27;14;35~" [?\C-\M-#])
(define-key map "\e[27;14;36~" [?\C-\M-$])
(define-key map "\e[27;14;37~" [?\C-\M-%])
(define-key map "\e[27;14;38~" [?\C-\M-&])
(define-key map "\e[27;14;40~" [?\C-\M-\(])
(define-key map "\e[27;14;41~" [?\C-\M-\)])
(define-key map "\e[27;14;42~" [?\C-\M-*])
(define-key map "\e[27;14;43~" [?\C-\M-+])
(define-key map "\e[27;14;58~" [?\C-\M-:])
(define-key map "\e[27;14;60~" [?\C-\M-<])
(define-key map "\e[27;14;62~" [?\C-\M->])
(define-key map "\e[27;14;63~" [(control meta ??)])
(define-key map "\e[27;7;9~" [C-M-tab])
(define-key map "\e[27;7;13~" [C-M-return])
(define-key map "\e[27;7;32~" [?\C-\M-\s])
(define-key map "\e[27;7;39~" [?\C-\M-\'])
(define-key map "\e[27;7;44~" [?\C-\M-,])
(define-key map "\e[27;7;45~" [?\C-\M--])
(define-key map "\e[27;7;46~" [?\C-\M-.])
(define-key map "\e[27;7;47~" [?\C-\M-/])
(define-key map "\e[27;7;48~" [?\C-\M-0])
(define-key map "\e[27;7;49~" [?\C-\M-1])
(define-key map "\e[27;7;50~" [?\C-\M-2])
(define-key map "\e[27;7;51~" [?\C-\M-3])
(define-key map "\e[27;7;52~" [?\C-\M-4])
(define-key map "\e[27;7;53~" [?\C-\M-5])
(define-key map "\e[27;7;54~" [?\C-\M-6])
(define-key map "\e[27;7;55~" [?\C-\M-7])
(define-key map "\e[27;7;56~" [?\C-\M-8])
(define-key map "\e[27;7;57~" [?\C-\M-9])
(define-key map "\e[27;7;59~" [?\C-\M-\;])
(define-key map "\e[27;7;61~" [?\C-\M-=])
(define-key map "\e[27;7;92~" [?\C-\M-\\])
(define-key map "\e[27;8;33~" [?\C-\M-!])
(define-key map "\e[27;8;34~" [?\C-\M-\"])
(define-key map "\e[27;8;35~" [?\C-\M-#])
(define-key map "\e[27;8;36~" [?\C-\M-$])
(define-key map "\e[27;8;37~" [?\C-\M-%])
(define-key map "\e[27;8;38~" [?\C-\M-&])
(define-key map "\e[27;8;40~" [?\C-\M-\(])
(define-key map "\e[27;8;41~" [?\C-\M-\)])
(define-key map "\e[27;8;42~" [?\C-\M-*])
(define-key map "\e[27;8;43~" [?\C-\M-+])
(define-key map "\e[27;8;58~" [?\C-\M-:])
(define-key map "\e[27;8;60~" [?\C-\M-<])
(define-key map "\e[27;8;62~" [?\C-\M->])
(define-key map "\e[27;8;63~" [(control meta ??)])
(define-key map "\e[27;2;9~" [S-tab])
(define-key map "\e[27;2;13~" [S-return])
(define-key map "\e[27;6;9~" [C-S-tab])
(define-key map "\e[27;6;13~" [C-S-return])
;; Other versions of xterm might emit these.
(define-key map "\e[A" [up])
(define-key map "\e[B" [down])
(define-key map "\e[C" [right])
(define-key map "\e[D" [left])
(define-key map "\e[1~" [home])
(define-key map "\eO2A" [S-up])
(define-key map "\eO2B" [S-down])
(define-key map "\eO2C" [S-right])
(define-key map "\eO2D" [S-left])
(define-key map "\eO2F" [S-end])
(define-key map "\eO2H" [S-home])
(define-key map "\eO5A" [C-up])
(define-key map "\eO5B" [C-down])
(define-key map "\eO5C" [C-right])
(define-key map "\eO5D" [C-left])
(define-key map "\eO5F" [C-end])
(define-key map "\eO5H" [C-home])
(define-key map "\e[11~" [f1])
(define-key map "\e[12~" [f2])
(define-key map "\e[13~" [f3])
(define-key map "\e[14~" [f4]))
(xterm-register-default-colors)
;; This recomputes all the default faces given the colors we've just set up.

155
lisp/textmodes/bibtex-style.el Normal file
View File

@ -0,0 +1,155 @@
;;; bibtex-style.el --- Major mode for BibTeX Style files
;; Copyright (C) 2005,2007 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords:
;; 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
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file 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; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; Done: font-lock, imenu, outline, commenting, indentation.
;; Todo: tab-completion.
;; Bugs:
;;; Code:
(defvar bibtex-style-mode-syntax-table
(let ((st (make-syntax-table)))
(modify-syntax-entry ?% "<" st)
(modify-syntax-entry ?\n ">" st)
(modify-syntax-entry ?\{ "(}" st)
(modify-syntax-entry ?\} "){" st)
(modify-syntax-entry ?\" "\"" st)
(modify-syntax-entry ?. "_" st)
(modify-syntax-entry ?' "'" st)
(modify-syntax-entry ?# "'" st)
(modify-syntax-entry ?* "." st)
(modify-syntax-entry ?= "." st)
(modify-syntax-entry ?$ "_" st)
st))
(defconst bibtex-style-commands
'("ENTRY" "EXECUTE" "FUNCTION" "INTEGERS" "ITERATE" "MACRO" "READ"
"REVERSE" "SORT" "STRINGS"))
(defconst bibtex-style-functions
;; From http://www.eeng.dcu.ie/local-docs/btxdocs/btxhak/btxhak/node4.html.
'("<" ">" "=" "+" "-" "*" ":="
"add.period$" "call.type$" "change.case$" "chr.to.int$" "cite$"
"duplicate$" "empty$" "format.name$" "if$" "int.to.chr$" "int.to.str$"
"missing$" "newline$" "num.names$" "pop$" "preamble$" "purify$" "quote$"
"skip$" "stack$" "substring$" "swap$" "text.length$" "text.prefix$"
"top$" "type$" "warning$" "while$" "width$" "write$"))
(defvar bibtex-style-font-lock-keywords
`((,(regexp-opt bibtex-style-commands 'words) . font-lock-keyword-face)
("\\w+\\$" . font-lock-keyword-face)
("\\<\\(FUNCTION\\|MACRO\\)\\s-+{\\([^}\n]+\\)}"
(2 font-lock-function-name-face))))
;;;###autoload (add-to-list 'auto-mode-alist '("\\.bst\\'" . bibtex-style-mode))
;;;###autoload
(define-derived-mode bibtex-style-mode nil "BibStyle"
"Major mode for editing BibTeX style files."
(set (make-local-variable 'comment-start) "%")
(set (make-local-variable 'outline-regexp) "^[a-z]")
(set (make-local-variable 'imenu-generic-expression)
'((nil "\\<\\(FUNCTION\\|MACRO\\)\\s-+{\\([^}\n]+\\)}" 2)))
(set (make-local-variable 'indent-line-function) 'bibtex-style-indent-line)
(set (make-local-variable 'parse-sexp-ignore-comments) t)
(setq font-lock-defaults
'(bibtex-style-font-lock-keywords nil t
((?. . "w")))))
(defun bibtex-style-indent-line ()
"Indent current line of BibTeX Style code."
(interactive)
(let* ((savep (point))
(indent (condition-case nil
(save-excursion
(forward-line 0)
(skip-chars-forward " \t")
(if (>= (point) savep) (setq savep nil))
(max (bibtex-style-calculate-indentation) 0))
(error 0))))
(if savep
(save-excursion (indent-line-to indent))
(indent-line-to indent))))
(defcustom bibtex-style-indent-basic 2
"Basic amount of indentation to use in BibTeX Style mode."
:type 'integer)
(defun bibtex-style-calculate-indentation (&optional virt)
(or
;; Stick the first line at column 0.
(and (= (point-min) (line-beginning-position)) 0)
;; Commands start at column 0.
(and (looking-at (regexp-opt bibtex-style-commands 'words)) 0)
;; Trust the current indentation, if such info is applicable.
(and virt (save-excursion (skip-chars-backward " \t{") (bolp))
(current-column))
;; Put leading close-paren where the matching open brace would be.
(and (looking-at "}")
(condition-case nil
(save-excursion
(up-list -1)
(bibtex-style-calculate-indentation 'virt))
(scan-error nil)))
;; Align leading "if$" with previous command.
(and (looking-at "if\\$")
(condition-case nil
(save-excursion
(backward-sexp 3)
(bibtex-style-calculate-indentation 'virt))
(scan-error
;; There is no command before the "if$".
(condition-case nil
(save-excursion
(up-list -1)
(+ bibtex-style-indent-basic
(bibtex-style-calculate-indentation 'virt)))
(scan-error nil)))))
;; Right after an opening brace.
(condition-case err (save-excursion (backward-sexp 1) nil)
(scan-error (goto-char (nth 2 err))
(+ bibtex-style-indent-basic
(bibtex-style-calculate-indentation 'virt))))
;; Default, align with previous command.
(let ((fai ;; First arm of an "if$".
(condition-case nil
(save-excursion
(forward-sexp 2)
(forward-comment (point-max))
(looking-at "if\\$"))
(scan-error nil))))
(save-excursion
(condition-case err
(while (progn
(backward-sexp 1)
(save-excursion (skip-chars-backward " \t{") (not (bolp)))))
(scan-error nil))
(+ (current-column)
(if (or fai (looking-at "ENTRY")) bibtex-style-indent-basic 0))))))
(provide 'bibtex-style)
;; arch-tag: b20ad41a-fd36-466e-8fd2-cc6137f9c55c
;;; bibtex-style.el ends here

2
lisp/textmodes/org-publish.el
View File

@ -6,8 +6,6 @@
;; Keywords: hypermedia, outlines
;; Version: 1.80
;; $Id: org-publish.el,v 1.2 2007/06/07 02:04:17 miles Exp $
;; 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
;; the Free Software Foundation; either version 2, or (at your option)

31
lisp/thingatpt.el
View File

@ -67,7 +67,7 @@
"Determine the start and end buffer locations for the THING at point.
THING is a symbol which specifies the kind of syntactic entity you want.
Possibilities include `symbol', `list', `sexp', `defun', `filename', `url',
`word', `sentence', `whitespace', `line', `page' and others.
`email', `word', `sentence', `whitespace', `line', `page' and others.
See the file `thingatpt.el' for documentation on how to define
a symbol as a valid THING.
@ -124,7 +124,7 @@ of the textual entity that was found."
"Return the THING at point.
THING is a symbol which specifies the kind of syntactic entity you want.
Possibilities include `symbol', `list', `sexp', `defun', `filename', `url',
`word', `sentence', `whitespace', `line', `page' and others.
`email', `word', `sentence', `whitespace', `line', `page' and others.
See the file `thingatpt.el' for documentation on how to define
a symbol as a valid THING."
@ -340,6 +340,33 @@ point."
(goto-char (car bounds))
(error "No URL here")))))
;; Email addresses
(defvar thing-at-point-email-regexp
"<?[-+_.~a-zA-Z][-+_.~:a-zA-Z0-9]*@[-.a-zA-Z0-9]+>?"
"A regular expression probably matching an email address.
This does not match the real name portion, only the address, optionally
with angle brackets.")
;; Haven't set 'forward-op on 'email nor defined 'forward-email' because
;; not sure they're actually needed, and URL seems to skip them too.
;; Note that (end-of-thing 'email) and (beginning-of-thing 'email)
;; work automagically, though.
(put 'email 'bounds-of-thing-at-point
(lambda ()
(let ((thing (thing-at-point-looking-at thing-at-point-email-regexp)))
(if thing
(let ((beginning (match-beginning 0))
(end (match-end 0)))
(cons beginning end))))))
(put 'email 'thing-at-point
(lambda ()
(let ((boundary-pair (bounds-of-thing-at-point 'email)))
(if boundary-pair
(buffer-substring-no-properties
(car boundary-pair) (cdr boundary-pair))))))
;; Whitespace
(defun forward-whitespace (arg)

2
lisp/thumbs.el
View File

@ -67,7 +67,7 @@
:version "22.1"
:group 'multimedia)
(defcustom thumbs-thumbsdir "~/.emacs.d/thumbs"
(defcustom thumbs-thumbsdir (concat user-emacs-directory "thumbs")
"*Directory to store thumbnails."
:type 'directory
:group 'thumbs)

3
lisp/tutorial.el
View File

@ -623,8 +623,7 @@ with some explanatory links."
(defun tutorial--saved-dir ()
"Directory to which tutorials are saved."
(expand-file-name "tutorial"
(if (eq system-type 'ms-dos) "~/_emacs.d/" "~/.emacs.d/")))
(expand-file-name "tutorial" user-emacs-directory))
(defun tutorial--saved-file ()
"File name in which to save tutorials."

15
lisp/url/ChangeLog
View File

@ -1,3 +1,18 @@
2007-06-12 Tom Tromey <tromey@redhat.com>
* url.el (url-configuration-directory): Use user-emacs-directory.
2007-06-12 Stefan Monnier <monnier@iro.umontreal.ca>
* url-cookie.el (url-cookie-name, url-cookie-value)
(url-cookie-expires, url-cookie-localpart, url-cookie-domain)
(url-cookie-secure, url-cookie-set-name, url-cookie-set-value)
(url-cookie-set-expires, url-cookie-set-localpart)
(url-cookie-set-domain, url-cookie-set-secure)
(url-cookie-retrieve-arg, url-cookie-create, url-cookie-p): Remove.
(url-cookie): New struct.
(url-cookie-store): Use setf instead of url-cookie-set-*.
2007-05-29 Chong Yidong <cyd@stupidchicken.com>
* url-mailto.el (url-mailto): Insert body after

63
lisp/url/url-cookie.el
View File

@ -33,51 +33,6 @@
;; See http://home.netscape.com/newsref/std/cookie_spec.html for the
;; 'open standard' defining this crap.
;;
;; A cookie is stored internally as a vector of 7 slots
;; [ cookie NAME VALUE EXPIRES LOCALPART DOMAIN SECURE ]
(defsubst url-cookie-name (cookie) (aref cookie 1))
(defsubst url-cookie-value (cookie) (aref cookie 2))
(defsubst url-cookie-expires (cookie) (aref cookie 3))
(defsubst url-cookie-localpart (cookie) (aref cookie 4))
(defsubst url-cookie-domain (cookie) (aref cookie 5))
(defsubst url-cookie-secure (cookie) (aref cookie 6))
(defsubst url-cookie-set-name (cookie val) (aset cookie 1 val))
(defsubst url-cookie-set-value (cookie val) (aset cookie 2 val))
(defsubst url-cookie-set-expires (cookie val) (aset cookie 3 val))
(defsubst url-cookie-set-localpart (cookie val) (aset cookie 4 val))
(defsubst url-cookie-set-domain (cookie val) (aset cookie 5 val))
(defsubst url-cookie-set-secure (cookie val) (aset cookie 6 val))
(defsubst url-cookie-retrieve-arg (key args) (nth 1 (memq key args)))
(defsubst url-cookie-create (&rest args)
"Create a cookie vector object from keyword-value pairs ARGS.
The keywords allowed are
:name NAME
:value VALUE
:expires TIME
:localpart LOCALPAR
:domain DOMAIN
:secure ???
Could someone fill in more information?"
(let ((retval (make-vector 7 nil)))
(aset retval 0 'cookie)
(url-cookie-set-name retval (url-cookie-retrieve-arg :name args))
(url-cookie-set-value retval (url-cookie-retrieve-arg :value args))
(url-cookie-set-expires retval (url-cookie-retrieve-arg :expires args))
(url-cookie-set-localpart retval (url-cookie-retrieve-arg :localpart args))
(url-cookie-set-domain retval (url-cookie-retrieve-arg :domain args))
(url-cookie-set-secure retval (url-cookie-retrieve-arg :secure args))
retval))
(defun url-cookie-p (obj)
"Return non-nil if OBJ is a cookie vector object.
These objects represent cookies in the URL package.
A cookie vector object is a vector of 7 slots:
[cookie NAME VALUE EXPIRES LOCALPART DOMAIN SECURE]."
(and (vectorp obj) (= (length obj) 7) (eq (aref obj 0) 'cookie)))
(defgroup url-cookie nil
"URL cookies."
@ -85,6 +40,20 @@ A cookie vector object is a vector of 7 slots:
:prefix "url-cookie-"
:group 'url)
;; A cookie is stored internally as a vector of 7 slots
;; [ cookie NAME VALUE EXPIRES LOCALPART DOMAIN SECURE ]
(defstruct (url-cookie
(:constructor url-cookie-create)
(:copier nil)
;; For compatibility with a previous version which did not use
;; defstruct, and also in order to make sure that the printed
;; representation does not depend on CL internals, we use an
;; explicitly managed tag.
(:type vector))
(tag 'cookie :read-only t)
name value expires localpart domain secure)
(defvar url-cookie-storage nil "Where cookies are stored.")
(defvar url-cookie-secure-storage nil "Where secure cookies are stored.")
(defcustom url-cookie-file nil
@ -199,8 +168,8 @@ telling Microsoft that."
(if (and (equal localpart (url-cookie-localpart cur))
(equal name (url-cookie-name cur)))
(progn
(url-cookie-set-expires cur expires)
(url-cookie-set-value cur value)
(setf (url-cookie-expires cur) expires)
(setf (url-cookie-value cur) value)
(setq tmp t))))
(if (not tmp)
;; New cookie

3
lisp/url/url.el
View File

@ -50,7 +50,8 @@
(defvar url-configuration-directory
(cond
((file-directory-p "~/.url") "~/.url")
((file-directory-p "~/.emacs.d") "~/.emacs.d/url")
((file-directory-p user-emacs-directory)
(concat user-emacs-directory "url"))
(t "~/.url")))
(defun url-do-setup ()

2
lisp/vc-arch.el
View File

@ -62,7 +62,7 @@
;;;
(defvar vc-arch-command
(let ((candidates '("tla")))
(let ((candidates '("tla" "baz")))
(while (and candidates (not (executable-find (car candidates))))
(setq candidates (cdr candidates)))
(or (car candidates) "tla")))

569
lisp/vc-bzr.el Normal file
View File

@ -0,0 +1,569 @@
;;; vc-bzr.el --- VC backend for the bzr revision control system
;; Copyright (C) 2006, 2007 Free Software Foundation, Inc.
;; NOTE: THIS IS A MODIFIED VERSION OF Dave Love's vc-bzr.el,
;; which you can find at: http://www.loveshack.ukfsn.org/emacs/vc-bzr.el
;; I could not get in touch with Dave Love by email, so
;; I am releasing my changes separately. -- Riccardo
;; Author: Dave Love <fx@gnu.org>, Riccardo Murri <riccardo.murri@gmail.com>
;; Keywords: tools
;; Created: Sept 2006
;; Version: 2007-01-17
;; URL: http://launchpad.net/vc-bzr
;; 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
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file 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; see the file COPYING. If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
;;; Commentary:
;; NOTE: THIS IS A MODIFIED VERSION OF Dave Love's vc-bzr.el,
;; which you can find at: http://www.loveshack.ukfsn.org/emacs/vc-bzr.el
;; See <URL:http://bazaar-vcs.org/> concerning bzr.
;; Load this library to register bzr support in VC. The support is
;; preliminary and incomplete, adapted from my darcs version. Lightly
;; exercised with bzr 0.8 and Emacs 21, and bzr 0.11 on Emacs 22. See
;; various Fixmes below.
;; This should be suitable for direct inclusion in Emacs if someone
;; can persuade rms.
;;; Code:
(eval-when-compile
(require 'vc)) ; for vc-exec-after
(defgroup vc-bzr nil
"VC bzr backend."
;; :version "22"
:group 'vc)
(defcustom vc-bzr-program "bzr"
"*Name of the bzr command (excluding any arguments)."
:group 'vc-bzr
:type 'string)
;; Fixme: there's probably no call for this.
(defcustom vc-bzr-program-args nil
"*List of global arguments to pass to `vc-bzr-program'."
:group 'vc-bzr
:type '(repeat string))
(defcustom vc-bzr-diff-switches nil
"*String/list of strings specifying extra switches for bzr diff under VC."
:type '(choice (const :tag "None" nil)
(string :tag "Argument String")
(repeat :tag "Argument List" :value ("") string))
:group 'vc-bzr)
(defvar vc-bzr-version nil
"Internal use.")
;; Could be used for compatibility checks if bzr changes.
(defun vc-bzr-version ()
"Return a three-numeric element list with components of the bzr version.
This is of the form (X Y Z) for revision X.Y.Z. The elements are zero
if running `vc-bzr-program' doesn't produce the expected output."
(if vc-bzr-version
vc-bzr-version
(let ((s (shell-command-to-string
(concat (shell-quote-argument vc-bzr-program) " --version"))))
(if (string-match "\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)$" s)
(setq vc-bzr-version (list (string-to-number (match-string 1 s))
(string-to-number (match-string 2 s))
(string-to-number (match-string 3 s))))
'(0 0 0)))))
(defun vc-bzr-at-least-version (vers)
"Return t if the bzr command reports being a least version VERS.
First argument VERS is a list of the form (X Y Z), as returned by `vc-bzr-version'."
(version-list-<= vers (vc-bzr-version)))
;; XXX: vc-do-command is tailored for RCS and assumes that command-line
;; options precede the file name (ci -something file); with bzr, we need
; to pass options *after* the subcommand, e.g. bzr ls --versioned.
(defun vc-bzr-do-command* (buffer okstatus command &rest args)
"Execute bzr COMMAND, notifying user and checking for errors.
This is a wrapper around `vc-do-command', which see for detailed
explanation of arguments BUFFER, OKSTATUS and COMMAND.
If the optional list of ARGS is present, its elements are
appended to the command line, in the order given.
Unlike `vc-do-command', this has no way of telling which elements
in ARGS are file names and which are command-line options, so be
sure to pass absolute file names if needed. On the other hand,
you can mix options and file names in any order."
(apply 'vc-do-command buffer okstatus command nil args))
(cond
((vc-bzr-at-least-version '(0 9))
;; since v0.9, bzr supports removing the progress indicators
;; by setting environment variable BZR_PROGRESS_BAR to "none".
(defun vc-bzr-command (bzr-command buffer okstatus file &rest args)
"Wrapper round `vc-do-command' using `vc-bzr-program' as COMMAND.
Invoke the bzr command adding `BZR_PROGRESS_BAR=none' to the environment."
(let ((process-environment (cons "BZR_PROGRESS_BAR=none" process-environment)))
(apply 'vc-do-command buffer okstatus vc-bzr-program
file bzr-command (append vc-bzr-program-args args))))
(defun vc-bzr-command* (bzr-command buffer okstatus file &rest args)
"Wrapper round `vc-bzr-do-command*' using `vc-bzr-program' as COMMAND.
Invoke the bzr command adding `BZR_PROGRESS_BAR=none' to the environment.
First argument BZR-COMMAND is passed as the first optional argument to
`vc-bzr-do-command*'."
(let ((process-environment (cons "BZR_PROGRESS_BAR=none" process-environment)))
(apply 'vc-bzr-do-command* buffer okstatus vc-bzr-program
bzr-command (append vc-bzr-program-args args)))))
(t
;; for older versions, we fall back to washing the log buffer
;; when all output has been gathered.
(defun vc-bzr-command (command buffer okstatus file &rest args)
"Wrapper round `vc-do-command' using `vc-bzr-program' as COMMAND."
;; Note: The ^Ms from the progress-indicator stuff that bzr prints
;; on stderr cause auto-detection of a mac coding system on the
;; stream for async output. bzr ought to be fixed to be able to
;; suppress this. See also `vc-bzr-post-command-function'. (We
;; can't sink the stderr output in `vc-do-command'.)
(apply 'vc-do-command buffer okstatus vc-bzr-program
file command (append vc-bzr-program-args args)))
(defun vc-bzr-command* (command buffer okstatus &rest args)
"Wrapper round `vc-bzr-do-command*' using `vc-bzr-program' as COMMAND."
(apply 'vc-bzr-do-command* buffer okstatus vc-bzr-program
command file (append vc-bzr-program-args args)))
(defun vc-bzr-post-command-function (command file flags)
"`vc-post-command-functions' function to remove progress messages."
;; Note that using this requires that the vc command is run
;; synchronously. Otherwise, the ^Ms in the leading progress
;; message on stdout cause the stream to be interpreted as having
;; DOS line endings, losing the ^Ms, so the search fails. I don't
;; know how this works under Windows.
(when (equal command vc-bzr-program)
(save-excursion
(goto-char (point-min))
(if (looking-at "^\\(\r.*\r\\)[^\r]+$")
(replace-match "" nil nil nil 1)))
(save-excursion
(goto-char (point-min))
;; This is inserted by bzr 0.11 `log', at least
(while (looking-at "read knit.*\n")
(replace-match "")))))
(add-hook 'vc-post-command-functions 'vc-bzr-post-command-function)))
;; Fixme: If we're only interested in status messages, we only need
;; to set LC_MESSAGES, and we might need finer control of this. This
;; is moot anyhow, since bzr doesn't appear to be localized at all
;; (yet?).
(eval-when-compile
(defmacro vc-bzr-with-c-locale (&rest body)
"Run BODY with LC_ALL=C in the process environment.
This ensures that messages to be matched come out as expected."
`(let ((process-environment (cons "LC_ALL=C" process-environment)))
,@body)))
(put 'vc-bzr-with-c-locale 'edebug-form-spec t)
(put 'vc-bzr-with-c-locale 'lisp-indent-function 0)
(defun vc-bzr-bzr-dir (file)
"Return the .bzr directory in the hierarchy above FILE.
Return nil if there isn't one."
(setq file (expand-file-name file))
(let ((dir (if (file-directory-p file)
file
(file-name-directory file)))
bzr)
(catch 'found
(while t
(setq bzr (expand-file-name ".bzr" dir)) ; fixme: "_bzr" on Doze??
(if (file-directory-p bzr)
(throw 'found (file-name-as-directory bzr)))
(if (equal "" (file-name-nondirectory (directory-file-name dir)))
(throw 'found nil)
(setq dir (file-name-directory (directory-file-name dir))))))))
(defun vc-bzr-registered (file)
"Return non-nil if FILE is registered with bzr."
(if (vc-bzr-bzr-dir file) ; short cut
(vc-bzr-state file))) ; expensive
(defun vc-bzr-state (file)
(let (ret state conflicts pending-merges)
(with-temp-buffer
(cd (file-name-directory file))
(setq ret (vc-bzr-with-c-locale (vc-bzr-command "status" t 255 file)))
(goto-char 1)
(save-excursion
(when (re-search-forward "^conflicts:" nil t)
(message "Warning -- conflicts in bzr branch")))
(save-excursion
(when (re-search-forward "^pending merges:" nil t)
(message "Warning -- pending merges in bzr branch")))
(setq state
(cond ((not (equal ret 0)) nil)
((looking-at "added\\|renamed\\|modified\\|removed") 'edited)
;; Fixme: Also get this in a non-registered sub-directory.
((looking-at "^$") 'up-to-date)
;; if we're seeing this as first line of text,
;; then the status is up-to-date,
;; but bzr output only gives the warning to users.
((looking-at "conflicts\\|pending") 'up-to-date)
((looking-at "unknown\\|ignored") nil)
(t (error "Unrecognized output from `bzr status'"))))
(when (or conflicts pending-merges)
(message
(concat "Warning -- "
(if conflicts "conflicts ")
(if (and conflicts pending-merges) "and ")
(if pending-merges "pending merges ")
"in bzr branch")))
(when state
(vc-file-setprop file 'vc-workfile-version
(vc-bzr-workfile-version file))
(vc-file-setprop file 'vc-state state))
state)))
(defun vc-bzr-workfile-unchanged-p (file)
(eq 'up-to-date (vc-bzr-state file)))
(defun vc-bzr-workfile-version (file)
(with-temp-buffer
(vc-bzr-command "revno" t 0 file)
(goto-char 1)
(buffer-substring 1 (line-end-position))))
(defun vc-bzr-checkout-model (file)
'implicit)
(defun vc-bzr-register (file &optional rev comment)
"Register FILE under bzr.
Signal an error unless REV is nil.
COMMENT is ignored."
(if rev (error "Can't register explicit version with bzr"))
(vc-bzr-command "add" nil 0 file))
;; Could run `bzr status' in the directory and see if it succeeds, but
;; that's relatively expensive.
(defun vc-bzr-responsible-p (file)
"Return non-nil if FILE is (potentially) controlled by bzr.
The criterion is that there is a `.bzr' directory in the same
or a superior directory."
(vc-bzr-bzr-dir file))
(defun vc-bzr-could-register (file)
"Return non-nil if FILE could be registered under bzr."
(and (vc-bzr-responsible-p file) ; shortcut
(condition-case ()
(with-temp-buffer
(vc-bzr-command "add" t 0 file "--dry-run")
;; The command succeeds with no output if file is
;; registered (in bzr 0.8).
(goto-char 1)
(looking-at "added "))
(error))))
(defun vc-bzr-unregister (file)
"Unregister FILE from bzr."
(vc-bzr-command "remove" nil 0 file))
(defun vc-bzr-checkin (file rev comment)
"Check FILE in to bzr with log message COMMENT.
REV non-nil gets an error."
(if rev (error "Can't check in a specific version with bzr"))
(vc-bzr-command "commit" nil 0 file "-m" comment))
(defun vc-bzr-checkout (file &optional editable rev destfile)
"Checkout revision REV of FILE from bzr to DESTFILE.
EDITABLE is ignored."
(unless destfile
(setq destfile (vc-version-backup-file-name file rev)))
(let ((coding-system-for-read 'binary)
(coding-system-for-write 'binary))
(with-temp-file destfile
(if rev
(vc-bzr-command "cat" t 0 file "-r" rev)
(vc-bzr-command "cat" t 0 file)))))
(defun vc-bzr-revert (file &optional contents-done)
(unless contents-done
(with-temp-buffer (vc-bzr-command "revert" t 'async file))))
(eval-when-compile
(defvar log-view-message-re)
(defvar log-view-file-re)
(defvar log-view-font-lock-keywords)
(defvar log-view-current-tag-function))
;; Grim hack to account for lack of an extension mechanism for
;; log-view. Should be fixed in VC...
(defun vc-bzr-view-log-function ()
"To be added to `log-view-mode-hook' to set variables for bzr output.
Removes itself after running."
(remove-hook 'log-view-mode-hook 'vc-bzr-view-log-function)
(require 'add-log)
;; Don't have file markers, so use impossible regexp.
(set (make-local-variable 'log-view-file-re) "\\'\\`")
(set (make-local-variable 'log-view-message-re) "^ *-+\n *\\(revno: [0-9]+\\|merged: .+\\)")
(set (make-local-variable 'log-view-font-lock-keywords)
`(("^ *committer: \
\\([^<(]+?\\)[ ]*[(<]\\([A-Za-z0-9_.-]+@[A-Za-z0-9_.-]+\\)[>)]"
nil nil
(1 'change-log-name-face nil t)
(2 'change-log-email-face nil t)
(3 'change-log-email-face nil t))
("^ *timestamp: \\(.*\\)" (1 'change-log-date-face))
(,log-view-message-re . 'log-view-message-face)
;; ("^ \\(.*\\)$" (1 'log-view-message-face))
)))
(defun vc-bzr-print-log (file &optional buffer) ; get buffer arg in Emacs 22
"Get bzr change log for FILE into specified BUFFER."
;; Fixme: VC needs a hook to sort out the mode for the buffer, or at
;; least set the regexps right.
;; Fixme: This might need the locale fixing up if things like `revno'
;; got localized, but certainly it shouldn't use LC_ALL=C.
;; NB. Can't be async -- see `vc-bzr-post-command-function'.
(vc-bzr-command "log" buffer 0 file)
(add-hook 'log-view-mode-hook 'vc-bzr-view-log-function))
(defun vc-bzr-show-log-entry (version)
"Find entry for patch name VERSION in bzr change log buffer."
(goto-char (point-min))
(let (case-fold-search)
(if (re-search-forward (concat "^-+\nrevno: " version "$") nil t)
(beginning-of-line 0)
(goto-char (point-min)))))
;; Fixem: vc-bzr-wash-log
(autoload 'vc-diff-switches-list "vc" nil nil t)
(defun vc-bzr-diff (file &optional rev1 rev2 buffer)
"VC bzr backend for diff."
(let ((working (vc-workfile-version file)))
(if (and (equal rev1 working) (not rev2))
(setq rev1 nil))
(if (and (not rev1) rev2)
(setq rev1 working))
;; NB. Can't be async -- see `vc-bzr-post-command-function'.
;; bzr diff produces condition code 1 for some reason.
(apply #'vc-bzr-command "diff" (or buffer "*vc-diff*") 1 file
"--diff-options" (mapconcat 'identity (vc-diff-switches-list bzr)
" ")
(when rev1
(if rev2
(list "-r" (format "%s..%s" rev1 rev2))
(list "-r" rev1))))))
(defalias 'vc-bzr-diff-tree 'vc-bzr-diff)
;; Fixme: implement vc-bzr-dir-state, vc-bzr-dired-state-info
;; Fixme: vc-{next,previous}-version need fixing in vc.el to deal with
;; straight integer versions.
(defun vc-bzr-delete-file (file)
"Delete FILE and delete it in the bzr repository."
(condition-case ()
(delete-file file)
(file-error nil))
(vc-bzr-command "remove" nil 0 file))
(defun vc-bzr-rename-file (old new)
"Rename file from OLD to NEW using `bzr mv'."
(vc-bzr-command "mv" nil 0 new old))
(defvar vc-bzr-annotation-table nil
"Internal use.")
(make-variable-buffer-local 'vc-bzr-annotation-table)
(defun vc-bzr-annotate-command (file buffer &optional version)
"Prepare BUFFER for `vc-annotate' on FILE.
Each line is tagged with the revision number, which has a `help-echo'
property containing author and date information."
(apply #'vc-bzr-command "annotate" buffer 0 file "-l" "--all"
(if version (list "-r" version)))
(with-current-buffer buffer
;; Store the tags for the annotated source lines in a hash table
;; to allow saving space by sharing the text properties.
(setq vc-bzr-annotation-table (make-hash-table :test 'equal))
(goto-char (point-min))
(while (re-search-forward "^\\( *[0-9]+\\) \\(.+\\) +\\([0-9]\\{8\\}\\) |"
nil t)
(let* ((rev (match-string 1))
(author (match-string 2))
(date (match-string 3))
(key (match-string 0))
(tag (gethash key vc-bzr-annotation-table)))
(unless tag
(save-match-data
(string-match " +\\'" author)
(setq author (substring author 0 (match-beginning 0))))
(setq tag (propertize rev 'help-echo (concat "Author: " author
", date: " date)
'mouse-face 'highlight))
(puthash key tag vc-bzr-annotation-table))
(replace-match "")
(insert tag " |")))))
;; Definition from Emacs 22
(unless (fboundp 'vc-annotate-convert-time)
(defun vc-annotate-convert-time (time)
"Convert a time value to a floating-point number of days.
The argument TIME is a list as returned by `current-time' or
`encode-time', only the first two elements of that list are considered."
(/ (+ (* (float (car time)) (lsh 1 16)) (cadr time)) 24 3600)))
(defun vc-bzr-annotate-time ()
(when (re-search-forward "^ *[0-9]+ |" nil t)
(let ((prop (get-text-property (line-beginning-position) 'help-echo)))
(string-match "[0-9]+\\'" prop)
(vc-annotate-convert-time
(encode-time 0 0 0
(string-to-number (substring (match-string 0 prop) 6 8))
(string-to-number (substring (match-string 0 prop) 4 6))
(string-to-number (substring (match-string 0 prop) 0 4))
)))))
(defun vc-bzr-annotate-extract-revision-at-line ()
"Return revision for current line of annoation buffer, or nil.
Return nil if current line isn't annotated."
(save-excursion
(beginning-of-line)
(if (looking-at " *\\([0-9]+\\) | ")
(match-string-no-properties 1))))
;; Not needed for Emacs 22
(defun vc-bzr-annotate-difference (point)
(let ((next-time (vc-bzr-annotate-time)))
(if next-time
(- (vc-annotate-convert-time (current-time)) next-time))))
;; FIXME: `bzr root' will return the real path to the repository root,
;; that is, it can differ from the buffer's current directory name
;; if there are any symbolic links.
(defun vc-bzr-root (dir)
"Return the root directory of the bzr repository containing DIR."
;; Cache technique copied from vc-arch.el.
(or (vc-file-getprop dir 'bzr-root)
(vc-file-setprop
dir 'bzr-root
(substring
(shell-command-to-string (concat vc-bzr-program " root " dir)) 0 -1))))
;; TODO: it would be nice to mark the conflicted files in VC Dired,
;; and implement a command to run ediff and `bzr resolve' once the
;; changes have been merged.
(defun vc-bzr-dir-state (dir &optional localp)
"Find the VC state of all files in DIR.
Optional argument LOCALP is always ignored."
(let (at-start bzr-root-directory current-bzr-state current-vc-state)
;; check that DIR is a bzr repository
(set 'bzr-root-directory (vc-bzr-root dir))
(unless (string-match "^/" bzr-root-directory)
(error "Cannot find bzr repository for directory `%s'" dir))
;; `bzr ls --versioned' lists all versioned files;
;; assume they are up-to-date, unless we are given
;; evidence of the contrary.
(set 'at-start t)
(with-temp-buffer
(vc-bzr-command* "ls" t 0 "--versioned" "--non-recursive")
(goto-char (point-min))
(while (or at-start
(eq 0 (forward-line)))
(set 'at-start nil)
(let ((file (expand-file-name
(buffer-substring-no-properties
(line-beginning-position) (line-end-position))
bzr-root-directory)))
(vc-file-setprop file 'vc-state 'up-to-date)
;; XXX: is this correct? what happens if one
;; mixes different SCMs in the same dir?
(vc-file-setprop file 'vc-backend 'BZR))))
;; `bzr status' reports on added/modified/renamed and unknown/ignored files
(set 'at-start t)
(with-temp-buffer
(vc-bzr-with-c-locale (vc-bzr-command "status" t 0 nil))
(goto-char (point-min))
(while (or at-start
(eq 0 (forward-line)))
(set 'at-start nil)
(cond
((looking-at "^added")
(set 'current-vc-state 'edited)
(set 'current-bzr-state 'added))
((looking-at "^modified")
(set 'current-vc-state 'edited)
(set 'current-bzr-state 'modified))
((looking-at "^renamed")
(set 'current-vc-state 'edited)
(set 'current-bzr-state 'renamed))
((looking-at "^\\(unknown\\|ignored\\)")
(set 'current-vc-state nil)
(set 'current-bzr-state 'not-versioned))
((looking-at " ")
;; file names are indented by two spaces
(when current-vc-state
(let ((file (expand-file-name
(buffer-substring-no-properties
(match-end 0) (line-end-position))
bzr-root-directory)))
(vc-file-setprop file 'vc-state current-vc-state)
(vc-file-setprop file 'vc-bzr-state current-bzr-state)
(when (eq 'added current-bzr-state)
(vc-file-setprop file 'vc-workfile-version "0"))))
(when (eq 'not-versioned current-bzr-state)
(let ((file (expand-file-name
(buffer-substring-no-properties
(match-end 0) (line-end-position))
bzr-root-directory)))
(vc-file-setprop file 'vc-backend 'none)
(vc-file-setprop file 'vc-state nil))))
(t
;; skip this part of `bzr status' output
(set 'current-vc-state nil)
(set 'current-bzr-state nil)))))))
(defun vc-bzr-dired-state-info (file)
"Bzr-specific version of `vc-dired-state-info'."
(if (eq 'edited (vc-state file))
(let ((bzr-state (vc-file-getprop file 'vc-bzr-state)))
(if bzr-state
(concat "(" (symbol-name bzr-state) ")")
;; else fall back to default vc representation
(vc-default-dired-state-info 'BZR file)))))
;; In case of just `(load "vc-bzr")', but that's probably the wrong
;; way to do it.
(add-to-list 'vc-handled-backends 'BZR)
(eval-after-load "vc"
'(add-to-list 'vc-directory-exclusion-list ".bzr" t))
(defconst vc-bzr-unload-hook
(lambda ()
(setq vc-handled-backends (delq 'BZR vc-handled-backends))
(remove-hook 'vc-post-command-functions 'vc-bzr-post-command-function)))
(provide 'vc-bzr)
;; arch-tag: 8101bad8-4e92-4e7d-85ae-d8e08b4e7c06
;;; vc-bzr.el ends here

7
lisp/vc-svn.el
View File

@ -464,11 +464,16 @@ NAME is assumed to be a URL."
;;; Internal functions
;;;
(defcustom vc-svn-program "svn"
"Name of the svn executable."
:type 'string
:group 'vc)
(defun vc-svn-command (buffer okstatus file &rest flags)
"A wrapper around `vc-do-command' for use in vc-svn.el.
The difference to vc-do-command is that this function always invokes `svn',
and that it passes `vc-svn-global-switches' to it before FLAGS."
(apply 'vc-do-command buffer okstatus "svn" file
(apply 'vc-do-command buffer okstatus vc-svn-program file
(if (stringp vc-svn-global-switches)
(cons vc-svn-global-switches flags)
(append vc-svn-global-switches

8
lisp/vc.el
View File

@ -2096,7 +2096,7 @@ See Info node `Merging'."
(define-key vmap "t" 'vc-dired-toggle-terse-mode)
map))
(define-derived-mode vc-dired-mode dired-mode "Dired under VC"
(define-derived-mode vc-dired-mode dired-mode "Dired under "
"The major mode used in VC directory buffers.
It works like Dired, but lists only files under version control, with
@ -2156,6 +2156,8 @@ There is a special command, `*l', to mark all files currently locked."
(set (make-local-variable 'dired-actual-switches)
vc-dired-switches))
(set (make-local-variable 'vc-dired-terse-mode) vc-dired-terse-display)
(setq mode-name (concat mode-name (symbol-name (vc-responsible-backend
default-directory))))
(setq vc-dired-mode t))
(defun vc-dired-toggle-terse-mode ()
@ -2214,7 +2216,9 @@ Called by dired after any portion of a vc-dired buffer has been read in."
;; if the backend supports it, get the state
;; of all files in this directory at once
(let ((backend (vc-responsible-backend subdir)))
(if (vc-find-backend-function backend 'dir-state)
;; check `backend' can really handle `subdir'.
(if (and (vc-call-backend backend 'responsible-p subdir)
(vc-find-backend-function backend 'dir-state))
(vc-call-backend backend 'dir-state subdir)))
(forward-line 1)
;; erase (but don't remove) the "total" line

98
lisp/wid-edit.el
View File

@ -1491,6 +1491,8 @@ If that does not exists, call the value of `widget-complete-field'."
(delete-backward-char 1))
(insert ?\n)
(setq doc-end (point)))))
((eq escape ?h)
(widget-add-documentation-string-button widget))
((eq escape ?v)
(if (and button-begin (not button-end))
(widget-apply widget :value-create)
@ -1516,44 +1518,7 @@ If that does not exists, call the value of `widget-complete-field'."
(widget-clear-undo))
(defun widget-default-format-handler (widget escape)
;; We recognize the %h escape by default.
(let* ((buttons (widget-get widget :buttons)))
(cond ((eq escape ?h)
(let* ((doc-property (widget-get widget :documentation-property))
(doc-try (cond ((widget-get widget :doc))
((functionp doc-property)
(funcall doc-property
(widget-get widget :value)))
((symbolp doc-property)
(documentation-property
(widget-get widget :value)
doc-property))))
(doc-text (and (stringp doc-try)
(> (length doc-try) 1)
doc-try))
(doc-indent (widget-get widget :documentation-indent)))
(when doc-text
(and (eq (preceding-char) ?\n)
(widget-get widget :indent)
(insert-char ?\s (widget-get widget :indent)))
;; The `*' in the beginning is redundant.
(when (eq (aref doc-text 0) ?*)
(setq doc-text (substring doc-text 1)))
;; Get rid of trailing newlines.
(when (string-match "\n+\\'" doc-text)
(setq doc-text (substring doc-text 0 (match-beginning 0))))
(push (widget-create-child-and-convert
widget 'documentation-string
:indent (cond ((numberp doc-indent )
doc-indent)
((null doc-indent)
nil)
(t 0))
doc-text)
buttons))))
(t
(error "Unknown escape `%c'" escape)))
(widget-put widget :buttons buttons)))
(error "Unknown escape `%c'" escape))
(defun widget-default-button-face-get (widget)
;; Use :button-face or widget-button-face
@ -1665,13 +1630,32 @@ If that does not exists, call the value of `widget-complete-field'."
(widget-default-action widget event))
(defun widget-default-prompt-value (widget prompt value unbound)
"Read an arbitrary value. Stolen from `set-variable'."
;; (let ((initial (if unbound
;; nil
;; It would be nice if we could do a `(cons val 1)' here.
;; (prin1-to-string (custom-quote value))))))
"Read an arbitrary value."
(eval-minibuffer prompt))
(defun widget-docstring (widget)
"Return the documentation string specificied by WIDGET, or nil if none.
If WIDGET has a `:doc' property, that specifies the documentation string.
Otherwise, try the `:documentation-property' property. If this
is a function, call it with the widget's value as an argument; if
it is a symbol, use this symbol together with the widget's value
as the argument to `documentation-property'."
(let ((doc (or (widget-get widget :doc)
(let ((doc-prop (widget-get widget :documentation-property))
(value (widget-get widget :value)))
(cond ((functionp doc-prop)
(funcall doc-prop value))
((symbolp doc-prop)
(documentation-property value doc-prop)))))))
(when (and (stringp doc) (> (length doc) 0))
;; Remove any redundant `*' in the beginning.
(when (eq (aref doc 0) ?*)
(setq doc (substring doc 1)))
;; Remove trailing newlines.
(when (string-match "\n+\\'" doc)
(setq doc (substring doc 0 (match-beginning 0))))
doc)))
;;; The `item' Widget.
(define-widget 'item 'default
@ -2913,7 +2897,8 @@ link for that string."
"A documentation string."
:format "%v"
:action 'widget-documentation-string-action
:value-create 'widget-documentation-string-value-create)
:value-create 'widget-documentation-string-value-create
:visibility-widget 'visibility)
(defun widget-documentation-string-value-create (widget)
;; Insert documentation string.
@ -2929,7 +2914,7 @@ link for that string."
(widget-documentation-link-add widget start (point))
(setq button
(widget-create-child-and-convert
widget 'visibility
widget (widget-get widget :visibility-widget)
:help-echo "Show or hide rest of the documentation."
:on "Hide Rest"
:off "More"
@ -2954,6 +2939,29 @@ link for that string."
(not (widget-get parent :documentation-shown))))
;; Redraw.
(widget-value-set widget (widget-value widget)))
(defun widget-add-documentation-string-button (widget &rest args)
"Insert a new `documentation-string' widget based on WIDGET.
The new widget becomes a child of WIDGET, and is also added to
its `:buttons' list. The documentation string is found from
WIDGET using the function `widget-docstring'.
Optional ARGS specifies additional keyword arguments for the
`documentation-string' widget."
(let ((doc (widget-docstring widget))
(indent (widget-get widget :indent))
(doc-indent (widget-get widget :documentation-indent)))
(when doc
(and (eq (preceding-char) ?\n)
indent
(insert-char ?\s indent))
(unless (or (numberp doc-indent) (null doc-indent))
(setq doc-indent 0))
(widget-put widget :buttons
(cons (apply 'widget-create-child-and-convert
widget 'documentation-string
:indent doc-indent
(nconc args (list doc)))
(widget-get widget :buttons))))))
;;; The Sexp Widgets.

8
lisp/x-dnd.el
View File

@ -172,7 +172,7 @@ FRAME-OR-WINDOW is the frame or window that the mouse is over."
WINDOW is the window the mouse is over. ACTION is the suggested
action from the source. If nothing has changed, return the last
action and type we got from `x-dnd-test-function'."
(let ((buffer (when (and (windowp window) (window-live-p window))
(let ((buffer (when (window-live-p window)
(window-buffer window)))
(current-state (x-dnd-get-state-for-frame window)))
(when (or (not (equal buffer (aref current-state 0)))
@ -207,9 +207,7 @@ EXTRA-DATA is data needed for a specific protocol."
(when types (aset current-state 2 types))
(when extra-data (aset current-state 6 extra-data))
(aset current-state 1 window)
(aset current-state 0 (if (and (windowp window)
(window-live-p window))
(window-buffer window) nil))
(aset current-state 0 (and (window-live-p window) (window-buffer window)))
(setcdr (x-dnd-get-state-cons-for-frame window) current-state)))
@ -320,7 +318,7 @@ nil if not."
(action (aref state 5))
(w (posn-window (event-start event))))
(when handler
(if (and (windowp w) (window-live-p w)
(if (and (window-live-p w)
(not (window-minibuffer-p w))
(not (window-dedicated-p w)))
;; If dropping in an ordinary window which we could use,

4
lispref/.gitignore vendored
View File

@ -11,3 +11,7 @@ index.texi
elisp
elisp-?
elisp-??
vol1.*
vol2.*
elisp1*
elisp2*

50
lispref/ChangeLog
View File

@ -1,3 +1,25 @@
2007-06-15 Juanma Barranquero <lekktu@gmail.com>
* display.texi (Overlay Arrow): Doc fix.
2007-06-14 Karl Berry <karl@tug.org>
* anti.texi (Antinews): Typo.
2007-06-14 Chong Yidong <cyd@stupidchicken.com>
* display.texi (Image Cache): Document image-refresh.
2007-06-12 Karl Berry <karl@gnu.org>
* vol1.texi, vol2.texi, two-volume-cross-refs.txt: Update.
* two-volume.make: New file.
* .cvsignore: Ignore two-volume files.
2007-06-12 Tom Tromey <tromey@redhat.com>
* os.texi (Init File): Document user-emacs-directory.
2007-06-03 Nick Roberts <nickrob@snap.net.nz>
* commands.texi (Click Events): Describe width and height when
@ -58,7 +80,7 @@
2007-05-07 Karl Berry <karl@gnu.org>
* elisp.texi (EMACSVER): back to 22.
* elisp.texi (EMACSVER): Back to 22.
2007-05-06 Richard Stallman <rms@gnu.org>
@ -81,7 +103,7 @@
2007-05-03 Karl Berry <karl@gnu.org>
* elisp.texi (\urlcolor, \linkcolor) [smallbook]: \Black for printing.
(EMACSVER) [smallbook]: 22 for printed version.
(EMACSVER) [smallbook]: 22 for printed version.
* control.texi (Signaling Errors) <signal>: texinfo.tex is fixed,
so restore anchor to normal position after defun. Found by Kevin Ryde.
@ -143,16 +165,16 @@
2007-04-11 Karl Berry <karl@gnu.org>
* anti.texi (Antinews),
* display.texi (Overlay Properties) and (Defining Images),
* processes.texi (Synchronous Processes) and (Sentinels),
* syntax.texi (Syntax Table Internals),
* searching.texi (Regexp Special),
* nonascii.texi (Default Coding Systems),
* text.texi (Special Properties),
* anti.texi (Antinews):
* display.texi (Overlay Properties, Defining Images):
* processes.texi (Synchronous Processes, Sentinels):
* syntax.texi (Syntax Table Internals):
* searching.texi (Regexp Special):
* nonascii.texi (Default Coding Systems):
* text.texi (Special Properties):
* minibuf.texi (Basic Completion): Wording to improve breaks in
8.5x11 format.
* elisp.texi (smallbook): new @set to more easily switch between
* elisp.texi (smallbook): New @set to more easily switch between
smallbook and 8.5x11.
2007-04-11 Richard Stallman <rms@gnu.org>
@ -299,10 +321,10 @@
2007-04-01 Karl Berry <karl@gnu.org>
* processes.texi (Low-Level Network): typo.
* loading.texi (Hooks for Loading): avoid double "the".
* keymaps.texi (Key Sequences): no double "and".
(Changing Key Bindings): shorten to improve line break.
* processes.texi (Low-Level Network): Typo.
* loading.texi (Hooks for Loading): Avoid double "the".
* keymaps.texi (Key Sequences): No double "and".
(Changing Key Bindings): Shorten to improve line break.
2007-03-31 Glenn Morris <rgm@gnu.org>

2
lispref/anti.texi
View File

@ -111,7 +111,7 @@ Several simplifications have been made to mouse support:
@item
Clicking @kbd{mouse-1} won't follow links, as that is alien to the
spirit of Emacs. Therefore, the @code{follow-link} property doesn't
has any special meaning, and the function @code{mouse-on-link-p} has
have any special meaning, and the function @code{mouse-on-link-p} has
been removed.
@item

50
lispref/display.texi
View File

@ -3103,7 +3103,7 @@ overwritten.
The overlay-arrow string is displayed in any given buffer if the value
of @code{overlay-arrow-position} in that buffer points into that
buffer. Thus, it works to can display multiple overlay arrow strings
buffer. Thus, it is possible to display multiple overlay arrow strings
by creating buffer-local bindings of @code{overlay-arrow-position}.
However, it is usually cleaner to use
@code{overlay-arrow-variable-list} to achieve this result.
@ -4276,13 +4276,43 @@ cache, it can always be displayed, even if the value of
@subsection Image Cache
@cindex image cache
Emacs stores images in an image cache when it displays them, so it can
display them again more efficiently. It removes an image from the cache
when it hasn't been displayed for a specified period of time.
Emacs stores images in an image cache so that it can display them
again more efficiently. When Emacs displays an image, it searches the
image cache for an existing image specification @code{equal} to the
desired specification. If a match is found, the image is displayed
from the cache; otherwise, Emacs loads the image normally.
When an image is looked up in the cache, its specification is compared
with cached image specifications using @code{equal}. This means that
all images with equal specifications share the same image in the cache.
Occasionally, you may need to tell Emacs to refresh the images
associated with a given image specification. For example, suppose you
display an image using a specification that contains a @code{:file}
property. The image is loaded from the given file and stored in the
image cache. If you later display the image again, using the same
image specification, the image is displayed from the image cache.
Normally, this is not a problem. However, if the image file has
changed in the meantime, Emacs would be displaying the old version of
the image. In such a situation, it is necessary to ``refresh'' the
image using @code{image-refresh}.
@defun image-refresh spec &optional frame
This function refreshes any images having image specifications
@code{equal} to @var{spec} on frame @var{frame}. If @var{frame} is
@code{nil}, the selected frame is used. If @var{frame} is @code{t},
the refresh is applied to all existing frames.
This works by removing all image with image specifications matching
@var{spec} from the image cache. Thus, the next time the image is
displayed, Emacs will load the image again.
@end defun
@defun clear-image-cache &optional frame
This function clears the entire image cache. If @var{frame} is
non-@code{nil}, only the cache for that frame is cleared. Otherwise,
all frames' caches are cleared.
@end defun
If an image in the image cache has not been displayed for a specified
period of time, Emacs removes it from the cache and frees the
associated memory.
@defvar image-cache-eviction-delay
This variable specifies the number of seconds an image can remain in the
@ -4294,12 +4324,6 @@ except when you explicitly clear it. This mode can be useful for
debugging.
@end defvar
@defun clear-image-cache &optional frame
This function clears the image cache. If @var{frame} is non-@code{nil},
only the cache for that frame is cleared. Otherwise all frames' caches
are cleared.
@end defun
@node Buttons
@section Buttons
@cindex buttons in buffers

5
lispref/os.texi
View File

@ -258,6 +258,11 @@ actual init file loaded is a compiled file, such as @file{.emacs.elc},
the value refers to the corresponding source file.
@end defvar
@defvar user-emacs-directory
This variable holds the name of the @file{.emacs.d} directory. It is
ordinarily @file{~/.emacs.d}, but differs on some platforms.
@end defvar
@node Terminal-Specific
@subsection Terminal-Specific Initialization
@cindex terminal-specific initialization

10
lispref/searching.texi
View File

@ -650,6 +650,16 @@ Shy groups are particularly useful for mechanically-constructed regular
expressions because they can be added automatically without altering the
numbering of any ordinary, non-shy groups.
@item \(?@var{num}: @dots{} \)
is the @dfn{explicitly numbered group} construct. Normal groups get
their number implicitly, based on their position, which can be
inconvenient. This construct allows you to force a particular group
number. There is no particular restriction on the numbering,
e.g.@: you can have several groups with the same number in which case
the last one to match (i.e.@: the rightmost match) will win.
Implicitly numbered groups always get the smallest integer larger than
the one of any previous group.
@item \@var{digit}
matches the same text that matched the @var{digit}th occurrence of a
grouping (@samp{\( @dots{} \)}) construct.

76
lispref/two-volume-cross-refs.txt
View File

@ -5,7 +5,24 @@ Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007
Two Volume Cross References
===========================
18 March 1992
12 June 2007 (karl)
For lispref 2.9 (for Emacs 22, June 2007), I created a very ugly
Makefile, in the file two-volume.make, to encapsulate all the steps
below, without manual intervention. In theory, simply running "make -f
two-volume.make" should create a vol1.pdf and vol2.pdf with all the
niceties worked out.
One issue not explicitly discussed below is getting page numbers right.
It's not enough to go through the whole process. You have to go through
the whole process twice -- otherwise, some index entries and/or toc
entries will be off by one. See two-volume.make for a few more comments.
For future editions, it should suffice to update the usual things in
vol[12].texi (as well as elisp.texi). That was my hope, anyway.
18 March 1992 (bob)
This enables you to create manuals in *two* volumes, with tables of
contents, cross references, and indices in each volume referring to
@ -57,23 +74,23 @@ Here are the steps in detail:
% cp vol1.aux elisp1-aux
% cp vol2.aux elisp2-aux
% cp vol1.aux elisp1-aux-vol-number-added
% cp vol2.aux elisp2-aux-vol-number-added
% cp vol1.aux elisp1-aux-vol-added
% cp vol2.aux elisp2-aux-vol-added
on elisp1-aux-vol-number-added
(volume-aux-markup 1) see defun for volum-aux-markup below.
to create elisp1-aux-vol-number-added
(volume-aux-markup 1) see defun for volume-aux-markup below.
to create elisp1-aux-vol-added
on elisp2-aux-vol-number-added
(volume-aux-markup 2)
to create elisp2-aux-vol-number-added
to create elisp2-aux-vol-added
insert elisp2-aux-vol-number-added into vol1.aux (append)
insert elisp1-aux-vol-number-added into vol2.aux (prepend)
insert elisp2-aux-vol-added into vol1.aux (append)
insert elisp1-aux-vol-added into vol2.aux (prepend)
(so you dont have to do it again)
% cp vol1.aux elisp1-aux-2vol-ready
% cp vol2.aux elisp2-aux-2vol-ready
% cp vol1.aux elisp1-aux-ready
% cp vol2.aux elisp2-aux-ready
### Create .fn files with volume numbers for other volume.
@ -166,45 +183,6 @@ Do not change the .texi files; they will call the elisp-toc-2vol.toc file.
% tex vol1.texi
% tex vol2.texi
================================================================
@c ================================================================
@tex
% Special @contents command
% This inputs fixed up table of contents file rather than create new one.
\global\def\contents{%
\startcontents{Table of Contents}%
\input elisp-toc-2vol.toc
\endgroup
\vfill \eject
}
% Special @summarycontents command
% This inputs fixed up table of contents file rather than create new one.
\outer\def\summarycontents{%
\startcontents{Short Contents}%
%
\let\chapentry = \shortchapentry
\let\unnumbchapentry = \shortunnumberedentry
% We want a true roman here for the page numbers.
\secfonts
\let\rm=\shortcontrm \let\bf=\shortcontbf \let\sl=\shortcontsl
\rm
\advance\baselineskip by 1pt % Open it up a little.
\def\secentry ##1##2##3##4{}
\def\unnumbsecentry ##1##2{}
\def\subsecentry ##1##2##3##4##5{}
\def\unnumbsubsecentry ##1##2{}
\def\subsubsecentry ##1##2##3##4##5##6{}
\def\unnumbsubsubsecentry ##1##2{}
\input elisp-toc-2vol.toc
\endgroup
\vfill \eject
}
@end tex
@c ================================================================
================================================================

227
lispref/two-volume.make Normal file
View File

@ -0,0 +1,227 @@
# Copyright 2007 Free Software Foundation, Inc.
# See end for copying conditions.
# although it would be nice to use tex rather than pdftex to avoid
# colors, spurious warnings about names being referenced but not
# existing, etc., dvips | ps2pdf doesn't preserve the page size.
# Instead of creating a special dvips config file, put up with the warnings.
tex = pdftex -interaction=nonstopmode
all: vol1.pdf vol2.pdf
# vol1.texi and vol2.texi specially define \tocreadfilename so we can
# use our premade .toc's.
#
vol1.pdf: elisp1med-fns-ready elisp1med-aux-ready elisp1med-toc-ready
@echo -e "\f Final TeX run for volume 1..."
cp elisp1med-toc-ready elisp1-toc-ready.toc
cp elisp1med-fns-ready vol1.fns
cp elisp1med-aux-ready vol1.aux
$(tex) vol1.texi
#
vol2.pdf: elisp2med-fns-ready elisp2med-aux-ready elisp2med-toc-ready
@echo "Final TeX run for volume 2..."
cp elisp2med-toc-ready elisp2-toc-ready.toc
cp elisp2med-fns-ready vol2.fns
cp elisp2med-aux-ready vol2.aux
$(tex) vol2.texi
# intermediate toc files.
#
# vol1 toc: volume 1, page break, volume 2 (with II: prepended).
elisp1med-toc-ready: elisp1med-init elisp2med-init
echo '@unnchapentry{@b{Volume 1}}{10001}{vol1}{}' >$@
cat elisp1med-toc >>$@
echo '@page' >>$@
echo '@unnchapentry{@b{Volume 2}}{10001}{vol2}{}' >>$@
sed 's/{\([^}]*\)}$$/{II:\1}/' elisp2med-toc >>$@
#
# vol2 toc: volume 1 (with I: prepended), page break, volume 2.
elisp2med-toc-ready: elisp1med-init elisp2med-init
echo '@unnchapentry{@b{Volume 1}}{10001}{vol1}{}' >$@
sed 's/{\([^}]*\)}$$/{I:\1}/' elisp1med-toc >>$@
echo '@page' >>$@
echo '@unnchapentry{@b{Volume 2}}{10001}{vol2}{}' >>$@
cat elisp2med-toc >>$@
# intermediate aux files.
#
# append vol2's fixed aux to normal vol1.
elisp1med-aux-ready: elisp2med-aux-vol-added
cat elisp1med-aux $< >$@
#
# prepend vol1's fixed aux to vol2.
elisp2med-aux-ready: elisp1med-aux-vol-added
cat $< elisp2med-aux >$@
# on -pg entries, append volume number after page number.
elisp1med-aux-vol-added: elisp1med-init
sed 's/-pg}{\(.*\)}$$/-pg}{\1, vol.@tie1}/' elisp1med-aux >$@
#
elisp2med-aux-vol-added: elisp2med-init
sed 's/-pg}{\(.*\)}$$/-pg}{\1, vol.@tie2}/' elisp2med-aux >$@
# intermediate index (fns) file.
#
elisp1med-fns-ready: elisp1med-fn-vol-added elisp2med-fn-vol-added
cat elisp2med-fn-vol-added >>vol1.fn
texindex vol1.fn
cp vol1.fns $@
#
elisp2med-fns-ready: elisp1med-fn-vol-added elisp2med-fn-vol-added
cat elisp1med-fn-vol-added >>vol2.fn
texindex vol2.fn
cp vol2.fns $@
# Insert volume number (I: or II:) into index file.
elisp1med-fn-vol-added: elisp1med-init
cp vol1.fn elisp1med-fn
sed 's/}{/}{I:/' elisp1med-fn >$@
#
elisp2med-fn-vol-added: elisp2med-init
cp vol2.fn elisp2med-fn
sed 's/}{/}{II:/' elisp2med-fn >$@
# -----------------------------------------------------------------------------
# everything above is essentially a duplicate of everything below. sorry.
# -----------------------------------------------------------------------------
# intermediate TeX runs.
#
# this generates what would be the final versions -- except the page
# numbers aren't right. The process of adding the I: and II: changes
# the page breaks, so a few index entries, at least are wrong. (In
# 2007, x-meta-keysym in vol.II ended up on page 374 when the index had
# it on page 375 from the initial run.)
#
# So, we start all over again, from these fns/aux/toc files.
#
elisp1med-init: elisp1-fns-ready elisp1-aux-ready elisp1init-toc-ready texinfo.tex
@echo -e "\f Intermediate TeX run for volume 1..."
cp elisp1init-toc-ready elisp1-toc-ready.toc
cp elisp1-fns-ready vol1.fns
cp elisp1-aux-ready vol1.aux
$(tex) vol1.texi
texindex vol1.??
mv vol1.aux elisp1med-aux
mv vol1.toc elisp1med-toc
#
elisp2med-init: elisp2-fns-ready elisp2-aux-ready elisp2init-toc-ready texinfo.tex
@echo "Final TeX run for volume 2..."
cp elisp2init-toc-ready elisp2-toc-ready.toc
cp elisp2-fns-ready vol2.fns
cp elisp2-aux-ready vol2.aux
$(tex) vol2.texi
texindex vol2.??
mv vol2.aux elisp2med-aux
mv vol2.toc elisp2med-toc
# initial toc files.
#
# vol1 toc: volume 1, page break, volume 2 (with II: prepended).
elisp1init-toc-ready: elisp1-init elisp2-init
echo '@unnchapentry{@b{Volume 1}}{10001}{vol1}{}' >$@
cat elisp1-toc >>$@
echo '@page' >>$@
echo '@unnchapentry{@b{Volume 2}}{10001}{vol2}{}' >>$@
sed 's/{\([^}]*\)}$$/{II:\1}/' elisp2-toc >>$@
#
# vol2 toc: volume 1 (with I: prepended), page break, volume 2.
elisp2init-toc-ready: elisp1-init elisp2-init
echo '@unnchapentry{@b{Volume 1}}{10001}{vol1}{}' >$@
sed 's/{\([^}]*\)}$$/{I:\1}/' elisp1-toc >>$@
echo '@page' >>$@
echo '@unnchapentry{@b{Volume 2}}{10001}{vol2}{}' >>$@
cat elisp2-toc >>$@
# initial aux files.
#
# append vol2's fixed aux to normal vol1. The initial runs saved
# elisp1-aux and elisp2-aux.
elisp1-aux-ready: elisp2-aux-vol-added
cat elisp1-aux $< >$@
#
# prepend vol1's fixed aux to vol2.
elisp2-aux-ready: elisp1-aux-vol-added
cat $< elisp2-aux >$@
# on -pg entries, append volume number after page number.
elisp1-aux-vol-added: elisp1-init
sed 's/-pg}{\(.*\)}$$/-pg}{\1, vol.@tie1}/' elisp1-aux >$@
#
elisp2-aux-vol-added: elisp2-init
sed 's/-pg}{\(.*\)}$$/-pg}{\1, vol.@tie2}/' elisp2-aux >$@
# initial index (fns) file.
#
# Append other volume's index entries to this one's.
# Index entries in this volume will then take precedence.
elisp1-fns-ready: elisp1-fn-vol-added elisp2-fn-vol-added
cat elisp2-fn-vol-added >>vol1.fn
texindex vol1.fn
cp vol1.fns $@
#
elisp2-fns-ready: elisp1-fn-vol-added elisp2-fn-vol-added
cat elisp1-fn-vol-added >>vol2.fn
texindex vol2.fn
cp vol2.fns $@
# Insert volume number (I: or II:) into index file.
elisp1-fn-vol-added: elisp1-init
cp vol1.fn elisp1-fn
sed 's/}{/}{I:/' elisp1-fn >$@
#
elisp2-fn-vol-added: elisp2-init
cp vol2.fn elisp2-fn
sed 's/}{/}{II:/' elisp2-fn >$@
# initial TeX runs.
#
# We use the .fn, .aux, and .toc files created here in subsequent
# processing. The page numbers generated here will not be correct yet,
# but we run texindex and TeX a second time just to get them closer.
# Otherwise it might take even longer for them to converge.
#
elisp1-init: vol1.texi
@echo -e "\f Initial TeX run for volume 1..."
rm -f vol1.aux vol1.toc
$(tex) $<
texindex vol1.??
mv vol1.aux elisp1-aux
mv vol1.toc elisp1-toc
touch $@
#
elisp2-init: vol2.texi
@echo "Initial TeX run for volume 2..."
rm -f vol2.aux vol2.toc
$(tex) $<
texindex vol2.??
mv vol2.aux elisp2-aux
mv vol2.toc elisp2-toc
touch $@
# COPYING CONDITIONS
#
# 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
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# This file 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 this file; see the file COPYING. If not, write to
# the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
# Boston, MA 02110-1301, USA.
# arch-tag: 5c258a2e-d4a9-4d0e-b279-fb3a6faa27eb

1069
lispref/vol1.texi
View File

File diff suppressed because it is too large Load Diff

1072
lispref/vol2.texi
View File

File diff suppressed because it is too large Load Diff

4
lwlib/ChangeLog
View File

@ -1,3 +1,7 @@
2007-06-13 Chong Yidong <cyd@stupidchicken.com>
* lwlib-Xaw.c, lwlib.c: Link to xaw3d if available.
2007-06-02 Chong Yidong <cyd@stupidchicken.com>
* Version 22.1 released.

9
lwlib/lwlib-Xaw.c
View File

@ -35,12 +35,21 @@ Boston, MA 02110-1301, USA. */
#include <X11/CoreP.h>
#include <X11/Shell.h>
#ifdef HAVE_XAW3D
#include <X11/Xaw3d/Scrollbar.h>
#include <X11/Xaw3d/Paned.h>
#include <X11/Xaw3d/Dialog.h>
#include <X11/Xaw3d/Form.h>
#include <X11/Xaw3d/Command.h>
#include <X11/Xaw3d/Label.h>
#else /* !HAVE_XAW3D */
#include <X11/Xaw/Scrollbar.h>
#include <X11/Xaw/Paned.h>
#include <X11/Xaw/Dialog.h>
#include <X11/Xaw/Form.h>
#include <X11/Xaw/Command.h>
#include <X11/Xaw/Label.h>
#endif /* HAVE_XAW3D */
#include <X11/Xatom.h>

4
lwlib/lwlib.c
View File

@ -48,7 +48,11 @@ Boston, MA 02110-1301, USA. */
#endif /* not USE_MOTIF && USE_LUCID */
#endif
#if defined (USE_XAW)
#ifdef HAVE_XAW3D
#include <X11/Xaw3d/Paned.h>
#else /* !HAVE_XAW3D */
#include <X11/Xaw/Paned.h>
#endif /* HAVE_XAW3D */
#include "lwlib-Xaw.h"
#endif

6
nt/ChangeLog
View File

@ -1,3 +1,9 @@
2007-06-15 Jason Rumney <jasonr@gnu.org>
* emacs.manifest: New file.
* emacs.rc: Use it.
2007-06-02 Chong Yidong <cyd@stupidchicken.com>
* Version 22.1 released.

11
nt/emacs.manifest Normal file
View File

@ -0,0 +1,11 @@
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<dependency>
<dependentAssembly>
<assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls"
version="6.0.0.0" processorArchitecture="X86"
publicKeyToken="6595b64144ccf1df"
language="*"/>
</dependentAssembly>
</dependency>
</assembly>

1
nt/emacs.rc
View File

@ -1,5 +1,6 @@
Emacs ICON icons\emacs.ico
32649 CURSOR icons\hand.cur
1 24 "emacs.manifest"
#ifndef VS_VERSION_INFO
#define VS_VERSION_INFO 1

103
src/ChangeLog
View File

@ -1,3 +1,93 @@
2007-06-16 Eli Zaretskii <eliz@gnu.org>
* w32menu.c (add_menu_item): Escape `&' characters in menu items
and their keybindings.
2007-06-15 Chong Yidong <cyd@stupidchicken.com>
* composite.c (update_compositions): Fix last fix.
2007-06-14 Jason Rumney <jasonr@gnu.org>
* w32.c (get_process_times_fn): New function pointer.
(globals_of_w32): Intialize it if present in kernel32.dll.
(w32_get_internal_run_time): New function.
* editfns.c (Fget_internal_run_time) [WINDOWSNT]: Use it.
2007-06-14 Kenichi Handa <handa@etlken.m17n.org>
* composite.c (update_compositions): Check the validness of
compositions.
2007-06-14 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
* frame.h (struct frame) [MAC_OS]: New member external_tool_bar.
(FRAME_EXTERNAL_TOOL_BAR) [MAC_OS]: Use it.
* macfns.c (mac_window) [USE_MAC_TOOLBAR]: Set toolbar_win_gravity.
(x_set_tool_bar_lines) [USE_MAC_TOOLBAR]: Set FRAME_EXTERNAL_TOOL_BAR.
* macgui.h (USE_MAC_TOOLBAR): New define.
* macmenu.c [TARGET_API_MAC_CARBON] (menu_target_item_handler):
Return immediately unless popup is activated.
* macterm.c (x_draw_fringe_bitmap) [MAC_OSX]: Extend fringe
background to scroll bar gap.
(x_scroll_bar_create) [MAC_OSX]: Set bar->fringe_extended_p.
(XTset_vertical_scroll_bar) [MAC_OSX]: Put leftmost/rightmost
scroll bars on frame edge. Check fringe background extension.
Don't clear extended fringe background area.
(TOOLBAR_IDENTIFIER, TOOLBAR_ICON_ITEM_IDENTIFIER)
(TOOLBAR_ITEM_COMMAND_ID_OFFSET, TOOLBAR_ITEM_COMMAND_ID_P)
(TOOLBAR_ITEM_COMMAND_ID_VALUE, TOOLBAR_ITEM_MAKE_COMMAND_ID):
[USE_MAC_TOOLBAR]: New macros.
(mac_move_window_with_gravity, mac_get_window_origin_with_gravity)
(mac_handle_toolbar_event, mac_image_spec_to_cg_image)
(mac_create_frame_tool_bar, update_frame_tool_bar, free_frame_tool_bar)
(mac_tool_bar_note_mouse_movement, mac_handle_toolbar_command_event)
[USE_MAC_TOOLBAR]: New functions.
(mac_handle_window_event) [USE_MAC_TOOLBAR]: Reposition window
manually if previous repositioning has failed.
(mac_handle_keyboard_event): Use precomputed event kind.
(XTread_socket) [USE_MAC_TOOLBAR]: Handle click in structure region
as tool bar item click. Handle mouse movement over tool bar items.
* macterm.h (struct mac_output) [USE_MAC_TOOLBAR]: New member
toolbar_win_gravity.
(struct scroll_bar) [MAC_OSX]: New member fringe_extended_p.
(update_frame_tool_bar, free_frame_tool_bar) [USE_MAC_TOOLBAR]:
Add externs.
* xdisp.c (update_tool_bar, redisplay_tool_bar, redisplay_window)
[USE_MAC_TOOLBAR]: Sync with GTK+ tool bar display.
2007-06-14 Chong Yidong <cyd@stupidchicken.com>
* image.c (search_image_cache): Remove unused variable.
2007-06-13 Chong Yidong <cyd@stupidchicken.com>
* xfns.c, xmenu.c: Link to xaw3d if available.
2007-06-13 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>
* dispextern.h (struct image) [HAVE_WINDOW_SYSTEM]: New members
frame_foreground and frame_background.
* image.c (lookup_image): Save frame foreground and background colors.
(search_image_cache): Check if saved and current frame colors match.
2007-06-12 Stefan Monnier <monnier@iro.umontreal.ca>
* regex.c (regex_compile): Remove the `regnum' counter.
Use bufp->re_nsub instead. Add support for \(?N:RE\).
2007-06-11 Stefan Monnier <monnier@iro.umontreal.ca>
* term.c: Include intervals.h to declare Fget_text_property.
2007-06-10 Jason Rumney <jasonr@gnu.org>
* w32fns.c (Fx_file_dialog): Take size from struct not pointer.
@ -106,11 +196,11 @@
New function.
(init_dm_notification_handler) [MAC_OS_X_VERSION_MAX_ALLOWED >= 1030]:
Register it.
(XTread_socket) [TARGET_API_MAC_CARBON]: Consolidate
SendEventToEventTarget calls. Use FRAME_OUTER_TO_INNER_DIFF_X and
FRAME_OUTER_TO_INNER_DIFF_Y. Move application activation handler
to mac_handle_application_event. Move keyboard handler to
mac_handle_keyboard_event.
(XTread_socket) [TARGET_API_MAC_CARBON]:
Consolidate SendEventToEventTarget calls.
Use FRAME_OUTER_TO_INNER_DIFF_X and FRAME_OUTER_TO_INNER_DIFF_Y.
Move application activation handler to mac_handle_application_event.
Move keyboard handler to mac_handle_keyboard_event.
(XTread_socket) [!TARGET_API_MAC_CARBON]: Use do_keystroke.
(mac_initialize) [TARGET_API_MAC_CARBON]: Don't call
init_command_handler. Call install_application_handler.
@ -124,8 +214,7 @@
2007-06-06 Chong Yidong <cyd@stupidchicken.com>
* image.c (xpm_load): Remove spurious call to
xpm_init_color_cache.
* image.c (xpm_load): Remove spurious call to xpm_init_color_cache.
2007-06-06 YAMAMOTO Mitsuharu <mituharu@math.s.chiba-u.ac.jp>

13
src/composite.c
View File

@ -500,7 +500,8 @@ update_compositions (from, to, check_mask)
avoid it, in such a case, we change the property of the
latter to the copy of it. */
if (from > BEGV
&& find_composition (from - 1, -1, &start, &end, &prop, Qnil))
&& find_composition (from - 1, -1, &start, &end, &prop, Qnil)
&& COMPOSITION_VALID_P (start, end, prop))
{
if (from < end)
Fput_text_property (make_number (from), make_number (end),
@ -510,7 +511,8 @@ update_compositions (from, to, check_mask)
from = end;
}
else if (from < ZV
&& find_composition (from, -1, &start, &from, &prop, Qnil))
&& find_composition (from, -1, &start, &from, &prop, Qnil)
&& COMPOSITION_VALID_P (start, from, prop))
run_composition_function (start, from, prop);
}
@ -521,6 +523,7 @@ update_compositions (from, to, check_mask)
(to - 1). */
while (from < to - 1
&& find_composition (from, to, &start, &from, &prop, Qnil)
&& COMPOSITION_VALID_P (start, from, prop)
&& from < to - 1)
run_composition_function (start, from, prop);
}
@ -528,7 +531,8 @@ update_compositions (from, to, check_mask)
if (check_mask & CHECK_TAIL)
{
if (from < to
&& find_composition (to - 1, -1, &start, &end, &prop, Qnil))
&& find_composition (to - 1, -1, &start, &end, &prop, Qnil)
&& COMPOSITION_VALID_P (start, end, prop))
{
/* TO should be also at composition boundary. But,
insertion or deletion will make two compositions adjacent
@ -542,7 +546,8 @@ update_compositions (from, to, check_mask)
run_composition_function (start, end, prop);
}
else if (to < ZV
&& find_composition (to, -1, &start, &end, &prop, Qnil))
&& find_composition (to, -1, &start, &end, &prop, Qnil)
&& COMPOSITION_VALID_P (start, end, prop))
run_composition_function (start, end, prop);
}
}

6
src/config.in
View File

@ -228,7 +228,8 @@ Boston, MA 02110-1301, USA. */
/* Define to 1 if you have the `get_current_dir_name' function. */
#undef HAVE_GET_CURRENT_DIR_NAME
/* Define to 1 if you have the ungif library (-lungif). */
/* Define to 1 if you have a gif library (default -lungif; otherwise specify
with LIBGIF). */
#undef HAVE_GIF
/* Define to 1 if you have the gpm library (-lgpm). */
@ -768,6 +769,9 @@ Boston, MA 02110-1301, USA. */
Solaris, for example). */
#undef LD_SWITCH_X_SITE_AUX
/* Compiler option to link with the gif library (if not -lungif). */
#undef LIBGIF
/* Define to 1 if localtime caches TZ. */
#undef LOCALTIME_CACHE

4
src/dispextern.h
View File

@ -2422,6 +2422,10 @@ struct image
if necessary. */
unsigned long background;
/* Foreground and background colors of the frame on which the image
is created. */
unsigned long frame_foreground, frame_background;
/* True if this image has a `transparent' background -- that is, is
uses an image mask. The accessor macro for this is
`IMAGE_BACKGROUND_TRANSPARENT'. */

13
src/editfns.c
View File

@ -84,6 +84,11 @@ extern char **environ;
extern size_t emacs_strftimeu P_ ((char *, size_t, const char *,
const struct tm *, int));
#ifdef WINDOWSNT
extern Lisp_Object w32_get_internal_run_time ();
#endif
static int tm_diff P_ ((struct tm *, struct tm *));
static void find_field P_ ((Lisp_Object, Lisp_Object, Lisp_Object, int *, Lisp_Object, int *));
static void update_buffer_properties P_ ((int, int));
@ -1483,9 +1488,13 @@ on systems that do not provide resolution finer than a second. */)
return list3 (make_number ((secs >> 16) & 0xffff),
make_number ((secs >> 0) & 0xffff),
make_number (usecs));
#else
#else /* ! HAVE_GETRUSAGE */
#if WINDOWSNT
return w32_get_internal_run_time ();
#else /* ! WINDOWSNT */
return Fcurrent_time ();
#endif
#endif /* WINDOWSNT */
#endif /* HAVE_GETRUSAGE */
}

4
src/frame.h
View File

@ -197,7 +197,7 @@ struct frame
be used for output. */
unsigned glyphs_initialized_p : 1;
#if defined (USE_GTK)
#if defined (USE_GTK) || defined (MAC_OS)
/* Nonzero means using a tool bar that comes from the toolkit. */
int external_tool_bar;
#endif
@ -534,7 +534,7 @@ typedef struct frame *FRAME_PTR;
/* Nonzero if this frame should display a tool bar
in a way that does not use any text lines. */
#if defined (USE_GTK)
#if defined (USE_GTK) || defined (MAC_OS)
#define FRAME_EXTERNAL_TOOL_BAR(f) (f)->external_tool_bar
#else
#define FRAME_EXTERNAL_TOOL_BAR(f) 0

22
src/image.c
View File

@ -1642,22 +1642,28 @@ search_image_cache (f, spec, hash)
{
struct image *img;
struct image_cache *c = FRAME_X_IMAGE_CACHE (f);
Lisp_Object specified_bg = image_spec_value (spec, QCbackground, NULL);
int i = hash % IMAGE_CACHE_BUCKETS_SIZE;
/* If the image spec does not specify a background color, the cached
image must have the same background color as the current frame.
The following code be improved. For example, jpeg does not
support transparency, but currently a jpeg image spec won't match
a cached spec created with a different frame background. The
extra memory usage is probably negligible in practice. */
The foreground color must also match, for the sake of monochrome
images.
In fact, we could ignore the foreground color matching condition
for color images, or if the image spec specifies :foreground;
similarly we could ignore the background color matching condition
for formats that don't use transparency (such as jpeg), or if the
image spec specifies :background. However, the extra memory
usage is probably negligible in practice, so we don't bother. */
if (!c) return NULL;
for (img = c->buckets[i]; img; img = img->next)
if (img->hash == hash
&& !NILP (Fequal (img->spec, spec))
&& (STRINGP (specified_bg)
|| img->background == FRAME_BACKGROUND_PIXEL (f)))
/* If the image spec specifies a background, it doesn't matter
what the frame background is. */
&& img->frame_foreground == FRAME_FOREGROUND_PIXEL (f)
&& img->frame_background == FRAME_BACKGROUND_PIXEL (f))
break;
return img;
}
@ -1932,6 +1938,8 @@ lookup_image (f, spec)
img = make_image (spec, hash);
cache_image (f, img);
img->load_failed_p = img->type->load (f, img) == 0;
img->frame_foreground = FRAME_FOREGROUND_PIXEL (f);
img->frame_background = FRAME_BACKGROUND_PIXEL (f);
/* If we can't load the image, and we don't have a width and
height, use some arbitrary width and height so that we can

29
src/macfns.c
View File

@ -1681,6 +1681,25 @@ x_set_tool_bar_lines (f, value, oldval)
/* Make sure we redisplay all windows in this frame. */
++windows_or_buffers_changed;
#if USE_MAC_TOOLBAR
FRAME_TOOL_BAR_LINES (f) = 0;
if (nlines)
{
FRAME_EXTERNAL_TOOL_BAR (f) = 1;
if (FRAME_MAC_P (f) && !IsWindowToolbarVisible (FRAME_MAC_WINDOW (f)))
/* Make sure next redisplay shows the tool bar. */
XWINDOW (FRAME_SELECTED_WINDOW (f))->update_mode_line = Qt;
}
else
{
if (FRAME_EXTERNAL_TOOL_BAR (f))
free_frame_tool_bar (f);
FRAME_EXTERNAL_TOOL_BAR (f) = 0;
}
return;
#endif
delta = nlines - FRAME_TOOL_BAR_LINES (f);
/* Don't resize the tool-bar to more than we have room for. */
@ -2283,6 +2302,16 @@ mac_window (f, window_prompting, minibuffer_only)
XSetWindowBackground (FRAME_MAC_DISPLAY(f), FRAME_MAC_WINDOW (f),
FRAME_BACKGROUND_PIXEL (f));
#if USE_MAC_TOOLBAR
/* At the moment, the size of the tool bar is not yet known. We
record the gravity value of the newly created window and use it
to adjust the position of the window (especially for a negative
specification of its vertical position) when the tool bar is
first redisplayed. */
if (FRAME_EXTERNAL_TOOL_BAR (f))
f->output_data.mac->toolbar_win_gravity = f->win_gravity;
#endif
validate_x_resource_name ();
/* x_set_name normally ignores requests to set the name if the

7
src/macgui.h
View File

@ -117,6 +117,13 @@ typedef unsigned long Time;
#endif
#endif
/* Whether to use HIToolbar. */
#ifndef USE_MAC_TOOLBAR
#if MAC_OS_X_VERSION_MAX_ALLOWED >= 1030 && MAC_OS_X_VERSION_MIN_REQUIRED != 1020
#define USE_MAC_TOOLBAR 1
#endif
#endif
typedef WindowRef Window;
typedef GWorldPtr Pixmap;

4
src/macmenu.c
View File

@ -1602,6 +1602,10 @@ menu_target_item_handler (next_handler, event, data)
GrafPtr port;
int specpdl_count = SPECPDL_INDEX ();
/* Don't be bothered with the overflowed toolbar items menu. */
if (!popup_activated ())
return eventNotHandledErr;
err = GetEventParameter (event, kEventParamDirectObject, typeMenuRef,
NULL, sizeof (MenuRef), NULL, &menu);
if (err == noErr)

662
src/macterm.c
View File

@ -2197,6 +2197,57 @@ x_draw_fringe_bitmap (w, row, p)
struct face *face = p->face;
int rowY;
#ifdef MAC_OSX
if (p->bx >= 0 && !p->overlay_p)
{
int bx = p->bx, nx = p->nx;
#if 0 /* MAC_TODO: stipple */
/* In case the same realized face is used for fringes and
for something displayed in the text (e.g. face `region' on
mono-displays, the fill style may have been changed to
FillSolid in x_draw_glyph_string_background. */
if (face->stipple)
XSetFillStyle (FRAME_X_DISPLAY (f), face->gc, FillOpaqueStippled);
else
XSetForeground (FRAME_X_DISPLAY (f), face->gc, face->background);
#endif
/* If the fringe is adjacent to the left (right) scroll bar of a
leftmost (rightmost, respectively) window, then extend its
background to the gap between the fringe and the bar. */
if ((WINDOW_LEFTMOST_P (w)
&& WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (w))
|| (WINDOW_RIGHTMOST_P (w)
&& WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT (w)))
{
int sb_width = WINDOW_CONFIG_SCROLL_BAR_WIDTH (w);
if (sb_width > 0)
{
int left = WINDOW_SCROLL_BAR_AREA_X (w);
int width = (WINDOW_CONFIG_SCROLL_BAR_COLS (w)
* FRAME_COLUMN_WIDTH (f));
if (left + width == bx)
{
bx = left + sb_width;
nx += width - sb_width;
}
else if (bx + nx == left)
nx += width - sb_width;
}
}
mac_erase_rectangle (f, face->gc, bx, p->by, nx, p->ny);
#if 0 /* MAC_TODO: stipple */
if (!face->stipple)
XSetForeground (FRAME_X_DISPLAY (f), face->gc, face->foreground);
#endif
}
#endif /* MAC_OSX */
/* Must clip because of partially visible lines. */
rowY = WINDOW_TO_FRAME_PIXEL_Y (w, row->y);
if (p->y < rowY)
@ -2214,6 +2265,7 @@ x_draw_fringe_bitmap (w, row, p)
else
x_clip_to_row (w, row, -1, face->gc);
#ifndef MAC_OSX
if (p->bx >= 0 && !p->overlay_p)
{
#if 0 /* MAC_TODO: stipple */
@ -2234,6 +2286,7 @@ x_draw_fringe_bitmap (w, row, p)
XSetForeground (FRAME_X_DISPLAY (f), face->gc, face->foreground);
#endif
}
#endif /* !MAC_OSX */
if (p->which
#if USE_CG_DRAWING
@ -4990,6 +5043,9 @@ x_scroll_bar_create (w, top, left, width, height, disp_top, disp_height)
XSETINT (bar->start, 0);
XSETINT (bar->end, 0);
bar->dragging = Qnil;
#ifdef MAC_OSX
bar->fringe_extended_p = Qnil;
#endif
#ifdef USE_TOOLKIT_SCROLL_BARS
bar->track_top = Qnil;
bar->track_height = Qnil;
@ -5122,6 +5178,9 @@ XTset_vertical_scroll_bar (w, portion, whole, position)
struct scroll_bar *bar;
int top, height, left, sb_left, width, sb_width, disp_top, disp_height;
int window_y, window_height;
#ifdef MAC_OSX
int fringe_extended_p;
#endif
/* Get window dimensions. */
window_box (w, -1, 0, &window_y, 0, &window_height);
@ -5141,9 +5200,9 @@ XTset_vertical_scroll_bar (w, portion, whole, position)
/* Compute the left edge of the scroll bar. */
if (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_RIGHT (w))
sb_left = left;
sb_left = left + (WINDOW_RIGHTMOST_P (w) ? width - sb_width : 0);
else
sb_left = left + width - sb_width;
sb_left = left + (WINDOW_LEFTMOST_P (w) ? 0 : width - sb_width);
/* Adjustments according to Inside Macintosh to make it look nice */
disp_top = top;
@ -5164,11 +5223,29 @@ XTset_vertical_scroll_bar (w, portion, whole, position)
sb_left++;
#endif
#ifdef MAC_OSX
if (WINDOW_HAS_VERTICAL_SCROLL_BAR_ON_LEFT (w))
fringe_extended_p = (WINDOW_LEFTMOST_P (w)
&& WINDOW_LEFT_FRINGE_WIDTH (w)
&& (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
|| WINDOW_LEFT_MARGIN_COLS (w) == 0));
else
fringe_extended_p = (WINDOW_RIGHTMOST_P (w)
&& WINDOW_RIGHT_FRINGE_WIDTH (w)
&& (WINDOW_HAS_FRINGES_OUTSIDE_MARGINS (w)
|| WINDOW_RIGHT_MARGIN_COLS (w) == 0));
#endif
/* Does the scroll bar exist yet? */
if (NILP (w->vertical_scroll_bar))
{
BLOCK_INPUT;
mac_clear_area (f, left, top, width, height);
#ifdef MAC_OSX
if (fringe_extended_p)
mac_clear_area (f, sb_left, top, sb_width, height);
else
#endif
mac_clear_area (f, left, top, width, height);
UNBLOCK_INPUT;
bar = x_scroll_bar_create (w, top, sb_left, sb_width, height, disp_top,
disp_height);
@ -5188,11 +5265,20 @@ XTset_vertical_scroll_bar (w, portion, whole, position)
if (!(XINT (bar->left) == sb_left
&& XINT (bar->top) == top
&& XINT (bar->width) == sb_width
&& XINT (bar->height) == height))
&& XINT (bar->height) == height
#ifdef MAC_OSX
&& !NILP (bar->fringe_extended_p) == fringe_extended_p
#endif
))
{
/* Since toolkit scroll bars are smaller than the space reserved
for them on the frame, we have to clear "under" them. */
mac_clear_area (f, left, top, width, height);
#ifdef MAC_OSX
if (fringe_extended_p)
mac_clear_area (f, sb_left, top, sb_width, height);
else
#endif
mac_clear_area (f, left, top, width, height);
#if USE_CG_DRAWING
mac_prepare_for_quickdraw (f);
@ -5221,6 +5307,10 @@ XTset_vertical_scroll_bar (w, portion, whole, position)
UNBLOCK_INPUT;
}
#ifdef MAC_OSX
bar->fringe_extended_p = fringe_extended_p ? Qt : Qnil;
#endif
#ifdef USE_TOOLKIT_SCROLL_BARS
if (NILP (bar->track_top))
{
@ -5582,6 +5672,539 @@ x_scroll_bar_clear (f)
XTjudge_scroll_bars (f);
}
/***********************************************************************
Tool-bars
***********************************************************************/
#if USE_MAC_TOOLBAR
/* In identifiers such as function/variable names, Emacs tool bar is
referred to as `tool_bar', and Carbon HIToolbar as `toolbar'. */
#define TOOLBAR_IDENTIFIER (CFSTR ("org.gnu.Emacs.toolbar"))
#define TOOLBAR_ICON_ITEM_IDENTIFIER (CFSTR ("org.gnu.Emacs.toolbar.icon"))
#define TOOLBAR_ITEM_COMMAND_ID_OFFSET 'Tb\0\0'
#define TOOLBAR_ITEM_COMMAND_ID_P(id) \
(((id) & ~0xffff) == TOOLBAR_ITEM_COMMAND_ID_OFFSET)
#define TOOLBAR_ITEM_COMMAND_ID_VALUE(id) \
((id) - TOOLBAR_ITEM_COMMAND_ID_OFFSET)
#define TOOLBAR_ITEM_MAKE_COMMAND_ID(value) \
((value) + TOOLBAR_ITEM_COMMAND_ID_OFFSET)
static int mac_event_to_emacs_modifiers P_ ((EventRef));
static void mac_handle_origin_change P_ ((struct frame *));
static OSStatus mac_handle_toolbar_command_event P_ ((EventHandlerCallRef,
EventRef, void *));
static void
mac_move_window_with_gravity (f, win_gravity, left, top)
struct frame *f;
int win_gravity;
short left, top;
{
Rect inner, outer;
mac_get_window_bounds (f, &inner, &outer);
switch (win_gravity)
{
case NorthWestGravity:
case WestGravity:
case SouthWestGravity:
left += inner.left - outer.left;
break;
case NorthGravity:
case CenterGravity:
case SouthGravity:
left += ((inner.left - outer.left) + (inner.right - outer.right)) / 2;
break;
case NorthEastGravity:
case EastGravity:
case SouthEastGravity:
left += inner.right - outer.right;
break;
}
switch (win_gravity)
{
case NorthWestGravity:
case NorthGravity:
case NorthEastGravity:
top += inner.top - outer.top;
break;
case WestGravity:
case CenterGravity:
case EastGravity:
top += ((inner.top - outer.top) + (inner.bottom - outer.bottom)) / 2;
break;
case SouthWestGravity:
case SouthGravity:
case SouthEastGravity:
top += inner.bottom - outer.bottom;
break;
}
MoveWindow (FRAME_MAC_WINDOW (f), left, top, false);
}
static void
mac_get_window_origin_with_gravity (f, win_gravity, left, top)
struct frame *f;
int win_gravity;
short *left, *top;
{
Rect inner, outer;
mac_get_window_bounds (f, &inner, &outer);
switch (win_gravity)
{
case NorthWestGravity:
case WestGravity:
case SouthWestGravity:
*left = outer.left;
break;
case NorthGravity:
case CenterGravity:
case SouthGravity:
*left = outer.left + ((outer.right - outer.left)
- (inner.right - inner.left)) / 2;
break;
case NorthEastGravity:
case EastGravity:
case SouthEastGravity:
*left = outer.right - (inner.right - inner.left);
break;
}
switch (win_gravity)
{
case NorthWestGravity:
case NorthGravity:
case NorthEastGravity:
*top = outer.top;
break;
case WestGravity:
case CenterGravity:
case EastGravity:
*top = outer.top + ((outer.bottom - outer.top)
- (inner.bottom - inner.top)) / 2;
break;
case SouthWestGravity:
case SouthGravity:
case SouthEastGravity:
*top = outer.bottom - (inner.bottom - inner.top);
break;
}
}
static OSStatus
mac_handle_toolbar_event (next_handler, event, data)
EventHandlerCallRef next_handler;
EventRef event;
void *data;
{
OSStatus err, result = eventNotHandledErr;
switch (GetEventKind (event))
{
case kEventToolbarGetDefaultIdentifiers:
result = noErr;
break;
case kEventToolbarGetAllowedIdentifiers:
{
CFMutableArrayRef array;
GetEventParameter (event, kEventParamMutableArray,
typeCFMutableArrayRef, NULL,
sizeof (CFMutableArrayRef), NULL, &array);
CFArrayAppendValue (array, TOOLBAR_ICON_ITEM_IDENTIFIER);
result = noErr;
}
break;
case kEventToolbarCreateItemWithIdentifier:
{
CFStringRef identifier;
HIToolbarItemRef item = NULL;
GetEventParameter (event, kEventParamToolbarItemIdentifier,
typeCFStringRef, NULL,
sizeof (CFStringRef), NULL, &identifier);
if (CFStringCompare (identifier, TOOLBAR_ICON_ITEM_IDENTIFIER, 0)
== kCFCompareEqualTo)
HIToolbarItemCreate (identifier,
kHIToolbarItemAllowDuplicates
| kHIToolbarItemCantBeRemoved, &item);
if (item)
{
SetEventParameter (event, kEventParamToolbarItem,
typeHIToolbarItemRef,
sizeof (HIToolbarItemRef), &item);
result = noErr;
}
}
break;
default:
abort ();
}
return result;
}
static CGImageRef
mac_image_spec_to_cg_image (f, image)
struct frame *f;
Lisp_Object image;
{
if (!valid_image_p (image))
return NULL;
else
{
int img_id = lookup_image (f, image);
struct image *img = IMAGE_FROM_ID (f, img_id);
prepare_image_for_display (f, img);
return img->data.ptr_val;
}
}
/* Create a tool bar for frame F. */
static OSStatus
mac_create_frame_tool_bar (f)
FRAME_PTR f;
{
OSStatus err;
HIToolbarRef toolbar;
err = HIToolbarCreate (TOOLBAR_IDENTIFIER, kHIToolbarNoAttributes,
&toolbar);
if (err == noErr)
{
static const EventTypeSpec specs[] =
{{kEventClassToolbar, kEventToolbarGetDefaultIdentifiers},
{kEventClassToolbar, kEventToolbarGetAllowedIdentifiers},
{kEventClassToolbar, kEventToolbarCreateItemWithIdentifier}};
err = InstallEventHandler (HIObjectGetEventTarget (toolbar),
mac_handle_toolbar_event,
GetEventTypeCount (specs), specs,
f, NULL);
}
if (err == noErr)
err = HIToolbarSetDisplayMode (toolbar, kHIToolbarDisplayModeIconOnly);
if (err == noErr)
{
static const EventTypeSpec specs[] =
{{kEventClassCommand, kEventCommandProcess}};
err = InstallWindowEventHandler (FRAME_MAC_WINDOW (f),
mac_handle_toolbar_command_event,
GetEventTypeCount (specs),
specs, f, NULL);
}
if (err == noErr)
err = SetWindowToolbar (FRAME_MAC_WINDOW (f), toolbar);
if (toolbar)
CFRelease (toolbar);
return err;
}
/* Update the tool bar for frame F. Add new buttons and remove old. */
void
update_frame_tool_bar (f)
FRAME_PTR f;
{
HIToolbarRef toolbar = NULL;
short left, top;
CFArrayRef old_items = NULL;
CFIndex old_count;
int i, pos, win_gravity = f->output_data.mac->toolbar_win_gravity;
struct mac_display_info *dpyinfo = FRAME_MAC_DISPLAY_INFO (f);
BLOCK_INPUT;
GetWindowToolbar (FRAME_MAC_WINDOW (f), &toolbar);
if (toolbar == NULL)
{
mac_create_frame_tool_bar (f);
GetWindowToolbar (FRAME_MAC_WINDOW (f), &toolbar);
if (toolbar == NULL)
goto out;
if (win_gravity >= NorthWestGravity && win_gravity <= SouthEastGravity)
mac_get_window_origin_with_gravity (f, win_gravity, &left, &top);
}
HIToolbarCopyItems (toolbar, &old_items);
if (old_items == NULL)
goto out;
old_count = CFArrayGetCount (old_items);
pos = 0;
for (i = 0; i < f->n_tool_bar_items; ++i)
{
#define PROP(IDX) AREF (f->tool_bar_items, i * TOOL_BAR_ITEM_NSLOTS + (IDX))
int enabled_p = !NILP (PROP (TOOL_BAR_ITEM_ENABLED_P));
int selected_p = !NILP (PROP (TOOL_BAR_ITEM_SELECTED_P));
int idx;
Lisp_Object image;
CGImageRef cg_image;
CFStringRef label;
HIToolbarItemRef item;
/* If image is a vector, choose the image according to the
button state. */
image = PROP (TOOL_BAR_ITEM_IMAGES);
if (VECTORP (image))
{
if (enabled_p)
idx = (selected_p
? TOOL_BAR_IMAGE_ENABLED_SELECTED
: TOOL_BAR_IMAGE_ENABLED_DESELECTED);
else
idx = (selected_p
? TOOL_BAR_IMAGE_DISABLED_SELECTED
: TOOL_BAR_IMAGE_DISABLED_DESELECTED);
xassert (ASIZE (image) >= idx);
image = AREF (image, idx);
}
else
idx = -1;
cg_image = mac_image_spec_to_cg_image (f, image);
/* Ignore invalid image specifications. */
if (cg_image == NULL)
continue;
label = cfstring_create_with_string (PROP (TOOL_BAR_ITEM_CAPTION));
if (label == NULL)
label = CFSTR ("");
if (pos < old_count)
{
CGImageRef old_cg_image = NULL;
CFStringRef old_label = NULL;
Boolean old_enabled_p;
item = (HIToolbarItemRef) CFArrayGetValueAtIndex (old_items, pos);
HIToolbarItemCopyImage (item, &old_cg_image);
if (cg_image != old_cg_image)
HIToolbarItemSetImage (item, cg_image);
CGImageRelease (old_cg_image);
HIToolbarItemCopyLabel (item, &old_label);
if (CFStringCompare (label, old_label, 0) != kCFCompareEqualTo)
HIToolbarItemSetLabel (item, label);
CFRelease (old_label);
old_enabled_p = HIToolbarItemIsEnabled (item);
if ((enabled_p || idx >= 0) != old_enabled_p)
HIToolbarItemSetEnabled (item, (enabled_p || idx >= 0));
}
else
{
item = NULL;
HIToolbarCreateItemWithIdentifier (toolbar,
TOOLBAR_ICON_ITEM_IDENTIFIER,
NULL, &item);
if (item)
{
HIToolbarItemSetImage (item, cg_image);
HIToolbarItemSetLabel (item, label);
HIToolbarItemSetEnabled (item, (enabled_p || idx >= 0));
HIToolbarAppendItem (toolbar, item);
CFRelease (item);
}
}
CFRelease (label);
if (item)
{
HIToolbarItemSetCommandID (item, TOOLBAR_ITEM_MAKE_COMMAND_ID (i));
pos++;
}
}
CFRelease (old_items);
while (pos < old_count)
HIToolbarRemoveItemAtIndex (toolbar, --old_count);
ShowHideWindowToolbar (FRAME_MAC_WINDOW (f), true,
!win_gravity && f == mac_focus_frame (dpyinfo));
/* Mac OS X 10.3 does not issue kEventWindowBoundsChanged events on
toolbar visibility change. */
mac_handle_origin_change (f);
if (win_gravity >= NorthWestGravity && win_gravity <= SouthEastGravity)
{
mac_move_window_with_gravity (f, win_gravity, left, top);
/* If the title bar is completely outside the screen, adjust the
position. */
ConstrainWindowToScreen (FRAME_MAC_WINDOW (f), kWindowTitleBarRgn,
kWindowConstrainMoveRegardlessOfFit
| kWindowConstrainAllowPartial, NULL, NULL);
f->output_data.mac->toolbar_win_gravity = 0;
}
out:
UNBLOCK_INPUT;
}
/* Hide the tool bar on frame F. Unlike the counterpart on GTK+, it
doesn't deallocate the resources. */
void
free_frame_tool_bar (f)
FRAME_PTR f;
{
if (IsWindowToolbarVisible (FRAME_MAC_WINDOW (f)))
{
struct mac_display_info *dpyinfo = FRAME_MAC_DISPLAY_INFO (f);
BLOCK_INPUT;
ShowHideWindowToolbar (FRAME_MAC_WINDOW (f), false,
f == mac_focus_frame (dpyinfo));
/* Mac OS X 10.3 does not issue kEventWindowBoundsChanged events
on toolbar visibility change. */
mac_handle_origin_change (f);
UNBLOCK_INPUT;
}
}
static void
mac_tool_bar_note_mouse_movement (f, event)
struct frame *f;
EventRef event;
{
OSStatus err;
struct mac_display_info *dpyinfo = FRAME_MAC_DISPLAY_INFO (f);
int mouse_down_p;
HIViewRef item_view;
UInt32 command_id;
mouse_down_p = (dpyinfo->grabbed
&& f == last_mouse_frame
&& FRAME_LIVE_P (f));
if (mouse_down_p)
return;
err = HIViewGetViewForMouseEvent (HIViewGetRoot (FRAME_MAC_WINDOW (f)),
event, &item_view);
/* This doesn't work on Mac OS X 10.2. On Mac OS X 10.3 and 10.4, a
toolbar item view seems to have the same command ID with that of
the toolbar item. */
if (err == noErr)
err = GetControlCommandID (item_view, &command_id);
if (err == noErr && TOOLBAR_ITEM_COMMAND_ID_P (command_id))
{
int i = TOOLBAR_ITEM_COMMAND_ID_VALUE (command_id);
if (i < f->n_tool_bar_items)
{
HIRect bounds;
HIViewRef content_view;
err = HIViewGetBounds (item_view, &bounds);
if (err == noErr)
err = HIViewFindByID (HIViewGetRoot (FRAME_MAC_WINDOW (f)),
kHIViewWindowContentID, &content_view);
if (err == noErr)
err = HIViewConvertRect (&bounds, item_view, content_view);
if (err == noErr)
SetRect (&last_mouse_glyph,
CGRectGetMinX (bounds), CGRectGetMinY (bounds),
CGRectGetMaxX (bounds), CGRectGetMaxY (bounds));
help_echo_object = help_echo_window = Qnil;
help_echo_pos = -1;
help_echo_string = PROP (TOOL_BAR_ITEM_HELP);
if (NILP (help_echo_string))
help_echo_string = PROP (TOOL_BAR_ITEM_CAPTION);
}
}
}
static OSStatus
mac_handle_toolbar_command_event (next_handler, event, data)
EventHandlerCallRef next_handler;
EventRef event;
void *data;
{
OSStatus err, result = eventNotHandledErr;
struct frame *f = (struct frame *) data;
HICommand command;
err = GetEventParameter (event, kEventParamDirectObject,
typeHICommand, NULL,
sizeof (HICommand), NULL, &command);
if (err != noErr)
return result;
switch (GetEventKind (event))
{
case kEventCommandProcess:
if (!TOOLBAR_ITEM_COMMAND_ID_P (command.commandID))
result = CallNextEventHandler (next_handler, event);
else
{
int i = TOOLBAR_ITEM_COMMAND_ID_VALUE (command.commandID);
if (i < f->n_tool_bar_items
&& !NILP (PROP (TOOL_BAR_ITEM_ENABLED_P)))
{
Lisp_Object frame;
struct input_event buf;
EVENT_INIT (buf);
XSETFRAME (frame, f);
buf.kind = TOOL_BAR_EVENT;
buf.frame_or_window = frame;
buf.arg = frame;
kbd_buffer_store_event (&buf);
buf.kind = TOOL_BAR_EVENT;
buf.frame_or_window = frame;
buf.arg = PROP (TOOL_BAR_ITEM_KEY);
buf.modifiers = mac_event_to_emacs_modifiers (event);
kbd_buffer_store_event (&buf);
result = noErr;
}
}
break;
default:
abort ();
}
#undef PROP
return result;
}
#endif /* USE_MAC_TOOLBAR */
/***********************************************************************
Text Cursor
@ -10075,6 +10698,13 @@ mac_handle_window_event (next_handler, event, data)
kWindowCascadeOnParentWindowScreen
#endif
);
#if USE_MAC_TOOLBAR
/* This is a workaround. RepositionWindow fails to put
a window at the cascading position when its parent
window has a Carbon HIToolbar. */
if (f->top_pos == sf->top_pos && f->left_pos == sf->left_pos)
MoveWindowStructure (wp, f->left_pos + 10, f->top_pos + 32);
#endif
}
result = noErr;
}
@ -10357,8 +10987,7 @@ mac_handle_keyboard_event (next_handler, event, data)
if (err != noErr)
break;
do_keystroke ((GetEventKind (event) == kEventRawKeyDown
? keyDown : autoKey),
do_keystroke ((event_kind == kEventRawKeyDown ? keyDown : autoKey),
char_code, key_code, modifiers,
((unsigned long)
(GetEventTime (event) / kEventDurationMillisecond)),
@ -11412,6 +12041,21 @@ XTread_socket (sd, expected, hold_quit)
do_zoom_window (window_ptr, part_code);
break;
#if USE_MAC_TOOLBAR
case inStructure:
{
OSStatus err;
HIViewRef ch;
err = HIViewGetViewForMouseEvent (HIViewGetRoot (window_ptr),
eventRef, &ch);
/* This doesn't work on Mac OS X 10.2. */
if (err == noErr)
HIViewClick (ch, eventRef);
}
break;
#endif /* USE_MAC_TOOLBAR */
default:
break;
}
@ -11496,6 +12140,10 @@ XTread_socket (sd, expected, hold_quit)
}
if (!note_mouse_movement (f, &mouse_pos))
help_echo_string = previous_help_echo_string;
#if USE_MAC_TOOLBAR
else
mac_tool_bar_note_mouse_movement (f, eventRef);
#endif
}
}

20
src/macterm.h
View File

@ -336,6 +336,16 @@ struct mac_output
/* Hints for the size and the position of a window. */
XSizeHints *size_hints;
#if USE_MAC_TOOLBAR
/* This variable records the gravity value of the window position if
the window has an external tool bar when it is created. The
position of the window is adjusted using this information when
the tool bar is first redisplayed. Once the tool bar is
redisplayed, it is set to 0 in order to avoid further
adjustment. */
int toolbar_win_gravity;
#endif
#if USE_CG_DRAWING
/* Quartz 2D graphics context. */
CGContextRef cg_context;
@ -441,6 +451,12 @@ struct scroll_bar {
being dragged, this is Qnil. */
Lisp_Object dragging;
#ifdef MAC_OSX
/* t if the background of the fringe that is adjacent to a scroll
bar is extended to the gap between the fringe and the bar. */
Lisp_Object fringe_extended_p;
#endif
#ifdef USE_TOOLKIT_SCROLL_BARS
/* The position and size of the scroll bar handle track area in
pixels, relative to the frame. */
@ -651,6 +667,10 @@ extern void mac_prepare_for_quickdraw P_ ((struct frame *));
#endif
extern void mac_get_window_bounds P_ ((struct frame *, Rect *, Rect *));
extern int mac_quit_char_key_p P_ ((UInt32, UInt32));
#if USE_MAC_TOOLBAR
extern void update_frame_tool_bar P_ ((FRAME_PTR f));
extern void free_frame_tool_bar P_ ((FRAME_PTR f));
#endif
#define FONT_TYPE_FOR_UNIBYTE(font, ch) 0
#define FONT_TYPE_FOR_MULTIBYTE(font, ch) 0

71
src/regex.c
View File

@ -2482,11 +2482,6 @@ regex_compile (pattern, size, syntax, bufp)
last -- ends with a forward jump of this sort. */
unsigned char *fixup_alt_jump = 0;
/* Counts open-groups as they are encountered. Remembered for the
matching close-group on the compile stack, so the same register
number is put in the stop_memory as the start_memory. */
regnum_t regnum = 0;
/* Work area for range table of charset. */
struct range_table_work_area range_table_work;
@ -3123,28 +3118,54 @@ regex_compile (pattern, size, syntax, bufp)
handle_open:
{
int shy = 0;
regnum_t regnum = 0;
if (p+1 < pend)
{
/* Look for a special (?...) construct */
if ((syntax & RE_SHY_GROUPS) && *p == '?')
{
PATFETCH (c); /* Gobble up the '?'. */
PATFETCH (c);
switch (c)
while (!shy)
{
case ':': shy = 1; break;
default:
/* Only (?:...) is supported right now. */
FREE_STACK_RETURN (REG_BADPAT);
PATFETCH (c);
switch (c)
{
case ':': shy = 1; break;
case '0':
/* An explicitly specified regnum must start
with non-0. */
if (regnum == 0)
FREE_STACK_RETURN (REG_BADPAT);
case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
regnum = 10*regnum + (c - '0'); break;
default:
/* Only (?:...) is supported right now. */
FREE_STACK_RETURN (REG_BADPAT);
}
}
}
}
if (!shy)
{
bufp->re_nsub++;
regnum++;
regnum = ++bufp->re_nsub;
else if (regnum)
{ /* It's actually not shy, but explicitly numbered. */
shy = 0;
if (regnum > bufp->re_nsub)
bufp->re_nsub = regnum;
else if (regnum > bufp->re_nsub
/* Ideally, we'd want to check that the specified
group can't have matched (i.e. all subgroups
using the same regnum are in other branches of
OR patterns), but we don't currently keep track
of enough info to do that easily. */
|| group_in_compile_stack (compile_stack, regnum))
FREE_STACK_RETURN (REG_BADPAT);
}
else
/* It's really shy. */
regnum = - bufp->re_nsub;
if (COMPILE_STACK_FULL)
{
@ -3163,12 +3184,11 @@ regex_compile (pattern, size, syntax, bufp)
COMPILE_STACK_TOP.fixup_alt_jump
= fixup_alt_jump ? fixup_alt_jump - bufp->buffer + 1 : 0;
COMPILE_STACK_TOP.laststart_offset = b - bufp->buffer;
COMPILE_STACK_TOP.regnum = shy ? -regnum : regnum;
COMPILE_STACK_TOP.regnum = regnum;
/* Do not push a
start_memory for groups beyond the last one we can
represent in the compiled pattern. */
if (regnum <= MAX_REGNUM && !shy)
/* Do not push a start_memory for groups beyond the last one
we can represent in the compiled pattern. */
if (regnum <= MAX_REGNUM && regnum > 0)
BUF_PUSH_2 (start_memory, regnum);
compile_stack.avail++;
@ -3213,7 +3233,7 @@ regex_compile (pattern, size, syntax, bufp)
/* We don't just want to restore into `regnum', because
later groups should continue to be numbered higher,
as in `(ab)c(de)' -- the second group is #2. */
regnum_t this_group_regnum;
regnum_t regnum;
compile_stack.avail--;
begalt = bufp->buffer + COMPILE_STACK_TOP.begalt_offset;
@ -3222,7 +3242,7 @@ regex_compile (pattern, size, syntax, bufp)
? bufp->buffer + COMPILE_STACK_TOP.fixup_alt_jump - 1
: 0;
laststart = bufp->buffer + COMPILE_STACK_TOP.laststart_offset;
this_group_regnum = COMPILE_STACK_TOP.regnum;
regnum = COMPILE_STACK_TOP.regnum;
/* If we've reached MAX_REGNUM groups, then this open
won't actually generate any code, so we'll have to
clear pending_exact explicitly. */
@ -3230,8 +3250,8 @@ regex_compile (pattern, size, syntax, bufp)
/* We're at the end of the group, so now we know how many
groups were inside this one. */
if (this_group_regnum <= MAX_REGNUM && this_group_regnum > 0)
BUF_PUSH_2 (stop_memory, this_group_regnum);
if (regnum <= MAX_REGNUM && regnum > 0)
BUF_PUSH_2 (stop_memory, regnum);
}
break;
@ -3557,8 +3577,9 @@ regex_compile (pattern, size, syntax, bufp)
reg = c - '0';
/* Can't back reference to a subexpression before its end. */
if (reg > regnum || group_in_compile_stack (compile_stack, reg))
if (reg > bufp->re_nsub || reg < 1
/* Can't back reference to a subexp before its end. */
|| group_in_compile_stack (compile_stack, reg))
FREE_STACK_RETURN (REG_ESUBREG);
laststart = b;

Some files were not shown because too many files have changed in this diff Show More