Mercurial > emacs
changeset 110600:0e84d4500f6b
merge trunk
| author | Kenichi Handa <handa@m17n.org> |
|---|---|
| date | Mon, 27 Sep 2010 14:42:43 +0900 |
| parents | ee58b36ab139 (current diff) eae9fd6b889d (diff) |
| children | 1d759828bb3d |
| files | lisp/gnus/earcon.el lisp/gnus/gnus-audio.el lisp/gnus/gnus-nocem.el src/ChangeLog src/dispextern.h src/dispnew.c src/term.c src/xdisp.c |
| diffstat | 325 files changed, 11990 insertions(+), 8307 deletions(-) [+] |
line wrap: on
line diff
--- a/ChangeLog Mon Sep 27 14:27:28 2010 +0900 +++ b/ChangeLog Mon Sep 27 14:42:43 2010 +0900 @@ -1,3 +1,16 @@ +2010-09-26 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * configure.in (HAVE_GNUTLS): Don't break if we don't have the + gnutls libraries. + +2010-09-26 Teodor Zlatanov <tzz@lifelogs.com> + + * configure.in: Set up GnuTLS. + +2010-09-22 Chong Yidong <cyd@stupidchicken.com> + + * configure.in: Announce whether libxml2 is linked to. + 2010-09-20 Dan Nicolaescu <dann@ics.uci.edu> * configure.in (LINKER): Rename to LD_FIRSTFLAG, do not include $(CC).
--- a/configure Mon Sep 27 14:27:28 2010 +0900 +++ b/configure Mon Sep 27 14:42:43 2010 +0900 @@ -681,6 +681,8 @@ FONTCONFIG_CFLAGS LIBXMU LIBXTR6 +LIBGNUTLS_LIBS +LIBGNUTLS_CFLAGS LIBSELINUX_LIBS GCONF_LIBS GCONF_CFLAGS @@ -822,6 +824,7 @@ with_dbus with_gconf with_selinux +with_gnutls with_makeinfo with_compress_info with_pkg_config_prog @@ -1532,6 +1535,7 @@ --without-dbus don't compile with D-Bus support --without-gconf don't compile with GConf support --without-selinux don't compile with SELinux support + --without-gnutls don't use -lgnutls for SSL/TLS support --without-makeinfo don't require makeinfo for building manuals --without-compress-info don't compress the installed Info pages --with-pkg-config-prog=PATH @@ -2843,6 +2847,14 @@ fi +# Check whether --with-gnutls was given. +if test "${with_gnutls+set}" = set; then : + withval=$with_gnutls; +else + with_gnutls=yes +fi + + ## For the times when you want to build Emacs but don't have ## a suitable makeinfo, and can live without the manuals. @@ -9398,6 +9410,110 @@ fi +HAVE_GNUTLS=no +if test "${with_gnutls}" = "yes" ; then + + succeeded=no + + # Extract the first word of "pkg-config", so it can be a program name with args. +set dummy pkg-config; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + case $PKG_CONFIG in + [\\/]* | ?:[\\/]*) + ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no" + ;; +esac +fi +PKG_CONFIG=$ac_cv_path_PKG_CONFIG +if test -n "$PKG_CONFIG"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 +$as_echo "$PKG_CONFIG" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + + if test "$PKG_CONFIG" = "no" ; then + HAVE_GNUTLS=no + else + PKG_CONFIG_MIN_VERSION=0.9.0 + if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gnutls >= 2.2.4" >&5 +$as_echo_n "checking for gnutls >= 2.2.4... " >&6; } + + if $PKG_CONFIG --exists "gnutls >= 2.2.4" 2>&5; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + succeeded=yes + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBGNUTLS_CFLAGS" >&5 +$as_echo_n "checking LIBGNUTLS_CFLAGS... " >&6; } + LIBGNUTLS_CFLAGS=`$PKG_CONFIG --cflags "gnutls >= 2.2.4"|sed -e 's,///*,/,g'` + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBGNUTLS_CFLAGS" >&5 +$as_echo "$LIBGNUTLS_CFLAGS" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBGNUTLS_LIBS" >&5 +$as_echo_n "checking LIBGNUTLS_LIBS... " >&6; } + LIBGNUTLS_LIBS=`$PKG_CONFIG --libs "gnutls >= 2.2.4"|sed -e 's,///*,/,g'` + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBGNUTLS_LIBS" >&5 +$as_echo "$LIBGNUTLS_LIBS" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + LIBGNUTLS_CFLAGS="" + LIBGNUTLS_LIBS="" + ## If we have a custom action on failure, don't print errors, but + ## do set a variable so people can do so. + LIBGNUTLS_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "gnutls >= 2.2.4"` + + fi + + + + else + echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer." + echo "*** See http://www.freedesktop.org/software/pkgconfig" + fi + fi + + if test $succeeded = yes; then + HAVE_GNUTLS=yes + else + HAVE_GNUTLS=no + fi + + if test "${HAVE_GNUTLS}" = "yes"; then + $as_echo "#define HAVE_GNUTLS 1" >>confdefs.h + + fi +fi + + + HAVE_XAW3D=no LUCID_LIBW= if test x"${USE_X_TOOLKIT}" = xmaybe || test x"${USE_X_TOOLKIT}" = xLUCID; then @@ -14849,10 +14965,13 @@ echo " Does Emacs use -lpng? ${HAVE_PNG}" echo " Does Emacs use -lrsvg-2? ${HAVE_RSVG}" echo " Does Emacs use imagemagick? ${HAVE_IMAGEMAGICK}" + echo " Does Emacs use -lgpm? ${HAVE_GPM}" echo " Does Emacs use -ldbus? ${HAVE_DBUS}" echo " Does Emacs use -lgconf? ${HAVE_GCONF}" echo " Does Emacs use -lselinux? ${HAVE_LIBSELINUX}" +echo " Does Emacs use -lgnutls (BROKEN)? ${HAVE_GNUTLS}" +echo " Does Emacs use -lxml2? ${HAVE_LIBXML2}" echo " Does Emacs use -lfreetype? ${HAVE_FREETYPE}" echo " Does Emacs use -lm17n-flt? ${HAVE_M17N_FLT}"
--- a/configure.in Mon Sep 27 14:27:28 2010 +0900 +++ b/configure.in Mon Sep 27 14:42:43 2010 +0900 @@ -171,6 +171,7 @@ OPTION_DEFAULT_ON([dbus],[don't compile with D-Bus support]) OPTION_DEFAULT_ON([gconf],[don't compile with GConf support]) OPTION_DEFAULT_ON([selinux],[don't compile with SELinux support]) +OPTION_DEFAULT_ON([gnutls],[don't use -lgnutls for SSL/TLS support]) ## For the times when you want to build Emacs but don't have ## a suitable makeinfo, and can live without the manuals. @@ -1999,6 +2000,16 @@ fi AC_SUBST(LIBSELINUX_LIBS) +HAVE_GNUTLS=no +if test "${with_gnutls}" = "yes" ; then + PKG_CHECK_MODULES([LIBGNUTLS], [gnutls >= 2.2.4], HAVE_GNUTLS=yes, HAVE_GNUTLS=no) + if test "${HAVE_GNUTLS}" = "yes"; then + AC_DEFINE(HAVE_GNUTLS) + fi +fi +AC_SUBST(LIBGNUTLS_LIBS) +AC_SUBST(LIBGNUTLS_CFLAGS) + dnl Do not put whitespace before the #include statements below. dnl Older compilers (eg sunos4 cc) choke on it. HAVE_XAW3D=no @@ -3696,10 +3707,13 @@ echo " Does Emacs use -lpng? ${HAVE_PNG}" echo " Does Emacs use -lrsvg-2? ${HAVE_RSVG}" echo " Does Emacs use imagemagick? ${HAVE_IMAGEMAGICK}" + echo " Does Emacs use -lgpm? ${HAVE_GPM}" echo " Does Emacs use -ldbus? ${HAVE_DBUS}" echo " Does Emacs use -lgconf? ${HAVE_GCONF}" echo " Does Emacs use -lselinux? ${HAVE_LIBSELINUX}" +echo " Does Emacs use -lgnutls (BROKEN)? ${HAVE_GNUTLS}" +echo " Does Emacs use -lxml2? ${HAVE_LIBXML2}" echo " Does Emacs use -lfreetype? ${HAVE_FREETYPE}" echo " Does Emacs use -lm17n-flt? ${HAVE_M17N_FLT}"
--- a/doc/lispintro/ChangeLog Mon Sep 27 14:27:28 2010 +0900 +++ b/doc/lispintro/ChangeLog Mon Sep 27 14:42:43 2010 +0900 @@ -1,3 +1,9 @@ +2010-09-21 Glenn Morris <rgm@gnu.org> + + * cons-1.eps, cons-2.eps, cons-2a.eps, cons-3.eps, cons-4.eps: + * cons-5.eps, lambda-1.eps, lambda-2.eps, lambda-3.eps: + Add first line EPSF magic comment. (Bug#7064) + 2010-06-23 Glenn Morris <rgm@gnu.org> * emacs-lisp-intro.texi: Untabify.
--- a/doc/lispintro/cons-1.eps Mon Sep 27 14:27:28 2010 +0900 +++ b/doc/lispintro/cons-1.eps Mon Sep 27 14:42:43 2010 +0900 @@ -1,14 +1,11 @@ -%! +%!PS-Adobe-3.0 EPSF-3.0 %%BoundingBox: 35 711 289 757 %%Title: cons-cell-diagram1 %%CreationDate: Wed Mar 8 14:26:58 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% -% Due to bugs in Transcript, the 'PS-Adobe-' stuff is omitted from line 1 -% -% Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -% Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +% 2008, 2009, 2010 Free Software Foundation, Inc. % % This file is part of GNU Emacs. %
--- a/doc/lispintro/cons-2.eps Mon Sep 27 14:27:28 2010 +0900 +++ b/doc/lispintro/cons-2.eps Mon Sep 27 14:42:43 2010 +0900 @@ -1,14 +1,11 @@ -%! +%!PS-Adobe-3.0 EPSF-3.0 %%BoundingBox: 15 712 321 775 %%Title: cons-cell-diagram2 %%CreationDate: Wed Mar 8 14:26:39 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% -% Due to bugs in Transcript, the 'PS-Adobe-' stuff is omitted from line 1 -% -% Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -% Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +% 2008, 2009, 2010 Free Software Foundation, Inc. % % This file is part of GNU Emacs. %
--- a/doc/lispintro/cons-2a.eps Mon Sep 27 14:27:28 2010 +0900 +++ b/doc/lispintro/cons-2a.eps Mon Sep 27 14:42:43 2010 +0900 @@ -1,14 +1,11 @@ -%! +%!PS-Adobe-3.0 EPSF-3.0 %%BoundingBox: 15 702 300 767 %%Title: cons-cell-diagram2a %%CreationDate: Tue Mar 14 15:09:30 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% -% Due to bugs in Transcript, the 'PS-Adobe-' stuff is omitted from line 1 -% -% Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -% Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +% 2008, 2009, 2010 Free Software Foundation, Inc. % % This file is part of GNU Emacs. %
--- a/doc/lispintro/cons-3.eps Mon Sep 27 14:27:28 2010 +0900 +++ b/doc/lispintro/cons-3.eps Mon Sep 27 14:42:43 2010 +0900 @@ -1,14 +1,11 @@ -%! +%!PS-Adobe-3.0 EPSF-3.0 %%BoundingBox: -1 691 324 757 %%Title: cons-cell-diagram3 %%CreationDate: Wed Mar 8 14:25:41 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% -% Due to bugs in Transcript, the 'PS-Adobe-' stuff is omitted from line 1 -% -% Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -% Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +% 2008, 2009, 2010 Free Software Foundation, Inc. % % This file is part of GNU Emacs. %
--- a/doc/lispintro/cons-4.eps Mon Sep 27 14:27:28 2010 +0900 +++ b/doc/lispintro/cons-4.eps Mon Sep 27 14:42:43 2010 +0900 @@ -1,14 +1,11 @@ -%! +%!PS-Adobe-3.0 EPSF-3.0 %%BoundingBox: 6 681 355 758 %%Title: cons-cell-diagram4 %%CreationDate: Wed Mar 8 14:25:06 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% -% Due to bugs in Transcript, the 'PS-Adobe-' stuff is omitted from line 1 -% -% Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -% Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +% 2008, 2009, 2010 Free Software Foundation, Inc. % % This file is part of GNU Emacs. %
--- a/doc/lispintro/cons-5.eps Mon Sep 27 14:27:28 2010 +0900 +++ b/doc/lispintro/cons-5.eps Mon Sep 27 14:42:43 2010 +0900 @@ -1,14 +1,11 @@ -%! +%!PS-Adobe-3.0 EPSF-3.0 %%BoundingBox: 15 680 305 764 %%Title: cons-cell-diagram5 %%CreationDate: Wed Mar 8 14:27:28 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% -% Due to bugs in Transcript, the 'PS-Adobe-' stuff is omitted from line 1 -% -% Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -% Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +% 2008, 2009, 2010 Free Software Foundation, Inc. % % This file is part of GNU Emacs. %
--- a/doc/lispintro/lambda-1.eps Mon Sep 27 14:27:28 2010 +0900 +++ b/doc/lispintro/lambda-1.eps Mon Sep 27 14:42:43 2010 +0900 @@ -1,14 +1,11 @@ -%! +%!PS-Adobe-3.0 EPSF-3.0 %%BoundingBox: 33 710 173 759 %%Title: lambda-diagram1 %%CreationDate: Wed Mar 8 14:31:53 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% -% Due to bugs in Transcript, the 'PS-Adobe-' stuff is omitted from line 1 -% -% Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -% Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +% 2008, 2009, 2010 Free Software Foundation, Inc. % % This file is part of GNU Emacs. %
--- a/doc/lispintro/lambda-2.eps Mon Sep 27 14:27:28 2010 +0900 +++ b/doc/lispintro/lambda-2.eps Mon Sep 27 14:42:43 2010 +0900 @@ -1,14 +1,11 @@ -%! +%!PS-Adobe-3.0 EPSF-3.0 %%BoundingBox: 33 730 240 777 %%Title: lambda-diagram2 %%CreationDate: Wed Mar 8 14:33:09 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% -% Due to bugs in Transcript, the 'PS-Adobe-' stuff is omitted from line 1 -% -% Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -% Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +% 2008, 2009, 2010 Free Software Foundation, Inc. % % This file is part of GNU Emacs. %
--- a/doc/lispintro/lambda-3.eps Mon Sep 27 14:27:28 2010 +0900 +++ b/doc/lispintro/lambda-3.eps Mon Sep 27 14:42:43 2010 +0900 @@ -1,14 +1,11 @@ -%! +%!PS-Adobe-3.0 EPSF-3.0 %%BoundingBox: 33 728 211 777 %%Title: lambda-diagram3 %%CreationDate: Wed Mar 8 14:33:49 1995 %%Creator: Tgif-2.16-p4 by William Chia-Wei Cheng (william@cs.UCLA.edu) -% -% Due to bugs in Transcript, the 'PS-Adobe-' stuff is omitted from line 1 -% -% Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -% Free Software Foundation, Inc. +% Copyright (C) 1995, 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +% 2008, 2009, 2010 Free Software Foundation, Inc. % % This file is part of GNU Emacs. %
--- a/doc/man/ChangeLog Mon Sep 27 14:27:28 2010 +0900 +++ b/doc/man/ChangeLog Mon Sep 27 14:42:43 2010 +0900 @@ -1,3 +1,7 @@ +2010-09-25 Ulrich Mueller <ulm@gentoo.org> + + * etags.1: xz compression is now supported. + 2010-08-26 Sven Joachim <svenjoac@gmx.de> * emacs.1: Mention "maximized" value for the "fullscreen" X resource.
--- a/doc/man/etags.1 Mon Sep 27 14:27:28 2010 +0900 +++ b/doc/man/etags.1 Mon Sep 27 14:42:43 2010 +0900 @@ -62,7 +62,7 @@ with absolute file names. Files generated from a source file\-\-like a C file generated from a source Cweb file\-\-will be recorded with the name of the source file. -Compressed files are supported using gzip and bzip2. +Compressed files are supported using gzip, bzip2, and xz. The programs recognize the language used in an input file based on its file name and contents. The \fB\-\-language\fP switch can be used to force parsing of the file names following the switch according to the given
--- a/doc/misc/ChangeLog Mon Sep 27 14:27:28 2010 +0900 +++ b/doc/misc/ChangeLog Mon Sep 27 14:42:43 2010 +0900 @@ -1,3 +1,60 @@ +2010-09-26 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-news.texi: Mention nnimap-inbox. + + * gnus.texi (Picons): Document gnus-picon-inhibit-top-level-domains. + +2010-09-26 Julien Danjou <julien@danjou.info> + + * gnus.texi (Oort Gnus): Remove mention of ssl.el + +2010-09-26 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Security): Remove gpg.el mention. + +2010-09-26 Andreas Seltenreich <seltenreich@gmx.de> + + * gnus.texi (Browse Foreign Server): New variable + gnus-browse-subscribe-newsgroup-method. + + * gnus-news.texi: Mention it. + +2010-09-26 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (NoCeM): Removed. + (Startup Variables): No jingle. + +2010-09-25 Ulrich Mueller <ulm@gentoo.org> + + * woman.texi (Interface Options): xz compression is now supported. + +2010-09-25 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Article Commands): Document gnus-fetch-partial-articles. + (Unavailable Servers): Document gnus-server-copy-server. + (Using IMAP): Document the new nnimap. + +2010-09-25 Julien Danjou <julien@danjou.info> + + * gnus.texi (Customizing Articles): Remove gnus-treat-translate + +2010-09-24 Glenn Morris <rgm@gnu.org> + + * url.texi (Disk Caching): Tweak previous change. + +2010-09-24 Julien Danjou <julien@danjou.info> + + * url.texi (Disk Caching): Mention url-cache-expire-time, + url-cache-expired, and url-fetch-from-cache. + +2010-09-24 Julien Danjou <julien@danjou.info> + + * gnus.texi: Add Gravatars. + +2010-09-23 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Startup Variables): Mention gnus-use-backend-marks. + 2010-09-21 Lars Magne Ingebrigtsen <larsi@gnus.org> * gnus.texi (Expunging mailboxes): Update name of the expunging
--- a/doc/misc/gnus-news.texi Mon Sep 27 14:27:28 2010 +0900 +++ b/doc/misc/gnus-news.texi Mon Sep 27 14:42:43 2010 +0900 @@ -68,8 +68,10 @@ @item New version of @code{nnimap} -@code{nnimap} has been reimplemented in a mostly-compatible way. -@c Mention any incompatibilities. +@code{nnimap} has been reimplemented in a mostly-compatible way. See +the Gnus manual for a description of the new interface. In +particular, @code{nnimap-inbox} and the client side split method has +changed. @item Gnus includes the Emacs Lisp @acronym{SASL} library. @@ -103,6 +105,12 @@ @c ************************ @itemize @bullet + +@item +Symbols like @code{gcc-self} now has the same presedence rules in +@code{gnus-parameters} as other ``real'' variables: The last match +wins instead of the first match. + @item Old intermediate incoming mail files (@file{Incoming*}) are deleted after a couple of days, not immediately. @xref{Mail Source @@ -246,6 +254,16 @@ @code{message-insert-formatted-citation-line} as well. @end itemize +@item Changes in Browse Server mode + +@itemize @bullet +@item Gnus' sophisticated subscription methods are now available in +Browse Server buffers as well using the variable +@code{gnus-browse-subscribe-newsgroup-method}. + +@end itemize + + @item Changes in back ends @itemize @bullet @@ -336,6 +354,8 @@ moving articles to a group that has not turned auto-expire on. @xref{Expiring Mail}. +@item NoCeM support has been removed. + @end itemize @end itemize
--- a/doc/misc/gnus.texi Mon Sep 27 14:27:28 2010 +0900 +++ b/doc/misc/gnus.texi Mon Sep 27 14:42:43 2010 +0900 @@ -589,7 +589,7 @@ * Article Buttons:: Click on URLs, Message-IDs, addresses and the like. * Article Button Levels:: Controlling appearance of buttons. * Article Date:: Grumble, UT! -* Article Display:: Display various stuff---X-Face, Picons, Smileys +* Article Display:: Display various stuff---X-Face, Picons, Smileys, Gravatars * Article Signature:: What is a signature? * Article Miscellanea:: Various other stuff. @@ -629,9 +629,9 @@ * Server Buffer:: Making and editing virtual servers. * Getting News:: Reading USENET news with Gnus. +* Using @acronym{IMAP}:: Reading mail from @acronym{IMAP}. * Getting Mail:: Reading your personal mail with Gnus. * Browsing the Web:: Getting messages from a plethora of Web sources. -* IMAP:: Using Gnus as a @acronym{IMAP} client. * Other Sources:: Reading directories, files. * Combined Groups:: Combining groups into one group. * Email Based Diary:: Using mails to manage diary events in Gnus. @@ -698,15 +698,6 @@ * RSS:: Reading RDF site summary. * Customizing W3:: Doing stuff to Emacs/W3 from Gnus. -@acronym{IMAP} - -* Splitting in IMAP:: Splitting mail with nnimap. -* Expiring in IMAP:: Expiring mail with nnimap. -* Editing IMAP ACLs:: Limiting/enabling other users access to a mailbox. -* Expunging mailboxes:: Equivalent of a ``compress mailbox'' button. -* A note on namespaces:: How to (not) use @acronym{IMAP} namespace in Gnus. -* Debugging IMAP:: What to do when things don't work. - Other Sources * Directory Groups:: You can read a directory as if it was a newsgroup. @@ -808,7 +799,6 @@ * Highlighting and Menus:: Making buffers look all nice and cozy. * Buttons:: Get tendinitis in ten easy steps! * Daemons:: Gnus can do things behind your back. -* NoCeM:: How to avoid spam and other fatty foods. * Undo:: Some actions can be undone. * Predicate Specifiers:: Specifying predicates. * Moderation:: What to do if you're a moderator. @@ -1637,14 +1627,11 @@ @vindex gnus-no-groups-message Message displayed by Gnus when no groups are available. -@item gnus-play-startup-jingle -@vindex gnus-play-startup-jingle -If non-@code{nil}, play the Gnus jingle at startup. - -@item gnus-startup-jingle -@vindex gnus-startup-jingle -Jingle to be played if the above variable is non-@code{nil}. The -default is @samp{Tuxedomoon.Jingle4.au}. +@item gnus-use-backend-marks +@vindex gnus-use-backend-marks +If non-@code{nil}, Gnus will store article marks both in the +@file{.newsrc.eld} file and in the backends. This will slow down +group operation some. @end table @@ -1996,8 +1983,7 @@ @vindex gnus-group-update-hook @findex gnus-group-highlight-line @code{gnus-group-update-hook} is called when a group line is changed. -It will not be called when @code{gnus-visual} is @code{nil}. This hook -calls @code{gnus-group-highlight-line} by default. +It will not be called when @code{gnus-visual} is @code{nil}. @node Group Maneuvering @@ -2611,18 +2597,6 @@ @findex gnus-group-make-help-group Make the Gnus help group (@code{gnus-group-make-help-group}). -@item G a -@kindex G a (Group) -@cindex (ding) archive -@cindex archive group -@findex gnus-group-make-archive-group -@vindex gnus-group-archive-directory -@vindex gnus-group-recent-archive-directory -Make a Gnus archive group (@code{gnus-group-make-archive-group}). By -default a group pointing to the most recent articles will be created -(@code{gnus-group-recent-archive-directory}), but given a prefix, a full -group will be created from @code{gnus-group-archive-directory}. - @item G D @kindex G D (Group) @findex gnus-group-enter-directory @@ -3624,8 +3598,12 @@ @item u @kindex u (Browse) @findex gnus-browse-unsubscribe-current-group +@vindex gnus-browse-subscribe-newsgroup-method Unsubscribe to the current group, or, as will be the case here, -subscribe to it (@code{gnus-browse-unsubscribe-current-group}). +subscribe to it (@code{gnus-browse-unsubscribe-current-group}). You +can affect the way the new group is entered into the Group buffer +using the variable @code{gnus-browse-subscribe-newsgroup-method}. See +@pxref{Subscription Methods} for available options. @item l @itemx q @@ -5217,19 +5195,6 @@ If fetching from the first site is unsuccessful, Gnus will attempt to go through @code{gnus-group-faq-directory} and try to open them one by one. -@item H c -@kindex H c (Group) -@findex gnus-group-fetch-charter -@vindex gnus-group-charter-alist -@cindex charter -Try to open the charter for the current group in a web browser -(@code{gnus-group-fetch-charter}). Query for a group if given a -prefix argument. - -Gnus will use @code{gnus-group-charter-alist} to find the location of -the charter. If no location is known, Gnus will fetch the control -messages for the group, which in some cases includes the charter. - @item H C @kindex H C (Group) @findex gnus-group-fetch-control @@ -9250,7 +9215,8 @@ * Article Buttons:: Click on URLs, Message-IDs, addresses and the like. * Article Button Levels:: Controlling appearance of buttons. * Article Date:: Grumble, UT! -* Article Display:: Display various stuff---X-Face, Picons, Smileys +* Article Display:: Display various stuff: + X-Face, Picons, Gravatars, Smileys. * Article Signature:: What is a signature? * Article Miscellanea:: Various other stuff. @end menu @@ -10105,18 +10071,6 @@ An alist of @code{(RATE . REGEXP)} pairs used by the function @code{gnus-button-mid-or-mail-heuristic}. -@c Stuff related to gnus-button-tex-level - -@item gnus-button-ctan-handler -@findex gnus-button-ctan-handler -The function to use for displaying CTAN links. It must take one -argument, the string naming the URL. - -@item gnus-ctan-url -@vindex gnus-ctan-url -Top directory of a CTAN (Comprehensive TeX Archive Network) archive used -by @code{gnus-button-ctan-handler}. - @c Misc stuff @item gnus-article-button-face @@ -10189,14 +10143,6 @@ @code{gnus-button-mid-or-mail-heuristic}, and @code{gnus-button-mid-or-mail-heuristic-alist}. -@item gnus-button-tex-level -@vindex gnus-button-tex-level -Controls the display of references to @TeX{} or LaTeX stuff, e.g. for CTAN -URLs. See the variables @code{gnus-ctan-url}, -@code{gnus-button-ctan-handler}, -@code{gnus-button-ctan-directory-regexp}, and -@code{gnus-button-handle-ctan-bogus-regexp}. - @end table @@ -10294,6 +10240,7 @@ @cindex picons @cindex x-face @cindex smileys +@cindex gravatars These commands add various frivolous display gimmicks to the article buffer in Emacs versions that support them. @@ -10310,6 +10257,9 @@ Picons, on the other hand, reside on your own system, and Gnus will try to match the headers to what you have (@pxref{Picons}). +Gravatars reside on-line and are fetched from +@uref{http://www.gravatar.com/} (@pxref{Gravatars}). + All these functions are toggles---if the elements already exist, they'll be removed. @@ -10348,6 +10298,17 @@ Piconify all news headers (i. e., @code{Newsgroups} and @code{Followup-To}) (@code{gnus-treat-newsgroups-picon}). +@item W D g +@kindex W D g (Summary) +@findex gnus-treat-from-gravatar +Gravatarify the @code{From} header (@code{gnus-treat-from-gravatar}). + +@item W D h +@kindex W D h (Summary) +@findex gnus-treat-mail-gravatar +Gravatarify all mail headers (i. e., @code{Cc}, @code{To}) +(@code{gnus-treat-from-gravatar}). + @item W D D @kindex W D D (Summary) @findex gnus-article-remove-images @@ -10833,6 +10794,16 @@ be run just before printing the buffer. An alternative way to print article is to use Muttprint (@pxref{Saving Articles}). +@item A C +@vindex gnus-fetch-partial-articles +@findex gnus-summary-show-complete-article +If @code{gnus-fetch-partial-articles} is non-@code{nil}, Gnus will +fetch partial articles, if the backend it fetches them from supports +it. Currently only @code{nnimap} does. If you're looking at a +partial article, and want to see the complete article instead, then +the @kbd{A C} command (@code{gnus-summary-show-complete-article}) will +do so. + @end table @@ -11556,18 +11527,6 @@ @table @kbd -@item H f -@kindex H f (Summary) -@findex gnus-summary-fetch-faq -@vindex gnus-group-faq-directory -Try to fetch the @acronym{FAQ} (list of frequently asked questions) -for the current group (@code{gnus-summary-fetch-faq}). Gnus will try -to get the @acronym{FAQ} from @code{gnus-group-faq-directory}, which -is usually a directory on a remote machine. This variable can also be -a list of directories. In that case, giving a prefix to this command -will allow you to choose between the various sites. @code{ange-ftp} -or @code{efs} will probably be used for fetching the file. - @item H d @kindex H d (Summary) @findex gnus-summary-describe-group @@ -11893,8 +11852,7 @@ posted it to several groups separately. Posting the same article to several groups (not cross-posting) is called @dfn{spamming}, and you are by law required to send nasty-grams to anyone who perpetrates such a -heinous crime. You may want to try NoCeM handling to filter out spam -(@pxref{NoCeM}). +heinous crime. Remember: Cross-posting is kinda ok, but posting the same article separately to several groups is not. Massive cross-posting (aka. @@ -12025,7 +11983,7 @@ install an OpenPGP implementation such as GnuPG. The Lisp interface to GnuPG included with Emacs is called EasyPG (@pxref{Top, ,EasyPG, epa, EasyPG Assistant user's manual}), but PGG (@pxref{Top, ,PGG, pgg, -PGG Manual}), Mailcrypt, and gpg.el are also supported. +PGG Manual}), and Mailcrypt are also supported. @item To handle @acronym{S/MIME} message, you need to install OpenSSL. OpenSSL 0.9.6 @@ -12064,7 +12022,7 @@ @vindex mml1991-use Symbol indicating elisp interface to OpenPGP implementation for @acronym{PGP} messages. The default is @code{epg}, but @code{pgg}, -@code{mailcrypt}, and @code{gpg} are also supported although +and @code{mailcrypt} are also supported although deprecated. By default, Gnus uses the first available interface in this order. @@ -12072,7 +12030,7 @@ @vindex mml2015-use Symbol indicating elisp interface to OpenPGP implementation for @acronym{PGP/MIME} messages. The default is @code{epg}, but -@code{pgg}, @code{mailcrypt}, and @code{gpg} are also supported +@code{pgg}, and @code{mailcrypt} are also supported although deprecated. By default, Gnus uses the first available interface in this order. @@ -12626,6 +12584,8 @@ @vindex gnus-treat-from-picon @vindex gnus-treat-mail-picon @vindex gnus-treat-newsgroups-picon +@vindex gnus-treat-from-gravatar +@vindex gnus-treat-mail-gravatar @vindex gnus-treat-display-smileys @vindex gnus-treat-body-boundary @vindex gnus-treat-display-x-face @@ -12644,7 +12604,6 @@ @vindex gnus-treat-highlight-headers @vindex gnus-treat-highlight-signature @vindex gnus-treat-play-sounds -@vindex gnus-treat-translate @vindex gnus-treat-x-pgp-sig @vindex gnus-treat-unfold-headers @vindex gnus-treat-fold-headers @@ -12692,6 +12651,11 @@ @xref{Picons}. +@item gnus-treat-from-gravatar (head) +@item gnus-treat-mail-gravatar (head) + +@xref{Gravatars}. + @item gnus-treat-display-smileys (t, integer) @item gnus-treat-body-boundary (head) @@ -12746,8 +12710,6 @@ @vindex gnus-treat-play-sounds @item gnus-treat-play-sounds -@vindex gnus-treat-translate -@item gnus-treat-translate @item gnus-treat-ansi-sequences (t) @vindex gnus-treat-x-pgp-sig @item gnus-treat-x-pgp-sig (head) @@ -13738,9 +13700,9 @@ @menu * Server Buffer:: Making and editing virtual servers. * Getting News:: Reading USENET news with Gnus. +* Using @acronym{IMAP}:: Reading mail from @acronym{IMAP}. * Getting Mail:: Reading your personal mail with Gnus. * Browsing the Web:: Getting messages from a plethora of Web sources. -* IMAP:: Using Gnus as a @acronym{IMAP} client. * Other Sources:: Reading directories, files. * Combined Groups:: Combining groups into one group. * Email Based Diary:: Using mails to manage diary events in Gnus. @@ -14153,6 +14115,14 @@ Remove all marks to whether Gnus was denied connection from any servers (@code{gnus-server-remove-denials}). +@item c +@kindex c (Server) +@findex gnus-server-copy-server +Copy a server and give it a new name +(@code{gnus-server-copy-server}). This can be useful if you have a +complex method definition, and want to use the same definition towards +a different (physical) server. + @item L @kindex L (Server) @findex gnus-server-offline-server @@ -14817,6 +14787,121 @@ @end table +@node Using @acronym{IMAP} +@section Using @acronym{IMAP} +@cindex imap + +The most popular mail backend is probably @code{nnimap}, which +provides access to @acronym{IMAP} servers. @acronym{IMAP} servers +store mail remotely, so the client doesn't store anything locally. +This means that it's a convenient choice when you're reading your mail +from different locations, or with different user agents. + +@menu +* Connecting to an @acronym{IMAP} Server:: Getting started with @acronym{IMAP}. +* Customizing the @acronym{IMAP} Connection:: Variables for @acronym{IMAP} connection. +* Client-Side @acronym{IMAP} Splitting:: Put mail in the correct mail box. +@end menu + + +@node Connecting to an @acronym{IMAP} Server +@subsection Connecting to an @acronym{IMAP} Server + +Connecting to an @acronym{IMAP} can be very easy. Type @kbd{B} in the +group buffer, or (if your primary interest is reading email), say +something like: + +@example +(setq gnus-select-method + '(nnimap "imap.gmail.com")) +@end example + +You'll be prompted for a user name and password. If you grow tired of +that, then add the following to your @file{~/.authinfo} file: + +@example +machine imap.gmail.com login <username> password <password> port imap +@end example + +That should basically be it for most users. + + +@node Customizing the @acronym{IMAP} Connection +@subsection Customizing the @acronym{IMAP} Connection + +Here's an example method that's more complex: + +@example +(nnimap "imap.gmail.com" + (nnimap-inbox "INBOX") + (nnimap-split-methods ,nnmail-split-methods) + (nnimap-expunge t) + (nnimap-stream 'ssl) + (nnir-search-engine imap) + (nnimap-expunge-inbox t)) +@end example + +@table @code +@item nnimap-address +The address of the server, like @samp{imap.gmail.com}. + +@item nnimap-server-port +If the server uses a non-standard port, that can be specified here. A +typical port would be @samp{imap} or @samp{imaps}. + +@item nnimap-stream +How @code{nnimap} should connect to the server. Possible values are: + +@table @code +@item ssl +This is the default, and this uses standard +@acronym{TLS}/@acronym{SSL} connection. + +@item network +Non-encrypted and unsafe straight socket connection. + +@item starttls +Encrypted @acronym{STARTTLS} over the normal @acronym{IMAP} port. + +@item shell +If you need to tunnel via other systems to connect to the server, you +can use this option, and customize @code{nnimap-shell-program} to be +what you need. + +@end table + +@item nnimap-authenticator +Some @acronym{IMAP} servers allow anonymous logins. In that case, +this should be set to @code{anonymous}. + +@item nnimap-streaming +Virtually all @code{IMAP} server support fast streaming of data. If +you have problems connecting to the server, try setting this to @code{nil}. + +@end table + + +@node Client-Side @acronym{IMAP} Splitting +@subsection Client-Side @acronym{IMAP} Splitting + +Many people prefer to do the sorting/splitting of mail into their mail +boxes on the @acronym{IMAP} server. That way they don't have to +download the mail they're not all that interested in. + +If you do want to do client-side mail splitting, then the following +variables are relevant: + +@table @code +@item nnimap-inbox +This is the @acronym{IMAP} mail box that will be scanned for new mail. + +@item nnimap-split-methods +Uses the same syntax as @code{nnmail-split-methods} (@pxref{Splitting +Mail}). + +@end table + + @node Getting Mail @section Getting Mail @cindex reading mail @@ -15375,10 +15460,7 @@ @acronym{IMAP} as intended, as a network mail reading protocol (ie with nnimap), for some reason or other, Gnus let you treat it similar to a @acronym{POP} server and fetches articles from a given -@acronym{IMAP} mailbox. @xref{IMAP}, for more information. - -Note that for the Kerberos, GSSAPI, @acronym{TLS}/@acronym{SSL} and STARTTLS support you -may need external programs and libraries, @xref{IMAP}. +@acronym{IMAP} mailbox. @xref{Using @acronym{IMAP}}, for more information. Keywords: @@ -15847,7 +15929,7 @@ above. Also note that with the nnimap backend, message bodies will not be downloaded by default. You need to set @code{nnimap-split-download-body} to @code{t} to do that -(@pxref{Splitting in IMAP}). +(@pxref{Client-Side @acronym{IMAP} Splitting}). @item (! @var{func} @var{split}) If the split is a list, and the first element is @code{!}, then @@ -16611,6 +16693,7 @@ @end menu + @node Unix Mail Box @subsubsection Unix Mail Box @cindex nnmbox @@ -17736,739 +17819,6 @@ follow the link. -@node IMAP -@section IMAP -@cindex nnimap -@cindex @acronym{IMAP} - -@acronym{IMAP} is a network protocol for reading mail (or news, or @dots{}), -think of it as a modernized @acronym{NNTP}. Connecting to a @acronym{IMAP} -server is much similar to connecting to a news server, you just -specify the network address of the server. - -@acronym{IMAP} has two properties. First, @acronym{IMAP} can do -everything that @acronym{POP} can, it can hence be viewed as a -@acronym{POP++}. Secondly, @acronym{IMAP} is a mail storage protocol, -similar to @acronym{NNTP} being a news storage protocol---however, -@acronym{IMAP} offers more features than @acronym{NNTP} because news -is more or less read-only whereas mail is read-write. - -If you want to use @acronym{IMAP} as a @acronym{POP++}, use an imap -entry in @code{mail-sources}. With this, Gnus will fetch mails from -the @acronym{IMAP} server and store them on the local disk. This is -not the usage described in this section---@xref{Mail Sources}. - -If you want to use @acronym{IMAP} as a mail storage protocol, use an nnimap -entry in @code{gnus-secondary-select-methods}. With this, Gnus will -manipulate mails stored on the @acronym{IMAP} server. This is the kind of -usage explained in this section. - -A server configuration in @file{~/.gnus.el} with a few @acronym{IMAP} -servers might look something like the following. (Note that for -@acronym{TLS}/@acronym{SSL}, you need external programs and libraries, -see below.) - -@lisp -(setq gnus-secondary-select-methods - '((nnimap "simpleserver") ; @r{no special configuration} - ; @r{perhaps a ssh port forwarded server:} - (nnimap "dolk" - (nnimap-address "localhost") - (nnimap-server-port 1430)) - ; @r{a UW server running on localhost} - (nnimap "barbar" - (nnimap-server-port 143) - (nnimap-address "localhost") - (nnimap-list-pattern ("INBOX" "mail/*"))) - ; @r{anonymous public cyrus server:} - (nnimap "cyrus.andrew.cmu.edu" - (nnimap-authenticator anonymous) - (nnimap-list-pattern "archive.*") - (nnimap-stream network)) - ; @r{a ssl server on a non-standard port:} - (nnimap "vic20" - (nnimap-address "vic20.somewhere.com") - (nnimap-server-port 9930) - (nnimap-stream ssl)))) -@end lisp - -After defining the new server, you can subscribe to groups on the -server using normal Gnus commands such as @kbd{U} in the Group Buffer -(@pxref{Subscription Commands}) or via the Server Buffer -(@pxref{Server Buffer}). - -The following variables can be used to create a virtual @code{nnimap} -server: - -@table @code - -@item nnimap-address -@vindex nnimap-address - -The address of the remote @acronym{IMAP} server. Defaults to the virtual -server name if not specified. - -@item nnimap-server-port -@vindex nnimap-server-port -Port on server to contact. Defaults to port 143, or 993 for @acronym{TLS}/@acronym{SSL}. - -Note that this should be an integer, example server specification: - -@lisp -(nnimap "mail.server.com" - (nnimap-server-port 4711)) -@end lisp - -@item nnimap-list-pattern -@vindex nnimap-list-pattern -String or list of strings of mailboxes to limit available groups to. -This is used when the server has very many mailboxes and you're only -interested in a few---some servers export your home directory via -@acronym{IMAP}, you'll probably want to limit the mailboxes to those in -@file{~/Mail/*} then. - -The string can also be a cons of REFERENCE and the string as above, what -REFERENCE is used for is server specific, but on the University of -Washington server it's a directory that will be concatenated with the -mailbox. - -Example server specification: - -@lisp -(nnimap "mail.server.com" - (nnimap-list-pattern ("INBOX" "Mail/*" "alt.sex.*" - ("~friend/Mail/" . "list/*")))) -@end lisp - -@item nnimap-stream -@vindex nnimap-stream -The type of stream used to connect to your server. By default, nnimap -will detect and automatically use all of the below, with the exception -of @acronym{TLS}/@acronym{SSL}. (@acronym{IMAP} over -@acronym{TLS}/@acronym{SSL} is being replaced by STARTTLS, which can -be automatically detected, but it's not widely deployed yet.) - -Example server specification: - -@lisp -(nnimap "mail.server.com" - (nnimap-stream ssl)) -@end lisp - -Please note that the value of @code{nnimap-stream} is a symbol! - -@itemize @bullet -@item -@dfn{gssapi:} Connect with GSSAPI (usually Kerberos 5). Requires the -@samp{gsasl} or @samp{imtest} program. -@item -@dfn{kerberos4:} Connect with Kerberos 4. Requires the @samp{imtest} program. -@item -@dfn{starttls:} Connect via the STARTTLS extension (similar to -@acronym{TLS}/@acronym{SSL}). Requires the external library @samp{starttls.el} and program -@samp{starttls}. -@item -@dfn{tls:} Connect through @acronym{TLS}. Requires GNUTLS (the program -@samp{gnutls-cli}). -@item -@dfn{ssl:} Connect through @acronym{SSL}. Requires OpenSSL (the program -@samp{openssl}) or SSLeay (@samp{s_client}). -@item -@dfn{shell:} Use a shell command to start @acronym{IMAP} connection. -@item -@dfn{network:} Plain, TCP/IP network connection. -@end itemize - -@vindex imap-kerberos4-program -The @samp{imtest} program is shipped with Cyrus IMAPD. If you're -using @samp{imtest} from Cyrus IMAPD < 2.0.14 (which includes version -1.5.x and 1.6.x) you need to frob @code{imap-process-connection-type} -to make @code{imap.el} use a pty instead of a pipe when communicating -with @samp{imtest}. You will then suffer from a line length -restrictions on @acronym{IMAP} commands, which might make Gnus seem to hang -indefinitely if you have many articles in a mailbox. The variable -@code{imap-kerberos4-program} contain parameters to pass to the imtest -program. - -For @acronym{TLS} connection, the @code{gnutls-cli} program from GNUTLS is -needed. It is available from -@uref{http://www.gnu.org/software/gnutls/}. - -@vindex imap-gssapi-program -This parameter specifies a list of command lines that invoke a GSSAPI -authenticated @acronym{IMAP} stream in a subshell. They are tried -sequentially until a connection is made, or the list has been -exhausted. By default, @samp{gsasl} from GNU SASL, available from -@uref{http://www.gnu.org/software/gsasl/}, and the @samp{imtest} -program from Cyrus IMAPD (see @code{imap-kerberos4-program}), are -tried. - -@vindex imap-ssl-program -For @acronym{SSL} connections, the OpenSSL program is available from -@uref{http://www.openssl.org/}. OpenSSL was formerly known as SSLeay, -and nnimap support it too---although the most recent versions of -SSLeay, 0.9.x, are known to have serious bugs making it -useless. Earlier versions, especially 0.8.x, of SSLeay are known to -work. The variable @code{imap-ssl-program} contain parameters to pass -to OpenSSL/SSLeay. - -@vindex imap-shell-program -@vindex imap-shell-host -For @acronym{IMAP} connections using the @code{shell} stream, the -variable @code{imap-shell-program} specify what program to call. Make -sure nothing is interfering with the output of the program, e.g., don't -forget to redirect the error output to the void. - -@item nnimap-authenticator -@vindex nnimap-authenticator - -The authenticator used to connect to the server. By default, nnimap -will use the most secure authenticator your server is capable of. - -Example server specification: - -@lisp -(nnimap "mail.server.com" - (nnimap-authenticator anonymous)) -@end lisp - -Please note that the value of @code{nnimap-authenticator} is a symbol! - -@itemize @bullet -@item -@dfn{gssapi:} GSSAPI (usually kerberos 5) authentication. Requires -external program @code{gsasl} or @code{imtest}. -@item -@dfn{kerberos4:} Kerberos 4 authentication. Requires external program -@code{imtest}. -@item -@dfn{digest-md5:} Encrypted username/password via DIGEST-MD5. Requires -external library @code{digest-md5.el}. -@item -@dfn{cram-md5:} Encrypted username/password via CRAM-MD5. -@item -@dfn{login:} Plain-text username/password via LOGIN. -@item -@dfn{anonymous:} Login as ``anonymous'', supplying your email address as password. -@end itemize - -@item nnimap-expunge-on-close -@cindex expunging -@vindex nnimap-expunge-on-close -Unlike Parmenides the @acronym{IMAP} designers have decided things that -don't exist actually do exist. More specifically, @acronym{IMAP} has -this concept of marking articles @code{Deleted} which doesn't actually -delete them, and this (marking them @code{Deleted}, that is) is what -nnimap does when you delete an article in Gnus (with @kbd{B DEL} or -similar). - -Since the articles aren't really removed when we mark them with the -@code{Deleted} flag we'll need a way to actually delete them. Feel like -running in circles yet? - -Traditionally, nnimap has removed all articles marked as @code{Deleted} -when closing a mailbox but this is now configurable by this server -variable. - -The possible options are: - -@table @code - -@item always -The default behavior, delete all articles marked as ``Deleted'' when -closing a mailbox. -@item never -Never actually delete articles. Currently there is no way of showing -the articles marked for deletion in nnimap, but other @acronym{IMAP} clients -may allow you to do this. If you ever want to run the EXPUNGE command -manually, @xref{Expunging mailboxes}. -@item ask -When closing mailboxes, nnimap will ask if you wish to expunge deleted -articles or not. - -@end table - -@item nnimap-importantize-dormant -@vindex nnimap-importantize-dormant - -If non-@code{nil} (the default), marks dormant articles as ticked (as -well), for other @acronym{IMAP} clients. Within Gnus, dormant articles will -naturally still (only) be marked as dormant. This is to make dormant -articles stand out, just like ticked articles, in other @acronym{IMAP} -clients. (In other words, Gnus has two ``Tick'' marks and @acronym{IMAP} -has only one.) - -Probably the only reason for frobbing this would be if you're trying -enable per-user persistent dormant flags, using something like: - -@lisp -(setcdr (assq 'dormant nnimap-mark-to-flag-alist) - (format "gnus-dormant-%s" (user-login-name))) -(setcdr (assq 'dormant nnimap-mark-to-predicate-alist) - (format "KEYWORD gnus-dormant-%s" (user-login-name))) -@end lisp - -In this case, you would not want the per-user dormant flag showing up -as ticked for other users. - -@item nnimap-expunge-search-string -@cindex expunging -@vindex nnimap-expunge-search-string -@cindex expiring @acronym{IMAP} mail - -This variable contain the @acronym{IMAP} search command sent to server when -searching for articles eligible for expiring. The default is -@code{"UID %s NOT SINCE %s"}, where the first @code{%s} is replaced by -UID set and the second @code{%s} is replaced by a date. - -Probably the only useful value to change this to is -@code{"UID %s NOT SENTSINCE %s"}, which makes nnimap use the Date: in -messages instead of the internal article date. See section 6.4.4 of -RFC 2060 for more information on valid strings. - -However, if @code{nnimap-search-uids-not-since-is-evil} -is true, this variable has no effect since the search logic -is reversed, as described below. - -@item nnimap-authinfo-file -@vindex nnimap-authinfo-file - -A file containing credentials used to log in on servers. The format is -(almost) the same as the @code{ftp} @file{~/.netrc} file. See the -variable @code{nntp-authinfo-file} for exact syntax; also see -@ref{NNTP}. An example of an .authinfo line for an IMAP server, is: - -@example -machine students.uio.no login larsi password geheimnis port imap -@end example - -Note that it should be @code{port imap}, or @code{port 143}, if you -use a @code{nnimap-stream} of @code{tls} or @code{ssl}, even if the -actual port number used is port 993 for secured IMAP. For -convenience, Gnus will accept @code{port imaps} as a synonym of -@code{port imap}. - -@item nnimap-need-unselect-to-notice-new-mail -@vindex nnimap-need-unselect-to-notice-new-mail - -Unselect mailboxes before looking for new mail in them. Some servers -seem to need this under some circumstances; it was reported that -Courier 1.7.1 did. - -@item nnimap-nov-is-evil -@vindex nnimap-nov-is-evil -@cindex Courier @acronym{IMAP} server -@cindex @acronym{NOV} - -Never generate or use a local @acronym{NOV} database. Defaults to the -value of @code{gnus-agent}. - -Using a @acronym{NOV} database usually makes header fetching much -faster, but it uses the @code{UID SEARCH UID} command, which is very -slow on some servers (notably some versions of Courier). Since the Gnus -Agent caches the information in the @acronym{NOV} database without using -the slow command, this variable defaults to true if the Agent is in use, -and false otherwise. - -@item nnimap-search-uids-not-since-is-evil -@vindex nnimap-search-uids-not-since-is-evil -@cindex Courier @acronym{IMAP} server -@cindex expiring @acronym{IMAP} mail - -Avoid the @code{UID SEARCH UID @var{message numbers} NOT SINCE -@var{date}} command, which is slow on some @acronym{IMAP} servers -(notably, some versions of Courier). Instead, use @code{UID SEARCH SINCE -@var{date}} and prune the list of expirable articles within Gnus. - -When Gnus expires your mail (@pxref{Expiring Mail}), it starts with a -list of expirable articles and asks the IMAP server questions like ``Of -these articles, which ones are older than a week?'' While this seems -like a perfectly reasonable question, some IMAP servers take a long time -to answer it, since they seemingly go looking into every old article to -see if it is one of the expirable ones. Curiously, the question ``Of -@emph{all} articles, which ones are newer than a week?'' seems to be -much faster to answer, so setting this variable causes Gnus to ask this -question and figure out the answer to the real question itself. - -This problem can really sneak up on you: when you first configure Gnus, -everything works fine, but once you accumulate a couple thousand -messages, you start cursing Gnus for being so slow. On the other hand, -if you get a lot of email within a week, setting this variable will -cause a lot of network traffic between Gnus and the IMAP server. - -@item nnimap-logout-timeout -@vindex nnimap-logout-timeout - -There is a case where a connection to a @acronym{IMAP} server is unable -to close, when connecting to the server via a certain kind of network, -e.g. @acronym{VPN}. In that case, it will be observed that a connection -between Emacs and the local network looks alive even if the server has -closed a connection for some reason (typically, a timeout). -Consequently, Emacs continues waiting for a response from the server for -the @code{LOGOUT} command that Emacs sent, or hangs in other words. If -you are in such a network, setting this variable to a number of seconds -will be helpful. If it is set, a hung connection will be closed -forcibly, after this number of seconds from the time Emacs sends the -@code{LOGOUT} command. It should not be too small value but too large -value will be inconvenient too. Perhaps the value 1.0 will be a good -candidate but it might be worth trying some other values. - -Example server specification: - -@lisp -(nnimap "mail.server.com" - (nnimap-logout-timeout 1.0)) -@end lisp - -@end table - -@menu -* Splitting in IMAP:: Splitting mail with nnimap. -* Expiring in IMAP:: Expiring mail with nnimap. -* Editing IMAP ACLs:: Limiting/enabling other users access to a mailbox. -* Expunging mailboxes:: Equivalent of a ``compress mailbox'' button. -* A note on namespaces:: How to (not) use @acronym{IMAP} namespace in Gnus. -* Debugging IMAP:: What to do when things don't work. -@end menu - - - -@node Splitting in IMAP -@subsection Splitting in IMAP -@cindex splitting imap mail - -Splitting is something Gnus users have loved and used for years, and now -the rest of the world is catching up. Yeah, dream on, not many -@acronym{IMAP} servers have server side splitting and those that have -splitting seem to use some non-standard protocol. This means that -@acronym{IMAP} support for Gnus has to do its own splitting. - -And it does. - -(Incidentally, people seem to have been dreaming on, and Sieve has -gaining a market share and is supported by several IMAP servers. -Fortunately, Gnus support it too, @xref{Sieve Commands}.) - -Here are the variables of interest: - -@table @code - -@item nnimap-split-crosspost -@cindex splitting, crosspost -@cindex crosspost -@vindex nnimap-split-crosspost - -If non-@code{nil}, do crossposting if several split methods match the -mail. If @code{nil}, the first match in @code{nnimap-split-rule} -found will be used. - -Nnmail equivalent: @code{nnmail-crosspost}. - -@item nnimap-split-inbox -@cindex splitting, inbox -@cindex inbox -@vindex nnimap-split-inbox - -A string or a list of strings that gives the name(s) of @acronym{IMAP} -mailboxes to split from. Defaults to @code{nil}, which means that -splitting is disabled! - -@lisp -(setq nnimap-split-inbox - '("INBOX" ("~/friend/Mail" . "lists/*") "lists.imap")) -@end lisp - -No nnmail equivalent. - -@item nnimap-split-rule -@cindex splitting, rules -@vindex nnimap-split-rule - -New mail found in @code{nnimap-split-inbox} will be split according to -this variable. - -This variable contains a list of lists, where the first element in the -sublist gives the name of the @acronym{IMAP} mailbox to move articles -matching the regexp in the second element in the sublist. Got that? -Neither did I, we need examples. - -@lisp -(setq nnimap-split-rule - '(("INBOX.nnimap" - "^Sender: owner-nnimap@@vic20.globalcom.se") - ("INBOX.junk" "^Subject:.*MAKE MONEY") - ("INBOX.private" ""))) -@end lisp - -This will put all articles from the nnimap mailing list into mailbox -INBOX.nnimap, all articles containing MAKE MONEY in the Subject: line -into INBOX.junk and everything else in INBOX.private. - -The first string may contain @samp{\\1} forms, like the ones used by -replace-match to insert sub-expressions from the matched text. For -instance: - -@lisp -("INBOX.lists.\\1" "^Sender: owner-\\([a-z-]+\\)@@") -@end lisp - -The first element can also be the symbol @code{junk} to indicate that -matching messages should simply be deleted. Use with care. - -The second element can also be a function. In that case, it will be -called with the first element of the rule as the argument, in a buffer -containing the headers of the article. It should return a -non-@code{nil} value if it thinks that the mail belongs in that group. - -Nnmail users might recollect that the last regexp had to be empty to -match all articles (like in the example above). This is not required in -nnimap. Articles not matching any of the regexps will not be moved out -of your inbox. (This might affect performance if you keep lots of -unread articles in your inbox, since the splitting code would go over -them every time you fetch new mail.) - -These rules are processed from the beginning of the alist toward the -end. The first rule to make a match will ``win'', unless you have -crossposting enabled. In that case, all matching rules will ``win''. - -This variable can also have a function as its value, the function will -be called with the headers narrowed and should return a group where it -thinks the article should be split to. See @code{nnimap-split-fancy}. - -The splitting code tries to create mailboxes if it needs to. - -To allow for different split rules on different virtual servers, and -even different split rules in different inboxes on the same server, -the syntax of this variable have been extended along the lines of: - -@lisp -(setq nnimap-split-rule - '(("my1server" (".*" (("ding" "ding@@gnus.org") - ("junk" "From:.*Simon")))) - ("my2server" ("INBOX" nnimap-split-fancy)) - ("my[34]server" (".*" (("private" "To:.*Simon") - ("junk" my-junk-func)))))) -@end lisp - -The virtual server name is in fact a regexp, so that the same rules -may apply to several servers. In the example, the servers -@code{my3server} and @code{my4server} both use the same rules. -Similarly, the inbox string is also a regexp. The actual splitting -rules are as before, either a function, or a list with group/regexp or -group/function elements. - -Nnmail equivalent: @code{nnmail-split-methods}. - -@item nnimap-split-predicate -@cindex splitting -@vindex nnimap-split-predicate - -Mail matching this predicate in @code{nnimap-split-inbox} will be -split, it is a string and the default is @samp{UNSEEN UNDELETED}. - -This might be useful if you use another @acronym{IMAP} client to read mail in -your inbox but would like Gnus to split all articles in the inbox -regardless of readedness. Then you might change this to -@samp{UNDELETED}. - -@item nnimap-split-fancy -@cindex splitting, fancy -@findex nnimap-split-fancy -@vindex nnimap-split-fancy - -It's possible to set @code{nnimap-split-rule} to -@code{nnmail-split-fancy} if you want to use fancy -splitting. @xref{Fancy Mail Splitting}. - -However, to be able to have different fancy split rules for nnmail and -nnimap back ends you can set @code{nnimap-split-rule} to -@code{nnimap-split-fancy} and define the nnimap specific fancy split -rule in @code{nnimap-split-fancy}. - -Example: - -@lisp -(setq nnimap-split-rule 'nnimap-split-fancy - nnimap-split-fancy ...) -@end lisp - -Nnmail equivalent: @code{nnmail-split-fancy}. - -@item nnimap-split-download-body -@findex nnimap-split-download-body -@vindex nnimap-split-download-body - -Set to non-@code{nil} to download entire articles during splitting. -This is generally not required, and will slow things down -considerably. You may need it if you want to use an advanced -splitting function that analyzes the body to split the article. - -@end table - -@node Expiring in IMAP -@subsection Expiring in IMAP -@cindex expiring @acronym{IMAP} mail - -Even though @code{nnimap} is not a proper @code{nnmail} derived back -end, it supports most features in regular expiring (@pxref{Expiring -Mail}). Unlike splitting in @acronym{IMAP} (@pxref{Splitting in -IMAP}) it does not clone the @code{nnmail} variables (i.e., creating -@var{nnimap-expiry-wait}) but reuse the @code{nnmail} variables. What -follows below are the variables used by the @code{nnimap} expiry -process. - -A note on how the expire mark is stored on the @acronym{IMAP} server is -appropriate here as well. The expire mark is translated into a -@code{imap} client specific mark, @code{gnus-expire}, and stored on the -message. This means that likely only Gnus will understand and treat -the @code{gnus-expire} mark properly, although other clients may allow -you to view client specific flags on the message. It also means that -your server must support permanent storage of client specific flags on -messages. Most do, fortunately. - -If expiring @acronym{IMAP} mail seems very slow, try setting the server -variable @code{nnimap-search-uids-not-since-is-evil}. - -@table @code - -@item nnmail-expiry-wait -@item nnmail-expiry-wait-function - -These variables are fully supported. The expire value can be a -number, the symbol @code{immediate} or @code{never}. - -@item nnmail-expiry-target - -This variable is supported, and internally implemented by calling the -@code{nnmail} functions that handle this. It contains an optimization -that if the destination is a @acronym{IMAP} group on the same server, the -article is copied instead of appended (that is, uploaded again). - -@end table - -@node Editing IMAP ACLs -@subsection Editing IMAP ACLs -@cindex editing imap acls -@cindex Access Control Lists -@cindex Editing @acronym{IMAP} ACLs -@kindex G l (Group) -@findex gnus-group-nnimap-edit-acl - -ACL stands for Access Control List. ACLs are used in @acronym{IMAP} for -limiting (or enabling) other users access to your mail boxes. Not all -@acronym{IMAP} servers support this, this function will give an error if it -doesn't. - -To edit an ACL for a mailbox, type @kbd{G l} -(@code{gnus-group-edit-nnimap-acl}) and you'll be presented with an ACL -editing window with detailed instructions. - -Some possible uses: - -@itemize @bullet -@item -Giving ``anyone'' the ``lrs'' rights (lookup, read, keep seen/unseen flags) -on your mailing list mailboxes enables other users on the same server to -follow the list without subscribing to it. -@item -At least with the Cyrus server, you are required to give the user -``anyone'' posting ("p") capabilities to have ``plussing'' work (that is, -mail sent to user+mailbox@@domain ending up in the @acronym{IMAP} mailbox -INBOX.mailbox). -@end itemize - -@node Expunging mailboxes -@subsection Expunging mailboxes -@cindex expunging - -@cindex expunge -@cindex manual expunging -@kindex G x (Group) -@findex gnus-group-expunge-group - -If you're using the @code{never} setting of @code{nnimap-expunge-on-close}, -you may want the option of expunging all deleted articles in a mailbox -manually. This is exactly what @kbd{G x} does. - -Currently there is no way of showing deleted articles, you can just -delete them. - -@node A note on namespaces -@subsection A note on namespaces -@cindex IMAP namespace -@cindex namespaces - -The @acronym{IMAP} protocol has a concept called namespaces, described -by the following text in the RFC2060: - -@display -5.1.2. Mailbox Namespace Naming Convention - - By convention, the first hierarchical element of any mailbox name - which begins with "#" identifies the "namespace" of the remainder of - the name. This makes it possible to disambiguate between different - types of mailbox stores, each of which have their own namespaces. - - For example, implementations which offer access to USENET - newsgroups MAY use the "#news" namespace to partition the USENET - newsgroup namespace from that of other mailboxes. Thus, the - comp.mail.misc newsgroup would have an mailbox name of - "#news.comp.mail.misc", and the name "comp.mail.misc" could refer - to a different object (e.g. a user's private mailbox). -@end display - -While there is nothing in this text that warrants concern for the -@acronym{IMAP} implementation in Gnus, some servers use namespace -prefixes in a way that does not work with how Gnus uses mailbox names. - -Specifically, University of Washington's @acronym{IMAP} server uses -mailbox names like @code{#driver.mbx/read-mail} which are valid only -in the @sc{create} and @sc{append} commands. After the mailbox is -created (or a messages is appended to a mailbox), it must be accessed -without the namespace prefix, i.e. @code{read-mail}. Since Gnus do -not make it possible for the user to guarantee that user entered -mailbox names will only be used with the CREATE and APPEND commands, -you should simply not use the namespace prefixed mailbox names in -Gnus. - -See the UoW IMAPD documentation for the @code{#driver.*/} prefix -for more information on how to use the prefixes. They are a power -tool and should be used only if you are sure what the effects are. - -@node Debugging IMAP -@subsection Debugging IMAP -@cindex IMAP debugging -@cindex protocol dump (IMAP) - -@acronym{IMAP} is a complex protocol, more so than @acronym{NNTP} or -@acronym{POP3}. Implementation bugs are not unlikely, and we do our -best to fix them right away. If you encounter odd behavior, chances -are that either the server or Gnus is buggy. - -If you are familiar with network protocols in general, you will -probably be able to extract some clues from the protocol dump of the -exchanges between Gnus and the server. Even if you are not familiar -with network protocols, when you include the protocol dump in -@acronym{IMAP}-related bug reports you are helping us with data -critical to solving the problem. Therefore, we strongly encourage you -to include the protocol dump when reporting IMAP bugs in Gnus. - - -@vindex imap-log -Because the protocol dump, when enabled, generates lots of data, it is -disabled by default. You can enable it by setting @code{imap-log} as -follows: - -@lisp -(setq imap-log t) -@end lisp - -This instructs the @code{imap.el} package to log any exchanges with -the server. The log is stored in the buffer @samp{*imap-log*}. Look -for error messages, which sometimes are tagged with the keyword -@code{BAD}---but when submitting a bug, make sure to include all the -data. - @node Other Sources @section Other Sources @@ -22381,7 +21731,6 @@ * Highlighting and Menus:: Making buffers look all nice and cozy. * Buttons:: Get tendinitis in ten easy steps! * Daemons:: Gnus can do things behind your back. -* NoCeM:: How to avoid spam and other fatty foods. * Undo:: Some actions can be undone. * Predicate Specifiers:: Specifying predicates. * Moderation:: What to do if you're a moderator. @@ -23400,13 +22749,12 @@ (gnus-demon-add-handler 'gnus-demon-close-connections 30 t) @end lisp -@findex gnus-demon-add-nocem @findex gnus-demon-add-scanmail @findex gnus-demon-add-rescan @findex gnus-demon-add-scan-timestamps @findex gnus-demon-add-disconnection Some ready-made functions to do this have been created: -@code{gnus-demon-add-nocem}, @code{gnus-demon-add-disconnection}, +@code{gnus-demon-add-disconnection}, @code{gnus-demon-add-nntp-close-connection}, @code{gnus-demon-add-scan-timestamps}, @code{gnus-demon-add-rescan}, and @code{gnus-demon-add-scanmail}. Just put those functions in your @@ -23425,152 +22773,6 @@ behave. -@node NoCeM -@section NoCeM -@cindex nocem -@cindex spam - -@dfn{Spamming} is posting the same article lots and lots of times. -Spamming is bad. Spamming is evil. - -Spamming is usually canceled within a day or so by various anti-spamming -agencies. These agencies usually also send out @dfn{NoCeM} messages. -NoCeM is pronounced ``no see-'em'', and means what the name -implies---these are messages that make the offending articles, like, go -away. - -What use are these NoCeM messages if the articles are canceled anyway? -Some sites do not honor cancel messages and some sites just honor cancels -from a select few people. Then you may wish to make use of the NoCeM -messages, which are distributed in the newsgroups -@samp{news.lists.filters}, @samp{alt.nocem.misc}, etc. - -Gnus can read and parse the messages in this group automatically, and -this will make spam disappear. - -There are some variables to customize, of course: - -@table @code -@item gnus-use-nocem -@vindex gnus-use-nocem -Set this variable to @code{t} to set the ball rolling. It is @code{nil} -by default. - -You can also set this variable to a positive number as a group level. -In that case, Gnus scans NoCeM messages when checking new news if this -value is not exceeding a group level that you specify as the prefix -argument to some commands, e.g. @code{gnus}, -@code{gnus-group-get-new-news}, etc. Otherwise, Gnus does not scan -NoCeM messages if you specify a group level that is smaller than this -value to those commands. For example, if you use 1 or 2 on the mail -groups and the levels on the news groups remain the default, 3 is the -best choice. - -@item gnus-nocem-groups -@vindex gnus-nocem-groups -Gnus will look for NoCeM messages in the groups in this list. The -default is -@lisp -("news.lists.filters" "alt.nocem.misc") -@end lisp - -@item gnus-nocem-issuers -@vindex gnus-nocem-issuers -There are many people issuing NoCeM messages. This list says what -people you want to listen to. The default is: - -@lisp -("Adri Verhoef" - "alba-nocem@@albasani.net" - "bleachbot@@httrack.com" - "news@@arcor-online.net" - "news@@uni-berlin.de" - "nocem@@arcor.de" - "pgpmoose@@killfile.org" - "xjsppl@@gmx.de") -@end lisp - -Known despammers that you can put in this list are listed at@* -@uref{http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html}. - -You do not have to heed NoCeM messages from all these people---just the -ones you want to listen to. You also don't have to accept all NoCeM -messages from the people you like. Each NoCeM message has a @dfn{type} -header that gives the message a (more or less, usually less) rigorous -definition. Common types are @samp{spam}, @samp{spew}, @samp{mmf}, -@samp{binary}, and @samp{troll}. To specify this, you have to use -@code{(@var{issuer} @var{conditions} @dots{})} elements in the list. -Each condition is either a string (which is a regexp that matches types -you want to use) or a list on the form @code{(not @var{string})}, where -@var{string} is a regexp that matches types you don't want to use. - -For instance, if you want all NoCeM messages from Chris Lewis except his -@samp{troll} messages, you'd say: - -@lisp -("clewis@@ferret.ocunix.on.ca" ".*" (not "troll")) -@end lisp - -On the other hand, if you just want nothing but his @samp{spam} and -@samp{spew} messages, you'd say: - -@lisp -("clewis@@ferret.ocunix.on.ca" (not ".*") "spew" "spam") -@end lisp - -The specs are applied left-to-right. - - -@item gnus-nocem-verifyer -@vindex gnus-nocem-verifyer -@findex gnus-nocem-epg-verify -@findex pgg-verify -This should be a function for verifying that the NoCeM issuer is who she -says she is. This variable defaults to @code{gnus-nocem-epg-verify} if -EasyPG is available, otherwise defaults to @code{pgg-verify}. The -function should return non-@code{nil} if the verification is successful, -otherwise (including the case the NoCeM message was not signed) should -return @code{nil}. If this is too slow and you don't care for -verification (which may be dangerous), you can set this variable to -@code{nil}. - -Formerly the default was @code{mc-verify}, which is a Mailcrypt -function. While you can still use it, you can change it into -@code{gnus-nocem-epg-verify} or @code{pgg-verify} running with GnuPG if -you are willing to add the @acronym{PGP} public keys to GnuPG's keyring. - -@item gnus-nocem-directory -@vindex gnus-nocem-directory -This is where Gnus will store its NoCeM cache files. The default is@* -@file{~/News/NoCeM/}. - -@item gnus-nocem-expiry-wait -@vindex gnus-nocem-expiry-wait -The number of days before removing old NoCeM entries from the cache. -The default is 15. If you make it shorter Gnus will be faster, but you -might then see old spam. - -@item gnus-nocem-check-from -@vindex gnus-nocem-check-from -Non-@code{nil} means check for valid issuers in message bodies. -Otherwise don't bother fetching articles unless their author matches a -valid issuer; that is much faster if you are selective about the -issuers. - -@item gnus-nocem-check-article-limit -@vindex gnus-nocem-check-article-limit -If non-@code{nil}, the maximum number of articles to check in any NoCeM -group. @code{nil} means no restriction. NoCeM groups can be huge and -very slow to process. - -@end table - -Using NoCeM could potentially be a memory hog. If you have many living -(i. e., subscribed or unsubscribed groups), your Emacs process will grow -big. If this is a problem, you should kill off all (or most) of your -unsubscribed groups (@pxref{Subscription Commands}). - - @node Undo @section Undo @cindex undo @@ -23704,6 +22906,7 @@ * Face:: Display a funkier, teensier colored image. * Smileys:: Show all those happy faces the way they were meant to be shown. * Picons:: How to display pictures of what you're reading. +* Gravatars:: Display the avatar of people you read. * XVarious:: Other XEmacsy Gnusey variables. @end menu @@ -24030,7 +23233,55 @@ Ordered list of suffixes on picon file names to try. Defaults to @code{("xpm" "gif" "xbm")} minus those not built-in your Emacs. -@end table +@item gnus-picon-inhibit-top-level-domains +@vindex gnus-picon-inhibit-top-level-domains +If non-@code{nil} (which is the default), don't display picons for +things like @samp{.net} and @samp{.de}, which aren't usually very +interesting. + +@end table + +@node Gravatars +@subsection Gravatars + +@iftex +@iflatex +\include{gravatars} +@end iflatex +@end iftex + +A gravatar is an image registered to an e-mail address. + +You can submit yours on-line at @uref{http://www.gravatar.com}. + +The following variables offer control over how things are displayed. + +@table @code + +@item gnus-gravatar-size +@vindex gnus-gravatar-size +The size in pixels of gravatars. Gravatars are always square, so one +number for the size is enough. + +@item gnus-gravatar-relief +@vindex gnus-gravatar-relief +If non-nil, adds a shadow rectangle around the image. The value, +relief, specifies the width of the shadow lines, in pixels. If relief +is negative, shadows are drawn so that the image appears as a pressed +button; otherwise, it appears as an unpressed button. + +@end table + +If you want to see them in the From field, set: +@lisp +(setq gnus-treat-from-gravatar 'head) +@end lisp + +If you want to see them in the Cc and To fields, set: + +@lisp +(setq gnus-treat-mail-gravatar 'head) +@end lisp @node XVarious @@ -24367,7 +23618,7 @@ Note that with the nnimap back end, message bodies will not be downloaded by default. You need to set @code{nnimap-split-download-body} to @code{t} to do that -(@pxref{Splitting in IMAP}). +(@pxref{Client-Side @acronym{IMAP} Splitting}). That is about it. As some spam is likely to get through anyway, you might want to have a nifty function to call when you happen to read @@ -24649,14 +23900,14 @@ @vindex nnimap-split-download-body Note for IMAP users: if you use the @code{spam-check-bogofilter}, @code{spam-check-ifile}, and @code{spam-check-stat} spam back ends, -you should also set the variable @code{nnimap-split-download-body} -to @code{t}. These spam back ends are most useful when they can -``scan'' the full message body. By default, the nnimap back end only -retrieves the message headers; @code{nnimap-split-download-body} tells -it to retrieve the message bodies as well. We don't set this by -default because it will slow @acronym{IMAP} down, and that is not an -appropriate decision to make on behalf of the user. @xref{Splitting -in IMAP}. +you should also set the variable @code{nnimap-split-download-body} to +@code{t}. These spam back ends are most useful when they can ``scan'' +the full message body. By default, the nnimap back end only retrieves +the message headers; @code{nnimap-split-download-body} tells it to +retrieve the message bodies as well. We don't set this by default +because it will slow @acronym{IMAP} down, and that is not an +appropriate decision to make on behalf of the user. @xref{Client-Side +@acronym{IMAP} Splitting}. You have to specify one or more spam back ends for @code{spam-split} to use, by setting the @code{spam-use-*} variables. @xref{Spam Back @@ -27573,13 +26824,6 @@ @end iftex @item -Gnus can make use of NoCeM files to weed out spam (@pxref{NoCeM}). - -@lisp -(setq gnus-use-nocem t) -@end lisp - -@item Groups can be made permanently visible (@pxref{Listing Groups}). @lisp @@ -28095,9 +27339,7 @@ @acronym{TLS} wrapper shipped with Gnus @acronym{TLS}/@acronym{SSL} is now supported in @acronym{IMAP} and -@acronym{NNTP} via @file{tls.el} and GNUTLS. The old -@acronym{TLS}/@acronym{SSL} support via (external third party) -@file{ssl.el} and OpenSSL still works. +@acronym{NNTP} via @file{tls.el} and GNUTLS. @item Improved anti-spam features.
--- a/doc/misc/message.texi Mon Sep 27 14:27:28 2010 +0900 +++ b/doc/misc/message.texi Mon Sep 27 14:42:43 2010 +0900 @@ -1090,11 +1090,11 @@ @subsection Using PGP/MIME @acronym{PGP/MIME} requires an external OpenPGP implementation, such -as @uref{http://www.gnupg.org/, GNU Privacy Guard}. Pre-OpenPGP -implementations such as PGP 2.x and PGP 5.x are also supported. One +as @uref{http://www.gnupg.org/, GNU Privacy Guard}. Pre-OpenPGP +implementations such as PGP 2.x and PGP 5.x are also supported. One Emacs interface to the PGP implementations, PGG (@pxref{Top, ,PGG, -pgg, PGG Manual}), is included, but Mailcrypt and Florian Weimer's -@code{gpg.el} are also supported. @xref{PGP Compatibility}. +pgg, PGG Manual}), is included, but Mailcrypt is also supported. +@xref{PGP Compatibility}. @cindex gpg-agent Message internally calls GnuPG (the @command{gpg} command) to perform
--- a/doc/misc/url.texi Mon Sep 27 14:27:28 2010 +0900 +++ b/doc/misc/url.texi Mon Sep 27 14:42:43 2010 +0900 @@ -731,14 +731,6 @@ @file{cache} of @code{url-configuration-directory}. @end defopt -@c Fixme: function v. option, but neither used. -@c @findex url-cache-expired -@c @defopt url-cache-expired -@c This is a function to decide whether or not a cache entry has expired. -@c It takes two times as it parameters and returns non-@code{nil} if the -@c second time is ``too old'' when compared with the first time. -@c @end defopt - @defopt url-cache-creation-function The cache relies on a scheme for mapping URLs to files in the cache. This variable names a function which sets the type of cache to use. @@ -768,6 +760,22 @@ @end smallexample @end defun +@defun url-cache-expired +This function returns non-nil if a cache entry has expired (or is absent). +The arguments are a URL and optional expiration delay in seconds +(default @var{url-cache-expire-time}). +@end defun + +@defopt url-cache-expire-time +This variable is the default number of seconds to use for the +expire-time argument of the function @code{url-cache-expired}. +@end defopt + +@defun url-fetch-from-cache +This function takes a URL as its argument and returns a buffer +containing the data cached for that URL. +@end defun + @c Fixme: never actually used currently? @c @defopt url-standalone-mode @c @cindex Relying on cache
--- a/doc/misc/woman.texi Mon Sep 27 14:27:28 2010 +0900 +++ b/doc/misc/woman.texi Mon Sep 27 14:42:43 2010 +0900 @@ -1121,8 +1121,8 @@ for which decompressors are available and handled by auto-compression mode. It should begin with @code{\\.} and end with @code{\\'} and @emph{must not} be optional. The default value is -@code{"\\.\\(g?z\\|bz2\\)\\'"}, which matches the @code{gzip} and -@code{bzip2} compression extensions. +@code{"\\.\\(g?z\\|bz2\\|xz\\)\\'"}, which matches the @code{gzip}, +@code{bzip2}, and @code{xz} compression extensions. @emph{Do not change this unless you are sure you know what you are doing!}
--- a/etc/ChangeLog Mon Sep 27 14:27:28 2010 +0900 +++ b/etc/ChangeLog Mon Sep 27 14:42:43 2010 +0900 @@ -1,3 +1,7 @@ +2010-09-21 Eric Ludlam <zappo@gnu.org> + + * srecode/java.srt: Make NAME be a prompt. + 2010-09-13 Michael Albinus <michael.albinus@gmx.de> * NEWS: Some Tramp methods are discontinued.
--- a/etc/NEWS Mon Sep 27 14:27:28 2010 +0900 +++ b/etc/NEWS Mon Sep 27 14:42:43 2010 +0900 @@ -561,10 +561,13 @@ ** XML and HTML parsing *** If Emacs is compiled with libxml2 support (which is the default), -two new Emacs Lisp-level functions are defined: `html-parse-string' -(which will parse "real world" HTML) and `xml-parse-string' (which -parses XML). Both return an Emacs Lisp parse tree. See the Emacs -Lisp Reference Manual for details. +two new Emacs Lisp-level functions are defined: +`xml-parse-html-string-internal' (which will parse "real world" HTML) +and `xml-parse-string-internal' (which parses XML). Both return an +Emacs Lisp parse tree. + +FIXME: These should be front-ended by xml.el. + ** Isearch
--- a/etc/NEWS.23 Mon Sep 27 14:27:28 2010 +0900 +++ b/etc/NEWS.23 Mon Sep 27 14:42:43 2010 +0900 @@ -40,6 +40,8 @@ * Lisp changes in Emacs 23.3 +** `e' and `pi' are now called `float-e' and `float-pi'. + The old names are obsolete. ** The use of unintern without an obarray arg is declared obsolete. ** New function byte-to-string, like char-to-string but for bytes.
--- a/etc/srecode/java.srt Mon Sep 27 14:27:28 2010 +0900 +++ b/etc/srecode/java.srt Mon Sep 27 14:42:43 2010 +0900 @@ -83,7 +83,7 @@ template include :blank "An include statement." ---- -import {{NAME}}; +import {{?NAME}}; ---- context misc
--- a/lib-src/ChangeLog Mon Sep 27 14:27:28 2010 +0900 +++ b/lib-src/ChangeLog Mon Sep 27 14:42:43 2010 +0900 @@ -1,3 +1,7 @@ +2010-09-25 Ulrich Mueller <ulm@gentoo.org> + + * etags.c (compressors, print_language_names): Support xz compression. + 2010-08-11 Jan Djärv <jan.h.d@swipnet.se> * fakemail.c: Include stdlib.h for getenv. Remove declaration of
--- a/lib-src/etags.c Mon Sep 27 14:27:28 2010 +0900 +++ b/lib-src/etags.c Mon Sep 27 14:42:43 2010 +0900 @@ -561,6 +561,7 @@ { "gz", "gzip -d -c"}, { "GZ", "gzip -d -c"}, { "bz2", "bzip2 -d -c" }, + { "xz", "xz -d -c" }, { NULL } }; @@ -874,7 +875,7 @@ Fortran is tried first; if no tags are found, C is tried next.\n\ When parsing any C file, a \"class\" or \"template\" keyword\n\ switches to C++."); - puts ("Compressed files are supported using gzip and bzip2.\n\ + puts ("Compressed files are supported using gzip, bzip2, and xz.\n\ \n\ For detailed help on a given language use, for example,\n\ etags --help --lang=ada.");
--- a/lisp/ChangeLog Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/ChangeLog Mon Sep 27 14:42:43 2010 +0900 @@ -1,3 +1,189 @@ +2010-09-26 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/pcase.el (pcase-let*, pcase-let): plet -> pcase-let. + +2010-09-26 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/gnutls.el (starttls-negotiate): Avoid the cl.el decf function. + + * net/netrc.el (netrc-store-data): New function. + +2010-09-26 Teodor Zlatanov <tzz@lifelogs.com> + + * net/gnutls.el: GnuTLS glue code to set up a connection. + +2010-09-25 Julien Danjou <julien@danjou.info> + + * notifications.el: Call dbus-register-signal only if it is bound. + +2010-09-25 Glenn Morris <rgm@gnu.org> + + * eshell/em-alias.el, eshell/em-banner.el, eshell/em-basic.el: + * eshell/em-cmpl.el, eshell/em-dirs.el, eshell/em-glob.el: + * eshell/em-hist.el, eshell/em-ls.el, eshell/em-pred.el: + * eshell/em-prompt.el, eshell/em-rebind.el, eshell/em-script.el: + * eshell/em-smart.el, eshell/em-term.el, eshell/em-unix.el: + * eshell/esh-cmd.el, eshell/esh-ext.el, eshell/esh-io.el: + * eshell/esh-mode.el, eshell/esh-proc.el, eshell/esh-test.el: + * eshell/esh-util.el, eshell/esh-var.el: + Remove leading `*' from docs of faces and defcustoms. + +2010-09-25 Ulrich Mueller <ulm@gentoo.org> + + * eshell/em-ls.el (eshell-ls-archive-regexp): + * eshell/esh-util.el (eshell-tar-regexp): + * ibuffer.el (ibuffer-compressed-file-name-regexp): + * info.el (Info-suffix-list): + * international/mule.el (auto-coding-alist): + * woman.el (woman-file-regexp, woman-file-compression-regexp): + * progmodes/etags.el (tags-compression-info-list): + Support xz compression. + +2010-09-25 Chong Yidong <cyd@stupidchicken.com> + + * files.el (get-free-disk-space): Don't assume the "df" output + columns line up (Bug#6995). + +2010-09-25 Juanma Barranquero <lekktu@gmail.com> + + * finder.el (finder-unknown-keywords): + * progmodes/gdb-mi.el (gdb-jsonify-buffer, gdb-running-threads-count): + * progmodes/etags.el (tags-table-including): Fix typos in docstrings. + +2010-09-25 Juanma Barranquero <lekktu@gmail.com> + + * server.el (server-start): Revert part of 2010-08-08 change. Using + address 127.0.0.1 for local host is now done in Fmake_network_process. + +2010-09-24 Glenn Morris <rgm@gnu.org> + + * image-mode.el, progmodes/compile.el, progmodes/gud.el: + * progmodes/mixal-mode.el, textmodes/bibtex-style.el: + * textmodes/css-mode.el, textmodes/dns-mode.el: + Move autoloaded auto-mode-alist entries to files.el. + * files.el (auto-mode-alist): Move entries here. + +2010-09-23 Glenn Morris <rgm@gnu.org> + + * isearch.el (isearch-lazy-highlight-cleanup) + (isearch-lazy-highlight-initial-delay) + (isearch-lazy-highlight-interval) + (isearch-lazy-highlight-max-at-a-time, isearch-lazy-highlight-face): + * net/net-utils.el (ipconfig-program-options): + Move aliases to options before the associated definitions. + +2010-09-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * newcomment.el (comment-normalize-vars): Better test validity of + comment-end-skip. + +2010-09-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/float-sup.el (float-pi): New name for `pi'. + (float-e): New name for `e'. + (degrees-to-radians, radians-to-degrees): + * calendar/solar.el (solar-longitude): + * calculator.el (calculator-registers, calculator-funcall): + * textmodes/artist.el (artist-spray-random-points): + * play/bubbles.el (bubbles--initialize-images): Use new names. + +2010-09-23 Eric M. Ludlam <zappo@gnu.org> + + Update to CEDET 1.0's version of EIEIO. + + * emacs-lisp/eieio.el (eieio-specialized-key-to-generic-key): + New function. + (eieio-defmethod, eieio-generic-form, eieio-generic-call): Use it. + (eieio-default-eval-maybe): Eval val instead of unquoting only. + (class-precedence-list): If class is nil, return nil. + (eieio-generic-call): If class of first input arg is nil, don't + look up static methods, and do check for primary methods. + (initialize-instance): See if the default needs to be evaluated + during the constructor. + (eieio-perform-slot-validation-for-default): Don't do the check + for values that will eventually be evaluated. + (eieio-eval-default-p): New function. + (eieio-default-eval-maybe): Use it. + +2010-09-23 Jan Moringen <jan.moringen@uni-bielefeld.de> + + * emacs-lisp/eieio.el (eieio-defclass): Allow :c3 + method-invocation-order. + (eieio-c3-candidate, eieio-c3-merge-lists): New functions. + (eieio-class-precedence-dfs): Compute class precedence list using + dfs algorithm. + (eieio-class-precedence-bfs): Compute class precedence list using + bfs algorithm. + (eieio-class-precedence-c3): Compute class precedence list using + c3 algorithm. + (class-precedence-list): New function. + (eieiomt-method-list, eieiomt-sym-optimize): Use it. + (inconsistent-class-hierarchy): New error symbol. + (call-next-method): Stow the replacement argument list for future + call-next-method invocations. + +2010-09-23 Glenn Morris <rgm@gnu.org> + + * calendar/appt.el (appt-check): If not displaying the diary, + use (diary 1) to only get the entries we need. + (appt-make-list): Sort diary-list-entries, if we cannot guarantee + that it is in day order. (Bug#7019) + + * calendar/appt.el (appt-check): Rather than showing the diary, + just turn off invisible display, and only if needed. + + * calendar/diary-lib.el (diary-list-entries): Doc fix. (Bug#7019) + +2010-09-23 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/bytecomp.el (byte-compile-file-form-defvar): + (byte-compile-defvar, byte-compile-cl-warn): + Start warnings with lower-case, like the majority. + + * files.el (auto-mode-alist): Add .xa, .xw, .xsw for ld-script-mode. + + * files.el (auto-mode-alist): Prefer C-mode for .xs. (Bug#7071) + + * progmodes/ld-script.el (auto-mode-alist): Move to files.el. + * files.el (auto-mode-alist): Move ld-script entries here, further down + the list. + + * vc/add-log.el: Don't require timezone when compiling. + (timezone-make-date-sortable): Autoload it. + (change-log-sortable-date-at): Don't require timezone. + Use `ignore-errors'. + + * comint.el (comint-use-prompt-regexp-instead-of-fields): + Move alias before definition, so it does not need autoloading. + + * emulation/crisp.el, emulation/cua-base.el, emulation/edt.el: + * emulation/pc-select.el, emulation/vip.el, international/iso-ascii.el: + * international/kkc.el, international/ogonek.el, mail/feedmail.el: + * net/browse-url.el, net/eudc-vars.el, net/net-utils.el: + * net/rcompile.el, net/rlogin.el, textmodes/enriched.el: + * textmodes/makeinfo.el, textmodes/page-ext.el, textmodes/picture.el: + * textmodes/refer.el, textmodes/spell.el, textmodes/table.el: + * textmodes/tex-mode.el, textmodes/two-column.el: + Remove leading `*' from docs of defcustoms etc. + +2010-09-23 Teodor Zlatanov <tzz@lifelogs.com> + + * net/netrc.el (netrc-parse): Remove encrypt.el mentions. + +2010-09-22 Dan Christensen <jdc@uwo.ca> + + * calendar/time-date.el (date-to-time): Try using parse-time-string + first before using the slower timezone-make-date-arpa-standard. + +2010-09-22 Katsumi Yamaoka <yamaoka@jpl.org> + + * calendar/time-date.el (format-seconds): Comment fix. + +2010-09-22 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/package.el (package-menu-mode): `revert-buffer-function' + is not automatically buffer-local. + 2010-09-21 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/smie.el (smie-debug--describe-cycle): Fix typo. @@ -426,7 +612,7 @@ (tramp-find-inline-encoding, tramp-call-local-coding-command) (tramp-inline-compress-commands, tramp-find-inline-compress) (tramp-compute-multi-hops, tramp-maybe-open-connection) - (tramp-send-command , tramp-wait-for-output) + (tramp-send-command, tramp-wait-for-output) (tramp-send-command-and-check, tramp-barf-unless-okay) (tramp-send-command-and-read, tramp-mode-string-to-int) (tramp-convert-file-attributes, tramp-check-cached-permissions) @@ -2415,8 +2601,6 @@ * help-fns.el (find-lisp-object-file-name): Doc fix (bug#6494). - * cedet/semantic/db-file.el (object-write): Fix typo in docstring. - * time.el (display-time-day-and-date): Remove spurious * in docstring. (display-time-world-buffer-name, display-time-world-mode-map): Fix typos in docstrings. @@ -3604,12 +3788,6 @@ * international/mule.el (make-translation-table-from-vector): Doc fix. -2010-06-03 Eric Ludlam <zappo@gnu.org> - - * cedet/semantic/lex-spp.el - (semantic-lex-spp-table-write-slot-value): Instead of erroring on - invalid values during save, just save a nil (Bug#6324). - 2010-06-03 Glenn Morris <rgm@gnu.org> * desktop.el (desktop-clear-preserve-buffers): @@ -3718,11 +3896,6 @@ * vc-bzr.el (vc-bzr-revision-completion-table): Apply `file-directory-p' to the filename part rather than to the whole text. -2010-05-31 Jonathan Marchand <jonathlela@gmail.com> (tiny change) - - * cedet/ede/cpp-root.el (ede-set-project-variables): Fix feature name - (bug#6231). - 2010-05-31 Stefan Monnier <monnier@iro.umontreal.ca> * man.el (Man-completion-table): Let the user type "-k " (bug#6319). @@ -4873,67 +5046,6 @@ (filter-buffer-substring-functions): New variable. (filter-buffer-substring): Use it. Remove unused arg `noprops'. - Use a mode-line spec rather than a static string in Semantic. - * cedet/semantic/util-modes.el: - (semantic-minor-modes-format): New var to replace... - (semantic-minor-modes-status): Remove. - (semantic-mode-line-update): Construct a mode-line spec rather than - a static string so that mouse buttons can be used on individual minor - modes and so that semantic-mode-line-update only needs to be called - when global settings are changed. - (semantic-add-minor-mode, semantic-toggle-minor-mode-globally): - Call semantic-mode-line-update. - (semantic-toggle-minor-mode-globally): Don't assume mode is on - minor-mode-alist, check semantic-minor-mode-alist as well. - (semantic-stickyfunc-mode, semantic-show-parser-state-auto-marker) - (semantic-show-parser-state-marker, semantic-show-parser-state-mode) - (semantic-show-unmatched-syntax-mode, semantic-highlight-edits-mode): - * cedet/semantic/mru-bookmark.el (semantic-mru-bookmark-mode): - * cedet/semantic/idle.el (semantic-idle-scheduler-mode) - (define-semantic-idle-service, semantic-idle-summary-mode): - * cedet/semantic/decorate/mode.el (semantic-decoration-mode): - Don't call semantic-mode-line-update any more. - -2010-05-02 Stefan Monnier <monnier@iro.umontreal.ca> - - Use define-minor-mode in CEDET where applicable. - - * cedet/srecode/mode.el (srecode-minor-mode,global-srecode-minor-mode): - Use define-minor-mode. - - * cedet/semantic/util-modes.el (semantic-add-minor-mode): - Remove unused arg `keymap' and code redundant with define-minor-mode. - (semantic-toggle-minor-mode-globally): Only handle arg -1 and 1. - (semantic-stickyfunc-mode, global-semantic-show-unmatched-syntax-mode) - (semantic-highlight-func-mode, global-semantic-show-parser-state-mode) - (global-semantic-highlight-edits-mode, semantic-highlight-edits-mode) - (semantic-show-unmatched-syntax-mode, semantic-show-parser-state-mode) - (global-semantic-stickyfunc-mode, global-semantic-highlight-func-mode): - Use define-minor-mode. - (semantic-stickyfunc-mode-setup, semantic-highlight-edits-mode-setup) - (semantic-show-unmatched-syntax-mode-setup) - (semantic-show-parser-state-mode-setup) - (semantic-highlight-func-mode-setup): Inline into sole caller. - - * cedet/semantic/mru-bookmark.el (global-semantic-mru-bookmark-mode) - (semantic-mru-bookmark-mode): Use define-minor-mode. - (semantic-mru-bookmark-mode-setup): Inline into sole caller. - - * cedet/semantic/idle.el (define-semantic-idle-service): - Use define-minor-mode and inline setup function into its sole caller. - (semantic-idle-scheduler-mode-setup) - (semantic-idle-summary-mode-setup): Inline into sole caller. - (global-semantic-idle-scheduler-mode, semantic-idle-scheduler-mode): - Use define-minor-mode. - - * cedet/semantic/decorate/mode.el (global-semantic-decoration-mode) - (semantic-decoration-mode): Use define-minor-mode. - (semantic-decoration-mode-setup): Inline into sole caller. - - * cedet/ede/dired.el (ede-dired-minor-mode): Initialize in declaration. - (ede-dired-minor-mode): Use define-minor-mode and derived-mode-p. - (ede-dired-add-to-target): Use dolist. - 2010-05-01 Toru TSUNEYOSHI <t_tuneyosi@hotmail.com> Michael Albinus <michael.albinus@gmx.de> @@ -4976,11 +5088,6 @@ * minibuffer.el (tags-completion-at-point-function): New function. (completion-at-point-functions): Use it. - * cedet/semantic.el (semantic-completion-at-point-function): - New function. - (semantic-mode): Use semantic-completion-at-point-function for - completion-at-point-functions instead. - * progmodes/etags.el (complete-tag): Revert last change. 2010-04-29 Alan Mackenzie <acm@muc.de> @@ -5007,12 +5114,6 @@ * progmodes/etags.el (complete-tag): Move to minibuffer.el. - * cedet/semantic.el (semantic-mode): When enabled, add - semantic-ia-complete-symbol to completion-at-point-functions. - - * cedet/semantic/ia.el (semantic-ia-complete-symbol): Return nil - if Semantic is not active. - 2010-04-28 Michael Albinus <michael.albinus@gmx.de> * net/tramp.el (tramp-remote-selinux-p): New defun. @@ -5298,11 +5399,6 @@ (vc-bzr-shelve-apply-and-keep, vc-bzr-shelve-snapshot): Don't use *vc-bzr-shelve*. -2010-04-19 Chong Yidong <cyd@stupidchicken.com> - - * cedet/ede/pmake.el (ede-proj-makefile-insert-variables): - Don't destroy list before using it. - 2010-04-19 Dan Nicolaescu <dann@ics.uci.edu> Fix the version number for added files. @@ -5845,12 +5941,6 @@ * emacs-lisp/authors.el (authors-fixed-entries): Add entry for Eli Zaretskii. -2010-04-02 Juanma Barranquero <lekktu@gmail.com> - - * cedet/semantic/imenu.el (semantic-imenu-bucketize-type-members) - (semantic-create-imenu-directory-index): Fix typos in docstrings. - (semantic-imenu-goto-function): Reflow docstring. - 2010-04-02 Juri Linkov <juri@jurta.org> * ehelp.el (electric-help-orig-major-mode): @@ -6065,8 +6155,6 @@ * faces.el (set-face-attribute): Fix typo in docstring. (face-valid-attribute-values): Reflow docstring. - * cedet/srecode/table.el (srecode-template-table): Fix docstring typo. - 2010-03-24 Glenn Morris <rgm@gnu.org> * textmodes/flyspell.el (sgml-lexical-context): Autoload it (Bug#5752). @@ -6139,11 +6227,6 @@ (tramp-open-connection-setup-interactive-shell): Remove workaround for OpenSolaris bug, it is not needed anymore. -2010-03-24 Eric M. Ludlam <zappo@gnu.org> - - * cedet/semantic/imenu.el: New file, from the CEDET repository - (Bug#5412). - 2010-03-24 Glenn Morris <rgm@gnu.org> * emacs-lisp/cl-macs.el (defsubst*): Add autoload cookie. (Bug#4427) @@ -6170,11 +6253,6 @@ * log-edit.el (log-edit-before-checkin-process): Doc fix. - * cedet/semantic/bovine/c.el (semantic-c-describe-environment): - Consistently check ede-object is bound throughout. - - * cedet/ede/project-am.el (ede-shell-run-something): Declare. - 2010-03-23 Sam Steingold <sds@gnu.org> Fix bug#5620: recalculate all markers on compilation buffer @@ -6611,11 +6689,6 @@ (vc-git-show-log-entry): Use prog1. (vc-git-after-dir-status-stage): Remove unused var `remaining'. -2010-03-06 Glenn Morris <rgm@gnu.org> - - * cedet/semantic/grammar.el (semantic-grammar-header-template): - Update template copyright to GPLv3+. - 2010-03-05 Stefan Monnier <monnier@iro.umontreal.ca> * man.el (Man-files-regexp): Tighten up the regexp (bug#5686). @@ -6682,9 +6755,6 @@ * textmodes/reftex-toc.el (reftex-toc-promote-prepare): * emacs-lisp/elint.el (elint-add-required-env): - * cedet/semantic/db-find.el - (semanticdb-find-translate-path-brutish-default): - * cedet/ede/make.el (ede-make-check-version): * calendar/icalendar.el (icalendar--add-diary-entry): * calc/calcalg2.el (math-tracing-integral): * files.el (recover-session-finish): Use with-current-buffer @@ -6849,12 +6919,6 @@ * doc-view.el (doc-view): Add to data custom group. - * cedet/data-debug.el (data-debug): Move to extensions group. - - * cedet/ede.el (ede): - * cedet/srecode.el (srecode): - * cedet/semantic.el (semantic): Put in tools and extensions group. - * nxml/nxml-mode.el (nxml-faces): Remove from font-lock-faces group. * textmodes/flyspell.el (flyspell-word): Obey the offset specified @@ -6891,10 +6955,6 @@ * outline.el (outline-head-from-level): * simple.el (with-wrapper-hook): - * cedet/ede.el (ede-run-target, project-delete-target) - (project-dist-files, ede-name, ede-documentation, ede-parent-project) - (ede-adebug-project, ede-adebug-project-parent) - (ede-adebug-project-root): * emacs-lisp/elint.el (elint-extra-errors, elint-current-buffer) (elint-defun, elint-buffer-env, elint-top-form-logged) (elint-unbound-variable): @@ -7343,70 +7403,10 @@ 2010-01-18 Juanma Barranquero <lekktu@gmail.com> - * cedet/ede/locate.el (ede-locate-file-in-project) - (ede-locate-file-in-project-impl): Fix typos in docstrings. - (ede-enable-locate-on-project): Fix typos in error messages. - - * cedet/semantic/util-modes.el (semantic-unmatched-syntax-face) - (semantic-stickyfunc-old-hlf, semantic-stickyfunc-header-line-format) - (semantic-stickyfunc-sticky-classes, semantic-highlight-func-mode-setup) - (semantic-stickyfunc-fetch-stickyline): Fix typos in docstrings. - (semantic-stickyfunc-popup-menu, semantic-highlight-func-popup-menu): - Fix typos in menu help. - * emacs-lisp/chart.el (chart-file-count, chart-rmail-from): Fix typos in chart titles. * whitespace.el (whitespace-style, global-whitespace-newline-mode): - * cedet/semantic.el (semantic-require-version, semantic--buffer-cache) - (semantic-unmatched-syntax-cache-check, semantic-unmatched-syntax-hook) - (semantic--before-fetch-tags-hook, semantic-new-buffer-fcn-was-run) - (semantic--umatched-syntax-needs-refresh-p, semantic-elapsed-time) - (semantic-parse-stream, semantic-parse-region) - (semantic-parse-region-default, semantic--set-buffer-cache) - (semantic-minimum-working-buffer-size, semantic-refresh-tags-safe) - (semantic-bovinate-toplevel, semantic-load-system-cache-loaded) - (semantic-default-submodes): - * cedet/semantic/db-ebrowse.el (semanticdb-table-ebrowse) - (semanticdb-create-ebrowse-database) - (semanticdb-find-tags-for-completion-method) - (semanticdb-find-tags-by-class-method) - (semanticdb-deep-find-tags-by-name-method) - (semanticdb-deep-find-tags-for-completion-method): - * cedet/semantic/db-el.el (semanticdb-elisp-mapatom-collector) - (semanticdb-find-tags-by-name-method, emacs-lisp-mode) - (semanticdb-find-tags-for-completion-method) - (semanticdb-find-tags-by-class-method) - (semanticdb-deep-find-tags-for-completion-method): - * cedet/semantic/db-find.el (semanticdb-find-translate-path) - (semanticdb-find-need-cache-update-p, semanticdb-find-result-with-nil-p) - (semanticdb-find-scanned-include-tags, semanticdb-find-tags-collector) - (semanticdb-find-tags-by-name-method) - (semanticdb-find-tags-by-name-regexp-method) - (semanticdb-find-tags-for-completion-method) - (semanticdb-find-tags-by-class-method) - (semanticdb-find-tags-external-children-of-type-method) - (semanticdb-find-tags-subclasses-of-type-method) - (semanticdb-deep-find-tags-by-name-method) - (semanticdb-deep-find-tags-by-name-regexp-method) - (semanticdb-deep-find-tags-for-completion-method): - * cedet/semantic/db-global.el (semanticdb-enable-gnu-global-hook) - (semanticdb-enable-gnu-global-in-buffer) - (semanticdb-find-tags-for-completion-method) - (semanticdb-deep-find-tags-by-name-method) - (semanticdb-deep-find-tags-for-completion-method): - * cedet/semantic/db-javascript.el (semanticdb-javascript-tags) - (javascript-mode, semanticdb-find-translate-path) - (semanticdb-find-tags-for-completion-method) - (semanticdb-find-tags-by-class-method) - (semanticdb-deep-find-tags-by-name-method) - (semanticdb-deep-find-tags-for-completion-method) - (semanticdb-find-tags-external-children-of-type-method): - * cedet/semantic/idle.el (semantic-idle-work-core-handler) - (define-semantic-idle-service, semantic-idle-summary-useful-context-p) - (global-semantic-idle-scheduler-mode): - * cedet/srecode/dictionary.el (srecode-field-value) - (srecode-dictionary-add-section-dictionary): * emacs-lisp/eieio.el (eieio-error-unsupported-class-tags) (eieio-generic-form, eieio-help-mode-augmentation-maybee, eieio-browse) (describe-class, eieio-describe-generic, describe-generic): @@ -7458,13 +7458,8 @@ * calc/calc.el (calc-command-flags): Give it an initial value. -2010-01-17 Glenn Morris <rgm@gnu.org> - - * cedet/semantic/idle.el (semantic-idle-work-for-one-buffer): Doc fix. - 2010-01-17 Juanma Barranquero <lekktu@gmail.com> - * cedet/semantic.el (semantic-mode): * files.el (minibuffer-with-setup-hook): * textmodes/artist.el (artist-mt, artist-key-undraw-continously) (artist-key-draw-continously, artist-key-do-continously-continously) @@ -7496,17 +7491,6 @@ 2010-01-16 Mario Lang <mlang@delysid.org> - * cedet/ede/cpp-root.el (ede-cpp-root-project): - * cedet/ede/files.el (ede-expand-filename): - * cedet/ede/simple.el (ede-simple-project): - * cedet/semantic/complete.el (semantic-complete-read-tag-engine) - (semantic-complete-inline-tag-engine): - * cedet/semantic/db-el.el (semanticdb-equivalent-mode): - * cedet/semantic/db-global.el (semanticdb-equivalent-mode): - * cedet/semantic/db-javascript.el (semanticdb-equivalent-mode): - * cedet/semantic/db.el (semanticdb-equivalent-mode): - * cedet/semantic/decorate/include.el (semantic-decoration-unknown-include-describe): - * cedet/semantic/idle.el (semantic-idle-work-for-one-buffer): * emacs-lisp/chart.el (chart-translate-namezone): * textmodes/artist.el (artist-compute-popup-menu-table): Remove duplicated words in doc-strings. @@ -7535,13 +7519,6 @@ * find-cmd.el (find-constituents): * vc-arch.el (vc-arch-root): * window.el (window-body-height, pop-up-frames): - * cedet/semantic/edit.el (semantic-reparse-needed-change-hook) - (semantic-no-reparse-needed-change-hook): - * cedet/srecode/insert.el (srecode-resolve-argument-list) - (srecode-template-inserter-blank, srecode-template-inserter-variable) - (srecode-template-inserter-ask, srecode-template-inserter-width) - (srecode-template-inserter-section-start) - (srecode-template-inserter-section-end, srecode-insert-method): * emacs-lisp/eieio-base.el (eieio-singleton, slot-missing): * progmodes/ada-stmt.el (ada-if): * progmodes/gdb-ui.el (gdb-jsonify-buffer): @@ -7612,36 +7589,6 @@ * mail/emacsbug.el (report-emacs-bug-pretest-address): Set it to bug-gnu-emacs rather than emacs-pretest-bug. -2010-01-12 Juanma Barranquero <lekktu@gmail.com> - - * cedet/data-debug.el (data-debug): Fix customization group reference. - -2010-01-12 Juanma Barranquero <lekktu@gmail.com> - - * cedet/semantic/analyze.el (semantic-analyze-push-error) - (semantic-analyze-context, semantic-analyze-context-assignment) - (semantic-analyze-find-tag-sequence, semantic-analyze-find-tag): - * cedet/semantic/java.el (java-mode, semantic-tag-include-filename) - (semantic-java-doc-keywords-map): - * cedet/semantic/bovine/c.el (c-mode, semantic-c-member-of-autocast) - (semantic-lex-c-nested-namespace-ignore-second, semantic-parse-region) - (semantic-c-parse-lexical-token, semantic-c-debug-mode-init-pch) - (semantic-c-classname, semantic-format-tag-uml-prototype) - (semantic-c-dereference-namespace, semantic-analyze-type-constants): - * cedet/semantic/bovine/el.el (semantic-elisp-form-to-doc-string) - (semantic-emacs-lisp-obsoleted-doc, semantic-up-context) - (semantic-get-local-variables, semantic-end-of-command) - (semantic-beginning-of-command, semantic-ctxt-current-class-list) - (lisp-mode): - * cedet/semantic/bovine/make.el (makefile-mode): - * cedet/semantic/wisent/python.el (wisent-python-string-re) - (wisent-python-implicit-line-joining-p, wisent-python-forward-string) - (wisent-python-lex-beginning-of-line, wisent-python-lex-end-of-line) - (semantic-lex, semantic-get-local-variables, python-mode): - * cedet/semantic/wisent/python-wy.el (wisent-python-wy--keyword-table): - * cedet/srecode/extract.el (srecode-extract-state-set) - (srecode-extract-method): Fix typos in docstrings. - 2010-01-11 Sam Steingold <sds@gnu.org> * imenu.el (imenu-default-create-index-function): Detect infinite @@ -7700,17 +7647,9 @@ 2010-01-10 Chong Yidong <cyd@stupidchicken.com> - * cedet/semantic.el (semantic-new-buffer-setup-functions): - Add python parser. - * Makefile.in (ELCFILES): Add wisent/python-wy.el and wisent/python.el. -2010-01-10 Richard Kim <emacs18@gmail.com> - - * cedet/semantic/wisent/python-wy.el: - * cedet/semantic/wisent/python.el: New files. - 2010-01-09 Chong Yidong <cyd@stupidchicken.com> * man.el (Man-goto-section): Signal error if the section is not @@ -7894,9 +7833,6 @@ * mpc.el (mpc-playlist-delete): Fix typo in error messages. - * cedet/semantic/db-typecache.el (semanticdb-typecache-find-default): - Fix typo in docstring. - * net/imap-hash.el (imap-hash-make): Doc fix. (imap-hash-test): Fix typo in error message; reflow docstring. (imap-hash-p, imap-hash-get, imap-hash-put, imap-hash-make-message) @@ -8125,14 +8061,6 @@ `Info-display-images-node', and not put the `invisible' property in this case. -2009-12-14 Chong Yidong <cyd@stupidchicken.com> - - * cedet/semantic/mru-bookmark.el (global-semantic-mru-bookmark-mode) - (semantic-mru-bookmark-mode): Doc fixes. - - * cedet/semantic/db.el (semanticdb-cache-get): Use error instead - of assert. - 2009-12-13 Glenn Morris <rgm@gnu.org> * mail/emacsbug.el (message-sort-headers): Define for compiler. @@ -8550,9 +8478,6 @@ * bindings.el (complete-symbol): Call semantic-ia-complete-symbol if possible. - * cedet/semantic/ia.el (semantic-ia-complete-symbol): - Make argument optional. - * shell.el (shell): Require ansi-color (Bug#5113). * ansi-color.el (ansi-color-for-comint-mode): Default to t. @@ -8580,24 +8505,6 @@ (Info-mode-menu): Add `Info-virtual-index' to the menu. (Info-mode): Add `Info-virtual-index' to the docstring. -2009-12-05 Eric Ludlam <zappo@gnu.org> - - * cedet/semantic/bovine/c.el (semantic-c-describe-environment): - Describe project macro symbols. - - * cedet/semantic/complete.el (semantic-complete-do-completion): - Don't call semantic-collector-current-exact-match. - - * cedet/ede.el (ede-apply-preprocessor-map): Accept lists of - ede-objects as targets. - - * cedet/ede/pmake.el (ede-proj-makefile-insert-variables): Output - a target's object list even if compiler vars are already in the - Makefile. - - * cedet/ede/emacs.el (ede-preprocessor-map): Add config.h to the - list of headers producing necessary macros. - 2009-12-05 Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> * textmodes/bibtex.el (bibtex-map-entries): Use marker to keep @@ -9480,9 +9387,6 @@ * bookmark.el (bookmark-bmenu-hide-filenames): Remove assignment to deleted variable bookmark-bmenu-bookmark-column. - * cedet/semantic/idle.el (global-semantic-idle-scheduler-mode): - Move after definition of global-semantic-idle-tag-highlight-mode. - 2009-11-24 Stefan Monnier <monnier@iro.umontreal.ca> * bookmark.el (bookmark-bmenu-search): Clear echo area when exiting. @@ -9547,56 +9451,6 @@ * dired-x.el (dired-guess-shell-alist-default): Support xz format. (Bug#4953) -2009-11-22 Chong Yidong <cyd@stupidchicken.com> - - * cedet/srecode/map.el (srecode-get-maps): - * cedet/semantic/wisent/wisent.el (wisent-parse-toggle-verbose-flag): - * cedet/semantic/wisent/comp.el (wisent-toggle-verbose-flag): - * cedet/semantic/decorate/mode.el (semantic-decoration-mode) - (semantic-toggle-decoration-style): - * cedet/semantic/decorate/include.el - (semantic-decoration-include-describe) - (semantic-decoration-unknown-include-describe) - (semantic-decoration-unparsed-include-describe) - (semantic-decoration-all-include-summary): - * cedet/semantic/bovine/c.el (semantic-c-debug-mode-init): - * cedet/semantic/analyze/complete.el - (semantic-analyze-possible-completions): - * cedet/semantic/util-modes.el (semantic-highlight-edits-mode) - (semantic-show-unmatched-syntax-mode) - (semantic-show-parser-state-mode, semantic-stickyfunc-mode) - (semantic-highlight-func-mode): - * cedet/semantic/util.el (semantic-describe-buffer): - * cedet/semantic/symref.el (semantic-symref-find-references-by-name) - (semantic-symref-find-tags-by-name) - (semantic-symref-find-tags-by-regexp) - (semantic-symref-find-tags-by-completion) - (semantic-symref-find-file-references-by-name) - (semantic-symref-find-text): - * cedet/semantic/senator.el (senator-copy-tag, senator-kill-tag) - (senator-yank-tag): - * cedet/semantic/scope.el (semantic-calculate-scope): - * cedet/semantic/mru-bookmark.el (semantic-mru-bookmark-mode): - * cedet/semantic/idle.el (semantic-idle-scheduler-mode) - (define-semantic-idle-service): - * cedet/semantic/complete.el (semantic-complete-analyze-inline) - (semantic-complete-analyze-inline-idle): - * cedet/semantic/analyze.el (semantic-analyze-current-context): - * cedet/mode-local.el (describe-mode-local-bindings) - (describe-mode-local-bindings-in-mode): - * cedet/ede/make.el (ede-make-check-version): - * cedet/ede/locate.el (ede-enable-locate-on-project): - * cedet/cedet-idutils.el (cedet-idutils-expand-filename) - (cedet-idutils-version-check): - * cedet/cedet-global.el (cedet-gnu-global-expand-filename) - (cedet-gnu-global-version-check): - * cedet/cedet-cscope.el (cedet-cscope-expand-filename) - (cedet-cscope-version-check): Use called-interactively-p instead - of interactive-p. - - * cedet/semantic/ia.el (semantic-ia-completion-format-tag-function): - Use semantic-format-tag-prototype. - 2009-11-22 Michael Kifer <kifer@cs.stonybrook.edu> * emulation/viper-cmd.el: Use viper-last-command-char instead of @@ -9623,12 +9477,6 @@ * progmodes/subword.el (subword-mode-map): Fix subword-mode-map generation from word-movement command names. -2009-11-21 Chong Yidong <cyd@stupidchicken.com> - - * cedet/semantic/complete.el (semantic-complete-read-tag-engine) - (semantic-complete-jump-local, semantic-complete-jump): - Improve prompt string. - 2009-11-21 Jan Djärv <jan.h.d@swipnet.se> * cus-start.el (all): Add native condition for font-use-system-font. @@ -9715,13 +9563,6 @@ (bookmark-bmenu-search): New command. (bookmark-bmenu-mode-map): Bind it. -2009-11-20 Chong Yidong <cyd@stupidchicken.com> - - * cedet/semantic/complete.el (semantic-complete-inline-map): Doc fix. - - * cedet/semantic/idle.el (define-semantic-idle-service) - (semantic-idle-summary-mode, semantic-idle-completions): Doc fix. - 2009-11-20 Tassilo Horn <tassilo@member.fsf.org> * progmodes/cc-cmds.el: declare-functioned forward-subword and @@ -9768,17 +9609,6 @@ * Makefile.in (ELCFILES): Regenerate. -2009-11-20 Chong Yidong <cyd@stupidchicken.com> - - * cedet/cedet.el (cedet-menu-map): Re-order menu items. - - * cedet/semantic.el: Enable idle-mode menu items only if - global-semantic-idle-scheduler-mode is enabled. - (semantic-default-submodes): Doc fix. - - * cedet/semantic/idle.el (global-semantic-idle-scheduler-mode): - When turning off, disable other idle modes. - 2009-11-20 Jay Belanger <jay.p.belanger@gmail.com> * calc/calc.el (calc-set-mode-line): @@ -10085,13 +9915,6 @@ * strokes.el (strokes-update-window-configuration): Make strokes buffer current before erasing (Bug#4906). - * cedet/semantic/idle.el (semantic-idle-summary-mode) - (semantic-idle-summary-mode): Define using define-minor-mode - instead of define-semantic-idle-service. - (semantic-idle-summary-mode): New function. - (semantic-idle-summary-mode-setup): Use pre-command-hook to ensure - that mouse motion does not reset the echo area. - 2009-11-15 Juri Linkov <juri@jurta.org> * simple.el (set-mark-default-inactive): Add :type, :group @@ -10460,9 +10283,6 @@ 2009-11-08 Chong Yidong <cyd@stupidchicken.com> - * cedet/semantic/ctxt.el (semantic-get-local-variables): Disable - the progress reporter entirely. - * emulation/cua-base.el: Add CUA property to some CC mode commands (Bug#4100). @@ -10745,79 +10565,6 @@ * emacs-lisp/autoload.el (generated-autoload-feature): Remove. (autoload-rubric): Don't use any more. - * cedet/semantic/fw.el (semantic/loaddefs): - * cedet/srecode.el (srecode/loaddefs): - * cedet/ede.el (ede/loaddefs): Load rather than require. - * cedet/ede/cpp-root.el: - * cedet/ede/emacs.el: - * cedet/ede/files.el: - * cedet/ede/linux.el: - * cedet/ede/locate.el: - * cedet/ede/make.el: - * cedet/ede/shell.el: - * cedet/ede/speedbar.el: - * cedet/ede/system.el: - * cedet/ede/util.el: - * cedet/semantic/analyze.el: - * cedet/semantic/bovine.el: - * cedet/semantic/complete.el: - * cedet/semantic/ctxt.el: - * cedet/semantic/db-file.el: - * cedet/semantic/db-find.el: - * cedet/semantic/db-global.el: - * cedet/semantic/db-mode.el: - * cedet/semantic/db-typecache.el: - * cedet/semantic/db.el: - * cedet/semantic/debug.el: - * cedet/semantic/dep.el: - * cedet/semantic/doc.el: - * cedet/semantic/edit.el: - * cedet/semantic/find.el: - * cedet/semantic/format.el: - * cedet/semantic/html.el: - * cedet/semantic/ia-sb.el: - * cedet/semantic/ia.el: - * cedet/semantic/idle.el: - * cedet/semantic/lex-spp.el: - * cedet/semantic/lex.el: - * cedet/semantic/mru-bookmark.el: - * cedet/semantic/scope.el: - * cedet/semantic/senator.el: - * cedet/semantic/sort.el: - * cedet/semantic/symref.el: - * cedet/semantic/tag-file.el: - * cedet/semantic/tag-ls.el: - * cedet/semantic/tag-write.el: - * cedet/semantic/tag.el: - * cedet/semantic/util-modes.el: - * cedet/semantic/analyze/complete.el: - * cedet/semantic/analyze/refs.el: - * cedet/semantic/bovine/c.el: - * cedet/semantic/bovine/gcc.el: - * cedet/semantic/bovine/make.el: - * cedet/semantic/bovine/scm.el: - * cedet/semantic/decorate/include.el: - * cedet/semantic/decorate/mode.el: - * cedet/semantic/symref/cscope.el: - * cedet/semantic/symref/global.el: - * cedet/semantic/symref/grep.el: - * cedet/semantic/symref/idutils.el: - * cedet/semantic/symref/list.el: - * cedet/semantic/wisent/java-tags.el: - * cedet/semantic/wisent/javascript.el: - * cedet/srecode/compile.el: - * cedet/srecode/cpp.el: - * cedet/srecode/document.el: - * cedet/srecode/el.el: - * cedet/srecode/expandproto.el: - * cedet/srecode/getset.el: - * cedet/srecode/insert.el: - * cedet/srecode/java.el: - * cedet/srecode/map.el: - * cedet/srecode/mode.el: - * cedet/srecode/template.el: - * cedet/srecode/texi.el: Remove the file-local setting of - generated-autoload-feature. * emacs-lisp/byte-run.el (define-obsolete-variable-alias): Use dolist, and only put a prop if it is non-nil. @@ -10834,8 +10581,6 @@ 2009-11-03 Glenn Morris <rgm@gnu.org> - * cedet/mode-local.el (with-mode-local): Doc fix. - * emacs-lisp/bytecomp.el (byte-compile-file-form-defvar) (byte-compile-file-form-define-abbrev-table) (byte-compile-file-form-custom-declare-variable) @@ -10957,12 +10702,6 @@ * menu-bar.el (menu-bar-tools-menu): Add Semantic and EDE menu items. - * cedet/cedet.el (cedet-menu-map): Remove Semantic and EDE menu - items. - - * cedet/ede.el (ede-minor-mode): - * cedet/semantic.el (semantic-mode): Toggle menu separators. - 2009-10-31 Stefan Monnier <monnier@iro.umontreal.ca> * textmodes/two-column.el (2C-split): @@ -11116,89 +10855,12 @@ (byte-compile-variable-ref, byte-compile-setq-default): Respect `constants' member of byte-compile-warnings. - * cedet/semantic/tag.el (semantic--tag-link-list-to-buffer): - Use mapc rather than mapcar because the return value is never used. - - * cedet/srecode/template.el, cedet/semantic/wisent/javascript.el: - * cedet/semantic/wisent/java-tags.el, cedet/semantic/texi.el: - * cedet/semantic/html.el: - Suppress harmless warnings about setting up semantic-imenu (not - part of Emacs) variables. - 2009-10-30 Stefan Monnier <monnier@iro.umontreal.ca> * vc-bzr.el (vc-bzr-revision-keywords): New var. (vc-bzr-revision-completion-table): Use it to fix completion of "s:" to "submit:". - * cedet/srecode/srt-mode.el (semantic-analyze-possible-completions): - * cedet/semantic/symref/list.el (semantic-symref-rb-toggle-expand-tag): - * cedet/semantic/symref/grep.el (semantic-symref-perform-search): - * cedet/semantic/bovine/gcc.el (semantic-gcc-query): - * cedet/semantic/bovine/c.el (semantic-c-parse-lexical-token): - * cedet/semantic/analyze/debug.el (semantic-analyzer-debug-add-buttons) - (semantic-analyzer-debug-global-symbol) - (semantic-analyzer-debug-missing-innertype) - (semantic-analyzer-debug-insert-include-summary): - * cedet/semantic/util.el (semantic-file-tag-table): - (semantic-describe-buffer-var-helper, semantic-something-to-tag-table) - (semantic-recursive-find-nonterminal-by-name): - * cedet/semantic/tag-ls.el (semantic-tag-calculate-parent-default): - * cedet/semantic/tag-file.el (semantic-prototype-file): - * cedet/semantic/symref.el (semantic-symref-parse-tool-output): - * cedet/semantic/sb.el (semantic-sb-fetch-tag-table): - * cedet/semantic/lex-spp.el (semantic-lex-spp-lex-text-string): - * cedet/semantic/idle.el (semantic-idle-work-for-one-buffer): - (semantic-idle-summary-maybe-highlight): - * cedet/semantic/ia-sb.el (semantic-ia-speedbar) - (semantic-ia-sb-tag-info): - * cedet/semantic/grammar.el (semantic-analyze-possible-completions): - * cedet/semantic/find.el (semantic-brute-find-tag-by-position): - * cedet/semantic/ede-grammar.el (project-compile-target): - (ede-proj-makefile-insert-variables): - * cedet/semantic/debug.el (semantic-debug-set-parser-location): - (semantic-debug-set-source-location, semantic-debug-interface-layout) - (semantic-debug-mode, semantic-debug): - * cedet/semantic/db.el (semanticdb-needs-refresh-p): - * cedet/semantic/db-typecache.el (semanticdb-typecache-refresh-for-buffer): - * cedet/semantic/db-javascript.el (semanticdb-equivalent-mode): - * cedet/semantic/db-find.el (semanticdb-find-log-new-search) - (semanticdb-find-translate-path-includes--internal) - (semanticdb-reset-log, semanticdb-find-log-activity): - * cedet/semantic/db-file.el (object-write): - * cedet/semantic/db-el.el (semanticdb-equivalent-mode): - * cedet/semantic/db-ebrowse.el (semanticdb-ebrowse-C-file-p) - (semanticdb-create-ebrowse-database): - * cedet/semantic/db-debug.el (semanticdb-table-sanity-check): - * cedet/semantic/complete.el (semantic-displayor-focus-request) - (semantic-collector-calculate-completions-raw) - (semantic-complete-read-tag-analyzer): - * cedet/semantic/analyze.el (semantic-analyze-pulse): - * cedet/ede/util.el (ede-update-version-in-source): - * cedet/ede/proj.el (project-delete-target): - * cedet/ede/proj-elisp.el (ede-update-version-in-source) - (ede-proj-flush-autoconf): - * cedet/ede/pconf.el (ede-proj-configure-synchronize) - (ede-proj-configure-synchronize): - * cedet/ede/locate.el (ede-locate-file-in-project-impl): - * cedet/ede/linux.el (ede-linux-version): - * cedet/ede/emacs.el (ede-emacs-version): - * cedet/ede/dired.el (ede-dired-add-to-target): - * cedet/ede.el (ede-buffer-header-file, ede-find-target) - (ede-buffer-documentation-files, ede-project-buffers, ede-set) - (ede-target-buffers, ede-buffers, ede-make-project-local-variable): - * cedet/cedet-idutils.el (cedet-idutils-fnid-call): - (cedet-idutils-lid-call, cedet-idutils-expand-filename) - (cedet-idutils-version-check): - * cedet/cedet-global.el (cedet-gnu-global-call): - (cedet-gnu-global-expand-filename, cedet-gnu-global-root) - (cedet-gnu-global-version-check, cedet-gnu-global-scan-hits): - * cedet/cedet-cscope.el (cedet-cscope-call) - (cedet-cscope-expand-filename, cedet-cscope-version-check): - Use with-current-buffer. - * cedet/ede.el (ede-make-project-local-variable) - (ede-set-project-variables, ede-set): Use dolist. - 2009-10-30 Dan Nicolaescu <dann@ics.uci.edu> * textmodes/ispell.el (ispell-skip-region-alist): @@ -11242,16 +10904,6 @@ (calc-embedded-finish-command, calc-embedded-stack-change): * calc/calc-aent.el (calcAlg-enter): Use with-current-buffer. - * cedet/mode-local.el (make-obsolete-overload): Add `when' argument. - (overload-docstring-extension): Use that info. - * cedet/semantic/fw.el (semantic-alias-obsolete): Pass the `when' info. - * cedet/semantic/idle.el (semantic-eldoc-current-symbol-info): - * cedet/semantic/tag-ls.el (semantic-nonterminal-protection) - (semantic-nonterminal-abstract, semantic-nonterminal-leaf) - (semantic-nonterminal-full-name): Add the new `when' info. - * cedet/semantic/decorate/mode.el (semantic/decorate): Require CL for - `assert'. - * pcomplete.el (pcomplete-comint-setup): If there's a choice, replace shell-dynamic-complete-filename in preference to comint-dynamic-complete-filename. @@ -11392,36 +11044,6 @@ * bookmark.el (bookmark-bmenu-list): Don't use switch-to-buffer if we're inside a dedicated or minibuffer window. -2009-10-25 Stefan Monnier <monnier@iro.umontreal.ca> - - * cedet/semantic/fw.el (semantic-alias-obsolete) - (semantic-varalias-obsolete): Make the `when' arg mandatory. - (define-mode-overload-implementation): - * cedet/semantic/decorate/mode.el (semantic-decorate-pending-decoration-hooks): - * cedet/semantic/wisent.el (wisent-lex-make-token-table): - * cedet/semantic/util.el (semantic-file-token-stream) - (semantic-something-to-stream): - * cedet/semantic/tag.el (semantic-tag-make-assoc-list) - (semantic-expand-nonterminal): - * cedet/semantic/tag-file.el (semantic-find-nonterminal) - (semantic-find-dependency, semantic-find-nonterminal) - (semantic-find-dependency): - * cedet/semantic/lex.el (semantic-flex-start, semantic-flex-end) - (semantic-flex-text, semantic-flex-make-keyword-table) - (semantic-flex-keyword-p, semantic-flex-keyword-put) - (semantic-flex-keyword-get, semantic-flex-map-keywords) - (semantic-flex-keywords, semantic-flex-buffer, semantic-flex-list): - * cedet/semantic/java.el (semantic-java-prototype-nonterminal): - * cedet/semantic/idle.el (semantic-before-idle-scheduler-reparse-hooks) - (semantic-after-idle-scheduler-reparse-hooks): - * cedet/semantic/edit.el (semantic-edits-incremental-reparse-failed-hooks): - * cedet/semantic/db-mode.el (semanticdb-mode-hooks): - * cedet/semantic.el (semantic-toplevel-bovine-table) - (semantic-toplevel-bovine-cache) - (semantic-before-toplevel-bovination-hook, semantic-init-hooks) - (semantic-init-mode-hooks, semantic-init-db-hooks) - (semantic-bovination-working-type): Provide the `when' arg. - 2009-10-24 Karl Fogel <kfogel@red-bean.com> * bookmark.el: Update documentation, especially documentation @@ -11450,15 +11072,6 @@ * files.el (delete-directory): Delete symlinks to directories with delete-file (Bug#4739). -2009-10-24 Chong Yidong <cyd@stupidchicken.com> - - * cedet/semantic/util.el (semantic-recursive-find-nonterminal-by-name): - * cedet/semantic/tag.el (semantic-token-type-parent): Add WHEN - argument to make-obsolete. - - * cedet/semantic/fw.el (semantic-alias-obsolete) - (semantic-varalias-obsolete): Add optional WHEN argument. - 2009-10-24 Dan Nicolaescu <dann@ics.uci.edu> * vc.el (vc-backend-for-registration): Rename from @@ -11660,16 +11273,6 @@ * help-fns.el: Don't require help-mode (to avoid bootstrap issues). -2009-10-21 Eric Ludlam <zappo@gnu.org> - - * cedet/semantic/bovine/c.el (semantic-c-debug-mode-init) - (semantic-c-debug-mode-init-pch): New functions. - (semantic-c-debug-mode-init-last-mode): New var. - (semantic-c-parse-lexical-token): Use them. - - * cedet/semantic/lex-spp.el (semantic-lex-spp-anlyzer-do-replace): - When extracting the argument list, limit only by point-max. - 2009-10-21 Michael Albinus <michael.albinus@gmx.de> * net/tramp-smb.el (tramp-smb-get-stat-capability): New defun. @@ -11784,81 +11387,6 @@ (tar-header-block-tokenize): Decode the username and groupname. (tar-chown-entry, tar-chgrp-entry): Encode the names (bug#4730). -2009-10-17 Chong Yidong <cyd@stupidchicken.com> - - * cedet/srecode/srt.el: - * cedet/srecode/compile.el: - * cedet/semantic/mru-bookmark.el: - * cedet/semantic/debug.el: - * cedet/semantic/complete.el: - * cedet/semantic/analyze.el: Require CL when compiling. - -2009-10-17 Eric Ludlam <zappo@gnu.org> - - * cedet/semantic/scope.el - (semantic-analyze-scoped-inherited-tag-map): Wrap calculation of - tmpscope so that the regular scope will continue to work. - - * cedet/semantic/idle.el (semantic-idle-tag-highlight): - Use semantic-idle-summary-highlight-face as the highlighting. - - * emacs-lisp/eieio-base.el (eieio-persistent-save): If buffer - contains multibyte characters, choose first applicable coding - system automatically. - - * cedet/ede/project-am.el (project-run-target): New method. - (project-run-target): New method. - - * cedet/ede.el (ede-target): Add run target menu item. - (ede-project, ede-minor-keymap): Add ede-run-target binding. - (ede-run-target): New function. - (ede-target::project-run-target): New method. - - * cedet/ede/proj.el (project-run-target): New method. - - * cedet/ede/proj-shared.el (ede-gcc-libtool-shared-compiler) - (ede-g++-libtool-shared-compiler): Remove SHELL. Remove COMMANDS. - Add :rules. - (ede-proj-target-makefile-shared-object): Only libtool compilers - now available. Add linkers for libtool. - (ede-cc-linker-libtool, ede-g++-linker-libtool): New. - (ede-proj-makefile-target-name): Always use .la extension. - - * cedet/ede/proj-prog.el (project-run-target): New method. - - * cedet/ede/proj-obj.el (ede-cc-linker): Rename from ede-gcc-linker. - (ede-g++-linker): Change Change link lines. - - * cedet/ede/pmake.el (ede-pmake-insert-variable-shared): - When searching for old variables, go to the end of the buffer and - search backward from there. - (ede-proj-makefile-automake-insert-subdirs) - (ede-proj-makefile-automake-insert-extradist): New methods. - (ede-proj-makefile-create): Use them. - - * cedet/ede/pconf.el (ede-proj-configure-test-required-file): - Force FILE to expand to the current target. Use file-exists-p to - check that it exists. - - * cedet/ede/linux.el (ede-linux-version): Don't call "head". - (ede-linux-load): Wrap dir in file-name-as-directory. - Set :version slot. - - * cedet/ede/files.el (ede-get-locator-object): When enabling - locate, do so on "top". - - * cedet/ede/emacs.el (ede-emacs-file-existing): Wrap "dir" in - file-name-as-directory during compare. - (ede-emacs-version): Return Emacs/XEmacs differentiator. - Get version number from different places. Don't call egrep. - (ede-emacs-load): Set :version slot. Call file-name-as-directory - to set the directory. - - * cedet/ede/shell.el: New file. - - * cedet/inversion.el (inversion-decoders): Allow for stray . in - alpha/beta variants. - 2009-10-17 Stefan Monnier <monnier@iro.umontreal.ca> * international/mule-cmds.el (select-safe-coding-system): If the file @@ -11866,9 +11394,6 @@ 2009-10-17 Glenn Morris <rgm@gnu.org> - * cedet/semantic/grammar.el (semantic-grammar--lex-delim-spec): - All errors should have messages. - * foldout.el (foldout-mouse-swallow-events): * gs.el (gs-load-image): Replace obsolete forms of sit-for, sleep-for. @@ -12167,16 +11692,6 @@ * calendar/calendar.el (calendar-split-width-threshold): New option. (calendar-basic-setup): Use calendar-split-width-threshold. -2009-10-10 Sascha Wilde <wilde@sha-bang.de> - - * cedet/ede/proj-shared.el (ede-proj-makefile-target-name): - Use .la for Automake. - -2009-10-09 Chong Yidong <cyd@stupidchicken.com> - - * cedet/ede/pconf.el (ede-proj-configure-synchronize): - Use "autoreconf -i". Suggested by Andreas Schwab. - 2009-10-09 Juanma Barranquero <lekktu@gmail.com> * international/mule-cmds.el (ucs-names): Exclude new "Enclosed @@ -12205,13 +11720,6 @@ (bookmark-jump-other-window): Just invoke bookmark-jump with new argument now, so the two function's behaviors will match. (Bug#3645) -2009-10-08 Chong Yidong <cyd@stupidchicken.com> - - * cedet/ede/proj.el (project-make-dist, project-compile-project): - Fix filename test. - (ede-proj-dist-makefile): Use expand-file-name instead of concat - to expand file names. - 2009-10-08 Michael Albinus <michael.albinus@gmx.de> * net/tramp.el (tramp-file-name-real-user, tramp-file-name-domain) @@ -12223,15 +11731,6 @@ (tramp-smb-handle-expand-file-name): Implement "~" expansion. (tramp-smb-maybe-open-connection): Flush the cache only if necessary. -2009-10-08 Chong Yidong <cyd@stupidchicken.com> - - * cedet/ede/proj-obj.el (ede-gcc-linker): New var. - (ede-proj-target-makefile-objectcode): Use it. - - * cedet/ede/source.el (ede-want-any-source-files-p) - (ede-want-any-auxiliary-files-p, ede-want-any-files-p): - Return search result. This error was introduced while merging. - 2009-10-07 Juanma Barranquero <lekktu@gmail.com> * makefile.w32-in (WINS_UPDATES): Fix typo in previous change. @@ -12506,26 +12005,6 @@ (Info-bookmark-jump): Document with a doc string, not just a comment. (Bug#4203) -2009-10-04 Chong Yidong <cyd@stupidchicken.com> - - * cedet/semantic.el (semantic-new-buffer-setup-functions): New option. - (semantic-new-buffer-fcn): Call parser setup functions here. - (semantic-mode): Don't call parser setup functions here, it's done - in semantic-new-buffer-fcn now. - (semantic-mode): Parse all existing buffers when enabled. - - * cedet/srecode/compile.el (srecode-compile-file): - Call semantic-new-buffer-fcn if the buffer has not been parsed. - -2009-10-04 Chong Yidong <cyd@stupidchicken.com> - - * cedet/ede/pmake.el (ede-pmake-insert-variable-once): Delete. - - * cedet/ede/proj-comp.el: Don't require ede/pmake at toplevel. - (proj-comp-insert-variable-once): New macro, renamed from - ede-pmake-insert-variable-once in ede/pmake.edl. - (ede-proj-makefile-insert-variables): Use it. - 2009-10-04 Michael Albinus <michael.albinus@gmx.de> * files.el (copy-directory): New defun. @@ -12534,35 +12013,12 @@ 2009-10-04 Juanma Barranquero <lekktu@gmail.com> - * cedet/ede/makefile-edit.el (makefile-beginning-of-command) - (makefile-end-of-command): - * cedet/srecode/srt-mode.el (semantic-beginning-of-context) - (semantic-end-of-context): Fix previous change. Doc fixes. - -2009-10-04 Juanma Barranquero <lekktu@gmail.com> - * files-x.el (modify-dir-local-variable) - (copy-dir-locals-to-file-locals-prop-line): - * cedet/ede/makefile-edit.el (makefile-beginning-of-command) - (makefile-end-of-command): - * cedet/semantic/lex.el (semantic-lex-token): - * cedet/semantic/analyze/fcn.el - (semantic-analyze-dereference-metatype-1): - * cedet/semantic/bovine/c.el (semantic-lex-cpp-define) - (semantic-lex-cpp-undef): - * cedet/semantic/wisent/wisent.el (wisent-skip-block): - * cedet/srecode/srt-mode.el (semantic-beginning-of-context) - (semantic-end-of-context): Fix typos in docstrings. + (copy-dir-locals-to-file-locals-prop-line): Fix typos in + docstrings. * recentf.el (recentf-unload-function): New function. -2009-10-04 Chong Yidong <cyd@stupidchicken.com> - - * cedet/ede.el (ede-project-placeholder-cache-file): - * cedet/semantic/db-file.el (semanticdb-default-save-directory): - * cedet/srecode/map.el (srecode-map-save-file): - Use locate-user-emacs-file. Suggested by Juanma Barranquero. - 2009-10-04 Glenn Morris <rgm@gnu.org> * window.el (window-full-height-p): Add doc string. @@ -12571,51 +12027,6 @@ * window.el (window-full-height-p): New function. (Bug#4543) -2009-10-03 Chong Yidong <cyd@stupidchicken.com> - - * cedet/srecode/insert.el: Require srecode/args. - - * cedet/srecode/args.el: Require srecode/dictionary instead of - srecode/insert. - - * cedet/srecode/srt-mode.el (srecode-template-mode): Doc fix. - - * files.el (auto-mode-alist): Add .srt and Project.ede. - - * cedet/semantic.el (semantic-mode): - Handle srecode-template-mode-hook as well. - (semantic-mode): Use js-mode-hook for Javascript hook. - - * cedet/srecode/template.el: Remove hook variable. - - * cedet/ede/proj-comp.el: Require ede/pmake when compiling. - - * cedet/ede.el (ede-target-forms-menu): Don't enable if no - projects exist. - (ede-project-placeholder-cache-file): Default to a file in - user-emacs-directory. - - * cedet/srecode/map.el (srecode-map-base-template-dir): Look for - templates in data-directory. - (srecode-map-save-file): Default to a file in user-emacs-directory. - - * cedet/ede/srecode.el (ede-srecode-setup): Use default templates - directory. - -2009-09-30 Eric Ludlam <zappo@gnu.org> - - * cedet/semantic/util-modes.el (semantic-highlight-func-mode): - Doc fix. - - * cedet/ede/proj-comp.el (ede-proj-makefile-insert-variables): - Only insert each variable once. - - * cedet/ede/pmake.el (ede-pmake-insert-variable-once): New macro. - (ede-pmake-insert-variable-shared): Use it. - - * cedet/ede/cpp-root.el (ede-preprocessor-map): Do not deref table - for lexical table iff table is nil. - 2009-10-03 Dan Nicolaescu <dann@ics.uci.edu> * vc.el: Remove commented out code. @@ -12635,9 +12046,6 @@ the frame is wide. (calendar-generate-window): Test for shrinkability rather than width. - * cedet/semantic/db-find.el (data-debug-insert-tag-list): Comment out - declaration, currently false. - * mail/rmail.el (rmail-generate-viewer-buffer): Be more careful about reusing existing buffers, in case we happen to visit two files with the same basename. (Bug#4593) @@ -12907,142 +12315,10 @@ * emacs-lisp/eieio.el (defclass, eieio-defclass-autoload) (eieio-copy-parents-into-subclass, make-instance, class-children) (eieio-generic-form): - * cedet/cedet-files.el (cedet-directory-name-to-file-name): - * cedet/cedet-idutils.el (cedet-idutils-search) - (cedet-idutils-expand-filename, cedet-idutils-support-for-directory) - (cedet-idutils-version-check): - * cedet/cedet.el (cedet-version): - * cedet/data-debug.el (data-debug-insert-overlay-button) - (data-debug-insert-overlay-list-button) - (data-debug-insert-buffer-button) - (data-debug-insert-buffer-list-button) - (data-debug-insert-process-button, data-debug-insert-ring-button) - (data-debug-insert-widget, data-debug-insert-stuff-list-button) - (data-debug-insert-stuff-vector-button) - (data-debug-insert-symbol-button, data-debug-insert-string) - (data-debug-insert-number, data-debug-insert-lambda-expression) - (data-debug-insert-nil, data-debug-insert-simple-thing) - (data-debug-insert-custom, data-debug-edebug-expr): - * cedet/ede.el (ede-auto-add-method, ede-project-class-files) - (global-ede-mode-map, ede-new, ede-debug-target) - (ede-customize-current-target, ede-buffers, ede-map-buffers, ede-set): - * cedet/semantic.el (semantic-minimum-working-buffer-size) - (semantic-fetch-tags, semantic-submode-list) - (semantic-default-submodes): - * cedet/ede/source.el (ede-source-match): - * cedet/ede/project-am.el (project-am-type-alist, project-add-file) - (project-am-package-info): - * cedet/ede/proj.el (ede-proj-target, project-new-target): - * cedet/ede/proj-elisp.el (ede-proj-tweak-autoconf): - * cedet/ede/proj-comp.el (ede-current-build-list): - * cedet/ede/makefile-edit.el (makefile-move-to-macro): - * cedet/ede/files.el (ede-toplevel-project-or-nil): - * cedet/ede/cpp-root.el (initialize-instance): - * cedet/ede/autoconf-edit.el (autoconf-find-last-macro) - (autoconf-parameter-strip, autoconf-insert-new-macro): - * cedet/semantic/wisent.el (wisent-lex-eoi): - * cedet/semantic/util-modes.el (global-semantic-show-parser-state-mode) - (semantic-show-parser-state-mode): - * cedet/semantic/texi.el (semantic-texi-environment-regexp): - * cedet/semantic/tag.el (semantic-tag-new-variable) - (semantic-tag-class, semantic-tag-new-variable, semantic-tag-copy) - (semantic--tag-deep-copy-attributes, semantic--tag-deep-copy-value) - (semantic--tag-deep-copy-tag-list) - (semantic-tag-components-with-overlays-default): - * cedet/semantic/symref.el (semantic-symref-find-text): - * cedet/semantic/senator.el (senator-yank-tag) - (senator-transpose-tags-up): - * cedet/semantic/scope.el (semantic-analyze-scoped-tags-default) - (semantic-analyze-scoped-inherited-tags, semantic-scope-find): - * cedet/semantic/sb.el (semantic-sb-autoexpand-length): - * cedet/semantic/lex.el (semantic-lex-comment-regex) - (semantic-lex-maximum-depth, define-lex, semantic-lex-token) - (semantic-lex-unterminated-syntax-protection, define-lex-analyzer): - * cedet/semantic/lex-spp.el - (semantic-lex-spp-dynamic-macro-symbol-obarray-stack) - (semantic-lex-spp-symbol, semantic-lex-spp-one-token-to-txt): - * cedet/semantic/idle.el - (semantic-idle-summary-current-symbol-info-brutish) - (semantic-idle-summary-current-symbol-info-default): - * cedet/semantic/grammar.el (semantic-grammar-recreate-package) - (semantic--grammar-macro-compl-dict): - * cedet/semantic/grammar-wy.el (semantic-grammar-wy--parse-table): - * cedet/semantic/format.el (semantic-format-tag-custom-list) - (semantic-format-tag-canonical-name-default): - * cedet/semantic/find.el (semantic-find-tag-by-overlay-in-region) - (semantic-find-tags-for-completion) - (semantic-find-tags-by-scope-protection-default) - (semantic-deep-find-tags-for-completion): - * cedet/semantic/edit.el - (semantic-edits-incremental-reparse-failed-hook) - (semantic-edits-verbose-flag, semantic-edits-assert-valid-region) - (semantic-edits-splice-remove, semantic-edits-splice-replace): - * cedet/semantic/doc.el (semantic-documentation-comment-preceeding-tag): - * cedet/semantic/dep.el (semantic-dependency-include-path): - * cedet/semantic/db.el (semanticdb-default-find-index-class) - (semanticdb-match-any-mode, semanticdb-with-match-any-mode) - (semanticdb-project-roots): - * cedet/semantic/db-find.el (semanticdb-implied-include-tags) - (semanticdb-find-adebug-insert-scanned-tag-cons) - (semanticdb-find-log-buffer-name, semanticdb-find-result-mapc) - (semanticdb-brute-deep-find-tags-for-completion): - * cedet/semantic/db-ebrowse.el (semanticdb-ebrowse-add-tree-to-table): - * cedet/semantic/ctxt.el (semantic-beginning-of-context-default) - (semantic-end-of-context-default) - (semantic-ctxt-current-function-default) - (semantic-ctxt-scoped-types-default): - * cedet/semantic/complete.el (semantic-complete-read-tag-engine) - (semantic-complete-inline-tag-engine) - (semantic-complete-inline-custom-type) - (semantic-complete-read-tag-analyzer): - * cedet/semantic/chart.el (semantic-chart-tags-by-class) - (semantic-chart-database-size): - * cedet/semantic/analyze.el (semantic-analyze-current-symbol) - (semantic-analyze-current-context): - * cedet/semantic/symref/list.el (semantic-symref) - (semantic-symref-hide-buffer, semantic-symref-symbol): - * cedet/semantic/symref/grep.el (semantic-symref-grep-use-template): - * cedet/semantic/symref/filter.el (semantic-symref-hits-in-region): - * cedet/semantic/bovine/el.el (semantic-elisp-form-to-doc-string): - * cedet/semantic/bovine/c.el (semantic-lex-c-preprocessor-symbol-map) - (semantic-c-parse-token-hack-depth, semantic-c--template-name-1) - (semantic-c-dereference-template): - * cedet/semantic/analyze/refs.el (semantic--analyze-refs-full-lookup) - (semantic--analyze-refs-full-lookup-with-parents) - (semantic--analyze-refs-full-lookup-simple): - * cedet/semantic/analyze/complete.el - (semantic-analyze-possible-completions): - * cedet/srecode/table.el (srecode-mode-table-new): - * cedet/srecode/srt.el (srecode-read-variable-name): - * cedet/srecode/srt-mode.el (srecode-macro-help, srecode-in-macro-p): - * cedet/srecode/semantic.el (srecode-semantic-handle-:tag) - (srecode-semantic-handle-:tagtype, srecode-semantic-insert-tag): - * cedet/srecode/map.el (srecode-current-map): - * cedet/srecode/insert.el (srecode-insert) - (srecode-insert-variable-secondname-handler, srecode-insert-method) - (srecode-template-inserter-point-override) - (srecode-insert-include-lookup): - * cedet/srecode/getset.el (srecode-auto-choose-class): - * cedet/srecode/extract.el (srecode-inserter-extract): - * cedet/srecode/document.el - (srecode-document-autocomment-return-last-alist) - (srecode-document-autocomment-param-type-alist) - (srecode-document-insert-function-comment) - (srecode-document-insert-variable-one-line-comment) - (srecode-document-function-name-comment): - * cedet/srecode/dictionary.el (srecode-create-dictionary) - (srecode-compound-toString): - * cedet/srecode/compile.el (srecode-flush-active-templates): - * cedet/srecode/args.el (srecode-semantic-handle-:blank): - Doc/message fixes. * vc-cvs.el (vc-cvs-parse-entry): Be more careful with the match-data. (Bug#4555). - * cedet/semantic/bovine/gcc.el - (semantic-c-reset-preprocessor-symbol-map): Fix declaration. - (semantic-gcc-get-include-paths, semantic-gcc-setup-data): Doc fixes. - * emacs-lisp/check-declare.el (check-declare-scan): Read the declaration rather than parsing it as a regexp. This relaxes the layout requirements and makes errors easier to detect. @@ -13057,41 +12333,8 @@ * term/w32-win.el (setup-default-fontset, set-fontset-font): Remove unused declarations. -2009-10-01 Juanma Barranquero <lekktu@gmail.com> - - * cedet/semantic/wisent/javat-wy.el - (wisent-java-tags-wy--keyword-table): Use \000 instead of literal ^@. - -2009-09-30 Juanma Barranquero <lekktu@gmail.com> - - * cedet/srecode/expandproto.el: Fix provide statement. - -2009-09-30 Eric Ludlam <zappo@gnu.org> - - * emacs-lisp/eieio.el (boolean-p): Delete. - -2009-09-30 Sascha Wilde <wilde@sha-bang.de> - - * cedet/ede/srecode.el: Fix provide statement. - 2009-09-30 Glenn Morris <rgm@gnu.org> - * cedet/ede/proj.el (ede-proj-target-makefile-miscelaneous): - * cedet/ede/proj-aux.el (ede-aux-source): - * cedet/ede/proj-misc.el (ede-proj-target-makefile-miscelaneous) - (ede-misc-source): - * cedet/semantic/mru-bookmark.el (semantic-mrub-completing-read) - (semantic-mrub-switch-tags): Fix doc typos. - - * cedet/semantic/db-global.el (data-debug-new-buffer) - (data-debug-insert-thing): Remove unneeded declarations (one broken). - (semanticdb-enable-gnu-global-databases): Fix prompt typo. - - * cedet/semantic/analyze/fcn.el (semantic-scope-find): Fix declaration. - - * cedet/semantic/bovine/gcc.el (semantic-gcc-setup): Replace runtime - use of CL function `remove-if-not'. - * emacs-lisp/authors.el (authors-ignored-files): Add "js2-mode.el". * emacs-lisp/elint.el (elint-init-form): Report declarations where the @@ -13129,16 +12372,6 @@ 2009-09-29 Glenn Morris <rgm@gnu.org> - * cedet/semantic/symref/idutils.el: - * cedet/semantic/symref/list.el: Relicense under GPLv3+. - - * cedet/ede/srecode.el (srecode-resolve-arguments): Fix declaration. - - * cedet/semantic/complete.el (semantic-displayor-focus-abstract-child-p): - * cedet/semantic/tag-file.el (semanticdb-table-child-p): - * cedet/srecode/compile.el (srecode-template-inserter-newline-child-p): - Mark declarations not understood by check-declare. - * emacs-lisp/check-declare.el (check-declare-locate): Remove pointless file-name-nondirectory call preventing location of cedet files. (check-declare-verify): Use literal search rather than re-search. @@ -13176,15 +12409,6 @@ * Makefile.in (ELCFILES): Add CEDET files. -2009-09-28 Eric Ludlam <zappo@gnu.org> - - CEDET (development tools) package merged. - - * cedet/*.el: - * cedet/ede/*.el: - * cedet/semantic/*.el: - * cedet/srecode/*.el: New files. - 2009-09-28 Michael Albinus <michael.albinus@gmx.de> * Makefile.in (ELCFILES): Add net/tramp-imap.elc. @@ -13198,26 +12422,6 @@ * net/tramp-imap.el: New package. -2009-09-28 Eric Ludlam <zappo@gnu.org> - - * emacs-lisp/chart.el: - * emacs-lisp/eieio-base.el: - * emacs-lisp/eieio-comp.el: - * emacs-lisp/eieio-custom.el: - * emacs-lisp/eieio-datadebug.el: - * emacs-lisp/eieio-opt.el: - * emacs-lisp/eieio-speedbar.el: - * emacs-lisp/eieio.el: New files. - - * cedet/cedet-cscope.el: - * cedet/cedet-files.el: - * cedet/cedet-global.el: - * cedet/cedet-idutils.el: - * cedet/data-debug.el: - * cedet/inversion.el: - * cedet/mode-local.el: - * cedet/pulse.el: New files. - 2009-09-27 Vinicius Jose Latorre <viniciusjl@ig.com.br> * whitespace.el (whitespace-trailing-regexp)
--- a/lisp/ChangeLog.12 Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/ChangeLog.12 Mon Sep 27 14:42:43 2010 +0900 @@ -1140,7 +1140,7 @@ (rcirc-keepalive-seconds): Remove variable. (rcirc-server-name, rcirc-timeout-timer, rcirc-connecting) (rcirc-process, rcirc-user-disconnect): New variables. - (rcirc-connect): Initalize new variables. + (rcirc-connect): Initialize new variables. (rcirc-keepalive): Don't send keepalive pings before connection is completed. (rcirc-sentinel): Do mark all channels with activity when
--- a/lisp/ChangeLog.14 Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/ChangeLog.14 Mon Sep 27 14:42:43 2010 +0900 @@ -1,3 +1,7 @@ +2009-02-07 Dave Love <fx@gnu.org> + + * net/tls.el (open-tls-stream): Don't query killing process. + 2009-06-21 Chong Yidong <cyd@stupidchicken.com> * Branch for 23.1.
--- a/lisp/ChangeLog.9 Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/ChangeLog.9 Mon Sep 27 14:42:43 2010 +0900 @@ -8121,7 +8121,7 @@ * dired.el (dired-get-filename): Return filename verbatim if LOCALP is `verbatim'. * dired-aux.el (dired-add-entry): Call `dired-get-filename' with - `verbatim' so that we don't inadvertently delete a non-existant + `verbatim' so that we don't inadvertently delete a non-existent directory name. 2000-11-27 Kenichi Handa <handa@etl.go.jp>
--- a/lisp/calculator.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/calculator.el Mon Sep 27 14:42:43 2010 +0900 @@ -369,7 +369,8 @@ Used for repeating operations in calculator-repR/L.") (defvar calculator-registers ; use user-bindings first - (append calculator-user-registers (list (cons ?e e) (cons ?p pi))) + (append calculator-user-registers + (list (cons ?e float-e) (cons ?p float-pi))) "The association list of calculator register values.") (defvar calculator-saved-global-map nil @@ -1300,7 +1301,7 @@ (calculator-funcall __f__ x y)))) (fset 'D (function (lambda (x) - (if calculator-deg (/ (* x 180) pi) x)))) + (if calculator-deg (/ (* x 180) float-pi) x)))) (unwind-protect (eval f) (if Fbound (fset 'F Fsave) (fmakunbound 'F)) (if Dbound (fset 'D Dsave) (fmakunbound 'D)))))
--- a/lisp/calendar/appt.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/calendar/appt.el Mon Sep 27 14:42:43 2010 +0900 @@ -334,30 +334,42 @@ (if (or force ; eg initialize, diary save (null appt-prev-comp-time) ; first check (< cur-comp-time appt-prev-comp-time)) ; new day - (condition-case nil - (if appt-display-diary - (let ((diary-hook - (if (assoc 'appt-make-list diary-hook) - diary-hook - (cons 'appt-make-list diary-hook)))) - (diary)) - (let* ((diary-display-function 'appt-make-list) - (d-buff (find-buffer-visiting diary-file)) - (selective - (if d-buff ; diary buffer exists - (with-current-buffer d-buff - diary-selective-display)))) - ;; FIXME why not using diary-list-entries with - ;; non-nil LIST-ONLY? - (diary) - ;; If the diary buffer existed before this command, - ;; restore its display state. Otherwise, kill it. - (if d-buff - ;; Displays the diary buffer. - (or selective (diary-show-all-entries)) - (and (setq d-buff (find-buffer-visiting diary-file)) - (kill-buffer d-buff))))) - (error nil))) + (ignore-errors + (if appt-display-diary + (let ((diary-hook + (if (assoc 'appt-make-list diary-hook) + diary-hook + (cons 'appt-make-list diary-hook)))) + (diary)) + (let* ((diary-display-function 'appt-make-list) + (d-buff (find-buffer-visiting diary-file)) + (selective + (if d-buff ; diary buffer exists + (with-current-buffer d-buff + diary-selective-display))) + d-buff2) + ;; Not displaying the diary, so we can ignore + ;; diary-number-of-entries. Since appt.el only + ;; works on a daily basis, no need for more entries. + ;; FIXME why not using diary-list-entries with + ;; non-nil LIST-ONLY? + (diary 1) + ;; If the diary buffer existed before this command, + ;; restore its display state. Otherwise, kill it. + (and (setq d-buff2 (find-buffer-visiting diary-file)) + (if d-buff + (or selective + (with-current-buffer d-buff2 + (if diary-selective-display + ;; diary-show-all-entries displays + ;; the diary buffer. + (diary-unhide-everything)))) + ;; FIXME does not kill any included diary files. + ;; The real issue is that (diary) should not + ;; have the side effect of visiting all the + ;; diary files. It is not really appt.el's job to + ;; clean up this mess... + (kill-buffer d-buff2))))))) (setq appt-prev-comp-time cur-comp-time appt-mode-string nil appt-display-count nil) @@ -573,6 +585,17 @@ (let ((entry-list diary-entries-list) (new-time-string "") time-string) + ;; Below, we assume diary-entries-list was in date + ;; order. It is, unless something on + ;; diary-list-entries-hook has changed it, eg + ;; diary-include-other-files (bug#7019). It must be + ;; in date order if number = 1. + (and diary-list-entries-hook + appt-display-diary + (not (eq diary-number-of-entries 1)) + (not (memq (car (last diary-list-entries-hook)) + '(diary-sort-entries sort-diary-entries))) + (setq entry-list (sort entry-list 'diary-entry-compare))) ;; Skip diary entries for dates before today. (while (and entry-list (calendar-date-compare
--- a/lisp/calendar/diary-lib.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/calendar/diary-lib.el Mon Sep 27 14:42:43 2010 +0900 @@ -711,14 +711,26 @@ for NUMBER days starting with date DATE. The other entries are hidden using overlays. If NUMBER is less than 1, this function does nothing. -Returns a list of all relevant diary entries found, if any, in order by date. +Returns a list of all relevant diary entries found. The list entries have the form ((MONTH DAY YEAR) STRING SPECIFIER) where \(MONTH DAY YEAR) is the date of the entry, STRING is the entry text, and SPECIFIER is the applicability. If the variable `diary-list-include-blanks' is non-nil, this list includes a dummy diary entry consisting of the empty string for a date with no diary entries. -After the list is prepared, the following hooks are run: +If entries are being produced for multiple dates (i.e., NUMBER > 1), +then this function normally returns the entries from any given +diary file in date order. The entries for any given day are in +the order in which they were found in the file, not necessarily +in time-of-day order. Note that any functions present on the +hooks (see below) may add entries, or change the order. For +example, `diary-include-other-diary-files' adds entries from any +include files that it finds to the end of the original list. The +entries from each file will be in date order, but the overall +list will not be. If you want the entire list to be in time order, +add `diary-sort-entries' to the end of `diary-list-entries-hook'. + +After the initial list is prepared, the following hooks are run: `diary-nongregorian-listing-hook' can cull dates from the diary and each included file, for example to process Islamic diary
--- a/lisp/calendar/solar.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/calendar/solar.el Mon Sep 27 14:42:43 2010 +0900 @@ -753,12 +753,12 @@ (sin (mod (+ (cadr x) (* (nth 2 x) U)) - (* 2 pi))))) + (* 2 float-pi))))) solar-data-list))))) (aberration (* 0.0000001 (- (* 17 (cos (+ 3.10 (* 62830.14 U)))) 973))) - (A1 (mod (+ 2.18 (* U (+ -3375.70 (* 0.36 U)))) (* 2 pi))) - (A2 (mod (+ 3.51 (* U (+ 125666.39 (* 0.10 U)))) (* 2 pi))) + (A1 (mod (+ 2.18 (* U (+ -3375.70 (* 0.36 U)))) (* 2 float-pi))) + (A2 (mod (+ 3.51 (* U (+ 125666.39 (* 0.10 U)))) (* 2 float-pi))) (nutation (* -0.0000001 (+ (* 834 (sin A1)) (* 64 (sin A2)))))) (mod (radians-to-degrees (+ longitude aberration nutation)) 360.0)))
--- a/lisp/calendar/time-date.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/calendar/time-date.el Mon Sep 27 14:42:43 2010 +0900 @@ -97,20 +97,20 @@ (autoload 'timezone-make-date-arpa-standard "timezone") ;;;###autoload +;; `parse-time-string' isn't sufficiently general or robust. It fails +;; to grok some of the formats that timezone does (e.g. dodgy +;; post-2000 stuff from some Elms) and either fails or returns bogus +;; values. timezone-make-date-arpa-standard should help. (defun date-to-time (date) "Parse a string DATE that represents a date-time and return a time value. If DATE lacks timezone information, GMT is assumed." (condition-case () - (apply 'encode-time - (parse-time-string - ;; `parse-time-string' isn't sufficiently general or - ;; robust. It fails to grok some of the formats that - ;; timezone does (e.g. dodgy post-2000 stuff from some - ;; Elms) and either fails or returns bogus values. Lars - ;; reverted this change, but that loses non-trivially - ;; often for me. -- fx - (timezone-make-date-arpa-standard date))) - (error (error "Invalid date: %s" date)))) + (apply 'encode-time (parse-time-string date)) + (error (condition-case () + (apply 'encode-time + (parse-time-string + (timezone-make-date-arpa-standard date))) + (error (error "Invalid date: %s" date)))))) ;; Bit of a mess. Emacs has float-time since at least 21.1. ;; This file is synced to Gnus, and XEmacs packages may have been written @@ -317,10 +317,10 @@ (setq start (match-end 0) spec (match-string 1 string)) (unless (string-equal spec "%") - ;; `assoc-string' is not available in XEmacs or Emacs 21. So when - ;; compiling Gnus (`time-date.el' is part of Gnus) with XEmacs or - ;; Emacs 21, we get a warning here. But `format-seconds' is not - ;; used anywhere in Gnus so it's not a real problem. --rsteib + ;; `assoc-string' is not available in XEmacs. So when compiling + ;; Gnus (`time-date.el' is part of Gnus) with XEmacs, we get + ;; a warning here. But `format-seconds' is not used anywhere in + ;; Gnus so it's not a real problem. --rsteib (or (setq match (assoc-string spec units t)) (error "Bad format specifier: `%s'" spec)) (if (assoc-string spec usedunits t)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ChangeLog Mon Sep 27 14:42:43 2010 +0900 @@ -0,0 +1,1452 @@ +2010-09-25 Chong Yidong <cyd@stupidchicken.com> + + * ede/linux.el (ede-project-class-files): + * ede/generic.el (ede-generic-new-autoloader): + * ede/emacs.el (ede-project-class-files): + * ede/simple.el (ede-project-class-files): + * ede/cpp-root.el (ede-project-class-files): Fix require name. + +2010-09-25 Juanma Barranquero <lekktu@gmail.com> + + * semantic/lex.el (semantic-ignore-comments): Doc fix. + + * semantic/symref/list.el (semantic-symref-list-rename-open-hits): + Fix typo in error message. + (semantic-symref-list-map-open-hits): Fix typo in docstring. + +2010-09-21 Eric Ludlam <zappo@gnu.org> + + Synch SRecode to CEDET 1.0. + + * pulse.el (pulse-momentary-highlight-overlay): If pulse-flag is + 'never, disable all pulsing. + + * cedet.el (cedet-version): + * srecode.el (srecode-version): Bump version to 1.0. + + * srecode/texi.el (srecode-texi-insert-tag-as-doc): New function. + (semantic-insert-foreign-tag): Use it. + + * srecode/mode.el (srecode-bind-insert): Call + srecode-load-tables-for-mode. + (srecode-minor-mode-templates-menu): Do not list templates that + are not in the current project. + (srecode-menu-bar): Add binding for srecode-macro-help. + + * srecode/table.el (srecode-template-table): Add :project slot. + (srecode-dump): Dump it. + + * srecode/map.el (srecode-map-update-map): Make map loading more + robust. + + * srecode/insert.el (srecode-insert-fcn): Merge template + dictionary before resolving arguments. + (srecode-insert-method-helper): Add error checking to make sure + that we only have dictionaries. + (srecode-insert-method): Check template nesting depth when using + point inserter override. + (srecode-insert-method): Install override with depth limit. + + * srecode/getset.el (srecode-insert-getset): Force tag table + update. Don't query the class if it is empty. + + * srecode/find.el (srecode-template-get-table) + (srecode-template-get-table-for-binding) + (srecode-all-template-hash): Skip if not in current project. + (srecode-template-table-in-project-p): New method. + + * srecode/fields.el (srecode-fields-exit-confirmation): New option. + (srecode-field-exit-ask): Use it. + + * srecode/dictionary.el (srecode-dictionary-add-template-table): + Do not add variables in tables not for the current project. + (srecode-compound-toString): Handle cases where the default value + is another compound value. + (srecode-dictionary-lookup-name): New optional argument + NON-RECURSIVE, which inhibits visiting dictionary parents. + (srecode-dictionary-add-section-dictionary) + (srecode-dictionary-merge): New optional argument FORCE adds + values even if an identically named entry exists. + (srecode-dictionary-add-entries): New method. + (srecode-create-dictionaries-from-tags): New function. + + * srecode/cpp.el (srecode-cpp): New defgroup. + (srecode-cpp-namespaces): New option. + (srecode-semantic-handle-:using-namespaces) + (srecode-cpp-apply-templates): New functions. + (srecode-semantic-apply-tag-to-dict): Handle template parameters + by calling `srecode-cpp-apply-templates'. + + * srecode/compile.el (srecode-compile-templates): Fix directory + compare of built-in templates. Give built-ins lower piority. + Support special variable "project". + (srecode-compile-template-table): Set :project slot of new tables. + (srecode-compile-one-template-tag): Use + srecode-create-dictionaries-from-tags. + +2010-09-21 Eric Ludlam <zappo@gnu.org> + + Synch EDE to CEDET 1.0. + + * cedet-idutils.el (cedet-idutils-make-command): New option. + (cedet-idutils-mkid-call): + (cedet-idutils-create/update-database): New functions. + + * cedet-cscope.el (cedet-cscope-create): + (cedet-cscope-create/update-database): New functions. + (cedet-cscope-support-for-directory): Make interactive. + + * cedet-global.el (cedet-global-gtags-command): New option. + (cedet-gnu-global-gtags-call) + (cedet-gnu-global-create/update-database): New functions. + + * ede.el (ede-save-cache): Fix recentf-exclude expression. + (ede-make-dist): Always use toplevel project. + (ede-buffer-object): If we fail to find an object in the current + project, loop upward looking for a match. If no target is found, + use most local project. + (ede-buffer-belongs-to-target-p) + (ede-buffer-belongs-to-project-p): New functions. + (ede-initialize-state-current-buffer): New function. + (ede-target-forms-menu, ede-project-buffers): Use them. + (ede-minor-mode, ede-reset-all-buffers): Use it. + (project-interactive-select-target, project-add-file): Don't use + ede-project-force-load. + (ede-buffer-object): New arg PROJSYM. + (ede-minor-mode): Remove ede-directory-project-p test. + (ede-initialize-state-current-buffer): Don't test for + ede-directory-project-p if there is a matching open project. + (ede-customize-forms-menu): Prevent error if there is no project. + (ede-load-project-file): Set ede-constructing to the thing being + constructed, instead of t. + (ede-project-force-load): Deleted. + + * ede/base.el: + * ede/auto.el: + * ede/custom.el: New files. + + * ede/autoconf-edit.el (autoconf-find-last-macro) + (autoconf-parameters-for-macro): Parse multiline parameters of + macros. Optionally ignore case and at bol for macro. + (autoconf-parameter-strip): Use greedy match for newlines. + (autoconf-new-automake-string): Deleted. + (autoconf-new-program): Use SRecode to fill an empty file. + + * ede/cpp-root.el (ede-create-lots-of-projects-under-dir): New + function. + + * ede/files.el (ede-flush-project-hash): New command. + (ede-convert-path): Add optional PROJECT arg. + (ede-directory-project-p): Obey ".ede-ignore". + (ede-expand-filename-local) + (ede-expand-filename-impl-via-subproj): New methods. + (ede-expand-filename-impl): Use them. + (ede-project-root, ede-project-root-directory): Move to + ede/auto.el. + + * ede/locate.el (ede-locate-flush-hash): + (ede-locate-create/update-root-database): New methods. + (initialize-instance): Use ede-locate-flush-hash. + + * ede/pmake.el (ede-proj-makefile-insert-variables): If this is + the top project and not a metasubproject, set TOP to CURDIR. + (ede-proj-makefile-insert-variables): Output a target's object + list whether or not the vars are already in the Makefile. + (ede-pmake-insert-variable-once): New macro. + + * ede/project-am.el (project-am-with-makefile-current): Add + recentf-exclude. + (project-am-load-makefile): Obey an optional suggested name. + (project-am-expand-subdirlist): New function. + (project-am-makefile::project-rescan): Use it. Combine SUBDIRS + and DIST_SUBDIRS. + (project-am-meta-type-alist): A list to scan better Makefile.am + (project-am-scan-for-targets): Scan also over + project-am-meta-type-alist. + (ede-system-include-path): Simple implementation. + (ede-find-target): Deleted. EDE core takes care of this. + (ede-buffer-mine): Create the searched filename as relative. + (project-am-load): Simplify, using autoconf-edit. + (project-am-extract-package-info): Fix separators. + + * ede/proj.el (project-run-target): New method. + (project-make-dist, project-compile-project): Use + ede-proj-automake-p to determine which kind of compile to use. + (project-rescan): Call ede-load-project-file. + (ede-buffer-mine): Add more file names that belong to the project. + (ede-proj-compilers): Improve error message. + + * ede/proj-obj.el (ede-ld-linker): Use the LDDEPS variable. + (ede-source-c++): Add more C++ extensions. + (ede-proj-target-makefile-objectcode): Quote initforms. Support + lex and yacc. + + * ede/proj-prog.el (ede-proj-makefile-insert-rules): Removed. + (ede-proj-makefile-insert-variables): New, add LDDEPS. + (ede-proj-makefile-insert-automake-post-variables): Add LDADD + variable. Use ldlibs-local slot. Add a -l to ldlibs strings. + (ede-proj-target-makefile-program): Swap order of two slots so + they show up in the same order as in the command line. + (ede-proj-target-makefile-program): Add ldlibs-local slot. + + * ede/proj-shared.el (ede-g++-libtool-shared-compiler): Fix + inference rule to use cpp files. + (ede-proj-target-makefile-shared-object): Quote initforms. + + * ede/proj-misc.el (ede-proj-target-makefile-miscelaneous): + * ede/proj-info.el (ede-proj-target-makefile-info): + * ede/proj-aux.el (ede-proj-target-aux): + * ede/proj-archive.el (ede-proj-target-makefile-archive): + * ede/proj-elisp.el (ede-proj-target-elisp) + (ede-proj-target-elisp-autoloads): Quote initforms. + + * ede/srecode.el (ede-srecode-setup): Load autoconf templates. + + * ede/shell.el (ede-shell-buffer): Fix buffer name. + + * ede/pconf.el (ede-proj-configure-synchronize): If user events + occur while waiting for the compile process to finish, pull them + in and discard those events. + +2010-09-19 Eric Ludlam <zappo@gnu.org> + + Synch Semantic to CEDET 1.0. + + * semantic.el (semantic-version): Update to 2.0. + (semantic-mode-map): Add "," and "m" bindings. + (navigate-menu): Update. + + * semantic/symref.el (semantic-symref-calculate-rootdir): + New function. + (semantic-symref-detect-symref-tool): Use it. + + * semantic/symref/grep.el (semantic-symref-grep-shell): New var. + (semantic-symref-perform-search): Use it. Calculate root dir with + semantic-symref-calculate-rootdir. + (semantic-symref-derive-find-filepatterns): Improve error message. + + * semantic/symref/list.el + (semantic-symref-results-mode-map): New bindings. + (semantic-symref-auto-expand-results): New option. + (semantic-symref-results-dump): Obey auto-expand. + (semantic-symref-list-expand-all, semantic-symref-regexp) + (semantic-symref-list-contract-all) + (semantic-symref-list-map-open-hits) + (semantic-symref-list-update-open-hits) + (semantic-symref-list-create-macro-on-open-hit) + (semantic-symref-list-call-macro-on-open-hits): New functions. + (semantic-symref-list-menu-entries) + (semantic-symref-list-menu): New vars. + (semantic-symref-list-map-open-hits): Move cursor to beginning of + match before calling the mapped function. + + * semantic/doc.el + (semantic-documentation-comment-preceeding-tag): Do nothing if the + mode doesn't provide comment-start-skip. + + * semantic/scope.el + (semantic-analyze-scope-nested-tags-default): Strip duplicates. + (semantic-analyze-scoped-inherited-tag-map): Take the tag we are + looking for as part of the scoped tags list. + + * semantic/html.el (semantic-default-html-setup): Add + senator-step-at-tag-classes. + + * semantic/decorate/include.el + (semantic-decoration-on-unknown-includes): Change light bgcolor. + (semantic-decoration-on-includes-highlight-default): Check that + the include tag has a postion. + + * semantic/complete.el (semantic-collector-local-members): + (semantic-complete-read-tag-local-members) + (semantic-complete-jump-local-members): New class and functions. + (semantic-complete-self-insert): Save excursion before completing. + + * semantic/analyze/complete.el + (semantic-analyze-possible-completions-default): If no completions + are found, return the raw by-name-only completion list. Add FLAGS + arguments. Add support for 'no-tc (type constraint) and + 'no-unique, or no stripping duplicates. + (semantic-analyze-possible-completions-default): Add FLAGS arg. + + * semantic/util-modes.el + (semantic-stickyfunc-show-only-functions-p): New option. + (semantic-stickyfunc-fetch-stickyline): Don't show stickytext for + the very first line in a buffer. + + * semantic/util.el (semantic-hack-search) + (semantic-recursive-find-nonterminal-by-name) + (semantic-current-tag-interactive): Deleted. + (semantic-describe-buffer): Fix expand-nonterminal. Add + lex-syntax-mods, type relation separator char, and command + separation char. + (semantic-sanity-check): Only message if called interactively. + + * semantic/tag.el (semantic-tag-deep-copy-one-tag): Copy the + :filename property and the tag position. + + * semantic/lex-spp.el (semantic-lex-spp-lex-text-string): + Add recursion limit. + + * semantic/imenu.el (semantic-imenu-bucketize-type-members): + Make this buffer local, not the obsoleted variable. + + * semantic/idle.el: Add breadcrumbs support. + (semantic-idle-summary-current-symbol-info-default) + (semantic-idle-tag-highlight) + (semantic-idle-completion-list-default): Use + semanticdb-without-unloaded-file-searches for speed, and to + conform to the controls that specify if the idle timer is supposed + to be parsing unparsed includes. + (semantic-idle-symbol-highlight-face) + (semantic-idle-symbol-maybe-highlight): Rename from *-summary-*. + Callers changed. + (semantic-idle-work-parse-neighboring-files-flag): Default to nil. + (semantic-idle-work-update-headers-flag): New var. + (semantic-idle-work-for-one-buffer): Use it. + (semantic-idle-local-symbol-highlight): Rename from + semantic-idle-tag-highlight. + (semantic-idle-truncate-long-summaries): New option. + + * semantic/ia.el (semantic-ia-cache) + (semantic-ia-get-completions): Deleted. Callers changed. + (semantic-ia-show-variants): New command. + (semantic-ia-show-doc): If doc is empty, don't make a temp buffer. + (semantic-ia-show-summary): If there isn't anything to show, say so. + + * semantic/grammar.el (semantic-grammar-create-package): + Save the buffer even in batch mode. + + * semantic/fw.el + (semanticdb-without-unloaded-file-searches): New macro. + + * semantic/dep.el (semantic-dependency-find-file-on-path): + Fix case dereferencing ede-object when it is a list. + + * semantic/db-typecache.el (semanticdb-expand-nested-tag) + (semanticdb-typecache-faux-namespace): New functions. + (semanticdb-typecache-file-tags) + (semanticdb-typecache-merge-streams): Use them. + (semanticdb-typecache-file-tags): When deriving tags from a file, + give the mode a chance to monkey with the tag copy. + (semanticdb-typecache-find-default): Wrap find in save-excursion. + (semanticdb-typecache-find-by-name-helper): Merge found names down. + + * semantic/db-global.el + (semanticdb-enable-gnu-global-in-buffer): Don't show messages if + GNU Global is not available and we don't want to throw an error. + + * semantic/db-find.el (semanticdb-find-result-nth-in-buffer): + When trying to normalize the tag to a buffer, don't error if + set-buffer method doesn't exist. + + * semantic/db-file.el (semanticdb-save-db): Simplify msg. + + * semantic/db.el (semanticdb-refresh-table): If forcing a + refresh on a file not in a buffer, use semantic-find-file-noselect + and delete the buffer after use. + (semanticdb-current-database-list): When calculating root via + hooks, force it through true-filename and skip the list of + possible roots. + + * semantic/ctxt.el (semantic-ctxt-imported-packages): New. + + * semantic/analyze/debug.el + (semantic-analyzer-debug-insert-tag): Reset standard output to + current buffer. + (semantic-analyzer-debug-global-symbol) + (semantic-analyzer-debug-missing-innertype): Change "prefix" to + "symbol" in messages. + + * semantic/analyze/refs.el: (semantic-analyze-refs-impl) + (semantic-analyze-refs-proto): When calculating value, make sure + the found tag is 'similar' to the originating tag. + (semantic--analyze-refs-find-tags-with-parent): Attempt to + identify matches via imported symbols of parents. + (semantic--analyze-refs-full-lookup-with-parents): Do a deep + search during the brute search. + + * semantic/analyze.el + (semantic-analyze-find-tag-sequence-default): Be robust to + calculated scopes being nil. + + * semantic/bovine/c.el (semantic-c-describe-environment): Add + project macro symbol array. + (semantic-c-parse-lexical-token): Add recursion limit. + (semantic-ctxt-imported-packages, semanticdb-expand-nested-tag): + New overrides. + (semantic-expand-c-tag-namelist): Split a full type from a typedef + out to its own tag. + (semantic-expand-c-tag-namelist): Do not split out a typedef'd + inline type if it is an anonymous type. + (semantic-c-reconstitute-token): Use the optional initializers as + a clue that some function is probably a constructor. When + defining the type of these constructors, split the parent name, + and use only the class part, if applicable. + + * semantic/bovine/c-by.el: + * semantic/wisent/python-wy.el: Regenerate. + +2010-07-20 Juanma Barranquero <lekktu@gmail.com> + + * semantic/db-file.el (object-write): Fix typo in docstring. + +2010-06-03 Eric Ludlam <zappo@gnu.org> + + * semantic/lex-spp.el + (semantic-lex-spp-table-write-slot-value): Instead of erroring on + invalid values during save, just save a nil (Bug#6324). + +2010-05-31 Jonathan Marchand <jonathlela@gmail.com> (tiny change) + + * ede/cpp-root.el (ede-set-project-variables): Fix feature name + (bug#6231). + +2010-05-02 Stefan Monnier <monnier@iro.umontreal.ca> + + Use a mode-line spec rather than a static string in Semantic. + * semantic/util-modes.el: + (semantic-minor-modes-format): New var to replace... + (semantic-minor-modes-status): Remove. + (semantic-mode-line-update): Construct a mode-line spec rather than + a static string so that mouse buttons can be used on individual minor + modes and so that semantic-mode-line-update only needs to be called + when global settings are changed. + (semantic-add-minor-mode, semantic-toggle-minor-mode-globally): + Call semantic-mode-line-update. + (semantic-toggle-minor-mode-globally): Don't assume mode is on + minor-mode-alist, check semantic-minor-mode-alist as well. + (semantic-stickyfunc-mode, semantic-show-parser-state-auto-marker) + (semantic-show-parser-state-marker, semantic-show-parser-state-mode) + (semantic-show-unmatched-syntax-mode, semantic-highlight-edits-mode): + * semantic/mru-bookmark.el (semantic-mru-bookmark-mode): + * semantic/idle.el (semantic-idle-scheduler-mode) + (define-semantic-idle-service, semantic-idle-summary-mode): + * semantic/decorate/mode.el (semantic-decoration-mode): + Don't call semantic-mode-line-update any more. + +2010-05-02 Stefan Monnier <monnier@iro.umontreal.ca> + + Use define-minor-mode in CEDET where applicable. + + * srecode/mode.el (srecode-minor-mode,global-srecode-minor-mode): + Use define-minor-mode. + + * semantic/util-modes.el (semantic-add-minor-mode): + Remove unused arg `keymap' and code redundant with define-minor-mode. + (semantic-toggle-minor-mode-globally): Only handle arg -1 and 1. + (semantic-stickyfunc-mode, global-semantic-show-unmatched-syntax-mode) + (semantic-highlight-func-mode, global-semantic-show-parser-state-mode) + (global-semantic-highlight-edits-mode, semantic-highlight-edits-mode) + (semantic-show-unmatched-syntax-mode, semantic-show-parser-state-mode) + (global-semantic-stickyfunc-mode, global-semantic-highlight-func-mode): + Use define-minor-mode. + (semantic-stickyfunc-mode-setup, semantic-highlight-edits-mode-setup) + (semantic-show-unmatched-syntax-mode-setup) + (semantic-show-parser-state-mode-setup) + (semantic-highlight-func-mode-setup): Inline into sole caller. + + * semantic/mru-bookmark.el (global-semantic-mru-bookmark-mode) + (semantic-mru-bookmark-mode): Use define-minor-mode. + (semantic-mru-bookmark-mode-setup): Inline into sole caller. + + * semantic/idle.el (define-semantic-idle-service): + Use define-minor-mode and inline setup function into its sole caller. + (semantic-idle-scheduler-mode-setup) + (semantic-idle-summary-mode-setup): Inline into sole caller. + (global-semantic-idle-scheduler-mode, semantic-idle-scheduler-mode): + Use define-minor-mode. + + * semantic/decorate/mode.el (global-semantic-decoration-mode) + (semantic-decoration-mode): Use define-minor-mode. + (semantic-decoration-mode-setup): Inline into sole caller. + + * ede/dired.el (ede-dired-minor-mode): Initialize in declaration. + (ede-dired-minor-mode): Use define-minor-mode and derived-mode-p. + (ede-dired-add-to-target): Use dolist. + +2010-04-18 Chong Yidong <cyd@stupidchicken.com> + + * ede/pmake.el (ede-proj-makefile-insert-variables): + Don't destroy list before using it. + +2010-04-29 Chong Yidong <cyd@stupidchicken.com> + + * semantic.el (semantic-completion-at-point-function): + New function. + (semantic-mode): Use semantic-completion-at-point-function for + completion-at-point-functions instead. + +2010-04-28 Chong Yidong <cyd@stupidchicken.com> + + * semantic.el (semantic-mode): When enabled, add + semantic-ia-complete-symbol to completion-at-point-functions. + + * semantic/ia.el (semantic-ia-complete-symbol): Return nil + if Semantic is not active. + +2010-04-19 Chong Yidong <cyd@stupidchicken.com> + + * ede/pmake.el (ede-proj-makefile-insert-variables): + Don't destroy list before using it. + +2010-04-02 Juanma Barranquero <lekktu@gmail.com> + + * semantic/imenu.el (semantic-imenu-bucketize-type-members) + (semantic-create-imenu-directory-index): Fix typos in docstrings. + (semantic-imenu-goto-function): Reflow docstring. + +2010-03-24 Juanma Barranquero <lekktu@gmail.com> + + * srecode/table.el (srecode-template-table): Fix docstring typo. + +2010-03-24 Glenn Morris <rgm@gnu.org> + + * semantic/bovine/c.el (semantic-c-describe-environment): + Consistently check ede-object is bound throughout. + + * ede/project-am.el (ede-shell-run-something): Declare. + +2010-03-13 Eric M. Ludlam <zappo@gnu.org> + + * semantic/imenu.el: New file, from the CEDET repository + (Bug#5412). + +2010-03-06 Glenn Morris <rgm@gnu.org> + + * semantic/grammar.el (semantic-grammar-header-template): + Update template copyright to GPLv3+. + +2010-02-28 Chong Yidong <cyd@stupidchicken.com> + + * semantic/db-find.el + (semanticdb-find-translate-path-brutish-default): + * ede/make.el (ede-make-check-version): Use + with-current-buffer instead of save-excursion. + +2010-02-16 Chong Yidong <cyd@stupidchicken.com> + + * data-debug.el (data-debug): Move to extensions group. + + * ede.el (ede): + * srecode.el (srecode): + * semantic.el (semantic): Put in tools and extensions group. + +2010-02-14 Juanma Barranquero <lekktu@gmail.com> + + * ede.el (ede-run-target, project-delete-target) + (project-dist-files, ede-name, ede-documentation, ede-parent-project) + (ede-adebug-project, ede-adebug-project-parent) + (ede-adebug-project-root): Fix typos in docstrings. + +2010-01-18 Juanma Barranquero <lekktu@gmail.com> + + * ede/locate.el (ede-locate-file-in-project) + (ede-locate-file-in-project-impl): Fix typos in docstrings. + (ede-enable-locate-on-project): Fix typos in error messages. + + * semantic/util-modes.el (semantic-unmatched-syntax-face) + (semantic-stickyfunc-old-hlf, semantic-stickyfunc-header-line-format) + (semantic-stickyfunc-sticky-classes, semantic-highlight-func-mode-setup) + (semantic-stickyfunc-fetch-stickyline): Fix typos in docstrings. + (semantic-stickyfunc-popup-menu, semantic-highlight-func-popup-menu): + Fix typos in menu help. + + * semantic.el (semantic-require-version, semantic--buffer-cache) + (semantic-unmatched-syntax-cache-check, semantic-unmatched-syntax-hook) + (semantic--before-fetch-tags-hook, semantic-new-buffer-fcn-was-run) + (semantic--umatched-syntax-needs-refresh-p, semantic-elapsed-time) + (semantic-parse-stream, semantic-parse-region) + (semantic-parse-region-default, semantic--set-buffer-cache) + (semantic-minimum-working-buffer-size, semantic-refresh-tags-safe) + (semantic-bovinate-toplevel, semantic-load-system-cache-loaded) + (semantic-default-submodes): + * semantic/db-ebrowse.el (semanticdb-table-ebrowse) + (semanticdb-create-ebrowse-database) + (semanticdb-find-tags-for-completion-method) + (semanticdb-find-tags-by-class-method) + (semanticdb-deep-find-tags-by-name-method) + (semanticdb-deep-find-tags-for-completion-method): + * semantic/db-el.el (semanticdb-elisp-mapatom-collector) + (semanticdb-find-tags-by-name-method, emacs-lisp-mode) + (semanticdb-find-tags-for-completion-method) + (semanticdb-find-tags-by-class-method) + (semanticdb-deep-find-tags-for-completion-method): + * semantic/db-find.el (semanticdb-find-translate-path) + (semanticdb-find-need-cache-update-p, semanticdb-find-result-with-nil-p) + (semanticdb-find-scanned-include-tags, semanticdb-find-tags-collector) + (semanticdb-find-tags-by-name-method) + (semanticdb-find-tags-by-name-regexp-method) + (semanticdb-find-tags-for-completion-method) + (semanticdb-find-tags-by-class-method) + (semanticdb-find-tags-external-children-of-type-method) + (semanticdb-find-tags-subclasses-of-type-method) + (semanticdb-deep-find-tags-by-name-method) + (semanticdb-deep-find-tags-by-name-regexp-method) + (semanticdb-deep-find-tags-for-completion-method): + * semantic/db-global.el (semanticdb-enable-gnu-global-hook) + (semanticdb-enable-gnu-global-in-buffer) + (semanticdb-find-tags-for-completion-method) + (semanticdb-deep-find-tags-by-name-method) + (semanticdb-deep-find-tags-for-completion-method): + * semantic/db-javascript.el (semanticdb-javascript-tags) + (javascript-mode, semanticdb-find-translate-path) + (semanticdb-find-tags-for-completion-method) + (semanticdb-find-tags-by-class-method) + (semanticdb-deep-find-tags-by-name-method) + (semanticdb-deep-find-tags-for-completion-method) + (semanticdb-find-tags-external-children-of-type-method): + * semantic/idle.el (semantic-idle-work-core-handler) + (define-semantic-idle-service, semantic-idle-summary-useful-context-p) + (global-semantic-idle-scheduler-mode): + * srecode/dictionary.el (srecode-field-value) + (srecode-dictionary-add-section-dictionary): + Fix typos in docstrings. + +2010-01-17 Glenn Morris <rgm@gnu.org> + + * semantic/idle.el (semantic-idle-work-for-one-buffer): Doc fix. + +2010-01-17 Juanma Barranquero <lekktu@gmail.com> + + * semantic.el (semantic-mode): Fix typos in docstrings. + +2010-01-16 Mario Lang <mlang@delysid.org> + + * ede/cpp-root.el (ede-cpp-root-project): + * ede/files.el (ede-expand-filename): + * ede/simple.el (ede-simple-project): + * semantic/complete.el (semantic-complete-read-tag-engine) + (semantic-complete-inline-tag-engine): + * semantic/db-el.el (semanticdb-equivalent-mode): + * semantic/db-global.el (semanticdb-equivalent-mode): + * semantic/db-javascript.el (semanticdb-equivalent-mode): + * semantic/db.el (semanticdb-equivalent-mode): + * semantic/decorate/include.el (semantic-decoration-unknown-include-describe): + * semantic/idle.el (semantic-idle-work-for-one-buffer): + Remove duplicated words in doc-strings. + +2010-01-14 Juanma Barranquero <lekktu@gmail.com> + + * semantic/edit.el (semantic-reparse-needed-change-hook) + (semantic-no-reparse-needed-change-hook): + * srecode/insert.el (srecode-resolve-argument-list) + (srecode-template-inserter-blank, srecode-template-inserter-variable) + (srecode-template-inserter-ask, srecode-template-inserter-width) + (srecode-template-inserter-section-start) + (srecode-template-inserter-section-end, srecode-insert-method): + +2010-01-12 Juanma Barranquero <lekktu@gmail.com> + + * data-debug.el (data-debug): Fix customization group reference. + +2010-01-12 Juanma Barranquero <lekktu@gmail.com> + + * semantic/analyze.el (semantic-analyze-push-error) + (semantic-analyze-context, semantic-analyze-context-assignment) + (semantic-analyze-find-tag-sequence, semantic-analyze-find-tag): + * semantic/java.el (java-mode, semantic-tag-include-filename) + (semantic-java-doc-keywords-map): + * semantic/bovine/c.el (c-mode, semantic-c-member-of-autocast) + (semantic-lex-c-nested-namespace-ignore-second, semantic-parse-region) + (semantic-c-parse-lexical-token, semantic-c-debug-mode-init-pch) + (semantic-c-classname, semantic-format-tag-uml-prototype) + (semantic-c-dereference-namespace, semantic-analyze-type-constants): + * semantic/bovine/el.el (semantic-elisp-form-to-doc-string) + (semantic-emacs-lisp-obsoleted-doc, semantic-up-context) + (semantic-get-local-variables, semantic-end-of-command) + (semantic-beginning-of-command, semantic-ctxt-current-class-list) + (lisp-mode): + * semantic/bovine/make.el (makefile-mode): + * semantic/wisent/python.el (wisent-python-string-re) + (wisent-python-implicit-line-joining-p, wisent-python-forward-string) + (wisent-python-lex-beginning-of-line, wisent-python-lex-end-of-line) + (semantic-lex, semantic-get-local-variables, python-mode): + * semantic/wisent/python-wy.el (wisent-python-wy--keyword-table): + * srecode/extract.el (srecode-extract-state-set) + (srecode-extract-method): Fix typos in docstrings. + +2010-01-10 Chong Yidong <cyd@stupidchicken.com> + + * semantic.el (semantic-new-buffer-setup-functions): + Add python parser. + +2010-01-10 Richard Kim <emacs18@gmail.com> + + * semantic/wisent/python-wy.el: + * semantic/wisent/python.el: New files. + +2010-01-02 Juanma Barranquero <lekktu@gmail.com> + + * semantic/db-typecache.el (semanticdb-typecache-find-default): + Fix typo in docstring. + +2009-12-14 Chong Yidong <cyd@stupidchicken.com> + + * semantic/mru-bookmark.el (global-semantic-mru-bookmark-mode) + (semantic-mru-bookmark-mode): Doc fixes. + + * semantic/db.el (semanticdb-cache-get): Use error instead + of assert. + +2009-12-05 Chong Yidong <cyd@stupidchicken.com> + + * semantic/ia.el (semantic-ia-complete-symbol): + Make argument optional. + +2009-12-05 Eric Ludlam <zappo@gnu.org> + + * semantic/bovine/c.el (semantic-c-describe-environment): + Describe project macro symbols. + + * semantic/complete.el (semantic-complete-do-completion): + Don't call semantic-collector-current-exact-match. + + * ede.el (ede-apply-preprocessor-map): Accept lists of + ede-objects as targets. + + * ede/pmake.el (ede-proj-makefile-insert-variables): Output + a target's object list even if compiler vars are already in the + Makefile. + + * ede/emacs.el (ede-preprocessor-map): Add config.h to the + list of headers producing necessary macros. + +2009-11-24 Glenn Morris <rgm@gnu.org> + + * semantic/idle.el (global-semantic-idle-scheduler-mode): + Move after definition of global-semantic-idle-tag-highlight-mode. + +2009-11-22 Chong Yidong <cyd@stupidchicken.com> + + * srecode/map.el (srecode-get-maps): + * semantic/wisent/wisent.el (wisent-parse-toggle-verbose-flag): + * semantic/wisent/comp.el (wisent-toggle-verbose-flag): + * semantic/decorate/mode.el (semantic-decoration-mode) + (semantic-toggle-decoration-style): + * semantic/decorate/include.el + (semantic-decoration-include-describe) + (semantic-decoration-unknown-include-describe) + (semantic-decoration-unparsed-include-describe) + (semantic-decoration-all-include-summary): + * semantic/bovine/c.el (semantic-c-debug-mode-init): + * semantic/analyze/complete.el + (semantic-analyze-possible-completions): + * semantic/util-modes.el (semantic-highlight-edits-mode) + (semantic-show-unmatched-syntax-mode) + (semantic-show-parser-state-mode, semantic-stickyfunc-mode) + (semantic-highlight-func-mode): + * semantic/util.el (semantic-describe-buffer): + * semantic/symref.el (semantic-symref-find-references-by-name) + (semantic-symref-find-tags-by-name) + (semantic-symref-find-tags-by-regexp) + (semantic-symref-find-tags-by-completion) + (semantic-symref-find-file-references-by-name) + (semantic-symref-find-text): + * semantic/senator.el (senator-copy-tag, senator-kill-tag) + (senator-yank-tag): + * semantic/scope.el (semantic-calculate-scope): + * semantic/mru-bookmark.el (semantic-mru-bookmark-mode): + * semantic/idle.el (semantic-idle-scheduler-mode) + (define-semantic-idle-service): + * semantic/complete.el (semantic-complete-analyze-inline) + (semantic-complete-analyze-inline-idle): + * semantic/analyze.el (semantic-analyze-current-context): + * mode-local.el (describe-mode-local-bindings) + (describe-mode-local-bindings-in-mode): + * ede/make.el (ede-make-check-version): + * ede/locate.el (ede-enable-locate-on-project): + * cedet-idutils.el (cedet-idutils-expand-filename) + (cedet-idutils-version-check): + * cedet-global.el (cedet-gnu-global-expand-filename) + (cedet-gnu-global-version-check): + * cedet-cscope.el (cedet-cscope-expand-filename) + (cedet-cscope-version-check): Use called-interactively-p instead + of interactive-p. + + * semantic/ia.el (semantic-ia-completion-format-tag-function): + Use semantic-format-tag-prototype. + +2009-11-21 Chong Yidong <cyd@stupidchicken.com> + + * semantic/complete.el (semantic-complete-read-tag-engine) + (semantic-complete-jump-local, semantic-complete-jump): + Improve prompt string. + +2009-11-20 Chong Yidong <cyd@stupidchicken.com> + + * semantic/complete.el (semantic-complete-inline-map): Doc fix. + + * semantic/idle.el (define-semantic-idle-service) + (semantic-idle-summary-mode, semantic-idle-completions): Doc fix. + +2009-11-20 Chong Yidong <cyd@stupidchicken.com> + + * cedet.el (cedet-menu-map): Re-order menu items. + + * semantic.el: Enable idle-mode menu items only if + global-semantic-idle-scheduler-mode is enabled. + (semantic-default-submodes): Doc fix. + + * semantic/idle.el (global-semantic-idle-scheduler-mode): + When turning off, disable other idle modes. + +2009-11-15 Chong Yidong <cyd@stupidchicken.com> + + * semantic/idle.el (semantic-idle-summary-mode) + (semantic-idle-summary-mode): Define using define-minor-mode + instead of define-semantic-idle-service. + (semantic-idle-summary-mode): New function. + (semantic-idle-summary-mode-setup): Use pre-command-hook to ensure + that mouse motion does not reset the echo area. + +2009-11-08 Chong Yidong <cyd@stupidchicken.com> + + * semantic/ctxt.el (semantic-get-local-variables): Disable + the progress reporter entirely. + +2009-11-03 Stefan Monnier <monnier@iro.umontreal.ca> + + * semantic/fw.el (semantic/loaddefs): + * srecode.el (srecode/loaddefs): + * ede.el (ede/loaddefs): Load rather than require. + * ede/cpp-root.el: + * ede/emacs.el: + * ede/files.el: + * ede/linux.el: + * ede/locate.el: + * ede/make.el: + * ede/shell.el: + * ede/speedbar.el: + * ede/system.el: + * ede/util.el: + * semantic/analyze.el: + * semantic/bovine.el: + * semantic/complete.el: + * semantic/ctxt.el: + * semantic/db-file.el: + * semantic/db-find.el: + * semantic/db-global.el: + * semantic/db-mode.el: + * semantic/db-typecache.el: + * semantic/db.el: + * semantic/debug.el: + * semantic/dep.el: + * semantic/doc.el: + * semantic/edit.el: + * semantic/find.el: + * semantic/format.el: + * semantic/html.el: + * semantic/ia-sb.el: + * semantic/ia.el: + * semantic/idle.el: + * semantic/lex-spp.el: + * semantic/lex.el: + * semantic/mru-bookmark.el: + * semantic/scope.el: + * semantic/senator.el: + * semantic/sort.el: + * semantic/symref.el: + * semantic/tag-file.el: + * semantic/tag-ls.el: + * semantic/tag-write.el: + * semantic/tag.el: + * semantic/util-modes.el: + * semantic/analyze/complete.el: + * semantic/analyze/refs.el: + * semantic/bovine/c.el: + * semantic/bovine/gcc.el: + * semantic/bovine/make.el: + * semantic/bovine/scm.el: + * semantic/decorate/include.el: + * semantic/decorate/mode.el: + * semantic/symref/cscope.el: + * semantic/symref/global.el: + * semantic/symref/grep.el: + * semantic/symref/idutils.el: + * semantic/symref/list.el: + * semantic/wisent/java-tags.el: + * semantic/wisent/javascript.el: + * srecode/compile.el: + * srecode/cpp.el: + * srecode/document.el: + * srecode/el.el: + * srecode/expandproto.el: + * srecode/getset.el: + * srecode/insert.el: + * srecode/java.el: + * srecode/map.el: + * srecode/mode.el: + * srecode/template.el: + * srecode/texi.el: Remove the file-local setting of + generated-autoload-feature. + +2009-11-03 Glenn Morris <rgm@gnu.org> + + * mode-local.el (with-mode-local): Doc fix. + +2009-10-31 Chong Yidong <cyd@stupidchicken.com> + + * cedet.el (cedet-menu-map): Remove Semantic and EDE menu + items. + + * ede.el (ede-minor-mode): + * semantic.el (semantic-mode): Toggle menu separators. + +2009-10-31 Glenn Morris <rgm@gnu.org> + + * semantic/tag.el (semantic--tag-link-list-to-buffer): + Use mapc rather than mapcar because the return value is never used. + + * srecode/template.el, semantic/wisent/javascript.el: + * semantic/wisent/java-tags.el, semantic/texi.el: + * semantic/html.el: + Suppress harmless warnings about setting up semantic-imenu (not + part of Emacs) variables. + +2009-10-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * srecode/srt-mode.el (semantic-analyze-possible-completions): + * semantic/symref/list.el (semantic-symref-rb-toggle-expand-tag): + * semantic/symref/grep.el (semantic-symref-perform-search): + * semantic/bovine/gcc.el (semantic-gcc-query): + * semantic/bovine/c.el (semantic-c-parse-lexical-token): + * semantic/analyze/debug.el (semantic-analyzer-debug-add-buttons) + (semantic-analyzer-debug-global-symbol) + (semantic-analyzer-debug-missing-innertype) + (semantic-analyzer-debug-insert-include-summary): + * semantic/util.el (semantic-file-tag-table): + (semantic-describe-buffer-var-helper, semantic-something-to-tag-table) + (semantic-recursive-find-nonterminal-by-name): + * semantic/tag-ls.el (semantic-tag-calculate-parent-default): + * semantic/tag-file.el (semantic-prototype-file): + * semantic/symref.el (semantic-symref-parse-tool-output): + * semantic/sb.el (semantic-sb-fetch-tag-table): + * semantic/lex-spp.el (semantic-lex-spp-lex-text-string): + * semantic/idle.el (semantic-idle-work-for-one-buffer): + (semantic-idle-summary-maybe-highlight): + * semantic/ia-sb.el (semantic-ia-speedbar) + (semantic-ia-sb-tag-info): + * semantic/grammar.el (semantic-analyze-possible-completions): + * semantic/find.el (semantic-brute-find-tag-by-position): + * semantic/ede-grammar.el (project-compile-target): + (ede-proj-makefile-insert-variables): + * semantic/debug.el (semantic-debug-set-parser-location): + (semantic-debug-set-source-location, semantic-debug-interface-layout) + (semantic-debug-mode, semantic-debug): + * semantic/db.el (semanticdb-needs-refresh-p): + * semantic/db-typecache.el (semanticdb-typecache-refresh-for-buffer): + * semantic/db-javascript.el (semanticdb-equivalent-mode): + * semantic/db-find.el (semanticdb-find-log-new-search) + (semanticdb-find-translate-path-includes--internal) + (semanticdb-reset-log, semanticdb-find-log-activity): + * semantic/db-file.el (object-write): + * semantic/db-el.el (semanticdb-equivalent-mode): + * semantic/db-ebrowse.el (semanticdb-ebrowse-C-file-p) + (semanticdb-create-ebrowse-database): + * semantic/db-debug.el (semanticdb-table-sanity-check): + * semantic/complete.el (semantic-displayor-focus-request) + (semantic-collector-calculate-completions-raw) + (semantic-complete-read-tag-analyzer): + * semantic/analyze.el (semantic-analyze-pulse): + * ede/util.el (ede-update-version-in-source): + * ede/proj.el (project-delete-target): + * ede/proj-elisp.el (ede-update-version-in-source) + (ede-proj-flush-autoconf): + * ede/pconf.el (ede-proj-configure-synchronize) + (ede-proj-configure-synchronize): + * ede/locate.el (ede-locate-file-in-project-impl): + * ede/linux.el (ede-linux-version): + * ede/emacs.el (ede-emacs-version): + * ede/dired.el (ede-dired-add-to-target): + * ede.el (ede-buffer-header-file, ede-find-target) + (ede-buffer-documentation-files, ede-project-buffers, ede-set) + (ede-target-buffers, ede-buffers, ede-make-project-local-variable): + * cedet-idutils.el (cedet-idutils-fnid-call): + (cedet-idutils-lid-call, cedet-idutils-expand-filename) + (cedet-idutils-version-check): + * cedet-global.el (cedet-gnu-global-call): + (cedet-gnu-global-expand-filename, cedet-gnu-global-root) + (cedet-gnu-global-version-check, cedet-gnu-global-scan-hits): + * cedet-cscope.el (cedet-cscope-call) + (cedet-cscope-expand-filename, cedet-cscope-version-check): + Use with-current-buffer. + * ede.el (ede-make-project-local-variable) + (ede-set-project-variables, ede-set): Use dolist. + +2009-10-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * mode-local.el (make-obsolete-overload): Add `when' argument. + (overload-docstring-extension): Use that info. + * semantic/fw.el (semantic-alias-obsolete): Pass the `when' info. + * semantic/idle.el (semantic-eldoc-current-symbol-info): + * semantic/tag-ls.el (semantic-nonterminal-protection) + (semantic-nonterminal-abstract, semantic-nonterminal-leaf) + (semantic-nonterminal-full-name): Add the new `when' info. + * semantic/decorate/mode.el (semantic/decorate): Require CL for + `assert'. + +2009-10-25 Stefan Monnier <monnier@iro.umontreal.ca> + + * semantic/fw.el (semantic-alias-obsolete) + (semantic-varalias-obsolete): Make the `when' arg mandatory. + (define-mode-overload-implementation): + * semantic/decorate/mode.el (semantic-decorate-pending-decoration-hooks): + * semantic/wisent.el (wisent-lex-make-token-table): + * semantic/util.el (semantic-file-token-stream) + (semantic-something-to-stream): + * semantic/tag.el (semantic-tag-make-assoc-list) + (semantic-expand-nonterminal): + * semantic/tag-file.el (semantic-find-nonterminal) + (semantic-find-dependency, semantic-find-nonterminal) + (semantic-find-dependency): + * semantic/lex.el (semantic-flex-start, semantic-flex-end) + (semantic-flex-text, semantic-flex-make-keyword-table) + (semantic-flex-keyword-p, semantic-flex-keyword-put) + (semantic-flex-keyword-get, semantic-flex-map-keywords) + (semantic-flex-keywords, semantic-flex-buffer, semantic-flex-list): + * semantic/java.el (semantic-java-prototype-nonterminal): + * semantic/idle.el (semantic-before-idle-scheduler-reparse-hooks) + (semantic-after-idle-scheduler-reparse-hooks): + * semantic/edit.el (semantic-edits-incremental-reparse-failed-hooks): + * semantic/db-mode.el (semanticdb-mode-hooks): + * semantic.el (semantic-toplevel-bovine-table) + (semantic-toplevel-bovine-cache) + (semantic-before-toplevel-bovination-hook, semantic-init-hooks) + (semantic-init-mode-hooks, semantic-init-db-hooks) + (semantic-bovination-working-type): Provide the `when' arg. + +2009-10-24 Chong Yidong <cyd@stupidchicken.com> + + * semantic/util.el (semantic-recursive-find-nonterminal-by-name): + * semantic/tag.el (semantic-token-type-parent): Add WHEN + argument to make-obsolete. + + * semantic/fw.el (semantic-alias-obsolete) + (semantic-varalias-obsolete): Add optional WHEN argument. + +2009-10-21 Eric Ludlam <zappo@gnu.org> + + * semantic/bovine/c.el (semantic-c-debug-mode-init) + (semantic-c-debug-mode-init-pch): New functions. + (semantic-c-debug-mode-init-last-mode): New var. + (semantic-c-parse-lexical-token): Use them. + + * semantic/lex-spp.el (semantic-lex-spp-anlyzer-do-replace): + When extracting the argument list, limit only by point-max. + +2009-10-17 Chong Yidong <cyd@stupidchicken.com> + + * srecode/srt.el: + * srecode/compile.el: + * semantic/mru-bookmark.el: + * semantic/debug.el: + * semantic/complete.el: + * semantic/analyze.el: Require CL when compiling. + +2009-10-17 Eric Ludlam <zappo@gnu.org> + + * semantic/scope.el + (semantic-analyze-scoped-inherited-tag-map): Wrap calculation of + tmpscope so that the regular scope will continue to work. + + * semantic/idle.el (semantic-idle-tag-highlight): + Use semantic-idle-summary-highlight-face as the highlighting. + + * emacs-lisp/eieio-base.el (eieio-persistent-save): If buffer + contains multibyte characters, choose first applicable coding + system automatically. + + * ede/project-am.el (project-run-target): New method. + (project-run-target): New method. + + * ede.el (ede-target): Add run target menu item. + (ede-project, ede-minor-keymap): Add ede-run-target binding. + (ede-run-target): New function. + (ede-target::project-run-target): New method. + + * ede/proj.el (project-run-target): New method. + + * ede/proj-shared.el (ede-gcc-libtool-shared-compiler) + (ede-g++-libtool-shared-compiler): Remove SHELL. Remove COMMANDS. + Add :rules. + (ede-proj-target-makefile-shared-object): Only libtool compilers + now available. Add linkers for libtool. + (ede-cc-linker-libtool, ede-g++-linker-libtool): New. + (ede-proj-makefile-target-name): Always use .la extension. + + * ede/proj-prog.el (project-run-target): New method. + + * ede/proj-obj.el (ede-cc-linker): Rename from ede-gcc-linker. + (ede-g++-linker): Change Change link lines. + + * ede/pmake.el (ede-pmake-insert-variable-shared): + When searching for old variables, go to the end of the buffer and + search backward from there. + (ede-proj-makefile-automake-insert-subdirs) + (ede-proj-makefile-automake-insert-extradist): New methods. + (ede-proj-makefile-create): Use them. + + * ede/pconf.el (ede-proj-configure-test-required-file): + Force FILE to expand to the current target. Use file-exists-p to + check that it exists. + + * ede/linux.el (ede-linux-version): Don't call "head". + (ede-linux-load): Wrap dir in file-name-as-directory. + Set :version slot. + + * ede/files.el (ede-get-locator-object): When enabling + locate, do so on "top". + + * ede/emacs.el (ede-emacs-file-existing): Wrap "dir" in + file-name-as-directory during compare. + (ede-emacs-version): Return Emacs/XEmacs differentiator. + Get version number from different places. Don't call egrep. + (ede-emacs-load): Set :version slot. Call file-name-as-directory + to set the directory. + + * ede/shell.el: New file. + + * inversion.el (inversion-decoders): Allow for stray . in + alpha/beta variants. + +2009-10-17 Glenn Morris <rgm@gnu.org> + + * semantic/grammar.el (semantic-grammar--lex-delim-spec): + All errors should have messages. + +2009-10-10 Sascha Wilde <wilde@sha-bang.de> + + * ede/proj-shared.el (ede-proj-makefile-target-name): + Use .la for Automake. + +2009-10-09 Chong Yidong <cyd@stupidchicken.com> + + * ede/pconf.el (ede-proj-configure-synchronize): + Use "autoreconf -i". Suggested by Andreas Schwab. + +2009-10-08 Chong Yidong <cyd@stupidchicken.com> + + * ede/proj.el (project-make-dist, project-compile-project): + Fix filename test. + (ede-proj-dist-makefile): Use expand-file-name instead of concat + to expand file names. + +2009-10-08 Chong Yidong <cyd@stupidchicken.com> + + * ede/proj-obj.el (ede-gcc-linker): New var. + (ede-proj-target-makefile-objectcode): Use it. + + * ede/source.el (ede-want-any-source-files-p) + (ede-want-any-auxiliary-files-p, ede-want-any-files-p): + Return search result. This error was introduced while merging. + +2009-10-04 Chong Yidong <cyd@stupidchicken.com> + + * semantic.el (semantic-new-buffer-setup-functions): New option. + (semantic-new-buffer-fcn): Call parser setup functions here. + (semantic-mode): Don't call parser setup functions here, it's done + in semantic-new-buffer-fcn now. + (semantic-mode): Parse all existing buffers when enabled. + + * srecode/compile.el (srecode-compile-file): + Call semantic-new-buffer-fcn if the buffer has not been parsed. + +2009-10-04 Chong Yidong <cyd@stupidchicken.com> + + * ede/pmake.el (ede-pmake-insert-variable-once): Delete. + + * ede/proj-comp.el: Don't require ede/pmake at toplevel. + (proj-comp-insert-variable-once): New macro, renamed from + ede-pmake-insert-variable-once in ede/pmake.edl. + (ede-proj-makefile-insert-variables): Use it. + +2009-10-04 Juanma Barranquero <lekktu@gmail.com> + + * ede/makefile-edit.el (makefile-beginning-of-command) + (makefile-end-of-command): + * srecode/srt-mode.el (semantic-beginning-of-context) + (semantic-end-of-context): Fix previous change. Doc fixes. + +2009-10-04 Juanma Barranquero <lekktu@gmail.com> + + * ede/makefile-edit.el (makefile-beginning-of-command) + (makefile-end-of-command): + * semantic/lex.el (semantic-lex-token): + * semantic/analyze/fcn.el + (semantic-analyze-dereference-metatype-1): + * semantic/bovine/c.el (semantic-lex-cpp-define) + (semantic-lex-cpp-undef): + * semantic/wisent/wisent.el (wisent-skip-block): + * srecode/srt-mode.el (semantic-beginning-of-context) + (semantic-end-of-context): Fix typos in docstrings. + +2009-10-04 Chong Yidong <cyd@stupidchicken.com> + + * ede.el (ede-project-placeholder-cache-file): + * semantic/db-file.el (semanticdb-default-save-directory): + * srecode/map.el (srecode-map-save-file): + Use locate-user-emacs-file. Suggested by Juanma Barranquero. + +2009-10-03 Chong Yidong <cyd@stupidchicken.com> + + * srecode/insert.el: Require srecode/args. + + * srecode/args.el: Require srecode/dictionary instead of + srecode/insert. + + * srecode/srt-mode.el (srecode-template-mode): Doc fix. + + * files.el (auto-mode-alist): Add .srt and Project.ede. + + * semantic.el (semantic-mode): + Handle srecode-template-mode-hook as well. + (semantic-mode): Use js-mode-hook for Javascript hook. + + * srecode/template.el: Remove hook variable. + + * ede/proj-comp.el: Require ede/pmake when compiling. + + * ede.el (ede-target-forms-menu): Don't enable if no + projects exist. + (ede-project-placeholder-cache-file): Default to a file in + user-emacs-directory. + + * srecode/map.el (srecode-map-base-template-dir): Look for + templates in data-directory. + (srecode-map-save-file): Default to a file in user-emacs-directory. + + * ede/srecode.el (ede-srecode-setup): Use default templates + directory. + +2009-09-30 Eric Ludlam <zappo@gnu.org> + + * semantic/util-modes.el (semantic-highlight-func-mode): + Doc fix. + + * ede/proj-comp.el (ede-proj-makefile-insert-variables): + Only insert each variable once. + + * ede/pmake.el (ede-pmake-insert-variable-once): New macro. + (ede-pmake-insert-variable-shared): Use it. + + * ede/cpp-root.el (ede-preprocessor-map): Do not deref table + for lexical table iff table is nil. + +2009-10-01 Glenn Morris <rgm@gnu.org> + + * semantic/bovine/gcc.el + (semantic-c-reset-preprocessor-symbol-map): Fix declaration. + (semantic-gcc-get-include-paths, semantic-gcc-setup-data): Doc fixes. + +2009-10-03 Glenn Morris <rgm@gnu.org> + + * semantic/db-find.el (data-debug-insert-tag-list): Comment out + declaration, currently false. + +2009-10-01 Glenn Morris <rgm@gnu.org> + + * cedet-files.el (cedet-directory-name-to-file-name): + * cedet-idutils.el (cedet-idutils-search) + (cedet-idutils-expand-filename, cedet-idutils-support-for-directory) + (cedet-idutils-version-check): + * cedet.el (cedet-version): + * data-debug.el (data-debug-insert-overlay-button) + (data-debug-insert-overlay-list-button) + (data-debug-insert-buffer-button) + (data-debug-insert-buffer-list-button) + (data-debug-insert-process-button, data-debug-insert-ring-button) + (data-debug-insert-widget, data-debug-insert-stuff-list-button) + (data-debug-insert-stuff-vector-button) + (data-debug-insert-symbol-button, data-debug-insert-string) + (data-debug-insert-number, data-debug-insert-lambda-expression) + (data-debug-insert-nil, data-debug-insert-simple-thing) + (data-debug-insert-custom, data-debug-edebug-expr): + * ede.el (ede-auto-add-method, ede-project-class-files) + (global-ede-mode-map, ede-new, ede-debug-target) + (ede-customize-current-target, ede-buffers, ede-map-buffers, ede-set): + * semantic.el (semantic-minimum-working-buffer-size) + (semantic-fetch-tags, semantic-submode-list) + (semantic-default-submodes): + * ede/source.el (ede-source-match): + * ede/project-am.el (project-am-type-alist, project-add-file) + (project-am-package-info): + * ede/proj.el (ede-proj-target, project-new-target): + * ede/proj-elisp.el (ede-proj-tweak-autoconf): + * ede/proj-comp.el (ede-current-build-list): + * ede/makefile-edit.el (makefile-move-to-macro): + * ede/files.el (ede-toplevel-project-or-nil): + * ede/cpp-root.el (initialize-instance): + * ede/autoconf-edit.el (autoconf-find-last-macro) + (autoconf-parameter-strip, autoconf-insert-new-macro): + * semantic/wisent.el (wisent-lex-eoi): + * semantic/util-modes.el (global-semantic-show-parser-state-mode) + (semantic-show-parser-state-mode): + * semantic/texi.el (semantic-texi-environment-regexp): + * semantic/tag.el (semantic-tag-new-variable) + (semantic-tag-class, semantic-tag-new-variable, semantic-tag-copy) + (semantic--tag-deep-copy-attributes, semantic--tag-deep-copy-value) + (semantic--tag-deep-copy-tag-list) + (semantic-tag-components-with-overlays-default): + * semantic/symref.el (semantic-symref-find-text): + * semantic/senator.el (senator-yank-tag) + (senator-transpose-tags-up): + * semantic/scope.el (semantic-analyze-scoped-tags-default) + (semantic-analyze-scoped-inherited-tags, semantic-scope-find): + * semantic/sb.el (semantic-sb-autoexpand-length): + * semantic/lex.el (semantic-lex-comment-regex) + (semantic-lex-maximum-depth, define-lex, semantic-lex-token) + (semantic-lex-unterminated-syntax-protection, define-lex-analyzer): + * semantic/lex-spp.el + (semantic-lex-spp-dynamic-macro-symbol-obarray-stack) + (semantic-lex-spp-symbol, semantic-lex-spp-one-token-to-txt): + * semantic/idle.el + (semantic-idle-summary-current-symbol-info-brutish) + (semantic-idle-summary-current-symbol-info-default): + * semantic/grammar.el (semantic-grammar-recreate-package) + (semantic--grammar-macro-compl-dict): + * semantic/grammar-wy.el (semantic-grammar-wy--parse-table): + * semantic/format.el (semantic-format-tag-custom-list) + (semantic-format-tag-canonical-name-default): + * semantic/find.el (semantic-find-tag-by-overlay-in-region) + (semantic-find-tags-for-completion) + (semantic-find-tags-by-scope-protection-default) + (semantic-deep-find-tags-for-completion): + * semantic/edit.el + (semantic-edits-incremental-reparse-failed-hook) + (semantic-edits-verbose-flag, semantic-edits-assert-valid-region) + (semantic-edits-splice-remove, semantic-edits-splice-replace): + * semantic/doc.el (semantic-documentation-comment-preceeding-tag): + * semantic/dep.el (semantic-dependency-include-path): + * semantic/db.el (semanticdb-default-find-index-class) + (semanticdb-match-any-mode, semanticdb-with-match-any-mode) + (semanticdb-project-roots): + * semantic/db-find.el (semanticdb-implied-include-tags) + (semanticdb-find-adebug-insert-scanned-tag-cons) + (semanticdb-find-log-buffer-name, semanticdb-find-result-mapc) + (semanticdb-brute-deep-find-tags-for-completion): + * semantic/db-ebrowse.el (semanticdb-ebrowse-add-tree-to-table): + * semantic/ctxt.el (semantic-beginning-of-context-default) + (semantic-end-of-context-default) + (semantic-ctxt-current-function-default) + (semantic-ctxt-scoped-types-default): + * semantic/complete.el (semantic-complete-read-tag-engine) + (semantic-complete-inline-tag-engine) + (semantic-complete-inline-custom-type) + (semantic-complete-read-tag-analyzer): + * semantic/chart.el (semantic-chart-tags-by-class) + (semantic-chart-database-size): + * semantic/analyze.el (semantic-analyze-current-symbol) + (semantic-analyze-current-context): + * semantic/symref/list.el (semantic-symref) + (semantic-symref-hide-buffer, semantic-symref-symbol): + * semantic/symref/grep.el (semantic-symref-grep-use-template): + * semantic/symref/filter.el (semantic-symref-hits-in-region): + * semantic/bovine/el.el (semantic-elisp-form-to-doc-string): + * semantic/bovine/c.el (semantic-lex-c-preprocessor-symbol-map) + (semantic-c-parse-token-hack-depth, semantic-c--template-name-1) + (semantic-c-dereference-template): + * semantic/analyze/refs.el (semantic--analyze-refs-full-lookup) + (semantic--analyze-refs-full-lookup-with-parents) + (semantic--analyze-refs-full-lookup-simple): + * semantic/analyze/complete.el + (semantic-analyze-possible-completions): + * srecode/table.el (srecode-mode-table-new): + * srecode/srt.el (srecode-read-variable-name): + * srecode/srt-mode.el (srecode-macro-help, srecode-in-macro-p): + * srecode/semantic.el (srecode-semantic-handle-:tag) + (srecode-semantic-handle-:tagtype, srecode-semantic-insert-tag): + * srecode/map.el (srecode-current-map): + * srecode/insert.el (srecode-insert) + (srecode-insert-variable-secondname-handler, srecode-insert-method) + (srecode-template-inserter-point-override) + (srecode-insert-include-lookup): + * srecode/getset.el (srecode-auto-choose-class): + * srecode/extract.el (srecode-inserter-extract): + * srecode/document.el + (srecode-document-autocomment-return-last-alist) + (srecode-document-autocomment-param-type-alist) + (srecode-document-insert-function-comment) + (srecode-document-insert-variable-one-line-comment) + (srecode-document-function-name-comment): + * srecode/dictionary.el (srecode-create-dictionary) + (srecode-compound-toString): + * srecode/compile.el (srecode-flush-active-templates): + * srecode/args.el (srecode-semantic-handle-:blank): + Doc/message fixes. + +2009-10-01 Juanma Barranquero <lekktu@gmail.com> + + * semantic/wisent/javat-wy.el + (wisent-java-tags-wy--keyword-table): Use \000 instead of literal ^@. + +2009-09-30 Juanma Barranquero <lekktu@gmail.com> + + * srecode/expandproto.el: Fix provide statement. + +2009-09-30 Eric Ludlam <zappo@gnu.org> + + * emacs-lisp/eieio.el (boolean-p): Delete. + +2009-09-30 Sascha Wilde <wilde@sha-bang.de> + + * ede/srecode.el: Fix provide statement. + +2009-09-30 Glenn Morris <rgm@gnu.org> + + * ede/proj.el (ede-proj-target-makefile-miscelaneous): + * ede/proj-aux.el (ede-aux-source): + * ede/proj-misc.el (ede-proj-target-makefile-miscelaneous) + (ede-misc-source): + * semantic/mru-bookmark.el (semantic-mrub-completing-read) + (semantic-mrub-switch-tags): Fix doc typos. + + * semantic/db-global.el (data-debug-new-buffer) + (data-debug-insert-thing): Remove unneeded declarations (one broken). + (semanticdb-enable-gnu-global-databases): Fix prompt typo. + + * semantic/analyze/fcn.el (semantic-scope-find): Fix declaration. + + * semantic/bovine/gcc.el (semantic-gcc-setup): Replace runtime + use of CL function `remove-if-not'. + +2009-09-29 Glenn Morris <rgm@gnu.org> + + * semantic/symref/idutils.el: + * semantic/symref/list.el: Relicense under GPLv3+. + + * ede/srecode.el (srecode-resolve-arguments): Fix declaration. + + * semantic/complete.el (semantic-displayor-focus-abstract-child-p): + * semantic/tag-file.el (semanticdb-table-child-p): + * srecode/compile.el (srecode-template-inserter-newline-child-p): + Mark declarations not understood by check-declare. + +2009-09-28 Eric Ludlam <zappo@gnu.org> + + CEDET (development tools) package merged. + + * *.el: + * ede/*.el: + * semantic/*.el: + * srecode/*.el: New files. + +2009-09-28 Eric Ludlam <zappo@gnu.org> + + * emacs-lisp/chart.el: + * emacs-lisp/eieio-base.el: + * emacs-lisp/eieio-comp.el: + * emacs-lisp/eieio-custom.el: + * emacs-lisp/eieio-datadebug.el: + * emacs-lisp/eieio-opt.el: + * emacs-lisp/eieio-speedbar.el: + * emacs-lisp/eieio.el: New files. + + * cedet-cscope.el: + * cedet-files.el: + * cedet-global.el: + * cedet-idutils.el: + * data-debug.el: + * inversion.el: + * mode-local.el: + * pulse.el: New files.
--- a/lisp/cedet/cedet-cscope.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/cedet-cscope.el Mon Sep 27 14:42:43 2010 +0900 @@ -73,6 +73,12 @@ ) (cedet-cscope-call (list "-d" "-L" idx searchtext)))) +(defun cedet-cscope-create (flags) + "Create a CScope database at the current directory. +FLAGS are additional flags to pass to cscope beyond the +options -cR." + (cedet-cscope-call (append (list "-cR") flags))) + (defun cedet-cscope-call (flags) "Call CScope with the list of FLAGS." (let ((b (get-buffer-create "*CEDET CScope*")) @@ -113,13 +119,19 @@ If DIR is not supplied, use the current default directory. This works by running cscope on a bogus symbol, and looking for the error code." + (interactive "DDirectory: ") (save-excursion (let ((default-directory (or dir default-directory))) (set-buffer (cedet-cscope-call (list "-d" "-L" "-7" "moose"))) (goto-char (point-min)) - (if (looking-at "[^ \n]*cscope: ") - nil - t)))) + (let ((ans (looking-at "[^ \n]*cscope: "))) + (if (called-interactively-p 'interactive) + (if ans + (message "No support for CScope in %s" default-directory) + (message "CScope is supported in %s" default-directory)) + (if ans + nil + t)))))) (defun cedet-cscope-version-check (&optional noerror) "Check the version of the installed CScope command. @@ -151,6 +163,14 @@ (message "CScope %s - Good enough for CEDET." rev)) t))))) +(defun cedet-cscope-create/update-database (&optional dir) + "Create a CScope database in DIR. +CScope will automatically choose incremental rebuild if +there is already a database in DIR." + (interactive "DDirectory: ") + (let ((default-directory dir)) + (cedet-cscope-create nil))) + (provide 'cedet-cscope) ;; arch-tag: 9973f1ad-f13b-4399-bc67-7f488478d78d
--- a/lisp/cedet/cedet-global.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/cedet-global.el Mon Sep 27 14:42:43 2010 +0900 @@ -34,6 +34,12 @@ :type 'string :group 'cedet) +(defcustom cedet-global-gtags-command "gtags" + "Command name for the GNU Global gtags executable. +GTAGS is used to create the tags table queried by the 'global' command." + :type 'string + :group 'cedet) + ;;; Code: (defun cedet-gnu-global-search (searchtext texttype type scope) "Perform a search with GNU Global, return the created buffer. @@ -76,6 +82,19 @@ flags) b)) +(defun cedet-gnu-global-gtags-call (flags) + "Create GNU Global TAGS using gtags with FLAGS." + (let ((b (get-buffer-create "*CEDET Global gtags*")) + (cd default-directory) + ) + (with-current-buffer b + (setq default-directory cd) + (erase-buffer)) + (apply 'call-process cedet-global-gtags-command + nil b nil + flags) + b)) + (defun cedet-gnu-global-expand-filename (filename) "Expand the FILENAME with GNU Global. Return a fully qualified filename." @@ -153,6 +172,18 @@ ;; Return the results (nreverse hits)))) +(defun cedet-gnu-global-create/update-database (&optional dir) + "Create a GNU Global database in DIR. +If a database already exists, then just update it." + (interactive "DDirectory: ") + (let ((root (cedet-gnu-global-root dir))) + (if root (setq dir root)) + (let ((default-directory dir)) + (cedet-gnu-global-gtags-call + (when root + '("-i");; Incremental update flag. + ))))) + (provide 'cedet-global) ;; arch-tag: 0d0d3ac2-91ef-4820-bb2b-1d59ccf38392
--- a/lisp/cedet/cedet-idutils.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/cedet-idutils.el Mon Sep 27 14:42:43 2010 +0900 @@ -44,6 +44,11 @@ :type 'string :group 'cedet) +(defcustom cedet-idutils-make-command "mkid" + "Command name for the ID Utils executable for creating token databases." + :type 'string + :group 'cedet) + (defun cedet-idutils-search (searchtext texttype type scope) "Perform a search with ID Utils, return the created buffer. SEARCHTEXT is text to find. @@ -105,6 +110,20 @@ flags) b)) +(defun cedet-idutils-mkid-call (flags) + "Call ID Utils mkid with the list of FLAGS. +Return the created buffer with with program output." + (let ((b (get-buffer-create "*CEDET mkid*")) + (cd default-directory) + ) + (with-current-buffer b + (setq default-directory cd) + (erase-buffer)) + (apply 'call-process cedet-idutils-make-command + nil b nil + flags) + b)) + ;;; UTIL CALLS ;; (defun cedet-idutils-expand-filename (filename) @@ -172,6 +191,12 @@ (message "ID Utils %s - Good enough for CEDET." rev)) t))))) +(defun cedet-idutils-create/update-database (&optional dir) + "Create an IDUtils database in DIR. +IDUtils must start from scratch when updating a database." + (interactive "DDirectory: ") + (let ((default-directory dir)) + (cedet-idutils-mkid-call nil))) (provide 'cedet-idutils)
--- a/lisp/cedet/cedet.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/cedet.el Mon Sep 27 14:42:43 2010 +0900 @@ -36,19 +36,19 @@ (declare-function inversion-find-version "inversion") -(defconst cedet-version "1.0pre7" +(defconst cedet-version "1.0" "Current version of CEDET.") (defconst cedet-packages `( ;;PACKAGE MIN-VERSION (cedet ,cedet-version) - (eieio "1.2") - (semantic "2.0pre7") - (srecode "1.0pre7") - (ede "1.0pre7") - (speedbar "1.0.3")) - "Table of CEDET packages to install.") + (eieio "1.3") + (semantic "2.0") + (srecode "1.0") + (ede "1.0") + (speedbar "1.0")) + "Table of CEDET packages installed.") (defvar cedet-menu-map ;(make-sparse-keymap "CEDET menu") (let ((map (make-sparse-keymap "CEDET menu")))
--- a/lisp/cedet/ede.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede.el Mon Sep 27 14:42:43 2010 +0900 @@ -44,24 +44,24 @@ (require 'eieio) (require 'eieio-speedbar) (require 'ede/source) +(require 'ede/base) +(require 'ede/auto) + (load "ede/loaddefs" nil 'nomessage) +(declare-function ede-commit-project "ede/custom") (declare-function ede-convert-path "ede/files") (declare-function ede-directory-get-open-project "ede/files") (declare-function ede-directory-get-toplevel-open-project "ede/files") (declare-function ede-directory-project-p "ede/files") (declare-function ede-find-subproject-for-directory "ede/files") (declare-function ede-project-directory-remove-hash "ede/files") -(declare-function ede-project-root "ede/files") -(declare-function ede-project-root-directory "ede/files") (declare-function ede-toplevel "ede/files") (declare-function ede-toplevel-project "ede/files") (declare-function ede-up-directory "ede/files") -(declare-function data-debug-new-buffer "data-debug") -(declare-function data-debug-insert-object-slots "eieio-datadebug") (declare-function semantic-lex-make-spp-table "semantic/lex-spp") -(defconst ede-version "1.0pre7" +(defconst ede-version "1.0" "Current version of the Emacs EDE.") ;;; Code: @@ -95,314 +95,6 @@ :group 'ede :type 'sexp) ; make this be a list of options some day - -;;; Top level classes for projects and targets - -(defclass ede-project-autoload () - ((name :initarg :name - :documentation "Name of this project type") - (file :initarg :file - :documentation "The lisp file belonging to this class.") - (proj-file :initarg :proj-file - :documentation "Name of a project file of this type.") - (proj-root :initarg :proj-root - :type function - :documentation "A function symbol to call for the project root. -This function takes no arguments, and returns the current directories -root, if available. Leave blank to use the EDE directory walking -routine instead.") - (initializers :initarg :initializers - :initform nil - :documentation - "Initializers passed to the project object. -These are used so there can be multiple types of projects -associated with a single object class, based on the initilizeres used.") - (load-type :initarg :load-type - :documentation "Fn symbol used to load this project file.") - (class-sym :initarg :class-sym - :documentation "Symbol representing the project class to use.") - (new-p :initarg :new-p - :initform t - :documentation - "Non-nil if this is an option when a user creates a project.") - ) - "Class representing minimal knowledge set to run preliminary EDE functions. -When more advanced functionality is needed from a project type, that projects -type is required and the load function used.") - -(defvar ede-project-class-files - (list - (ede-project-autoload "edeproject-makefile" - :name "Make" :file 'ede/proj - :proj-file "Project.ede" - :load-type 'ede-proj-load - :class-sym 'ede-proj-project) - (ede-project-autoload "edeproject-automake" - :name "Automake" :file 'ede/proj - :proj-file "Project.ede" - :initializers '(:makefile-type Makefile.am) - :load-type 'ede-proj-load - :class-sym 'ede-proj-project) - (ede-project-autoload "automake" - :name "automake" :file 'ede/project-am - :proj-file "Makefile.am" - :load-type 'project-am-load - :class-sym 'project-am-makefile - :new-p nil) - (ede-project-autoload "cpp-root" - :name "CPP ROOT" :file 'ede/cpp-root - :proj-file 'ede-cpp-root-project-file-for-dir - :proj-root 'ede-cpp-root-project-root - :load-type 'ede-cpp-root-load - :class-sym 'ede-cpp-root - :new-p nil) - (ede-project-autoload "emacs" - :name "EMACS ROOT" :file 'ede/emacs - :proj-file "src/emacs.c" - :proj-root 'ede-emacs-project-root - :load-type 'ede-emacs-load - :class-sym 'ede-emacs-project - :new-p nil) - (ede-project-autoload "linux" - :name "LINUX ROOT" :file 'ede/linux - :proj-file "scripts/ver_linux" - :proj-root 'ede-linux-project-root - :load-type 'ede-linux-load - :class-sym 'ede-linux-project - :new-p nil) - (ede-project-autoload "simple-overlay" - :name "Simple" :file 'ede/simple - :proj-file 'ede-simple-projectfile-for-dir - :load-type 'ede-simple-load - :class-sym 'ede-simple-project)) - "List of vectors defining how to determine what type of projects exist.") - -;;; Generic project information manager objects - -(defclass ede-target (eieio-speedbar-directory-button) - ((buttonface :initform speedbar-file-face) ;override for superclass - (name :initarg :name - :type string - :custom string - :label "Name" - :group (default name) - :documentation "Name of this target.") - ;; @todo - I think this should be "dir", and not "path". - (path :initarg :path - :type string - ;:custom string - ;:label "Path to target" - ;:group (default name) - :documentation "The path to the sources of this target. -Relative to the path of the project it belongs to.") - (source :initarg :source - :initform nil - ;; I'd prefer a list of strings. - :type list - :custom (repeat (string :tag "File")) - :label "Source Files" - :group (default source) - :documentation "Source files in this target.") - (versionsource :initarg :versionsource - :initform nil - :type list - :custom (repeat (string :tag "File")) - :label "Source Files with Version String" - :group (source) - :documentation - "Source files with a version string in them. -These files are checked for a version string whenever the EDE version -of the master project is changed. When strings are found, the version -previously there is updated.") - ;; Class level slots - ;; -; (takes-compile-command :allocation :class -; :initarg :takes-compile-command -; :type boolean -; :initform nil -; :documentation -; "Non-nil if this target requires a user approved command.") - (sourcetype :allocation :class - :type list ;; list of symbols - :documentation - "A list of `ede-sourcecode' objects this class will handle. -This is used to match target objects with the compilers they can use, and -which files this object is interested in." - :accessor ede-object-sourcecode) - (keybindings :allocation :class - :initform (("D" . ede-debug-target)) - :documentation -"Keybindings specialized to this type of target." - :accessor ede-object-keybindings) - (menu :allocation :class - :initform ( [ "Debug target" ede-debug-target - (and ede-object - (obj-of-class-p ede-object ede-target)) ] - ) - [ "Run target" ede-run-target - (and ede-object - (obj-of-class-p ede-object ede-target)) ] - :documentation "Menu specialized to this type of target." - :accessor ede-object-menu) - ) - "A top level target to build.") - -(defclass ede-project-placeholder (eieio-speedbar-directory-button) - ((name :initarg :name - :initform "Untitled" - :type string - :custom string - :label "Name" - :group (default name) - :documentation "The name used when generating distribution files.") - (version :initarg :version - :initform "1.0" - :type string - :custom string - :label "Version" - :group (default name) - :documentation "The version number used when distributing files.") - (directory :type string - :initarg :directory - :documentation "Directory this project is associated with.") - (dirinode :documentation "The inode id for :directory.") - (file :type string - :initarg :file - :documentation "File name where this project is stored.") - (rootproject ; :initarg - no initarg, don't save this slot! - :initform nil - :type (or null ede-project-placeholder-child) - :documentation "Pointer to our root project.") - ) - "Placeholder object for projects not loaded into memory. -Projects placeholders will be stored in a user specific location -and querying them will cause the actual project to get loaded.") - -(defclass ede-project (ede-project-placeholder) - ((subproj :initform nil - :type list - :documentation "Sub projects controlled by this project. -For Automake based projects, each directory is treated as a project.") - (targets :initarg :targets - :type list - :custom (repeat (object :objectcreatefcn ede-new-target-custom)) - :label "Local Targets" - :group (targets) - :documentation "List of top level targets in this project.") - (locate-obj :type (or null ede-locate-base-child) - :documentation - "A locate object to use as a backup to `ede-expand-filename'.") - (tool-cache :initarg :tool-cache - :type list - :custom (repeat object) - :label "Tool: " - :group tools - :documentation "List of tool cache configurations in this project. -This allows any tool to create, manage, and persist project-specific settings.") - (mailinglist :initarg :mailinglist - :initform "" - :type string - :custom string - :label "Mailing List Address" - :group name - :documentation - "An email address where users might send email for help.") - (web-site-url :initarg :web-site-url - :initform "" - :type string - :custom string - :label "Web Site URL" - :group name - :documentation "URL to this projects web site. -This is a URL to be sent to a web site for documentation.") - (web-site-directory :initarg :web-site-directory - :initform "" - :custom string - :label "Web Page Directory" - :group name - :documentation - "A directory where web pages can be found by Emacs. -For remote locations use a path compatible with ange-ftp or EFS. -You can also use TRAMP for use with rcp & scp.") - (web-site-file :initarg :web-site-file - :initform "" - :custom string - :label "Web Page File" - :group name - :documentation - "A file which contains the home page for this project. -This file can be relative to slot `web-site-directory'. -This can be a local file, use ange-ftp, EFS, or TRAMP.") - (ftp-site :initarg :ftp-site - :initform "" - :type string - :custom string - :label "FTP site" - :group name - :documentation - "FTP site where this project's distribution can be found. -This FTP site should be in Emacs form, as needed by `ange-ftp', but can -also be of a form used by TRAMP for use with scp, or rcp.") - (ftp-upload-site :initarg :ftp-upload-site - :initform "" - :type string - :custom string - :label "FTP Upload site" - :group name - :documentation - "FTP Site to upload new distributions to. -This FTP site should be in Emacs form as needed by `ange-ftp'. -If this slot is nil, then use `ftp-site' instead.") - (configurations :initarg :configurations - :initform ("debug" "release") - :type list - :custom (repeat string) - :label "Configuration Options" - :group (settings) - :documentation "List of available configuration types. -Individual target/project types can form associations between a configuration, -and target specific elements such as build variables.") - (configuration-default :initarg :configuration-default - :initform "debug" - :custom string - :label "Current Configuration" - :group (settings) - :documentation "The default configuration.") - (local-variables :initarg :local-variables - :initform nil - :custom (repeat (cons (sexp :tag "Variable") - (sexp :tag "Value"))) - :label "Project Local Variables" - :group (settings) - :documentation "Project local variables") - (keybindings :allocation :class - :initform (("D" . ede-debug-target) - ("R" . ede-run-target)) - :documentation "Keybindings specialized to this type of target." - :accessor ede-object-keybindings) - (menu :allocation :class - :initform - ( - [ "Update Version" ede-update-version ede-object ] - [ "Version Control Status" ede-vc-project-directory ede-object ] - [ "Edit Project Homepage" ede-edit-web-page - (and ede-object (oref (ede-toplevel) web-site-file)) ] - [ "Browse Project URL" ede-web-browse-home - (and ede-object - (not (string= "" (oref (ede-toplevel) web-site-url)))) ] - "--" - [ "Rescan Project Files" ede-rescan-toplevel t ] - [ "Edit Projectfile" ede-edit-file-target - (and ede-object - (or (listp ede-object) - (not (obj-of-class-p ede-object ede-project)))) ] - ) - :documentation "Menu specialized to this type of target." - :accessor ede-object-menu) - ) - "Top level EDE project specification. -All specific project types must derive from this project." - :method-invocation-order :depth-first) ;;; Management variables @@ -431,109 +123,13 @@ If `ede-object' is nil, then commands will operate on this object.") (defvar ede-constructing nil - "Non nil when constructing a project hierarchy.") + "Non nil when constructing a project hierarchy. +If the project is being constructed from an autoload, then the +value is the autoload object being used.") (defvar ede-deep-rescan nil "Non nil means scan down a tree, otherwise rescans are top level only. Do not set this to non-nil globally. It is used internally.") - -;;; The EDE persistent cache. -;; -(defcustom ede-project-placeholder-cache-file - (locate-user-emacs-file "ede-projects.el" ".projects.ede") - "File containing the list of projects EDE has viewed." - :group 'ede - :type 'file) - -(defvar ede-project-cache-files nil - "List of project files EDE has seen before.") - -(defun ede-save-cache () - "Save a cache of EDE objects that Emacs has seen before." - (interactive) - (let ((p ede-projects) - (c ede-project-cache-files) - (recentf-exclude '(ignore)) - ) - (condition-case nil - (progn - (set-buffer (find-file-noselect ede-project-placeholder-cache-file t)) - (erase-buffer) - (insert ";; EDE project cache file. -;; This contains a list of projects you have visited.\n(") - (while p - (when (and (car p) (ede-project-p p)) - (let ((f (oref (car p) file))) - (when (file-exists-p f) - (insert "\n \"" f "\"")))) - (setq p (cdr p))) - (while c - (insert "\n \"" (car c) "\"") - (setq c (cdr c))) - (insert "\n)\n") - (condition-case nil - (save-buffer 0) - (error - (message "File %s could not be saved." - ede-project-placeholder-cache-file))) - (kill-buffer (current-buffer)) - ) - (error - (message "File %s could not be read." - ede-project-placeholder-cache-file)) - - ))) - -(defun ede-load-cache () - "Load the cache of EDE projects." - (save-excursion - (let ((cachebuffer nil)) - (condition-case nil - (progn - (setq cachebuffer - (find-file-noselect ede-project-placeholder-cache-file t)) - (set-buffer cachebuffer) - (goto-char (point-min)) - (let ((c (read (current-buffer))) - (new nil) - (p ede-projects)) - ;; Remove loaded projects from the cache. - (while p - (setq c (delete (oref (car p) file) c)) - (setq p (cdr p))) - ;; Remove projects that aren't on the filesystem - ;; anymore. - (while c - (when (file-exists-p (car c)) - (setq new (cons (car c) new))) - (setq c (cdr c))) - ;; Save it - (setq ede-project-cache-files (nreverse new)))) - (error nil)) - (when cachebuffer (kill-buffer cachebuffer)) - ))) - -;;; Important macros for doing commands. -;; -(defmacro ede-with-projectfile (obj &rest forms) - "For the project in which OBJ resides, execute FORMS." - (list 'save-window-excursion - (list 'let* (list - (list 'pf - (list 'if (list 'obj-of-class-p - obj 'ede-target) - ;; @todo -I think I can change - ;; this to not need ede-load-project-file - ;; but I'm not sure how to test well. - (list 'ede-load-project-file - (list 'oref obj 'path)) - obj)) - '(dbka (get-file-buffer (oref pf file)))) - '(if (not dbka) (find-file (oref pf file)) - (switch-to-buffer dbka)) - (cons 'progn forms) - '(if (not dbka) (kill-buffer (current-buffer)))))) -(put 'ede-with-projectfile 'lisp-indent-function 1) ;;; Prompting @@ -611,6 +207,18 @@ :enable ede-object :visible global-ede-mode)) +(defun ede-buffer-belongs-to-target-p () + "Return non-nil if this buffer belongs to at least one target." + (let ((obj ede-object)) + (if (consp obj) + (setq obj (car obj))) + (and obj (obj-of-class-p obj ede-target)))) + +(defun ede-buffer-belongs-to-project-p () + "Return non-nil if this buffer belongs to at least one target." + (if (or (null ede-object) (consp ede-object)) nil + (obj-of-class-p ede-object ede-project))) + (defun ede-menu-obj-of-class-p (class) "Return non-nil if some member of `ede-object' is a child of CLASS." (if (listp ede-object) @@ -672,9 +280,7 @@ (and (ede-current-project) (oref (ede-current-project) targets)) ] [ "Remove File" ede-remove-file - (and ede-object - (or (listp ede-object) - (not (obj-of-class-p ede-object ede-project)))) ] + (ede-buffer-belongs-to-project-p) ] "-") (if (not obj) nil @@ -718,7 +324,7 @@ (let* ((obj (ede-current-project)) targ) (when obj - (setq targ (when (slot-boundp obj 'targets) + (setq targ (when (and obj (slot-boundp obj 'targets)) (oref obj targets))) ;; Make custom menus for everything here. (append (list @@ -804,31 +410,49 @@ (eq major-mode 'vc-dired-mode)) (ede-dired-minor-mode (if ede-minor-mode 1 -1))) (ede-minor-mode - (if (and (not ede-constructing) - (ede-directory-project-p default-directory t)) - (let* ((ROOT nil) - (proj (ede-directory-get-open-project default-directory - 'ROOT))) - (when (not proj) - ;; @todo - this could be wasteful. - (setq proj (ede-load-project-file default-directory 'ROOT))) - (setq ede-object-project proj) - (setq ede-object-root-project - (or ROOT (ede-project-root proj))) - (setq ede-object (ede-buffer-object)) - (if (and (not ede-object) ede-object-project) - (ede-auto-add-to-target)) - (ede-apply-target-options)) + (if (not ede-constructing) + (ede-initialize-state-current-buffer) ;; If we fail to have a project here, turn it back off. (ede-minor-mode -1))))) +(defun ede-initialize-state-current-buffer () + "Initialize the current buffer's state for EDE. +Sets buffer local variables for EDE." + (let* ((ROOT nil) + (proj (ede-directory-get-open-project default-directory + 'ROOT))) + (when (or proj ROOT + (ede-directory-project-p default-directory t)) + + (when (not proj) + ;; @todo - this could be wasteful. + (setq proj (ede-load-project-file default-directory 'ROOT))) + + (setq ede-object (ede-buffer-object (current-buffer) + 'ede-object-project)) + + (setq ede-object-root-project + (or ROOT (ede-project-root ede-object-project))) + + (if (and (not ede-object) ede-object-project) + (ede-auto-add-to-target)) + + (ede-apply-target-options)))) + (defun ede-reset-all-buffers (onoff) "Reset all the buffers due to change in EDE. ONOFF indicates enabling or disabling the mode." (let ((b (buffer-list))) (while b (when (buffer-file-name (car b)) - (ede-buffer-object (car b)) + (with-current-buffer (car b) + ;; Reset all state variables + (setq ede-object nil + ede-object-project nil + ede-object-root-project nil) + ;; Now re-initialize this buffer. + (ede-initialize-state-current-buffer) + ) ) (setq b (cdr b))))) @@ -967,6 +591,7 @@ r) ) nil t))) + (require 'ede/custom) ;; Make sure we have a valid directory (when (not (file-exists-p default-directory)) (error "Cannot create project in non-existent directory %s" default-directory)) @@ -1014,20 +639,6 @@ "Add into PROJ-A, the subproject PROJ-B." (oset proj-a subproj (cons proj-b (oref proj-a subproj)))) -(defmethod ede-subproject-relative-path ((proj ede-project) &optional parent-in) - "Get a path name for PROJ which is relative to the parent project. -If PARENT is specified, then be relative to the PARENT project. -Specifying PARENT is useful for sub-sub projects relative to the root project." - (let* ((parent (or parent-in (ede-parent-project proj))) - (dir (file-name-directory (oref proj file)))) - (if (and parent (not (eq parent proj))) - (file-relative-name dir (file-name-directory (oref parent file))) - ""))) - -(defmethod ede-subproject-p ((proj ede-project)) - "Return non-nil if PROJ is a sub project." - (ede-parent-project proj)) - (defun ede-invoke-method (sym &rest args) "Invoke method SYM on the current buffer's project object. ARGS are additional arguments to pass to method sym." @@ -1162,175 +773,9 @@ (defun ede-make-dist () "Create a distribution from the current project." (interactive) - (let ((ede-object (ede-current-project))) + (let ((ede-object (ede-toplevel))) (ede-invoke-method 'project-make-dist))) -;;; Customization -;; -;; Routines for customizing projects and targets. - -(defvar eieio-ede-old-variables nil - "The old variables for a project.") - -(defalias 'customize-project 'ede-customize-project) -(defun ede-customize-project (&optional group) - "Edit fields of the current project through EIEIO & Custom. -Optional GROUP specifies the subgroup of slots to customize." - (interactive "P") - (require 'eieio-custom) - (let* ((ov (oref (ede-current-project) local-variables)) - (cp (ede-current-project)) - (group (if group (eieio-read-customization-group cp)))) - (eieio-customize-object cp group) - (make-local-variable 'eieio-ede-old-variables) - (setq eieio-ede-old-variables ov))) - -(defalias 'customize-target 'ede-customize-current-target) -(defun ede-customize-current-target(&optional group) - "Edit fields of the current target through EIEIO & Custom. -Optional argument OBJ is the target object to customize. -Optional argument GROUP is the slot group to display." - (interactive "P") - (require 'eieio-custom) - (if (not (obj-of-class-p ede-object ede-target)) - (error "Current file is not part of a target")) - (let ((group (if group (eieio-read-customization-group ede-object)))) - (ede-customize-target ede-object group))) - -(defun ede-customize-target (obj group) - "Edit fields of the current target through EIEIO & Custom. -Optional argument OBJ is the target object to customize. -Optional argument GROUP is the slot group to display." - (require 'eieio-custom) - (if (and obj (not (obj-of-class-p obj ede-target))) - (error "No logical target to customize")) - (eieio-customize-object obj (or group 'default))) -;;; Target Sorting -;; -;; Target order can be important, but custom doesn't support a way -;; to resort items in a list. This function by David Engster allows -;; targets to be re-arranged. - -(defvar ede-project-sort-targets-order nil - "Variable for tracking target order in `ede-project-sort-targets'.") - -(defun ede-project-sort-targets () - "Create a custom-like buffer for sorting targets of current project." - (interactive) - (let ((proj (ede-current-project)) - (count 1) - current order) - (switch-to-buffer (get-buffer-create "*EDE sort targets*")) - (erase-buffer) - (setq ede-object-project proj) - (widget-create 'push-button - :notify (lambda (&rest ignore) - (let ((targets (oref ede-object-project targets)) - cur newtargets) - (while (setq cur (pop ede-project-sort-targets-order)) - (setq newtargets (append newtargets - (list (nth cur targets))))) - (oset ede-object-project targets newtargets)) - (ede-commit-project ede-object-project) - (kill-buffer)) - " Accept ") - (widget-insert " ") - (widget-create 'push-button - :notify (lambda (&rest ignore) - (kill-buffer)) - " Cancel ") - (widget-insert "\n\n") - (setq ede-project-sort-targets-order nil) - (mapc (lambda (x) - (add-to-ordered-list - 'ede-project-sort-targets-order - x x)) - (number-sequence 0 (1- (length (oref proj targets))))) - (ede-project-sort-targets-list) - (use-local-map widget-keymap) - (widget-setup) - (goto-char (point-min)))) - -(defun ede-project-sort-targets-list () - "Sort the target list while using `ede-project-sort-targets'." - (save-excursion - (let ((count 0) - (targets (oref ede-object-project targets)) - (inhibit-read-only t) - (inhibit-modification-hooks t)) - (goto-char (point-min)) - (forward-line 2) - (delete-region (point) (point-max)) - (while (< count (length targets)) - (if (> count 0) - (widget-create 'push-button - :notify `(lambda (&rest ignore) - (let ((cur ede-project-sort-targets-order)) - (add-to-ordered-list - 'ede-project-sort-targets-order - (nth ,count cur) - (1- ,count)) - (add-to-ordered-list - 'ede-project-sort-targets-order - (nth (1- ,count) cur) ,count)) - (ede-project-sort-targets-list)) - " Up ") - (widget-insert " ")) - (if (< count (1- (length targets))) - (widget-create 'push-button - :notify `(lambda (&rest ignore) - (let ((cur ede-project-sort-targets-order)) - (add-to-ordered-list - 'ede-project-sort-targets-order - (nth ,count cur) (1+ ,count)) - (add-to-ordered-list - 'ede-project-sort-targets-order - (nth (1+ ,count) cur) ,count)) - (ede-project-sort-targets-list)) - " Down ") - (widget-insert " ")) - (widget-insert (concat " " (number-to-string (1+ count)) ".: " - (oref (nth (nth count ede-project-sort-targets-order) - targets) name) "\n")) - (setq count (1+ count)))))) - -;;; Customization hooks -;; -;; These hooks are used when finishing up a customization. -(defmethod eieio-done-customizing ((proj ede-project)) - "Call this when a user finishes customizing PROJ." - (let ((ov eieio-ede-old-variables) - (nv (oref proj local-variables))) - (setq eieio-ede-old-variables nil) - (while ov - (if (not (assoc (car (car ov)) nv)) - (save-excursion - (mapc (lambda (b) - (set-buffer b) - (kill-local-variable (car (car ov)))) - (ede-project-buffers proj)))) - (setq ov (cdr ov))) - (mapc (lambda (b) (ede-set-project-variables proj b)) - (ede-project-buffers proj)))) - -(defmethod eieio-done-customizing ((target ede-target)) - "Call this when a user finishes customizing TARGET." - nil) - -(defmethod ede-commit-project ((proj ede-project)) - "Commit any change to PROJ to its file." - nil - ) - - -;;; EDE project placeholder methods -;; -(defmethod ede-project-force-load ((this ede-project-placeholder)) - "Make sure the placeholder THIS is replaced with the real thing. -Return the new object created in its place." - this - ) - ;;; EDE project target baseline methods. ;; @@ -1343,9 +788,9 @@ ;; methods based on those below. (defmethod project-interactive-select-target ((this ede-project-placeholder) prompt) - ; checkdoc-params: (prompt) + ; checkdoc-params: (prompt) "Make sure placeholder THIS is replaced with the real thing, and pass through." - (project-interactive-select-target (ede-project-force-load this) prompt)) + (project-interactive-select-target this prompt)) (defmethod project-interactive-select-target ((this ede-project) prompt) "Interactively query for a target that exists in project THIS. @@ -1354,9 +799,9 @@ (cdr (assoc (completing-read prompt ob nil t) ob)))) (defmethod project-add-file ((this ede-project-placeholder) file) - ; checkdoc-params: (file) + ; checkdoc-params: (file) "Make sure placeholder THIS is replaced with the real thing, and pass through." - (project-add-file (ede-project-force-load this) file)) + (project-add-file this file)) (defmethod project-add-file ((ot ede-target) file) "Add the current buffer into project project target OT. @@ -1413,132 +858,6 @@ (defmethod project-rescan ((this ede-project)) "Rescan the EDE proj project THIS." (error "Rescanning a project is not supported by %s" (object-name this))) - -;;; Default methods for EDE classes -;; -;; These are methods which you might want to override, but there is -;; no need to in most situations because they are either a) simple, or -;; b) cosmetic. - -(defmethod ede-name ((this ede-target)) - "Return the name of THIS target." - (oref this name)) - -(defmethod ede-target-name ((this ede-target)) - "Return the name of THIS target, suitable for make or debug style commands." - (oref this name)) - -(defmethod ede-name ((this ede-project)) - "Return a short-name for THIS project file. -Do this by extracting the lowest directory name." - (oref this name)) - -(defmethod ede-description ((this ede-project)) - "Return a description suitable for the minibuffer about THIS." - (format "Project %s: %d subprojects, %d targets." - (ede-name this) (length (oref this subproj)) - (length (oref this targets)))) - -(defmethod ede-description ((this ede-target)) - "Return a description suitable for the minibuffer about THIS." - (format "Target %s: with %d source files." - (ede-name this) (length (oref this source)))) - -(defmethod ede-want-file-p ((this ede-target) file) - "Return non-nil if THIS target wants FILE." - ;; By default, all targets reference the source object, and let it decide. - (let ((src (ede-target-sourcecode this))) - (while (and src (not (ede-want-file-p (car src) file))) - (setq src (cdr src))) - src)) - -(defmethod ede-want-file-source-p ((this ede-target) file) - "Return non-nil if THIS target wants FILE." - ;; By default, all targets reference the source object, and let it decide. - (let ((src (ede-target-sourcecode this))) - (while (and src (not (ede-want-file-source-p (car src) file))) - (setq src (cdr src))) - src)) - -(defun ede-header-file () - "Return the header file for the current buffer. -Not all buffers need headers, so return nil if no applicable." - (if ede-object - (ede-buffer-header-file ede-object (current-buffer)) - nil)) - -(defmethod ede-buffer-header-file ((this ede-project) buffer) - "Return nil, projects don't have header files." - nil) - -(defmethod ede-buffer-header-file ((this ede-target) buffer) - "There are no default header files in EDE. -Do a quick check to see if there is a Header tag in this buffer." - (with-current-buffer buffer - (if (re-search-forward "::Header:: \\([a-zA-Z0-9.]+\\)" nil t) - (buffer-substring-no-properties (match-beginning 1) - (match-end 1)) - (let ((src (ede-target-sourcecode this)) - (found nil)) - (while (and src (not found)) - (setq found (ede-buffer-header-file (car src) (buffer-file-name)) - src (cdr src))) - found)))) - -(defun ede-documentation-files () - "Return the documentation files for the current buffer. -Not all buffers need documentations, so return nil if no applicable. -Some projects may have multiple documentation files, so return a list." - (if ede-object - (ede-buffer-documentation-files ede-object (current-buffer)) - nil)) - -(defmethod ede-buffer-documentation-files ((this ede-project) buffer) - "Return all documentation in project THIS based on BUFFER." - ;; Find the info node. - (ede-documentation this)) - -(defmethod ede-buffer-documentation-files ((this ede-target) buffer) - "Check for some documentation files for THIS. -Also do a quick check to see if there is a Documentation tag in this BUFFER." - (with-current-buffer buffer - (if (re-search-forward "::Documentation:: \\([a-zA-Z0-9.]+\\)" nil t) - (buffer-substring-no-properties (match-beginning 1) - (match-end 1)) - ;; Check the master project - (let ((cp (ede-toplevel))) - (ede-buffer-documentation-files cp (current-buffer)))))) - -(defmethod ede-documentation ((this ede-project)) - "Return a list of files that provide documentation. -Documentation is not for object THIS, but is provided by THIS for other -files in the project." - (let ((targ (oref this targets)) - (proj (oref this subproj)) - (found nil)) - (while targ - (setq found (append (ede-documentation (car targ)) found) - targ (cdr targ))) - (while proj - (setq found (append (ede-documentation (car proj)) found) - proj (cdr proj))) - found)) - -(defmethod ede-documentation ((this ede-target)) - "Return a list of files that provide documentation. -Documentation is not for object THIS, but is provided by THIS for other -files in the project." - nil) - -(defun ede-html-documentation-files () - "Return a list of HTML documentation files associated with this project." - (ede-html-documentation (ede-toplevel)) - ) - -(defmethod ede-html-documentation ((this ede-project)) - "Return a list of HTML files provided by project THIS." - - ) (defun ede-ecb-project-paths () "Return a list of all paths for all active EDE projects. @@ -1550,24 +869,8 @@ d) p (cdr p))) d)) - -;;; EDE project-autoload methods -;; -(defmethod ede-dir-to-projectfile ((this ede-project-autoload) dir) - "Return a full file name of project THIS found in DIR. -Return nil if the project file does not exist." - (let* ((d (file-name-as-directory dir)) - (root (ede-project-root-directory this d)) - (pf (oref this proj-file)) - (f (cond ((stringp pf) - (expand-file-name pf (or root d))) - ((and (symbolp pf) (fboundp pf)) - (funcall pf (or root d))))) - ) - (when (and f (file-exists-p f)) - f))) -;;; EDE basic functions +;;; PROJECT LOADING/TRACKING ;; (defun ede-add-project-to-global-list (proj) "Add the project PROJ to the master list of projects. @@ -1603,7 +906,7 @@ (if p (ede-load-project-file p) nil) ;; recomment as we go - ;nil + ;;nil )) ;; Do nothing if we are buiding an EDE project already (ede-constructing @@ -1612,7 +915,7 @@ (t (setq toppath (ede-toplevel-project path)) ;; We found the top-most directory. Check to see if we already - ;; have an object defining it's project. + ;; have an object defining its project. (setq pfc (ede-directory-project-p toppath t)) ;; See if it's been loaded before @@ -1620,7 +923,7 @@ ede-projects)) (if (not o) ;; If not, get it now. - (let ((ede-constructing t)) + (let ((ede-constructing pfc)) (setq o (funcall (oref pfc load-type) toppath)) (when (not o) (error "Project type error: :load-type failed to create a project")) @@ -1649,9 +952,14 @@ (delete (oref found file) ede-project-cache-files))) found))))) +;;; PROJECT ASSOCIATIONS +;; +;; Moving between relative projects. Associating between buffers and +;; projects. + (defun ede-parent-project (&optional obj) "Return the project belonging to the parent directory. -Returns nil if there is no previous directory. +Return nil if there is no previous directory. Optional argument OBJ is an object to find the parent of." (let* ((proj (or obj ede-object-project)) ;; Current project. (root (if obj (ede-project-root obj) @@ -1701,17 +1009,38 @@ ;; Return what we found. ans)) -(defun ede-buffer-object (&optional buffer) +(defun ede-buffer-object (&optional buffer projsym) "Return the target object for BUFFER. -This function clears cached values and recalculates." +This function clears cached values and recalculates. +Optional PROJSYM is a symbol, which will be set to the project +that contains the target that becomes buffer's object." (save-excursion (if (not buffer) (setq buffer (current-buffer))) (set-buffer buffer) (setq ede-object nil) - (let ((po (ede-current-project))) - (if po (setq ede-object (ede-find-target po buffer)))) - (if (= (length ede-object) 1) - (setq ede-object (car ede-object))) + (let* ((localpo (ede-current-project)) + (po localpo) + (top (ede-toplevel po))) + (if po (setq ede-object (ede-find-target po buffer))) + ;; If we get nothing, go with the backup plan of slowly + ;; looping upward + (while (and (not ede-object) (not (eq po top))) + (setq po (ede-parent-project po)) + (if po (setq ede-object (ede-find-target po buffer)))) + ;; Filter down to 1 project if there are dups. + (if (= (length ede-object) 1) + (setq ede-object (car ede-object))) + ;; Track the project, if needed. + (when (and projsym (symbolp projsym)) + (if ede-object + ;; If we found a target, then PO is the + ;; project to use. + (set projsym po) + ;; If there is no ede-object, then the projsym + ;; is whichever part of the project is most local. + (set projsym localpo)) + )) + ;; Return our findings. ede-object)) (defmethod ede-target-in-project-p ((proj ede-project) target) @@ -1738,14 +1067,6 @@ projs (cdr projs))) ans)) -(defun ede-maybe-checkout (&optional buffer) - "Check BUFFER out of VC if necessary." - (save-excursion - (if buffer (set-buffer buffer)) - (if (and buffer-read-only vc-mode - (y-or-n-p "Checkout Makefile.am from VC? ")) - (vc-toggle-read-only)))) - (defmethod ede-find-target ((proj ede-project) buffer) "Fetch the target in PROJ belonging to BUFFER or nil." (with-current-buffer buffer @@ -1786,7 +1107,7 @@ (pl nil)) (while bl (with-current-buffer (car bl) - (if (and ede-object (eq (ede-current-project) project)) + (if (ede-buffer-belongs-to-project-p) (setq pl (cons (car bl) pl)))) (setq bl (cdr bl))) pl)) @@ -1857,6 +1178,16 @@ Return the first non-nil value returned by PROC." (eval (cons 'or (ede-map-targets this proc)))) +;;; VC Handling +;; +(defun ede-maybe-checkout (&optional buffer) + "Check BUFFER out of VC if necessary." + (save-excursion + (if buffer (set-buffer buffer)) + (if (and buffer-read-only vc-mode + (y-or-n-p "Checkout Makefile.am from VC? ")) + (vc-toggle-read-only)))) + ;;; Some language specific methods. ;; @@ -1913,7 +1244,7 @@ (with-current-buffer buffer (dolist (v (oref project local-variables)) (make-local-variable (car v)) - ;; set it's value here? + ;; set its value here? (set (car v) (cdr v))))) (defun ede-set (variable value &optional proj) @@ -1936,60 +1267,6 @@ "Commit change to local variables in PROJ." nil) - -;;; Accessors for more complex types where oref is inappropriate. -;; -(defmethod ede-target-sourcecode ((this ede-target)) - "Return the sourcecode objects which THIS permits." - (let ((sc (oref this sourcetype)) - (rs nil)) - (while (and (listp sc) sc) - (setq rs (cons (symbol-value (car sc)) rs) - sc (cdr sc))) - rs)) - - -;;; Debugging. - -(defun ede-adebug-project () - "Run adebug against the current EDE project. -Display the results as a debug list." - (interactive) - (require 'data-debug) - (when (ede-current-project) - (data-debug-new-buffer "*Analyzer ADEBUG*") - (data-debug-insert-object-slots (ede-current-project) "") - )) - -(defun ede-adebug-project-parent () - "Run adebug against the current EDE parent project. -Display the results as a debug list." - (interactive) - (require 'data-debug) - (when (ede-parent-project) - (data-debug-new-buffer "*Analyzer ADEBUG*") - (data-debug-insert-object-slots (ede-parent-project) "") - )) - -(defun ede-adebug-project-root () - "Run adebug against the current EDE parent project. -Display the results as a debug list." - (interactive) - (require 'data-debug) - (when (ede-toplevel) - (data-debug-new-buffer "*Analyzer ADEBUG*") - (data-debug-insert-object-slots (ede-toplevel) "") - )) - -;;; Hooks & Autoloads -;; -;; These let us watch various activities, and respond appropriately. - -;; (add-hook 'edebug-setup-hook -;; (lambda () -;; (def-edebug-spec ede-with-projectfile -;; (form def-body)))) - (provide 'ede) ;; Include this last because it depends on ede.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/auto.el Mon Sep 27 14:42:43 2010 +0900 @@ -0,0 +1,128 @@ +;;; ede/auto.el --- Autoload features for EDE + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; EDE Autoloads are a way to refer to different project types without +;; loading those projects into Emacs. +;; +;; These routines are used to detect a project in a filesystem before +;; handing over control to the usual EDE project system. + +;;; Code: + +(require 'eieio) + +(defclass ede-project-autoload () + ((name :initarg :name + :documentation "Name of this project type") + (file :initarg :file + :documentation "The lisp file belonging to this class.") + (proj-file :initarg :proj-file + :documentation "Name of a project file of this type.") + (proj-root :initarg :proj-root + :type function + :documentation "A function symbol to call for the project root. +This function takes no arguments, and returns the current directories +root, if available. Leave blank to use the EDE directory walking +routine instead.") + (initializers :initarg :initializers + :initform nil + :documentation + "Initializers passed to the project object. +These are used so there can be multiple types of projects +associated with a single object class, based on the initilizeres used.") + (load-type :initarg :load-type + :documentation "Fn symbol used to load this project file.") + (class-sym :initarg :class-sym + :documentation "Symbol representing the project class to use.") + (new-p :initarg :new-p + :initform t + :documentation + "Non-nil if this is an option when a user creates a project.") + ) + "Class representing minimal knowledge set to run preliminary EDE functions. +When more advanced functionality is needed from a project type, that projects +type is required and the load function used.") + +(defvar ede-project-class-files + (list + (ede-project-autoload "edeproject-makefile" + :name "Make" :file 'ede/proj + :proj-file "Project.ede" + :load-type 'ede-proj-load + :class-sym 'ede-proj-project) + (ede-project-autoload "edeproject-automake" + :name "Automake" :file 'ede/proj + :proj-file "Project.ede" + :initializers '(:makefile-type Makefile.am) + :load-type 'ede-proj-load + :class-sym 'ede-proj-project) + (ede-project-autoload "automake" + :name "automake" :file 'ede/project-am + :proj-file "Makefile.am" + :load-type 'project-am-load + :class-sym 'project-am-makefile + :new-p nil)) + "List of vectors defining how to determine what type of projects exist.") + +;;; EDE project-autoload methods +;; +(defmethod ede-project-root ((this ede-project-autoload)) + "If a project knows its root, return it here. +Allows for one-project-object-for-a-tree type systems." + nil) + +(defmethod ede-project-root-directory ((this ede-project-autoload) + &optional file) + "If a project knows its root, return it here. +Allows for one-project-object-for-a-tree type systems. +Optional FILE is the file to test. If there is no FILE, use +the current buffer." + (when (not file) + (setq file default-directory)) + (when (slot-boundp this :proj-root) + (let ((rootfcn (oref this proj-root))) + (when rootfcn + (condition-case nil + (funcall rootfcn file) + (error + (funcall rootfcn))) + )))) + +(defmethod ede-dir-to-projectfile ((this ede-project-autoload) dir) + "Return a full file name of project THIS found in DIR. +Return nil if the project file does not exist." + (let* ((d (file-name-as-directory dir)) + (root (ede-project-root-directory this d)) + (pf (oref this proj-file)) + (f (cond ((stringp pf) + (expand-file-name pf (or root d))) + ((and (symbolp pf) (fboundp pf)) + (funcall pf (or root d))))) + ) + (when (and f (file-exists-p f)) + f))) + + +(provide 'ede/auto) + +;;; ede/auto.el ends here
--- a/lisp/cedet/ede/autoconf-edit.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede/autoconf-edit.el Mon Sep 27 14:42:43 2010 +0900 @@ -27,20 +27,8 @@ ;;; Code: (require 'autoconf) - -(defvar autoconf-new-automake-string - "dnl Process this file with autoconf to produce a configure script - -AC_INIT(%s) -AM_INIT_AUTOMAKE([%s], 0) -AM_CONFIG_HEADER(config.h) - -dnl End the configure script. -AC_OUTPUT(Makefile, [date > stamp-h] )\n" - "This string is used to initialize a new configure.in. -The default is designed to be used with automake. -The first %s will be filled with the test file. -The second %s will be filled with the program name.") +(declare-function ede-srecode-setup "ede/srecode") +(declare-function ede-srecode-insert "ede/srecode") (defun autoconf-new-program (rootdir program testfile) "Initialize a new configure.in in ROOTDIR for PROGRAM using TESTFILE. @@ -49,6 +37,7 @@ TESTFILE is the file used with AC_INIT. configure the initial configure script using `autoconf-new-automake-string'" (interactive "DRoot Dir: \nsProgram: \nsTest File: ") + (require 'ede/srecode) (if (bufferp rootdir) (set-buffer rootdir) (let ((cf1 (expand-file-name "configure.in" rootdir)) @@ -62,7 +51,12 @@ (find-file cf2))) ;; Note, we only ask about overwrite if a string/path is specified. (erase-buffer) - (insert (format autoconf-new-automake-string testfile program))) + (ede-srecode-setup) + (ede-srecode-insert + "file:ede-empty" + "TEST_FILE" testfile + "PROGRAM" program) + ) (defvar autoconf-preferred-macro-order '("AC_INIT" @@ -151,42 +145,44 @@ (beginning-of-line) (looking-at (concat "\\(A[CM]_" macro "\\|" macro "\\)")))) -(defun autoconf-find-last-macro (macro) +(defun autoconf-find-last-macro (macro &optional ignore-bol) "Move to the last occurrence of MACRO in FILE, and return that point. The last macro is usually the one in which we would like to insert more items such as CHECK_HEADERS." - (let ((op (point))) + (let ((op (point)) (atbol (if ignore-bol "" "^"))) (goto-char (point-max)) - (if (re-search-backward (concat "^" (regexp-quote macro) "\\s-*\\((\\|$\\)") nil t) + (if (re-search-backward (concat atbol (regexp-quote macro) "\\s-*\\((\\|$\\)") nil t) (progn - (beginning-of-line) + (unless ignore-bol (beginning-of-line)) (point)) (goto-char op) nil))) (defun autoconf-parameter-strip (param) "Strip the parameter PARAM of whitespace and miscellaneous characters." - (when (string-match "^\\s-*\\[?\\s-*" param) + ;; force greedy match for \n. + (when (string-match "\\`\n*\\s-*\\[?\\s-*" param) (setq param (substring param (match-end 0)))) - (when (string-match "\\s-*\\]?\\s-*$" param) + (when (string-match "\\s-*\\]?\\s-*\\'" param) (setq param (substring param 0 (match-beginning 0)))) param) -(defun autoconf-parameters-for-macro (macro) +(defun autoconf-parameters-for-macro (macro &optional ignore-bol ignore-case) "Retrieve the parameters to MACRO. Returns a list of the arguments passed into MACRO as strings." - (save-excursion - (when (autoconf-find-last-macro macro) - (forward-sexp 1) - (mapcar - #'autoconf-parameter-strip - (when (looking-at "(") - (let* ((start (+ (point) 1)) - (end (save-excursion - (forward-sexp 1) - (- (point) 1))) - (ans (buffer-substring-no-properties start end))) - (split-string ans "," t))))))) + (let ((case-fold-search ignore-case)) + (save-excursion + (when (autoconf-find-last-macro macro ignore-bol) + (forward-sexp 1) + (mapcar + #'autoconf-parameter-strip + (when (looking-at "(") + (let* ((start (+ (point) 1)) + (end (save-excursion + (forward-sexp 1) + (- (point) 1))) + (ans (buffer-substring-no-properties start end))) + (split-string ans "," t)))))))) (defun autoconf-position-for-macro (macro) "Position the cursor where a new MACRO could be inserted.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/base.el Mon Sep 27 14:42:43 2010 +0900 @@ -0,0 +1,636 @@ +;;; ede/base.el --- Baseclasses for EDE. + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Baseclasses for EDE. +;; +;; Contains all the base structures needed by EDE. + +;;; Code: +(require 'eieio) +(require 'eieio-speedbar) +(require 'ede/auto) + +;; Defined in ede.el: +(defvar ede-projects) +(defvar ede-object) +(defvar ede-object-root-project) + +(declare-function data-debug-new-buffer "data-debug") +(declare-function data-debug-insert-object-slots "eieio-datadebug") +(declare-function ede-parent-project "ede" (&optional obj)) +(declare-function ede-current-project "ede" (&optional dir)) + +;;; TARGET +;; +;; The TARGET is an entity in a project that knows about files +;; and features of those files. + +(defclass ede-target (eieio-speedbar-directory-button) + ((buttonface :initform speedbar-file-face) ;override for superclass + (name :initarg :name + :type string + :custom string + :label "Name" + :group (default name) + :documentation "Name of this target.") + ;; @todo - I think this should be "dir", and not "path". + (path :initarg :path + :type string + ;:custom string + ;:label "Path to target" + ;:group (default name) + :documentation "The path to the sources of this target. +Relative to the path of the project it belongs to.") + (source :initarg :source + :initform nil + ;; I'd prefer a list of strings. + :type list + :custom (repeat (string :tag "File")) + :label "Source Files" + :group (default source) + :documentation "Source files in this target.") + (versionsource :initarg :versionsource + :initform nil + :type list + :custom (repeat (string :tag "File")) + :label "Source Files with Version String" + :group (source) + :documentation + "Source files with a version string in them. +These files are checked for a version string whenever the EDE version +of the master project is changed. When strings are found, the version +previously there is updated.") + ;; Class level slots + ;; + (sourcetype :allocation :class + :type list ;; list of symbols + :documentation + "A list of `ede-sourcecode' objects this class will handle. +This is used to match target objects with the compilers they can use, and +which files this object is interested in." + :accessor ede-object-sourcecode) + (keybindings :allocation :class + :initform (("D" . ede-debug-target)) + :documentation +"Keybindings specialized to this type of target." + :accessor ede-object-keybindings) + (menu :allocation :class + :initform ( [ "Debug target" ede-debug-target + (ede-buffer-belongs-to-target-p) ] + [ "Run target" ede-run-target + (ede-buffer-belongs-to-target-p) ] + ) + :documentation "Menu specialized to this type of target." + :accessor ede-object-menu) + ) + "A target is a structure that describes a file set that produces something. +Targets, as with 'Make', is an entity that will manage a file set +and knows how to compile or otherwise transform those files into some +other desired outcome.") + +;;; PROJECT/PLACEHOLDER +;; +;; Project placeholders are minimum parts of a project used +;; by the project cache. The project cache can refer to these placeholders, +;; and swap them out with the real-deal when that project is loaded. +;; +(defclass ede-project-placeholder (eieio-speedbar-directory-button) + ((name :initarg :name + :initform "Untitled" + :type string + :custom string + :label "Name" + :group (default name) + :documentation "The name used when generating distribution files.") + (version :initarg :version + :initform "1.0" + :type string + :custom string + :label "Version" + :group (default name) + :documentation "The version number used when distributing files.") + (directory :type string + :initarg :directory + :documentation "Directory this project is associated with.") + (dirinode :documentation "The inode id for :directory.") + (file :type string + :initarg :file + :documentation "File name where this project is stored.") + (rootproject ; :initarg - no initarg, don't save this slot! + :initform nil + :type (or null ede-project-placeholder-child) + :documentation "Pointer to our root project.") + ) + "Placeholder object for projects not loaded into memory. +Projects placeholders will be stored in a user specific location +and querying them will cause the actual project to get loaded.") + +;;; PROJECT +;; +;; An EDE project controls a set of TARGETS, and can also contain +;; multiple SUBPROJECTS. +;; +;; The project defines a set of features that need to be built from +;; files, in addition as to controlling what to do with the file set, +;; such as creating distributions, compilation, and web sites. +;; +;; Projects can also affect how EDE works, by changing what appears in +;; the EDE menu, or how some keys are bound. +;; +(defclass ede-project (ede-project-placeholder) + ((subproj :initform nil + :type list + :documentation "Sub projects controlled by this project. +For Automake based projects, each directory is treated as a project.") + (targets :initarg :targets + :type list + :custom (repeat (object :objectcreatefcn ede-new-target-custom)) + :label "Local Targets" + :group (targets) + :documentation "List of top level targets in this project.") + (locate-obj :type (or null ede-locate-base-child) + :documentation + "A locate object to use as a backup to `ede-expand-filename'.") + (tool-cache :initarg :tool-cache + :type list + :custom (repeat object) + :label "Tool: " + :group tools + :documentation "List of tool cache configurations in this project. +This allows any tool to create, manage, and persist project-specific settings.") + (mailinglist :initarg :mailinglist + :initform "" + :type string + :custom string + :label "Mailing List Address" + :group name + :documentation + "An email address where users might send email for help.") + (web-site-url :initarg :web-site-url + :initform "" + :type string + :custom string + :label "Web Site URL" + :group name + :documentation "URL to this projects web site. +This is a URL to be sent to a web site for documentation.") + (web-site-directory :initarg :web-site-directory + :initform "" + :custom string + :label "Web Page Directory" + :group name + :documentation + "A directory where web pages can be found by Emacs. +For remote locations use a path compatible with ange-ftp or EFS. +You can also use TRAMP for use with rcp & scp.") + (web-site-file :initarg :web-site-file + :initform "" + :custom string + :label "Web Page File" + :group name + :documentation + "A file which contains the home page for this project. +This file can be relative to slot `web-site-directory'. +This can be a local file, use ange-ftp, EFS, or TRAMP.") + (ftp-site :initarg :ftp-site + :initform "" + :type string + :custom string + :label "FTP site" + :group name + :documentation + "FTP site where this project's distribution can be found. +This FTP site should be in Emacs form, as needed by `ange-ftp', but can +also be of a form used by TRAMP for use with scp, or rcp.") + (ftp-upload-site :initarg :ftp-upload-site + :initform "" + :type string + :custom string + :label "FTP Upload site" + :group name + :documentation + "FTP Site to upload new distributions to. +This FTP site should be in Emacs form as needed by `ange-ftp'. +If this slot is nil, then use `ftp-site' instead.") + (configurations :initarg :configurations + :initform ("debug" "release") + :type list + :custom (repeat string) + :label "Configuration Options" + :group (settings) + :documentation "List of available configuration types. +Individual target/project types can form associations between a configuration, +and target specific elements such as build variables.") + (configuration-default :initarg :configuration-default + :initform "debug" + :custom string + :label "Current Configuration" + :group (settings) + :documentation "The default configuration.") + (local-variables :initarg :local-variables + :initform nil + :custom (repeat (cons (sexp :tag "Variable") + (sexp :tag "Value"))) + :label "Project Local Variables" + :group (settings) + :documentation "Project local variables") + (keybindings :allocation :class + :initform (("D" . ede-debug-target) + ("R" . ede-run-target)) + :documentation "Keybindings specialized to this type of target." + :accessor ede-object-keybindings) + (menu :allocation :class + :initform + ( + [ "Update Version" ede-update-version ede-object ] + [ "Version Control Status" ede-vc-project-directory ede-object ] + [ "Edit Project Homepage" ede-edit-web-page + (and ede-object (oref (ede-toplevel) web-site-file)) ] + [ "Browse Project URL" ede-web-browse-home + (and ede-object + (not (string= "" (oref (ede-toplevel) web-site-url)))) ] + "--" + [ "Rescan Project Files" ede-rescan-toplevel t ] + [ "Edit Projectfile" ede-edit-file-target + (ede-buffer-belongs-to-project-p) ] + ) + :documentation "Menu specialized to this type of target." + :accessor ede-object-menu) + ) + "Top level EDE project specification. +All specific project types must derive from this project." + :method-invocation-order :depth-first) + +;;; Important macros for doing commands. +;; +(defmacro ede-with-projectfile (obj &rest forms) + "For the project in which OBJ resides, execute FORMS." + (list 'save-window-excursion + (list 'let* (list + (list 'pf + (list 'if (list 'obj-of-class-p + obj 'ede-target) + ;; @todo -I think I can change + ;; this to not need ede-load-project-file + ;; but I'm not sure how to test well. + (list 'ede-load-project-file + (list 'oref obj 'path)) + obj)) + '(dbka (get-file-buffer (oref pf file)))) + '(if (not dbka) (find-file (oref pf file)) + (switch-to-buffer dbka)) + (cons 'progn forms) + '(if (not dbka) (kill-buffer (current-buffer)))))) +(put 'ede-with-projectfile 'lisp-indent-function 1) + +;;; The EDE persistent cache. +;; +;; The cache is a way to mark where all known projects live without +;; loading those projects into memory, or scanning for them each time +;; emacs starts. +;; +(defcustom ede-project-placeholder-cache-file + (locate-user-emacs-file "ede-projects.el" ".projects.ede") + "File containing the list of projects EDE has viewed." + :group 'ede + :type 'file) + +(defvar ede-project-cache-files nil + "List of project files EDE has seen before.") + +(defun ede-save-cache () + "Save a cache of EDE objects that Emacs has seen before." + (interactive) + (let ((p ede-projects) + (c ede-project-cache-files) + (recentf-exclude '( (lambda (f) t) )) + ) + (condition-case nil + (progn + (set-buffer (find-file-noselect ede-project-placeholder-cache-file t)) + (erase-buffer) + (insert ";; EDE project cache file. +;; This contains a list of projects you have visited.\n(") + (while p + (when (and (car p) (ede-project-p p)) + (let ((f (oref (car p) file))) + (when (file-exists-p f) + (insert "\n \"" f "\"")))) + (setq p (cdr p))) + (while c + (insert "\n \"" (car c) "\"") + (setq c (cdr c))) + (insert "\n)\n") + (condition-case nil + (save-buffer 0) + (error + (message "File %s could not be saved." + ede-project-placeholder-cache-file))) + (kill-buffer (current-buffer)) + ) + (error + (message "File %s could not be read." + ede-project-placeholder-cache-file)) + + ))) + +(defun ede-load-cache () + "Load the cache of EDE projects." + (save-excursion + (let ((cachebuffer nil)) + (condition-case nil + (progn + (setq cachebuffer + (find-file-noselect ede-project-placeholder-cache-file t)) + (set-buffer cachebuffer) + (goto-char (point-min)) + (let ((c (read (current-buffer))) + (new nil) + (p ede-projects)) + ;; Remove loaded projects from the cache. + (while p + (setq c (delete (oref (car p) file) c)) + (setq p (cdr p))) + ;; Remove projects that aren't on the filesystem + ;; anymore. + (while c + (when (file-exists-p (car c)) + (setq new (cons (car c) new))) + (setq c (cdr c))) + ;; Save it + (setq ede-project-cache-files (nreverse new)))) + (error nil)) + (when cachebuffer (kill-buffer cachebuffer)) + ))) + +;;; Get the cache usable. + +;; @TODO - Remove this cache setup, or use this for something helpful. +;;(add-hook 'kill-emacs-hook 'ede-save-cache) +;;(when (not noninteractive) +;; ;; No need to load the EDE cache if we aren't interactive. +;; ;; This occurs during batch byte-compiling of other tools. +;; (ede-load-cache)) + + +;;; METHODS +;; +;; The methods in ede-base handle project related behavior, and DO NOT +;; related to EDE mode commands directory, such as keybindings. +;; +;; Mode related methods are in ede.el. These methods are related +;; project specific activities not directly tied to a keybinding. +(defmethod ede-subproject-relative-path ((proj ede-project) &optional parent-in) + "Get a path name for PROJ which is relative to the parent project. +If PARENT is specified, then be relative to the PARENT project. +Specifying PARENT is useful for sub-sub projects relative to the root project." + (let* ((parent (or parent-in (ede-parent-project proj))) + (dir (file-name-directory (oref proj file)))) + (if (and parent (not (eq parent proj))) + (file-relative-name dir (file-name-directory (oref parent file))) + ""))) + +(defmethod ede-subproject-p ((proj ede-project)) + "Return non-nil if PROJ is a sub project." + ;; @TODO - Use this in more places, and also pay attention to + ;; metasubproject in ede-proj.el + (ede-parent-project proj)) + + +;;; Default descriptive methods for EDE classes +;; +;; These are methods which you might want to override, but there is +;; no need to in most situations because they are either a) simple, or +;; b) cosmetic. + +(defmethod ede-name ((this ede-target)) + "Return the name of THIS target." + (oref this name)) + +(defmethod ede-target-name ((this ede-target)) + "Return the name of THIS target, suitable for make or debug style commands." + (oref this name)) + +(defmethod ede-name ((this ede-project)) + "Return a short-name for THIS project file. +Do this by extracting the lowest directory name." + (oref this name)) + +(defmethod ede-description ((this ede-project)) + "Return a description suitable for the minibuffer about THIS." + (format "Project %s: %d subprojects, %d targets." + (ede-name this) (length (oref this subproj)) + (length (oref this targets)))) + +(defmethod ede-description ((this ede-target)) + "Return a description suitable for the minibuffer about THIS." + (format "Target %s: with %d source files." + (ede-name this) (length (oref this source)))) + +;;; HEADERS/DOC +;; +;; Targets and projects are often associated with other files, such as +;; header files, documentation files and the like. Have strong +;; associations can make useful user commands to quickly navigate +;; between the files base on their associations. +;; +(defun ede-header-file () + "Return the header file for the current buffer. +Not all buffers need headers, so return nil if no applicable." + (if ede-object + (ede-buffer-header-file ede-object (current-buffer)) + nil)) + +(defmethod ede-buffer-header-file ((this ede-project) buffer) + "Return nil, projects don't have header files." + nil) + +(defmethod ede-buffer-header-file ((this ede-target) buffer) + "There are no default header files in EDE. +Do a quick check to see if there is a Header tag in this buffer." + (with-current-buffer buffer + (if (re-search-forward "::Header:: \\([a-zA-Z0-9.]+\\)" nil t) + (buffer-substring-no-properties (match-beginning 1) + (match-end 1)) + (let ((src (ede-target-sourcecode this)) + (found nil)) + (while (and src (not found)) + (setq found (ede-buffer-header-file (car src) (buffer-file-name)) + src (cdr src))) + found)))) + +(defun ede-documentation-files () + "Return the documentation files for the current buffer. +Not all buffers need documentations, so return nil if no applicable. +Some projects may have multiple documentation files, so return a list." + (if ede-object + (ede-buffer-documentation-files ede-object (current-buffer)) + nil)) + +(defmethod ede-buffer-documentation-files ((this ede-project) buffer) + "Return all documentation in project THIS based on BUFFER." + ;; Find the info node. + (ede-documentation this)) + +(defmethod ede-buffer-documentation-files ((this ede-target) buffer) + "Check for some documentation files for THIS. +Also do a quick check to see if there is a Documentation tag in this BUFFER." + (with-current-buffer buffer + (if (re-search-forward "::Documentation:: \\([a-zA-Z0-9.]+\\)" nil t) + (buffer-substring-no-properties (match-beginning 1) + (match-end 1)) + ;; Check the master project + (let ((cp (ede-toplevel))) + (ede-buffer-documentation-files cp (current-buffer)))))) + +(defmethod ede-documentation ((this ede-project)) + "Return a list of files that provide documentation. +Documentation is not for object THIS, but is provided by THIS for other +files in the project." + (let ((targ (oref this targets)) + (proj (oref this subproj)) + (found nil)) + (while targ + (setq found (append (ede-documentation (car targ)) found) + targ (cdr targ))) + (while proj + (setq found (append (ede-documentation (car proj)) found) + proj (cdr proj))) + found)) + +(defmethod ede-documentation ((this ede-target)) + "Return a list of files that provide documentation. +Documentation is not for object THIS, but is provided by THIS for other +files in the project." + nil) + +(defun ede-html-documentation-files () + "Return a list of HTML documentation files associated with this project." + (ede-html-documentation (ede-toplevel)) + ) + +(defmethod ede-html-documentation ((this ede-project)) + "Return a list of HTML files provided by project THIS." + + ) + +;;; Default "WANT" methods. +;; +;; These methods are used to determine if a target "wants", or could +;; somehow handle a file, or some source type. +;; +(defmethod ede-want-file-p ((this ede-target) file) + "Return non-nil if THIS target wants FILE." + ;; By default, all targets reference the source object, and let it decide. + (let ((src (ede-target-sourcecode this))) + (while (and src (not (ede-want-file-p (car src) file))) + (setq src (cdr src))) + src)) + +(defmethod ede-want-file-source-p ((this ede-target) file) + "Return non-nil if THIS target wants FILE." + ;; By default, all targets reference the source object, and let it decide. + (let ((src (ede-target-sourcecode this))) + (while (and src (not (ede-want-file-source-p (car src) file))) + (setq src (cdr src))) + src)) + +(defmethod ede-target-sourcecode ((this ede-target)) + "Return the sourcecode objects which THIS permits." + (let ((sc (oref this sourcetype)) + (rs nil)) + (while (and (listp sc) sc) + (setq rs (cons (symbol-value (car sc)) rs) + sc (cdr sc))) + rs)) + + +;;; Debugging. +;; +(defun ede-adebug-project () + "Run adebug against the current EDE project. +Display the results as a debug list." + (interactive) + (require 'data-debug) + (when (ede-current-project) + (data-debug-new-buffer "*Analyzer ADEBUG*") + (data-debug-insert-object-slots (ede-current-project) "") + )) + +(defun ede-adebug-project-parent () + "Run adebug against the current EDE parent project. +Display the results as a debug list." + (interactive) + (require 'data-debug) + (when (ede-parent-project) + (data-debug-new-buffer "*Analyzer ADEBUG*") + (data-debug-insert-object-slots (ede-parent-project) "") + )) + +(defun ede-adebug-project-root () + "Run adebug against the current EDE parent project. +Display the results as a debug list." + (interactive) + (require 'data-debug) + (when (ede-toplevel) + (data-debug-new-buffer "*Analyzer ADEBUG*") + (data-debug-insert-object-slots (ede-toplevel) "") + )) + + + +;;; TOPLEVEL PROJECT +;; +;; The toplevel project is a way to identify the EDE structure that belongs +;; to the top of a project. + +(defun ede-toplevel (&optional subproj) + "Return the ede project which is the root of the current project. +Optional argument SUBPROJ indicates a subproject to start from +instead of the current project." + (or ede-object-root-project + (let* ((cp (or subproj (ede-current-project)))) + (or (and cp (ede-project-root cp)) + (progn + (while (ede-parent-project cp) + (setq cp (ede-parent-project cp))) + cp))))) + + +;;; Hooks & Autoloads +;; +;; These let us watch various activities, and respond appropriately. + +;; (add-hook 'edebug-setup-hook +;; (lambda () +;; (def-edebug-spec ede-with-projectfile +;; (form def-body)))) + +(provide 'ede/base) + +;; Local variables: +;; generated-autoload-file: "loaddefs.el" +;; generated-autoload-load-name: "ede/base" +;; End: + +;;; ede/base.el ends here
--- a/lisp/cedet/ede/cpp-root.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede/cpp-root.el Mon Sep 27 14:42:43 2010 +0900 @@ -131,7 +131,7 @@ ;; (add-to-list 'ede-project-class-files ;; (ede-project-autoload "cpp-root" ;; :name "CPP ROOT" -;; :file 'ede-cpp-root +;; :file 'ede/cpp-root ;; :proj-file 'MY-FILE-FOR-DIR ;; :proj-root 'MY-ROOT-FCN ;; :load-type 'MY-LOAD @@ -237,6 +237,18 @@ ;; Snoop through our master list. (ede-cpp-root-file-existing dir)) +;;;###autoload +(add-to-list 'ede-project-class-files + (ede-project-autoload "cpp-root" + :name "CPP ROOT" + :file 'ede/cpp-root + :proj-file 'ede-cpp-root-project-file-for-dir + :proj-root 'ede-cpp-root-project-root + :load-type 'ede-cpp-root-load + :class-sym 'ede-cpp-root + :new-p nil) + t) + ;;; CLASSES ;; ;; EDE sets up projects with two kinds of objects. @@ -504,6 +516,21 @@ "Get the pre-processor map for project THIS." (ede-preprocessor-map (ede-target-parent this))) +;;; Quick Hack +(defun ede-create-lots-of-projects-under-dir (dir projfile &rest attributes) + "Create a bunch of projects under directory DIR. +PROJFILE is a file name sans directory that indicates a subdirectory +is a project directory. +Generic ATTRIBUTES, such as :include-path can be added. +Note: This needs some work." + (let ((files (directory-files dir t))) + (dolist (F files) + (if (file-exists-p (expand-file-name projfile F)) + `(ede-cpp-root-project (file-name-nondirectory F) + :name (file-name-nondirectory F) + :file (expand-file-name projfile F) + attributes))))) + (provide 'ede/cpp-root) ;; Local variables:
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/custom.el Mon Sep 27 14:42:43 2010 +0900 @@ -0,0 +1,215 @@ +;;; ede.el --- customization of EDE projects. + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <zappo@gnu.org> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Customization commands/hooks for EDE. +;; +;; EIEIO supports customizing objects, and EDE uses this to allow +;; users to change basic settings in their projects. +;; + +;;; Code: +;;; Customization +;; +;; Routines for customizing projects and targets. + +(require 'ede) +(eval-when-compile (require 'eieio-custom)) + +(defvar eieio-ede-old-variables nil + "The old variables for a project.") + +;;; Customization Commands +;; +;; These commands initialize custoization of EDE control objects. + +;;;###autoload +(defun ede-customize-project () + "Edit fields of the current project through EIEIO & Custom." + (interactive) + (require 'eieio-custom) + (let* ((ov (oref (ede-current-project) local-variables)) + (cp (ede-current-project))) + (ede-customize cp) + (make-local-variable 'eieio-ede-old-variables) + (setq eieio-ede-old-variables ov))) + +;;;###autoload +(defalias 'customize-project 'ede-customize-project) + +;;;###autoload +(defun ede-customize-current-target() + "Edit fields of the current target through EIEIO & Custom." + (interactive) + (require 'eieio-custom) + (if (not (obj-of-class-p ede-object ede-target)) + (error "Current file is not part of a target")) + (ede-customize-target ede-object)) + +;;;###autoload +(defalias 'customize-target 'ede-customize-current-target) + +(defun ede-customize-target (obj) + "Edit fields of the current target through EIEIO & Custom. +OBJ is the target object to customize." + (require 'eieio-custom) + (if (and obj (not (obj-of-class-p obj ede-target))) + (error "No logical target to customize")) + (ede-customize obj)) + +(defmethod ede-customize ((proj ede-project)) + "Customize the EDE project PROJ." + (eieio-customize-object proj 'default)) + +(defmethod ede-customize ((target ede-target)) + "Customize the EDE TARGET." + (eieio-customize-object target 'default)) + +;;; Target Sorting +;; +;; Target order can be important, but custom doesn't support a way +;; to resort items in a list. This function by David Engster allows +;; targets to be re-arranged. + +(defvar ede-project-sort-targets-order nil + "Variable for tracking target order in `ede-project-sort-targets'.") + +;;;###autoload +(defun ede-project-sort-targets () + "Create a custom-like buffer for sorting targets of current project." + (interactive) + (let ((proj (ede-current-project)) + (count 1) + current order) + (switch-to-buffer (get-buffer-create "*EDE sort targets*")) + (erase-buffer) + (setq ede-object-project proj) + (widget-create 'push-button + :notify (lambda (&rest ignore) + (let ((targets (oref ede-object-project targets)) + cur newtargets) + (while (setq cur (pop ede-project-sort-targets-order)) + (setq newtargets (append newtargets + (list (nth cur targets))))) + (oset ede-object-project targets newtargets)) + (ede-commit-project ede-object-project) + (kill-buffer)) + " Accept ") + (widget-insert " ") + (widget-create 'push-button + :notify (lambda (&rest ignore) + (kill-buffer)) + " Cancel ") + (widget-insert "\n\n") + (setq ede-project-sort-targets-order nil) + (mapc (lambda (x) + (add-to-ordered-list + 'ede-project-sort-targets-order + x x)) + (number-sequence 0 (1- (length (oref proj targets))))) + (ede-project-sort-targets-list) + (use-local-map widget-keymap) + (widget-setup) + (goto-char (point-min)))) + +(defun ede-project-sort-targets-list () + "Sort the target list while using `ede-project-sort-targets'." + (save-excursion + (let ((count 0) + (targets (oref ede-object-project targets)) + (inhibit-read-only t) + (inhibit-modification-hooks t)) + (goto-char (point-min)) + (forward-line 2) + (delete-region (point) (point-max)) + (while (< count (length targets)) + (if (> count 0) + (widget-create 'push-button + :notify `(lambda (&rest ignore) + (let ((cur ede-project-sort-targets-order)) + (add-to-ordered-list + 'ede-project-sort-targets-order + (nth ,count cur) + (1- ,count)) + (add-to-ordered-list + 'ede-project-sort-targets-order + (nth (1- ,count) cur) ,count)) + (ede-project-sort-targets-list)) + " Up ") + (widget-insert " ")) + (if (< count (1- (length targets))) + (widget-create 'push-button + :notify `(lambda (&rest ignore) + (let ((cur ede-project-sort-targets-order)) + (add-to-ordered-list + 'ede-project-sort-targets-order + (nth ,count cur) (1+ ,count)) + (add-to-ordered-list + 'ede-project-sort-targets-order + (nth (1+ ,count) cur) ,count)) + (ede-project-sort-targets-list)) + " Down ") + (widget-insert " ")) + (widget-insert (concat " " (number-to-string (1+ count)) ".: " + (oref (nth (nth count ede-project-sort-targets-order) + targets) name) "\n")) + (setq count (1+ count)))))) + +;;; Customization hooks +;; +;; These hooks are used when finishing up a customization. +(defmethod eieio-done-customizing ((proj ede-project)) + "Call this when a user finishes customizing PROJ." + (let ((ov eieio-ede-old-variables) + (nv (oref proj local-variables))) + (setq eieio-ede-old-variables nil) + (while ov + (if (not (assoc (car (car ov)) nv)) + (save-excursion + (mapc (lambda (b) + (set-buffer b) + (kill-local-variable (car (car ov)))) + (ede-project-buffers proj)))) + (setq ov (cdr ov))) + (mapc (lambda (b) (ede-set-project-variables proj b)) + (ede-project-buffers proj)))) + +;; These two methods should be implemented by subclasses of +;; project and targets in order to account for user specified +;; changes. +(defmethod eieio-done-customizing ((target ede-target)) + "Call this when a user finishes customizing TARGET." + nil) + +(defmethod ede-commit-project ((proj ede-project)) + "Commit any change to PROJ to its file." + nil + ) + +(provide 'ede/custom) + +;; Local variables: +;; generated-autoload-file: "loaddefs.el" +;; generated-autoload-load-name: "ede/custom" +;; End: + +;;; ede/custom.el ends here
--- a/lisp/cedet/ede/dired.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede/dired.el Mon Sep 27 14:42:43 2010 +0900 @@ -76,11 +76,11 @@ "Add files to Target: ")))) (dolist (file (dired-get-marked-files t)) (project-add-file target file) - ;; Find the buffer for this files, and set it's ede-object + ;; Find the buffer for this files, and set its ede-object (if (get-file-buffer file) - (with-current-buffer (get-file-buffer file) - (setq ede-object nil) - (setq ede-object (ede-buffer-object (current-buffer))))))) + (with-current-buffer (get-file-buffer file) + (setq ede-object nil) + (setq ede-object (ede-buffer-object (current-buffer))))))) (provide 'ede/dired)
--- a/lisp/cedet/ede/emacs.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede/emacs.el Mon Sep 27 14:42:43 2010 +0900 @@ -133,6 +133,18 @@ ) ) +;;;###autoload +(add-to-list 'ede-project-class-files + (ede-project-autoload "emacs" + :name "EMACS ROOT" + :file 'ede/emacs + :proj-file "src/emacs.c" + :proj-root 'ede-emacs-project-root + :load-type 'ede-emacs-load + :class-sym 'ede-emacs-project + :new-p nil) + t) + (defclass ede-emacs-target-c (ede-target) () "EDE Emacs Project target for C code. @@ -150,7 +162,7 @@ (defmethod initialize-instance ((this ede-emacs-project) &rest fields) - "Make sure the :file is fully expanded." + "Make sure the targets slot is bound." (call-next-method) (unless (slot-boundp this 'targets) (oset this :targets nil)))
--- a/lisp/cedet/ede/files.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede/files.el Mon Sep 27 14:42:43 2010 +0900 @@ -38,6 +38,7 @@ (declare-function ede-locate-file-in-hash "ede/locate") (declare-function ede-locate-add-file-to-hash "ede/locate") (declare-function ede-locate-file-in-project "ede/locate") +(declare-function ede-locate-flush-hash "ede/locate") (defvar ede--disable-inode nil "Set to 't' to simulate systems w/out inode support.") @@ -57,44 +58,29 @@ (ede-project-root-directory (ede-current-project)))) (find-file fname))) +(defun ede-flush-project-hash () + "Flush the file locate hash for the current project." + (interactive) + (require 'ede/locate) + (let* ((loc (ede-get-locator-object (ede-current-project)))) + (ede-locate-flush-hash loc))) + ;;; Placeholders for ROOT directory scanning on base objects ;; (defmethod ede-project-root ((this ede-project-placeholder)) - "If a project knows it's root, return it here. + "If a project knows its root, return it here. Allows for one-project-object-for-a-tree type systems." (oref this rootproject)) (defmethod ede-project-root-directory ((this ede-project-placeholder) &optional file) - "If a project knows it's root, return it here. + "If a project knows its root, return it here. Allows for one-project-object-for-a-tree type systems. Optional FILE is the file to test. It is ignored in preference of the anchor file for the project." (file-name-directory (expand-file-name (oref this file)))) -(defmethod ede-project-root ((this ede-project-autoload)) - "If a project knows it's root, return it here. -Allows for one-project-object-for-a-tree type systems." - nil) - -(defmethod ede-project-root-directory ((this ede-project-autoload) - &optional file) - "If a project knows it's root, return it here. -Allows for one-project-object-for-a-tree type systems. -Optional FILE is the file to test. If there is no FILE, use -the current buffer." - (when (not file) - (setq file default-directory)) - (when (slot-boundp this :proj-root) - (let ((rootfcn (oref this proj-root))) - (when rootfcn - (condition-case nil - (funcall rootfcn file) - (error - (funcall rootfcn))) - )))) - (defmethod ede--project-inode ((proj ede-project-placeholder)) "Get the inode of the directory project PROJ is in." (if (slot-boundp proj 'dirinode) @@ -262,27 +248,30 @@ (defun ede-directory-project-p (dir &optional force) "Return a project description object if DIR has a project. Optional argument FORCE means to ignore a hash-hit of 'nomatch. -This depends on an up to date `ede-project-class-files' variable." - (let* ((dirtest (expand-file-name dir)) - (match (ede-directory-project-from-hash dirtest))) - (cond - ((and (eq match 'nomatch) (not force)) - nil) - ((and match (not (eq match 'nomatch))) - match) - (t - (let ((types ede-project-class-files) - (ret nil)) - ;; Loop over all types, loading in the first type that we find. - (while (and types (not ret)) - (if (ede-dir-to-projectfile (car types) dirtest) - (progn - ;; We found one! Require it now since we will need it. - (require (oref (car types) file)) - (setq ret (car types)))) - (setq types (cdr types))) - (ede-directory-project-add-description-to-hash dirtest (or ret 'nomatch)) - ret))))) +This depends on an up to date `ede-project-class-files' variable. +Any directory that contains the file .ede-ignore will allways +return nil." + (when (not (file-exists-p (expand-file-name ".ede-ignore" dir))) + (let* ((dirtest (expand-file-name dir)) + (match (ede-directory-project-from-hash dirtest))) + (cond + ((and (eq match 'nomatch) (not force)) + nil) + ((and match (not (eq match 'nomatch))) + match) + (t + (let ((types ede-project-class-files) + (ret nil)) + ;; Loop over all types, loading in the first type that we find. + (while (and types (not ret)) + (if (ede-dir-to-projectfile (car types) dirtest) + (progn + ;; We found one! Require it now since we will need it. + (require (oref (car types) file)) + (setq ret (car types)))) + (setq types (cdr types))) + (ede-directory-project-add-description-to-hash dirtest (or ret 'nomatch)) + ret)))))) ;;; TOPLEVEL ;; @@ -324,7 +313,7 @@ ;; If PROJ didn't know, or there is no PROJ, then ;; Loop up to the topmost project, and then load that single - ;; project, and it's sub projects. When we are done, identify the + ;; project, and its sub projects. When we are done, identify the ;; sub-project object belonging to file. (while (and (not ans) newpath proj) (setq toppath newpath @@ -338,24 +327,6 @@ ) (or ans toppath)))))) -;;; TOPLEVEL PROJECT -;; -;; The toplevel project is a way to identify the EDE structure that belongs -;; to the top of a project. - -(defun ede-toplevel (&optional subproj) - "Return the ede project which is the root of the current project. -Optional argument SUBPROJ indicates a subproject to start from -instead of the current project." - (or ede-object-root-project - (let* ((cp (or subproj (ede-current-project))) - ) - (or (and cp (ede-project-root cp)) - (progn - (while (ede-parent-project cp) - (setq cp (ede-parent-project cp))) - cp))))) - ;;; DIRECTORY CONVERSION STUFF ;; (defmethod ede-convert-path ((this ede-project) path) @@ -372,11 +343,13 @@ (substring fptf (match-end 0)) (error "Cannot convert relativize path %s" fp)))))) -(defmethod ede-convert-path ((this ede-target) path) +(defmethod ede-convert-path ((this ede-target) path &optional project) "Convert path in a standard way for a given project. Default to making it project relative. -Argument THIS is the project to convert PATH to." - (let ((proj (ede-target-parent this))) +Argument THIS is the project to convert PATH to. +Optional PROJECT is the project that THIS belongs to. Associating +a target to a project is expensive, so using this can speed things up." + (let ((proj (or project (ede-target-parent this)))) (if proj (let ((p (ede-convert-path proj path)) (lp (or (oref this path) ""))) @@ -406,7 +379,8 @@ by this project. Optional argument FORCE forces the default filename to be provided even if it doesn't exist. -If FORCE equals 'newfile, then the cache is ignored." +If FORCE equals 'newfile, then the cache is ignored and a new file in THIS +is returned." (require 'ede/locate) (let* ((loc (ede-get-locator-object this)) (ha (ede-locate-file-in-hash loc filename)) @@ -467,17 +441,8 @@ (proj (oref this subproj)) (found nil)) ;; find it Locally. - (setq found - (cond ((file-exists-p (expand-file-name filename path)) - (expand-file-name filename path)) - ((file-exists-p (expand-file-name (concat "include/" filename) path)) - (expand-file-name (concat "include/" filename) path)) - (t - (while (and (not found) proj) - (setq found (when (car proj) - (ede-expand-filename (car proj) filename)) - proj (cdr proj))) - found))) + (setq found (or (ede-expand-filename-local this filename) + (ede-expand-filename-impl-via-subproj this filename))) ;; Use an external locate tool. (when (not found) (require 'ede/locate) @@ -485,6 +450,30 @@ ;; Return it found)) +(defmethod ede-expand-filename-local ((this ede-project) filename) + "Expand filename locally to project THIS with filesystem tests." + (let ((path (ede-project-root-directory this))) + (cond ((file-exists-p (expand-file-name filename path)) + (expand-file-name filename path)) + ((file-exists-p (expand-file-name (concat "include/" filename) path)) + (expand-file-name (concat "include/" filename) path))))) + +(defmethod ede-expand-filename-impl-via-subproj ((this ede-project) filename) + "Return a fully qualified file name based on project THIS. +FILENAME should be just a filename which occurs in a directory controlled +by this project." + (let ((proj (list (ede-toplevel this))) + (found nil)) + ;; find it Locally. + (while (and (not found) proj) + (let ((thisproj (car proj))) + (setq proj (append (cdr proj) (oref thisproj subproj))) + (setq found (when thisproj + (ede-expand-filename-local thisproj filename))) + )) + ;; Return it + found)) + (defmethod ede-expand-filename ((this ede-target) filename &optional force) "Return a fully qualified file name based on target THIS. FILENAME should be a filename which occurs in a directory in which THIS works.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/cedet/ede/generic.el Mon Sep 27 14:42:43 2010 +0900 @@ -0,0 +1,442 @@ +;;; ede/generic.el --- Base Support for generic build systems + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Eric M. Ludlam <eric@siege-engine.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; There are a lot of build systems out there, and EDE can't support +;; them all fully. The ede-generic.el system is the base for +;; supporting alternate build systems in a simple way, automatically. +;; +;; The structure is for the ede-generic baseclass, which is augmented +;; by simple sub-classes that can be created by users on an as needed +;; basis. The generic system will have targets for many language +;; types, and create the targets on an as needed basis. All +;; sub-project types will recycle the same generic target types. +;; +;; The generic target types will only be implemented for languages +;; where having EDE support actually matters, with a single MISC to +;; represent anything else. +;; +;; TOO MANY PROJECTS DETECTED: +;; +;; If enabling ede-generic support starts identifying too many +;; projects, drop a file called `.ede-ignore' into any directory where +;; you do not want a project to be. +;; +;; Customization: +;; +;; Since these projects are all so increadibly generic, a user will +;; need to configure some aspects of the project by hand. In order to +;; enable this without configuring the project objects directly (which +;; are auto-generated) a special ede-generic-confg object is defined to +;; hold the basics. Generic projects will identify and use these +;; config files. +;; +;; Adding support for new projects: +;; +;; To add support to EDE Generic for new project types is very quick. +;; See the end of this file for examples such as CMake and SCons. +;; +;; Support consists of one class for your project, specifying the file +;; name used by the project system you want to support. It also +;; should implement th method `ede-generic-setup-configuration' to +;; prepopulate the configurable portion of the generic project with +;; build details. +;; +;; Lastly, call `ede-generic-new-autoloader' to setup your project so +;; EDE can use it. +;; +;; Adding support for new types of source code: +;; +;; Sources of different types are supported with a simple class which +;; subclasses `ede-generic-target'. The slots `shortname' and +;; `extension' should be given new initial values. +;; +;; Optionally, any target method used by EDE can then be overriden. +;; The ede-generic-target-c-cpp has some example methods setting up +;; the pre-processor map and system include path. +;; +;; NOTE: It is not necessary to modify ede-generic.el to add any of +;; the above described support features. + +(require 'eieio-opt) +(require 'ede) +(require 'semantic/db) + +;;; Code: +;; +;; Start with the configuration system +(defclass ede-generic-config (eieio-persistent) + ((extension :initform ".ede") + (file-header-line :initform ";; EDE Generic Project Configuration") + (project :initform nil + :documentation + "The project this config is bound to.") + ;; Generic customizations + (build-command :initarg :build-command + :initform "make -k" + :type string + :custom string + :group (default build) + :documentation + "Command used for building this project.") + (debug-command :initarg :debug-command + :initform "gdb " + :type string + :custom string + :group (default build) + :documentation + "Command used for debugging this project.") + ;; C target customixations + (c-include-path :initarg :c-include-path + :initform nil + :type list + :custom (repeat (string :tag "Path")) + :group c + :documentation + "The include path used by C/C++ projects.") + (c-preprocessor-table :initarg :c-preprocessor-table + :initform nil + :type list + :custom (repeat (cons (string :tag "Macro") + (string :tag "Value"))) + :group c + :documentation + "Preprocessor Symbols for this project.") + (c-preprocessor-files :initarg :c-preprocessor-files + :initform nil + :type list + :custom (repeat (string :tag "Include File"))) + ) + "User Configuration object for a generic project.") + +(defun ede-generic-load (dir &optional rootproj) + "Return a Generic Project object if there is a match. +Return nil if there isn't one. +Argument DIR is the directory it is created for. +ROOTPROJ is nil, since there is only one project." + ;; Doesn't already exist, so lets make one. + (let* ((alobj ede-constructing) + (this nil)) + (when (not alobj) (error "Cannot load generic project without the autoload instance")) + + (setq this + (funcall (oref alobj class-sym) + (symbol-name (oref alobj class-sym)) + :name (file-name-nondirectory + (directory-file-name dir)) + :version "1.0" + :directory (file-name-as-directory dir) + :file (expand-file-name (oref alobj :proj-file)) )) + (ede-add-project-to-global-list this) + )) + +;;; Base Classes for the system +(defclass ede-generic-target (ede-target) + ((shortname :initform "" + :type string + :allocation :class + :documentation + "Something prepended to the target name.") + (extension :initform "" + :type string + :allocation :class + :documentation + "Regular expression representing the extension used for this target. +subclasses of this base target will override the default value.") + ) + "Baseclass for all targets belonging to the generic ede system." + :abstract t) + +(defclass ede-generic-project (ede-project) + ((buildfile :initform "" + :type string + :allocation :class + :documentation "The file name that identifies a project of this type. +The class allocated value is replace by different sub classes.") + (config :initform nil + :type (or null ede-generic-config) + :documentation + "The configuration object for this project.") + ) + "The baseclass for all generic EDE project types." + :abstract t) + +(defmethod initialize-instance ((this ede-generic-project) + &rest fields) + "Make sure the targets slot is bound." + (call-next-method) + (unless (slot-boundp this 'targets) + (oset this :targets nil)) + ) + +(defmethod ede-generic-get-configuration ((proj ede-generic-project)) + "Return the configuration for the project PROJ." + (let ((config (oref proj config))) + (when (not config) + (let ((fname (expand-file-name "EDEConfig.el" + (oref proj :directory)))) + (if (file-exists-p fname) + ;; Load in the configuration + (setq config (eieio-persistent-read fname)) + ;; Create a new one. + (setq config (ede-generic-config + "Configuration" + :file fname)) + ;; Set initial values based on project. + (ede-generic-setup-configuration proj config)) + ;; Link things together. + (oset proj config config) + (oset config project proj))) + config)) + +(defmethod ede-generic-setup-configuration ((proj ede-generic-project) config) + "Default configuration setup method." + nil) + +(defmethod ede-commit-project ((proj ede-generic-project)) + "Commit any change to PROJ to its file." + (let ((config (ede-generic-get-configuration proj))) + (ede-commit config))) + +;;; A list of different targets +(defclass ede-generic-target-c-cpp (ede-generic-target) + ((shortname :initform "C/C++") + (extension :initform "\\([ch]\\(pp\\|xx\\|\\+\\+\\)?\\|cc\\|hh\\|CC?\\)")) + "EDE Generic Project target for C and C++ code. +All directories need at least one target.") + +(defclass ede-generic-target-el (ede-generic-target) + ((shortname :initform "ELisp") + (extension :initform "el")) + "EDE Generic Project target for Emacs Lisp code. +All directories need at least one target.") + +(defclass ede-generic-target-fortran (ede-generic-target) + ((shortname :initform "Fortran") + (extension :initform "[fF]9[05]\\|[fF]\\|for")) + "EDE Generic Project target for Fortran code. +All directories need at least one target.") + +(defclass ede-generic-target-texi (ede-generic-target) + ((shortname :initform "Texinfo") + (extension :initform "texi")) + "EDE Generic Project target for texinfo code. +All directories need at least one target.") + +;; MISC must always be last since it will always match the file. +(defclass ede-generic-target-misc (ede-generic-target) + ((shortname :initform "Misc") + (extension :initform "")) + "EDE Generic Project target for Misc files. +All directories need at least one target.") + +;;; Automatic target aquisition. +(defun ede-generic-find-matching-target (class dir targets) + "Find a target that is a CLASS and is in DIR in the list of TARGETS." + (let ((match nil)) + (dolist (T targets) + (when (and (object-of-class-p T class) + (string= (oref T :path) dir)) + (setq match T) + )) + match)) + +(defmethod ede-find-target ((proj ede-generic-project) buffer) + "Find an EDE target in PROJ for BUFFER. +If one doesn't exist, create a new one for this directory." + (let* ((ext (file-name-extension (buffer-file-name buffer))) + (classes (eieio-build-class-alist 'ede-generic-target t)) + (cls nil) + (targets (oref proj targets)) + (dir default-directory) + (ans nil) + ) + ;; Pick a matching class type. + (when ext + (dolist (C classes) + (let* ((classsym (intern (car C))) + (extreg (oref classsym extension))) + (when (and (not (string= extreg "")) + (string-match (concat "^" extreg "$") ext)) + (setq cls classsym))))) + (when (not cls) (setq cls 'ede-generic-target-misc)) + ;; find a pre-existing matching target + (setq ans (ede-generic-find-matching-target cls dir targets)) + ;; Create a new instance if there wasn't one + (when (not ans) + (setq ans (make-instance + cls + :name (oref cls shortname) + :path dir + :source nil)) + (object-add-to-list proj :targets ans) + ) + ans)) + +;;; C/C++ support +(defmethod ede-preprocessor-map ((this ede-generic-target-c-cpp)) + "Get the pre-processor map for some generic C code." + (let* ((proj (ede-target-parent this)) + (root (ede-project-root proj)) + (config (ede-generic-get-configuration proj)) + filemap + ) + ;; Preprocessor files + (dolist (G (oref config :c-preprocessor-files)) + (let ((table (semanticdb-file-table-object + (ede-expand-filename root G)))) + (when table + (when (semanticdb-needs-refresh-p table) + (semanticdb-refresh-table table)) + (setq filemap (append filemap (oref table lexical-table))) + ))) + ;; The core table + (setq filemap (append filemap (oref config :c-preprocessor-table))) + + filemap + )) + +(defmethod ede-system-include-path ((this ede-generic-target-c-cpp)) + "Get the system include path used by project THIS." + (let* ((proj (ede-target-parent this)) + (config (ede-generic-get-configuration proj))) + (oref config c-include-path))) + +;;; Customization +;; +(defmethod ede-customize ((proj ede-generic-project)) + "Customize the EDE project PROJ." + (let ((config (ede-generic-get-configuration proj))) + (eieio-customize-object config))) + +(defmethod ede-customize ((target ede-generic-target)) + "Customize the EDE TARGET." + ;; Nothing unique for the targets, use the project. + (ede-customize-project)) + +(defmethod eieio-done-customizing ((config ede-generic-config)) + "Called when EIEIO is done customizing the configuration object. +We need to go back through the old buffers, and update them with +the new configuration." + (ede-commit config) + ;; Loop over all the open buffers, and re-apply. + (ede-map-targets + (oref config project) + (lambda (target) + (ede-map-target-buffers + target + (lambda (b) + (with-current-buffer b + (ede-apply-target-options))))))) + +(defmethod ede-commit ((config ede-generic-config)) + "Commit all changes to the configuration to disk." + (eieio-persistent-save config)) + +;;; Creating Derived Projects: +;; +;; Derived projects need an autoloader so that EDE can find the +;; different projects on disk. +(defun ede-generic-new-autoloader (internal-name external-name + projectfile class) + "Add a new EDE Autoload instance for identifying a generic project. +INTERNAL-NAME is a long name that identifies thsi project type. +EXTERNAL-NAME is a shorter human readable name to describe the project. +PROJECTFILE is a file name that identifies a project of this type to EDE, such as +a Makefile, or SConstruct file. +CLASS is the EIEIO class that is used to track this project. It should subclass +the class `ede-generic-project' project." + (add-to-list 'ede-project-class-files + (ede-project-autoload internal-name + :name external-name + :file 'ede/generic + :proj-file projectfile + :load-type 'ede-generic-load + :class-sym class + :new-p nil) + ;; Generics must go at the end, since more specific types + ;; can create Makefiles also. + t)) + +;;;###autoload +(defun ede-enable-generic-projects () + "Enable generic project loaders." + (interactive) + (ede-generic-new-autoloader "edeproject-makefile" "Make" + "Makefile" 'ede-generic-makefile-project) + (ede-generic-new-autoloader "edeproject-scons" "SCons" + "SConstruct" 'ede-generic-scons-project) + (ede-generic-new-autoloader "edeproject-cmake" "CMake" + "CMakeLists" 'ede-generic-cmake-project) + ) + + +;;; SPECIFIC TYPES OF GENERIC BUILDS +;; + +;;; MAKEFILE + +(defclass ede-generic-makefile-project (ede-generic-project) + ((buildfile :initform "Makefile") + ) + "Generic Project for makefiles.") + +(defmethod ede-generic-setup-configuration ((proj ede-generic-makefile-project) config) + "Setup a configuration for Make." + (oset config build-command "make -k") + (oset config debug-command "gdb ") + ) + + +;;; SCONS +(defclass ede-generic-scons-project (ede-generic-project) + ((buildfile :initform "SConstruct") + ) + "Generic Project for scons.") + +(defmethod ede-generic-setup-configuration ((proj ede-generic-scons-project) config) + "Setup a configuration for SCONS." + (oset config build-command "scons") + (oset config debug-command "gdb ") + ) + + +;;; CMAKE +(defclass ede-generic-cmake-project (ede-generic-project) + ((buildfile :initform "CMakeLists") + ) + "Generic Project for cmake.") + +(defmethod ede-generic-setup-configuration ((proj ede-generic-cmake-project) config) + "Setup a configuration for CMake." + (oset config build-command "cmake") + (oset config debug-command "gdb ") + ) + +(provide 'ede/generic) + +;; Local variables: +;; generated-autoload-file: "loaddefs.el" +;; generated-autoload-load-name: "ede/generic" +;; End: + +;;; ede/generic.el ends here
--- a/lisp/cedet/ede/linux.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede/linux.el Mon Sep 27 14:42:43 2010 +0900 @@ -112,6 +112,18 @@ ) ) +;;;###autoload +(add-to-list 'ede-project-class-files + (ede-project-autoload "linux" + :name "LINUX ROOT" + :file 'ede/linux + :proj-file "scripts/ver_linux" + :proj-root 'ede-linux-project-root + :load-type 'ede-linux-load + :class-sym 'ede-linux-project + :new-p nil) + t) + (defclass ede-linux-target-c (ede-target) () "EDE Linux Project target for C code. @@ -124,7 +136,7 @@ (defmethod initialize-instance ((this ede-linux-project) &rest fields) - "Make sure the :file is fully expanded." + "Make sure the targets slot is bound." (call-next-method) (unless (slot-boundp this 'targets) (oset this :targets nil)))
--- a/lisp/cedet/ede/locate.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede/locate.el Mon Sep 27 14:42:43 2010 +0900 @@ -121,7 +121,7 @@ ;; Basic setup. (call-next-method) ;; Make sure we have a hash table. - (oset loc hash (make-hash-table :test 'equal)) + (ede-locate-flush-hash loc) ) (defmethod ede-locate-ok-in-project :static ((loc ede-locate-base) @@ -129,6 +129,10 @@ "Is it ok to use this project type under ROOT." t) +(defmethod ede-locate-flush-hash ((loc ede-locate-base)) + "For LOC, flush hashtable and start from scratch." + (oset loc hash (make-hash-table :test 'equal))) + (defmethod ede-locate-file-in-hash ((loc ede-locate-base) filestring) "For LOC, is the file FILESTRING in our hashtable?" @@ -160,6 +164,13 @@ nil ) +(defmethod ede-locate-create/update-root-database :STATIC + ((loc ede-locate-base) root) + "Create or update the database for the current project. +You cannot create projects for the baseclass." + (error "Cannot create/update a database of type %S" + (object-name loc))) + ;;; LOCATE ;; ;; Using the standard unix "locate" command. @@ -242,6 +253,11 @@ (let ((default-directory (oref loc root))) (cedet-gnu-global-expand-filename filesubstring))) +(defmethod ede-locate-create/update-root-database :STATIC + ((loc ede-locate-global) root) + "Create or update the GNU Global database for the current project." + (cedet-gnu-global-create/update-database root)) + ;;; IDUTILS ;; (defclass ede-locate-idutils (ede-locate-base) @@ -280,6 +296,11 @@ (let ((default-directory (oref loc root))) (cedet-idutils-expand-filename filesubstring))) +(defmethod ede-locate-create/update-root-database :STATIC + ((loc ede-locate-idutils) root) + "Create or update the GNU Global database for the current project." + (cedet-idutils-create/update-database root)) + ;;; CSCOPE ;; (defclass ede-locate-cscope (ede-locate-base) @@ -315,6 +336,11 @@ (let ((default-directory (oref loc root))) (cedet-cscope-expand-filename filesubstring))) +(defmethod ede-locate-create/update-root-database :STATIC + ((loc ede-locate-cscope) root) + "Create or update the GNU Global database for the current project." + (cedet-cscope-create/update-database root)) + (provide 'ede/locate) ;; Local variables:
--- a/lisp/cedet/ede/pconf.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede/pconf.el Mon Sep 27 14:42:43 2010 +0900 @@ -126,7 +126,11 @@ (while compilation-in-progress (accept-process-output) - (sit-for 1)) + ;; If sit for indicates that input is waiting, then + ;; read and discard whatever it is that is going on. + (when (not (sit-for 1)) + (read-event nil nil .1) + )) (with-current-buffer "*compilation*" (goto-char (point-max))
--- a/lisp/cedet/ede/pmake.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede/pmake.el Mon Sep 27 14:42:43 2010 +0900 @@ -262,6 +262,18 @@ (goto-char (point-max)))) (put 'ede-pmake-insert-variable-shared 'lisp-indent-function 1) +(defmacro ede-pmake-insert-variable-once (varname &rest body) + "Add VARNAME into the current Makefile if it doesn't exist. +Execute BODY in a location where a value can be placed." + `(let ((addcr t) (v ,varname)) + (unless (re-search-backward (concat "^" v "\\s-*=") nil t) + (insert v "=") + ,@body + (if addcr (insert "\n")) + (goto-char (point-max))) + )) +(put 'ede-pmake-insert-variable-once 'lisp-indent-function 1) + ;;; SOURCE VARIABLE NAME CONSTRUCTION (defsubst ede-pmake-varname (obj) @@ -369,10 +381,14 @@ conf-table)) (let* ((top "") (tmp this)) + ;; Use relative paths for subdirs. (while (ede-parent-project tmp) (setq tmp (ede-parent-project tmp) top (concat "../" top))) - (insert "\ntop=" top)) + ;; If this is the top, then use CURDIR. + (if (and (not (oref this metasubproject)) (string= top "")) + (insert "\ntop=\"$(CURDIR)\"/") + (insert "\ntop=" top))) (insert "\nede_FILES=" (file-name-nondirectory (oref this file)) " " (file-name-nondirectory (ede-proj-dist-makefile this)) "\n")) @@ -425,14 +441,13 @@ (link (ede-proj-linkers this)) (name (ede-proj-makefile-target-name this)) (src (oref this source))) + (ede-proj-makefile-insert-object-variables (car comp) name src) (dolist (obj comp) (ede-compiler-only-once obj (ede-proj-makefile-insert-variables obj))) - (ede-proj-makefile-insert-object-variables (car comp) name src) - (while link - (ede-linker-only-once (car link) - (ede-proj-makefile-insert-variables (car link))) - (setq link (cdr link))))) + (dolist (linker link) + (ede-linker-only-once linker + (ede-proj-makefile-insert-variables linker))))) (defmethod ede-proj-makefile-insert-automake-pre-variables ((this ede-proj-target))
--- a/lisp/cedet/ede/proj-archive.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede/proj-archive.el Mon Sep 27 14:42:43 2010 +0900 @@ -29,7 +29,7 @@ (defclass ede-proj-target-makefile-archive (ede-proj-target-makefile-objectcode) - ((availablelinkers :initform (ede-archive-linker))) + ((availablelinkers :initform '(ede-archive-linker))) "This target generates an object code archive.") (defvar ede-archive-linker
--- a/lisp/cedet/ede/proj-aux.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede/proj-aux.el Mon Sep 27 14:42:43 2010 +0900 @@ -29,7 +29,7 @@ ;;; Code: (defclass ede-proj-target-aux (ede-proj-target) - ((sourcetype :initform (ede-aux-source))) + ((sourcetype :initform '(ede-aux-source))) "This target consists of aux files such as READMEs and COPYING.") (defvar ede-aux-source
--- a/lisp/cedet/ede/proj-elisp.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede/proj-elisp.el Mon Sep 27 14:42:43 2010 +0900 @@ -36,8 +36,8 @@ ((menu :initform nil) (keybindings :initform nil) (phony :initform t) - (sourcetype :initform (ede-source-emacs)) - (availablecompilers :initform (ede-emacs-compiler ede-xemacs-compiler)) + (sourcetype :initform '(ede-source-emacs)) + (availablecompilers :initform '(ede-emacs-compiler ede-xemacs-compiler)) (aux-packages :initarg :aux-packages :initform nil :type list @@ -259,7 +259,7 @@ ;; Autoload generators ;; (defclass ede-proj-target-elisp-autoloads (ede-proj-target-elisp) - ((availablecompilers :initform (ede-emacs-cedet-autogen-compiler)) + ((availablecompilers :initform '(ede-emacs-cedet-autogen-compiler)) (aux-packages :initform ("cedet-autogen")) (phony :initform t) (autoload-file :initarg :autoload-file
--- a/lisp/cedet/ede/proj-info.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede/proj-info.el Mon Sep 27 14:42:43 2010 +0900 @@ -31,9 +31,9 @@ (defclass ede-proj-target-makefile-info (ede-proj-target-makefile) ((menu :initform nil) (keybindings :initform nil) - (availablecompilers :initform (ede-makeinfo-compiler - ede-texi2html-compiler)) - (sourcetype :initform (ede-makeinfo-source)) + (availablecompilers :initform '(ede-makeinfo-compiler + ede-texi2html-compiler)) + (sourcetype :initform '(ede-makeinfo-source)) (mainmenu :initarg :mainmenu :initform "" :type string
--- a/lisp/cedet/ede/proj-misc.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede/proj-misc.el Mon Sep 27 14:42:43 2010 +0900 @@ -35,8 +35,8 @@ ;; FIXME this isn't how you spell "miscellaneous". :( (defclass ede-proj-target-makefile-miscelaneous (ede-proj-target-makefile) - ((sourcetype :initform (ede-misc-source)) - (availablecompilers :initform (ede-misc-compile)) + ((sourcetype :initform '(ede-misc-source)) + (availablecompilers :initform '(ede-misc-compile)) (submakefile :initarg :submakefile :initform "" :type string
--- a/lisp/cedet/ede/proj-obj.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede/proj-obj.el Mon Sep 27 14:42:43 2010 +0900 @@ -39,28 +39,32 @@ (configuration-variables :initform ("debug" . (("CFLAGS" . "-g") ("LDFLAGS" . "-g")))) ;; @TODO - add an include path. - (availablecompilers :initform (ede-gcc-compiler - ede-g++-compiler - ede-gfortran-compiler - ede-gfortran-module-compiler - ;; More C and C++ compilers, plus - ;; fortran or pascal can be added here - )) - (availablelinkers :initform (ede-g++-linker - ede-cc-linker - ede-gfortran-linker - ede-ld-linker - ;; Add more linker thingies here. - )) - (sourcetype :initform (ede-source-c - ede-source-c++ - ede-source-f77 - ede-source-f90 - ;; ede-source-other - ;; This object should take everything that - ;; gets compiled into objects like fortran - ;; and pascal. - )) + (availablecompilers :initform '(ede-gcc-compiler + ede-g++-compiler + ede-gfortran-compiler + ede-gfortran-module-compiler + ede-lex-compiler + ede-yacc-compiler + ;; More C and C++ compilers, plus + ;; fortran or pascal can be added here + )) + (availablelinkers :initform '(ede-g++-linker + ede-cc-linker + ede-ld-linker + ede-gfortran-linker + ;; Add more linker thingies here. + )) + (sourcetype :initform '(ede-source-c + ede-source-c++ + ede-source-f77 + ede-source-f90 + ede-source-lex + ede-source-yacc + ;; ede-source-other + ;; This object should take everything that + ;; gets compiled into objects like fortran + ;; and pascal. + )) ) "Abstract class for Makefile based object code generating targets. Belonging to this group assumes you could make a .o from an element source @@ -115,15 +119,15 @@ :name "cc" :sourcetype '(ede-source-c) :variables '(("C_LINK" . "$(CC) $(CFLAGS) $(LDFLAGS) -L.")) - :commands '("$(C_LINK) -o $@ $^") + :commands '("$(C_LINK) -o $@ $^ $(LDDEPS)") :objectextention "") "Linker for C sourcecode.") (defvar ede-source-c++ (ede-sourcecode "ede-source-c++" :name "C++" - :sourcepattern "\\.\\(cpp\\|cc\\|cxx\\)$" - :auxsourcepattern "\\.\\(hpp\\|hh?\\|hxx\\)$" + :sourcepattern "\\.\\(c\\(pp?\\|c\\|xx\\|++\\)\\|C\\\(PP\\)?\\)$" + :auxsourcepattern "\\.\\(hpp?\\|hh?\\|hxx\\|H\\)$" :garbagepattern '("*.o" "*.obj" ".deps/*.P" ".lo")) "C++ source code definition.") @@ -158,11 +162,43 @@ ;; Only use this linker when c++ exists. :sourcetype '(ede-source-c++) :variables '(("CXX_LINK" . "$(CXX) $(CFLAGS) $(LDFLAGS) -L.")) - :commands '("$(CXX_LINK) -o $@ $^") + :commands '("$(CXX_LINK) -o $@ $^ $(LDDEPS)") :autoconf '("AC_PROG_CXX") :objectextention "") "Linker needed for c++ programs.") +;;; LEX +(defvar ede-source-lex + (ede-sourcecode "ede-source-lex" + :name "lex" + :sourcepattern "\\.l\\(l\\|pp\\|++\\)") + "Lex source code definition. +No garbage pattern since it creates C or C++ code.") + +(defvar ede-lex-compiler + (ede-object-compiler + "ede-lex-compiler" + ;; Can we support regular makefiles too?? + :autoconf '("AC_PROG_LEX") + :sourcetype '(ede-source-lex)) + "Compiler used for Lexical source.") + +;;; YACC +(defvar ede-source-yacc + (ede-sourcecode "ede-source-yacc" + :name "yacc" + :sourcepattern "\\.y\\(y\\|pp\\|++\\)") + "Yacc source code definition. +No garbage pattern since it creates C or C++ code.") + +(defvar ede-yacc-compiler + (ede-object-compiler + "ede-yacc-compiler" + ;; Can we support regular makefiles too?? + :autoconf '("AC_PROG_YACC") + :sourcetype '(ede-source-yacc)) + "Compiler used for yacc/bison grammar files source.") + ;;; Fortran Compiler/Linker ;; ;; Contributed by David Engster @@ -233,7 +269,7 @@ :name "ld" :variables '(("LD" . "ld") ("LD_LINK" . "$(LD) $(LDFLAGS) -L.")) - :commands '("$(LD_LINK) -o $@ $^") + :commands '("$(LD_LINK) -o $@ $^ $(LDDEPS)") :objectextention "") "Linker needed for c++ programs.")
--- a/lisp/cedet/ede/proj-prog.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede/proj-prog.el Mon Sep 27 14:42:43 2010 +0900 @@ -34,14 +34,14 @@ ;;; Code: (defclass ede-proj-target-makefile-program (ede-proj-target-makefile-objectcode) - ((ldlibs :initarg :ldlibs - :initform nil - :type list - :custom (repeat (string :tag "Library")) - :documentation - "Libraries, such as \"m\" or \"Xt\" which this program depends on. -The linker flag \"-l\" is automatically prepended. Do not include a \"lib\" -prefix, or a \".so\" suffix. + ((ldlibs-local :initarg :ldlibs-local + :initform nil + :type list + :custom (repeat (string :tag "Local Library")) + :documentation + "Libraries that are part of this project. +The full path to these libraries should be specified, such as: +../lib/libMylib.la or ../ar/myArchive.a Note: Currently only used for Automake projects." ) @@ -51,10 +51,21 @@ :custom (repeat (string :tag "Link Flag")) :documentation "Additional flags to add when linking this target. -Use ldlibs to add addition libraries. Use this to specify specific -options to the linker. +Use this to specify specific options to the linker. +A Common use may be to add -L to specify in-project locations of libraries +specified with ldlibs.") + (ldlibs :initarg :ldlibs + :initform nil + :type list + :custom (repeat (string :tag "Library")) + :documentation + "Libraries, such as \"m\" or \"Xt\" which this program depends on. +The linker flag \"-l\" is automatically prepended. Do not include a \"lib\" +prefix, or a \".so\" suffix. +Use the 'ldflags' slot to specify where in-project libraries might be. -Note: Not currently used. This bug needs to be fixed.") +Note: Currently only used for Automake projects." + ) ) "This target is an executable program.") @@ -70,27 +81,24 @@ "Insert bin_PROGRAMS variables needed by target THIS." (ede-pmake-insert-variable-shared (concat (ede-name this) "_LDADD") - (mapc (lambda (c) (insert " -l" c)) (oref this ldlibs))) - ;; For other targets THIS depends on - ;; - ;; NOTE: FIX THIS - ;; - ;;(ede-pmake-insert-variable-shared - ;; (concat (ede-name this) "_DEPENDENCIES") - ;; (mapcar (lambda (d) (insert d)) (oref this FOOOOOOOO))) + (mapc (lambda (l) (insert " " l)) (oref this ldlibs-local)) + (mapc (lambda (c) (insert " " c)) (oref this ldflags)) + (when (oref this ldlibs) + (mapc (lambda (d) (insert " -l" d)) (oref this ldlibs))) + ) (call-next-method)) -(defmethod ede-proj-makefile-insert-rules ((this ede-proj-target-makefile-program)) - "Insert rules needed by THIS target." - (let ((ede-proj-compiler-object-linkflags - (mapconcat 'identity (oref this ldflags) " "))) +(defmethod ede-proj-makefile-insert-variables ((this ede-proj-target-makefile-program)) + "Insert variables needed by the compiler THIS." + (call-next-method) + (let ((lf (mapconcat 'identity (oref this ldflags) " "))) (with-slots (ldlibs) this (if ldlibs - (setq ede-proj-compiler-object-linkflags - (concat ede-proj-compiler-object-linkflags - " -l" - (mapconcat 'identity ldlibs " -l"))))) - (call-next-method))) + (setq lf + (concat lf " -l" (mapconcat 'identity ldlibs " -l"))))) + ;; LDFLAGS as needed. + (when (and lf (not (string= "" lf))) + (ede-pmake-insert-variable-once "LDDEPS" (insert lf))))) (defmethod project-debug-target ((obj ede-proj-target-makefile-program)) "Debug a program target OBJ."
--- a/lisp/cedet/ede/proj-shared.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede/proj-shared.el Mon Sep 27 14:42:43 2010 +0900 @@ -34,15 +34,15 @@ ;;; Code: (defclass ede-proj-target-makefile-shared-object (ede-proj-target-makefile-program) - ((availablecompilers :initform (ede-gcc-libtool-shared-compiler - ;;ede-gcc-shared-compiler - ede-g++-libtool-shared-compiler - ;;ede-g++-shared-compiler - )) - (availablelinkers :initform (ede-cc-linker-libtool - ede-g++-linker-libtool - ;; Add more linker thingies here. - )) + ((availablecompilers :initform '(ede-gcc-libtool-shared-compiler + ;;ede-gcc-shared-compiler + ede-g++-libtool-shared-compiler + ;;ede-g++-shared-compiler + )) + (availablelinkers :initform '(ede-cc-linker-libtool + ede-g++-linker-libtool + ;; Add more linker thingies here. + )) (ldflags :custom (repeat (string :tag "Libtool flag")) :documentation "Additional flags to add when linking this shared library. @@ -124,7 +124,7 @@ :rules (list (ede-makefile-rule "c++-inference-rule-libtool" :target "%.o" - :dependencies "%.c" + :dependencies "%.cpp" :rules '("@echo '$(LTCOMPILE) -o $@ $<'; \\" "$(LTCOMPILE) -o $@ $<" )
--- a/lisp/cedet/ede/proj.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede/proj.el Mon Sep 27 14:42:43 2010 +0900 @@ -29,7 +29,6 @@ ;; rebuild. The targets provided in ede-proj can be augmented with ;; additional target types inherited directly from `ede-proj-target'. -;; (eval-and-compile '(require 'ede)) (require 'ede/proj-comp) (require 'ede/make) @@ -336,7 +335,9 @@ (or (string= (file-name-nondirectory (oref this file)) f) (string= (ede-proj-dist-makefile this) f) (string-match "Makefile\\(\\.\\(in\\|am\\)\\)?$" f) - (string-match "config\\(ure\\.in\\|\\.stutus\\)?$" f) + (string-match "config\\(ure\\.\\(in\\|ac\\)\\|\\.status\\)?$" f) + (string-match "config.h\\(\\.in\\)?" f) + (member f '("AUTHORS" "NEWS" "COPYING" "INSTALL" "README")) ))) (defmethod ede-buffer-mine ((this ede-proj-target) buffer) @@ -398,11 +399,11 @@ :source nil))) (defmethod project-delete-target ((this ede-proj-target)) - "Delete the current target THIS from it's parent project." + "Delete the current target THIS from its parent project." (let ((p (ede-current-project)) (ts (oref this source))) ;; Loop across all sources. If it exists in a buffer, - ;; clear it's object. + ;; clear its object. (while ts (let* ((default-directory (oref this path)) (b (get-file-buffer (car ts)))) @@ -413,7 +414,7 @@ (setq ede-object nil) (ede-apply-object-keymap)))))) (setq ts (cdr ts))) - ;; Remove THIS from it's parent. + ;; Remove THIS from its parent. ;; The two vectors should be pointer equivalent. (oset p targets (delq this (oref p targets))) (ede-proj-save (ede-current-project)))) @@ -447,15 +448,13 @@ (defmethod project-make-dist ((this ede-proj-project)) "Build a distribution for the project based on THIS target." - ;; I'm a lazy bum, so I'll make a makefile for doing this sort - ;; of thing, and rely only on that small section of code. (let ((pm (ede-proj-dist-makefile this)) (df (project-dist-files this))) (if (and (file-exists-p (car df)) (not (y-or-n-p "Dist file already exists. Rebuild? "))) (error "Try `ede-update-version' before making a distribution")) (ede-proj-setup-buildenvironment this) - (if (string= (file-name-nondirectory pm) "Makefile.am") + (if (ede-proj-automake-p this) (setq pm (expand-file-name "Makefile" (file-name-directory pm)))) (compile (concat ede-make-command " -f " pm " dist")))) @@ -473,7 +472,7 @@ (let ((pm (ede-proj-dist-makefile proj)) (default-directory (file-name-directory (oref proj file)))) (ede-proj-setup-buildenvironment proj) - (if (string= (file-name-nondirectory pm) "Makefile.am") + (if (ede-proj-automake-p proj) (setq pm (expand-file-name "Makefile" (file-name-directory pm)))) (compile (concat ede-make-command" -f " pm " all")))) @@ -539,7 +538,15 @@ (if (ede-want-any-source-files-p (symbol-value (car st)) sources) (let ((c (ede-proj-find-compiler avail (car st)))) (if c (setq comp (cons c comp))))) - (setq st (cdr st))))) + (setq st (cdr st))) + ;; Provide a good error msg. + (unless comp + (error "Could not find compiler match for source code extension \"%s\". +You may need to add support for this type of file." + (if sources + (file-name-extension (car sources)) + ""))) + )) ;; Return the disovered compilers comp))) @@ -664,18 +671,9 @@ (let ((root (or (ede-project-root this) this)) ) (setq ede-projects (delq root ede-projects)) - (ede-proj-load (ede-project-root-directory root)) + (ede-load-project-file (ede-project-root-directory root)) )) -(defmethod project-rescan ((this ede-proj-target) readstream) - "Rescan target THIS from the read list READSTREAM." - (setq readstream (cdr (cdr readstream))) ;; constructor/name - (while readstream - (let ((tag (car readstream)) - (val (car (cdr readstream)))) - (eieio-oset this tag val)) - (setq readstream (cdr (cdr readstream))))) - (provide 'ede/proj) ;; arch-tag: eb8a40f8-0d2c-41c4-b273-af04101d1cdf
--- a/lisp/cedet/ede/project-am.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede/project-am.el Mon Sep 27 14:42:43 2010 +0900 @@ -30,27 +30,19 @@ ;; fashion. ;; ;; project-am uses the structure defined in all good GNU projects with -;; the Automake file as it's base template, and then maintains that +;; the Automake file as its base template, and then maintains that ;; information during edits, automatically updating the automake file ;; where appropriate. - -;; (eval-and-compile -;; ;; Compatibility for makefile mode. -;; (condition-case nil -;; (require 'makefile "make-mode") -;; (error (require 'make-mode "make-mode"))) - -;; ;; Requiring the .el files prevents incomplete builds. -;; (require 'eieio "eieio.el") -;; (require 'ede "ede.el")) - (require 'make-mode) (require 'ede) (require 'ede/make) (require 'ede/makefile-edit) +(require 'semantic/find) ;; for semantic-find-tags-by-... +(require 'ede/autoconf-edit) (declare-function autoconf-parameters-for-macro "ede/autoconf-edit") +(declare-function ede-shell-run-something "ede/shell") (eval-when-compile (require 'compile)) ;;; Code: @@ -104,7 +96,7 @@ ;; ("ltlibcustom" project-am-lib ".*?_LTLIBRARIES" t) ) "Alist of type names and the type of object to create for them. -Each entry is of th form: +Each entry is of the form: (EMACSNAME CLASS AUTOMAKEVAR INDIRECT) where EMACSNAME is a name for Emacs to use. CLASS is the EDE target class to represent the target. @@ -113,6 +105,23 @@ INDIRECT is optional. If it is non-nil, then the variable in question lists other variables that need to be looked up.") + +(defconst project-am-meta-type-alist + '((project-am-program "_PROGRAMS$" t) + (project-am-lib "_\\(LIBS\\|LIBRARIES\\|LTLIBRARIES\\)$" t) + + ;; direct primary target use a dummy object (man target) + ;; update to: * 3.3 Uniform in automake-1.11 info node. + (project-am-man "_\\(DATA\\|HEADERS\\|PYTHON\\|JAVA\\|SCRIPTS\\|MANS\\|TEXINFOS\\)$" nil) + ) + "Alist of meta-target type, each entry has form: + (CLASS REGEXPVAR INDIRECT) +where CLASS is the EDE target class for target. +REGEXPVAR is the regexp used in `semantic-find-tags-by-name-regexp'. +INDIRECT is optional. If it is non-nil, then the variable in it have +other meta-variable based on this name.") + + (defclass project-am-target (ede-target) nil "Base target class for everything in project-am.") @@ -291,16 +300,6 @@ ;; Rescan the object in this makefile. (project-rescan ede-object)))) -;(defun project-am-rescan-toplevel () -; "Rescan all projects in which the current buffer resides." -; (interactive) -; (let* ((tlof (project-am-find-topmost-level default-directory)) -; (tlo (project-am-load tlof)) -; (ede-deep-rescan t)) ; scan deep in this case. -; ;; tlo is the top level object for whatever file we are in -; ;; or nil. If we have an object, call the rescan method. -; (if tlo (project-am-rescan tlo)))) - ;; ;; NOTE TO SELF ;; @@ -406,6 +405,7 @@ (defmethod project-run-target ((obj project-am-objectcode)) "Run the current project target in comint buffer." + (require 'ede/shell) (let ((tb (get-buffer-create " *padt*")) (dd (oref obj path)) (cmd nil)) @@ -429,45 +429,17 @@ ;;; Project loading and saving ;; -(defun project-am-load (project &optional rootproj) - "Read an automakefile PROJECT into our data structure. -Make sure that the tree down to our makefile is complete so that there -is cohesion in the project. Return the project file (or sub-project). +(defun project-am-load (directory &optional rootproj) + "Read an automakefile DIRECTORY into our data structure. If a given set of projects has already been loaded, then do nothing but return the project for the directory given. Optional ROOTPROJ is the root EDE project." - ;; @TODO - rationalize this to the newer EDE way of doing things. - (setq project (expand-file-name project)) - (let* ((ede-constructing t) - (fn (project-am-find-topmost-level (file-name-as-directory project))) - (amo nil) - (trimmed (if (string-match (regexp-quote fn) - project) - (replace-match "" t t project) - "")) - (subdir nil)) - (setq amo (object-assoc (expand-file-name "Makefile.am" fn) - 'file ede-projects)) - (if amo - (error "Synchronous error in ede/project-am objects") - (let ((project-am-constructing t)) - (setq amo (project-am-load-makefile fn)))) - (if (not amo) - nil - ;; Now scan down from amo, and find the current directory - ;; from the PROJECT file. - (while (< 0 (length trimmed)) - (if (string-match "\\([a-zA-Z0-9.-]+\\)/" trimmed) - (setq subdir (match-string 0 trimmed) - trimmed (replace-match "" t t trimmed)) - (error "Error scanning down path for project")) - (setq amo (project-am-subtree - amo - (expand-file-name "Makefile.am" - (expand-file-name subdir fn))) - fn (expand-file-name subdir fn))) - amo) - )) + (let* ((ede-constructiong t) + (amo (object-assoc (expand-file-name "Makefile.am" directory) + 'file ede-projects))) + (when (not amo) + (setq amo (project-am-load-makefile directory))) + amo)) (defun project-am-find-topmost-level (dir) "Find the topmost automakefile starting with DIR." @@ -488,17 +460,19 @@ (fb nil) (kb (get-file-buffer fn))) (if (not (file-exists-p fn)) - nil - (save-excursion - (if kb (setq fb kb) - ;; We need to find-file this thing, but don't use - ;; any semantic features. - (let ((semantic-init-hook nil)) - (setq fb (find-file-noselect fn))) - ) - (set-buffer fb) - (prog1 ,@forms - (if (not kb) (kill-buffer (current-buffer)))))))) + nil + (save-excursion + (if kb (setq fb kb) + ;; We need to find-file this thing, but don't use + ;; any semantic features. + (let ((semantic-init-hook nil) + (recentf-exclude '( (lambda (f) t) )) + ) + (setq fb (find-file-noselect fn))) + ) + (set-buffer fb) + (prog1 ,@forms + (if (not kb) (kill-buffer (current-buffer)))))))) (put 'project-am-with-makefile-current 'lisp-indent-function 1) (add-hook 'edebug-setup-hook @@ -507,14 +481,18 @@ (form def-body)))) -(defun project-am-load-makefile (path) +(defun project-am-load-makefile (path &optional suggestedname) "Convert PATH into a project Makefile, and return its project object. -It does not check for existing project objects. Use `project-am-load'." +It does not check for existing project objects. Use `project-am-load'. +Optional argument SUGGESTEDNAME will be the project name. +This is used when subprojects are made in named subdirectories." (project-am-with-makefile-current path (if (and ede-object (project-am-makefile-p ede-object)) ede-object (let* ((pi (project-am-package-info path)) - (pn (or (nth 0 pi) (project-am-last-dir fn))) + (sfn (when suggestedname + (project-am-last-dir suggestedname))) + (pn (or sfn (nth 0 pi) (project-am-last-dir fn))) (ver (or (nth 1 pi) "0.0")) (bug (nth 2 pi)) (cof (nth 3 pi)) @@ -532,21 +510,6 @@ ampf)))) ;;; Methods: -(defmethod ede-find-target ((amf project-am-makefile) buffer) - "Fetch the target belonging to BUFFER." - (or (call-next-method) - (let ((targ (oref amf targets)) - (sobj (oref amf subproj)) - (obj nil)) - (while (and targ (not obj)) - (if (ede-buffer-mine (car targ) buffer) - (setq obj (car targ))) - (setq targ (cdr targ))) - (while (and sobj (not obj)) - (setq obj (project-am-buffer-object (car sobj) buffer) - sobj (cdr sobj))) - obj))) - (defmethod project-targets-for-file ((proj project-am-makefile)) "Return a list of targets the project PROJ." (oref proj targets)) @@ -556,44 +519,110 @@ CURRPROJ is the current project being scanned. DIR is the directory to apply to new targets." (let* ((otargets (oref currproj targets)) + ;; `ntargets' results in complete targets list + ;; not only the new targets by diffing. (ntargets nil) (tmp nil) ) - (mapc - ;; Map all the different types - (lambda (typecar) - (let ((macro (nth 2 typecar)) - (class (nth 1 typecar)) - (indirect (nth 3 typecar)) - ;(name (car typecar)) - ) - (if indirect - ;; Map all the found objects - (mapc (lambda (lstcar) - (setq tmp (object-assoc lstcar 'name otargets)) - (when (not tmp) - (setq tmp (apply class lstcar :name lstcar - :path dir nil))) - (project-rescan tmp) - (setq ntargets (cons tmp ntargets))) - (makefile-macro-file-list macro)) - ;; Non-indirect will have a target whos sources - ;; are actual files, not names of other targets. - (let ((files (makefile-macro-file-list macro))) - (when files - (setq tmp (object-assoc macro 'name otargets)) - (when (not tmp) - (setq tmp (apply class macro :name macro + + (mapc + ;; Map all the different types + (lambda (typecar) + (let ((macro (nth 2 typecar)) + (class (nth 1 typecar)) + (indirect (nth 3 typecar)) + ) + (if indirect + ;; Map all the found objects + (mapc (lambda (lstcar) + (setq tmp (object-assoc lstcar 'name otargets)) + (when (not tmp) + (setq tmp (apply class lstcar :name lstcar + :path dir nil))) + (project-rescan tmp) + (setq ntargets (cons tmp ntargets))) + (makefile-macro-file-list macro)) + ;; Non-indirect will have a target whos sources + ;; are actual files, not names of other targets. + (let ((files (makefile-macro-file-list macro))) + (when files + (setq tmp (object-assoc macro 'name otargets)) + (when (not tmp) + (setq tmp (apply class macro :name macro + :path dir nil))) + (project-rescan tmp) + (setq ntargets (cons tmp ntargets)) + )) + ) + )) + project-am-type-alist) + + ;; At now check variables for meta-target regexp + ;; We have to check ntargets to avoid useless rescan. + ;; Also we have check otargets to prevent duplication. + (mapc + (lambda (typecar) + (let ((class (nth 0 typecar)) + (metaregex (nth 1 typecar)) + (indirect (nth 2 typecar))) + (if indirect + ;; Map all the found objects + (mapc + (lambda (lstcar) + (unless (object-assoc lstcar 'name ntargets) + (or + (setq tmp (object-assoc lstcar 'name otargets)) + (setq tmp (apply class lstcar :name lstcar :path dir nil))) - (project-rescan tmp) - (setq ntargets (cons tmp ntargets)) - )) - ) - )) - project-am-type-alist) - ntargets)) + (project-rescan tmp) + (setq ntargets (cons tmp ntargets)))) + ;; build a target list to map over + (let (atargets) + (dolist (TAG + (semantic-find-tags-by-name-regexp + metaregex (semantic-find-tags-by-class + 'variable (semantic-fetch-tags)))) + ;; default-value have to be a list + (when (cadr (assoc ':default-value TAG)) + (setq atargets + (append + (nreverse (cadr (assoc ':default-value TAG))) + atargets)))) + (nreverse atargets))) -(defmethod project-rescan ((this project-am-makefile)) + ;; else not indirect, TODO: FIX various direct meta type in a sane way. + (dolist (T (semantic-find-tags-by-name-regexp + metaregex (semantic-find-tags-by-class + 'variable (semantic-fetch-tags)))) + (unless (setq tmp (object-assoc (car T) 'name ntargets)) + (or (setq tmp (object-assoc (car T) 'name otargets)) + ;; we are really new + (setq tmp (apply class (car T) :name (car T) + :path dir nil))) + (project-rescan tmp) + (setq ntargets (cons tmp ntargets)))) + ))) + project-am-meta-type-alist) + ntargets)) + +(defun project-am-expand-subdirlist (place subdirs) + "Store in PLACE the SUBDIRS expanded from variables. +Strip out duplicates, and recurse on variables." + (mapc (lambda (sp) + (let ((var (makefile-extract-varname-from-text sp))) + (if var + ;; If it is a variable, expand that variable, and keep going. + (project-am-expand-subdirlist + place (makefile-macro-file-list var)) + ;; Else, add SP in if it isn't a dup. + (if (member sp (symbol-value place)) + nil ; don't do it twice. + (set place (cons sp (symbol-value place))) ;; add + )))) + subdirs) + ) + +(defmethod project-rescan ((this project-am-makefile) &optional suggestedname) "Rescan the makefile for all targets and sub targets." (project-am-with-makefile-current (file-name-directory (oref this file)) ;;(message "Scanning %s..." (oref this file)) @@ -603,10 +632,10 @@ (bug (nth 2 pi)) (cof (nth 3 pi)) (osubproj (oref this subproj)) - (csubproj (or - ;; If DIST_SUBDIRS doesn't exist, then go for the - ;; static list of SUBDIRS. The DIST version should - ;; contain SUBDIRS plus extra stuff. + ;; 1/30/10 - We need to append these two lists together, + ;; then strip out duplicates. Expanding this list (via + ;; references to other variables should also strip out dups + (csubproj (append (makefile-macro-file-list "DIST_SUBDIRS") (makefile-macro-file-list "SUBDIRS"))) (csubprojexpanded nil) @@ -617,79 +646,57 @@ (tmp nil) (ntargets (project-am-scan-for-targets this dir)) ) - - (and pn (string= (directory-file-name - (oref this directory)) - (directory-file-name - (project-am-find-topmost-level - (oref this directory)))) - (oset this name pn) - (and pv (oset this version pv)) - (and bug (oset this mailinglist bug)) - (oset this configureoutputfiles cof)) - -; ;; LISP is different. Here there is only one kind of lisp (that I know of -; ;; anyway) so it doesn't get mapped when it is found. -; (if (makefile-move-to-macro "lisp_LISP") -; (let ((tmp (project-am-lisp "lisp" -; :name "lisp" -; :path dir))) -; (project-rescan tmp) -; (setq ntargets (cons tmp ntargets)))) -; + (if suggestedname + (oset this name (project-am-last-dir suggestedname)) + ;; Else, setup toplevel project info. + (and pn (string= (directory-file-name + (oref this directory)) + (directory-file-name + (project-am-find-topmost-level + (oref this directory)))) + (oset this name pn) + (and pv (oset this version pv)) + (and bug (oset this mailinglist bug)) + (oset this configureoutputfiles cof))) ;; Now that we have this new list, chuck the old targets ;; and replace it with the new list of targets I just created. (oset this targets (nreverse ntargets)) ;; We still have a list of targets. For all buffers, make sure ;; their object still exists! - ;; FIGURE THIS OUT - - (mapc (lambda (sp) - (let ((var (makefile-extract-varname-from-text sp)) - ) - (if (not var) - (setq csubprojexpanded (cons sp csubprojexpanded)) - ;; If it is a variable, expand that variable, and keep going. - (let ((varexp (makefile-macro-file-list var))) - (dolist (V varexp) - (setq csubprojexpanded (cons V csubprojexpanded))))) - )) - csubproj) - + (project-am-expand-subdirlist 'csubprojexpanded csubproj) ;; Ok, now lets look at all our sub-projects. (mapc (lambda (sp) - (let* ((subdir (file-name-as-directory - (expand-file-name - sp (file-name-directory (oref this :file))))) - (submake (expand-file-name - "Makefile.am" - subdir))) - (if (string= submake (oref this :file)) - nil ;; don't recurse.. please! - - ;; For each project id found, see if we need to recycle, - ;; and if we do not, then make a new one. Check the deep - ;; rescan value for behavior patterns. - (setq tmp (object-assoc - submake - 'file osubproj)) - (if (not tmp) - (setq tmp - (condition-case nil - ;; In case of problem, ignore it. - (project-am-load-makefile subdir) - (error nil))) - ;; If we have tmp, then rescan it only if deep mode. - (if ede-deep-rescan - (project-rescan tmp))) - ;; Tac tmp onto our list of things to keep, but only - ;; if tmp was found. - (when tmp - ;;(message "Adding %S" (object-print tmp)) - (setq nsubproj (cons tmp nsubproj))))) - ) - (nreverse csubprojexpanded)) + (let* ((subdir (file-name-as-directory + (expand-file-name + sp (file-name-directory (oref this :file))))) + (submake (expand-file-name + "Makefile.am" + subdir))) + (if (string= submake (oref this :file)) + nil ;; don't recurse.. please! + ;; For each project id found, see if we need to recycle, + ;; and if we do not, then make a new one. Check the deep + ;; rescan value for behavior patterns. + (setq tmp (object-assoc + submake + 'file osubproj)) + (if (not tmp) + (setq tmp + (condition-case nil + ;; In case of problem, ignore it. + (project-am-load-makefile subdir subdir) + (error nil))) + ;; If we have tmp, then rescan it only if deep mode. + (if ede-deep-rescan + (project-rescan tmp subdir))) + ;; Tac tmp onto our list of things to keep, but only + ;; if tmp was found. + (when tmp + ;;(message "Adding %S" (object-print tmp)) + (setq nsubproj (cons tmp nsubproj))))) + ) + (nreverse csubprojexpanded)) (oset this subproj nsubproj) ;; All elements should be updated now. ))) @@ -698,12 +705,16 @@ (defmethod project-rescan ((this project-am-program)) "Rescan object THIS." (oset this :source (makefile-macro-file-list (project-am-macro this))) + (unless (oref this :source) + (oset this :source (list (concat (oref this :name) ".c")))) (oset this :ldadd (makefile-macro-file-list (concat (oref this :name) "_LDADD")))) (defmethod project-rescan ((this project-am-lib)) "Rescan object THIS." - (oset this :source (makefile-macro-file-list (project-am-macro this)))) + (oset this :source (makefile-macro-file-list (project-am-macro this))) + (unless (oref this :source) + (oset this :source (list (concat (file-name-sans-extension (oref this :name)) ".c"))))) (defmethod project-rescan ((this project-am-texinfo)) "Rescan object THIS." @@ -728,19 +739,6 @@ (defmethod project-rescan ((this project-am-extra-dist)) "Rescan object THIS." (oset this :source (makefile-macro-file-list "EXTRA_DIST"))) - ;; NOTE: The below calls 'file' then checks that it is some sort of - ;; text file. The file command may not be available on all platforms - ;; and some files may not exist yet. (ie - auto-generated) - - ;;(mapc - ;; (lambda (f) - ;; ;; prevent garbage to be parsed, could we use :aux ? - ;; (if (and (not (member f (oref this :source))) - ;; (string-match-p "ASCII\\|text" - ;; (shell-command-to-string - ;; (concat "file " f)))) - ;; (oset this :source (cons f (oref this :source))))) - ;; (makefile-macro-file-list "EXTRA_DIST"))) (defmethod project-am-macro ((this project-am-objectcode)) "Return the default macro to 'edit' for this object type." @@ -810,22 +808,24 @@ (defmethod ede-buffer-mine ((this project-am-objectcode) buffer) "Return t if object THIS lays claim to the file in BUFFER." - (member (file-name-nondirectory (buffer-file-name buffer)) + (member (file-relative-name (buffer-file-name buffer) (oref this :path)) (oref this :source))) (defmethod ede-buffer-mine ((this project-am-texinfo) buffer) "Return t if object THIS lays claim to the file in BUFFER." - (let ((bfn (buffer-file-name buffer))) - (or (string= (oref this :name) (file-name-nondirectory bfn)) - (member (file-name-nondirectory bfn) (oref this :include))))) + (let ((bfn (file-relative-name (buffer-file-name buffer) + (oref this :path)))) + (or (string= (oref this :name) bfn) + (member bfn (oref this :include))))) (defmethod ede-buffer-mine ((this project-am-man) buffer) "Return t if object THIS lays claim to the file in BUFFER." - (string= (oref this :name) (buffer-file-name buffer))) + (string= (oref this :name) + (file-relative-name (buffer-file-name buffer) (oref this :path)))) (defmethod ede-buffer-mine ((this project-am-lisp) buffer) "Return t if object THIS lays claim to the file in BUFFER." - (member (file-name-nondirectory (buffer-file-name buffer)) + (member (file-relative-name (buffer-file-name buffer) (oref this :path)) (oref this :source))) (defmethod project-am-subtree ((ampf project-am-makefile) subdir) @@ -956,7 +956,6 @@ (cond ;; Try configure.in or configure.ac (conf-in - (require 'ede/autoconf-edit) (project-am-with-config-current conf-in (let ((aci (autoconf-parameters-for-macro "AC_INIT")) (aia (autoconf-parameters-for-macro "AM_INIT_AUTOMAKE")) @@ -982,7 +981,7 @@ (t acf)))) (if (> (length outfiles) 1) (setq configfiles outfiles) - (setq configfiles (split-string (car outfiles) " " t))) + (setq configfiles (split-string (car outfiles) "\\s-" t))) ) )) ) @@ -1007,6 +1006,18 @@ (when top (setq dir (oref top :directory))) (project-am-extract-package-info dir))) +;; for simple per project include path extension +(defmethod ede-system-include-path ((this project-am-makefile)) + "Return `project-am-localvars-include-path', usually local variable +per file or in .dir-locals.el or similar." + (bound-and-true-p project-am-localvars-include-path)) + +(defmethod ede-system-include-path ((this project-am-target)) + "Return `project-am-localvars-include-path', usually local variable +per file or in .dir-locals.el or similar." + (bound-and-true-p project-am-localvars-include-path)) + + (provide 'ede/project-am) ;; arch-tag: 528db935-f186-4240-b647-e305c5b784a2
--- a/lisp/cedet/ede/shell.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede/shell.el Mon Sep 27 14:42:43 2010 +0900 @@ -70,7 +70,7 @@ (defmethod ede-shell-buffer ((target ede-target)) "Get the buffer for running shell commands for TARGET." (let ((name (ede-name target))) - (get-buffer-create (format "*EDE Shell %s" name)))) + (get-buffer-create (format "*EDE Shell %s*" name)))) (provide 'ede/shell)
--- a/lisp/cedet/ede/simple.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede/simple.el Mon Sep 27 14:42:43 2010 +0900 @@ -21,6 +21,10 @@ ;;; Commentary: ;; +;; NOTE: EDE Simple Projects are considered obsolete. Use generic +;; projects instead. They have much better automatic support and +;; simpler configuration. +;; ;; A vast majority of projects use non-EDE project techniques, such ;; as hand written Makefiles, or other IDE's. ;; @@ -41,6 +45,14 @@ ;;; Code: +(add-to-list 'ede-project-class-files + (ede-project-autoload "simple-overlay" + :name "Simple" :file 'ede/simple + :proj-file 'ede-simple-projectfile-for-dir + :load-type 'ede-simple-load + :class-sym 'ede-simple-project) + t) + (defcustom ede-simple-save-directory "~/.ede" "*Directory where simple EDE project overlays are saved." :group 'ede
--- a/lisp/cedet/ede/speedbar.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede/speedbar.el Mon Sep 27 14:42:43 2010 +0900 @@ -108,7 +108,7 @@ ;;; Some special commands useful in EDE ;; (defun ede-speedbar-remove-file-from-target () - "Remove the file at point from it's target." + "Remove the file at point from its target." (interactive) (if (stringp (speedbar-line-token)) (progn
--- a/lisp/cedet/ede/srecode.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/ede/srecode.el Mon Sep 27 14:42:43 2010 +0900 @@ -43,7 +43,9 @@ (srecode-map-update-map t) ;; We don't call this unless we need it. Load in the templates. (srecode-load-tables-for-mode 'makefile-mode) - (srecode-load-tables-for-mode 'makefile-mode 'ede)) + (srecode-load-tables-for-mode 'makefile-mode 'ede) + (srecode-load-tables-for-mode 'autoconf-mode) + (srecode-load-tables-for-mode 'autoconf-mode 'ede)) (defmacro ede-srecode-insert-with-dictionary (template &rest forms) "Insert TEMPLATE after executing FORMS with a dictionary.
--- a/lisp/cedet/pulse.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/pulse.el Mon Sep 27 14:42:43 2010 +0900 @@ -3,6 +3,7 @@ ;;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <eric@siege-engine.com> +;; Version: 1.0 ;; This file is part of GNU Emacs. @@ -57,10 +58,14 @@ (error nil))) (defcustom pulse-flag (pulse-available-p) - "*Non-nil means to pulse the overlay face for momentary highlighting. -Pulsing involves a bright highlight that slowly shifts to the background -color. Non-nil just means to highlight with an unchanging color for a short -time. + "Whether to use pulsing for momentary highlighting. +Pulsing involves a bright highlight that slowly shifts to the +background color. + +If the value is nil, highlight with an unchanging color until a +key is pressed. +If the value is `never', do no coloring at all. +Any other value means to the default pulsing behavior. If `pulse-flag' is non-nil, but `pulse-available-p' is nil, then this flag is ignored." @@ -178,22 +183,23 @@ Optional argument FACE specifies the fact to do the highlighting." (overlay-put o 'original-face (overlay-get o 'face)) (add-to-list 'pulse-momentary-overlay o) - (if (or (not pulse-flag) (not (pulse-available-p))) - ;; Provide a face... clear on next command - (progn - (overlay-put o 'face (or face 'pulse-highlight-start-face)) - (add-hook 'pre-command-hook - 'pulse-momentary-unhighlight) - ) - ;; pulse it. - (unwind-protect + (if (eq pulse-flag 'never) + nil + (if (or (not pulse-flag) (not (pulse-available-p))) + ;; Provide a face... clear on next command (progn - (overlay-put o 'face 'pulse-highlight-face) - ;; The pulse function puts FACE onto 'pulse-highlight-face. - ;; Thus above we put our face on the overlay, but pulse - ;; with a reference face needed for the color. - (pulse face)) - (pulse-momentary-unhighlight)))) + (overlay-put o 'face (or face 'pulse-highlight-start-face)) + (add-hook 'pre-command-hook + 'pulse-momentary-unhighlight)) + ;; pulse it. + (unwind-protect + (progn + (overlay-put o 'face 'pulse-highlight-face) + ;; The pulse function puts FACE onto 'pulse-highlight-face. + ;; Thus above we put our face on the overlay, but pulse + ;; with a reference face needed for the color. + (pulse face)) + (pulse-momentary-unhighlight))))) (defun pulse-momentary-unhighlight () "Unhighlight a line recently highlighted."
--- a/lisp/cedet/semantic.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic.el Mon Sep 27 14:42:43 2010 +0900 @@ -5,7 +5,7 @@ ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: syntax tools -;; Version: 2.0pre7 +;; Version: 2.0 ;; This file is part of GNU Emacs. @@ -39,7 +39,7 @@ (require 'semantic/tag) (require 'semantic/lex) -(defvar semantic-version "2.0pre7" +(defvar semantic-version "2.0" "Current version of Semantic.") (declare-function inversion-test "inversion") @@ -876,6 +876,7 @@ ;; (define-key km "i" 'senator-isearch-toggle-semantic-mode) (define-key map "\C-c,j" 'semantic-complete-jump-local) (define-key map "\C-c,J" 'semantic-complete-jump) + (define-key map "\C-c,m" 'semantic-complete-jump-local-members) (define-key map "\C-c,g" 'semantic-symref-symbol) (define-key map "\C-c,G" 'semantic-symref) (define-key map "\C-c,p" 'senator-previous-tag) @@ -886,6 +887,7 @@ (define-key map "\C-c,\M-w" 'senator-copy-tag) (define-key map "\C-c,\C-y" 'senator-yank-tag) (define-key map "\C-c,r" 'senator-copy-tag-to-register) + (define-key map "\C-c,," 'semantic-force-refresh) (define-key map [?\C-c ?, up] 'senator-transpose-tags-up) (define-key map [?\C-c ?, down] 'senator-transpose-tags-down) (define-key map "\C-c,l" 'semantic-analyze-possible-completions) @@ -951,6 +953,9 @@ (define-key navigate-menu [semantic-complete-jump] '(menu-item "Find Tag Globally..." semantic-complete-jump :help "Read a tag name and find it in the current project")) + (define-key navigate-menu [semantic-complete-jump-local-members] + '(menu-item "Find Local Members ..." semantic-complete-jump-local-members + :help "Read a tag name and find a local member with that name")) (define-key navigate-menu [semantic-complete-jump-local] '(menu-item "Find Tag in This Buffer..." semantic-complete-jump-local :help "Read a tag name and find it in this buffer"))
--- a/lisp/cedet/semantic/analyze.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/analyze.el Mon Sep 27 14:42:43 2010 +0900 @@ -253,7 +253,7 @@ (tag nil) ; tag return list (tagtype nil) ; tag types return list (fname nil) - (miniscope (clone scope)) + (miniscope (when scope (clone scope))) ) ;; First order check. Is this wholely contained in the typecache? (setq tmp (semanticdb-typecache-find sequence)) @@ -297,11 +297,12 @@ ;; and we can use it directly. (cond ((semantic-tag-of-class-p tmp 'type) ;; update the miniscope when we need to analyze types directly. - (let ((rawscope - (apply 'append - (mapcar 'semantic-tag-type-members - tagtype)))) - (oset miniscope fullscope rawscope)) + (when miniscope + (let ((rawscope + (apply 'append + (mapcar 'semantic-tag-type-members + tagtype)))) + (oset miniscope fullscope rawscope))) ;; Now analayze the type to remove metatypes. (or (semantic-analyze-type tmp miniscope) tmp)) @@ -351,7 +352,7 @@ additional tags which are in SCOPE and do not need prefixing to find. -This is a wrapper on top of semanticdb, semanticdb-typecache, +This is a wrapper on top of semanticdb, semanticdb typecache, semantic-scope, and semantic search functions. Almost all searches use the same arguments." (let ((namelst (if (consp name) name ;; test if pre-split.
--- a/lisp/cedet/semantic/analyze/complete.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/analyze/complete.el Mon Sep 27 14:42:43 2010 +0900 @@ -63,11 +63,15 @@ ;;; MAIN completion calculator ;; ;;;###autoload -(define-overloadable-function semantic-analyze-possible-completions (context) +(define-overloadable-function semantic-analyze-possible-completions (context &rest flags) "Return a list of semantic tags which are possible completions. CONTEXT is either a position (such as point), or a precalculated context. Passing in a context is useful if the caller also needs to access parts of the analysis. +The remaining FLAGS arguments are passed to the mode specific completion engine. +Bad flags should be ignored by modes that don't use them. +See `semantic-analyze-possible-completions-default' for details on the default FLAGS. + Completions run through the following filters: * Elements currently in scope * Constants currently in scope @@ -98,9 +102,13 @@ (get-buffer-window "*Possible Completions*"))) ans))) -(defun semantic-analyze-possible-completions-default (context) +(defun semantic-analyze-possible-completions-default (context &optional flags) "Default method for producing smart completions. -Argument CONTEXT is an object specifying the locally derived context." +Argument CONTEXT is an object specifying the locally derived context. +The optional argument FLAGS changes which return options are returned. +FLAGS can be any number of: + 'no-tc - do not apply data-type constraint. + 'no-unique - do not apply unique by name filtering." (let* ((a context) (desired-type (semantic-analyze-type-constraint a)) (desired-class (oref a prefixclass)) @@ -109,8 +117,13 @@ (completetext nil) (completetexttype nil) (scope (oref a scope)) - (localvar (oref scope localvar)) - (c nil)) + (localvar (when scope (oref scope localvar))) + (origc nil) + (c nil) + (any nil) + (do-typeconstraint (not (memq 'no-tc flags))) + (do-unique (not (memq 'no-unique flags))) + ) ;; Calculate what our prefix string is so that we can ;; find all our matching text. @@ -160,33 +173,36 @@ ;; Argument list and local variables (semantic-find-tags-for-completion completetext localvar) ;; The current scope - (semantic-find-tags-for-completion completetext (oref scope fullscope)) + (semantic-find-tags-for-completion completetext (when scope (oref scope fullscope))) ;; The world (semantic-analyze-find-tags-by-prefix completetext)) ) ) - (let ((origc c) + (let ((loopc c) (dtname (semantic-tag-name desired-type))) + ;; Save off our first batch of completions + (setq origc c) + ;; Reset c. (setq c nil) ;; Loop over all the found matches, and catagorize them ;; as being possible features. - (while origc + (while (and loopc do-typeconstraint) (cond ;; Strip operators - ((semantic-tag-get-attribute (car origc) :operator-flag) + ((semantic-tag-get-attribute (car loopc) :operator-flag) nil ) ;; If we are completing from within some prefix, ;; then we want to exclude constructors and destructors ((and completetexttype - (or (semantic-tag-get-attribute (car origc) :constructor-flag) - (semantic-tag-get-attribute (car origc) :destructor-flag))) + (or (semantic-tag-get-attribute (car loopc) :constructor-flag) + (semantic-tag-get-attribute (car loopc) :destructor-flag))) nil ) @@ -197,17 +213,17 @@ ;; Ok, we now have a completion list based on the text we found ;; we want to complete on. Now filter that stream against the ;; type we want to search for. - ((string= dtname (semantic-analyze-type-to-name (semantic-tag-type (car origc)))) - (setq c (cons (car origc) c)) + ((string= dtname (semantic-analyze-type-to-name (semantic-tag-type (car loopc)))) + (setq c (cons (car loopc) c)) ) ;; Now anything that is a compound type which could contain ;; additional things which are of the desired type - ((semantic-tag-type (car origc)) - (let ((att (semantic-analyze-tag-type (car origc) scope)) + ((semantic-tag-type (car loopc)) + (let ((att (semantic-analyze-tag-type (car loopc) scope)) ) (if (and att (semantic-tag-type-members att)) - (setq c (cons (car origc) c)))) + (setq c (cons (car loopc) c)))) ) ) ; cond @@ -215,11 +231,11 @@ ;; No desired type, no other restrictions. Just add. (t - (setq c (cons (car origc) c))) + (setq c (cons (car loopc) c))) ); cond - (setq origc (cdr origc))) + (setq loopc (cdr loopc))) (when desired-type ;; Some types, like the enum in C, have special constant values that @@ -241,15 +257,16 @@ (when desired-class (setq c (semantic-analyze-tags-of-class-list c desired-class))) - ;; Pull out trash. - ;; NOTE TO SELF: Is this too slow? - ;; OTHER NOTE: Do we not want to strip duplicates by name and - ;; only by position? When are duplicate by name but not by tag - ;; useful? - (setq c (semantic-unique-tag-table-by-name c)) + (if do-unique + (if c + ;; Pull out trash. + ;; NOTE TO SELF: Is this too slow? + (setq c (semantic-unique-tag-table-by-name c)) + (setq c (semantic-unique-tag-table-by-name origc))) + (when (not c) + (setq c origc))) ;; All done! - c)) (provide 'semantic/analyze/complete)
--- a/lisp/cedet/semantic/analyze/debug.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/analyze/debug.el Mon Sep 27 14:42:43 2010 +0900 @@ -54,6 +54,8 @@ )) +;; @TODO - If this happens, but the last found type is +;; a datatype, then the below is wrong (defun semantic-analyzer-debug-found-prefix (ctxt) "Debug the prefix found by the analyzer output CTXT." (let* ((pf (oref ctxt prefix)) @@ -97,7 +99,7 @@ ) (with-output-to-temp-buffer (help-buffer) (with-current-buffer standard-output - (princ "Unable to find prefix ") + (princ "Unable to find symbol ") (princ prefix) (princ ".\n\n") @@ -217,7 +219,7 @@ (when (not dt) (error "Missing Innertype debugger is confused")) (with-output-to-temp-buffer (help-buffer) (with-current-buffer standard-output - (princ "Cannot find prefix \"") + (princ "Cannot find symbol \"") (princ prefixitem) (princ "\" in datatype: ") @@ -550,24 +552,25 @@ (let ((str (semantic-format-tag-prototype tag parent))) (if (and (semantic-tag-with-position-p tag) (semantic-tag-file-name tag)) - (insert-button str - 'mouse-face 'custom-button-pressed-face - 'tag tag - 'action - `(lambda (button) - (let ((buff nil) - (pnt nil)) - (save-excursion - (semantic-go-to-tag - (button-get button 'tag)) - (setq buff (current-buffer)) - (setq pnt (point))) - (if (get-buffer-window buff) - (select-window (get-buffer-window buff)) - (pop-to-buffer buff t)) - (goto-char pnt) - (pulse-line-hook-function))) - ) + (with-current-buffer standard-output + (insert-button str + 'mouse-face 'custom-button-pressed-face + 'tag tag + 'action + `(lambda (button) + (let ((buff nil) + (pnt nil)) + (save-excursion + (semantic-go-to-tag + (button-get button 'tag)) + (setq buff (current-buffer)) + (setq pnt (point))) + (if (get-buffer-window buff) + (select-window (get-buffer-window buff)) + (pop-to-buffer buff t)) + (goto-char pnt) + (pulse-line-hook-function))) + )) (princ "\"") (princ str) (princ "\""))
--- a/lisp/cedet/semantic/analyze/refs.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/analyze/refs.el Mon Sep 27 14:42:43 2010 +0900 @@ -104,6 +104,7 @@ "Return the implementations derived in the reference analyzer REFS. Optional argument IN-BUFFER indicates that the returned tag should be in an active buffer." (let ((allhits (oref refs rawsearchdata)) + (tag (oref refs :tag)) (impl nil) ) (semanticdb-find-result-mapc @@ -113,7 +114,8 @@ (aT (cdr ans)) (aDB (car ans)) ) - (when (not (semantic-tag-prototype-p aT)) + (when (and (not (semantic-tag-prototype-p aT)) + (semantic-tag-similar-p tag aT :prototype-flag :parent)) (when in-buffer (save-excursion (semantic-go-to-tag aT aDB))) (push aT impl)))) allhits) @@ -123,6 +125,7 @@ "Return the prototypes derived in the reference analyzer REFS. Optional argument IN-BUFFER indicates that the returned tag should be in an active buffer." (let ((allhits (oref refs rawsearchdata)) + (tag (oref refs :tag)) (proto nil)) (semanticdb-find-result-mapc (lambda (T DB) @@ -131,7 +134,8 @@ (aT (cdr ans)) (aDB (car ans)) ) - (when (semantic-tag-prototype-p aT) + (when (and (semantic-tag-prototype-p aT) + (semantic-tag-similar-p tag aT :prototype-flag :parent)) (when in-buffer (save-excursion (semantic-go-to-tag aT aDB))) (push aT proto)))) allhits) @@ -142,8 +146,8 @@ (defun semantic--analyze-refs-full-lookup (tag scope) "Perform a full lookup for all occurrences of TAG in the current project. TAG should be the tag currently under point. -PARENT is the list of tags that are parents to TAG by -containment, as opposed to reference." +SCOPE is the scope the cursor is in. From this a list of parents is +derived. If SCOPE does not have parents, then only a simple lookup is done." (if (not (oref scope parents)) ;; If this tag has some named parent, but is not (semantic--analyze-refs-full-lookup-simple tag) @@ -177,20 +181,36 @@ ans)) (defun semantic--analyze-refs-find-tags-with-parent (find-results parents) - "Find in FIND-RESULTS all tags with PARNTS. + "Find in FIND-RESULTS all tags with PARENTS. NAME is the name of the tag needing finding. PARENTS is a list of names." - (let ((ans nil)) + (let ((ans nil) (usingnames nil)) + ;; Loop over the find-results passed in. (semanticdb-find-result-mapc (lambda (tag db) (let* ((p (semantic-tag-named-parent tag)) - (ps (when (stringp p) - (semantic-analyze-split-name p)))) + (ps (when (stringp p) (semantic-analyze-split-name p)))) (when (stringp ps) (setq ps (list ps))) - (when (and ps (equal ps parents)) - ;; We could optimize this, but it seems unlikely. - (push (list db tag) ans)) - )) + (when ps + ;; If there is a perfect match, then use it. + (if (equal ps parents) + (push (list db tag) ans)) + ;; No match, find something from our list of using names. + ;; Do we need to split UN? + (save-excursion + (semantic-go-to-tag tag db) + (setq usingnames nil) + (let ((imports (semantic-ctxt-imported-packages))) + ;; Derive the names from all the using statements. + (mapc (lambda (T) + (setq usingnames + (cons (semantic-format-tag-name-from-anything T) usingnames))) + imports)) + (dolist (UN usingnames) + (when (equal (cons UN ps) parents) + (push (list db tag) ans) + (setq usingnames (cdr usingnames)))) + )))) find-results) ans)) @@ -206,7 +226,7 @@ ;; Find all hits for the first parent name. (brute (semanticdb-find-tags-collector (lambda (table tags) - (semanticdb-find-tags-by-name-method table name tags) + (semanticdb-deep-find-tags-by-name-method table name tags) ) nil nil t)) ;; Prime the answer. @@ -214,6 +234,7 @@ ) ;; First parent is already search to initialize "brute". (setq plist (cdr plist)) + ;; Go through the list of parents, and try to find matches. ;; As we cycle through plist, for each level look for NAME, ;; and compare the named-parent, and also dive into the next item of @@ -253,7 +274,8 @@ (lambda (table tags) (semanticdb-find-tags-by-name-method table name tags) ) - nil nil t)) + nil ;; This may need to be the entire project?? + nil t)) ) (when (and (not brute) (not noerror))
--- a/lisp/cedet/semantic/bovine/c.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/bovine/c.el Mon Sep 27 14:42:43 2010 +0900 @@ -39,6 +39,7 @@ (declare-function semantic-brute-find-tag-by-attribute "semantic/find") (declare-function semanticdb-minor-mode-p "semantic/db-mode") (declare-function semanticdb-needs-refresh-p "semantic/db") +(declare-function semanticdb-typecache-faux-namespace "semantic/db-typecache") (declare-function c-forward-conditional "cc-cmds") (declare-function ede-system-include-path "ede") @@ -158,7 +159,7 @@ Each entry is a cons cell like this: ( \"KEYWORD\" . \"REPLACEMENT\" ) Where KEYWORD is the macro that gets replaced in the lexical phase, -and REPLACEMENT is a string that is inserted in it's place. Empty string +and REPLACEMENT is a string that is inserted in its place. Empty string implies that the lexical analyzer will discard KEYWORD when it is encountered. Alternately, it can be of the form: @@ -295,6 +296,7 @@ (cond ((looking-at "^\\s-*#\\s-*if") ;; We found a nested if. Skip it. + ;; @TODO - can we use the new c-scan-conditionals (c-forward-conditional 1)) ((looking-at "^\\s-*#\\s-*elif") ;; We need to let the preprocessor analize this one. @@ -348,7 +350,6 @@ ;; (message "%s %s yes" ift sym) (beginning-of-line) (setq pt (point)) - ;;(c-forward-conditional 1) ;; This skips only a section of a conditional. Once that section ;; is opened, encountering any new #else or related conditional ;; should be skipped. @@ -356,8 +357,8 @@ (setq semantic-lex-end-point (point)) (semantic-push-parser-warning (format "Skip #%s %s" ift sym) pt (point)) -;; (semantic-lex-push-token -;; (semantic-lex-token 'c-preprocessor-skip pt (point))) + ;; (semantic-lex-push-token + ;; (semantic-lex-token 'c-preprocessor-skip pt (point))) nil) ;; Else, don't ignore it, but do handle the internals. ;;(message "%s %s no" ift sym) @@ -703,58 +704,60 @@ (symtext (semantic-lex-token-text lexicaltoken)) (macros (get-text-property 0 'macros symtext)) ) - (with-current-buffer buf - (erase-buffer) - (when (not (eq major-mode mode)) - (save-match-data + (if (> semantic-c-parse-token-hack-depth 5) + nil + (with-current-buffer buf + (erase-buffer) + (when (not (eq major-mode mode)) + (save-match-data - ;; Protect against user hooks throwing errors. - (condition-case nil - (funcall mode) - (error - (if (y-or-n-p - (format "There was an error initializing %s in buffer \"%s\". Debug your hooks? " - mode (buffer-name))) - (semantic-c-debug-mode-init mode) - (message "Macro parsing state may be broken...") - (sit-for 1)))) - ) ; save match data + ;; Protect against user hooks throwing errors. + (condition-case nil + (funcall mode) + (error + (if (y-or-n-p + (format "There was an error initializing %s in buffer \"%s\". Debug your hooks? " + mode (buffer-name))) + (semantic-c-debug-mode-init mode) + (message "Macro parsing state may be broken...") + (sit-for 1)))) + ) ; save match data - ;; Hack in mode-local - (activate-mode-local-bindings) - ;; CHEATER! The following 3 lines are from - ;; `semantic-new-buffer-fcn', but we don't want to turn - ;; on all the other annoying modes for this little task. - (setq semantic-new-buffer-fcn-was-run t) - (semantic-lex-init) - (semantic-clear-toplevel-cache) - (remove-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook - t) - ) - ;; Get the macro symbol table right. - (setq semantic-lex-spp-dynamic-macro-symbol-obarray spp-syms) - ;; (message "%S" macros) - (dolist (sym macros) - (semantic-lex-spp-symbol-set (car sym) (cdr sym))) + ;; Hack in mode-local + (activate-mode-local-bindings) + ;; CHEATER! The following 3 lines are from + ;; `semantic-new-buffer-fcn', but we don't want to turn + ;; on all the other annoying modes for this little task. + (setq semantic-new-buffer-fcn-was-run t) + (semantic-lex-init) + (semantic-clear-toplevel-cache) + (remove-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook + t) + ) + ;; Get the macro symbol table right. + (setq semantic-lex-spp-dynamic-macro-symbol-obarray spp-syms) + ;; (message "%S" macros) + (dolist (sym macros) + (semantic-lex-spp-symbol-set (car sym) (cdr sym))) - (insert symtext) + (insert symtext) - (setq stream - (semantic-parse-region-default - (point-min) (point-max) nonterminal depth returnonerror)) + (setq stream + (semantic-parse-region-default + (point-min) (point-max) nonterminal depth returnonerror)) - ;; Clean up macro symbols - (dolist (sym macros) - (semantic-lex-spp-symbol-remove (car sym))) + ;; Clean up macro symbols + (dolist (sym macros) + (semantic-lex-spp-symbol-remove (car sym))) - ;; Convert the text of the stream. - (dolist (tag stream) - ;; Only do two levels here 'cause I'm lazy. - (semantic--tag-set-overlay tag (list start end)) - (dolist (stag (semantic-tag-components-with-overlays tag)) - (semantic--tag-set-overlay stag (list start end)) - )) - ) + ;; Convert the text of the stream. + (dolist (tag stream) + ;; Only do two levels here 'cause I'm lazy. + (semantic--tag-set-overlay tag (list start end)) + (dolist (stag (semantic-tag-components-with-overlays tag)) + (semantic--tag-set-overlay stag (list start end)) + )) + )) stream)) (defvar semantic-c-debug-mode-init-last-mode nil @@ -920,8 +923,34 @@ ;; of type "typedef". ;; Each elt of NAME is ( STARS NAME ) (let ((vl nil) - (names (semantic-tag-name tag))) + (names (semantic-tag-name tag)) + (super (semantic-tag-get-attribute tag :superclasses)) + (addlast nil)) + + (when (and (semantic-tag-of-type-p tag "typedef") + (semantic-tag-of-class-p super 'type) + (semantic-tag-type-members super)) + ;; This is a typedef of a real type. Extract + ;; the super class, and stick it into the tags list. + (setq addlast super) + + ;; Clone super and remove the members IFF super has a name. + ;; Note: anonymous struct/enums that are typedef'd shouldn't + ;; exist in the top level type list, so they will appear only + ;; in the :typedef slot of the typedef. + (setq super (semantic-tag-clone super)) + (if (not (string= (semantic-tag-name super) "")) + (semantic-tag-put-attribute super :members nil) + (setq addlast nil)) + + ;; Add in props to the full superclass. + (when addlast + (semantic--tag-copy-properties tag addlast) + (semantic--tag-set-overlay addlast (semantic-tag-overlay tag))) + ) + (while names + (setq vl (cons (semantic-tag-new-type (nth 1 (car names)) ; name "typedef" @@ -938,16 +967,18 @@ ;; is expanded out as. Just the ;; name shows up as a parent of this ;; typedef. - :typedef - (semantic-tag-get-attribute tag :superclasses) + :typedef super ;;(semantic-tag-type-superclasses tag) :documentation (semantic-tag-docstring tag)) vl)) (semantic--tag-copy-properties tag (car vl)) - (semantic--tag-set-overlay (car vl) - (semantic-tag-overlay tag)) + (semantic--tag-set-overlay (car vl) (semantic-tag-overlay tag)) (setq names (cdr names))) + + ;; Add typedef superclass last. + (when addlast (setq vl (cons addlast vl))) + vl)) ((and (listp (car tag)) (semantic-tag-of-class-p (car tag) 'variable)) @@ -999,6 +1030,7 @@ (car tokenpart))) (and (stringp (car (nth 2 tokenpart))) (string= (car (nth 2 tokenpart)) (car tokenpart))) + (nth 10 tokenpart) ; initializers ) (not (car (nth 3 tokenpart))))) (fcnpointer (string-match "^\\*" (car tokenpart))) @@ -1029,7 +1061,10 @@ (semantic-tag-new-type ;; name (or (car semantic-c-classname) - (car (nth 2 tokenpart))) + (let ((split (semantic-analyze-split-name-c-mode + (car (nth 2 tokenpart))))) + (if (stringp split) split + (car (last split))))) ;; type (or (cdr semantic-c-classname) "class") @@ -1580,6 +1615,48 @@ tagreturn )) +(define-mode-local-override semantic-ctxt-imported-packages c++-mode (&optional point) + "Return the list of using tag types in scope of POINT." + (when point (goto-char (point))) + (let ((tagsaroundpoint (semantic-find-tag-by-overlay)) + (namereturn nil) + (tmp nil) + ) + ;; Collect using statements from the top level. + (setq tmp (semantic-find-tags-by-class 'using (current-buffer))) + (dolist (T tmp) (setq namereturn (cons (semantic-tag-type T) namereturn))) + ;; Move through the tags around point looking for more using statements + (while (cdr tagsaroundpoint) ; don't search the last one + (setq tmp (semantic-find-tags-by-class 'using (semantic-tag-components (car tagsaroundpoint)))) + (dolist (T tmp) (setq namereturn (cons (semantic-tag-type T) namereturn))) + (setq tagsaroundpoint (cdr tagsaroundpoint)) + ) + namereturn)) + +(define-mode-local-override semanticdb-expand-nested-tag c++-mode (tag) + "Expand TAG if it has a fully qualified name. +For types with a :parent, create faux namespaces to put TAG into." + (let ((p (semantic-tag-get-attribute tag :parent))) + (if (and p (semantic-tag-of-class-p tag 'type)) + ;; Expand the tag + (let ((s (semantic-analyze-split-name p)) + (newtag (semantic-tag-copy tag nil t))) + ;; Erase the qualified name. + (semantic-tag-put-attribute newtag :parent nil) + ;; Fixup the namespace name + (setq s (if (stringp s) (list s) (nreverse s))) + ;; Loop over all the parents, creating the nested + ;; namespace. + (require 'semantic/db-typecache) + (dolist (namespace s) + (setq newtag (semanticdb-typecache-faux-namespace + namespace (list newtag))) + ) + ;; Return the last created namespace. + newtag) + ;; Else, return tag unmodified. + tag))) + (define-mode-local-override semantic-get-local-variables c++-mode () "Do what `semantic-get-local-variables' does, plus add `this' if needed." (let* ((origvar (semantic-get-local-variables-default)) @@ -1759,7 +1836,9 @@ (princ "\n") )) - (when (arrayp semantic-lex-spp-project-macro-symbol-obarray) + (when (and (boundp 'ede-object) + ede-object + (arrayp semantic-lex-spp-project-macro-symbol-obarray)) (princ "\n Project symbol map:\n") (when (and (boundp 'ede-object) ede-object) (princ " Your project symbol map is derived from the EDE object:\n ")
--- a/lisp/cedet/semantic/complete.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/complete.el Mon Sep 27 14:42:43 2010 +0900 @@ -1206,6 +1206,27 @@ (require 'semantic/db-find) (semanticdb-brute-deep-find-tags-for-completion prefix (oref obj path))) +;;; Current Datatype member search. +(defclass semantic-collector-local-members (semantic-collector-project-abstract) + ((scope :initform nil + :type (or null semantic-scope-cache) + :documentation + "The scope the local members are being completed from.")) + "Completion engine for tags in a project.") + +(defmethod semantic-collector-calculate-completions-raw + ((obj semantic-collector-local-members) prefix completionlist) + "Calculate the completions for prefix from completionlist." + (let* ((scope (or (oref obj scope) + (oset obj scope (semantic-calculate-scope)))) + (localstuff (oref scope scope))) + (list + (cons + (oref scope :table) + (semantic-find-tags-for-completion prefix localstuff))))) + ;(semanticdb-brute-deep-find-tags-for-completion prefix (oref obj path)))) + +;;; Smart completion collector (defclass semantic-collector-analyze-completions (semantic-collector-abstract) ((context :initarg :context :type semantic-analyze-context @@ -1800,6 +1821,28 @@ history) ) +(defun semantic-complete-read-tag-local-members (prompt &optional + default-tag + initial-input + history) + "Ask for a tag by name from the local type members. +Available tags are from the the current scope. +Completion options are presented in a traditional way, with highlighting +to resolve same-name collisions. +PROMPT is a string to prompt with. +DEFAULT-TAG is a semantic tag or string to use as the default value. +If INITIAL-INPUT is non-nil, insert it in the minibuffer initially. +HISTORY is a symbol representing a variable to store the history in." + (semantic-complete-read-tag-engine + (semantic-collector-local-members prompt :buffer (current-buffer)) + (semantic-displayor-traditional-with-focus-highlight "simple") + ;;(semantic-displayor-tooltip "simple") + prompt + default-tag + initial-input + history) + ) + (defun semantic-complete-read-tag-project (prompt &optional default-tag initial-input @@ -1979,7 +2022,7 @@ ;;;###autoload (defun semantic-complete-jump-local () - "Jump to a semantic symbol." + "Jump to a local semantic symbol." (interactive) (let ((tag (semantic-complete-read-tag-buffer-deep "Jump to symbol: "))) (when (semantic-tag-p tag) @@ -2005,6 +2048,23 @@ (semantic-tag-name tag))))) ;;;###autoload +(defun semantic-complete-jump-local-members () + "Jump to a semantic symbol." + (interactive) + (let* ((tag (semantic-complete-read-tag-local-members "Jump to symbol: "))) + (when (semantic-tag-p tag) + (let ((start (condition-case nil (semantic-tag-start tag) + (error nil)))) + (unless start + (error "Tag %s has no location" (semantic-format-tag-prototype tag))) + (push-mark) + (goto-char start) + (semantic-momentary-highlight-tag tag) + (message "%S: %s " + (semantic-tag-class tag) + (semantic-tag-name tag)))))) + +;;;###autoload (defun semantic-complete-analyze-and-replace () "Perform prompt completion to do in buffer completion. `semantic-analyze-possible-completions' is used to determine the @@ -2075,15 +2135,17 @@ ;; Prepare for doing completion, but exit quickly if there is keyboard ;; input. - (when (and (not (semantic-exit-on-input 'csi - (semantic-fetch-tags) - (semantic-throw-on-input 'csi) - nil)) - (= arg 1) - (not (semantic-exit-on-input 'csi - (semantic-analyze-current-context) - (semantic-throw-on-input 'csi) - nil))) + (when (save-window-excursion + (save-excursion + (and (not (semantic-exit-on-input 'csi + (semantic-fetch-tags) + (semantic-throw-on-input 'csi) + nil)) + (= arg 1) + (not (semantic-exit-on-input 'csi + (semantic-analyze-current-context) + (semantic-throw-on-input 'csi) + nil))))) (condition-case nil (semantic-complete-analyze-inline) ;; Ignore errors. Seems likely that we'll get some once in a while.
--- a/lisp/cedet/semantic/ctxt.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/ctxt.el Mon Sep 27 14:42:43 2010 +0900 @@ -599,12 +599,18 @@ "Return a list of scoped types by name for the current context at POINT. This is very different for various languages, and does nothing unless overridden." - (if point (goto-char point)) - (let ((case-fold-search semantic-case-fold)) - ;; We need to look at TYPES within the bounds of locally parse arguments. - ;; C needs to find using statements and the like too. Bleh. - nil - )) + nil) + +(define-overloadable-function semantic-ctxt-imported-packages (&optional point) + "Return a list of package tags or names which are being imported at POINT. +The return value is a list of strings which are package names +that are implied in code. Thus a C++ symbol: + foo::bar(); +where there is a statement such as: + using baz; +means that the first symbol might be: + baz::foo::bar();" + nil) (provide 'semantic/ctxt)
--- a/lisp/cedet/semantic/db-file.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/db-file.el Mon Sep 27 14:42:43 2010 +0900 @@ -245,7 +245,7 @@ ;; @todo - It should ask if we are not called from a hook. ;; How? (if (or supress-questions - (y-or-n-p (format "Skip Error: %S ?" (car (cdr foo))))) + (y-or-n-p (format "Skip Error: %s ?" (car (cdr foo))))) (message "Save Error: %S: %s" (car (cdr foo)) objname) (error "%S" (car (cdr foo))))))))
--- a/lisp/cedet/semantic/db-find.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/db-find.el Mon Sep 27 14:42:43 2010 +0900 @@ -202,7 +202,7 @@ (when (oref idx type-cache) (semantic-reset (oref idx type-cache))) ;; Clear the scope. Scope doesn't have the data it needs to track - ;; it's own reset. + ;; its own reset. (semantic-scope-reset-cache) ) @@ -262,13 +262,13 @@ "Translate PATH into a list of semantic tables. Path translation involves identifying the PATH input argument in one of the following ways: - nil - Take the current buffer, and use it's include list + nil - Take the current buffer, and use its include list buffer - Use that buffer's include list. filename - Use that file's include list. If the file is not in a buffer, see of there is a semanticdb table for it. If not, read that file into a buffer. tag - Get that tag's buffer of file file. See above. - table - Search that table, and it's include list. + table - Search that table, and its include list. find result - Search the results of a previous find. In addition, once the base path is found, there is the possibility of @@ -1006,9 +1006,14 @@ (when norm ;; The normalized tags can now be found based on that ;; tags table. - (semanticdb-set-buffer (car norm)) - ;; Now reset ans - (setq ans (cdr norm)) + (condition-case foo + (progn + (semanticdb-set-buffer (car norm)) + ;; Now reset ans + (setq ans (cdr norm))) + ;; Don't error for this case, but don't store + ;; the thing either. + (no-method-definition nil)) )) ) ;; Return the tag. @@ -1019,10 +1024,10 @@ FCN takes two arguments. The first is a TAG, and the second is a DB from whence TAG originated. Returns result." - (mapc (lambda (sublst) - (mapc (lambda (tag) - (funcall fcn tag (car sublst))) - (cdr sublst))) + (mapc (lambda (sublst-icky) + (mapc (lambda (tag-icky) + (funcall fcn tag-icky (car sublst-icky))) + (cdr sublst-icky))) result) result)
--- a/lisp/cedet/semantic/db-global.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/db-global.el Mon Sep 27 14:42:43 2010 +0900 @@ -93,7 +93,7 @@ '(omniscience)) ) (if dont-err-if-not-available - (message "No Global support in %s" default-directory) + nil; (message "No Global support in %s" default-directory) (error "No Global support in %s" default-directory)) ))
--- a/lisp/cedet/semantic/db-typecache.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/db-typecache.el Mon Sep 27 14:42:43 2010 +0900 @@ -217,6 +217,14 @@ (semanticdb-full-filename table) tags)) +(defun semanticdb-typecache-faux-namespace (name members) + "Create a new namespace tag with NAME and a set of MEMBERS. +The new tag will be a faux tag, used as a placeholder in a typecache." + (let ((tag (semantic-tag-new-type name "namespace" members nil))) + ;; Make sure we mark this as a fake tag. + (semantic-tag-set-faux tag) + tag)) + (defun semanticdb-typecache-merge-streams (cache1 cache2) "Merge into CACHE1 and CACHE2 together. The Caches will be merged in place." (if (or (and (not cache1) (not cache2)) @@ -256,23 +264,22 @@ (setq ans (cons next ans)) ;; ELSE - We have a NAME match. (setq type (semantic-tag-type next)) - (if (semantic-tag-of-type-p prev type) ; Are they the same datatype + (if (or (semantic-tag-of-type-p prev type) ; Are they the same datatype + (semantic-tag-faux-p prev) + (semantic-tag-faux-p next) ; or either a faux tag? + ) ;; Same Class, we can do a merge. (cond ((and (semantic-tag-of-class-p next 'type) (string= type "namespace")) ;; Namespaces - merge the children together. (setcar ans - (semantic-tag-new-type + (semanticdb-typecache-faux-namespace (semantic-tag-name prev) ; - they are the same - "namespace" ; - we know this as fact (semanticdb-typecache-merge-streams (semanticdb-typecache-safe-tag-members prev) (semanticdb-typecache-safe-tag-members next)) - nil ; - no attributes )) - ;; Make sure we mark this as a fake tag. - (semantic-tag-set-faux (car ans)) ) ((semantic-tag-prototype-p next) ;; NEXT is a prototype... so keep previous. @@ -299,6 +306,12 @@ ;;; Refresh / Query API ;; ;; Queries that can be made for the typecache. +(define-overloadable-function semanticdb-expand-nested-tag (tag) + "Expand TAG from fully qualified names. +If TAG has fully qualified names, expand it to a series of nested +namespaces instead." + tag) + (defmethod semanticdb-typecache-file-tags ((table semanticdb-abstract-table)) "No tags available from non-file based tables." nil) @@ -313,10 +326,13 @@ ;; Make sure our file-tags list is up to date. (when (not (oref cache filestream)) - (let ((tags (semantic-find-tags-by-class 'type table))) + (let ((tags (semantic-find-tags-by-class 'type table)) + (exptags nil)) (when tags (setq tags (semanticdb-typecache-safe-tag-list tags table)) - (oset cache filestream (semanticdb-typecache-merge-streams tags nil))))) + (dolist (T tags) + (push (semanticdb-expand-nested-tag T) exptags)) + (oset cache filestream (semanticdb-typecache-merge-streams exptags nil))))) ;; Return our cache. (oref cache filestream) @@ -372,6 +388,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Search Routines +;; ;;;###autoload (define-overloadable-function semanticdb-typecache-find (type &optional path find-file-match) "Search the typecache for TYPE in PATH. @@ -386,16 +403,20 @@ PATH is the search path, which should be one table object. If FIND-FILE-MATCH is non-nil, then force the file belonging to the found tag to be loaded." - (semanticdb-typecache-find-method (or path semanticdb-current-table) - type find-file-match)) + (if (not (and (featurep 'semanticdb) semanticdb-current-database)) + nil ;; No DB, no search + (save-excursion + (semanticdb-typecache-find-method (or path semanticdb-current-table) + type find-file-match)))) (defun semanticdb-typecache-find-by-name-helper (name table) "Find the tag with NAME in TABLE, which is from a typecache. If more than one tag has NAME in TABLE, we will prefer the tag that is of class 'type." (let* ((names (semantic-find-tags-by-name name table)) - (types (semantic-find-tags-by-class 'type names))) - (or (car-safe types) (car-safe names)))) + (nmerge (semanticdb-typecache-merge-streams names nil)) + (types (semantic-find-tags-by-class 'type nmerge))) + (or (car-safe types) (car-safe nmerge)))) (defmethod semanticdb-typecache-find-method ((table semanticdb-abstract-table) type find-file-match)
--- a/lisp/cedet/semantic/db.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/db.el Mon Sep 27 14:42:43 2010 +0900 @@ -542,10 +542,25 @@ is not in a buffer. Avoid using FORCE for most uses, as an old cache may be sufficient for the general case. Forced updates can be slow. This will call `semantic-fetch-tags' if that file is in memory." - (when (or (semanticdb-in-buffer-p obj) force) + (cond + ;; + ;; Already in a buffer, just do it. + ((semanticdb-in-buffer-p obj) + (semanticdb-set-buffer obj) + (semantic-fetch-tags)) + ;; + ;; Not in a buffer. Forcing a load. + (force + ;; Patch from Iain Nicol. -- + ;; @TODO: I wonder if there is a way to recycle + ;; semanticdb-create-table-for-file-not-in-buffer (save-excursion - (semanticdb-set-buffer obj) - (semantic-fetch-tags)))) + (let ((buff (semantic-find-file-noselect + (semanticdb-full-filename obj)))) + (set-buffer buff) + (semantic-fetch-tags) + ;; Kill off the buffer if it didn't exist when we were called. + (kill-buffer buff)))))) (defmethod semanticdb-needs-refresh-p ((obj semanticdb-table)) "Return non-nil of OBJ's tag list is out of date. @@ -808,12 +823,14 @@ (setq root (run-hook-with-args-until-success 'semanticdb-project-root-functions dir)) - ;; Find roots based on strings - (while (and roots (not root)) - (let ((r (file-truename (car roots)))) - (if (string-match (concat "^" (regexp-quote r)) dir) - (setq root r))) - (setq roots (cdr roots))) + (if root + (setq root (file-truename root)) + ;; Else, Find roots based on strings + (while roots + (let ((r (file-truename (car roots)))) + (if (string-match (concat "^" (regexp-quote r)) dir) + (setq root r))) + (setq roots (cdr roots)))) ;; If no roots are found, use this directory. (unless root (setq root dir))
--- a/lisp/cedet/semantic/decorate.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/decorate.el Mon Sep 27 14:42:43 2010 +0900 @@ -45,7 +45,7 @@ )) (defun semantic-unhighlight-tag (tag) - "Unhighlight TAG, restoring it's previous face." + "Unhighlight TAG, restoring its previous face." (let ((o (semantic-tag-overlay tag))) (semantic-overlay-put o 'face (car (semantic-overlay-get o 'old-face))) (semantic-overlay-put o 'old-face (cdr (semantic-overlay-get o 'old-face)))
--- a/lisp/cedet/semantic/decorate/include.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/decorate/include.el Mon Sep 27 14:42:43 2010 +0900 @@ -118,7 +118,7 @@ '((((class color) (background dark)) (:background "#900000")) (((class color) (background light)) - (:background "#ff5050"))) + (:background "#fff0f0"))) "*Face used to show includes that cannot be found. Used by the decoration style: `semantic-decoration-on-unknown-includes'." :group 'semantic-faces) @@ -302,16 +302,19 @@ ) )) - (let ((ol (semantic-decorate-tag tag - (semantic-tag-start tag) - (semantic-tag-end tag) - face)) - ) - (semantic-overlay-put ol 'mouse-face 'highlight) - (semantic-overlay-put ol 'keymap map) - (semantic-overlay-put ol 'help-echo - "Header File : mouse-3 - Context menu") - ))) + ;; @TODO - if not a tag w/ a position, we need to get one. How? + + (when (semantic-tag-with-position-p tag) + (let ((ol (semantic-decorate-tag tag + (semantic-tag-start tag) + (semantic-tag-end tag) + face)) + ) + (semantic-overlay-put ol 'mouse-face 'highlight) + (semantic-overlay-put ol 'keymap map) + (semantic-overlay-put ol 'help-echo + "Header File : mouse-3 - Context menu") + )))) ;;; Regular Include Functions ;;
--- a/lisp/cedet/semantic/dep.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/dep.el Mon Sep 27 14:42:43 2010 +0900 @@ -208,7 +208,8 @@ mode 'semantic-dependency-system-include-path)) (edesys (when (and (featurep 'ede) ede-minor-mode ede-object) - (ede-system-include-path ede-object))) + (ede-system-include-path + (if (listp ede-object) (car ede-object) ede-object)))) (locp (mode-local-value mode 'semantic-dependency-include-path)) (found nil))
--- a/lisp/cedet/semantic/doc.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/doc.el Mon Sep 27 14:42:43 2010 +0900 @@ -78,7 +78,8 @@ (start (if starttag (semantic-tag-end starttag) (point-min)))) - (when (re-search-backward comment-start-skip start t) + (when (and comment-start-skip + (re-search-backward comment-start-skip start t)) ;; We found a comment that doesn't belong to the body ;; of a function. (semantic-doc-snarf-comment-for-tag nosnarf)))
--- a/lisp/cedet/semantic/fw.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/fw.el Mon Sep 27 14:42:43 2010 +0900 @@ -310,6 +310,17 @@ (find-file-noselect file nowarn rawfile wildcards))) )) +;;; Database restriction settings +;; +(defmacro semanticdb-without-unloaded-file-searches (forms) + "Execute FORMS with `unloaded' removed from the current throttle." + `(let ((semanticdb-find-default-throttle + (if (featurep 'semanticdb-find) + (remq 'unloaded semanticdb-find-default-throttle) + nil))) + ,forms)) +(put 'semanticdb-without-unloaded-file-searches 'lisp-indent-function 1) + ;; ;;; Editor goodies ;-) ;; ;;
--- a/lisp/cedet/semantic/grammar.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/grammar.el Mon Sep 27 14:42:43 2010 +0900 @@ -928,6 +928,12 @@ ;; If running interactively, eval declarations and epilogue ;; code, then pop to the buffer visiting the generated file. (eval-region (point) (point-max)) + ;; Loop over the defvars and eval them explicitly to force + ;; them to be evaluated and ready to use. + (goto-char (point-min)) + (while (re-search-forward "(defvar " nil t) + (eval-defun nil)) + ;; Move cursor to a logical spot in the generated code. (goto-char (point-min)) (pop-to-buffer (current-buffer)) ;; The generated code has been evaluated and updated into
--- a/lisp/cedet/semantic/html.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/html.el Mon Sep 27 14:42:43 2010 +0900 @@ -243,6 +243,7 @@ semantic-imenu-bucketize-file nil semantic-imenu-bucketize-type-members nil senator-step-at-start-end-tag-classes '(section) + senator-step-at-tag-classes '(section) semantic-stickyfunc-sticky-classes '(section) ) (semantic-install-function-overrides
--- a/lisp/cedet/semantic/ia.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/ia.el Mon Sep 27 14:42:43 2010 +0900 @@ -40,7 +40,8 @@ (require 'pulse) (eval-when-compile (require 'semantic/analyze) - (require 'semantic/analyze/refs)) + (require 'semantic/analyze/refs) + (require 'semantic/find)) (declare-function imenu--mouse-menu "imenu") @@ -57,14 +58,6 @@ :group 'semantic :type semantic-format-tag-custom-list) -(defvar semantic-ia-cache nil - "Cache of the last completion request. -Of the form ( POINT . COMPLETIONS ) where POINT is a location in the -buffer where the completion was requested. COMPLETONS is the list -of semantic tag names that provide logical completions from that -location.") -(make-variable-buffer-local 'semantic-ia-cache) - ;;; COMPLETION HELPER ;; ;; This overload function handles inserting a tag @@ -86,23 +79,16 @@ (insert "(")) (t nil)))) -(declare-function semantic-analyze-possible-completions - "semantic/analyze/complete") +(defalias 'semantic-ia-get-completions 'semantic-ia-get-completions-deprecated + "`Semantic-ia-get-completions' is obsolete. +Use `semantic-analyze-possible-completions' instead.") -(defun semantic-ia-get-completions (context point) - "Fetch the completion of CONTEXT at POINT. -Supports caching." - ;; Cache the current set of symbols so that we can get at - ;; them quickly the second time someone presses the - ;; complete button. - (let ((symbols - (if (and semantic-ia-cache - (= point (car semantic-ia-cache))) - (cdr semantic-ia-cache) - (semantic-analyze-possible-completions context)))) - ;; Set the cache - (setq semantic-ia-cache (cons point symbols)) - symbols)) +(defun semantic-ia-get-completions-deprecated (context point) + "A function to help transition away from `semantic-ia-get-completions'. +Return completions based on CONTEXT at POINT. +You should not use this, nor the aliased version. +Use `semantic-analyze-possible-completions' instead." + (semantic-analyze-possible-completions context)) ;;;###autoload (defun semantic-ia-complete-symbol (&optional pos) @@ -119,7 +105,7 @@ ;; ;; The second step derives completions from that context. (let* ((a (semantic-analyze-current-context pos)) - (syms (semantic-ia-get-completions a pos)) + (syms (semantic-analyze-possible-completions a)) (pre (car (reverse (oref a prefix))))) ;; If PRE was actually an already completed symbol, it doesn't ;; come in as a string, but as a tag instead. @@ -173,7 +159,7 @@ "Pop up a tooltip for completion at POINT." (interactive "d") (let* ((a (semantic-analyze-current-context point)) - (syms (semantic-ia-get-completions a point)) + (syms (semantic-analyze-possible-completions a)) (x (mod (- (current-column) (window-hscroll)) (window-width))) (y (save-excursion @@ -212,8 +198,48 @@ ;; tag associated with the current context. (semantic-analyze-interesting-tag ctxt))) ) - (when pf - (message "%s" (semantic-format-tag-summarize pf nil t))))) + (if pf + (message "%s" (semantic-format-tag-summarize pf nil t)) + (message "No summary info availalble")))) + +;;; Variants +;; +;; Show all variants for the symbol under point. + +;;;###autoload +(defun semantic-ia-show-variants (point) + "Display a list of all variants for the symbol under POINT." + (interactive "P") + (let* ((ctxt (semantic-analyze-current-context point)) + (comp nil)) + + ;; We really want to look at the function if we are on an + ;; argument. Are there some additional rules we care about for + ;; changing the CTXT we look at? + (when (semantic-analyze-context-functionarg-p ctxt) + (goto-char (cdr (oref ctxt bounds))) + (setq ctxt (semantic-analyze-current-context (point)))) + + ;; Get the "completion list", but remove ALL filters to get the master list + ;; of all the possible things. + (setq comp (semantic-analyze-possible-completions ctxt 'no-unique 'no-tc)) + + ;; Special case for a single type. List the constructors? + (when (and (= (length comp) 1) (semantic-tag-of-class-p (car comp) 'type)) + (setq comp (semantic-find-tags-by-name (semantic-tag-name (car comp)) + (semantic-tag-type-members (car comp))))) + + ;; Display the results. + (cond ((= (length comp) 0) + (message "No Variants found.")) + ((= (length comp) 1) + (message "%s" (semantic-format-tag-summarize (car comp) nil t))) + (t + (with-output-to-temp-buffer "*Symbol Variants*" + (semantic-analyze-princ-sequence comp "" (current-buffer))) + (shrink-window-if-larger-than-buffer + (get-buffer-window "*Symbol Variants*"))) + ))) ;;; FAST Jump ;; @@ -354,18 +380,21 @@ ;; The default tries to find a comment in front of the tag ;; and then strings off comment prefixes. (let ((doc (semantic-documentation-for-tag (car pf)))) - (with-output-to-temp-buffer "*TAG DOCUMENTATION*" - (princ "Tag: ") - (princ (semantic-format-tag-prototype (car pf))) - (princ "\n") - (princ "\n") - (princ "Snarfed Documentation: ") - (princ "\n") - (princ "\n") - (if doc - (princ doc) - (princ " Documentation unavailable.")) - ))) + (if (or (null doc) (string= doc "")) + (message "Doc unavailable for: %s" + (semantic-format-tag-prototype (car pf))) + (with-output-to-temp-buffer "*TAG DOCUMENTATION*" + (princ "Tag: ") + (princ (semantic-format-tag-prototype (car pf))) + (princ "\n") + (princ "\n") + (princ "Snarfed Documentation: ") + (princ "\n") + (princ "\n") + (if doc + (princ doc) + (princ " Documentation unavailable.")) + )))) (t (message "Unknown tag."))) ))
--- a/lisp/cedet/semantic/idle.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/idle.el Mon Sep 27 14:42:43 2010 +0900 @@ -49,6 +49,7 @@ (defvar eldoc-last-message) (declare-function eldoc-message "eldoc") (declare-function semantic-analyze-interesting-tag "semantic/analyze") +(declare-function semantic-analyze-unsplit-name "semantic/analyze/fcn") (declare-function semantic-complete-analyze-inline-idle "semantic/complete") (declare-function semanticdb-deep-find-tags-by-name "semantic/db-find") (declare-function semanticdb-save-all-db-idle "semantic/db") @@ -294,12 +295,18 @@ ;; ;; Unlike the shorter timer, the WORK timer will kick of tasks that ;; may take a long time to complete. -(defcustom semantic-idle-work-parse-neighboring-files-flag t +(defcustom semantic-idle-work-parse-neighboring-files-flag nil "*Non-nil means to parse files in the same dir as the current buffer. Disable to prevent lots of excessive parsing in idle time." :group 'semantic :type 'boolean) +(defcustom semantic-idle-work-update-headers-flag nil + "*Non-nil means to parse through header files in idle time. +Disable to prevent idle time parsing of many files. If completion +is called that work will be done then instead." + :group 'semantic + :type 'boolean) (defun semantic-idle-work-for-one-buffer (buffer) "Do long-processing work for BUFFER. @@ -312,6 +319,9 @@ (semantic-idle-scheduler-refresh-tags) t) + ;; Option to disable this work. + semantic-idle-work-update-headers-flag + ;; Force all our include files to get read in so we ;; are ready to provide good smart completion and idle ;; summary information @@ -603,6 +613,11 @@ ;;; SUMMARY MODE ;; ;; A mode similar to eldoc using semantic +(defcustom semantic-idle-truncate-long-summaries t + "Truncate summaries that are too long to fit in the minibuffer. +This can prevent minibuffer resizing in idle time." + :group 'semantic + :type 'boolean) (defcustom semantic-idle-summary-function 'semantic-format-tag-summarize-with-file @@ -654,21 +669,16 @@ "Return a string message describing the current context. This function will disable loading of previously unloaded files by semanticdb as a time-saving measure." - (let ( - (semanticdb-find-default-throttle - (if (featurep 'semantic/db-find) - (remq 'unloaded semanticdb-find-default-throttle) - nil)) - ) - (save-excursion - ;; use whicever has success first. - (or - (semantic-idle-summary-current-symbol-keyword) + (semanticdb-without-unloaded-file-searches + (save-excursion + ;; use whichever has success first. + (or + (semantic-idle-summary-current-symbol-keyword) - (semantic-idle-summary-current-symbol-info-context) + (semantic-idle-summary-current-symbol-info-context) - (semantic-idle-summary-current-symbol-info-brutish) - )))) + (semantic-idle-summary-current-symbol-info-brutish) + )))) (defvar semantic-idle-summary-out-of-context-faces '( @@ -732,6 +742,14 @@ (let ((w (1- (window-width (minibuffer-window))))) (if (> (length str) w) (setq str (substring str 0 w))))) + ;; I borrowed some bits from eldoc to shorten the + ;; message. + (when semantic-idle-truncate-long-summaries + (let ((ea-width (1- (window-width (minibuffer-window)))) + (strlen (length str))) + (when (> strlen ea-width) + (setq str (substring str 0 ea-width))))) + ;; Display it (eldoc-message str)))) (define-minor-mode semantic-idle-summary-mode @@ -791,12 +809,12 @@ ;; of all uses of the symbol that is under the cursor. ;; ;; This is to mimic the Eclipse tool of a similar nature. -(defvar semantic-idle-summary-highlight-face 'region - "Face used for the summary highlight.") +(defvar semantic-idle-symbol-highlight-face 'region + "Face used for highlighting local symbols.") -(defun semantic-idle-summary-maybe-highlight (tag) - "Perhaps add highlighting onto TAG. -TAG was found as the thing under point. If it happens to be +(defun semantic-idle-symbol-maybe-highlight (tag) + "Perhaps add highlighting to the symbol represented by TAG. +TAG was found as the symbol under point. If it happens to be visible, then highlight it." (require 'pulse) (let* ((region (when (and (semantic-tag-p tag) @@ -817,12 +835,12 @@ (point) (get-buffer-window (current-buffer) 'visible)) (if (< (semantic-overlay-end region) (point-at-eol)) (pulse-momentary-highlight-overlay - region semantic-idle-summary-highlight-face) + region semantic-idle-symbol-highlight-face) ;; Not the same (pulse-momentary-highlight-region (semantic-overlay-start region) (point-at-eol) - semantic-idle-summary-highlight-face))) + semantic-idle-symbol-highlight-face))) )) ((vectorp region) (let ((start (aref region 0)) @@ -842,17 +860,19 @@ (pulse-momentary-highlight-region start (if (<= end (point-at-eol)) end (point-at-eol)) - semantic-idle-summary-highlight-face))) + semantic-idle-symbol-highlight-face))) )))) nil)) -(define-semantic-idle-service semantic-idle-tag-highlight - "Highlight the tag, and references of the symbol under point. +(define-semantic-idle-service semantic-idle-local-symbol-highlight + "Highlight the tag and symbol references of the symbol under point. Call `semantic-analyze-current-context' to find the reference tag. Call `semantic-symref-hits-in-region' to identify local references." (require 'pulse) (when (semantic-idle-summary-useful-context-p) - (let* ((ctxt (semantic-analyze-current-context)) + (let* ((ctxt + (semanticdb-without-unloaded-file-searches + (semantic-analyze-current-context))) (Hbounds (when ctxt (oref ctxt bounds))) (target (when ctxt (car (reverse (oref ctxt prefix))))) (tag (semantic-current-tag)) @@ -862,7 +882,7 @@ (when ctxt ;; Highlight the original tag? Protect against problems. (condition-case nil - (semantic-idle-summary-maybe-highlight target) + (semantic-idle-symbol-maybe-highlight target) (error nil)) ;; Identify all hits in this current tag. (when (semantic-tag-p target) @@ -871,7 +891,7 @@ target (lambda (start end prefix) (when (/= start (car Hbounds)) (pulse-momentary-highlight-region - start end semantic-idle-summary-highlight-face)) + start end semantic-idle-symbol-highlight-face)) (semantic-throw-on-input 'symref-highlight) ) (semantic-tag-start tag) @@ -891,7 +911,7 @@ ;; When turning off, disable other idle modes. (when (null global-semantic-idle-scheduler-mode) (global-semantic-idle-summary-mode -1) - (global-semantic-idle-tag-highlight-mode -1) + (global-semantic-idle-local-symbol-highlight-mode -1) (global-semantic-idle-completions-mode -1)) (semantic-toggle-minor-mode-globally 'semantic-idle-scheduler-mode @@ -903,25 +923,23 @@ ;; This mode uses tooltips to display a (hopefully) short list of possible ;; completions available for the text under point. It provides ;; NO provision for actually filling in the values from those completions. +(defun semantic-idle-completions-end-of-symbol-p () + "Return non-nil if the cursor is at the END of a symbol. +If the cursor is in the middle of a symbol, then we shouldn't be +doing fancy completions." + (not (looking-at "\\w\\|\\s_"))) (defun semantic-idle-completion-list-default () "Calculate and display a list of completions." - (when (semantic-idle-summary-useful-context-p) + (when (and (semantic-idle-summary-useful-context-p) + (semantic-idle-completions-end-of-symbol-p)) ;; This mode can be fragile. Ignore problems. ;; If something doesn't do what you expect, run ;; the below command by hand instead. (condition-case nil - (let ( - ;; Don't go loading in oodles of header libraries in - ;; IDLE time. - (semanticdb-find-default-throttle - (if (featurep 'semantic/db-find) - (remq 'unloaded semanticdb-find-default-throttle) - nil)) - ) - ;; Use idle version. - (require 'semantic/complete) - (semantic-complete-analyze-inline-idle) + (semanticdb-without-unloaded-file-searches + ;; Use idle version. + (semantic-complete-analyze-inline-idle) ) (error nil)) )) @@ -949,6 +967,347 @@ ;; Add the ability to override sometime. (semantic-idle-completion-list-default)) + +;;; Breadcrumbs for tag under point +;; +;; Service that displays a breadcrumbs indication of the tag under +;; point and its parents in the header or mode line. +;; + +(defcustom semantic-idle-breadcrumbs-display-function + #'semantic-idle-breadcrumbs--display-in-header-line + "Function to display the tag under point in idle time. +This function should take a list of Semantic tags as its only +argument. The tags are sorted according to their nesting order, +starting with the outermost tag. The function should call +`semantic-idle-breadcrumbs-format-tag-list-function' to convert +the tag list into a string." + :group 'semantic + :type '(choice + (const :tag "Display in header line" + semantic-idle-breadcrumbs--display-in-header-line) + (const :tag "Display in mode line" + semantic-idle-breadcrumbs--display-in-mode-line) + (function :tag "Other function"))) + +(defcustom semantic-idle-breadcrumbs-format-tag-list-function + #'semantic-idle-breadcrumbs--format-linear + "Function to format the list of tags containing point. +This function should take a list of Semantic tags and an optional +maximum length of the produced string as its arguments. The +maximum length is a hint and can be ignored. When the maximum +length is omitted, an unconstrained string should be +produced. The tags are sorted according to their nesting order, +starting with the outermost tag. Single tags should be formatted +using `semantic-idle-breadcrumbs-format-tag-function' unless +special formatting is required." + :group 'semantic + :type '(choice + (const :tag "Format tags as list, innermost last" + semantic-idle-breadcrumbs--format-linear) + (const :tag "Innermost tag with details, followed by remaining tags" + semantic-idle-breadcrumbs--format-innermost-first) + (function :tag "Other function"))) + +(defcustom semantic-idle-breadcrumbs-format-tag-function + #'semantic-format-tag-abbreviate + "Function to call to format information about tags. +This function should take a single argument, a Semantic tag, and +return a string to display. +Some useful functions are found in `semantic-format-tag-functions'." + :group 'semantic + :type semantic-format-tag-custom-list) + +(defcustom semantic-idle-breadcrumbs-separator 'mode-specific + "Specify how to separate tags in the breadcrumbs string. +An arbitrary string or a mode-specific scope nesting +string (like, for example, \"::\" in C++, or \".\" in Java) can +be used." + :group 'semantic + :type '(choice + (const :tag "Use mode specific separator" + mode-specific) + (string :tag "Specify separator string"))) + +(defcustom semantic-idle-breadcrumbs-header-line-prefix + semantic-stickyfunc-indent-string ;; TODO not optimal + "String used to indent the breadcrumbs string. +Customize this string to match the space used by scrollbars and +fringe." + :group 'semantic + :type 'string) + +(defvar semantic-idle-breadcrumbs-popup-menu nil + "Menu used when a tag displayed by `semantic-idle-breadcrumbs-mode' is clicked.") + +(defun semantic-idle-breadcrumbs--popup-menu (event) + "Popup a menu that displays things to do to the clicked tag. +Argument EVENT describes the event that caused this function to +be called." + (interactive "e") + (let ((old-window (selected-window)) + (window (semantic-event-window event))) + (select-window window t) + (semantic-popup-menu semantic-idle-breadcrumbs-popup-menu) + (select-window old-window))) + +(defmacro semantic-idle-breadcrumbs--tag-function (function) + "Return lambda expression calling FUNCTION when called from a popup." + `(lambda (event) + (interactive "e") + (let* ((old-window (selected-window)) + (window (semantic-event-window event)) + (column (car (nth 6 (nth 1 event)))) ;; TODO semantic-event-column? + (tag (progn + (select-window window t) + (plist-get + (text-properties-at column header-line-format) + 'tag)))) + (,function tag) + (select-window old-window))) + ) + +;; TODO does this work for mode-line case? +(defvar semantic-idle-breadcrumbs-popup-map + (let ((map (make-sparse-keymap))) + ;; mouse-1 goes to clicked tag + (define-key map + [ header-line mouse-1 ] + (semantic-idle-breadcrumbs--tag-function + semantic-go-to-tag)) + ;; mouse-3 pops up a context menu + (define-key map + [ header-line mouse-3 ] + 'semantic-idle-breadcrumbs--popup-menu) + map) + "Keymap for semantic idle breadcrumbs minor mode.") + +(easy-menu-define + semantic-idle-breadcrumbs-popup-menu + semantic-idle-breadcrumbs-popup-map + "Semantic Breadcrumbs Mode Menu" + (list + "Breadcrumb Tag" + (semantic-menu-item + (vector + "Go to Tag" + (semantic-idle-breadcrumbs--tag-function + semantic-go-to-tag) + :active t + :help "Jump to this tag")) + ;; TODO these entries need minor changes (optional tag argument) in + ;; senator-copy-tag etc + ;; (semantic-menu-item + ;; (vector + ;; "Copy Tag" + ;; (semantic-idle-breadcrumbs--tag-function + ;; senator-copy-tag) + ;; :active t + ;; :help "Copy this tag")) + ;; (semantic-menu-item + ;; (vector + ;; "Kill Tag" + ;; (semantic-idle-breadcrumbs--tag-function + ;; senator-kill-tag) + ;; :active t + ;; :help "Kill tag text to the kill ring, and copy the tag to + ;; the tag ring")) + ;; (semantic-menu-item + ;; (vector + ;; "Copy Tag to Register" + ;; (semantic-idle-breadcrumbs--tag-function + ;; senator-copy-tag-to-register) + ;; :active t + ;; :help "Copy this tag")) + ;; (semantic-menu-item + ;; (vector + ;; "Narrow to Tag" + ;; (semantic-idle-breadcrumbs--tag-function + ;; senator-narrow-to-defun) + ;; :active t + ;; :help "Narrow to the bounds of the current tag")) + ;; (semantic-menu-item + ;; (vector + ;; "Fold Tag" + ;; (semantic-idle-breadcrumbs--tag-function + ;; senator-fold-tag-toggle) + ;; :active t + ;; :style 'toggle + ;; :selected '(let ((tag (semantic-current-tag))) + ;; (and tag (semantic-tag-folded-p tag))) + ;; :help "Fold the current tag to one line")) + "---" + (semantic-menu-item + (vector + "About this Header Line" + (lambda () + (interactive) + (describe-function 'semantic-idle-breadcrumbs-mode)) + :active t + :help "Display help about this header line.")) + ) + ) + +(define-semantic-idle-service semantic-idle-breadcrumbs + "Display breadcrumbs for the tag under point and its parents." + (let* ((scope (semantic-calculate-scope)) + (tag-list (if scope + ;; If there is a scope, extract the tag and its + ;; parents. + (append (oref scope parents) + (when (oref scope tag) + (list (oref scope tag)))) + ;; Fall back to tags by overlay + (semantic-find-tag-by-overlay)))) + ;; Display the tags. + (funcall semantic-idle-breadcrumbs-display-function tag-list))) + +(defun semantic-idle-breadcrumbs--display-in-header-line (tag-list) + "Display the tags in TAG-LIST in the header line of their buffer." + (let ((width (- (nth 2 (window-edges)) + (nth 0 (window-edges))))) + ;; Format TAG-LIST and put the formatted string into the header + ;; line. + (setq header-line-format + (concat + semantic-idle-breadcrumbs-header-line-prefix + (if tag-list + (semantic-idle-breadcrumbs--format-tag-list + tag-list + (- width + (length semantic-idle-breadcrumbs-header-line-prefix))) + (propertize + "<not on tags>" + 'face + 'font-lock-comment-face))))) + + ;; Update the header line. + (force-mode-line-update)) + +(defun semantic-idle-breadcrumbs--display-in-mode-line (tag-list) + "Display the tags in TAG-LIST in the mode line of their buffer. +TODO THIS FUNCTION DOES NOT WORK YET." + + (error "This function does not work yet") + + (let ((width (- (nth 2 (window-edges)) + (nth 0 (window-edges))))) + (setq mode-line-format + (semantic-idle-breadcrumbs--format-tag-list tag-list width))) + + (force-mode-line-update)) + +(defun semantic-idle-breadcrumbs--format-tag-list (tag-list max-length) + "Format TAG-LIST using configured functions respecting MAX-LENGTH. +If the initial formatting result is longer than MAX-LENGTH, it is +shortened at the beginning." + ;; Format TAG-LIST using the configured formatting function. + (let* ((complete-format (funcall + semantic-idle-breadcrumbs-format-tag-list-function + tag-list max-length)) + ;; Determine length of complete format. + (complete-length (length complete-format))) + ;; Shorten string if necessary. + (if (<= complete-length max-length) + complete-format + (concat "... " + (substring + complete-format + (- complete-length (- max-length 4)))))) + ) + +(defun semantic-idle-breadcrumbs--format-linear + (tag-list &optional max-length) + "Format TAG-LIST as a linear list, starting with the outermost tag. +MAX-LENGTH is not used." + (require 'semantic/analyze/fcn) + (let* ((format-pieces (mapcar + #'semantic-idle-breadcrumbs--format-tag + tag-list)) + ;; Format tag list, putting configured separators between the + ;; tags. + (complete-format (cond + ;; Mode specific separator. + ((eq semantic-idle-breadcrumbs-separator + 'mode-specific) + (semantic-analyze-unsplit-name format-pieces)) + + ;; Custom separator. + ((stringp semantic-idle-breadcrumbs-separator) + (mapconcat + #'identity + format-pieces + semantic-idle-breadcrumbs-separator))))) + complete-format) + ) + +(defun semantic-idle-breadcrumbs--format-innermost-first + (tag-list &optional max-length) + "Format TAG-LIST placing the innermost tag first, separated from its parents. +If MAX-LENGTH is non-nil, the innermost tag is shortened." + (let* (;; Separate and format remaining tags. Calculate length of + ;; resulting string. + (rest-tags (butlast tag-list)) + (rest-format (if rest-tags + (concat + " | " + (semantic-idle-breadcrumbs--format-linear + rest-tags)) + "")) + (rest-length (length rest-format)) + ;; Format innermost tag and calculate length of resulting + ;; string. + (inner-format (semantic-idle-breadcrumbs--format-tag + (car (last tag-list)) + #'semantic-format-tag-prototype)) + (inner-length (length inner-format)) + ;; Calculate complete length and shorten string for innermost + ;; tag if MAX-LENGTH is non-nil and the complete string is + ;; too long. + (complete-length (+ inner-length rest-length)) + (inner-short (if (and max-length + (<= complete-length max-length)) + inner-format + (concat (substring + inner-format + 0 + (- inner-length + (- complete-length max-length) + 4)) + " ...")))) + ;; Concat both parts. + (concat inner-short rest-format)) + ) + +(defun semantic-idle-breadcrumbs--format-tag (tag &optional format-function) + "Format TAG using the configured function or FORMAT-FUNCTION. +This function also adds text properties for help-echo, mouse +highlighting and a keymap." + (let ((formatted (funcall + (or format-function + semantic-idle-breadcrumbs-format-tag-function) + tag nil t))) + (add-text-properties + 0 (length formatted) + (list + 'tag + tag + 'help-echo + (format + "Tag %s +Type: %s +mouse-1: jump to tag +mouse-3: popup context menu" + (semantic-tag-name tag) + (semantic-tag-class tag)) + 'mouse-face + 'highlight + 'keymap + semantic-idle-breadcrumbs-popup-map) + formatted) + formatted)) + + (provide 'semantic/idle) ;; Local variables:
--- a/lisp/cedet/semantic/imenu.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/imenu.el Mon Sep 27 14:42:43 2010 +0900 @@ -99,7 +99,7 @@ Overriden to nil if `semantic-imenu-bucketize-file' is nil." :group 'semantic-imenu :type 'boolean) -(make-variable-buffer-local 'semantic-imenu-bucketize-type-parts) +(make-variable-buffer-local 'semantic-imenu-bucketize-type-members) (semantic-varalias-obsolete 'semantic-imenu-bucketize-type-parts 'semantic-imenu-bucketize-type-members "23.2")
--- a/lisp/cedet/semantic/lex-spp.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/lex-spp.el Mon Sep 27 14:42:43 2010 +0900 @@ -864,42 +864,45 @@ semantic-lex-spp-expanded-macro-stack )) ) - (with-current-buffer buf - (erase-buffer) - ;; Below is a painful hack to make sure everything is setup correctly. - (when (not (eq major-mode mode)) - (save-match-data + (if (> semantic-lex-spp-hack-depth 5) + nil + (with-current-buffer buf + (erase-buffer) + ;; Below is a painful hack to make sure everything is setup correctly. + (when (not (eq major-mode mode)) + (save-match-data - ;; Protect against user-hooks that throw errors. - (condition-case nil - (funcall mode) - (error nil)) + ;; Protect against user-hooks that throw errors. + (condition-case nil + (funcall mode) + (error nil)) + + ;; Hack in mode-local + (activate-mode-local-bindings) - ;; Hack in mode-local - (activate-mode-local-bindings) - ;; CHEATER! The following 3 lines are from - ;; `semantic-new-buffer-fcn', but we don't want to turn - ;; on all the other annoying modes for this little task. - (setq semantic-new-buffer-fcn-was-run t) - (semantic-lex-init) - (semantic-clear-toplevel-cache) - (remove-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook - t) - )) + ;; CHEATER! The following 3 lines are from + ;; `semantic-new-buffer-fcn', but we don't want to turn + ;; on all the other annoying modes for this little task. + (setq semantic-new-buffer-fcn-was-run t) + (semantic-lex-init) + (semantic-clear-toplevel-cache) + (remove-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook + t) + )) - ;; Second Cheat: copy key variables regarding macro state from the - ;; the originating buffer we are parsing. We need to do this every time - ;; since the state changes. - (dolist (V important-vars) - (set V (semantic-buffer-local-value V origbuff))) - (insert text) - (goto-char (point-min)) + ;; Second Cheat: copy key variables regarding macro state from the + ;; the originating buffer we are parsing. We need to do this every time + ;; since the state changes. + (dolist (V important-vars) + (set V (semantic-buffer-local-value V origbuff))) + (insert text) + (goto-char (point-min)) - (setq fresh-toks (semantic-lex-spp-stream-for-macro (point-max)))) + (setq fresh-toks (semantic-lex-spp-stream-for-macro (point-max)))) - (dolist (tok fresh-toks) - (when (memq (semantic-lex-token-class tok) '(symbol semantic-list)) - (setq toks (cons tok toks)))) + (dolist (tok fresh-toks) + (when (memq (semantic-lex-token-class tok) '(symbol semantic-list)) + (setq toks (cons tok toks))))) (nreverse toks)))
--- a/lisp/cedet/semantic/lex.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/lex.el Mon Sep 27 14:42:43 2010 +0900 @@ -1810,8 +1810,8 @@ (defvar semantic-ignore-comments t "Default comment handling. -t means to strip comments when flexing. Nil means to keep comments -as part of the token stream.") +The value t means to strip comments when flexing; nil means +to keep comments as part of the token stream.") (make-variable-buffer-local 'semantic-ignore-comments) (defvar semantic-flex-enable-newlines nil
--- a/lisp/cedet/semantic/scope.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/scope.el Mon Sep 27 14:42:43 2010 +0900 @@ -67,7 +67,7 @@ :documentation "The list of types currently in scope. For C++, this would contain anonymous namespaces known, and -anything labled by a `using' statement.") +anything labeled by a `using' statement.") (parents :initform nil :documentation "List of parents in scope w/in the body of this function. @@ -239,8 +239,11 @@ ) ;; In case of arg lists or some-such, throw out non-types. (while (and stack (not (semantic-tag-of-class-p pparent 'type))) - (setq stack (cdr stack) - pparent (car (cdr stack)))) + (setq stack (cdr stack) pparent (car (cdr stack)))) + + ;; Remove duplicates + (while (member pparent scopetypes) + (setq stack (cdr stack) pparent (car (cdr stack)))) ;; Step 1: ;; Analyze the stack of tags we are nested in as parents. @@ -611,7 +614,7 @@ ;; to do any of the stuff related to variables and what-not. (setq tmpscope (semantic-scope-cache "mini")) (let* ( ;; Step 1: - (scopetypes (semantic-analyze-scoped-types (point))) + (scopetypes (cons type (semantic-analyze-scoped-types (point)))) (parents (semantic-analyze-scope-nested-tags (point) scopetypes)) ;;(parentinherited (semantic-analyze-scope-lineage-tags parents scopetypes)) (lscope nil)
--- a/lisp/cedet/semantic/sort.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/sort.el Mon Sep 27 14:42:43 2010 +0900 @@ -463,7 +463,7 @@ ) (defun semantic-tag-external-member-parent-default (tag) - "Return the name of TAGs parent only if TAG is not defined in it's parent." + "Return the name of TAGs parent only if TAG is not defined in its parent." ;; Use only the extra spec because a type has a parent which ;; means something completely different. (let ((tp (semantic-tag-get-attribute tag :parent))) @@ -473,7 +473,7 @@ (define-overloadable-function semantic-tag-external-member-p (parent tag) "Return non-nil if PARENT is the parent of TAG. TAG is an external member of PARENT when it is somehow tagged -as having PARENT as it's parent. +as having PARENT as its parent. PARENT and TAG must both be semantic tags. The default behavior, if not overridden with
--- a/lisp/cedet/semantic/symref.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/symref.el Mon Sep 27 14:42:43 2010 +0900 @@ -71,6 +71,7 @@ (declare-function data-debug-insert-object-slots "eieio-datadebug") (declare-function ede-toplevel "ede/files") (declare-function ede-project-root-directory "ede/files") +(declare-function ede-up-directory "ede/files") ;;; Code: (defvar semantic-symref-tool 'detect @@ -98,16 +99,27 @@ If no tools are supported, then 'grep is assumed.") +(defun semantic-symref-calculate-rootdir () + "Calculate the root directory for a symref search. +Start with and EDE project, or use the default directory." + (let* ((rootproj (when (and (featurep 'ede) ede-minor-mode) + (ede-toplevel))) + (rootdirbase (if rootproj + (ede-project-root-directory rootproj) + default-directory))) + (if (and rootproj (condition-case nil + ;; Hack for subprojects. + (oref rootproj :metasubproject) + (error nil))) + (ede-up-directory rootdirbase) + rootdirbase))) + (defun semantic-symref-detect-symref-tool () "Detect the symref tool to use for the current buffer." (if (not (eq semantic-symref-tool 'detect)) semantic-symref-tool ;; We are to perform a detection for the right tool to use. - (let* ((rootproj (when (and (featurep 'ede) ede-minor-mode) - (ede-toplevel))) - (rootdir (if rootproj - (ede-project-root-directory rootproj) - default-directory)) + (let* ((rootdir (semantic-symref-calculate-rootdir)) (tools semantic-symref-tool-alist)) (while (and tools (eq semantic-symref-tool 'detect)) (when (funcall (car (car tools)) rootdir)
--- a/lisp/cedet/semantic/symref/grep.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/symref/grep.el Mon Sep 27 14:42:43 2010 +0900 @@ -30,10 +30,6 @@ (require 'semantic/symref) (require 'grep) -(defvar ede-minor-mode) -(declare-function ede-toplevel "ede/files") -(declare-function ede-project-root-directory "ede/files") - ;;; Code: ;;; GREP @@ -86,7 +82,7 @@ " -o ") " \\)")) (t - (error "Configuration for `semantic-symref-tool-grep' needed for %s" major-mode)) + (error "Customize `semantic-symref-filepattern-alist' for %s" major-mode)) ))) (defvar semantic-symref-grep-expand-keywords @@ -119,6 +115,12 @@ ;;(message "New command: %s" cmd) cmd)) +(defcustom semantic-symref-grep-shell "sh" + "The shell command to use for executing find/grep. +This shell should support pipe redirect syntax." + :group 'semantic + :type 'string) + (defmethod semantic-symref-perform-search ((tool semantic-symref-tool-grep)) "Perform a search with Grep." ;; Grep doesn't support some types of searches. @@ -129,19 +131,7 @@ ;; Find the root of the project, and do a find-grep... (let* (;; Find the file patterns to use. (pat (cdr (assoc major-mode semantic-symref-filepattern-alist))) - (rootdir (cond - ;; Project root via EDE. - ((eq (oref tool :searchscope) 'project) - (let ((rootproj (when (and (featurep 'ede) ede-minor-mode) - (ede-toplevel)))) - (if rootproj - (ede-project-root-directory rootproj) - default-directory))) - ;; Calculate the target files as just in - ;; this directory... cause I'm lazy. - ((eq (oref tool :searchscope) 'target) - default-directory) - )) + (rootdir (semantic-symref-calculate-rootdir)) (filepattern (semantic-symref-derive-find-filepatterns)) ;; Grep based flags. (grepflags (cond ((eq (oref tool :resulttype) 'file) @@ -168,10 +158,10 @@ (let ((cmd (concat "find " default-directory " -type f " filepattern " -print0 " "| xargs -0 grep -H " grepflags "-e " greppat))) ;;(message "Old command: %s" cmd) - (call-process "sh" nil b nil "-c" cmd) + (call-process semantic-symref-grep-shell nil b nil "-c" cmd) ) (let ((cmd (semantic-symref-grep-use-template rootdir filepattern grepflags greppat))) - (call-process "sh" nil b nil "-c" cmd)) + (call-process semantic-symref-grep-shell nil b nil "-c" cmd)) )) (setq ans (semantic-symref-parse-tool-output tool b)) ;; Return the answer
--- a/lisp/cedet/semantic/symref/list.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/symref/list.el Mon Sep 27 14:42:43 2010 +0900 @@ -33,6 +33,7 @@ (require 'semantic/symref) (require 'semantic/complete) +(require 'semantic/senator) (require 'pulse) ;;; Code: @@ -42,9 +43,9 @@ "Find references to the current tag. This command uses the currently configured references tool within the current project to find references to the current tag. The -references are the organized by file and the name of the function +references are organized by file and the name of the function they are used in. -Display the references in`semantic-symref-results-mode'." +Display the references in `semantic-symref-results-mode'." (interactive) (semantic-fetch-tags) (let ((ct (semantic-current-tag)) @@ -65,6 +66,24 @@ "Find references to the symbol SYM. This command uses the currently configured references tool within the current project to find references to the input SYM. The +references are organized by file and the name of the function +they are used in. +Display the references in `semantic-symref-results-mode'." + (interactive (list (semantic-tag-name (semantic-complete-read-tag-buffer-deep + "Symrefs for: ")))) + (semantic-fetch-tags) + (let ((res nil) + ) + ;; Gather results and tags + (message "Gathering References...") + (setq res (semantic-symref-find-references-by-name sym)) + (semantic-symref-produce-list-on-results res sym))) + +;;;###autoload +(defun semantic-symref-regexp (sym) + "Find references to the a symbol regexp SYM. +This command uses the currently configured references tool within the +current project to find references to the input SYM. The references are the organized by file and the name of the function they are used in. Display the references in`semantic-symref-results-mode'." @@ -75,7 +94,7 @@ ) ;; Gather results and tags (message "Gathering References...") - (setq res (semantic-symref-find-references-by-name sym)) + (setq res (semantic-symref-find-text sym)) (semantic-symref-produce-list-on-results res sym))) @@ -110,11 +129,59 @@ (define-key km "n" 'semantic-symref-list-next-line) (define-key km "p" 'semantic-symref-list-prev-line) (define-key km "q" 'semantic-symref-hide-buffer) + (define-key km "\C-c\C-e" 'semantic-symref-list-expand-all) + (define-key km "\C-c\C-r" 'semantic-symref-list-contract-all) + (define-key km "R" 'semantic-symref-list-rename-open-hits) + (define-key km "(" 'semantic-symref-list-create-macro-on-open-hit) + (define-key km "E" 'semantic-symref-list-call-macro-on-open-hits) km) "Keymap used in `semantic-symref-results-mode'.") +(defvar semantic-symref-list-menu-entries + (list + "Symref" + (semantic-menu-item + ["Toggle Line Open" + semantic-symref-list-toggle-showing + :active t + :help "Toggle the current line open or closed." + ]) + (semantic-menu-item + ["Expand All Entries" + semantic-symref-list-expand-all + :active t + :help "Expand every expandable entry." + ]) + (semantic-menu-item + ["Contract All Entries" + semantic-symref-list-contract-all + :active t + :help "Close every expandable entry." + ]) + (semantic-menu-item + ["Rename Symbol in Open hits" + semantic-symref-list-rename-open-hits + :active t + :help "Rename the searched for symbol in all hits that are currently open." + ]) + ) + "Menu entries for the Semantic Symref list mode.") + +(defvar semantic-symref-list-menu nil + "Menu keymap build from `semantic-symref-results-mode'.") + +(easy-menu-define semantic-symref-list-menu + semantic-symref-results-mode-map + "Symref Mode Menu" + semantic-symref-list-menu-entries) + +(defcustom semantic-symref-auto-expand-results nil + "Non-nil to expand symref results on buffer creation." + :group 'semantic-symref + :type 'boolean) + (defcustom semantic-symref-results-mode-hook nil - "*Hook run when `semantic-symref-results-mode' starts." + "Hook run when `semantic-symref-results-mode' starts." :group 'semantic-symref :type 'hook) @@ -189,6 +256,10 @@ )) + ;; Auto expand + (when semantic-symref-auto-expand-results + (semantic-symref-list-expand-all)) + ;; Clean up the mess (toggle-read-only 1) (set-buffer-modified-p nil) @@ -305,7 +376,8 @@ (win (selected-window)) ) (switch-to-buffer-other-window buff) - (with-no-warnings (goto-line line)) + (goto-char (point-min)) + (forward-line (1- line)) (pulse-momentary-highlight-one-line (point)) (when (eq last-command-event ?\s) (select-window win)) ) @@ -323,6 +395,158 @@ (forward-line -1) (back-to-indentation)) +(defun semantic-symref-list-expand-all () + "Expand all the nodes in the current buffer." + (interactive) + (let ((start (make-marker))) + (move-marker start (point)) + (goto-char (point-min)) + (while (re-search-forward "\\[[+]\\]" nil t) + (semantic-symref-list-toggle-showing)) + ;; Restore position + (goto-char start))) + +(defun semantic-symref-list-contract-all () + "Expand all the nodes in the current buffer." + (interactive) + (let ((start (make-marker))) + (move-marker start (point)) + (goto-char (point-min)) + (while (re-search-forward "\\[[-]\\]" nil t) + (semantic-symref-list-toggle-showing)) + ;; Restore position + (goto-char start))) + +;;; UTILS +;; +;; List mode utils for understadning the current line + +(defun semantic-symref-list-on-hit-p () + "Return the line number if the cursor is on a buffer line with a hit. +Hits are the line of code from the buffer, not the tag summar or file lines." + (save-excursion + (end-of-line) + (let* ((ol (car (semantic-overlays-at (1- (point)))))) ;; trust this for now + (when ol (semantic-overlay-get ol 'line))))) + + +;;; Keyboard Macros on a Hit +;; +;; Record a macro on a hit, and store in a special way for execution later. +(defun semantic-symref-list-create-macro-on-open-hit () + "Record a keyboard macro at the location of the hit in the current list. +Under point should be one hit for the active keyword. Move +cursor to the beginning of that symbol, then record a macro as if +`kmacro-start-macro' was pressed. Use `kmacro-end-macro', +{kmacro-end-macro} to end the macro, and return to the symbol found list." + (interactive) + (let* ((oldsym (oref (oref semantic-symref-current-results + :created-by) + :searchfor)) + (ol (save-excursion + (end-of-line) + (car (semantic-overlays-at (1- (point)))))) + (tag (when ol (semantic-overlay-get ol 'tag))) + (line (when ol (semantic-overlay-get ol 'line)))) + (when (not line) + (error "Cannot create macro on a non-hit line")) + ;; Go there, and do something useful. + (switch-to-buffer-other-window (semantic-tag-buffer tag)) + (goto-char (point-min)) + (forward-line (1- line)) + (when (not (re-search-forward (regexp-quote oldsym) (point-at-eol) t)) + (error "Cannot find hit. Cannot record macro")) + (goto-char (match-beginning 0)) + ;; Cursor is now in the right location. Start recording a macro. + (kmacro-start-macro nil) + ;; Notify the user + (message "Complete with C-x ). Use E in the symref buffer to call this macro."))) + +(defun semantic-symref-list-call-macro-on-open-hits () + "Call the most recently created keyboard macro on each hit. +Cursor is placed at the beginning of the symbol found, even if +there is more than one symbol on the current line. The +previously recorded macro is then executed." + (interactive) + (save-window-excursion + (let ((count (semantic-symref-list-map-open-hits + (lambda () + (switch-to-buffer (current-buffer)) + (kmacro-call-macro nil))))) + (semantic-symref-list-update-open-hits) + (message "Executed Macro %d times." count)))) + +;;; REFACTORING EDITS +;; +;; Utilities and features for refactoring across a list of hits. +;; +(defun semantic-symref-list-rename-open-hits (newname) + "Rename the discovered symbol references to NEWNAME. +Only renames the locations that are open in the symref list. +Closed items will be skipped." + (interactive + (list (read-string "Rename to: " + (oref (oref semantic-symref-current-results + :created-by) + :searchfor)))) + (let ((count (semantic-symref-list-map-open-hits + (lambda () (replace-match newname nil t))))) + (semantic-symref-list-update-open-hits) + (message "Renamed %d occurrences." count))) + +;;; REFACTORING UTILITIES +;; +;; Refactoring tools want to operate on only the "good" stuff the +;; user selected. +(defun semantic-symref-list-map-open-hits (function) + "For every open hit in the symref buffer, perform FUNCTION. +The `match-data' will be set to a successful hit of the searched for symbol. +Return the number of occurrences FUNCTION was operated upon." + + ;; First Pass in this function - a straight rename. + ;; Second Pass - Allow context specification based on + ;; class members. (Not Done) + + (let ((oldsym (oref (oref semantic-symref-current-results + :created-by) + :searchfor)) + (count 0)) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + ;; Is this line a "hit" line? + (let* ((ol (car (semantic-overlays-at (1- (point))))) ;; trust this for now + (tag (when ol (semantic-overlay-get ol 'tag))) + (line (when ol (semantic-overlay-get ol 'line)))) + (when line + ;; The "line" means we have an open hit. + (with-current-buffer (semantic-tag-buffer tag) + (goto-char (point-min)) + (forward-line (1- line)) + (beginning-of-line) + (while (re-search-forward (regexp-quote oldsym) (point-at-eol) t) + (setq count (1+ count)) + (save-excursion ;; Leave cursor after the matched name. + (goto-char (match-beginning 0)) ;; Go to beginning of that sym + (funcall function)))))) + ;; Go to the next line + (forward-line 1) + (end-of-line))) + count)) + +(defun semantic-symref-list-update-open-hits () + "Update the text for all the open hits in the symref list." + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "\\[-\\]" nil t) + (end-of-line) + (let* ((ol (car (semantic-overlays-at (1- (point))))) ;; trust this for now + (tag (when ol (semantic-overlay-get ol 'tag)))) + ;; If there is a tag, then close/open it. + (when tag + (semantic-symref-list-toggle-showing) + (semantic-symref-list-toggle-showing)))))) + (provide 'semantic/symref/list) ;; Local variables:
--- a/lisp/cedet/semantic/tag.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/tag.el Mon Sep 27 14:42:43 2010 +0900 @@ -687,18 +687,24 @@ ;; (defun semantic-tag-deep-copy-one-tag (tag &optional filter) "Make a deep copy of TAG, applying FILTER to each child-tag. -Properties and overlay info are not copied. -FILTER takes TAG as an argument, and should returns a semantic-tag. +No properties are copied except for :filename. +Overlay will be a vector. +FILTER takes TAG as an argument, and should return a `semantic-tag'. It is safe for FILTER to modify the input tag and return it." (when (not filter) (setq filter 'identity)) (when (not (semantic-tag-p tag)) (signal 'wrong-type-argument (list tag 'semantic-tag-p))) - (funcall filter (list (semantic-tag-name tag) - (semantic-tag-class tag) - (semantic--tag-deep-copy-attributes - (semantic-tag-attributes tag) filter) - nil - nil))) + (let ((ol (semantic-tag-overlay tag)) + (fn (semantic-tag-file-name tag))) + (funcall filter (list (semantic-tag-name tag) + (semantic-tag-class tag) + (semantic--tag-deep-copy-attributes + (semantic-tag-attributes tag) filter) + ;; Only copy the filename property + (when fn (list :filename fn)) + ;; Only setup a vector if we had an overlay. + (when ol (vector (semantic-tag-start tag) + (semantic-tag-end tag))))))) (defun semantic--tag-deep-copy-attributes (attrs &optional filter) "Make a deep copy of ATTRS, applying FILTER to each child-tag. @@ -877,7 +883,7 @@ "Return the parent of the function that TAG describes. That is the value of the `:parent' attribute. A function has a parent if it is a method of a class, and if the -function does not appear in body of it's parent class." +function does not appear in body of its parent class." (semantic-tag-named-parent tag)) (defsubst semantic-tag-function-destructor-p (tag)
--- a/lisp/cedet/semantic/texi.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/texi.el Mon Sep 27 14:42:43 2010 +0900 @@ -591,12 +591,16 @@ ;; ;; Test for doc string ;; (unless docstring ;; (error "Could not find documentation for %s" (semantic-tag-name tag))) +;; +;; (require 'srecode) +;; (require 'srecode-texi) +;; ;; ;; If we have a string, do the replacement. ;; (delete-region (semantic-tag-start tag) ;; (semantic-tag-end tag)) ;; ;; Use useful functions from the docaument library. -;; (require 'document) -;; (document-insert-texinfo doctag (semantic-tag-buffer doctag)) +;; (srecode-texi-insert-tag-as-doc doctag) +;; ;(semantic-insert-foreign-tag doctag) ;; )) ;; (defun semantic-texi-update-doc-from-source (&optional tag)
--- a/lisp/cedet/semantic/util-modes.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/util-modes.el Mon Sep 27 14:42:43 2010 +0900 @@ -743,6 +743,13 @@ "List of tag classes which stickyfunc will display in the header line.") (make-variable-buffer-local 'semantic-stickyfunc-sticky-classes) +(defcustom semantic-stickyfunc-show-only-functions-p nil + "Non-nil means don't show lines that aren't part of a tag. +If this is nil, then comments or other text between tags that is +1 line above the top of the current window will be shown." + :group 'semantic + :type 'boolean) + (defun semantic-stickyfunc-tag-to-stick () "Return the tag to stick at the current point." (let ((tags (nreverse (semantic-find-tag-by-overlay (point))))) @@ -759,45 +766,51 @@ "Make the function at the top of the current window sticky. Capture its function declaration, and place it in the header line. If there is no function, disable the header line." - (let ((str - (save-excursion - (goto-char (window-start (selected-window))) - (forward-line -1) - (end-of-line) - ;; Capture this function - (let* ((tag (semantic-stickyfunc-tag-to-stick))) - ;; TAG is nil if there was nothing of the appropriate type there. - (if (not tag) - ;; Set it to be the text under the header line - (buffer-substring (point-at-bol) (point-at-eol)) - ;; Get it - (goto-char (semantic-tag-start tag)) - ;; Klaus Berndl <klaus.berndl@sdm.de>: - ;; goto the tag name; this is especially needed for languages - ;; like c++ where a often used style is like: - ;; void - ;; ClassX::methodM(arg1...) - ;; { - ;; ... - ;; } - ;; Without going to the tag-name we would get"void" in the - ;; header line which is IMHO not really useful - (search-forward (semantic-tag-name tag) nil t) - (buffer-substring (point-at-bol) (point-at-eol)) - )))) - (start 0)) - (while (string-match "%" str start) - (setq str (replace-match "%%" t t str 0) - start (1+ (match-end 0))) - ) - ;; In 21.4 (or 22.1) the heder doesn't expand tabs. Hmmmm. - ;; We should replace them here. - ;; - ;; This hack assumes that tabs are kept smartly at tab boundaries - ;; instead of in a tab boundary where it might only represent 4 spaces. - (while (string-match "\t" str start) - (setq str (replace-match " " t t str 0))) - str)) + (save-excursion + (goto-char (window-start (selected-window))) + (let* ((noshow (bobp)) + (str + (progn + (forward-line -1) + (end-of-line) + ;; Capture this function + (let* ((tag (semantic-stickyfunc-tag-to-stick))) + ;; TAG is nil if there was nothing of the appropriate type there. + (if (not tag) + ;; Set it to be the text under the header line + (if noshow + "" + (if semantic-stickyfunc-show-only-functions-p "" + (buffer-substring (point-at-bol) (point-at-eol)) + )) + ;; Go get the first line of this tag. + (goto-char (semantic-tag-start tag)) + ;; Klaus Berndl <klaus.berndl@sdm.de>: + ;; goto the tag name; this is especially needed for languages + ;; like c++ where a often used style is like: + ;; void + ;; ClassX::methodM(arg1...) + ;; { + ;; ... + ;; } + ;; Without going to the tag-name we would get"void" in the + ;; header line which is IMHO not really useful + (search-forward (semantic-tag-name tag) nil t) + (buffer-substring (point-at-bol) (point-at-eol)) + )))) + (start 0)) + (while (string-match "%" str start) + (setq str (replace-match "%%" t t str 0) + start (1+ (match-end 0))) + ) + ;; In 21.4 (or 22.1) the header doesn't expand tabs. Hmmmm. + ;; We should replace them here. + ;; + ;; This hack assumes that tabs are kept smartly at tab boundaries + ;; instead of in a tab boundary where it might only represent 4 spaces. + (while (string-match "\t" str start) + (setq str (replace-match " " t t str 0))) + str))) (defun semantic-stickyfunc-menu (event) "Popup a menu that can help a user understand stickyfunc-mode.
--- a/lisp/cedet/semantic/util.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/util.el Mon Sep 27 14:42:43 2010 +0900 @@ -132,44 +132,6 @@ (semantic-alias-obsolete 'semantic-something-to-stream 'semantic-something-to-tag-table "23.2") -;;; Recursive searching through dependency trees -;; -;; This will depend on the general searching APIS defined above. -;; but will add full recursion through the dependencies list per -;; stream. -(defun semantic-recursive-find-nonterminal-by-name (name buffer) - "Recursively find the first occurrence of NAME. -Start search with BUFFER. Recurse through all dependencies till found. -The return item is of the form (BUFFER TOKEN) where BUFFER is the buffer -in which TOKEN (the token found to match NAME) was found. - -THIS ISN'T USED IN SEMANTIC. DELETE ME SOON." - (with-current-buffer buffer - (let* ((stream (semantic-fetch-tags)) - (includelist (or (semantic-find-tags-by-class 'include stream) - "empty.silly.thing")) - (found (semantic-find-first-tag-by-name name stream)) - (unfound nil)) - (while (and (not found) includelist) - (let ((fn (semantic-dependency-tag-file (car includelist)))) - (if (and fn (not (member fn unfound))) - (with-current-buffer (save-match-data - (find-file-noselect fn)) - (message "Scanning %s" (buffer-file-name)) - (setq stream (semantic-fetch-tags)) - (setq found (semantic-find-first-tag-by-name name stream)) - (if found - (setq found (cons (current-buffer) (list found))) - (setq includelist - (append includelist - (semantic-find-tags-by-class - 'include stream)))) - (setq unfound (cons fn unfound))))) - (setq includelist (cdr includelist))) - found))) -(make-obsolete 'semantic-recursive-find-nonterminal-by-name - "Do not use this function." "23.2") - ;;; Completion APIs ;; ;; These functions provide minibuffer reading/completion for lists of @@ -315,11 +277,12 @@ (princ "Buffer specific configuration items:\n") (let ((vars '(major-mode semantic-case-fold - semantic-expand-nonterminal + semantic-tag-expand-function semantic-parser-name semantic-parse-tree-state semantic-lex-analyzer semantic-lex-reset-hooks + semantic-lex-syntax-modifications ))) (dolist (V vars) (semantic-describe-buffer-var-helper V buff))) @@ -334,7 +297,8 @@ semantic-after-toplevel-cache-change-hook semantic-before-toplevel-cache-flush-hook semantic-dump-parse - + semantic-type-relation-separator-character + semantic-command-separation-character ))) (dolist (V vars) (semantic-describe-buffer-var-helper V buff))) @@ -344,34 +308,6 @@ ))) ) -(defun semantic-current-tag-interactive (p) - "Display the current token. -Argument P is the point to search from in the current buffer." - (interactive "d") - (require 'semantic/find) - (let ((tok (semantic-brute-find-innermost-tag-by-position - p (current-buffer)))) - (message (mapconcat 'semantic-abbreviate-nonterminal tok ",")) - (car tok)) - ) - -(defun semantic-hack-search () - "Display info about something under the cursor using generic methods." - (interactive) - (require 'semantic/find) - (let ((strm (cdr (semantic-fetch-tags))) - (res nil)) - (setq res (semantic-brute-find-tag-by-position (point) strm)) - (if res - (progn - (pop-to-buffer "*SEMANTIC HACK RESULTS*") - (require 'pp) - (erase-buffer) - (insert (pp-to-string res) "\n") - (goto-char (point-min)) - (shrink-window-if-larger-than-buffer)) - (message "nil")))) - (defun semantic-assert-valid-token (tok) "Assert that TOK is a valid token." (if (semantic-tag-p tok) @@ -415,7 +351,8 @@ 'unmatched))) (setq o (cons (car over) o))) (setq over (cdr over))) - (message "Remaining overlays: %S" o))) + (when (called-interactively-p 'any) + (message "Remaining overlays: %S" o)))) over) ;;; Interactive commands (from Senator).
--- a/lisp/cedet/semantic/wisent/python-wy.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/semantic/wisent/python-wy.el Mon Sep 27 14:42:43 2010 +0900 @@ -35,6 +35,7 @@ (defconst wisent-python-wy--keyword-table (semantic-lex-make-keyword-table '(("and" . AND) + ("as" . AS) ("assert" . ASSERT) ("break" . BREAK) ("class" . CLASS) @@ -72,6 +73,7 @@ ("pass" summary "Statement that does nothing") ("or" summary "Binary logical 'or' operator") ("not" summary "Unary boolean negation operator") + ("lambda" summary "Create anonymous function") ("is" summary "Binary operator that tests for object equality") ("in" summary "Part of 'for' statement ") ("import" summary "Load specified modules") @@ -86,10 +88,11 @@ ("elif" summary "Shorthand for 'else if' following an 'if' statement") ("del" summary "Delete specified objects, i.e., undo what assignment did") ("def" summary "Define a new function") - ("continue" summary "Skip to the next interation of enclosing 'for' or 'while' loop") + ("continue" summary "Skip to the next iteration of enclosing 'for' or 'while' loop") ("class" summary "Define a new class") ("break" summary "Terminate 'for' or 'while' loop") ("assert" summary "Raise AssertionError exception if <expr> is false") + ("as" summary "EXPR as NAME makes value of EXPR available as variable NAME") ("and" summary "Logical AND binary operator ... "))) "Table of language keywords.") @@ -172,7 +175,7 @@ (eval-when-compile (require 'semantic/wisent/comp)) (wisent-compile-grammar - '((BACKSLASH NEWLINE INDENT DEDENT INDENT_BLOCK PAREN_BLOCK BRACE_BLOCK BRACK_BLOCK LPAREN RPAREN LBRACE RBRACE LBRACK RBRACK LTLTEQ GTGTEQ EXPEQ DIVDIVEQ DIVDIV LTLT GTGT EXPONENT EQ GE LE PLUSEQ MINUSEQ MULTEQ DIVEQ MODEQ AMPEQ OREQ HATEQ LTGT NE HAT LT GT AMP MULT DIV MOD PLUS MINUS PERIOD TILDE BAR COLON SEMICOLON COMMA ASSIGN BACKQUOTE STRING_LITERAL NUMBER_LITERAL NAME AND ASSERT BREAK CLASS CONTINUE DEF DEL ELIF ELSE EXCEPT EXEC FINALLY FOR FROM GLOBAL IF IMPORT IN IS LAMBDA NOT OR PASS PRINT RAISE RETURN TRY WHILE YIELD) + '((BACKSLASH NEWLINE INDENT DEDENT INDENT_BLOCK PAREN_BLOCK BRACE_BLOCK BRACK_BLOCK LPAREN RPAREN LBRACE RBRACE LBRACK RBRACK LTLTEQ GTGTEQ EXPEQ DIVDIVEQ DIVDIV LTLT GTGT EXPONENT EQ GE LE PLUSEQ MINUSEQ MULTEQ DIVEQ MODEQ AMPEQ OREQ HATEQ LTGT NE HAT LT GT AMP MULT DIV MOD PLUS MINUS PERIOD TILDE BAR COLON SEMICOLON COMMA ASSIGN BACKQUOTE STRING_LITERAL NUMBER_LITERAL NAME AND AS ASSERT BREAK CLASS CONTINUE DEF DEL ELIF ELSE EXCEPT EXEC FINALLY FOR FROM GLOBAL IF IMPORT IN IS LAMBDA NOT OR PASS PRINT RAISE RETURN TRY WHILE YIELD) nil (goal ((NEWLINE)) @@ -280,6 +283,9 @@ ((testlist) nil)) (yield_stmt + ((YIELD) + (wisent-raw-tag + (semantic-tag-new-code $1 nil))) ((YIELD testlist) (wisent-raw-tag (semantic-tag-new-code $1 nil)))) @@ -320,14 +326,14 @@ ((import_as_name_list COMMA import_as_name) nil)) (import_as_name - ((NAME name_name_opt) + ((NAME as_name_opt) nil)) (dotted_as_name - ((dotted_name name_name_opt))) - (name_name_opt + ((dotted_name as_name_opt))) + (as_name_opt (nil) - ((NAME NAME) - nil)) + ((AS NAME) + (identity $2))) (dotted_name ((NAME)) ((dotted_name PERIOD NAME)
--- a/lisp/cedet/srecode.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/srecode.el Mon Sep 27 14:42:43 2010 +0900 @@ -41,7 +41,7 @@ (require 'mode-local) (load "srecode/loaddefs" nil 'nomessage) -(defvar srecode-version "1.0pre7" +(defvar srecode-version "1.0" "Current version of the Semantic Recoder.") ;;; Code:
--- a/lisp/cedet/srecode/compile.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/srecode/compile.el Mon Sep 27 14:42:43 2010 +0900 @@ -35,19 +35,17 @@ (require 'semantic) (require 'eieio) (require 'eieio-base) -(require 'srecode) (require 'srecode/table) +(require 'srecode/dictionary) (declare-function srecode-template-inserter-newline-child-p "srecode/insert" t t) -(declare-function srecode-create-section-dictionary "srecode/dictionary") -(declare-function srecode-dictionary-compound-variable "srecode/dictionary") ;;; Code: ;;; Template Class ;; -;; Templatets describe a patter of text that can be inserted into a +;; Templates describe a pattern of text that can be inserted into a ;; buffer. ;; (defclass srecode-template (eieio-named) @@ -213,6 +211,7 @@ (mode nil) (application nil) (priority nil) + (project nil) (vars nil) ) @@ -256,6 +255,8 @@ (setq application (read firstvalue))) ((string= name "priority") (setq priority (read firstvalue))) + ((string= name "project") + (setq project firstvalue)) (t ;; Assign this into some table of variables. (setq vars (cons (cons name firstvalue) vars)) @@ -297,12 +298,19 @@ ;; Calculate priority ;; (if (not priority) - (let ((d (file-name-directory (buffer-file-name))) - (sd (file-name-directory (locate-library "srecode"))) - (defaultdelta (if (eq mode 'default) 20 0))) - (if (string= d sd) - (setq priority (+ 80 defaultdelta)) - (setq priority (+ 30 defaultdelta))) + (let ((d (expand-file-name (file-name-directory (buffer-file-name)))) + (sd (expand-file-name (file-name-directory (locate-library "srecode")))) + (defaultdelta (if (eq mode 'default) 0 10))) + ;; @TODO : WHEN INTEGRATING INTO EMACS + ;; The location of Emacs default templates needs to be specified + ;; here to also have a lower priority. + (if (string-match (concat "^" sd) d) + (setq priority (+ 30 defaultdelta)) + ;; If the user created template is for a project, then + ;; don't add as much as if it is unique to just some user. + (if (stringp project) + (setq priority (+ 50 defaultdelta)) + (setq priority (+ 80 defaultdelta)))) (message "Templates %s has estimated priority of %d" (file-name-nondirectory (buffer-file-name)) priority)) @@ -311,56 +319,56 @@ priority)) ;; Save it up! - (srecode-compile-template-table table mode priority application vars) + (srecode-compile-template-table table mode priority application project vars) ) ) -(defun srecode-compile-one-template-tag (tag STATE) - "Compile a template tag TAG into an srecode template class. -STATE is the current compile state as an object `srecode-compile-state'." - (require 'srecode/dictionary) - (let* ((context (oref STATE context)) - (codeout (srecode-compile-split-code - tag (semantic-tag-get-attribute tag :code) - STATE)) - (code (cdr codeout)) - (args (semantic-tag-function-arguments tag)) - (binding (semantic-tag-get-attribute tag :binding)) - (rawdicts (semantic-tag-get-attribute tag :dictionaries)) - (sdicts (srecode-create-section-dictionary rawdicts STATE)) - (addargs nil) - ) -; (message "Compiled %s to %d codes with %d args and %d prompts." -; (semantic-tag-name tag) -; (length code) -; (length args) -; (length prompts)) - (while args - (setq addargs (cons (intern (car args)) addargs)) - (when (eq (car addargs) :blank) - ;; If we have a wrap, then put wrap inserters on both - ;; ends of the code. - (setq code (append - (list (srecode-compile-inserter "BLANK" - "\r" - STATE - :secondname nil - :where 'begin)) - code - (list (srecode-compile-inserter "BLANK" - "\r" - STATE - :secondname nil - :where 'end)) - ))) - (setq args (cdr args))) +(defun srecode-compile-one-template-tag (tag state) + "Compile a template tag TAG into a srecode template object. +STATE is the current compile state as an object of class +`srecode-compile-state'." + (let* ((context (oref state context)) + (code (cdr (srecode-compile-split-code + tag (semantic-tag-get-attribute tag :code) + state))) + (args (semantic-tag-function-arguments tag)) + (binding (semantic-tag-get-attribute tag :binding)) + (dict-tags (semantic-tag-get-attribute tag :dictionaries)) + (root-dict (when dict-tags + (srecode-create-dictionaries-from-tags + dict-tags state))) + (addargs)) + ;; Examine arguments. + (dolist (arg args) + (let ((symbol (intern arg))) + (push symbol addargs) + + ;; If we have a wrap, then put wrap inserters on both ends of + ;; the code. + (when (eq symbol :blank) + (setq code (append + (list (srecode-compile-inserter + "BLANK" + "\r" + state + :secondname nil + :where 'begin)) + code + (list (srecode-compile-inserter + "BLANK" + "\r" + state + :secondname nil + :where 'end))))))) + + ;; Construct and return the template object. (srecode-template (semantic-tag-name tag) - :context context - :args (nreverse addargs) - :dictionary sdicts - :binding binding - :code code) - )) + :context context + :args (nreverse addargs) + :dictionary root-dict + :binding binding + :code code)) + ) (defun srecode-compile-do-hard-newline-p (comp) "Examine COMP to decide if the upcoming newline should be hard. @@ -514,12 +522,13 @@ (if (not new) (error "SRECODE: Unknown macro code %S" key)) new))) -(defun srecode-compile-template-table (templates mode priority application vars) +(defun srecode-compile-template-table (templates mode priority application project vars) "Compile a list of TEMPLATES into an semantic recode table. The table being compiled is for MODE, or the string \"default\". PRIORITY is a numerical value that indicates this tables location in an ordered search. APPLICATION is the name of the application these templates belong to. +PROJECT is a directory name which these templates scope to. A list of defined variables VARS provides a variable table." (let ((namehash (make-hash-table :test 'equal :size (length templates))) @@ -549,6 +558,9 @@ (setq lp (cdr lp)))) + (when (stringp project) + (setq project (expand-file-name project))) + (let* ((table (srecode-mode-table-new mode (buffer-file-name) :templates (nreverse templates) :namehash namehash @@ -556,7 +568,8 @@ :variables vars :major-mode mode :priority priority - :application application)) + :application application + :project project)) (tmpl (oref table templates))) ;; Loop over all the templates, and xref. (while tmpl
--- a/lisp/cedet/srecode/cpp.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/srecode/cpp.el Mon Sep 27 14:42:43 2010 +0900 @@ -26,6 +26,27 @@ ;;; Code: +(require 'srecode) +(require 'srecode/dictionary) +(require 'srecode/semantic) +(require 'semantic/tag) + +;;; Customization +;; + +(defgroup srecode-cpp nil + "C++-specific Semantic Recoder settings." + :group 'srecode) + +(defcustom srecode-cpp-namespaces + '("std" "boost") + "List expansion candidates for the :using-namespaces argument. +A dictionary entry of the named PREFIX_NAMESPACE with the value +NAMESPACE:: is created for each namespace unless the current +buffer contains a using NAMESPACE; statement " + :group 'srecode-cpp + :type '(repeat string)) + ;;; :cpp ARGUMENT HANDLING ;; ;; When a :cpp argument is required, fill the dictionary with @@ -33,10 +54,6 @@ ;; ;; Error if not in a C++ mode. -(require 'srecode) -(require 'srecode/dictionary) -(require 'srecode/semantic) - ;;;###autoload (defun srecode-semantic-handle-:cpp (dict) "Add macros into the dictionary DICT based on the current c++ file. @@ -59,6 +76,23 @@ ) ) +(defun srecode-semantic-handle-:using-namespaces (dict) + "Add macros into the dictionary DICT based on used namespaces. +Adds the following: +PREFIX_NAMESPACE - for each NAMESPACE in `srecode-cpp-namespaces'." + (let ((tags (semantic-find-tags-by-class + 'using (semantic-fetch-tags)))) + (dolist (name srecode-cpp-namespaces) + (let ((variable (format "PREFIX_%s" (upcase name))) + (prefix (format "%s::" name))) + (srecode-dictionary-set-value dict variable prefix) + (dolist (tag tags) + (when (and (eq (semantic-tag-get-attribute tag :kind) + 'namespace) + (string= (semantic-tag-name tag) name)) + (srecode-dictionary-set-value dict variable "")))))) + ) + (define-mode-local-override srecode-semantic-apply-tag-to-dict c++-mode (tag-wrapper dict) "Apply C++ specific features from TAG-WRAPPER into DICT. @@ -97,6 +131,7 @@ (srecode-semantic-tag (semantic-tag-name value-tag) :prime value-tag) value-dict)) + ;; Discriminate using statements referring to namespaces and ;; types. (when (eq (semantic-tag-get-attribute tag :kind) 'namespace) @@ -111,7 +146,8 @@ ;; when they make sense. My best bet would be ;; (semantic-tag-function-parent tag), but it is not there, when ;; the function is defined in the scope of a class. - (let ((member 't) + (let ((member t) + (templates (semantic-tag-get-attribute tag :template)) (modifiers (semantic-tag-modifiers tag))) ;; Add modifiers into the dictionary @@ -120,6 +156,9 @@ dict "MODIFIERS"))) (srecode-dictionary-set-value modifier-dict "NAME" modifier))) + ;; Add templates into child dictionaries. + (srecode-cpp-apply-templates dict templates) + ;; When the function is a member function, it can have ;; additional modifiers. (when member @@ -133,11 +172,40 @@ ;; entry. (when (semantic-tag-get-attribute tag :pure-virtual-flag) (srecode-dictionary-show-section dict "PURE")) - ) - )) + ))) + + ;; + ;; CLASS + ;; + ((eq class 'type) + ;; For classes, add template parameters. + (when (or (semantic-tag-of-type-p tag "class") + (semantic-tag-of-type-p tag "struct")) + + ;; Add templates into child dictionaries. + (let ((templates (semantic-tag-get-attribute tag :template))) + (srecode-cpp-apply-templates dict templates)))) )) ) + +;;; Helper functions +;; + +(defun srecode-cpp-apply-templates (dict templates) + "Add section dictionaries for TEMPLATES to DICT." + (when templates + (let ((templates-dict (srecode-dictionary-add-section-dictionary + dict "TEMPLATES"))) + (dolist (template templates) + (let ((template-dict (srecode-dictionary-add-section-dictionary + templates-dict "ARGS"))) + (srecode-semantic-apply-tag-to-dict + (srecode-semantic-tag (semantic-tag-name template) + :prime template) + template-dict))))) + ) + (provide 'srecode/cpp) ;; Local variables:
--- a/lisp/cedet/srecode/dictionary.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/srecode/dictionary.el Mon Sep 27 14:42:43 2010 +0900 @@ -37,6 +37,7 @@ (declare-function srecode-compile-parse-inserter "srecode/compile") (declare-function srecode-dump-code-list "srecode/compile") (declare-function srecode-load-tables-for-mode "srecode/find") +(declare-function srecode-template-table-in-project-p "srecode/find") (declare-function srecode-insert-code-stream "srecode/insert") (declare-function data-debug-new-buffer "data-debug") (declare-function data-debug-insert-object-slots "eieio-datadebug") @@ -157,40 +158,49 @@ If BUFFER-OR-PARENT is t, then this dictionary should not be associated with a buffer or parent." (save-excursion + ;; Handle the parent (let ((parent nil) (buffer nil) (origin nil) (initfrombuff nil)) - (cond ((bufferp buffer-or-parent) - (set-buffer buffer-or-parent) - (setq buffer buffer-or-parent - origin (buffer-name buffer-or-parent) - initfrombuff t)) - ((srecode-dictionary-child-p buffer-or-parent) - (setq parent buffer-or-parent - buffer (oref buffer-or-parent buffer) - origin (concat (object-name buffer-or-parent) " in " - (if buffer (buffer-name buffer) - "no buffer"))) - (when buffer - (set-buffer buffer))) - ((eq buffer-or-parent t) - (setq buffer nil - origin "Unspecified Origin")) - (t - (setq buffer (current-buffer) - origin (concat "Unspecified. Assume " - (buffer-name buffer)) - initfrombuff t) - ) - ) + (cond + ;; Parent is a buffer + ((bufferp buffer-or-parent) + (set-buffer buffer-or-parent) + (setq buffer buffer-or-parent + origin (buffer-name buffer-or-parent) + initfrombuff t)) + + ;; Parent is another dictionary + ((srecode-dictionary-child-p buffer-or-parent) + (setq parent buffer-or-parent + buffer (oref buffer-or-parent buffer) + origin (concat (object-name buffer-or-parent) " in " + (if buffer (buffer-name buffer) + "no buffer"))) + (when buffer + (set-buffer buffer))) + + ;; No parent + ((eq buffer-or-parent t) + (setq buffer nil + origin "Unspecified Origin")) + + ;; Default to unspecified parent + (t + (setq buffer (current-buffer) + origin (concat "Unspecified. Assume " + (buffer-name buffer)) + initfrombuff t))) + + ;; Create the new dictionary object. (let ((dict (srecode-dictionary major-mode - :buffer buffer - :parent parent - :namehash (make-hash-table :test 'equal - :size 20) - :origin origin))) + :buffer buffer + :parent parent + :namehash (make-hash-table :test 'equal + :size 20) + :origin origin))) ;; Only set up the default variables if we are being built ;; directroy for a particular buffer. (when initfrombuff @@ -211,34 +221,37 @@ TPL is an object representing a compiled template file." (when tpl (let ((tabs (oref tpl :tables))) + (require 'srecode/find) ; For srecode-template-table-in-project-p (while tabs - (let ((vars (oref (car tabs) variables))) - (while vars - (srecode-dictionary-set-value - dict (car (car vars)) (cdr (car vars))) - (setq vars (cdr vars)))) - (setq tabs (cdr tabs)))))) + (when (srecode-template-table-in-project-p (car tabs)) + (let ((vars (oref (car tabs) variables))) + (while vars + (srecode-dictionary-set-value + dict (car (car vars)) (cdr (car vars))) + (setq vars (cdr vars))))) + (setq tabs (cdr tabs)))))) (defmethod srecode-dictionary-set-value ((dict srecode-dictionary) name value) "In dictionary DICT, set NAME to have VALUE." ;; Validate inputs - (if (not (stringp name)) - (signal 'wrong-type-argument (list name 'stringp))) + (unless (stringp name) + (signal 'wrong-type-argument (list name 'stringp))) + ;; Add the value. (with-slots (namehash) dict (puthash name value namehash)) ) (defmethod srecode-dictionary-add-section-dictionary ((dict srecode-dictionary) - name &optional show-only) + name &optional show-only force) "In dictionary DICT, add a section dictionary for section macro NAME. Return the new dictionary. -You can add several dictionaries to the same section macro. -For each dictionary added to a macro, the block of codes in the -template will be repeated. +You can add several dictionaries to the same section entry. +For each dictionary added to a variable, the block of codes in +the template will be repeated. If optional argument SHOW-ONLY is non-nil, then don't add a new dictionary if there is already one in place. Also, don't add FIRST/LAST entries. @@ -255,10 +268,11 @@ Adding a new dictionary will alter these values in previously inserted dictionaries." ;; Validate inputs - (if (not (stringp name)) - (signal 'wrong-type-argument (list name 'stringp))) + (unless (stringp name) + (signal 'wrong-type-argument (list name 'stringp))) + (let ((new (srecode-create-dictionary dict)) - (ov (srecode-dictionary-lookup-name dict name))) + (ov (srecode-dictionary-lookup-name dict name t))) (when (not show-only) ;; Setup the FIRST/NOTFIRST and LAST/NOTLAST entries. @@ -275,7 +289,9 @@ (srecode-dictionary-show-section new "LAST")) ) - (when (or (not show-only) (null ov)) + (when (or force + (not show-only) + (null ov)) (srecode-dictionary-set-value dict name (append ov (list new)))) ;; Return the new sub-dictionary. new)) @@ -283,8 +299,9 @@ (defmethod srecode-dictionary-show-section ((dict srecode-dictionary) name) "In dictionary DICT, indicate that the section NAME should be exposed." ;; Validate inputs - (if (not (stringp name)) - (signal 'wrong-type-argument (list name 'stringp))) + (unless (stringp name) + (signal 'wrong-type-argument (list name 'stringp))) + ;; Showing a section is just like making a section dictionary, but ;; with no dictionary values to add. (srecode-dictionary-add-section-dictionary dict name t) @@ -294,51 +311,120 @@ "In dictionary DICT, indicate that the section NAME should be hidden." ;; We need to find the has value, and then delete it. ;; Validate inputs - (if (not (stringp name)) - (signal 'wrong-type-argument (list name 'stringp))) + (unless (stringp name) + (signal 'wrong-type-argument (list name 'stringp))) + ;; Add the value. (with-slots (namehash) dict (remhash name namehash)) nil) -(defmethod srecode-dictionary-merge ((dict srecode-dictionary) otherdict) - "Merge into DICT the dictionary entries from OTHERDICT." +(defmethod srecode-dictionary-add-entries ((dict srecode-dictionary) + entries &optional state) + "Add ENTRIES to DICT. + +ENTRIES is a list of even length of dictionary entries to +add. ENTRIES looks like this: + + (NAME_1 VALUE_1 NAME_2 VALUE_2 ...) + +The following rules apply: + * NAME_N is a string +and for values + * If VALUE_N is t, the section NAME_N is shown. + * If VALUE_N is a string, an ordinary value is inserted. + * If VALUE_N is a dictionary, it is inserted as entry NAME_N. + * Otherwise, a compound variable is created for VALUE_N. + +The optional argument STATE has to non-nil when compound values +are inserted. An error is signaled if ENTRIES contains compound +values but STATE is nil." + (while entries + (let ((name (nth 0 entries)) + (value (nth 1 entries))) + (cond + ;; Value is t; show a section. + ((eq value t) + (srecode-dictionary-show-section dict name)) + + ;; Value is a simple string; create an ordinary dictionary + ;; entry + ((stringp value) + (srecode-dictionary-set-value dict name value)) + + ;; Value is a dictionary; insert as child dictionary. + ((srecode-dictionary-child-p value) + (srecode-dictionary-merge + (srecode-dictionary-add-section-dictionary dict name) + value t)) + + ;; Value is some other object; create a compound value. + (t + (unless state + (error "Cannot insert compound values without state.")) + + (srecode-dictionary-set-value + dict name + (srecode-dictionary-compound-variable + name :value value :state state))))) + (setq entries (nthcdr 2 entries))) + dict) + +(defmethod srecode-dictionary-merge ((dict srecode-dictionary) otherdict + &optional force) + "Merge into DICT the dictionary entries from OTHERDICT. +Unless the optional argument FORCE is non-nil, values in DICT are +not modified, even if there are values of the same names in +OTHERDICT." (when otherdict (maphash (lambda (key entry) - ;; Only merge in the new values if there was no old value. + ;; The new values is only merged in if there was no old value + ;; or FORCE is non-nil. + ;; ;; This protects applications from being whacked, and basically ;; makes these new section dictionary entries act like ;; "defaults" instead of overrides. - (when (not (srecode-dictionary-lookup-name dict key)) - (cond ((and (listp entry) (srecode-dictionary-p (car entry))) - ;; A list of section dictionaries. - ;; We need to merge them in. - (while entry - (let ((new-sub-dict - (srecode-dictionary-add-section-dictionary - dict key))) - (srecode-dictionary-merge new-sub-dict (car entry))) - (setq entry (cdr entry))) - ) + (when (or force + (not (srecode-dictionary-lookup-name dict key t))) + (cond + ;; A list of section dictionaries. We need to merge them in. + ((and (listp entry) + (srecode-dictionary-p (car entry))) + (dolist (sub-dict entry) + (srecode-dictionary-merge + (srecode-dictionary-add-section-dictionary + dict key t t) + sub-dict force))) - (t - (srecode-dictionary-set-value dict key entry))) - )) + ;; Other values can be set directly. + (t + (srecode-dictionary-set-value dict key entry))))) (oref otherdict namehash)))) (defmethod srecode-dictionary-lookup-name ((dict srecode-dictionary) - name) - "Return information about the current DICT's value for NAME." + name &optional non-recursive) + "Return information about DICT's value for NAME. +DICT is a dictionary, and NAME is a string that is treated as the +name of an entry in the dictionary. If such an entry exists, its +value is returned. Otherwise, nil is returned. Normally, the +lookup is recursive in the sense that the parent of DICT is +searched for NAME if it is not found in DICT. This recursive +lookup can be disabled by the optional argument NON-RECURSIVE. + +This function derives values for some special NAMEs, such as +'FIRST' and 'LAST'." (if (not (slot-boundp dict 'namehash)) nil - ;; Get the value of this name from the dictionary - (or (with-slots (namehash) dict - (gethash name namehash)) - (and (not (member name '("FIRST" "LAST" "NOTFIRST" "NOTLAST"))) - (oref dict parent) - (srecode-dictionary-lookup-name (oref dict parent) name)) - ))) + ;; Get the value of this name from the dictionary or its parent + ;; unless the lookup should be non-recursive. + (with-slots (namehash parent) dict + (or (gethash name namehash) + (and (not non-recursive) + (not (member name '("FIRST" "LAST" "NOTFIRST" "NOTLAST"))) + parent + (srecode-dictionary-lookup-name parent name))))) + ) (defmethod srecode-root-dictionary ((dict srecode-dictionary)) "For dictionary DICT, return the root dictionary. @@ -431,10 +517,22 @@ (start (point)) (name (oref sti :object-name))) - (if (or (not dv) (string= dv "")) - (insert name) - (insert dv)) + (cond + ;; No default value. + ((not dv) (insert name)) + ;; A compound value as the default? Recurse. + ((srecode-dictionary-compound-value-child-p dv) + (srecode-compound-toString dv function dictionary)) + ;; A string that is empty? Use the name. + ((and (stringp dv) (string= dv "")) + (insert name)) + ;; Insert strings + ((stringp dv) (insert dv)) + ;; Some other issue + (t + (error "Unknown default value for value %S" name))) + ;; Create a field from the inserter. (srecode-field name :name name :start start :end (point) @@ -482,6 +580,53 @@ (setq sectiondicts (cdr sectiondicts))) new))) +(defun srecode-create-dictionaries-from-tags (tags state) + "Create a dictionary with entries according to TAGS. + +TAGS should be in the format produced by the template file +grammar. That is + +TAGS = (ENTRY_1 ENTRY_2 ...) + +where + +ENTRY_N = (NAME ENTRY_N_1 ENTRY_N_2 ...) | TAG + +where TAG is a semantic tag of class 'variable. The (NAME ... ) +form creates a child dictionary which is stored under the name +NAME. The TAG form creates a value entry or section dictionary +entry whose name is the name of the tag. + +STATE is the current compiler state." + (let ((dict (srecode-create-dictionary t)) + (entries (apply #'append + (mapcar + (lambda (entry) + (cond + ;; Entry is a tag + ((semantic-tag-p entry) + (let ((name (semantic-tag-name entry)) + (value (semantic-tag-variable-default entry))) + (list name + (if (and (listp value) + (= (length value) 1) + (stringp (car value))) + (car value) + value)))) + + ;; Entry is a nested dictionary + (t + (let ((name (car entry)) + (entries (cdr entry))) + (list name + (srecode-create-dictionaries-from-tags + entries state)))))) + tags)))) + (srecode-dictionary-add-entries + dict entries state) + dict) + ) + ;;; DUMP DICTIONARY ;; ;; Make a dictionary, and dump it's contents.
--- a/lisp/cedet/srecode/fields.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/srecode/fields.el Mon Sep 27 14:42:43 2010 +0900 @@ -35,6 +35,8 @@ ;; Each field has 2 overlays. The second overlay allows control in ;; the character just after the field, but does not highlight it. +;; @TODO - Cancel an old field array if a new one is about to be created! + ;; Keep this library independent of SRecode proper. (require 'eieio) @@ -43,6 +45,10 @@ "While inserting a set of fields, collect in this variable. Once an insertion set is done, these fields will be activated.") + +;;; Customization +;; + (defface srecode-field-face '((((class color) (background dark)) (:underline "green")) @@ -51,6 +57,11 @@ "*Face used to specify editable fields from a template." :group 'semantic-faces) +(defcustom srecode-fields-exit-confirmation nil + "Ask for confirmation before leaving field editing mode." + :group 'srecode + :type 'boolean) + ;;; BASECLASS ;; ;; Fields and the template region share some basic overlay features. @@ -187,7 +198,7 @@ (oset ir fields srecode-field-archive) (setq srecode-field-archive nil) - ;; Initailize myself first. + ;; Initialize myself first. (call-next-method) ) @@ -237,7 +248,7 @@ (remove-hook 'post-command-hook 'srecode-field-post-command t) (if (srecode-point-in-region-p ar) nil ;; Keep going - ;; We moved out of the temlate. Cancel the edits. + ;; We moved out of the template. Cancel the edits. (srecode-delete ar))) )) @@ -429,7 +440,8 @@ (defun srecode-field-exit-ask () "Ask if the user wants to exit field-editing mini-mode." (interactive) - (when (y-or-n-p "Exit field-editing mode? ") + (when (or (not srecode-fields-exit-confirmation) + (y-or-n-p "Exit field-editing mode? ")) (srecode-delete (srecode-active-template-region))))
--- a/lisp/cedet/srecode/find.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/srecode/find.el Mon Sep 27 14:42:43 2010 +0900 @@ -92,6 +92,23 @@ )) )) +;;; PROJECT +;; +;; Find if a template table has a project set, and if so, is the +;; current buffer in that project. +(defmethod srecode-template-table-in-project-p ((tab srecode-template-table)) + "Return non-nil if the table TAB can be used in the current project. +If TAB has a :project set, check that the directories match. +If TAB is nil, then always return t." + (let ((proj (oref tab :project))) + ;; Return t if the project wasn't set. + (if (not proj) t + ;; If the project directory was set, lets check it. + (let ((dd (expand-file-name default-directory)) + (projexp (regexp-quote (directory-file-name proj)))) + (if (string-match (concat "^" projexp) dd) + t nil))))) + ;;; SEARCH ;; ;; Find a given template based on name, and features of the current @@ -103,13 +120,14 @@ Optional argument CONTEXT specifies that the template should part of a particular context. The APPLICATION argument is unused." - (if context - ;; If a context is specified, then look it up there. - (let ((ctxth (gethash context (oref tab contexthash)))) - (when ctxth - (gethash template-name ctxth))) - ;; No context, perhaps a merged name? - (gethash template-name (oref tab namehash)))) + (when (srecode-template-table-in-project-p tab) + (if context + ;; If a context is specified, then look it up there. + (let ((ctxth (gethash context (oref tab contexthash)))) + (when ctxth + (gethash template-name ctxth))) + ;; No context, perhaps a merged name? + (gethash template-name (oref tab namehash))))) (defmethod srecode-template-get-table ((tab srecode-mode-table) template-name &optional @@ -144,32 +162,33 @@ "Find in the template name in table TAB, the template with BINDING. Optional argument CONTEXT specifies that the template should part of a particular context." - (let* ((keyout nil) - (hashfcn (lambda (key value) - (when (and (slot-boundp value 'binding) - (oref value binding) - (= (aref (oref value binding) 0) binding)) - (setq keyout key)))) - (contextstr (cond ((listp context) - (car-safe context)) - ((stringp context) - context) - (t nil))) - ) - (if context - (let ((ctxth (gethash contextstr (oref tab contexthash)))) - (when ctxth - ;; If a context is specified, then look it up there. - (maphash hashfcn ctxth) - ;; Context hashes EXCLUDE the context prefix which - ;; we need to include, so concat it here - (when keyout - (setq keyout (concat contextstr ":" keyout))) - ))) - (when (not keyout) - ;; No context, or binding in context. Try full hash. - (maphash hashfcn (oref tab namehash))) - keyout)) + (when (srecode-template-table-in-project-p tab) + (let* ((keyout nil) + (hashfcn (lambda (key value) + (when (and (slot-boundp value 'binding) + (oref value binding) + (= (aref (oref value binding) 0) binding)) + (setq keyout key)))) + (contextstr (cond ((listp context) + (car-safe context)) + ((stringp context) + context) + (t nil))) + ) + (if context + (let ((ctxth (gethash contextstr (oref tab contexthash)))) + (when ctxth + ;; If a context is specified, then look it up there. + (maphash hashfcn ctxth) + ;; Context hashes EXCLUDE the context prefix which + ;; we need to include, so concat it here + (when keyout + (setq keyout (concat contextstr ":" keyout))) + ))) + (when (not keyout) + ;; No context, or binding in context. Try full hash. + (maphash hashfcn (oref tab namehash))) + keyout))) (defmethod srecode-template-get-table-for-binding ((tab srecode-mode-table) binding &optional context application) @@ -220,7 +239,8 @@ ) (while tabs ;; Exclude templates for a perticular application. - (when (not (oref (car tabs) :application)) + (when (and (not (oref (car tabs) :application)) + (srecode-template-table-in-project-p (car tabs))) (maphash (lambda (key temp) (puthash key temp mhash) )
--- a/lisp/cedet/srecode/getset.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/srecode/getset.el Mon Sep 27 14:42:43 2010 +0900 @@ -55,8 +55,9 @@ (error "No templates for inserting get/set")) ;; Step 1: Try to derive the tag for the class we will use + (semantic-fetch-tags) (let* ((class (or class-in (srecode-auto-choose-class (point)))) - (tagstart (semantic-tag-start class)) + (tagstart (when class (semantic-tag-start class))) (inclass (eq (semantic-current-tag-of-class 'type) class)) (field nil) )
--- a/lisp/cedet/srecode/insert.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/srecode/insert.el Mon Sep 27 14:42:43 2010 +0900 @@ -26,6 +26,9 @@ ;; Manage the insertion process for a template. ;; +(eval-when-compile + (require 'cl)) ;; for `lexical-let' + (require 'srecode/compile) (require 'srecode/find) (require 'srecode/dictionary) @@ -49,7 +52,7 @@ NOTE: The field feature does not yet work with XEmacs." :group 'srecode :type '(choice (const :tag "Ask" ask) - (cons :tag "Field" field))) + (const :tag "Field" field))) (defvar srecode-insert-with-fields-in-progress nil "Non-nil means that we are actively inserting a template with fields.") @@ -86,7 +89,6 @@ (car dict-entries) (car (cdr dict-entries))) (setq dict-entries (cdr (cdr dict-entries)))) - ;;(srecode-resolve-arguments temp newdict) (srecode-insert-fcn temp newdict) ;; Don't put code here. We need to return the end-mark ;; for this insertion step. @@ -100,6 +102,10 @@ ;; Perform the insertion. (let ((standard-output (or stream (current-buffer))) (end-mark nil)) + ;; Merge any template entries into the input dictionary. + (when (slot-boundp template 'dictionary) + (srecode-dictionary-merge dictionary (oref template dictionary))) + (unless skipresolver ;; Make sure the semantic tags are up to date. (semantic-fetch-tags) @@ -110,7 +116,7 @@ ;; If there is a buffer, turn off various hooks. This will cause ;; the mod hooks to be buffered up during the insert, but ;; prevent tools like font-lock from fontifying mid-template. - ;; Especialy important during insertion of complex comments that + ;; Especially important during insertion of complex comments that ;; cause the new font-lock to comment-color stuff after the inserted ;; comment. ;; @@ -239,6 +245,9 @@ (defmethod srecode-insert-method ((st srecode-template) dictionary) "Insert the srecoder template ST." ;; Merge any template entries into the input dictionary. + ;; This may happen twice since some templates arguments need + ;; these dictionary values earlier, but these values always + ;; need merging for template inserting in other templates. (when (slot-boundp st 'dictionary) (srecode-dictionary-merge dictionary (oref st dictionary))) ;; Do an insertion. @@ -264,7 +273,7 @@ ;; Specific srecode inserters. ;; The base class is from srecode-compile. ;; -;; Each inserter handles various macro codes from the temlate. +;; Each inserter handles various macro codes from the template. ;; The `code' slot specifies a character used to identify which ;; inserter is to be created. ;; @@ -471,7 +480,7 @@ ;; (setq val (format "%S" val)))) )) ;; Output the dumb thing unless the type of thing specifically - ;; did the inserting forus. + ;; did the inserting for us. (when do-princ (princ val)))) @@ -498,7 +507,8 @@ The prompt text used is derived from the previous PROMPT command in the template file.") -(defmethod srecode-inserter-apply-state ((ins srecode-template-inserter-ask) STATE) +(defmethod srecode-inserter-apply-state + ((ins srecode-template-inserter-ask) STATE) "For the template inserter INS, apply information from STATE. Loop over the prompts to see if we have a match." (let ((prompts (oref STATE prompts)) @@ -669,7 +679,13 @@ ) (defvar srecode-template-inserter-point-override nil - "When non-nil, the point inserter will do this function instead.") + "Point-positioning method for the SRecode template inserter. +When nil, perform normal point-positioning behavior. +When the value is a cons cell (DEPTH . FUNCTION), call FUNCTION +instead, unless the template nesting depth, measured +by (length (oref srecode-template active)), is greater than +DEPTH.") + (defclass srecode-template-inserter-point (srecode-template-inserter) ((key :initform ?^ @@ -702,15 +718,20 @@ dictionary) "Insert the STI inserter. Save point in the class allocated 'point' slot. -If `srecode-template-inserter-point-override' then this generalized -marker will do something else. See `srecode-template-inserter-include-wrap' -as an example." - (if srecode-template-inserter-point-override +If `srecode-template-inserter-point-override' non-nil then this +generalized marker will do something else. See +`srecode-template-inserter-include-wrap' as an example." + ;; If `srecode-template-inserter-point-override' is non-nil, its car + ;; is the maximum template nesting depth for which the override is + ;; valid. Compare this to the actual template nesting depth and + ;; maybe use the override function which is stored in the cdr. + (if (and srecode-template-inserter-point-override + (<= (length (oref srecode-template active)) + (car srecode-template-inserter-point-override))) ;; Disable the old override while we do this. - (let ((over srecode-template-inserter-point-override) + (let ((over (cdr srecode-template-inserter-point-override)) (srecode-template-inserter-point-override nil)) - (funcall over dictionary) - ) + (funcall over dictionary)) (oset sti point (point-marker)) )) @@ -751,9 +772,15 @@ The template to insert is stored in SLOT." (let ((dicts (srecode-dictionary-lookup-name dictionary (oref sti :object-name)))) + (when (not (listp dicts)) + (error "Cannot insert section %S from non-section variable." + (oref sti :object-name))) ;; If there is no section dictionary, then don't output anything ;; from this section. (while dicts + (when (not (srecode-dictionary-p (car dicts))) + (error "Cannot insert section %S from non-section variable." + (oref sti :object-name))) (srecode-insert-subtemplate sti (car dicts) slot) (setq dicts (cdr dicts))))) @@ -853,39 +880,44 @@ ;; If there was no template name, throw an error (if (not templatenamepart) (error "Include macro %s needs a template name" (oref sti :object-name))) - ;; Find the template by name, and save it. - (if (or (not (slot-boundp sti 'includedtemplate)) - (not (oref sti includedtemplate))) - (let ((tmpl (srecode-template-get-table (srecode-table) - templatenamepart)) - (active (oref srecode-template active)) - ctxt) + + ;; NOTE: We used to cache the template and not look it up a second time, + ;; but changes in the template tables can change which template is + ;; eventually discovered, so now we always lookup that template. + + ;; Calculate and store the discovered template + (let ((tmpl (srecode-template-get-table (srecode-table) + templatenamepart)) + (active (oref srecode-template active)) + ctxt) + (when (not tmpl) + ;; If it isn't just available, scan back through + ;; the active template stack, searching for a matching + ;; context. + (while (and (not tmpl) active) + (setq ctxt (oref (car active) context)) + (setq tmpl (srecode-template-get-table (srecode-table) + templatenamepart + ctxt)) (when (not tmpl) - ;; If it isn't just available, scan back through - ;; the active template stack, searching for a matching - ;; context. - (while (and (not tmpl) active) - (setq ctxt (oref (car active) context)) - (setq tmpl (srecode-template-get-table (srecode-table) - templatenamepart - ctxt)) - (when (not tmpl) - (when (slot-boundp (car active) 'table) - (let ((app (oref (oref (car active) table) application))) - (when app - (setq tmpl (srecode-template-get-table - (srecode-table) - templatenamepart - ctxt app))) - ))) - (setq active (cdr active))) - (when (not tmpl) - ;; If it wasn't in this context, look to see if it - ;; defines its own context - (setq tmpl (srecode-template-get-table (srecode-table) - templatenamepart))) - ) - (oset sti :includedtemplate tmpl))) + (when (slot-boundp (car active) 'table) + (let ((app (oref (oref (car active) table) application))) + (when app + (setq tmpl (srecode-template-get-table + (srecode-table) + templatenamepart + ctxt app))) + ))) + (setq active (cdr active))) + (when (not tmpl) + ;; If it wasn't in this context, look to see if it + ;; defines it's own context + (setq tmpl (srecode-template-get-table (srecode-table) + templatenamepart))) + ) + + ;; Store the found template into this object for later use. + (oset sti :includedtemplate tmpl)) (if (not (oref sti includedtemplate)) ;; @todo - Call into a debugger to help find the template in question. @@ -955,23 +987,31 @@ template where a ^ inserter occurs." ;; Step 1: Look up the included inserter (srecode-insert-include-lookup sti dictionary) - ;; Step 2: Temporarilly override the point inserter. - (let* ((vaguely-unique-name sti) - (srecode-template-inserter-point-override - (lambda (dict2) - (if (srecode-dictionary-lookup-name - dict2 (oref vaguely-unique-name :object-name)) - ;; Insert our sectional part with looping. - (srecode-insert-method-helper - vaguely-unique-name dict2 'template) - ;; Insert our sectional part just once. - (srecode-insert-subtemplate vaguely-unique-name - dict2 'template)) - ))) + ;; Step 2: Temporarily override the point inserter. + ;; We bind `srecode-template-inserter-point-override' to a cons cell + ;; (DEPTH . FUNCTION) that has the maximum template nesting depth, + ;; for which the override is valid, in DEPTH and a lambda function + ;; which implements the wrap insertion behavior in FUNCTION. The + ;; maximum valid nesting depth is just the current depth + 1. + (let ((srecode-template-inserter-point-override + (lexical-let ((inserter1 sti)) + (cons + ;; DEPTH + (+ (length (oref srecode-template active)) 1) + ;; FUNCTION + (lambda (dict) + (let ((srecode-template-inserter-point-override nil)) + (if (srecode-dictionary-lookup-name + dict (oref inserter1 :object-name)) + ;; Insert our sectional part with looping. + (srecode-insert-method-helper + inserter1 dict 'template) + ;; Insert our sectional part just once. + (srecode-insert-subtemplate + inserter1 dict 'template)))))))) ;; Do a regular insertion for an include, but with our override in ;; place. - (call-next-method) - )) + (call-next-method))) (provide 'srecode/insert)
--- a/lisp/cedet/srecode/map.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/srecode/map.el Mon Sep 27 14:42:43 2010 +0900 @@ -295,8 +295,14 @@ ;; 2) Do we not have a current map? If so load. (when (not srecode-current-map) - (setq srecode-current-map - (eieio-persistent-read srecode-map-save-file)) + (condition-case nil + (setq srecode-current-map + (eieio-persistent-read srecode-map-save-file)) + (error + ;; There was an error loading the old map. Create a new one. + (setq srecode-current-map + (srecode-map "SRecode Map" + :file srecode-map-save-file)))) ) )
--- a/lisp/cedet/srecode/mode.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/srecode/mode.el Mon Sep 27 14:42:43 2010 +0900 @@ -112,7 +112,13 @@ ["Dump Dictionary" srecode-dictionary-dump :active t - :help "Calculate a dump a dictionary for point." + :help "Calculate and dump a dictionary for point." + ]) + (semantic-menu-item + ["Show Macro Help" + srecode-macro-help + :active t + :help "Display the different types of macros available." ]) ) ) @@ -196,43 +202,44 @@ (setq context (car-safe (srecode-calculate-context))) (while subtab - (setq ltab (oref (car subtab) templates)) - (while ltab - (setq temp (car ltab)) - - ;; Do something with this template. + (when (srecode-template-table-in-project-p (car subtab)) + (setq ltab (oref (car subtab) templates)) + (while ltab + (setq temp (car ltab)) - (let* ((ctxt (oref temp context)) - (ctxtcons (assoc ctxt alltabs)) - (bind (if (slot-boundp temp 'binding) - (oref temp binding))) - (name (object-name-string temp))) + ;; Do something with this template. + + (let* ((ctxt (oref temp context)) + (ctxtcons (assoc ctxt alltabs)) + (bind (if (slot-boundp temp 'binding) + (oref temp binding))) + (name (object-name-string temp))) - (when (not ctxtcons) - (if (string= context ctxt) - ;; If this context is not in the current list of contexts - ;; is equal to the current context, then manage the - ;; active list instead - (setq active - (setq ctxtcons (or active (cons ctxt nil)))) - ;; This is not an active context, add it to alltabs. - (setq ctxtcons (cons ctxt nil)) - (setq alltabs (cons ctxtcons alltabs)))) + (when (not ctxtcons) + (if (string= context ctxt) + ;; If this context is not in the current list of contexts + ;; is equal to the current context, then manage the + ;; active list instead + (setq active + (setq ctxtcons (or active (cons ctxt nil)))) + ;; This is not an active context, add it to alltabs. + (setq ctxtcons (cons ctxt nil)) + (setq alltabs (cons ctxtcons alltabs)))) - (let ((new (vector - (if bind - (concat name " (" bind ")") - name) - `(lambda () (interactive) - (srecode-insert (concat ,ctxt ":" ,name))) - t))) + (let ((new (vector + (if bind + (concat name " (" bind ")") + name) + `(lambda () (interactive) + (srecode-insert (concat ,ctxt ":" ,name))) + t))) - (setcdr ctxtcons (cons - new - (cdr ctxtcons))))) + (setcdr ctxtcons (cons + new + (cdr ctxtcons))))) - (setq ltab (cdr ltab))) - (setq subtab (cdr subtab))) + (setq ltab (cdr ltab)))) + (setq subtab (cdr subtab))) ;; Now create the menu (easy-menu-filter-return @@ -273,6 +280,7 @@ This command will insert whichever srecode template has a binding to the current key." (interactive) + (srecode-load-tables-for-mode major-mode) (let* ((k last-command-event) (ctxt (srecode-calculate-context)) ;; Find the template with the binding K
--- a/lisp/cedet/srecode/semantic.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/srecode/semantic.el Mon Sep 27 14:42:43 2010 +0900 @@ -91,7 +91,7 @@ to be augmented.") (define-overload srecode-semantic-apply-tag-to-dict (tagobj dict) - "Insert fewatures of TAGOBJ into the dictionary DICT. + "Insert features of TAGOBJ into the dictionary DICT. TAGOBJ is an object of class `srecode-semantic-tag'. This class is a compound inserter value. DICT is a dictionary object. @@ -195,7 +195,7 @@ ;;; :tag ARGUMENT HANDLING ;; ;; When a :tag argument is required, identify the current :tag, -;; and apply it's parts into the dictionary. +;; and apply its parts into the dictionary. (defun srecode-semantic-handle-:tag (dict) "Add macros into the dictionary DICT based on the current :tag." ;; We have a tag, start adding "stuff" into the dictionary. @@ -305,8 +305,8 @@ For various conditions, this function looks for a template with the name CLASS-tag, where CLASS is the tag class. If it cannot -find that, it will look for that template in the -`declaration'context (if the current context was not `declaration'). +find that, it will look for that template in the `declaration' +context (if the current context was not `declaration'). If PROTOTYPE is specified, it will first look for templates with the name CLASS-tag-prototype, or CLASS-prototype as above. @@ -382,7 +382,7 @@ (error "Cannot find template %s in %s for inserting tag %S" errtype top (semantic-format-tag-summarize tag))) - ;; Resolve Arguments + ;; Resolve arguments (let ((srecode-semantic-selected-tag tag)) (srecode-resolve-arguments temp dict))
--- a/lisp/cedet/srecode/table.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/srecode/table.el Mon Sep 27 14:42:43 2010 +0900 @@ -31,6 +31,7 @@ (require 'srecode) (declare-function srecode-load-tables-for-mode "srecode/find") +(declare-function srecode-template-table-in-project-p "srecode/find") ;;; Code: @@ -74,6 +75,12 @@ When there are multiple template files with similar names, templates with the highest priority are scanned last, allowing them to override values in previous template files.") + (project :initarg :project + :type (or null string) + :documentation + "Scope some project files to a specific project. +The value is a directory which forms the root of a particular project, +or a subset of a particular project.") ;; ;; Parsed Data from the template file ;; @@ -224,6 +231,12 @@ (when (oref tab :application) (princ "\nApplication: ") (princ (oref tab :application))) + (when (oref tab :project) + (require 'srecode/find) ; For srecode-template-table-in-project-p + (princ "\nProject Directory: ") + (princ (oref tab :project)) + (when (not (srecode-template-table-in-project-p tab)) + (princ "\n ** Not Usable in this file. **"))) (princ "\n\nVariables:\n") (let ((vars (oref tab variables))) (while vars
--- a/lisp/cedet/srecode/texi.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/cedet/srecode/texi.el Mon Sep 27 14:42:43 2010 +0900 @@ -175,10 +175,17 @@ (define-mode-local-override semantic-insert-foreign-tag texinfo-mode (foreign-tag) - "Insert TAG from a foreign buffer in TAGFILE. + "Insert FOREIGN-TAG from a foreign buffer in TAGFILE. Assume TAGFILE is a source buffer, and create a documentation thingy from it using the `document' tool." - (let ((srecode-semantic-selected-tag foreign-tag)) + (srecode-texi-insert-tag-as-doc foreign-tag)) + +(defun srecode-texi-insert-tag-as-doc (tag) + "Insert TAG into the current buffer with SRecode." + (when (not (eq major-mode 'texinfo-mode)) + (error "Can only insert tags into texinfo in texinfo mode")) + (let ((srecode-semantic-selected-tag tag)) + (srecode-load-tables-for-mode major-mode) ;; @todo - choose of the many types of tags to insert, ;; or put all that logic into srecode. (srecode-insert "declaration:function")))
--- a/lisp/comint.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/comint.el Mon Sep 27 14:42:43 2010 +0900 @@ -1,8 +1,8 @@ ;;; comint.el --- general command interpreter in a window stuff -;; Copyright (C) 1988, 1990, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, -;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 1988, 1990, 1992, 1993, 1994, 1995, 1996, 1997, 1998, +;; 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, +;; 2010 Free Software Foundation, Inc. ;; Author: Olin Shivers <shivers@cs.cmu.edu> ;; Simon Marshall <simon@gnu.org> @@ -415,6 +415,9 @@ :type 'boolean :group 'comint) +(define-obsolete-variable-alias 'comint-use-prompt-regexp-instead-of-fields + 'comint-use-prompt-regexp "22.1") + ;; Note: If it is decided to purge comint-prompt-regexp from the source ;; entirely, searching for uses of this variable will help to identify ;; places that need attention. @@ -427,11 +430,6 @@ :type 'boolean :group 'comint) -;; Autoload is necessary for Custom to recognize old alias. -;;;###autoload -(define-obsolete-variable-alias 'comint-use-prompt-regexp-instead-of-fields - 'comint-use-prompt-regexp "22.1") - (defcustom comint-mode-hook nil "Hook run upon entry to `comint-mode'. This is run before the process is cranked up."
--- a/lisp/emacs-lisp/bytecomp.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/emacs-lisp/bytecomp.el Mon Sep 27 14:42:43 2010 +0900 @@ -1343,7 +1343,7 @@ (not (and (eq (get func 'byte-compile) 'cl-byte-compile-compiler-macro) (string-match "\\`c[ad]+r\\'" (symbol-name func))))) - (byte-compile-warn "Function `%s' from cl package called at runtime" + (byte-compile-warn "function `%s' from cl package called at runtime" func))) form) @@ -2156,7 +2156,7 @@ (when (and (symbolp (nth 1 form)) (not (string-match "[-*/:$]" (symbol-name (nth 1 form)))) (byte-compile-warning-enabled-p 'lexical)) - (byte-compile-warn "Global/dynamic var `%s' lacks a prefix" + (byte-compile-warn "global/dynamic var `%s' lacks a prefix" (nth 1 form))) (push (nth 1 form) byte-compile-bound-variables) (if (eq (car form) 'defconst) @@ -3812,7 +3812,7 @@ (when (and (symbolp (nth 1 form)) (not (string-match "[-*/:$]" (symbol-name (nth 1 form)))) (byte-compile-warning-enabled-p 'lexical)) - (byte-compile-warn "Global/dynamic var `%s' lacks a prefix" + (byte-compile-warn "global/dynamic var `%s' lacks a prefix" (nth 1 form))) (let ((fun (nth 0 form)) (var (nth 1 form))
--- a/lisp/emacs-lisp/eieio.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/emacs-lisp/eieio.el Mon Sep 27 14:42:43 2010 +0900 @@ -5,7 +5,7 @@ ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> -;; Version: 0.2 +;; Version: 1.3 ;; Keywords: OO, lisp ;; This file is part of GNU Emacs. @@ -31,6 +31,11 @@ ;; Emacs running environment. ;; ;; See eieio.texi for complete documentation on using this package. +;; +;; Note: the implementation of the c3 algorithm is based on: +;; Kim Barrett et al.: A Monotonic Superclass Linearization for Dylan +;; Retrieved from: +;; http://192.220.96.201/dylan/linearization-oopsla96.html ;; There is funny stuff going on with typep and deftype. This ;; is the only way I seem to be able to make this stuff load properly. @@ -44,7 +49,7 @@ (require 'cl) (require 'eieio-comp)) -(defvar eieio-version "1.2" +(defvar eieio-version "1.3" "Current version of EIEIO.") (defun eieio-version () @@ -79,7 +84,7 @@ "*This hook is executed, then cleared each time `defclass' is called.") (defvar eieio-error-unsupported-class-tags nil - "*Non-nil to throw an error if an encountered tag us unsupported. + "Non-nil to throw an error if an encountered tag is unsupported. This may prevent classes from CLOS applications from being used with EIEIO since EIEIO does not support all CLOS tags.") @@ -170,6 +175,13 @@ (defconst method-generic-after 6 "Index into generic :after tag on a method.") (defconst method-num-slots 7 "Number of indexes into a method's vector.") +(defsubst eieio-specialized-key-to-generic-key (key) + "Convert a specialized KEY into a generic method key." + (cond ((eq key method-static) 0) ;; don't convert + ((< key method-num-lists) (+ key 3)) ;; The conversion + (t key) ;; already generic.. maybe. + )) + ;; How to specialty compile stuff. (autoload 'byte-compile-file-form-defmethod "eieio-comp" "This function is used to byte compile methods in a nice way.") @@ -243,8 +255,7 @@ )) (defmacro class-option-assoc (list option) - "Return from LIST the found OPTION. -Return nil if it doesn't exist." + "Return from LIST the found OPTION, or nil if it doesn't exist." `(car-safe (cdr (memq ,option ,list)))) (defmacro class-option (class option) @@ -518,7 +529,7 @@ ;; Make sure the method invocation order is a valid value. (let ((io (class-option-assoc options :method-invocation-order))) - (when (and io (not (member io '(:depth-first :breadth-first)))) + (when (and io (not (member io '(:depth-first :breadth-first :c3)))) (error "Method invocation order %s is not allowed" io) )) @@ -800,11 +811,11 @@ (defun eieio-perform-slot-validation-for-default (slot spec value skipnil) "For SLOT, signal if SPEC does not match VALUE. If SKIPNIL is non-nil, then if VALUE is nil return t instead." - (let ((val (eieio-default-eval-maybe value))) - (if (and (not eieio-skip-typecheck) - (not (and skipnil (null val))) - (not (eieio-perform-slot-validation spec val))) - (signal 'invalid-slot-type (list slot spec val))))) + (if (and (not (eieio-eval-default-p value)) + (not eieio-skip-typecheck) + (not (and skipnil (null value))) + (not (eieio-perform-slot-validation spec value))) + (signal 'invalid-slot-type (list slot spec value)))) (defun eieio-add-new-slot (newc a d doc type cust label custg print prot init alloc &optional defaultoverride skipnil) @@ -1340,7 +1351,7 @@ (if (= key -1) (signal 'wrong-type-argument (list :static 'non-class-arg))) ;; generics are higher - (setq key (+ key 3))) + (setq key (eieio-specialized-key-to-generic-key key))) ;; Put this lambda into the symbol so we can find it (if (byte-code-function-p (car-safe body)) (eieiomt-add method (car-safe body) key argclass) @@ -1516,13 +1527,21 @@ (eieio-default-eval-maybe val)) obj cl 'oref-default)))) +(defsubst eieio-eval-default-p (val) + "Whether the default value VAL should be evaluated for use." + (and (consp val) (symbolp (car val)) (fboundp (car val)))) + (defun eieio-default-eval-maybe (val) "Check VAL, and return what `oref-default' would provide." - ;; check for quoted things, and unquote them - (if (and (listp val) (eq (car val) 'quote)) - (car (cdr val)) - ;; return it verbatim - val)) + (cond + ;; Is it a function call? If so, evaluate it. + ((eieio-eval-default-p val) + (eval val)) + ;;;; check for quoted things, and unquote them + ;;((and (consp val) (eq (car val) 'quote)) + ;; (car (cdr val))) + ;; return it verbatim + (t val))) ;;; Object Set macros ;; @@ -1677,6 +1696,116 @@ (if (not (class-p class)) (signal 'wrong-type-argument (list 'class-p class))) (class-children-fast class)) +(defun eieio-c3-candidate (class remaining-inputs) + "Returns CLASS if it can go in the result now, otherwise nil" + ;; Ensure CLASS is not in any position but the first in any of the + ;; element lists of REMAINING-INPUTS. + (and (not (let ((found nil)) + (while (and remaining-inputs (not found)) + (setq found (member class (cdr (car remaining-inputs))) + remaining-inputs (cdr remaining-inputs))) + found)) + class)) + +(defun eieio-c3-merge-lists (reversed-partial-result remaining-inputs) + "Merge REVERSED-PARTIAL-RESULT REMAINING-INPUTS in a consistent order, if possible. +If a consistent order does not exist, signal an error." + (if (let ((tail remaining-inputs) + (found nil)) + (while (and tail (not found)) + (setq found (car tail) tail (cdr tail))) + (not found)) + ;; If all remaining inputs are empty lists, we are done. + (nreverse reversed-partial-result) + ;; Otherwise, we try to find the next element of the result. This + ;; is achieved by considering the first element of each + ;; (non-empty) input list and accepting a candidate if it is + ;; consistent with the rests of the input lists. + (let* ((found nil) + (tail remaining-inputs) + (next (progn + (while (and tail (not found)) + (setq found (and (car tail) + (eieio-c3-candidate (caar tail) + remaining-inputs)) + tail (cdr tail))) + found))) + (if next + ;; The graph is consistent so far, add NEXT to result and + ;; merge input lists, dropping NEXT from their heads where + ;; applicable. + (eieio-c3-merge-lists + (cons next reversed-partial-result) + (mapcar (lambda (l) (if (eq (first l) next) (rest l) l)) + remaining-inputs)) + ;; The graph is inconsistent, give up + (signal 'inconsistent-class-hierarchy (list remaining-inputs)))))) + +(defun eieio-class-precedence-dfs (class) + "Return all parents of CLASS in depth-first order." + (let* ((parents (class-parents-fast class)) + (classes (copy-sequence + (apply #'append + (list class) + (or + (mapcar + (lambda (parent) + (cons parent + (eieio-class-precedence-dfs parent))) + parents) + '((eieio-default-superclass)))))) + (tail classes)) + ;; Remove duplicates. + (while tail + (setcdr tail (delq (car tail) (cdr tail))) + (setq tail (cdr tail))) + classes)) + +(defun eieio-class-precedence-bfs (class) + "Return all parents of CLASS in breadth-first order." + (let ((result) + (queue (or (class-parents-fast class) + '(eieio-default-superclass)))) + (while queue + (let ((head (pop queue))) + (unless (member head result) + (push head result) + (unless (eq head 'eieio-default-superclass) + (setq queue (append queue (or (class-parents-fast head) + '(eieio-default-superclass)))))))) + (cons class (nreverse result))) + ) + +(defun eieio-class-precedence-c3 (class) + "Return all parents of CLASS in c3 order." + (let ((parents (class-parents-fast class))) + (eieio-c3-merge-lists + (list class) + (append + (or + (mapcar + (lambda (x) + (eieio-class-precedence-c3 x)) + parents) + '((eieio-default-superclass))) + (list parents)))) + ) + +(defun class-precedence-list (class) + "Return (transitively closed) list of parents of CLASS. +The order, in which the parents are returned depends on the +method invocation orders of the involved classes." + (if (or (null class) (eq class 'eieio-default-superclass)) + nil + (case (class-method-invocation-order class) + (:depth-first + (eieio-class-precedence-dfs class)) + (:breadth-first + (eieio-class-precedence-bfs class)) + (:c3 + (eieio-class-precedence-c3 class)))) + ) + ;; Official CLOS functions. (defalias 'class-direct-superclasses 'class-parents) (defalias 'class-direct-subclasses 'class-children) @@ -1714,7 +1843,8 @@ p (cdr p))) (if child t))) -(defun object-slots (obj) "Return list of slots available in OBJ." +(defun object-slots (obj) + "Return list of slots available in OBJ." (if (not (eieio-object-p obj)) (signal 'wrong-type-argument (list 'eieio-object-p obj))) (aref (class-v (object-class-fast obj)) class-public-a)) @@ -2008,14 +2138,26 @@ keys (append (make-list (length tlambdas) method-before) keys)) ) - ;; If there were no methods found, then there could be :static methods. - (when (not lambdas) + (if mclass + ;; For the case of a class, + ;; if there were no methods found, then there could be :static methods. + (when (not lambdas) + (setq tlambdas + (eieio-generic-form method method-static mclass)) + (setq lambdas (cons tlambdas lambdas) + keys (cons method-static keys) + primarymethodlist ;; Re-use even with bad name here + (eieiomt-method-list method method-static mclass))) + ;; For the case of no class (ie - mclass == nil) then there may + ;; be a primary method. (setq tlambdas - (eieio-generic-form method method-static mclass)) - (setq lambdas (cons tlambdas lambdas) - keys (cons method-static keys) - primarymethodlist ;; Re-use even with bad name here - (eieiomt-method-list method method-static mclass))) + (eieio-generic-form method method-primary nil)) + (when tlambdas + (setq lambdas (cons tlambdas lambdas) + keys (cons method-primary keys) + primarymethodlist + (eieiomt-method-list method method-primary nil))) + ) (run-hook-with-args 'eieio-pre-method-execution-hooks primarymethodlist) @@ -2142,37 +2284,23 @@ If CLASS is nil, then an empty list of methods should be returned." ;; Note: eieiomt - the MT means MethodTree. See more comments below ;; for the rest of the eieiomt methods. - (let ((lambdas nil) - (mclass (list class))) - (while mclass - ;; Note: a nil can show up in the class list once we start - ;; searching through the method tree. - (when (car mclass) - ;; lookup the form to use for the PRIMARY object for the next level - (let ((tmpl (eieio-generic-form method key (car mclass)))) - (when (or (not lambdas) - ;; This prevents duplicates coming out of the - ;; class method optimizer. Perhaps we should - ;; just not optimize before/afters? - (not (eq (car tmpl) (car (car lambdas))))) - (setq lambdas (cons tmpl lambdas)) - (if (null (car lambdas)) - (setq lambdas (cdr lambdas)))))) - ;; Add new classes to mclass. Since our input might not be a class - ;; protect against that. - (if (car mclass) - ;; If there is a class, append any methods it may provide - ;; to the remainder of the class list. - (let ((io (class-method-invocation-order (car mclass)))) - (if (eq io :depth-first) - ;; Depth first. - (setq mclass (append (eieiomt-next (car mclass)) (cdr mclass))) - ;; Breadth first. - (setq mclass (append (cdr mclass) (eieiomt-next (car mclass))))) - ) - ;; Advance to next entry in mclass if it is nil. - (setq mclass (cdr mclass))) - ) + + ;; Collect lambda expressions stored for the class and its parent + ;; classes. + (let (lambdas) + (dolist (ancestor (class-precedence-list class)) + ;; Lookup the form to use for the PRIMARY object for the next level + (let ((tmpl (eieio-generic-form method key ancestor))) + (when (and tmpl + (or (not lambdas) + ;; This prevents duplicates coming out of the + ;; class method optimizer. Perhaps we should + ;; just not optimize before/afters? + (not (member tmpl lambdas)))) + (push tmpl lambdas)))) + + ;; Return collected lambda. For :after methods, return in current + ;; order (most general class last); Otherwise, reverse order. (if (eq key method-after) lambdas (nreverse lambdas)))) @@ -2206,6 +2334,7 @@ (apply 'no-next-method (car newargs) (cdr newargs)) (let* ((eieio-generic-call-next-method-list (cdr eieio-generic-call-next-method-list)) + (eieio-generic-call-arglst newargs) (scoped-class (cdr next)) (fcn (car next)) ) @@ -2298,32 +2427,18 @@ (defun eieiomt-sym-optimize (s) "Find the next class above S which has a function body for the optimizer." - ;; (message "Optimizing %S" s) - (let* ((es (intern-soft (symbol-name s))) ;external symbol of class - (io (class-method-invocation-order es)) - (ov nil) - (cont t)) - ;; This converts ES from a single symbol to a list of parent classes. - (setq es (eieiomt-next es)) - ;; Loop over ES, then its children individually. - ;; We can have multiple hits only at one level of the parent tree. - (while (and es cont) - (setq ov (intern-soft (symbol-name (car es)) eieiomt-optimizing-obarray)) - (if (fboundp ov) - (progn - (set s ov) ;store ov as our next symbol - (setq cont nil)) - (if (eq io :depth-first) - ;; Pre-pend the subclasses of (car es) so we get - ;; DEPTH FIRST optimization. - (setq es (append (eieiomt-next (car es)) (cdr es))) - ;; Else, we are breadth first. - ;; (message "Class %s is breadth first" es) - (setq es (append (cdr es) (eieiomt-next (car es)))) - ))) - ;; If there is no nearest call, then set our value to nil - (if (not es) (set s nil)) - )) + ;; Set the value to nil in case there is no nearest cell. + (set s nil) + ;; Find the nearest cell that has a function body. If we find one, + ;; we replace the nil from above. + (let ((external-symbol (intern-soft (symbol-name s)))) + (catch 'done + (dolist (ancestor (rest (class-precedence-list external-symbol))) + (let ((ov (intern-soft (symbol-name ancestor) + eieiomt-optimizing-obarray))) + (when (fboundp ov) + (set s ov) ;; store ov as our next symbol + (throw 'done ancestor))))))) (defun eieio-generic-form (method key class) "Return the lambda form belonging to METHOD using KEY based upon CLASS. @@ -2332,7 +2447,7 @@ The first time a form is requested from a symbol, an optimized path is memorized for faster future use." (let ((emto (aref (get method 'eieio-method-obarray) - (if class key (+ key 3))))) + (if class key (eieio-specialized-key-to-generic-key key))))) (if (class-p class) ;; 1) find our symbol (let ((cs (intern-soft (symbol-name class) emto))) @@ -2365,7 +2480,7 @@ nil))) ;; for a generic call, what is a list, is the function body we want. (let ((emtl (aref (get method 'eieio-method-tree) - (if class key (+ key 3))))) + (if class key (eieio-specialized-key-to-generic-key key))))) (if emtl ;; The car of EMTL is supposed to be a class, which in this ;; case is nil, so skip it. @@ -2430,6 +2545,11 @@ (put 'unbound-slot 'error-conditions '(unbound-slot error nil)) (put 'unbound-slot 'error-message "Unbound slot") +(intern "inconsistent-class-hierarchy") +(put 'inconsistent-class-hierarchy 'error-conditions + '(inconsistent-class-hierarchy error nil)) +(put 'inconsistent-class-hierarchy 'error-message "Inconsistent class hierarchy") + ;;; Here are some CLOS items that need the CL package ;; @@ -2525,6 +2645,17 @@ (slot (aref scoped-class class-public-a)) (defaults (aref scoped-class class-public-d))) (while slot + ;; For each slot, see if we need to evaluate it. + ;; + ;; Paul Landes said in an email: + ;; > CL evaluates it if it can, and otherwise, leaves it as + ;; > the quoted thing as you already have. This is by the + ;; > Sonya E. Keene book and other things I've look at on the + ;; > web. + (let ((dflt (eieio-default-eval-maybe (car defaults)))) + (when (not (eq dflt (car defaults))) + (eieio-oset this (car slot) dflt) )) + ;; Next. (setq slot (cdr slot) defaults (cdr defaults)))) ;; Shared initialize will parse our slots for us.
--- a/lisp/emacs-lisp/float-sup.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/emacs-lisp/float-sup.el Mon Sep 27 14:42:43 2010 +0900 @@ -35,25 +35,25 @@ ;; provide an easy hook to tell if we are running with floats or not. ;; define pi and e via math-lib calls. (much less prone to killer typos.) -(defconst pi (* 4 (atan 1)) "The value of Pi (3.1415926...).") +(defconst float-pi (* 4 (atan 1)) "The value of Pi (3.1415926...).") +(defconst pi float-pi "Obsolete since Emacs-23.3. Use `float-pi' instead.") -;; It's too inconvenient to make `e' a constant because it's used as -;; a temporary variable all the time. -(defvar e (exp 1) "The value of e (2.7182818...).") +(defconst float-e (exp 1) "The value of e (2.7182818...).") +(defvar e float-e "Obsolete since Emacs-23.3. Use `float-e' instead.") -(defconst degrees-to-radians (/ pi 180.0) +(defconst degrees-to-radians (/ float-pi 180.0) "Degrees to radian conversion constant.") -(defconst radians-to-degrees (/ 180.0 pi) +(defconst radians-to-degrees (/ 180.0 float-pi) "Radian to degree conversion constant.") ;; these expand to a single multiply by a float when byte compiled (defmacro degrees-to-radians (x) "Convert ARG from degrees to radians." - (list '* (/ pi 180.0) x)) + (list '* degrees-to-radians x)) (defmacro radians-to-degrees (x) "Convert ARG from radians to degrees." - (list '* (/ 180.0 pi) x)) + (list '* radians-to-degrees x)) (provide 'lisp-float-type)
--- a/lisp/emacs-lisp/package.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/emacs-lisp/package.el Mon Sep 27 14:42:43 2010 +0900 @@ -1273,7 +1273,7 @@ (setq mode-name "Package Menu") (setq truncate-lines t) (setq buffer-read-only t) - (setq revert-buffer-function 'package-menu-revert) + (set (make-local-variable 'revert-buffer-function) 'package-menu-revert) (setq header-line-format (mapconcat (lambda (pair)
--- a/lisp/emacs-lisp/pcase.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/emacs-lisp/pcase.el Mon Sep 27 14:42:43 2010 +0900 @@ -76,8 +76,8 @@ of the form (UPAT EXP)." (if (null bindings) body `(pcase ,(cadr (car bindings)) - (,(caar bindings) (plet* ,(cdr bindings) ,body)) - (t (error "Pattern match failure in `plet'"))))) + (,(caar bindings) (pcase-let* ,(cdr bindings) ,body)) + (t (error "Pattern match failure in `pcase-let'"))))) ;;;###autoload (defmacro pcase-let (bindings body) @@ -85,13 +85,14 @@ BODY should be an expression, and BINDINGS should be a list of bindings of the form (UPAT EXP)." (if (null (cdr bindings)) - `(plet* ,bindings ,body) + `(pcase-let* ,bindings ,body) (setq bindings (mapcar (lambda (x) (cons (make-symbol "x") x)) bindings)) `(let ,(mapcar (lambda (binding) (list (nth 0 binding) (nth 2 binding))) bindings) - (plet* ,(mapcar (lambda (binding) (list (nth 1 binding) (nth 0 binding))) - bindings) - ,body)))) + (pcase-let* + ,(mapcar (lambda (binding) (list (nth 1 binding) (nth 0 binding))) + bindings) + ,body)))) (defun pcase-expand (exp cases) (let* ((defs (if (symbolp exp) '()
--- a/lisp/emulation/crisp.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/emulation/crisp.el Mon Sep 27 14:42:43 2010 +0900 @@ -1,7 +1,7 @@ ;;; crisp.el --- CRiSP/Brief Emacs emulator -;; Copyright (C) 1997, 1998, 1999, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1998, 1999, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Gary D. Foster <Gary.Foster@Corp.Sun.COM> ;; Keywords: emulations brief crisp @@ -175,7 +175,7 @@ nice to the world.") (defcustom crisp-mode-modeline-string " *CRiSP*" - "*String to display in the modeline when CRiSP emulation mode is enabled." + "String to display in the modeline when CRiSP emulation mode is enabled." :type 'string :group 'crisp) @@ -195,7 +195,7 @@ :group 'crisp) (defcustom crisp-override-meta-x t - "*Controls overriding the normal Emacs M-x key binding in the CRiSP emulator. + "Controls overriding the normal Emacs M-x key binding in the CRiSP emulator. Normally the CRiSP emulator rebinds M-x to `save-buffers-exit-emacs', and provides the usual M-x functionality on the F10 key. If this variable is non-nil, M-x will exit Emacs."
--- a/lisp/emulation/cua-base.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/emulation/cua-base.el Mon Sep 27 14:42:43 2010 +0900 @@ -270,7 +270,7 @@ :link '(emacs-library-link :tag "Lisp File" "cua-base.el")) (defcustom cua-enable-cua-keys t - "*Enable using C-z, C-x, C-c, and C-v for undo, cut, copy, and paste. + "Enable using C-z, C-x, C-c, and C-v for undo, cut, copy, and paste. If the value is t, these mappings are always enabled. If the value is `shift', these keys are only enabled if the last region was marked with a shifted movement key. If the value is nil, these keys are never @@ -281,18 +281,18 @@ :group 'cua) (defcustom cua-remap-control-v t - "*If non-nil, C-v binding is used for paste (yank). + "If non-nil, C-v binding is used for paste (yank). Also, M-v is mapped to `cua-repeat-replace-region'." :type 'boolean :group 'cua) (defcustom cua-remap-control-z t - "*If non-nil, C-z binding is used for undo." + "If non-nil, C-z binding is used for undo." :type 'boolean :group 'cua) (defcustom cua-highlight-region-shift-only nil - "*If non-nil, only highlight region if marked with S-<move>. + "If non-nil, only highlight region if marked with S-<move>. When this is non-nil, CUA toggles `transient-mark-mode' on when the region is marked using shifted movement keys, and off when the mark is cleared. But when the mark was set using \\[cua-set-mark], Transient Mark mode @@ -302,7 +302,7 @@ (defcustom cua-prefix-override-inhibit-delay (if (featurep 'lisp-float-type) (/ (float 1) (float 5)) nil) - "*If non-nil, time in seconds to delay before overriding prefix key. + "If non-nil, time in seconds to delay before overriding prefix key. If there is additional input within this time, the prefix key is used as a normal prefix key. So typing a key sequence quickly will inhibit overriding the prefix key. @@ -315,7 +315,7 @@ :group 'cua) (defcustom cua-delete-selection t - "*If non-nil, typed text replaces text in the active selection." + "If non-nil, typed text replaces text in the active selection." :type '(choice (const :tag "Disabled" nil) (other :tag "Enabled" t)) :group 'cua) @@ -326,13 +326,13 @@ :group 'cua) (defcustom cua-toggle-set-mark t - "*If non-nil, the `cua-set-mark' command toggles the mark." + "If non-nil, the `cua-set-mark' command toggles the mark." :type '(choice (const :tag "Disabled" nil) (other :tag "Enabled" t)) :group 'cua) (defcustom cua-auto-mark-last-change nil - "*If non-nil, set implicit mark at position of last buffer change. + "If non-nil, set implicit mark at position of last buffer change. This means that \\[universal-argument] \\[cua-set-mark] will jump to the position of the last buffer change before jumping to the explicit marks on the mark ring. See `cua-set-mark' for details." @@ -340,7 +340,7 @@ :group 'cua) (defcustom cua-enable-register-prefix 'not-ctrl-u - "*If non-nil, registers are supported via numeric prefix arg. + "If non-nil, registers are supported via numeric prefix arg. If the value is t, any numeric prefix arg in the range 0 to 9 will be interpreted as a register number. If the value is `not-ctrl-u', using C-u to enter a numeric prefix is not @@ -354,29 +354,29 @@ :group 'cua) (defcustom cua-delete-copy-to-register-0 t - "*If non-nil, save last deleted region or rectangle to register 0." + "If non-nil, save last deleted region or rectangle to register 0." :type 'boolean :group 'cua) (defcustom cua-enable-region-auto-help nil - "*If non-nil, automatically show help for active region." + "If non-nil, automatically show help for active region." :type 'boolean :group 'cua) (defcustom cua-enable-modeline-indications nil - "*If non-nil, use minor-mode hook to show status in mode line." + "If non-nil, use minor-mode hook to show status in mode line." :type 'boolean :group 'cua) (defcustom cua-check-pending-input t - "*If non-nil, don't override prefix key if input pending. + "If non-nil, don't override prefix key if input pending. It is rumoured that `input-pending-p' is unreliable under some window managers, so try setting this to nil, if prefix override doesn't work." :type 'boolean :group 'cua) (defcustom cua-paste-pop-rotate-temporarily nil - "*If non-nil, \\[cua-paste-pop] only rotates the kill-ring temporarily. + "If non-nil, \\[cua-paste-pop] only rotates the kill-ring temporarily. This means that both \\[yank] and the first \\[yank-pop] in a sequence always insert the most recently killed text. Each immediately following \\[cua-paste-pop] replaces the previous text with the next older element on the `kill-ring'. @@ -388,7 +388,7 @@ ;;; Rectangle Customization (defcustom cua-virtual-rectangle-edges t - "*If non-nil, rectangles have virtual straight edges. + "If non-nil, rectangles have virtual straight edges. Note that although rectangles are always DISPLAYED with straight edges, the buffer is NOT modified, until you execute a command that actually modifies it. M-p toggles this feature when a rectangle is active." @@ -396,7 +396,7 @@ :group 'cua) (defcustom cua-auto-tabify-rectangles 1000 - "*If non-nil, automatically tabify after rectangle commands. + "If non-nil, automatically tabify after rectangle commands. This basically means that `tabify' is applied to all lines that are modified by inserting or deleting a rectangle. If value is an integer, CUA will look for existing tabs in a region around @@ -428,7 +428,7 @@ :group 'cua) (defcustom cua-rectangle-modifier-key 'meta - "*Modifier key used for rectangle commands bindings. + "Modifier key used for rectangle commands bindings. On non-window systems, always use the meta modifier. Must be set prior to enabling CUA." :type '(choice (const :tag "Meta key" meta) @@ -438,27 +438,27 @@ :group 'cua) (defcustom cua-enable-rectangle-auto-help t - "*If non-nil, automatically show help for region, rectangle and global mark." + "If non-nil, automatically show help for region, rectangle and global mark." :type 'boolean :group 'cua) (defface cua-rectangle '((default :inherit region) (((class color)) :foreground "white" :background "maroon")) - "*Font used by CUA for highlighting the rectangle." + "Font used by CUA for highlighting the rectangle." :group 'cua) (defface cua-rectangle-noselect '((default :inherit region) (((class color)) :foreground "white" :background "dimgray")) - "*Font used by CUA for highlighting the non-selected rectangle lines." + "Font used by CUA for highlighting the non-selected rectangle lines." :group 'cua) ;;; Global Mark Customization (defcustom cua-global-mark-keep-visible t - "*If non-nil, always keep global mark visible in other window." + "If non-nil, always keep global mark visible in other window." :type 'boolean :group 'cua) @@ -466,11 +466,11 @@ '((((min-colors 88)(class color)) :foreground "black" :background "yellow1") (((class color)) :foreground "black" :background "yellow") (t :bold t)) - "*Font used by CUA for highlighting the global mark." + "Font used by CUA for highlighting the global mark." :group 'cua) (defcustom cua-global-mark-blink-cursor-interval 0.20 - "*Blink cursor at this interval when global mark is active." + "Blink cursor at this interval when global mark is active." :type '(choice (number :tag "Blink interval") (const :tag "No blink" nil)) :group 'cua) @@ -479,7 +479,7 @@ ;;; Cursor Indication Customization (defcustom cua-enable-cursor-indications nil - "*If non-nil, use different cursor colors for indications." + "If non-nil, use different cursor colors for indications." :type 'boolean :group 'cua) @@ -517,7 +517,7 @@ :group 'cua) (defcustom cua-read-only-cursor-color "darkgreen" - "*Cursor color used in read-only buffers, if non-nil. + "Cursor color used in read-only buffers, if non-nil. Only used when `cua-enable-cursor-indications' is non-nil. If the value is a COLOR name, then only the `cursor-color' attribute will be @@ -541,7 +541,7 @@ :group 'cua) (defcustom cua-overwrite-cursor-color "yellow" - "*Cursor color used when overwrite mode is set, if non-nil. + "Cursor color used when overwrite mode is set, if non-nil. Only used when `cua-enable-cursor-indications' is non-nil. If the value is a COLOR name, then only the `cursor-color' attribute will be @@ -565,7 +565,7 @@ :group 'cua) (defcustom cua-global-mark-cursor-color "cyan" - "*Indication for active global mark. + "Indication for active global mark. Will change cursor color to specified color if string. Only used when `cua-enable-cursor-indications' is non-nil.
--- a/lisp/emulation/edt.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/emulation/edt.el Mon Sep 27 14:42:43 2010 +0900 @@ -194,7 +194,7 @@ ;;; (defcustom edt-keep-current-page-delimiter nil - "*Emacs MUST be restarted for a change in value to take effect! + "Emacs MUST be restarted for a change in value to take effect! Non-nil leaves Emacs value of `page-delimiter' unchanged within EDT Emulation. If set to nil (the default), the `page-delimiter' variable is set to \"\\f\" when edt-emulation-on is first invoked. This @@ -204,7 +204,7 @@ :group 'edt) (defcustom edt-use-EDT-control-key-bindings nil - "*Emacs MUST be restarted for a change in value to take effect! + "Emacs MUST be restarted for a change in value to take effect! Non-nil causes the control key bindings to be replaced with EDT bindings. If set to nil (the default), EDT control key bindings are not used and the current Emacs control key bindings are retained for @@ -213,7 +213,7 @@ :group 'edt) (defcustom edt-word-entities '(?\t) - "*Specifies the list of EDT word entity characters. + "Specifies the list of EDT word entity characters. The default list, (\?\\t), contains just the TAB character, which emulates EDT. Characters are specified in the list using their decimal ASCII values. A question mark, followed by the actual @@ -238,14 +238,14 @@ :group 'edt) (defcustom edt-top-scroll-margin 10 - "*Scroll margin at the top of the screen. + "Scroll margin at the top of the screen. Interpreted as a percent of the current window size with a default setting of 10%. If set to 0, top scroll margin is disabled." :type 'integer :group 'edt) (defcustom edt-bottom-scroll-margin 15 - "*Scroll margin at the bottom of the screen. + "Scroll margin at the bottom of the screen. Interpreted as a percent of the current window size with a default setting of 15%. If set to 0, bottom scroll margin is disabled." :type 'integer
--- a/lisp/emulation/pc-select.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/emulation/pc-select.el Mon Sep 27 14:42:43 2010 +0900 @@ -85,7 +85,7 @@ :group 'emulations) (defcustom pc-select-override-scroll-error t - "*Non-nil means don't generate error on scrolling past edge of buffer. + "Non-nil means don't generate error on scrolling past edge of buffer. This variable applies in PC Selection mode only. The scroll commands normally generate an error if you try to scroll past the top or bottom of the buffer. This is annoying when selecting @@ -98,14 +98,14 @@ "24.1") (defcustom pc-select-selection-keys-only nil - "*Non-nil means only bind the basic selection keys when started. + "Non-nil means only bind the basic selection keys when started. Other keys that emulate pc-behavior will be untouched. This gives mostly Emacs-like behavior with only the selection keys enabled." :type 'boolean :group 'pc-select) (defcustom pc-select-meta-moves-sexps nil - "*Non-nil means move sexp-wise with Meta key, otherwise move word-wise." + "Non-nil means move sexp-wise with Meta key, otherwise move word-wise." :type 'boolean :group 'pc-select)
--- a/lisp/emulation/vip.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/emulation/vip.el Mon Sep 27 14:42:43 2010 +0900 @@ -91,12 +91,12 @@ "How to reexecute last destructive command. Value is list (M-COM VAL COM).") (defcustom vip-shift-width 8 - "*The number of columns shifted by > and < command." + "The number of columns shifted by > and < command." :type 'integer :group 'vip) (defcustom vip-re-replace nil - "*If t then do regexp replace, if nil then do string replace." + "If t then do regexp replace, if nil then do string replace." :type 'boolean :group 'vip) @@ -116,12 +116,12 @@ "For use by \";\" command.") (defcustom vip-search-wrap-around t - "*If t, search wraps around." + "If t, search wraps around." :type 'boolean :group 'vip) (defcustom vip-re-search nil - "*If t, search is reg-exp search, otherwise vanilla search." + "If t, search is reg-exp search, otherwise vanilla search." :type 'boolean :group 'vip) @@ -132,22 +132,22 @@ "If t, search is forward.") (defcustom vip-case-fold-search nil - "*If t, search ignores cases." + "If t, search ignores cases." :type 'boolean :group 'vip) (defcustom vip-re-query-replace nil - "*If t then do regexp replace, if nil then do string replace." + "If t then do regexp replace, if nil then do string replace." :type 'boolean :group 'vip) (defcustom vip-open-with-indent nil - "*If t, indent when open a new line." + "If t, indent when open a new line." :type 'boolean :group 'vip) (defcustom vip-help-in-insert-mode nil - "*If t then C-h is bound to help-command in insert mode. + "If t then C-h is bound to help-command in insert mode. If nil then it is bound to `delete-backward-char'." :type 'boolean :group 'vip)
--- a/lisp/eshell/em-alias.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/eshell/em-alias.el Mon Sep 27 14:42:43 2010 +0900 @@ -103,7 +103,7 @@ :group 'eshell-module) (defcustom eshell-aliases-file (expand-file-name "alias" eshell-directory-name) - "*The file in which aliases are kept. + "The file in which aliases are kept. Whenever an alias is defined by the user, using the `alias' command, it will be written to this file. Thus, alias definitions (and deletions) are always permanent. This approach was chosen for the @@ -113,13 +113,13 @@ :group 'eshell-alias) (defcustom eshell-bad-command-tolerance 3 - "*The number of failed commands to ignore before creating an alias." + "The number of failed commands to ignore before creating an alias." :type 'integer ;; :link '(custom-manual "(eshell)Auto-correction of bad commands") :group 'eshell-alias) (defcustom eshell-alias-load-hook '(eshell-alias-initialize) - "*A hook that gets run when `eshell-alias' is loaded." + "A hook that gets run when `eshell-alias' is loaded." :type 'hook :group 'eshell-alias)
--- a/lisp/eshell/em-banner.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/eshell/em-banner.el Mon Sep 27 14:42:43 2010 +0900 @@ -58,7 +58,7 @@ ;;; User Variables: (defcustom eshell-banner-message "Welcome to the Emacs shell\n\n" - "*The banner message to be displayed when Eshell is loaded. + "The banner message to be displayed when Eshell is loaded. This can be any sexp, and should end with at least two newlines." :type 'sexp :group 'eshell-banner) @@ -66,7 +66,7 @@ (put 'eshell-banner-message 'risky-local-variable t) (defcustom eshell-banner-load-hook '(eshell-banner-initialize) - "*A list of functions to run when `eshell-banner' is loaded." + "A list of functions to run when `eshell-banner' is loaded." :type 'hook :group 'eshell-banner)
--- a/lisp/eshell/em-basic.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/eshell/em-basic.el Mon Sep 27 14:42:43 2010 +0900 @@ -77,7 +77,7 @@ :group 'eshell-module) (defcustom eshell-plain-echo-behavior nil - "*If non-nil, `echo' tries to behave like an ordinary shell echo. + "If non-nil, `echo' tries to behave like an ordinary shell echo. This comes at some detriment to Lisp functionality. However, the Lisp equivalent of `echo' can always be achieved by using `identity'." :type 'boolean
--- a/lisp/eshell/em-cmpl.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/eshell/em-cmpl.el Mon Sep 27 14:42:43 2010 +0900 @@ -86,26 +86,26 @@ ;;; User Variables: (defcustom eshell-cmpl-load-hook '(eshell-cmpl-initialize) - "*A list of functions to run when `eshell-cmpl' is loaded." + "A list of functions to run when `eshell-cmpl' is loaded." :type 'hook :group 'eshell-cmpl) (defcustom eshell-show-lisp-completions nil - "*If non-nil, include Lisp functions in the command completion list. + "If non-nil, include Lisp functions in the command completion list. If this variable is nil, Lisp completion can still be done in command position by using M-TAB instead of TAB." :type 'boolean :group 'eshell-cmpl) (defcustom eshell-show-lisp-alternatives t - "*If non-nil, and no other completions found, show Lisp functions. + "If non-nil, and no other completions found, show Lisp functions. Setting this variable means nothing if `eshell-show-lisp-completions' is non-nil." :type 'boolean :group 'eshell-cmpl) (defcustom eshell-no-completion-during-jobs t - "*If non-nil, don't allow completion while a process is running." + "If non-nil, don't allow completion while a process is running." :type 'boolean :group 'eshell-cmpl) @@ -126,7 +126,7 @@ ("dbx" . "\\`\\([^.]*\\|a\\.out\\)\\'") ("sdb" . "\\`\\([^.]*\\|a\\.out\\)\\'") ("adb" . "\\`\\([^.]*\\|a\\.out\\)\\'")) - "*An alist that defines simple argument type correlations. + "An alist that defines simple argument type correlations. This is provided for common commands, as a simplistic alternative to writing a completion function." :type '(repeat (cons string regexp))
--- a/lisp/eshell/em-dirs.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/eshell/em-dirs.el Mon Sep 27 14:42:43 2010 +0900 @@ -60,14 +60,14 @@ ;;; User Variables: (defcustom eshell-dirs-load-hook '(eshell-dirs-initialize) - "*A hook that gets run when `eshell-dirs' is loaded." + "A hook that gets run when `eshell-dirs' is loaded." :type 'hook :group 'eshell-dirs) (defcustom eshell-pwd-convert-function (if (eshell-under-windows-p) 'expand-file-name 'identity) - "*The function used to normalize the value of Eshell's `pwd'. + "The function used to normalize the value of Eshell's `pwd'. The value returned by `pwd' is also used when recording the last-visited directory in the last-dir-ring, so it will affect the form of the list used by 'cd ='." @@ -78,7 +78,7 @@ :group 'eshell-dirs) (defcustom eshell-ask-to-save-last-dir 'always - "*Determine if the last-dir-ring should be automatically saved. + "Determine if the last-dir-ring should be automatically saved. The last-dir-ring is always preserved when exiting an Eshell buffer. However, when Emacs is being shut down, this variable determines whether to prompt the user, or just save the ring. @@ -91,22 +91,22 @@ :group 'eshell-dirs) (defcustom eshell-cd-shows-directory nil - "*If non-nil, using `cd' will report the directory it changes to." + "If non-nil, using `cd' will report the directory it changes to." :type 'boolean :group 'eshell-dirs) (defcustom eshell-cd-on-directory t - "*If non-nil, do a cd if a directory is in command position." + "If non-nil, do a cd if a directory is in command position." :type 'boolean :group 'eshell-dirs) (defcustom eshell-directory-change-hook nil - "*A hook to run when the current directory changes." + "A hook to run when the current directory changes." :type 'hook :group 'eshell-dirs) (defcustom eshell-list-files-after-cd nil - "*If non-nil, call \"ls\" with any remaining args after doing a cd. + "If non-nil, call \"ls\" with any remaining args after doing a cd. This is provided for convenience, since the same effect is easily achieved by adding a function to `eshell-directory-change-hook' that calls \"ls\" and references `eshell-last-arguments'." @@ -114,39 +114,39 @@ :group 'eshell-dirs) (defcustom eshell-pushd-tohome nil - "*If non-nil, make pushd with no arg behave as 'pushd ~' (like `cd'). + "If non-nil, make pushd with no arg behave as 'pushd ~' (like `cd'). This mirrors the optional behavior of tcsh." :type 'boolean :group 'eshell-dirs) (defcustom eshell-pushd-dextract nil - "*If non-nil, make \"pushd +n\" pop the nth dir to the stack top. + "If non-nil, make \"pushd +n\" pop the nth dir to the stack top. This mirrors the optional behavior of tcsh." :type 'boolean :group 'eshell-dirs) (defcustom eshell-pushd-dunique nil - "*If non-nil, make pushd only add unique directories to the stack. + "If non-nil, make pushd only add unique directories to the stack. This mirrors the optional behavior of tcsh." :type 'boolean :group 'eshell-dirs) (defcustom eshell-dirtrack-verbose t - "*If non-nil, show the directory stack following directory change. + "If non-nil, show the directory stack following directory change. This is effective only if directory tracking is enabled." :type 'boolean :group 'eshell-dirs) (defcustom eshell-last-dir-ring-file-name (expand-file-name "lastdir" eshell-directory-name) - "*If non-nil, name of the file to read/write the last-dir-ring. + "If non-nil, name of the file to read/write the last-dir-ring. See also `eshell-read-last-dir-ring' and `eshell-write-last-dir-ring'. If it is nil, the last-dir-ring will not be written to disk." :type 'file :group 'eshell-dirs) (defcustom eshell-last-dir-ring-size 32 - "*If non-nil, the size of the directory history ring. + "If non-nil, the size of the directory history ring. This ring is added to every time `cd' or `pushd' is used. It simply stores the most recent directory locations Eshell has been in. To return to the most recent entry, use 'cd -' (equivalent to 'cd -0'). @@ -167,7 +167,7 @@ :group 'eshell-dirs) (defcustom eshell-last-dir-unique t - "*If non-nil, `eshell-last-dir-ring' contains only unique entries." + "If non-nil, `eshell-last-dir-ring' contains only unique entries." :type 'boolean :group 'eshell-dirs)
--- a/lisp/eshell/em-glob.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/eshell/em-glob.el Mon Sep 27 14:42:43 2010 +0900 @@ -63,39 +63,39 @@ ;;; User Variables: (defcustom eshell-glob-load-hook '(eshell-glob-initialize) - "*A list of functions to run when `eshell-glob' is loaded." + "A list of functions to run when `eshell-glob' is loaded." :type 'hook :group 'eshell-glob) (defcustom eshell-glob-include-dot-files nil - "*If non-nil, glob patterns will match files beginning with a dot." + "If non-nil, glob patterns will match files beginning with a dot." :type 'boolean :group 'eshell-glob) (defcustom eshell-glob-include-dot-dot t - "*If non-nil, glob patterns that match dots will match . and .." + "If non-nil, glob patterns that match dots will match . and .." :type 'boolean :group 'eshell-glob) (defcustom eshell-glob-case-insensitive (eshell-under-windows-p) - "*If non-nil, glob pattern matching will ignore case." + "If non-nil, glob pattern matching will ignore case." :type 'boolean :group 'eshell-glob) (defcustom eshell-glob-show-progress nil - "*If non-nil, display progress messages during a recursive glob. + "If non-nil, display progress messages during a recursive glob. This option slows down recursive glob processing by quite a bit." :type 'boolean :group 'eshell-glob) (defcustom eshell-error-if-no-glob nil - "*If non-nil, it is an error for a glob pattern not to match. + "If non-nil, it is an error for a glob pattern not to match. This mimcs the behavior of zsh if non-nil, but bash if nil." :type 'boolean :group 'eshell-glob) (defcustom eshell-glob-chars-list '(?\] ?\[ ?* ?? ?~ ?\( ?\) ?| ?# ?^) - "*List of additional characters used in extended globbing." + "List of additional characters used in extended globbing." :type '(repeat character) :group 'eshell-glob) @@ -117,7 +117,7 @@ (if (eq (aref str (1+ pos)) ?*) "*" "+")) (+ pos 2)) (cons "*" (1+ pos)))))) - "*An alist for translation of extended globbing characters." + "An alist for translation of extended globbing characters." :type '(repeat (cons character (choice regexp function))) :group 'eshell-glob)
--- a/lisp/eshell/em-hist.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/eshell/em-hist.el Mon Sep 27 14:42:43 2010 +0900 @@ -72,7 +72,7 @@ ;;; User Variables: (defcustom eshell-hist-load-hook '(eshell-hist-initialize) - "*A list of functions to call when loading `eshell-hist'." + "A list of functions to call when loading `eshell-hist'." :type 'hook :group 'eshell-hist) @@ -81,31 +81,31 @@ (function (lambda () (remove-hook 'kill-emacs-hook 'eshell-save-some-history)))) - "*A hook that gets run when `eshell-hist' is unloaded." + "A hook that gets run when `eshell-hist' is unloaded." :type 'hook :group 'eshell-hist) (defcustom eshell-history-file-name (expand-file-name "history" eshell-directory-name) - "*If non-nil, name of the file to read/write input history. + "If non-nil, name of the file to read/write input history. See also `eshell-read-history' and `eshell-write-history'. If it is nil, Eshell will use the value of HISTFILE." :type 'file :group 'eshell-hist) (defcustom eshell-history-size 128 - "*Size of the input history ring. If nil, use envvar HISTSIZE." + "Size of the input history ring. If nil, use envvar HISTSIZE." :type 'integer :group 'eshell-hist) (defcustom eshell-hist-ignoredups nil - "*If non-nil, don't add input matching the last on the input ring. + "If non-nil, don't add input matching the last on the input ring. This mirrors the optional behavior of bash." :type 'boolean :group 'eshell-hist) (defcustom eshell-save-history-on-exit t - "*Determine if history should be automatically saved. + "Determine if history should be automatically saved. History is always preserved after sanely exiting an Eshell buffer. However, when Emacs is being shut down, this variable determines whether to prompt the user. @@ -121,7 +121,7 @@ (function (lambda (str) (not (string-match "\\`\\s-*\\'" str)))) - "*Predicate for filtering additions to input history. + "Predicate for filtering additions to input history. Takes one argument, the input. If non-nil, the input may be saved on the input history list. Default is to save anything that isn't all whitespace." @@ -131,7 +131,7 @@ (put 'eshell-input-filter 'risky-local-variable t) (defcustom eshell-hist-match-partial t - "*If non-nil, movement through history is constrained by current input. + "If non-nil, movement through history is constrained by current input. Otherwise, typing <M-p> and <M-n> will always go to the next history element, regardless of any text on the command line. In that case, <C-c M-r> and <C-c M-s> still offer that functionality." @@ -139,25 +139,25 @@ :group 'eshell-hist) (defcustom eshell-hist-move-to-end t - "*If non-nil, move to the end of the buffer before cycling history." + "If non-nil, move to the end of the buffer before cycling history." :type 'boolean :group 'eshell-hist) (defcustom eshell-hist-event-designator "^!\\(!\\|-?[0-9]+\\|\\??[^:^$%*?]+\\??\\|#\\)" - "*The regexp used to identifier history event designators." + "The regexp used to identifier history event designators." :type 'regexp :group 'eshell-hist) (defcustom eshell-hist-word-designator "^:?\\([0-9]+\\|[$^%*]\\)?\\(\\*\\|-[0-9]*\\|[$^%*]\\)?" - "*The regexp used to identify history word designators." + "The regexp used to identify history word designators." :type 'regexp :group 'eshell-hist) (defcustom eshell-hist-modifier "^\\(:\\([hretpqx&g]\\|s/\\([^/]*\\)/\\([^/]*\\)/\\)\\)*" - "*The regexp used to identity history modifiers." + "The regexp used to identity history modifiers." :type 'regexp :group 'eshell-hist) @@ -174,7 +174,7 @@ ([(meta ?n)] . eshell-next-matching-input-from-input) ([up] . eshell-previous-matching-input-from-input) ([down] . eshell-next-matching-input-from-input)) - "*History keys to bind differently if point is in input text." + "History keys to bind differently if point is in input text." :type '(repeat (cons (vector :tag "Keys to bind" (repeat :inline t sexp)) (function :tag "Command")))
--- a/lisp/eshell/em-ls.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/eshell/em-ls.el Mon Sep 27 14:42:43 2010 +0900 @@ -54,24 +54,24 @@ (function (lambda () (fset 'insert-directory eshell-ls-orig-insert-directory)))) - "*When unloading `eshell-ls', restore the definition of `insert-directory'." + "When unloading `eshell-ls', restore the definition of `insert-directory'." :type 'hook :group 'eshell-ls) (defcustom eshell-ls-initial-args nil - "*If non-nil, this list of args is included before any call to `ls'. + "If non-nil, this list of args is included before any call to `ls'. This is useful for enabling human-readable format (-h), for example." :type '(repeat :tag "Arguments" string) :group 'eshell-ls) (defcustom eshell-ls-dired-initial-args nil - "*If non-nil, args is included before any call to `ls' in Dired. + "If non-nil, args is included before any call to `ls' in Dired. This is useful for enabling human-readable format (-h), for example." :type '(repeat :tag "Arguments" string) :group 'eshell-ls) (defcustom eshell-ls-use-in-dired nil - "*If non-nil, use `eshell-ls' to read directories in Dired." + "If non-nil, use `eshell-ls' to read directories in Dired." :set (lambda (symbol value) (if value (unless (and (boundp 'eshell-ls-use-in-dired) @@ -86,24 +86,24 @@ :group 'eshell-ls) (defcustom eshell-ls-default-blocksize 1024 - "*The default blocksize to use when display file sizes with -s." + "The default blocksize to use when display file sizes with -s." :type 'integer :group 'eshell-ls) (defcustom eshell-ls-exclude-regexp nil - "*Unless -a is specified, files matching this regexp will not be shown." + "Unless -a is specified, files matching this regexp will not be shown." :type '(choice regexp (const nil)) :group 'eshell-ls) (defcustom eshell-ls-exclude-hidden t - "*Unless -a is specified, files beginning with . will not be shown. + "Unless -a is specified, files beginning with . will not be shown. Using this boolean, instead of `eshell-ls-exclude-regexp', is both faster and conserves more memory." :type 'boolean :group 'eshell-ls) (defcustom eshell-ls-use-colors t - "*If non-nil, use colors in file listings." + "If non-nil, use colors in file listings." :type 'boolean :group 'eshell-ls) @@ -111,7 +111,7 @@ '((((class color) (background light)) (:foreground "Blue" :weight bold)) (((class color) (background dark)) (:foreground "SkyBlue" :weight bold)) (t (:weight bold))) - "*The face used for highlight directories." + "The face used for highlight directories." :group 'eshell-ls) (define-obsolete-face-alias 'eshell-ls-directory-face 'eshell-ls-directory "22.1") @@ -119,14 +119,14 @@ (defface eshell-ls-symlink '((((class color) (background light)) (:foreground "Dark Cyan" :weight bold)) (((class color) (background dark)) (:foreground "Cyan" :weight bold))) - "*The face used for highlight symbolic links." + "The face used for highlight symbolic links." :group 'eshell-ls) (define-obsolete-face-alias 'eshell-ls-symlink-face 'eshell-ls-symlink "22.1") (defface eshell-ls-executable '((((class color) (background light)) (:foreground "ForestGreen" :weight bold)) (((class color) (background dark)) (:foreground "Green" :weight bold))) - "*The face used for highlighting executables (not directories, though)." + "The face used for highlighting executables (not directories, though)." :group 'eshell-ls) (define-obsolete-face-alias 'eshell-ls-executable-face 'eshell-ls-executable "22.1") @@ -134,14 +134,14 @@ (defface eshell-ls-readonly '((((class color) (background light)) (:foreground "Brown")) (((class color) (background dark)) (:foreground "Pink"))) - "*The face used for highlighting read-only files." + "The face used for highlighting read-only files." :group 'eshell-ls) (define-obsolete-face-alias 'eshell-ls-readonly-face 'eshell-ls-readonly "22.1") (defface eshell-ls-unreadable '((((class color) (background light)) (:foreground "Grey30")) (((class color) (background dark)) (:foreground "DarkGrey"))) - "*The face used for highlighting unreadable files." + "The face used for highlighting unreadable files." :group 'eshell-ls) (define-obsolete-face-alias 'eshell-ls-unreadable-face 'eshell-ls-unreadable "22.1") @@ -149,49 +149,50 @@ (defface eshell-ls-special '((((class color) (background light)) (:foreground "Magenta" :weight bold)) (((class color) (background dark)) (:foreground "Magenta" :weight bold))) - "*The face used for highlighting non-regular files." + "The face used for highlighting non-regular files." :group 'eshell-ls) (define-obsolete-face-alias 'eshell-ls-special-face 'eshell-ls-special "22.1") (defface eshell-ls-missing '((((class color) (background light)) (:foreground "Red" :weight bold)) (((class color) (background dark)) (:foreground "Red" :weight bold))) - "*The face used for highlighting non-existent file names." + "The face used for highlighting non-existent file names." :group 'eshell-ls) (define-obsolete-face-alias 'eshell-ls-missing-face 'eshell-ls-missing "22.1") (defcustom eshell-ls-archive-regexp (concat "\\.\\(t\\(a[rz]\\|gz\\)\\|arj\\|lzh\\|" - "zip\\|[zZ]\\|gz\\|bz2\\|deb\\|rpm\\)\\'") - "*A regular expression that matches names of file archives. + "zip\\|[zZ]\\|gz\\|bz2\\|xz\\|deb\\|rpm\\)\\'") + "A regular expression that matches names of file archives. This typically includes both traditional archives and compressed files." + :version "24.1" ; added xz :type 'regexp :group 'eshell-ls) (defface eshell-ls-archive '((((class color) (background light)) (:foreground "Orchid" :weight bold)) (((class color) (background dark)) (:foreground "Orchid" :weight bold))) - "*The face used for highlighting archived and compressed file names." + "The face used for highlighting archived and compressed file names." :group 'eshell-ls) (define-obsolete-face-alias 'eshell-ls-archive-face 'eshell-ls-archive "22.1") (defcustom eshell-ls-backup-regexp "\\(\\`\\.?#\\|\\(\\.bak\\|~\\)\\'\\)" - "*A regular expression that matches names of backup files." + "A regular expression that matches names of backup files." :type 'regexp :group 'eshell-ls) (defface eshell-ls-backup '((((class color) (background light)) (:foreground "OrangeRed")) (((class color) (background dark)) (:foreground "LightSalmon"))) - "*The face used for highlighting backup file names." + "The face used for highlighting backup file names." :group 'eshell-ls) (define-obsolete-face-alias 'eshell-ls-backup-face 'eshell-ls-backup "22.1") (defcustom eshell-ls-product-regexp "\\.\\(elc\\|o\\(bj\\)?\\|a\\|lib\\|res\\)\\'" - "*A regular expression that matches names of product files. + "A regular expression that matches names of product files. Products are files that get generated from a source file, and hence ought to be recreatable if they are deleted." :type 'regexp @@ -200,13 +201,13 @@ (defface eshell-ls-product '((((class color) (background light)) (:foreground "OrangeRed")) (((class color) (background dark)) (:foreground "LightSalmon"))) - "*The face used for highlighting files that are build products." + "The face used for highlighting files that are build products." :group 'eshell-ls) (define-obsolete-face-alias 'eshell-ls-product-face 'eshell-ls-product "22.1") (defcustom eshell-ls-clutter-regexp "\\(^texput\\.log\\|^core\\)\\'" - "*A regular expression that matches names of junk files. + "A regular expression that matches names of junk files. These are mainly files that get created for various reasons, but don't really need to stick around for very long." :type 'regexp @@ -215,7 +216,7 @@ (defface eshell-ls-clutter '((((class color) (background light)) (:foreground "OrangeRed" :weight bold)) (((class color) (background dark)) (:foreground "OrangeRed" :weight bold))) - "*The face used for highlighting junk file names." + "The face used for highlighting junk file names." :group 'eshell-ls) (define-obsolete-face-alias 'eshell-ls-clutter-face 'eshell-ls-clutter "22.1") @@ -249,7 +250,7 @@ (,(eval func) ,file))))) (defcustom eshell-ls-highlight-alist nil - "*This alist correlates test functions to color. + "This alist correlates test functions to color. The format of the members of this alist is (TEST-SEXP . FACE)
--- a/lisp/eshell/em-pred.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/eshell/em-pred.el Mon Sep 27 14:42:43 2010 +0900 @@ -61,7 +61,7 @@ ;;; User Variables: (defcustom eshell-pred-load-hook '(eshell-pred-initialize) - "*A list of functions to run when `eshell-pred' is loaded." + "A list of functions to run when `eshell-pred' is loaded." :type 'hook :group 'eshell-pred) @@ -101,7 +101,7 @@ (?m . (eshell-pred-file-time ?m "modification" 5)) (?c . (eshell-pred-file-time ?c "change" 6)) (?L . (eshell-pred-file-size))) - "*A list of predicates than can be applied to a globbing pattern. + "A list of predicates than can be applied to a globbing pattern. The format of each entry is (CHAR . PREDICATE-FUNC-SEXP)" @@ -150,7 +150,7 @@ (eshell-pred-substitute t) (error "`g' modifier cannot be used alone")))) (?s . (eshell-pred-substitute))) - "*A list of modifiers than can be applied to an argument expansion. + "A list of modifiers than can be applied to an argument expansion. The format of each entry is (CHAR ENTRYWISE-P MODIFIER-FUNC-SEXP)"
--- a/lisp/eshell/em-prompt.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/eshell/em-prompt.el Mon Sep 27 14:42:43 2010 +0900 @@ -39,7 +39,7 @@ ;;; User Variables: (defcustom eshell-prompt-load-hook '(eshell-prompt-initialize) - "*A list of functions to call when loading `eshell-prompt'." + "A list of functions to call when loading `eshell-prompt'." :type 'hook :group 'eshell-prompt) @@ -55,7 +55,7 @@ :group 'eshell-prompt) (defcustom eshell-prompt-regexp "^[^#$\n]* [#$] " - "*A regexp which fully matches your eshell prompt. + "A regexp which fully matches your eshell prompt. This setting is important, since it affects how eshell will interpret the lines that are passed to it. If this variable is changed, all Eshell buffers must be exited and @@ -64,7 +64,7 @@ :group 'eshell-prompt) (defcustom eshell-highlight-prompt t - "*If non-nil, Eshell should highlight the prompt." + "If non-nil, Eshell should highlight the prompt." :type 'boolean :group 'eshell-prompt) @@ -72,20 +72,20 @@ '((((class color) (background light)) (:foreground "Red" :bold t)) (((class color) (background dark)) (:foreground "Pink" :bold t)) (t (:bold t))) - "*The face used to highlight prompt strings. + "The face used to highlight prompt strings. For highlighting other kinds of strings -- similar to shell mode's behavior -- simply use an output filer which changes text properties." :group 'eshell-prompt) (define-obsolete-face-alias 'eshell-prompt-face 'eshell-prompt "22.1") (defcustom eshell-before-prompt-hook nil - "*A list of functions to call before outputting the prompt." + "A list of functions to call before outputting the prompt." :type 'hook :options '(eshell-begin-on-new-line) :group 'eshell-prompt) (defcustom eshell-after-prompt-hook nil - "*A list of functions to call after outputting the prompt. + "A list of functions to call after outputting the prompt. Note that if `eshell-scroll-show-maximum-output' is non-nil, then setting `eshell-show-maximum-output' here won't do much. It depends on whether the user wants the resizing to happen while output is
--- a/lisp/eshell/em-rebind.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/eshell/em-rebind.el Mon Sep 27 14:42:43 2010 +0900 @@ -43,7 +43,7 @@ ;;; User Variables: (defcustom eshell-rebind-load-hook '(eshell-rebind-initialize) - "*A list of functions to call when loading `eshell-rebind'." + "A list of functions to call when loading `eshell-rebind'." :type 'hook :group 'eshell-rebind) @@ -55,14 +55,14 @@ ([delete] . eshell-delete-backward-char) ([(control ?w)] . backward-kill-word) ([(control ?u)] . eshell-kill-input)) - "*Bind some keys differently if point is in input text." + "Bind some keys differently if point is in input text." :type '(repeat (cons (vector :tag "Keys to bind" (repeat :inline t sexp)) (function :tag "Command"))) :group 'eshell-rebind) (defcustom eshell-confine-point-to-input t - "*If non-nil, do not allow the point to leave the current input. + "If non-nil, do not allow the point to leave the current input. This is more difficult to do nicely in Emacs than one might think. Basically, the `point-left' attribute is added to the input text, and a function is placed on that hook to take the point back to @@ -77,13 +77,13 @@ :group 'eshell-rebind) (defcustom eshell-error-if-move-away t - "*If non-nil, consider it an error to try to move outside current input. + "If non-nil, consider it an error to try to move outside current input. This is default behavior of shells like bash." :type 'boolean :group 'eshell-rebind) (defcustom eshell-remap-previous-input t - "*If non-nil, remap input keybindings on previous prompts as well." + "If non-nil, remap input keybindings on previous prompts as well." :type 'boolean :group 'eshell-rebind) @@ -132,7 +132,7 @@ forward-visible-line forward-comment forward-thing) - "*A list of commands that cannot leave the input area." + "A list of commands that cannot leave the input area." :type '(repeat function) :group 'eshell-rebind)
--- a/lisp/eshell/em-script.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/eshell/em-script.el Mon Sep 27 14:42:43 2010 +0900 @@ -36,19 +36,19 @@ ;;; User Variables: (defcustom eshell-script-load-hook '(eshell-script-initialize) - "*A list of functions to call when loading `eshell-script'." + "A list of functions to call when loading `eshell-script'." :type 'hook :group 'eshell-script) (defcustom eshell-login-script (expand-file-name "login" eshell-directory-name) - "*If non-nil, a file to invoke when starting up Eshell interactively. + "If non-nil, a file to invoke when starting up Eshell interactively. This file should be a file containing Eshell commands, where comment lines begin with '#'." :type 'file :group 'eshell-script) (defcustom eshell-rc-script (expand-file-name "profile" eshell-directory-name) - "*If non-nil, a file to invoke whenever Eshell is started. + "If non-nil, a file to invoke whenever Eshell is started. This includes when running `eshell-command'." :type 'file :group 'eshell-script)
--- a/lisp/eshell/em-smart.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/eshell/em-smart.el Mon Sep 27 14:42:43 2010 +0900 @@ -86,7 +86,7 @@ ;;; User Variables: (defcustom eshell-smart-load-hook '(eshell-smart-initialize) - "*A list of functions to call when loading `eshell-smart'." + "A list of functions to call when loading `eshell-smart'." :type 'hook :group 'eshell-smart) @@ -96,12 +96,12 @@ (lambda () (remove-hook 'window-configuration-change-hook 'eshell-refresh-windows)))) - "*A hook that gets run when `eshell-smart' is unloaded." + "A hook that gets run when `eshell-smart' is unloaded." :type 'hook :group 'eshell-smart) (defcustom eshell-review-quick-commands nil - "*If t, always review commands. + "If t, always review commands. Reviewing means keeping point on the text of the command that was just invoked, to allow corrections to be made easily. @@ -124,12 +124,12 @@ yank-pop yank-rectangle yank) - "*A list of commands which cause Eshell to jump to the end of buffer." + "A list of commands which cause Eshell to jump to the end of buffer." :type '(repeat function) :group 'eshell-smart) (defcustom eshell-smart-space-goes-to-end t - "*If non-nil, space will go to end of buffer when point-max is visible. + "If non-nil, space will go to end of buffer when point-max is visible. That is, if a command is running and the user presses SPACE at a time when the end of the buffer is visible, point will go to the end of the buffer and smart-display will be turned off (that is, subsequently @@ -148,7 +148,7 @@ :group 'eshell-smart) (defcustom eshell-where-to-jump 'begin - "*This variable indicates where point should jump to after a command. + "This variable indicates where point should jump to after a command. The options are `begin', `after' or `end'." :type '(radio (const :tag "Beginning of command" begin) (const :tag "After command word" after)
--- a/lisp/eshell/em-term.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/eshell/em-term.el Mon Sep 27 14:42:43 2010 +0900 @@ -48,7 +48,7 @@ ;;; User Variables: (defcustom eshell-term-load-hook '(eshell-term-initialize) - "*A list of functions to call when loading `eshell-term'." + "A list of functions to call when loading `eshell-term'." :type 'hook :group 'eshell-term) @@ -58,19 +58,19 @@ "less" "more" ; M-x view-file "lynx" "ncftp" ; w3.el, ange-ftp "pine" "tin" "trn" "elm") ; GNUS!! - "*A list of commands that present their output in a visual fashion." + "A list of commands that present their output in a visual fashion." :type '(repeat string) :group 'eshell-term) (defcustom eshell-term-name "eterm" - "*Name to use for the TERM variable when running visual commands. + "Name to use for the TERM variable when running visual commands. See `term-term-name' in term.el for more information on how this is used." :type 'string :group 'eshell-term) (defcustom eshell-escape-control-x t - "*If non-nil, allow <C-x> to be handled by Emacs key in visual buffers. + "If non-nil, allow <C-x> to be handled by Emacs key in visual buffers. See the variable `eshell-visual-commands'. If this variable is set to nil, <C-x> will send that control character to the invoked process." :type 'boolean
--- a/lisp/eshell/em-unix.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/eshell/em-unix.el Mon Sep 27 14:42:43 2010 +0900 @@ -55,84 +55,84 @@ :group 'eshell-module) (defcustom eshell-unix-load-hook '(eshell-unix-initialize) - "*A list of functions to run when `eshell-unix' is loaded." + "A list of functions to run when `eshell-unix' is loaded." :type 'hook :group 'eshell-unix) (defcustom eshell-plain-grep-behavior nil - "*If non-nil, standalone \"grep\" commands will behave normally. + "If non-nil, standalone \"grep\" commands will behave normally. Standalone in this context means not redirected, and not on the receiving side of a command pipeline." :type 'boolean :group 'eshell-unix) (defcustom eshell-no-grep-available (not (eshell-search-path "grep")) - "*If non-nil, no grep is available on the current machine." + "If non-nil, no grep is available on the current machine." :type 'boolean :group 'eshell-unix) (defcustom eshell-plain-diff-behavior nil - "*If non-nil, standalone \"diff\" commands will behave normally. + "If non-nil, standalone \"diff\" commands will behave normally. Standalone in this context means not redirected, and not on the receiving side of a command pipeline." :type 'boolean :group 'eshell-unix) (defcustom eshell-plain-locate-behavior (featurep 'xemacs) - "*If non-nil, standalone \"locate\" commands will behave normally. + "If non-nil, standalone \"locate\" commands will behave normally. Standalone in this context means not redirected, and not on the receiving side of a command pipeline." :type 'boolean :group 'eshell-unix) (defcustom eshell-rm-removes-directories nil - "*If non-nil, `rm' will remove directory entries. + "If non-nil, `rm' will remove directory entries. Otherwise, `rmdir' is required." :type 'boolean :group 'eshell-unix) (defcustom eshell-rm-interactive-query (= (user-uid) 0) - "*If non-nil, `rm' will query before removing anything." + "If non-nil, `rm' will query before removing anything." :type 'boolean :group 'eshell-unix) (defcustom eshell-mv-interactive-query (= (user-uid) 0) - "*If non-nil, `mv' will query before overwriting anything." + "If non-nil, `mv' will query before overwriting anything." :type 'boolean :group 'eshell-unix) (defcustom eshell-mv-overwrite-files t - "*If non-nil, `mv' will overwrite files without warning." + "If non-nil, `mv' will overwrite files without warning." :type 'boolean :group 'eshell-unix) (defcustom eshell-cp-interactive-query (= (user-uid) 0) - "*If non-nil, `cp' will query before overwriting anything." + "If non-nil, `cp' will query before overwriting anything." :type 'boolean :group 'eshell-unix) (defcustom eshell-cp-overwrite-files t - "*If non-nil, `cp' will overwrite files without warning." + "If non-nil, `cp' will overwrite files without warning." :type 'boolean :group 'eshell-unix) (defcustom eshell-ln-interactive-query (= (user-uid) 0) - "*If non-nil, `ln' will query before overwriting anything." + "If non-nil, `ln' will query before overwriting anything." :type 'boolean :group 'eshell-unix) (defcustom eshell-ln-overwrite-files nil - "*If non-nil, `ln' will overwrite files without warning." + "If non-nil, `ln' will overwrite files without warning." :type 'boolean :group 'eshell-unix) (defcustom eshell-default-target-is-dot nil - "*If non-nil, the default destination for cp, mv or ln is `.'." + "If non-nil, the default destination for cp, mv or ln is `.'." :type 'boolean :group 'eshell-unix) (defcustom eshell-du-prefer-over-ange nil - "*Use Eshell's du in ange-ftp remote directories. + "Use Eshell's du in ange-ftp remote directories. Otherwise, Emacs will attempt to use rsh to invoke du on the remote machine." :type 'boolean :group 'eshell-unix)
--- a/lisp/eshell/esh-cmd.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/eshell/esh-cmd.el Mon Sep 27 14:42:43 2010 +0900 @@ -122,28 +122,28 @@ :group 'eshell) (defcustom eshell-prefer-lisp-functions nil - "*If non-nil, prefer Lisp functions to external commands." + "If non-nil, prefer Lisp functions to external commands." :type 'boolean :group 'eshell-cmd) (defcustom eshell-lisp-regexp "\\([(`]\\|#'\\)" - "*A regexp which, if matched at beginning of an argument, means Lisp. + "A regexp which, if matched at beginning of an argument, means Lisp. Such arguments will be passed to `read', and then evaluated." :type 'regexp :group 'eshell-cmd) (defcustom eshell-pre-command-hook nil - "*A hook run before each interactive command is invoked." + "A hook run before each interactive command is invoked." :type 'hook :group 'eshell-cmd) (defcustom eshell-post-command-hook nil - "*A hook run after each interactive command is invoked." + "A hook run after each interactive command is invoked." :type 'hook :group 'eshell-cmd) (defcustom eshell-prepare-command-hook nil - "*A set of functions called to prepare a named command. + "A set of functions called to prepare a named command. The command name and its argument are in `eshell-last-command-name' and `eshell-last-arguments'. The functions on this hook can change the value of these symbols if necessary. @@ -154,7 +154,7 @@ :group 'eshell-cmd) (defcustom eshell-named-command-hook nil - "*A set of functions called before a named command is invoked. + "A set of functions called before a named command is invoked. Each function will be passed the command name and arguments that were passed to `eshell-named-command'. @@ -180,7 +180,7 @@ (defcustom eshell-pre-rewrite-command-hook '(eshell-no-command-conversion eshell-subcommand-arg-values) - "*A hook run before command rewriting begins. + "A hook run before command rewriting begins. The terms of the command to be rewritten is passed as arguments, and may be modified in place. Any return value is ignored." :type 'hook @@ -193,7 +193,7 @@ eshell-rewrite-sexp-command eshell-rewrite-initial-subcommand eshell-rewrite-named-command) - "*A set of functions used to rewrite the command argument. + "A set of functions used to rewrite the command argument. Once parsing of a command line is completed, the next step is to rewrite the initial argument into something runnable. @@ -207,14 +207,14 @@ :group 'eshell-cmd) (defcustom eshell-post-rewrite-command-hook nil - "*A hook run after command rewriting is finished. + "A hook run after command rewriting is finished. Each function is passed the symbol containing the rewritten command, which may be modified directly. Any return value is ignored." :type 'hook :group 'eshell-cmd) (defcustom eshell-complex-commands '("ls") - "*A list of commands names or functions, that determine complexity. + "A list of commands names or functions, that determine complexity. That is, if a command is defined by a function named eshell/NAME, and NAME is part of this list, it is invoked as a complex command. Complex commands are always correct, but run much slower. If a @@ -231,12 +231,12 @@ ;;; User Variables: (defcustom eshell-cmd-load-hook '(eshell-cmd-initialize) - "*A hook that gets run when `eshell-cmd' is loaded." + "A hook that gets run when `eshell-cmd' is loaded." :type 'hook :group 'eshell-cmd) (defcustom eshell-debug-command nil - "*If non-nil, enable debugging code. SSLLOOWW. + "If non-nil, enable debugging code. SSLLOOWW. This option is only useful for reporting bugs. If you enable it, you will have to visit the file 'eshell-cmd.el' and run the command \\[eval-buffer]." @@ -247,7 +247,7 @@ '(eshell-named-command eshell-lisp-command eshell-process-identity) - "*A list of functions which might return an ansychronous process. + "A list of functions which might return an ansychronous process. If they return a process object, execution of the calling Eshell command will wait for completion (in the background) before finishing the command." @@ -258,7 +258,7 @@ '((eshell-in-subcommand-p t) (default-directory default-directory) (process-environment (eshell-copy-environment))) - "*A list of `let' bindings for subcommand environments." + "A list of `let' bindings for subcommand environments." :type 'sexp :group 'eshell-cmd)
--- a/lisp/eshell/esh-ext.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/eshell/esh-ext.el Mon Sep 27 14:42:43 2010 +0900 @@ -1,7 +1,7 @@ ;;; esh-ext.el --- commands external to Eshell -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw@gnu.org> @@ -48,17 +48,17 @@ ;;; User Variables: (defcustom eshell-ext-load-hook '(eshell-ext-initialize) - "*A hook that gets run when `eshell-ext' is loaded." + "A hook that gets run when `eshell-ext' is loaded." :type 'hook :group 'eshell-ext) (defcustom eshell-binary-suffixes exec-suffixes - "*A list of suffixes used when searching for executable files." + "A list of suffixes used when searching for executable files." :type '(repeat string) :group 'eshell-ext) (defcustom eshell-force-execution nil - "*If non-nil, try to execute binary files regardless of permissions. + "If non-nil, try to execute binary files regardless of permissions. This can be useful on systems like Windows, where the operating system doesn't happen to honor the permission bits in certain cases; or in cases where you want to associate an interpreter with a particular @@ -96,7 +96,7 @@ (or (eshell-search-path "cmd.exe") (eshell-search-path "command.com")) shell-file-name)) - "*The name of the shell command to use for DOS/Windows batch files. + "The name of the shell command to use for DOS/Windows batch files. This defaults to nil on non-Windows systems, where this variable is wholly ignored." :type '(choice file (const nil)) @@ -113,7 +113,7 @@ (defcustom eshell-interpreter-alist (if (eshell-under-windows-p) '(("\\.\\(bat\\|cmd\\)\\'" . eshell-invoke-batch-file))) - "*An alist defining interpreter substitutions. + "An alist defining interpreter substitutions. Each member is a cons cell of the form: (MATCH . INTERPRETER) @@ -134,7 +134,7 @@ :group 'eshell-ext) (defcustom eshell-alternate-command-hook nil - "*A hook run whenever external command lookup fails. + "A hook run whenever external command lookup fails. If a functions wishes to provide an alternate command, they must throw it using the tag `eshell-replace-command'. This is done because the substituted command need not be external at all, and therefore must be @@ -147,12 +147,12 @@ :group 'eshell-ext) (defcustom eshell-command-interpreter-max-length 256 - "*The maximum length of any command interpreter string, plus args." + "The maximum length of any command interpreter string, plus args." :type 'integer :group 'eshell-ext) (defcustom eshell-explicit-command-char ?* - "*If this char occurs before a command name, call it externally. + "If this char occurs before a command name, call it externally. That is, although `vi' may be an alias, `\vi' will always call the external version." :type 'character
--- a/lisp/eshell/esh-io.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/eshell/esh-io.el Mon Sep 27 14:42:43 2010 +0900 @@ -73,12 +73,12 @@ ;;; User Variables: (defcustom eshell-io-load-hook '(eshell-io-initialize) - "*A hook that gets run when `eshell-io' is loaded." + "A hook that gets run when `eshell-io' is loaded." :type 'hook :group 'eshell-io) (defcustom eshell-number-of-handles 3 - "*The number of file handles that eshell supports. + "The number of file handles that eshell supports. Currently this is standard input, output and error. But even all of these Emacs does not currently support with asynchronous processes \(which is what eshell uses so that you can continue doing work in @@ -87,17 +87,17 @@ :group 'eshell-io) (defcustom eshell-output-handle 1 - "*The index of the standard output handle." + "The index of the standard output handle." :type 'integer :group 'eshell-io) (defcustom eshell-error-handle 2 - "*The index of the standard error handle." + "The index of the standard error handle." :type 'integer :group 'eshell-io) (defcustom eshell-buffer-shorthand nil - "*If non-nil, a symbol name can be used for a buffer in redirection. + "If non-nil, a symbol name can be used for a buffer in redirection. If nil, redirecting to a buffer requires buffer name syntax. If this variable is set, redirection directly to Lisp symbols will be impossible. @@ -110,7 +110,7 @@ :group 'eshell-io) (defcustom eshell-print-queue-size 5 - "*The size of the print queue, for doing buffered printing. + "The size of the print queue, for doing buffered printing. This is basically a speed enhancement, to avoid blocking the Lisp code from executing while Emacs is redisplaying." :type 'integer @@ -127,7 +127,7 @@ (let ((x-select-enable-clipboard t)) (kill-new ""))) 'eshell-clipboard-append) t)) - "*Map virtual devices name to Emacs Lisp functions. + "Map virtual devices name to Emacs Lisp functions. If the user specifies any of the filenames above as a redirection target, the function in the second element will be called.
--- a/lisp/eshell/esh-mode.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/eshell/esh-mode.el Mon Sep 27 14:42:43 2010 +0900 @@ -75,54 +75,54 @@ ;;; User Variables: (defcustom eshell-mode-unload-hook nil - "*A hook that gets run when `eshell-mode' is unloaded." + "A hook that gets run when `eshell-mode' is unloaded." :type 'hook :group 'eshell-mode) (defcustom eshell-mode-hook nil - "*A hook that gets run when `eshell-mode' is entered." + "A hook that gets run when `eshell-mode' is entered." :type 'hook :group 'eshell-mode) (defcustom eshell-first-time-mode-hook nil - "*A hook that gets run the first time `eshell-mode' is entered. + "A hook that gets run the first time `eshell-mode' is entered. That is to say, the first time during an Emacs session." :type 'hook :group 'eshell-mode) (defcustom eshell-exit-hook '(eshell-query-kill-processes) - "*A hook that is run whenever `eshell' is exited. + "A hook that is run whenever `eshell' is exited. This hook is only run if exiting actually kills the buffer." :type 'hook :group 'eshell-mode) (defcustom eshell-kill-on-exit t - "*If non-nil, kill the Eshell buffer on the `exit' command. + "If non-nil, kill the Eshell buffer on the `exit' command. Otherwise, the buffer will simply be buried." :type 'boolean :group 'eshell-mode) (defcustom eshell-input-filter-functions nil - "*Functions to call before input is processed. + "Functions to call before input is processed. The input is contained in the region from `eshell-last-input-start' to `eshell-last-input-end'." :type 'hook :group 'eshell-mode) (defcustom eshell-send-direct-to-subprocesses nil - "*If t, send any input immediately to a subprocess." + "If t, send any input immediately to a subprocess." :type 'boolean :group 'eshell-mode) (defcustom eshell-expand-input-functions nil - "*Functions to call before input is parsed. + "Functions to call before input is parsed. Each function is passed two arguments, which bounds the region of the current input text." :type 'hook :group 'eshell-mode) (defcustom eshell-scroll-to-bottom-on-input nil - "*Controls whether input to interpreter causes window to scroll. + "Controls whether input to interpreter causes window to scroll. If nil, then do not scroll. If t or `all', scroll all windows showing buffer. If `this', scroll only the selected window. @@ -133,7 +133,7 @@ :group 'eshell-mode) (defcustom eshell-scroll-to-bottom-on-output nil - "*Controls whether interpreter output causes window to scroll. + "Controls whether interpreter output causes window to scroll. If nil, then do not scroll. If t or `all', scroll all windows showing buffer. If `this', scroll only the selected window. If `others', scroll only those that are not the selected window. @@ -147,7 +147,7 @@ :group 'eshell-mode) (defcustom eshell-scroll-show-maximum-output t - "*Controls how interpreter output causes window to scroll. + "Controls how interpreter output causes window to scroll. If non-nil, then show the maximum output when the window is scrolled. See variable `eshell-scroll-to-bottom-on-output' and function @@ -156,7 +156,7 @@ :group 'eshell-mode) (defcustom eshell-buffer-maximum-lines 1024 - "*The maximum size in lines for eshell buffers. + "The maximum size in lines for eshell buffers. Eshell buffers are truncated from the top to be no greater than this number, if the function `eshell-truncate-buffer' is on `eshell-output-filter-functions'." @@ -168,14 +168,14 @@ eshell-handle-control-codes eshell-handle-ansi-color eshell-watch-for-password-prompt) - "*Functions to call before output is displayed. + "Functions to call before output is displayed. These functions are only called for output that is displayed interactively, and not for output which is redirected." :type 'hook :group 'eshell-mode) (defcustom eshell-preoutput-filter-functions nil - "*Functions to call before output is inserted into the buffer. + "Functions to call before output is inserted into the buffer. These functions get one argument, a string containing the text to be inserted. They return the string as it should be inserted." :type 'hook @@ -183,18 +183,18 @@ (defcustom eshell-password-prompt-regexp "[Pp]ass\\(word\\|phrase\\).*:\\s *\\'" - "*Regexp matching prompts for passwords in the inferior process. + "Regexp matching prompts for passwords in the inferior process. This is used by `eshell-watch-for-password-prompt'." :type 'regexp :group 'eshell-mode) (defcustom eshell-skip-prompt-function nil - "*A function called from beginning of line to skip the prompt." + "A function called from beginning of line to skip the prompt." :type '(choice (const nil) function) :group 'eshell-mode) (defcustom eshell-status-in-modeline t - "*If non-nil, let the user know a command is running in the modeline." + "If non-nil, let the user know a command is running in the modeline." :type 'boolean :group 'eshell-mode)
--- a/lisp/eshell/esh-proc.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/eshell/esh-proc.el Mon Sep 27 14:42:43 2010 +0900 @@ -1,7 +1,7 @@ ;;; esh-proc.el --- process management -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw@gnu.org> @@ -40,27 +40,27 @@ ;;; User Variables: (defcustom eshell-proc-load-hook '(eshell-proc-initialize) - "*A hook that gets run when `eshell-proc' is loaded." + "A hook that gets run when `eshell-proc' is loaded." :type 'hook :group 'eshell-proc) (defcustom eshell-process-wait-seconds 0 - "*The number of seconds to delay waiting for a synchronous process." + "The number of seconds to delay waiting for a synchronous process." :type 'integer :group 'eshell-proc) (defcustom eshell-process-wait-milliseconds 50 - "*The number of milliseconds to delay waiting for a synchronous process." + "The number of milliseconds to delay waiting for a synchronous process." :type 'integer :group 'eshell-proc) (defcustom eshell-done-messages-in-minibuffer t - "*If non-nil, subjob \"Done\" messages will display in minibuffer." + "If non-nil, subjob \"Done\" messages will display in minibuffer." :type 'boolean :group 'eshell-proc) (defcustom eshell-delete-exited-processes t - "*If nil, process entries will stick around until `jobs' is run. + "If nil, process entries will stick around until `jobs' is run. This variable sets the buffer-local value of `delete-exited-processes' in Eshell buffers. @@ -81,12 +81,12 @@ (defcustom eshell-reset-signals "^\\(interrupt\\|killed\\|quit\\|stopped\\)" - "*If a termination signal matches this regexp, the terminal will be reset." + "If a termination signal matches this regexp, the terminal will be reset." :type 'regexp :group 'eshell-proc) (defcustom eshell-exec-hook nil - "*Called each time a process is exec'd by `eshell-gather-process-output'. + "Called each time a process is exec'd by `eshell-gather-process-output'. It is passed one argument, which is the process that was just started. It is useful for things that must be done each time a process is executed in a eshell mode buffer (e.g., `process-kill-without-query'). @@ -96,7 +96,7 @@ :group 'eshell-proc) (defcustom eshell-kill-hook '(eshell-reset-after-proc) - "*Called when a process run by `eshell-gather-process-output' has ended. + "Called when a process run by `eshell-gather-process-output' has ended. It is passed two arguments: the process that was just ended, and the termination status (as a string). Note that the first argument may be nil, in which case the user attempted to send a signal, but there was @@ -418,12 +418,12 @@ result)) (defcustom eshell-kill-process-wait-time 5 - "*Seconds to wait between sending termination signals to a subprocess." + "Seconds to wait between sending termination signals to a subprocess." :type 'integer :group 'eshell-proc) (defcustom eshell-kill-process-signals '(SIGINT SIGQUIT SIGKILL) - "*Signals used to kill processes when an Eshell buffer exits. + "Signals used to kill processes when an Eshell buffer exits. Eshell calls each of these signals in order when an Eshell buffer is killed; if the process is still alive afterwards, Eshell waits a number of seconds defined by `eshell-kill-process-wait-time', and @@ -432,7 +432,7 @@ :group 'eshell-proc) (defcustom eshell-kill-processes-on-exit nil - "*If non-nil, kill active processes when exiting an Eshell buffer. + "If non-nil, kill active processes when exiting an Eshell buffer. Emacs will only kill processes owned by that Eshell buffer. If nil, ownership of background and foreground processes reverts to
--- a/lisp/eshell/esh-test.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/eshell/esh-test.el Mon Sep 27 14:42:43 2010 +0900 @@ -43,7 +43,7 @@ (defface eshell-test-ok '((((class color) (background light)) (:foreground "Green" :bold t)) (((class color) (background dark)) (:foreground "Green" :bold t))) - "*The face used to highlight OK result strings." + "The face used to highlight OK result strings." :group 'eshell-test) (define-obsolete-face-alias 'eshell-test-ok-face 'eshell-test-ok "22.1") @@ -51,12 +51,12 @@ '((((class color) (background light)) (:foreground "OrangeRed" :bold t)) (((class color) (background dark)) (:foreground "OrangeRed" :bold t)) (t (:bold t))) - "*The face used to highlight FAILED result strings." + "The face used to highlight FAILED result strings." :group 'eshell-test) (define-obsolete-face-alias 'eshell-test-failed-face 'eshell-test-failed "22.1") (defcustom eshell-show-usage-metrics nil - "*If non-nil, display different usage metrics for each Eshell command." + "If non-nil, display different usage metrics for each Eshell command." :set (lambda (symbol value) (if value (add-hook 'eshell-mode-hook 'eshell-show-usage-metrics)
--- a/lisp/eshell/esh-util.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/eshell/esh-util.el Mon Sep 27 14:42:43 2010 +0900 @@ -32,7 +32,7 @@ ;;; User Variables: (defcustom eshell-stringify-t t - "*If non-nil, the string representation of t is 't'. + "If non-nil, the string representation of t is 't'. If nil, t will be represented only in the exit code of the function, and not printed as a string. This causes Lisp functions to behave similarly to external commands, as far as successful result output." @@ -40,44 +40,45 @@ :group 'eshell-util) (defcustom eshell-group-file "/etc/group" - "*If non-nil, the name of the group file on your system." + "If non-nil, the name of the group file on your system." :type '(choice (const :tag "No group file" nil) file) :group 'eshell-util) (defcustom eshell-passwd-file "/etc/passwd" - "*If non-nil, the name of the passwd file on your system." + "If non-nil, the name of the passwd file on your system." :type '(choice (const :tag "No passwd file" nil) file) :group 'eshell-util) (defcustom eshell-hosts-file "/etc/hosts" - "*The name of the /etc/hosts file." + "The name of the /etc/hosts file." :type '(choice (const :tag "No hosts file" nil) file) :group 'eshell-util) (defcustom eshell-handle-errors t - "*If non-nil, Eshell will handle errors itself. + "If non-nil, Eshell will handle errors itself. Setting this to nil is offered as an aid to debugging only." :type 'boolean :group 'eshell-util) (defcustom eshell-private-file-modes 384 ; umask 177 - "*The file-modes value to use for creating \"private\" files." + "The file-modes value to use for creating \"private\" files." :type 'integer :group 'eshell-util) (defcustom eshell-private-directory-modes 448 ; umask 077 - "*The file-modes value to use for creating \"private\" directories." + "The file-modes value to use for creating \"private\" directories." :type 'integer :group 'eshell-util) (defcustom eshell-tar-regexp - "\\.t\\(ar\\(\\.\\(gz\\|bz2\\|Z\\)\\)?\\|gz\\|a[zZ]\\|z2\\)\\'" - "*Regular expression used to match tar file names." + "\\.t\\(ar\\(\\.\\(gz\\|bz2\\|xz\\|Z\\)\\)?\\|gz\\|a[zZ]\\|z2\\)\\'" + "Regular expression used to match tar file names." + :version "24.1" ; added xz :type 'regexp :group 'eshell-util) (defcustom eshell-convert-numeric-arguments t - "*If non-nil, converting arguments of numeric form to Lisp numbers. + "If non-nil, converting arguments of numeric form to Lisp numbers. Numeric form is tested using the regular expression `eshell-number-regexp'. @@ -95,7 +96,7 @@ :group 'eshell-util) (defcustom eshell-number-regexp "-?\\([0-9]*\\.\\)?[0-9]+\\(e[-0-9.]+\\)?" - "*Regular expression used to match numeric arguments. + "Regular expression used to match numeric arguments. If `eshell-convert-numeric-arguments' is non-nil, and an argument matches this regexp, it will be converted to a Lisp number, using the function `string-to-number'." @@ -103,7 +104,7 @@ :group 'eshell-util) (defcustom eshell-ange-ls-uids nil - "*List of user/host/id strings, used to determine remote ownership." + "List of user/host/id strings, used to determine remote ownership." :type '(repeat (cons :tag "Host for User/UID map" (string :tag "Hostname") (repeat (cons :tag "User/UID List"
--- a/lisp/eshell/esh-var.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/eshell/esh-var.el Mon Sep 27 14:42:43 2010 +0900 @@ -1,7 +1,7 @@ ;;; esh-var.el --- handling of variables -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw@gnu.org> @@ -128,27 +128,27 @@ ;;; User Variables: (defcustom eshell-var-load-hook '(eshell-var-initialize) - "*A list of functions to call when loading `eshell-var'." + "A list of functions to call when loading `eshell-var'." :type 'hook :group 'eshell-var) (defcustom eshell-prefer-lisp-variables nil - "*If non-nil, prefer Lisp variables to environment variables." + "If non-nil, prefer Lisp variables to environment variables." :type 'boolean :group 'eshell-var) (defcustom eshell-complete-export-definition t - "*If non-nil, completing names for `export' shows current definition." + "If non-nil, completing names for `export' shows current definition." :type 'boolean :group 'eshell-var) (defcustom eshell-modify-global-environment nil - "*If non-nil, using `export' changes Emacs's global environment." + "If non-nil, using `export' changes Emacs's global environment." :type 'boolean :group 'eshell-var) (defcustom eshell-variable-name-regexp "[A-Za-z0-9_-]+" - "*A regexp identifying what constitutes a variable name reference. + "A regexp identifying what constitutes a variable name reference. Note that this only applies for '$NAME'. If the syntax '$<NAME>' is used, then NAME can contain any character, including angle brackets, if they are quoted with a backslash." @@ -183,7 +183,7 @@ eshell-command-arguments (eshell-apply-indices eshell-command-arguments indices))))) - "*This list provides aliasing for variable references. + "This list provides aliasing for variable references. It is very similar in concept to what `eshell-user-aliases-list' does for commands. Each member of this defines defines the name of a command, and the Lisp value to return for that variable if it is
--- a/lisp/files.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/files.el Mon Sep 27 14:42:43 2010 +0900 @@ -2211,6 +2211,15 @@ (cons (purecopy (car elt)) (cdr elt))) `(;; do this first, so that .html.pl is Polish html, not Perl ("\\.s?html?\\(\\.[a-zA-Z_]+\\)?\\'" . html-mode) + ("\\.svgz?\\'" . image-mode) + ("\\.svgz?\\'" . xml-mode) + ("\\.x[bp]m\\'" . image-mode) + ("\\.x[bp]m\\'" . c-mode) + ("\\.p[bpgn]m\\'" . image-mode) + ("\\.tiff?\\'" . image-mode) + ("\\.gif\\'" . image-mode) + ("\\.png\\'" . image-mode) + ("\\.jpe?g\\'" . image-mode) ("\\.te?xt\\'" . text-mode) ("\\.[tT]e[xX]\\'" . tex-mode) ("\\.ins\\'" . tex-mode) ;Installation files for TeX packages. @@ -2246,6 +2255,14 @@ ("\\.te?xi\\'" . texinfo-mode) ("\\.[sS]\\'" . asm-mode) ("\\.asm\\'" . asm-mode) + ("\\.css\\'" . css-mode) + ("\\.mixal\\'" . mixal-mode) + ("\\.gcov\\'" . compilation-mode) + ;; Besides .gdbinit, gdb documents other names to be usable for init + ;; files, cross-debuggers can use something like + ;; .PROCESSORNAME-gdbinit so that the host and target gdbinit files + ;; don't interfere with each other. + ("/\\.[a-z0-9-]*gdbinit" . gdb-script-mode) ("[cC]hange\\.?[lL]og?\\'" . change-log-mode) ("[cC]hange[lL]og[-.][0-9]+\\'" . change-log-mode) ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode) @@ -2262,6 +2279,7 @@ ("\\.cl[so]\\'" . latex-mode) ;LaTeX 2e class option ("\\.bbl\\'" . latex-mode) ("\\.bib\\'" . bibtex-mode) + ("\\.bst\\'" . bibtex-style-mode) ("\\.sql\\'" . sql-mode) ("\\.m[4c]\\'" . m4-mode) ("\\.mf\\'" . metafont-mode) @@ -2310,6 +2328,20 @@ ("[:/]_emacs\\'" . emacs-lisp-mode) ("/crontab\\.X*[0-9]+\\'" . shell-script-mode) ("\\.ml\\'" . lisp-mode) + ;; Linux-2.6.9 uses some different suffix for linker scripts: + ;; "ld", "lds", "lds.S", "lds.in", "ld.script", and "ld.script.balo". + ;; eCos uses "ld" and "ldi". Netbsd uses "ldscript.*". + ("\\.ld[si]?\\'" . ld-script-mode) + ("ld\\.?script\\'" . ld-script-mode) + ;; .xs is also used for ld scripts, but seems to be more commonly + ;; associated with Perl .xs files (C with Perl bindings). (Bug#7071) + ("\\.xs\\'" . c-mode) + ;; Explained in binutils ld/genscripts.sh. Eg: + ;; A .x script file is the default script. + ;; A .xr script is for linking without relocation (-r flag). Etc. + ("\\.x[abdsru]?[cnw]?\\'" . ld-script-mode) + ("\\.zone\\'" . dns-mode) + ("\\.soa\\'" . dns-mode) ;; Common Lisp ASDF package system. ("\\.asd\\'" . lisp-mode) ("\\.\\(asn\\|mib\\|smi\\)\\'" . snmp-mode) @@ -5590,22 +5622,17 @@ directory-free-space-args dir) 0))) - ;; Usual format is as follows: - ;; Filesystem ... Used Available Capacity ... - ;; /dev/sda6 ...48106535 35481255 10669850 ... + ;; Assume that the "available" column is before the + ;; "capacity" column. Find the "%" and scan backward. (goto-char (point-min)) - (when (re-search-forward " +Avail[^ \n]*" - (line-end-position) t) - (let ((beg (match-beginning 0)) - (end (match-end 0)) - str) - (forward-line 1) - (setq str - (buffer-substring-no-properties - (+ beg (point) (- (point-min))) - (+ end (point) (- (point-min))))) - (when (string-match "\\` *\\([^ ]+\\)" str) - (match-string 1 str)))))))))) + (forward-line 1) + (when (re-search-forward + "[[:space:]]+[^[:space:]]+%[^%]*$" + (line-end-position) t) + (goto-char (match-beginning 0)) + (let ((endpt (point))) + (skip-chars-backward "^[:space:]") + (buffer-substring-no-properties (point) endpt))))))))) ;; The following expression replaces `dired-move-to-filename-regexp'. (defvar directory-listing-before-filename-regexp
--- a/lisp/filesets.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/filesets.el Mon Sep 27 14:42:43 2010 +0900 @@ -348,7 +348,7 @@ :group 'filesets) ;;(defcustom filesets-menu-cnvfp-flag nil -;; "*Non-nil means show \"Convert :pattern to :files\" entry for :pattern menus." +;; "Non-nil means show \"Convert :pattern to :files\" entry for :pattern menus." ;; :set (function filesets-set-default!) ;; :type 'boolean ;; :group 'filesets)
--- a/lisp/finder.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/finder.el Mon Sep 27 14:42:43 2010 +0900 @@ -278,7 +278,7 @@ help-echo finder-help-echo)))) (defun finder-unknown-keywords () - "Return an alist of unknown keywords and number of their occurences. + "Return an alist of unknown keywords and number of their occurrences. Unknown keywords are those present in `finder-keywords-hash' but not `finder-known-keywords'." (let (alist)
--- a/lisp/gnus/ChangeLog Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/ChangeLog Mon Sep 27 14:42:43 2010 +0900 @@ -1,3 +1,577 @@ +2010-09-27 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-art.el (gnus-mime-delete-part): Fix Lisp type of byte(s). + +2010-09-26 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nndoc.el (nndoc-request-list): Return success always. + + * gnus-agent.el (gnus-agent-retrieve-headers): Don't propagate + `fetch-old' -- we only want to fetch the articles we've requested. The + rest are in the agent, probably. + (gnus-agent-read-servers-validate): Change the level for the "Ignoring + disappeared server" to something low. It's not important. + + * nnimap.el (nnimap-get-whole-article): Remove the data that may have + arrived before the FETCH data. + + * nnmh.el (nnmh-request-expire-articles): Don't try to fetch the expiry + target here, because we don't know the Gnus name of the group. + + * nndraft.el (nndraft-request-expire-articles): Fetch the expiry target + for the correct group. + + * gnus-ems.el (gnus-create-image): Ignore all image-creation errors. + + * gnus.el (gnus): Give a final warning after startup. + + * gnus-util.el (gnus-action-message-log): New variable. + (gnus-message): Use it. + (gnus-final-warning): New function. + + * nnimap.el (nnimap-open-connection): Record the greeting. + (nnimap): Add greeting. + +2010-09-26 Julien Danjou <julien@danjou.info> + + * gnus-html.el (gnus-html-show-images): Fix gnus-html-display-image + arguments. + (gnus-html-wash-images): Fix spec computing to include start/end. + + * gnus-art.el (gnus-article-treat-body-boundary): Fix length computing. + +2010-09-26 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-request-expire-articles): Compress ranges before + deletion. + (nnimap-retrieve-headers): Don't select the group, because that's + already done by nnimap-possibly-change-group. + + * gnus-picon.el (gnus-picon-inhibit-top-level-domains): New variable. + (gnus-picon-transform-address): Use it. + + * mail-source.el (mail-source-value): Revert previous patch. + + * nnimap.el (nnimap-credentials): Allow inhibiting the password query + on failure. + (nnimap-open-connection): Look up both virtual and physical server name + credentials. + + * gnus-win.el: Revert previous patch, since it made Gnus backtrace. + +2009-02-08 Dave Love <fx@gnu.org> + + * gnus-win.el (gnus-window-to-buffer-helper, + gnus-all-windows-visible-p): Function needn't be a symbol. + + * mail-source.el (mail-source-value): Function needn't be a symbol. + +2010-09-26 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * message.el (message-cite-prefix-regexp): Remove } from the cite + prefix. + + * gnus-art.el (gnus-treatment-function-alist): Do picons before + highlight again, so that the highlight is correct. + + * gnus-picon.el (gnus-picon): Remove again. + (gnus-picon-create-glyph): Set the background XPM colour explicitly. + + * gnus-art.el (gnus-treatment-function-alist): Insert picons after + doing the header highlightling, so that the background colour of the + picon is correct. + + * gnus-picon.el (gnus-picon-xbm): Removed obsolete face. + (gnus-picon): Ditto. + (gnus-picon): Reinstate. The background colour for picons is white. + (gnus-picon-insert-glyph): Make the background white. + + * nnml.el (nnml-open-nov): Don't return dead buffers. + + * auth-source.el (auth-source-create): Query the user for whether to + store the credentials. + + * auth-source.el (auth-source-user-or-password): Use the existing auth + sources, if any, for creation. + + * gnus.el (gnus-group-fast-parameter): Return the last matching + parameter instead of the first matching parameter. + +2010-09-26 Julien Danjou <julien@danjou.info> + + * gnus-sum.el (gnus-auto-center-group): Transform into a defcustom. + +2010-09-26 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * mml2015.el (mml2015-use): Remove gpg support. + + * mml1991.el (mml1991-function-alist): Remove gpg function. + (mml1991-gpg-sign): Removed. + +2010-09-26 Andreas Seltenreich <seltenreich@gmx.de> + + * gnus-srvr.el (gnus-browse-subscribe-newsgroup-method): New variable. + (gnus-browse-unsubscribe-current-group): Document it. + (gnus-browse-unsubscribe-group): Use it. + +2010-09-26 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-group.el (gnus-read-ephemeral-bug-group): Add the bug email + address to the To list for easier response. + + * gnus.el (gnus-play-startup-jingle): Removed. + (gnus-splash): Don't play jingle. + (gnus): Silence gnus-load message. + + * gnus-art.el (gnus-treat-play-sounds): Removed. + + * gnus.el (gnus-play-jingle): Remove audio support. + + * gnus-cus.el (gnus-score-customize): Remove audio reference. + + * earcon.el: Removed -- no users. + + * gnus-audio.el: Removed -- no users of this package. + + * gnus-sum.el (gnus-summary-limit-children): Remove nocem support. + + * gnus-start.el (gnus-setup-news): Remove nocem support. + + * gnus-group.el (gnus-group-get-new-news): Removed nocem call. + + * gnus.el (gnus-use-nocem): Removed. + + * gnus-demon.el (gnus-demon-add-nocem, gnus-demon-scan-nocem): + Removed. + + * gnus-nocem.el (gnus-nocem-issuers): Removed file. Apparently nobody + uses NoCeM any more. + + * gnus-art.el (gnus-ctan-url): Seems not very useful -- removed. + (gnus-button-ctan-handler): Ditto. + (gnus-button-handle-ctan-bogus-regexp): Ditto. + (gnus-button-ctan-directory-regexp): Ditto. + (gnus-button-handle-ctan): Ditto. + (gnus-button-tex-level): Ditto. + (gnus-button-alist): Removed CTAN stuff. + +2010-09-25 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-wait-for-response): Reversed logic in the + nnimap-streaming test. + + * gnus-start.el (gnus-get-unread-articles): Don't try to open failed + servers twice. + + * nnimap.el (nnimap-open-connection): Add more error reporting when + nnimap fails early. + + * nnheader.el (nnheader-get-report-string): New function. + (nnheader-get-report): Use it. + + * gnus-int.el (gnus-check-server): Say what the error was when opening + failed. + + * nnimap.el (nnimap-wait-for-response): Search further when we're not + using streaming. + +2010-09-25 Julien Danjou <julien@danjou.info> + + * gnus-html.el (gnus-html-rescale-image): Use our defalias + gnus-window-inside-pixel-edges. + +2010-09-25 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-srvr.el (gnus-server-copy-server): Add documentation. + + * mm-decode.el (mm-save-part): Allow saving to other directories the + normal Emacs way. + + * nndoc.el (nndoc-type-alist): Move mime-parts after mbox. Suggested + by Jay Berkenbilt. + + * gnus-art.el (gnus-mime-delete-part): Fix plural for "byte" when + there isn't a single byte. + + * gnus-int.el (gnus-open-server): Don't query whether to go offline -- + just do it. It doesn't really seem to matter what the user responds + here, I think, so it's just a confusing question. + + * nnimap.el (nnimap-retrieve-group-data-early): Fix typo in the + non-streaming case. + + * gnus-art.el (gnus-flush-original-article-buffer): Separated out. + (gnus-article-encrypt-body): Use it. + + * gnus-sum.el (gnus-summary-show-complete-article): New command and + keystroke. + + * nnimap.el (nnimap-find-wanted-parts-1): Use + gnus-fetch-partial-articles. + + * gnus-art.el (gnus-fetch-partial-articles): New variable. + + * nnimap.el (nnimap-insert-partial-structure): New function. + (nnimap-get-partial-article): New function. + (nnimap-request-article): Use it. + (nnimap-wait-for-response): Return whether the wait was successful. + (nnimap-finish-retrieve-group-infos): Don't do anything if the + retrieval wasn't successful. + (nnimap-retrieve-group-data-early): Allow throttling servers. + (nnimap-streaming): New variable. + (nnimap-fetch-partial-articles): Removed. + + * mm-decode.el (mm-with-part): Protect against killed buffers. + + * nndraft.el (nndraft-retrieve-headers): Insert Lines and Chars headers + for prettier summary display. + +2010-09-25 Andrew Cohen <cohen@andy.bu.edu> (tiny change) + + * nnir.el (nnir-run-imap): Allow sending IMAP search patterns + directly. + +2010-09-25 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.el (gnus-local-domain): Put gnus-local-domain back again, since + apparently third-party libraries depend on it. + + * nnimap.el (nnimap-open-connection): Wait for the response to STARTTLS + before starting negotiation. + + * gnus-art.el (gnus-treat-from-gravatar): Change default to nil for + privacy reasons. + (gnus-treat-mail-gravatar): Ditto. + + * gnus-ems.el (gnus-put-image): Don't put any non-blank text into the + buffer when inserting images. Inserting text into the headers, for + instance, can make them invalid. + +2010-09-25 Julien Danjou <julien@danjou.info> + + * rfc1843.el: Remove useless rfc1843-old-gnus-decode-header-function + variables. + + * nnheader.el: Remove useless variables news-reply-yank-from and + news-reply-yank-message-id. + + * mml2015.el: Remove useless mc-default-scheme and mc-schemes + variables. + + * mml1991.el: Remove useless mml1991-verbose. + + * gnus.el: Remove useless variable gnus-use-generic-from. + Remove obsolete variable gnus-topic-indentation. + + * gnus-uu.el: Remove useless gnus-uu-shar-file-name. + + * gnus-sum.el: Remove useless gnus-newsgroup-none-id. + + * gnus-picon.el: Remove useless gnus-picon-setup-p variable. + + * gnus-group.el: Remove useless gnus-group-icon-cache. + Remove useless gnus-ephemeral-group-server. + + * gnus-bookmark.el: Remove useless gnus-bookmark-after-jump-hook. + + * mml2015.el: Remove useless mml2015-verbose. + + * mml-smime.el: Remove useless mml-smime-verbose. + + * gnus.el: Remove useless gnus-local-domain. + + * gnus-gravatar.el (gnus-gravatar-transform-address): Use + gnus-gravatar-size. + + * gnus-art.el: Remove useless gnus-treat-translate. + +2010-09-24 Julien Danjou <julien@danjou.info> + + * gnus-sum.el: Add support for Gravatars. + + * gnus-art.el: Add support for Gravatars. + + * gnus-gravatar.el: Add this file. + + * gravatar.el: Add this file. + +2010-09-24 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-sum.el (gnus-summary-fetch-faq): Removed. + + * gnus-group.el (gnus-group-fetch-faq): Removed. + + * gnus.el (gnus-group-faq-directory): Removed. + + * gnus-group.el (gnus-group-fetch-charter): Removed. + + * gnus.el (gnus-group-charter-alist): Removed. + + * gnus-group.el (gnus-group-archive-directory): Removed. + (gnus-group-recent-archive-directory): Ditto. + (gnus-group-make-archive-group): Removed. + + * nnimap.el (nnimap-update-info): Protect against nil uidnexts. + + * gnus-cache.el (gnus-cache-braid-heads): When braiding heads, don't + use the same article number for all the cached articles. + + * nnimap.el (nnimap-command): Register the last command time so + that we can use it for idling NOOPs. + (nnimap-open-connection): Start the keeplive timer. + (nnimap-make-process-buffer): Store all the process buffers. + (nnimap-keepalive): New function. + + * starttls.el: (starttls-open-stream): Add autoload cookie. + +2010-09-24 Michael Welsh Duggan <md5i@md5i.com> (tiny change) + + * nnimap.el (nnimap-split-incoming-mail): Fix paren typo in the 'junk + handling. + +2010-09-24 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnrss.el (nnrss-retrieve-groups): Change to the group before checking + its data structures. + + * gnus.el (gnus-sloppily-equal-method-parameters): Use copy-sequence + instead of the cl.el copy-list. + (gnus-sloppily-equal-method-parameters): Use equal instead of the cl + equalp. + +2010-09-24 Katsumi Yamaoka <yamaoka@jpl.org> + + * gmm-utils.el (gmm-tool-bar-from-list): Always use tool-bar-local-item + and tool-bar-local-item-from-menu. + + * gnus-agent.el (gnus-agent-make-mode-line-string): Always use + mode-line-highlight face for Emacs. + + * gnus-art.el (toplevel): Don't bind recursive-load-depth-limit while + loading gnus-sum.elc; fix comment for canlock-verify. + (gnus-article-jump-to-part): Use read-number. + (gnus-insert-mime-button, gnus-insert-mime-security-button): Remove + Emacs pre-21 compatible code for help-echo. + (gnus-article-next-page-1): No need to adjust the number of lines. + (gnus-article-describe-bindings): Always use help-buffer. + + * gnus-audio.el (gnus-audio-inline-sound) + * gnus-cus.el (gnus-custom-mode) + * gnus-group.el (gnus-group-update-tool-bar): Comment fix. + + * gnus-sum.el (gnus-remove-overlays): Doc fix. + + * gnus-util.el (gnus-select-frame-set-input-focus): Remove Emacs 21 + compatible code. + +2010-09-24 Glenn Morris <rgm@gnu.org> + + * message.el (message-output): Use gnus-output-to-rmail if a buffer is + visiting the fcc file in rmail-mode. + +2010-09-24 Katsumi Yamaoka <yamaoka@jpl.org> + + * nnir.el: Silence the byte compiler. + + * gnus-html.el (gnus-html-encode-url-chars): New function, that's an + alias to browse-url-url-encode-chars if any. + (gnus-html-encode-url): Use it. + +2010-09-23 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-start.el (gnus-use-backend-marks): New variable. + (gnus-get-unread-articles-in-group): Use it. + + * gnus-sum.el (gnus-summary-local-variables): Prepare for list/range + makeover. + +2010-09-23 Andrew Cohen <cohen@andy.bu.edu> + + * nnimap.el (nnimap-retrieve-headers): Return 'headers. + +2010-09-23 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-start.el (gnus-fixup-nnimap-unread-after-getting-new-news): + Removed. + (gnus-setup-news-hook): Removed + gnus-fixup-nnimap-unread-after-getting-new-news. + + * gnus-int.el (gnus-request-update-info): Protect against backends not + having the function. + + * nnimap.el (nnimap-stream): Mention starttls. + (nnimap-open-connection): Add starttls support. + +2010-09-23 Andrew Cohen <cohen@andy.bu.edu> + + * nnir.el (nnir-run-imap): Fix up nnir to work with the new nnimap. + +2010-09-23 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-transform-headers): Don't bug out on invalid + BODYSTRUCTUREs. + (nnimap-transform-headers): Unfold quoted {42} headers. + + * gnus-start.el (gnus-get-unread-articles): Allow backends to update + the info. + (gnus-get-unread-articles): Only call updatep on backends that support + it. + + * nnweb.el (nnweb-request-update-info): NOOP. + + * nnmaildir.el (nnmaildir-request-marks): Renamed from -update-info. + + * nnfolder.el (nnfolder-request-marks): Renamed from -update-info, + since it only deals with marks. + + * gnus-int.el (gnus-request-marks): Renamed gnus-request-update-info to + gnus-request-marks, and make a new gnus-request-update-info. + + * nnimap.el (nnimap-update-info): When UIDNEXT is present, use that for + the active instead of the high number, which is usually too low. + +2010-09-23 Teodor Zlatanov <tzz@lifelogs.com> + + * encrypt.el: Removed. + +2010-09-23 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-update-info): Sync non-standard flags from the + server in symbolic form. + + * gnus-html.el (gnus-max-image-proportion): Increase proportion to + 0.9. + +2010-09-22 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-parse-flags): Parse the data in any order. + (nnimap-update-info): Fix up code slightly. + + * gnus-int.el (gnus-open-server): Add tracing for performance + debugging. + + * gnus-group.el (gnus-group-highlight-line): Typo fix: beg, not start. + (gnus-group-insert-group-line): Pass the real group name so that it + gets the right data. + + * gnus-start.el (gnus-get-unread-articles): Don't have + `gnus-get-unread-articles-in-group' update info, since that can be + really slow and doesn't seem to be needed? + +2010-09-22 Julien Danjou <julien@danjou.info> + + * gnus-group.el (gnus-group-insert-group-line): Call + gnus-group-highlight-line. + (gnus-group-update-hook): Remove gnus-group-highlight-line from the + default hook list. + (gnus-group-update-eval-form): Add new function. + (gnus-group-highlight-line): Use gnus-group-update-eval-form. + (gnus-group-get-icon): Use gnus-group-update-eval-form. + +2010-09-22 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-request-expire-articles): If nnmail-expiry-wait is + immediate, then expire all articles. + (nnimap-update-info): Fix off-by-one errors. + (nnimap-flags-to-marks): Would return no marks lists for group with no + flags. Instead return the other data. + +2010-09-22 Julien Danjou <julien@danjou.info> + + * gnus-group.el (gnus-group-get-icon): Renamed gnus-group-add-icon that + Only return an icon. + (gnus-group-insert-group-line): Compute icon to return. + + * gnus-html.el (gnus-html-image-automatic-caching): Add custom + variable. + (gnus-html-image-fetched): Only cache if + gnus-html-image-automatic-caching is set. + (gnus-html-image-fetched): Check for errors. + +2010-09-22 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-start.el (gnus-read-active-for-groups): Only run -request-scan + once per method on `g'. This ensures that backends like nnfolder don't + open all their folders. + + * nnimap.el (nnimap-split-incoming-mail): Delete 'junk. + (nnimap-request-list): Nix out group in the correct buffer. + (nnimap-parse-flags): Implement by using `read' instead of + hand-parsing. + (nnimap-flags-to-marks): Pass on permanent-flags. + (nnimap-make-process-buffer): Record the server name. + (nnimap-parse-flags): Fix typo. + (nnimap-request-scan): Run split on the server in general, not just a + single group. + + * nnmail.el (nnmail-split-incoming): Take an optional junk-func + parameter, and propagate this downwards. + + * nnimap.el (nnimap-request-list): Set the current nnimap group to nil, + since EXAMINE changes it on the server. + + * gnus-int.el (gnus-request-expire-articles): Inhibit the daemon, since + this command might take a while. + +2010-09-22 Julien Danjou <julien@danjou.info> + + * gnus-html.el (gnus-html-put-image): Stop using markers. They are + harmful if you have 2 images side-by-side, they can't be properly + update on text deletion. Using text-property is safer here. + (gnus-html-image-fetched): Search also for \r\n\r\n to get the start of + data. + +2010-09-22 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-expunge-inbox): Removed. + (nnimap-mark-and-expunge-incoming): Use nnimap-expunge instead. + (nnimap-expunge): Flip default to t. + + * gnus.el (gnus-method-to-server): Don't push things to the cache + unless it's unique. + (gnus-server-to-method): Ditto. + +2010-09-22 Teodor Zlatanov <tzz@lifelogs.com> + + * nnimap.el (nnimap-delete-article): Tell user if expunge won't happen. + +2010-09-22 Julien Danjou <julien@danjou.info> + + * gnus-html.el (gnus-html-get-image-data): Search also for \r\n\r\n to + get the start of data. + (gnus-html-encode-url): Add this function to encode special chars in + URL. + (gnus-html-wash-images): Use gnus-html-encode-url to encode URL. + (gnus-html-prefetch-images): Use gnus-html-encode-url to encode URL. + + * gnus-group.el (gnus-group-update-hook): Call gnus-group-add-icon by + default. + (gnus-group-add-icon): Move to gnus-group.el, and rewrite so it works. + + * gnus-html.el (gnus-html-wash-images): Use xml-substitute-special on + images alt-text. + (gnus-html-put-image): Put alt-text as help-echo. + +2010-09-22 Katsumi Yamaoka <yamaoka@jpl.org> + + * mailcap.el (mailcap-parse-mailcap, mailcap-parse-mimetypes) + * mm-util.el (mm-decompress-buffer) + * nnir.el (nnir-run-find-grep) + * pop3.el (pop3-list): Use 3rd arg of split-string. + +2010-09-21 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-sum.el (gnus-update-marks): Add sanity check to not delete marks + outside the active range. Suggested by Dan Christensen. + + * gnus-start.el (gnus-get-unread-articles): Get the extended method + slightly later to avoid double-getting it. + + * nnml.el (nnml-generate-nov-file): Fix variable name clobbering from + previous patch. + + * gnus-sum.el (gnus-adjust-marked-articles): Fix another typo. + 2010-09-21 Adam Sjøgren <asjo@koldfront.dk> * gnus-sum.el (gnus-adjust-marked-articles): Fix typo. @@ -82,6 +656,9 @@ 2010-09-20 Lars Magne Ingebrigtsen <larsi@gnus.org> + * gnus-group.el (gnus-group-line-format-alist): Have the ?U (unseen) + spec inser "*" if the group isn't active instead of 0. + * nnimap.el (nnimap-request-group): Don't select the imap buffer before opening the server. (nnimap-request-delete-group): Implement group deletion. @@ -348,7 +925,7 @@ * dgnushack.el: Define netrc-credentials. -2010-09-17 Julien Danjou <julien@danjou.info> (tiny fix) +2010-09-17 Julien Danjou <julien@danjou.info> * mm-decode.el (mm-text-html-renderer): Document gnus-article-html. @@ -418,6 +995,9 @@ 2010-09-14 Lars Magne Ingebrigtsen <larsi@gnus.org> + * gnus-registry.el (gnus-registry-install-shortcuts): The second + parameter to unintern is mandatory-ish in Emacs 24. + * gnus-html.el (gnus-html-schedule-image-fetching) (gnus-html-prefetch-images): Check for curl before using it.
--- a/lisp/gnus/auth-source.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/auth-source.el Mon Sep 27 14:42:43 2010 +0900 @@ -32,9 +32,9 @@ ;;; Code: (require 'gnus-util) +(require 'netrc) (eval-when-compile (require 'cl)) -(autoload 'netrc-machine-user-or-password "netrc") (autoload 'secrets-create-item "secrets") (autoload 'secrets-delete-item "secrets") (autoload 'secrets-get-alias "secrets") @@ -312,25 +312,41 @@ (setq result (mapcar (lambda (m) - (cond - ((equal "password" m) - (let ((passwd (read-passwd - (format "Password for %s on %s: " prot host)))) - (cond - ;; Secret Service API. - ((consp source) - (apply - 'secrets-create-item - (auth-get-source entry) name passwd spec)) - (t)) ;; netrc not implemented yes. - passwd)) - ((equal "login" m) - (or user - (read-string (format "User name for %s on %s: " prot host)))) - (t - "unknownuser"))) + (cons + m + (cond + ((equal "password" m) + (let ((passwd (read-passwd + (format "Password for %s on %s: " prot host)))) + (cond + ;; Secret Service API. + ((consp source) + (apply + 'secrets-create-item + (auth-get-source entry) name passwd spec)) + (t)) ;; netrc not implemented yes. + passwd)) + ((equal "login" m) + (or user + (read-string (format "User name for %s on %s: " prot host)))) + (t + "unknownuser")))) (if (consp mode) mode (list mode)))) - (if (consp mode) result (car result)))) + ;; Allow the source to save the data. + (cond + ((consp source) + ;; Secret Service API -- not implemented. + ) + (t + ;; netrc interface. + (when (y-or-n-p (format "Do you want to save this password in %s? " + source)) + (netrc-store-data source host prot + (or user (cdr (assoc "login" result))) + (cdr (assoc "password" result)))))) + (if (consp mode) + (mapcar #'cdr result) + (cdar result)))) (defun auth-source-delete (entry &rest spec) "Delete credentials according to SPEC in ENTRY." @@ -430,8 +446,12 @@ (and found (return found))) ;; We haven't found something, so we will create it interactively. - (when (and (not found) choices create-missing) - (setq found (apply 'auth-source-create mode (car choices) search))) + (when (and (not found) create-missing) + (setq found (apply 'auth-source-create + mode (if choices + (car choices) + (car auth-sources)) + search))) ;; Cache the result. (when found
--- a/lisp/gnus/earcon.el Mon Sep 27 14:27:28 2010 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,230 +0,0 @@ -;;; earcon.el --- Sound effects for messages - -;; Copyright (C) 1996, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Steven L. Baur <steve@miranova.com> - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: -;; This file provides access to sound effects in Gnus. - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'gnus) -(require 'gnus-audio) -(require 'gnus-art) - -(defgroup earcon nil - "Turn ** sounds ** into noise." - :group 'gnus-visual) - -(defcustom earcon-prefix "**" - "*String denoting the start of an earcon." - :type 'string - :group 'earcon) - -(defcustom earcon-suffix "**" - "String denoting the end of an earcon." - :type 'string - :group 'earcon) - -(defcustom earcon-regexp-alist - '(("boring" 1 "Boring.au") - ("evil[ \t]+laugh" 1 "Evil_Laugh.au") - ("gag\\|puke" 1 "Puke.au") - ("snicker" 1 "Snicker.au") - ("meow" 1 "catmeow.wav") - ("sob\\|boohoo" 1 "cry.wav") - ("drum[ \t]*roll" 1 "drumroll.au") - ("blast" 1 "explosion.au") - ("flush\\|plonk!*" 1 "flush.au") - ("kiss" 1 "kiss.wav") - ("tee[ \t]*hee" 1 "laugh.au") - ("shoot" 1 "shotgun.wav") - ("yawn" 1 "snore.wav") - ("cackle" 1 "witch.au") - ("yell\\|roar" 1 "yell2.au") - ("whoop-de-doo" 1 "whistle.au")) - "*A list of regexps to map earcons to real sounds." - :type '(repeat (list regexp - (integer :tag "Match") - (string :tag "Sound"))) - :group 'earcon) -(defvar earcon-button-marker-list nil) -(make-variable-buffer-local 'earcon-button-marker-list) - -;;; FIXME!! clone of code from gnus-vis.el FIXME!! -(defun earcon-article-push-button (event) - "Check text under the mouse pointer for a callback function. -If the text under the mouse pointer has a `earcon-callback' property, -call it with the value of the `earcon-data' text property." - (interactive "e") - (set-buffer (window-buffer (posn-window (event-start event)))) - (let* ((pos (posn-point (event-start event))) - (data (get-text-property pos 'earcon-data)) - (fun (get-text-property pos 'earcon-callback))) - (if fun (funcall fun data)))) - -(defun earcon-article-press-button () - "Check text at point for a callback function. -If the text at point has a `earcon-callback' property, -call it with the value of the `earcon-data' text property." - (interactive) - (let* ((data (get-text-property (point) 'earcon-data)) - (fun (get-text-property (point) 'earcon-callback))) - (if fun (funcall fun data)))) - -(defun earcon-article-prev-button (n) - "Move point to N buttons backward. -If N is negative, move forward instead." - (interactive "p") - (earcon-article-next-button (- n))) - -(defun earcon-article-next-button (n) - "Move point to N buttons forward. -If N is negative, move backward instead." - (interactive "p") - (let ((function (if (< n 0) 'previous-single-property-change - 'next-single-property-change)) - (inhibit-point-motion-hooks t) - (backward (< n 0)) - (limit (if (< n 0) (point-min) (point-max)))) - (setq n (abs n)) - (while (and (not (= limit (point))) - (> n 0)) - ;; Skip past the current button. - (when (get-text-property (point) 'earcon-callback) - (goto-char (funcall function (point) 'earcon-callback nil limit))) - ;; Go to the next (or previous) button. - (gnus-goto-char (funcall function (point) 'earcon-callback nil limit)) - ;; Put point at the start of the button. - (when (and backward (not (get-text-property (point) 'earcon-callback))) - (goto-char (funcall function (point) 'earcon-callback nil limit))) - ;; Skip past intangible buttons. - (when (get-text-property (point) 'intangible) - (incf n)) - (decf n)) - (unless (zerop n) - (gnus-message 5 "No more buttons")) - n)) - -(defun earcon-article-add-button (from to fun &optional data) - "Create a button between FROM and TO with callback FUN and data DATA." - (and (boundp gnus-article-button-face) - gnus-article-button-face - (gnus-overlay-put (gnus-make-overlay from to) - 'face gnus-article-button-face)) - (gnus-add-text-properties - from to - (nconc (and gnus-article-mouse-face - (list gnus-mouse-face-prop gnus-article-mouse-face)) - (list 'gnus-callback fun) - (and data (list 'gnus-data data))))) - -(defun earcon-button-entry () - ;; Return the first entry in `gnus-button-alist' matching this place. - (let ((alist earcon-regexp-alist) - (case-fold-search t) - (entry nil)) - (while alist - (setq entry (pop alist)) - (if (looking-at (car entry)) - (setq alist nil) - (setq entry nil))) - entry)) - -(defun earcon-button-push (marker) - ;; Push button starting at MARKER. - (with-current-buffer gnus-article-buffer - (goto-char marker) - (let* ((entry (earcon-button-entry)) - (inhibit-point-motion-hooks t) - (fun 'gnus-audio-play) - (args (list (nth 2 entry)))) - (cond - ((fboundp fun) - (apply fun args)) - ((and (boundp fun) - (fboundp (symbol-value fun))) - (apply (symbol-value fun) args)) - (t - (gnus-message 1 "You must define `%S' to use this button" - (cons fun args))))))) - -;;; FIXME!! clone of code from gnus-vis.el FIXME!! - -;;;###interactive -(defun earcon-region (beg end) - "Play Sounds in the region between point and mark." - (interactive "r") - (earcon-buffer (current-buffer) beg end)) - -;;;###interactive -(defun earcon-buffer (&optional buffer st nd) - (interactive) - (save-excursion - ;; clear old markers. - (if (boundp 'earcon-button-marker-list) - (while earcon-button-marker-list - (set-marker (pop earcon-button-marker-list) nil)) - (setq earcon-button-marker-list nil)) - (and buffer (set-buffer buffer)) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (case-fold-search t) - (alist earcon-regexp-alist) - beg entry regexp) - (goto-char (point-min)) - (setq beg (point)) - (while (setq entry (pop alist)) - (setq regexp (concat (regexp-quote earcon-prefix) - ".*\\(" - (car entry) - "\\).*" - (regexp-quote earcon-suffix))) - (goto-char beg) - (while (re-search-forward regexp nil t) - (let* ((start (and entry (match-beginning 1))) - (end (and entry (match-end 1))) - (from (match-beginning 1))) - (earcon-article-add-button - start end 'earcon-button-push - (car (push (set-marker (make-marker) from) - earcon-button-marker-list))) - (gnus-audio-play (caddr entry)))))))) - -;;;###autoload -(defun gnus-earcon-display () - "Play sounds in message buffers." - (interactive) - (with-current-buffer gnus-article-buffer - (goto-char (point-min)) - ;; Skip headers - (unless (search-forward "\n\n" nil t) - (goto-char (point-max))) - (sit-for 0) - (earcon-buffer (current-buffer) (point)))) - -;;;*** - -(provide 'earcon) - -(run-hooks 'earcon-load-hook) - -;;; earcon.el ends here
--- a/lisp/gnus/gmm-utils.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/gmm-utils.el Mon Sep 27 14:42:43 2010 +0900 @@ -267,27 +267,16 @@ ;; (tool-bar-add-item ICON DEF KEY &rest PROPS) (apply 'tool-bar-add-item icon nil nil :enable nil props))) ((equal fmap t) ;; Not a menu command - (if (fboundp 'tool-bar-local-item) - (apply 'tool-bar-local-item - icon command - (intern icon) ;; reuse icon or fmap here? - tool-bar-map props) - ;; Emacs 21 compatibility: - (apply 'tool-bar-add-item - icon command - (intern icon) - props))) + (apply 'tool-bar-local-item + icon command + (intern icon) ;; reuse icon or fmap here? + tool-bar-map props)) (t ;; A menu command - (if (fboundp 'tool-bar-local-item-from-menu) - (apply 'tool-bar-local-item-from-menu - ;; (apply 'tool-bar-local-item icon def key - ;; tool-bar-map props) - command icon tool-bar-map (symbol-value fmap) - props) - ;; Emacs 21 compatibility: - (apply 'tool-bar-add-item-from-menu - command icon (symbol-value fmap) - props)))) + (apply 'tool-bar-local-item-from-menu + ;; (apply 'tool-bar-local-item icon def key + ;; tool-bar-map props) + command icon tool-bar-map (symbol-value fmap) + props))) t)) (if (symbolp icon-list) (eval icon-list)
--- a/lisp/gnus/gnus-agent.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/gnus-agent.el Mon Sep 27 14:42:43 2010 +0900 @@ -606,16 +606,13 @@ (propertize string 'local-map (make-mode-line-mouse-map mouse-button mouse-func) 'mouse-face - (cond ((and (featurep 'xemacs) - ;; XEmacs' `facep' only checks for a face - ;; object, not for a face name, so it's useless - ;; to check with `facep'. - (find-face 'modeline)) - 'modeline) - ((facep 'mode-line-highlight) ;; Emacs 22 - 'mode-line-highlight) - ((facep 'mode-line) ;; Emacs 21 - 'mode-line)) ) + (if (and (featurep 'xemacs) + ;; XEmacs' `facep' only checks for a face + ;; object, not for a face name, so it's useless + ;; to check with `facep'. + (find-face 'modeline)) + 'modeline + 'mode-line-highlight)) string)) (defun gnus-agent-toggle-plugged (set-to) @@ -1029,7 +1026,7 @@ (unless (member server gnus-agent-covered-methods) (push server gnus-agent-covered-methods) (setq gnus-agent-method-p-cache nil)) - (gnus-message 1 "Ignoring disappeared server `%s'" server)))) + (gnus-message 8 "Ignoring disappeared server `%s'" server)))) (prog1 gnus-agent-covered-methods (setq gnus-agent-covered-methods nil)))) @@ -3755,7 +3752,7 @@ (erase-buffer) (cond ((not (eq 'nov (let (gnus-agent) ; Turn off agent (gnus-retrieve-headers - uncached-articles group fetch-old)))) + uncached-articles group)))) (nnvirtual-convert-headers)) ((eq 'nntp (car gnus-current-select-method)) ;; The author of gnus-get-newsgroup-headers-xover
--- a/lisp/gnus/gnus-art.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/gnus-art.el Mon Sep 27 14:42:43 2010 +0900 @@ -34,10 +34,7 @@ (defvar w3m-minor-mode-map) (require 'gnus) -;; Avoid the "Recursive load suspected" error in Emacs 21.1. -(eval-and-compile - (let ((recursive-load-depth-limit 100)) - (require 'gnus-sum))) +(require 'gnus-sum) (require 'gnus-spec) (require 'gnus-int) (require 'gnus-win) @@ -260,6 +257,22 @@ (regexp :value ".*")) :group 'gnus-article-signature) +(defcustom gnus-fetch-partial-articles nil + "If non-nil, Gnus will fetch partial articles. +If t, nnimap will fetch only the first part. If a string, it +will fetch all parts that have types that match that string. A +likely value would be \"text/\" to automatically fetch all +textual parts. + +Currently only the nnimap backend actually supports partial +article fetching. If the backend doesn't support it, it has no +effect." + :version "24.1" + :type '(choice (const nil) + (const t) + (regexp)) + :group 'gnus-article) + (defcustom gnus-hidden-properties '(invisible t intangible t) "Property list to use for hiding text." :type 'sexp @@ -1532,10 +1545,38 @@ :type gnus-article-treat-head-custom) (put 'gnus-treat-newsgroups-picon 'highlight t) +(defcustom gnus-treat-from-gravatar nil + "Display gravatars in the From header. +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles' and Info +node `(gnus)Gravatars' for details." + :version "24.1" + :group 'gnus-article-treat + :group 'gnus-gravatar + :link '(custom-manual "(gnus)Customizing Articles") + :link '(custom-manual "(gnus)Gravatars") + :type gnus-article-treat-head-custom) +(put 'gnus-treat-from-gravatar 'highlight t) + +(defcustom gnus-treat-mail-gravatar nil + "Display gravatars in To and Cc headers. +Valid values are nil, t, `head', `first', `last', an integer or a +predicate. See Info node `(gnus)Customizing Articles' and Info +node `(gnus)Gravatars' for details." + :version "24.1" + :group 'gnus-article-treat + :group 'gnus-gravatar + :link '(custom-manual "(gnus)Customizing Articles") + :link '(custom-manual "(gnus)Gravatars") + :type gnus-article-treat-head-custom) +(put 'gnus-treat-mail-gravatar 'highlight t) + (defcustom gnus-treat-body-boundary (if (or gnus-treat-newsgroups-picon gnus-treat-mail-picon - gnus-treat-from-picon) + gnus-treat-from-picon + gnus-treat-from-gravatar + gnus-treat-mail-gravatar) ;; If there's much decoration, the user might prefer a boundery. 'head nil) @@ -1573,24 +1614,6 @@ :link '(custom-manual "(gnus)Customizing Articles") :type gnus-article-treat-custom) -(defcustom gnus-treat-play-sounds nil - "Play sounds. -Valid values are nil, t, `head', `first', `last', an integer or a -predicate. See Info node `(gnus)Customizing Articles'." - :version "21.1" - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - -(defcustom gnus-treat-translate nil - "Translate articles from one language to another. -Valid values are nil, t, `head', `first', `last', an integer or a -predicate. See Info node `(gnus)Customizing Articles'." - :version "21.1" - :group 'gnus-article-treat - :link '(custom-manual "(gnus)Customizing Articles") - :type gnus-article-treat-custom) - (defcustom gnus-treat-x-pgp-sig nil "Verify X-PGP-Sig. To automatically treat X-PGP-Sig, set it to head. @@ -1668,10 +1691,12 @@ (gnus-treat-hide-signature gnus-article-hide-signature) (gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers) (gnus-treat-leading-whitespace gnus-article-remove-leading-whitespace) - (gnus-treat-strip-pem gnus-article-hide-pem) (gnus-treat-from-picon gnus-treat-from-picon) (gnus-treat-mail-picon gnus-treat-mail-picon) (gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon) + (gnus-treat-strip-pem gnus-article-hide-pem) + (gnus-treat-from-gravatar gnus-treat-from-gravatar) + (gnus-treat-mail-gravatar gnus-treat-mail-gravatar) (gnus-treat-highlight-headers gnus-article-highlight-headers) (gnus-treat-highlight-signature gnus-article-highlight-signature) (gnus-treat-strip-trailing-blank-lines @@ -1693,8 +1718,7 @@ (gnus-treat-hide-citation gnus-article-hide-citation) (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe) (gnus-treat-highlight-citation gnus-article-highlight-citation) - (gnus-treat-body-boundary gnus-article-treat-body-boundary) - (gnus-treat-play-sounds gnus-earcon-display))) + (gnus-treat-body-boundary gnus-article-treat-body-boundary))) (defvar gnus-article-mime-handle-alist nil) (defvar article-lapsed-timer nil) @@ -2277,9 +2301,9 @@ (insert "X-Boundary: ") (gnus-add-text-properties start (point) '(invisible t intangible t)) (insert (let (str) - (while (>= (1- (window-width)) (length str)) + (while (>= (window-width) (length str)) (setq str (concat str gnus-body-boundary-delimiter))) - (substring str 0 (1- (window-width)))) + (substring str 0 (window-width))) "\n") (gnus-put-text-property start (point) 'gnus-decoration 'header))))) @@ -4259,7 +4283,7 @@ (put-text-property (match-end 0) (point-max) 'face eface))))))))) -(autoload 'canlock-verify "canlock" nil t) ;; for Emacs 21. +(autoload 'canlock-verify "canlock" nil t) ;; for XEmacs. (defun article-verify-cancel-lock () "Verify Cancel-Lock header." @@ -4894,10 +4918,7 @@ ;; FIXME: why is it necessary? (sit-for 0) (let ((parts (length gnus-article-mime-handle-alist))) - (or n (setq n - (string-to-number - (read-string ;; Emacs 21 doesn't have `read-number'. - (format "Jump to part (2..%s): " parts))))) + (or n (setq n (read-number (format "Jump to part (2..%s): " parts)))) (unless (and (integerp n) (<= n parts) (>= n 1)) (setq n (progn @@ -5051,7 +5072,7 @@ (unless data (error "No MIME part under point")) (with-current-buffer (mm-handle-buffer data) - (let ((bsize (format "%s" (buffer-size)))) + (let ((bsize (buffer-size))) (erase-buffer) (insert (concat @@ -5060,7 +5081,10 @@ "|\n" "| Type: " type "\n" "| Filename: " filename "\n" - "| Size (encoded): " bsize " Byte\n" + "| Size (encoded): " (format "%s byte%s\n" + bsize (if (= bsize 1) + "" + "s")) (when description (concat "| Description: " description "\n")) "`----\n")) @@ -5681,7 +5705,7 @@ :action 'gnus-widget-press-button :button-keymap gnus-mime-button-map :help-echo - (lambda (widget/window &optional overlay pos) + (lambda (widget) ;; Needed to properly clear the message due to a bug in ;; wid-edit (XEmacs only). (if (boundp 'help-echo-owns-message) @@ -5689,14 +5713,7 @@ (format "%S: %s the MIME part; %S: more options" (aref gnus-mouse-2 0) - ;; XEmacs will get a single widget arg; Emacs 21 will get - ;; window, overlay, position. - (if (mm-handle-displayed-p - (if overlay - (with-current-buffer (gnus-overlay-buffer overlay) - (widget-get (widget-at (gnus-overlay-start overlay)) - :mime-handle)) - (widget-get widget/window :mime-handle))) + (if (mm-handle-displayed-p (widget-get widget :mime-handle)) "hide" "show") (aref gnus-down-mouse-3 0)))))) @@ -6319,15 +6336,6 @@ 2))))))) (defun gnus-article-next-page-1 (lines) - (unless (featurep 'xemacs) - ;; Protect against the bug that Emacs 21.x hangs up when scrolling up for - ;; too many number of lines if `scroll-margin' is set as two or greater. - (when (and (numberp lines) - (> lines 0) - (> scroll-margin 0)) - (setq lines (min lines - (max 0 (- (count-lines (window-start) (point-max)) - scroll-margin)))))) (condition-case () (let ((scroll-in-place nil)) (scroll-up lines)) @@ -6581,6 +6589,9 @@ (defvar gnus-draft-mode) ;; Calling help-buffer will autoload help-mode. (defvar help-xref-stack-item) +;; Emacs 22 doesn't load it in the batch mode. +(eval-when-compile + (autoload 'help-buffer "help-mode")) (defun gnus-article-describe-bindings (&optional prefix) "Show a list of all defined keys, and their definitions. @@ -6631,9 +6642,7 @@ (with-current-buffer ,(current-buffer) (gnus-article-describe-bindings prefix))) ,prefix))) - (with-current-buffer (if (fboundp 'help-buffer) - (let (help-xref-following) (help-buffer)) - "*Help*") ;; Emacs 21 + (with-current-buffer (let (help-xref-following) (help-buffer)) (setq help-xref-stack-item item))))) (defun gnus-article-reply-with-original (&optional wide) @@ -7030,9 +7039,7 @@ (gnus-backlog-remove-article (car gnus-article-current) (cdr gnus-article-current))) ;; Flush original article as well. - (when (get-buffer gnus-original-article-buffer) - (with-current-buffer gnus-original-article-buffer - (setq gnus-original-article nil))) + (gnus-flush-original-article-buffer) (when gnus-use-cache (gnus-cache-update-article (car gnus-article-current) (cdr gnus-article-current))) @@ -7046,6 +7053,11 @@ (set-window-point (get-buffer-window buf) (point))) (gnus-summary-show-article)) +(defun gnus-flush-original-article-buffer () + (when (get-buffer gnus-original-article-buffer) + (with-current-buffer gnus-original-article-buffer + (setq gnus-original-article nil)))) + (defun gnus-article-edit-exit () "Exit the article editing without updating." (interactive) @@ -7134,46 +7146,6 @@ (function :tag "Other")) :group 'gnus-article-buttons) -(defcustom gnus-ctan-url "http://tug.ctan.org/tex-archive/" - "Top directory of a CTAN \(Comprehensive TeX Archive Network\) archive. -If the default site is too slow, try to find a CTAN mirror, see -<URL:http://tug.ctan.org/tex-archive/CTAN.sites?action=/index.html>. See also -the variable `gnus-button-handle-ctan'." - :version "22.1" - :group 'gnus-article-buttons - :link '(custom-manual "(gnus)Group Parameters") - :type '(choice (const "http://www.tex.ac.uk/tex-archive/") - (const "http://tug.ctan.org/tex-archive/") - (const "http://www.dante.de/CTAN/") - (string :tag "Other"))) - -(defcustom gnus-button-ctan-handler 'browse-url - "Function to use for displaying CTAN links. -The function must take one argument, the string naming the URL." - :version "22.1" - :type '(choice (function-item :tag "Browse Url" browse-url) - (function :tag "Other")) - :group 'gnus-article-buttons) - -(defcustom gnus-button-handle-ctan-bogus-regexp "^/?tex-archive/\\|^/" - "Bogus strings removed from CTAN URLs." - :version "22.1" - :group 'gnus-article-buttons - :type '(choice (const "^/?tex-archive/\\|/") - (regexp :tag "Other"))) - -(defcustom gnus-button-ctan-directory-regexp - (regexp-opt - (list "archive-tools" "biblio" "bibliography" "digests" "documentation" - "dviware" "fonts" "graphics" "help" "indexing" "info" "language" - "languages" "macros" "nonfree" "obsolete" "support" "systems" - "tds" "tools" "usergrps" "web") t) - "Regular expression for ctan directories. -It should match all directories in the top level of `gnus-ctan-url'." - :version "22.1" - :group 'gnus-article-buttons - :type 'regexp) - (defcustom gnus-button-mid-or-mail-regexp (concat "\\b\\(<?" gnus-button-valid-localpart-regexp "@" gnus-button-valid-fqdn-regexp @@ -7431,26 +7403,6 @@ (gnus-message 1 "Cannot locale library `%s'." url) (find-file-read-only file)))) -(defun gnus-button-handle-ctan (url) - "Call `browse-url' when pushing a CTAN URL button." - (funcall - gnus-button-ctan-handler - (concat - gnus-ctan-url - (gnus-replace-in-string url gnus-button-handle-ctan-bogus-regexp "")))) - -(defcustom gnus-button-tex-level 5 - "*Integer that says how many TeX-related buttons Gnus will show. -The higher the number, the more buttons will appear and the more false -positives are possible. Note that you can set this variable local to -specific groups. Setting it higher in TeX groups is probably a good idea. -See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on -how to set variables in specific groups." - :version "22.1" - :group 'gnus-article-buttons - :link '(custom-manual "(gnus)Group Parameters") - :type 'integer) - (defcustom gnus-button-man-level 5 "*Integer that says how many man-related buttons Gnus will show. The higher the number, the more buttons will appear and the more false @@ -7517,20 +7469,6 @@ 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) ("\\bmailto:\\([^ \n\t]+\\)" 0 (>= gnus-button-message-level 0) gnus-url-mailto 1) - ;; CTAN - ((concat "\\bCTAN:[ \t\n]?[^>)!;:,'\n\t ]*\\(" - gnus-button-ctan-directory-regexp - "[^][>)!;:,'\n\t ]+\\)") - 0 (>= gnus-button-tex-level 1) gnus-button-handle-ctan 1) - ((concat "\\btex-archive/\\(" - gnus-button-ctan-directory-regexp - "/[-_.a-z0-9/]+[-_./a-z0-9]+[/a-z0-9]\\)") - 1 (>= gnus-button-tex-level 6) gnus-button-handle-ctan 1) - ((concat - "\\b\\(" - gnus-button-ctan-directory-regexp - "/[-_.a-z0-9]+/[-_./a-z0-9]+[/a-z0-9]\\)") - 1 (>= gnus-button-tex-level 8) gnus-button-handle-ctan 1) ;; Info Konqueror style <info:/foo/bar baz>. ;; Must come before " Gnus home-grown style". ("\\binfo://?\\([^'\">\n\t]+\\)" @@ -8512,9 +8450,7 @@ (when gnus-keep-backlog (gnus-backlog-remove-article (car gnus-article-current) (cdr gnus-article-current))) - (when (get-buffer gnus-original-article-buffer) - (with-current-buffer gnus-original-article-buffer - (setq gnus-original-article nil))) + (gnus-flush-original-article-buffer) (when gnus-use-cache (gnus-cache-update-article (car gnus-article-current) (cdr gnus-article-current)))))))) @@ -8702,7 +8638,7 @@ :action 'gnus-widget-press-button :button-keymap gnus-mime-security-button-map :help-echo - (lambda (widget/window &optional overlay pos) + (lambda (widget) ;; Needed to properly clear the message due to a bug in ;; wid-edit (XEmacs only). (when (boundp 'help-echo-owns-message)
--- a/lisp/gnus/gnus-audio.el Mon Sep 27 14:27:28 2010 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,149 +0,0 @@ -;;; gnus-audio.el --- Sound effects for Gnus - -;; Copyright (C) 1996, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Steven L. Baur <steve@miranova.com> -;; Keywords: news, mail, multimedia - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This file provides access to sound effects in Gnus. -;; This file is partially stripped to support earcons.el. - -;;; Code: - -(require 'nnheader) - -(defgroup gnus-audio nil - "Playing sound in Gnus." - :version "21.1" - :group 'gnus-visual - :group 'multimedia) - -(defvar gnus-audio-inline-sound - (or (if (fboundp 'device-sound-enabled-p) - (device-sound-enabled-p)) ; XEmacs - (fboundp 'play-sound)) ; Emacs 21 - "Non-nil means try to play sounds without using an external program.") - -(defcustom gnus-audio-directory (nnheader-find-etc-directory "sounds") - "The directory containing the Sound Files." - :type '(choice directory (const nil)) - :group 'gnus-audio) - -(defcustom gnus-audio-au-player (executable-find "play") - "Executable program for playing sun AU format sound files." - :group 'gnus-audio - :type '(choice file (const nil))) - -(defcustom gnus-audio-wav-player (executable-find "play") - "Executable program for playing WAV files." - :group 'gnus-audio - :type '(choice file (const nil))) - -;;; The following isn't implemented yet. Wait for Millennium Gnus. -;;(defvar gnus-audio-effects-enabled t -;; "When t, Gnus will use sound effects.") -;;(defvar gnus-audio-enable-hooks nil -;; "Functions run when enabling sound effects.") -;;(defvar gnus-audio-disable-hooks nil -;; "Functions run when disabling sound effects.") -;;(defvar gnus-audio-theme-song nil -;; "Theme song for Gnus.") -;;(defvar gnus-audio-enter-group nil -;; "Sound effect played when selecting a group.") -;;(defvar gnus-audio-exit-group nil -;; "Sound effect played when exiting a group.") -;;(defvar gnus-audio-score-group nil -;; "Sound effect played when scoring a group.") -;;(defvar gnus-audio-busy-sound nil -;; "Sound effect played when going into a ... sequence.") - - -;;;###autoload -;;(defun gnus-audio-enable-sound () -;; "Enable Sound Effects for Gnus." -;; (interactive) -;; (setq gnus-audio-effects-enabled t) -;; (gnus-run-hooks gnus-audio-enable-hooks)) - -;;;###autoload - ;(defun gnus-audio-disable-sound () -;; "Disable Sound Effects for Gnus." -;; (interactive) -;; (setq gnus-audio-effects-enabled nil) -;; (gnus-run-hooks gnus-audio-disable-hooks)) - -;;;###autoload -(defun gnus-audio-play (file) - "Play a sound FILE through the speaker." - (interactive "fSound file name: ") - (let ((sound-file (if (file-exists-p file) - file - (expand-file-name file gnus-audio-directory)))) - (when (file-exists-p sound-file) - (cond ((and gnus-audio-inline-sound - (condition-case nil - ;; Even if we have audio, we may fail with the - ;; wrong sort of sound file. - (progn (play-sound-file sound-file) - t) - (error nil)))) - ;; If we don't have built-in sound, or playing it failed, - ;; try with external program. - ((equal "wav" (file-name-extension sound-file)) - (call-process gnus-audio-wav-player - sound-file - 0 - nil - sound-file)) - ((equal "au" (file-name-extension sound-file)) - (call-process gnus-audio-au-player - sound-file - 0 - nil - sound-file)))))) - - -;;; The following isn't implemented yet, wait for Red Gnus -;;(defun gnus-audio-startrek-sounds () -;; "Enable sounds from Star Trek the original series." -;; (interactive) -;; (setq gnus-audio-busy-sound "working.au") -;; (setq gnus-audio-enter-group "bulkhead_door.au") -;; (setq gnus-audio-exit-group "bulkhead_door.au") -;; (setq gnus-audio-score-group "ST_laser.au") -;; (setq gnus-audio-theme-song "startrek.au") -;; (add-hook 'gnus-select-group-hook 'gnus-audio-startrek-select-group) -;; (add-hook 'gnus-exit-group-hook 'gnus-audio-startrek-exit-group)) -;;;*** - -(defvar gnus-startup-jingle "Tuxedomoon.Jingle4.au" - "Name of the Gnus startup jingle file.") - -(defun gnus-play-jingle () - "Play the Gnus startup jingle, unless that's inhibited." - (interactive) - (gnus-audio-play gnus-startup-jingle)) - -(provide 'gnus-audio) - -(run-hooks 'gnus-audio-load-hook) - -;;; gnus-audio.el ends here
--- a/lisp/gnus/gnus-bookmark.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/gnus-bookmark.el Mon Sep 27 14:42:43 2010 +0900 @@ -156,9 +156,6 @@ "The current version of the format used by bookmark files. You should never need to change this.") -(defvar gnus-bookmark-after-jump-hook nil - "Hook run after `gnus-bookmark-jump' jumps to a Gnus bookmark.") - (defvar gnus-bookmark-alist () "Association list of Gnus bookmarks and their records. The format of the alist is
--- a/lisp/gnus/gnus-cache.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/gnus-cache.el Mon Sep 27 14:42:43 2010 +0900 @@ -603,7 +603,7 @@ (insert-file-contents (gnus-cache-file-name group entry))) (goto-char (point-min)) (insert "220 ") - (princ (car cached) (current-buffer)) + (princ (pop cached) (current-buffer)) (insert " Article retrieved.\n") (search-forward "\n\n" nil 'move) (delete-region (point) (point-max))
--- a/lisp/gnus/gnus-cus.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/gnus-cus.el Mon Sep 27 14:42:43 2010 +0900 @@ -50,7 +50,7 @@ (setq major-mode 'gnus-custom-mode mode-name "Gnus Customize") (use-local-map widget-keymap) - ;; Emacs 21 stuff: + ;; Emacs stuff: (when (and (facep 'custom-button-face) (facep 'custom-button-pressed-face)) (set (make-local-variable 'widget-button-face) @@ -865,11 +865,6 @@ Check the [ ] for the entries you want to apply to this score file, then edit the value to suit your taste. Don't forget to mark the checkbox, if you do all your changes will be lost. ") - (widget-create 'push-button - :action (lambda (&rest ignore) - (require 'gnus-audio) - (gnus-audio-play "Evil_Laugh.au")) - "Bhahahah!") (widget-insert "\n\n") (make-local-variable 'gnus-custom-scores) (setq gnus-custom-scores
--- a/lisp/gnus/gnus-demon.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/gnus-demon.el Mon Sep 27 14:42:43 2010 +0900 @@ -240,15 +240,6 @@ ;; this idle-cycle. (push (car handler) gnus-demon-idle-has-been-called))))))))) -(defun gnus-demon-add-nocem () - "Add daemonic NoCeM handling to Gnus." - (gnus-demon-add-handler 'gnus-demon-scan-nocem 60 30)) - -(defun gnus-demon-scan-nocem () - "Scan NoCeM groups for NoCeM messages." - (save-window-excursion - (gnus-nocem-scan-groups))) - (defun gnus-demon-add-disconnection () "Add daemonic server disconnection to Gnus." (gnus-demon-add-handler 'gnus-demon-close-connections nil 30))
--- a/lisp/gnus/gnus-ems.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/gnus-ems.el Mon Sep 27 14:42:43 2010 +0900 @@ -272,11 +272,12 @@ (when face (setq props (plist-put props :foreground (face-foreground face))) (setq props (plist-put props :background (face-background face)))) - (apply 'create-image file type data-p props))) + (ignore-errors + (apply 'create-image file type data-p props)))) (defun gnus-put-image (glyph &optional string category) (let ((point (point))) - (insert-image glyph (or string "*")) + (insert-image glyph (or string " ")) (put-text-property point (point) 'gnus-image-category category) (unless string (put-text-property (1- (point)) (point)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/gnus-gravatar.el Mon Sep 27 14:42:43 2010 +0900 @@ -0,0 +1,113 @@ +;;; gnus-gravatar.el --- Gnus Gravatar support + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Julien Danjou <julien@danjou.info> +;; Keywords: news + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'gravatar) + +(defgroup gnus-gravatar nil + "Gnus Gravatar." + :group 'gnus-visual) + +(defcustom gnus-gravatar-size 32 + "How big should gravatars be displayed." + :type 'integer + :group 'gnus-gravatar) + +(defcustom gnus-gravatar-relief 1 + "If non-nil, adds a shadow rectangle around the image. The +value, relief, specifies the width of the shadow lines, in +pixels. If relief is negative, shadows are drawn so that the +image appears as a pressed button; otherwise, it appears as an +unpressed button." + :group 'gnus-gravatar) + +(defun gnus-gravatar-transform-address (header category) + (gnus-with-article-headers + (let ((addresses + (mail-header-parse-addresses + ;; mail-header-parse-addresses does not work (reliably) on + ;; decoded headers. + (or + (ignore-errors + (mail-encode-encoded-word-string + (or (mail-fetch-field header) ""))) + (mail-fetch-field header))))) + (let ((gravatar-size gnus-gravatar-size)) + (dolist (address addresses) + (gravatar-retrieve + (car address) + 'gnus-gravatar-insert + (list header (car address) category))))))) + +(defun gnus-gravatar-insert (gravatar header address category) + "Insert GRAVATAR for ADDRESS in HEADER in current article buffer. +Set image category to CATEGORY." + (unless (eq gravatar 'error) + (gnus-with-article-headers + (gnus-article-goto-header header) + (mail-header-narrow-to-field) + (when (and (search-forward address nil t) + (or (search-backward ", " nil t) + (search-backward ": " nil t))) + (goto-char (1+ (point))) + ;; Do not do anything if there's already a gravatar. This can + ;; happens if the buffer has been regenerated in the mean time, for + ;; example we were fetching someaddress, and then we change to + ;; another mail with the same someaddress. + (unless (memq 'gnus-gravatar (text-properties-at (point))) + (let ((inhibit-read-only t) + (point (point)) + (gravatar (append + gravatar + `(:ascent center :relief ,gnus-gravatar-relief)))) + (gnus-put-image gravatar nil category) + (put-text-property point (point) 'gnus-gravatar address) + (gnus-add-wash-type category) + (gnus-add-image category gravatar))))))) + +;;;###autoload +(defun gnus-treat-from-gravatar () + "Display gravatar in the From header. +If gravatar is already displayed, remove it." + (interactive) + (gnus-with-article-buffer + (if (memq 'from-gravatar gnus-article-wash-types) + (gnus-delete-images 'from-gravatar) + (gnus-gravatar-transform-address "from" 'from-gravatar)))) + +;;;###autoload +(defun gnus-treat-mail-gravatar () + "Display gravatars in the Cc and To headers. +If gravatars are already displayed, remove them." + (interactive) + (gnus-with-article-buffer + (if (memq 'mail-gravatar gnus-article-wash-types) + (gnus-delete-images 'mail-gravatar) + (gnus-gravatar-transform-address "cc" 'mail-gravatar) + (gnus-gravatar-transform-address "to" 'mail-gravatar)))) + +(provide 'gnus-gravatar) + +;;; gnus-gravatar.el ends here
--- a/lisp/gnus/gnus-group.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/gnus-group.el Mon Sep 27 14:42:43 2010 +0900 @@ -55,18 +55,6 @@ (autoload 'gnus-agent-total-fetched-for "gnus-agent") (autoload 'gnus-cache-total-fetched-for "gnus-cache") -(defcustom gnus-group-archive-directory - "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/" - "*The address of the (ding) archives." - :group 'gnus-group-foreign - :type 'directory) - -(defcustom gnus-group-recent-archive-directory - "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/" - "*The address of the most recent (ding) articles." - :group 'gnus-group-foreign - :type 'directory) - (defcustom gnus-no-groups-message "No Gnus is good news" "*Message displayed by Gnus when no groups are available." :group 'gnus-start @@ -292,14 +280,10 @@ :group 'gnus-exit :type 'hook) -(defcustom gnus-group-update-hook '(gnus-group-highlight-line) - "Hook called when a group line is changed. -The hook will not be called if `gnus-visual' is nil. - -The default function `gnus-group-highlight-line' will -highlight the line according to the `gnus-group-highlight' -variable." +(defcustom gnus-group-update-hook nil + "Hook called when a group line is changed." :group 'gnus-group-visual + :version "24.1" :type 'hook) (defcustom gnus-useful-groups @@ -428,7 +412,6 @@ unread: The number of unread articles in the group. method: The select method used. mailp: Whether it's a mail group or not. -newsp: Whether it's a news group or not level: The level of the group. score: The score of the group. ticked: The number of ticked articles." @@ -565,8 +548,6 @@ (defvar gnus-group-list-mode nil) -(defvar gnus-group-icon-cache nil) - (defvar gnus-group-listed-groups nil) (defvar gnus-group-list-option nil) @@ -662,7 +643,6 @@ "d" gnus-group-make-directory-group "h" gnus-group-make-help-group "u" gnus-group-make-useful-group - "a" gnus-group-make-archive-group "l" gnus-group-nnimap-edit-acl "m" gnus-group-make-group "E" gnus-group-edit-group @@ -757,10 +737,8 @@ "e" gnus-score-edit-all-score) (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) - "c" gnus-group-fetch-charter "C" gnus-group-fetch-control "d" gnus-group-describe-group - "f" gnus-group-fetch-faq "v" gnus-version) (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map) @@ -826,11 +804,6 @@ ["Describe" gnus-group-describe-group :active (gnus-group-group-name) ,@(if (featurep 'xemacs) nil '(:help "Display description of the current group"))] - ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)] - ["Fetch charter" gnus-group-fetch-charter - :active (gnus-group-group-name) - ,@(if (featurep 'xemacs) nil - '(:help "Display the charter of the current group"))] ["Fetch control message" gnus-group-fetch-control :active (gnus-group-group-name) ,@(if (featurep 'xemacs) nil @@ -930,7 +903,6 @@ ["Make a foreign group..." gnus-group-make-group t] ["Add a directory group..." gnus-group-make-directory-group t] ["Add the help group" gnus-group-make-help-group t] - ["Add the archive group" gnus-group-make-archive-group t] ["Make a doc group..." gnus-group-make-doc-group t] ["Make a web group..." gnus-group-make-web-group t] ["Make a virtual group..." gnus-group-make-empty-virtual t] @@ -1520,7 +1492,7 @@ (and (not (featurep 'xemacs)) (boundp 'tool-bar-mode) tool-bar-mode - ;; Using `redraw-frame' (see `gnus-tool-bar-update') in Emacs 21 might + ;; Using `redraw-frame' (see `gnus-tool-bar-update') in Emacs might ;; be confusing, so maybe we shouldn't call it by default. (fboundp 'force-window-update)) "Force updating the group buffer tool bar." @@ -1578,7 +1550,7 @@ ?m ? )) (gnus-tmp-moderated-string (if (eq gnus-tmp-moderated ?m) "(m)" "")) - (gnus-tmp-group-icon "==&&==") + (gnus-tmp-group-icon (gnus-group-get-icon gnus-tmp-qualified-group)) (gnus-tmp-news-server (or (cadr gnus-tmp-method) "")) (gnus-tmp-news-method (or (car gnus-tmp-method) "")) (gnus-tmp-news-method-string @@ -1625,67 +1597,85 @@ 'gnus-tool-bar-update)) (forward-line -1) (when (inline (gnus-visual-p 'group-highlight 'highlight)) - (gnus-run-hooks 'gnus-group-update-hook)) + (gnus-group-highlight-line gnus-tmp-group beg end)) + (gnus-run-hooks 'gnus-group-update-hook) (forward-line) ;; Allow XEmacs to remove front-sticky text properties. (gnus-group-remove-excess-properties))) -(defun gnus-group-highlight-line () - "Highlight the current line according to `gnus-group-highlight'." - (let* ((list gnus-group-highlight) - (p (point)) - (end (point-at-eol)) - ;; now find out where the line starts and leave point there. - (beg (progn (beginning-of-line) (point))) - (group (gnus-group-group-name)) - (entry (gnus-group-entry group)) - (unread (if (numberp (car entry)) (car entry) 0)) - (active (gnus-active group)) - (total (if active (1+ (- (cdr active) (car active))) 0)) - (info (nth 2 entry)) - (method (inline (gnus-server-get-method group (gnus-info-method info)))) - (marked (gnus-info-marks info)) - (mailp (apply 'append - (mapcar - (lambda (x) - (memq x (assoc (symbol-name - (car (or method gnus-select-method))) - gnus-valid-select-methods))) - '(mail post-mail)))) - (level (or (gnus-info-level info) gnus-level-killed)) - (score (or (gnus-info-score info) 0)) - (ticked (gnus-range-length (cdr (assq 'tick marked)))) - (group-age (gnus-group-timestamp-delta group)) - (inhibit-read-only t)) - ;; FIXME: http://thread.gmane.org/gmane.emacs.gnus.general/65451/focus=65465 - ;; ====================================================================== - ;; From: Richard Stallman - ;; Subject: Re: Rewriting gnus-group-highlight-line (was: [...]) - ;; Cc: ding@gnus.org - ;; Date: Sat, 27 Oct 2007 19:41:20 -0400 - ;; Message-ID: <E1IlvHM-0006TS-7t@fencepost.gnu.org> - ;; - ;; [...] - ;; The kludge is that the alist elements contain expressions that refer - ;; to local variables with short names. Perhaps write your own tiny - ;; evaluator that handles just `and', `or', and numeric comparisons - ;; and just a few specific variables. - ;; ====================================================================== - ;; - ;; Similar for other evaluated variables. Grep for risky-local-variable - ;; to find them! -- rsteib - ;; - ;; Eval the cars of the lists until we find a match. - (while (and list - (not (eval (caar list)))) - (setq list (cdr list))) - (let ((face (cdar list))) - (unless (eq face (get-text-property beg 'face)) - (gnus-put-text-property-excluding-characters-with-faces - beg end 'face - (setq face (if (boundp face) (symbol-value face) face))) - (gnus-extent-start-open beg))) - (goto-char p))) +(defun gnus-group-update-eval-form (group list) + "Eval `car' of each element of LIST, and return the first that return t. +Some value are bound so the form can use them." + (when list + (let* ((entry (gnus-group-entry group)) + (unread (if (numberp (car entry)) (car entry) 0)) + (active (gnus-active group)) + (total (if active (1+ (- (cdr active) (car active))) 0)) + (info (nth 2 entry)) + (method (inline (gnus-server-get-method group (gnus-info-method info)))) + (marked (gnus-info-marks info)) + (mailp (apply 'append + (mapcar + (lambda (x) + (memq x (assoc (symbol-name + (car (or method gnus-select-method))) + gnus-valid-select-methods))) + '(mail post-mail)))) + (level (or (gnus-info-level info) gnus-level-killed)) + (score (or (gnus-info-score info) 0)) + (ticked (gnus-range-length (cdr (assq 'tick marked)))) + (group-age (gnus-group-timestamp-delta group))) + ;; FIXME: http://thread.gmane.org/gmane.emacs.gnus.general/65451/focus=65465 + ;; ====================================================================== + ;; From: Richard Stallman + ;; Subject: Re: Rewriting gnus-group-highlight-line (was: [...]) + ;; Cc: ding@gnus.org + ;; Date: Sat, 27 Oct 2007 19:41:20 -0400 + ;; Message-ID: <E1IlvHM-0006TS-7t@fencepost.gnu.org> + ;; + ;; [...] + ;; The kludge is that the alist elements contain expressions that refer + ;; to local variables with short names. Perhaps write your own tiny + ;; evaluator that handles just `and', `or', and numeric comparisons + ;; and just a few specific variables. + ;; ====================================================================== + ;; + ;; Similar for other evaluated variables. Grep for risky-local-variable + ;; to find them! -- rsteib + ;; + ;; Eval the cars of the lists until we find a match. + (while (and list + (not (eval (caar list)))) + (setq list (cdr list))) + list))) + +(defun gnus-group-highlight-line (group beg end) + "Highlight the current line according to `gnus-group-highlight'. +GROUP is current group, and the line to highlight starts at BEG +and ends at END." + (let ((face (cdar (gnus-group-update-eval-form + group + gnus-group-highlight)))) + (unless (eq face (get-text-property beg 'face)) + (let ((inhibit-read-only t)) + (gnus-put-text-property-excluding-characters-with-faces + beg end 'face + (if (boundp face) (symbol-value face) face))) + (gnus-extent-start-open beg)))) + +(defun gnus-group-get-icon (group) + "Return an icon for GROUP according to `gnus-group-icon-list'." + (if gnus-group-icon-list + (let ((image-path + (cdar (gnus-group-update-eval-form group gnus-group-icon-list)))) + (if image-path + (propertize " " + 'display + (append + (gnus-create-image (expand-file-name image-path)) + '(:ascent center))) + " ")) + " ")) (defun gnus-group-update-group (group &optional visible-only) "Update all lines where GROUP appear. @@ -2230,8 +2220,6 @@ (other-frame 1)))) (gnus-fetch-group group)) -(defvar gnus-ephemeral-group-server 0) - (defcustom gnus-large-ephemeral-newsgroup 200 "The number of articles which indicates a large ephemeral newsgroup. Same as `gnus-large-newsgroup', but only used for ephemeral newsgroups. @@ -2430,6 +2418,14 @@ (let ((tmpfile (mm-make-temp-file "gnus-temp-group-"))) (with-temp-file tmpfile (url-insert-file-contents (format mbox-url number)) + (goto-char (point-min)) + ;; Add the debbugs address so that we can respond to reports easily. + (while (re-search-forward "^To: " nil t) + (end-of-line) + (insert (format ", %s@%s" number + (replace-regexp-in-string + "/.*$" "" + (replace-regexp-in-string "^http://" "" mbox-url))))) (write-region (point-min) (point-max) tmpfile) (gnus-group-read-ephemeral-group "gnus-read-ephemeral-bug" @@ -3076,22 +3072,6 @@ (nnrss-save-server-data nil)) (error "No feeds found for %s" url)))) -(defun gnus-group-make-archive-group (&optional all) - "Create the (ding) Gnus archive group of the most recent articles. -Given a prefix, create a full group." - (interactive "P") - (let ((group (gnus-group-prefixed-name - (if all "ding.archives" "ding.recent") '(nndir "")))) - (when (gnus-group-entry group) - (error "Archive group already exists")) - (gnus-group-make-group - (gnus-group-real-name group) - (list 'nndir (if all "hpc" "edu") - (list 'nndir-directory - (if all gnus-group-archive-directory - gnus-group-recent-archive-directory)))) - (gnus-group-add-parameter group (cons 'to-address "ding@gnus.org")))) - (defun gnus-group-make-directory-group (dir) "Create an nndir group. The user will be prompted for a directory. The contents of this @@ -3974,14 +3954,6 @@ (unless gnus-slave (gnus-master-read-slave-newsrc)) - ;; We might read in new NoCeM messages here. - (when (and gnus-use-nocem - (or (and (numberp gnus-use-nocem) - (numberp arg) - (>= arg gnus-use-nocem)) - (not arg))) - (gnus-nocem-scan-groups)) - (gnus-get-unread-articles arg) ;; If the user wants it, we scan for new groups. @@ -4036,62 +4008,6 @@ (gnus-summary-position-point) ret)) -(defun gnus-group-fetch-faq (group &optional faq-dir) - "Fetch the FAQ for the current group. -If given a prefix argument, prompt for the FAQ dir -to use." - (interactive - (list - (gnus-group-group-name) - (when current-prefix-arg - (completing-read - "FAQ dir: " (and (listp gnus-group-faq-directory) - (mapcar #'list - gnus-group-faq-directory)))))) - (unless group - (error "No group name given")) - (let ((dirs (or faq-dir gnus-group-faq-directory)) - dir found file) - (unless (listp dirs) - (setq dirs (list dirs))) - (while (and (not found) - (setq dir (pop dirs))) - (let ((name (gnus-group-real-name group))) - (setq file (expand-file-name name dir))) - (if (not (file-exists-p file)) - (gnus-message 1 "No such file: %s" file) - (let ((enable-local-variables nil)) - (find-file file) - (setq found t)))))) - -(defun gnus-group-fetch-charter (group) - "Fetch the charter for the current group. -If given a prefix argument, prompt for a group." - (interactive - (list (or (when current-prefix-arg - (gnus-group-completing-read "Group: ")) - (gnus-group-group-name) - gnus-newsgroup-name))) - (unless group - (error "No group name given")) - (require 'mm-url) - (condition-case nil (require 'url-http) (error nil)) - (let ((name (mm-url-form-encode-xwfu (gnus-group-real-name group))) - url hierarchy) - (when (string-match "\\(^[^\\.]+\\)\\..*" name) - (setq hierarchy (match-string 1 name)) - (if (and (setq url (cdr (assoc hierarchy gnus-group-charter-alist))) - (if (fboundp 'url-http-file-exists-p) - (url-http-file-exists-p (eval url)) - t)) - (browse-url (eval url)) - (setq url (concat "http://" hierarchy - ".news-admin.org/charters/" name)) - (if (and (fboundp 'url-http-file-exists-p) - (url-http-file-exists-p url)) - (browse-url url) - (gnus-group-fetch-control group)))))) - (defun gnus-group-fetch-control (group) "Fetch the archived control messages for the current group. If given a prefix argument, prompt for a group."
--- a/lisp/gnus/gnus-html.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/gnus-html.el Mon Sep 27 14:42:43 2010 +0900 @@ -35,13 +35,21 @@ (require 'mm-url) (require 'url) (require 'url-cache) +(require 'xml) +(require 'browse-url) (defcustom gnus-html-image-cache-ttl (days-to-time 7) - "Time in seconds used to cache the image on disk." + "Time used to determine if we should use images from the cache." :version "24.1" :group 'gnus-art :type 'integer) +(defcustom gnus-html-image-automatic-caching t + "Whether automatically cache retrieve images." + :version "24.1" + :group 'gnus-art + :type 'boolean) + (defcustom gnus-html-frame-width 70 "What width to use when rendering HTML." :version "24.1" @@ -54,7 +62,7 @@ :group 'gnus-art :type 'regexp) -(defcustom gnus-max-image-proportion 0.7 +(defcustom gnus-max-image-proportion 0.9 "How big pictures displayed are in relation to the window they're in. A value of 0.7 means that they are allowed to take up 70% of the width and height of the window. If they are larger than this, @@ -80,6 +88,33 @@ (define-key map [tab] 'widget-forward) map)) +(eval-and-compile + (defalias 'gnus-html-encode-url-chars + (if (fboundp 'browse-url-url-encode-chars) + 'browse-url-url-encode-chars + (lambda (text chars) + "URL-encode the chars in TEXT that match CHARS. +CHARS is a regexp-like character alternative (e.g., \"[)$]\")." + (let ((encoded-text (copy-sequence text)) + (s 0)) + (while (setq s (string-match chars encoded-text s)) + (setq encoded-text + (replace-match (format "%%%x" + (string-to-char + (match-string 0 encoded-text))) + t t encoded-text) + s (1+ s))) + encoded-text)))) + ;; XEmacs does not have window-inside-pixel-edges + (defalias 'gnus-window-inside-pixel-edges + (if (fboundp 'window-inside-pixel-edges) + 'window-inside-pixel-edges + 'window-pixel-edges))) + +(defun gnus-html-encode-url (url) + "Encode URL." + (gnus-html-encode-url-chars url "[)$ ]")) + (defun gnus-html-cache-expired (url ttl) "Check if URL is cached for more than TTL." (cond (url-standalone-mode @@ -154,7 +189,7 @@ (delete-region (match-beginning 0) (match-end 0))) (setq end (point)) (when (string-match "src=\"\\([^\"]+\\)" parameters) - (setq url (match-string 1 parameters)) + (setq url (gnus-html-encode-url (match-string 1 parameters))) (gnus-message 8 "gnus-html-wash-tags: fetching image URL %s" url) (if (string-match "^cid:\\(.*\\)" url) ;; URLs with cid: have their content stashed in other @@ -175,7 +210,8 @@ ;; Normal, external URL. (let ((alt-text (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)" parameters) - (match-string 2 parameters)))) + (xml-substitute-special (match-string 2 parameters))))) + (gnus-put-text-property start end 'gnus-image-url url) (if (gnus-html-image-url-blocked-p url (if (buffer-live-p gnus-summary-buffer) @@ -190,13 +226,9 @@ :keymap gnus-html-image-map :button-keymap gnus-html-image-map) (let ((overlay (gnus-make-overlay start end)) - (spec (list url - (set-marker (make-marker) start) - (set-marker (make-marker) end) - alt-text))) + (spec (list url start end alt-text))) (gnus-overlay-put overlay 'local-map gnus-html-image-map) (gnus-overlay-put overlay 'gnus-image spec) - (gnus-put-text-property start end 'gnus-image-url url) (gnus-put-text-property start end 'gnus-image spec))) @@ -223,13 +255,9 @@ ;; asynchronously. (gnus-html-schedule-image-fetching (current-buffer) - (list url - (set-marker (make-marker) start) - (set-marker (make-marker) end) - alt-text)) + (list url alt-text)) ;; It's already cached, so just insert it. - (gnus-html-put-image (gnus-html-get-image-data url) - start end url alt-text))) + (gnus-html-put-image (gnus-html-get-image-data url) url alt-text))) (defun gnus-html-wash-tags () (let (tag parameters string start end images url) @@ -346,22 +374,17 @@ (list buffer image)))) (defun gnus-html-image-fetched (status buffer image) - (url-store-in-cache (current-buffer)) - (when (and (search-forward "\n\n" nil t) - (buffer-live-p buffer) - ;; If the `image' has no marker, do not replace anything - (cadr image) - ;; If the position of the marker is 1, then that - ;; means that the text it was in has been deleted; - ;; i.e., that the user has selected a different - ;; article before the image arrived. - (not (= (marker-position (cadr image)) - (with-current-buffer buffer - (point-min))))) - (let ((data (buffer-substring (point) (point-max)))) - (with-current-buffer buffer - (let ((inhibit-read-only t)) - (gnus-html-put-image data (cadr image) (caddr image) (car image) (cadddr image)))))) + "Callback function called when image has been fetched." + (unless (plist-get status :error) + (when gnus-html-image-automatic-caching + (url-store-in-cache (current-buffer))) + (when (and (or (search-forward "\n\n" nil t) + (search-forward "\r\n\r\n" nil t)) + (buffer-live-p buffer)) + (let ((data (buffer-substring (point) (point-max)))) + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (gnus-html-put-image data (car image) (cadr image))))))) (kill-buffer (current-buffer))) (defun gnus-html-get-image-data (url) @@ -370,53 +393,61 @@ (with-temp-buffer (mm-disable-multibyte) (url-cache-extract (url-cache-create-filename url)) - (when (search-forward "\n\n" nil t) + (when (or (search-forward "\n\n" nil t) + (search-forward "\r\n\r\n" nil t)) (buffer-substring (point) (point-max))))) -(defun gnus-html-put-image (data start end &optional url alt-text) +(defun gnus-html-put-image (data url &optional alt-text) (when (gnus-graphic-display-p) - (let* ((image (ignore-errors - (gnus-create-image data nil t))) - (size (and image - (if (featurep 'xemacs) - (cons (glyph-width image) (glyph-height image)) - (image-size image t))))) - (save-excursion - (goto-char start) - (let ((alt-text (or alt-text (buffer-substring-no-properties start end)))) - (if (and image - ;; Kludge to avoid displaying 30x30 gif images, which - ;; seems to be a signal of a broken image. - (not (and (if (featurep 'xemacs) - (glyphp image) - (listp image)) - (eq (if (featurep 'xemacs) - (let ((d (cdadar (specifier-spec-list - (glyph-image image))))) - (and (vectorp d) - (aref d 0))) - (plist-get (cdr image) :type)) - 'gif) - (= (car size) 30) - (= (cdr size) 30)))) - ;; Good image, add it! - (let ((image (gnus-html-rescale-image image data size))) - (delete-region start end) - (gnus-put-image image alt-text 'external) - (gnus-overlay-put (gnus-make-overlay start (point)) 'local-map - gnus-html-displayed-image-map) - (gnus-put-text-property start (point) 'gnus-alt-text alt-text) - (when url - (gnus-put-text-property start (point) 'gnus-image-url url)) - (gnus-add-image 'external image) - t) - ;; Bad image, try to show something else - (delete-region start end) - (when (fboundp 'find-image) - (setq image (find-image '((:type xpm :file "lock-broken.xpm")))) - (gnus-put-image image alt-text 'internal) - (gnus-add-image 'internal image)) - nil)))))) + (let* ((start (text-property-any (point-min) (point-max) 'gnus-image-url url)) + (end (when start + (next-single-property-change start 'gnus-image-url)))) + ;; Image found? + (when start + (let* ((image + (ignore-errors + (gnus-create-image data nil t))) + (size (and image + (if (featurep 'xemacs) + (cons (glyph-width image) (glyph-height image)) + (image-size image t))))) + (save-excursion + (goto-char start) + (let ((alt-text (or alt-text (buffer-substring-no-properties start end)))) + (if (and image + ;; Kludge to avoid displaying 30x30 gif images, which + ;; seems to be a signal of a broken image. + (not (and (if (featurep 'xemacs) + (glyphp image) + (listp image)) + (eq (if (featurep 'xemacs) + (let ((d (cdadar (specifier-spec-list + (glyph-image image))))) + (and (vectorp d) + (aref d 0))) + (plist-get (cdr image) :type)) + 'gif) + (= (car size) 30) + (= (cdr size) 30)))) + ;; Good image, add it! + (let ((image (gnus-html-rescale-image image data size))) + (delete-region start end) + (gnus-put-image image alt-text 'external) + (gnus-put-text-property start (point) 'help-echo alt-text) + (gnus-overlay-put (gnus-make-overlay start (point)) 'local-map + gnus-html-displayed-image-map) + (gnus-put-text-property start (point) 'gnus-alt-text alt-text) + (when url + (gnus-put-text-property start (point) 'gnus-image-url url)) + (gnus-add-image 'external image) + t) + ;; Bad image, try to show something else + (when (fboundp 'find-image) + (delete-region start end) + (setq image (find-image '((:type xpm :file "lock-broken.xpm")))) + (gnus-put-image image alt-text 'internal) + (gnus-add-image 'internal image)) + nil)))))))) (defun gnus-html-rescale-image (image data size) (if (or (not (fboundp 'imagemagick-types)) @@ -424,7 +455,7 @@ image (let* ((width (car size)) (height (cdr size)) - (edges (window-pixel-edges (get-buffer-window (current-buffer)))) + (edges (gnus-window-inside-pixel-edges (get-buffer-window (current-buffer)))) (window-width (truncate (* gnus-max-image-proportion (- (nth 2 edges) (nth 0 edges))))) (window-height (truncate (* gnus-max-image-proportion @@ -470,7 +501,7 @@ gnus-blocked-images))) (save-match-data (while (re-search-forward "<img.*src=[\"']\\([^\"']+\\)" nil t) - (let ((url (match-string 1))) + (let ((url (gnus-html-encode-url (match-string 1)))) (unless (gnus-html-image-url-blocked-p url blocked-images) (when (gnus-html-cache-expired url gnus-html-image-cache-ttl) (gnus-html-schedule-image-fetching nil
--- a/lisp/gnus/gnus-int.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/gnus-int.el Mon Sep 27 14:42:43 2010 +0900 @@ -181,10 +181,15 @@ (prog1 (setq result (gnus-open-server method)) (unless silent - (gnus-message 5 "Opening %s server%s...%s" (car method) - (if (equal (nth 1 method) "") "" - (format " on %s" (nth 1 method))) - (if result "done" "failed"))))))) + (gnus-message + (if result 5 3) + "Opening %s server%s...%s" (car method) + (if (equal (nth 1 method) "") "" + (format " on %s" (nth 1 method))) + (if result + "done" + (format "failed: %s" + (nnheader-get-report-string (car method)))))))))) (defun gnus-get-function (method function &optional noerror) "Return a function symbol based on METHOD and FUNCTION." @@ -226,10 +231,18 @@ (eq (nth 1 (assoc method gnus-opened-servers)) 'denied)) +(defvar gnus-backend-trace t) + (defun gnus-open-server (gnus-command-method) "Open a connection to GNUS-COMMAND-METHOD." (when (stringp gnus-command-method) (setq gnus-command-method (gnus-server-to-method gnus-command-method))) + (when gnus-backend-trace + (with-current-buffer (get-buffer-create "*gnus trace*") + (buffer-disable-undo) + (goto-char (point-max)) + (insert (format-time-string "%H:%M:%S") + (format " %S\n" gnus-command-method)))) (let ((elem (assoc gnus-command-method gnus-opened-servers)) (server (gnus-method-to-server-name gnus-command-method))) ;; If this method was previously denied, we just return nil. @@ -257,36 +270,31 @@ (setq elem (list gnus-command-method nil) gnus-opened-servers (cons elem gnus-opened-servers))) ;; Set the status of this server. - (setcar (cdr elem) - (cond (result - (if (eq open-server-function #'nnagent-open-server) - ;; The agent's backend has a "special" status - 'offline - 'ok)) - ((and gnus-agent - (gnus-agent-method-p gnus-command-method)) - (cond (gnus-server-unopen-status - ;; Set the server's status to the unopen - ;; status. If that status is offline, - ;; recurse to open the agent's backend. - (setq open-offline (eq gnus-server-unopen-status 'offline)) - gnus-server-unopen-status) - ((and - (not gnus-batch-mode) - (gnus-y-or-n-p - (format - "Unable to open server %s (%s), go offline? " - server - (nnheader-get-report - (car gnus-command-method))))) - (setq open-offline t) - 'offline) - (t - ;; This agentized server was still denied - 'denied))) - (t - ;; This unagentized server must be denied - 'denied))) + (setcar + (cdr elem) + (cond (result + (if (eq open-server-function #'nnagent-open-server) + ;; The agent's backend has a "special" status + 'offline + 'ok)) + ((and gnus-agent + (gnus-agent-method-p gnus-command-method)) + (cond + (gnus-server-unopen-status + ;; Set the server's status to the unopen + ;; status. If that status is offline, + ;; recurse to open the agent's backend. + (setq open-offline (eq gnus-server-unopen-status 'offline)) + gnus-server-unopen-status) + ((not gnus-batch-mode) + (setq open-offline t) + 'offline) + (t + ;; This agentized server was still denied + 'denied))) + (t + ;; This unagentized server must be denied + 'denied))) ;; NOTE: I MUST set the server's status to offline before this ;; recursive call as this status will drive the @@ -576,12 +584,21 @@ (and group (gnus-group-real-name group)) (nth 1 gnus-command-method))))) -(defsubst gnus-request-update-info (info gnus-command-method) +(defun gnus-request-update-info (info gnus-command-method) + (when (gnus-check-backend-function + 'request-update-info (car gnus-command-method)) + (when (stringp gnus-command-method) + (setq gnus-command-method (gnus-server-to-method gnus-command-method))) + (funcall (gnus-get-function gnus-command-method 'request-update-info) + (gnus-group-real-name (gnus-info-group info)) info + (nth 1 gnus-command-method)))) + +(defsubst gnus-request-marks (info gnus-command-method) "Request that GNUS-COMMAND-METHOD update INFO." (when (stringp gnus-command-method) (setq gnus-command-method (gnus-server-to-method gnus-command-method))) (when (gnus-check-backend-function - 'request-update-info (car gnus-command-method)) + 'request-marks (car gnus-command-method)) (let ((group (gnus-info-group info))) (and (funcall (gnus-get-function gnus-command-method 'request-update-info) @@ -601,6 +618,7 @@ (defun gnus-request-expire-articles (articles group &optional force) (let* ((gnus-command-method (gnus-find-method-for-group group)) + (gnus-inhibit-demon t) (not-deleted (funcall (gnus-get-function gnus-command-method 'request-expire-articles)
--- a/lisp/gnus/gnus-nocem.el Mon Sep 27 14:27:28 2010 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,452 +0,0 @@ -;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'nnmail) -(require 'gnus-art) -(require 'gnus-sum) -(require 'gnus-range) - -(defgroup gnus-nocem nil - "NoCeM pseudo-cancellation treatment." - :group 'gnus-score) - -(defcustom gnus-nocem-groups - '("news.lists.filters" "alt.nocem.misc") - "*List of groups that will be searched for NoCeM messages." - :group 'gnus-nocem - :version "23.1" - :type '(repeat (string :tag "Group"))) - -(defcustom gnus-nocem-issuers - '("Adri Verhoef" - "alba-nocem@albasani.net" - "bleachbot@httrack.com" - "news@arcor-online.net" - "news@uni-berlin.de" - "nocem@arcor.de" - "pgpmoose@killfile.org" - "xjsppl@gmx.de") - "*List of NoCeM issuers to pay attention to. - -This can also be a list of `(ISSUER CONDITION ...)' elements. - -See <URL:http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html> for an -issuer registry." - :group 'gnus-nocem - :link '(url-link "http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html") - :version "23.1" - :type '(repeat (cons :format "%v" (string :tag "Issuer") - (repeat :tag "Condition" - (group (checklist :inline t (const not)) - (regexp :tag "Type" :value ".*"))))) - :get (lambda (symbol) - (mapcar (lambda (elem) - (if (consp elem) - (cons (car elem) - (mapcar (lambda (elt) - (if (consp elt) elt (list elt))) - (cdr elem))) - (list elem))) - (default-value symbol))) - :set (lambda (symbol value) - (custom-set-default - symbol - (mapcar (lambda (elem) - (if (consp elem) - (if (cdr elem) - (mapcar (lambda (elt) - (if (consp elt) - (if (cdr elt) elt (car elt)) - elt)) - elem) - (car elem)) - elem)) - value)))) - -(defcustom gnus-nocem-directory - (nnheader-concat gnus-article-save-directory "NoCeM/") - "*Directory where NoCeM files will be stored." - :group 'gnus-nocem - :type 'directory) - -(defcustom gnus-nocem-expiry-wait 15 - "*Number of days to keep NoCeM headers in the cache." - :group 'gnus-nocem - :type 'integer) - -(defcustom gnus-nocem-verifyer (if (locate-library "epg") - 'gnus-nocem-epg-verify - 'pgg-verify) - "*Function called to verify that the NoCeM message is valid. -If the function in this variable isn't bound, the message will be used -unconditionally." - :group 'gnus-nocem - :version "23.1" - :type '(radio (function-item gnus-nocem-epg-verify) - (function-item pgg-verify) - (function-item mc-verify) - (function :tag "other")) - :set (lambda (symbol value) - (custom-set-default symbol - (if (and (eq value 'gnus-nocem-epg-verify) - (not (locate-library "epg"))) - 'pgg-verify - value)))) - -(defcustom gnus-nocem-liberal-fetch nil - "*If t try to fetch all messages which have @@NCM in the subject. -Otherwise don't fetch messages which have references or whose message-id -matches a previously scanned and verified nocem message." - :group 'gnus-nocem - :type 'boolean) - -(defcustom gnus-nocem-check-article-limit 500 - "*If non-nil, the maximum number of articles to check in any NoCeM group." - :group 'gnus-nocem - :version "21.1" - :type '(choice (const :tag "unlimited" nil) - (integer 1000))) - -(defcustom gnus-nocem-check-from t - "Non-nil means check for valid issuers in message bodies. -Otherwise don't bother fetching articles unless their author matches a -valid issuer, which is much faster if you are selective about the issuers." - :group 'gnus-nocem - :version "21.1" - :type 'boolean) - -;;; Internal variables - -(defvar gnus-nocem-active nil) -(defvar gnus-nocem-alist nil) -(defvar gnus-nocem-touched-alist nil) -(defvar gnus-nocem-hashtb nil) -(defvar gnus-nocem-seen-message-ids nil) - -;;; Functions - -(defun gnus-nocem-active-file () - (concat (file-name-as-directory gnus-nocem-directory) "active")) - -(defun gnus-nocem-cache-file () - (concat (file-name-as-directory gnus-nocem-directory) "cache")) - -;; -;; faster lookups for group names: -;; - -(defvar gnus-nocem-real-group-hashtb nil - "Real-name mappings of subscribed groups.") - -(defun gnus-fill-real-hashtb () - "Fill up a hash table with the real-name mappings from the user's active file." - (if (hash-table-p gnus-nocem-real-group-hashtb) - (clrhash gnus-nocem-real-group-hashtb) - (setq gnus-nocem-real-group-hashtb (make-hash-table :test 'equal))) - (mapcar (lambda (group) - (setq group (gnus-group-real-name (car group))) - (puthash group t gnus-nocem-real-group-hashtb)) - gnus-newsrc-alist)) - -;;;###autoload -(defun gnus-nocem-scan-groups () - "Scan all NoCeM groups for new NoCeM messages." - (interactive) - (let ((groups gnus-nocem-groups) - (gnus-inhibit-demon t) - group active gactive articles check-headers) - (gnus-make-directory gnus-nocem-directory) - ;; Load any previous NoCeM headers. - (gnus-nocem-load-cache) - ;; Get the group name mappings: - (gnus-fill-real-hashtb) - ;; Read the active file if it hasn't been read yet. - (and (file-exists-p (gnus-nocem-active-file)) - (not gnus-nocem-active) - (ignore-errors - (load (gnus-nocem-active-file) t t t))) - ;; Go through all groups and see whether new articles have - ;; arrived. - (while (setq group (pop groups)) - (if (not (setq gactive (gnus-activate-group group))) - () ; This group doesn't exist. - (setq active (nth 1 (assoc group gnus-nocem-active))) - (when (and (not (< (cdr gactive) (car gactive))) ; Empty group. - (or (not active) - (< (cdr active) (cdr gactive)))) - ;; Ok, there are new articles in this group, se we fetch the - ;; headers. - (save-excursion - (let ((dependencies (make-vector 10 nil)) - headers header) - (with-temp-buffer - (setq headers - (if (eq 'nov - (gnus-retrieve-headers - (setq articles - (gnus-uncompress-range - (cons - (if active (1+ (cdr active)) - (car gactive)) - (cdr gactive)))) - group)) - (gnus-get-newsgroup-headers-xover - articles nil dependencies) - (gnus-get-newsgroup-headers dependencies))) - (while (setq header (pop headers)) - ;; We take a closer look on all articles that have - ;; "@@NCM" in the subject. Unless we already read - ;; this cross posted message. Nocem messages - ;; are not allowed to have references, so we can - ;; ignore scanning followups. - (and (string-match "@@NCM" (mail-header-subject header)) - (and gnus-nocem-check-from - (let ((case-fold-search t)) - (catch 'ok - (mapc - (lambda (author) - (if (consp author) - (setq author (car author))) - (if (string-match - author (mail-header-from header)) - (throw 'ok t))) - gnus-nocem-issuers) - nil))) - (or gnus-nocem-liberal-fetch - (and (or (string= "" (mail-header-references - header)) - (null (mail-header-references header))) - (not (member (mail-header-message-id header) - gnus-nocem-seen-message-ids)))) - (push header check-headers))) - (setq check-headers (last (nreverse check-headers) - gnus-nocem-check-article-limit)) - (let ((i 0) - (len (length check-headers))) - (dolist (h check-headers) - (gnus-message - 7 "Checking article %d in %s for NoCeM (%d of %d)..." - (mail-header-number h) group (incf i) len) - (gnus-nocem-check-article group h))))))) - (setq gnus-nocem-active - (cons (list group gactive) - (delq (assoc group gnus-nocem-active) - gnus-nocem-active))))) - ;; Save the results, if any. - (gnus-nocem-save-cache) - (gnus-nocem-save-active))) - -(defun gnus-nocem-check-article (group header) - "Check whether the current article is an NCM article and that we want it." - ;; Get the article. - (let ((date (mail-header-date header)) - (gnus-newsgroup-name group) - issuer b e type) - (when (or (not date) - (time-less-p - (time-since (date-to-time date)) - (days-to-time gnus-nocem-expiry-wait))) - (gnus-request-article-this-buffer (mail-header-number header) group) - (goto-char (point-min)) - (when (re-search-forward - "-----BEGIN PGP\\(?: SIGNED\\)? MESSAGE-----" - nil t) - (delete-region (point-min) (match-beginning 0))) - (when (re-search-forward - "-----END PGP \\(?:MESSAGE\\|SIGNATURE\\)-----\n?" - nil t) - (delete-region (match-end 0) (point-max))) - (goto-char (point-min)) - ;; The article has to have proper NoCeM headers. - (when (and (setq b (search-forward "\n@@BEGIN NCM HEADERS\n" nil t)) - (setq e (search-forward "\n@@BEGIN NCM BODY\n" nil t))) - ;; We get the name of the issuer. - (narrow-to-region b e) - (setq issuer (mail-fetch-field "issuer") - type (mail-fetch-field "type")) - (widen) - (if (not (gnus-nocem-message-wanted-p issuer type)) - (message "invalid NoCeM issuer: %s" issuer) - (and (gnus-nocem-verify-issuer issuer) ; She is who she says she is. - (gnus-nocem-enter-article) ; We gobble the message. - (push (mail-header-message-id header) ; But don't come back for - gnus-nocem-seen-message-ids))))))) ; second helpings. - -(defun gnus-nocem-message-wanted-p (issuer type) - (let ((issuers gnus-nocem-issuers) - wanted conditions condition) - (cond - ;; Do the quick check first. - ((member issuer issuers) - t) - ((setq conditions (cdr (assoc issuer issuers))) - ;; Check whether we want this type. - (while (setq condition (pop conditions)) - (cond - ((stringp condition) - (when (string-match condition type) - (setq wanted t))) - ((and (consp condition) - (eq (car condition) 'not) - (stringp (cadr condition))) - (when (string-match (cadr condition) type) - (setq wanted nil))) - (t - (error "Invalid NoCeM condition: %S" condition)))) - wanted)))) - -(defun gnus-nocem-verify-issuer (person) - "Verify using PGP that the canceler is who she says she is." - (if (functionp gnus-nocem-verifyer) - (ignore-errors - (funcall gnus-nocem-verifyer)) - ;; If we don't have Mailcrypt, then we use the message anyway. - t)) - -(defun gnus-nocem-enter-article () - "Enter the current article into the NoCeM cache." - (goto-char (point-min)) - (let ((b (search-forward "\n@@BEGIN NCM BODY\n" nil t)) - (e (search-forward "\n@@END NCM BODY\n" nil t)) - (buf (current-buffer)) - ncm id group) - (when (and b e) - (narrow-to-region b (1+ (match-beginning 0))) - (goto-char (point-min)) - (while (search-forward "\t" nil t) - (cond - ((not (ignore-errors - (setq group (gnus-group-real-name (symbol-name (read buf)))) - (gethash group gnus-nocem-real-group-hashtb))) - ;; An error. - ) - (t - ;; Valid group. - (beginning-of-line) - (while (eq (char-after) ?\t) - (forward-line -1)) - (setq id (buffer-substring (point) (1- (search-forward "\t")))) - (unless (if (hash-table-p gnus-nocem-hashtb) - (gethash id gnus-nocem-hashtb) - (setq gnus-nocem-hashtb (make-hash-table :test 'equal)) - nil) - ;; only store if not already present - (puthash id t gnus-nocem-hashtb) - (push id ncm)) - (forward-line 1) - (while (eq (char-after) ?\t) - (forward-line 1))))) - (when ncm - (setq gnus-nocem-touched-alist t) - (push (cons (let ((time (current-time))) (setcdr (cdr time) nil) time) - ncm) - gnus-nocem-alist)) - t))) - -;;;###autoload -(defun gnus-nocem-load-cache () - "Load the NoCeM cache." - (interactive) - (unless gnus-nocem-alist - ;; The buffer doesn't exist, so we create it and load the NoCeM - ;; cache. - (when (file-exists-p (gnus-nocem-cache-file)) - (load (gnus-nocem-cache-file) t t t) - (gnus-nocem-alist-to-hashtb)))) - -(defun gnus-nocem-save-cache () - "Save the NoCeM cache." - (when (and gnus-nocem-alist - gnus-nocem-touched-alist) - (with-temp-file (gnus-nocem-cache-file) - (gnus-prin1 `(setq gnus-nocem-alist ',gnus-nocem-alist))) - (setq gnus-nocem-touched-alist nil))) - -(defun gnus-nocem-save-active () - "Save the NoCeM active file." - (with-temp-file (gnus-nocem-active-file) - (gnus-prin1 `(setq gnus-nocem-active ',gnus-nocem-active)))) - -(defun gnus-nocem-alist-to-hashtb () - "Create a hashtable from the Message-IDs we have." - (let* ((alist gnus-nocem-alist) - (pprev (cons nil alist)) - (prev pprev) - (expiry (days-to-time gnus-nocem-expiry-wait)) - entry) - (if (hash-table-p gnus-nocem-hashtb) - (clrhash gnus-nocem-hashtb) - (setq gnus-nocem-hashtb (make-hash-table :test 'equal))) - (while (setq entry (car alist)) - (if (not (time-less-p (time-since (car entry)) expiry)) - ;; This entry has expired, so we remove it. - (setcdr prev (cdr alist)) - (setq prev alist) - ;; This is ok, so we enter it into the hashtable. - (setq entry (cdr entry)) - (while entry - (puthash (car entry) t gnus-nocem-hashtb) - (setq entry (cdr entry)))) - (setq alist (cdr alist))))) - -(gnus-add-shutdown 'gnus-nocem-close 'gnus) - -(defun gnus-nocem-close () - "Clear internal NoCeM variables." - (setq gnus-nocem-alist nil - gnus-nocem-hashtb nil - gnus-nocem-active nil - gnus-nocem-touched-alist nil - gnus-nocem-seen-message-ids nil - gnus-nocem-real-group-hashtb nil)) - -(defun gnus-nocem-unwanted-article-p (id) - "Say whether article ID in the current group is wanted." - (and gnus-nocem-hashtb - (gethash id gnus-nocem-hashtb))) - -(autoload 'epg-make-context "epg") -(eval-when-compile - (autoload 'epg-verify-string "epg") - (autoload 'epg-context-result-for "epg") - (autoload 'epg-signature-status "epg")) - -(defun gnus-nocem-epg-verify () - "Return t if EasyPG verifies a signed message in the current buffer." - (let ((context (epg-make-context 'OpenPGP)) - result) - (epg-verify-string context (buffer-string)) - (and (setq result (epg-context-result-for context 'verify)) - (not (cdr result)) - (eq (epg-signature-status (car result)) 'good)))) - -(provide 'gnus-nocem) - -;;; gnus-nocem.el ends here
--- a/lisp/gnus/gnus-picon.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/gnus-picon.el Mon Sep 27 14:42:43 2010 +0900 @@ -85,23 +85,14 @@ (const right)) :group 'gnus-picon) -(defface gnus-picon-xbm '((t (:foreground "black" :background "white"))) - "Face to show xbm picon in." +(defcustom gnus-picon-inhibit-top-level-domains t + "If non-nil, don't piconify top-level domains. +These are often not very interesting." + :type 'boolean :group 'gnus-picon) -;; backward-compatibility alias -(put 'gnus-picon-xbm-face 'face-alias 'gnus-picon-xbm) -(put 'gnus-picon-xbm-face 'obsolete-face "22.1") - -(defface gnus-picon '((t (:foreground "black" :background "white"))) - "Face to show picon in." - :group 'gnus-picon) -;; backward-compatibility alias -(put 'gnus-picon-face 'face-alias 'gnus-picon) -(put 'gnus-picon-face 'obsolete-face "22.1") ;;; Internal variables: -(defvar gnus-picon-setup-p nil) (defvar gnus-picon-glyph-alist nil "Picon glyphs cache. List of pairs (KEY . GLYPH) where KEY is either a filename or an URL.") @@ -166,7 +157,9 @@ (defun gnus-picon-create-glyph (file) (or (cdr (assoc file gnus-picon-glyph-alist)) - (cdar (push (cons file (gnus-create-image file)) + (cdar (push (cons file (gnus-create-image + file nil nil + :color-symbols '(("None" . "white")))) gnus-picon-glyph-alist)))) ;;; Functions that does picon transformations: @@ -201,7 +194,9 @@ (setcar spec (cons (gnus-picon-create-glyph file) (car spec)))) - (dotimes (i (1- (length spec))) + (dotimes (i (- (length spec) + (if gnus-picon-inhibit-top-level-domains + 2 1))) (when (setq file (gnus-picon-find-face (concat "unknown@" (mapconcat
--- a/lisp/gnus/gnus-srvr.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/gnus-srvr.el Mon Sep 27 14:42:43 2010 +0900 @@ -28,6 +28,7 @@ (eval-when-compile (require 'cl)) (require 'gnus) +(require 'gnus-start) (require 'gnus-spec) (require 'gnus-group) (require 'gnus-int) @@ -547,6 +548,7 @@ (gnus-server-list-servers)) (defun gnus-server-copy-server (from to) + "Copy a server definiton to a new name." (interactive (list (or (gnus-server-server-name) @@ -643,6 +645,30 @@ (defvar gnus-browse-menu-hook nil "*Hook run after the creation of the browse mode menu.") +(defcustom gnus-browse-subscribe-newsgroup-method + 'gnus-subscribe-alphabetically + "Function(s) called when subscribing groups in the Browse Server Buffer +A few pre-made functions are supplied: `gnus-subscribe-randomly' +inserts new groups at the beginning of the list of groups; +`gnus-subscribe-alphabetically' inserts new groups in strict +alphabetic order; `gnus-subscribe-hierarchically' inserts new groups +in hierarchical newsgroup order; `gnus-subscribe-interactively' asks +for your decision; `gnus-subscribe-killed' kills all new groups; +`gnus-subscribe-zombies' will make all new groups into zombies; +`gnus-subscribe-topics' will enter groups into the topics that +claim them." + :version "24.1" + :group 'gnus-server + :type '(radio (function-item gnus-subscribe-randomly) + (function-item gnus-subscribe-alphabetically) + (function-item gnus-subscribe-hierarchically) + (function-item gnus-subscribe-interactively) + (function-item gnus-subscribe-killed) + (function-item gnus-subscribe-zombies) + (function-item gnus-subscribe-topics) + function + (repeat function))) + (defvar gnus-browse-mode-hook nil) (defvar gnus-browse-mode-map nil) (put 'gnus-browse-mode 'mode-class 'special) @@ -890,7 +916,9 @@ (gnus-browse-next-group (- n))) (defun gnus-browse-unsubscribe-current-group (arg) - "(Un)subscribe to the next ARG groups." + "(Un)subscribe to the next ARG groups. +The variable `gnus-browse-subscribe-newsgroup-method' determines +how new groups will be entered into the group buffer." (interactive "p") (when (eobp) (error "No group at current line")) @@ -939,22 +967,24 @@ ;; subscribe to it. (if (gnus-ephemeral-group-p group) (gnus-kill-ephemeral-group group)) - ;; We need to discern between killed/zombie groups and - ;; just unsubscribed ones. - (gnus-group-change-level - (or (gnus-group-entry group) - (list t group gnus-level-default-subscribed - nil nil (if (gnus-server-equal - gnus-browse-current-method "native") - nil - (gnus-method-simplify - gnus-browse-current-method)))) - gnus-level-default-subscribed (gnus-group-level group) - (and (car (nth 1 gnus-newsrc-alist)) - (gnus-group-entry (car (nth 1 gnus-newsrc-alist)))) - (null (gnus-group-entry group))) + (let ((entry (gnus-group-entry group))) + (if entry + ;; Just change the subscription level if it is an + ;; unsubscribed group. + (gnus-group-change-level entry + gnus-level-default-subscribed) + ;; If it is a killed group or a zombie, feed it to the + ;; mechanism for new group subscription. + (gnus-call-subscribe-functions + gnus-browse-subscribe-newsgroup-method + group))) (delete-char 1) - (insert ? )) + (insert (let ((lvl (gnus-group-level group))) + (cond + ((< lvl gnus-level-unsubscribed) ? ) + ((< lvl gnus-level-zombie) ?U) + ((< lvl gnus-level-killed) ?Z) + (t ?K))))) (gnus-group-change-level group gnus-level-unsubscribed gnus-level-default-subscribed) (delete-char 1)
--- a/lisp/gnus/gnus-start.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/gnus-start.el Mon Sep 27 14:42:43 2010 +0900 @@ -380,6 +380,13 @@ :group 'gnus-newsrc :type 'boolean) +(defcustom gnus-use-backend-marks nil + "If non-nil, Gnus will store and retrieve marks from the backends. +This means that marks will be stored both in .newsrc.eld and in +the backend, and will slow operation down somewhat." + :group 'gnus-newsrc + :type 'boolean) + (defcustom gnus-check-bogus-groups-hook nil "A hook run after removing bogus groups." :group 'gnus-start-server @@ -402,8 +409,7 @@ :group 'gnus-start :type 'hook) -(defcustom gnus-setup-news-hook - '(gnus-fixup-nnimap-unread-after-getting-new-news) +(defcustom gnus-setup-news-hook nil "A hook after reading the .newsrc file, but before generating the buffer." :group 'gnus-start :type 'hook) @@ -420,9 +426,9 @@ :type 'hook) (defcustom gnus-after-getting-new-news-hook - '(gnus-display-time-event-handler - gnus-fixup-nnimap-unread-after-getting-new-news) + '(gnus-display-time-event-handler) "*A hook run after Gnus checks for new news when Gnus is already running." + :version "24.1" :group 'gnus-group-new :type 'hook) @@ -1057,15 +1063,6 @@ (gnus-server-opened gnus-select-method)) (gnus-check-bogus-newsgroups)) - ;; We might read in new NoCeM messages here. - (when (and (not dont-connect) - gnus-use-nocem - (or (and (numberp gnus-use-nocem) - (numberp level) - (>= level gnus-use-nocem)) - (not level))) - (gnus-nocem-scan-groups)) - ;; Read any slave files. (gnus-master-read-slave-newsrc) @@ -1580,6 +1577,13 @@ (gnus-info-group info))))) (gnus-activate-group (gnus-info-group info) nil t)) + ;; Allow backends to update marks, + (when gnus-use-backend-marks + (let ((method (inline (gnus-find-method-for-group + (gnus-info-group info))))) + (when (gnus-check-backend-function 'request-marks (car method)) + (gnus-request-marks info method)))) + (let* ((range (gnus-info-read info)) (num 0)) @@ -1754,11 +1758,12 @@ (not (gnus-method-denied-p method))) (unless (gnus-server-opened method) (gnus-open-server method)) - (when (gnus-check-backend-function - 'retrieve-group-data-early (car method)) + (when (and + (gnus-server-opened method) + (gnus-check-backend-function + 'retrieve-group-data-early (car method))) (when (gnus-check-backend-function 'request-scan (car method)) - (dolist (info infos) - (gnus-request-scan (gnus-info-group info) method))) + (gnus-request-scan nil method)) (setcar (nthcdr 3 elem) (gnus-retrieve-group-data-early method infos)))))) @@ -1766,12 +1771,14 @@ (dolist (elem type-cache) (destructuring-bind (method method-type infos early-data) elem (when (and method infos) - ;; See if any of the groups from this method require updating. - (gnus-read-active-for-groups method infos early-data) - (dolist (info infos) - (inline (gnus-get-unread-articles-in-group - info (gnus-active (gnus-info-group info)) - t)))))) + (let ((updatep (gnus-check-backend-function + 'request-update-info (car method)))) + ;; See if any of the groups from this method require updating. + (gnus-read-active-for-groups method infos early-data) + (dolist (info infos) + (inline (gnus-get-unread-articles-in-group + info (gnus-active (gnus-info-group info)) + updatep))))))) (gnus-message 6 "Checking new news...done"))) (defun gnus-method-rank (type method) @@ -1806,8 +1813,7 @@ (gnus-agent-save-active method)) ((gnus-check-backend-function 'retrieve-groups (car method)) (when (gnus-check-backend-function 'request-scan (car method)) - (dolist (info infos) - (gnus-request-scan (gnus-info-group info) method))) + (gnus-request-scan nil method)) (let (groups) (gnus-read-active-file-2 (dolist (info infos (nreverse groups)) @@ -2055,10 +2061,7 @@ (gnus-online method)) (not gnus-agent)) (gnus-check-backend-function 'request-scan (car method))) - (if infos - (dolist (info infos) - (gnus-request-scan (gnus-info-group info) method)) - (gnus-request-scan nil method))) + (gnus-request-scan nil method)) (cond ((and (eq gnus-read-active-file 'some) (gnus-check-backend-function 'retrieve-groups (car method)) @@ -3151,20 +3154,6 @@ (gnus-boundp 'display-time-timer)) (display-time-event-handler))) -;;;###autoload -(defun gnus-fixup-nnimap-unread-after-getting-new-news () - (let (server group info) - (mapatoms - (lambda (sym) - (when (and (setq group (symbol-name sym)) - (gnus-group-entry group) - (setq info (symbol-value sym))) - (gnus-sethash group (cons (nth 2 info) (cdr (gnus-group-entry group))) - gnus-newsrc-hashtb))) - (if (boundp 'nnimap-mailbox-info) - (symbol-value 'nnimap-mailbox-info) - (make-vector 1 0))))) - (defun gnus-check-reasonable-setup () ;; Check whether nnml and nnfolder share a directory. (let ((display-warn
--- a/lisp/gnus/gnus-sum.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/gnus-sum.el Mon Sep 27 14:42:43 2010 +0900 @@ -451,8 +451,10 @@ (integer :tag "height") (sexp :menu-tag "both" t))) -(defvar gnus-auto-center-group t - "*If non-nil, always center the group buffer.") +(defcustom gnus-auto-center-group t + "If non-nil, always center the group buffer." + :group 'gnus-summary-maneuvering + :type 'boolean) (defcustom gnus-show-all-headers nil "*If non-nil, don't hide any headers." @@ -1539,22 +1541,34 @@ (defvar gnus-summary-local-variables '(gnus-newsgroup-name + + ;; Marks lists + gnus-newsgroup-unreads + gnus-newsgroup-unselected + gnus-newsgroup-marked + gnus-newsgroup-spam-marked + gnus-newsgroup-reads + gnus-newsgroup-saved + gnus-newsgroup-replied + gnus-newsgroup-forwarded + gnus-newsgroup-recent + gnus-newsgroup-expirable + gnus-newsgroup-killed + gnus-newsgroup-unseen + gnus-newsgroup-seen + gnus-newsgroup-cached + gnus-newsgroup-downloadable + gnus-newsgroup-undownloaded + gnus-newsgroup-unsendable + gnus-newsgroup-begin gnus-newsgroup-end gnus-newsgroup-last-rmail gnus-newsgroup-last-mail gnus-newsgroup-last-folder gnus-newsgroup-last-file gnus-newsgroup-last-directory - gnus-newsgroup-auto-expire gnus-newsgroup-unreads - gnus-newsgroup-unselected gnus-newsgroup-marked - gnus-newsgroup-spam-marked - gnus-newsgroup-reads gnus-newsgroup-saved - gnus-newsgroup-replied gnus-newsgroup-forwarded - gnus-newsgroup-recent - gnus-newsgroup-expirable - gnus-newsgroup-processable gnus-newsgroup-killed - gnus-newsgroup-downloadable gnus-newsgroup-undownloaded + gnus-newsgroup-auto-expire + gnus-newsgroup-processable gnus-newsgroup-unfetched - gnus-newsgroup-unsendable gnus-newsgroup-unseen - gnus-newsgroup-seen gnus-newsgroup-articles + gnus-newsgroup-articles gnus-newsgroup-bookmarks gnus-newsgroup-dormant gnus-newsgroup-headers gnus-newsgroup-threads gnus-newsgroup-prepared gnus-summary-highlight-line-function @@ -1573,7 +1587,7 @@ (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring) gnus-newsgroup-adaptive-score-file (gnus-reffed-article-number . -1) (gnus-newsgroup-expunged-tally . 0) - gnus-cache-removable-articles gnus-newsgroup-cached + gnus-cache-removable-articles gnus-newsgroup-data gnus-newsgroup-data-reverse gnus-newsgroup-limit gnus-newsgroup-limits gnus-newsgroup-charset gnus-newsgroup-display @@ -2035,6 +2049,7 @@ "e" gnus-summary-end-of-article "^" gnus-summary-refer-parent-article "r" gnus-summary-refer-parent-article + "C" gnus-summary-show-complete-article "D" gnus-summary-enter-digest-group "R" gnus-summary-refer-references "T" gnus-summary-refer-thread @@ -2112,7 +2127,9 @@ "W" gnus-html-show-images "f" gnus-treat-from-picon "m" gnus-treat-mail-picon - "n" gnus-treat-newsgroups-picon) + "n" gnus-treat-newsgroups-picon + "g" gnus-treat-from-gravatar + "h" gnus-treat-mail-gravatar) (gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map) "w" gnus-article-decode-mime-words @@ -2142,11 +2159,9 @@ (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map) "v" gnus-version - "f" gnus-summary-fetch-faq "d" gnus-summary-describe-group "h" gnus-summary-describe-briefly "i" gnus-info-find-node - "c" gnus-group-fetch-charter "C" gnus-group-fetch-control) (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map) @@ -2362,6 +2377,8 @@ ["Show picons in From" gnus-treat-from-picon t] ["Show picons in mail headers" gnus-treat-mail-picon t] ["Show picons in news headers" gnus-treat-newsgroups-picon t] + ["Show Gravatars in From" gnus-treat-from-gravatar t] + ["Show Gravatars in mail headers" gnus-treat-mail-gravatar t] ("View as different encoding" ,@(gnus-summary-menu-split (mapcar @@ -2721,11 +2738,7 @@ ["Randomize" gnus-summary-sort-by-random t] ["Original sort" gnus-summary-sort-by-original t]) ("Help" - ["Fetch group FAQ" gnus-summary-fetch-faq t] ["Describe group" gnus-summary-describe-group t] - ["Fetch charter" gnus-group-fetch-charter - ,@(if (featurep 'xemacs) nil - '(:help "Display the charter of the current group"))] ["Fetch control message" gnus-group-fetch-control ,@(if (featurep 'xemacs) nil '(:help "Display the archived control message for the current group"))] @@ -5358,18 +5371,18 @@ (if (= gnus-tmp-lines -1) (setq gnus-tmp-lines "?") (setq gnus-tmp-lines (number-to-string gnus-tmp-lines))) - (gnus-put-text-property - (point) - (progn (eval gnus-summary-line-format-spec) (point)) - 'gnus-number number) - (when gnus-visual-p - (forward-line -1) - (gnus-summary-highlight-line) - (when gnus-summary-update-hook - (gnus-run-hooks 'gnus-summary-update-hook)) - (forward-line 1)) - - (setq gnus-tmp-prev-subject simp-subject))) + (gnus-put-text-property + (point) + (progn (eval gnus-summary-line-format-spec) (point)) + 'gnus-number number) + (when gnus-visual-p + (forward-line -1) + (gnus-summary-highlight-line) + (when gnus-summary-update-hook + (gnus-run-hooks 'gnus-summary-update-hook)) + (forward-line 1)) + + (setq gnus-tmp-prev-subject simp-subject))) (when (nth 1 thread) (push (list (max 0 gnus-tmp-level) @@ -5976,6 +5989,10 @@ (when add (push (list add 'add (list (cdr type))) delta-marks)) (when del + ;; Don't delete marks from outside the active range. This + ;; shouldn't happen, but is a sanity check. + (setq del (gnus-sorted-range-intersection + (gnus-active gnus-newsgroup-name) del)) (push (list del 'del (list (cdr type))) delta-marks)))) (when list @@ -6202,8 +6219,6 @@ (unless (gnus-ephemeral-group-p group) (gnus-group-update-group group t)))))) -(defvar gnus-newsgroup-none-id 0) - (defun gnus-get-newsgroup-headers (&optional dependencies force-new) (let ((cur nntp-server-buffer) (dependencies @@ -7308,23 +7323,6 @@ t))) (gnus-message 3 "This dead summary is now alive again")) -;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>. -(defun gnus-summary-fetch-faq (&optional faq-dir) - "Fetch the FAQ for the current group. -If FAQ-DIR (the prefix), prompt for a directory to search for the faq -in." - (interactive - (list - (when current-prefix-arg - (completing-read - "FAQ dir: " (and (listp gnus-group-faq-directory) - (mapcar 'list - gnus-group-faq-directory)))))) - (let (gnus-faq-buffer) - (when (setq gnus-faq-buffer - (gnus-group-fetch-faq gnus-newsgroup-name faq-dir)) - (gnus-configure-windows 'summary-faq)))) - ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>. (defun gnus-summary-describe-group (&optional force) "Describe the current newsgroup." @@ -8650,8 +8648,7 @@ (null gnus-summary-expunge-below) (not (eq gnus-build-sparse-threads 'some)) (not (eq gnus-build-sparse-threads 'more)) - (null gnus-thread-expunge-below) - (not gnus-use-nocem))) + (null gnus-thread-expunge-below))) (push gnus-newsgroup-limit gnus-newsgroup-limits) (setq gnus-newsgroup-limit nil) (mapatoms @@ -8734,14 +8731,7 @@ t) ;; Do the `display' group parameter. (and gnus-newsgroup-display - (not (funcall gnus-newsgroup-display))) - ;; Check NoCeM things. - (when (and gnus-use-nocem - (gnus-nocem-unwanted-article-p - (mail-header-id (car thread)))) - (setq gnus-newsgroup-unreads - (delq number gnus-newsgroup-unreads)) - t))) + (not (funcall gnus-newsgroup-display))))) ;; Nope, invisible article. 0 ;; Ok, this article is to be visible, so we add it to the limit @@ -9362,6 +9352,18 @@ (ps-spool-buffer))))) (kill-buffer buffer)))) +(defun gnus-summary-show-complete-article () + "Show a complete version of the current article. +This is only useful if you're looking at a partial version of the +article currently." + (interactive) + (let ((gnus-keep-backlog nil) + (gnus-use-cache nil) + (gnus-agent nil) + (gnus-fetch-partial-articles nil)) + (gnus-flush-original-article-buffer) + (gnus-summary-show-article))) + (defun gnus-summary-show-article (&optional arg) "Force redisplaying of the current article. If ARG (the prefix) is a number, show the article with the charset @@ -11302,7 +11304,7 @@ (defalias 'gnus-remove-overlays 'remove-overlays) (defun gnus-remove-overlays (beg end name val) "Clear BEG and END of overlays whose property NAME has value VAL. -For compatibility with Emacs 21 and XEmacs." +For compatibility with XEmacs." (dolist (ov (gnus-overlays-in beg end)) (when (eq (gnus-overlay-get ov name) val) (gnus-delete-overlay ov))))))
--- a/lisp/gnus/gnus-util.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/gnus-util.el Mon Sep 27 14:42:43 2010 +0900 @@ -601,6 +601,8 @@ (t (apply 'message ,format-string ,args)))))))) +(defvar gnus-action-message-log nil) + (defun gnus-message-with-timestamp (format-string &rest args) "Display message with timestamp. Arguments are the same as `message'. The `gnus-add-timestamp-to-message' variable controls how to add @@ -615,14 +617,26 @@ that take a long time, 7 - not very important messages on stuff, 9 - messages inside loops." (if (<= level gnus-verbose) - (if gnus-add-timestamp-to-message - (apply 'gnus-message-with-timestamp args) - (apply 'message args)) + (let ((message + (if gnus-add-timestamp-to-message + (apply 'gnus-message-with-timestamp args) + (apply 'message args)))) + (when (and (consp gnus-action-message-log) + (<= level 3)) + (push message gnus-action-message-log)) + message) ;; We have to do this format thingy here even if the result isn't ;; shown - the return value has to be the same as the return value ;; from `message'. (apply 'format args))) +(defun gnus-final-warning () + (when (and (consp gnus-action-message-log) + (setq gnus-action-message-log + (delete nil gnus-action-message-log))) + (message "Warning: %s" + (mapconcat #'identity gnus-action-message-log "; ")))) + (defun gnus-error (level &rest args) "Beep an error if LEVEL is equal to or less than `gnus-verbose'. ARGS are passed to `message'." @@ -1661,30 +1675,14 @@ (kill-buffer buf)) tchar)) -(declare-function x-focus-frame "xfns.c" (frame)) -(declare-function w32-focus-frame "../term/w32-win" (frame)) - -(defun gnus-select-frame-set-input-focus (frame) - "Select FRAME, raise it, and set input focus, if possible." - (cond ((featurep 'xemacs) - (if (fboundp 'select-frame-set-input-focus) - (select-frame-set-input-focus frame) - (raise-frame frame) - (select-frame frame) - (focus-frame frame))) - ;; `select-frame-set-input-focus' defined in Emacs 21 will not - ;; set the input focus. - ((>= emacs-major-version 22) - (select-frame-set-input-focus frame)) - (t - (raise-frame frame) - (select-frame frame) - (cond ((memq window-system '(x ns mac)) - (x-focus-frame frame)) - ((eq window-system 'w32) - (w32-focus-frame frame))) - (when focus-follows-mouse - (set-mouse-position frame (1- (frame-width frame)) 0))))) +(if (fboundp 'select-frame-set-input-focus) + (defalias 'gnus-select-frame-set-input-focus 'select-frame-set-input-focus) + ;; XEmacs 21.4, SXEmacs + (defun gnus-select-frame-set-input-focus (frame) + "Select FRAME, raise it, and set input focus, if possible." + (raise-frame frame) + (select-frame frame) + (focus-frame frame))) (defun gnus-frame-or-window-display-name (object) "Given a frame or window, return the associated display name.
--- a/lisp/gnus/gnus-uu.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/gnus-uu.el Mon Sep 27 14:42:43 2010 +0900 @@ -335,7 +335,6 @@ (defvar gnus-uu-shar-begin-string "^#! */bin/sh") -(defvar gnus-uu-shar-file-name nil) (defvar gnus-uu-shar-name-marker "begin 0?[0-7][0-7][0-7][ \t]+\\(\\(\\w\\|[.\\:]\\)*\\b\\)")
--- a/lisp/gnus/gnus.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/gnus.el Mon Sep 27 14:42:43 2010 +0900 @@ -308,11 +308,6 @@ :group 'gnus-start :type 'boolean) -(defcustom gnus-play-startup-jingle nil - "If non-nil, play the Gnus jingle at startup." - :group 'gnus-start - :type 'boolean) - (unless (fboundp 'gnus-group-remove-excess-properties) (defalias 'gnus-group-remove-excess-properties 'ignore)) @@ -960,8 +955,6 @@ (defvar gnus-group-buffer "*Group*") -(autoload 'gnus-play-jingle "gnus-audio") - (defface gnus-splash '((((class color) (background dark)) @@ -984,9 +977,7 @@ (erase-buffer) (unless gnus-inhibit-startup-message (gnus-group-startup-message) - (sit-for 0) - (when gnus-play-startup-jingle - (gnus-play-jingle)))))) + (sit-for 0))))) (defun gnus-indent-rigidly (start end arg) "Indent rigidly using only spaces and no tabs." @@ -1470,75 +1461,6 @@ (nnweb "refer" (nnweb-type google))) gnus-select-method)))) -(defcustom gnus-group-faq-directory - '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/" - "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/" - "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/" - "/ftp@ftp.seas.gwu.edu:/pub/rtfm/" - "/ftp@ftp.pasteur.fr:/pub/FAQ/" - "/ftp@rtfm.mit.edu:/pub/usenet/" - "/ftp@ftp.uni-paderborn.de:/pub/FAQ/" - "/ftp@ftp.sunet.se:/pub/usenet/" - "/ftp@nctuccca.nctu.edu.tw:/pub/Documents/rtfm/usenet-by-group/" - "/ftp@hwarang.postech.ac.kr:/pub/usenet/" - "/ftp@ftp.hk.super.net:/mirror/faqs/") - "*Directory where the group FAQs are stored. -This will most commonly be on a remote machine, and the file will be -fetched by ange-ftp. - -This variable can also be a list of directories. In that case, the -first element in the list will be used by default. The others can -be used when being prompted for a site. - -Note that Gnus uses an aol machine as the default directory. If this -feels fundamentally unclean, just think of it as a way to finally get -something of value back from them. - -If the default site is too slow, try one of these: - - North America: mirrors.aol.com /pub/rtfm/usenet - ftp.seas.gwu.edu /pub/rtfm - rtfm.mit.edu /pub/usenet - Europe: ftp.uni-paderborn.de /pub/FAQ - src.doc.ic.ac.uk /usenet/news-FAQS - ftp.sunet.se /pub/usenet - ftp.pasteur.fr /pub/FAQ - Asia: nctuccca.nctu.edu.tw /pub/Documents/rtfm/usenet-by-group/ - hwarang.postech.ac.kr /pub/usenet - ftp.hk.super.net /mirror/faqs" - :group 'gnus-group-various - :type '(choice directory - (repeat directory))) - -(defcustom gnus-group-charter-alist - '(("no" . (concat "http://no.news-admin.org/charter/" name ".txt")) - ("de" . (concat "http://purl.net/charta/" name ".html")) - ("dk" . (concat "http://www.usenet.dk/grupper.pl?get=" name)) - ("england" . (concat "http://england.news-admin.org/charters/" name)) - ("fr" . (concat "http://www.usenet-fr.net/fur/chartes/" name ".html")) - ("europa" . (concat "http://www.europa.usenet.eu.org/chartas/charta-en-" - (gnus-replace-in-string name "europa\\." "") ".html")) - ("nl" . (concat "http://www.xs4all.nl/~sister/usenet/charters/" name)) - ("aus" . (concat "http://aus.news-admin.org/groupinfo.cgi/" name)) - ("pl" . (concat "http://www.usenet.pl/opisy/" name)) - ("ch" . (concat "http://www.use-net.ch/Usenet/charter.html#" name)) - ("at" . (concat "http://www.usenet.at/chartas/" name "/charta")) - ("uk" . (concat "http://www.usenet.org.uk/" name ".html")) - ("dfw" . (concat "http://www.cirr.com/dfw/charters/" name ".html")) - ("se" . (concat "http://www.usenet-se.net/Reglementen/" - (gnus-replace-in-string name "\\." "_") ".html")) - ("milw" . (concat "http://usenet.mil.wi.us/" - (gnus-replace-in-string name "milw\\." "") "-charter")) - ("ca" . (concat "http://www.sbay.org/ca/charter-" name ".html")) - ("netins" . (concat "http://www.netins.net/usenet/charter/" - (gnus-replace-in-string name "\\." "-") "-charter.html"))) - "*An alist of (HIERARCHY . FORM) pairs used to construct the URL of a charter. -When FORM is evaluated `name' is bound to the name of the group." - :version "22.1" - :group 'gnus-group-various - :type '(repeat (cons (string :tag "Hierarchy") (sexp :tag "Form")))) -(put 'gnus-group-charter-alist 'risky-local-variable t) - (defcustom gnus-group-fetch-control-use-browse-url nil "*Non-nil means that control messages are displayed using `browse-url'. Otherwise they are fetched with ange-ftp and displayed in an ephemeral @@ -1649,25 +1571,6 @@ (sexp :format "all" :value t))) -(defcustom gnus-use-nocem nil - "*If non-nil, Gnus will read NoCeM cancel messages. -You can also set this variable to a positive number as a group level. -In that case, Gnus scans NoCeM messages when checking new news if this -value is not exceeding a group level that you specify as the prefix -argument to some commands, e.g. `gnus', `gnus-group-get-new-news', etc. -Otherwise, Gnus does not scan NoCeM messages if you specify a group -level to those commands." - :group 'gnus-meta - :type '(choice - (const :tag "off" nil) - (const :tag "on" t) - (list :convert-widget - (lambda (widget) - (list 'integer :tag "group level" - :value (if (boundp 'gnus-level-default-subscribed) - gnus-level-default-subscribed - 3)))))) - (defcustom gnus-suppress-duplicates nil "*If non-nil, Gnus will mark duplicate copies of the same article as read." :group 'gnus-meta @@ -2699,9 +2602,6 @@ (defvar gnus-tree-buffer "*Tree*" "Buffer where Gnus thread trees are displayed.") -;; Dummy variable. -(defvar gnus-use-generic-from nil) - ;; Variable holding the user answers to all method prompts. (defvar gnus-method-history nil) @@ -2729,8 +2629,6 @@ ,(nnheader-concat gnus-cache-directory "active")))) "List of predefined (convenience) servers.") -(defvar gnus-topic-indentation "") ;; Obsolete variable. - (defconst gnus-article-mark-lists '((marked . tick) (replied . reply) (expirable . expire) (killed . killed) @@ -2887,13 +2785,12 @@ rmail-summary-exists rmail-select-summary) ;; Only used in gnus-util, which has an autoload. ("rmailsum" rmail-update-summary) - ("gnus-audio" :interactive t gnus-audio-play) ("gnus-xmas" gnus-xmas-splash) ("score-mode" :interactive t gnus-score-mode) ("gnus-mh" gnus-summary-save-article-folder gnus-Folder-save-name gnus-folder-save-name) ("gnus-mh" :interactive t gnus-summary-save-in-folder) - ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail + ("gnus-demon" gnus-demon-add-scanmail gnus-demon-add-rescan gnus-demon-add-scan-timestamps gnus-demon-add-disconnection gnus-demon-add-handler gnus-demon-remove-handler) @@ -2904,8 +2801,6 @@ gnus-face-from-file) ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer) - ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close - gnus-nocem-unwanted-article-p) ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info gnus-server-server-name) ("gnus-srvr" gnus-browse-foreign-server) @@ -3566,7 +3461,7 @@ (nth 1 method)))) method))) -(defsubst gnus-method-to-server (method &optional nocache) +(defsubst gnus-method-to-server (method &optional nocache no-enter-cache) (catch 'server-name (setq method (or method gnus-select-method)) @@ -3592,7 +3487,9 @@ (format "%s" (car method)) (format "%s:%s" (car method) (cadr method)))) (name-method (cons name method))) - (unless (member name-method gnus-server-method-cache) + (when (and (not (member name-method gnus-server-method-cache)) + (not no-enter-cache) + (not (assoc (car name-method) gnus-server-method-cache))) (push name-method gnus-server-method-cache)) name))) @@ -3634,11 +3531,13 @@ (while alist (setq method (gnus-info-method (pop alist))) (when (and (not (stringp method)) - (equal server (gnus-method-to-server method))) + (equal server + (gnus-method-to-server method nil t))) (setq match method alist nil))) match)))) - (when result + (when (and result + (not (assoc server gnus-server-method-cache))) (push (cons server result) gnus-server-method-cache)) result))) @@ -3691,8 +3590,8 @@ (defsubst gnus-sloppily-equal-method-parameters (m1 m2) ;; Check parameters for sloppy equalness. - (let ((p1 (copy-list (cddr m1))) - (p2 (copy-list (cddr m2))) + (let ((p1 (copy-sequence (cddr m1))) + (p2 (copy-sequence (cddr m2))) e1 e2) (block nil (while (setq e1 (pop p1)) @@ -3700,7 +3599,7 @@ ;; The parameter doesn't exist in p2. (return nil)) (setq p2 (delq e2 p2)) - (unless (equalp e1 e2) + (unless (equal e1 e2) (if (not (and (stringp (cadr e1)) (stringp (cadr e2)))) (return nil) @@ -3963,9 +3862,7 @@ ;; Expand if necessary. (if (and (stringp result) (string-match "\\\\[0-9&]" result)) (setq result (gnus-expand-group-parameter (car head) - result group))) - ;; Exit the loop early. - (setq tail nil)))) + result group)))))) ;; Done. result)))) @@ -4465,11 +4362,13 @@ ;; When using the development version of Gnus, load the gnus-load ;; file. (unless (string-match "^Gnus" gnus-version) - (load "gnus-load")) + (load "gnus-load" nil t)) (unless (byte-code-function-p (symbol-function 'gnus)) (message "You should byte-compile Gnus") (sit-for 2)) - (gnus-1 arg dont-connect slave)) + (let ((gnus-action-message-log (list nil))) + (gnus-1 arg dont-connect slave) + (gnus-final-warning))) ;; Allow redefinition of Gnus functions.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/gnus/gravatar.el Mon Sep 27 14:42:43 2010 +0900 @@ -0,0 +1,123 @@ +;;; gravatar.el --- Get Gravatars + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Julien Danjou <julien@danjou.info> +;; Keywords: news + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'image) +(require 'url) +(require 'url-cache) + +(defgroup gravatar nil + "Gravatar." + :group 'comm) + +(defcustom gravatar-automatic-caching t + "Whether cache retrieved gravatar." + :group 'gravatar) + +(defcustom gravatar-cache-ttl (days-to-time 30) + "Time to live for gravatar cache entries." + :group 'gravatar) + +(defcustom gravatar-rating "g" + "Default rating for gravatar." + :group 'gravatar) + +(defcustom gravatar-size 32 + "Default size in pixels for gravatars." + :group 'gravatar) + +(defconst gravatar-base-url + "http://www.gravatar.com/avatar" + "Base URL for getting gravatars.") + +(defun gravatar-hash (mail-address) + "Create an hash from MAIL-ADDRESS." + (md5 (downcase mail-address))) + +(defun gravatar-build-url (mail-address) + "Return an URL to retrieve MAIL-ADDRESS gravatar." + (format "%s/%s?d=404&r=%s&s=%d" + gravatar-base-url + (gravatar-hash mail-address) + gravatar-rating + gravatar-size)) + +(defun gravatar-cache-expired (url) + "Check if URL is cached for more than `gravatar-cache-ttl'." + (cond (url-standalone-mode + (not (file-exists-p (url-cache-create-filename url)))) + (t (let ((cache-time (url-is-cached url))) + (if cache-time + (time-less-p + (time-add + cache-time + gravatar-cache-ttl) + (current-time)) + t))))) + +(defun gravatar-get-data () + "Get data from current buffer." + (when (string-match "^HTTP/.+ 200 OK$" + (buffer-substring (point-min) (line-end-position))) + (when (search-forward "\n\n" nil t) + (buffer-substring (point) (point-max))))) + +(defun gravatar-data->image () + "Get data of current buffer and return an image. +If no image available, return 'error." + (let ((data (gravatar-get-data))) + (if data + (create-image data nil t) + 'error))) + +;;;###autoload +(defun gravatar-retrieve (mail-address cb &optional cbargs) + "Retrieve MAIL-ADDRESS gravatar and call CB on retrieval. +You can provide a list of argument to pass to CB in CBARGS." + (let ((url (gravatar-build-url mail-address))) + (if (gravatar-cache-expired url) + (url-retrieve url + 'gravatar-retrieved + (list cb (when cbargs cbargs))) + (apply cb + (with-temp-buffer + (mm-disable-multibyte) + (url-cache-extract (url-cache-create-filename url)) + (gravatar-data->image)) + cbargs)))) + +(defun gravatar-retrieved (status cb &optional cbargs) + "Callback function used by `gravatar-retrieve'." + ;; Store gravatar? + (when gravatar-automatic-caching + (url-store-in-cache (current-buffer))) + (if (plist-get status :error) + ;; Error happened. + (apply cb 'error cbargs) + (apply cb (gravatar-data->image) cbargs))) + +(provide 'gravatar) + +;;; gravatar.el ends here
--- a/lisp/gnus/mailcap.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/mailcap.el Mon Sep 27 14:42:43 2010 +0900 @@ -423,7 +423,7 @@ "/usr/local/etc/mailcap")))) (let ((fnames (reverse (if (stringp path) - (delete "" (split-string path path-separator)) + (split-string path path-separator t) path))) fname) (while fnames @@ -941,7 +941,7 @@ "/usr/local/etc/mime-types" "/usr/local/www/conf/mime-types")))) (let ((fnames (reverse (if (stringp path) - (delete "" (split-string path path-separator)) + (split-string path path-separator t) path))) fname) (while fnames
--- a/lisp/gnus/message.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/message.el Mon Sep 27 14:42:43 2010 +0900 @@ -626,29 +626,23 @@ :type 'regexp) (defcustom message-cite-prefix-regexp - ;; Default to the value of `mail-citation-prefix-regexp' if available. - ;; Note: as for Emacs 21, XEmacs 21.4 and 21.5, it is unavailable - ;; unless sendmail.el is loaded. - (cond ((boundp 'mail-citation-prefix-regexp) - mail-citation-prefix-regexp) - ((string-match "[[:digit:]]" "1") - ;; Support POSIX? XEmacs 21.5.27 doesn't. - "\\([ \t]*[_.[:word:]]+>+\\|[ \t]*[]>|}]\\)+") - (t - ;; ?-, ?_ or ?. MUST NOT be in syntax entry w. - (let (non-word-constituents) - (with-syntax-table text-mode-syntax-table - (setq non-word-constituents - (concat - (if (string-match "\\w" "_") "" "_") - (if (string-match "\\w" ".") "" ".")))) - (if (equal non-word-constituents "") - "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}]\\)+" - (concat "\\([ \t]*\\(\\w\\|[" - non-word-constituents - "]\\)+>+\\|[ \t]*[]>|}]\\)+"))))) + (if (string-match "[[:digit:]]" "1") + ;; Support POSIX? XEmacs 21.5.27 doesn't. + "\\([ \t]*[_.[:word:]]+>+\\|[ \t]*[]>|]\\)+" + ;; ?-, ?_ or ?. MUST NOT be in syntax entry w. + (let (non-word-constituents) + (with-syntax-table text-mode-syntax-table + (setq non-word-constituents + (concat + (if (string-match "\\w" "_") "" "_") + (if (string-match "\\w" ".") "" ".")))) + (if (equal non-word-constituents "") + "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|]\\)+" + (concat "\\([ \t]*\\(\\w\\|[" + non-word-constituents + "]\\)+>+\\|[ \t]*[]>|]\\)+")))) "*Regexp matching the longest possible citation prefix on a line." - :version "23.2" + :version "24.1" :group 'message-insertion :link '(custom-manual "(message)Insertion Variables") :type 'regexp @@ -5349,8 +5343,14 @@ (defun message-output (filename) "Append this article to Unix/babyl mail file FILENAME." - (if (and (file-readable-p filename) - (mail-file-babyl-p filename)) + (if (or (and (file-readable-p filename) + (mail-file-babyl-p filename)) + ;; gnus-output-to-mail does the wrong thing with live, mbox + ;; Rmail buffers in Emacs 23. + ;; http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=597255 + (let ((buff (find-buffer-visiting filename))) + (and buff (with-current-buffer buff + (eq major-mode 'rmail-mode))))) (gnus-output-to-rmail filename t) (gnus-output-to-mail filename t)))
--- a/lisp/gnus/mm-decode.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/mm-decode.el Mon Sep 27 14:42:43 2010 +0900 @@ -1147,13 +1147,15 @@ ;; time to adjust it, since we know at this point that it should ;; be unibyte. `(let* ((handle ,handle)) - (with-temp-buffer - (mm-disable-multibyte) - (insert-buffer-substring (mm-handle-buffer handle)) - (mm-decode-content-transfer-encoding - (mm-handle-encoding handle) - (mm-handle-media-type handle)) - ,@forms))) + (when (and (mm-handle-buffer handle) + (buffer-name (mm-handle-buffer handle))) + (with-temp-buffer + (mm-disable-multibyte) + (insert-buffer-substring (mm-handle-buffer handle)) + (mm-decode-content-transfer-encoding + (mm-handle-encoding handle) + (mm-handle-media-type handle)) + ,@forms)))) (put 'mm-with-part 'lisp-indent-function 1) (put 'mm-with-part 'edebug-form-spec '(body)) @@ -1246,9 +1248,13 @@ (setq filename (gnus-map-function mm-file-name-rewrite-functions (file-name-nondirectory filename)))) (setq file - (read-file-name (or prompt "Save MIME part to: ") + (read-file-name (or prompt + (format "Save MIME part to (default %s): " + (or filename ""))) (or mm-default-directory default-directory) - nil nil (or filename ""))) + (or filename ""))) + (when (file-directory-p file) + (setq file (expand-file-name filename file))) (setq mm-default-directory (file-name-directory file)) (and (or (not (file-exists-p file)) (yes-or-no-p (format "File %s already exists; overwrite? "
--- a/lisp/gnus/mm-util.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/mm-util.el Mon Sep 27 14:42:43 2010 +0900 @@ -1539,14 +1539,13 @@ prog t (list t err-file) nil args) jka-compr-acceptable-retval-list) (erase-buffer) - (insert (mapconcat - 'identity - (delete "" (split-string - (prog2 - (insert-file-contents err-file) - (buffer-string) - (erase-buffer)))) - " ") + (insert (mapconcat 'identity + (split-string + (prog2 + (insert-file-contents err-file) + (buffer-string) + (erase-buffer)) t) + " ") "\n") (setq err-msg (format "Error while executing \"%s %s < %s\""
--- a/lisp/gnus/mml-smime.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/mml-smime.el Mon Sep 27 14:42:43 2010 +0900 @@ -53,11 +53,6 @@ mml-smime-epg-verify mml-smime-epg-verify-test))) -(defcustom mml-smime-verbose mml-secure-verbose - "If non-nil, ask the user about the current operation more verbosely." - :group 'mime-security - :type 'boolean) - (defcustom mml-smime-cache-passphrase mml-secure-cache-passphrase "If t, cache passphrase." :group 'mime-security
--- a/lisp/gnus/mml1991.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/mml1991.el Mon Sep 27 14:42:43 2010 +0900 @@ -57,17 +57,12 @@ (defvar mml1991-function-alist '((mailcrypt mml1991-mailcrypt-sign mml1991-mailcrypt-encrypt) - (gpg mml1991-gpg-sign - mml1991-gpg-encrypt) (pgg mml1991-pgg-sign mml1991-pgg-encrypt) (epg mml1991-epg-sign mml1991-epg-encrypt)) "Alist of PGP functions.") -(defvar mml1991-verbose mml-secure-verbose - "If non-nil, ask the user about the current operation more verbosely.") - (defvar mml1991-cache-passphrase mml-secure-cache-passphrase "If t, cache passphrase.") @@ -171,99 +166,6 @@ (insert-buffer-substring cipher) (goto-char (point-max)))))) -;;; gpg wrapper - -(autoload 'gpg-sign-cleartext "gpg") - -(declare-function gpg-sign-encrypt "ext:gpg" - (plaintext ciphertext result recipients &optional - passphrase sign-with-key armor textmode)) -(declare-function gpg-encrypt "ext:gpg" - (plaintext ciphertext result recipients &optional - passphrase armor textmode)) - -(defun mml1991-gpg-sign (cont) - (let ((text (current-buffer)) - headers signature - (result-buffer (get-buffer-create "*GPG Result*"))) - ;; Save MIME Content[^ ]+: headers from signing - (goto-char (point-min)) - (while (looking-at "^Content[^ ]+:") (forward-line)) - (unless (bobp) - (setq headers (buffer-string)) - (delete-region (point-min) (point))) - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (quoted-printable-decode-region (point-min) (point-max)) - (with-temp-buffer - (unless (gpg-sign-cleartext text (setq signature (current-buffer)) - result-buffer - nil - (message-options-get 'message-sender)) - (unless (> (point-max) (point-min)) - (pop-to-buffer result-buffer) - (error "Sign error"))) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (quoted-printable-encode-region (point-min) (point-max)) - (set-buffer text) - (delete-region (point-min) (point-max)) - (if headers (insert headers)) - (insert "\n") - (insert-buffer-substring signature) - (goto-char (point-max))))) - -(defun mml1991-gpg-encrypt (cont &optional sign) - (let ((text (current-buffer)) - cipher - (result-buffer (get-buffer-create "*GPG Result*"))) - ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMORED - (goto-char (point-min)) - (while (looking-at "^Content[^ ]+:") (forward-line)) - (unless (bobp) - (delete-region (point-min) (point))) - (mm-with-unibyte-current-buffer - (with-temp-buffer - (inline (mm-disable-multibyte)) - (flet ((gpg-encrypt-func - (sign plaintext ciphertext result recipients &optional - passphrase sign-with-key armor textmode) - (if sign - (gpg-sign-encrypt - plaintext ciphertext result recipients passphrase - sign-with-key armor textmode) - (gpg-encrypt - plaintext ciphertext result recipients passphrase - armor textmode)))) - (unless (gpg-encrypt-func - sign - text (setq cipher (current-buffer)) - result-buffer - (split-string - (or - (message-options-get 'message-recipients) - (message-options-set 'message-recipients - (read-string "Recipients: "))) - "[ \f\t\n\r\v,]+") - nil - (message-options-get 'message-sender) - t t) ; armor & textmode - (unless (> (point-max) (point-min)) - (pop-to-buffer result-buffer) - (error "Encrypt error")))) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (set-buffer text) - (delete-region (point-min) (point-max)) - ;;(insert "Content-Type: application/pgp-encrypted\n\n") - ;;(insert "Version: 1\n\n") - (insert "\n") - (insert-buffer-substring cipher) - (goto-char (point-max)))))) - ;; pgg wrapper (defvar pgg-default-user-id)
--- a/lisp/gnus/mml2015.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/mml2015.el Mon Sep 27 14:42:43 2010 +0900 @@ -63,11 +63,6 @@ (require 'pgg))) (and (fboundp 'pgg-sign-region) 'pgg)) - (progn - (ignore-errors - (require 'gpg)) - (and (fboundp 'gpg-sign-detached) - 'gpg)) (progn (ignore-errors (load "mc-toplev")) (and (fboundp 'mc-encrypt-generic) @@ -75,7 +70,7 @@ (fboundp 'mc-cleanup-recipient-headers) 'mailcrypt))) "The package used for PGP/MIME. -Valid packages include `epg', `pgg', `gpg' and `mailcrypt'.") +Valid packages include `epg', `pgg' and `mailcrypt'.") ;; Something is not RFC2015. (defvar mml2015-function-alist @@ -85,24 +80,18 @@ mml2015-mailcrypt-decrypt mml2015-mailcrypt-clear-verify mml2015-mailcrypt-clear-decrypt) - (gpg mml2015-gpg-sign - mml2015-gpg-encrypt - mml2015-gpg-verify - mml2015-gpg-decrypt - mml2015-gpg-clear-verify - mml2015-gpg-clear-decrypt) - (pgg mml2015-pgg-sign - mml2015-pgg-encrypt - mml2015-pgg-verify - mml2015-pgg-decrypt - mml2015-pgg-clear-verify - mml2015-pgg-clear-decrypt) - (epg mml2015-epg-sign - mml2015-epg-encrypt - mml2015-epg-verify - mml2015-epg-decrypt - mml2015-epg-clear-verify - mml2015-epg-clear-decrypt)) + (pgg mml2015-pgg-sign + mml2015-pgg-encrypt + mml2015-pgg-verify + mml2015-pgg-decrypt + mml2015-pgg-clear-verify + mml2015-pgg-clear-decrypt) + (epg mml2015-epg-sign + mml2015-epg-encrypt + mml2015-epg-verify + mml2015-epg-decrypt + mml2015-epg-clear-verify + mml2015-epg-clear-decrypt)) "Alist of PGP/MIME functions.") (defvar mml2015-result-buffer nil) @@ -119,11 +108,6 @@ :type '(repeat (cons (regexp :tag "GnuPG output regexp") (boolean :tag "Trust key")))) -(defcustom mml2015-verbose mml-secure-verbose - "If non-nil, ask the user about the current operation more verbosely." - :group 'mime-security - :type 'boolean) - (defcustom mml2015-cache-passphrase mml-secure-cache-passphrase "If t, cache passphrase." :group 'mime-security @@ -153,7 +137,7 @@ ;; Extract plaintext from cleartext signature. IMO, this kind of task ;; should be done by GnuPG rather than Elisp, but older PGP backends -;; (such as Mailcrypt, PGG, and gpg.el) discard the output from GnuPG. +;; (such as Mailcrypt, and PGG) discard the output from GnuPG. (defun mml2015-extract-cleartext-signature () ;; Daiki Ueno in ;; <54a15d860801080142l70b95d7dkac4bf51a86196011@mail.gmail.com>: ``I still @@ -193,9 +177,6 @@ (autoload 'mc-cleanup-recipient-headers "mc-toplev") (autoload 'mc-sign-generic "mc-toplev") -(defvar mc-default-scheme) -(defvar mc-schemes) - (defvar mml2015-decrypt-function 'mailcrypt-decrypt) (defvar mml2015-verify-function 'mailcrypt-verify) @@ -242,6 +223,58 @@ handles (list handles))))) +(defun mml2015-gpg-pretty-print-fpr (fingerprint) + (let* ((result "") + (fpr-length (string-width fingerprint)) + (n-slice 0) + slice) + (setq fingerprint (string-to-list fingerprint)) + (while fingerprint + (setq fpr-length (- fpr-length 4)) + (setq slice (butlast fingerprint fpr-length)) + (setq fingerprint (nthcdr 4 fingerprint)) + (setq n-slice (1+ n-slice)) + (setq result + (concat + result + (case n-slice + (1 slice) + (otherwise (concat " " slice)))))) + result)) + +(defun mml2015-gpg-extract-signature-details () + (goto-char (point-min)) + (let* ((expired (re-search-forward + "^\\[GNUPG:\\] SIGEXPIRED$" + nil t)) + (signer (and (re-search-forward + "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$" + nil t) + (cons (match-string 1) (match-string 2)))) + (fprint (and (re-search-forward + "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) " + nil t) + (match-string 1))) + (trust (and (re-search-forward + "^\\[GNUPG:\\] \\(TRUST_.*\\)$" + nil t) + (match-string 1))) + (trust-good-enough-p + (cdr (assoc trust mml2015-unabbrev-trust-alist)))) + (cond ((and signer fprint) + (concat (cdr signer) + (unless trust-good-enough-p + (concat "\nUntrusted, Fingerprint: " + (mml2015-gpg-pretty-print-fpr fprint))) + (when expired + (format "\nWARNING: Signature from expired key (%s)" + (car signer))))) + ((re-search-forward + "^\\(gpg: \\)?Good signature from \"\\(.*\\)\"$" nil t) + (match-string 2)) + (t + "From unknown user")))) + (defun mml2015-mailcrypt-clear-decrypt () (let (result) (setq result @@ -454,280 +487,6 @@ (insert (format "--%s--\n" boundary)) (goto-char (point-max)))) -;;; gpg wrapper - -(autoload 'gpg-decrypt "gpg") -(autoload 'gpg-verify "gpg") -(autoload 'gpg-verify-cleartext "gpg") -(autoload 'gpg-sign-detached "gpg") -(autoload 'gpg-sign-encrypt "gpg") -(autoload 'gpg-encrypt "gpg") -(autoload 'gpg-passphrase-read "gpg") - -(defun mml2015-gpg-passphrase () - (or (message-options-get 'gpg-passphrase) - (message-options-set 'gpg-passphrase (gpg-passphrase-read)))) - -(defun mml2015-gpg-decrypt-1 () - (let ((cipher (current-buffer)) plain result) - (if (with-temp-buffer - (prog1 - (gpg-decrypt cipher (setq plain (current-buffer)) - mml2015-result-buffer nil) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (with-current-buffer mml2015-result-buffer - (buffer-string))) - (set-buffer cipher) - (erase-buffer) - (insert-buffer-substring plain) - (goto-char (point-min)) - (while (search-forward "\r\n" nil t) - (replace-match "\n" t t)))) - '(t) - ;; Some wrong with the return value, check plain text buffer. - (if (> (point-max) (point-min)) - '(t) - nil)))) - -(defun mml2015-gpg-decrypt (handle ctl) - (let ((mml2015-decrypt-function 'mml2015-gpg-decrypt-1)) - (mml2015-mailcrypt-decrypt handle ctl))) - -(defun mml2015-gpg-clear-decrypt () - (let (result) - (setq result (mml2015-gpg-decrypt-1)) - (if (car result) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "OK") - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed")))) - -(defun mml2015-gpg-pretty-print-fpr (fingerprint) - (let* ((result "") - (fpr-length (string-width fingerprint)) - (n-slice 0) - slice) - (setq fingerprint (string-to-list fingerprint)) - (while fingerprint - (setq fpr-length (- fpr-length 4)) - (setq slice (butlast fingerprint fpr-length)) - (setq fingerprint (nthcdr 4 fingerprint)) - (setq n-slice (1+ n-slice)) - (setq result - (concat - result - (case n-slice - (1 slice) - (otherwise (concat " " slice)))))) - result)) - -(defun mml2015-gpg-extract-signature-details () - (goto-char (point-min)) - (let* ((expired (re-search-forward - "^\\[GNUPG:\\] SIGEXPIRED$" - nil t)) - (signer (and (re-search-forward - "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$" - nil t) - (cons (match-string 1) (match-string 2)))) - (fprint (and (re-search-forward - "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) " - nil t) - (match-string 1))) - (trust (and (re-search-forward - "^\\[GNUPG:\\] \\(TRUST_.*\\)$" - nil t) - (match-string 1))) - (trust-good-enough-p - (cdr (assoc trust mml2015-unabbrev-trust-alist)))) - (cond ((and signer fprint) - (concat (cdr signer) - (unless trust-good-enough-p - (concat "\nUntrusted, Fingerprint: " - (mml2015-gpg-pretty-print-fpr fprint))) - (when expired - (format "\nWARNING: Signature from expired key (%s)" - (car signer))))) - ((re-search-forward - "^\\(gpg: \\)?Good signature from \"\\(.*\\)\"$" nil t) - (match-string 2)) - (t - "From unknown user")))) - -(defun mml2015-gpg-verify (handle ctl) - (catch 'error - (let (part message signature info-is-set-p) - (unless (setq part (mm-find-raw-part-by-type - ctl (or (mm-handle-multipart-ctl-parameter - ctl 'protocol) - "application/pgp-signature") - t)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Corrupted") - (throw 'error handle)) - (with-temp-buffer - (setq message (current-buffer)) - (insert part) - ;; Convert <LF> to <CR><LF> in signed text. If --textmode is - ;; specified when signing, the conversion is not necessary. - (goto-char (point-min)) - (end-of-line) - (while (not (eobp)) - (unless (eq (char-before) ?\r) - (insert "\r")) - (forward-line) - (end-of-line)) - (with-temp-buffer - (setq signature (current-buffer)) - (unless (setq part (mm-find-part-by-type - (cdr handle) "application/pgp-signature" nil t)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Corrupted") - (throw 'error handle)) - (mm-insert-part part) - (unless (condition-case err - (prog1 - (gpg-verify message signature mml2015-result-buffer) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (with-current-buffer mml2015-result-buffer - (buffer-string)))) - (error - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details (mml2015-format-error err)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Error.") - (setq info-is-set-p t) - nil) - (quit - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details "Quit.") - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Quit.") - (setq info-is-set-p t) - nil)) - (unless info-is-set-p - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed")) - (throw 'error handle))) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info - (with-current-buffer mml2015-result-buffer - (mml2015-gpg-extract-signature-details)))) - handle))) - -(defun mml2015-gpg-clear-verify () - (if (condition-case err - (prog1 - (gpg-verify-cleartext (current-buffer) mml2015-result-buffer) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details - (with-current-buffer mml2015-result-buffer - (buffer-string)))) - (error - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details (mml2015-format-error err)) - nil) - (quit - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-details "Quit.") - nil)) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info - (with-current-buffer mml2015-result-buffer - (mml2015-gpg-extract-signature-details))) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed")) - (mml2015-extract-cleartext-signature)) - -(defun mml2015-gpg-sign (cont) - (let ((boundary (mml-compute-boundary cont)) - (text (current-buffer)) signature) - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (with-temp-buffer - (unless (gpg-sign-detached text (setq signature (current-buffer)) - mml2015-result-buffer - nil - (message-options-get 'message-sender) - t t) ; armor & textmode - (unless (> (point-max) (point-min)) - (pop-to-buffer mml2015-result-buffer) - (error "Sign error"))) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (set-buffer text) - (goto-char (point-min)) - (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n" - boundary)) - ;;; FIXME: what is the micalg? - (insert "\tmicalg=pgp-sha1; protocol=\"application/pgp-signature\"\n") - (insert (format "\n--%s\n" boundary)) - (goto-char (point-max)) - (insert (format "\n--%s\n" boundary)) - (insert "Content-Type: application/pgp-signature\n\n") - (insert-buffer-substring signature) - (goto-char (point-max)) - (insert (format "--%s--\n" boundary)) - (goto-char (point-max))))) - -(defun mml2015-gpg-encrypt (cont &optional sign) - (let ((boundary (mml-compute-boundary cont)) - (text (current-buffer)) - cipher) - (mm-with-unibyte-current-buffer - (with-temp-buffer - (mm-disable-multibyte) - ;; set up a function to call the correct gpg encrypt routine - ;; with the right arguments. (FIXME: this should be done - ;; differently.) - (flet ((gpg-encrypt-func - (sign plaintext ciphertext result recipients &optional - passphrase sign-with-key armor textmode) - (if sign - (gpg-sign-encrypt - plaintext ciphertext result recipients passphrase - sign-with-key armor textmode) - (gpg-encrypt - plaintext ciphertext result recipients passphrase - armor textmode)))) - (unless (gpg-encrypt-func - sign ; passed in when using signencrypt - text (setq cipher (current-buffer)) - mml2015-result-buffer - (split-string - (or - (message-options-get 'message-recipients) - (message-options-set 'message-recipients - (read-string "Recipients: "))) - "[ \f\t\n\r\v,]+") - nil - (message-options-get 'message-sender) - t t) ; armor & textmode - (unless (> (point-max) (point-min)) - (pop-to-buffer mml2015-result-buffer) - (error "Encrypt error")))) - (goto-char (point-min)) - (while (re-search-forward "\r+$" nil t) - (replace-match "" t t)) - (set-buffer text) - (delete-region (point-min) (point-max)) - (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n" - boundary)) - (insert "\tprotocol=\"application/pgp-encrypted\"\n\n") - (insert (format "--%s\n" boundary)) - (insert "Content-Type: application/pgp-encrypted\n\n") - (insert "Version: 1\n\n") - (insert (format "--%s\n" boundary)) - (insert "Content-Type: application/octet-stream\n\n") - (insert-buffer-substring cipher) - (goto-char (point-max)) - (insert (format "--%s--\n" boundary)) - (goto-char (point-max)))))) - ;;; pgg wrapper (defvar pgg-default-user-id)
--- a/lisp/gnus/nndoc.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/nndoc.el Mon Sep 27 14:42:43 2010 +0900 @@ -64,9 +64,6 @@ (body-end . "") (file-end . "") (subtype digest guess)) - (mime-parts - (generate-head-function . nndoc-generate-mime-parts-head) - (article-transform-function . nndoc-transform-mime-parts)) (nsmail (article-begin . "^From - ")) (news @@ -77,6 +74,9 @@ (mbox (article-begin-function . nndoc-mbox-article-begin) (body-end-function . nndoc-mbox-body-end)) + (mime-parts + (generate-head-function . nndoc-generate-mime-parts-head) + (article-transform-function . nndoc-transform-mime-parts)) (babyl (article-begin . "\^_\^L *\n") (body-end . "\^_") @@ -298,7 +298,7 @@ t) (deffoo nndoc-request-list (&optional server) - nil) + t) (deffoo nndoc-request-newgroups (date &optional server) nil)
--- a/lisp/gnus/nndraft.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/nndraft.el Mon Sep 27 14:42:43 2010 +0900 @@ -79,7 +79,7 @@ (nndraft-possibly-change-group group) (with-current-buffer nntp-server-buffer (erase-buffer) - (let* (article) + (let (article lines chars) ;; We don't support fetching by Message-ID. (if (stringp (car articles)) 'headers @@ -91,9 +91,12 @@ (if (search-forward "\n\n" nil t) (forward-line -1) (goto-char (point-max))) + (setq lines (count-lines (point) (point-max)) + chars (- (point-max) (point))) (delete-region (point) (point-max)) (goto-char (point-min)) (insert (format "221 %d Article retrieved.\n" article)) + (insert (format "Lines: %d\nChars: %d\n" lines chars)) (widen) (goto-char (point-max)) (insert ".\n"))) @@ -219,6 +222,11 @@ (deffoo nndraft-request-expire-articles (articles group &optional server force) (nndraft-possibly-change-group group) (let* ((nnmh-allow-delete-final t) + (nnmail-expiry-target + (or (gnus-group-find-parameter + (gnus-group-prefixed-name "nndraft" (list 'nndraft server)) + 'expiry-target t) + nnmail-expiry-target)) (res (nnoo-parent-function 'nndraft 'nnmh-request-expire-articles (list articles group server force)))
--- a/lisp/gnus/nnfolder.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/nnfolder.el Mon Sep 27 14:42:43 2010 +0900 @@ -1202,7 +1202,7 @@ (nnfolder-save-marks group server)) nil) -(deffoo nnfolder-request-update-info (group info &optional server) +(deffoo nnfolder-request-marks (group info &optional server) ;; Change servers. (when (and server (not (nnfolder-server-opened server)))
--- a/lisp/gnus/nnheader.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/nnheader.el Mon Sep 27 14:42:43 2010 +0900 @@ -570,8 +570,6 @@ (defvar nntp-server-buffer nil) (defvar nntp-process-response nil) -(defvar news-reply-yank-from nil) -(defvar news-reply-yank-message-id nil) (defvar nnheader-callback-function nil) @@ -824,12 +822,16 @@ (apply 'format args))) nil) -(defun nnheader-get-report (backend) +(defun nnheader-get-report-string (backend) "Get the most recent report from BACKEND." (condition-case () - (nnheader-message 5 "%s" (symbol-value (intern (format "%s-status-string" - backend)))) - (error (nnheader-message 5 "")))) + (format "%s" (symbol-value (intern (format "%s-status-string" + backend)))) + (error ""))) + +(defun nnheader-get-report (backend) + "Get the most recent report from BACKEND." + (nnheader-message 5 (nnheader-get-report-string backend))) (defun nnheader-insert (format &rest args) "Clear the communication buffer and insert FORMAT and ARGS into the buffer.
--- a/lisp/gnus/nnimap.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/nnimap.el Mon Sep 27 14:42:43 2010 +0900 @@ -51,7 +51,7 @@ (defvoo nnimap-stream 'ssl "How nnimap will talk to the IMAP server. -Values are `ssl' and `network'.") +Values are `ssl', `network', `starttls' or `shell'.") (defvoo nnimap-shell-program (if (boundp 'imap-shell-program) (if (listp imap-shell-program) @@ -62,23 +62,23 @@ (defvoo nnimap-inbox nil "The mail box where incoming mail arrives and should be split out of.") -(defvoo nnimap-expunge-inbox nil - "If non-nil, expunge the inbox after fetching mail. -This is always done if the server supports UID EXPUNGE, but it's -not done by default on servers that doesn't support that command.") +(defvoo nnimap-split-methods nil + "How mail is split. +Uses the same syntax as nnmail-split-methods") (defvoo nnimap-authenticator nil "How nnimap authenticate itself to the server. Possible choices are nil (use default methods) or `anonymous'.") -(defvoo nnimap-fetch-partial-articles nil - "If non-nil, nnimap will fetch partial articles. -If t, nnimap will fetch only the first part. If a string, it -will fetch all parts that have types that match that string. A -likely value would be \"text/\" to automatically fetch all -textual parts.") +(defvoo nnimap-expunge t + "If non-nil, expunge articles after deleting them. +This is always done if the server supports UID EXPUNGE, but it's +not done by default on servers that doesn't support that command.") -(defvoo nnimap-expunge nil) +(defvoo nnimap-streaming t + "If non-nil, try to use streaming commands with IMAP servers. +Switching this off will make nnimap slower, but it helps with +some servers.") (defvoo nnimap-connection-alist nil) @@ -91,15 +91,19 @@ (defvar nnimap-split-download-body-default nil "Internal variable with default value for `nnimap-split-download-body'.") +(defvar nnimap-keepalive-timer nil) +(defvar nnimap-process-buffers nil) + (defstruct nnimap - group process commands capabilities select-result newlinep) + group process commands capabilities select-result newlinep server + last-command-time greeting) (defvar nnimap-object nil) (defvar nnimap-mark-alist - '((read "\\Seen") - (tick "\\Flagged") - (reply "\\Answered") + '((read "\\Seen" %Seen) + (tick "\\Flagged" %Flagged) + (reply "\\Answered" %Answered) (expire "gnus-expire") (dormant "gnus-dormant") (score "gnus-score") @@ -107,8 +111,6 @@ (download "gnus-download") (forward "gnus-forward"))) -(defvar nnimap-split-methods nil) - (defun nnimap-buffer () (nnimap-find-process-buffer nntp-server-buffer)) @@ -117,7 +119,6 @@ (erase-buffer) (when (nnimap-possibly-change-group group server) (with-current-buffer (nnimap-buffer) - (nnimap-send-command "SELECT %S" (utf7-encode group t)) (erase-buffer) (nnimap-wait-for-response (nnimap-send-command @@ -125,8 +126,7 @@ (nnimap-article-ranges (gnus-compress-sequence articles)) (format "(UID RFC822.SIZE BODYSTRUCTURE %s)" (format - (if (member "IMAP4REV1" - (nnimap-capabilities nnimap-object)) + (if (nnimap-ver4-p) "BODY.PEEK[HEADER.FIELDS %s]" "RFC822.HEADER.LINES %s") (append '(Subject From Date Message-Id @@ -136,19 +136,26 @@ (nnimap-transform-headers)) (insert-buffer-substring (nnimap-find-process-buffer (current-buffer)))) - t)) + 'headers)) (defun nnimap-transform-headers () (goto-char (point-min)) - (let (article bytes lines size) + (let (article bytes lines size string) (block nil (while (not (eobp)) (while (not (looking-at "^\\* [0-9]+ FETCH.*UID \\([0-9]+\\)")) (delete-region (point) (progn (forward-line 1) (point))) (when (eobp) (return))) - (setq article (match-string 1) - bytes (nnimap-get-length) + (setq article (match-string 1)) + ;; Unfold quoted {number} strings. + (while (re-search-forward "[^]] {\\([0-9]+\\)}\r\n" + (1+ (line-end-position)) t) + (setq size (string-to-number (match-string 1))) + (delete-region (+ (match-beginning 0) 2) (point)) + (setq string (delete-region (point) (+ (point) size))) + (insert (format "%S" string))) + (setq bytes (nnimap-get-length) lines nil) (beginning-of-line) (setq size @@ -158,7 +165,8 @@ (match-string 1))) (beginning-of-line) (when (search-forward "BODYSTRUCTURE" (line-end-position) t) - (let ((structure (ignore-errors (read (current-buffer))))) + (let ((structure (ignore-errors + (read (current-buffer))))) (while (and (consp structure) (not (stringp (car structure)))) (setq structure (car structure))) @@ -213,8 +221,10 @@ (buffer-disable-undo) (gnus-add-buffer) (set (make-local-variable 'after-change-functions) nil) - (set (make-local-variable 'nnimap-object) (make-nnimap)) + (set (make-local-variable 'nnimap-object) + (make-nnimap :server (nnoo-current-server 'nnimap))) (push (list buffer (current-buffer)) nnimap-connection-alist) + (push (current-buffer) nnimap-process-buffers) (current-buffer))) (defun nnimap-open-shell-stream (name buffer host port) @@ -227,7 +237,7 @@ ?s host ?p port))))) -(defun nnimap-credentials (address ports) +(defun nnimap-credentials (address ports &optional inhibit-create) (let (port credentials) ;; Request the credentials from all ports, but only query on the ;; last port if all the previous ones have failed. @@ -235,54 +245,99 @@ (setq port (pop ports))) (setq credentials (auth-source-user-or-password - '("login" "password") address port nil (null ports)))) + '("login" "password") address port nil + (if inhibit-create + nil + (null ports))))) credentials)) +(defun nnimap-keepalive () + (let ((now (current-time))) + (dolist (buffer nnimap-process-buffers) + (when (buffer-name buffer) + (with-current-buffer buffer + (when (and nnimap-object + (nnimap-last-command-time nnimap-object) + (> (time-to-seconds + (time-subtract + now + (nnimap-last-command-time nnimap-object))) + ;; More than five minutes since the last command. + (* 5 60))) + (nnimap-send-command "NOOP"))))))) + (defun nnimap-open-connection (buffer) + (unless nnimap-keepalive-timer + (setq nnimap-keepalive-timer (run-at-time (* 60 15) (* 60 15) + 'nnimap-keepalive))) (with-current-buffer (nnimap-make-process-buffer buffer) (let* ((coding-system-for-read 'binary) (coding-system-for-write 'binary) + (port nil) (ports (cond ((eq nnimap-stream 'network) (open-network-stream "*nnimap*" (current-buffer) nnimap-address - (or nnimap-server-port - (if (netrc-find-service-number "imap") - "imap" - "143"))) + (setq port + (or nnimap-server-port + (if (netrc-find-service-number "imap") + "imap" + "143")))) '("143" "imap")) ((eq nnimap-stream 'shell) (nnimap-open-shell-stream "*nnimap*" (current-buffer) nnimap-address - (or nnimap-server-port "imap")) + (setq port (or nnimap-server-port "imap"))) + '("imap")) + ((eq nnimap-stream 'starttls) + (starttls-open-stream + "*nnimap*" (current-buffer) nnimap-address + (setq port (or nnimap-server-port "imap"))) '("imap")) ((eq nnimap-stream 'ssl) (open-tls-stream "*nnimap*" (current-buffer) nnimap-address - (or nnimap-server-port - (if (netrc-find-service-number "imaps") - "imaps" - "993"))) + (setq port + (or nnimap-server-port + (if (netrc-find-service-number "imaps") + "imaps" + "993")))) '("143" "993" "imap" "imaps")))) connection-result login-result credentials) (setf (nnimap-process nnimap-object) (get-buffer-process (current-buffer))) - (when (and (nnimap-process nnimap-object) - (memq (process-status (nnimap-process nnimap-object)) - '(open run))) + (if (not (and (nnimap-process nnimap-object) + (memq (process-status (nnimap-process nnimap-object)) + '(open run)))) + (nnheader-report 'nnimap "Unable to contact %s:%s via %s" + nnimap-address port nnimap-stream) (gnus-set-process-query-on-exit-flag (nnimap-process nnimap-object) nil) - (when (setq connection-result (nnimap-wait-for-connection)) + (if (not (setq connection-result (nnimap-wait-for-connection))) + (nnheader-report 'nnimap + "%s" (buffer-substring + (point) (line-end-position))) + (setf (nnimap-greeting nnimap-object) + (buffer-substring (line-beginning-position) + (line-end-position))) + (when (eq nnimap-stream 'starttls) + (nnimap-command "STARTTLS") + (starttls-negotiate (nnimap-process nnimap-object))) + (when nnimap-server-port + (push (format "%s" nnimap-server-port) ports)) (unless (equal connection-result "PREAUTH") (if (not (setq credentials (if (eq nnimap-authenticator 'anonymous) (list "anonymous" (message-make-address)) - (nnimap-credentials - nnimap-address - (if nnimap-server-port - (cons (format "%s" nnimap-server-port) ports) - ports))))) + (or + ;; First look for the credentials based + ;; on the virtual server name. + (nnimap-credentials + (nnoo-current-server 'nnimap) ports t) + ;; Then look them up based on the + ;; physical address. + (nnimap-credentials nnimap-address ports))))) (setq nnimap-object nil) (setq login-result (nnimap-command "LOGIN %S %S" (car credentials) @@ -331,7 +386,7 @@ (deffoo nnimap-request-article (article &optional group server to-buffer) (with-current-buffer nntp-server-buffer (let ((result (nnimap-possibly-change-group group server)) - parts) + parts structure) (when (stringp article) (setq article (nnimap-find-article-by-message-id group article))) (when (and result @@ -339,36 +394,116 @@ (erase-buffer) (with-current-buffer (nnimap-buffer) (erase-buffer) - (when nnimap-fetch-partial-articles - (if (eq nnimap-fetch-partial-articles t) + (when gnus-fetch-partial-articles + (if (eq gnus-fetch-partial-articles t) (setq parts '(1)) (nnimap-command "UID FETCH %d (BODYSTRUCTURE)" article) (goto-char (point-min)) (when (re-search-forward "FETCH.*BODYSTRUCTURE" nil t) - (let ((structure (ignore-errors (read (current-buffer))))) - (setq parts (nnimap-find-wanted-parts structure)))))) - (setq result - (nnimap-command - (if (member "IMAP4REV1" (nnimap-capabilities nnimap-object)) - "UID FETCH %d BODY.PEEK[]" - "UID FETCH %d RFC822.PEEK") - article)) - ;; Check that we really got an article. - (goto-char (point-min)) - (unless (looking-at "\\* [0-9]+ FETCH") - (setq result nil))) - (let ((buffer (nnimap-find-process-buffer (current-buffer)))) - (when (car result) - (with-current-buffer (or to-buffer nntp-server-buffer) - (insert-buffer-substring buffer) - (goto-char (point-min)) - (let ((bytes (nnimap-get-length))) - (delete-region (line-beginning-position) - (progn (forward-line 1) (point))) - (goto-char (+ (point) bytes)) - (delete-region (point) (point-max)) - (nnheader-ms-strip-cr)) - (cons group article)))))))) + (setq structure (ignore-errors (read (current-buffer))) + parts (nnimap-find-wanted-parts structure))))) + (when (if parts + (nnimap-get-partial-article article parts structure) + (nnimap-get-whole-article article)) + (let ((buffer (current-buffer))) + (with-current-buffer (or to-buffer nntp-server-buffer) + (erase-buffer) + (insert-buffer-substring buffer) + (nnheader-ms-strip-cr) + (cons group article))))))))) + +(defun nnimap-get-whole-article (article) + (let ((result + (nnimap-command + (if (nnimap-ver4-p) + "UID FETCH %d BODY.PEEK[]" + "UID FETCH %d RFC822.PEEK") + article))) + ;; Check that we really got an article. + (goto-char (point-min)) + (unless (re-search-forward "\\* [0-9]+ FETCH" nil t) + (setq result nil)) + (when result + ;; Remove any data that may have arrived before the FETCH data. + (beginning-of-line) + (unless (bobp) + (delete-region (point-min) (point))) + (let ((bytes (nnimap-get-length))) + (delete-region (line-beginning-position) + (progn (forward-line 1) (point))) + (goto-char (+ (point) bytes)) + (delete-region (point) (point-max))) + t))) + +(defun nnimap-ver4-p () + (member "IMAP4REV1" (nnimap-capabilities nnimap-object))) + +(defun nnimap-get-partial-article (article parts structure) + (let ((result + (nnimap-command + "UID FETCH %d (%s %s)" + article + (if (nnimap-ver4-p) + "BODY.PEEK[HEADER]" + "RFC822.HEADER") + (if (nnimap-ver4-p) + (mapconcat (lambda (part) + (format "BODY.PEEK[%s]" part)) + parts " ") + (mapconcat (lambda (part) + (format "RFC822.PEEK[%s]" part)) + parts " "))))) + (when result + (nnimap-convert-partial-article structure)))) + +(defun nnimap-convert-partial-article (structure) + ;; First just skip past the headers. + (goto-char (point-min)) + (let ((bytes (nnimap-get-length)) + id parts) + ;; Delete "FETCH" line. + (delete-region (line-beginning-position) + (progn (forward-line 1) (point))) + (goto-char (+ (point) bytes)) + ;; Collect all the body parts. + (while (looking-at ".*BODY\\[\\([.0-9]+\\)\\]") + (setq id (match-string 1) + bytes (nnimap-get-length)) + (beginning-of-line) + (delete-region (point) (progn (forward-line 1) (point))) + (push (list id (buffer-substring (point) (+ (point) bytes))) + parts) + (delete-region (point) (+ (point) bytes))) + ;; Delete trailing junk. + (delete-region (point) (point-max)) + ;; Now insert all the parts again where they fit in the structure. + (nnimap-insert-partial-structure structure parts) + t)) + +(defun nnimap-insert-partial-structure (structure parts &optional subp) + (let ((type (car (last structure 4))) + (boundary (cadr (member "BOUNDARY" (car (last structure 3)))))) + (when subp + (insert (format "Content-type: multipart/%s; boundary=%S\n\n" + (downcase type) boundary))) + (while (not (stringp (car structure))) + (insert "\n--" boundary "\n") + (if (consp (caar structure)) + (nnimap-insert-partial-structure (pop structure) parts t) + (let ((bit (pop structure))) + (insert (format "Content-type: %s/%s" + (downcase (nth 0 bit)) + (downcase (nth 1 bit)))) + (if (member "CHARSET" (nth 2 bit)) + (insert (format + "; charset=%S\n" (cadr (member "CHARSET" (nth 2 bit))))) + (insert "\n")) + (insert (format "Content-transfer-encoding: %s\n" + (nth 5 bit))) + (insert "\n") + (when (assoc (nth 9 bit) parts) + (insert (cadr (assoc (nth 9 bit) parts))))))) + (insert "\n--" boundary "--\n"))) (defun nnimap-find-wanted-parts (structure) (message-flatten-list (nnimap-find-wanted-parts-1 structure ""))) @@ -384,13 +519,14 @@ (number-to-string num) (format "%s.%s" prefix num))) parts) - (let ((type (format "%s/%s" (nth 0 sub) (nth 1 sub)))) - (when (string-match nnimap-fetch-partial-articles type) - (push (if (string= prefix "") + (let ((type (format "%s/%s" (nth 0 sub) (nth 1 sub))) + (id (if (string= prefix "") (number-to-string num) - (format "%s.%s" prefix num)) - parts))) - (incf num)))) + (format "%s.%s" prefix num)))) + (setcar (nthcdr 9 sub) id) + (when (string-match gnus-fetch-partial-articles type) + (push id parts)))) + (incf num))) (nreverse parts))) (deffoo nnimap-request-group (group &optional server dont-check info) @@ -419,13 +555,11 @@ (when info (nnimap-update-infos marks (list info))) (goto-char (point-max)) - (cond - (marks - (setq high (nth 3 (car marks)) - low (nth 4 (car marks)))) - ((re-search-backward "UIDNEXT \\([0-9]+\\)" nil t) - (setq high (1- (string-to-number (match-string 1))) - low 1))))) + (let ((uidnext (nth 5 (car marks)))) + (setq high (if uidnext + (1- uidnext) + (nth 3 (car marks))) + low (or (nth 4 (car marks)) uidnext))))) (erase-buffer) (insert (format @@ -497,12 +631,13 @@ articles) ((and force (eq nnmail-expiry-target 'delete)) - (unless (nnimap-delete-article articles) + (unless (nnimap-delete-article (gnus-compress-sequence articles)) (message "Article marked for deletion, but not expunged.")) nil) (t (let ((deletable-articles - (if force + (if (or force + (eq nnmail-expiry-wait 'immediate)) articles (gnus-sorted-intersection articles @@ -510,7 +645,7 @@ (if (null deletable-articles) articles (if (eq nnmail-expiry-target 'delete) - (nnimap-delete-article deletable-articles) + (nnimap-delete-article (gnus-compress-sequence deletable-articles)) (setq deletable-articles (nnimap-process-expiry-targets deletable-articles group server))) @@ -537,7 +672,7 @@ ;; Change back to the current group again. (nnimap-possibly-change-group group server) (setq deleted-articles (nreverse deleted-articles)) - (nnimap-delete-article deleted-articles) + (nnimap-delete-article (gnus-compress-sequence deleted-articles)) deleted-articles)) (defun nnimap-find-expired-articles (group) @@ -580,13 +715,16 @@ t) (nnimap-expunge (nnimap-command "EXPUNGE") - t)))) + t) + (t (gnus-message 7 (concat "nnimap: nnimap-expunge is not set and the " + "server doesn't support UIDPLUS, so we won't " + "delete this article now")))))) (deffoo nnimap-request-scan (&optional group server) (when (and (nnimap-possibly-change-group nil server) - (equal group nnimap-inbox) nnimap-inbox nnimap-split-methods) + (message "nnimap %s splitting mail..." server) (nnimap-split-incoming-mail))) (defun nnimap-marks-to-flags (marks) @@ -664,6 +802,7 @@ sequences responses) (when groups (with-current-buffer (nnimap-buffer) + (setf (nnimap-group nnimap-object) nil) (dolist (group groups) (push (list (nnimap-send-command "EXAMINE %S" (utf7-encode group t)) group) @@ -713,6 +852,7 @@ groups)) ;; Then request the data. (erase-buffer) + (setf (nnimap-group nnimap-object) nil) (dolist (elem groups) (if (and qresyncp (nth 2 elem)) @@ -734,7 +874,12 @@ (nnimap-send-command "UID FETCH %d:* FLAGS" start) start (car elem)) - sequences)))) + sequences))) + ;; Some servers apparently can't have many outstanding + ;; commands, so throttle them. + (when (and (not nnimap-streaming) + (car sequences)) + (nnimap-wait-for-response (caar sequences)))) sequences)))) (deffoo nnimap-finish-retrieve-group-infos (server infos sequences) @@ -742,26 +887,26 @@ (nnimap-possibly-change-group nil server)) (with-current-buffer (nnimap-buffer) ;; Wait for the final data to trickle in. - (nnimap-wait-for-response (cadar sequences)) - ;; Now we should have all the data we need, no matter whether - ;; we're QRESYNCING, fetching all the flags from scratch, or - ;; just fetching the last 100 flags per group. - (nnimap-update-infos (nnimap-flags-to-marks - (nnimap-parse-flags - (nreverse sequences))) - infos) - ;; Finally, just return something resembling an active file in - ;; the nntp buffer, so that the agent can save the info, too. - (with-current-buffer nntp-server-buffer - (erase-buffer) - (dolist (info infos) - (let* ((group (gnus-info-group info)) - (active (gnus-active group))) - (when active - (insert (format "%S %d %d y\n" - (gnus-group-real-name group) - (cdr active) - (car active)))))))))) + (when (nnimap-wait-for-response (cadar sequences)) + ;; Now we should have all the data we need, no matter whether + ;; we're QRESYNCING, fetching all the flags from scratch, or + ;; just fetching the last 100 flags per group. + (nnimap-update-infos (nnimap-flags-to-marks + (nnimap-parse-flags + (nreverse sequences))) + infos) + ;; Finally, just return something resembling an active file in + ;; the nntp buffer, so that the agent can save the info, too. + (with-current-buffer nntp-server-buffer + (erase-buffer) + (dolist (info infos) + (let* ((group (gnus-info-group info)) + (active (gnus-active group))) + (when active + (insert (format "%S %d %d y\n" + (gnus-group-real-name group) + (cdr active) + (car active))))))))))) (defun nnimap-update-infos (flags infos) (dolist (info infos) @@ -770,27 +915,40 @@ (defun nnimap-update-info (info marks) (when marks - (destructuring-bind (existing flags high low uidnext start-article) marks + (destructuring-bind (existing flags high low uidnext start-article + permanent-flags) marks (let ((group (gnus-info-group info)) (completep (and start-article (= start-article 1)))) + (when uidnext + (setq high (1- uidnext))) ;; First set the active ranges based on high/low. (if (or completep (not (gnus-active group))) (gnus-set-active group - (if high - (cons low high) + (cond + ((and low high) + (cons low high)) + (uidnext ;; No articles in this group. - (cons (1- uidnext) uidnext))) - (setcdr (gnus-active group) high)) + (cons uidnext (1- uidnext))) + (start-article + (cons start-article (1- start-article))) + (t + ;; No articles and no uidnext. + nil))) + (setcdr (gnus-active group) (or high (1- uidnext)))) + (when (and (not high) + uidnext) + (setq high (1- uidnext))) ;; Then update the list of read articles. (let* ((unread (gnus-compress-sequence (gnus-set-difference (gnus-set-difference existing - (cdr (assoc "\\Seen" flags))) - (cdr (assoc "\\Flagged" flags))))) + (cdr (assoc '%Seen flags))) + (cdr (assoc '%Flagged flags))))) (read (gnus-range-difference (cons start-article high) unread))) (when (> start-article 1) @@ -812,8 +970,11 @@ (push (cons 'active (gnus-active group)) marks))) (dolist (type (cdr nnimap-mark-alist)) (let ((old-marks (assoc (car type) marks)) - (new-marks (gnus-compress-sequence - (cdr (assoc (cadr type) flags))))) + (new-marks + (gnus-compress-sequence + (cdr (or (assoc (caddr type) flags) ; %Flagged + (assoc (intern (cadr type) obarray) flags) + (assoc (cadr type) flags)))))) ; "\Flagged" (setq marks (delq old-marks marks)) (pop old-marks) (when (and old-marks @@ -835,12 +996,13 @@ (push (list group info active) nnimap-current-infos)))) (defun nnimap-flags-to-marks (groups) - (let (data group totalp uidnext articles start-article mark) + (let (data group totalp uidnext articles start-article mark permanent-flags) (dolist (elem groups) (setq group (car elem) - uidnext (cadr elem) - start-article (caddr elem) - articles (cdddr elem)) + uidnext (nth 1 elem) + start-article (nth 2 elem) + permanent-flags (nth 3 elem) + articles (nthcdr 4 elem)) (let ((high (caar articles)) marks low existing) (dolist (article articles) @@ -850,36 +1012,49 @@ (setq mark (assoc flag marks)) (if (not mark) (push (list flag (car article)) marks) - (setcdr mark (cons (car article) (cdr mark))))) - (push (list group existing marks high low uidnext start-article) - data)))) + (setcdr mark (cons (car article) (cdr mark)))))) + (push (list group existing marks high low uidnext start-article + permanent-flags) + data))) data)) (defun nnimap-parse-flags (sequences) (goto-char (point-min)) - (let (start end articles groups uidnext elems) + ;; Change \Delete etc to %Delete, so that the reader can read it. + (subst-char-in-region (point-min) (point-max) + ?\\ ?% t) + (let (start end articles groups uidnext elems permanent-flags) (dolist (elem sequences) (destructuring-bind (group-sequence flag-sequence totalp group) elem + (setq start (point)) ;; The EXAMINE was successful. (when (and (search-forward (format "\n%d OK " group-sequence) nil t) (progn (forward-line 1) - (setq start (point)) - (if (re-search-backward "UIDNEXT \\([0-9]+\\)" - (or end (point-min)) t) - (setq uidnext (string-to-number (match-string 1))) - (setq uidnext nil)) - (goto-char start)) + (setq end (point)) + (goto-char start) + (setq permanent-flags + (and (search-forward "PERMANENTFLAGS " + (or end (point-min)) t) + (read (current-buffer)))) + (goto-char start) + (setq uidnext + (and (search-forward "UIDNEXT " + (or end (point-min)) t) + (read (current-buffer)))) + (goto-char end) + (forward-line -1)) ;; The UID FETCH FLAGS was successful. (search-forward (format "\n%d OK " flag-sequence) nil t)) - (setq end (point)) - (goto-char start) - (while (re-search-forward "^\\* [0-9]+ FETCH (\\(.*\\))" end t) - (setq elems (nnimap-parse-line (match-string 1))) - (push (cons (string-to-number (cadr (member "UID" elems))) - (cadr (member "FLAGS" elems))) + (setq start (point)) + (goto-char end) + (while (search-forward " FETCH " start t) + (setq elems (read (current-buffer))) + (push (cons (cadr (memq 'UID elems)) + (cadr (memq 'FLAGS elems))) articles)) - (push (nconc (list group uidnext totalp) articles) groups) + (push (nconc (list group uidnext totalp permanent-flags) articles) + groups) (setq articles nil)))) groups)) @@ -944,6 +1119,7 @@ (defun nnimap-command (&rest args) (erase-buffer) + (setf (nnimap-last-command-time nnimap-object) (current-time)) (let* ((sequence (apply #'nnimap-send-command args)) (response (nnimap-get-response sequence))) (if (equal (caar response) "OK") @@ -971,17 +1147,22 @@ (match-string 1)))) (defun nnimap-wait-for-response (sequence &optional messagep) - (let ((process (get-buffer-process (current-buffer)))) + (let ((process (get-buffer-process (current-buffer))) + openp) (goto-char (point-max)) - (while (and (memq (process-status process) - '(open run)) - (not (re-search-backward (format "^%d .*\n" sequence) - (max (point-min) (- (point) 500)) - t))) + (while (and (setq openp (memq (process-status process) + '(open run))) + (not (re-search-backward + (format "^%d .*\n" sequence) + (if nnimap-streaming + (max (point-min) (- (point) 500)) + (point-min)) + t))) (when messagep (message "Read %dKB" (/ (buffer-size) 1000))) (nnheader-accept-process-output process) - (goto-char (point-max))))) + (goto-char (point-max))) + openp)) (defun nnimap-parse-response () (let ((lines (split-string (nnimap-last-response-string) "\r\n" t)) @@ -1055,8 +1236,7 @@ (nnimap-article-ranges articles) (format "(UID %s%s)" (format - (if (member "IMAP4REV1" - (nnimap-capabilities nnimap-object)) + (if (nnimap-ver4-p) "BODY.PEEK[HEADER] BODY.PEEK" "RFC822.PEEK")) (if nnimap-split-download-body-default @@ -1082,32 +1262,38 @@ (nnmail-split-incoming (current-buffer) #'nnimap-save-mail-spec nil nil - #'nnimap-dummy-active-number) + #'nnimap-dummy-active-number + #'nnimap-save-mail-spec) (when nnimap-incoming-split-list (let ((specs (nnimap-make-split-specs nnimap-incoming-split-list)) - sequences) + sequences junk-articles) ;; Create any groups that doesn't already exist on the ;; server first. (dolist (spec specs) - (unless (member (car spec) groups) + (when (and (not (member (car spec) groups)) + (not (eq (car spec) 'junk))) (nnimap-command "CREATE %S" (utf7-encode (car spec) t)))) ;; Then copy over all the messages. (erase-buffer) (dolist (spec specs) (let ((group (car spec)) (ranges (cdr spec))) - (push (list (nnimap-send-command "UID COPY %s %S" - (nnimap-article-ranges ranges) - (utf7-encode group t)) - ranges) - sequences))) + (if (eq group 'junk) + (setq junk-articles ranges) + (push (list (nnimap-send-command + "UID COPY %s %S" + (nnimap-article-ranges ranges) + (utf7-encode group t)) + ranges) + sequences)))) ;; Wait for the last COPY response... (when sequences (nnimap-wait-for-response (caar sequences)) ;; And then mark the successful copy actions as deleted, ;; and possibly expunge them. (nnimap-mark-and-expunge-incoming - (nnimap-parse-copied-articles sequences))))))))) + (nnimap-parse-copied-articles sequences))) + (nnimap-mark-and-expunge-incoming junk-articles))))))) (defun nnimap-mark-and-expunge-incoming (range) (when range @@ -1122,7 +1308,7 @@ (setq sequence (nnimap-send-command "UID EXPUNGE %s" range))) ;; If it doesn't support UID EXPUNGE, then we only expunge if the ;; user has configured it. - (nnimap-expunge-inbox + (nnimap-expunge (setq sequence (nnimap-send-command "EXPUNGE")))) (nnimap-wait-for-response sequence)))) @@ -1139,8 +1325,8 @@ (let (new) (dolist (elem flags) (when (or (null (cdr elem)) - (and (not (member "\\Deleted" (cdr elem))) - (not (member "\\Seen" (cdr elem))))) + (and (not (memq '%Deleted (cdr elem))) + (not (memq '%Seen (cdr elem))))) (push (car elem) new))) (gnus-compress-sequence (nreverse new)))) @@ -1187,7 +1373,10 @@ (if (not (re-search-forward "X-nnimap-article: \\([0-9]+\\)" nil t)) (error "Invalid nnimap mail") (setq article (string-to-number (match-string 1)))) - (push (list article group-art) + (push (list article + (if (eq group-art 'junk) + (list (cons 'junk 1)) + group-art)) nnimap-incoming-split-list))) (provide 'nnimap)
--- a/lisp/gnus/nnir.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/nnir.el Mon Sep 27 14:42:43 2010 +0900 @@ -345,14 +345,16 @@ (gnus-declare-backend "nnir" 'mail) (defvar nnir-imap-search-field "TEXT" - "The IMAP search item when doing an nnir search") + "The IMAP search item when doing an nnir search. To use raw + imap queries by default set this to \"\"") (defvar nnir-imap-search-arguments '(("Whole message" . "TEXT") ("Subject" . "SUBJECT") ("To" . "TO") ("From" . "FROM") - (nil . "HEADER \"%s\"")) + ("Head" . "HEADER \"%s\"") + (nil . "")) "Mapping from user readable strings to IMAP search items for use in nnir") (defvar nnir-imap-search-argument-history () @@ -956,6 +958,11 @@ (autoload 'imap-search "imap") (autoload 'imap-quote-specials "imap") +(eval-when-compile + (autoload 'nnimap-buffer "nnimap") + (autoload 'nnimap-command "nnimap") + (autoload 'nnimap-possibly-change-group "nnimap")) + (defun nnir-run-imap (query srv &optional group-option) "Run a search against an IMAP back-end server. This uses a custom query language parser; see `nnir-imap-make-query' for @@ -967,23 +974,30 @@ (defs (caddr (gnus-server-to-method srv))) (criteria (or (cdr (assq 'criteria query)) nnir-imap-search-field)) - artlist buf) + (gnus-inhibit-demon t) + artlist) (message "Opening server %s" server) (condition-case () - (when (nnimap-open-server server defs) ;; xxx - (setq buf nnimap-server-buffer) ;; xxx - (message "Searching %s..." group) - (let ((arts 0) - (mbx (gnus-group-real-name group))) - (when (imap-mailbox-select mbx nil buf) - (mapc - (lambda (artnum) - (push (vector group artnum 1) artlist) - (setq arts (1+ arts))) - (imap-search (nnir-imap-make-query criteria qstring) buf)) - (message "Searching %s... %d matches" mbx arts))) - (message "Searching %s...done" group)) - (quit nil)) + (when (nnimap-possibly-change-group (gnus-group-short-name group) server) + (with-current-buffer (nnimap-buffer) + (message "Searching %s..." group) + (let ((arts 0) + (result + (nnimap-command "UID SEARCH %s" + (if (string= criteria "") + qstring + (nnir-imap-make-query criteria qstring) + )))) + (mapc + (lambda (artnum) + (push (vector group artnum 1) artlist) + (setq arts (1+ arts))) + (and (car result) + (delete 0 (mapcar #'string-to-number + (cdr (assoc "SEARCH" (cdr result))))))) + (message "Searching %s... %d matches" group arts))) + (message "Searching %s...done" group)) + (quit nil)) (reverse artlist)))) (defun nnir-imap-make-query (criteria qstring) @@ -1536,17 +1550,13 @@ "find" group "-type" "f" "-name" "[0-9]*" "-exec" "grep" `("-l" ,@(and grep-options - ;; Note: the 3rd arg of `split-string' is not - ;; available in Emacs 21. - (delete "" (split-string grep-options "\\s-"))) + (split-string grep-options "\\s-" t)) "-e" ,regexp "{}" "+")))) ;; Translate relative paths to group names. (while (not (eobp)) - (let* ((path (delete - "" - (split-string - (buffer-substring (point) (line-end-position)) "/"))) + (let* ((path (split-string + (buffer-substring (point) (line-end-position)) "/" t)) (art (string-to-number (car (last path))))) (while (string= "." (car path)) (setq path (cdr path)))
--- a/lisp/gnus/nnmail.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/nnmail.el Mon Sep 27 14:42:43 2010 +0900 @@ -963,7 +963,7 @@ (goto-char end))) count)) -(defun nnmail-process-mmdf-mail-format (func artnum-func) +(defun nnmail-process-mmdf-mail-format (func artnum-func &optional junk-func) (let ((delim "^\^A\^A\^A\^A$") (case-fold-search t) (count 0) @@ -1011,7 +1011,7 @@ (narrow-to-region start (point)) (goto-char (point-min)) (incf count) - (nnmail-check-duplication message-id func artnum-func) + (nnmail-check-duplication message-id func artnum-func junk-func) (setq end (point-max)))) (goto-char end) (forward-line 2))) @@ -1056,7 +1056,7 @@ "Non-nil means group names are not encoded.") (defun nnmail-split-incoming (incoming func &optional exit-func - group artnum-func) + group artnum-func junk-func) "Go through the entire INCOMING file and pick out each individual mail. FUNC will be called with the buffer narrowed to each mail. INCOMING can also be a buffer object. In that case, the mail @@ -1087,7 +1087,8 @@ (looking-at "BABYL OPTIONS:")) (nnmail-process-babyl-mail-format func artnum-func)) ((looking-at "\^A\^A\^A\^A") - (nnmail-process-mmdf-mail-format func artnum-func)) + (nnmail-process-mmdf-mail-format + func artnum-func junk-func)) ((looking-at "Return-Path:") (nnmail-process-maildir-mail-format func artnum-func)) (t @@ -1096,7 +1097,7 @@ (funcall exit-func)) (kill-buffer (current-buffer)))))) -(defun nnmail-article-group (func &optional trace) +(defun nnmail-article-group (func &optional trace junk-func) "Look at the headers and return an alist of groups that match. FUNC will be called with the group name to determine the article number." (let ((methods (or nnmail-split-methods '(("bogus" "")))) @@ -1163,9 +1164,10 @@ ;; The article may be "cross-posted" to `junk'. What ;; to do? Just remove the `junk' spec. Don't really ;; see anything else to do... - (let (elem) - (while (setq elem (car (memq 'junk split))) - (setq split (delq elem split)))) + (when (and (memq 'junk split) + junk-func) + (funcall junk-func 'junk)) + (setq split (delq 'junk split)) (when split (setq group-art (mapcar @@ -1714,7 +1716,8 @@ (message-narrow-to-head) (message-fetch-field header)))) -(defun nnmail-check-duplication (message-id func artnum-func) +(defun nnmail-check-duplication (message-id func artnum-func + &optional junk-func) (run-hooks 'nnmail-prepare-incoming-message-hook) ;; If this is a duplicate message, then we do not save it. (let* ((duplication (nnmail-cache-id-exists-p message-id)) @@ -1739,7 +1742,8 @@ (cond ((not duplication) (funcall func (setq group-art - (nreverse (nnmail-article-group artnum-func)))) + (nreverse (nnmail-article-group + artnum-func nil junk-func)))) (nnmail-cache-insert message-id (caar group-art))) ((eq action 'delete) (setq group-art nil))
--- a/lisp/gnus/nnmaildir.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/nnmaildir.el Mon Sep 27 14:42:43 2010 +0900 @@ -916,7 +916,7 @@ "\n"))))) 'group) -(defun nnmaildir-request-update-info (gname info &optional server) +(defun nnmaildir-request-marks (gname info &optional server) (let ((group (nnmaildir--prepare server gname)) pgname flist always-marks never-marks old-marks dotfile num dir markdirs marks mark ranges markdir article read end new-marks ls
--- a/lisp/gnus/nnmairix.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/nnmairix.el Mon Sep 27 14:42:43 2010 +0900 @@ -705,7 +705,7 @@ (autoload 'nnimap-request-update-info-internal "nnimap") -(deffoo nnmairix-request-update-info (group info &optional server) +(deffoo nnmairix-request-marks (group info &optional server) ;; propagate info from underlying IMAP folder to nnmairix group ;; This is currently experimental and must be explicitly activated ;; with nnmairix-propagate-marks-to-nnmairix-group
--- a/lisp/gnus/nnmh.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/nnmh.el Mon Sep 27 14:42:43 2010 +0900 @@ -258,9 +258,6 @@ &optional server force) (nnmh-possibly-change-directory newsgroup server) (let ((is-old t) - (nnmail-expiry-target - (or (gnus-group-find-parameter newsgroup 'expiry-target t) - nnmail-expiry-target)) article rest mod-time) (nnheader-init-server-buffer)
--- a/lisp/gnus/nnml.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/nnml.el Mon Sep 27 14:42:43 2010 +0900 @@ -846,7 +846,9 @@ buffer)) (defun nnml-open-nov (group) - (or (cdr (assoc group nnml-nov-buffer-alist)) + (or (let ((buffer (cdr (assoc group nnml-nov-buffer-alist)))) + (and (buffer-name buffer) + buffer)) (let ((buffer (nnml-get-nov-buffer group))) (push (cons group buffer) nnml-nov-buffer-alist) buffer))) @@ -1047,7 +1049,7 @@ (nnml-save-marks group server)) nil) -(deffoo nnml-request-update-info (group info &optional server) +(deffoo nnml-request-marks (group info &optional server) (nnml-possibly-change-directory group server) (when (and (not nnml-marks-is-evil) (nnml-marks-changed-p group server)) (nnheader-message 8 "Updating marks for %s..." group)
--- a/lisp/gnus/nnrss.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/nnrss.el Mon Sep 27 14:42:43 2010 +0900 @@ -391,8 +391,8 @@ t) (deffoo nnrss-retrieve-groups (groups &optional server) - (nnrss-possibly-change-group nil server) (dolist (group groups) + (nnrss-possibly-change-group group server) (nnrss-check-group group server)) (with-current-buffer nntp-server-buffer (erase-buffer)
--- a/lisp/gnus/nntp.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/nntp.el Mon Sep 27 14:42:43 2010 +0900 @@ -1130,7 +1130,7 @@ (nntp-save-marks group server)) nil) -(deffoo nntp-request-update-info (group info &optional server) +(deffoo nntp-request-marks (group info &optional server) (when (and (not nntp-marks-is-evil) nntp-marks-file-name) (nntp-possibly-create-directory group server)
--- a/lisp/gnus/nnweb.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/nnweb.el Mon Sep 27 14:42:43 2010 +0900 @@ -193,8 +193,7 @@ (nnmail-generate-active (list (assoc server nnweb-group-alist))) t)) -(deffoo nnweb-request-update-info (group info &optional server) - (nnweb-possibly-change-server group server)) +(deffoo nnweb-request-update-info (group info &optional server)) (deffoo nnweb-asynchronous-p () nil)
--- a/lisp/gnus/pop3.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/pop3.el Mon Sep 27 14:42:43 2010 +0900 @@ -520,8 +520,7 @@ (mapcar #'(lambda (s) (let ((split (split-string s " "))) (cons (string-to-number (nth 0 split)) (string-to-number (nth 1 split))))) - (delete "" (split-string (buffer-substring start end) - "\r\n")))))))) + (split-string (buffer-substring start end) "\r\n" t))))))) (defun pop3-retr (process msg crashbuf) "Retrieve message-id MSG to buffer CRASHBUF."
--- a/lisp/gnus/rfc1843.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/rfc1843.el Mon Sep 27 14:42:43 2010 +0900 @@ -166,7 +166,6 @@ (equal (car ctl) "text/plain")) (rfc1843-decode-region (point) (point-max)))))))) -(defvar rfc1843-old-gnus-decode-header-function nil) (defvar gnus-decode-header-methods) (defvar gnus-decode-encoded-word-methods)
--- a/lisp/gnus/starttls.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/gnus/starttls.el Mon Sep 27 14:42:43 2010 +0900 @@ -269,6 +269,7 @@ host port (if done "done" "failed")) process)) +;;;###autoload (defun starttls-open-stream (name buffer host port) "Open a TLS connection for a port to a host. Returns a subprocess object to represent the connection.
--- a/lisp/ibuffer.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/ibuffer.el Mon Sep 27 14:42:43 2010 +0900 @@ -332,8 +332,9 @@ :group 'ibuffer) (defcustom ibuffer-compressed-file-name-regexp - "\\.\\(arj\\|bgz\\|bz2\\|gz\\|lzh\\|taz\\|tgz\\|zip\\|z\\)$" + "\\.\\(arj\\|bgz\\|bz2\\|gz\\|lzh\\|taz\\|tgz\\|xz\\|zip\\|z\\)$" "Regexp to match compressed file names." + :version "24.1" ; added xz :type 'regexp :group 'ibuffer)
--- a/lisp/image-mode.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/image-mode.el Mon Sep 27 14:42:43 2010 +0900 @@ -36,18 +36,6 @@ (require 'image) (eval-when-compile (require 'cl)) -;;;###autoload (push (cons (purecopy "\\.jpe?g\\'") 'image-mode) auto-mode-alist) -;;;###autoload (push (cons (purecopy "\\.png\\'") 'image-mode) auto-mode-alist) -;;;###autoload (push (cons (purecopy "\\.gif\\'") 'image-mode) auto-mode-alist) -;;;###autoload (push (cons (purecopy "\\.tiff?\\'") 'image-mode) auto-mode-alist) -;;;###autoload (push (cons (purecopy "\\.p[bpgn]m\\'") 'image-mode) auto-mode-alist) - -;;;###autoload (push (cons (purecopy "\\.x[bp]m\\'") 'c-mode) auto-mode-alist) -;;;###autoload (push (cons (purecopy "\\.x[bp]m\\'") 'image-mode) auto-mode-alist) - -;;;###autoload (push (cons (purecopy "\\.svgz?\\'") 'xml-mode) auto-mode-alist) -;;;###autoload (push (cons (purecopy "\\.svgz?\\'") 'image-mode) auto-mode-alist) - ;;; Image mode window-info management. (defvar image-mode-winprops-alist t)
--- a/lisp/imenu.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/imenu.el Mon Sep 27 14:42:43 2010 +0900 @@ -162,7 +162,7 @@ ;; No longer used. KFS 2004-10-27 ;; (defcustom imenu-scanning-message "Scanning buffer for index (%3d%%)" -;; "*Progress message during the index scanning of the buffer. +;; "Progress message during the index scanning of the buffer. ;; If non-nil, user gets a message during the scanning of the buffer. ;; ;; Relevant only if the mode-specific function that creates the buffer
--- a/lisp/info.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/info.el Mon Sep 27 14:42:43 2010 +0900 @@ -402,24 +402,28 @@ (".info.gz". "gunzip") (".info.z". "gunzip") (".info.bz2" . ("bzip2" "-dc")) + (".info.xz". "unxz") (".info". nil) ("-info.Z". "uncompress") ("-info.Y". "unyabba") ("-info.gz". "gunzip") ("-info.bz2" . ("bzip2" "-dc")) ("-info.z". "gunzip") + ("-info.xz". "unxz") ("-info". nil) ("/index.Z". "uncompress") ("/index.Y". "unyabba") ("/index.gz". "gunzip") ("/index.z". "gunzip") ("/index.bz2". ("bzip2" "-dc")) + ("/index.xz". "unxz") ("/index". nil) (".Z". "uncompress") (".Y". "unyabba") (".gz". "gunzip") (".z". "gunzip") (".bz2" . ("bzip2" "-dc")) + (".xz". "unxz") ("". nil))) "List of file name suffixes and associated decoding commands. Each entry should be (SUFFIX . STRING); the file is given to
--- a/lisp/international/iso-ascii.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/international/iso-ascii.el Mon Sep 27 14:42:43 2010 +0900 @@ -1,7 +1,7 @@ ;;; iso-ascii.el --- set up char tables for ISO 8859/1 on ASCII terminals -;; Copyright (C) 1987, 1995, 1998, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1987, 1995, 1998, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Howard Gayle ;; Maintainer: FSF @@ -41,7 +41,7 @@ :group 'i18n) (defcustom iso-ascii-convenient nil - "*Non-nil means `iso-ascii' should aim for convenience, not precision." + "Non-nil means `iso-ascii' should aim for convenience, not precision." :type 'boolean :group 'iso-ascii)
--- a/lisp/international/kkc.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/international/kkc.el Mon Sep 27 14:42:43 2010 +0900 @@ -1,7 +1,7 @@ ;;; kkc.el --- Kana Kanji converter -*- coding: iso-2022-7bit; -*- -;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1997, 1998, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, ;; 2005, 2006, 2007, 2008, 2009, 2010 ;; National Institute of Advanced Industrial Science and Technology (AIST) @@ -135,7 +135,7 @@ (defvar kkc-current-conversions-width nil) (defcustom kkc-show-conversion-list-count 4 - "*Count of successive `kkc-next' or `kkc-prev' to show conversion list. + "Count of successive `kkc-next' or `kkc-prev' to show conversion list. When you type SPC or C-p successively this count while using the input method `japanese', the conversion candidates are shown in the echo area while indicating the current selection by `<N>'."
--- a/lisp/international/mule.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/international/mule.el Mon Sep 27 14:42:43 2010 +0900 @@ -1679,7 +1679,7 @@ . no-conversion-multibyte) ("\\.\\(exe\\|EXE\\)\\'" . no-conversion) ("\\.\\(sx[dmicw]\\|odt\\|tar\\|tgz\\)\\'" . no-conversion) - ("\\.\\(gz\\|Z\\|bz\\|bz2\\|gpg\\)\\'" . no-conversion) + ("\\.\\(gz\\|Z\\|bz\\|bz2\\|xz\\|gpg\\)\\'" . no-conversion) ("\\.\\(jpe?g\\|png\\|gif\\|tiff?\\|p[bpgn]m\\)\\'" . no-conversion) ("\\.pdf\\'" . no-conversion) ("/#[^/]+#\\'" . emacs-mule))) @@ -1690,6 +1690,7 @@ The settings in this alist take priority over `coding:' tags in the file (see the function `set-auto-coding') and the contents of `file-coding-system-alist'." + :version "24.1" ; added xz :group 'files :group 'mule :type '(repeat (cons (regexp :tag "File name regexp")
--- a/lisp/international/ogonek.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/international/ogonek.el Mon Sep 27 14:42:43 2010 +0900 @@ -273,23 +273,23 @@ ogonek-name-encoding-alist)) "List of ogonek encodings. Used only for customization.") (defcustom ogonek-from-encoding "iso8859-2" - "*Encoding in the source file of recoding." + "Encoding in the source file of recoding." :type ogonek-encoding-choices :group 'ogonek) (defcustom ogonek-to-encoding "ascii" - "*Encoding in the target file of recoding." + "Encoding in the target file of recoding." :type ogonek-encoding-choices :group 'ogonek) (defcustom ogonek-prefix-char ?/ - "*Prefix character for prefix encodings." + "Prefix character for prefix encodings." :type 'character :group 'ogonek) (defcustom ogonek-prefix-from-encoding "iso8859-2" - "*Encoding in the source file subject to prefixifation." + "Encoding in the source file subject to prefixifation." :type ogonek-encoding-choices :group 'ogonek) (defcustom ogonek-prefix-to-encoding "iso8859-2" - "*Encoding in the target file subject to deprefixifation." + "Encoding in the target file subject to deprefixifation." :type ogonek-encoding-choices :group 'ogonek)
--- a/lisp/isearch.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/isearch.el Mon Sep 27 14:42:43 2010 +0900 @@ -275,30 +275,37 @@ :group 'isearch :group 'matching) +(define-obsolete-variable-alias 'isearch-lazy-highlight-cleanup + 'lazy-highlight-cleanup + "22.1") + (defcustom lazy-highlight-cleanup t "Controls whether to remove extra highlighting after a search. If this is nil, extra highlighting can be \"manually\" removed with \\[lazy-highlight-cleanup]." :type 'boolean :group 'lazy-highlight) -(define-obsolete-variable-alias 'isearch-lazy-highlight-cleanup - 'lazy-highlight-cleanup + +(define-obsolete-variable-alias 'isearch-lazy-highlight-initial-delay + 'lazy-highlight-initial-delay "22.1") (defcustom lazy-highlight-initial-delay 0.25 "Seconds to wait before beginning to lazily highlight all matches." :type 'number :group 'lazy-highlight) -(define-obsolete-variable-alias 'isearch-lazy-highlight-initial-delay - 'lazy-highlight-initial-delay + +(define-obsolete-variable-alias 'isearch-lazy-highlight-interval + 'lazy-highlight-interval "22.1") (defcustom lazy-highlight-interval 0 ; 0.0625 "Seconds between lazily highlighting successive matches." :type 'number :group 'lazy-highlight) -(define-obsolete-variable-alias 'isearch-lazy-highlight-interval - 'lazy-highlight-interval + +(define-obsolete-variable-alias 'isearch-lazy-highlight-max-at-a-time + 'lazy-highlight-max-at-a-time "22.1") (defcustom lazy-highlight-max-at-a-time 20 @@ -309,9 +316,6 @@ :type '(choice (const :tag "All" nil) (integer :tag "Some")) :group 'lazy-highlight) -(define-obsolete-variable-alias 'isearch-lazy-highlight-max-at-a-time - 'lazy-highlight-max-at-a-time - "22.1") (defface lazy-highlight '((((class color) (min-colors 88) (background light)) @@ -327,10 +331,10 @@ :group 'lazy-highlight :group 'basic-faces) (define-obsolete-face-alias 'isearch-lazy-highlight-face 'lazy-highlight "22.1") -(defvar lazy-highlight-face 'lazy-highlight) (define-obsolete-variable-alias 'isearch-lazy-highlight-face 'lazy-highlight-face "22.1") +(defvar lazy-highlight-face 'lazy-highlight) ;; Define isearch help map.
--- a/lisp/mail/feedmail.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/mail/feedmail.el Mon Sep 27 14:42:43 2010 +0900 @@ -314,7 +314,7 @@ (defcustom feedmail-confirm-outgoing nil - "*If non-nil, give a y-or-n confirmation prompt before sending mail. + "If non-nil, give a y-or-n confirmation prompt before sending mail. This is done after the message is completely prepped, and you'll be looking at the top of the message in a buffer when you get the prompt. If set to the symbol 'queued, give the confirmation prompt only while @@ -330,7 +330,7 @@ (defcustom feedmail-confirm-outgoing-timeout nil - "*If non-nil, a timeout in seconds at the send confirmation prompt. + "If non-nil, a timeout in seconds at the send confirmation prompt. If a positive number, it's a timeout before sending. If a negative number, it's a timeout before not sending. This will not work if your version of Emacs doesn't include the function `y-or-n-p-with-timeout' @@ -341,7 +341,7 @@ (defcustom feedmail-nuke-bcc t - "*If non-nil remove Bcc: lines from the message headers. + "If non-nil remove Bcc: lines from the message headers. In any case, the Bcc: lines do participate in the composed address list. You may want to leave them in if you're using sendmail \(see `feedmail-buffer-eating-function'\)." @@ -351,7 +351,7 @@ (defcustom feedmail-nuke-resent-bcc t - "*If non-nil remove Resent-Bcc: lines from the message headers. + "If non-nil remove Resent-Bcc: lines from the message headers. In any case, the Resent-Bcc: lines do participate in the composed address list. You may want to leave them in if you're using sendmail \(see `feedmail-buffer-eating-function'\)." @@ -361,7 +361,7 @@ (defcustom feedmail-deduce-bcc-where nil - "*Where Bcc:/Resent-Bcc: addresses should appear in the envelope list. + "Where Bcc:/Resent-Bcc: addresses should appear in the envelope list. Addresses for the message envelope are deduced by examining appropriate address headers in the message. Generally, they will show up in the list of deduced addresses in the order that the headers @@ -387,7 +387,7 @@ (defcustom feedmail-fill-to-cc t - "*If non-nil do smart filling of addressee header lines. + "If non-nil do smart filling of addressee header lines. Smart filling means breaking long lines at appropriate points and making continuation lines. Despite the function name, it includes To:, Cc:, Bcc: (and their Resent-* forms), as well as From: and @@ -399,14 +399,14 @@ (defcustom feedmail-fill-to-cc-fill-column default-fill-column - "*Fill column used by `feedmail-fill-to-cc'." + "Fill column used by `feedmail-fill-to-cc'." :group 'feedmail-headers :type 'integer ) (defcustom feedmail-nuke-bcc-in-fcc nil - "*If non-nil remove [Resent-]Bcc: lines in message copies saved via Fcc:. + "If non-nil remove [Resent-]Bcc: lines in message copies saved via Fcc:. This is independent of whether the Bcc: header lines are actually sent with the message (see feedmail-nuke-bcc). Though not implied in the name, the same Fcc: treatment applies to both Bcc: and Resent-Bcc: lines." @@ -416,7 +416,7 @@ (defcustom feedmail-nuke-body-in-fcc nil - "*If non-nil remove body of message in copies saved via Fcc:. + "If non-nil remove body of message in copies saved via Fcc:. If a positive integer value, leave (up to) that many lines of the beginning of the body intact. The result is that the Fcc: copy will consist only of the message headers, serving as a sort of an outgoing @@ -427,7 +427,7 @@ (defcustom feedmail-force-expand-mail-aliases nil - "*If non-nil, force the calling of `expand-mail-aliases'. + "If non-nil, force the calling of `expand-mail-aliases'. Normally, feedmail tries to figure out if you're using mailalias or mailabbrevs and only calls `expand-mail-aliases' if it thinks you're using the mailalias package. This user option can be used to force @@ -439,7 +439,7 @@ (defcustom feedmail-nuke-empty-headers t - "*If non-nil, remove header lines which have no contents. + "If non-nil, remove header lines which have no contents. A completely empty Subject: header is always removed, regardless of the setting of this variable. The only time you would want them left in would be if you used some headers whose presence indicated @@ -457,7 +457,7 @@ ;; RFC-822 and RFC-1123, but are you *really* one of those cases ;; they're talking about? I doubt it.) (defcustom feedmail-sender-line nil - "*If non-nil and the email has no Sender: header, use this value. + "If non-nil and the email has no Sender: header, use this value. May be nil, in which case nothing in particular is done with respect to Sender: lines. By design, will not replace an existing Sender: line, but you can achieve that with a fiddle-plex 'replace action. @@ -484,7 +484,7 @@ (defcustom feedmail-force-binary-write t - "*If non-nil, force writing file as binary (this applies to queues and Fcc:). + "If non-nil, force writing file as binary (this applies to queues and Fcc:). On systems where there is a difference between binary and text files, feedmail will temporarily manipulate the value of `buffer-file-type' to make the writing as binary. If nil, writing will be in text mode. @@ -496,7 +496,7 @@ (defcustom feedmail-from-line t - "*If non-nil and the email has no From: header, use this value. + "If non-nil and the email has no From: header, use this value. May be t, in which case a default is computed (and you probably won't be happy with it). May be nil, in which case nothing in particular is done with respect to From: lines. By design, will not replace an @@ -526,7 +526,7 @@ (defcustom feedmail-deduce-envelope-from t - "*If non-nil, deduce message envelope \"from\" from header From: or Sender:. + "If non-nil, deduce message envelope \"from\" from header From: or Sender:. In other words, if there is a Sender: header in the message, temporarily change the value of `user-mail-address' to be the same while the message is being sent. If there is no Sender: header, use the From: header, @@ -555,14 +555,14 @@ (defcustom feedmail-x-mailer-line-user-appendage nil - "*See feedmail-x-mailer-line." + "See feedmail-x-mailer-line." :group 'feedmail-headers :type '(choice (const nil) (const t) string) ) (defcustom feedmail-x-mailer-line t - "*Control the form of an X-Mailer: header in an outgoing message. + "Control the form of an X-Mailer: header in an outgoing message. Moderately useful for debugging, keeping track of your correspondents' mailer preferences, or just wearing your MUA on your sleeve. You should probably know that some people are fairly emotional about the @@ -592,7 +592,7 @@ (defcustom feedmail-message-id-generator t - "*Specifies the creation of a Message-Id: header field. + "Specifies the creation of a Message-Id: header field. If nil, nothing is done about Message-Id:. @@ -622,7 +622,7 @@ (defcustom feedmail-message-id-suffix nil - "*If non-nil, used as a suffix for generating unique Message-Id: headers. + "If non-nil, used as a suffix for generating unique Message-Id: headers. The function `feedmail-default-message-id-generator' creates its work based on a formatted date-time string, a random number, and a domain-looking suffix. You can control the suffix used by assigning a string value to this variable. @@ -637,7 +637,7 @@ ;; this was suggested in various forms by several people; first was ;; Tony DeSimone in Oct 1992; sorry to be so tardy (defcustom feedmail-date-generator t - "*Specifies the creation of a Date: header field. + "Specifies the creation of a Date: header field. If nil, nothing is done about Date:. @@ -671,7 +671,7 @@ (defcustom feedmail-fiddle-headers-upwardly t - "*Non-nil means fiddled header fields should go at the top of the header. + "Non-nil means fiddled header fields should go at the top of the header. nil means insert them at the bottom. This is mostly a novelty issue since the standards define the ordering of header fields to be immaterial and it's fairly likely that some MTA along the way will have its own idea of what the @@ -777,7 +777,7 @@ (defcustom feedmail-enable-queue nil - "*If non-nil, provide for stashing outgoing messages in a queue. + "If non-nil, provide for stashing outgoing messages in a queue. This is the master on/off switch for feedmail message queuing. Queuing is quite handy for laptop-based users. It's also handy if you get a lot of mail and process it more or less sequentially. For @@ -804,7 +804,7 @@ (defcustom feedmail-queue-runner-confirm-global nil - "*If non-nil, give a y-or-n confirmation prompt before running the queue. + "If non-nil, give a y-or-n confirmation prompt before running the queue. Prompt even if the queue is about to be processed as a result of a call to `feedmail-run-the-queue-no-prompts'. This gives you a way to bail out without having to answer no to the individual message prompts." @@ -814,7 +814,7 @@ (defcustom feedmail-queue-directory (concat (getenv "HOME") "/mail/q") - "*Name of a directory where messages will be queued. + "Name of a directory where messages will be queued. Directory will be created if necessary. Should be a string that doesn't end with a slash. Default is \"$HOME/mail/q\"." :group 'feedmail-queue @@ -824,7 +824,7 @@ (defcustom feedmail-queue-draft-directory (concat (getenv "HOME") "/mail/draft") - "*Name of a directory where draft messages will be queued. + "Name of a directory where draft messages will be queued. Directory will be created if necessary. Should be a string that doesn't end with a slash. Default is \"$HOME/mail/draft\"." :group 'feedmail-queue @@ -833,7 +833,7 @@ (defcustom feedmail-ask-before-queue t - "*If non-nil, feedmail will ask what you want to do with the message. + "If non-nil, feedmail will ask what you want to do with the message. Default choices for the message action prompt will include sending it immediately, putting it in the main queue, putting it in the draft queue, or returning to the buffer to continue editing. Only matters if @@ -845,7 +845,7 @@ (defcustom feedmail-ask-before-queue-prompt "FQM: Message action (q, i, d, e, ?)? [%s]: " - "*A string which will be used for the message action prompt. + "A string which will be used for the message action prompt. If it contains a \"%s\", that will be replaced with the value of `feedmail-ask-before-queue-default'." :group 'feedmail-queue @@ -854,7 +854,7 @@ (defcustom feedmail-ask-before-queue-reprompt "FQM: Please type q, i, d, or e; or ? for help [%s]: " - "*A string which will be used for repompting after invalid input. + "A string which will be used for repompting after invalid input. If it contains a \"%s\", that will be replaced with the value of `feedmail-ask-before-queue-default'." :group 'feedmail-queue @@ -863,7 +863,7 @@ (defcustom feedmail-ask-before-queue-default "queue" - "*Meaning if user hits return in response to the message action prompt. + "Meaning if user hits return in response to the message action prompt. Should be a character or a string; if a string, only the first character is significant. Useful values are those described in the help for the message action prompt." @@ -947,7 +947,7 @@ (defcustom feedmail-queue-chatty t - "*If non-nil, blat a few status messages and such in the mini-buffer. + "If non-nil, blat a few status messages and such in the mini-buffer. If nil, just do the work and don't pester people about what's going on. In some cases, though, specific options inspire mini-buffer prompting. That's not affected by this variable setting. Also does not control @@ -958,7 +958,7 @@ (defcustom feedmail-queue-chatty-sit-for 2 - "*Duration of pause after most queue-related messages. + "Duration of pause after most queue-related messages. After some messages are divulged, it is prudent to pause before something else obliterates them. This value controls the duration of the pause." @@ -968,7 +968,7 @@ (defcustom feedmail-queue-run-orderer nil - "*If non-nil, name a function which will sort the queued messages. + "If non-nil, name a function which will sort the queued messages. The function is called during a running of the queue for sending, and takes one argument, a list of the files in the queue directory. It may contain the names of non-message files, and it's okay to leave @@ -982,7 +982,7 @@ (defcustom feedmail-queue-use-send-time-for-date nil - "*If non-nil, use send time for the Date: header value. + "If non-nil, use send time for the Date: header value. This variable is used by the default date generating function, feedmail-default-date-generator. If nil, the default, the last-modified timestamp of the queue file is used to create the @@ -994,7 +994,7 @@ (defcustom feedmail-queue-use-send-time-for-message-id nil - "*If non-nil, use send time for the Message-Id: header value. + "If non-nil, use send time for the Message-Id: header value. This variable is used by the default Message-Id: generating function, `feedmail-default-message-id-generator'. If nil, the default, the last-modified timestamp of the queue file is used to create the @@ -1006,7 +1006,7 @@ (defcustom feedmail-ask-for-queue-slug nil - "*If non-nil, prompt user for part of the queue file name. + "If non-nil, prompt user for part of the queue file name. The file will automatically get the FQM suffix and an embedded sequence number for uniqueness, so don't specify that. feedmail will get rid of all characters other than alphanumeric and hyphen in the @@ -1023,7 +1023,7 @@ (defcustom feedmail-queue-slug-maker 'feedmail-queue-subject-slug-maker - "*If non-nil, a function which creates part of the queued file name. + "If non-nil, a function which creates part of the queued file name. Takes a single argument giving the name of the directory into which the message will be queued. The returned string should be just the non-directory filename part, without FQM suffix or uniquifying @@ -1036,7 +1036,7 @@ (defcustom feedmail-queue-default-file-slug t - "*Indicates what to use for subject-less messages when forming a file name. + "Indicates what to use for subject-less messages when forming a file name. When feedmail queues a message, it creates a unique file name. By default, the file name is based in part on the subject of the message being queued. If there is no subject, consult this variable. See documentation for the @@ -1059,7 +1059,7 @@ (defcustom feedmail-queue-fqm-suffix ".fqm" - "*The FQM suffix used to distinguish feedmail queued message files. + "The FQM suffix used to distinguish feedmail queued message files. You probably want this to be a period followed by some letters and/or digits. The distinction is to be able to tell them from other random files that happen to be in the `feedmail-queue-directory' or @@ -1071,7 +1071,7 @@ (defcustom feedmail-nuke-buffer-after-queue nil - "*If non-nil, silently kill the buffer after a message is queued. + "If non-nil, silently kill the buffer after a message is queued. You might like that since a side-effect of queueing the message is that its buffer name gets changed to the filename. That means that the buffer won't be reused for the next message you compose. If you @@ -1084,7 +1084,7 @@ (defcustom feedmail-queue-auto-file-nuke nil - "*If non-nil, automatically delete queue files when a message is sent. + "If non-nil, automatically delete queue files when a message is sent. Normally, feedmail will notice such files when you send a message in immediate mode (i.e., not when you're running the queue) and will ask if you want to delete them. Since the answer is usually yes, setting this @@ -1154,7 +1154,7 @@ (defcustom feedmail-last-chance-hook nil - "*User's last opportunity to modify the message on its way out. + "User's last opportunity to modify the message on its way out. It has already had all the header prepping from the standard package. The next step after running the hook will be to push the buffer into a subprocess that mails the mail. The hook might be interested in @@ -1172,7 +1172,7 @@ (defcustom feedmail-before-fcc-hook nil - "*User's last opportunity to modify the message before Fcc action. + "User's last opportunity to modify the message before Fcc action. It has already had all the header prepping from the standard package. The next step after running the hook will be to save the message via Fcc: processing. The hook might be interested in these: (1) @@ -1189,7 +1189,7 @@ (defcustom feedmail-queue-runner-mode-setter '(lambda (&optional arg) (mail-mode)) - "*A function to set the proper mode of a message file. + "A function to set the proper mode of a message file. Called when the message is read back out of the queue directory with a single argument, the optional argument used in the call to `feedmail-run-the-queue' or `feedmail-run-the-queue-no-prompts'. @@ -1204,7 +1204,7 @@ (defcustom feedmail-queue-alternative-mail-header-separator nil - "*Alternative header demarcation for queued messages. + "Alternative header demarcation for queued messages. If you sometimes get alternative values for `mail-header-separator' in queued messages, set the value of this variable to whatever it is. For example, `rmail-resend' uses a `mail-header-separator' value of empty @@ -1221,7 +1221,7 @@ (defcustom feedmail-queue-runner-message-sender 'mail-send-and-exit - "*Function to initiate sending a message file. + "Function to initiate sending a message file. Called for each message read back out of the queue directory with a single argument, the optional argument used in the call to `feedmail-run-the-queue' or `feedmail-run-the-queue-no-prompts'. @@ -1238,7 +1238,7 @@ '(lambda (fqm-file &optional arg) (delete-file fqm-file) (if (and arg feedmail-queue-chatty) (message "FQM: Nuked %s" fqm-file))) - "*Function that will be called after a message has been sent. + "Function that will be called after a message has been sent. Not called in the case of errors. This function is called with two arguments: the name of the message queue file for the message just sent, and the optional argument used in the call to `feedmail-run-the-queue' @@ -1265,7 +1265,7 @@ (defcustom feedmail-buffer-eating-function 'feedmail-buffer-to-binmail - "*Function used to send the prepped buffer to a subprocess. + "Function used to send the prepped buffer to a subprocess. The function's three (mandatory) arguments are: (1) the buffer containing the prepped message; (2) a buffer where errors should be directed; and (3) a list containing the addresses individually as @@ -1281,7 +1281,7 @@ (defcustom feedmail-binmail-template (if mail-interactive "/bin/mail %s" "/bin/rmail %s") - "*Command template for the subprocess which will get rid of the mail. + "Command template for the subprocess which will get rid of the mail. It can result in any command understandable by /bin/sh. Might not work at all in non-Unix environments. The single '%s', if present, gets replaced by the space-separated, simplified list of addressees. @@ -1446,7 +1446,7 @@ ;; From a VM mailing list discussion and some suggestions from Samuel Mikes <smikes@alumni.hmc.edu> (defun feedmail-queue-express-to-queue () - "*Send message directly to the queue, with a minimum of fuss and bother." + "Send message directly to the queue, with a minimum of fuss and bother." (interactive) (let ((feedmail-enable-queue t) (feedmail-ask-before-queue nil) @@ -1458,7 +1458,7 @@ (defun feedmail-queue-express-to-draft () - "*Send message directly to the draft queue, with a minimum of fuss and bother." + "Send message directly to the draft queue, with a minimum of fuss and bother." (interactive) (let ((feedmail-queue-directory feedmail-queue-draft-directory)) (feedmail-queue-express-to-queue)
--- a/lisp/man.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/man.el Mon Sep 27 14:42:43 2010 +0900 @@ -314,7 +314,7 @@ "Regular expression describing references to normal files.") ;; This includes the section as an optional part to catch hyphenated -;; refernces to manpages. +;; references to manpages. (defvar Man-hyphenated-reference-regexp (concat "\\(" Man-name-regexp "\\)\\((\\(" Man-section-regexp "\\))\\)?") "Regular expression describing a reference in the SEE ALSO section.")
--- a/lisp/net/browse-url.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/net/browse-url.el Mon Sep 27 14:42:43 2010 +0900 @@ -1,7 +1,8 @@ ;;; browse-url.el --- pass a URL to a WWW browser -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, -;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Denis Howe <dbh@doc.ic.ac.uk> ;; Maintainer: FSF @@ -607,7 +608,7 @@ :group 'browse-url) (defcustom browse-url-elinks-wrapper '("xterm" "-e") - "*Wrapper command prepended to the Elinks command-line." + "Wrapper command prepended to the Elinks command-line." :type '(repeat (string :tag "Wrapper")) :group 'browse-url)
--- a/lisp/net/eudc-vars.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/net/eudc-vars.el Mon Sep 27 14:42:43 2010 +0900 @@ -1,7 +1,7 @@ ;;; eudc-vars.el --- Emacs Unified Directory Client -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> ;; Maintainer: Pavel Janík <Pavel@Janik.cz> @@ -39,7 +39,7 @@ :group 'comm) (defcustom eudc-server nil - "*The name or IP address of the directory server. + "The name or IP address of the directory server. A port number may be specified by appending a colon and a number to the name of the server. Use `localhost' if the directory server resides on your computer (BBDB backend)." @@ -56,7 +56,7 @@ are loaded, *do not change manually*.") (defcustom eudc-protocol nil - "*The directory protocol to use to query the server. + "The directory protocol to use to query the server. Supported protocols are specified by `eudc-supported-protocols'." :type `(choice :menu-tag "Protocol" ,@(mapcar (lambda (s) @@ -67,13 +67,13 @@ (defcustom eudc-strict-return-matches t - "*Ignore or allow entries not containing all requested return attributes. + "Ignore or allow entries not containing all requested return attributes. If non-nil, such entries are ignored." :type 'boolean :group 'eudc) (defcustom eudc-default-return-attributes nil - "*A list of default attributes to extract from directory entries. + "A list of default attributes to extract from directory entries. If set to the symbol `all', return all attributes. A value of nil means return the default attributes as configured in the server." @@ -87,7 +87,7 @@ :group 'eudc) (defcustom eudc-multiple-match-handling-method 'select - "*What to do when multiple entries match an inline expansion query. + "What to do when multiple entries match an inline expansion query. Possible values are: `first' (equivalent to nil) which means keep the first match only, `select' pop-up a selection buffer, @@ -107,7 +107,7 @@ :group 'eudc) (defcustom eudc-duplicate-attribute-handling-method '((email . duplicate)) - "*A method to handle entries containing duplicate attributes. + "A method to handle entries containing duplicate attributes. This is either an alist (ATTR . METHOD) or a symbol METHOD. The alist form of the variable associates a method to an individual attribute, the second form specifies a method applicable to all attributes. @@ -136,7 +136,7 @@ (defcustom eudc-inline-query-format '((name) (firstname name)) - "*Format of an inline expansion query. + "Format of an inline expansion query. This is a list of FORMATs. A FORMAT is itself a list of one or more EUDC attribute names. A FORMAT applies if it contains as many attributes as there are individual words in the inline query string. @@ -164,12 +164,12 @@ :group 'eudc) (defcustom eudc-expansion-overwrites-query t - "*If non-nil, expanding a query overwrites the query string." + "If non-nil, expanding a query overwrites the query string." :type 'boolean :group 'eudc) (defcustom eudc-inline-expansion-format '("%s" email) - "*A list specifying the format of the expansion of inline queries. + "A list specifying the format of the expansion of inline queries. This variable controls what `eudc-expand-inline' actually inserts in the buffer. First element is a string passed to `format'. Remaining elements are symbols indicating attribute names; the corresponding values @@ -189,7 +189,7 @@ :group 'eudc) (defcustom eudc-inline-expansion-servers 'server-then-hotlist - "*Which servers to contact for the expansion of inline queries. + "Which servers to contact for the expansion of inline queries. Possible values are: `current-server': the EUDC current server. `hotlist': the servers of the hotlist in the order they appear, @@ -203,7 +203,7 @@ :group 'eudc) (defcustom eudc-max-servers-to-query nil - "*Maximum number of servers to query for an inline expansion. + "Maximum number of servers to query for an inline expansion. If nil, query all servers available from `eudc-inline-expansion-servers'." :tag "Max Number of Servers to Query" :type '(choice :tag "Max. Servers" @@ -218,7 +218,7 @@ :group 'eudc) (defcustom eudc-query-form-attributes '(name firstname email phone) - "*A list of attributes presented in the query form." + "A list of attributes presented in the query form." :tag "Attributes in Query Forms" :type '(repeat (choice @@ -249,7 +249,7 @@ (telephonenumber . "Phone") (uniqueidentifier . "ID") (objectclass . "Object Class")) - "*Alist of user-defined names for directory attributes. + "Alist of user-defined names for directory attributes. These names are used as prompt strings in query/response forms instead of the raw directory attribute names. Prompt strings for attributes that are not listed here @@ -262,14 +262,14 @@ :group 'eudc) (defcustom eudc-use-raw-directory-names nil - "*If non-nil, use attributes names as defined in the directory. + "If non-nil, use attributes names as defined in the directory. Otherwise, directory query/response forms display the user attribute names defined in `eudc-user-attribute-names-alist'." :type 'boolean :group 'eudc) (defcustom eudc-attribute-display-method-alist nil - "*An alist specifying methods to display attribute values. + "An alist specifying methods to display attribute values. Each member of the list is of the form (NAME . FUNC) where NAME is a lowercased string naming a directory attribute (translated according to `eudc-user-attribute-names-alist' if `eudc-use-raw-directory-names' is @@ -283,7 +283,7 @@ (defcustom eudc-external-viewers '(("ImageMagick" "display" "-") ("ShowAudio" "showaudio")) - "*A list of viewer program specifications. + "A list of viewer program specifications. Viewers are programs which can be piped a directory attribute value for display or arbitrary processing. Each specification is a list whose first element is a string naming the viewer. The second element is the @@ -300,12 +300,12 @@ :group 'eudc) (defcustom eudc-options-file "~/.eudc-options" - "*A file where the `servers' hotlist is stored." + "A file where the `servers' hotlist is stored." :type '(file :Tag "File Name:") :group 'eudc) (defcustom eudc-mode-hook nil - "*Normal hook run on entry to EUDC mode." + "Normal hook run on entry to EUDC mode." :type '(repeat (sexp :tag "Hook definition")) :group 'eudc) @@ -323,7 +323,7 @@ (address . (eudc-bbdbify-address address "Address")) (phone . ((eudc-bbdbify-phone phone "Phone") (eudc-bbdbify-phone office_phone "Office Phone")))) - "*A mapping from BBDB to PH/QI fields. + "A mapping from BBDB to PH/QI fields. This is a list of cons cells (BBDB-FIELD . SPEC-OR-LIST) where BBDB-FIELD is the name of a field that must be defined in your BBDB environment (standard field names are `name', `company', `net', `phone', @@ -358,7 +358,7 @@ (net . mail) (address . (eudc-bbdbify-address postaladdress "Address")) (phone . ((eudc-bbdbify-phone telephonenumber "Phone")))) - "*A mapping from BBDB to LDAP attributes. + "A mapping from BBDB to LDAP attributes. This is a list of cons cells (BBDB-FIELD . SPEC-OR-LIST) where BBDB-FIELD is the name of a field that must be defined in your BBDB environment (standard field names are `name', `company', `net', `phone',
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/net/gnutls.el Mon Sep 27 14:42:43 2010 +0900 @@ -0,0 +1,128 @@ +;;; gnutls.el --- Support SSL and TLS connections through GnuTLS +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Ted Zlatanov <tzz@lifelogs.com> +;; Keywords: comm, tls, ssl, encryption +;; Originally-By: Simon Josefsson (See http://josefsson.org/emacs-security/) + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This package provides language bindings for the GnuTLS library +;; using the corresponding core functions in gnutls.c. + +;; Simple test: +;; +;; (setq jas (open-ssl-stream "ssl" (current-buffer) "www.pdc.kth.se" 443)) +;; (process-send-string jas "GET /\r\n\r\n") + +;;; Code: + +(defun open-ssl-stream (name buffer host service) + "Open a SSL connection for a service to a host. +Returns a subprocess-object to represent the connection. +Input and output work as for subprocesses; `delete-process' closes it. +Args are NAME BUFFER HOST SERVICE. +NAME is name for process. It is modified if necessary to make it unique. +BUFFER is the buffer (or `buffer-name') to associate with the process. + Process output goes at end of that buffer, unless you specify + an output stream or filter function to handle the output. + BUFFER may be also nil, meaning that this process is not associated + with any buffer +Third arg is name of the host to connect to, or its IP address. +Fourth arg SERVICE is name of the service desired, or an integer +specifying a port number to connect to." + (let ((proc (open-network-stream name buffer host service))) + (starttls-negotiate proc nil 'gnutls-x509pki))) + +;; (open-ssl-stream "tls" "tls-buffer" "yourserver.com" "https") +(defun starttls-negotiate (proc &optional priority-string + credentials credentials-file) + "Negotiate a SSL or TLS connection. +PROC is the process returned by `starttls-open-stream'. +PRIORITY-STRING is as per the GnuTLS docs. +CREDENTIALS is `gnutls-x509pki' or `gnutls-anon'. +CREDENTIALS-FILE is a filename with meaning dependent on CREDENTIALS." + (let* ((credentials (or credentials 'gnutls-x509pki)) + (credentials-file (or credentials-file + "/etc/ssl/certs/ca-certificates.crt" + ;"/etc/ssl/certs/ca.pem" + )) + + (priority-string (or priority-string + (cond + ((eq credentials 'gnutls-anon) + "NORMAL:+ANON-DH:!ARCFOUR-128") + ((eq credentials 'gnutls-x509pki) + "NORMAL")))) + ret) + + (gnutls-message-maybe + (setq ret (gnutls-boot proc priority-string credentials credentials-file)) + "boot: %s") + + (when (gnutls-errorp ret) + (error "Could not boot GnuTLS for this process")); + + (let ((ret 'gnutls-e-again) + (n 25000)) + (while (and (not (gnutls-error-fatalp ret)) + (> n 0)) + (setq n (1- n)) + (gnutls-message-maybe + (setq ret (gnutls-handshake proc)) + "handshake: %s") + ;(debug "handshake ret" ret (gnutls-error-string ret))) + ) + (if (gnutls-errorp ret) + (progn + (message "Ouch, error return %s (%s)" + ret (gnutls-error-string ret)) + (setq proc nil)) + (message "Handshake complete %s." ret))) + proc)) + +(defun starttls-open-stream (name buffer host service) + "Open a TLS connection for a service to a host. +Returns a subprocess-object to represent the connection. +Input and output work as for subprocesses; `delete-process' closes it. +Args are NAME BUFFER HOST SERVICE. +NAME is name for process. It is modified if necessary to make it unique. +BUFFER is the buffer (or `buffer-name') to associate with the process. + Process output goes at end of that buffer, unless you specify + an output stream or filter function to handle the output. + BUFFER may be also nil, meaning that this process is not associated + with any buffer +Third arg is name of the host to connect to, or its IP address. +Fourth arg SERVICE is name of the service desired, or an integer +specifying a port number to connect to." + (open-network-stream name buffer host service)) + +(defun gnutls-message-maybe (doit format &rest params) + "When DOIT, message with the caller name followed by FORMAT on PARAMS." + ;; (apply 'debug format (or params '(nil))) + (when (gnutls-errorp doit) + (message "%s: (err=[%s] %s) %s" + "gnutls.el" + doit (gnutls-error-string doit) + (apply 'format format (or params '(nil)))))) + +(provide 'ssl) +(provide 'gnutls) +(provide 'starttls) + +;;; gnutls.el ends here
--- a/lisp/net/ldap.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/net/ldap.el Mon Sep 27 14:42:43 2010 +0900 @@ -1,7 +1,7 @@ ;;; ldap.el --- client interface to LDAP for Emacs -;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Oscar Figueiredo <oscar@cpe.fr> ;; Maintainer: FSF @@ -43,7 +43,7 @@ :group 'comm) (defcustom ldap-default-host nil - "*Default LDAP server. + "Default LDAP server. A TCP port number can be appended to that name using a colon as a separator." :type '(choice (string :tag "Host name") @@ -51,14 +51,14 @@ :group 'ldap) (defcustom ldap-default-port nil - "*Default TCP port for LDAP connections. + "Default TCP port for LDAP connections. Initialized from the LDAP library at build time. Default value is 389." :type '(choice (const :tag "Use library default" nil) (integer :tag "Port number")) :group 'ldap) (defcustom ldap-default-base nil - "*Default base for LDAP searches. + "Default base for LDAP searches. This is a string using the syntax of RFC 1779. For instance, \"o=ACME, c=US\" limits the search to the Acme organization in the United States." @@ -68,7 +68,7 @@ (defcustom ldap-host-parameters-alist nil - "*Alist of host-specific options for LDAP transactions. + "Alist of host-specific options for LDAP transactions. The format of each list element is (HOST PROP1 VAL1 PROP2 VAL2 ...). HOST is the hostname of an LDAP server (with an optional TCP port number appended to it using a colon as a separator). @@ -148,28 +148,28 @@ :group 'ldap) (defcustom ldap-ldapsearch-prog "ldapsearch" - "*The name of the ldapsearch command line program." + "The name of the ldapsearch command line program." :type '(string :tag "`ldapsearch' Program") :group 'ldap) (defcustom ldap-ldapsearch-args '("-LL" "-tt") - "*A list of additional arguments to pass to `ldapsearch'." + "A list of additional arguments to pass to `ldapsearch'." :type '(repeat :tag "`ldapsearch' Arguments" (string :tag "Argument")) :group 'ldap) (defcustom ldap-ignore-attribute-codings nil - "*If non-nil, do not encode/decode LDAP attribute values." + "If non-nil, do not encode/decode LDAP attribute values." :type 'boolean :group 'ldap) (defcustom ldap-default-attribute-decoder nil - "*Decoder function to use for attributes whose syntax is unknown." + "Decoder function to use for attributes whose syntax is unknown." :type 'symbol :group 'ldap) (defcustom ldap-coding-system 'utf-8 - "*Coding system of LDAP string values. + "Coding system of LDAP string values. LDAP v3 specifies the coding system of strings to be UTF-8." :type 'symbol :group 'ldap)
--- a/lisp/net/net-utils.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/net/net-utils.el Mon Sep 27 14:42:43 2010 +0900 @@ -99,6 +99,9 @@ :group 'net-utils :type 'string) +(define-obsolete-variable-alias 'ipconfig-program-options + 'ifconfig-program-options "22.2") + (defcustom ifconfig-program-options (list (if (eq system-type 'windows-nt) @@ -113,9 +116,6 @@ :type 'string :version "23.1") -(define-obsolete-variable-alias 'ipconfig-program-options - 'ifconfig-program-options "22.2") - (defcustom iwconfig-program-options nil "Options for the iwconfig program." :group 'net-utils
--- a/lisp/net/netrc.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/net/netrc.el Mon Sep 27 14:42:43 2010 +0900 @@ -34,14 +34,10 @@ ;;; .netrc and .authinfo rc parsing ;;; -;; use encrypt if loaded (encrypt-file-alist has to be set as well) -(autoload 'encrypt-find-model "encrypt") -(autoload 'encrypt-insert-file-contents "encrypt") (defalias 'netrc-point-at-eol (if (fboundp 'point-at-eol) 'point-at-eol 'line-end-position)) -(defvar encrypt-file-alist) (eval-when-compile ;; This is unnecessary in the compiled version as it is a macro. (if (fboundp 'bound-and-true-p) @@ -74,12 +70,8 @@ (let ((tokens '("machine" "default" "login" "password" "account" "macdef" "force" "port")) - (encryption-model (when (netrc-bound-and-true-p encrypt-file-alist) - (encrypt-find-model file))) alist elem result pair) - (if encryption-model - (encrypt-insert-file-contents file encryption-model) - (insert-file-contents file)) + (insert-file-contents file) (goto-char (point-min)) ;; Go through the file, line by line. (while (not (eobp)) @@ -228,6 +220,17 @@ (eq type (car (cddr service))))))) (cadr service))) +(defun netrc-store-data (file host port user password) + (with-temp-buffer + (when (file-exists-p file) + (insert-file-contents file)) + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) + (insert (format "machine %s login %s password %s port %s\n" + host user password port)) + (write-region (point-min) (point-max) file nil 'silent))) + ;;;###autoload (defun netrc-credentials (machine &rest ports) "Return a user name/password pair.
--- a/lisp/net/rcompile.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/net/rcompile.el Mon Sep 27 14:42:43 2010 +0900 @@ -1,7 +1,7 @@ ;;; rcompile.el --- run a compilation on a remote machine -;; Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Albert <alon@milcse.rtsg.mot.com> ;; Maintainer: FSF @@ -75,7 +75,7 @@ (defcustom remote-compile-host nil - "*Host for remote compilations." + "Host for remote compilations." :type '(choice string (const nil)) :group 'remote-compile) @@ -86,7 +86,7 @@ :group 'remote-compile) (defcustom remote-compile-run-before nil - "*Command to run before compilation. + "Command to run before compilation. This can be used for setting up environment variables, since rsh does not invoke the shell as a login shell and files like .login \(tcsh\) and .bash_profile \(bash\) are not run. @@ -95,12 +95,12 @@ :group 'remote-compile) (defcustom remote-compile-prompt-for-host nil - "*Non-nil means prompt for host if not available from filename." + "Non-nil means prompt for host if not available from filename." :type 'boolean :group 'remote-compile) (defcustom remote-compile-prompt-for-user nil - "*Non-nil means prompt for user if not available from filename." + "Non-nil means prompt for user if not available from filename." :type 'boolean :group 'remote-compile)
--- a/lisp/net/rlogin.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/net/rlogin.el Mon Sep 27 14:42:43 2010 +0900 @@ -1,7 +1,8 @@ ;;; rlogin.el --- remote login interface ;; Copyright (C) 1992, 1993, 1994, 1995, 1997, 1998, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Noah Friedman ;; Maintainer: Noah Friedman <friedman@splode.com> @@ -45,17 +46,17 @@ :group 'unix) (defcustom rlogin-program "rlogin" - "*Name of program to invoke rlogin" + "Name of program to invoke rlogin" :type 'string :group 'rlogin) (defcustom rlogin-explicit-args nil - "*List of arguments to pass to rlogin on the command line." + "List of arguments to pass to rlogin on the command line." :type '(repeat (string :tag "Argument")) :group 'rlogin) (defcustom rlogin-mode-hook nil - "*Hooks to run after setting current buffer to rlogin-mode." + "Hooks to run after setting current buffer to rlogin-mode." :type 'hook :group 'rlogin) @@ -68,7 +69,7 @@ (string-match "-solaris2" system-configuration)) t) (t nil))) - "*If non-nil, use a pty for the local rlogin process. + "If non-nil, use a pty for the local rlogin process. If nil, use a pipe (if pipes are supported on the local system). Generally it is better not to waste ptys on systems which have a static @@ -79,7 +80,7 @@ :group 'rlogin) (defcustom rlogin-directory-tracking-mode 'local - "*Control whether and how to do directory tracking in an rlogin buffer. + "Control whether and how to do directory tracking in an rlogin buffer. nil means don't do directory tracking. @@ -103,12 +104,12 @@ (make-variable-buffer-local 'rlogin-directory-tracking-mode) (defcustom rlogin-host nil - "*The name of the remote host. This variable is buffer-local." + "The name of the remote host. This variable is buffer-local." :type '(choice (const nil) string) :group 'rlogin) (defcustom rlogin-remote-user nil - "*The username used on the remote host. + "The username used on the remote host. This variable is buffer-local and defaults to your local user name. If rlogin is invoked with the `-l' option to specify the remote username, this variable is set from that."
--- a/lisp/net/tls.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/net/tls.el Mon Sep 27 14:42:43 2010 +0900 @@ -238,6 +238,10 @@ (setq process (start-process name buffer shell-file-name shell-command-switch formatted-cmd)) + (funcall (if (fboundp 'set-process-query-on-exit-flag) + 'set-process-query-on-exit-flag + 'process-kill-without-query) + process nil) (while (and process (memq (process-status process) '(open run)) (progn
--- a/lisp/newcomment.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/newcomment.el Mon Sep 27 14:42:43 2010 +0900 @@ -319,7 +319,8 @@ "+\\)[ \t]*"))) (unless (and comment-end-skip ;; In case comment-end has changed since last time. - (string-match comment-end-skip comment-end)) + (string-match comment-end-skip + (if (string= "" comment-end) "\n" comment-end))) (let ((ce (if (string= "" comment-end) "\n" (comment-string-strip comment-end t t)))) (set (make-local-variable 'comment-end-skip)
--- a/lisp/notifications.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/notifications.el Mon Sep 27 14:42:43 2010 +0900 @@ -95,13 +95,14 @@ (funcall (cadr entry) id action) (remove entry 'notifications-on-action-map)))) -(dbus-register-signal - :session - notifications-service - notifications-path - notifications-interface - notifications-action-signal - 'notifications-on-action-signal) +(when (fboundp 'dbus-register-signal) + (dbus-register-signal + :session + notifications-service + notifications-path + notifications-interface + notifications-action-signal + 'notifications-on-action-signal)) (defun notifications-on-closed-signal (id reason) "Dispatch signals to callback functions from `notifications-on-closed-map'." @@ -111,13 +112,14 @@ id (cadr (assoc reason notifications-closed-reason))) (remove entry 'notifications-on-close-map)))) -(dbus-register-signal - :session - notifications-service - notifications-path - notifications-interface - notifications-closed-signal - 'notifications-on-closed-signal) +(when (fboundp 'dbus-register-signal) + (dbus-register-signal + :session + notifications-service + notifications-path + notifications-interface + notifications-closed-signal + 'notifications-on-closed-signal)) (defun notifications-notify (&rest params) "Send notification via D-Bus using the Freedesktop notification protocol.
--- a/lisp/org/ChangeLog Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/org/ChangeLog Mon Sep 27 14:42:43 2010 +0900 @@ -1,3 +1,8 @@ +2010-09-25 Juanma Barranquero <lekktu@gmail.com> + + * org.el (org-refile-targets): + * org-agenda.el (org-agenda-hide-tags-regexp): Fix typos in docstrings. + 2010-08-19 Glenn Morris <rgm@gnu.org> * org.el (org-outline-overlay-data, org-set-outline-overlay-data)
--- a/lisp/org/org-agenda.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/org/org-agenda.el Mon Sep 27 14:42:43 2010 +0900 @@ -1359,7 +1359,7 @@ "Regular expression used to filter away specific tags in agenda views. This means that these tags will be present, but not be shown in the agenda line. Secondary filtering will still work on the hidden tags. -Nil means don't hide any tags." +The value nil means don't hide any tags." :group 'org-agenda-line-format :type '(choice (const :tag "Hide none" nil)
--- a/lisp/org/org.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/org/org.el Mon Sep 27 14:42:43 2010 +0900 @@ -1797,8 +1797,8 @@ - a specification of the files to be considered, either a list of files, or a symbol whose function or variable value will be used to retrieve a file name or a list of file names. If you use `org-agenda-files' for - that, all agenda files will be scanned for targets. Nil means consider - headings in the current buffer. + that, all agenda files will be scanned for targets. The value nil means + consider headings in the current buffer. - A specification of how to find candidate refile targets. This may be any of: - a cons cell (:tag . \"TAG\") to identify refile targets by a tag.
--- a/lisp/play/bubbles.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/play/bubbles.el Mon Sep 27 14:42:43 2010 +0900 @@ -1377,7 +1377,7 @@ (g (nth 1 crgb)) (b (nth 2 crgb)) (brightness (/ (+ r g b) 3.0 256 256)) - (val (sin (* brightness (/ pi 2)))) + (val (sin (* brightness (/ float-pi 2)))) (rr (* red val)) (gg (* green val)) (bb (* blue val))
--- a/lisp/progmodes/compile.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/progmodes/compile.el Mon Sep 27 14:42:43 2010 +0900 @@ -2425,9 +2425,6 @@ (or compilation-auto-jump-to-first-error (eq compilation-scroll-output 'first-error)))) -;;;###autoload -(add-to-list 'auto-mode-alist (cons (purecopy "\\.gcov\\'") 'compilation-mode)) - (provide 'compile) ;; arch-tag: 12465727-7382-4f72-b234-79855a00dd8c
--- a/lisp/progmodes/etags.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/progmodes/etags.el Mon Sep 27 14:42:43 2010 +0900 @@ -68,12 +68,14 @@ :type '(repeat file)) ;;;###autoload -(defcustom tags-compression-info-list (purecopy '("" ".Z" ".bz2" ".gz" ".tgz")) +(defcustom tags-compression-info-list + (purecopy '("" ".Z" ".bz2" ".gz" ".xz" ".tgz")) "*List of extensions tried by etags when jka-compr is used. An empty string means search the non-compressed file. These extensions will be tried only if jka-compr was activated \(i.e. via customize of `auto-compression-mode' or by calling the function `auto-compression-mode')." + :version "24.1" ; added xz :type '(repeat string) :group 'etags) @@ -472,7 +474,7 @@ Looks for a tags table that has such tags or that includes a table that has them. Returns the name of the first such table. Non-nil CORE-ONLY means check only tags tables that are already in -buffers. Nil CORE-ONLY is ignored." +buffers. If CORE-ONLY is nil, it is ignored." (let ((tables tags-table-computed-list) (found nil)) ;; Loop over the list, looking for a table containing tags for THIS-FILE.
--- a/lisp/progmodes/gdb-mi.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/progmodes/gdb-mi.el Mon Sep 27 14:42:43 2010 +0900 @@ -163,7 +163,7 @@ (defvar gdb-running-threads-count nil "Number of currently running threads. -Nil means that no information is available. +If nil, no information is available. Updated in `gdb-thread-list-handler-custom'.") @@ -2051,7 +2051,7 @@ Field names are wrapped in double quotes and equal signs are replaced with semicolons. -If FIX-KEY is non-nil, strip all \"FIX-KEY=\" occurences from +If FIX-KEY is non-nil, strip all \"FIX-KEY=\" occurrences from partial output. This is used to get rid of useless keys in lists in MI messages, e.g.: [key=.., key=..]. -stack-list-frames and -break-info are examples of MI commands which issue such
--- a/lisp/progmodes/gud.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/progmodes/gud.el Mon Sep 27 14:42:43 2010 +0900 @@ -3218,13 +3218,6 @@ (goto-char (point-max))) t) -;; Besides .gdbinit, gdb documents other names to be usable for init -;; files, cross-debuggers can use something like -;; .PROCESSORNAME-gdbinit so that the host and target gdbinit files -;; don't interfere with each other. -;;;###autoload -(add-to-list 'auto-mode-alist (cons (purecopy "/\\.[a-z0-9-]*gdbinit") 'gdb-script-mode)) - ;;;###autoload (define-derived-mode gdb-script-mode nil "GDB-Script" "Major mode for editing GDB scripts."
--- a/lisp/progmodes/ld-script.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/progmodes/ld-script.el Mon Sep 27 14:42:43 2010 +0900 @@ -1,7 +1,7 @@ ;;; ld-script.el --- GNU linker script editing mode for Emacs -;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, +;; 2010 Free Software Foundation, Inc. ;; Author: Masatake YAMATO<jet@gyve.org> ;; Keywords: languages, faces @@ -76,20 +76,20 @@ (defvar ld-script-keywords '( ;; 3.4.1 Setting the Entry Point - "ENTRY" + "ENTRY" ;; 3.4.2 Commands Dealing with Files "INCLUDE" "INPUT" "GROUP" "AS_NEEDED" "OUTPUT" "SEARCH_DIR" "STARTUP" ;; 3.4.3 Commands Dealing with Object File Formats "OUTPUT_FORMAT" "TARGET" ;; 3.4.3 Other Linker Script Commands - "ASSERT" "EXTERN" "FORCE_COMMON_ALLOCATION" + "ASSERT" "EXTERN" "FORCE_COMMON_ALLOCATION" "INHIBIT_COMMON_ALLOCATION" "NOCROSSREFS" "OUTPUT_ARCH" ;; 3.5.2 PROVIDE "PROVIDE" ;; 3.5.3 PROVIDE_HIDDEN "PROVIDE_HIDDEN" ;; 3.6 SECTIONS Command - "SECTIONS" + "SECTIONS" ;; 3.6.4.2 Input Section Wildcard Patterns "SORT" "SORT_BY_NAME" "SORT_BY_ALIGNMENT" ;; 3.6.4.3 Input Section for Common Symbols @@ -157,18 +157,6 @@ cpp-font-lock-keywords) "Default font-lock-keywords for `ld-script-mode'.") -;; Linux-2.6.9 uses some different suffix for linker scripts: -;; "ld", "lds", "lds.S", "lds.in", "ld.script", and "ld.script.balo". -;; eCos uses "ld" and "ldi". -;; Netbsd uses "ldscript.*". -;;;###autoload -(add-to-list 'auto-mode-alist (purecopy '("\\.ld[si]?\\>" . ld-script-mode))) -;;;###autoload -(add-to-list 'auto-mode-alist (purecopy '("ld\\.?script\\>" . ld-script-mode))) - -;;;###autoload -(add-to-list 'auto-mode-alist (purecopy '("\\.x[bdsru]?[cn]?\\'" . ld-script-mode))) - ;;;###autoload (define-derived-mode ld-script-mode nil "LD-Script" "A major mode to edit GNU ld script files"
--- a/lisp/progmodes/mixal-mode.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/progmodes/mixal-mode.el Mon Sep 27 14:42:43 2010 +0900 @@ -125,7 +125,7 @@ (defvar mixal-operation-codes-alist ;; FIXME: the codes FADD, FSUB, FMUL, FDIV, JRAD, and FCMP were in ;; mixal-operation-codes but not here. They should probably be added here. - ;; + ;; ;; We used to define this with a backquote and subexps like ,(+ 8 3) for ;; better clarity, but the resulting code was too big and caused the ;; byte-compiler to eat up all the stack space. Even using @@ -1123,9 +1123,6 @@ (set (make-local-variable 'require-final-newline) mode-require-final-newline)) -;;;###autoload -(add-to-list 'auto-mode-alist '("\\.mixal\\'" . mixal-mode)) - (provide 'mixal-mode) ;; arch-tag: be7c128a-bf61-4951-a90e-9398267ce3f3
--- a/lisp/server.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/server.el Mon Sep 27 14:42:43 2010 +0900 @@ -565,7 +565,7 @@ (if server-use-tcp (list :family 'ipv4 ;; We're not ready for IPv6 yet :service t - :host (or server-host "127.0.0.1") ;; See bug#6781 + :host (or server-host 'local) :plist '(:authenticated nil)) (list :family 'local :service server-file
--- a/lisp/simple.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/simple.el Mon Sep 27 14:42:43 2010 +0900 @@ -4410,7 +4410,7 @@ (goto-char (next-char-property-change (point)))) ;; Move a line. ;; We don't use `end-of-line', since we want to escape - ;; from field boundaries ocurring exactly at point. + ;; from field boundaries occurring exactly at point. (goto-char (constrain-to-field (let ((inhibit-field-text-motion t)) (line-end-position))
--- a/lisp/textmodes/artist.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/textmodes/artist.el Mon Sep 27 14:42:43 2010 +0900 @@ -2939,7 +2939,7 @@ Returns a list of points. Each point is on the form (X1 . Y1)." (let ((points)) (while (> n 0) - (let* ((angle (* (random 359) (/ pi 180))) + (let* ((angle (* (random 359) (/ float-pi 180))) (dist (random radius)) (point (cons (round (* dist (cos angle))) (round (* dist (sin angle))))))
--- a/lisp/textmodes/bibtex-style.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/textmodes/bibtex-style.el Mon Sep 27 14:42:43 2010 +0900 @@ -1,6 +1,7 @@ ;;; bibtex-style.el --- Major mode for BibTeX Style files -;; Copyright (C) 2005, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2005, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> ;; Keywords: tex @@ -63,8 +64,6 @@ ("\\<\\(FUNCTION\\|MACRO\\)\\s-+{\\([^}\n]+\\)}" (2 font-lock-function-name-face)))) -;;;###autoload (add-to-list 'auto-mode-alist (cons (purecopy "\\.bst\\'") 'bibtex-style-mode)) - ;;;###autoload (define-derived-mode bibtex-style-mode nil "BibStyle" "Major mode for editing BibTeX style files."
--- a/lisp/textmodes/css-mode.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/textmodes/css-mode.el Mon Sep 27 14:42:43 2010 +0900 @@ -264,7 +264,6 @@ (defvar css-font-lock-defaults '(css-font-lock-keywords nil t)) -;;;###autoload (add-to-list 'auto-mode-alist (cons (purecopy "\\.css\\'") 'css-mode)) ;;;###autoload (define-derived-mode css-mode fundamental-mode "CSS" "Major mode to edit Cascading Style Sheets."
--- a/lisp/textmodes/dns-mode.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/textmodes/dns-mode.el Mon Sep 27 14:42:43 2010 +0900 @@ -28,11 +28,6 @@ ;; C-c C-s Increment SOA serial. ;; Understands YYYYMMDDNN, Unix time, and serial number formats, ;; and complains if it fail to find SOA serial. -;; -;; Put something similar to the following in your ~/.emacs to use this file: -;; -;; (load "~/path/to/dns-mode.el") -;; (setq auto-mode-alist (cons '("\\.soa\\'" . dns-mode) auto-mode-alist)) ;;; References: @@ -151,7 +146,6 @@ (easy-menu-add dns-mode-menu dns-mode-map)) ;;;###autoload (defalias 'zone-mode 'dns-mode) -;;;###autoload (add-to-list 'auto-mode-alist (purecopy '("\\.zone\\'" . zone-mode))) ;; Tools. @@ -223,8 +217,6 @@ ;; We return nil in case this is used in write-contents-functions. nil))) -;;;###autoload(add-to-list 'auto-mode-alist (purecopy '("\\.soa\\'" . dns-mode))) - (provide 'dns-mode) ;;; dns-mode.el ends here
--- a/lisp/textmodes/enriched.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/textmodes/enriched.el Mon Sep 27 14:42:43 2010 +0900 @@ -1,7 +1,7 @@ ;;; enriched.el --- read and save files in text/enriched format -;; Copyright (C) 1994, 1995, 1996, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 2001, 2002, 2003, 2004, 2005, 2006, +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Boris Goldowsky <boris@gnu.org> ;; Keywords: wp, faces @@ -50,7 +50,7 @@ :group 'wp) (defcustom enriched-verbose t - "*If non-nil, give status messages when reading and writing files." + "If non-nil, give status messages when reading and writing files." :type 'boolean :group 'enriched)
--- a/lisp/textmodes/makeinfo.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/textmodes/makeinfo.el Mon Sep 27 14:42:43 2010 +0900 @@ -1,7 +1,7 @@ ;;; makeinfo.el --- run makeinfo conveniently -;; Copyright (C) 1991, 1993, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1991, 1993, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Robert J. Chassell ;; Maintainer: FSF @@ -58,13 +58,13 @@ (defcustom makeinfo-run-command "makeinfo" - "*Command used to run `makeinfo' subjob. + "Command used to run `makeinfo' subjob. The name of the file is appended to this string, separated by a space." :type 'string :group 'makeinfo) (defcustom makeinfo-options "--fill-column=70" - "*String containing options for running `makeinfo'. + "String containing options for running `makeinfo'. Do not include `--footnote-style' or `--paragraph-indent'; the proper way to specify those is with the Texinfo commands `@footnotestyle` and `@paragraphindent'."
--- a/lisp/textmodes/page-ext.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/textmodes/page-ext.el Mon Sep 27 14:42:43 2010 +0900 @@ -1,7 +1,7 @@ ;;; page-ext.el --- extended page handling commands -;; Copyright (C) 1990, 1991, 1993, 1994, 2001, 2002, 2003, 2004, 2005, 2006, -;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1990, 1991, 1993, 1994, 2001, 2002, 2003, 2004, 2005, +;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Robert J. Chassell <bob@gnu.org> ;; (according to ack.texi) @@ -242,17 +242,17 @@ (defcustom pages-directory-buffer-narrowing-p t - "*If non-nil, `pages-directory-goto' narrows pages buffer to entry." + "If non-nil, `pages-directory-goto' narrows pages buffer to entry." :type 'boolean :group 'pages) (defcustom pages-directory-for-adding-page-narrowing-p t - "*If non-nil, `add-new-page' narrows page buffer to new entry." + "If non-nil, `add-new-page' narrows page buffer to new entry." :type 'boolean :group 'pages) (defcustom pages-directory-for-adding-new-page-before-current-page-p t - "*If non-nil, `add-new-page' inserts new page before current page." + "If non-nil, `add-new-page' inserts new page before current page." :type 'boolean :group 'pages) @@ -260,23 +260,23 @@ ;;; Addresses related variables (defcustom pages-addresses-file-name "~/addresses" - "*Standard name for file of addresses. Entries separated by page-delimiter. + "Standard name for file of addresses. Entries separated by page-delimiter. Used by `pages-directory-for-addresses' function." :type 'file :group 'pages) (defcustom pages-directory-for-addresses-goto-narrowing-p t - "*If non-nil, `pages-directory-goto' narrows addresses buffer to entry." + "If non-nil, `pages-directory-goto' narrows addresses buffer to entry." :type 'boolean :group 'pages) (defcustom pages-directory-for-addresses-buffer-keep-windows-p t - "*If nil, `pages-directory-for-addresses' deletes other windows." + "If nil, `pages-directory-for-addresses' deletes other windows." :type 'boolean :group 'pages) (defcustom pages-directory-for-adding-addresses-narrowing-p t - "*If non-nil, `add-new-page' narrows addresses buffer to new entry." + "If non-nil, `add-new-page' narrows addresses buffer to new entry." :type 'boolean :group 'pages)
--- a/lisp/textmodes/picture.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/textmodes/picture.el Mon Sep 27 14:42:43 2010 +0900 @@ -37,27 +37,27 @@ :group 'wp) (defcustom picture-rectangle-ctl ?+ - "*Character `picture-draw-rectangle' uses for top left corners." + "Character `picture-draw-rectangle' uses for top left corners." :type 'character :group 'picture) (defcustom picture-rectangle-ctr ?+ - "*Character `picture-draw-rectangle' uses for top right corners." + "Character `picture-draw-rectangle' uses for top right corners." :type 'character :group 'picture) (defcustom picture-rectangle-cbr ?+ - "*Character `picture-draw-rectangle' uses for bottom right corners." + "Character `picture-draw-rectangle' uses for bottom right corners." :type 'character :group 'picture) (defcustom picture-rectangle-cbl ?+ - "*Character `picture-draw-rectangle' uses for bottom left corners." + "Character `picture-draw-rectangle' uses for bottom left corners." :type 'character :group 'picture) (defcustom picture-rectangle-v ?| - "*Character `picture-draw-rectangle' uses for vertical lines." + "Character `picture-draw-rectangle' uses for vertical lines." :type 'character :group 'picture) (defcustom picture-rectangle-h ?- - "*Character `picture-draw-rectangle' uses for horizontal lines." + "Character `picture-draw-rectangle' uses for horizontal lines." :type 'character :group 'picture) @@ -363,7 +363,7 @@ ;; Picture Tabs (defcustom picture-tab-chars "!-~" - "*A character set which controls behavior of commands. + "A character set which controls behavior of commands. \\[picture-set-tab-stops] and \\[picture-tab-search]. It is NOT a regular expression, any regexp special characters will be quoted. It defines a set of \"interesting characters\" to look for when setting
--- a/lisp/textmodes/refer.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/textmodes/refer.el Mon Sep 27 14:42:43 2010 +0900 @@ -1,7 +1,7 @@ ;;; refer.el --- look up references in bibliography files -;; Copyright (C) 1992, 1996, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1992, 1996, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Ashwin Ram <ashwin@cc.gatech.edu> ;; Maintainer: Gernot Heiser <gernot@acm.org> @@ -96,7 +96,7 @@ :group 'refer) (defcustom refer-bib-files 'dir - "*List of \\.bib files to search for references, + "List of \\.bib files to search for references, or one of the following special values: nil = prompt for \\.bib file (if visiting a \\.bib file, use it as default) auto = read \\.bib file names from appropriate command in buffer (see @@ -115,7 +115,7 @@ :group 'refer) (defcustom refer-cache-bib-files t - "*Variable determining whether the value of `refer-bib-files' should be cached. + "Variable determining whether the value of `refer-bib-files' should be cached. If t, initialize the value of refer-bib-files the first time it is used. If nil, re-read the list of \\.bib files depending on the value of `refer-bib-files' each time it is needed." @@ -123,7 +123,7 @@ :group 'refer) (defcustom refer-bib-files-regexp "\\\\bibliography" - "*Regexp matching a bibliography file declaration. + "Regexp matching a bibliography file declaration. The current buffer is expected to contain a line such as \\bibliography{file1,file2,file3} which is read to set up `refer-bib-files'. The regexp must specify the command
--- a/lisp/textmodes/spell.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/textmodes/spell.el Mon Sep 27 14:42:43 2010 +0900 @@ -1,7 +1,7 @@ ;;; spell.el --- spelling correction interface for Emacs -;; Copyright (C) 1985, 2001, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1985, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: wp, unix @@ -37,12 +37,12 @@ :group 'applications) (defcustom spell-command "spell" - "*Command to run the spell program." + "Command to run the spell program." :type 'string :group 'spell) (defcustom spell-filter nil - "*Filter function to process text before passing it to spell program. + "Filter function to process text before passing it to spell program. This function might remove text-processor commands. nil means don't alter the text before checking it." :type '(choice (const nil) function)
--- a/lisp/textmodes/table.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/textmodes/table.el Mon Sep 27 14:42:43 2010 +0900 @@ -6,7 +6,6 @@ ;; Keywords: wp, convenience ;; Author: Takaaki Ota <Takaaki.Ota@am.sony.com> ;; Created: Sat Jul 08 2000 13:28:45 (PST) -;; Revised: Fri Aug 21 2009 00:16:58 (PDT) ;; This file is part of GNU Emacs. @@ -651,7 +650,7 @@ :group 'table) (defcustom table-time-before-update 0.2 - "*Time in seconds before updating the cell contents after typing. + "Time in seconds before updating the cell contents after typing. Updating the cell contents on the screen takes place only after this specified amount of time has passed after the last modification to the cell contents. When the contents of a table cell changes repetitively @@ -665,7 +664,7 @@ :group 'table) (defcustom table-time-before-reformat 0.2 - "*Time in seconds before reformatting the table. + "Time in seconds before reformatting the table. This many seconds must pass in addition to `table-time-before-update' before the table is updated with newly widened width or heightened height." @@ -674,7 +673,7 @@ :group 'table) (defcustom table-command-prefix [(control c) (control c)] - "*Key sequence to be used as prefix for table command key bindings." + "Key sequence to be used as prefix for table command key bindings." :type '(vector (repeat :inline t sexp)) :tag "Table Command Prefix" :group 'table) @@ -685,30 +684,30 @@ (((class color)) (:foreground "gray90" :background "blue")) (t (:bold t))) - "*Face used for table cell contents." + "Face used for table cell contents." :tag "Cell Face" :group 'table) (defcustom table-cell-horizontal-chars "-=" - "*Characters that may be used for table cell's horizontal border line." + "Characters that may be used for table cell's horizontal border line." :tag "Cell Horizontal Boundary Characters" :type 'string :group 'table) (defcustom table-cell-vertical-char ?\| - "*Character that forms table cell's vertical border line." + "Character that forms table cell's vertical border line." :tag "Cell Vertical Boundary Character" :type 'character :group 'table) (defcustom table-cell-intersection-char ?\+ - "*Character that forms table cell's corner." + "Character that forms table cell's corner." :tag "Cell Intersection Character" :type 'character :group 'table) (defcustom table-word-continuation-char ?\\ - "*Character that indicates word continuation into the next line. + "Character that indicates word continuation into the next line. This character has a special meaning only in the fixed width mode, that is when `table-fixed-width-mode' is non-nil . In the fixed width mode this character indicates that the location is continuing into the @@ -727,7 +726,7 @@ (set variable value)) (defcustom table-fixed-width-mode nil - "*Cell width is fixed when this is non-nil. + "Cell width is fixed when this is non-nil. Normally it should be nil for allowing automatic cell width expansion that widens a cell when it is necessary. When non-nil, typing in a cell does not automatically expand the cell width. A word that is too @@ -742,7 +741,7 @@ :group 'table) (defcustom table-detect-cell-alignment t - "*Detect cell contents alignment automatically. + "Detect cell contents alignment automatically. When non-nil cell alignment is automatically determined by the appearance of the current cell contents when recognizing tables as a whole. This applies to `table-recognize', `table-recognize-region' @@ -752,38 +751,38 @@ :group 'table) (defcustom table-dest-buffer-name "table" - "*Default buffer name (without a suffix) for source generation." + "Default buffer name (without a suffix) for source generation." :tag "Source Buffer Name" :type 'string :group 'table) (defcustom table-html-delegate-spacing-to-user-agent nil - "*Non-nil delegates cell contents spacing entirely to user agent. + "Non-nil delegates cell contents spacing entirely to user agent. Otherwise, when nil, it preserves the original spacing and line breaks." :tag "HTML delegate spacing" :type 'boolean :group 'table) (defcustom table-html-th-rows 0 - "*Number of top rows to become header cells automatically in HTML generation." + "Number of top rows to become header cells automatically in HTML generation." :tag "HTML Header Rows" :type 'integer :group 'table) (defcustom table-html-th-columns 0 - "*Number of left columns to become header cells automatically in HTML generation." + "Number of left columns to become header cells automatically in HTML generation." :tag "HTML Header Columns" :type 'integer :group 'table) (defcustom table-html-table-attribute "border=\"1\"" - "*Table attribute that applies to the table in HTML generation." + "Table attribute that applies to the table in HTML generation." :tag "HTML table attribute" :type 'string :group 'table) (defcustom table-html-cell-attribute "" - "*Cell attribute that applies to all cells in HTML generation. + "Cell attribute that applies to all cells in HTML generation. Do not specify \"align\" and \"valign\" because they are determined by the cell contents dynamically." :tag "HTML cell attribute" @@ -791,28 +790,28 @@ :group 'table) (defcustom table-cals-thead-rows 1 - "*Number of top rows to become header rows in CALS table." + "Number of top rows to become header rows in CALS table." :tag "CALS Header Rows" :type 'integer :group 'table) ;;;###autoload (defcustom table-cell-map-hook nil - "*Normal hooks run when finishing construction of `table-cell-map'. + "Normal hooks run when finishing construction of `table-cell-map'. User can modify `table-cell-map' by adding custom functions here." :tag "Cell Keymap Hooks" :type 'hook :group 'table-hooks) (defcustom table-disable-incompatibility-warning nil - "*Disable compatibility warning notice. + "Disable compatibility warning notice. When nil user is reminded of known incompatible issues." :tag "Disable Incompatibility Warning" :type 'boolean :group 'table) (defcustom table-abort-recognition-when-input-pending t - "*Abort current recognition process when input pending. + "Abort current recognition process when input pending. Abort current recognition process when we are not sure that no input is available. When non-nil lengthy recognition process is aborted simply by any key input." @@ -822,19 +821,19 @@ ;;;###autoload (defcustom table-load-hook nil - "*List of functions to be called after the table is first loaded." + "List of functions to be called after the table is first loaded." :type 'hook :group 'table-hooks) ;;;###autoload (defcustom table-point-entered-cell-hook nil - "*List of functions to be called after point entered a table cell." + "List of functions to be called after point entered a table cell." :type 'hook :group 'table-hooks) ;;;###autoload (defcustom table-point-left-cell-hook nil - "*List of functions to be called after point left a table cell." + "List of functions to be called after point left a table cell." :type 'hook :group 'table-hooks) @@ -860,7 +859,7 @@ ;;; No need of user configuration (defconst table-paragraph-start "[ \t\n\f]" - "*Regexp for beginning of a line that starts OR separates paragraphs.") + "Regexp for beginning of a line that starts OR separates paragraphs.") (defconst table-cache-buffer-name " *table cell cache*" "Cell cache buffer name.") (defvar table-cell-info-lu-coordinate nil @@ -5590,14 +5589,5 @@ (provide 'table) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Local Variables: *** -;; time-stamp-line-limit: 16 *** -;; time-stamp-start: ";; Revised:[ \t]+" *** -;; time-stamp-end: "$" *** -;; time-stamp-format: "%3a %3b %02d %:y %02H:%02M:%02S (%Z)" *** -;; End: *** -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; arch-tag: 0d69b03e-aa5f-4e72-8806-5727217617e0 ;;; table.el ends here
--- a/lisp/textmodes/tex-mode.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/textmodes/tex-mode.el Mon Sep 27 14:42:43 2010 +0900 @@ -58,14 +58,14 @@ ;;;###autoload (defcustom tex-shell-file-name nil - "*If non-nil, the shell file name to run in the subshell used to run TeX." + "If non-nil, the shell file name to run in the subshell used to run TeX." :type '(choice (const :tag "None" nil) string) :group 'tex-run) ;;;###autoload (defcustom tex-directory (purecopy ".") - "*Directory in which temporary files are written. + "Directory in which temporary files are written. You can make this `/tmp' if your TEXINPUTS has no relative directories in it and you don't try to apply \\[tex-region] or \\[tex-buffer] when there are `\\input' commands with relative directories." @@ -84,7 +84,7 @@ ;;;###autoload (defcustom tex-main-file nil - "*The main TeX source file which includes this buffer's file. + "The main TeX source file which includes this buffer's file. The command `tex-file' runs TeX on the file specified by `tex-main-file' if the variable is non-nil." :type '(choice (const :tag "None" nil) @@ -93,13 +93,13 @@ ;;;###autoload (defcustom tex-offer-save t - "*If non-nil, ask about saving modified buffers before \\[tex-file] is run." + "If non-nil, ask about saving modified buffers before \\[tex-file] is run." :type 'boolean :group 'tex-file) ;;;###autoload (defcustom tex-run-command (purecopy "tex") - "*Command used to run TeX subjob. + "Command used to run TeX subjob. TeX Mode sets `tex-command' to this string. See the documentation of that variable." :type 'string @@ -107,7 +107,7 @@ ;;;###autoload (defcustom latex-run-command (purecopy "latex") - "*Command used to run LaTeX subjob. + "Command used to run LaTeX subjob. LaTeX Mode sets `tex-command' to this string. See the documentation of that variable." :type 'string @@ -115,7 +115,7 @@ ;;;###autoload (defcustom slitex-run-command (purecopy "slitex") - "*Command used to run SliTeX subjob. + "Command used to run SliTeX subjob. SliTeX Mode sets `tex-command' to this string. See the documentation of that variable." :type 'string @@ -123,7 +123,7 @@ ;;;###autoload (defcustom tex-start-options (purecopy "") - "*TeX options to use when starting TeX. + "TeX options to use when starting TeX. These immediately precede the commands in `tex-start-commands' and the input file name, with no separating space and are not shell-quoted. If nil, TeX runs with no options. See the documentation of `tex-command'." @@ -133,7 +133,7 @@ ;;;###autoload (defcustom tex-start-commands (purecopy "\\nonstopmode\\input") - "*TeX commands to use when starting TeX. + "TeX commands to use when starting TeX. They are shell-quoted and precede the input file name, with a separating space. If nil, no commands are used. See the documentation of `tex-command'." :type '(radio (const :tag "Interactive \(nil\)" nil) @@ -157,14 +157,14 @@ ;;;###autoload (defcustom latex-block-names nil - "*User defined LaTeX block names. + "User defined LaTeX block names. Combined with `latex-standard-block-names' for minibuffer completion." :type '(repeat string) :group 'tex-run) ;;;###autoload (defcustom tex-bibtex-command (purecopy "bibtex") - "*Command used by `tex-bibtex-file' to gather bibliographic data. + "Command used by `tex-bibtex-file' to gather bibliographic data. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end." :type 'string @@ -172,7 +172,7 @@ ;;;###autoload (defcustom tex-dvi-print-command (purecopy "lpr -d") - "*Command used by \\[tex-print] to print a .dvi file. + "Command used by \\[tex-print] to print a .dvi file. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end." :type 'string @@ -180,7 +180,7 @@ ;;;###autoload (defcustom tex-alt-dvi-print-command (purecopy "lpr -d") - "*Command used by \\[tex-print] with a prefix arg to print a .dvi file. + "Command used by \\[tex-print] with a prefix arg to print a .dvi file. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by blank, is added at the end. @@ -203,7 +203,7 @@ ((eq window-system 'x) ,(purecopy "xdvi")) ((eq window-system 'w32) ,(purecopy "yap")) (t ,(purecopy "dvi2tty * | cat -s"))) - "*Command used by \\[tex-view] to display a `.dvi' file. + "Command used by \\[tex-view] to display a `.dvi' file. If it is a string, that specifies the command directly. If this string contains an asterisk (`*'), that is replaced by the file name; otherwise, the file name, preceded by a space, is added at the end. @@ -214,14 +214,14 @@ ;;;###autoload (defcustom tex-show-queue-command (purecopy "lpq") - "*Command used by \\[tex-show-print-queue] to show the print queue. + "Command used by \\[tex-show-print-queue] to show the print queue. Should show the queue(s) that \\[tex-print] puts jobs on." :type 'string :group 'tex-view) ;;;###autoload (defcustom tex-default-mode 'latex-mode - "*Mode to enter for a new file that might be either TeX or LaTeX. + "Mode to enter for a new file that might be either TeX or LaTeX. This variable is used when it can't be determined whether the file is plain TeX or LaTeX or what because the file contains no commands. Normally set to either `plain-tex-mode' or `latex-mode'." @@ -230,14 +230,14 @@ ;;;###autoload (defcustom tex-open-quote (purecopy "``") - "*String inserted by typing \\[tex-insert-quote] to open a quotation." + "String inserted by typing \\[tex-insert-quote] to open a quotation." :type 'string :options '("``" "\"<" "\"`" "<<" "«") :group 'tex) ;;;###autoload (defcustom tex-close-quote (purecopy "''") - "*String inserted by typing \\[tex-insert-quote] to close a quotation." + "String inserted by typing \\[tex-insert-quote] to close a quotation." :type 'string :options '("''" "\">" "\"'" ">>" "»") :group 'tex) @@ -327,7 +327,7 @@ ;;;; (defcustom latex-imenu-indent-string ". " - "*String to add repeated in front of nested sectional units for Imenu. + "String to add repeated in front of nested sectional units for Imenu. An alternative value is \" . \", if you use a font with a narrow period." :type 'string :group 'tex)
--- a/lisp/textmodes/two-column.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/textmodes/two-column.el Mon Sep 27 14:42:43 2010 +0900 @@ -209,19 +209,19 @@ (defcustom 2C-mode-line-format '("-%*- %15b --" (-3 . "%p") "--%[(" mode-name minor-mode-alist "%n" mode-line-process ")%]%-") - "*Value of `mode-line-format' for a buffer in two-column minor mode." + "Value of `mode-line-format' for a buffer in two-column minor mode." :type 'sexp :group 'two-column) (defcustom 2C-other-buffer-hook 'text-mode - "*Hook run in new buffer when it is associated with current one." + "Hook run in new buffer when it is associated with current one." :type 'function :group 'two-column) (defcustom 2C-separator "" - "*A string inserted between the two columns when merging. + "A string inserted between the two columns when merging. This gets set locally by \\[2C-split]." :type 'string :group 'two-column) @@ -230,7 +230,7 @@ (defcustom 2C-window-width 40 - "*The width of the first column. (Must be at least `window-min-width') + "The width of the first column. (Must be at least `window-min-width') This value is local for every buffer that sets it." :type 'integer :group 'two-column) @@ -240,7 +240,7 @@ (defcustom 2C-beyond-fill-column 4 - "*Base for calculating `fill-column' for a buffer in two-column minor mode. + "Base for calculating `fill-column' for a buffer in two-column minor mode. The value of `fill-column' becomes `2C-window-width' for this buffer minus this value." :type 'integer
--- a/lisp/url/ChangeLog Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/url/ChangeLog Mon Sep 27 14:42:43 2010 +0900 @@ -1,3 +1,26 @@ +2010-09-25 Julien Danjou <julien@danjou.info> + + * url-cache.el (url-cache-create-filename): Ensure no-port and + default-port end up with the same cache file. + (url-cache-create-filename-human-readable) + (url-cache-create-filename-using-md5): Argument is always in the form of + a string now. + +2010-09-23 Glenn Morris <rgm@gnu.org> + + * url-cache.el (url-is-cached): Doc fix. + +2010-09-23 Glenn Morris <rgm@gnu.org> + + * url-cache.el (url-cache-expired): Don't autoload. + Tweak previous change. + (url-cache-expire-time): Doc fix. + +2010-09-23 Julien Danjou <julien@danjou.info> + + * url-cache.el (url-cache-expire-time): New option. + (url-cache-expired): Rewrite. + 2010-09-19 Julien Danjou <julien@danjou.info> * url-cache.el (url-fetch-from-cache): New function.
--- a/lisp/url/url-cache.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/url/url-cache.el Mon Sep 27 14:42:43 2010 +0900 @@ -32,6 +32,13 @@ :type 'directory :group 'url-file) +(defcustom url-cache-expire-time 3600 + "Default maximum time in seconds before cache files expire. +Used by the function `url-cache-expired'." + :version "24.1" + :type 'integer + :group 'url-cache) + ;; Cache manager (defun url-cache-file-writable-p (file) "Follows the documentation of `file-writable-p', unlike `file-writable-p'." @@ -76,7 +83,8 @@ ;;;###autoload (defun url-is-cached (url) - "Return non-nil if the URL is cached." + "Return non-nil if the URL is cached. +The actual return value is the last modification time of the cache file." (let* ((fname (url-cache-create-filename url)) (attribs (file-attributes fname))) (and fname ; got a filename @@ -87,8 +95,7 @@ (defun url-cache-create-filename-human-readable (url) "Return a filename in the local cache for URL." (if url - (let* ((url (if (vectorp url) (url-recreate-url url) url)) - (urlobj (url-generic-parse-url url)) + (let* ((urlobj (url-generic-parse-url url)) (protocol (url-type urlobj)) (hostname (url-host urlobj)) (host-components @@ -146,8 +153,7 @@ Very fast if you have an `md5' primitive function, suitably fast otherwise." (require 'md5) (if url - (let* ((url (if (vectorp url) (url-recreate-url url) url)) - (checksum (md5 url)) + (let* ((checksum (md5 url)) (urlobj (url-generic-parse-url url)) (protocol (url-type urlobj)) (hostname (url-host urlobj)) @@ -177,7 +183,13 @@ :group 'url-cache) (defun url-cache-create-filename (url) - (funcall url-cache-creation-function url)) + (funcall url-cache-creation-function + ;; We need to parse+recreate in order to remove the default port + ;; if it has been specified: e.g. http://www.example.com:80 will + ;; be transcoded as http://www.example.com + (url-recreate-url + (if (vectorp url) url + (url-generic-parse-url url))))) ;;;###autoload (defun url-cache-extract (fnam) @@ -185,22 +197,19 @@ (erase-buffer) (insert-file-contents-literally fnam)) -;;;###autoload -(defun url-cache-expired (url mod) - "Return t if a cached file has expired." - (let* ((urlobj (if (vectorp url) url (url-generic-parse-url url))) - (type (url-type urlobj))) - (cond - (url-standalone-mode - (not (file-exists-p (url-cache-create-filename url)))) - ((string= type "http") - t) - ((member type '("file" "ftp")) - (if (or (equal mod '(0 0)) (not mod)) - t - (or (> (nth 0 mod) (nth 0 (current-time))) - (> (nth 1 mod) (nth 1 (current-time)))))) - (t nil)))) +(defun url-cache-expired (url &optional expire-time) + "Return non-nil if a cached URL is older than EXPIRE-TIME seconds. +The default value of EXPIRE-TIME is `url-cache-expire-time'. +If `url-standalone-mode' is non-nil, cached items never expire." + (if url-standalone-mode + (not (file-exists-p (url-cache-create-filename url))) + (let ((cache-time (url-is-cached url))) + (or (not cache-time) + (time-less-p + (time-add + cache-time + (seconds-to-time (or expire-time url-cache-expire-time))) + (current-time)))))) (provide 'url-cache)
--- a/lisp/vc/add-log.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/vc/add-log.el Mon Sep 27 14:42:43 2010 +0900 @@ -37,9 +37,6 @@ ;;; Code: -(eval-when-compile - (require 'timezone)) - (defgroup change-log nil "Change log maintenance." :group 'tools @@ -1252,19 +1249,18 @@ (change-log-get-method-definition-1 "")) (concat change-log-get-method-definition-md "]")))))) +(autoload 'timezone-make-date-sortable "timezone") + (defun change-log-sortable-date-at () "Return date of log entry in a consistent form for sorting. Point is assumed to be at the start of the entry." - (require 'timezone) (if (looking-at change-log-start-entry-re) (let ((date (match-string-no-properties 0))) (if date (if (string-match "\\(....\\)-\\(..\\)-\\(..\\)\\s-+" date) (concat (match-string 1 date) (match-string 2 date) (match-string 3 date)) - (condition-case nil - (timezone-make-date-sortable date) - (error nil))))) + (ignore-errors (timezone-make-date-sortable date))))) (error "Bad date"))) (defun change-log-resolve-conflict ()
--- a/lisp/woman.el Mon Sep 27 14:27:28 2010 +0900 +++ b/lisp/woman.el Mon Sep 27 14:42:43 2010 +0900 @@ -810,7 +810,7 @@ (defvar woman-file-regexp nil "Regexp used to select (possibly compressed) man source files, e.g. -\"\\.\\([0-9lmnt]\\w*\\)\\(\\.\\(g?z\\|bz2\\)\\)?\\'\". +\"\\.\\([0-9lmnt]\\w*\\)\\(\\.\\(g?z\\|bz2\\|xz\\)\\)?\\'\". Built automatically from the customizable user options `woman-uncompressed-file-regexp' and `woman-file-compression-regexp'.") @@ -846,16 +846,17 @@ :group 'woman-interface) (defcustom woman-file-compression-regexp - "\\.\\(g?z\\|bz2\\)\\'" + "\\.\\(g?z\\|bz2\\|xz\\)\\'" "Do not change this unless you are sure you know what you are doing! Regexp used to match compressed man file extensions for which decompressors are available and handled by auto-compression mode, -e.g. \"\\\\.\\\\(g?z\\\\|bz2\\\\)\\\\'\" for `gzip' or `bzip2'. +e.g. \"\\\\.\\\\(g?z\\\\|bz2\\\\|xz\\\\)\\\\'\" for `gzip', `bzip2', or `xz'. Should begin with \\. and end with \\' and MUST NOT be optional." ;; Should be compatible with car of ;; `jka-compr-file-name-handler-entry', but that is unduly ;; complicated, includes an inappropriate extension (.tgz) and is ;; not loaded by default! + :version "24.1" ; added xz :type 'regexp :set 'set-woman-file-regexp :group 'woman-interface)
--- a/lwlib/ChangeLog Mon Sep 27 14:27:28 2010 +0900 +++ b/lwlib/ChangeLog Mon Sep 27 14:42:43 2010 +0900 @@ -1,3 +1,11 @@ +2010-09-26 Dan Nicolaescu <dann@ics.uci.edu> + + Use const for some pointer arguments. + * lwlib.h (my_strcasecmp, safe_strcmp, name_to_widget) + (find_in_table, dialog_spec_p, lw_separator_p): + * lwlib.c (my_strcasecmp, safe_strcmp, name_to_widget) + (find_in_table, dialog_spec_p, lw_separator_p): Use const. + 2010-09-20 Dan Nicolaescu <dann@ics.uci.edu> * lwlib.h (lw_register_widget, lw_create_widget):
--- a/lwlib/lwlib.c Mon Sep 27 14:27:28 2010 +0900 +++ b/lwlib/lwlib.c Mon Sep 27 14:42:43 2010 +0900 @@ -75,7 +75,7 @@ widget_value *, int, int *); static void instantiate_widget_instance (widget_instance *); -static int my_strcasecmp (char *, char *); +static int my_strcasecmp (const char *, const char *); static void safe_free_str (char *); static void free_widget_value_tree (widget_value *); static widget_value *copy_widget_value_tree (widget_value *, @@ -92,14 +92,14 @@ static widget_info *get_widget_info (LWLIB_ID, Boolean); static widget_instance *get_widget_instance (Widget, Boolean); static widget_instance *find_instance (LWLIB_ID, Widget, Boolean); -static Boolean safe_strcmp (char *, char *); -static Widget name_to_widget (widget_instance *, char *); +static Boolean safe_strcmp (const char *, const char *); +static Widget name_to_widget (widget_instance *, const char *); static void set_one_value (widget_instance *, widget_value *, Boolean); static void update_one_widget_instance (widget_instance *, Boolean); static void update_all_widget_values (widget_info *, Boolean); static void initialize_widget_instance (widget_instance *); -static widget_creation_function find_in_table (char *, widget_creation_entry *); -static Boolean dialog_spec_p (char *); +static widget_creation_function find_in_table (const char *, const widget_creation_entry *); +static Boolean dialog_spec_p (const char *); static void destroy_one_instance (widget_instance *); static void lw_pop_all_widgets (LWLIB_ID, Boolean); static Boolean get_one_value (widget_instance *, widget_value *); @@ -120,7 +120,7 @@ /* Like strcmp but ignore differences in case. */ static int -my_strcasecmp (char *s1, char *s2) +my_strcasecmp (const char *s1, const char *s2) { while (1) { @@ -402,7 +402,7 @@ /* utility function for widget_value */ static Boolean -safe_strcmp (char *s1, char *s2) +safe_strcmp (const char *s1, const char *s2) { if (!!s1 ^ !!s2) return True; return (s1 && s2) ? strcmp (s1, s2) : s1 ? False : !!s2; @@ -586,7 +586,7 @@ /* modifying the widgets */ static Widget -name_to_widget (widget_instance *instance, char *name) +name_to_widget (widget_instance *instance, const char *name) { Widget widget = NULL; @@ -729,9 +729,9 @@ static widget_creation_function -find_in_table (char *type, widget_creation_entry *table) +find_in_table (const char *type, const widget_creation_entry *table) { - widget_creation_entry* cur; + const widget_creation_entry* cur; for (cur = table; cur->type; cur++) if (!my_strcasecmp (type, cur->type)) return cur->function; @@ -739,7 +739,7 @@ } static Boolean -dialog_spec_p (char *name) +dialog_spec_p (const char *name) { /* return True if name matches [EILPQeilpq][1-9][Bb] or [EILPQeilpq][1-9][Bb][Rr][1-9] */ @@ -1317,7 +1317,7 @@ to similar ones that are supported. */ int -lw_separator_p (char *label, enum menu_separator *type, int motif_p) +lw_separator_p (const char *label, enum menu_separator *type, int motif_p) { int separator_p = 0;
--- a/lwlib/lwlib.h Mon Sep 27 14:27:28 2010 +0900 +++ b/lwlib/lwlib.h Mon Sep 27 14:42:43 2010 +0900 @@ -186,7 +186,7 @@ MOTIF_P non-zero means map separator types not supported by Motif to similar ones that are supported. */ -int lw_separator_p (char *label, enum menu_separator *type, +int lw_separator_p (const char *label, enum menu_separator *type, int motif_p); #endif /* LWLIB_H */
--- a/msdos/ChangeLog Mon Sep 27 14:27:28 2010 +0900 +++ b/msdos/ChangeLog Mon Sep 27 14:42:43 2010 +0900 @@ -1,3 +1,9 @@ +2010-09-22 Eli Zaretskii <eliz@gnu.org> + + * sed1v2.inp (LINKER): Don't edit, variable was removed from + src/Makefile.in. + (LD_FIRSTFLAG): Edit to empty. + 2010-09-17 Eli Zaretskii <eliz@gnu.org> * sed1v2.inp (LIBXML2_LIBS, LIBXML2_CFLAGS): Edit to empty.
--- a/msdos/sed1v2.inp Mon Sep 27 14:27:28 2010 +0900 +++ b/msdos/sed1v2.inp Mon Sep 27 14:42:43 2010 +0900 @@ -31,6 +31,7 @@ /^ALL_CFLAGS *=/s/@[^@\n]*@//g /^CPPFLAGS *=/s/@[^@\n]*@// /^LDFLAGS *=/s/@[^@\n]*@// +/^LD_FIRSTFLAG *=/s/@[^@\n]*@// /^LIBS *=/s/@[^@\n]*@// /^LIBES *=/,/^ *$/ { s/@[^@\n]*@//g @@ -51,7 +52,6 @@ /^TEMACS_LDFLAGS2 *=/s/@TEMACS_LDFLAGS2@/$(LDFLAGS)/ /^LIBS_SYSTEM *=/s/@LIBS_SYSTEM@// /^LIB_GCC *=/s/@LIB_GCC@// -/^LD *=/s/@LINKER@/$(CC)/ /^LIB_STANDARD *=/s/@LIB_STANDARD@// /^LIB_MATH *=/s/@LIB_MATH@/-lm/ /^LIBTIFF *=/s/@LIBTIFF@//
--- a/nt/ChangeLog Mon Sep 27 14:27:28 2010 +0900 +++ b/nt/ChangeLog Mon Sep 27 14:42:43 2010 +0900 @@ -1,3 +1,8 @@ +2010-09-22 Juanma Barranquero <lekktu@gmail.com> + + * configure.bat: Err out when the argument of --cflags contains + invalid characters (check implemented only for GCC). (Bug#6820) + 2010-08-19 Juanma Barranquero <lekktu@gmail.com> * addpm.c (add_registry): Create App Paths of type REG_EXPAND_SZ.
--- a/nt/configure.bat Mon Sep 27 14:27:28 2010 +0900 +++ b/nt/configure.bat Mon Sep 27 14:42:43 2010 +0900 @@ -358,9 +358,25 @@ @echo gcc %cf% -c junk.c >>config.log gcc %cf% -c junk.c >>config.log 2>&1 set cf= -if exist junk.o goto gccOk +if exist junk.o goto chkuser echo The failed program was: >>config.log type junk.c >>config.log +goto nocompiler + +:chkuser +rm -f junk.o +echo int main (int argc, char *argv[]) {>junk.c +echo char *usercflags = "%usercflags%";>>junk.c +echo }>>junk.c +echo gcc -Werror -c junk.c >>config.log +gcc -Werror -c junk.c >>config.log 2>&1 +if exist junk.o goto gccOk +echo. +echo Error in --cflags argument: %usercflags% +echo Backslashes and quotes cannot be used with --cflags. Please use forward +echo slashes for filenames and paths (e.g. when passing directories to -I). +rm -f junk.c +goto end :nocompiler echo. @@ -630,6 +646,8 @@ copy config.nt config.tmp echo. >>config.tmp echo /* Start of settings from configure.bat. */ >>config.tmp +rem We write USER_CFLAGS and USER_LDFLAGS starting with a space to simplify +rem processing of compiler options in w32.c:get_emacs_configuration_options if (%docflags%) == (Y) echo #define USER_CFLAGS " %usercflags%">>config.tmp if (%doldflags%) == (Y) echo #define USER_LDFLAGS " %userldflags%">>config.tmp if (%profile%) == (Y) echo #define PROFILING 1 >>config.tmp
--- a/src/ChangeLog Mon Sep 27 14:27:28 2010 +0900 +++ b/src/ChangeLog Mon Sep 27 14:42:43 2010 +0900 @@ -24,6 +24,516 @@ (append_glyph, produce_image_glyph, append_stretch_glyph) (note_mouse_highlight): Likewise. +2010-09-26 Jan Djärv <jan.h.d@swipnet.se> + + * process.c (add_keyboard_wait_descriptor) + (delete_keyboard_wait_descriptor): Reinstate ifdef subprocesses. + (wait_reading_process_output): Don't pass write_mask to select + if SELECT_CANT_DO_WRITE_MASK is defined. + (SELECT_CANT_DO_WRITE_MASK): Define if SELECT_CANT_DO_WRITE_MASK. + + * process.h (add_read_fd, delete_read_fd, add_write_fd) + (delete_write_fd): Declare. + + * process.c (gpm_wait_mask, max_gpm_desc): Remove. + (write_mask): New variable. + (max_input_desc): Renamed from max_keyboard_desc. + (fd_callback_info): New variable. + (add_read_fd, delete_read_fd, add_write_fd, delete_write_fd): New + functions. + (Fmake_network_process): FD_SET write_mask. + (deactivate_process): FD_CLR write_mask. + (wait_reading_process_output): Connecting renamed to Writeok. + check_connect removed. check_write is new. Remove references to + gpm. Use Writeok/check_write unconditionally (i.e. no #ifdef + NON_BLOCKING_CONNECT) instead of Connecting. + Loop over file descriptors and call callbacks in fd_callback_info + if file descriptor is ready for I/O. + (add_gpm_wait_descriptor): Just call add_keyboard_wait_descriptor. + (delete_gpm_wait_descriptor): Just call delete_keyboard_wait_descriptor. + (keyboard_bit_set): Use max_input_desc. + (add_keyboard_wait_descriptor, delete_keyboard_wait_descriptor): Remove + #ifdef subprocesses. Use max_input_desc. + (init_process): Initialize write_mask and fd_callback_info. + + * keyboard.c (readable_events, gobble_input): Remove DBUS code. + + * dbusbind.c: Include process.h. + (dbus_fd_cb, xd_find_watch_fd, xd_toggle_watch) + (xd_read_message_1): New functions. + (xd_add_watch, xd_remove_watch): Call xd_find_watch_fd. Handle + watch for both read and write. + (Fdbus_init_bus): Also register xd_toggle_watch. + (Fdbus_call_method_asynchronously, Fdbus_method_return_internal) + (Fdbus_method_error_internal, Fdbus_send_signal): Remove call + to dbus_connection_flush. + (xd_read_message): Move most of the code to xd_read_message_1. + Call xd_read_message_1 until status is COMPLETE. + +2010-09-26 Dan Nicolaescu <dann@ics.uci.edu> + + * term.c: Do not include sys/ioctl.h, not needed. + (init_tty): Reorder code to reduce the number of #ifdefs. No code + changes. + +2010-09-26 Teodor Zlatanov <tzz@lifelogs.com> + + * process.h: Set up GnuTLS support. + + * process.c (make_process, Fstart_process) + (read_process_output, send_process): Set up GnuTLS support for + process input/output file descriptors. + + * gnutls.h: The GnuTLS glue for Emacs, macros and enums. + + * gnutls.c: The source code for GnuTLS support in Emacs. + + * emacs.c: Set up GnuTLS support and call syms_of_gnutls. + + * config.in: Set up GnuTLS support. + + * Makefile.in (LIBGNUTLS_LIBS, LIBGNUTLS_CFLAGS, ALL_CFLAGS) + (obj, LIBES): Set up GnuTLS support. + +2010-09-26 Juanma Barranquero <lekktu@gmail.com> + + * w32.c (get_emacs_configuration_options): Fix previous change. + +2010-09-25 Chong Yidong <cyd@stupidchicken.com> + + * insdel.c (prepare_to_modify_buffer): Ensure the mark marker is + alive before using it (Bug#6977). + +2010-09-25 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * xdisp.c (face_before_or_after_it_pos): EMACS_INT/int fixup. + + * dispextern.h: EMACS_INT/int fixup. + + * xdisp.c (string_pos_nchars_ahead, init_iterator): EMACS_INT/int + fixup. + + * xrdb.c (magic_file_p): EMACS_INT/int fixup. + +2010-09-25 Eli Zaretskii <eliz@gnu.org> + + * window.c (Fpos_visible_in_window_p, Fdelete_other_windows) + (Fselect_window, window_scroll_pixel_based) + (window_scroll_line_based, Frecenter, Fset_window_configuration): + Use EMACS_INT for buffer positions. + + * textprop.c (validate_interval_range, interval_of) + (property_change_between_p, Fadd_text_properties) + (set_text_properties_1, Fremove_text_properties) + (Fremove_list_of_text_properties, Ftext_property_any) + (Ftext_property_not_all, copy_text_properties) + (text_property_list, extend_property_ranges) + (verify_interval_modification): Use EMACS_INT for buffer + positions. + + * term.c (fast_find_position, term_mouse_highlight): Use EMACS_INT + for buffer positions. + + * process.c (read_process_output, send_process) + (Fprocess_send_region, status_notify): Use EMACS_INT for buffer + and string positions and size. + + * print.c (print_object, print_string, strout): Use EMACS_INT for + string indices. + + * minibuf.c (string_to_object): Use EMACS_INT for string position + and size. + + * marker.c (verify_bytepos): Use EMACS_INT for buffer positions. + + * lread.c <read_from_string_index, read_from_string_index_byte> + <read_from_string_limit, readchar_count>: Define EMACS_INT. + (readchar, unreadchar, read_internal_start): Use EMACS_INT for + buffer positions and string length. + + * keyboard.c <last_point_position, last_non_minibuf_size>: Declare + EMACS_INT. + (echo_truncate, adjust_point_for_property, read_char) + (gen_help_event, make_lispy_event, modify_event_symbol) + (Fexecute_extended_command, stuff_buffered_input): Use EMACS_INT + for buffer positions and string length. + + * keyboard.h (gen_help_event): Adjust prototype. + + * termhooks.h <struct input_event>: Make `code' member EMACS_INT. + + * commands.h <last_point_position>: Declare EMACS_INT. + + * xdisp.c <help_echo_pos>: Define as EMACS_INT. + (truncate_echo_area): Accept EMACS_INT argument. + + * dispextern.h <help_echo_pos>: Declare EMACS_INT. + + * lisp.h (truncate_echo_area): Adjust prototype. + + * composite.c (composition_adjust_point): Return EMACS_INT. + + * composite.h (composition_adjust_point): Adjust prototype. + +2010-09-25 Juanma Barranquero <lekktu@gmail.com> + + * process.c (Fmake_network_process): When arg :host is 'local, + use address 127.0.0.1, not name "localhost". (Bug#6781) + +2010-09-24 Eli Zaretskii <eliz@gnu.org> + + * indent.c (Fcurrent_indentation, indented_beyond_p) + (compute_motion): Use EMACS_INT for buffer position variables. + + * lisp.h (indented_beyond_p): Adjust prototype. + + * buffer.c (overlay_strings): Return EMACS_INT. + + * buffer.h (overlay_strings): Adjust prototype. + + * region-cache.c (pp_cache): Adjust format to arguments. + + * eval.c <specpdl_size, lisp_eval_depth>: Declare EMACS_INT. + (call_debugger): Use EMACS_INT for specpdl_size related variables. + (verror): Use EMACS_INT for size of allocated buffer. + + * keyboard.c (make_lispy_position): Use EMACS_INT for buffer + positions. + + * xdisp.c (redisplay_internal, try_window_id) + (set_cursor_from_row, find_first_unchanged_at_end_row): Use + EMACS_INT for buffer positions. + + * dispextern.h (set_cursor_from_row): Adjust prototype. + + * dispnew.c (increment_matrix_positions) + (increment_row_positions, copy_glyph_row_contents) + (mode_line_string, marginal_area_string): Use EMACS_INT for buffer + positions. + + * dispextern.h (mode_line_string, marginal_area_string) + (increment_matrix_positions, increment_row_positions): Adjust + prototypes. + + * data.c (Faref, Faset): Use EMACS_INT for string length and + positions. + + * cmds.c (internal_self_insert): Use EMACS_INT for the count of + characters to insert. + + * ccl.c (Fccl_execute_on_string): Use EMACS_INT for string + position and size. + + * syntax.c (scan_words, update_syntax_table) + (prev_char_comend_first, back_comment, skip_chars) + (skip_syntaxes, Fforward_comment, Fbackward_prefix_chars): Use + EMACS_INT for buffer and string positions. + + * syntax.h (scan_words, update_syntax_table): Adjust prototypes. + + * casefiddle.c (operate_on_word): Use EMACS_INT for buffer + positions. + +2010-09-24 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * scroll.c (calculate_scrolling, line_ins_del) + (calculate_direct_scrolling, scroll_cost): Fix EMACS_INT/int + conversion. + + * region-cache.c (move_cache_gap, set_cache_region, pp_cache) + (region_cache_backward, region_cache_forward) + (revalidate_region_cache, set_cache_region): FIX EMACS_INT/int + conversion. + + * xdisp.c (message_dolog): Fix EMACS_INT/int conversion. + + * eval.c (verror): Fix EMACS_INT/int conversion. + + * print.c (PRINTDECLARE, PRINTPREPARE, strout, print_string) + (print_preprocess, print_check_string_charset_prop) + (print_object): Fix EMACS_INT/int conversion. + + * xdisp.c (message_dolog): Fix EMACS_INT/int conversion. + +2010-09-24 Eli Zaretskii <eliz@gnu.org> + + * callproc.c (Fcall_process): Use EMACS_INT for count of + characters read from the subprocess. + + * bidi.c (struct bidi_paragraph_info): Use EMACS_INT for buffer + positions. + (bidi_cache_search, bidi_cache_find): Use EMACS_INT for buffer + positions. + + * buffer.c (struct sortvec): Use EMACS_INT for buffer positions. + (struct sortstrlist, overlay_str_len): Use EMACS_INT for string + length. + (advance_to_char_boundary, Fset_buffer_multibyte) + (overlays_at, overlays_in, mouse_face_overlay_overlaps) + (overlay_touches_p, record_overlay_string, overlay_strings) + (recenter_overlay_lists, fix_start_end_in_overlays) + (modify_overlay, Fmove_overlay, report_overlay_modification) + (evaporate_overlays): Use EMACS_INT for buffer positions. + + * lisp.h (fix_start_end_in_overlays, overlay_touches_p): Adjust + prototypes. + + * dispextern.h (struct bidi_saved_info): Use EMACS_INT for buffer + positions. + + * fns.c (Fcompare_strings, Fstring_lessp, concat) + (string_make_unibyte, Fstring_as_unibyte, Fsubstring) + (Fsubstring_no_properties, substring_both, Ffillarray) + (Fclear_string, mapcar1, Fmapconcat, Fmapcar, Fmapc) + (Fbase64_encode_region, Fbase64_encode_string, base64_encode_1) + (Fbase64_decode_region, Fbase64_decode_string, base64_decode_1) + (Fmd5): Use EMACS_INT for buffer and string positions and length + variables and arguments. + + * lisp.h (substring_both): Adjust prototype. + +2010-09-24 Juanma Barranquero <lekktu@gmail.com> + + Remove W32 API function pointer unused since 2005-02-15 (revno 60055). + * w32fns.c (clipboard_sequence_fn): Don't declare. + (globals_of_w32fns): Don't initialize it. + +2010-09-23 Stefan Monnier <monnier@iro.umontreal.ca> + + * syntax.c (back_comment): Detect the case where a 1-char comment + starter is also the 2nd char of a 2-char comment ender. + +2010-09-23 Jan Djärv <jan.h.d@swipnet.se> + + * gtkutil.c (xg_tool_bar_menu_proxy): Set gtk-menu-items to TRUE. + +2010-09-23 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * eval.c (verror): EMACS_INT/int cleanup. + + * lisp.h (SPECPDL_INDEX): Cast to int, since we're not going to + unwind_protect more than 2GB worth of functions. + + * editfns.c (Finsert_char): EMACS_INT/int cleanup. + + * lisp.h: Have oblookup take EMACS_INT to allow interning big + string and avoid compiler warnings. + (USE_SAFE_ALLOCA): Cast to int to avoid compilation warnings in + all users. + + * lread.c (oblookup): EMACS_INT/int cleanup. + + * cmds.c (Fforward_line, Fdelete_char): EMACS_INT/int cleanup. + +2010-09-23 Eli Zaretskii <eliz@gnu.org> + + * editfns.c (clip_to_bounds): Return an EMACS_INT value. + + * lisp.h (clip_to_bounds): Adjust prototype. + + * intervals.c (adjust_for_invis_intang): Return EMACS_INT value. + +2010-09-23 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * lisp.h: doprnt.c EMACS_INT/int cleanup. + + * doprnt.c (doprnt): EMACS_INT/int cleanup. + + * doc.c (Fsnarf_documentation, get_doc_string): EMACS_INT/int + cleanup. + + * lisp.h: Change the definition of all marker.c functions that + take and return buffer stuff to be EMACS_INT instead of int. + + * marker.c (buf_charpos_to_bytepos, CONSIDER, set_marker_both) + (buf_charpos_to_bytepos, bytepos_to_charpos) + (buf_bytepos_to_charpos, Fbuffer_has_markers_at) + (set_marker_restricted, set_marker_both): Convert int to EMACS_INT + for all buffer positions. + +2010-09-23 Chong Yidong <cyd@stupidchicken.com> + + * intervals.c (traverse_intervals, rotate_right, rotate_left) + (split_interval_right, find_interval, next_interval) + (delete_node, delete_interval, interval_deletion_adjustment) + (adjust_intervals_for_deletion, merge_interval_right) + (merge_interval_left, graft_intervals_into_buffer) + (copy_intervals): Convert EMACS_UINTs to EMACS_INT. + + * intervals.h (traverse_intervals): Update prototype. + +2010-09-23 Eli Zaretskii <eliz@gnu.org> + + * indent.c (compute_motion): Use EMACS_INT for arguments to + region_cache_forward. + + * region-cache.c (struct boundary, struct region_cache): Use + EMACS_INT for positions. + (find_cache_boundary, move_cache_gap, insert_cache_boundary) + (delete_cache_boundaries, set_cache_region) + (invalidate_region_cache, know_region_cache) + (region_cache_forward, region_cache_backward, pp_cache): Use + EMACS_INT for buffer positions. + + * region-cache.h (know_region_cache, invalidate_region_cache) + (region_cache_forward, region_cache_backward): Adjust prototypes. + + * search.c (string_match_1, fast_c_string_match_ignore_case) + (looking_at_1, scan_buffer, scan_newline) + (find_next_newline_no_quit, find_before_next_newline) + (search_command, trivial_regexp_p, search_buffer, simple_search) + (boyer_moore, wordify, Freplace_match): Use EMACS_INT for buffer + and string positions and length. + + * lisp.h (scan_buffer, scan_newline, find_next_newline_no_quit) + (find_before_next_newline): Adjust prototypes. + + * editfns.c (transpose_markers, update_buffer_properties) + (buildmark, clip_to_bounds, Fgoto_char, overlays_around) + (get_pos_property, Fconstrain_to_field) + (Fline_beginning_position, Fline_end_position, Fprevious_char) + (Fchar_after, Fchar_before, Finsert_char) + (Finsert_buffer_substring, Fcompare_buffer_substrings) + (Fsubst_char_in_region, Fformat, Ftranspose_regions): Use + EMACS_INT for buffer and string position variables. + (Finsert_char): Protect against too large insertions. + + * lisp.h (clip_to_bounds): Adjust prototype. + + * intervals.c (traverse_intervals, rotate_right, rotate_left) + (balance_an_interval, split_interval_right, split_interval_left) + (find_interval, next_interval, update_interval) + (adjust_intervals_for_insertion, delete_node, delete_interval) + (interval_deletion_adjustment, adjust_intervals_for_deletion) + (offset_intervals, merge_interval_right, merge_interval_left) + (graft_intervals_into_buffer, adjust_for_invis_intang) + (move_if_not_intangible, get_local_map, copy_intervals) + (copy_intervals_to_string, compare_string_intervals) + (set_intervals_multibyte_1): Use EMACS_INT for buffer positions + and for interval tree size. + + * intervals.h (traverse_intervals, split_interval_right) + (split_interval_left, find_interval, offset_intervals) + (graft_intervals_into_buffer, copy_intervals) + (copy_intervals_to_string, move_if_not_intangible, get_local_map) + (update_interval): Adjust prototypes. + + * xdisp.c (check_point_in_composition, reconsider_clip_changes): + Use EMACS_INT for buffer position variables and arguments. + + * composite.c (get_composition_id, find_composition) + (run_composition_function, compose_text) + (composition_gstring_width, autocmp_chars) + (composition_update_it, Ffind_composition_internal): Use EMACS_INT + for buffer positions and string length variables and arguments. + + * composite.h (get_composition_id, find_composition, compose_text) + (composition_gstring_width): Adjust prototypes. + + * editfns.c (Fformat): Use EMACS_INT for string size variables. + + * xdisp.c (store_mode_line_noprop, display_mode_element): Use + EMACS_INT for string positions. + + * intervals.c (get_property_and_range): Use EMACS_INT for buffer + position arguments. + + * intervals.h (get_property_and_range): Adjust prototype. + + * character.c (parse_str_as_multibyte, str_as_multibyte) + (parse_str_to_multibyte, str_to_multibyte, str_as_unibyte) + (string_count_byte8, string_escape_byte8, c_string_width) + (strwidth, lisp_string_width, multibyte_chars_in_text): Use + EMACS_INT for string length variables and arguments. + + * character.h (parse_str_as_multibyte, str_as_multibyte) + (parse_str_to_multibyte, str_to_multibyte, str_as_unibyte) + (c_string_width, strwidth, lisp_string_width): Adjust + prototypes. + + * font.c (font_intern_prop): Use EMACS_INT for string length + variables. + + * font.c (font_intern_prop): Use EMACS_INT for string length + variables. + + * fns.c (Fstring_as_multibyte): Use EMACS_INT for string length + variables. + + * alloc.c <total_string_size>: Declare as EMACS_INT, not int. + (Fmake_string): Protect against too large strings. + (live_string_p, live_cons_p, live_symbol_p, live_float_p) + (live_misc_p): Use ptrdiff_t instead of int for pointer + differences. + (string_bytes, check_sblock, check_string_free_list) + (allocate_string_data, compact_small_strings, Fmake_string) + (Fmake_bool_vector, make_string, make_unibyte_string) + (make_multibyte_string, make_string_from_bytes) + (make_specified_string_string, Fmake_list, Fmake_vector): Use + EMACS_INT for string length variables and arguments. + (find_string_data_in_pure, make_pure_string, make_pure_c_string) + (Fpurecopy): Use EMACS_INT for string size. + (mark_vectorlike, mark_char_table, mark_object): Use EMACS_UINT + for vector size. + + * lisp.h (make_string, make_unibyte_string, make_multibyte_string) + (make_string_from_bytes, make_specified_string_string) + (make_pure_string, string_bytes, check_point_in_composition): + Adjust prototypes. + +2010-09-22 Eli Zaretskii <eliz@gnu.org> + + * editfns.c (Fsubst_char_in_region, Ftranslate_region_internal) + (check_translation): Use EMACS_INT for buffer positions and + length. + + * undo.c (record_marker_adjustment, record_delete) + (record_change, record_point, record_insert) + (record_property_change, Fprimitive_undo): Use EMACS_INT for + buffer positions. + + * lisp.h (record_marker_adjustment, record_delete) + (record_change, record_point, record_insert) + (record_property_change, Fprimitive_undo): Adjust prototypes. + +2010-09-22 Juanma Barranquero <lekktu@gmail.com> + Eli Zaretskii <eliz@gnu.org> + + * w32.c (get_emacs_configuration_options): Fix buffer overrun. + +2010-09-22 Eli Zaretskii <eliz@gnu.org> + + * minibuf.c (Fminibuffer_contents) + (Fminibuffer_contents_no_properties) + (Fminibuffer_completion_contents): Use EMACS_INT for minibuffer + positions. + + * keyboard.c (command_loop_1): Use EMACS_INT to compare point with + mark. + + * alloc.c (make_uninit_string, make_uninit_multibyte_string) + (allocate_string_data): Accept EMACS_INT for string length. + + * editfns.c (Ffield_string, Ffield_string_no_properties) + (make_buffer_string, make_buffer_string_both, Fbuffer_substring) + (Fbuffer_substring_no_properties, find_field, Fdelete_field) + (Ffield_string, Ffield_string_no_properties, Ffield_beginning) + (Ffield_end): Use EMACS_INT for buffer positions. + + * insdel.c (prepare_to_modify_buffer): Use EMACS_INT to compare + point with mark. + + * lisp.h (allocate_string_data, make_uninit_string) + (make_uninit_multibyte_string, make_buffer_string) + (make_buffer_string_both): Adjust prototypes. + +2010-09-22 Chong Yidong <cyd@stupidchicken.com> + + * xml.c: Switch to GNU indentation. + (make_dom): Change parse tree format to match xml.el. + (Fxml_parse_html_string_internal): Rename from html-parse-string. + (Fxml_parse_string_internal): Rename from xml-parse-string. + 2010-09-22 Kenichi Handa <handa@m17n.org> * xdisp.c (compute_stop_pos): Call composition_compute_stop_pos @@ -18809,7 +19319,7 @@ (Ffont_shape_text): New function. (Fopen_font): If the font size is not given, use 12-pixel. (Ffont_at): New arg STRING. - (syms_of_font): Initalize font_charset_alist. + (syms_of_font): Initialize font_charset_alist. Declare Ffont_shape_text as a Lisp function. Call syms_of_XXfont conditionally. @@ -19806,7 +20316,7 @@ * font.c (font_unparse_fcname): Fix typo (swidth->width). (font_list_entities): Check driver_list->on. - (register_font_driver): Initalize `on' member to 0. + (register_font_driver): Initialize `on' member to 0. (font_update_drivers): New function. (Fclear_font_cache): Check driver_list->on.
--- a/src/ChangeLog.5 Mon Sep 27 14:27:28 2010 +0900 +++ b/src/ChangeLog.5 Mon Sep 27 14:42:43 2010 +0900 @@ -4093,7 +4093,7 @@ * xterm.h: Delete X10 code. - * xfns.c (Fx_create_frame): Don't increment refernce_count + * xfns.c (Fx_create_frame): Don't increment reference_count until the frame is put on the frame list. * xterm.c (x_initialize): Init x_noop_count, x_focus_frame
--- a/src/ChangeLog.7 Mon Sep 27 14:27:28 2010 +0900 +++ b/src/ChangeLog.7 Mon Sep 27 14:42:43 2010 +0900 @@ -1040,7 +1040,7 @@ * lread.c: Remember the last TWO strings skipped with #@. (prev_saved_doc_string*): New variables. - (Fload): Initalize prev_saved_doc_string. + (Fload): Initialize prev_saved_doc_string. (read1): Copy saved_doc_string to prev_saved_doc_string before storing a new string in saved_doc_string. (read_list): Look in prev_saved_doc_string as well as
--- a/src/Makefile.in Mon Sep 27 14:27:28 2010 +0900 +++ b/src/Makefile.in Mon Sep 27 14:42:43 2010 +0900 @@ -286,6 +286,9 @@ LIBSELINUX_LIBS = @LIBSELINUX_LIBS@ +LIBGNUTLS_LIBS = @LIBGNUTLS_LIBS@ +LIBGNUTLS_CFLAGS = @LIBGNUTLS_CFLAGS@ + INTERVALS_H = dispextern.h intervals.h composite.h GETLOADAVG_LIBS = @GETLOADAVG_LIBS@ @@ -325,6 +328,7 @@ ${LIBXML2_CFLAGS} ${DBUS_CFLAGS} \ ${GCONF_CFLAGS} ${FREETYPE_CFLAGS} ${FONTCONFIG_CFLAGS} \ ${LIBOTF_CFLAGS} ${M17N_FLT_CFLAGS} ${DEPFLAGS} ${PROFILING_CFLAGS} \ + $(LIBGNUTLS_CFLAGS) \ ${C_WARNINGS_SWITCH} ${CFLAGS} ALL_OBJC_CFLAGS=$(ALL_CFLAGS) $(GNU_OBJC_CFLAGS) @@ -349,7 +353,7 @@ alloc.o data.o doc.o editfns.o callint.o \ eval.o floatfns.o fns.o font.o print.o lread.o \ syntax.o $(UNEXEC_OBJ) bytecode.o \ - process.o callproc.o \ + process.o gnutls.o callproc.o \ region-cache.o sound.o atimer.o \ doprnt.o strftime.o intervals.o textprop.o composite.o md5.o xml.o \ $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) @@ -601,6 +605,7 @@ ${LIBXML2_LIBS} $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) \ $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) ${GCONF_LIBS} ${LIBSELINUX_LIBS} \ $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ + $(LIBGNUTLS_LIBS) \ $(LIB_GCC) $(LIB_MATH) $(LIB_STANDARD) $(LIB_GCC) all: emacs${EXEEXT} $(OTHER_FILES)
--- a/src/alloc.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/alloc.c Mon Sep 27 14:42:43 2010 +0900 @@ -1644,7 +1644,7 @@ /* Number of bytes used by live strings. */ -static int total_string_size; +static EMACS_INT total_string_size; /* Given a pointer to a Lisp_String S which is on the free-list string_free_list, return a pointer to its successor in the @@ -1739,11 +1739,12 @@ /* Like GC_STRING_BYTES, but with debugging check. */ -int -string_bytes (s) - struct Lisp_String *s; +EMACS_INT +string_bytes (struct Lisp_String *s) { - int nbytes = (s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte); + EMACS_INT nbytes = + (s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte); + if (!PURE_POINTER_P (s) && s->data && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s))) @@ -1765,7 +1766,7 @@ { /* Compute the next FROM here because copying below may overwrite data we need to compute it. */ - int nbytes; + EMACS_INT nbytes; /* Check that the string size recorded in the string is the same as the one recorded in the sdata structure. */ @@ -1825,7 +1826,7 @@ s = string_free_list; while (s != NULL) { - if ((unsigned)s < 1024) + if ((unsigned long)s < 1024) abort(); s = NEXT_FREE_LISP_STRING (s); } @@ -1908,11 +1909,12 @@ S->data if it was initially non-null. */ void -allocate_string_data (struct Lisp_String *s, int nchars, int nbytes) +allocate_string_data (struct Lisp_String *s, + EMACS_INT nchars, EMACS_INT nbytes) { struct sdata *data, *old_data; struct sblock *b; - int needed, old_nbytes; + EMACS_INT needed, old_nbytes; /* Determine the number of bytes needed to store NBYTES bytes of string data. */ @@ -2154,7 +2156,7 @@ { /* Compute the next FROM here because copying below may overwrite data we need to compute it. */ - int nbytes; + EMACS_INT nbytes; #ifdef GC_CHECK_STRING_BYTES /* Check that the string size recorded in the string is the @@ -2232,7 +2234,8 @@ { register Lisp_Object val; register unsigned char *p, *end; - int c, nbytes; + int c; + EMACS_INT nbytes; CHECK_NATNUM (length); CHECK_NUMBER (init); @@ -2251,9 +2254,12 @@ { unsigned char str[MAX_MULTIBYTE_LENGTH]; int len = CHAR_STRING (c, str); - - nbytes = len * XINT (length); - val = make_uninit_multibyte_string (XINT (length), nbytes); + EMACS_INT string_len = XINT (length); + + if (string_len > MOST_POSITIVE_FIXNUM / len) + error ("Maximum string size exceeded"); + nbytes = len * string_len; + val = make_uninit_multibyte_string (string_len, nbytes); p = SDATA (val); end = p + nbytes; while (p != end) @@ -2276,7 +2282,8 @@ register Lisp_Object val; struct Lisp_Bool_Vector *p; int real_init, i; - int length_in_chars, length_in_elts, bits_per_value; + EMACS_INT length_in_chars, length_in_elts; + int bits_per_value; CHECK_NATNUM (length); @@ -2316,10 +2323,10 @@ multibyte, depending on the contents. */ Lisp_Object -make_string (const char *contents, int nbytes) +make_string (const char *contents, EMACS_INT nbytes) { register Lisp_Object val; - int nchars, multibyte_nbytes; + EMACS_INT nchars, multibyte_nbytes; parse_str_as_multibyte (contents, nbytes, &nchars, &multibyte_nbytes); if (nbytes == nchars || nbytes != multibyte_nbytes) @@ -2335,7 +2342,7 @@ /* Make an unibyte string from LENGTH bytes at CONTENTS. */ Lisp_Object -make_unibyte_string (const char *contents, int length) +make_unibyte_string (const char *contents, EMACS_INT length) { register Lisp_Object val; val = make_uninit_string (length); @@ -2349,7 +2356,8 @@ bytes at CONTENTS. */ Lisp_Object -make_multibyte_string (const char *contents, int nchars, int nbytes) +make_multibyte_string (const char *contents, + EMACS_INT nchars, EMACS_INT nbytes) { register Lisp_Object val; val = make_uninit_multibyte_string (nchars, nbytes); @@ -2362,7 +2370,8 @@ CONTENTS. It is a multibyte string if NBYTES != NCHARS. */ Lisp_Object -make_string_from_bytes (const char *contents, int nchars, int nbytes) +make_string_from_bytes (const char *contents, + EMACS_INT nchars, EMACS_INT nbytes) { register Lisp_Object val; val = make_uninit_multibyte_string (nchars, nbytes); @@ -2379,7 +2388,8 @@ characters by itself. */ Lisp_Object -make_specified_string (const char *contents, int nchars, int nbytes, int multibyte) +make_specified_string (const char *contents, + EMACS_INT nchars, EMACS_INT nbytes, int multibyte) { register Lisp_Object val; @@ -2412,7 +2422,7 @@ occupying LENGTH bytes. */ Lisp_Object -make_uninit_string (int length) +make_uninit_string (EMACS_INT length) { Lisp_Object val; @@ -2428,7 +2438,7 @@ which occupy NBYTES bytes. */ Lisp_Object -make_uninit_multibyte_string (int nchars, int nbytes) +make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes) { Lisp_Object string; struct Lisp_String *s; @@ -2767,7 +2777,7 @@ (register Lisp_Object length, Lisp_Object init) { register Lisp_Object val; - register int size; + register EMACS_INT size; CHECK_NATNUM (length); size = XFASTINT (length); @@ -2945,7 +2955,7 @@ { Lisp_Object vector; register EMACS_INT sizei; - register int index; + register EMACS_INT index; register struct Lisp_Vector *p; CHECK_NATNUM (length); @@ -3785,7 +3795,7 @@ if (m->type == MEM_TYPE_STRING) { struct string_block *b = (struct string_block *) m->start; - int offset = (char *) p - (char *) &b->strings[0]; + ptrdiff_t offset = (char *) p - (char *) &b->strings[0]; /* P must point to the start of a Lisp_String structure, and it must not be on the free-list. */ @@ -3808,7 +3818,7 @@ if (m->type == MEM_TYPE_CONS) { struct cons_block *b = (struct cons_block *) m->start; - int offset = (char *) p - (char *) &b->conses[0]; + ptrdiff_t offset = (char *) p - (char *) &b->conses[0]; /* P must point to the start of a Lisp_Cons, not be one of the unused cells in the current cons block, @@ -3834,7 +3844,7 @@ if (m->type == MEM_TYPE_SYMBOL) { struct symbol_block *b = (struct symbol_block *) m->start; - int offset = (char *) p - (char *) &b->symbols[0]; + ptrdiff_t offset = (char *) p - (char *) &b->symbols[0]; /* P must point to the start of a Lisp_Symbol, not be one of the unused cells in the current symbol block, @@ -3860,7 +3870,7 @@ if (m->type == MEM_TYPE_FLOAT) { struct float_block *b = (struct float_block *) m->start; - int offset = (char *) p - (char *) &b->floats[0]; + ptrdiff_t offset = (char *) p - (char *) &b->floats[0]; /* P must point to the start of a Lisp_Float and not be one of the unused cells in the current float block. */ @@ -3884,7 +3894,7 @@ if (m->type == MEM_TYPE_MISC) { struct marker_block *b = (struct marker_block *) m->start; - int offset = (char *) p - (char *) &b->markers[0]; + ptrdiff_t offset = (char *) p - (char *) &b->markers[0]; /* P must point to the start of a Lisp_Misc, not be one of the unused cells in the current misc block, @@ -4591,9 +4601,10 @@ address. Return NULL if not found. */ static char * -find_string_data_in_pure (const char *data, int nbytes) +find_string_data_in_pure (const char *data, EMACS_INT nbytes) { - int i, skip, bm_skip[256], last_char_skip, infinity, start, start_max; + int i; + EMACS_INT skip, bm_skip[256], last_char_skip, infinity, start, start_max; const unsigned char *p; char *non_lisp_beg; @@ -4660,7 +4671,8 @@ string; then the string is not protected from gc. */ Lisp_Object -make_pure_string (const char *data, int nchars, int nbytes, int multibyte) +make_pure_string (const char *data, + EMACS_INT nchars, EMACS_INT nbytes, int multibyte) { Lisp_Object string; struct Lisp_String *s; @@ -4688,7 +4700,7 @@ { Lisp_Object string; struct Lisp_String *s; - int nchars = strlen (data); + EMACS_INT nchars = strlen (data); s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String); s->size = nchars; @@ -4778,7 +4790,7 @@ else if (COMPILEDP (obj) || VECTORP (obj)) { register struct Lisp_Vector *vec; - register int i; + register EMACS_INT i; EMACS_INT size; size = XVECTOR (obj)->size; @@ -5227,8 +5239,8 @@ static void mark_vectorlike (struct Lisp_Vector *ptr) { - register EMACS_INT size = ptr->size; - register int i; + register EMACS_UINT size = ptr->size; + register EMACS_UINT i; eassert (!VECTOR_MARKED_P (ptr)); VECTOR_MARK (ptr); /* Else mark it */ @@ -5250,8 +5262,8 @@ static void mark_char_table (struct Lisp_Vector *ptr) { - register EMACS_INT size = ptr->size & PSEUDOVECTOR_SIZE_MASK; - register int i; + register EMACS_UINT size = ptr->size & PSEUDOVECTOR_SIZE_MASK; + register EMACS_UINT i; eassert (!VECTOR_MARKED_P (ptr)); VECTOR_MARK (ptr); @@ -5380,8 +5392,8 @@ recursion there. */ { register struct Lisp_Vector *ptr = XVECTOR (obj); - register EMACS_INT size = ptr->size; - register int i; + register EMACS_UINT size = ptr->size; + register EMACS_UINT i; CHECK_LIVE (live_vector_p); VECTOR_MARK (ptr); /* Else mark it */
--- a/src/bidi.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/bidi.c Mon Sep 27 14:42:43 2010 +0900 @@ -79,10 +79,10 @@ /* What we need to know about the current paragraph. */ struct bidi_paragraph_info { - int start_bytepos; /* byte position where it begins */ - int end_bytepos; /* byte position where it ends */ - int embedding_level; /* its basic embedding level */ - bidi_dir_t base_dir; /* its base direction */ + EMACS_INT start_bytepos; /* byte position where it begins */ + EMACS_INT end_bytepos; /* byte position where it ends */ + int embedding_level; /* its basic embedding level */ + bidi_dir_t base_dir; /* its base direction */ }; /* Data type for describing the bidirectional character categories. */ @@ -313,7 +313,7 @@ resolved levels in cached states. DIR, if non-zero, means search in that direction from the last cache hit. */ static INLINE int -bidi_cache_search (int charpos, int level, int dir) +bidi_cache_search (EMACS_INT charpos, int level, int dir) { int i, i_start; @@ -462,7 +462,7 @@ } static INLINE bidi_type_t -bidi_cache_find (int charpos, int level, struct bidi_it *bidi_it) +bidi_cache_find (EMACS_INT charpos, int level, struct bidi_it *bidi_it) { int i = bidi_cache_search (charpos, level, bidi_it->scan_dir);
--- a/src/buffer.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/buffer.c Mon Sep 27 14:42:43 2010 +0900 @@ -2092,7 +2092,7 @@ and return the adjusted position. */ static int -advance_to_char_boundary (int byte_pos) +advance_to_char_boundary (EMACS_INT byte_pos) { int c; @@ -2105,7 +2105,7 @@ { /* We should advance BYTE_POS only when C is a constituent of a multibyte sequence. */ - int orig_byte_pos = byte_pos; + EMACS_INT orig_byte_pos = byte_pos; do { @@ -2273,7 +2273,7 @@ { struct Lisp_Marker *tail, *markers; struct buffer *other; - int begv, zv; + EMACS_INT begv, zv; int narrowed = (BEG != BEGV || Z != ZV); int modified_p = !NILP (Fbuffer_modified_p (Qnil)); Lisp_Object old_undo = current_buffer->undo_list; @@ -2305,7 +2305,7 @@ if (NILP (flag)) { - int pos, stop; + EMACS_INT pos, stop; unsigned char *p; /* Do this first, so it can use CHAR_TO_BYTE @@ -2369,8 +2369,8 @@ } else { - int pt = PT; - int pos, stop; + EMACS_INT pt = PT; + EMACS_INT pos, stop; unsigned char *p, *pend; /* Be sure not to have a multibyte sequence striding over the GAP. @@ -2386,7 +2386,7 @@ while (! CHAR_HEAD_P (*p) && p > BEG_ADDR) p--; if (LEADING_CODE_P (*p)) { - int new_gpt = GPT_BYTE - (GPT_ADDR - p); + EMACS_INT new_gpt = GPT_BYTE - (GPT_ADDR - p); move_gap_both (new_gpt, new_gpt); } @@ -2470,8 +2470,8 @@ ZV = chars_in_text (BEG_ADDR, ZV_BYTE - BEG_BYTE) + BEG; { - int pt_byte = advance_to_char_boundary (PT_BYTE); - int pt; + EMACS_INT pt_byte = advance_to_char_boundary (PT_BYTE); + EMACS_INT pt; if (pt_byte > GPT_BYTE) pt = chars_in_text (GAP_END_ADDR, pt_byte - GPT_BYTE) + GPT; @@ -2642,13 +2642,13 @@ int idx = 0; int len = *len_ptr; Lisp_Object *vec = *vec_ptr; - int next = ZV; - int prev = BEGV; + EMACS_INT next = ZV; + EMACS_INT prev = BEGV; int inhibit_storing = 0; for (tail = current_buffer->overlays_before; tail; tail = tail->next) { - int startpos, endpos; + EMACS_INT startpos, endpos; XSETMISC (overlay, tail); @@ -2699,7 +2699,7 @@ for (tail = current_buffer->overlays_after; tail; tail = tail->next) { - int startpos, endpos; + EMACS_INT startpos, endpos; XSETMISC (overlay, tail); @@ -2773,22 +2773,23 @@ But we still return the total number of overlays. */ static int -overlays_in (int beg, int end, int extend, Lisp_Object **vec_ptr, int *len_ptr, - int *next_ptr, int *prev_ptr) +overlays_in (EMACS_INT beg, EMACS_INT end, int extend, + Lisp_Object **vec_ptr, int *len_ptr, + EMACS_INT *next_ptr, EMACS_INT *prev_ptr) { Lisp_Object overlay, ostart, oend; struct Lisp_Overlay *tail; int idx = 0; int len = *len_ptr; Lisp_Object *vec = *vec_ptr; - int next = ZV; - int prev = BEGV; + EMACS_INT next = ZV; + EMACS_INT prev = BEGV; int inhibit_storing = 0; int end_is_Z = end == Z; for (tail = current_buffer->overlays_before; tail; tail = tail->next) { - int startpos, endpos; + EMACS_INT startpos, endpos; XSETMISC (overlay, tail); @@ -2838,7 +2839,7 @@ for (tail = current_buffer->overlays_after; tail; tail = tail->next) { - int startpos, endpos; + EMACS_INT startpos, endpos; XSETMISC (overlay, tail); @@ -2897,8 +2898,8 @@ int mouse_face_overlay_overlaps (Lisp_Object overlay) { - int start = OVERLAY_POSITION (OVERLAY_START (overlay)); - int end = OVERLAY_POSITION (OVERLAY_END (overlay)); + EMACS_INT start = OVERLAY_POSITION (OVERLAY_START (overlay)); + EMACS_INT end = OVERLAY_POSITION (OVERLAY_END (overlay)); int n, i, size; Lisp_Object *v, tem; @@ -2924,14 +2925,14 @@ /* Fast function to just test if we're at an overlay boundary. */ int -overlay_touches_p (int pos) +overlay_touches_p (EMACS_INT pos) { Lisp_Object overlay; struct Lisp_Overlay *tail; for (tail = current_buffer->overlays_before; tail; tail = tail->next) { - int endpos; + EMACS_INT endpos; XSETMISC (overlay ,tail); if (!OVERLAYP (overlay)) @@ -2946,7 +2947,7 @@ for (tail = current_buffer->overlays_after; tail; tail = tail->next) { - int startpos; + EMACS_INT startpos; XSETMISC (overlay, tail); if (!OVERLAYP (overlay)) @@ -2964,7 +2965,7 @@ struct sortvec { Lisp_Object overlay; - int beg, end; + EMACS_INT beg, end; int priority; }; @@ -3051,7 +3052,7 @@ struct sortstr *buf; /* An array that expands as needed; never freed. */ int size; /* Allocated length of that array. */ int used; /* How much of the array is currently in use. */ - int bytes; /* Total length of the strings in buf. */ + EMACS_INT bytes; /* Total length of the strings in buf. */ }; /* Buffers for storing information about the overlays touching a given @@ -3062,7 +3063,7 @@ static unsigned char *overlay_str_buf; /* Allocated length of overlay_str_buf. */ -static int overlay_str_len; +static EMACS_INT overlay_str_len; /* A comparison function suitable for passing to qsort. */ static int @@ -3080,7 +3081,7 @@ static void record_overlay_string (struct sortstrlist *ssl, Lisp_Object str, Lisp_Object str2, Lisp_Object pri, int size) { - int nbytes; + EMACS_INT nbytes; if (ssl->used == ssl->size) { @@ -3133,12 +3134,12 @@ PSTR, if that variable is non-null. The string may be overwritten by subsequent calls. */ -int +EMACS_INT overlay_strings (EMACS_INT pos, struct window *w, unsigned char **pstr) { Lisp_Object overlay, window, str; struct Lisp_Overlay *ov; - int startpos, endpos; + EMACS_INT startpos, endpos; int multibyte = ! NILP (current_buffer->enable_multibyte_characters); overlay_heads.used = overlay_heads.bytes = 0; @@ -3208,9 +3209,9 @@ if (overlay_heads.bytes || overlay_tails.bytes) { Lisp_Object tem; - int i; + EMACS_INT i; unsigned char *p; - int total = overlay_heads.bytes + overlay_tails.bytes; + EMACS_INT total = overlay_heads.bytes + overlay_tails.bytes; if (total > overlay_str_len) { @@ -3221,7 +3222,7 @@ p = overlay_str_buf; for (i = overlay_tails.used; --i >= 0;) { - int nbytes; + EMACS_INT nbytes; tem = overlay_tails.buf[i].string; nbytes = copy_text (SDATA (tem), p, SBYTES (tem), @@ -3230,7 +3231,7 @@ } for (i = 0; i < overlay_heads.used; ++i) { - int nbytes; + EMACS_INT nbytes; tem = overlay_heads.buf[i].string; nbytes = copy_text (SDATA (tem), p, SBYTES (tem), @@ -3295,7 +3296,7 @@ if (OVERLAY_POSITION (end) > pos) { /* OVERLAY needs to be moved. */ - int where = OVERLAY_POSITION (beg); + EMACS_INT where = OVERLAY_POSITION (beg); struct Lisp_Overlay *other, *other_prev; /* Splice the cons cell TAIL out of overlays_before. */ @@ -3368,7 +3369,7 @@ if (OVERLAY_POSITION (end) <= pos) { /* OVERLAY needs to be moved. */ - int where = OVERLAY_POSITION (end); + EMACS_INT where = OVERLAY_POSITION (end); struct Lisp_Overlay *other, *other_prev; /* Splice the cons cell TAIL out of overlays_after. */ @@ -3440,7 +3441,7 @@ Such an overlay might even have negative size at this point. If so, we'll make the overlay empty. */ void -fix_start_end_in_overlays (register int start, register int end) +fix_start_end_in_overlays (register EMACS_INT start, register EMACS_INT end) { Lisp_Object overlay; struct Lisp_Overlay *before_list, *after_list; @@ -3452,7 +3453,7 @@ current_buffer->overlays_before or overlays_after, depending which loop we're in. */ struct Lisp_Overlay *tail, *parent; - int startpos, endpos; + EMACS_INT startpos, endpos; /* This algorithm shifts links around instead of consing and GCing. The loop invariant is that before_list (resp. after_list) is a @@ -3753,7 +3754,7 @@ { if (start > end) { - int temp = start; + EMACS_INT temp = start; start = end; end = temp; } @@ -3844,8 +3845,8 @@ /* Redisplay where the overlay was. */ if (!NILP (obuffer)) { - int o_beg; - int o_end; + EMACS_INT o_beg; + EMACS_INT o_end; o_beg = OVERLAY_POSITION (OVERLAY_START (overlay)); o_end = OVERLAY_POSITION (OVERLAY_END (overlay)); @@ -3859,7 +3860,7 @@ else /* Redisplay the area the overlay has just left, or just enclosed. */ { - int o_beg, o_end; + EMACS_INT o_beg, o_end; o_beg = OVERLAY_POSITION (OVERLAY_START (overlay)); o_end = OVERLAY_POSITION (OVERLAY_END (overlay)); @@ -4037,7 +4038,7 @@ /* Put all the overlays we want in a vector in overlay_vec. Store the length in len. */ noverlays = overlays_in (XINT (beg), XINT (end), 1, &overlay_vec, &len, - (int *) 0, (int *) 0); + NULL, NULL); /* Make a list of them all. */ result = Flist (noverlays, overlay_vec); @@ -4280,7 +4281,7 @@ last_overlay_modification_hooks_used = 0; for (tail = current_buffer->overlays_before; tail; tail = tail->next) { - int startpos, endpos; + EMACS_INT startpos, endpos; Lisp_Object ostart, oend; XSETMISC (overlay, tail); @@ -4317,7 +4318,7 @@ for (tail = current_buffer->overlays_after; tail; tail = tail->next) { - int startpos, endpos; + EMACS_INT startpos, endpos; Lisp_Object ostart, oend; XSETMISC (overlay, tail); @@ -4409,7 +4410,7 @@ if (pos <= current_buffer->overlay_center) for (tail = current_buffer->overlays_before; tail; tail = tail->next) { - int endpos; + EMACS_INT endpos; XSETMISC (overlay, tail); endpos = OVERLAY_POSITION (OVERLAY_END (overlay)); if (endpos < pos) @@ -4421,7 +4422,7 @@ else for (tail = current_buffer->overlays_after; tail; tail = tail->next) { - int startpos; + EMACS_INT startpos; XSETMISC (overlay, tail); startpos = OVERLAY_POSITION (OVERLAY_START (overlay)); if (startpos > pos)
--- a/src/buffer.h Mon Sep 27 14:27:28 2010 +0900 +++ b/src/buffer.h Mon Sep 27 14:42:43 2010 +0900 @@ -865,7 +865,7 @@ EMACS_INT *prev_ptr, int change_req); extern int sort_overlays (Lisp_Object *, int, struct window *); extern void recenter_overlay_lists (struct buffer *, EMACS_INT); -extern int overlay_strings (EMACS_INT, struct window *, unsigned char **); +extern EMACS_INT overlay_strings (EMACS_INT, struct window *, unsigned char **); extern void validate_region (Lisp_Object *, Lisp_Object *); extern void set_buffer_internal (struct buffer *); extern void set_buffer_internal_1 (struct buffer *);
--- a/src/callproc.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/callproc.c Mon Sep 27 14:42:43 2010 +0900 @@ -678,9 +678,9 @@ QUIT; { - register int nread; + register EMACS_INT nread; int first = 1; - int total_read = 0; + EMACS_INT total_read = 0; int carryover = 0; int display_on_the_fly = display_p; struct coding_system saved_coding;
--- a/src/casefiddle.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/casefiddle.c Mon Sep 27 14:42:43 2010 +0900 @@ -352,8 +352,8 @@ operate_on_word (Lisp_Object arg, EMACS_INT *newpoint) { Lisp_Object val; - int farend; - int iarg; + EMACS_INT farend; + EMACS_INT iarg; CHECK_NUMBER (arg); iarg = XINT (arg);
--- a/src/ccl.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/ccl.c Mon Sep 27 14:42:43 2010 +0900 @@ -2061,10 +2061,10 @@ int i; int outbufsize; unsigned char *outbuf, *outp; - int str_chars, str_bytes; + EMACS_INT str_chars, str_bytes; #define CCL_EXECUTE_BUF_SIZE 1024 int source[CCL_EXECUTE_BUF_SIZE], destination[CCL_EXECUTE_BUF_SIZE]; - int consumed_chars, consumed_bytes, produced_chars; + EMACS_INT consumed_chars, consumed_bytes, produced_chars; if (setup_ccl_program (&ccl, ccl_prog) < 0) error ("Invalid CCL program"); @@ -2128,7 +2128,7 @@ if (outp - outbuf + MAX_MULTIBYTE_LENGTH * ccl.produced > outbufsize) { - int offset = outp - outbuf; + EMACS_INT offset = outp - outbuf; outbufsize += MAX_MULTIBYTE_LENGTH * ccl.produced; outbuf = (unsigned char *) xrealloc (outbuf, outbufsize); outp = outbuf + offset; @@ -2140,7 +2140,7 @@ { if (outp - outbuf + ccl.produced > outbufsize) { - int offset = outp - outbuf; + EMACS_INT offset = outp - outbuf; outbufsize += ccl.produced; outbuf = (unsigned char *) xrealloc (outbuf, outbufsize); outp = outbuf + offset;
--- a/src/character.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/character.c Mon Sep 27 14:42:43 2010 +0900 @@ -378,11 +378,12 @@ characters and bytes of the substring in *NCHARS and *NBYTES respectively. */ -int -c_string_width (const unsigned char *str, int len, int precision, int *nchars, int *nbytes) +EMACS_INT +c_string_width (const unsigned char *str, EMACS_INT len, int precision, + EMACS_INT *nchars, EMACS_INT *nbytes) { - int i = 0, i_byte = 0; - int width = 0; + EMACS_INT i = 0, i_byte = 0; + EMACS_INT width = 0; struct Lisp_Char_Table *dp = buffer_display_table (); while (i_byte < len) @@ -429,8 +430,8 @@ current buffer. The width is measured by how many columns it occupies on the screen. */ -int -strwidth (const unsigned char *str, int len) +EMACS_INT +strwidth (const unsigned char *str, EMACS_INT len) { return c_string_width (str, len, -1, NULL, NULL); } @@ -442,17 +443,18 @@ PRECISION, and set number of characters and bytes of the substring in *NCHARS and *NBYTES respectively. */ -int -lisp_string_width (Lisp_Object string, int precision, int *nchars, int *nbytes) +EMACS_INT +lisp_string_width (Lisp_Object string, int precision, + EMACS_INT *nchars, EMACS_INT *nbytes) { - int len = SCHARS (string); + EMACS_INT len = SCHARS (string); /* This set multibyte to 0 even if STRING is multibyte when it contains only ascii and eight-bit-graphic, but that's intentional. */ int multibyte = len < SBYTES (string); unsigned char *str = SDATA (string); - int i = 0, i_byte = 0; - int width = 0; + EMACS_INT i = 0, i_byte = 0; + EMACS_INT width = 0; struct Lisp_Char_Table *dp = buffer_display_table (); while (i < len) @@ -570,11 +572,11 @@ multibyte_chars_in_text (const unsigned char *ptr, EMACS_INT nbytes) { const unsigned char *endp = ptr + nbytes; - int chars = 0; + EMACS_INT chars = 0; while (ptr < endp) { - int len = MULTIBYTE_LENGTH (ptr, endp); + EMACS_INT len = MULTIBYTE_LENGTH (ptr, endp); if (len == 0) abort (); @@ -592,10 +594,11 @@ represented by 2-byte in a multibyte text. */ void -parse_str_as_multibyte (const unsigned char *str, int len, int *nchars, int *nbytes) +parse_str_as_multibyte (const unsigned char *str, EMACS_INT len, + EMACS_INT *nchars, EMACS_INT *nbytes) { const unsigned char *endp = str + len; - int n, chars = 0, bytes = 0; + EMACS_INT n, chars = 0, bytes = 0; if (len >= MAX_MULTIBYTE_LENGTH) { @@ -633,12 +636,13 @@ area and that is enough. Return the number of bytes of the resulting text. */ -int -str_as_multibyte (unsigned char *str, int len, int nbytes, int *nchars) +EMACS_INT +str_as_multibyte (unsigned char *str, EMACS_INT len, EMACS_INT nbytes, + EMACS_INT *nchars) { unsigned char *p = str, *endp = str + nbytes; unsigned char *to; - int chars = 0; + EMACS_INT chars = 0; int n; if (nbytes >= MAX_MULTIBYTE_LENGTH) @@ -709,11 +713,11 @@ bytes it may ocupy when converted to multibyte string by `str_to_multibyte'. */ -int -parse_str_to_multibyte (const unsigned char *str, int len) +EMACS_INT +parse_str_to_multibyte (const unsigned char *str, EMACS_INT len) { const unsigned char *endp = str + len; - int bytes; + EMACS_INT bytes; for (bytes = 0; str < endp; str++) bytes += (*str < 0x80) ? 1 : 2; @@ -727,8 +731,8 @@ that we can use LEN bytes at STR as a work area and that is enough. */ -int -str_to_multibyte (unsigned char *str, int len, int bytes) +EMACS_INT +str_to_multibyte (unsigned char *str, EMACS_INT len, EMACS_INT bytes) { unsigned char *p = str, *endp = str + bytes; unsigned char *to; @@ -756,8 +760,8 @@ actually converts characters in the range 0x80..0xFF to unibyte. */ -int -str_as_unibyte (unsigned char *str, int bytes) +EMACS_INT +str_as_unibyte (unsigned char *str, EMACS_INT bytes) { const unsigned char *p = str, *endp = str + bytes; unsigned char *to; @@ -818,14 +822,14 @@ } -int +EMACS_INT string_count_byte8 (Lisp_Object string) { int multibyte = STRING_MULTIBYTE (string); - int nbytes = SBYTES (string); + EMACS_INT nbytes = SBYTES (string); unsigned char *p = SDATA (string); unsigned char *pend = p + nbytes; - int count = 0; + EMACS_INT count = 0; int c, len; if (multibyte) @@ -851,10 +855,10 @@ Lisp_Object string_escape_byte8 (Lisp_Object string) { - int nchars = SCHARS (string); - int nbytes = SBYTES (string); + EMACS_INT nchars = SCHARS (string); + EMACS_INT nbytes = SBYTES (string); int multibyte = STRING_MULTIBYTE (string); - int byte8_count; + EMACS_INT byte8_count; const unsigned char *src, *src_end; unsigned char *dst; Lisp_Object val; @@ -869,12 +873,22 @@ return string; if (multibyte) - /* Convert 2-byte sequence of byte8 chars to 4-byte octal. */ - val = make_uninit_multibyte_string (nchars + byte8_count * 3, - nbytes + byte8_count * 2); + { + if ((MOST_POSITIVE_FIXNUM - nchars) / 3 < byte8_count + || (MOST_POSITIVE_FIXNUM - nbytes) / 2 < byte8_count) + error ("Maximum string size exceeded"); + + /* Convert 2-byte sequence of byte8 chars to 4-byte octal. */ + val = make_uninit_multibyte_string (nchars + byte8_count * 3, + nbytes + byte8_count * 2); + } else - /* Convert 1-byte sequence of byte8 chars to 4-byte octal. */ - val = make_uninit_string (nbytes + byte8_count * 3); + { + if ((MOST_POSITIVE_FIXNUM - nchars) / 3 < byte8_count) + error ("Maximum string size exceeded"); + /* Convert 1-byte sequence of byte8 chars to 4-byte octal. */ + val = make_uninit_string (nbytes + byte8_count * 3); + } src = SDATA (string); src_end = src + nbytes;
--- a/src/character.h Mon Sep 27 14:27:28 2010 +0900 +++ b/src/character.h Mon Sep 27 14:42:43 2010 +0900 @@ -603,17 +603,20 @@ extern int translate_char (Lisp_Object, int c); extern int char_printable_p (int c); -extern void parse_str_as_multibyte (const unsigned char *, int, int *, - int *); -extern int parse_str_to_multibyte (const unsigned char *, int); -extern int str_as_multibyte (unsigned char *, int, int, int *); -extern int str_to_multibyte (unsigned char *, int, int); -extern int str_as_unibyte (unsigned char *, int); +extern void parse_str_as_multibyte (const unsigned char *, + EMACS_INT, EMACS_INT *, EMACS_INT *); +extern EMACS_INT parse_str_to_multibyte (const unsigned char *, EMACS_INT); +extern EMACS_INT str_as_multibyte (unsigned char *, EMACS_INT, EMACS_INT, + EMACS_INT *); +extern EMACS_INT str_to_multibyte (unsigned char *, EMACS_INT, EMACS_INT); +extern EMACS_INT str_as_unibyte (unsigned char *, EMACS_INT); extern EMACS_INT str_to_unibyte (const unsigned char *, unsigned char *, EMACS_INT, int); -extern int strwidth (const unsigned char *, int); -extern int c_string_width (const unsigned char *, int, int, int *, int *); -extern int lisp_string_width (Lisp_Object, int, int *, int *); +extern EMACS_INT strwidth (const unsigned char *, EMACS_INT); +extern EMACS_INT c_string_width (const unsigned char *, EMACS_INT, int, + EMACS_INT *, EMACS_INT *); +extern EMACS_INT lisp_string_width (Lisp_Object, int, + EMACS_INT *, EMACS_INT *); extern Lisp_Object Vprintable_chars;
--- a/src/cmds.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/cmds.c Mon Sep 27 14:42:43 2010 +0900 @@ -37,7 +37,7 @@ /* A possible value for a buffer's overwrite-mode variable. */ Lisp_Object Qoverwrite_mode_binary; -static int internal_self_insert (int, int); +static int internal_self_insert (int, EMACS_INT); DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0, doc: /* Return buffer position N characters after (before if N negative) point. */) @@ -68,7 +68,7 @@ hooks, etcetera), that's not a good approach. So we validate the proposed position, then set point. */ { - int new_point = PT + XINT (n); + EMACS_INT new_point = PT + XINT (n); if (new_point < BEGV) { @@ -116,9 +116,9 @@ successfully moved (for the return value). */) (Lisp_Object n) { - int opoint = PT, opoint_byte = PT_BYTE; - int pos, pos_byte; - int count, shortage; + EMACS_INT opoint = PT, opoint_byte = PT_BYTE; + EMACS_INT pos, pos_byte; + EMACS_INT count, shortage; if (NILP (n)) count = 1; @@ -188,7 +188,7 @@ to t. */) (Lisp_Object n) { - int newpos; + EMACS_INT newpos; if (NILP (n)) XSETFASTINT (n, 1); @@ -233,7 +233,7 @@ The command `delete-forward' is preferable for interactive use. */) (Lisp_Object n, Lisp_Object killflag) { - int pos; + EMACS_INT pos; CHECK_NUMBER (n); @@ -303,7 +303,7 @@ bitch_at_user (); { int character = translate_char (Vtranslation_table_for_input, - XINT (last_command_event)); + (int) XINT (last_command_event)); int val = internal_self_insert (character, XFASTINT (n)); if (val == 2) nonundocount = 0; @@ -323,7 +323,7 @@ static Lisp_Object Qpost_self_insert_hook, Vpost_self_insert_hook; static int -internal_self_insert (int c, int n) +internal_self_insert (int c, EMACS_INT n) { int hairy = 0; Lisp_Object tem; @@ -333,8 +333,8 @@ int len; /* Working buffer and pointer for multi-byte form of C. */ unsigned char str[MAX_MULTIBYTE_LENGTH]; - int chars_to_delete = 0; - int spaces_to_insert = 0; + EMACS_INT chars_to_delete = 0; + EMACS_INT spaces_to_insert = 0; overwrite = current_buffer->overwrite_mode; if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions)) @@ -380,12 +380,12 @@ chars_to_delete = n; else if (c != '\n' && c2 != '\n') { - int pos = PT; - int pos_byte = PT_BYTE; + EMACS_INT pos = PT; + EMACS_INT pos_byte = PT_BYTE; /* Column the cursor should be placed at after this insertion. The correct value should be calculated only when necessary. */ int target_clm = ((int) current_column () /* iftc */ - + n * XINT (Fchar_width (make_number (c)))); + + n * (int) XINT (Fchar_width (make_number (c)))); /* The actual cursor position after the trial of moving to column TARGET_CLM. It is greater than TARGET_CLM @@ -393,7 +393,8 @@ character. In that case, the new point is set after that character. */ int actual_clm - = XFASTINT (Fmove_to_column (make_number (target_clm), Qnil)); + = (int) XFASTINT (Fmove_to_column (make_number (target_clm), + Qnil)); chars_to_delete = PT - pos;
--- a/src/commands.h Mon Sep 27 14:27:28 2010 +0900 +++ b/src/commands.h Mon Sep 27 14:42:43 2010 +0900 @@ -74,7 +74,7 @@ extern Lisp_Object unread_switch_frame; /* The value of point when the last command was started. */ -extern int last_point_position; +extern EMACS_INT last_point_position; /* The buffer that was current when the last command was started. */ extern Lisp_Object last_point_position_buffer;
--- a/src/composite.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/composite.c Mon Sep 27 14:42:43 2010 +0900 @@ -180,7 +180,8 @@ If the composition is invalid, return -1. */ int -get_composition_id (int charpos, int bytepos, int nchars, Lisp_Object prop, Lisp_Object string) +get_composition_id (EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT nchars, + Lisp_Object prop, Lisp_Object string) { Lisp_Object id, length, components, key, *key_contents; int glyph_len; @@ -188,7 +189,8 @@ int hash_index; unsigned hash_code; struct composition *cmp; - int i, ch; + EMACS_INT i; + int ch; /* PROP should be Form-A: ((LENGTH . COMPONENTS) . MODIFICATION-FUNC) @@ -290,7 +292,7 @@ && VECTORP (AREF (components, 0))) { /* COMPONENTS is a glyph-string. */ - int len = ASIZE (key); + EMACS_UINT len = ASIZE (key); for (i = 1; i < len; i++) if (! VECTORP (AREF (key, i))) @@ -298,7 +300,7 @@ } else if (VECTORP (components) || CONSP (components)) { - int len = XVECTOR (key)->size; + EMACS_UINT len = XVECTOR (key)->size; /* The number of elements should be odd. */ if ((len % 2) == 0) @@ -427,7 +429,9 @@ This doesn't check the validity of composition. */ int -find_composition (int pos, int limit, EMACS_INT *start, EMACS_INT *end, Lisp_Object *prop, Lisp_Object object) +find_composition (EMACS_INT pos, EMACS_INT limit, + EMACS_INT *start, EMACS_INT *end, + Lisp_Object *prop, Lisp_Object object) { Lisp_Object val; @@ -465,7 +469,7 @@ FROM and TO with property PROP. */ static void -run_composition_function (int from, int to, Lisp_Object prop) +run_composition_function (EMACS_INT from, EMACS_INT to, Lisp_Object prop) { Lisp_Object func; EMACS_INT start, end; @@ -628,7 +632,8 @@ indices START and END in STRING. */ void -compose_text (int start, int end, Lisp_Object components, Lisp_Object modification_func, Lisp_Object string) +compose_text (EMACS_INT start, EMACS_INT end, Lisp_Object components, + Lisp_Object modification_func, Lisp_Object string) { Lisp_Object prop; @@ -735,7 +740,8 @@ } int -composition_gstring_width (Lisp_Object gstring, int from, int to, struct font_metrics *metrics) +composition_gstring_width (Lisp_Object gstring, EMACS_INT from, EMACS_INT to, + struct font_metrics *metrics) { Lisp_Object *glyph; int width = 0; @@ -907,7 +913,7 @@ EMACS_INT to; EMACS_INT pt = PT, pt_byte = PT_BYTE; Lisp_Object re, font_object, lgstring; - int len; + EMACS_INT len; record_unwind_save_match_data (); re = AREF (rule, 0); @@ -1397,7 +1403,7 @@ /* automatic composition */ Lisp_Object gstring = composition_gstring_from_id (cmp_it->id); Lisp_Object glyph; - int from, to; + EMACS_INT from; if (cmp_it->nglyphs == 0) { @@ -1656,7 +1662,7 @@ /* Return the adjusted point provided that point is moved from LAST_PT to NEW_PT. */ -int +EMACS_INT composition_adjust_point (EMACS_INT last_pt, EMACS_INT new_pt) { EMACS_INT charpos, bytepos, startpos, beg, end, pos; @@ -1879,9 +1885,9 @@ id = COMPOSITION_ID (prop); else { - int start_byte = (NILP (string) - ? CHAR_TO_BYTE (start) - : string_char_to_byte (string, start)); + EMACS_INT start_byte = (NILP (string) + ? CHAR_TO_BYTE (start) + : string_char_to_byte (string, start)); id = get_composition_id (start, start_byte, end - start, prop, string); }
--- a/src/composite.h Mon Sep 27 14:27:28 2010 +0900 +++ b/src/composite.h Mon Sep 27 14:42:43 2010 +0900 @@ -212,15 +212,16 @@ extern Lisp_Object Qauto_composition_function; extern Lisp_Object Vcomposition_function_table; -extern int get_composition_id (int, int, int, Lisp_Object, Lisp_Object); -extern int find_composition (int, int, EMACS_INT *, EMACS_INT *, Lisp_Object *, - Lisp_Object); +extern int get_composition_id (EMACS_INT, EMACS_INT, EMACS_INT, + Lisp_Object, Lisp_Object); +extern int find_composition (EMACS_INT, EMACS_INT, EMACS_INT *, EMACS_INT *, + Lisp_Object *, Lisp_Object); extern void update_compositions (EMACS_INT, EMACS_INT, int); extern void make_composition_value_copy (Lisp_Object); extern void compose_region (int, int, Lisp_Object, Lisp_Object, Lisp_Object); extern void syms_of_composite (void); -extern void compose_text (int, int, Lisp_Object, Lisp_Object, +extern void compose_text (EMACS_INT, EMACS_INT, Lisp_Object, Lisp_Object, Lisp_Object); /* Macros for lispy glyph-string. This is completely different from @@ -306,7 +307,7 @@ extern Lisp_Object composition_gstring_put_cache (Lisp_Object, int); extern Lisp_Object composition_gstring_from_id (int); extern int composition_gstring_p (Lisp_Object); -extern int composition_gstring_width (Lisp_Object, int, int, +extern int composition_gstring_width (Lisp_Object, EMACS_INT, EMACS_INT, struct font_metrics *); extern void composition_compute_stop_pos (struct composition_it *, @@ -319,7 +320,7 @@ extern int composition_update_it (struct composition_it *, EMACS_INT, EMACS_INT, Lisp_Object); -extern int composition_adjust_point (EMACS_INT, EMACS_INT); +extern EMACS_INT composition_adjust_point (EMACS_INT, EMACS_INT); EXFUN (Fcompose_region_internal, 4); EXFUN (Fcompose_string_internal, 5);
--- a/src/config.in Mon Sep 27 14:27:28 2010 +0900 +++ b/src/config.in Mon Sep 27 14:42:43 2010 +0900 @@ -255,6 +255,9 @@ /* Define to 1 if you have a gif (or ungif) library. */ #undef HAVE_GIF +/* Define if we have the GNU TLS library. */ +#undef HAVE_GNUTLS + /* Define to 1 if you have the gpm library (-lgpm). */ #undef HAVE_GPM @@ -1094,6 +1097,12 @@ #include config_opsysfile #include config_machfile +#if HAVE_GNUTLS +#define LIBGNUTLS $(LIBGNUTLS_LIBS) +#else /* not HAVE_GNUTLS */ +#define LIBGNUTLS +#endif /* not HAVE_GNUTLS */ + /* Set up some defines, C and LD flags for NeXTstep interface on GNUstep. (There is probably a better place to do this, but right now the Cocoa side does this in s/darwin.h and we cannot
--- a/src/data.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/data.c Mon Sep 27 14:42:43 2010 +0900 @@ -2082,13 +2082,14 @@ or a byte-code object. IDX starts at 0. */) (register Lisp_Object array, Lisp_Object idx) { - register int idxval; + register EMACS_INT idxval; CHECK_NUMBER (idx); idxval = XINT (idx); if (STRINGP (array)) { - int c, idxval_byte; + int c; + EMACS_INT idxval_byte; if (idxval < 0 || idxval >= SCHARS (array)) args_out_of_range (array, idx); @@ -2136,7 +2137,7 @@ bool-vector. IDX starts at 0. */) (register Lisp_Object array, Lisp_Object idx, Lisp_Object newelt) { - register int idxval; + register EMACS_INT idxval; CHECK_NUMBER (idx); idxval = XINT (idx); @@ -2171,7 +2172,7 @@ } else if (STRING_MULTIBYTE (array)) { - int idxval_byte, prev_bytes, new_bytes, nbytes; + EMACS_INT idxval_byte, prev_bytes, new_bytes, nbytes; unsigned char workbuf[MAX_MULTIBYTE_LENGTH], *p0 = workbuf, *p1; if (idxval < 0 || idxval >= SCHARS (array)) @@ -2187,7 +2188,7 @@ if (prev_bytes != new_bytes) { /* We must relocate the string data. */ - int nchars = SCHARS (array); + EMACS_INT nchars = SCHARS (array); unsigned char *str; USE_SAFE_ALLOCA;
--- a/src/dbusbind.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/dbusbind.c Mon Sep 27 14:42:43 2010 +0900 @@ -27,6 +27,7 @@ #include "frame.h" #include "termhooks.h" #include "keyboard.h" +#include "process.h" /* Subroutines. */ @@ -799,71 +800,93 @@ return connection; } +/* Callback called when something is read to read ow write. */ -/* Add connection file descriptor to input_wait_mask, in order to - let select() detect, whether a new message has been arrived. */ -dbus_bool_t +static void +dbus_fd_cb (int fd, void *data, int for_read) +{ + xd_read_queued_messages (); +} + +/* Return the file descriptor for WATCH, -1 if not found. */ + +static int +xd_find_watch_fd (DBusWatch *watch) +{ +#if HAVE_DBUS_WATCH_GET_UNIX_FD + /* TODO: Reverse these on Win32, which prefers the opposite. */ + int fd = dbus_watch_get_unix_fd (watch); + if (fd == -1) + fd = dbus_watch_get_socket (watch); +#else + int fd = dbus_watch_get_fd (watch); +#endif + return fd; +} + + +/* Start monitoring WATCH for possible I/O. */ + +static dbus_bool_t xd_add_watch (DBusWatch *watch, void *data) { - /* We check only for incoming data. */ - if (dbus_watch_get_flags (watch) & DBUS_WATCH_READABLE) + unsigned int flags = dbus_watch_get_flags (watch); + int fd = xd_find_watch_fd (watch); + + XD_DEBUG_MESSAGE ("fd %d, write %d, enabled %d", + fd, flags & DBUS_WATCH_WRITABLE, + dbus_watch_get_enabled (watch)); + + if (fd == -1) + return FALSE; + + if (dbus_watch_get_enabled (watch)) { -#if HAVE_DBUS_WATCH_GET_UNIX_FD - /* TODO: Reverse these on Win32, which prefers the opposite. */ - int fd = dbus_watch_get_unix_fd(watch); - if (fd == -1) - fd = dbus_watch_get_socket(watch); -#else - int fd = dbus_watch_get_fd(watch); -#endif - XD_DEBUG_MESSAGE ("fd %d", fd); - - if (fd == -1) - return FALSE; - - /* Add the file descriptor to input_wait_mask. */ - add_keyboard_wait_descriptor (fd); + if (flags & DBUS_WATCH_WRITABLE) + add_write_fd (fd, dbus_fd_cb, NULL); + if (flags & DBUS_WATCH_READABLE) + add_read_fd (fd, dbus_fd_cb, NULL); } - - /* Return. */ return TRUE; } -/* Remove connection file descriptor from input_wait_mask. DATA is - the used bus, either a string or QCdbus_system_bus or +/* Stop monitoring WATCH for possible I/O. + DATA is the used bus, either a string or QCdbus_system_bus or QCdbus_session_bus. */ -void + +static void xd_remove_watch (DBusWatch *watch, void *data) { - /* We check only for incoming data. */ - if (dbus_watch_get_flags (watch) & DBUS_WATCH_READABLE) - { -#if HAVE_DBUS_WATCH_GET_UNIX_FD - /* TODO: Reverse these on Win32, which prefers the opposite. */ - int fd = dbus_watch_get_unix_fd(watch); - if (fd == -1) - fd = dbus_watch_get_socket(watch); -#else - int fd = dbus_watch_get_fd(watch); -#endif - XD_DEBUG_MESSAGE ("fd %d", fd); + unsigned int flags = dbus_watch_get_flags (watch); + int fd = xd_find_watch_fd (watch); + + XD_DEBUG_MESSAGE ("fd %d", fd); + + if (fd == -1) return; - if (fd == -1) - return; - /* Unset session environment. */ - if ((data != NULL) && (data == (void*) XHASH (QCdbus_session_bus))) - { - XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS"); - unsetenv ("DBUS_SESSION_BUS_ADDRESS"); - } - - /* Remove the file descriptor from input_wait_mask. */ - delete_keyboard_wait_descriptor (fd); + /* Unset session environment. */ + if (data != NULL && data == (void*) XHASH (QCdbus_session_bus)) + { + XD_DEBUG_MESSAGE ("unsetenv DBUS_SESSION_BUS_ADDRESS"); + unsetenv ("DBUS_SESSION_BUS_ADDRESS"); } - /* Return. */ - return; + if (flags & DBUS_WATCH_WRITABLE) + delete_write_fd (fd); + if (flags & DBUS_WATCH_READABLE) + delete_read_fd (fd); +} + +/* Toggle monitoring WATCH for possible I/O. */ + +static void +xd_toggle_watch (DBusWatch *watch, void *data) +{ + if (dbus_watch_get_enabled (watch)) + xd_add_watch (watch, data); + else + xd_remove_watch (watch, data); } DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 1, 0, @@ -880,7 +903,8 @@ if (!dbus_connection_set_watch_functions (connection, xd_add_watch, xd_remove_watch, - NULL, (void*) XHASH (bus), NULL)) + xd_toggle_watch, + (void*) XHASH (bus), NULL)) XD_SIGNAL1 (build_string ("Cannot add watch functions")); /* Add bus to list of registered buses. */ @@ -1288,9 +1312,6 @@ result = Qnil; } - /* Flush connection to ensure the message is handled. */ - dbus_connection_flush (connection); - XD_DEBUG_MESSAGE ("Message sent"); /* Cleanup. */ @@ -1379,9 +1400,6 @@ if (!dbus_connection_send (connection, dmessage, NULL)) XD_SIGNAL1 (build_string ("Cannot send message")); - /* Flush connection to ensure the message is handled. */ - dbus_connection_flush (connection); - XD_DEBUG_MESSAGE ("Message sent"); /* Cleanup. */ @@ -1471,9 +1489,6 @@ if (!dbus_connection_send (connection, dmessage, NULL)) XD_SIGNAL1 (build_string ("Cannot send message")); - /* Flush connection to ensure the message is handled. */ - dbus_connection_flush (connection); - XD_DEBUG_MESSAGE ("Message sent"); /* Cleanup. */ @@ -1589,9 +1604,6 @@ if (!dbus_connection_send (connection, dmessage, NULL)) XD_SIGNAL1 (build_string ("Cannot send message")); - /* Flush connection to ensure the message is handled. */ - dbus_connection_flush (connection); - XD_DEBUG_MESSAGE ("Signal sent"); /* Cleanup. */ @@ -1645,32 +1657,27 @@ return FALSE; } -/* Read queued incoming message of the D-Bus BUS. BUS is either a - Lisp symbol, :system or :session, or a string denoting the bus - address. */ -static Lisp_Object -xd_read_message (Lisp_Object bus) +/* Read one queued incoming message of the D-Bus BUS. + BUS is either a Lisp symbol, :system or :session, or a string denoting + the bus address. */ + +static void +xd_read_message_1 (DBusConnection *connection, Lisp_Object bus) { Lisp_Object args, key, value; struct gcpro gcpro1; struct input_event event; - DBusConnection *connection; DBusMessage *dmessage; DBusMessageIter iter; unsigned int dtype; int mtype, serial; const char *uname, *path, *interface, *member; - /* Open a connection to the bus. */ - connection = xd_initialize (bus, TRUE); - - /* Non blocking read of the next available message. */ - dbus_connection_read_write (connection, 0); dmessage = dbus_connection_pop_message (connection); /* Return if there is no queued message. */ if (dmessage == NULL) - return Qnil; + return; /* Collect the parameters. */ args = Qnil; @@ -1801,7 +1808,26 @@ cleanup: dbus_message_unref (dmessage); - RETURN_UNGCPRO (Qnil); + UNGCPRO; +} + +/* Read queued incoming messages of the D-Bus BUS. + BUS is either a Lisp symbol, :system or :session, or a string denoting + the bus address. */ + +static Lisp_Object +xd_read_message (Lisp_Object bus) +{ + /* Open a connection to the bus. */ + DBusConnection *connection = xd_initialize (bus, TRUE); + + /* Non blocking read of the next available message. */ + dbus_connection_read_write (connection, 0); + + while (dbus_connection_get_dispatch_status (connection) + != DBUS_DISPATCH_COMPLETE) + xd_read_message_1 (connection, bus); + return Qnil; } /* Read queued incoming messages from all buses. */
--- a/src/dispextern.h Mon Sep 27 14:27:28 2010 +0900 +++ b/src/dispextern.h Mon Sep 27 14:42:43 2010 +0900 @@ -1783,7 +1783,7 @@ /* Data type for storing information about characters we need to remember. */ struct bidi_saved_info { - int bytepos, charpos; /* character's buffer position */ + EMACS_INT bytepos, charpos; /* character's buffer position */ bidi_type_t type; /* character's resolved bidi type */ bidi_type_t type_after_w1; /* original type of the character, after W1 */ bidi_type_t orig_type; /* type as we found it in the buffer */ @@ -2942,7 +2942,8 @@ void mark_window_display_accurate (Lisp_Object, int); void redisplay_preserve_echo_area (int); int set_cursor_from_row (struct window *, struct glyph_row *, - struct glyph_matrix *, int, int, int, int); + struct glyph_matrix *, EMACS_INT, EMACS_INT, + int, int); void init_iterator (struct it *, struct window *, EMACS_INT, EMACS_INT, struct glyph_row *, enum face_id); void init_iterator_to_row_start (struct it *, struct window *, @@ -2950,7 +2951,7 @@ int get_next_display_element (struct it *); void set_iterator_to_next (struct it *, int); void start_display (struct it *, struct window *, struct text_pos); -void move_it_to (struct it *, int, int, int, int, int); +void move_it_to (struct it *, EMACS_INT, int, int, int, int); void move_it_vertically (struct it *, int); void move_it_vertically_backward (struct it *, int); void move_it_by_lines (struct it *, int, int); @@ -2969,7 +2970,7 @@ extern int current_mode_line_height, current_header_line_height; extern Lisp_Object help_echo_string, help_echo_window; extern Lisp_Object help_echo_object, previous_help_echo_string; -extern int help_echo_pos; +extern EMACS_INT help_echo_pos; extern struct frame *last_mouse_frame; extern int last_tool_bar_item; extern Lisp_Object Vmouse_autoselect_window; @@ -3222,11 +3223,11 @@ Lisp_Object *, int *, int *, int *, int *); extern Lisp_Object mode_line_string (struct window *, enum window_part, - int *, int *, int *, + int *, int *, EMACS_INT *, Lisp_Object *, int *, int *, int *, int *); extern Lisp_Object marginal_area_string (struct window *, enum window_part, - int *, int *, int *, + int *, int *, EMACS_INT *, Lisp_Object *, int *, int *, int *, int *); extern void redraw_frame (struct frame *); @@ -3249,9 +3250,9 @@ int, int, int); void rotate_matrix (struct glyph_matrix *, int, int, int); void increment_matrix_positions (struct glyph_matrix *, - int, int, int, int); + int, int, EMACS_INT, EMACS_INT); void blank_row (struct window *, struct glyph_row *, int); -void increment_row_positions (struct glyph_row *, int, int); +void increment_row_positions (struct glyph_row *, EMACS_INT, EMACS_INT); void enable_glyph_matrix_rows (struct glyph_matrix *, int, int, int); void clear_glyph_row (struct glyph_row *); void prepare_desired_row (struct glyph_row *);
--- a/src/dispnew.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/dispnew.c Mon Sep 27 14:42:43 2010 +0900 @@ -849,7 +849,8 @@ DELTA_BYTES. */ void -increment_matrix_positions (struct glyph_matrix *matrix, int start, int end, int delta, int delta_bytes) +increment_matrix_positions (struct glyph_matrix *matrix, int start, int end, + EMACS_INT delta, EMACS_INT delta_bytes) { /* Check that START and END are reasonable values. */ xassert (start >= 0 && start <= matrix->nrows); @@ -1088,7 +1089,8 @@ ends. */ void -increment_row_positions (struct glyph_row *row, int delta, int delta_bytes) +increment_row_positions (struct glyph_row *row, + EMACS_INT delta, EMACS_INT delta_bytes) { int area, i; @@ -1200,7 +1202,8 @@ positions in row TO by DELTA/ DELTA_BYTES. */ void -copy_glyph_row_contents (struct glyph_row *to, struct glyph_row *from, int delta, int delta_bytes) +copy_glyph_row_contents (struct glyph_row *to, struct glyph_row *from, + EMACS_INT delta, EMACS_INT delta_bytes) { int area; @@ -5498,7 +5501,9 @@ *CHARPOS is set to the position in the string returned. */ Lisp_Object -mode_line_string (struct window *w, enum window_part part, int *x, int *y, int *charpos, Lisp_Object *object, int *dx, int *dy, int *width, int *height) +mode_line_string (struct window *w, enum window_part part, + int *x, int *y, EMACS_INT *charpos, Lisp_Object *object, + int *dx, int *dy, int *width, int *height) { struct glyph_row *row; struct glyph *glyph, *end; @@ -5565,7 +5570,9 @@ the string returned. */ Lisp_Object -marginal_area_string (struct window *w, enum window_part part, int *x, int *y, int *charpos, Lisp_Object *object, int *dx, int *dy, int *width, int *height) +marginal_area_string (struct window *w, enum window_part part, + int *x, int *y, EMACS_INT *charpos, Lisp_Object *object, + int *dx, int *dy, int *width, int *height) { struct glyph_row *row = w->current_matrix->rows; struct glyph *glyph, *end;
--- a/src/doc.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/doc.c Mon Sep 27 14:42:43 2010 +0900 @@ -99,8 +99,8 @@ register int fd; register char *name; register char *p, *p1; - int minsize; - int offset, position; + EMACS_INT minsize; + EMACS_INT offset, position; Lisp_Object file, tem; if (INTEGERP (filepos)) @@ -179,14 +179,14 @@ p = get_doc_string_buffer; while (1) { - int space_left = (get_doc_string_buffer_size - - (p - get_doc_string_buffer)); + EMACS_INT space_left = (get_doc_string_buffer_size + - (p - get_doc_string_buffer)); int nread; /* Allocate or grow the buffer if we need to. */ if (space_left == 0) { - int in_buffer = p - get_doc_string_buffer; + EMACS_INT in_buffer = p - get_doc_string_buffer; get_doc_string_buffer_size += 16 * 1024; get_doc_string_buffer = (char *) xrealloc (get_doc_string_buffer, @@ -286,8 +286,8 @@ else { /* The data determines whether the string is multibyte. */ - int nchars = multibyte_chars_in_text (get_doc_string_buffer + offset, - to - (get_doc_string_buffer + offset)); + EMACS_INT nchars = multibyte_chars_in_text (get_doc_string_buffer + offset, + to - (get_doc_string_buffer + offset)); return make_string_from_bytes (get_doc_string_buffer + offset, nchars, to - (get_doc_string_buffer + offset)); @@ -551,8 +551,8 @@ { int fd; char buf[1024 + 1]; - register int filled; - register int pos; + register EMACS_INT filled; + register EMACS_INT pos; register char *p, *end; Lisp_Object sym; char *name; @@ -586,7 +586,7 @@ for (beg = buildobj; *beg; beg = end) { - int len; + EMACS_INT len; while (*beg && isspace (*beg)) ++beg; @@ -633,7 +633,7 @@ if (end - p > 4 && end[-2] == '.' && (end[-1] == 'o' || end[-1] == 'c')) { - int len = end - p - 2; + EMACS_INT len = end - p - 2; char *fromfile = alloca (len + 1); strncpy (fromfile, &p[2], len); fromfile[len] = 0; @@ -705,16 +705,16 @@ int changed = 0; register unsigned char *strp; register unsigned char *bufp; - int idx; - int bsize; + EMACS_INT idx; + EMACS_INT bsize; Lisp_Object tem; Lisp_Object keymap; unsigned char *start; - int length, length_byte; + EMACS_INT length, length_byte; Lisp_Object name; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; int multibyte; - int nchars; + EMACS_INT nchars; if (NILP (string)) return Qnil; @@ -766,7 +766,7 @@ } else if (strp[0] == '\\' && strp[1] == '[') { - int start_idx; + EMACS_INT start_idx; int follow_remap = 1; changed = 1; @@ -805,7 +805,7 @@ if (NILP (tem)) /* but not on any keys */ { - int offset = bufp - buf; + EMACS_INT offset = bufp - buf; buf = (unsigned char *) xrealloc (buf, bsize += 4); bufp = buf + offset; memcpy (bufp, "M-x ", 4); @@ -828,7 +828,7 @@ else if (strp[0] == '\\' && (strp[1] == '{' || strp[1] == '<')) { struct buffer *oldbuf; - int start_idx; + EMACS_INT start_idx; /* This is for computing the SHADOWS arg for describe_map_tree. */ Lisp_Object active_maps = Fcurrent_active_maps (Qnil, Qnil); Lisp_Object earlier_maps; @@ -899,7 +899,7 @@ length_byte = SBYTES (tem); subst: { - int offset = bufp - buf; + EMACS_INT offset = bufp - buf; buf = (unsigned char *) xrealloc (buf, bsize += length_byte); bufp = buf + offset; memcpy (bufp, start, length_byte);
--- a/src/doprnt.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/doprnt.c Mon Sep 27 14:42:43 2010 +0900 @@ -54,7 +54,7 @@ String arguments are passed as C strings. Integers are passed as C integers. */ -int +EMACS_INT doprnt (char *buffer, register int bufsize, const char *format, const char *format_end, va_list ap) { @@ -96,7 +96,7 @@ if (*fmt == '%') /* Check for a '%' character */ { unsigned size_bound = 0; - int width; /* Columns occupied by STRING. */ + EMACS_INT width; /* Columns occupied by STRING. */ fmt++; /* Copy this one %-spec into fmtcpy. */
--- a/src/editfns.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/editfns.c Mon Sep 27 14:42:43 2010 +0900 @@ -94,8 +94,9 @@ #endif static int tm_diff (struct tm *, struct tm *); -static void find_field (Lisp_Object, Lisp_Object, Lisp_Object, int *, Lisp_Object, int *); -static void update_buffer_properties (int, int); +static void find_field (Lisp_Object, Lisp_Object, Lisp_Object, + EMACS_INT *, Lisp_Object, EMACS_INT *); +static void update_buffer_properties (EMACS_INT, EMACS_INT); static Lisp_Object region_limit (int); static size_t emacs_memftimeu (char *, size_t, const char *, size_t, const struct tm *, int); @@ -106,7 +107,8 @@ int, int, Lisp_Object *); static Lisp_Object subst_char_in_region_unwind (Lisp_Object); static Lisp_Object subst_char_in_region_unwind_1 (Lisp_Object); -static void transpose_markers (int, int, int, int, int, int, int, int); +static void transpose_markers (EMACS_INT, EMACS_INT, EMACS_INT, EMACS_INT, + EMACS_INT, EMACS_INT, EMACS_INT, EMACS_INT); Lisp_Object Vbuffer_access_fontify_functions; Lisp_Object Qbuffer_access_fontify_functions; @@ -245,7 +247,7 @@ } static Lisp_Object -buildmark (int charpos, int bytepos) +buildmark (EMACS_INT charpos, EMACS_INT bytepos) { register Lisp_Object mark; mark = Fmake_marker (); @@ -270,8 +272,8 @@ return buildmark (PT, PT_BYTE); } -int -clip_to_bounds (int lower, int num, int upper) +EMACS_INT +clip_to_bounds (EMACS_INT lower, EMACS_INT num, EMACS_INT upper) { if (num < lower) return lower; @@ -288,7 +290,7 @@ The return value is POSITION. */) (register Lisp_Object position) { - int pos; + EMACS_INT pos; if (MARKERP (position) && current_buffer == XMARKER (position)->buffer) @@ -364,11 +366,11 @@ of length LEN. */ static int -overlays_around (int pos, Lisp_Object *vec, int len) +overlays_around (EMACS_INT pos, Lisp_Object *vec, int len) { Lisp_Object overlay, start, end; struct Lisp_Overlay *tail; - int startpos, endpos; + EMACS_INT startpos, endpos; int idx = 0; for (tail = current_buffer->overlays_before; tail; tail = tail->next) @@ -436,7 +438,7 @@ return Fget_text_property (position, prop, object); else { - int posn = XINT (position); + EMACS_INT posn = XINT (position); int noverlays; Lisp_Object *overlay_vec, tem; struct buffer *obuf = current_buffer; @@ -515,7 +517,9 @@ is not stored. */ static void -find_field (Lisp_Object pos, Lisp_Object merge_at_boundary, Lisp_Object beg_limit, int *beg, Lisp_Object end_limit, int *end) +find_field (Lisp_Object pos, Lisp_Object merge_at_boundary, + Lisp_Object beg_limit, + EMACS_INT *beg, Lisp_Object end_limit, EMACS_INT *end) { /* Fields right before and after the point. */ Lisp_Object before_field, after_field; @@ -631,7 +635,7 @@ If POS is nil, the value of point is used for POS. */) (Lisp_Object pos) { - int beg, end; + EMACS_INT beg, end; find_field (pos, Qnil, Qnil, &beg, Qnil, &end); if (beg != end) del_range (beg, end); @@ -644,7 +648,7 @@ If POS is nil, the value of point is used for POS. */) (Lisp_Object pos) { - int beg, end; + EMACS_INT beg, end; find_field (pos, Qnil, Qnil, &beg, Qnil, &end); return make_buffer_string (beg, end, 1); } @@ -655,7 +659,7 @@ If POS is nil, the value of point is used for POS. */) (Lisp_Object pos) { - int beg, end; + EMACS_INT beg, end; find_field (pos, Qnil, Qnil, &beg, Qnil, &end); return make_buffer_string (beg, end, 0); } @@ -670,7 +674,7 @@ is before LIMIT, then LIMIT will be returned instead. */) (Lisp_Object pos, Lisp_Object escape_from_edge, Lisp_Object limit) { - int beg; + EMACS_INT beg; find_field (pos, escape_from_edge, limit, &beg, Qnil, 0); return make_number (beg); } @@ -685,7 +689,7 @@ is after LIMIT, then LIMIT will be returned instead. */) (Lisp_Object pos, Lisp_Object escape_from_edge, Lisp_Object limit) { - int end; + EMACS_INT end; find_field (pos, escape_from_edge, Qnil, 0, limit, &end); return make_number (end); } @@ -720,7 +724,7 @@ (Lisp_Object new_pos, Lisp_Object old_pos, Lisp_Object escape_from_edge, Lisp_Object only_in_line, Lisp_Object inhibit_capture_property) { /* If non-zero, then the original point, before re-positioning. */ - int orig_point = 0; + EMACS_INT orig_point = 0; int fwd; Lisp_Object prev_old, prev_new; @@ -817,7 +821,7 @@ This function does not move point. */) (Lisp_Object n) { - int orig, orig_byte, end; + EMACS_INT orig, orig_byte, end; int count = SPECPDL_INDEX (); specbind (Qinhibit_point_motion_hooks, Qt); @@ -858,8 +862,8 @@ This function does not move point. */) (Lisp_Object n) { - int end_pos; - int orig = PT; + EMACS_INT end_pos; + EMACS_INT orig = PT; if (NILP (n)) XSETFASTINT (n, 1); @@ -1131,7 +1135,7 @@ XSETFASTINT (temp, 0); else if (!NILP (current_buffer->enable_multibyte_characters)) { - int pos = PT_BYTE; + EMACS_INT pos = PT_BYTE; DEC_POS (pos); XSETFASTINT (temp, FETCH_CHAR (pos)); } @@ -1185,7 +1189,7 @@ If POS is out of range, the value is nil. */) (Lisp_Object pos) { - register int pos_byte; + register EMACS_INT pos_byte; if (NILP (pos)) { @@ -1218,7 +1222,7 @@ (Lisp_Object pos) { register Lisp_Object val; - register int pos_byte; + register EMACS_INT pos_byte; if (NILP (pos)) { @@ -2266,8 +2270,9 @@ (Lisp_Object character, Lisp_Object count, Lisp_Object inherit) { register unsigned char *string; - register int strlen; - register int i, n; + register EMACS_INT strlen; + register int i; + register EMACS_INT n; int len; unsigned char str[MAX_MULTIBYTE_LENGTH]; @@ -2278,6 +2283,8 @@ len = CHAR_STRING (XFASTINT (character), str); else str[0] = XFASTINT (character), len = 1; + if (MOST_POSITIVE_FIXNUM / len < XINT (count)) + error ("Maximum buffer size would be exceeded"); n = XINT (count) * len; if (n <= 0) return Qnil; @@ -2343,10 +2350,10 @@ buffer substrings. */ Lisp_Object -make_buffer_string (int start, int end, int props) +make_buffer_string (EMACS_INT start, EMACS_INT end, int props) { - int start_byte = CHAR_TO_BYTE (start); - int end_byte = CHAR_TO_BYTE (end); + EMACS_INT start_byte = CHAR_TO_BYTE (start); + EMACS_INT end_byte = CHAR_TO_BYTE (end); return make_buffer_string_both (start, start_byte, end, end_byte, props); } @@ -2367,7 +2374,8 @@ buffer substrings. */ Lisp_Object -make_buffer_string_both (int start, int start_byte, int end, int end_byte, int props) +make_buffer_string_both (EMACS_INT start, EMACS_INT start_byte, + EMACS_INT end, EMACS_INT end_byte, int props) { Lisp_Object result, tem, tem1; @@ -2400,7 +2408,7 @@ in the current buffer, if necessary. */ static void -update_buffer_properties (int start, int end) +update_buffer_properties (EMACS_INT start, EMACS_INT end) { /* If this buffer has some access functions, call them, specifying the range of the buffer being accessed. */ @@ -2439,7 +2447,7 @@ use `buffer-substring-no-properties' instead. */) (Lisp_Object start, Lisp_Object end) { - register int b, e; + register EMACS_INT b, e; validate_region (&start, &end); b = XINT (start); @@ -2455,7 +2463,7 @@ they can be in either order. */) (Lisp_Object start, Lisp_Object end) { - register int b, e; + register EMACS_INT b, e; validate_region (&start, &end); b = XINT (start); @@ -2481,7 +2489,7 @@ They default to the values of (point-min) and (point-max) in BUFFER. */) (Lisp_Object buffer, Lisp_Object start, Lisp_Object end) { - register int b, e, temp; + register EMACS_INT b, e, temp; register struct buffer *bp, *obuf; Lisp_Object buf; @@ -2534,13 +2542,13 @@ determines whether case is significant or ignored. */) (Lisp_Object buffer1, Lisp_Object start1, Lisp_Object end1, Lisp_Object buffer2, Lisp_Object start2, Lisp_Object end2) { - register int begp1, endp1, begp2, endp2, temp; + register EMACS_INT begp1, endp1, begp2, endp2, temp; register struct buffer *bp1, *bp2; register Lisp_Object trt = (!NILP (current_buffer->case_fold_search) ? current_buffer->case_canon_table : Qnil); - int chars = 0; - int i1, i2, i1_byte, i2_byte; + EMACS_INT chars = 0; + EMACS_INT i1, i2, i1_byte, i2_byte; /* Find the first buffer and its substring. */ @@ -2701,12 +2709,12 @@ Both characters must have the same length of multi-byte form. */) (Lisp_Object start, Lisp_Object end, Lisp_Object fromchar, Lisp_Object tochar, Lisp_Object noundo) { - register int pos, pos_byte, stop, i, len, end_byte; + register EMACS_INT pos, pos_byte, stop, i, len, end_byte; /* Keep track of the first change in the buffer: if 0 we haven't found it yet. if < 0 we've found it and we've run the before-change-function. if > 0 we've actually performed it and the value is its position. */ - int changed = 0; + EMACS_INT changed = 0; unsigned char fromstr[MAX_MULTIBYTE_LENGTH], tostr[MAX_MULTIBYTE_LENGTH]; unsigned char *p; int count = SPECPDL_INDEX (); @@ -2715,7 +2723,7 @@ #define COMBINING_AFTER 2 #define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER) int maybe_byte_combining = COMBINING_NO; - int last_changed = 0; + EMACS_INT last_changed = 0; int multibyte_p = !NILP (current_buffer->enable_multibyte_characters); restart: @@ -2772,7 +2780,7 @@ stop = min (stop, GPT_BYTE); while (1) { - int pos_byte_next = pos_byte; + EMACS_INT pos_byte_next = pos_byte; if (pos_byte >= stop) { @@ -2875,7 +2883,8 @@ } -static Lisp_Object check_translation (int, int, int, Lisp_Object); +static Lisp_Object check_translation (EMACS_INT, EMACS_INT, EMACS_INT, + Lisp_Object); /* Helper function for Ftranslate_region_internal. @@ -2884,7 +2893,8 @@ element is found, return it. Otherwise return Qnil. */ static Lisp_Object -check_translation (int pos, int pos_byte, int end, Lisp_Object val) +check_translation (EMACS_INT pos, EMACS_INT pos_byte, EMACS_INT end, + Lisp_Object val) { int buf_size = 16, buf_used = 0; int *buf = alloca (sizeof (int) * buf_size); @@ -2892,7 +2902,7 @@ for (; CONSP (val); val = XCDR (val)) { Lisp_Object elt; - int len, i; + EMACS_INT len, i; elt = XCAR (val); if (! CONSP (elt)) @@ -2908,7 +2918,7 @@ if (buf_used <= i) { unsigned char *p = BYTE_POS_ADDR (pos_byte); - int len; + int len1; if (buf_used == buf_size) { @@ -2919,8 +2929,8 @@ memcpy (newbuf, buf, sizeof (int) * buf_used); buf = newbuf; } - buf[buf_used++] = STRING_CHAR_AND_LENGTH (p, len); - pos_byte += len; + buf[buf_used++] = STRING_CHAR_AND_LENGTH (p, len1); + pos_byte += len1; } if (XINT (AREF (elt, i)) != buf[i]) break; @@ -2945,8 +2955,8 @@ register unsigned char *tt; /* Trans table. */ register int nc; /* New character. */ int cnt; /* Number of changes made. */ - int size; /* Size of translate table. */ - int pos, pos_byte, end_pos; + EMACS_INT size; /* Size of translate table. */ + EMACS_INT pos, pos_byte, end_pos; int multibyte = !NILP (current_buffer->enable_multibyte_characters); int string_multibyte; Lisp_Object val; @@ -3016,7 +3026,7 @@ } else { - int c; + EMACS_INT c; nc = oc; val = CHAR_TABLE_REF (table, oc); @@ -3229,7 +3239,7 @@ /* The restriction has changed from the saved one, so restore the saved restriction. */ { - int pt = BUF_PT (buf); + EMACS_INT pt = BUF_PT (buf); SET_BUF_BEGV_BOTH (buf, beg->charpos, beg->bytepos); SET_BUF_ZV_BOTH (buf, end->charpos, end->bytepos); @@ -3508,7 +3518,7 @@ (int nargs, register Lisp_Object *args) { register int n; /* The number of the next arg to substitute */ - register int total; /* An estimate of the final length */ + register EMACS_INT total; /* An estimate of the final length */ char *buf, *p; register unsigned char *format, *end, *format_start; int nchars; @@ -3602,8 +3612,8 @@ while (format != end) if (*format++ == '%') { - int thissize = 0; - int actual_width = 0; + EMACS_INT thissize = 0; + EMACS_INT actual_width = 0; unsigned char *this_format_start = format - 1; int field_width = 0; @@ -3845,8 +3855,8 @@ /* handle case (precision[n] >= 0) */ int width, padding; - int nbytes, start, end; - int nchars_string; + EMACS_INT nbytes, start, end; + EMACS_INT nchars_string; /* lisp_string_width ignores a precision of 0, but GNU libc functions print 0 characters when the precision @@ -3857,7 +3867,8 @@ if (precision[n] == 0) width = nchars_string = nbytes = 0; else if (precision[n] > 0) - width = lisp_string_width (args[n], precision[n], &nchars_string, &nbytes); + width = lisp_string_width (args[n], precision[n], + &nchars_string, &nbytes); else { /* no precision spec given for this argument */ width = lisp_string_width (args[n], -1, NULL, NULL); @@ -4016,7 +4027,8 @@ if (CONSP (props)) { - int bytepos = 0, position = 0, translated = 0, argn = 1; + EMACS_INT bytepos = 0, position = 0, translated = 0; + int argn = 1; Lisp_Object list; /* Adjust the bounds of each text property @@ -4034,7 +4046,7 @@ for (list = props; CONSP (list); list = XCDR (list)) { Lisp_Object item; - int pos; + EMACS_INT pos; item = XCAR (list); @@ -4170,11 +4182,12 @@ It's the caller's job to ensure that START1 <= END1 <= START2 <= END2. */ static void -transpose_markers (int start1, int end1, int start2, int end2, - int start1_byte, int end1_byte, - int start2_byte, int end2_byte) +transpose_markers (EMACS_INT start1, EMACS_INT end1, + EMACS_INT start2, EMACS_INT end2, + EMACS_INT start1_byte, EMACS_INT end1_byte, + EMACS_INT start2_byte, EMACS_INT end2_byte) { - register int amt1, amt1_byte, amt2, amt2_byte, diff, diff_byte, mpos; + register EMACS_INT amt1, amt1_byte, amt2, amt2_byte, diff, diff_byte, mpos; register struct Lisp_Marker *marker; /* Update point as if it were a marker. */ @@ -4271,7 +4284,7 @@ /* Swap the regions if they're reversed. */ if (start2 < end1) { - register int glumph = start1; + register EMACS_INT glumph = start1; start1 = start2; start2 = glumph; glumph = end1;
--- a/src/emacs.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/emacs.c Mon Sep 27 14:42:43 2010 +0900 @@ -59,6 +59,10 @@ #include "keyboard.h" #include "keymap.h" +#ifdef HAVE_GNUTLS +#include "gnutls.h" +#endif + #ifdef HAVE_NS #include "nsterm.h" #endif @@ -1569,6 +1573,10 @@ syms_of_fontset (); #endif /* HAVE_NS */ +#ifdef HAVE_GNUTLS + syms_of_gnutls (); +#endif + #ifdef HAVE_DBUS syms_of_dbusbind (); #endif /* HAVE_DBUS */
--- a/src/eval.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/eval.c Mon Sep 27 14:42:43 2010 +0900 @@ -79,7 +79,7 @@ /* Current number of specbindings allocated in specpdl. */ -int specpdl_size; +EMACS_INT specpdl_size; /* Pointer to beginning of specpdl. */ @@ -95,7 +95,7 @@ /* Depth in Lisp evaluations and function calls. */ -int lisp_eval_depth; +EMACS_INT lisp_eval_depth; /* Maximum allowed depth in Lisp evaluations and function calls. */ @@ -216,7 +216,7 @@ int debug_while_redisplaying; int count = SPECPDL_INDEX (); Lisp_Object val; - int old_max = max_specpdl_size; + EMACS_INT old_max = max_specpdl_size; /* Temporarily bump up the stack limits, so the debugger won't run out of stack. */ @@ -1992,7 +1992,7 @@ verror (const char *m, va_list ap) { char buf[200]; - int size = 200; + EMACS_INT size = 200; int mlen; char *buffer = buf; char *args[3]; @@ -2003,7 +2003,7 @@ while (1) { - int used; + EMACS_INT used; used = doprnt (buffer, size, m, m + mlen, ap); if (used < size) break;
--- a/src/fns.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/fns.c Mon Sep 27 14:42:43 2010 +0900 @@ -241,8 +241,8 @@ N - 1 is the number of characters that match at the beginning. */) (Lisp_Object str1, Lisp_Object start1, Lisp_Object end1, Lisp_Object str2, Lisp_Object start2, Lisp_Object end2, Lisp_Object ignore_case) { - register int end1_char, end2_char; - register int i1, i1_byte, i2, i2_byte; + register EMACS_INT end1_char, end2_char; + register EMACS_INT i1, i1_byte, i2, i2_byte; CHECK_STRING (str1); CHECK_STRING (str2); @@ -332,8 +332,8 @@ Symbols are also allowed; their print names are used instead. */) (register Lisp_Object s1, Lisp_Object s2) { - register int end; - register int i1, i1_byte, i2, i2_byte; + register EMACS_INT end; + register EMACS_INT i1, i1_byte, i2, i2_byte; if (SYMBOLP (s1)) s1 = SYMBOL_NAME (s1); @@ -456,8 +456,8 @@ struct textprop_rec { int argnum; /* refer to ARGS (arguments of `concat') */ - int from; /* refer to ARGS[argnum] (argument string) */ - int to; /* refer to VAL (the target string) */ + EMACS_INT from; /* refer to ARGS[argnum] (argument string) */ + EMACS_INT to; /* refer to VAL (the target string) */ }; static Lisp_Object @@ -466,10 +466,10 @@ Lisp_Object val; register Lisp_Object tail; register Lisp_Object this; - int toindex; - int toindex_byte = 0; - register int result_len; - register int result_len_byte; + EMACS_INT toindex; + EMACS_INT toindex_byte = 0; + register EMACS_INT result_len; + register EMACS_INT result_len_byte; register int argnum; Lisp_Object last_tail; Lisp_Object prev; @@ -513,16 +513,16 @@ some_multibyte = 0; for (argnum = 0; argnum < nargs; argnum++) { - int len; + EMACS_INT len; this = args[argnum]; len = XFASTINT (Flength (this)); if (target_type == Lisp_String) { /* We must count the number of bytes needed in the string as well as the number of characters. */ - int i; + EMACS_INT i; Lisp_Object ch; - int this_len_byte; + EMACS_INT this_len_byte; if (VECTORP (this)) for (i = 0; i < len; i++) @@ -594,9 +594,9 @@ for (argnum = 0; argnum < nargs; argnum++) { Lisp_Object thislen; - int thisleni = 0; - register unsigned int thisindex = 0; - register unsigned int thisindex_byte = 0; + EMACS_INT thisleni = 0; + register EMACS_INT thisindex = 0; + register EMACS_INT thisindex_byte = 0; this = args[argnum]; if (!CONSP (this)) @@ -606,7 +606,7 @@ if (STRINGP (this) && STRINGP (val) && STRING_MULTIBYTE (this) == some_multibyte) { - int thislen_byte = SBYTES (this); + EMACS_INT thislen_byte = SBYTES (this); memcpy (SDATA (val) + toindex_byte, SDATA (this), SBYTES (this)); if (! NULL_INTERVAL_P (STRING_INTERVALS (this))) @@ -713,7 +713,7 @@ if (num_textprops > 0) { Lisp_Object props; - int last_to_end = -1; + EMACS_INT last_to_end = -1; for (argnum = 0; argnum < num_textprops; argnum++) { @@ -938,7 +938,7 @@ Lisp_Object string_make_unibyte (Lisp_Object string) { - int nchars; + EMACS_INT nchars; unsigned char *buf; Lisp_Object ret; USE_SAFE_ALLOCA; @@ -1003,7 +1003,7 @@ if (STRING_MULTIBYTE (string)) { - int bytes = SBYTES (string); + EMACS_INT bytes = SBYTES (string); unsigned char *str = (unsigned char *) xmalloc (bytes); memcpy (str, SDATA (string), bytes); @@ -1036,7 +1036,7 @@ if (! STRING_MULTIBYTE (string)) { Lisp_Object new_string; - int nchars, nbytes; + EMACS_INT nchars, nbytes; parse_str_as_multibyte (SDATA (string), SBYTES (string), @@ -1138,10 +1138,10 @@ (Lisp_Object string, register Lisp_Object from, Lisp_Object to) { Lisp_Object res; - int size; - int size_byte = 0; - int from_char, to_char; - int from_byte = 0, to_byte = 0; + EMACS_INT size; + EMACS_INT size_byte = 0; + EMACS_INT from_char, to_char; + EMACS_INT from_byte = 0, to_byte = 0; CHECK_VECTOR_OR_STRING (string); CHECK_NUMBER (from); @@ -1206,9 +1206,9 @@ With one argument, just copy STRING without its properties. */) (Lisp_Object string, register Lisp_Object from, Lisp_Object to) { - int size, size_byte; - int from_char, to_char; - int from_byte, to_byte; + EMACS_INT size, size_byte; + EMACS_INT from_char, to_char; + EMACS_INT from_byte, to_byte; CHECK_STRING (string); @@ -1256,11 +1256,12 @@ both in characters and in bytes. */ Lisp_Object -substring_both (Lisp_Object string, int from, int from_byte, int to, int to_byte) +substring_both (Lisp_Object string, EMACS_INT from, EMACS_INT from_byte, + EMACS_INT to, EMACS_INT to_byte) { Lisp_Object res; - int size; - int size_byte; + EMACS_INT size; + EMACS_INT size_byte; CHECK_VECTOR_OR_STRING (string); @@ -2147,7 +2148,9 @@ ARRAY is a vector, string, char-table, or bool-vector. */) (Lisp_Object array, Lisp_Object item) { - register int size, index, charval; + register EMACS_INT size, index; + int charval; + if (VECTORP (array)) { register Lisp_Object *p = XVECTOR (array)->contents; @@ -2173,7 +2176,7 @@ { unsigned char str[MAX_MULTIBYTE_LENGTH]; int len = CHAR_STRING (charval, str); - int size_byte = SBYTES (array); + EMACS_INT size_byte = SBYTES (array); unsigned char *p1 = p, *endp = p + size_byte; int i; @@ -2221,7 +2224,7 @@ This makes STRING unibyte and may change its length. */) (Lisp_Object string) { - int len; + EMACS_INT len; CHECK_STRING (string); len = SBYTES (string); memset (SDATA (string), 0, len); @@ -2285,11 +2288,11 @@ LENI is the length of VALS, which should also be the length of SEQ. */ static void -mapcar1 (int leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) +mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) { register Lisp_Object tail; Lisp_Object dummy; - register int i; + register EMACS_INT i; struct gcpro gcpro1, gcpro2, gcpro3; if (vals) @@ -2331,12 +2334,12 @@ } else if (STRINGP (seq)) { - int i_byte; + EMACS_INT i_byte; for (i = 0, i_byte = 0; i < leni;) { int c; - int i_before = i; + EMACS_INT i_before = i; FETCH_STRING_CHAR_ADVANCE (c, seq, i, i_byte); XSETFASTINT (dummy, c); @@ -2368,10 +2371,10 @@ (Lisp_Object function, Lisp_Object sequence, Lisp_Object separator) { Lisp_Object len; - register int leni; + register EMACS_INT leni; int nargs; register Lisp_Object *args; - register int i; + register EMACS_INT i; struct gcpro gcpro1; Lisp_Object ret; USE_SAFE_ALLOCA; @@ -2408,7 +2411,7 @@ (Lisp_Object function, Lisp_Object sequence) { register Lisp_Object len; - register int leni; + register EMACS_INT leni; register Lisp_Object *args; Lisp_Object ret; USE_SAFE_ALLOCA; @@ -2434,7 +2437,7 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */) (Lisp_Object function, Lisp_Object sequence) { - register int leni; + register EMACS_INT leni; leni = XFASTINT (Flength (sequence)); if (CHAR_TABLE_P (sequence)) @@ -2958,8 +2961,9 @@ base64 characters. */ -static int base64_encode_1 (const char *, char *, int, int, int); -static int base64_decode_1 (const char *, char *, int, int, int *); +static EMACS_INT base64_encode_1 (const char *, char *, EMACS_INT, int, int); +static EMACS_INT base64_decode_1 (const char *, char *, EMACS_INT, int, + EMACS_INT *); DEFUN ("base64-encode-region", Fbase64_encode_region, Sbase64_encode_region, 2, 3, "r", @@ -2970,9 +2974,9 @@ (Lisp_Object beg, Lisp_Object end, Lisp_Object no_line_break) { char *encoded; - int allength, length; - int ibeg, iend, encoded_length; - int old_pos = PT; + EMACS_INT allength, length; + EMACS_INT ibeg, iend, encoded_length; + EMACS_INT old_pos = PT; USE_SAFE_ALLOCA; validate_region (&beg, &end); @@ -3028,7 +3032,7 @@ into shorter lines. */) (Lisp_Object string, Lisp_Object no_line_break) { - int allength, length, encoded_length; + EMACS_INT allength, length, encoded_length; char *encoded; Lisp_Object encoded_string; USE_SAFE_ALLOCA; @@ -3064,10 +3068,12 @@ return encoded_string; } -static int -base64_encode_1 (const char *from, char *to, int length, int line_break, int multibyte) +static EMACS_INT +base64_encode_1 (const char *from, char *to, EMACS_INT length, + int line_break, int multibyte) { - int counter = 0, i = 0; + int counter = 0; + EMACS_INT i = 0; char *e = to; int c; unsigned int value; @@ -3166,11 +3172,11 @@ If the region can't be decoded, signal an error and don't modify the buffer. */) (Lisp_Object beg, Lisp_Object end) { - int ibeg, iend, length, allength; + EMACS_INT ibeg, iend, length, allength; char *decoded; - int old_pos = PT; - int decoded_length; - int inserted_chars; + EMACS_INT old_pos = PT; + EMACS_INT decoded_length; + EMACS_INT inserted_chars; int multibyte = !NILP (current_buffer->enable_multibyte_characters); USE_SAFE_ALLOCA; @@ -3227,7 +3233,7 @@ (Lisp_Object string) { char *decoded; - int length, decoded_length; + EMACS_INT length, decoded_length; Lisp_Object decoded_string; USE_SAFE_ALLOCA; @@ -3259,14 +3265,15 @@ form. If NCHARS_RETRUN is not NULL, store the number of produced characters in *NCHARS_RETURN. */ -static int -base64_decode_1 (const char *from, char *to, int length, int multibyte, int *nchars_return) +static EMACS_INT +base64_decode_1 (const char *from, char *to, EMACS_INT length, + int multibyte, EMACS_INT *nchars_return) { - int i = 0; + EMACS_INT i = 0; /* Used inside READ_QUADRUPLET_BYTE */ char *e = to; unsigned char c; unsigned long value; - int nchars = 0; + EMACS_INT nchars = 0; while (1) { @@ -4572,13 +4579,13 @@ unsigned char digest[16]; unsigned char value[33]; int i; - int size; - int size_byte = 0; - int start_char = 0, end_char = 0; - int start_byte = 0, end_byte = 0; - register int b, e; + EMACS_INT size; + EMACS_INT size_byte = 0; + EMACS_INT start_char = 0, end_char = 0; + EMACS_INT start_byte = 0, end_byte = 0; + register EMACS_INT b, e; register struct buffer *bp; - int temp; + EMACS_INT temp; if (STRINGP (object)) {
--- a/src/font.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/font.c Mon Sep 27 14:42:43 2010 +0900 @@ -237,7 +237,7 @@ int i; Lisp_Object tem; Lisp_Object obarray; - int nbytes, nchars; + EMACS_INT nbytes, nchars; if (len == 1 && *str == '*') return Qnil;
--- a/src/frame.h Mon Sep 27 14:27:28 2010 +0900 +++ b/src/frame.h Mon Sep 27 14:42:43 2010 +0900 @@ -310,7 +310,7 @@ /* Canonical X unit. Width of default font, in pixels. */ int column_width; - /* Widht of space glyph of default font, in pixels. */ + /* Width of space glyph of default font, in pixels. */ int space_width; /* Canonical Y unit. Height of a line, in pixels. */
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/gnutls.c Mon Sep 27 14:42:43 2010 +0900 @@ -0,0 +1,551 @@ +/* GnuTLS glue for GNU Emacs. + Copyright (C) 2010 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ + +#include <config.h> +#include <errno.h> +#include <setjmp.h> + +#include "lisp.h" +#include "process.h" + +#ifdef HAVE_GNUTLS +#include <gnutls/gnutls.h> + +Lisp_Object Qgnutls_code; +Lisp_Object Qgnutls_anon, Qgnutls_x509pki; +Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again, + Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake; +int global_initialized; + +int +emacs_gnutls_write (int fildes, gnutls_session_t state, char *buf, + unsigned int nbyte) +{ + register int rtnval, bytes_written; + + bytes_written = 0; + + while (nbyte > 0) + { + rtnval = gnutls_write (state, buf, nbyte); + + if (rtnval == -1) + { + if (errno == EINTR) + continue; + else + return (bytes_written ? bytes_written : -1); + } + + buf += rtnval; + nbyte -= rtnval; + bytes_written += rtnval; + } + fsync (STDOUT_FILENO); + + return (bytes_written); +} + +int +emacs_gnutls_read (int fildes, gnutls_session_t state, char *buf, + unsigned int nbyte) +{ + register int rtnval; + + do { + rtnval = gnutls_read (state, buf, nbyte); + } while (rtnval == GNUTLS_E_INTERRUPTED || rtnval == GNUTLS_E_AGAIN); + fsync (STDOUT_FILENO); + + return (rtnval); +} + +/* convert an integer error to a Lisp_Object; it will be either a + known symbol like `gnutls_e_interrupted' and `gnutls_e_again' or + simply the integer value of the error. GNUTLS_E_SUCCESS is mapped + to Qt. */ +Lisp_Object gnutls_make_error (int error) +{ + switch (error) + { + case GNUTLS_E_SUCCESS: + return Qt; + case GNUTLS_E_AGAIN: + return Qgnutls_e_again; + case GNUTLS_E_INTERRUPTED: + return Qgnutls_e_interrupted; + case GNUTLS_E_INVALID_SESSION: + return Qgnutls_e_invalid_session; + } + + return make_number (error); +} + +DEFUN ("gnutls-get-initstage", Fgnutls_get_initstage, Sgnutls_get_initstage, 1, 1, 0, + doc: /* Return the GnuTLS init stage of PROCESS. +See also `gnutls-boot'. */) + (Lisp_Object proc) +{ + CHECK_PROCESS (proc); + + return make_number (GNUTLS_INITSTAGE (proc)); +} + +DEFUN ("gnutls-errorp", Fgnutls_errorp, Sgnutls_errorp, 1, 1, 0, + doc: /* Returns t if ERROR (as generated by gnutls_make_error) +indicates a GnuTLS problem. */) + (Lisp_Object error) +{ + if (EQ (error, Qt)) return Qnil; + + return Qt; +} + +DEFUN ("gnutls-error-fatalp", Fgnutls_error_fatalp, Sgnutls_error_fatalp, 1, 1, 0, + doc: /* Checks if ERROR is fatal. +ERROR is an integer or a symbol with an integer `gnutls-code' property. */) + (Lisp_Object err) +{ + Lisp_Object code; + + if (EQ (err, Qt)) return Qnil; + + if (SYMBOLP (err)) + { + code = Fget (err, Qgnutls_code); + if (NUMBERP (code)) + { + err = code; + } + else + { + error ("Symbol has no numeric gnutls-code property"); + } + } + + if (!NUMBERP (err)) + error ("Not an error symbol or code"); + + if (0 == gnutls_error_is_fatal (XINT (err))) + return Qnil; + + return Qt; +} + +DEFUN ("gnutls-error-string", Fgnutls_error_string, Sgnutls_error_string, 1, 1, 0, + doc: /* Returns a description of ERROR. +ERROR is an integer or a symbol with an integer `gnutls-code' property. */) + (Lisp_Object err) +{ + Lisp_Object code; + + if (EQ (err, Qt)) return build_string ("Not an error"); + + if (SYMBOLP (err)) + { + code = Fget (err, Qgnutls_code); + if (NUMBERP (code)) + { + err = code; + } + else + { + return build_string ("Symbol has no numeric gnutls-code property"); + } + } + + if (!NUMBERP (err)) + return build_string ("Not an error symbol or code"); + + return build_string (gnutls_strerror (XINT (err))); +} + +DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0, + doc: /* Deallocate GNU TLS resources associated with PROCESS. +See also `gnutls-init'. */) + (Lisp_Object proc) +{ + gnutls_session_t state; + + CHECK_PROCESS (proc); + state = XPROCESS (proc)->gnutls_state; + + if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT) + { + gnutls_deinit (state); + GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1; + } + + return Qt; +} + +/* Initializes global GNU TLS state to defaults. +Call `gnutls-global-deinit' when GNU TLS usage is no longer needed. +Returns zero on success. */ +Lisp_Object gnutls_emacs_global_init (void) +{ + int ret = GNUTLS_E_SUCCESS; + + if (!global_initialized) + ret = gnutls_global_init (); + + global_initialized = 1; + + return gnutls_make_error (ret); +} + +/* Deinitializes global GNU TLS state. +See also `gnutls-global-init'. */ +Lisp_Object gnutls_emacs_global_deinit (void) +{ + if (global_initialized) + gnutls_global_deinit (); + + global_initialized = 0; + + return gnutls_make_error (GNUTLS_E_SUCCESS); +} + +DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 6, 0, + doc: /* Initializes client-mode GnuTLS for process PROC. +Currently only client mode is supported. Returns a success/failure +value you can check with `gnutls-errorp'. + +PRIORITY_STRING is a string describing the priority. +TYPE is either `gnutls-anon' or `gnutls-x509pki'. +TRUSTFILE is a PEM encoded trust file for `gnutls-x509pki'. +KEYFILE is ... for `gnutls-x509pki' (TODO). +CALLBACK is ... for `gnutls-x509pki' (TODO). + +Note that the priority is set on the client. The server does not use +the protocols's priority except for disabling protocols that were not +specified. + +Processes must be initialized with this function before other GNU TLS +functions are used. This function allocates resources which can only +be deallocated by calling `gnutls-deinit' or by calling it again. + +Each authentication type may need additional information in order to +work. For X.509 PKI (`gnutls-x509pki'), you need TRUSTFILE and +KEYFILE and optionally CALLBACK. */) + (Lisp_Object proc, Lisp_Object priority_string, Lisp_Object type, + Lisp_Object trustfile, Lisp_Object keyfile, Lisp_Object callback) +{ + int ret = GNUTLS_E_SUCCESS; + + /* TODO: GNUTLS_X509_FMT_DER is also an option. */ + int file_format = GNUTLS_X509_FMT_PEM; + + gnutls_session_t state; + gnutls_certificate_credentials_t x509_cred; + gnutls_anon_client_credentials_t anon_cred; + gnutls_srp_client_credentials_t srp_cred; + gnutls_datum_t data; + Lisp_Object global_init; + + CHECK_PROCESS (proc); + CHECK_SYMBOL (type); + CHECK_STRING (priority_string); + + state = XPROCESS (proc)->gnutls_state; + + /* always initialize globals. */ + global_init = gnutls_emacs_global_init (); + if (! NILP (Fgnutls_errorp (global_init))) + return global_init; + + /* deinit and free resources. */ + if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_CRED_ALLOC) + { + message ("gnutls: deallocating certificates"); + + if (EQ (type, Qgnutls_x509pki)) + { + message ("gnutls: deallocating x509 certificates"); + + x509_cred = XPROCESS (proc)->x509_cred; + gnutls_certificate_free_credentials (x509_cred); + } + else if (EQ (type, Qgnutls_anon)) + { + message ("gnutls: deallocating anon certificates"); + + anon_cred = XPROCESS (proc)->anon_cred; + gnutls_anon_free_client_credentials (anon_cred); + } + else + { + error ("unknown credential type"); + ret = GNUTLS_EMACS_ERROR_INVALID_TYPE; + } + + if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT) + { + message ("gnutls: deinitializing"); + + Fgnutls_deinit (proc); + } + } + + GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY; + + message ("gnutls: allocating credentials"); + + if (EQ (type, Qgnutls_x509pki)) + { + message ("gnutls: allocating x509 credentials"); + + x509_cred = XPROCESS (proc)->x509_cred; + if (gnutls_certificate_allocate_credentials (&x509_cred) < 0) + memory_full (); + } + else if (EQ (type, Qgnutls_anon)) + { + message ("gnutls: allocating anon credentials"); + + anon_cred = XPROCESS (proc)->anon_cred; + if (gnutls_anon_allocate_client_credentials (&anon_cred) < 0) + memory_full (); + } + else + { + error ("unknown credential type"); + ret = GNUTLS_EMACS_ERROR_INVALID_TYPE; + } + + if (ret < GNUTLS_E_SUCCESS) + return gnutls_make_error (ret); + + GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_ALLOC; + + message ("gnutls: setting the trustfile"); + + if (EQ (type, Qgnutls_x509pki)) + { + if (STRINGP (trustfile)) + { + ret = gnutls_certificate_set_x509_trust_file + (x509_cred, + XSTRING (trustfile)->data, + file_format); + + if (ret < GNUTLS_E_SUCCESS) + return gnutls_make_error (ret); + + message ("gnutls: processed %d CA certificates", ret); + } + + message ("gnutls: setting the keyfile"); + + if (STRINGP (keyfile)) + { + ret = gnutls_certificate_set_x509_crl_file + (x509_cred, + XSTRING (keyfile)->data, + file_format); + + if (ret < GNUTLS_E_SUCCESS) + return gnutls_make_error (ret); + + message ("gnutls: processed %d CRL(s)", ret); + } + } + + GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES; + + message ("gnutls: gnutls_init"); + + ret = gnutls_init (&state, GNUTLS_CLIENT); + + if (ret < GNUTLS_E_SUCCESS) + return gnutls_make_error (ret); + + XPROCESS (proc)->gnutls_state = state; + + GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT; + + message ("gnutls: setting the priority string"); + + ret = gnutls_priority_set_direct(state, + (char*) SDATA (priority_string), + NULL); + + if (ret < GNUTLS_E_SUCCESS) + return gnutls_make_error (ret); + + GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_PRIORITY; + + message ("gnutls: setting the credentials"); + + if (EQ (type, Qgnutls_x509pki)) + { + message ("gnutls: setting the x509 credentials"); + + ret = gnutls_cred_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred); + } + else if (EQ (type, Qgnutls_anon)) + { + message ("gnutls: setting the anon credentials"); + + ret = gnutls_cred_set (state, GNUTLS_CRD_ANON, anon_cred); + } + else + { + error ("unknown credential type"); + ret = GNUTLS_EMACS_ERROR_INVALID_TYPE; + } + + if (ret < GNUTLS_E_SUCCESS) + return gnutls_make_error (ret); + + XPROCESS (proc)->anon_cred = anon_cred; + XPROCESS (proc)->x509_cred = x509_cred; + XPROCESS (proc)->gnutls_cred_type = type; + + GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET; + + return gnutls_make_error (GNUTLS_E_SUCCESS); +} + +DEFUN ("gnutls-bye", Fgnutls_bye, + Sgnutls_bye, 2, 2, 0, + doc: /* Terminate current GNU TLS connection for PROCESS. +The connection should have been initiated using `gnutls-handshake'. + +If CONT is not nil the TLS connection gets terminated and further +receives and sends will be disallowed. If the return value is zero you +may continue using the connection. If CONT is nil, GnuTLS actually +sends an alert containing a close request and waits for the peer to +reply with the same message. In order to reuse the connection you +should wait for an EOF from the peer. + +This function may also return `gnutls-e-again', or +`gnutls-e-interrupted'. */) + (Lisp_Object proc, Lisp_Object cont) +{ + gnutls_session_t state; + int ret; + + CHECK_PROCESS (proc); + + state = XPROCESS (proc)->gnutls_state; + + ret = gnutls_bye (state, + NILP (cont) ? GNUTLS_SHUT_RDWR : GNUTLS_SHUT_WR); + + return gnutls_make_error (ret); +} + +DEFUN ("gnutls-handshake", Fgnutls_handshake, + Sgnutls_handshake, 1, 1, 0, + doc: /* Perform GNU TLS handshake for PROCESS. +The identity of the peer is checked automatically. This function will +fail if any problem is encountered, and will return a negative error +code. In case of a client, if it has been asked to resume a session, +but the server didn't, then a full handshake will be performed. + +If the error `gnutls-e-not-ready-for-handshake' is returned, you +didn't call `gnutls-boot' first. + +This function may also return the non-fatal errors `gnutls-e-again', +or `gnutls-e-interrupted'. In that case you may resume the handshake +(by calling this function again). */) + (Lisp_Object proc) +{ + gnutls_session_t state; + int ret; + + CHECK_PROCESS (proc); + state = XPROCESS (proc)->gnutls_state; + + if (GNUTLS_INITSTAGE (proc) < GNUTLS_STAGE_HANDSHAKE_CANDO) + return Qgnutls_e_not_ready_for_handshake; + + + if (GNUTLS_INITSTAGE (proc) < GNUTLS_STAGE_TRANSPORT_POINTERS_SET) + { + /* for a network process in Emacs infd and outfd are the same + but this shows our intent more clearly. */ + message ("gnutls: handshake: setting the transport pointers to %d/%d", + XPROCESS (proc)->infd, XPROCESS (proc)->outfd); + + gnutls_transport_set_ptr2 (state, XPROCESS (proc)->infd, + XPROCESS (proc)->outfd); + + GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_TRANSPORT_POINTERS_SET; + } + + message ("gnutls: handshake: handshaking"); + ret = gnutls_handshake (state); + + GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_HANDSHAKE_TRIED; + + if (GNUTLS_E_SUCCESS == ret) + { + /* here we're finally done. */ + GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_READY; + } + + return gnutls_make_error (ret); +} + +void +syms_of_gnutls (void) +{ + global_initialized = 0; + + Qgnutls_code = intern_c_string ("gnutls-code"); + staticpro (&Qgnutls_code); + + Qgnutls_anon = intern_c_string ("gnutls-anon"); + staticpro (&Qgnutls_anon); + + Qgnutls_x509pki = intern_c_string ("gnutls-x509pki"); + staticpro (&Qgnutls_x509pki); + + Qgnutls_e_interrupted = intern_c_string ("gnutls-e-interrupted"); + staticpro (&Qgnutls_e_interrupted); + Fput (Qgnutls_e_interrupted, Qgnutls_code, + make_number (GNUTLS_E_INTERRUPTED)); + + Qgnutls_e_again = intern_c_string ("gnutls-e-again"); + staticpro (&Qgnutls_e_again); + Fput (Qgnutls_e_again, Qgnutls_code, + make_number (GNUTLS_E_AGAIN)); + + Qgnutls_e_invalid_session = intern_c_string ("gnutls-e-invalid-session"); + staticpro (&Qgnutls_e_invalid_session); + Fput (Qgnutls_e_invalid_session, Qgnutls_code, + make_number (GNUTLS_E_INVALID_SESSION)); + + Qgnutls_e_not_ready_for_handshake = + intern_c_string ("gnutls-e-not-ready-for-handshake"); + staticpro (&Qgnutls_e_not_ready_for_handshake); + Fput (Qgnutls_e_not_ready_for_handshake, Qgnutls_code, + make_number (GNUTLS_E_APPLICATION_ERROR_MIN)); + + defsubr (&Sgnutls_get_initstage); + defsubr (&Sgnutls_errorp); + defsubr (&Sgnutls_error_fatalp); + defsubr (&Sgnutls_error_string); + defsubr (&Sgnutls_boot); + defsubr (&Sgnutls_deinit); + defsubr (&Sgnutls_handshake); + defsubr (&Sgnutls_bye); +} +#endif
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/gnutls.h Mon Sep 27 14:42:43 2010 +0900 @@ -0,0 +1,60 @@ +/* GnuTLS glue for GNU Emacs. + Copyright (C) 2010 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ + +#ifndef EMACS_GNUTLS_DEFINED +#define EMACS_GNUTLS_DEFINED + +#ifdef HAVE_GNUTLS +#include <gnutls/gnutls.h> + +typedef enum +{ + /* Initialization stages. */ + GNUTLS_STAGE_EMPTY = 0, + GNUTLS_STAGE_CRED_ALLOC, + GNUTLS_STAGE_FILES, + GNUTLS_STAGE_INIT, + GNUTLS_STAGE_PRIORITY, + GNUTLS_STAGE_CRED_SET, + + /* Handshake stages. */ + GNUTLS_STAGE_HANDSHAKE_CANDO = GNUTLS_STAGE_CRED_SET, + GNUTLS_STAGE_TRANSPORT_POINTERS_SET, + GNUTLS_STAGE_HANDSHAKE_TRIED, + + GNUTLS_STAGE_READY, +} gnutls_initstage_t; + +#define GNUTLS_EMACS_ERROR_INVALID_TYPE GNUTLS_E_APPLICATION_ERROR_MIN + +#define GNUTLS_INITSTAGE(proc) (XPROCESS (proc)->gnutls_initstage) + +#define GNUTLS_PROCESS_USABLE(proc) (GNUTLS_INITSTAGE(proc) >= GNUTLS_STAGE_READY) + +int +emacs_gnutls_write (int fildes, gnutls_session_t state, char *buf, + unsigned int nbyte); +int +emacs_gnutls_read (int fildes, gnutls_session_t state, char *buf, + unsigned int nbyte); + +extern void syms_of_gnutls (void); + +#endif + +#endif
--- a/src/gtkutil.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/gtkutil.c Mon Sep 27 14:42:43 2010 +0900 @@ -3716,6 +3716,8 @@ GtkSettings *settings = gtk_widget_get_settings (GTK_WIDGET (wbutton)); GtkImageType store_type = gtk_image_get_storage_type (wimage); + g_object_set (G_OBJECT (settings), "gtk-menu-images", TRUE, NULL); + if (store_type == GTK_IMAGE_STOCK) { gchar *stock_id;
--- a/src/image.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/image.c Mon Sep 27 14:42:43 2010 +0900 @@ -8626,7 +8626,7 @@ #if defined (HAVE_IMAGEMAGICK) if (EQ (type, Qimagemagick)) { - /* MagickWandGenesis() initalizes the imagemagick library. */ + /* MagickWandGenesis() initializes the imagemagick library. */ MagickWandGenesis (); return CHECK_LIB_AVAILABLE (&imagemagick_type, init_imagemagick_functions, libraries);
--- a/src/indent.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/indent.c Mon Sep 27 14:42:43 2010 +0900 @@ -865,7 +865,7 @@ (void) { Lisp_Object val; - int opoint = PT, opoint_byte = PT_BYTE; + EMACS_INT opoint = PT, opoint_byte = PT_BYTE; scan_newline (PT, PT_BYTE, BEGV, BEGV_BYTE, -1, 1); @@ -964,10 +964,10 @@ preceding line. */ int -indented_beyond_p (int pos, int pos_byte, double column) +indented_beyond_p (EMACS_INT pos, EMACS_INT pos_byte, double column) { double val; - int opoint = PT, opoint_byte = PT_BYTE; + EMACS_INT opoint = PT, opoint_byte = PT_BYTE; SET_PT_BOTH (pos, pos_byte); while (PT > BEGV && FETCH_BYTE (PT_BYTE) == '\n') @@ -1254,7 +1254,7 @@ to be changed here. */ { unsigned char *ovstr; - int ovlen = overlay_strings (pos, win, &ovstr); + EMACS_INT ovlen = overlay_strings (pos, win, &ovstr); hpos += ((multibyte && ovlen > 0) ? strwidth (ovstr, ovlen) : ovlen); } @@ -1448,7 +1448,7 @@ the text character-by-character. */ if (current_buffer->width_run_cache && pos >= next_width_run) { - int run_end; + EMACS_INT run_end; int common_width = region_cache_forward (current_buffer, current_buffer->width_run_cache, @@ -1459,7 +1459,7 @@ want to skip over it for some other reason. */ if (common_width != 0) { - int run_end_hpos; + EMACS_INT run_end_hpos; /* Don't go past the final buffer posn the user requested. */
--- a/src/insdel.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/insdel.c Mon Sep 27 14:42:43 2010 +0900 @@ -2051,14 +2051,15 @@ /* If `select-active-regions' is non-nil, save the region text. */ if (!NILP (current_buffer->mark_active) + && XMARKER (current_buffer->mark)->buffer && NILP (Vsaved_region_selection) && (EQ (Vselect_active_regions, Qonly) ? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly) : (!NILP (Vselect_active_regions) && !NILP (Vtransient_mark_mode)))) { - int b = XINT (Fmarker_position (current_buffer->mark)); - int e = XINT (make_number (PT)); + EMACS_INT b = XMARKER (current_buffer->mark)->charpos; + EMACS_INT e = PT; if (b < e) Vsaved_region_selection = make_buffer_string (b, e, 0); else if (b > e)
--- a/src/intervals.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/intervals.c Mon Sep 27 14:42:43 2010 +0900 @@ -222,7 +222,8 @@ Pass FUNCTION two args: an interval, and ARG. */ void -traverse_intervals (INTERVAL tree, int position, void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg) +traverse_intervals (INTERVAL tree, EMACS_INT position, + void (*function) (INTERVAL, Lisp_Object), Lisp_Object arg) { while (!NULL_INTERVAL_P (tree)) { @@ -316,7 +317,7 @@ { INTERVAL i; INTERVAL B = interval->left; - int old_total = interval->total_length; + EMACS_INT old_total = interval->total_length; /* Deal with any Parent of A; make it point to B. */ if (! ROOT_INTERVAL_P (interval)) @@ -363,7 +364,7 @@ { INTERVAL i; INTERVAL B = interval->right; - int old_total = interval->total_length; + EMACS_INT old_total = interval->total_length; /* Deal with any parent of A; make it point to B. */ if (! ROOT_INTERVAL_P (interval)) @@ -402,7 +403,7 @@ static INTERVAL balance_an_interval (INTERVAL i) { - register int old_diff, new_diff; + register EMACS_INT old_diff, new_diff; while (1) { @@ -502,11 +503,11 @@ it is still a root after this operation. */ INTERVAL -split_interval_right (INTERVAL interval, int offset) +split_interval_right (INTERVAL interval, EMACS_INT offset) { INTERVAL new = make_interval (); - int position = interval->position; - int new_length = LENGTH (interval) - offset; + EMACS_INT position = interval->position; + EMACS_INT new_length = LENGTH (interval) - offset; new->position = position + offset; SET_INTERVAL_PARENT (new, interval); @@ -547,10 +548,10 @@ it is still a root after this operation. */ INTERVAL -split_interval_left (INTERVAL interval, int offset) +split_interval_left (INTERVAL interval, EMACS_INT offset) { INTERVAL new = make_interval (); - int new_length = offset; + EMACS_INT new_length = offset; new->position = interval->position; interval->position = interval->position + offset; @@ -613,11 +614,11 @@ will update this cache based on the result of find_interval. */ INTERVAL -find_interval (register INTERVAL tree, register int position) +find_interval (register INTERVAL tree, register EMACS_INT position) { /* The distance from the left edge of the subtree at TREE to POSITION. */ - register int relative_position; + register EMACS_INT relative_position; if (NULL_INTERVAL_P (tree)) return NULL_INTERVAL; @@ -670,7 +671,7 @@ next_interval (register INTERVAL interval) { register INTERVAL i = interval; - register int next_position; + register EMACS_INT next_position; if (NULL_INTERVAL_P (i)) return NULL_INTERVAL; @@ -745,7 +746,7 @@ To speed up the process, we assume that the ->position of I and all its parents is already uptodate. */ INTERVAL -update_interval (register INTERVAL i, int pos) +update_interval (register INTERVAL i, EMACS_INT pos) { if (NULL_INTERVAL_P (i)) return NULL_INTERVAL; @@ -864,13 +865,14 @@ this text, and make it have the merged properties of both ends. */ static INTERVAL -adjust_intervals_for_insertion (INTERVAL tree, int position, int length) +adjust_intervals_for_insertion (INTERVAL tree, + EMACS_INT position, EMACS_INT length) { register INTERVAL i; register INTERVAL temp; int eobp = 0; Lisp_Object parent; - int offset; + EMACS_INT offset; if (TOTAL_LENGTH (tree) == 0) /* Paranoia */ abort (); @@ -1228,7 +1230,7 @@ delete_node (register INTERVAL i) { register INTERVAL migrate, this; - register int migrate_amt; + register EMACS_INT migrate_amt; if (NULL_INTERVAL_P (i->left)) return i->right; @@ -1261,7 +1263,7 @@ delete_interval (register INTERVAL i) { register INTERVAL parent; - int amt = LENGTH (i); + EMACS_INT amt = LENGTH (i); if (amt > 0) /* Only used on zero-length intervals now. */ abort (); @@ -1311,10 +1313,11 @@ Do this by recursing down TREE to the interval in question, and deleting the appropriate amount of text. */ -static int -interval_deletion_adjustment (register INTERVAL tree, register int from, register int amount) +static EMACS_INT +interval_deletion_adjustment (register INTERVAL tree, register EMACS_INT from, + register EMACS_INT amount) { - register int relative_position = from; + register EMACS_INT relative_position = from; if (NULL_INTERVAL_P (tree)) return 0; @@ -1322,9 +1325,9 @@ /* Left branch */ if (relative_position < LEFT_TOTAL_LENGTH (tree)) { - int subtract = interval_deletion_adjustment (tree->left, - relative_position, - amount); + EMACS_INT subtract = interval_deletion_adjustment (tree->left, + relative_position, + amount); tree->total_length -= subtract; CHECK_TOTAL_LENGTH (tree); return subtract; @@ -1333,7 +1336,7 @@ else if (relative_position >= (TOTAL_LENGTH (tree) - RIGHT_TOTAL_LENGTH (tree))) { - int subtract; + EMACS_INT subtract; relative_position -= (tree->total_length - RIGHT_TOTAL_LENGTH (tree)); @@ -1348,9 +1351,9 @@ else { /* How much can we delete from this interval? */ - int my_amount = ((tree->total_length - - RIGHT_TOTAL_LENGTH (tree)) - - relative_position); + EMACS_INT my_amount = ((tree->total_length + - RIGHT_TOTAL_LENGTH (tree)) + - relative_position); if (amount > my_amount) amount = my_amount; @@ -1372,12 +1375,13 @@ buffer position, i.e. origin 1). */ static void -adjust_intervals_for_deletion (struct buffer *buffer, int start, int length) +adjust_intervals_for_deletion (struct buffer *buffer, + EMACS_INT start, EMACS_INT length) { - register int left_to_delete = length; + register EMACS_INT left_to_delete = length; register INTERVAL tree = BUF_INTERVALS (buffer); Lisp_Object parent; - int offset; + EMACS_INT offset; GET_INTERVAL_OBJECT (parent, tree); offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0); @@ -1423,7 +1427,7 @@ of LENGTH. */ INLINE void -offset_intervals (struct buffer *buffer, int start, int length) +offset_intervals (struct buffer *buffer, EMACS_INT start, EMACS_INT length) { if (NULL_INTERVAL_P (BUF_INTERVALS (buffer)) || length == 0) return; @@ -1446,7 +1450,7 @@ INTERVAL merge_interval_right (register INTERVAL i) { - register int absorb = LENGTH (i); + register EMACS_INT absorb = LENGTH (i); register INTERVAL successor; /* Zero out this interval. */ @@ -1502,7 +1506,7 @@ INTERVAL merge_interval_left (register INTERVAL i) { - register int absorb = LENGTH (i); + register EMACS_INT absorb = LENGTH (i); register INTERVAL predecessor; /* Zero out this interval. */ @@ -1598,7 +1602,7 @@ static INTERVAL make_new_interval (intervals, start, length) INTERVAL intervals; - int start, length; + EMACS_INT start, length; { INTERVAL slot; @@ -1670,11 +1674,13 @@ text... */ void -graft_intervals_into_buffer (INTERVAL source, int position, int length, struct buffer *buffer, int inherit) +graft_intervals_into_buffer (INTERVAL source, EMACS_INT position, + EMACS_INT length, struct buffer *buffer, + int inherit) { register INTERVAL under, over, this, prev; register INTERVAL tree; - int over_used; + EMACS_INT over_used; tree = BUF_INTERVALS (buffer); @@ -1920,8 +1926,9 @@ Note that `stickiness' is determined by overlay marker insertion types, if the invisible property comes from an overlay. */ -static int -adjust_for_invis_intang (int pos, int test_offs, int adj, int test_intang) +static EMACS_INT +adjust_for_invis_intang (EMACS_INT pos, EMACS_INT test_offs, EMACS_INT adj, + int test_intang) { Lisp_Object invis_propval, invis_overlay; Lisp_Object test_pos; @@ -2183,7 +2190,7 @@ segment that reaches all the way to point. */ void -move_if_not_intangible (int position) +move_if_not_intangible (EMACS_INT position) { Lisp_Object pos; Lisp_Object intangible_propval; @@ -2246,7 +2253,8 @@ nil means the current buffer. */ int -get_property_and_range (int pos, Lisp_Object prop, Lisp_Object *val, EMACS_INT *start, EMACS_INT *end, Lisp_Object object) +get_property_and_range (EMACS_INT pos, Lisp_Object prop, Lisp_Object *val, + EMACS_INT *start, EMACS_INT *end, Lisp_Object object) { INTERVAL i, prev, next; @@ -2289,10 +2297,11 @@ POSITION must be in the accessible part of BUFFER. */ Lisp_Object -get_local_map (register int position, register struct buffer *buffer, Lisp_Object type) +get_local_map (register EMACS_INT position, register struct buffer *buffer, + Lisp_Object type) { Lisp_Object prop, lispy_position, lispy_buffer; - int old_begv, old_zv, old_begv_byte, old_zv_byte; + EMACS_INT old_begv, old_zv, old_begv_byte, old_zv_byte; /* Perhaps we should just change `position' to the limit. */ if (position > BUF_ZV (buffer) || position < BUF_BEGV (buffer)) @@ -2342,10 +2351,10 @@ The new interval tree has no parent and has a starting-position of 0. */ INTERVAL -copy_intervals (INTERVAL tree, int start, int length) +copy_intervals (INTERVAL tree, EMACS_INT start, EMACS_INT length) { register INTERVAL i, new, t; - register int got, prevlen; + register EMACS_INT got, prevlen; if (NULL_INTERVAL_P (tree) || length <= 0) return NULL_INTERVAL; @@ -2383,7 +2392,8 @@ /* Give STRING the properties of BUFFER from POSITION to LENGTH. */ INLINE void -copy_intervals_to_string (Lisp_Object string, struct buffer *buffer, int position, int length) +copy_intervals_to_string (Lisp_Object string, struct buffer *buffer, + EMACS_INT position, EMACS_INT length) { INTERVAL interval_copy = copy_intervals (BUF_INTERVALS (buffer), position, length); @@ -2401,8 +2411,8 @@ compare_string_intervals (Lisp_Object s1, Lisp_Object s2) { INTERVAL i1, i2; - int pos = 0; - int end = SCHARS (s1); + EMACS_INT pos = 0; + EMACS_INT end = SCHARS (s1); i1 = find_interval (STRING_INTERVALS (s1), 0); i2 = find_interval (STRING_INTERVALS (s2), 0); @@ -2410,9 +2420,9 @@ while (pos < end) { /* Determine how far we can go before we reach the end of I1 or I2. */ - int len1 = (i1 != 0 ? INTERVAL_LAST_POS (i1) : end) - pos; - int len2 = (i2 != 0 ? INTERVAL_LAST_POS (i2) : end) - pos; - int distance = min (len1, len2); + EMACS_INT len1 = (i1 != 0 ? INTERVAL_LAST_POS (i1) : end) - pos; + EMACS_INT len2 = (i2 != 0 ? INTERVAL_LAST_POS (i2) : end) - pos; + EMACS_INT distance = min (len1, len2); /* If we ever find a mismatch between the strings, they differ. */ @@ -2436,7 +2446,9 @@ START_BYTE ... END_BYTE in bytes. */ static void -set_intervals_multibyte_1 (INTERVAL i, int multi_flag, int start, int start_byte, int end, int end_byte) +set_intervals_multibyte_1 (INTERVAL i, int multi_flag, + EMACS_INT start, EMACS_INT start_byte, + EMACS_INT end, EMACS_INT end_byte) { /* Fix the length of this interval. */ if (multi_flag) @@ -2454,11 +2466,11 @@ /* Recursively fix the length of the subintervals. */ if (i->left) { - int left_end, left_end_byte; + EMACS_INT left_end, left_end_byte; if (multi_flag) { - int temp; + EMACS_INT temp; left_end_byte = start_byte + LEFT_TOTAL_LENGTH (i); left_end = BYTE_TO_CHAR (left_end_byte); @@ -2487,11 +2499,11 @@ } if (i->right) { - int right_start_byte, right_start; + EMACS_INT right_start_byte, right_start; if (multi_flag) { - int temp; + EMACS_INT temp; right_start_byte = end_byte - RIGHT_TOTAL_LENGTH (i); right_start = BYTE_TO_CHAR (right_start_byte);
--- a/src/intervals.h Mon Sep 27 14:27:28 2010 +0900 +++ b/src/intervals.h Mon Sep 27 14:42:43 2010 +0900 @@ -250,36 +250,36 @@ extern INTERVAL create_root_interval (Lisp_Object); extern void copy_properties (INTERVAL, INTERVAL); extern int intervals_equal (INTERVAL, INTERVAL); -extern void traverse_intervals (INTERVAL, int, +extern void traverse_intervals (INTERVAL, EMACS_INT, void (*) (INTERVAL, Lisp_Object), Lisp_Object); extern void traverse_intervals_noorder (INTERVAL, void (*) (INTERVAL, Lisp_Object), Lisp_Object); -extern INTERVAL split_interval_right (INTERVAL, int); -extern INTERVAL split_interval_left (INTERVAL, int); -extern INTERVAL find_interval (INTERVAL, int); +extern INTERVAL split_interval_right (INTERVAL, EMACS_INT); +extern INTERVAL split_interval_left (INTERVAL, EMACS_INT); +extern INTERVAL find_interval (INTERVAL, EMACS_INT); extern INTERVAL next_interval (INTERVAL); extern INTERVAL previous_interval (INTERVAL); extern INTERVAL merge_interval_left (INTERVAL); extern INTERVAL merge_interval_right (INTERVAL); extern void delete_interval (INTERVAL); -extern INLINE void offset_intervals (struct buffer *, int, int); -extern void graft_intervals_into_buffer (INTERVAL, int, int, +extern INLINE void offset_intervals (struct buffer *, EMACS_INT, EMACS_INT); +extern void graft_intervals_into_buffer (INTERVAL, EMACS_INT, EMACS_INT, struct buffer *, int); extern void verify_interval_modification (struct buffer *, int, int); extern INTERVAL balance_intervals (INTERVAL); extern INLINE void copy_intervals_to_string (Lisp_Object, struct buffer *, - int, int); -extern INTERVAL copy_intervals (INTERVAL, int, int); + EMACS_INT, EMACS_INT); +extern INTERVAL copy_intervals (INTERVAL, EMACS_INT, EMACS_INT); extern int compare_string_intervals (Lisp_Object, Lisp_Object); extern Lisp_Object textget (Lisp_Object, Lisp_Object); extern Lisp_Object lookup_char_property (Lisp_Object, Lisp_Object, int); -extern void move_if_not_intangible (int); -extern int get_property_and_range (int, Lisp_Object, Lisp_Object *, +extern void move_if_not_intangible (EMACS_INT); +extern int get_property_and_range (EMACS_INT, Lisp_Object, Lisp_Object *, EMACS_INT *, EMACS_INT *, Lisp_Object); -extern Lisp_Object get_local_map (int, struct buffer *, Lisp_Object); -extern INTERVAL update_interval (INTERVAL, int); +extern Lisp_Object get_local_map (EMACS_INT, struct buffer *, Lisp_Object); +extern INTERVAL update_interval (INTERVAL, EMACS_INT); extern void set_intervals_multibyte (int); extern INTERVAL validate_interval_range (Lisp_Object, Lisp_Object *, Lisp_Object *, int);
--- a/src/keyboard.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/keyboard.c Mon Sep 27 14:42:43 2010 +0900 @@ -304,7 +304,7 @@ Lisp_Object meta_prefix_char; /* Last size recorded for a current buffer which is not a minibuffer. */ -static int last_non_minibuf_size; +static EMACS_INT last_non_minibuf_size; /* Number of idle seconds before an auto-save and garbage collection. */ static Lisp_Object Vauto_save_timeout; @@ -337,7 +337,7 @@ Lisp_Object Vthis_original_command; /* The value of point when the last command was started. */ -int last_point_position; +EMACS_INT last_point_position; /* The buffer that was current when the last command was started. */ Lisp_Object last_point_position_buffer; @@ -621,7 +621,7 @@ Lisp_Object, Lisp_Object, unsigned long); #endif -static Lisp_Object modify_event_symbol (int, unsigned, Lisp_Object, +static Lisp_Object modify_event_symbol (EMACS_INT, unsigned, Lisp_Object, Lisp_Object, const char **, Lisp_Object *, unsigned); static Lisp_Object make_lispy_switch_frame (Lisp_Object); @@ -867,7 +867,7 @@ switches frames while entering a key sequence. */ static void -echo_truncate (int nchars) +echo_truncate (EMACS_INT nchars) { if (STRINGP (current_kboard->echo_string)) current_kboard->echo_string @@ -1480,7 +1480,7 @@ static int read_key_sequence (Lisp_Object *, int, Lisp_Object, int, int, int); void safe_run_hooks (Lisp_Object); -static void adjust_point_for_property (int, int); +static void adjust_point_for_property (EMACS_INT, int); /* Cancel hourglass from protect_unwind. ARG is not used. */ @@ -1811,8 +1811,9 @@ && !NILP (Vtransient_mark_mode))) && !EQ (Vthis_command, Qhandle_switch_frame)) { - int beg = XINT (Fmarker_position (current_buffer->mark)); - int end = XINT (make_number (PT)); + EMACS_INT beg = + XINT (Fmarker_position (current_buffer->mark)); + EMACS_INT end = PT; if (beg < end) call2 (Qx_set_selection, QPRIMARY, make_buffer_string (beg, end, 0)); @@ -1869,7 +1870,7 @@ LAST_PT is the last position of point. */ static void -adjust_point_for_property (int last_pt, int modified) +adjust_point_for_property (EMACS_INT last_pt, int modified) { EMACS_INT beg, end; Lisp_Object val, overlay, tmp; @@ -1878,7 +1879,7 @@ user can keep inserting another character at point or keep deleting characters around point. */ int check_composition = ! modified, check_display = 1, check_invisible = 1; - int orig_pt = PT; + EMACS_INT orig_pt = PT; /* FIXME: cycling is probably not necessary because these properties can't be usefully combined anyway. */ @@ -2781,7 +2782,8 @@ if (INTERACTIVE && NILP (c)) { - int delay_level, buffer_size; + int delay_level; + EMACS_INT buffer_size; /* Slow down auto saves logarithmically in size of current buffer, and garbage collect while we're at it. */ @@ -3520,12 +3522,6 @@ static int readable_events (int flags) { -#ifdef HAVE_DBUS - /* Check whether a D-Bus message has arrived. */ - if (xd_pending_messages () > 0) - return 1; -#endif /* HAVE_DBUS */ - if (flags & READABLE_EVENTS_DO_TIMERS_NOW) timer_check (1); @@ -3795,22 +3791,20 @@ } -/* Generate HELP_EVENT input_events in BUFP which has room for - SIZE events. If there's not enough room in BUFP, ignore this - event. +/* Generate a HELP_EVENT input_event and store it in the keyboard + buffer. HELP is the help form. - FRAME is the frame on which the help is generated. OBJECT is the - Lisp object where the help was found (a buffer, a string, an - overlay, or nil if neither from a string nor from a buffer. POS is - the position within OBJECT where the help was found. - - Value is the number of input_events generated. */ + FRAME and WINDOW are the frame and window where the help is + generated. OBJECT is the Lisp object where the help was found (a + buffer, a string, an overlay, or nil if neither from a string nor + from a buffer). POS is the position within OBJECT where the help + was found. */ void gen_help_event (Lisp_Object help, Lisp_Object frame, Lisp_Object window, - Lisp_Object object, int pos) + Lisp_Object object, EMACS_INT pos) { struct input_event event; @@ -5280,7 +5274,8 @@ /* It's a click in window window at frame coordinates (x,y) */ struct window *w = XWINDOW (window); Lisp_Object string_info = Qnil; - int textpos = -1, rx = -1, ry = -1; + EMACS_INT textpos = -1; + int rx = -1, ry = -1; int dx = -1, dy = -1; int width = -1, height = -1; Lisp_Object object = Qnil; @@ -5299,7 +5294,7 @@ /* Mode line or header line. Look for a string under the mouse that may have a `local-map' property. */ Lisp_Object string; - int charpos; + EMACS_INT charpos; posn = part == ON_MODE_LINE ? Qmode_line : Qheader_line; rx = wx, ry = wy; @@ -5323,7 +5318,7 @@ else if (part == ON_LEFT_MARGIN || part == ON_RIGHT_MARGIN) { Lisp_Object string; - int charpos; + EMACS_INT charpos; posn = (part == ON_LEFT_MARGIN) ? Qleft_margin : Qright_margin; rx = wx, ry = wy; @@ -5458,7 +5453,7 @@ case MULTIBYTE_CHAR_KEYSTROKE_EVENT: { Lisp_Object lispy_c; - int c = event->code; + EMACS_INT c = event->code; if (event->kind == ASCII_KEYSTROKE_EVENT) { c &= 0377; @@ -6582,7 +6577,7 @@ in the symbol's name. */ static Lisp_Object -modify_event_symbol (int symbol_num, unsigned int modifiers, Lisp_Object symbol_kind, +modify_event_symbol (EMACS_INT symbol_num, unsigned int modifiers, Lisp_Object symbol_kind, Lisp_Object name_alist_or_stem, const char **name_table, Lisp_Object *symbol_table, unsigned int table_size) { @@ -6646,7 +6641,7 @@ if (NILP (value)) { char buf[20]; - sprintf (buf, "key-%d", symbol_num); + sprintf (buf, "key-%ld", (long)symbol_num); value = intern (buf); } @@ -6876,11 +6871,6 @@ void gobble_input (int expected) { -#ifdef HAVE_DBUS - /* Read D-Bus messages. */ - xd_read_queued_messages (); -#endif /* HAVE_DBUS */ - #ifdef SIGIO if (interrupt_input) { @@ -10352,7 +10342,7 @@ (Lisp_Object prefixarg) { Lisp_Object function; - int saved_last_point_position; + EMACS_INT saved_last_point_position; Lisp_Object saved_keys, saved_last_point_position_buffer; Lisp_Object bindings, value; struct gcpro gcpro1, gcpro2, gcpro3; @@ -10820,7 +10810,7 @@ if (STRINGP (stuffstring)) { - register int count; + register EMACS_INT count; p = SDATA (stuffstring); count = SBYTES (stuffstring);
--- a/src/keyboard.h Mon Sep 27 14:27:28 2010 +0900 +++ b/src/keyboard.h Mon Sep 27 14:42:43 2010 +0900 @@ -524,7 +524,7 @@ extern void show_help_echo (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, int); extern void gen_help_event (Lisp_Object, Lisp_Object, Lisp_Object, - Lisp_Object, int); + Lisp_Object, EMACS_INT); extern void kbd_buffer_store_help_event (Lisp_Object, Lisp_Object); extern Lisp_Object menu_item_eval_property (Lisp_Object); extern int kbd_buffer_events_waiting (int);
--- a/src/lisp.h Mon Sep 27 14:27:28 2010 +0900 +++ b/src/lisp.h Mon Sep 27 14:42:43 2010 +0900 @@ -739,7 +739,7 @@ #ifdef GC_CHECK_STRING_BYTES struct Lisp_String; -extern int string_bytes (struct Lisp_String *); +extern EMACS_INT string_bytes (struct Lisp_String *); #define STRING_BYTES(S) string_bytes ((S)) #else /* not GC_CHECK_STRING_BYTES */ @@ -1877,11 +1877,11 @@ extern struct specbinding *specpdl; extern struct specbinding *specpdl_ptr; -extern int specpdl_size; +extern EMACS_INT specpdl_size; extern EMACS_INT max_specpdl_size; -#define SPECPDL_INDEX() (specpdl_ptr - specpdl) +#define SPECPDL_INDEX() ((int) (specpdl_ptr - specpdl)) /* Everything needed to describe an active condition case. */ struct handler @@ -2495,7 +2495,8 @@ EXFUN (Fstring_to_multibyte, 1); EXFUN (Fstring_to_unibyte, 1); EXFUN (Fsubstring, 3); -extern Lisp_Object substring_both (Lisp_Object, int, int, int, int); +extern Lisp_Object substring_both (Lisp_Object, EMACS_INT, EMACS_INT, + EMACS_INT, EMACS_INT); EXFUN (Fnth, 2); EXFUN (Fnthcdr, 2); EXFUN (Fmemq, 2); @@ -2666,14 +2667,14 @@ extern void message2_nolog (const char *, int, int); extern void message3 (Lisp_Object, int, int); extern void message3_nolog (Lisp_Object, int, int); -extern void message_dolog (const char *, int, int, int); +extern void message_dolog (const char *, EMACS_INT, int, int); extern void message_with_string (const char *, Lisp_Object, int); extern void message_log_maybe_newline (void); extern void update_echo_area (void); -extern void truncate_echo_area (int); +extern void truncate_echo_area (EMACS_INT); extern void redisplay (void); extern int check_point_in_composition - (struct buffer *, int, struct buffer *, int); + (struct buffer *, EMACS_INT, struct buffer *, EMACS_INT); extern void redisplay_preserve_echo_area (int); extern void prepare_menu_bars (void); @@ -2692,7 +2693,7 @@ /* Defined in alloc.c */ extern void check_pure_size (void); -extern void allocate_string_data (struct Lisp_String *, int, int); +extern void allocate_string_data (struct Lisp_String *, EMACS_INT, EMACS_INT); extern void reset_malloc_hooks (void); extern void uninterrupt_malloc (void); extern void malloc_warning (const char *); @@ -2718,16 +2719,17 @@ EXFUN (Fmake_marker, 0); EXFUN (Fmake_string, 2); extern Lisp_Object build_string (const char *); -extern Lisp_Object make_string (const char *, int); -extern Lisp_Object make_unibyte_string (const char *, int); -extern Lisp_Object make_multibyte_string (const char *, int, int); +extern Lisp_Object make_string (const char *, EMACS_INT); +extern Lisp_Object make_unibyte_string (const char *, EMACS_INT); +extern Lisp_Object make_multibyte_string (const char *, EMACS_INT, EMACS_INT); extern Lisp_Object make_event_array (int, Lisp_Object *); -extern Lisp_Object make_uninit_string (int); -extern Lisp_Object make_uninit_multibyte_string (int, int); -extern Lisp_Object make_string_from_bytes (const char *, int, int); -extern Lisp_Object make_specified_string (const char *, int, int, int); +extern Lisp_Object make_uninit_string (EMACS_INT); +extern Lisp_Object make_uninit_multibyte_string (EMACS_INT, EMACS_INT); +extern Lisp_Object make_string_from_bytes (const char *, EMACS_INT, EMACS_INT); +extern Lisp_Object make_specified_string (const char *, + EMACS_INT, EMACS_INT, int); EXFUN (Fpurecopy, 1); -extern Lisp_Object make_pure_string (const char *, int, int, int); +extern Lisp_Object make_pure_string (const char *, EMACS_INT, EMACS_INT, int); extern Lisp_Object make_pure_c_string (const char *data); extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); extern Lisp_Object make_pure_vector (EMACS_INT); @@ -2815,7 +2817,7 @@ extern void syms_of_print (void); /* Defined in doprnt.c */ -extern int doprnt (char *, int, const char *, const char *, va_list); +extern EMACS_INT doprnt (char *, int, const char *, const char *, va_list); /* Defined in lread.c */ extern Lisp_Object Vafter_load_alist; @@ -2838,7 +2840,7 @@ extern Lisp_Object intern (const char *); extern Lisp_Object intern_c_string (const char *); extern Lisp_Object make_symbol (const char *); -extern Lisp_Object oblookup (Lisp_Object, const char *, int, int); +extern Lisp_Object oblookup (Lisp_Object, const char *, EMACS_INT, EMACS_INT); #define LOADHIST_ATTACH(x) \ do { \ if (initialized) Vcurrent_load_list = Fcons (x, Vcurrent_load_list); \ @@ -2990,9 +2992,10 @@ EXFUN (Fuser_login_name, 1); EXFUN (Fsystem_name, 0); EXFUN (Fcurrent_time, 0); -extern int clip_to_bounds (int, int, int); -extern Lisp_Object make_buffer_string (int, int, int); -extern Lisp_Object make_buffer_string_both (int, int, int, int, int); +extern EMACS_INT clip_to_bounds (EMACS_INT, EMACS_INT, EMACS_INT); +extern Lisp_Object make_buffer_string (EMACS_INT, EMACS_INT, int); +extern Lisp_Object make_buffer_string_both (EMACS_INT, EMACS_INT, EMACS_INT, + EMACS_INT, int); extern void init_editfns (void); extern void syms_of_editfns (void); EXFUN (Fconstrain_to_field, 5); @@ -3012,10 +3015,10 @@ EXFUN (Foverlay_buffer, 1); extern void adjust_overlays_for_insert (EMACS_INT, EMACS_INT); extern void adjust_overlays_for_delete (EMACS_INT, EMACS_INT); -extern void fix_start_end_in_overlays (int, int); +extern void fix_start_end_in_overlays (EMACS_INT, EMACS_INT); extern void report_overlay_modification (Lisp_Object, Lisp_Object, int, Lisp_Object, Lisp_Object, Lisp_Object); -extern int overlay_touches_p (int); +extern int overlay_touches_p (EMACS_INT); extern Lisp_Object Vbuffer_alist, Vinhibit_read_only; EXFUN (Fbuffer_list, 1); EXFUN (Fget_buffer, 1); @@ -3052,17 +3055,17 @@ EXFUN (Fmarker_buffer, 1); EXFUN (Fcopy_marker, 2); EXFUN (Fset_marker, 3); -extern int marker_position (Lisp_Object); -extern int marker_byte_position (Lisp_Object); +extern EMACS_INT marker_position (Lisp_Object); +extern EMACS_INT marker_byte_position (Lisp_Object); extern void clear_charpos_cache (struct buffer *); -extern int charpos_to_bytepos (int); -extern int buf_charpos_to_bytepos (struct buffer *, int); -extern int buf_bytepos_to_charpos (struct buffer *, int); +extern EMACS_INT charpos_to_bytepos (EMACS_INT); +extern EMACS_INT buf_charpos_to_bytepos (struct buffer *, EMACS_INT); +extern EMACS_INT buf_bytepos_to_charpos (struct buffer *, EMACS_INT); extern void unchain_marker (struct Lisp_Marker *marker); extern Lisp_Object set_marker_restricted (Lisp_Object, Lisp_Object, Lisp_Object); -extern Lisp_Object set_marker_both (Lisp_Object, Lisp_Object, int, int); +extern Lisp_Object set_marker_both (Lisp_Object, Lisp_Object, EMACS_INT, EMACS_INT); extern Lisp_Object set_marker_restricted_both (Lisp_Object, Lisp_Object, - int, int); + EMACS_INT, EMACS_INT); extern void syms_of_marker (void); /* Defined in fileio.c */ @@ -3120,12 +3123,13 @@ extern int fast_string_match_ignore_case (Lisp_Object, Lisp_Object); extern EMACS_INT fast_looking_at (Lisp_Object, EMACS_INT, EMACS_INT, EMACS_INT, EMACS_INT, Lisp_Object); -extern int scan_buffer (int, EMACS_INT, EMACS_INT, int, int *, int); -extern int scan_newline (EMACS_INT, EMACS_INT, EMACS_INT, EMACS_INT, - int, int); -extern int find_next_newline (EMACS_INT, int); -extern int find_next_newline_no_quit (EMACS_INT, int); -extern int find_before_next_newline (EMACS_INT, EMACS_INT, int); +extern EMACS_INT scan_buffer (int, EMACS_INT, EMACS_INT, EMACS_INT, + int *, int); +extern EMACS_INT scan_newline (EMACS_INT, EMACS_INT, EMACS_INT, EMACS_INT, + EMACS_INT, int); +extern EMACS_INT find_next_newline (EMACS_INT, int); +extern EMACS_INT find_next_newline_no_quit (EMACS_INT, EMACS_INT); +extern EMACS_INT find_before_next_newline (EMACS_INT, EMACS_INT, EMACS_INT); extern void syms_of_search (void); extern void clear_regexp_cache (void); @@ -3237,7 +3241,7 @@ EXFUN (Fmove_to_column, 2); extern double current_column (void); extern void invalidate_current_column (void); -extern int indented_beyond_p (int, int, double); +extern int indented_beyond_p (EMACS_INT, EMACS_INT, double); extern void syms_of_indent (void); /* Defined in frame.c */ @@ -3392,12 +3396,13 @@ extern Lisp_Object Qinhibit_read_only; EXFUN (Fundo_boundary, 0); extern void truncate_undo_list (struct buffer *); -extern void record_marker_adjustment (Lisp_Object, int); -extern void record_insert (int, int); -extern void record_delete (int, Lisp_Object); +extern void record_marker_adjustment (Lisp_Object, EMACS_INT); +extern void record_insert (EMACS_INT, EMACS_INT); +extern void record_delete (EMACS_INT, Lisp_Object); extern void record_first_change (void); -extern void record_change (int, int); -extern void record_property_change (int, int, Lisp_Object, Lisp_Object, +extern void record_change (EMACS_INT, EMACS_INT); +extern void record_property_change (EMACS_INT, EMACS_INT, + Lisp_Object, Lisp_Object, Lisp_Object); extern void syms_of_undo (void); extern Lisp_Object Vundo_outer_limit; @@ -3722,7 +3727,7 @@ extern Lisp_Object safe_alloca_unwind (Lisp_Object); #define USE_SAFE_ALLOCA \ - int sa_count = SPECPDL_INDEX (), sa_must_free = 0 + int sa_count = (int) SPECPDL_INDEX (), sa_must_free = 0 /* SAFE_ALLOCA allocates a simple buffer. */
--- a/src/lread.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/lread.c Mon Sep 27 14:42:43 2010 +0900 @@ -163,13 +163,13 @@ static int read_pure; /* For use within read-from-string (this reader is non-reentrant!!) */ -static int read_from_string_index; -static int read_from_string_index_byte; -static int read_from_string_limit; +static EMACS_INT read_from_string_index; +static EMACS_INT read_from_string_index_byte; +static EMACS_INT read_from_string_limit; /* Number of characters read in the current call to Fread or Fread_from_string. */ -static int readchar_count; +static EMACS_INT readchar_count; /* This contains the last string skipped with #@. */ static char *saved_doc_string; @@ -276,7 +276,7 @@ { register struct buffer *inbuffer = XBUFFER (readcharfun); - int pt_byte = BUF_PT_BYTE (inbuffer); + EMACS_INT pt_byte = BUF_PT_BYTE (inbuffer); if (pt_byte >= BUF_ZV_BYTE (inbuffer)) return -1; @@ -305,7 +305,7 @@ { register struct buffer *inbuffer = XMARKER (readcharfun)->buffer; - int bytepos = marker_byte_position (readcharfun); + EMACS_INT bytepos = marker_byte_position (readcharfun); if (bytepos >= BUF_ZV_BYTE (inbuffer)) return -1; @@ -439,7 +439,7 @@ else if (BUFFERP (readcharfun)) { struct buffer *b = XBUFFER (readcharfun); - int bytepos = BUF_PT_BYTE (b); + EMACS_INT bytepos = BUF_PT_BYTE (b); BUF_PT (b)--; if (! NILP (b->enable_multibyte_characters)) @@ -452,7 +452,7 @@ else if (MARKERP (readcharfun)) { struct buffer *b = XMARKER (readcharfun)->buffer; - int bytepos = XMARKER (readcharfun)->bytepos; + EMACS_INT bytepos = XMARKER (readcharfun)->bytepos; XMARKER (readcharfun)->charpos--; if (! NILP (b->enable_multibyte_characters)) @@ -1893,7 +1893,7 @@ if (STRINGP (stream) || ((CONSP (stream) && STRINGP (XCAR (stream))))) { - int startval, endval; + EMACS_INT startval, endval; Lisp_Object string; if (STRINGP (stream)) @@ -3739,7 +3739,7 @@ Also store the bucket number in oblookup_last_bucket_number. */ Lisp_Object -oblookup (Lisp_Object obarray, register const char *ptr, int size, int size_byte) +oblookup (Lisp_Object obarray, register const char *ptr, EMACS_INT size, EMACS_INT size_byte) { int hash; int obsize;
--- a/src/marker.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/marker.c Mon Sep 27 14:42:43 2010 +0900 @@ -27,12 +27,12 @@ /* Record one cached position found recently by buf_charpos_to_bytepos or buf_bytepos_to_charpos. */ -static int cached_charpos; -static int cached_bytepos; +static EMACS_INT cached_charpos; +static EMACS_INT cached_bytepos; static struct buffer *cached_buffer; static int cached_modiff; -static void byte_char_debug_check (struct buffer *, int, int); +static void byte_char_debug_check (struct buffer *, EMACS_INT, EMACS_INT); /* Nonzero means enable debugging checks on byte/char correspondences. */ @@ -60,12 +60,12 @@ #define CONSIDER(CHARPOS, BYTEPOS) \ { \ - int this_charpos = (CHARPOS); \ + EMACS_INT this_charpos = (CHARPOS); \ int changed = 0; \ \ if (this_charpos == charpos) \ { \ - int value = (BYTEPOS); \ + EMACS_INT value = (BYTEPOS); \ if (byte_debug_flag) \ byte_char_debug_check (b, charpos, value); \ return value; \ @@ -90,7 +90,7 @@ { \ if (best_above - best_below == best_above_byte - best_below_byte) \ { \ - int value = best_below_byte + (charpos - best_below); \ + EMACS_INT value = best_below_byte + (charpos - best_below); \ if (byte_debug_flag) \ byte_char_debug_check (b, charpos, value); \ return value; \ @@ -99,9 +99,9 @@ } static void -byte_char_debug_check (struct buffer *b, int charpos, int bytepos) +byte_char_debug_check (struct buffer *b, EMACS_INT charpos, EMACS_INT bytepos) { - int nchars = 0; + EMACS_INT nchars = 0; if (bytepos > BUF_GPT_BYTE (b)) { @@ -118,18 +118,18 @@ abort (); } -int -charpos_to_bytepos (int charpos) +EMACS_INT +charpos_to_bytepos (EMACS_INT charpos) { return buf_charpos_to_bytepos (current_buffer, charpos); } -int -buf_charpos_to_bytepos (struct buffer *b, int charpos) +EMACS_INT +buf_charpos_to_bytepos (struct buffer *b, EMACS_INT charpos) { struct Lisp_Marker *tail; - int best_above, best_above_byte; - int best_below, best_below_byte; + EMACS_INT best_above, best_above_byte; + EMACS_INT best_below, best_below_byte; if (charpos < BUF_BEG (b) || charpos > BUF_Z (b)) abort (); @@ -247,11 +247,11 @@ /* Used for debugging: recompute the bytepos corresponding to CHARPOS in the simplest, most reliable way. */ -int -verify_bytepos (int charpos) +EMACS_INT +verify_bytepos (EMACS_INT charpos) { - int below = 1; - int below_byte = 1; + EMACS_INT below = 1; + EMACS_INT below_byte = 1; while (below != charpos) { @@ -269,12 +269,12 @@ #define CONSIDER(BYTEPOS, CHARPOS) \ { \ - int this_bytepos = (BYTEPOS); \ + EMACS_INT this_bytepos = (BYTEPOS); \ int changed = 0; \ \ if (this_bytepos == bytepos) \ { \ - int value = (CHARPOS); \ + EMACS_INT value = (CHARPOS); \ if (byte_debug_flag) \ byte_char_debug_check (b, value, bytepos); \ return value; \ @@ -299,7 +299,7 @@ { \ if (best_above - best_below == best_above_byte - best_below_byte) \ { \ - int value = best_below + (bytepos - best_below_byte); \ + EMACS_INT value = best_below + (bytepos - best_below_byte); \ if (byte_debug_flag) \ byte_char_debug_check (b, value, bytepos); \ return value; \ @@ -307,18 +307,18 @@ } \ } -int -bytepos_to_charpos (int bytepos) +EMACS_INT +bytepos_to_charpos (EMACS_INT bytepos) { return buf_bytepos_to_charpos (current_buffer, bytepos); } -int -buf_bytepos_to_charpos (struct buffer *b, int bytepos) +EMACS_INT +buf_bytepos_to_charpos (struct buffer *b, EMACS_INT bytepos) { struct Lisp_Marker *tail; - int best_above, best_above_byte; - int best_below, best_below_byte; + EMACS_INT best_above, best_above_byte; + EMACS_INT best_below, best_below_byte; if (bytepos < BUF_BEG_BYTE (b) || bytepos > BUF_Z_BYTE (b)) abort (); @@ -470,7 +470,7 @@ Returns MARKER. */) (Lisp_Object marker, Lisp_Object position, Lisp_Object buffer) { - register int charno, bytepos; + register EMACS_INT charno, bytepos; register struct buffer *b; register struct Lisp_Marker *m; @@ -545,7 +545,7 @@ Lisp_Object set_marker_restricted (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer) { - register int charno, bytepos; + register EMACS_INT charno, bytepos; register struct buffer *b; register struct Lisp_Marker *m; @@ -618,7 +618,7 @@ character position and the corresponding byte position. */ Lisp_Object -set_marker_both (Lisp_Object marker, Lisp_Object buffer, int charpos, int bytepos) +set_marker_both (Lisp_Object marker, Lisp_Object buffer, EMACS_INT charpos, EMACS_INT bytepos) { register struct buffer *b; register struct Lisp_Marker *m; @@ -666,7 +666,7 @@ be outside the visible part. */ Lisp_Object -set_marker_restricted_both (Lisp_Object marker, Lisp_Object buffer, int charpos, int bytepos) +set_marker_restricted_both (Lisp_Object marker, Lisp_Object buffer, EMACS_INT charpos, EMACS_INT bytepos) { register struct buffer *b; register struct Lisp_Marker *m; @@ -776,7 +776,7 @@ /* Return the char position of marker MARKER, as a C integer. */ -int +EMACS_INT marker_position (Lisp_Object marker) { register struct Lisp_Marker *m = XMARKER (marker); @@ -790,12 +790,12 @@ /* Return the byte position of marker MARKER, as a C integer. */ -int +EMACS_INT marker_byte_position (Lisp_Object marker) { register struct Lisp_Marker *m = XMARKER (marker); register struct buffer *buf = m->buffer; - register int i = m->bytepos; + register EMACS_INT i = m->bytepos; if (!buf) error ("Marker does not point anywhere"); @@ -856,7 +856,7 @@ (Lisp_Object position) { register struct Lisp_Marker *tail; - register int charno; + register EMACS_INT charno; charno = XINT (position);
--- a/src/minibuf.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/minibuf.c Mon Sep 27 14:42:43 2010 +0900 @@ -236,7 +236,7 @@ { struct gcpro gcpro1, gcpro2; Lisp_Object expr_and_pos; - int pos; + EMACS_INT pos; GCPRO2 (val, defalt); @@ -254,7 +254,7 @@ { /* Ignore trailing whitespace; any other trailing junk is an error. */ - int i; + EMACS_INT i; pos = string_char_to_byte (val, pos); for (i = pos; i < SBYTES (val); i++) { @@ -370,7 +370,7 @@ If the current buffer is not a minibuffer, return its entire contents. */) (void) { - int prompt_end = XINT (Fminibuffer_prompt_end ()); + EMACS_INT prompt_end = XINT (Fminibuffer_prompt_end ()); return make_buffer_string (prompt_end, ZV, 1); } @@ -380,7 +380,7 @@ If the current buffer is not a minibuffer, return its entire contents. */) (void) { - int prompt_end = XINT (Fminibuffer_prompt_end ()); + EMACS_INT prompt_end = XINT (Fminibuffer_prompt_end ()); return make_buffer_string (prompt_end, ZV, 0); } @@ -391,7 +391,7 @@ If the current buffer is not a minibuffer, return its entire contents. */) (void) { - int prompt_end = XINT (Fminibuffer_prompt_end ()); + EMACS_INT prompt_end = XINT (Fminibuffer_prompt_end ()); if (PT < prompt_end) error ("Cannot do completion in the prompt"); return make_buffer_string (prompt_end, PT, 1);
--- a/src/print.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/print.c Mon Sep 27 14:42:43 2010 +0900 @@ -96,11 +96,11 @@ char *print_buffer; /* Size allocated in print_buffer. */ -int print_buffer_size; +EMACS_INT print_buffer_size; /* Chars stored in print_buffer. */ -int print_buffer_pos; +EMACS_INT print_buffer_pos; /* Bytes stored in print_buffer. */ -int print_buffer_pos_byte; +EMACS_INT print_buffer_pos_byte; /* Maximum length of list to print in full; noninteger means effectively infinity */ @@ -177,8 +177,8 @@ #define PRINTDECLARE \ struct buffer *old = current_buffer; \ - int old_point = -1, start_point = -1; \ - int old_point_byte = -1, start_point_byte = -1; \ + EMACS_INT old_point = -1, start_point = -1; \ + EMACS_INT old_point_byte = -1, start_point_byte = -1; \ int specpdl_count = SPECPDL_INDEX (); \ int free_print_buffer = 0; \ int multibyte = !NILP (current_buffer->enable_multibyte_characters); \ @@ -342,8 +342,8 @@ to data in a Lisp string. Otherwise that is not safe. */ static void -strout (const char *ptr, int size, int size_byte, Lisp_Object printcharfun, - int multibyte) +strout (const char *ptr, EMACS_INT size, EMACS_INT size_byte, + Lisp_Object printcharfun, int multibyte) { if (size < 0) size_byte = size = strlen (ptr); @@ -395,7 +395,7 @@ else { /* PRINTCHARFUN is a Lisp function. */ - int i = 0; + EMACS_INT i = 0; if (size == size_byte) { @@ -430,7 +430,7 @@ { if (EQ (printcharfun, Qt) || NILP (printcharfun)) { - int chars; + EMACS_INT chars; if (print_escape_nonascii) string = string_escape_byte8 (string); @@ -446,7 +446,7 @@ convert STRING to a multibyte string containing the same character codes. */ Lisp_Object newstr; - int bytes; + EMACS_INT bytes; chars = SBYTES (string); bytes = parse_str_to_multibyte (SDATA (string), chars); @@ -464,7 +464,7 @@ if (EQ (printcharfun, Qt)) { /* Output to echo area. */ - int nbytes = SBYTES (string); + EMACS_INT nbytes = SBYTES (string); char *buffer; /* Copy the string contents so that relocation of STRING by @@ -489,9 +489,9 @@ { /* Otherwise, string may be relocated by printing one char. So re-fetch the string address for each character. */ - int i; - int size = SCHARS (string); - int size_byte = SBYTES (string); + EMACS_INT i; + EMACS_INT size = SCHARS (string); + EMACS_INT size_byte = SBYTES (string); struct gcpro gcpro1; GCPRO1 (string); if (size == size_byte) @@ -868,7 +868,7 @@ (Lisp_Object character) { CHECK_NUMBER (character); - putc (XINT (character), stderr); + putc ((int) XINT (character), stderr); #ifdef WINDOWSNT /* Send the output to a debugger (nothing happens if there isn't one). */ @@ -1430,8 +1430,8 @@ || ! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND)) { int i, c; - int charpos = interval->position; - int bytepos = string_char_to_byte (string, charpos); + EMACS_INT charpos = interval->position; + EMACS_INT bytepos = string_char_to_byte (string, charpos); Lisp_Object charset; charset = XCAR (XCDR (val)); @@ -1563,10 +1563,10 @@ print_string (obj, printcharfun); else { - register int i, i_byte; + register EMACS_INT i, i_byte; struct gcpro gcpro1; unsigned char *str; - int size_byte; + EMACS_INT size_byte; /* 1 means we must ensure that the next character we output cannot be taken as part of a hex character escape. */ int need_nonhex = 0; @@ -1684,7 +1684,8 @@ register unsigned char *p = SDATA (SYMBOL_NAME (obj)); register unsigned char *end = p + SBYTES (SYMBOL_NAME (obj)); register int c; - int i, i_byte, size_byte; + int i, i_byte; + EMACS_INT size_byte; Lisp_Object name; name = SYMBOL_NAME (obj); @@ -1803,7 +1804,8 @@ } { - int print_length, i; + EMACS_INT print_length; + int i; Lisp_Object halftail = obj; /* Negative values of print-length are invalid in CL. @@ -1898,7 +1900,7 @@ register int i; register unsigned char c; struct gcpro gcpro1; - int size_in_chars + EMACS_INT size_in_chars = ((XBOOL_VECTOR (obj)->size + BOOL_VECTOR_BITS_PER_CHAR - 1) / BOOL_VECTOR_BITS_PER_CHAR); @@ -1984,7 +1986,8 @@ else if (HASH_TABLE_P (obj)) { struct Lisp_Hash_Table *h = XHASH_TABLE (obj); - int i, real_size, size; + int i; + EMACS_INT real_size, size; #if 0 strout ("#<hash-table", -1, -1, printcharfun, 0); if (SYMBOLP (h->test)) @@ -2150,7 +2153,7 @@ { register int i; register Lisp_Object tem; - int real_size = size; + EMACS_INT real_size = size; /* Don't print more elements than the specified maximum. */ if (NATNUMP (Vprint_length)
--- a/src/process.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/process.c Mon Sep 27 14:42:43 2010 +0900 @@ -105,6 +105,9 @@ #include "sysselect.h" #include "syssignal.h" #include "syswait.h" +#ifdef HAVE_GNUTLS +#include "gnutls.h" +#endif #if defined (USE_GTK) || defined (HAVE_GCONF) #include "xgselect.h" @@ -198,8 +201,10 @@ /* Define NON_BLOCKING_CONNECT if we can support non-blocking connects. */ +/* Only W32 has this, it really means that select can't take write mask. */ #ifdef BROKEN_NON_BLOCKING_CONNECT #undef NON_BLOCKING_CONNECT +#define SELECT_CANT_DO_WRITE_MASK #else #ifndef NON_BLOCKING_CONNECT #ifdef HAVE_SELECT @@ -291,9 +296,9 @@ static SELECT_TYPE non_process_wait_mask; -/* Mask for the gpm mouse input descriptor. */ - -static SELECT_TYPE gpm_wait_mask; +/* Mask for selecting for write. */ + +static SELECT_TYPE write_mask; #ifdef NON_BLOCKING_CONNECT /* Mask of bits indicating the descriptors that we wait for connect to @@ -313,11 +318,8 @@ /* The largest descriptor currently in use for a process object. */ static int max_process_desc; -/* The largest descriptor currently in use for keyboard input. */ -static int max_keyboard_desc; - -/* The largest descriptor currently in use for gpm mouse input. */ -static int max_gpm_desc; +/* The largest descriptor currently in use for input. */ +static int max_input_desc; /* Indexed by descriptor, gives the process (if any) for that descriptor */ Lisp_Object chan_process[MAXDESC]; @@ -363,6 +365,90 @@ static char pty_name[24]; #endif + +struct fd_callback_data +{ + fd_callback func; + void *data; +#define FOR_READ 1 +#define FOR_WRITE 2 + int condition; /* mask of the defines above. */ +} fd_callback_info[MAXDESC]; + + +/* Add a file descriptor FD to be monitored for when read is possible. + When read is possible, call FUNC with argument DATA. */ + +void +add_read_fd (int fd, fd_callback func, void *data) +{ + xassert (fd < MAXDESC); + add_keyboard_wait_descriptor (fd); + + fd_callback_info[fd].func = func; + fd_callback_info[fd].data = data; + fd_callback_info[fd].condition |= FOR_READ; +} + +/* Stop monitoring file descriptor FD for when read is possible. */ + +void +delete_read_fd (int fd) +{ + xassert (fd < MAXDESC); + delete_keyboard_wait_descriptor (fd); + + fd_callback_info[fd].condition &= ~FOR_READ; + if (fd_callback_info[fd].condition == 0) + { + fd_callback_info[fd].func = 0; + fd_callback_info[fd].data = 0; + } +} + +/* Add a file descriptor FD to be monitored for when write is possible. + When write is possible, call FUNC with argument DATA. */ + +void +add_write_fd (int fd, fd_callback func, void *data) +{ + xassert (fd < MAXDESC); + FD_SET (fd, &write_mask); + if (fd > max_input_desc) + max_input_desc = fd; + + fd_callback_info[fd].func = func; + fd_callback_info[fd].data = data; + fd_callback_info[fd].condition |= FOR_WRITE; +} + +/* Stop monitoring file descriptor FD for when write is possible. */ + +void +delete_write_fd (int fd) +{ + int lim = max_input_desc; + + xassert (fd < MAXDESC); + FD_CLR (fd, &write_mask); + fd_callback_info[fd].condition &= ~FOR_WRITE; + if (fd_callback_info[fd].condition == 0) + { + fd_callback_info[fd].func = 0; + fd_callback_info[fd].data = 0; + + if (fd == max_input_desc) + for (fd = lim; fd >= 0; fd--) + if (FD_ISSET (fd, &input_wait_mask) || FD_ISSET (fd, &write_mask)) + { + max_input_desc = fd; + break; + } + + } +} + + /* Compute the Lisp form of the process status, p->status, from the numeric status that was returned by `wait'. */ @@ -583,6 +669,10 @@ p->read_output_skip = 0; #endif +#ifdef HAVE_GNUTLS + p->gnutls_initstage = GNUTLS_STAGE_EMPTY; +#endif + /* If name is already in use, modify it until it is unused. */ name1 = name; @@ -1526,6 +1616,12 @@ XPROCESS (proc)->filter = Qnil; XPROCESS (proc)->command = Flist (nargs - 2, args + 2); +#ifdef HAVE_GNUTLS + /* AKA GNUTLS_INITSTAGE(proc). */ + XPROCESS (proc)->gnutls_initstage = GNUTLS_STAGE_EMPTY; + XPROCESS (proc)->gnutls_cred_type = Qnil; +#endif + #ifdef ADAPTIVE_READ_BUFFERING XPROCESS (proc)->adaptive_read_buffering = (NILP (Vprocess_adaptive_read_buffering) ? 0 @@ -3170,7 +3266,9 @@ if (!NILP (host)) { if (EQ (host, Qlocal)) - host = build_string ("localhost"); + /* Depending on setup, "localhost" may map to different IPv4 and/or + IPv6 addresses, so it's better to be explicit. (Bug#6781) */ + host = build_string ("127.0.0.1"); CHECK_STRING (host); } @@ -3605,6 +3703,7 @@ if (!FD_ISSET (inch, &connect_wait_mask)) { FD_SET (inch, &connect_wait_mask); + FD_SET (inch, &write_mask); num_pending_connects++; } } @@ -4008,6 +4107,7 @@ if (FD_ISSET (inchannel, &connect_wait_mask)) { FD_CLR (inchannel, &connect_wait_mask); + FD_CLR (inchannel, &write_mask); if (--num_pending_connects < 0) abort (); } @@ -4386,10 +4486,8 @@ { register int channel, nfds; SELECT_TYPE Available; -#ifdef NON_BLOCKING_CONNECT - SELECT_TYPE Connecting; - int check_connect; -#endif + SELECT_TYPE Writeok; + int check_write; int check_delay, no_avail; int xerrno; Lisp_Object proc; @@ -4399,9 +4497,7 @@ int count = SPECPDL_INDEX (); FD_ZERO (&Available); -#ifdef NON_BLOCKING_CONNECT - FD_ZERO (&Connecting); -#endif + FD_ZERO (&Writeok); if (time_limit == 0 && microsecs == 0 && wait_proc && !NILP (Vinhibit_quit) && !(CONSP (wait_proc->status) && EQ (XCAR (wait_proc->status), Qexit))) @@ -4537,19 +4633,16 @@ if (update_tick != process_tick) { SELECT_TYPE Atemp; -#ifdef NON_BLOCKING_CONNECT SELECT_TYPE Ctemp; -#endif if (kbd_on_hold_p ()) FD_ZERO (&Atemp); else Atemp = input_wait_mask; - IF_NON_BLOCKING_CONNECT (Ctemp = connect_wait_mask); + Ctemp = write_mask; EMACS_SET_SECS_USECS (timeout, 0, 0); - if ((select (max (max (max_process_desc, max_keyboard_desc), - max_gpm_desc) + 1, + if ((select (max (max_process_desc, max_input_desc) + 1, &Atemp, #ifdef NON_BLOCKING_CONNECT (num_pending_connects > 0 ? &Ctemp : (SELECT_TYPE *)0), @@ -4620,13 +4713,13 @@ break; FD_SET (wait_proc->infd, &Available); check_delay = 0; - IF_NON_BLOCKING_CONNECT (check_connect = 0); + check_write = 0; } else if (!NILP (wait_for_cell)) { Available = non_process_wait_mask; check_delay = 0; - IF_NON_BLOCKING_CONNECT (check_connect = 0); + check_write = 0; } else { @@ -4634,7 +4727,12 @@ Available = non_keyboard_wait_mask; else Available = input_wait_mask; - IF_NON_BLOCKING_CONNECT (check_connect = (num_pending_connects > 0)); + Writeok = write_mask; +#ifdef SELECT_CANT_DO_WRITE_MASK + check_write = 0; +#else + check_write = 1; +#endif check_delay = wait_channel >= 0 ? 0 : process_output_delay_count; } @@ -4659,10 +4757,6 @@ } else { -#ifdef NON_BLOCKING_CONNECT - if (check_connect) - Connecting = connect_wait_mask; -#endif #ifdef ADAPTIVE_READ_BUFFERING /* Set the timeout for adaptive read buffering if any @@ -4704,15 +4798,10 @@ #else nfds = select #endif - (max (max (max_process_desc, max_keyboard_desc), - max_gpm_desc) + 1, - &Available, -#ifdef NON_BLOCKING_CONNECT - (check_connect ? &Connecting : (SELECT_TYPE *)0), -#else - (SELECT_TYPE *)0, -#endif - (SELECT_TYPE *)0, &timeout); + (max (max_process_desc, max_input_desc) + 1, + &Available, + (check_write ? &Writeok : (SELECT_TYPE *)0), + (SELECT_TYPE *)0, &timeout); } xerrno = errno; @@ -4752,7 +4841,7 @@ if (no_avail) { FD_ZERO (&Available); - IF_NON_BLOCKING_CONNECT (check_connect = 0); + check_write = 0; } #if 0 /* When polling is used, interrupt_input is 0, @@ -4848,12 +4937,26 @@ if (no_avail || nfds == 0) continue; + for (channel = 0; channel <= max_input_desc; ++channel) + { + struct fd_callback_data *d = &fd_callback_info[channel]; + if (FD_ISSET (channel, &Available) + && d->func != 0 + && (d->condition & FOR_READ) != 0) + d->func (channel, d->data, 1); + if (FD_ISSET (channel, &write_mask) + && d->func != 0 + && (d->condition & FOR_WRITE) != 0) + d->func (channel, d->data, 0); + } + /* Really FIRST_PROC_DESC should be 0 on Unix, but this is safer in the short run. */ for (channel = 0; channel <= max_process_desc; channel++) { if (FD_ISSET (channel, &Available) - && FD_ISSET (channel, &non_keyboard_wait_mask)) + && FD_ISSET (channel, &non_keyboard_wait_mask) + && !FD_ISSET (channel, &non_process_wait_mask)) { int nread; @@ -4958,7 +5061,7 @@ } } #ifdef NON_BLOCKING_CONNECT - if (check_connect && FD_ISSET (channel, &Connecting) + if (FD_ISSET (channel, &Writeok) && FD_ISSET (channel, &connect_wait_mask)) { struct Lisp_Process *p; @@ -5073,7 +5176,7 @@ char *chars; register Lisp_Object outstream; register struct Lisp_Process *p = XPROCESS (proc); - register int opoint; + register EMACS_INT opoint; struct coding_system *coding = proc_decode_coding_system[channel]; int carryover = p->decoding_carryover; int readmax = 4096; @@ -5097,7 +5200,13 @@ #endif if (proc_buffered_char[channel] < 0) { - nbytes = emacs_read (channel, chars + carryover, readmax); +#ifdef HAVE_GNUTLS + if (NETCONN_P(proc) && GNUTLS_PROCESS_USABLE (proc)) + nbytes = emacs_gnutls_read (channel, XPROCESS (proc)->gnutls_state, + chars + carryover, readmax); + else +#endif + nbytes = emacs_read (channel, chars + carryover, readmax); #ifdef ADAPTIVE_READ_BUFFERING if (nbytes > 0 && p->adaptive_read_buffering) { @@ -5130,7 +5239,13 @@ { chars[carryover] = proc_buffered_char[channel]; proc_buffered_char[channel] = -1; - nbytes = emacs_read (channel, chars + carryover + 1, readmax - 1); +#ifdef HAVE_GNUTLS + if (NETCONN_P(proc) && GNUTLS_PROCESS_USABLE (proc)) + nbytes = emacs_gnutls_read (channel, XPROCESS (proc)->gnutls_state, + chars + carryover + 1, readmax - 1); + else +#endif + nbytes = emacs_read (channel, chars + carryover + 1, readmax - 1); if (nbytes < 0) nbytes = 1; else @@ -5263,10 +5378,10 @@ else if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name)) { Lisp_Object old_read_only; - int old_begv, old_zv; - int old_begv_byte, old_zv_byte; - int before, before_byte; - int opoint_byte; + EMACS_INT old_begv, old_zv; + EMACS_INT old_begv_byte, old_zv_byte; + EMACS_INT before, before_byte; + EMACS_INT opoint_byte; Lisp_Object text; struct buffer *b; @@ -5403,11 +5518,11 @@ static void send_process (volatile Lisp_Object proc, const unsigned char *volatile buf, - volatile int len, volatile Lisp_Object object) + volatile EMACS_INT len, volatile Lisp_Object object) { /* Use volatile to protect variables from being clobbered by longjmp. */ struct Lisp_Process *p = XPROCESS (proc); - int rv; + EMACS_INT rv; struct coding_system *coding; struct gcpro gcpro1; SIGTYPE (*volatile old_sigpipe) (int); @@ -5464,8 +5579,8 @@ coding->dst_object = Qt; if (BUFFERP (object)) { - int from_byte, from, to; - int save_pt, save_pt_byte; + EMACS_INT from_byte, from, to; + EMACS_INT save_pt, save_pt_byte; struct buffer *cur = current_buffer; set_buffer_internal (XBUFFER (object)); @@ -5517,7 +5632,7 @@ process_sent_to = proc; while (len > 0) { - int this = len; + EMACS_INT this = len; /* Send this batch, using one or more write calls. */ while (this > 0) @@ -5540,7 +5655,14 @@ else #endif { - rv = emacs_write (outfd, (char *) buf, this); +#ifdef HAVE_GNUTLS + if (NETCONN_P(proc) && GNUTLS_PROCESS_USABLE (proc)) + rv = emacs_gnutls_write (outfd, + XPROCESS (proc)->gnutls_state, + (char *) buf, this); + else +#endif + rv = emacs_write (outfd, (char *) buf, this); #ifdef ADAPTIVE_READ_BUFFERING if (p->read_output_delay > 0 && p->adaptive_read_buffering == 1) @@ -5651,7 +5773,7 @@ (Lisp_Object process, Lisp_Object start, Lisp_Object end) { Lisp_Object proc; - int start1, end1; + EMACS_INT start1, end1; proc = get_process (process); validate_region (&start, &end); @@ -6592,8 +6714,8 @@ { Lisp_Object tem; struct buffer *old = current_buffer; - int opoint, opoint_byte; - int before, before_byte; + EMACS_INT opoint, opoint_byte; + EMACS_INT before, before_byte; /* Avoid error if buffer is deleted (probably that's why the process is dead, too) */ @@ -6711,35 +6833,16 @@ -static int add_gpm_wait_descriptor_called_flag; - void add_gpm_wait_descriptor (int desc) { - if (! add_gpm_wait_descriptor_called_flag) - FD_CLR (0, &input_wait_mask); - add_gpm_wait_descriptor_called_flag = 1; - FD_SET (desc, &input_wait_mask); - FD_SET (desc, &gpm_wait_mask); - if (desc > max_gpm_desc) - max_gpm_desc = desc; + add_keyboard_wait_descriptor (desc); } void delete_gpm_wait_descriptor (int desc) { - int fd; - int lim = max_gpm_desc; - - FD_CLR (desc, &input_wait_mask); - FD_CLR (desc, &non_process_wait_mask); - - if (desc == max_gpm_desc) - for (fd = 0; fd < lim; fd++) - if (FD_ISSET (fd, &input_wait_mask) - && !FD_ISSET (fd, &non_keyboard_wait_mask) - && !FD_ISSET (fd, &non_process_wait_mask)) - max_gpm_desc = fd; + delete_keyboard_wait_descriptor (desc); } /* Return nonzero if *MASK has a bit set @@ -6750,7 +6853,7 @@ { int fd; - for (fd = 0; fd <= max_keyboard_desc; fd++) + for (fd = 0; fd <= max_input_desc; fd++) if (FD_ISSET (fd, mask) && FD_ISSET (fd, &input_wait_mask) && !FD_ISSET (fd, &non_keyboard_wait_mask)) return 1; @@ -6989,11 +7092,11 @@ void add_keyboard_wait_descriptor (int desc) { -#ifdef subprocesses +#ifdef subprocesses /* actually means "not MSDOS" */ FD_SET (desc, &input_wait_mask); FD_SET (desc, &non_process_wait_mask); - if (desc > max_keyboard_desc) - max_keyboard_desc = desc; + if (desc > max_input_desc) + max_input_desc = desc; #endif } @@ -7004,18 +7107,16 @@ { #ifdef subprocesses int fd; - int lim = max_keyboard_desc; + int lim = max_input_desc; FD_CLR (desc, &input_wait_mask); FD_CLR (desc, &non_process_wait_mask); - if (desc == max_keyboard_desc) + if (desc == max_input_desc) for (fd = 0; fd < lim; fd++) - if (FD_ISSET (fd, &input_wait_mask) - && !FD_ISSET (fd, &non_keyboard_wait_mask) - && !FD_ISSET (fd, &gpm_wait_mask)) - max_keyboard_desc = fd; -#endif /* subprocesses */ + if (FD_ISSET (fd, &input_wait_mask) || FD_ISSET (fd, &write_mask)) + max_input_desc = fd; +#endif } /* Setup coding systems of PROCESS. */ @@ -7272,7 +7373,9 @@ FD_ZERO (&input_wait_mask); FD_ZERO (&non_keyboard_wait_mask); FD_ZERO (&non_process_wait_mask); + FD_ZERO (&write_mask); max_process_desc = 0; + memset (fd_callback_info, 0, sizeof (fd_callback_info)); #ifdef NON_BLOCKING_CONNECT FD_ZERO (&connect_wait_mask);
--- a/src/process.h Mon Sep 27 14:27:28 2010 +0900 +++ b/src/process.h Mon Sep 27 14:42:43 2010 +0900 @@ -24,6 +24,10 @@ #include <unistd.h> #endif +#ifdef HAVE_GNUTLS +#include "gnutls.h" +#endif + /* This structure records information about a subprocess or network connection. @@ -76,6 +80,10 @@ /* Working buffer for encoding. */ Lisp_Object encoding_buf; +#ifdef HAVE_GNUTLS + Lisp_Object gnutls_cred_type; +#endif + /* After this point, there are no Lisp_Objects any more. */ /* alloc.c assumes that `pid' is the first such non-Lisp slot. */ @@ -121,6 +129,13 @@ needs to be synced to `status'. */ unsigned int raw_status_new : 1; int raw_status; + +#ifdef HAVE_GNUTLS + gnutls_initstage_t gnutls_initstage; + gnutls_session_t gnutls_state; + gnutls_certificate_client_credentials x509_cred; + gnutls_anon_client_credentials_t anon_cred; +#endif }; /* Every field in the preceding structure except for the first two @@ -177,5 +192,12 @@ extern void unhold_keyboard_input (void); extern int kbd_on_hold_p (void); +typedef void (*fd_callback)(int fd, void *data, int for_read); + +extern void add_read_fd (int fd, fd_callback func, void *data); +extern void delete_read_fd (int fd); +extern void add_write_fd (int fd, fd_callback func, void *data); +extern void delete_write_fd (int fd); + /* arch-tag: dffedfc4-d7bc-4b58-a26f-c16155449c72 (do not change this comment) */
--- a/src/region-cache.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/region-cache.c Mon Sep 27 14:42:43 2010 +0900 @@ -62,7 +62,7 @@ revalidate_region_cache to see how this helps. */ struct boundary { - int pos; + EMACS_INT pos; int value; }; @@ -72,16 +72,16 @@ struct boundary *boundaries; /* boundaries[gap_start ... gap_start + gap_len - 1] is the gap. */ - int gap_start, gap_len; + EMACS_INT gap_start, gap_len; /* The number of elements allocated to boundaries, not including the gap. */ - int cache_len; + EMACS_INT cache_len; /* The areas that haven't changed since the last time we cleaned out invalid entries from the cache. These overlap when the buffer is entirely unchanged. */ - int beg_unchanged, end_unchanged; + EMACS_INT beg_unchanged, end_unchanged; /* The first and last positions in the buffer. Because boundaries store their positions relative to the start (BEG) and end (Z) of @@ -91,7 +91,7 @@ Yes, buffer_beg is always 1. It's there for symmetry with buffer_end and the BEG and BUF_BEG macros. */ - int buffer_beg, buffer_end; + EMACS_INT buffer_beg, buffer_end; }; /* Return the position of boundary i in cache c. */ @@ -172,17 +172,17 @@ This operation should be logarithmic in the number of cache entries. It would be nice if it took advantage of locality of reference, too, by searching entries near the last entry found. */ -static int -find_cache_boundary (struct region_cache *c, int pos) +static EMACS_INT +find_cache_boundary (struct region_cache *c, EMACS_INT pos) { - int low = 0, high = c->cache_len; + EMACS_INT low = 0, high = c->cache_len; while (low + 1 < high) { /* mid is always a valid index, because low < high and ">> 1" rounds down. */ - int mid = (low + high) >> 1; - int boundary = BOUNDARY_POS (c, mid); + EMACS_INT mid = (low + high) >> 1; + EMACS_INT boundary = BOUNDARY_POS (c, mid); if (pos < boundary) high = mid; @@ -207,13 +207,13 @@ /* Move the gap of cache C to index POS, and make sure it has space for at least MIN_SIZE boundaries. */ static void -move_cache_gap (struct region_cache *c, int pos, int min_size) +move_cache_gap (struct region_cache *c, EMACS_INT pos, EMACS_INT min_size) { /* Copy these out of the cache and into registers. */ - int gap_start = c->gap_start; - int gap_len = c->gap_len; - int buffer_beg = c->buffer_beg; - int buffer_end = c->buffer_end; + EMACS_INT gap_start = c->gap_start; + EMACS_INT gap_len = c->gap_len; + EMACS_INT buffer_beg = c->buffer_beg; + EMACS_INT buffer_end = c->buffer_end; if (pos < 0 || pos > c->cache_len) @@ -245,7 +245,7 @@ when the portion after the gap is smallest. */ if (gap_len < min_size) { - int i; + EMACS_INT i; /* Always make at least NEW_CACHE_GAP elements, as long as we're expanding anyway. */ @@ -292,7 +292,8 @@ /* Insert a new boundary in cache C; it will have cache index INDEX, and have the specified POS and VALUE. */ static void -insert_cache_boundary (struct region_cache *c, int index, int pos, int value) +insert_cache_boundary (struct region_cache *c, EMACS_INT index, EMACS_INT pos, + int value) { /* index must be a valid cache index. */ if (index < 0 || index > c->cache_len) @@ -328,9 +329,10 @@ /* Delete the i'th entry from cache C if START <= i < END. */ static void -delete_cache_boundaries (struct region_cache *c, int start, int end) +delete_cache_boundaries (struct region_cache *c, + EMACS_INT start, EMACS_INT end) { - int len = end - start; + EMACS_INT len = end - start; /* Gotta be in range. */ if (start < 0 @@ -380,7 +382,8 @@ /* Set the value in cache C for the region START..END to VALUE. */ static void -set_cache_region (struct region_cache *c, int start, int end, int value) +set_cache_region (struct region_cache *c, + EMACS_INT start, EMACS_INT end, int value) { if (start > end) abort (); @@ -403,8 +406,8 @@ index of the earliest boundary after the last character in start..end. (This tortured terminology is intended to answer all the "< or <=?" sort of questions.) */ - int start_ix = find_cache_boundary (c, start); - int end_ix = find_cache_boundary (c, end - 1) + 1; + EMACS_INT start_ix = find_cache_boundary (c, start); + EMACS_INT end_ix = find_cache_boundary (c, end - 1) + 1; /* We must remember the value established by the last boundary before end; if that boundary's domain stretches beyond end, @@ -481,7 +484,8 @@ buffer positions in the presence of insertions and deletions; the args to pass are the same before and after such an operation.) */ void -invalidate_region_cache (struct buffer *buf, struct region_cache *c, int head, int tail) +invalidate_region_cache (struct buffer *buf, struct region_cache *c, + EMACS_INT head, EMACS_INT tail) { /* Let chead = c->beg_unchanged, and ctail = c->end_unchanged. @@ -619,7 +623,7 @@ corresponds to the modified region of the buffer. */ else { - int modified_ix; + EMACS_INT modified_ix; /* These positions are correct, relative to both the cache basis and the buffer basis. */ @@ -687,7 +691,8 @@ buffer positions) is "known," for the purposes of CACHE (e.g. "has no newlines", in the case of the line cache). */ void -know_region_cache (struct buffer *buf, struct region_cache *c, int start, int end) +know_region_cache (struct buffer *buf, struct region_cache *c, + EMACS_INT start, EMACS_INT end) { revalidate_region_cache (buf, c); @@ -701,14 +706,15 @@ the purposes of CACHE. If NEXT is non-zero, set *NEXT to the nearest position after POS where the knownness changes. */ int -region_cache_forward (struct buffer *buf, struct region_cache *c, int pos, int *next) +region_cache_forward (struct buffer *buf, struct region_cache *c, + EMACS_INT pos, EMACS_INT *next) { revalidate_region_cache (buf, c); { - int i = find_cache_boundary (c, pos); + EMACS_INT i = find_cache_boundary (c, pos); int i_value = BOUNDARY_VALUE (c, i); - int j; + EMACS_INT j; /* Beyond the end of the buffer is unknown, by definition. */ if (pos >= BUF_Z (buf)) @@ -736,7 +742,8 @@ /* Return true if the text immediately before POS in BUF is known, for the purposes of CACHE. If NEXT is non-zero, set *NEXT to the nearest position before POS where the knownness changes. */ -int region_cache_backward (struct buffer *buf, struct region_cache *c, int pos, int *next) +int region_cache_backward (struct buffer *buf, struct region_cache *c, + EMACS_INT pos, EMACS_INT *next) { revalidate_region_cache (buf, c); @@ -749,9 +756,9 @@ } { - int i = find_cache_boundary (c, pos - 1); + EMACS_INT i = find_cache_boundary (c, pos - 1); int i_value = BOUNDARY_VALUE (c, i); - int j; + EMACS_INT j; if (next) { @@ -777,17 +784,17 @@ pp_cache (struct region_cache *c) { int i; - int beg_u = c->buffer_beg + c->beg_unchanged; - int end_u = c->buffer_end - c->end_unchanged; + EMACS_INT beg_u = c->buffer_beg + c->beg_unchanged; + EMACS_INT end_u = c->buffer_end - c->end_unchanged; fprintf (stderr, - "basis: %d..%d modified: %d..%d\n", - c->buffer_beg, c->buffer_end, - beg_u, end_u); + "basis: %ld..%ld modified: %ld..%ld\n", + (long)c->buffer_beg, (long)c->buffer_end, + (long)beg_u, (long)end_u); for (i = 0; i < c->cache_len; i++) { - int pos = BOUNDARY_POS (c, i); + EMACS_INT pos = BOUNDARY_POS (c, i); putc (((pos < beg_u) ? 'v' : (pos == beg_u) ? '-' @@ -797,7 +804,7 @@ : (pos == end_u) ? '-' : ' '), stderr); - fprintf (stderr, "%d : %d\n", pos, BOUNDARY_VALUE (c, i)); + fprintf (stderr, "%ld : %d\n", (long)pos, BOUNDARY_VALUE (c, i)); } }
--- a/src/region-cache.h Mon Sep 27 14:27:28 2010 +0900 +++ b/src/region-cache.h Mon Sep 27 14:42:43 2010 +0900 @@ -71,7 +71,7 @@ no newlines", in the case of the line cache). */ extern void know_region_cache (struct buffer *BUF, struct region_cache *CACHE, - int START, int END); + EMACS_INT START, EMACS_INT END); /* Indicate that a section of BUF has changed, to invalidate CACHE. HEAD is the number of chars unchanged at the beginning of the buffer. @@ -83,7 +83,7 @@ args to pass are the same before and after such an operation.) */ extern void invalidate_region_cache (struct buffer *BUF, struct region_cache *CACHE, - int HEAD, int TAIL); + EMACS_INT HEAD, EMACS_INT TAIL); /* The scanning functions. @@ -99,16 +99,16 @@ position after POS where the knownness changes. */ extern int region_cache_forward (struct buffer *BUF, struct region_cache *CACHE, - int POS, - int *NEXT); + EMACS_INT POS, + EMACS_INT *NEXT); /* Return true if the text immediately before POS in BUF is known, for the purposes of CACHE. If NEXT is non-zero, set *NEXT to the nearest position before POS where the knownness changes. */ extern int region_cache_backward (struct buffer *BUF, struct region_cache *CACHE, - int POS, - int *NEXT); + EMACS_INT POS, + EMACS_INT *NEXT); /* arch-tag: 70f79125-ef22-4f58-9aec-a48ca2791435 (do not change this comment) */
--- a/src/scroll.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/scroll.c Mon Sep 27 14:42:43 2010 +0900 @@ -94,7 +94,7 @@ int free_at_end) { register int i, j; - int frame_lines = FRAME_LINES (frame); + EMACS_INT frame_lines = FRAME_LINES (frame); register struct matrix_elt *p, *p1; register int cost, cost1; @@ -115,7 +115,7 @@ /* Discourage long scrolls on fast lines. Don't scroll nearly a full frame height unless it saves at least 1/4 second. */ - int extra_cost = baud_rate / (10 * 4 * FRAME_LINES (frame)); + int extra_cost = (int) (baud_rate / (10 * 4 * FRAME_LINES (frame))); if (baud_rate <= 0) extra_cost = 1; @@ -428,7 +428,7 @@ int free_at_end) { register int i, j; - int frame_lines = FRAME_LINES (frame); + EMACS_INT frame_lines = FRAME_LINES (frame); register struct matrix_elt *p, *p1; register int cost, cost1, delta; @@ -448,7 +448,7 @@ /* Discourage long scrolls on fast lines. Don't scroll nearly a full frame height unless it saves at least 1/4 second. */ - int extra_cost = baud_rate / (10 * 4 * FRAME_LINES (frame)); + int extra_cost = (int) (baud_rate / (10 * 4 * FRAME_LINES (frame))); if (baud_rate <= 0) extra_cost = 1; @@ -886,9 +886,9 @@ { /* Compute how many lines, at bottom of frame, will not be involved in actual motion. */ - int limit = to; - int offset; - int height = FRAME_LINES (frame); + EMACS_INT limit = to; + EMACS_INT offset; + EMACS_INT height = FRAME_LINES (frame); if (amount == 0) return 0; @@ -921,8 +921,8 @@ static void line_ins_del (FRAME_PTR frame, int ov1, int pf1, int ovn, int pfn, register int *ov, register int *mf) { - register int i; - register int frame_lines = FRAME_LINES (frame); + register EMACS_INT i; + register EMACS_INT frame_lines = FRAME_LINES (frame); register int insert_overhead = ov1 * 10; register int next_insert_cost = ovn * 10;
--- a/src/search.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/search.c Mon Sep 27 14:42:43 2010 +0900 @@ -100,15 +100,15 @@ static void set_search_regs (EMACS_INT, EMACS_INT); static void save_search_regs (void); -static EMACS_INT simple_search (int, unsigned char *, int, int, - Lisp_Object, EMACS_INT, EMACS_INT, +static EMACS_INT simple_search (EMACS_INT, unsigned char *, EMACS_INT, + EMACS_INT, Lisp_Object, EMACS_INT, EMACS_INT, EMACS_INT, EMACS_INT); -static EMACS_INT boyer_moore (int, unsigned char *, int, int, +static EMACS_INT boyer_moore (EMACS_INT, unsigned char *, EMACS_INT, EMACS_INT, Lisp_Object, Lisp_Object, EMACS_INT, EMACS_INT, EMACS_INT, EMACS_INT, int); static EMACS_INT search_buffer (Lisp_Object, EMACS_INT, EMACS_INT, - EMACS_INT, EMACS_INT, int, int, + EMACS_INT, EMACS_INT, EMACS_INT, int, Lisp_Object, Lisp_Object, int); static void matcher_overflow (void) NO_RETURN; @@ -286,7 +286,7 @@ Lisp_Object val; unsigned char *p1, *p2; EMACS_INT s1, s2; - register int i; + register EMACS_INT i; struct re_pattern_buffer *bufp; if (running_asynch_code) @@ -396,7 +396,7 @@ pos = 0, pos_byte = 0; else { - int len = SCHARS (string); + EMACS_INT len = SCHARS (string); CHECK_NUMBER (start); pos = XINT (start); @@ -509,7 +509,7 @@ { int val; struct re_pattern_buffer *bufp; - int len = strlen (string); + size_t len = strlen (string); regexp = string_make_unibyte (regexp); re_match_object = Qt; @@ -654,8 +654,9 @@ If ALLOW_QUIT is non-zero, set immediate_quit. That's good to do except when inside redisplay. */ -int -scan_buffer (register int target, EMACS_INT start, EMACS_INT end, int count, int *shortage, int allow_quit) +EMACS_INT +scan_buffer (register int target, EMACS_INT start, EMACS_INT end, + EMACS_INT count, int *shortage, int allow_quit) { struct region_cache *newline_cache; int direction; @@ -695,7 +696,7 @@ to see where we can avoid some scanning. */ if (target == '\n' && newline_cache) { - int next_change; + EMACS_INT next_change; immediate_quit = 0; while (region_cache_forward (current_buffer, newline_cache, start_byte, &next_change)) @@ -767,7 +768,7 @@ /* Consult the newline cache, if appropriate. */ if (target == '\n' && newline_cache) { - int next_change; + EMACS_INT next_change; immediate_quit = 0; while (region_cache_backward (current_buffer, newline_cache, start_byte, &next_change)) @@ -846,8 +847,10 @@ If ALLOW_QUIT is non-zero, set immediate_quit. That's good to do except in special cases. */ -int -scan_newline (EMACS_INT start, EMACS_INT start_byte, EMACS_INT limit, EMACS_INT limit_byte, register int count, int allow_quit) +EMACS_INT +scan_newline (EMACS_INT start, EMACS_INT start_byte, + EMACS_INT limit, EMACS_INT limit_byte, + register EMACS_INT count, int allow_quit) { int direction = ((count > 0) ? 1 : -1); @@ -940,8 +943,8 @@ return count * direction; } -int -find_next_newline_no_quit (EMACS_INT from, int cnt) +EMACS_INT +find_next_newline_no_quit (EMACS_INT from, EMACS_INT cnt) { return scan_buffer ('\n', from, 0, cnt, (int *) 0, 0); } @@ -950,11 +953,11 @@ not after, and only search up to TO. This isn't just find_next_newline (...)-1, because you might hit TO. */ -int -find_before_next_newline (EMACS_INT from, EMACS_INT to, int cnt) +EMACS_INT +find_before_next_newline (EMACS_INT from, EMACS_INT to, EMACS_INT cnt) { int shortage; - int pos = scan_buffer ('\n', from, to, cnt, &shortage, 1); + EMACS_INT pos = scan_buffer ('\n', from, to, cnt, &shortage, 1); if (shortage == 0) pos--; @@ -965,10 +968,11 @@ /* Subroutines of Lisp buffer search functions. */ static Lisp_Object -search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, Lisp_Object count, int direction, int RE, int posix) +search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, + Lisp_Object count, int direction, int RE, int posix) { register int np; - int lim, lim_byte; + EMACS_INT lim, lim_byte; int n = direction; if (!NILP (count)) @@ -1044,7 +1048,7 @@ static int trivial_regexp_p (Lisp_Object regexp) { - int len = SBYTES (regexp); + EMACS_INT len = SBYTES (regexp); unsigned char *s = SDATA (regexp); while (--len >= 0) { @@ -1109,11 +1113,11 @@ static EMACS_INT search_buffer (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte, - EMACS_INT lim, EMACS_INT lim_byte, int n, + EMACS_INT lim, EMACS_INT lim_byte, EMACS_INT n, int RE, Lisp_Object trt, Lisp_Object inverse_trt, int posix) { - int len = SCHARS (string); - int len_byte = SBYTES (string); + EMACS_INT len = SCHARS (string); + EMACS_INT len_byte = SBYTES (string); register int i; if (running_asynch_code) @@ -1130,7 +1134,7 @@ if (RE && !(trivial_regexp_p (string) && NILP (Vsearch_spaces_regexp))) { unsigned char *p1, *p2; - int s1, s2; + EMACS_INT s1, s2; struct re_pattern_buffer *bufp; bufp = compile_pattern (string, @@ -1166,7 +1170,7 @@ while (n < 0) { - int val; + EMACS_INT val; val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2, pos_byte - BEGV_BYTE, lim_byte - pos_byte, (NILP (Vinhibit_changing_match_data) @@ -1210,7 +1214,7 @@ } while (n > 0) { - int val; + EMACS_INT val; val = re_search_2 (bufp, (char *) p1, s1, (char *) p2, s2, pos_byte - BEGV_BYTE, lim_byte - pos_byte, (NILP (Vinhibit_changing_match_data) @@ -1255,8 +1259,8 @@ else /* non-RE case */ { unsigned char *raw_pattern, *pat; - int raw_pattern_size; - int raw_pattern_size_byte; + EMACS_INT raw_pattern_size; + EMACS_INT raw_pattern_size_byte; unsigned char *patbuf; int multibyte = !NILP (current_buffer->enable_multibyte_characters); unsigned char *base_pat; @@ -1450,13 +1454,16 @@ boyer_moore cannot work. */ static EMACS_INT -simple_search (int n, unsigned char *pat, int len, int len_byte, Lisp_Object trt, EMACS_INT pos, EMACS_INT pos_byte, EMACS_INT lim, EMACS_INT lim_byte) +simple_search (EMACS_INT n, unsigned char *pat, + EMACS_INT len, EMACS_INT len_byte, Lisp_Object trt, + EMACS_INT pos, EMACS_INT pos_byte, + EMACS_INT lim, EMACS_INT lim_byte) { int multibyte = ! NILP (current_buffer->enable_multibyte_characters); int forward = n > 0; /* Number of buffer bytes matched. Note that this may be different from len_byte in a multibyte buffer. */ - int match_byte; + EMACS_INT match_byte; if (lim > pos && multibyte) while (n > 0) @@ -1466,7 +1473,7 @@ /* Try matching at position POS. */ EMACS_INT this_pos = pos; EMACS_INT this_pos_byte = pos_byte; - int this_len = len; + EMACS_INT this_len = len; unsigned char *p = pat; if (pos + len > lim || pos_byte + len_byte > lim_byte) goto stop; @@ -1511,7 +1518,7 @@ { /* Try matching at position POS. */ EMACS_INT this_pos = pos; - int this_len = len; + EMACS_INT this_len = len; unsigned char *p = pat; if (pos + len > lim) @@ -1551,7 +1558,7 @@ /* Try matching at position POS. */ EMACS_INT this_pos = pos; EMACS_INT this_pos_byte = pos_byte; - int this_len = len; + EMACS_INT this_len = len; const unsigned char *p = pat + len_byte; if (this_pos - len < lim || (pos_byte - len_byte) < lim_byte) @@ -1594,7 +1601,7 @@ { /* Try matching at position POS. */ EMACS_INT this_pos = pos - len; - int this_len = len; + EMACS_INT this_len = len; unsigned char *p = pat; if (this_pos < lim) @@ -1657,18 +1664,20 @@ If that criterion is not satisfied, do not call this function. */ static EMACS_INT -boyer_moore (int n, unsigned char *base_pat, int len, int len_byte, +boyer_moore (EMACS_INT n, unsigned char *base_pat, + EMACS_INT len, EMACS_INT len_byte, Lisp_Object trt, Lisp_Object inverse_trt, EMACS_INT pos, EMACS_INT pos_byte, EMACS_INT lim, EMACS_INT lim_byte, int char_base) { int direction = ((n > 0) ? 1 : -1); - register int dirlen; + register EMACS_INT dirlen; EMACS_INT limit; int stride_for_teases = 0; int BM_tab[0400]; register unsigned char *cursor, *p_limit; - register int i, j; + register EMACS_INT i; + register int j; unsigned char *pat, *pat_end; int multibyte = ! NILP (current_buffer->enable_multibyte_characters); @@ -2098,10 +2107,11 @@ wordify (Lisp_Object string, int lax) { register unsigned char *p, *o; - register int i, i_byte, len, punct_count = 0, word_count = 0; + register EMACS_INT i, i_byte, len, punct_count = 0, word_count = 0; Lisp_Object val; int prev_c = 0; - int adjust, whitespace_at_end; + EMACS_INT adjust; + int whitespace_at_end; CHECK_STRING (string); p = SDATA (string); @@ -2151,7 +2161,7 @@ for (i = 0, i_byte = 0; i < len; ) { int c; - int i_byte_orig = i_byte; + EMACS_INT i_byte_orig = i_byte; FETCH_STRING_CHAR_AS_MULTIBYTE_ADVANCE (c, string, i, i_byte); @@ -2392,7 +2402,7 @@ (Lisp_Object newtext, Lisp_Object fixedcase, Lisp_Object literal, Lisp_Object string, Lisp_Object subexp) { enum { nochange, all_caps, cap_initial } case_action; - register int pos, pos_byte; + register EMACS_INT pos, pos_byte; int some_multiletter_word; int some_lowercase; int some_uppercase; @@ -2540,8 +2550,8 @@ for (pos_byte = 0, pos = 0; pos_byte < length;) { - int substart = -1; - int subend = 0; + EMACS_INT substart = -1; + EMACS_INT subend = 0; int delbackslash = 0; FETCH_STRING_CHAR_ADVANCE (c, newtext, pos, pos_byte); @@ -2634,9 +2644,9 @@ perform substitution on the replacement string. */ if (NILP (literal)) { - int length = SBYTES (newtext); + EMACS_INT length = SBYTES (newtext); unsigned char *substed; - int substed_alloc_size, substed_len; + EMACS_INT substed_alloc_size, substed_len; int buf_multibyte = !NILP (current_buffer->enable_multibyte_characters); int str_multibyte = STRING_MULTIBYTE (newtext); Lisp_Object rev_tbl; @@ -2656,7 +2666,7 @@ { unsigned char str[MAX_MULTIBYTE_LENGTH]; const unsigned char *add_stuff = NULL; - int add_len = 0; + EMACS_INT add_len = 0; int idx = -1; if (str_multibyte) @@ -2750,7 +2760,8 @@ { if (buf_multibyte) { - int nchars = multibyte_chars_in_text (substed, substed_len); + EMACS_INT nchars = + multibyte_chars_in_text (substed, substed_len); newtext = make_multibyte_string (substed, nchars, substed_len); }
--- a/src/syntax.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/syntax.c Mon Sep 27 14:42:43 2010 +0900 @@ -185,7 +185,8 @@ start/end of OBJECT. */ void -update_syntax_table (int charpos, int count, int init, Lisp_Object object) +update_syntax_table (EMACS_INT charpos, int count, int init, + Lisp_Object object) { Lisp_Object tmp_table; int cnt = 0, invalidate = 1; @@ -475,7 +476,7 @@ /* Return the SYNTAX_COMEND_FIRST of the character before POS, POS_BYTE. */ static int -prev_char_comend_first (int pos, int pos_byte) +prev_char_comend_first (EMACS_INT pos, EMACS_INT pos_byte) { int c, val; @@ -557,8 +558,9 @@ that determines quote parity to the comment-end. */ while (from != stop) { - int temp_byte, prev_syntax; - int com2start, com2end; + EMACS_INT temp_byte; + int prev_syntax, com2start, com2end; + int comstart; /* Move back and examine a character. */ DEC_BOTH (from, from_byte); @@ -578,7 +580,8 @@ || SYNTAX_FLAGS_COMMENT_NESTED (syntax)) == comnested); com2end = (SYNTAX_FLAGS_COMEND_FIRST (syntax) && SYNTAX_FLAGS_COMEND_SECOND (prev_syntax)); - + comstart = (com2start || code == Scomment); + /* Nasty cases with overlapping 2-char comment markers: - snmp-mode: -- c -- foo -- c -- --- c -- @@ -589,15 +592,17 @@ /// */ /* If a 2-char comment sequence partly overlaps with another, - we don't try to be clever. */ - if (from > stop && (com2end || com2start)) + we don't try to be clever. E.g. |*| in C, or }% in modes that + have %..\n and %{..}%. */ + if (from > stop && (com2end || comstart)) { - int next = from, next_byte = from_byte, next_c, next_syntax; + EMACS_INT next = from, next_byte = from_byte; + int next_c, next_syntax; DEC_BOTH (next, next_byte); UPDATE_SYNTAX_TABLE_BACKWARD (next); next_c = FETCH_CHAR_AS_MULTIBYTE (next_byte); next_syntax = SYNTAX_WITH_FLAGS (next_c); - if (((com2start || comnested) + if (((comstart || comnested) && SYNTAX_FLAGS_COMEND_SECOND (syntax) && SYNTAX_FLAGS_COMEND_FIRST (next_syntax)) || ((com2end || comnested) @@ -1239,12 +1244,12 @@ If that many words cannot be found before the end of the buffer, return 0. COUNT negative means scan backward and stop at word beginning. */ -int -scan_words (register int from, register int count) +EMACS_INT +scan_words (register EMACS_INT from, register EMACS_INT count) { - register int beg = BEGV; - register int end = ZV; - register int from_byte = CHAR_TO_BYTE (from); + register EMACS_INT beg = BEGV; + register EMACS_INT end = ZV; + register EMACS_INT from_byte = CHAR_TO_BYTE (from); register enum syntaxcode code; int ch0, ch1; Lisp_Object func, script, pos; @@ -1452,14 +1457,14 @@ int *char_ranges; int n_char_ranges = 0; int negate = 0; - register int i, i_byte; + register EMACS_INT i, i_byte; /* Set to 1 if the current buffer is multibyte and the region contains non-ASCII chars. */ int multibyte; /* Set to 1 if STRING is multibyte and it contains non-ASCII chars. */ int string_multibyte; - int size_byte; + EMACS_INT size_byte; const unsigned char *str; int len; Lisp_Object iso_classes; @@ -1771,9 +1776,9 @@ } { - int start_point = PT; - int pos = PT; - int pos_byte = PT_BYTE; + EMACS_INT start_point = PT; + EMACS_INT pos = PT; + EMACS_INT pos_byte = PT_BYTE; unsigned char *p = PT_ADDR, *endp, *stop; if (forwardp) @@ -1943,9 +1948,9 @@ register unsigned int c; unsigned char fastmap[0400]; int negate = 0; - register int i, i_byte; + register EMACS_INT i, i_byte; int multibyte; - int size_byte; + EMACS_INT size_byte; unsigned char *str; CHECK_STRING (string); @@ -1998,9 +2003,9 @@ fastmap[i] ^= 1; { - int start_point = PT; - int pos = PT; - int pos_byte = PT_BYTE; + EMACS_INT start_point = PT; + EMACS_INT pos = PT; + EMACS_INT pos_byte = PT_BYTE; unsigned char *p = PT_ADDR, *endp, *stop; if (forwardp) @@ -2391,7 +2396,8 @@ if (code == Scomment_fence) { /* Skip until first preceding unquoted comment_fence. */ - int found = 0, ini = from, ini_byte = from_byte; + int found = 0; + EMACS_INT ini = from, ini_byte = from_byte; while (1) { @@ -2907,11 +2913,11 @@ This includes chars with "quote" or "prefix" syntax (' or p). */) (void) { - int beg = BEGV; - int opoint = PT; - int opoint_byte = PT_BYTE; - int pos = PT; - int pos_byte = PT_BYTE; + EMACS_INT beg = BEGV; + EMACS_INT opoint = PT; + EMACS_INT opoint_byte = PT_BYTE; + EMACS_INT pos = PT; + EMACS_INT pos_byte = PT_BYTE; int c; if (pos <= beg)
--- a/src/syntax.h Mon Sep 27 14:27:28 2010 +0900 +++ b/src/syntax.h Mon Sep 27 14:42:43 2010 +0900 @@ -19,7 +19,7 @@ extern Lisp_Object Qsyntax_table_p; -extern void update_syntax_table (int, int, int, Lisp_Object); +extern void update_syntax_table (EMACS_INT, int, int, Lisp_Object); /* The standard syntax table is stored where it will automatically be used in all new buffers. */ @@ -301,7 +301,7 @@ extern int parse_sexp_lookup_properties; extern INTERVAL interval_of (int, Lisp_Object); -extern int scan_words (int, int); +extern EMACS_INT scan_words (EMACS_INT, EMACS_INT); /* arch-tag: 28833cca-cd73-4741-8c85-a3111166a0e0 (do not change this comment) */
--- a/src/term.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/term.c Mon Sep 27 14:42:43 2010 +0900 @@ -31,10 +31,6 @@ #include <unistd.h> #endif -#ifdef HAVE_SYS_IOCTL_H -#include <sys/ioctl.h> -#endif - #include <signal.h> #include <stdarg.h> #include <setjmp.h> @@ -2618,9 +2614,10 @@ If POS is after end of W, return end of last line in W. - taken from msdos.c */ static int -fast_find_position (struct window *w, int pos, int *hpos, int *vpos) +fast_find_position (struct window *w, EMACS_INT pos, int *hpos, int *vpos) { - int i, lastcol, line_start_position, maybe_next_line_p = 0; + int i, lastcol, maybe_next_line_p = 0; + EMACS_INT line_start_position; int yb = window_text_bottom_y (w); struct glyph_row *row = MATRIX_ROW (w->current_matrix, 0), *best_row = row; @@ -2658,7 +2655,7 @@ for (i = 0; i < row->used[TEXT_AREA]; i++) { struct glyph *glyph = row->glyphs[TEXT_AREA] + i; - int charpos; + EMACS_INT charpos; charpos = glyph->charpos; if (charpos == pos) @@ -2719,7 +2716,8 @@ && XFASTINT (w->last_modified) == BUF_MODIFF (b) && XFASTINT (w->last_overlay_modified) == BUF_OVERLAY_MODIFF (b)) { - int pos, i, nrows = w->current_matrix->nrows; + int i, nrows = w->current_matrix->nrows; + EMACS_INT pos; struct glyph_row *row; struct glyph *glyph; @@ -2763,7 +2761,8 @@ /* Check for mouse-face. */ { Lisp_Object mouse_face, overlay, position, *overlay_vec; - int noverlays, obegv, ozv; + int noverlays; + EMACS_INT obegv, ozv; struct buffer *obuf; /* If we get an out-of-range value, return now; avoid an error. */ @@ -3404,6 +3403,15 @@ tty->Wcm = (struct cm *) xmalloc (sizeof (struct cm)); Wcm_clear (tty); + encode_terminal_src_size = 0; + encode_terminal_dst_size = 0; + +#ifdef HAVE_GPM + terminal->mouse_position_hook = term_mouse_position; + mouse_face_window = Qnil; +#endif + + #ifndef DOS_NT set_tty_hooks (terminal); @@ -3457,78 +3465,6 @@ add_keyboard_wait_descriptor (fileno (tty->input)); -#endif /* !DOS_NT */ - - encode_terminal_src_size = 0; - encode_terminal_dst_size = 0; - -#ifdef HAVE_GPM - terminal->mouse_position_hook = term_mouse_position; - mouse_face_window = Qnil; -#endif - -#ifdef DOS_NT -#ifdef WINDOWSNT - initialize_w32_display (terminal); -#else /* MSDOS */ - if (strcmp (terminal_type, "internal") == 0) - terminal->type = output_msdos_raw; - initialize_msdos_display (terminal); -#endif /* MSDOS */ - tty->output = stdout; - tty->input = stdin; - /* The following two are inaccessible from w32console.c. */ - terminal->delete_frame_hook = &tty_free_frame_resources; - terminal->delete_terminal_hook = &delete_tty; - - tty->name = xstrdup (name); - terminal->name = xstrdup (name); - tty->type = xstrdup (terminal_type); - - add_keyboard_wait_descriptor (0); - - Wcm_clear (tty); - -#ifdef WINDOWSNT - { - struct frame *f = XFRAME (selected_frame); - - FrameRows (tty) = FRAME_LINES (f); - FrameCols (tty) = FRAME_COLS (f); - tty->specified_window = FRAME_LINES (f); - - FRAME_CAN_HAVE_SCROLL_BARS (f) = 0; - FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none; - } -#else /* MSDOS */ - { - int height, width; - get_tty_size (fileno (tty->input), &width, &height); - FrameCols (tty) = width; - FrameRows (tty) = height; - } -#endif /* MSDOS */ - tty->delete_in_insert_mode = 1; - - UseTabs (tty) = 0; - terminal->scroll_region_ok = 0; - - /* Seems to insert lines when it's not supposed to, messing up the - display. In doing a trace, it didn't seem to be called much, so I - don't think we're losing anything by turning it off. */ - terminal->line_ins_del_ok = 0; -#ifdef WINDOWSNT - terminal->char_ins_del_ok = 1; - baud_rate = 19200; -#else /* MSDOS */ - terminal->char_ins_del_ok = 0; - init_baud_rate (fileno (tty->input)); -#endif /* MSDOS */ - - tty->TN_max_colors = 16; /* Required to be non-zero for tty-display-color-p */ - -#else /* not DOS_NT */ - Wcm_clear (tty); tty->termcap_term_buffer = (char *) xmalloc (buffer_size); @@ -3680,7 +3616,64 @@ tty->TF_underscore = tgetflag ("ul"); tty->TF_teleray = tgetflag ("xt"); -#endif /* !DOS_NT */ +#else /* DOS_NT */ +#ifdef WINDOWSNT + { + struct frame *f = XFRAME (selected_frame); + + initialize_w32_display (terminal); + + FrameRows (tty) = FRAME_LINES (f); + FrameCols (tty) = FRAME_COLS (f); + tty->specified_window = FRAME_LINES (f); + + FRAME_CAN_HAVE_SCROLL_BARS (f) = 0; + FRAME_VERTICAL_SCROLL_BAR_TYPE (f) = vertical_scroll_bar_none; + terminal->char_ins_del_ok = 1; + baud_rate = 19200; + } +#else /* MSDOS */ + { + int height, width; + if (strcmp (terminal_type, "internal") == 0) + terminal->type = output_msdos_raw; + initialize_msdos_display (terminal); + + get_tty_size (fileno (tty->input), &width, &height); + FrameCols (tty) = width; + FrameRows (tty) = height; + terminal->char_ins_del_ok = 0; + init_baud_rate (fileno (tty->input)); + } +#endif /* MSDOS */ + tty->output = stdout; + tty->input = stdin; + /* The following two are inaccessible from w32console.c. */ + terminal->delete_frame_hook = &tty_free_frame_resources; + terminal->delete_terminal_hook = &delete_tty; + + tty->name = xstrdup (name); + terminal->name = xstrdup (name); + tty->type = xstrdup (terminal_type); + + add_keyboard_wait_descriptor (0); + + /* FIXME: this should be removed, done earlier. */ + Wcm_clear (tty); + + tty->delete_in_insert_mode = 1; + + UseTabs (tty) = 0; + terminal->scroll_region_ok = 0; + + /* Seems to insert lines when it's not supposed to, messing up the + display. In doing a trace, it didn't seem to be called much, so I + don't think we're losing anything by turning it off. */ + terminal->line_ins_del_ok = 0; + + tty->TN_max_colors = 16; /* Required to be non-zero for tty-display-color-p */ +#endif /* DOS_NT */ + terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD)); init_kboard (terminal->kboard); terminal->kboard->Vwindow_system = Qnil;
--- a/src/termhooks.h Mon Sep 27 14:27:28 2010 +0900 +++ b/src/termhooks.h Mon Sep 27 14:42:43 2010 +0900 @@ -228,9 +228,11 @@ /* For an ASCII_KEYSTROKE_EVENT and MULTIBYTE_CHAR_KEYSTROKE_EVENT, this is the character. For a NON_ASCII_KEYSTROKE_EVENT, this is the keysym code. - For a mouse event, this is the button number. */ + For a mouse event, this is the button number. + For a HELP_EVENT, this is the position within the object + (stored in ARG below) where the help was found. */ /* In WindowsNT, for a mouse wheel event, this is the delta. */ - int code; + EMACS_INT code; enum scroll_bar_part part; int modifiers; /* See enum below for interpretation. */
--- a/src/textprop.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/textprop.c Mon Sep 27 14:42:43 2010 +0900 @@ -125,7 +125,7 @@ validate_interval_range (Lisp_Object object, Lisp_Object *begin, Lisp_Object *end, int force) { register INTERVAL i; - int searchpos; + EMACS_INT searchpos; CHECK_STRING_OR_BUFFER (object); CHECK_NUMBER_COERCE_MARKER (*begin); @@ -161,7 +161,7 @@ } else { - int len = SCHARS (object); + EMACS_INT len = SCHARS (object); if (! (0 <= XINT (*begin) && XINT (*begin) <= XINT (*end) && XINT (*end) <= len)) @@ -519,7 +519,7 @@ interval_of (int position, Lisp_Object object) { register INTERVAL i; - int beg, end; + EMACS_INT beg, end; if (NILP (object)) XSETBUFFER (object, current_buffer); @@ -984,7 +984,7 @@ /* Return 1 if there's a change in some property between BEG and END. */ int -property_change_between_p (int beg, int end) +property_change_between_p (EMACS_INT beg, EMACS_INT end) { register INTERVAL i, next; Lisp_Object object, pos; @@ -1173,7 +1173,8 @@ (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object) { register INTERVAL i, unchanged; - register int s, len, modified = 0; + register EMACS_INT s, len; + register int modified = 0; struct gcpro gcpro1; properties = validate_plist (properties); @@ -1202,7 +1203,7 @@ skip it. */ if (interval_has_all_properties (properties, i)) { - int got = (LENGTH (i) - (s - i->position)); + EMACS_INT got = (LENGTH (i) - (s - i->position)); if (got >= len) RETURN_UNGCPRO (Qnil); len -= got; @@ -1377,7 +1378,7 @@ set_text_properties_1 (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object buffer, INTERVAL i) { register INTERVAL prev_changed = NULL_INTERVAL; - register int s, len; + register EMACS_INT s, len; INTERVAL unchanged; s = XINT (start); @@ -1466,7 +1467,8 @@ (Lisp_Object start, Lisp_Object end, Lisp_Object properties, Lisp_Object object) { register INTERVAL i, unchanged; - register int s, len, modified = 0; + register EMACS_INT s, len; + register int modified = 0; if (NILP (object)) XSETBUFFER (object, current_buffer); @@ -1484,7 +1486,7 @@ it covers the entire region. */ if (! interval_has_some_properties (properties, i)) { - int got = (LENGTH (i) - (s - i->position)); + EMACS_INT got = (LENGTH (i) - (s - i->position)); if (got >= len) return Qnil; len -= got; @@ -1551,7 +1553,8 @@ (Lisp_Object start, Lisp_Object end, Lisp_Object list_of_properties, Lisp_Object object) { register INTERVAL i, unchanged; - register int s, len, modified = 0; + register EMACS_INT s, len; + register int modified = 0; Lisp_Object properties; properties = list_of_properties; @@ -1571,7 +1574,7 @@ it covers the entire region. */ if (! interval_has_some_properties_list (properties, i)) { - int got = (LENGTH (i) - (s - i->position)); + EMACS_INT got = (LENGTH (i) - (s - i->position)); if (got >= len) return Qnil; len -= got; @@ -1658,7 +1661,7 @@ (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object) { register INTERVAL i; - register int e, pos; + register EMACS_INT e, pos; if (NILP (object)) XSETBUFFER (object, current_buffer); @@ -1694,7 +1697,7 @@ (Lisp_Object start, Lisp_Object end, Lisp_Object property, Lisp_Object value, Lisp_Object object) { register INTERVAL i; - register int s, e; + register EMACS_INT s, e; if (NILP (object)) XSETBUFFER (object, current_buffer); @@ -1806,7 +1809,8 @@ Lisp_Object res; Lisp_Object stuff; Lisp_Object plist; - int s, e, e2, p, len, modified = 0; + EMACS_INT s, e, e2, p, len; + int modified = 0; struct gcpro gcpro1, gcpro2; i = validate_interval_range (src, &start, &end, soft); @@ -1902,12 +1906,12 @@ i = validate_interval_range (object, &start, &end, soft); if (!NULL_INTERVAL_P (i)) { - int s = XINT (start); - int e = XINT (end); + EMACS_INT s = XINT (start); + EMACS_INT e = XINT (end); while (s < e) { - int interval_end, len; + EMACS_INT interval_end, len; Lisp_Object plist; interval_end = i->position + LENGTH (i); @@ -1985,7 +1989,7 @@ extend_property_ranges (Lisp_Object list, Lisp_Object new_end) { Lisp_Object prev = Qnil, head = list; - int max = XINT (new_end); + EMACS_INT max = XINT (new_end); for (; CONSP (list); prev = list, list = XCDR (list)) { @@ -2059,7 +2063,7 @@ if (start > end) { - int temp = start; + EMACS_INT temp = start; start = end; end = temp; }
--- a/src/undo.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/undo.c Mon Sep 27 14:42:43 2010 +0900 @@ -67,7 +67,7 @@ undo record that will be added just after this command terminates. */ static void -record_point (int pt) +record_point (EMACS_INT pt) { int at_boundary; @@ -129,7 +129,7 @@ because we don't need to record the contents.) */ void -record_insert (int beg, int length) +record_insert (EMACS_INT beg, EMACS_INT length) { Lisp_Object lbeg, lend; @@ -164,7 +164,7 @@ of the characters in STRING, at location BEG. */ void -record_delete (int beg, Lisp_Object string) +record_delete (EMACS_INT beg, Lisp_Object string) { Lisp_Object sbeg; @@ -192,7 +192,7 @@ won't be inverted automatically by undoing the buffer modification. */ void -record_marker_adjustment (Lisp_Object marker, int adjustment) +record_marker_adjustment (Lisp_Object marker, EMACS_INT adjustment) { if (EQ (current_buffer->undo_list, Qt)) return; @@ -215,7 +215,7 @@ The replacement must not change the number of characters. */ void -record_change (int beg, int length) +record_change (EMACS_INT beg, EMACS_INT length) { record_delete (beg, make_buffer_string (beg, beg + length, 1)); record_insert (beg, length); @@ -250,7 +250,9 @@ for LENGTH characters starting at position BEG in BUFFER. */ void -record_property_change (int beg, int length, Lisp_Object prop, Lisp_Object value, Lisp_Object buffer) +record_property_change (EMACS_INT beg, EMACS_INT length, + Lisp_Object prop, Lisp_Object value, + Lisp_Object buffer) { Lisp_Object lbeg, lend, entry; struct buffer *obuf = current_buffer, *buf = XBUFFER (buffer); @@ -601,7 +603,7 @@ { /* Element (STRING . POS) means STRING was deleted. */ Lisp_Object membuf; - int pos = XINT (cdr); + EMACS_INT pos = XINT (cdr); membuf = car; if (pos < 0)
--- a/src/w32.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/w32.c Mon Sep 27 14:42:43 2010 +0900 @@ -1925,7 +1925,25 @@ char * get_emacs_configuration_options (void) { - static char options_buffer[256]; + static char *options_buffer; + char cv[32]; /* Enough for COMPILER_VERSION. */ + char *options[] = { + cv, /* To be filled later. */ +#ifdef EMACSDEBUG + " --no-opt", +#endif + /* configure.bat already sets USER_CFLAGS and USER_LDFLAGS + with a starting space to save work here. */ +#ifdef USER_CFLAGS + " --cflags", USER_CFLAGS, +#endif +#ifdef USER_LDFLAGS + " --ldflags", USER_LDFLAGS, +#endif + NULL + }; + size_t size = 0; + int i; /* Work out the effective configure options for this build. */ #ifdef _MSC_VER @@ -1938,18 +1956,19 @@ #endif #endif - sprintf (options_buffer, COMPILER_VERSION); -#ifdef EMACSDEBUG - strcat (options_buffer, " --no-opt"); -#endif -#ifdef USER_CFLAGS - strcat (options_buffer, " --cflags"); - strcat (options_buffer, USER_CFLAGS); -#endif -#ifdef USER_LDFLAGS - strcat (options_buffer, " --ldflags"); - strcat (options_buffer, USER_LDFLAGS); -#endif + if (_snprintf (cv, sizeof (cv) - 1, COMPILER_VERSION) < 0) + return "Error: not enough space for compiler version"; + cv[sizeof (cv) - 1] = '\0'; + + for (i = 0; options[i]; i++) + size += strlen (options[i]); + + options_buffer = xmalloc (size + 1); + options_buffer[0] = '\0'; + + for (i = 0; options[i]; i++) + strcat (options_buffer, options[i]); + return options_buffer; }
--- a/src/w32fns.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/w32fns.c Mon Sep 27 14:42:43 2010 +0900 @@ -262,7 +262,6 @@ (IN HMONITOR monitor, OUT struct MONITOR_INFO* info); TrackMouseEvent_Proc track_mouse_event_fn = NULL; -ClipboardSequence_Proc clipboard_sequence_fn = NULL; ImmGetCompositionString_Proc get_composition_string_fn = NULL; ImmGetContext_Proc get_ime_context_fn = NULL; ImmReleaseContext_Proc release_ime_context_fn = NULL; @@ -7183,9 +7182,6 @@ */ track_mouse_event_fn = (TrackMouseEvent_Proc) GetProcAddress (user32_lib, "TrackMouseEvent"); - /* ditto for GetClipboardSequenceNumber. */ - clipboard_sequence_fn = (ClipboardSequence_Proc) - GetProcAddress (user32_lib, "GetClipboardSequenceNumber"); monitor_from_point_fn = (MonitorFromPoint_Proc) GetProcAddress (user32_lib, "MonitorFromPoint");
--- a/src/window.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/window.c Mon Sep 27 14:42:43 2010 +0900 @@ -311,7 +311,7 @@ (Lisp_Object pos, Lisp_Object window, Lisp_Object partially) { register struct window *w; - register int posint; + register EMACS_INT posint; register struct buffer *buf; struct text_pos top; Lisp_Object in_window = Qnil; @@ -2500,7 +2500,7 @@ (Lisp_Object window) { struct window *w; - int startpos; + EMACS_INT startpos; int top, new_top; if (NILP (window)) @@ -3629,7 +3629,7 @@ redisplay_window has altered point after scrolling, because it makes the change only in the window. */ { - register int new_point = marker_position (w->pointm); + register EMACS_INT new_point = marker_position (w->pointm); if (new_point < BEGV) SET_PT (BEGV); else if (new_point > ZV) @@ -4848,7 +4848,7 @@ /* Maybe modify window start instead of scrolling. */ if (rbot > 0 || w->vscroll < 0) { - int spos; + EMACS_INT spos; Fset_window_vscroll (window, make_number (0), Qt); /* If there are other text lines above the current row, @@ -4902,7 +4902,7 @@ start_display (&it, w, start); if (whole) { - int start_pos = IT_CHARPOS (it); + EMACS_INT start_pos = IT_CHARPOS (it); int dy = WINDOW_FRAME_LINE_HEIGHT (w); dy = max ((window_box_height (w) - next_screen_context_lines * dy), @@ -4981,8 +4981,8 @@ if (! vscrolled) { - int pos = IT_CHARPOS (it); - int bytepos; + EMACS_INT pos = IT_CHARPOS (it); + EMACS_INT bytepos; /* If in the middle of a multi-glyph character move forward to the next character. */ @@ -5052,7 +5052,7 @@ } else if (n < 0) { - int charpos, bytepos; + EMACS_INT charpos, bytepos; int partial_p; /* Save our position, for the @@ -5122,13 +5122,13 @@ window_scroll_line_based (Lisp_Object window, int n, int whole, int noerror) { register struct window *w = XWINDOW (window); - register int opoint = PT, opoint_byte = PT_BYTE; - register int pos, pos_byte; + register EMACS_INT opoint = PT, opoint_byte = PT_BYTE; + register EMACS_INT pos, pos_byte; register int ht = window_internal_height (w); register Lisp_Object tem; int lose; Lisp_Object bolp; - int startpos; + EMACS_INT startpos; Lisp_Object original_pos = Qnil; /* If scrolling screen-fulls, compute the number of lines to @@ -5573,7 +5573,7 @@ struct buffer *buf = XBUFFER (w->buffer); struct buffer *obuf = current_buffer; int center_p = 0; - int charpos, bytepos; + EMACS_INT charpos, bytepos; int iarg; int this_scroll_margin; @@ -5914,7 +5914,7 @@ Lisp_Object new_current_buffer; Lisp_Object frame; FRAME_PTR f; - int old_point = -1; + EMACS_INT old_point = -1; CHECK_WINDOW_CONFIGURATION (configuration);
--- a/src/xdisp.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/xdisp.c Mon Sep 27 14:42:43 2010 +0900 @@ -907,7 +907,7 @@ Lisp_Object help_echo_string; Lisp_Object help_echo_window; Lisp_Object help_echo_object; -int help_echo_pos; +EMACS_INT help_echo_pos; /* Temporary variable for XTread_socket. */ @@ -1052,8 +1052,8 @@ static void back_to_previous_line_start (struct it *); static int forward_to_next_line_start (struct it *, int *); static struct text_pos string_pos_nchars_ahead (struct text_pos, - Lisp_Object, int); -static struct text_pos string_pos (int, Lisp_Object); + Lisp_Object, EMACS_INT); +static struct text_pos string_pos (EMACS_INT, Lisp_Object); static struct text_pos c_string_pos (int, const unsigned char *, int); static int number_of_chars (const unsigned char *, int); static void compute_stop_pos (struct it *); @@ -1522,13 +1522,13 @@ in STRING, return the position NCHARS ahead (NCHARS >= 0). */ static struct text_pos -string_pos_nchars_ahead (struct text_pos pos, Lisp_Object string, int nchars) +string_pos_nchars_ahead (struct text_pos pos, Lisp_Object string, EMACS_INT nchars) { xassert (STRINGP (string) && nchars >= 0); if (STRING_MULTIBYTE (string)) { - int rest = SBYTES (string) - BYTEPOS (pos); + EMACS_INT rest = SBYTES (string) - BYTEPOS (pos); const unsigned char *p = SDATA (string) + BYTEPOS (pos); int len; @@ -1552,7 +1552,7 @@ for character position CHARPOS in STRING. */ static INLINE struct text_pos -string_pos (int charpos, Lisp_Object string) +string_pos (EMACS_INT charpos, Lisp_Object string) { struct text_pos pos; xassert (STRINGP (string)); @@ -2653,7 +2653,7 @@ && WINDOWP (minibuf_selected_window) && w == XWINDOW (minibuf_selected_window)))) { - int charpos = marker_position (current_buffer->mark); + EMACS_INT charpos = marker_position (current_buffer->mark); it->region_beg_charpos = min (PT, charpos); it->region_end_charpos = max (PT, charpos); } @@ -2899,7 +2899,7 @@ { Lisp_Object prop, window; int ellipses_p = 0; - int charpos = CHARPOS (pos->pos); + EMACS_INT charpos = CHARPOS (pos->pos); /* If POS specifies a position in a display vector, this might be for an ellipsis displayed for invisible text. We won't @@ -3455,7 +3455,8 @@ } else { - int base_face_id, bufpos; + int base_face_id; + EMACS_INT bufpos; int i; Lisp_Object from_overlay = (it->current.overlay_string_index >= 0 @@ -3579,7 +3580,8 @@ if (STRINGP (it->string)) { - int bufpos, base_face_id; + EMACS_INT bufpos; + int base_face_id; /* No face change past the end of the string (for the case we are padding with spaces). No face change before the @@ -3622,7 +3624,7 @@ if (STRING_MULTIBYTE (it->string)) { const unsigned char *p = SDATA (it->string) + BYTEPOS (pos); - int rest = SBYTES (it->string) - BYTEPOS (pos); + EMACS_INT rest = SBYTES (it->string) - BYTEPOS (pos); int c, len; struct face *face = FACE_FROM_ID (it->f, face_id); @@ -7411,7 +7413,7 @@ TO_CHARPOS. */ void -move_it_to (struct it *it, int to_charpos, int to_x, int to_y, int to_vpos, int op) +move_it_to (struct it *it, EMACS_INT to_charpos, int to_x, int to_y, int to_vpos, int op) { enum move_it_result skip, skip2 = MOVE_X_REACHED; int line_height, line_start_x = 0, reached = 0; @@ -7990,7 +7992,7 @@ so the buffer M must NOT point to a Lisp string. */ void -message_dolog (const char *m, int nbytes, int nlflag, int multibyte) +message_dolog (const char *m, EMACS_INT nbytes, int nlflag, int multibyte) { if (!NILP (Vmemory_full)) return; @@ -9189,7 +9191,7 @@ time we display it---but don't redisplay it now. */ void -truncate_echo_area (int nchars) +truncate_echo_area (EMACS_INT nchars) { if (nchars == 0) echo_area_buffer[0] = Qnil; @@ -9628,7 +9630,7 @@ store_mode_line_noprop (const unsigned char *str, int field_width, int precision) { int n = 0; - int dummy, nbytes; + EMACS_INT dummy, nbytes; /* Copy at most PRECISION chars from STR. */ nbytes = strlen (str); @@ -11103,7 +11105,7 @@ /* Delta in characters and bytes for try_window_id. */ -int debug_delta, debug_delta_bytes; +EMACS_INT debug_delta, debug_delta_bytes; /* Values of window_end_pos and window_end_vpos at the end of try_window_id. */ @@ -11378,8 +11380,8 @@ position. BUF and PT are the current point buffer and position. */ int -check_point_in_composition (struct buffer *prev_buf, int prev_pt, - struct buffer *buf, int pt) +check_point_in_composition (struct buffer *prev_buf, EMACS_INT prev_pt, + struct buffer *buf, EMACS_INT pt) { EMACS_INT start, end; Lisp_Object prop; @@ -11432,7 +11434,7 @@ if (!b->clip_changed && BUFFERP (w->buffer) && !NILP (w->window_end_valid)) { - int pt; + EMACS_INT pt; if (w == XWINDOW (selected_window)) pt = BUF_PT (current_buffer); @@ -11834,7 +11836,7 @@ { struct glyph_row *row = MATRIX_ROW (w->current_matrix, this_line_vpos + 1); - int delta, delta_bytes; + EMACS_INT delta, delta_bytes; /* We used to distinguish between two cases here, conditioned by Z - CHARPOS (tlendpos) == ZV, for @@ -12463,7 +12465,8 @@ int set_cursor_from_row (struct window *w, struct glyph_row *row, - struct glyph_matrix *matrix, int delta, int delta_bytes, + struct glyph_matrix *matrix, + EMACS_INT delta, EMACS_INT delta_bytes, int dy, int dvpos) { struct glyph *glyph = row->glyphs[TEXT_AREA]; @@ -15056,7 +15059,7 @@ static struct glyph_row *find_last_unchanged_at_beg_row (struct window *); static struct glyph_row *find_first_unchanged_at_end_row (struct window *, - int *, int *); + EMACS_INT *, EMACS_INT *); static struct glyph_row * find_last_row_displaying_text (struct glyph_matrix *, struct it *, struct glyph_row *); @@ -15151,7 +15154,8 @@ changes. */ static struct glyph_row * -find_first_unchanged_at_end_row (struct window *w, int *delta, int *delta_bytes) +find_first_unchanged_at_end_row (struct window *w, + EMACS_INT *delta, EMACS_INT *delta_bytes) { struct glyph_row *row; struct glyph_row *row_found = NULL; @@ -15382,13 +15386,14 @@ struct glyph_row *bottom_row; int bottom_vpos; struct it it; - int delta = 0, delta_bytes = 0, stop_pos, dvpos, dy; + EMACS_INT delta = 0, delta_bytes = 0, stop_pos; + int dvpos, dy; struct text_pos start_pos; struct run run; int first_unchanged_at_end_vpos = 0; struct glyph_row *last_text_row, *last_text_row_at_end; struct text_pos start; - int first_changed_charpos, last_changed_charpos; + EMACS_INT first_changed_charpos, last_changed_charpos; #if GLYPH_DEBUG if (inhibit_try_window_id) @@ -15515,7 +15520,7 @@ || (last_changed_charpos < CHARPOS (start) - 1 && FETCH_BYTE (BYTEPOS (start) - 1) == '\n'))) { - int Z_old, delta, Z_BYTE_old, delta_bytes; + EMACS_INT Z_old, delta, Z_BYTE_old, delta_bytes; struct glyph_row *r0; /* Compute how many chars/bytes have been added to or removed @@ -18377,7 +18382,7 @@ { /* A string: output it and check for %-constructs within it. */ unsigned char c; - int offset = 0; + EMACS_INT offset = 0; if (SCHARS (elt) > 0 && (!NILP (props) || risky)) @@ -18474,7 +18479,7 @@ && (mode_line_target != MODE_LINE_DISPLAY || it->current_x < it->last_visible_x)) { - int last_offset = offset; + EMACS_INT last_offset = offset; /* Advance to end of string or next format specifier. */ while ((c = SREF (elt, offset++)) != '\0' && c != '%') @@ -18482,7 +18487,7 @@ if (offset - 1 != last_offset) { - int nchars, nbytes; + EMACS_INT nchars, nbytes; /* Output to end of string or up to '%'. Field width is length of string. Don't output more than @@ -18501,11 +18506,11 @@ break; case MODE_LINE_STRING: { - int bytepos = last_offset; - int charpos = string_byte_to_char (elt, bytepos); - int endpos = (precision <= 0 - ? string_byte_to_char (elt, offset) - : charpos + nchars); + EMACS_INT bytepos = last_offset; + EMACS_INT charpos = string_byte_to_char (elt, bytepos); + EMACS_INT endpos = (precision <= 0 + ? string_byte_to_char (elt, offset) + : charpos + nchars); n += store_mode_line_string (NULL, Fsubstring (elt, make_number (charpos), @@ -18515,8 +18520,8 @@ break; case MODE_LINE_DISPLAY: { - int bytepos = last_offset; - int charpos = string_byte_to_char (elt, bytepos); + EMACS_INT bytepos = last_offset; + EMACS_INT charpos = string_byte_to_char (elt, bytepos); if (precision <= 0) nchars = string_byte_to_char (elt, offset) - charpos; @@ -18529,7 +18534,7 @@ } else /* c == '%' */ { - int percent_position = offset; + EMACS_INT percent_position = offset; /* Get the specified minimum width. Zero means don't pad. */ @@ -24167,7 +24172,8 @@ Display_Info *dpyinfo = FRAME_X_DISPLAY_INFO (f); Cursor cursor = FRAME_X_OUTPUT (f)->nontext_cursor; Lisp_Object pointer = Qnil; - int charpos, dx, dy, width, height; + int dx, dy, width, height; + EMACS_INT charpos; Lisp_Object string, object = Qnil; Lisp_Object pos, help;
--- a/src/xml.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/xml.c Mon Sep 27 14:42:43 2010 +0900 @@ -30,41 +30,46 @@ Lisp_Object make_dom (xmlNode *node) { - if (node->type == XML_ELEMENT_NODE) { - Lisp_Object result = Fcons (intern (node->name), Qnil); - xmlNode *child; - xmlAttr *property; + if (node->type == XML_ELEMENT_NODE) + { + Lisp_Object result = Fcons (intern (node->name), Qnil); + xmlNode *child; + xmlAttr *property; + Lisp_Object plist = Qnil; - /* First add the attributes. */ - property = node->properties; - while (property != NULL) { - if (property->children && - property->children->content) { - char *pname = xmalloc (strlen (property->name) + 2); - *pname = ':'; - strcpy(pname + 1, property->name); - result = Fcons (Fcons (intern (pname), - build_string(property->children->content)), - result); - xfree (pname); - } - property = property->next; + /* First add the attributes. */ + property = node->properties; + while (property != NULL) + { + if (property->children && + property->children->content) + { + plist = Fcons (Fcons (intern (property->name), + build_string (property->children->content)), + plist); + } + property = property->next; + } + result = Fcons (Fnreverse (plist), result); + + /* Then add the children of the node. */ + child = node->children; + while (child != NULL) + { + result = Fcons (make_dom (child), result); + child = child->next; + } + + return Fnreverse (result); } - /* Then add the children of the node. */ - child = node->children; - while (child != NULL) { - result = Fcons (make_dom (child), result); - child = child->next; + else if (node->type == XML_TEXT_NODE) + { + if (node->content) + return build_string (node->content); + else + return Qnil; } - return Fnreverse (result); - } else if (node->type == XML_TEXT_NODE) { - Lisp_Object content = Qnil; - - if (node->content) - content = build_string (node->content); - - return Fcons (intern (node->name), content); - } else + else return Qnil; } @@ -81,47 +86,47 @@ CHECK_STRING (string); - if (! NILP (base_url)) { - CHECK_STRING (base_url); - burl = SDATA (base_url); - } + if (! NILP (base_url)) + { + CHECK_STRING (base_url); + burl = SDATA (base_url); + } - if (htmlp) - doc = htmlReadMemory (SDATA (string), SBYTES (string), burl, "utf-8", - HTML_PARSE_RECOVER|HTML_PARSE_NONET| - HTML_PARSE_NOWARNING|HTML_PARSE_NOERROR); - else - doc = xmlReadMemory (SDATA (string), SBYTES (string), burl, "utf-8", - XML_PARSE_NONET|XML_PARSE_NOWARNING| - XML_PARSE_NOERROR); + doc = htmlp + ? htmlReadMemory (SDATA (string), SBYTES (string), burl, "utf-8", + HTML_PARSE_RECOVER|HTML_PARSE_NONET| + HTML_PARSE_NOWARNING|HTML_PARSE_NOERROR) + : xmlReadMemory (SDATA (string), SBYTES (string), burl, "utf-8", + XML_PARSE_NONET|XML_PARSE_NOWARNING| + XML_PARSE_NOERROR); - if (doc != NULL) { - node = xmlDocGetRootElement (doc); - if (node != NULL) - result = make_dom (node); - - xmlFreeDoc (doc); - xmlCleanupParser (); - } + if (doc != NULL) + { + node = xmlDocGetRootElement (doc); + if (node != NULL) + result = make_dom (node); + xmlFreeDoc (doc); + xmlCleanupParser (); + } return result; } -DEFUN ("html-parse-string", Fhtml_parse_string, Shtml_parse_string, +DEFUN ("xml-parse-html-string-internal", Fxml_parse_html_string_internal, + Sxml_parse_html_string_internal, 1, 2, 0, doc: /* Parse STRING as an HTML document and return the parse tree. -If BASE-URL is non-nil, it will be used to expand relative URLs in -the HTML document. */) +If BASE-URL is non-nil, it is used to expand relative URLs. */) (Lisp_Object string, Lisp_Object base_url) { return parse_string (string, base_url, 1); } -DEFUN ("xml-parse-string", Fxml_parse_string, Sxml_parse_string, +DEFUN ("xml-parse-string-internal", Fxml_parse_string_internal, + Sxml_parse_string_internal, 1, 2, 0, doc: /* Parse STRING as an XML document and return the parse tree. -If BASE-URL is non-nil, it will be used to expand relative URLs in -the XML document. */) +If BASE-URL is non-nil, it is used to expand relative URLs. */) (Lisp_Object string, Lisp_Object base_url) { return parse_string (string, base_url, 0); @@ -134,8 +139,8 @@ void syms_of_xml (void) { - defsubr (&Shtml_parse_string); - defsubr (&Sxml_parse_string); + defsubr (&Sxml_parse_html_string_internal); + defsubr (&Sxml_parse_string_internal); } #endif /* HAVE_LIBXML2 */
--- a/src/xrdb.c Mon Sep 27 14:27:28 2010 +0900 +++ b/src/xrdb.c Mon Sep 27 14:42:43 2010 +0900 @@ -127,7 +127,7 @@ Return NULL otherwise. */ static char * -magic_file_p (const char *string, int string_len, const char *class, const char *escaped_suffix, const char *suffix) +magic_file_p (const char *string, EMACS_INT string_len, const char *class, const char *escaped_suffix, const char *suffix) { char *lang = getenv ("LANG");