# HG changeset patch # User cvs # Date 1186991476 -7200 # Node ID 6075d714658b84bac1316ab6248365f29ce3a1fa # Parent 6866abce6aafc6190ab3f73a20d59a85624966c1 Import from CVS: tag r20-3b15 diff -r 6866abce6aaf -r 6075d714658b CHANGES-beta --- a/CHANGES-beta Mon Aug 13 09:50:16 2007 +0200 +++ b/CHANGES-beta Mon Aug 13 09:51:16 2007 +0200 @@ -1,4 +1,21 @@ -*- indented-text -*- +to 20.3 beta15 "Berlin" +-- cc-mode-5.14 +-- hm--html-menus-5.8 +-- Gnus-5.4.64 is packaged +-- AUCTeX-9.7p is packaged +-- Initial implementation of Packages +-- Handling of printing circular objects synched with Emacs 19.34 +-- mel-6.10.1 [Formerly part of tm] Courtesy of MORIOKA Tomohiko +-- apel-3.4 [Formerly part of tm] Courtesy of MORIOKA Tomohiko +-- Fix for installing XEmacs with separate --prefix, --exec-prefix directories +-- New configure option --pkg-dir [list] enabled, contents available via + the Lisp variable `package-path' (default is "/etc/xemacs:~/.xemacs)) +-- Advisory message added to *scratch* at startup +-- Gnus-5.4.64 +-- strokes.el-2.3 +-- Miscellaneous bug fixes + to 20.3 beta14 "Vienna" -- VM-6.33 -- Miscellaneous Martin Buchholz patches to configure diff -r 6866abce6aaf -r 6075d714658b ChangeLog --- a/ChangeLog Mon Aug 13 09:50:16 2007 +0200 +++ b/ChangeLog Mon Aug 13 09:51:16 2007 +0200 @@ -1,10 +1,31 @@ -1997-07-19 Stephanie L Baur +1997-07-26 SL Baur + + * XEmacs 20.3-beta15 is released. + +1997-07-25 SL Baur + + * lwlib/xlwscrollbar.c: Add debug malloc support. + * lwlib/xlwmenu.c: Ditto. + * lwlib/lwlib-utils.h: Ditto. + + * configure.in (null_string): Add --use-debug-malloc option. + +1997-07-21 SL Baur + + * info/dir (Packages): Remove AUCTeX, Gnus and Message manuals. + +1997-07-20 SL Baur + + * Makefile.in (install-arch-indep): Create required links when + prefixdir != execdir. + +1997-07-19 SL Baur * XEmacs 20.3-beta14 is released. 1997-07-19 Martin Buchholz - * src/fns.c (requrire): Print messages when loading a file as a + * src/fns.c (require): Print messages when loading a file as a result of require. * configure.in: @@ -1166,7 +1187,7 @@ * XEmacs 20.0 beta 34 is released. * XEmacs 19.15 beta 7 is released. -Fri Jan 3 15:18:59 1997 Jeff Miller +Fri Jan 3 15:18:59 1997 Jeff Miller * lwlib/Makefile.in.in: lwlib is required if X11 is used. diff -r 6866abce6aaf -r 6075d714658b INSTALL --- a/INSTALL Mon Aug 13 09:50:16 2007 +0200 +++ b/INSTALL Mon Aug 13 09:51:16 2007 +0200 @@ -283,6 +283,11 @@ default configuration for your system. Note that on many systems using the system malloc disables the use of the relocating allocator. +The `--use-debug-malloc' option can be used to link a special debugging +version of malloc. Debug Malloc is not included with XEmacs, is +intended for use only by the developers and may be obtained from +. + The `--debug' and `--error-checking' options are intended for use only by the developers. `--debug' adds code to be compiled in for performing various tests. `--error-checking' adds additional tests to diff -r 6866abce6aaf -r 6075d714658b Makefile.in --- a/Makefile.in Mon Aug 13 09:50:16 2007 +0200 +++ b/Makefile.in Mon Aug 13 09:51:16 2007 +0200 @@ -414,6 +414,13 @@ ${INSTALL_DATA} ${srcdir}/etc/$${page}.1 ${mandir}/$${page}${manext} ; \ chmod 0644 ${mandir}/$${page}${manext} ; \ done + if test ! -d ${prefix}/bin; then \ + $(LN_S) ${exec_prefix}/bin ${prefix}/bin; \ + fi + if test ! -d ${prefix}/lib/xemacs-${version}/${configuration}; then \ + ${LN_S} ${exec_prefix}/lib/xemacs-${version}/${configuration} \ + ${prefix}/lib/xemacs-${version}/${configuration}; \ + fi @echo "If you would like to save approximately 15M of disk space, do" @echo "make gzip-el" @echo "or you may run " diff -r 6866abce6aaf -r 6075d714658b configure --- a/configure Mon Aug 13 09:50:16 2007 +0200 +++ b/configure Mon Aug 13 09:51:16 2007 +0200 @@ -303,6 +303,9 @@ --x-includes=DIR Search for X header files in DIR. --x-libraries=DIR Search for X libraries in DIR. --with-toolbars=no Don't compile with any toolbar support. +--with-wm Compile with realized leader window for proper + creation of the ApplicationIcon with the + WindowMaker windowmanager (SESSION MANAGEMENT). --with-menubars=TYPE Use TYPE menubars (lucid, motif, or no). The Lucid widgets emulate Motif (mostly) but are faster. *WARNING* The Motif menubar is currently broken. @@ -393,6 +396,9 @@ This is alpha level code. --with-i18n3 Compile with I18N level 3 (support for message translation). This doesn't currently work. +--with-xfs Compile with XFontSet support for bilingual menubar. + Can't use this option with --with-xim=motif or xlib. + And should have --with-menubars=lucid. Debugging options: @@ -427,6 +433,7 @@ The default is to not do clash detection. --use-system-malloc Force use of the system malloc, rather than GNU malloc. +--use-debug-malloc Use the debugging malloc package. You may also specify any of the \`path' variables found in Makefile.in, including --bindir, --libdir, --lispdir, --datadir, and @@ -509,6 +516,7 @@ with_jpeg | \ with_png | \ with_tiff | \ + with_wm | \ with_xmu | \ with_quantify | \ with_toolbars | \ @@ -571,6 +579,7 @@ ;; rel_alloc | \ + use_debug_malloc | \ use_system_malloc ) case "$val" in y | ye | yes ) val=yes ;; @@ -640,6 +649,18 @@ eval "$opt=\"$val\"" ;; + "with_xfs" ) + case "$val" in + y | ye | yes ) val=yes ;; + n | no | non | none ) val=no ;; + * ) (echo "$progname: Usage error:" +echo " " "The \`--$optname' option must have one of these values: + \`yes', or \`no'." +echo " Use \`$progname --help' to show usage.") >&2 && exit 1 ;; + esac + eval "$opt=\"$val\"" + ;; + "mail_locking" ) case "$val" in lockf ) val=lockf ;; @@ -825,7 +846,7 @@ esac echo $ac_n "checking whether ln -s works""... $ac_c" 1>&6 -echo "configure:829: checking whether ln -s works" >&5 +echo "configure:850: checking whether ln -s works" >&5 rm -f conftestdata if ln -s X conftestdata 2>/dev/null @@ -1001,7 +1022,7 @@ echo "checking "the configuration name"" 1>&6 -echo "configure:1005: checking "the configuration name"" >&5 +echo "configure:1026: checking "the configuration name"" >&5 internal_configuration=`echo $configuration | sed 's/-\(energize\|workshop\)//'` if canonical=`$srcdir/config.sub "$internal_configuration"` ; then : ; else exit $? @@ -1401,12 +1422,12 @@ esac fi -canonical_version=`echo ${version}_${canonical} | sed 'y/.-/__/'` +stack_trace_eye_catcher=`echo xemacs_${version}_${canonical} | sed 'y/.-/__/'` { test "$extra_verbose" = "yes" && cat << EOF - Defining CANONICAL_VERSION = $canonical_version + Defining STACK_TRACE_EYE_CATCHER = $stack_trace_eye_catcher EOF cat >> confdefs.h <&6 -echo "configure:1459: checking for $ac_word" >&5 +echo "configure:1480: checking for $ac_word" >&5 if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1481,7 +1502,7 @@ # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1485: checking for $ac_word" >&5 +echo "configure:1506: checking for $ac_word" >&5 if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1526,7 +1547,7 @@ fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 -echo "configure:1530: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 +echo "configure:1551: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 ac_ext=c xe_cppflags='$CPPFLAGS $c_switch_site $c_switch_machine $c_switch_system $c_switch_x_site $X_CFLAGS' @@ -1538,11 +1559,11 @@ cross_compiling=no cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:1567: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then ac_cv_prog_cc_works=yes # If we can't run a trivial program, we are probably using a cross compiler. if (./conftest; exit) 2>/dev/null; then @@ -1562,19 +1583,19 @@ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 -echo "configure:1566: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 +echo "configure:1587: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 cross_compiling=$ac_cv_prog_cc_cross echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:1571: checking whether we are using GNU C" >&5 +echo "configure:1592: checking whether we are using GNU C" >&5 cat > conftest.c <&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then +if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:1599: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no @@ -1588,7 +1609,7 @@ ac_save_CFLAGS="$CFLAGS" CFLAGS= echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 -echo "configure:1592: checking whether ${CC-cc} accepts -g" >&5 +echo "configure:1613: checking whether ${CC-cc} accepts -g" >&5 echo 'void f(){}' > conftest.c if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then @@ -1617,7 +1638,7 @@ # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1621: checking for $ac_word" >&5 +echo "configure:1642: checking for $ac_word" >&5 if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1643,7 +1664,7 @@ # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1647: checking for $ac_word" >&5 +echo "configure:1668: checking for $ac_word" >&5 if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1688,7 +1709,7 @@ fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 -echo "configure:1692: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 +echo "configure:1713: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 ac_ext=c xe_cppflags='$CPPFLAGS $c_switch_site $c_switch_machine $c_switch_system $c_switch_x_site $X_CFLAGS' @@ -1700,11 +1721,11 @@ cross_compiling=no cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:1729: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then ac_cv_prog_cc_works=yes # If we can't run a trivial program, we are probably using a cross compiler. if (./conftest; exit) 2>/dev/null; then @@ -1724,19 +1745,19 @@ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 -echo "configure:1728: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 +echo "configure:1749: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 cross_compiling=$ac_cv_prog_cc_cross echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:1733: checking whether we are using GNU C" >&5 +echo "configure:1754: checking whether we are using GNU C" >&5 cat > conftest.c <&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then +if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:1761: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no @@ -1750,7 +1771,7 @@ ac_save_CFLAGS="$CFLAGS" CFLAGS= echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 -echo "configure:1754: checking whether ${CC-cc} accepts -g" >&5 +echo "configure:1775: checking whether ${CC-cc} accepts -g" >&5 echo 'void f(){}' > conftest.c if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then @@ -1779,7 +1800,7 @@ # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1783: checking for $ac_word" >&5 +echo "configure:1804: checking for $ac_word" >&5 if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1805,7 +1826,7 @@ # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:1809: checking for $ac_word" >&5 +echo "configure:1830: checking for $ac_word" >&5 if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. @@ -1850,7 +1871,7 @@ fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6 -echo "configure:1854: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 +echo "configure:1875: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5 ac_ext=c xe_cppflags='$CPPFLAGS $c_switch_site $c_switch_machine $c_switch_system $c_switch_x_site $X_CFLAGS' @@ -1862,11 +1883,11 @@ cross_compiling=no cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:1891: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then ac_cv_prog_cc_works=yes # If we can't run a trivial program, we are probably using a cross compiler. if (./conftest; exit) 2>/dev/null; then @@ -1886,19 +1907,19 @@ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; } fi echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6 -echo "configure:1890: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 +echo "configure:1911: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5 echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6 cross_compiling=$ac_cv_prog_cc_cross echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6 -echo "configure:1895: checking whether we are using GNU C" >&5 +echo "configure:1916: checking whether we are using GNU C" >&5 cat > conftest.c <&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then +if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:1923: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then ac_cv_prog_gcc=yes else ac_cv_prog_gcc=no @@ -1912,7 +1933,7 @@ ac_save_CFLAGS="$CFLAGS" CFLAGS= echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6 -echo "configure:1916: checking whether ${CC-cc} accepts -g" >&5 +echo "configure:1937: checking whether ${CC-cc} accepts -g" >&5 echo 'void f(){}' > conftest.c if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then @@ -1945,7 +1966,7 @@ test -n "$NON_GNU_CPP" -a "$GCC" != "yes" -a -z "$CPP" && CPP="$NON_GNU_CPP" echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6 -echo "configure:1949: checking how to run the C preprocessor" >&5 +echo "configure:1970: checking how to run the C preprocessor" >&5 # On Suns, sometimes $CPP names a directory. if test -n "$CPP" && test -d "$CPP"; then CPP= @@ -1958,13 +1979,13 @@ # On the NeXT, cc -E runs the code through the compiler's parser, # not just through cpp. cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1968: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:1989: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then : @@ -1975,13 +1996,13 @@ rm -rf conftest* CPP="${CC-cc} -E -traditional-cpp" cat > conftest.$ac_ext < Syntax Error EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:1985: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2006: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then : @@ -2004,9 +2025,9 @@ echo $ac_n "checking for AIX""... $ac_c" 1>&6 -echo "configure:2008: checking for AIX" >&5 -cat > conftest.$ac_ext <&5 +cat > conftest.$ac_ext <&6 -echo "configure:2037: checking whether we are using SunPro C" >&5 -cat > conftest.$ac_ext <&5 +cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2071: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* __sunpro_c=yes else @@ -2333,7 +2354,7 @@ fi echo $ac_n "checking for dynodump""... $ac_c" 1>&6 -echo "configure:2337: checking for dynodump" >&5 +echo "configure:2358: checking for dynodump" >&5 if test "$unexec" != "unexsol2.o"; then echo "$ac_t""no" 1>&6 else @@ -2404,19 +2425,19 @@ if test "$add_runtime_path" = "yes"; then echo $ac_n "checking "for runtime libraries flag"""... $ac_c" 1>&6 -echo "configure:2408: checking "for runtime libraries flag"" >&5 +echo "configure:2429: checking "for runtime libraries flag"" >&5 dash_r="" for try_dash_r in "-R" "-R " "-rpath "; do xe_check_libs="${try_dash_r}/no/such/file-or-directory" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:2441: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* dash_r="$try_dash_r" else @@ -2499,18 +2520,22 @@ if test "$system_malloc" = "yes" ; then GNU_MALLOC=no GNU_MALLOC_reason=" - (The GNU allocators don't work with this system configuration.)" + (The GNU allocators don't work with this system configuration)." elif test "$use_system_malloc" = "yes" ; then GNU_MALLOC=no GNU_MALLOC_reason=" - (User chose not to use GNU allocators.)" + (User chose not to use GNU allocators)." +elif test "$use_debug_malloc" = "yes" ; then + GNU_MALLOC=no + GNU_MALLOC_reason=" + (User chose to use Debugging Malloc)." fi # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2514: checking for $ac_word" >&5 +echo "configure:2539: checking for $ac_word" >&5 if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. @@ -2563,7 +2588,7 @@ # SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" # ./install, which can be erroneously created by make from ./install.sh. echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6 -echo "configure:2567: checking for a BSD compatible install" >&5 +echo "configure:2592: checking for a BSD compatible install" >&5 if test -z "$INSTALL"; then IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS="${IFS}:" @@ -2614,7 +2639,7 @@ # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 echo $ac_n "checking for $ac_word""... $ac_c" 1>&6 -echo "configure:2618: checking for $ac_word" >&5 +echo "configure:2643: checking for $ac_word" >&5 if test -n "$YACC"; then ac_cv_prog_YACC="$YACC" # Let the user override the test. @@ -2645,15 +2670,15 @@ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:2649: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2657: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2682: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -2686,15 +2711,15 @@ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:2690: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2698: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2723: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -2727,15 +2752,15 @@ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:2731: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2739: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2764: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -2765,10 +2790,10 @@ done echo $ac_n "checking for sys/wait.h that is POSIX.1 compatible""... $ac_c" 1>&6 -echo "configure:2769: checking for sys/wait.h that is POSIX.1 compatible" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #include @@ -2784,7 +2809,7 @@ s = WIFEXITED (s) ? WEXITSTATUS (s) : 1; ; return 0; } EOF -if { (eval echo configure:2788: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2813: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_header_sys_wait_h=yes else @@ -2808,10 +2833,10 @@ fi echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6 -echo "configure:2812: checking for ANSI C header files" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #include @@ -2819,7 +2844,7 @@ #include EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:2823: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:2848: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -2836,7 +2861,7 @@ if test $ac_cv_header_stdc = yes; then # SunOS 4.x string.h does not declare mem*, contrary to ANSI. cat > conftest.$ac_ext < EOF @@ -2854,7 +2879,7 @@ if test $ac_cv_header_stdc = yes; then # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. cat > conftest.$ac_ext < EOF @@ -2872,7 +2897,7 @@ if test $ac_cv_header_stdc = yes; then # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. cat > conftest.$ac_ext < #define ISLOWER(c) ('a' <= (c) && (c) <= 'z') @@ -2883,7 +2908,7 @@ exit (0); } EOF -if { (eval echo configure:2887: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:2912: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then : else @@ -2908,10 +2933,10 @@ fi echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6 -echo "configure:2912: checking whether time.h and sys/time.h may both be included" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #include @@ -2920,7 +2945,7 @@ struct tm *tp; ; return 0; } EOF -if { (eval echo configure:2924: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2949: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_header_time=yes else @@ -2944,10 +2969,10 @@ fi echo $ac_n "checking for sys_siglist declaration in signal.h or unistd.h""... $ac_c" 1>&6 -echo "configure:2948: checking for sys_siglist declaration in signal.h or unistd.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #include @@ -2959,7 +2984,7 @@ char *msg = *(sys_siglist + 1); ; return 0; } EOF -if { (eval echo configure:2963: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:2988: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_decl_sys_siglist=yes else @@ -2984,9 +3009,9 @@ echo $ac_n "checking for struct utimbuf""... $ac_c" 1>&6 -echo "configure:2988: checking for struct utimbuf" >&5 -cat > conftest.$ac_ext <&5 +cat > conftest.$ac_ext < @@ -3005,7 +3030,7 @@ static struct utimbuf x; x.actime = x.modtime; ; return 0; } EOF -if { (eval echo configure:3009: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3034: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* echo "$ac_t""yes" 1>&6 { test "$extra_verbose" = "yes" && cat << \EOF @@ -3025,10 +3050,10 @@ rm -f conftest* echo $ac_n "checking return type of signal handlers""... $ac_c" 1>&6 -echo "configure:3029: checking return type of signal handlers" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #include @@ -3045,7 +3070,7 @@ int i; ; return 0; } EOF -if { (eval echo configure:3049: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3074: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_type_signal=void else @@ -3067,10 +3092,10 @@ echo $ac_n "checking for size_t""... $ac_c" 1>&6 -echo "configure:3071: checking for size_t" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #if STDC_HEADERS @@ -3101,10 +3126,10 @@ fi echo $ac_n "checking for pid_t""... $ac_c" 1>&6 -echo "configure:3105: checking for pid_t" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #if STDC_HEADERS @@ -3135,10 +3160,10 @@ fi echo $ac_n "checking for uid_t in sys/types.h""... $ac_c" 1>&6 -echo "configure:3139: checking for uid_t in sys/types.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF @@ -3174,10 +3199,10 @@ fi echo $ac_n "checking for mode_t""... $ac_c" 1>&6 -echo "configure:3178: checking for mode_t" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #if STDC_HEADERS @@ -3208,10 +3233,10 @@ fi echo $ac_n "checking for off_t""... $ac_c" 1>&6 -echo "configure:3212: checking for off_t" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #if STDC_HEADERS @@ -3243,9 +3268,9 @@ echo $ac_n "checking for struct timeval""... $ac_c" 1>&6 -echo "configure:3247: checking for struct timeval" >&5 -cat > conftest.$ac_ext <&5 +cat > conftest.$ac_ext < @@ -3261,7 +3286,7 @@ static struct timeval x; x.tv_sec = x.tv_usec; ; return 0; } EOF -if { (eval echo configure:3265: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3290: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* echo "$ac_t""yes" 1>&6 HAVE_TIMEVAL=yes @@ -3283,10 +3308,10 @@ rm -f conftest* echo $ac_n "checking whether struct tm is in sys/time.h or time.h""... $ac_c" 1>&6 -echo "configure:3287: checking whether struct tm is in sys/time.h or time.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #include @@ -3294,7 +3319,7 @@ struct tm *tp; tp->tm_sec; ; return 0; } EOF -if { (eval echo configure:3298: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3323: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_tm=time.h else @@ -3318,10 +3343,10 @@ fi echo $ac_n "checking for tm_zone in struct tm""... $ac_c" 1>&6 -echo "configure:3322: checking for tm_zone in struct tm" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #include <$ac_cv_struct_tm> @@ -3329,7 +3354,7 @@ struct tm tm; tm.tm_zone; ; return 0; } EOF -if { (eval echo configure:3333: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3358: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_struct_tm_zone=yes else @@ -3352,10 +3377,10 @@ else echo $ac_n "checking for tzname""... $ac_c" 1>&6 -echo "configure:3356: checking for tzname" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < #ifndef tzname /* For SGI. */ @@ -3365,7 +3390,7 @@ atoi(*tzname); ; return 0; } EOF -if { (eval echo configure:3369: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3394: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* ac_cv_var_tzname=yes else @@ -3391,10 +3416,10 @@ echo $ac_n "checking for working const""... $ac_c" 1>&6 -echo "configure:3395: checking for working const" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3472: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_const=yes else @@ -3468,7 +3493,7 @@ echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6 -echo "configure:3472: checking whether ${MAKE-make} sets \${MAKE}" >&5 +echo "configure:3497: checking whether ${MAKE-make} sets \${MAKE}" >&5 set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'` cat > conftestmake <<\EOF @@ -3493,12 +3518,12 @@ echo $ac_n "checking whether byte ordering is bigendian""... $ac_c" 1>&6 -echo "configure:3497: checking whether byte ordering is bigendian" >&5 +echo "configure:3522: checking whether byte ordering is bigendian" >&5 ac_cv_c_bigendian=unknown # See if sys/param.h defines the BYTE_ORDER macro. cat > conftest.$ac_ext < #include @@ -3509,11 +3534,11 @@ #endif ; return 0; } EOF -if { (eval echo configure:3513: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3538: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* # It does; now see whether it defined to BIG_ENDIAN or not. cat > conftest.$ac_ext < #include @@ -3524,7 +3549,7 @@ #endif ; return 0; } EOF -if { (eval echo configure:3528: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:3553: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_bigendian=yes else @@ -3541,7 +3566,7 @@ rm -f conftest* if test $ac_cv_c_bigendian = unknown; then cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3583: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_c_bigendian=no else @@ -3580,10 +3605,10 @@ echo $ac_n "checking size of short""... $ac_c" 1>&6 -echo "configure:3584: checking size of short" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < main() @@ -3594,7 +3619,7 @@ exit(0); } EOF -if { (eval echo configure:3598: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3623: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_sizeof_short=`cat conftestval` else @@ -3621,10 +3646,10 @@ exit 1 fi echo $ac_n "checking size of int""... $ac_c" 1>&6 -echo "configure:3625: checking size of int" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < main() @@ -3635,7 +3660,7 @@ exit(0); } EOF -if { (eval echo configure:3639: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3664: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_sizeof_int=`cat conftestval` else @@ -3656,10 +3681,10 @@ echo $ac_n "checking size of long""... $ac_c" 1>&6 -echo "configure:3660: checking size of long" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < main() @@ -3670,7 +3695,7 @@ exit(0); } EOF -if { (eval echo configure:3674: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3699: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_sizeof_long=`cat conftestval` else @@ -3691,10 +3716,10 @@ echo $ac_n "checking size of long long""... $ac_c" 1>&6 -echo "configure:3695: checking size of long long" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < main() @@ -3705,7 +3730,7 @@ exit(0); } EOF -if { (eval echo configure:3709: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3734: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_sizeof_long_long=`cat conftestval` else @@ -3726,10 +3751,10 @@ echo $ac_n "checking size of void *""... $ac_c" 1>&6 -echo "configure:3730: checking size of void *" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < main() @@ -3740,7 +3765,7 @@ exit(0); } EOF -if { (eval echo configure:3744: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:3769: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ac_cv_sizeof_void_p=`cat conftestval` else @@ -3762,7 +3787,7 @@ echo $ac_n "checking for long file names""... $ac_c" 1>&6 -echo "configure:3766: checking for long file names" >&5 +echo "configure:3791: checking for long file names" >&5 ac_cv_sys_long_file_names=yes # Test for long file names in all the places we know might matter: @@ -3809,12 +3834,12 @@ echo $ac_n "checking for sqrt in -lm""... $ac_c" 1>&6 -echo "configure:3813: checking for sqrt in -lm" >&5 +echo "configure:3838: checking for sqrt in -lm" >&5 ac_lib_var=`echo m'_'sqrt | sed 'y%./+-%__p_%'` xe_check_libs=" -lm " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3854: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -3857,7 +3882,6 @@ - { test "$extra_verbose" = "yes" && cat << \EOF Defining LISP_FLOAT_TYPE EOF @@ -3868,7 +3892,7 @@ echo "checking type of mail spool file locking" 1>&6 -echo "configure:3872: checking type of mail spool file locking" >&5 +echo "configure:3896: checking type of mail spool file locking" >&5 test -z "$mail_locking" -a "$mail_use_flock" = "yes" && mail_locking=flock test -z "$mail_locking" -a "$mail_use_lockf" = "yes" && mail_locking=lockf if test "$mail_locking" = "lockf"; then { test "$extra_verbose" = "yes" && cat << \EOF @@ -3892,12 +3916,12 @@ echo $ac_n "checking for kstat_open in -lkstat""... $ac_c" 1>&6 -echo "configure:3896: checking for kstat_open in -lkstat" >&5 +echo "configure:3920: checking for kstat_open in -lkstat" >&5 ac_lib_var=`echo kstat'_'kstat_open | sed 'y%./+-%__p_%'` xe_check_libs=" -lkstat " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3936: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -3942,12 +3966,12 @@ echo $ac_n "checking for kvm_read in -lkvm""... $ac_c" 1>&6 -echo "configure:3946: checking for kvm_read in -lkvm" >&5 +echo "configure:3970: checking for kvm_read in -lkvm" >&5 ac_lib_var=`echo kvm'_'kvm_read | sed 'y%./+-%__p_%'` xe_check_libs=" -lkvm " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:3986: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -3992,12 +4016,12 @@ echo $ac_n "checking for cma_open in -lpthreads""... $ac_c" 1>&6 -echo "configure:3996: checking for cma_open in -lpthreads" >&5 +echo "configure:4020: checking for cma_open in -lpthreads" >&5 ac_lib_var=`echo pthreads'_'cma_open | sed 'y%./+-%__p_%'` xe_check_libs=" -lpthreads " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4036: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4044,7 +4068,7 @@ fi echo $ac_n "checking whether the -xildoff compiler flag is required""... $ac_c" 1>&6 -echo "configure:4048: checking whether the -xildoff compiler flag is required" >&5 +echo "configure:4072: checking whether the -xildoff compiler flag is required" >&5 if ${CC-cc} '-###' -xildon no_such_file.c 2>&1 | grep '^[^ ]*/ild ' > /dev/null ; then if ${CC-cc} '-###' -xildoff no_such_file.c 2>&1 | grep '^[^ ]*/ild ' > /dev/null ; then echo "$ac_t""no" 1>&6; @@ -4055,7 +4079,7 @@ if test "$opsys" = "sol2" && test "$OS_RELEASE" -ge 56; then echo $ac_n "checking for \"-z ignore\" linker flag""... $ac_c" 1>&6 -echo "configure:4059: checking for \"-z ignore\" linker flag" >&5 +echo "configure:4083: checking for \"-z ignore\" linker flag" >&5 case "`ld -h 2>&1`" in *-z\ ignore\|record* ) echo "$ac_t""yes" 1>&6 ld_switch_site="-z ignore $ld_switch_site" && if test "$extra_verbose" = "yes"; then echo " Prepending \"-z ignore\" to \$ld_switch_site"; fi ;; @@ -4065,7 +4089,7 @@ echo "checking "for specified window system"" 1>&6 -echo "configure:4069: checking "for specified window system"" >&5 +echo "configure:4093: checking "for specified window system"" >&5 if test "$x_includes $x_libraries" = "NONE NONE"; then if test -n "$OPENWINHOME" \ @@ -4086,7 +4110,7 @@ # Uses ac_ vars as temps to allow command line to override cache and checks. # --without-x overrides everything else, but does not touch the cache. echo $ac_n "checking for X""... $ac_c" 1>&6 -echo "configure:4090: checking for X" >&5 +echo "configure:4114: checking for X" >&5 # Check whether --with-x or --without-x was given. if test "${with_x+set}" = set; then @@ -4146,12 +4170,12 @@ # First, try using that file with no special directory specified. cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:4155: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:4179: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -4220,14 +4244,14 @@ ac_save_LIBS="$LIBS" LIBS="-l$x_direct_test_library $LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4255: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* LIBS="$ac_save_LIBS" # We can link X programs with no special library path. @@ -4336,17 +4360,17 @@ case "`(uname -sr) 2>/dev/null`" in "SunOS 5"*) echo $ac_n "checking whether -R must be followed by a space""... $ac_c" 1>&6 -echo "configure:4340: checking whether -R must be followed by a space" >&5 +echo "configure:4364: checking whether -R must be followed by a space" >&5 ac_xsave_LIBS="$LIBS"; LIBS="$LIBS -R$x_libraries" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4374: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* ac_R_nospace=yes else @@ -4362,14 +4386,14 @@ else LIBS="$ac_xsave_LIBS -R $x_libraries" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4397: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* ac_R_space=yes else @@ -4405,12 +4429,12 @@ else echo $ac_n "checking for dnet_ntoa in -ldnet""... $ac_c" 1>&6 -echo "configure:4409: checking for dnet_ntoa in -ldnet" >&5 +echo "configure:4433: checking for dnet_ntoa in -ldnet" >&5 ac_lib_var=`echo dnet'_'dnet_ntoa | sed 'y%./+-%__p_%'` xe_check_libs=" -ldnet " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4449: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4445,12 +4469,12 @@ if test $ac_cv_lib_dnet_dnet_ntoa = no; then echo $ac_n "checking for dnet_ntoa in -ldnet_stub""... $ac_c" 1>&6 -echo "configure:4449: checking for dnet_ntoa in -ldnet_stub" >&5 +echo "configure:4473: checking for dnet_ntoa in -ldnet_stub" >&5 ac_lib_var=`echo dnet_stub'_'dnet_ntoa | sed 'y%./+-%__p_%'` xe_check_libs=" -ldnet_stub " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4489: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4490,10 +4514,10 @@ # The nsl library prevents programs from opening the X display # on Irix 5.2, according to dickey@clark.net. echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6 -echo "configure:4494: checking for gethostbyname" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4544: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_gethostbyname=yes" else @@ -4537,12 +4561,12 @@ if test $ac_cv_func_gethostbyname = no; then echo $ac_n "checking for gethostbyname in -lnsl""... $ac_c" 1>&6 -echo "configure:4541: checking for gethostbyname in -lnsl" >&5 +echo "configure:4565: checking for gethostbyname in -lnsl" >&5 ac_lib_var=`echo nsl'_'gethostbyname | sed 'y%./+-%__p_%'` xe_check_libs=" -lnsl " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4581: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4583,10 +4607,10 @@ # -lsocket must be given before -lnsl if both are needed. # We assume that if connect needs -lnsl, so does gethostbyname. echo $ac_n "checking for connect""... $ac_c" 1>&6 -echo "configure:4587: checking for connect" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4637: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_connect=yes" else @@ -4632,12 +4656,12 @@ xe_msg_checking="for connect in -lsocket" test -n "$X_EXTRA_LIBS" && xe_msg_checking="$xe_msg_checking using extra libs $X_EXTRA_LIBS" echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 -echo "configure:4636: checking "$xe_msg_checking"" >&5 +echo "configure:4660: checking "$xe_msg_checking"" >&5 ac_lib_var=`echo socket'_'connect | sed 'y%./+-%__p_%'` xe_check_libs=" -lsocket $X_EXTRA_LIBS" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4676: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4672,10 +4696,10 @@ # gomez@mi.uni-erlangen.de says -lposix is necessary on A/UX. echo $ac_n "checking for remove""... $ac_c" 1>&6 -echo "configure:4676: checking for remove" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4726: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_remove=yes" else @@ -4719,12 +4743,12 @@ if test $ac_cv_func_remove = no; then echo $ac_n "checking for remove in -lposix""... $ac_c" 1>&6 -echo "configure:4723: checking for remove in -lposix" >&5 +echo "configure:4747: checking for remove in -lposix" >&5 ac_lib_var=`echo posix'_'remove | sed 'y%./+-%__p_%'` xe_check_libs=" -lposix " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4763: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4759,10 +4783,10 @@ # BSDI BSD/OS 2.1 needs -lipc for XOpenDisplay. echo $ac_n "checking for shmat""... $ac_c" 1>&6 -echo "configure:4763: checking for shmat" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4813: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_shmat=yes" else @@ -4806,12 +4830,12 @@ if test $ac_cv_func_shmat = no; then echo $ac_n "checking for shmat in -lipc""... $ac_c" 1>&6 -echo "configure:4810: checking for shmat in -lipc" >&5 +echo "configure:4834: checking for shmat in -lipc" >&5 ac_lib_var=`echo ipc'_'shmat | sed 'y%./+-%__p_%'` xe_check_libs=" -lipc " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4850: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -4856,12 +4880,12 @@ # --interran@uluru.Stanford.EDU, kb@cs.umb.edu. echo $ac_n "checking for IceConnectionNumber in -lICE""... $ac_c" 1>&6 -echo "configure:4860: checking for IceConnectionNumber in -lICE" >&5 +echo "configure:4884: checking for IceConnectionNumber in -lICE" >&5 ac_lib_var=`echo ICE'_'IceConnectionNumber | sed 'y%./+-%__p_%'` xe_check_libs=" -lICE " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:4900: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5005,7 +5029,7 @@ fi echo "checking for X defines extracted by xmkmf" 1>&6 -echo "configure:5009: checking for X defines extracted by xmkmf" >&5 +echo "configure:5033: checking for X defines extracted by xmkmf" >&5 rm -fr conftestdir if mkdir conftestdir; then cd conftestdir @@ -5037,15 +5061,15 @@ ac_safe=`echo "X11/Intrinsic.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for X11/Intrinsic.h""... $ac_c" 1>&6 -echo "configure:5041: checking for X11/Intrinsic.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5049: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5073: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5069,12 +5093,12 @@ echo $ac_n "checking for XOpenDisplay in -lX11""... $ac_c" 1>&6 -echo "configure:5073: checking for XOpenDisplay in -lX11" >&5 +echo "configure:5097: checking for XOpenDisplay in -lX11" >&5 ac_lib_var=`echo X11'_'XOpenDisplay | sed 'y%./+-%__p_%'` xe_check_libs=" -lX11 " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5113: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5110,12 +5134,12 @@ xe_msg_checking="for XGetFontProperty in -lX11" test -n "-b i486-linuxaout" && xe_msg_checking="$xe_msg_checking using extra libs -b i486-linuxaout" echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 -echo "configure:5114: checking "$xe_msg_checking"" >&5 +echo "configure:5138: checking "$xe_msg_checking"" >&5 ac_lib_var=`echo X11'_'XGetFontProperty | sed 'y%./+-%__p_%'` xe_check_libs=" -lX11 -b i486-linuxaout" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5154: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5153,12 +5177,12 @@ echo $ac_n "checking for XShapeSelectInput in -lXext""... $ac_c" 1>&6 -echo "configure:5157: checking for XShapeSelectInput in -lXext" >&5 +echo "configure:5181: checking for XShapeSelectInput in -lXext" >&5 ac_lib_var=`echo Xext'_'XShapeSelectInput | sed 'y%./+-%__p_%'` xe_check_libs=" -lXext " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5197: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5192,12 +5216,12 @@ echo $ac_n "checking for XtOpenDisplay in -lXt""... $ac_c" 1>&6 -echo "configure:5196: checking for XtOpenDisplay in -lXt" >&5 +echo "configure:5220: checking for XtOpenDisplay in -lXt" >&5 ac_lib_var=`echo Xt'_'XtOpenDisplay | sed 'y%./+-%__p_%'` xe_check_libs=" -lXt " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5236: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5231,14 +5255,14 @@ echo $ac_n "checking the version of X11 being used""... $ac_c" 1>&6 -echo "configure:5235: checking the version of X11 being used" >&5 +echo "configure:5259: checking the version of X11 being used" >&5 cat > conftest.$ac_ext < main(int c, char* v[]) { return c>1 ? XlibSpecificationRelease : 0; } EOF -if { (eval echo configure:5242: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:5266: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ./conftest foobar; x11_release=$? else @@ -5262,15 +5286,15 @@ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:5266: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5274: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5298: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5301,7 +5325,7 @@ echo $ac_n "checking for XFree86""... $ac_c" 1>&6 -echo "configure:5305: checking for XFree86" >&5 +echo "configure:5329: checking for XFree86" >&5 if test -d "/usr/X386/include" -o \ -f "/etc/XF86Config" -o \ -f "/etc/X11/XF86Config" -o \ @@ -5321,12 +5345,12 @@ test -z "$with_xmu" && { echo $ac_n "checking for XmuReadBitmapDataFromFile in -lXmu""... $ac_c" 1>&6 -echo "configure:5325: checking for XmuReadBitmapDataFromFile in -lXmu" >&5 +echo "configure:5349: checking for XmuReadBitmapDataFromFile in -lXmu" >&5 ac_lib_var=`echo Xmu'_'XmuReadBitmapDataFromFile | sed 'y%./+-%__p_%'` xe_check_libs=" -lXmu " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5365: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5367,19 +5391,19 @@ echo $ac_n "checking for main in -lXbsd""... $ac_c" 1>&6 -echo "configure:5371: checking for main in -lXbsd" >&5 +echo "configure:5395: checking for main in -lXbsd" >&5 ac_lib_var=`echo Xbsd'_'main | sed 'y%./+-%__p_%'` xe_check_libs=" -lXbsd " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5407: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5402,12 +5426,12 @@ echo $ac_n "checking for XawScrollbarSetThumb in -lXaw""... $ac_c" 1>&6 -echo "configure:5406: checking for XawScrollbarSetThumb in -lXaw" >&5 +echo "configure:5430: checking for XawScrollbarSetThumb in -lXaw" >&5 ac_lib_var=`echo Xaw'_'XawScrollbarSetThumb | sed 'y%./+-%__p_%'` xe_check_libs=" -lXaw " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5446: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5442,15 +5466,15 @@ if test "$have_xaw" = "yes"; then ac_safe=`echo "X11/Xaw/Reports.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for X11/Xaw/Reports.h""... $ac_c" 1>&6 -echo "configure:5446: checking for X11/Xaw/Reports.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5454: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5478: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5481,7 +5505,7 @@ if test "$with_tty" = "no" ; then { echo "configure: error: No window system support and no TTY support - Unable to proceed." 1>&2; exit 1; } fi - for feature in tooltalk cde offix \ + for feature in tooltalk cde offix wm \ menubars scrollbars toolbars dialogs xim xmu \ tiff png jpeg gif compface xpm do @@ -5506,18 +5530,31 @@ test "$opsys" = "hpux9-shr" && opsysfile="s/hpux9shxr4.h" esac +echo "checking for WindowMaker option" 1>&6 +echo "configure:5535: checking for WindowMaker option" >&5; +if test "$with_wm" = "yes"; then + { test "$extra_verbose" = "yes" && cat << \EOF + Defining HAVE_WINDOWMAKER +EOF +cat >> confdefs.h <<\EOF +#define HAVE_WINDOWMAKER 1 +EOF +} + +fi + test -z "$with_xauth" && test "$window_system" = "none" && with_xauth=no test -z "$with_xauth" && { ac_safe=`echo "X11/Xauth.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for X11/Xauth.h""... $ac_c" 1>&6 -echo "configure:5513: checking for X11/Xauth.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5521: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5558: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5540,12 +5577,12 @@ } test -z "$with_xauth" && { echo $ac_n "checking for XauGetAuthByAddr in -lXau""... $ac_c" 1>&6 -echo "configure:5544: checking for XauGetAuthByAddr in -lXau" >&5 +echo "configure:5581: checking for XauGetAuthByAddr in -lXau" >&5 ac_lib_var=`echo Xau'_'XauGetAuthByAddr | sed 'y%./+-%__p_%'` xe_check_libs=" -lXau " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5597: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5597,15 +5634,15 @@ test -z "$with_offix" && { ac_safe=`echo "OffiX/DragAndDrop.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for OffiX/DragAndDrop.h""... $ac_c" 1>&6 -echo "configure:5601: checking for OffiX/DragAndDrop.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5609: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5646: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5628,12 +5665,12 @@ } test -z "$with_offix" && { echo $ac_n "checking for DndInitialize in -lDnd""... $ac_c" 1>&6 -echo "configure:5632: checking for DndInitialize in -lDnd" >&5 +echo "configure:5669: checking for DndInitialize in -lDnd" >&5 ac_lib_var=`echo Dnd'_'DndInitialize | sed 'y%./+-%__p_%'` xe_check_libs=" -lDnd " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5685: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5683,15 +5720,15 @@ for dir in "" "Tt/" "desktop/" ; do ac_safe=`echo "${dir}tt_c.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for ${dir}tt_c.h""... $ac_c" 1>&6 -echo "configure:5687: checking for ${dir}tt_c.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5695: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5732: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5720,12 +5757,12 @@ xe_msg_checking="for tt_message_create in -ltt" test -n "$extra_libs" && xe_msg_checking="$xe_msg_checking using extra libs $extra_libs" echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 -echo "configure:5724: checking "$xe_msg_checking"" >&5 +echo "configure:5761: checking "$xe_msg_checking"" >&5 ac_lib_var=`echo tt'_'tt_message_create | sed 'y%./+-%__p_%'` xe_check_libs=" -ltt $extra_libs" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5777: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5785,15 +5822,15 @@ test -z "$with_cde" && { ac_safe=`echo "Dt/Dt.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for Dt/Dt.h""... $ac_c" 1>&6 -echo "configure:5789: checking for Dt/Dt.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5797: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:5834: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -5816,12 +5853,12 @@ } test -z "$with_cde" && { echo $ac_n "checking for DtDndDragStart in -lDtSvc""... $ac_c" 1>&6 -echo "configure:5820: checking for DtDndDragStart in -lDtSvc" >&5 +echo "configure:5857: checking for DtDndDragStart in -lDtSvc" >&5 ac_lib_var=`echo DtSvc'_'DtDndDragStart | sed 'y%./+-%__p_%'` xe_check_libs=" -lDtSvc " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5873: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5879,19 +5916,19 @@ echo $ac_n "checking for main in -lenergize""... $ac_c" 1>&6 -echo "configure:5883: checking for main in -lenergize" >&5 +echo "configure:5920: checking for main in -lenergize" >&5 ac_lib_var=`echo energize'_'main | sed 'y%./+-%__p_%'` xe_check_libs=" -lenergize " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5932: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5923,19 +5960,19 @@ if test -z "$energize_version"; then echo $ac_n "checking for main in -lconn""... $ac_c" 1>&6 -echo "configure:5927: checking for main in -lconn" >&5 +echo "configure:5964: checking for main in -lconn" >&5 ac_lib_var=`echo conn'_'main | sed 'y%./+-%__p_%'` xe_check_libs=" -lconn " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:5976: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -5968,15 +6005,15 @@ fi ac_safe=`echo "editorconn.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for editorconn.h""... $ac_c" 1>&6 -echo "configure:5972: checking for editorconn.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:5980: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6017: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6018,7 +6055,7 @@ echo "checking for graphics libraries" 1>&6 -echo "configure:6022: checking for graphics libraries" >&5 +echo "configure:6059: checking for graphics libraries" >&5 test -z "$with_gif" && with_gif=yes; if test "$with_gif" = "yes"; then { test "$extra_verbose" = "yes" && cat << \EOF @@ -6035,10 +6072,10 @@ fi echo $ac_n "checking for Xpm - no older than 3.4f""... $ac_c" 1>&6 -echo "configure:6039: checking for Xpm - no older than 3.4f" >&5 +echo "configure:6076: checking for Xpm - no older than 3.4f" >&5 xe_check_libs=-lXpm test -z "$with_xpm" && { cat > conftest.$ac_ext < int main(int c, char **v) { @@ -6048,7 +6085,7 @@ 0 ; } EOF -if { (eval echo configure:6052: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:6089: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then ./conftest foobar; xpm_status=$?; if test "$xpm_status" = "0"; then with_xpm=yes; else with_xpm=no; fi; @@ -6086,15 +6123,15 @@ test -z "$with_xface" && { ac_safe=`echo "compface.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for compface.h""... $ac_c" 1>&6 -echo "configure:6090: checking for compface.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6098: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6135: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6117,12 +6154,12 @@ } test -z "$with_xface" && { echo $ac_n "checking for UnGenFace in -lcompface""... $ac_c" 1>&6 -echo "configure:6121: checking for UnGenFace in -lcompface" >&5 +echo "configure:6158: checking for UnGenFace in -lcompface" >&5 ac_lib_var=`echo compface'_'UnGenFace | sed 'y%./+-%__p_%'` xe_check_libs=" -lcompface " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6174: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6169,15 +6206,15 @@ test -z "$with_jpeg" && { ac_safe=`echo "jpeglib.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for jpeglib.h""... $ac_c" 1>&6 -echo "configure:6173: checking for jpeglib.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6181: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6218: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6200,12 +6237,12 @@ } test -z "$with_jpeg" && { echo $ac_n "checking for jpeg_destroy_decompress in -ljpeg""... $ac_c" 1>&6 -echo "configure:6204: checking for jpeg_destroy_decompress in -ljpeg" >&5 +echo "configure:6241: checking for jpeg_destroy_decompress in -ljpeg" >&5 ac_lib_var=`echo jpeg'_'jpeg_destroy_decompress | sed 'y%./+-%__p_%'` xe_check_libs=" -ljpeg " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6257: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6252,15 +6289,15 @@ test -z "$with_png" && { ac_safe=`echo "png.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for png.h""... $ac_c" 1>&6 -echo "configure:6256: checking for png.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6264: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6301: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6282,10 +6319,10 @@ fi } test -z "$with_png" && { echo $ac_n "checking for pow""... $ac_c" 1>&6 -echo "configure:6286: checking for pow" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6349: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_pow=yes" else @@ -6333,12 +6370,12 @@ xe_msg_checking="for png_read_image in -lpng" test -n "$extra_libs" && xe_msg_checking="$xe_msg_checking using extra libs $extra_libs" echo $ac_n "checking "$xe_msg_checking"""... $ac_c" 1>&6 -echo "configure:6337: checking "$xe_msg_checking"" >&5 +echo "configure:6374: checking "$xe_msg_checking"" >&5 ac_lib_var=`echo png'_'png_read_image | sed 'y%./+-%__p_%'` xe_check_libs=" -lpng $extra_libs" cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6390: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6399,15 +6436,15 @@ ac_safe=`echo "Xm/Xm.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for Xm/Xm.h""... $ac_c" 1>&6 -echo "configure:6403: checking for Xm/Xm.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6411: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6448: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6424,12 +6461,12 @@ echo "$ac_t""yes" 1>&6 echo $ac_n "checking for XmStringFree in -lXm""... $ac_c" 1>&6 -echo "configure:6428: checking for XmStringFree in -lXm" >&5 +echo "configure:6465: checking for XmStringFree in -lXm" >&5 ac_lib_var=`echo Xm'_'XmStringFree | sed 'y%./+-%__p_%'` xe_check_libs=" -lXm " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6481: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6688,7 +6725,7 @@ if test "$with_mule" = "yes" ; then echo "checking for Mule-related features" 1>&6 -echo "configure:6692: checking for Mule-related features" >&5 +echo "configure:6729: checking for Mule-related features" >&5 { test "$extra_verbose" = "yes" && cat << \EOF Defining MULE EOF @@ -6705,15 +6742,15 @@ do ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'` echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6 -echo "configure:6709: checking for $ac_hdr" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6717: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6754: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6744,12 +6781,12 @@ echo $ac_n "checking for strerror in -lintl""... $ac_c" 1>&6 -echo "configure:6748: checking for strerror in -lintl" >&5 +echo "configure:6785: checking for strerror in -lintl" >&5 ac_lib_var=`echo intl'_'strerror | sed 'y%./+-%__p_%'` xe_check_libs=" -lintl " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6801: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6793,19 +6830,19 @@ echo "checking for Mule input methods" 1>&6 -echo "configure:6797: checking for Mule input methods" >&5 +echo "configure:6834: checking for Mule input methods" >&5 test -z "$with_xim" -a "$opsys" != "sol2" && with_xim=no case "$with_xim" in "" | "yes" ) echo "checking for XIM" 1>&6 -echo "configure:6801: checking for XIM" >&5 +echo "configure:6838: checking for XIM" >&5 echo $ac_n "checking for XmImMbLookupString in -lXm""... $ac_c" 1>&6 -echo "configure:6804: checking for XmImMbLookupString in -lXm" >&5 +echo "configure:6841: checking for XmImMbLookupString in -lXm" >&5 ac_lib_var=`echo Xm'_'XmImMbLookupString | sed 'y%./+-%__p_%'` xe_check_libs=" -lXm " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:6857: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -6874,19 +6911,78 @@ echo " xemacs will be linked with \"input-method-motif.o\"" fi fi + if test "$with_xfs" = "yes"; then + with_xfs=no + fi + else case "$with_xfs" in "yes" ) + echo "checking for XFontSet" 1>&6 +echo "configure:6920: checking for XFontSet" >&5 + +echo $ac_n "checking for XmbDrawString in -lX11""... $ac_c" 1>&6 +echo "configure:6923: checking for XmbDrawString in -lX11" >&5 +ac_lib_var=`echo X11'_'XmbDrawString | sed 'y%./+-%__p_%'` + +xe_check_libs=" -lX11 " +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=yes" +else + echo "configure: failed program was:" >&5 + cat conftest.$ac_ext >&5 + rm -rf conftest* + eval "ac_cv_lib_$ac_lib_var=no" +fi +rm -f conftest* +xe_check_libs="" + +if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then + echo "$ac_t""yes" 1>&6 + : +else + echo "$ac_t""no" 1>&6 +with_xfs=no +fi + + + esac + if test "$with_xfs" = "yes" && test "$with_menubars" = "lucid"; then + { test "$extra_verbose" = "yes" && cat << \EOF + Defining USE_XFONTSET +EOF +cat >> confdefs.h <<\EOF +#define USE_XFONTSET 1 +EOF +} + + extra_objs="$extra_objs input-method-xfs.o" && if test "$extra_verbose" = "yes"; then + echo " xemacs will be linked with \"input-method-xfs.o\"" + fi + fi fi test "$with_wnn6" = "yes" && with_wnn=yes # wnn6 implies wnn support test -z "$with_wnn" && { ac_safe=`echo "wnn/jllib.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for wnn/jllib.h""... $ac_c" 1>&6 -echo "configure:6882: checking for wnn/jllib.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:6890: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:6986: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -6911,10 +7007,10 @@ for ac_func in crypt do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:6915: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7037: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -6966,12 +7062,12 @@ test "$ac_cv_func_crypt" != "yes" && { echo $ac_n "checking for crypt in -lcrypt""... $ac_c" 1>&6 -echo "configure:6970: checking for crypt in -lcrypt" >&5 +echo "configure:7066: checking for crypt in -lcrypt" >&5 ac_lib_var=`echo crypt'_'crypt | sed 'y%./+-%__p_%'` xe_check_libs=" -lcrypt " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7082: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -7016,12 +7112,12 @@ fi test -z "$with_wnn" && { echo $ac_n "checking for jl_dic_list_e in -lwnn""... $ac_c" 1>&6 -echo "configure:7020: checking for jl_dic_list_e in -lwnn" >&5 +echo "configure:7116: checking for jl_dic_list_e in -lwnn" >&5 ac_lib_var=`echo wnn'_'jl_dic_list_e | sed 'y%./+-%__p_%'` xe_check_libs=" -lwnn " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7132: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -7069,12 +7165,12 @@ fi echo $ac_n "checking for jl_fi_dic_list in -lwnn""... $ac_c" 1>&6 -echo "configure:7073: checking for jl_fi_dic_list in -lwnn" >&5 +echo "configure:7169: checking for jl_fi_dic_list in -lwnn" >&5 ac_lib_var=`echo wnn'_'jl_fi_dic_list | sed 'y%./+-%__p_%'` xe_check_libs=" -lwnn " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7185: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -7117,15 +7213,15 @@ test -z "$with_canna" && { ac_safe=`echo "canna/RK.h" | sed 'y%./+-%__p_%'` echo $ac_n "checking for canna/RK.h""... $ac_c" 1>&6 -echo "configure:7121: checking for canna/RK.h" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext < EOF ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out" -{ (eval echo configure:7129: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } +{ (eval echo configure:7225: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; } ac_err=`grep -v '^ *+' conftest.out` if test -z "$ac_err"; then rm -rf conftest* @@ -7148,12 +7244,12 @@ } test -z "$with_canna" && { echo $ac_n "checking for RkBgnBun in -lRKC""... $ac_c" 1>&6 -echo "configure:7152: checking for RkBgnBun in -lRKC" >&5 +echo "configure:7248: checking for RkBgnBun in -lRKC" >&5 ac_lib_var=`echo RKC'_'RkBgnBun | sed 'y%./+-%__p_%'` xe_check_libs=" -lRKC " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7264: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -7187,12 +7283,12 @@ } test -z "$with_canna" && { echo $ac_n "checking for jrKanjiControl in -lcanna""... $ac_c" 1>&6 -echo "configure:7191: checking for jrKanjiControl in -lcanna" >&5 +echo "configure:7287: checking for jrKanjiControl in -lcanna" >&5 ac_lib_var=`echo canna'_'jrKanjiControl | sed 'y%./+-%__p_%'` xe_check_libs=" -lcanna " cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7303: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_lib_$ac_lib_var=yes" else @@ -7303,10 +7399,10 @@ for ac_func in acosh asinh atanh cbrt closedir dup2 eaccess fmod fpathconf frexp ftime gethostname getpagesize gettimeofday getcwd getwd logb lrand48 matherr mkdir mktime perror poll random rename res_init rint rmdir select setitimer setpgid setlocale setsid sigblock sighold sigprocmask strcasecmp strerror tzset ulimit usleep utimes waitpid do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:7307: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7429: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -7366,10 +7462,10 @@ for ac_func in realpath do echo $ac_n "checking for $ac_func""... $ac_c" 1>&6 -echo "configure:7370: checking for $ac_func" >&5 - -cat > conftest.$ac_ext <&5 + +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7492: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* eval "ac_cv_func_$ac_func=yes" else @@ -7425,16 +7521,16 @@ esac echo $ac_n "checking whether netdb declares h_errno""... $ac_c" 1>&6 -echo "configure:7429: checking whether netdb declares h_errno" >&5 -cat > conftest.$ac_ext <&5 +cat > conftest.$ac_ext < int main() { return h_errno; ; return 0; } EOF -if { (eval echo configure:7438: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7534: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* echo "$ac_t""yes" 1>&6 { test "$extra_verbose" = "yes" && cat << \EOF @@ -7454,16 +7550,16 @@ rm -f conftest* echo $ac_n "checking for sigsetjmp""... $ac_c" 1>&6 -echo "configure:7458: checking for sigsetjmp" >&5 -cat > conftest.$ac_ext <&5 +cat > conftest.$ac_ext < int main() { sigjmp_buf bar; sigsetjmp (bar, 0); ; return 0; } EOF -if { (eval echo configure:7467: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:7563: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* echo "$ac_t""yes" 1>&6 { test "$extra_verbose" = "yes" && cat << \EOF @@ -7483,11 +7579,11 @@ rm -f conftest* echo $ac_n "checking whether localtime caches TZ""... $ac_c" 1>&6 -echo "configure:7487: checking whether localtime caches TZ" >&5 +echo "configure:7583: checking whether localtime caches TZ" >&5 if test "$ac_cv_func_tzset" = "yes"; then cat > conftest.$ac_ext < #if STDC_HEADERS @@ -7522,7 +7618,7 @@ exit (0); } EOF -if { (eval echo configure:7526: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 +if { (eval echo configure:7622: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest && (./conftest; exit) 2>&5 then emacs_cv_localtime_cache=no else @@ -7551,9 +7647,9 @@ if test "$HAVE_TIMEVAL" = "yes"; then echo $ac_n "checking whether gettimeofday cannot accept two arguments""... $ac_c" 1>&6 -echo "configure:7555: checking whether gettimeofday cannot accept two arguments" >&5 -cat > conftest.$ac_ext <&5 +cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then +if { (eval echo configure:7675: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then rm -rf conftest* echo "$ac_t""no" 1>&6 else @@ -7597,19 +7693,19 @@ echo $ac_n "checking for inline""... $ac_c" 1>&6 -echo "configure:7601: checking for inline" >&5 +echo "configure:7697: checking for inline" >&5 ac_cv_c_inline=no for ac_kw in inline __inline__ __inline; do cat > conftest.$ac_ext <&5; (eval $ac_compile) 2>&5; }; then +if { (eval echo configure:7709: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then rm -rf conftest* ac_cv_c_inline=$ac_kw; break else @@ -7655,102 +7751,6 @@ fi fi -case "$opsys" in hpux* ) - echo $ac_n "checking for alloca""... $ac_c" 1>&6 -echo "configure:7661: checking for alloca" >&5 - -cat > conftest.$ac_ext < -/* Override any gcc2 internal prototype to avoid an error. */ -/* We use char because int might match the return type of a gcc2 - builtin and then its argument prototype would still apply. */ -char alloca(); - -int main() { - -/* The GNU C library defines this for functions which it implements - to always fail with ENOSYS. Some functions are actually named - something starting with __ and the normal name is an alias. */ -#if defined (__stub_alloca) || defined (__stub___alloca) -choke me -#else -alloca(); -#endif - -; return 0; } -EOF -if { (eval echo configure:7687: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_func_alloca=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_func_alloca=no" -fi -rm -f conftest* - -if eval "test \"`echo '$ac_cv_func_'alloca`\" = yes"; then - echo "$ac_t""yes" 1>&6 - : -else - echo "$ac_t""no" 1>&6 - -echo $ac_n "checking for alloca in -lPW""... $ac_c" 1>&6 -echo "configure:7705: checking for alloca in -lPW" >&5 -ac_lib_var=`echo PW'_'alloca | sed 'y%./+-%__p_%'` - -xe_check_libs=" -lPW " -cat > conftest.$ac_ext <&5; (eval $ac_link) 2>&5; } && test -s conftest; then - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=yes" -else - echo "configure: failed program was:" >&5 - cat conftest.$ac_ext >&5 - rm -rf conftest* - eval "ac_cv_lib_$ac_lib_var=no" -fi -rm -f conftest* -xe_check_libs="" - -if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes" ; then - echo "$ac_t""yes" 1>&6 - ac_tr_lib=HAVE_LIB`echo PW | sed -e 's/[^a-zA-Z0-9_]/_/g' \ - -e 'y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/'` - { test "$extra_verbose" = "yes" && cat << EOF - Defining $ac_tr_lib -EOF -cat >> confdefs.h <&6 -fi - - -fi - -esac # The Ultrix 4.2 mips builtin alloca declared by alloca.h only works # for constant arguments. Useless! @@ -10263,6 +10263,22 @@ EOF } +elif test "$use_debug_malloc" = "yes"; then { test "$extra_verbose" = "yes" && cat << \EOF + Defining USE_DEBUG_MALLOC +EOF +cat >> confdefs.h <<\EOF +#define USE_DEBUG_MALLOC 1 +EOF +} + + { test "$extra_verbose" = "yes" && cat << \EOF + Defining USE_SYSTEM_MALLOC +EOF +cat >> confdefs.h <<\EOF +#define USE_SYSTEM_MALLOC 1 +EOF +} + fi test "$with_i18n3" = "yes" && { test "$extra_verbose" = "yes" && cat << \EOF Defining I18N3 @@ -10438,6 +10454,7 @@ test "$with_xim" != no && echo " Compiling in XIM (X11R5+ I18N input method) support." test "$with_xim" = motif && echo " Using Motif to provide XIM support." test "$with_xim" = xlib && echo " Using raw Xlib to provide XIM support." +test "$with_xfs" = yes && echo " Using XFontSet to provide bilingual menubar." test "$with_canna" = yes && echo " Compiling in support for Canna on Mule." if test "$with_wnn" = yes; then echo " Compiling in support for the WNN input method on Mule." @@ -10450,6 +10467,7 @@ test "$with_offix" = yes && echo " Compiling in support for OffiX." test "$with_workshop" = yes && echo " Compiling in support for Sun WorkShop." test "$with_energize" = yes && echo " Compiling in support for Lucid Energize (doesn't currently work)." +test "$with_wm" = yes && echo " Compiling in support for WindowMaker." case "$with_menubars" in lucid ) echo " Using Lucid menubars." ;; motif ) echo " Using Motif menubars." diff -r 6866abce6aaf -r 6075d714658b configure.in --- a/configure.in Mon Aug 13 09:50:16 2007 +0200 +++ b/configure.in Mon Aug 13 09:51:16 2007 +0200 @@ -418,6 +418,9 @@ --x-includes=DIR Search for X header files in DIR. --x-libraries=DIR Search for X libraries in DIR. --with-toolbars=no Don't compile with any toolbar support. +--with-wm Compile with realized leader window for proper + creation of the ApplicationIcon with the + WindowMaker windowmanager (SESSION MANAGEMENT). --with-menubars=TYPE Use TYPE menubars (lucid, motif, or no). The Lucid widgets emulate Motif (mostly) but are faster. *WARNING* The Motif menubar is currently broken. @@ -508,6 +511,9 @@ This is alpha level code. --with-i18n3 Compile with I18N level 3 (support for message translation). This doesn't currently work. +--with-xfs Compile with XFontSet support for bilingual menubar. + Can't use this option with --with-xim=motif or xlib. + And should have --with-menubars=lucid. Debugging options: @@ -542,6 +548,7 @@ The default is to not do clash detection. --use-system-malloc Force use of the system malloc, rather than GNU malloc. +--use-debug-malloc Use the debugging malloc package. You may also specify any of the \`path' variables found in Makefile.in, including --bindir, --libdir, --lispdir, --datadir, and @@ -655,6 +662,7 @@ with_jpeg | \ with_png | \ with_tiff | \ + with_wm | \ with_xmu | \ with_quantify | \ with_toolbars | \ @@ -719,6 +727,7 @@ dnl Options that take "yes", "no", or "default" values rel_alloc | \ + use_debug_malloc | \ use_system_malloc ) case "$val" in y | ye | yes ) val=yes ;; @@ -783,6 +792,17 @@ eval "$opt=\"$val\"" ;; + dnl XFontSet support? + "with_xfs" ) + case "$val" in + y | ye | yes ) val=yes ;; + n | no | non | none ) val=no ;; + * ) USAGE_ERROR(["The \`--$optname' option must have one of these values: + \`yes', or \`no'."]) ;; + esac + eval "$opt=\"$val\"" + ;; + dnl Mail locking specification "mail_locking" ) case "$val" in @@ -1596,8 +1616,8 @@ esac fi -canonical_version=`echo ${version}_${canonical} | sed 'y/.-/__/'` -AC_DEFINE_UNQUOTED(CANONICAL_VERSION, $canonical_version) +stack_trace_eye_catcher=`echo xemacs_${version}_${canonical} | sed 'y/.-/__/'` +AC_DEFINE_UNQUOTED(STACK_TRACE_EYE_CATCHER, $stack_trace_eye_catcher) machfile="m/${machine}.h" opsysfile="s/${opsys}.h" @@ -2040,11 +2060,15 @@ if test "$system_malloc" = "yes" ; then GNU_MALLOC=no GNU_MALLOC_reason=" - (The GNU allocators don't work with this system configuration.)" + (The GNU allocators don't work with this system configuration)." elif test "$use_system_malloc" = "yes" ; then GNU_MALLOC=no GNU_MALLOC_reason=" - (User chose not to use GNU allocators.)" + (User chose not to use GNU allocators)." +elif test "$use_debug_malloc" = "yes" ; then + GNU_MALLOC=no + GNU_MALLOC_reason=" + (User chose to use Debugging Malloc)." fi dnl Some other nice autoconf tests. If you add a test here which @@ -2140,10 +2164,6 @@ dnl -lm is required by LISP_FLOAT_TYPE, among other things AC_CHECK_LIB(m, sqrt) -dnl -lPW might be needed on some systems -dnl But they break more other systems. -dnl AC_CHECK_LIB(PW, main) - dnl Floating operation support is now unconditional AC_DEFINE(LISP_FLOAT_TYPE) @@ -2365,7 +2385,7 @@ if test "$with_tty" = "no" ; then AC_MSG_ERROR([No window system support and no TTY support - Unable to proceed.]) fi - for feature in tooltalk cde offix \ + for feature in tooltalk cde offix wm \ menubars scrollbars toolbars dialogs xim xmu \ tiff png jpeg gif compface xpm do @@ -2391,6 +2411,12 @@ test "$opsys" = "hpux9-shr" && opsysfile="s/hpux9shxr4.h" esac +dnl Check for WindowMaker +AC_CHECKING(for WindowMaker option); +if test "$with_wm" = "yes"; then + AC_DEFINE(HAVE_WINDOWMAKER) +fi + dnl Autodetect Xauth dnl -lXau is only used by gnuclient, so use a special variable for Xauth X libs test -z "$with_xauth" && test "$window_system" = "none" && with_xauth=no @@ -2661,6 +2687,18 @@ need_motif=yes XE_ADD_OBJS(input-method-motif.o) fi + if test "$with_xfs" = "yes"; then + with_xfs=no + fi + else dnl "with_xim" = "no" + case "$with_xfs" in "yes" ) + AC_CHECKING(for XFontSet) + AC_CHECK_LIB(X11, XmbDrawString, [:], with_xfs=no) + esac + if test "$with_xfs" = "yes" && test "$with_menubars" = "lucid"; then + AC_DEFINE(USE_XFONTSET) + XE_ADD_OBJS(input-method-xfs.o) + fi fi dnl with_xim dnl Autodetect WNN @@ -2817,9 +2855,9 @@ fi dnl HP-UX has a working alloca in libPW. -case "$opsys" in hpux* ) - AC_CHECK_FUNC(alloca, [:], [AC_CHECK_LIB(PW, alloca)]) -esac +dnl case "${GCC}${opsys}" in hpux* ) +dnl AC_CHECK_FUNC(alloca, [:], [AC_CHECK_LIB(PW, alloca)]) +dnl esac AC_FUNC_ALLOCA test -n "$ALLOCA" && XE_ADD_OBJS($ALLOCA) @@ -3354,6 +3392,8 @@ if test "$GNU_MALLOC" = "yes"; then AC_DEFINE(GNU_MALLOC) elif test "$use_system_malloc" = "yes"; then AC_DEFINE(USE_SYSTEM_MALLOC) +elif test "$use_debug_malloc" = "yes"; then AC_DEFINE(USE_DEBUG_MALLOC) + AC_DEFINE(USE_SYSTEM_MALLOC) fi test "$with_i18n3" = "yes" && AC_DEFINE(I18N3) test "$GCC" = "yes" && AC_DEFINE(USE_GCC) @@ -3451,6 +3491,7 @@ test "$with_xim" != no && echo " Compiling in XIM (X11R5+ I18N input method) support." test "$with_xim" = motif && echo " Using Motif to provide XIM support." test "$with_xim" = xlib && echo " Using raw Xlib to provide XIM support." +test "$with_xfs" = yes && echo " Using XFontSet to provide bilingual menubar." test "$with_canna" = yes && echo " Compiling in support for Canna on Mule." if test "$with_wnn" = yes; then echo " Compiling in support for the WNN input method on Mule." @@ -3463,6 +3504,7 @@ test "$with_offix" = yes && echo " Compiling in support for OffiX." test "$with_workshop" = yes && echo " Compiling in support for Sun WorkShop." test "$with_energize" = yes && echo " Compiling in support for Lucid Energize (doesn't currently work)." +test "$with_wm" = yes && echo " Compiling in support for WindowMaker." case "$with_menubars" in lucid ) echo " Using Lucid menubars." ;; motif ) echo " Using Motif menubars." diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/amsart.el --- a/etc/auctex/style/amsart.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -;;; amsart.el --- AMS article style hook. - -;;; Code: - -(TeX-add-style-hook "amsart" - (function - (lambda () - (TeX-run-style-hooks "amstex")))) - -;;; amsart.el ends here. diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/amsbook.el --- a/etc/auctex/style/amsbook.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -;;; amsbook.el --- AMS book style hook. - -;;; Code: - -(TeX-add-style-hook "amsbook" - (function - (lambda () - (TeX-run-style-hooks "amstex")))) - -;;; amsbook.el ends here. diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/amstex.el --- a/etc/auctex/style/amstex.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -;;; amstex.el --- AMS LaTeX support. - -;;; Code: - -(TeX-add-style-hook "amstex" - (function - (lambda () - (TeX-add-symbols - '("eqref" TeX-arg-label))))) - -;;; amstex.el ends here. diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/article.el --- a/etc/auctex/style/article.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -;;; article.el - Special code for article style. - -;; $Id: article.el,v 1.1 1997/04/05 17:56:45 steve Exp $ - -;;; Code: - -(TeX-add-style-hook "article" - (function (lambda () - (setq LaTeX-largest-level (LaTeX-section-level "section"))))) - -;;; article.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/book.el --- a/etc/auctex/style/book.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -;;; book.el - Special code for book style. - -;; $Id: book.el,v 1.1 1997/04/05 17:56:45 steve Exp $ - -;;; Code: - -(TeX-add-style-hook "book" - (function (lambda () - (setq LaTeX-largest-level (LaTeX-section-level "chapter"))))) - -;;; book.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/danish.el --- a/etc/auctex/style/danish.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -;;; danish.el - Setup AUC TeX for editing Danish text. - -;; $Id: danish.el,v 1.1 1997/05/27 22:13:46 steve Exp $ - -;;; Code: - -(TeX-add-style-hook "danish" - (function (lambda () - (run-hooks 'TeX-language-dk-hook)))) - -;;; danish.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/dinbrief.el --- a/etc/auctex/style/dinbrief.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,163 +0,0 @@ -;;; dinbrief.el - Special code for LaTeX-Style dinbrief. - -;; Contributed by Werner Fink -;; Please direct comments to him. - -;;; Commentary: - -;; LaTeX-Style: dinbrief.sty -;; Server: rusinfo.rus.uni-stuttgart.de -;; Directory: /pub/soft/tex/macros/latex/contrib/letters - -;;; Code: - -(TeX-add-style-hook "dinbrief" - (function - (lambda () - (LaTeX-add-environments - '("letter" LaTeX-recipient-hook)) - (TeX-add-symbols - '("Absender" "Absender: ") - '("Postvermerk" "Postvermerk: ") - '("Datum" "Datum: ") - '("Betreff" "Betreff: ") - '("Behandlungsvermerk" "Behandlungsvermerk: ") - '("Verteiler" "Verteiler: ") - "makelabel" "Retourlabel" - '("Anlagen" "Anlagen: ") - '("Fenster" "Fenster \(ja/nein\): ") - '("Retouradresse" "Retouradresse: ") - '("signature" "Unterschrift: ") - '("opening" "Anrede: ") - '("closing" "Schlu\"s: "))))) - -(defun LaTeX-recipient-hook (environment) - "Insert ENVIRONMENT and prompt for recipient and address." - (let ((sender (read-input "Absender: " (user-full-name))) - (recipient (read-input "Empf\"anger: ")) - (address (read-input "Anschrift: ")) - (postvermerk (read-input "Postvermerk: ")) - (date (read-input "Datum: " (LaTeX-today))) - (betreff (read-input "Betreff: ")) - (vermerk (read-input "Behandlungsvermerk: ")) - (verteil (read-input "Verteiler: ")) - (anlage (read-input "Anlagen: ")) - (opening (read-input "Anrede: ")) - (closing (read-input "Schlu\"s: ")) - (fenster (read-input "Fenster \(ja/nein\): ")) - (signature (read-input "Unterschrift: ")) - ) - - (if (not (zerop (length sender))) - (progn - (insert TeX-esc "Absender" TeX-grop sender TeX-grcl) - (newline-and-indent))) - (if (not (zerop (length postvermerk))) - (progn - (insert TeX-esc "Postvermerk" TeX-grop postvermerk TeX-grcl) - (newline-and-indent))) - (if (not (zerop (length betreff))) - (progn - (insert TeX-esc "Betreff" TeX-grop betreff TeX-grcl) - (newline-and-indent))) - (if (not (zerop (length vermerk))) - (progn - (insert TeX-esc "Behandlungsvermerk" TeX-grop vermerk TeX-grcl) - (newline-and-indent))) - (if (not (zerop (length verteil))) - (progn - (insert TeX-esc "Verteiler" TeX-grop verteil TeX-grcl) - (newline-and-indent))) - (if (not (zerop (length anlage))) - (progn - (insert TeX-esc "Anlagen" TeX-grop anlage TeX-grcl) - (newline-and-indent))) - (if (string= fenster "ja") - (progn - (insert TeX-esc "Fenster") - (let ((retouradr (read-input "Retouradresse: " (user-full-name)))) - (newline-and-indent) - (if (not (zerop (length retouradr))) - (progn - (insert TeX-esc "Retouradresse" TeX-grop retouradr TeX-grcl) - (newline-and-indent)))))) - (if (not (zerop (length signature))) - (progn - (insert TeX-esc "signature" TeX-grop signature TeX-grcl) - (newline-and-indent))) - (if (not (zerop (length date))) - (progn - (insert TeX-esc "Datum" TeX-grop date TeX-grcl) - (newline-and-indent))) - (newline-and-indent) - - (let ((indentation (current-column))) - (LaTeX-insert-environment - environment - (concat TeX-grop recipient - (if (not (zerop (length address))) - (concat - (if (not (zerop (length recipient))) - (concat " " TeX-esc TeX-esc " ")) - address)) - TeX-grcl)) - (save-excursion ; Fix indentation of address - (if (search-backward TeX-grcl nil 'move) - (let ((addr-end (point-marker))) - (if (search-backward TeX-grop nil 'move) - (let ((addr-column (current-column))) - (while (search-forward - (concat TeX-esc TeX-esc) - (marker-position addr-end) 'move) - (progn - (newline) - (indent-to addr-column)))))))) - (insert "\n") - (indent-to indentation)) - (insert TeX-esc "opening" - TeX-grop - (if (zerop (length opening)) - (concat TeX-esc " ") - opening) - TeX-grcl "\n") - - (indent-relative-maybe) - (save-excursion - (insert "\n" TeX-esc "closing" - TeX-grop - (if (zerop (length closing)) - (concat TeX-esc " ") - closing) - TeX-grcl "\n") - (indent-relative-maybe)))) - -(defun LaTeX-today nil - "Return a string representing todays date according to flavor." - (interactive) - (let ((ctime-string (current-time-string)) - (month-alist '(("Jan" . "Januar") - ("Feb" . "Februar") - ("Mar" . "M\\\"arz") - ("Apr" . "April") - ("May" . "Mai") - ("Jun" . "Juni") - ("Jul" . "Juli") - ("Aug" . "August") - ("Sep" . "September") - ("Oct" . "Oktober") - ("Nov" . "November") - ("Dec" . "Dezember")))) - (string-match - "^\\S-+\\s-+\\(\\S-+\\)\\s-+\\(\\S-+\\)\\s-+\\S-+\\s-+\\(\\S-+\\)" - ctime-string) - (let ((year (substring ctime-string (match-beginning 3) (match-end 3))) - (month (substring ctime-string (match-beginning 1) (match-end 1))) - (day (substring ctime-string (match-beginning 2) (match-end 2)))) - (if (assoc month month-alist) - (progn - (setq month (cdr (assoc month month-alist))) - (if (> 2 (length day)) - (setq day (concat "0" day))))) - (format "Stuttgart, den %s. %s %s" day month year)))) - -;;; dinbrief.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/dk.el --- a/etc/auctex/style/dk.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -;;; dk.el - Setup AUC TeX for editing Danish text. - -;; $Id: dk.el,v 1.1 1997/04/05 17:56:45 steve Exp $ - -;;; Code: - -(TeX-add-style-hook "dk" - (function (lambda () - (run-hooks 'TeX-language-dk-hook)))) - -;;; dk.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/dutch.el --- a/etc/auctex/style/dutch.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -;;; dutch.el - Setup AUC TeX for editing Dutch text. - -;; $Id: dutch.el,v 1.1 1997/04/05 17:56:45 steve Exp $ - -;;; Code: - -(TeX-add-style-hook "dutch" - (function (lambda () - (run-hooks 'TeX-language-nl-hook)))) - -;;; dutch.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/epsf.el --- a/etc/auctex/style/epsf.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,96 +0,0 @@ -;;; epsf.el - Support for the epsf style option. - -;; Contributed by Marc Gemis - -;;; Code: - -(TeX-add-style-hook "epsf" - (function - (lambda () - (TeX-add-symbols - '("epsfsize" TeX-arg-epsfsize) - '("epsffile" TeX-arg-file) - '("epsfbox" TeX-arg-file) - "epsflly" "epsfury" "testit" "epsfgetlitbb" - "epsfnormal" "epsfgetbb" "other" "epsfsetgraph" - "PsFragSpecialArgs" "epsfaux" "testit" "epsfgrab" - "epsfllx" "epsflly" "epsfury" "epsfverbosetrue" - ) - (LaTeX-add-environments - '("epsffig" LaTeX-env-epsffigure) - ) - - ))) - - -(defun LaTeX-env-epsffigure (environment) - "Create a `figure'-environment with \\label and \\caption and \\epsfbox -commands. Eventually a `psfrags'-environment is inserted round the \\epsfbox." - - (let ((float (read-input "Float to: " LaTeX-float)) - (caption (read-input "Caption: ")) - (label (read-input "Label: " LaTeX-figure-label)) - ; gf: ask if there is an psfrag environment needed - (psfrag (y-or-n-p "PS fragments: ")) - (psfile (read-file-name "EPS-file: " "" "" nil)) - ) - - (setq LaTeX-float (if (zerop (length float)) - LaTeX-float - float)) - - (LaTeX-insert-environment "figure" - (concat LaTeX-optop LaTeX-float LaTeX-optcl)) - (LaTeX-insert-environment "center") - (if psfrag - (progn - (LaTeX-insert-environment "psfrags") - (newline-and-indent) - )) - (if (or (zerop (length label)) - (and (string= "figure" environment) - (equal LaTeX-figure-label label)) - ) - () - (newline-and-indent) - (insert TeX-esc "label" TeX-grop label TeX-grcl) - (end-of-line 0) - (LaTeX-indent-line)) - - - (newline-and-indent) - (insert TeX-esc "leavevmode") - (newline-and-indent) - (insert TeX-esc "epsfbox" TeX-grop psfile TeX-grcl) - (if (zerop (length caption)) - () - (newline-and-indent) - (insert TeX-esc "caption" TeX-grop caption TeX-grcl)) - (newline) - (forward-line 4) - (newline) - -)) - -(defun TeX-arg-epsfsize (optional &optional prompt definition) - "Create a line that print epsf figures at a certain percentage" - (interactive) - (let ((scale (read-input "Scale (%): ")) - ) - (setq scalestr (if (zerop (length scale)) - "75" - (format "%s" scale) - )) - (save-excursion - ; append #1#{scale#1} - (insert "#1#2" TeX-grop "0." scale "#1" TeX-grcl) - ; insert \def before \epsfsize - (beginning-of-line 1) - (newline) - (insert TeX-esc "def") - (forward-line -1) - (insert "% From now on print figures at " scale "% of original size") - ) - (end-of-line))) - -;;; epsf.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/foils.el --- a/etc/auctex/style/foils.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,47 +0,0 @@ -;;; foils.el - Special code for FoilTeX. - -;; $Id: foils.el,v 1.1 1997/04/05 17:56:45 steve Exp $ - -;;; Code: - -(require 'latex) - -(TeX-add-style-hook "foils" - (function - (lambda () - (add-hook 'LaTeX-document-style-hook 'LaTeX-style-foils) - (setq LaTeX-default-style "foils") - (setq LaTeX-default-options '("landscape")) - (TeX-add-symbols - '("foilhead" [ "Rubric-body separation" ] "Foil rubric"))))) - -(defun LaTeX-style-foils nil - "Prompt for and insert foiltex options." - (require 'timezone) - (let* ((date (timezone-parse-date (current-time-string))) - (year (string-to-int (aref date 0))) - (month (string-to-int (aref date 1))) - (day (string-to-int (aref date 2))) - (title (read-input "Title: "))) - (save-excursion - (goto-char (point-max)) - (re-search-backward ".begin.document.") - (insert TeX-esc "title" - TeX-grop title TeX-grcl "\n") - (insert TeX-esc "author" - TeX-grop (user-full-name) TeX-grcl "\n") - (insert TeX-esc "date" TeX-grop - (format "%d-%02d-%02d" year month day) - TeX-grcl "\n") - (insert "" TeX-esc "\nMyLogo" TeX-grop TeX-grcl "\n") - (insert "%" TeX-esc "Restriction" TeX-grop TeX-grcl "\n") - (insert "%" TeX-esc "rightfooter" TeX-grop TeX-grcl "\n") - (insert "%" TeX-esc "leftheader" TeX-grop TeX-grcl "\n") - (insert "%" TeX-esc "rightheader" TeX-grop TeX-grcl "\n\n") - (re-search-forward ".begin.document.") - (end-of-line) - (newline-and-indent) - (insert "" TeX-esc "maketitle\n\n")) - (forward-line -1))) - -;;; foils.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/german.el --- a/etc/auctex/style/german.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,28 +0,0 @@ -;;; german.el - Setup AUC TeX for editing German text. - -;; $Id: german.el,v 1.1 1997/04/05 17:56:46 steve Exp $ - -;;; Commentary: -;; -;; `german.sty' use `"' to give next character an umlaut. - -;;; Code: - -(defvar LaTeX-german-mode-syntax-table - (copy-syntax-table LaTeX-mode-syntax-table) - "Syntax table used in LaTeX mode when using `german.sty'.") - -(modify-syntax-entry ?\" "w" LaTeX-german-mode-syntax-table) - -(TeX-add-style-hook "german" - (function (lambda () - (set-syntax-table LaTeX-german-mode-syntax-table) - (make-local-variable 'TeX-open-quote) - (make-local-variable 'TeX-close-quote) - (make-local-variable 'TeX-quote-after-quote) - (setq TeX-quote-after-quote t) - (setq TeX-open-quote "\"`") - (setq TeX-close-quote "\"'") - (run-hooks 'TeX-language-de-hook)))) - -;;; german.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/harvard.el --- a/etc/auctex/style/harvard.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,97 +0,0 @@ -;; harvard.el --- Support for Harvard Citation style package for AUC-TeX - -;; Copyright (C) 1994 Berwin Turlach - -;; Version: $Id: harvard.el,v 1.1 1997/04/05 17:56:46 steve Exp $ - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 1, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Commentary: - -;; Harvard citation style is from Peter Williams available on the CTAN -;; servers - -;;; Code: - -(require 'latex) - -(TeX-add-style-hook "harvard" - (function - (lambda () - - (LaTeX-add-environments - '("thebibliography" LaTeX-env-harvardbib ignore)) - - (TeX-add-symbols - "harvardand" - '("citeasnoun" - (TeX-arg-conditional TeX-arg-cite-note-p ([ "Note" ]) nil) - TeX-arg-cite) - '("possessivecite" - (TeX-arg-conditional TeX-arg-cite-note-p ([ "Note" ]) nil) - TeX-arg-cite) - '("citeaffixed" - (TeX-arg-conditional TeX-arg-cite-note-p ([ "Note" ]) nil) - TeX-arg-cite "Affix") - '("citeyear" - (TeX-arg-conditional TeX-arg-cite-note-p ([ "Note" ]) nil) - TeX-arg-cite) - '("citename" - (TeX-arg-conditional TeX-arg-cite-note-p ([ "Note" ]) nil) - TeX-arg-cite) - '("citationstyle" - (TeX-arg-eval completing-read "Citation style: " '(("agsm") ("dcu")))) - '("citationmode" - (TeX-arg-eval completing-read "Citation mode: " - '(("full") ("abbr") ("default")))) - '("harvardparenthesis" - (TeX-arg-eval completing-read "Harvardparenthesis: " - '(("round") ("curly") ("angle") ("square")))) - '("bibliographystyle" - (TeX-arg-eval - completing-read "Bibliography style: " - '(("agsm") ("dcu") ("jmr") ("jphysicsB") ("kluwer") ("nederlands"))) - ignore) - '("harvarditem" [ "Short citation" ] - "Complete citation" "Year" TeX-arg-define-cite)) - - (setq TeX-complete-list - (append '(("\\\\citeasnoun{\\([^{}\n\m\\%]*\\)" - 1 LaTeX-bibitem-list "}") - ("\\\\citeyear{\\([^{}\n\m\\%]*\\)" - 1 LaTeX-bibitem-list "}") - ("\\\\citename{\\([^{}\n\m\\%]*\\)" - 1 LaTeX-bibitem-list "}")) - TeX-complete-list)) - - (setq LaTeX-item-list - (cons '("thebibliography" . LaTeX-item-harvardbib) - LaTeX-item-list))))) - -(defun LaTeX-env-harvardbib (environment &optional ignore) - "Insert ENVIRONMENT with label for harvarditem." - (LaTeX-insert-environment environment - (concat TeX-grop "xx" TeX-grcl)) - (end-of-line 0) - (delete-char 1) - (delete-horizontal-space) - (LaTeX-insert-item)) - -;; Analog to LaTeX-item-bib from latex.el -(defun LaTeX-item-harvardbib () - "Insert a new harvarditem." - (TeX-insert-macro "harvarditem")) - -;; harvard.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/j-article.el --- a/etc/auctex/style/j-article.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -;;; j-article.el - Special code for j-article style. - -;; $Id: j-article.el,v 1.1 1997/04/05 17:56:46 steve Exp $ - -;;; Code: - -(TeX-add-style-hook "j-article" - (function (lambda () - (setq LaTeX-largest-level (LaTeX-section-level "section"))))) - -;;; j-article.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/j-book.el --- a/etc/auctex/style/j-book.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -;;; j-book.el - Special code for j-book style. - -;; $Id: j-book.el,v 1.1 1997/04/05 17:56:46 steve Exp $ - -;;; Code: - -(TeX-add-style-hook "j-book" - (function (lambda () (setq LaTeX-largest-level - (LaTeX-section-level "chapter"))))) - -;;; j-book.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/j-report.el --- a/etc/auctex/style/j-report.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -;;; j-report.el - Special code for j-report style. - -;; $Id: j-report.el,v 1.1 1997/04/05 17:56:46 steve Exp $ - -;;; Code: - -(TeX-add-style-hook "j-report" - (function (lambda () (setq LaTeX-largest-level - (LaTeX-section-level "chapter"))))) - -;;; j-report.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/jarticle.el --- a/etc/auctex/style/jarticle.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,10 +0,0 @@ -;;; jarticle.el - Special code for jarticle style. - -;; $Id: jarticle.el,v 1.1 1997/04/05 17:56:46 steve Exp $ - -;;; Code: - -(TeX-add-style-hook "jarticle" - (function (lambda () (setq LaTeX-largest-level 2)))) - -;;; jarticle.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/jbook.el --- a/etc/auctex/style/jbook.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -;;; jbook.el - Special code for jbook style. - -;; $Id: jbook.el,v 1.1 1997/04/05 17:56:46 steve Exp $ - -;;; Code: - -(TeX-add-style-hook "jbook" - (function (lambda () (setq LaTeX-largest-level - (LaTeX-section-level "chapter"))))) - -;;; jbook.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/jreport.el --- a/etc/auctex/style/jreport.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -;;; jreport.el - Special code for jreport style. - -;; $Id: jreport.el,v 1.1 1997/04/05 17:56:47 steve Exp $ - -;;; Code: - -(TeX-add-style-hook "jreport" - (function (lambda () (setq LaTeX-largest-level - (LaTeX-section-level "chapter"))))) - - -;;; jreport.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/latexinfo.el --- a/etc/auctex/style/latexinfo.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,183 +0,0 @@ -;;; latexinfo.el - Support for LaTeXinfo files. - -;; Copyright (C) 1993 Marc Gemis - -;; Author: Marc Gemis -;; Version: $Id: latexinfo.el,v 1.1 1997/04/05 17:56:47 steve Exp $ - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Code: - -(require 'latex) - -;;; LaTeXinfo mode - -(defvar TeX-latexinfo-node-regexp - '("\\\\node[ \t]+\\([^,\n\r%]+\\)" 1 TeX-auto-label) - "Matches LaTeXinfo \\node commands, only current node will be found. -We ignore next, previous and up fields.") - -(defvar LaTeXinfo-mode nil - "Non-nil means LaTeXinfo minor mode is active.") - (make-variable-buffer-local 'LaTeXinfo-mode) - -(defvar LaTeXinfo-mode-map nil - "Keymap containing LaTeXinfo commands.") - -(if LaTeXinfo-mode-map - () - (setq LaTeXinfo-mode-map (make-sparse-keymap)) - (define-key LaTeXinfo-mode-map "\C-c\C-u\C-b" 'latexinfo-format-buffer) - (define-key LaTeXinfo-mode-map "\C-c\C-u\C-r" 'latexinfo-format-region) - (define-key LaTeXinfo-mode-map "\C-c\C-u\C-s" 'latexinfo-show-structure) - (define-key LaTeXinfo-mode-map "\C-c\C-ud" 'makke:latexinfo-delete-structure) - (define-key LaTeXinfo-mode-map "\C-c\C-ug" 'latexinfo-goto-node) - (define-key LaTeXinfo-mode-map "\C-c\C-ui" 'makke:latexinfo-structure)) - -(or (assq 'LaTeXinfo-mode minor-mode-map-alist) - (setq minor-mode-map-alist - (cons (cons 'LaTeXinfo-mode LaTeXinfo-mode-map) - minor-mode-map-alist))) - -(defun TeX-arg-latexinfo-index (optional &optional prompt) - "Prompt for a LaTeXinfo index type with completion." - (TeX-argument-insert - (completing-read (TeX-argument-prompt optional prompt "Index") - '(("cp") ("vr") ("fn") ("tp") ("pg") ("ky")) - nil t) - optional)) - -(defun LaTeX-item-latexinfo-menu () - "Insert a new menu item" - (insert "* ::") - (backward-char 2)) - -(defun latexinfo-goto-node () ; temporarily here, later in latexinfo-upd.el ?? - "Place pointer on the node given by the user, read node with completion -This fails when the user types in the label of something else" - (interactive) - (let ((node-name (completing-read "Goto Node: " (LaTeX-label-list)))) - (goto-char (point-min)) - (if (re-search-forward - (concat - TeX-esc "node[ \\t]+" node-name "," - "\\|" - TeX-esc "label{" LaTeX-section-label node-name - "\\|" - TeX-esc "label{" node-name - ) - (point-max) t) - (beginning-of-line 1) - (error "No such node")))) - -;;; Hook - -(TeX-add-style-hook "latexinfo" - (function - (lambda () - (require 'latexinfo) - (require 'latexinfo-structure) - - (require 'min-map) - (setq LaTeXinfo-mode t) - - (TeX-auto-add-regexp TeX-latexinfo-node-regexp) - - (TeX-add-symbols - '("node" - (TeX-arg-literal " ") - (TeX-arg-free TeX-arg-define-label "Node name") - (TeX-arg-literal ", ") - (TeX-arg-free TeX-arg-label "Next node") - (TeX-arg-literal ", ") - (TeX-arg-free TeX-arg-label "Previous node") - (TeX-arg-literal ", ") - (TeX-arg-free TeX-arg-label "Up node")) - '("setfilename" TeX-arg-file) - - '("var" t) - '("dfn" t) - '("emph" t) - '("kbd" t) - '("code" t) - '("samp" t) - '("key" t) - '("ctrl" t) - '("file" t) - - '("comment" - (TeX-arg-literal " ") - (TeX-arg-free "Comment")) - '("c" - (TeX-arg-literal " ") - (TeX-arg-free "Comment")) - - '("cindex" t) - '("cpsubindex" 2) - '("cpindexbold" t) - - '("newindex" TeX-arg-latexinfo-index) - - '("br" nil) - '("w" "Text") - '("dots" nil) - '("refill" nil) - '("bullet" nil) - '("copyright" nil) - '("sp" nil) - - '("xref" TeX-arg-label) - '("pxref" TeX-arg-label) - '("inforef" - (TeX-arg-literal "{") - (TeX-arg-free "Name of node") - (TeX-arg-literal ", ") - (TeX-arg-free "Name for note") - (TeX-arg-literal ", ") - (TeX-arg-free TeX-arg-file "Info file") - (TeX-arg-literal "}"))) - - (LaTeX-add-environments "menu" "tex" "ignore" "ifinfo" "iftex" - "example" "same" "display" "format") - - ; Menu's have a special kind of items - (make-local-variable 'LaTeX-item-list) - (setq LaTeX-item-list (cons '("menu" . LaTeX-item-latexinfo-menu) - LaTeX-item-list)) - - (make-local-variable 'TeX-font-list) - (setq TeX-font-list - (list (list ?\C-b (concat TeX-esc "b{") "}") - (list ?\C-c (concat TeX-esc "sc{") "}") - (list ?\C-e (concat TeX-esc "emph{") "}") - (list ?\C-i (concat TeX-esc "i{") "}") - (list ?\C-r (concat TeX-esc "r{") "}") - (list ?\C-s (concat TeX-esc "samp{") "}") - (list ?\C-t (concat TeX-esc "t{") "}") - (list ?s (concat TeX-esc "strong{") "}") - (list ?\C-f (concat TeX-esc "file{") "}") - (list ?\C-d (concat TeX-esc "dfn{") "}") - (list ?\C-v (concat TeX-esc "var{") "}") - (list ?k (concat TeX-esc "key{") "}") - (list ?\C-k (concat TeX-esc "kbd{") "}") - (list ?c (concat TeX-esc "code{") "}") - (list ?C (concat TeX-esc "cite{") "}"))) - - ;; need the following stuff to let xref and pxref work - (make-local-variable 'LaTeX-section-label) - (setq LaTeX-section-label "")))) - -;;; latexinfo.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/letter.el --- a/etc/auctex/style/letter.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,122 +0,0 @@ -;;; letter.el - Special code for letter style. - -;; $Id: letter.el,v 1.1 1997/04/05 17:56:47 steve Exp $ - -;;; Code: - -;; You may want to define this in tex-site.el to contain your -;; organizations address. -(defvar LaTeX-letter-sender-address "" - "Initial value when prompting for a sender address in the letter style.") - -(TeX-add-style-hook "letter" - (function - (lambda () - (LaTeX-add-environments - '("letter" LaTeX-env-recipient)) - (TeX-add-symbols - '("name" "Sender: ") - '("address" "Sender address: ") - '("signature" "Signature: ") - '("opening" "Opening: ") - '("closing" "Closing: "))))) - -(defun LaTeX-env-recipient (environment) - "Insert ENVIRONMENT and prompt for recipient and address." - (let ((sender (read-input "Sender: " (user-full-name))) - (sender-address (read-input "Sender address: " - LaTeX-letter-sender-address)) - (recipient (read-input "Recipient: ")) - (address (read-input "Recipient address: ")) - (signature (read-input "Signature: ")) - (opening (read-input "Opening: ")) - (closing (read-input "Closing: ")) - (date (read-input "Date: " (LaTeX-today)))) - - (insert TeX-esc "name" TeX-grop sender TeX-grcl) - (newline-and-indent) - (if (not (zerop (length sender-address))) - (progn - (setq LaTeX-letter-sender-address sender-address) - (insert TeX-esc "address" TeX-grop sender-address TeX-grcl) - (newline-and-indent))) - (if (not (zerop (length signature))) - (progn - (insert TeX-esc "signature" TeX-grop signature TeX-grcl) - (newline-and-indent))) - (if (not (zerop (length date))) - (progn - (insert TeX-esc "def" TeX-esc "today" TeX-grop date TeX-grcl) - (newline-and-indent))) - (newline-and-indent) - - (let ((indentation (current-column))) - (LaTeX-insert-environment - environment - (concat TeX-grop recipient - (if (not (zerop (length address))) - (concat - (if (not (zerop (length recipient))) - (concat " " TeX-esc TeX-esc " ")) - address)) - TeX-grcl)) - (save-excursion ; Fix indentation of address - (if (search-backward TeX-grcl nil 'move) - (let ((addr-end (point-marker))) - (if (search-backward TeX-grop nil 'move) - (let ((addr-column (current-column))) - (while (search-forward - (concat TeX-esc TeX-esc) - (marker-position addr-end) 'move) - (progn - (newline) - (indent-to addr-column)))))))) - (insert "\n") - (indent-to indentation)) - (insert TeX-esc "opening" - TeX-grop - (if (zerop (length opening)) - (concat TeX-esc " ") - opening) - TeX-grcl "\n") - - (indent-relative-maybe) - (save-excursion - (insert "\n" TeX-esc "closing" - TeX-grop - (if (zerop (length closing)) - (concat TeX-esc " ") - closing) - TeX-grcl "\n") - (indent-relative-maybe)))) - -(defun LaTeX-today nil - "Return a string representing todays date according to flavor." - (interactive) - (let ((ctime-string (current-time-string)) - (month-alist '(("Jan". "01") - ("Feb" . "02") - ("Mar" . "03") - ("Apr" . "04") - ("May" . "05") - ("Jun" . "06") - ("Jul" . "07") - ("Aug" . "08") - ("Sep" . "09") - ("Oct" . "10") - ("Nov" . "11") - ("Dec" . "12")))) - (string-match - "^\\S-+\\s-+\\(\\S-+\\)\\s-+\\(\\S-+\\)\\s-+\\S-+\\s-+\\(\\S-+\\)" - ctime-string) - (let ((year (substring ctime-string (match-beginning 3) (match-end 3))) - (month (substring ctime-string (match-beginning 1) (match-end 1))) - (day (substring ctime-string (match-beginning 2) (match-end 2)))) - (if (assoc month month-alist) - (progn - (setq month (cdr (assoc month month-alist))) - (if (> 2 (length day)) - (setq day (concat "0" day))))) - (format "%s-%s-%s" year month day)))) - -;;; letter.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/plfonts.el --- a/etc/auctex/style/plfonts.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,31 +0,0 @@ -;;; plfonts.el - Setup AUC TeX for editing Polish text with plfonts.sty - -;; $Id: plfonts.el,v 1.1 1997/04/05 17:56:47 steve Exp $ - -;;; Commentary: -;; -;; `plfonts.sty' use `"' to make next character Polish. -;; `plfonts.sty' L. Holenderski, IIUW, lhol@mimuw.edu.pl - -;;; Code: - -(defvar LaTeX-plfonts-mode-syntax-table - (copy-syntax-table LaTeX-mode-syntax-table) - "Syntax table used in LaTeX mode when using `plfonts.sty'.") - -(modify-syntax-entry ?\" "w" LaTeX-plfonts-mode-syntax-table) - -(TeX-add-style-hook "plfonts" - (function (lambda () - (set-syntax-table LaTeX-plfonts-mode-syntax-table) - (make-local-variable 'TeX-open-quote) - (make-local-variable 'TeX-close-quote) - (make-local-variable 'TeX-quote-after-quote) - (make-local-variable 'TeX-command-default) - (setq TeX-open-quote "\"<") - (setq TeX-close-quote "\">") - (setq TeX-quote-after-quote t) - (setq TeX-command-default "plLaTeX") - (run-hooks 'TeX-language-pl-hook)))) - -;;; plfonts.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/plhb.el --- a/etc/auctex/style/plhb.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,31 +0,0 @@ -;;; plhb.el - Setup AUC TeX for editing Polish text with plhb.sty - -;; $Id: plhb.el,v 1.1 1997/04/05 17:56:47 steve Exp $ - -;;; Commentary: -;; -;; `plhb.sty' use `"' to make next character Polish. -;; `plhb.sty' J. S. Bie\'n, IIUW, jsbien@mimuw.edu.pl - -;;; Code: - -(defvar LaTeX-plhb-mode-syntax-table - (copy-syntax-table LaTeX-mode-syntax-table) - "Syntax table used in LaTeX mode when using `plhb.sty'.") - -(modify-syntax-entry ?\" "w" LaTeX-plhb-mode-syntax-table) - -(TeX-add-style-hook "plhb" - (function (lambda () - (set-syntax-table LaTeX-plhb-mode-syntax-table) - (make-local-variable 'TeX-open-quote) - (make-local-variable 'TeX-close-quote) - (make-local-variable 'TeX-command-default) - (make-local-variable 'TeX-quote-after-quote) - (setq TeX-open-quote "\"<") - (setq TeX-close-quote "\">") - (setq TeX-quote-after-quote t) - (setq TeX-command-default "plLaTeX") - (run-hooks 'TeX-language-pl-hook)))) - -;;; plhb.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/psfig.el --- a/etc/auctex/style/psfig.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,79 +0,0 @@ -;;; psfig.el - Support for the psfig style option. - -;; Contributed by Marc Gemis -;; Please direct comments to him. - -;;; Code: - -(TeX-add-style-hook "psfig" - (function - (lambda () - ;; probable some of the following symbols may be removed - (TeX-add-symbols "protect" "figurepath" "fbox" - "other" "letter" "other" "then" "Sine" "Cosine" - "psdraft" "psfull" "psscalefirst" "psrotatefirst" - "psnodraftbox" "psdraftbox" "pssilent" "psnoisy" - "minmaxtest" - '("psfig" TeX-arg-psfig) - '("psfigurepath" t) - ) - (LaTeX-add-environments - '("psfigure" LaTeX-env-psfigure) - ) - ))) - -(defun TeX-arg-psfig (optional) - "Ask for file, width and length. Insert psfig macro" - (let ((psfile (read-file-name "PS-file: " "" "" nil)) - (figwidth (read-input "Figure width: ")) - (figheight (read-input "Figure height: ")) - ) - - (insert TeX-grop "figure=" psfile) - (if (not (zerop (length figwidth))) - (insert ",width=" figwidth)) - (if (not (zerop (length figheight))) - (insert ",height=" figheight)) - (insert TeX-grcl) - ) - ) - - -(defun LaTeX-env-psfigure (environment) - "Create with \\label and \\caption and \\psfig commands." - (let ((float (read-input "Float to: " LaTeX-float)) - (caption (read-input "Caption: ")) - (label (read-input "Label: " LaTeX-figure-label)) - ; gf: ask if this should be centered - (psfile (read-file-name "PS-file: " "" "" nil)) - (figwidth (read-input "Figure width: ")) - (figheight (read-input "Figure height: ")) - ) - - (setq LaTeX-float (if (zerop (length float)) - LaTeX-float - float)) - - (LaTeX-insert-environment "figure" - (concat LaTeX-optop LaTeX-float LaTeX-optcl)) - - (insert TeX-esc "centerline" TeX-grop TeX-esc "psfig" TeX-grop - "figure=" psfile) - (if (not (zerop (length figwidth))) - (insert ",width=" figwidth)) - (if (not (zerop (length figheight))) - (insert ",height=" figheight)) - (insert TeX-grcl TeX-grcl) - (if (zerop (length caption)) - () - (newline-and-indent) - (insert TeX-esc "caption" TeX-grop caption TeX-grcl)) - (if (or (zerop (length label)) - (equal LaTeX-figure-label label)) - () - (newline-and-indent) - (insert TeX-esc "label" TeX-grop label TeX-grcl)) - - (forward-line 2))) - -;;; psfig.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/report.el --- a/etc/auctex/style/report.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -;;; report.el - Special code for report style. - -;; $Id: report.el,v 1.1 1997/04/05 17:56:47 steve Exp $ - -;;; Code: - -(TeX-add-style-hook "report" - (function (lambda () - (setq LaTeX-largest-level (LaTeX-section-level "chapter"))))) - -;;; report.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/slides.el --- a/etc/auctex/style/slides.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,52 +0,0 @@ -;;; slides.el - Special code for slitex. -;; -;; $Id: slides.el,v 1.1 1997/04/05 17:56:47 steve Exp $ - -(require 'latex) - -;;; Code: - -(TeX-add-style-hook "slides" - (function - (lambda () - (setq LaTeX-default-style "slides") - (add-hook 'LaTeX-document-style-hook 'LaTeX-style-slides) - (LaTeX-add-environments '("slide" LaTeX-env-slide) - '("overlay" LaTeX-env-slide)) - (TeX-run-style-hooks "SLITEX")))) - -(defvar LaTeX-slide-color "" - "*Default slide color.") - - (make-variable-buffer-local 'LaTeX-slide-color) - -(defun LaTeX-style-slides () - "Prompt for and insert SliTeX options." - (let ((slide-file (read-input "Slide file: ")) - (slide-colors (read-input "Slide colors (comma separetade list): " - "black"))) - (save-excursion - (goto-char (point-min)) ; insert before \end{document} - (if (re-search-forward ".end.document." (point-max) t) - (beginning-of-line 1)) - (open-line 2) - (indent-relative-maybe) - (if (equal slide-colors "black") - (insert TeX-esc "blackandwhite" - TeX-grop slide-file TeX-grcl) - (progn - (insert TeX-esc "colors" - TeX-grop slide-colors TeX-grcl) - (newline-and-indent) - (insert TeX-esc "colorslides" - TeX-grop slide-file TeX-grcl)))))) - -(defun LaTeX-env-slide (environment) - "Insert ENVIRONMENT and prompt for slide colors." - (setq LaTeX-slide-color - (read-input "Slide colors: " LaTeX-slide-color)) - (LaTeX-insert-environment environment - (concat TeX-grop LaTeX-slide-color TeX-grcl))) - - -;;; slides.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/swedish.el --- a/etc/auctex/style/swedish.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,13 +0,0 @@ -;;; swedish.el - Setup AUC TeX for editing Swedish text. - -;; $Id: swedish.el,v 1.1 1997/04/05 17:56:48 steve Exp $ - -;;; Commentary: -;; -;; Apparently the Swedes use ''this style'' quotations. - -(TeX-add-style-hook "swedish" - (function (lambda () - (make-local-variable 'TeX-open-quote) - (setq TeX-open-quote "''") - (run-hooks 'TeX-language-sv-hook)))) diff -r 6866abce6aaf -r 6075d714658b etc/auctex/style/virtex.el --- a/etc/auctex/style/virtex.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,83 +0,0 @@ -;;; virtex.el - Common code for all TeX formats. - -;; $Id: virtex.el,v 1.1 1997/04/05 17:56:48 steve Exp $ - -;;; Code: - -(TeX-add-style-hook "virtex" - (function - (lambda () - (TeX-add-symbols "/" "above" "abovedisplayshortskip" - "abovedisplayskip" "abovewithdelims" "accent" - "adjdemerits" "advance" "afterassignment" - "aftergroup" "atop" "atopwithdelims" "badness" - "baselineskip" "batchmode" "begingroup" - "belowdisplayshortskip" "belowdisplayskip" - "binoppenalty" "botmark" "box" "boxmaxdepth" - "brokenpenalty" "catcode" "char" "chardef" - "cleaders" "closein" "closeout" "clubpenalty" - "copy" "count" "countdef" "cr" "crcr" "csname" - "day" "deadcycles" "def" "defaulthyphenchar" - "defaultskewchar" "delcode" "delimiter" - "delimiterfactor" "delimitershortfall" "dimen" - "dimendef" "discretionary" "displayindent" - "displaylimits" "displaystyle" - "displaywidowpenalty" "displaywidth" "divide" - "doublehyphendemerits" "dp" "dump" "edef" "else" - "emergencystretch" "end" "endcsname" "endgroup" - "endinput" "endlinechar" "eqno" "errhelp" - "errmessage" "errorcontextlines" "errorstopmode" - "escapechar" "everycr" "everydisplay" - "everyhbox" "everyjob" "everymath" "everypar" - "everyvbox" "exhyphenpenalty" "expandafter" - "fam" "fi" "finalhyphendemerits" "firstmark" - "floatingpenalty" "font" "fontdimen" "fontname" - "futurelet" "gdef" "global" "globaldefs" - "halign" "hangafter" "hangindent" "hbadness" - "hbox" "hfil" "hfill" "hfilneg" "hfuzz" - "hoffset" "holdinginserts" "hrule" "hsize" - "hskip" "hss" "ht" "hyphenpenation" "hyphenchar" - "hyphenpenalty" "if" "ifcase" "ifcat" "ifdim" - "ifeof" "iffalse" "ifhbox" "ifinner" "ifhmode" - "ifmmode" "ifnum" "ifodd" "iftrue" "ifvbox" - "ifvoid" "ifx" "ignorespaces" "immediate" - "indent" "input" "inputlineno" "insert" - "insertpenalties" "interlinepenalty" "jobname" - "kern" "language" "lastbox" "lastkern" - "lastpenalty" "lastskip" "lccode" "leaders" - "left" "lefthyphenmin" "leftskip" "leqno" "let" - "limits" "linepenalty" "lineskip" - "lineskiplimit" "long" "looseness" "lower" - "lowercase" "mag" "markaccent" "mathbin" - "mathchar" "mathchardef" "mathchoise" - "mathclose" "mathcode" "mathinner" "mathhop" - "mathopen" "mathord" "mathpunct" "mathrel" - "mathsurround" "maxdeadcycles" "maxdepth" - "meaning" "medmuskip" "message" "mkern" "month" - "moveleft" "moveright" "mskip" "multiply" - "muskip" "muskipdef" "newlinechar" "noalign" - "noboundary" "noexpand" "noindent" "nolimits" - "nonscript" "nonstopmode" "nulldelimiterspace" - "nullfont" "number" "omit" "openin" "openout" - "or" "outer" "output" "outputpenalty" - "overfullrule" "parfillskip" "parindent" - "parskip" "pausing" "postdisplaypenalty" - "predisplaypenalty" "predisplaysize" - "pretolerance" "relpenalty" "rightskip" - "scriptspace" "showboxbreadth" "showboxdepth" - "smallskipamount" "spaceskip" "splitmaxdepth" - "splittopskip" "tabskip" "thickmuskip" - "thinmuskip" "time" "tolerance" "topskip" - "tracingcommands" "tracinglostchars" - "tracingmacros" "tracingonline" "tracingoutput" - "tracingpages" "tracingparagraphs" - "tracingrestores" "tracingstats" "uccode" - "uchyph" "underline" "unhbox" "unhcopy" "unkern" - "unpenalty" "unskip" "unvbox" "unvcopy" - "uppercase" "vadjust" "valign" "vbadness" "vbox" - "vcenter" "vfil" "vfill" "vfilneg" "vfuzz" - "voffset" "vrule" "vsize" "vskip" "vss" "vtop" - "wd" "widowpenalty" "write" "xdef" "xleaders" - "xspaceskip" "year")))) - -;;; virtex.el ends here diff -r 6866abce6aaf -r 6075d714658b etc/custom/choose-down.gif Binary file etc/custom/choose-down.gif has changed diff -r 6866abce6aaf -r 6075d714658b etc/custom/choose-up.gif Binary file etc/custom/choose-up.gif has changed diff -r 6866abce6aaf -r 6075d714658b etc/custom/state-down.gif Binary file etc/custom/state-down.gif has changed diff -r 6866abce6aaf -r 6075d714658b etc/custom/state-up.gif Binary file etc/custom/state-up.gif has changed diff -r 6866abce6aaf -r 6075d714658b etc/custom/toggle-off-down.gif Binary file etc/custom/toggle-off-down.gif has changed diff -r 6866abce6aaf -r 6075d714658b etc/custom/toggle-off-up.gif Binary file etc/custom/toggle-off-up.gif has changed diff -r 6866abce6aaf -r 6075d714658b etc/custom/toggle-on-down.gif Binary file etc/custom/toggle-on-down.gif has changed diff -r 6866abce6aaf -r 6075d714658b etc/custom/toggle-on-up.gif Binary file etc/custom/toggle-on-up.gif has changed diff -r 6866abce6aaf -r 6075d714658b etc/gnus-tut.txt --- a/etc/gnus-tut.txt Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,294 +0,0 @@ -From lars Thu Feb 23 23:20:38 1995 -From: larsi@ifi.uio.no (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: So you want to use the new Gnus -Message-ID: - -Actually, since you are reading this, chances are you are already -using the new Gnus. Congratulations. - -This entire newsgroup you are reading is, in fact, no real newsgroup -at all, in the traditional sense. It is an example of one of the -"foreign" select methods that Gnus may use. - -The text you are now reading is stored in the "etc" directory with the -rest of the Emacs sources. You are using the "nndoc" backend for -accessing it. Scary, isn't it? - -This isn't the real documentation. `M-x info', `m gnus ' to read -that. This "newsgroup" is intended as a kinder, gentler way of getting -people started. - -Gnus is a rewrite of GNUS 4.1, written by Masanobu Umeda. The rewrite -was done by moi, yours truly, your humble servant, Lars Magne -Ingebrigtsen. If you have a WWW browser, you can investigate to your -heart's delight at . - -;; Copyright (C) 1995 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -From lars Thu Feb 23 23:20:38 1995 -From: larsi@ifi.uio.no (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: Starting up -Message-ID: - -If you are having problems with Gnus not finding your server, you have -to set `gnus-select-method'. A "method" is a way of specifying *how* -the news is to be found, and from *where*. - -Say you want to read news from you local, friendly nntp server -"news.my.local.server". - -(setq gnus-select-method '(nntp "news.my.local.server")) - -Quite easy, huh? - -From the news spool: - -(setq gnus-select-method '(nnspool "")) - -From your mh-e spool: - -(setq gnus-select-method '(nnmh "")) - -There's a whole bunch of other methods for reading mail and news, see -the "Foreign groups" article for that. - - -From lars Thu Feb 23 23:20:38 1995 -From: larsi@ifi.uio.no (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: Where are all the groups, then? -Message-ID: - -If this is the first time you have used a newsreader, you won't have a -.newsrc file. This means that Gnus will think that all the newsgroups -on the server are "new", and kill them all. - -If you have a .newsrc file, the new groups will be processed with the -function in the `gnus-subscribe-newsgroup-method' variable, which is -`gnus-subscribe-zombies' by default. - -This means that all the groups have been made into "zombies" - not -quite dead, but not exactly alive, either. - -Jump back to the *Group* buffer, and type `A z' to list all the zombie -groups. Look though the list, and subscribe to the groups you want to -read by pressing `u' on the one you think look interesting. - -If all the groups have been killed, type `A k' to list all the killed -groups. Subscribe to them the same way. - -When you are satisfied, press `S z' to kill all the zombie groups. - -Now you should have a nice list of all groups you are interested in. - -(If you later want to subscribe to more groups, press `A k' to -list all the kill groups, and repeat. You can also type `U' and be -prompted for groups to subscribe to.) - - -From lars Thu Feb 23 23:20:38 1995 -From: larsi@ifi.uio.no (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: I want to read my mail! -Message-ID: - -Yes, Virginia, you can read mail with Gnus. - -First you have to decide which mail backend you want to use. You have -nnml, which is a one-file-one-mail backend, which is quite nice, but -apt to make your systems administrator go crazy and come after you -with a shotgun. - -nnmbox uses a Unix mail box to store mail. Nice, but slow. - -nnmh uses mh-e folders, which is also a one-file-one-mail thingie, but -slower than nnml. (It doesn't support NOV files.) - -So if you want to go with nnmbox, you can simply say: - -(setq gnus-secondary-select-methods '((nnmbox ""))) - -(The same for the other methods, kind of.) - -You should also set `nnmail-split-methods' to something sensible: - -(setq nnmail-split-methods - '(("mail.junk" "From:.*Lars") - ("mail.misc ""))) - -This will put all mail from me in you junk mail group, and the rest in -"mail.misc". - -These groups will be subscribe the same way as the normal groups, so -you will probably find them among the zombie groups after you set -these variables and re-start Gnus. - - -From lars Thu Feb 23 23:20:38 1995 -From: larsi@ifi.uio.no (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: Foreign newsgroups -Message-ID: - -These are groups that do not come from `gnus-select-method'. - -Say you want to read "alt.furniture.couches" from "news.funet.fi". You -can then either type `B news.funet.fi ' to browse that server and -subscribe to that group, or you can type -`G m alt.furniture.couchesnntpnews.funet.fi', if you -like to type a lot. - -If you want to read a directory as a newsgroup, you can create an -nndir group, much the same way. There's a shorthand for that, -though. If, for instance, you want to read the (ding) list archives, -you could type `G d /ftp '. - -There's lots more to know about foreign groups, but you have to read -the info pages to find out more. - - -From lars Thu Feb 23 23:20:38 1995 -From: larsi@ifi.uio.no (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: Low level changes in GNUS, or, Wrong type argument: stringp, nil -Message-ID: - -Gnus really isn't GNUS, even though it looks like it. If you scrape -the surface, you'll find that most things have changed. - -This means that old code that relies on GNUS internals will fail. - -In particular, `gnus-newsrc-hashtb', `gnus-newsrc-assoc', -`gnus-killed-list', the `nntp-header-' macros and the display formats -have all changed. If you have some code lying around that depend on -these, or change these, you'll have to re-write your code. - -Old hilit19 code does not work at all. In fact, you should probably -remove all hilit code from all the Gnus hooks -(`gnus-group-prepare-hook', `gnus-summary-prepare-hook' and -`gnus-summary-article-hook'). (Well, at the very least the first -two.) Gnus provides various integrated functions for highlighting, -which are both faster and more accurated. - -There is absolutely no chance, whatsoever, of getting Gnus to work -with Emacs 18. It won't even work on Emacsen older than Emacs -19.30/XEmacs 19.13. Upgrade your Emacs or die. - - -From lars Thu Feb 23 23:20:38 1995 -From: larsi@ifi.uio.no (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: How do I re-scan my mail groups? -Message-ID: - -Reading the active file from the nntp server is a drag. - -Just press `M-g' on the mail groups, and they will be re-scanned. - -You can also re-scan all the mail groups by putting them on level 1 -(`S l 1'), and saying `1 g' to re-scan all level 1 groups. - - -From lars Thu Feb 23 23:20:38 1995 -From: larsi@ifi.uio.no (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: How do I set up virtual newsgroups? -Message-ID: - -Virtual newsgroups are collections of other newsgroups. Why people -want this is beyond me, but here goes: - -Create the group by saying - -`M-a my.virtual.newsgroupnnvirtual^rec\.aquaria\.*' - -This will create the group "nnvirtual:my.virtual.newsgroup", which -will collect all articles from all the groups in the "rec.aquaria" -hierarchy. - -If you want to edit the regular expression, just type `M-e' on the -group line. - -Note that all the groups that are part of the virtual group have to be -alive. This means that the cannot, absolutely not, be zombie or -killed. They can be unsubscribed; that's no problem. - -You can combine groups from different servers in the same virtual -newsgroup, something that may actually be useful. Say you have the -group "comp.headers" on the server "news.server.no" and the same group -on "news.server.edu". If people have posted articles with Distribution -headers that stop propagation of their articles, combining these two -newsgroups into one virtual newsgroup should give you a better view of -what's going on. - -One caveat, though: The virtual group article numbers from the first -source group (group A) will always be lower than the article numbers -from the second (group B). This means that Gnus will believe that -articles from group A are older than articles from group B. Threading -will lessen these problems, but it might be a good idea to sort the -threads over the date of the articles to get a correct feel for the -flow of the groups: - -(setq gnus-thread-sort-functions '(gnus-thread-sort-by-date)) - -If you only want this in virtual groups, you could say something along -the lines of: - -(setq gnus-select-group-hook - (lambda () - (if (eq 'nnvirtual (car (gnus-find-method-for-group - gnus-newsgroup-name))) - (progn - (make-local-variable 'gnus-thread-sort-functions) - (setq gnus-thread-sort-functions '(gnus-thread-sort-by-date)))))) - - -From lars Thu Feb 23 23:20:38 1995 -From: larsi@ifi.uio.no (ding) -Date: Fri Feb 24 13:40:45 1995 -Subject: Bugs & stuff -Message-ID: - -If you want to report a bug, please type `M-x gnus-bug'. This will -give me a precise overview of your Gnus and Emacs version numbers, -along with a look at all Gnus variables you have changed. - -Du not expect a reply back, but your bug should be fixed in the next -version. If the bug persists, please re-submit your bug report. - -When a bug occurs, I need a recipe for how to trigger the bug. You -have to tell me exactly what you do to uncover the bug, and you should -(setq debug-on-error t) and send me the backtrace along with the bug -report. - -If I am not able to reproduce the bug, I won't be able to fix it. - -I would, of course, prefer that you locate the bug, fix it, and mail -me the patches, but one can't have everything. - -If you have any questions on usage, the "ding@ifi.uio.no" mailing list -is where to post the questions. - - diff -r 6866abce6aaf -r 6075d714658b etc/gnus/bar.xbm --- a/etc/gnus/bar.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,7 +0,0 @@ -#define noname_width 6 -#define noname_height 48 -static char noname_bits[] = { - 0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c, - 0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c, - 0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c, - 0x0c,0x0c,0x0c}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/bar.xpm --- a/etc/gnus/bar.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,54 +0,0 @@ -/* XPM */ -static char * picon-bar_xpm[] = { -"6 48 2 1", -" c white s background", -". c black", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. ", -" .. "}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-group-catchup-current-up.xbm --- a/etc/gnus/gnus-group-catchup-current-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x20,0x40,0x10,0x20,0x0a,0x15,0x85,0x0a,0x20,0x20,0x28,0x50,0x8a,0x8a,0x02, - 0x05,0x10,0x5e,0x54,0xa8,0xa5,0x35,0x01,0x7a,0x00,0x33,0x54,0x95,0xaa,0xaa, - 0x02,0xcc,0xfe,0x17,0xa8,0xd8,0x01,0xac,0xfa,0x4f,0x3d,0xf8,0x05,0x30,0x22, - 0x80,0xf6,0x60,0x2b,0xfc,0x8f,0x20,0x11,0x82,0xca,0x60,0x1a,0x2a,0x6e,0x28, - 0x08,0x85,0x42,0x68,0xfa,0x11,0x28,0xc8,0x04,0x8b,0xe2,0xb7,0x06,0x21,0x14, - 0xd4,0x1a,0x11,0x31,0x04,0x31,0x56,0x6d,0xdc,0x58,0xea,0xc7,0x28,0x64,0x66, - 0x60,0xa9,0x57,0x72,0x90,0x49,0xc8,0xec,0x5f,0x99,0xa6,0x7f,0x95,0x52,0xaa, - 0x64,0x22,0xbf,0x49,0x2a,0xa9,0x7e,0x92,0x52,0x55,0x55,0x54,0x49,0x4a,0xa4, - 0x49,0xaa,0xa4,0x4a,0x2a,0x49,0x2a,0x25}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-group-catchup-current-up.xpm --- a/etc/gnus/gnus-group-catchup-current-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,39 +0,0 @@ -/* XPM */ -static char * icon-catchup_xpm[] = { -"32 32 4 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #999999999999", -"o c #FFFFFFFFFFFF", -" ", -" ", -" ", -" ", -" .... ", -" .XXXX. .... ", -" .XXXX. .XXXX.", -" .XXX. .XXXX.", -" .........XX. .XXX.", -".ooooooooo.. .........XX. ", -".o....ooooo...... .ooooooooo.. ", -"X. .ooooooooo.X..o....ooooo. ", -"X. .oooo........X. .ooooo. ", -". .oooo. .X. .ooooo. ", -" .oooo. .. .oooo.o. ", -" .oooo. .oooo.o. ", -" ...... .ooooo.oo..", -" .ooooo. ...... ..X.", -" .ooooo. .ooooo. ..", -" .o..ooo. ..oooo. ", -".ooo..ooo.XXXXXXXXX.o..ooo.XXXXX", -"ooo.XX.oo.XXX......ooo..ooo.XXXX", -"oo.XXX.oo.XXX..oooooo.XX.oo.XXXX", -"..XXXX.oo.XXX..ooooo.XXX.oo.XXXX", -"XXXXXXX.oo.XX.......XXX .oo.XXXX", -"XXXXXXX.....X..XXXXXXXXXX.oo.XXX", -"XXXXXXXXXXXXX.XXXXXXXXXXX.....XX", -"XXXXXXXXXXXXXXXXXXXXXXXXX......X", -"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX", -"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX", -"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX", -"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-group-catchup-current.xbm --- a/etc/gnus/gnus-group-catchup-current.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x84,0x20,0x00,0x04,0x21,0x88,0x54,0x51,0x84,0x22,0x02,0x04,0x51,0x88,0xa0, - 0x42,0x04,0x1f,0x0a,0x28,0x51,0x75,0xa1,0x7a,0x04,0x23,0x04,0xcc,0xa1,0x76, - 0xa9,0xa6,0xfe,0x1b,0x00,0xd8,0x01,0x0c,0xfd,0x5f,0x3d,0xf8,0x05,0x30,0x26, - 0x80,0xf7,0x60,0x33,0xfc,0xdb,0x20,0x11,0x22,0x8e,0x20,0x14,0x8a,0x66,0x68, - 0x09,0x45,0x48,0x28,0xfc,0x11,0x21,0xc8,0x04,0x45,0xf4,0xf7,0x06,0x89,0x10, - 0xc4,0x1a,0x23,0x35,0x2c,0x31,0xaa,0x6c,0x54,0x58,0xea,0xc7,0x48,0x64,0x66, - 0xa0,0x99,0x57,0x72,0x50,0x59,0xc8,0xec,0x2f,0x49,0xa6,0x7f,0xaa,0x52,0xaa, - 0x64,0x49,0xbf,0x49,0x2a,0xa5,0x7e,0x92,0xa4,0x14,0x55,0xa9,0x52,0xaa,0x92, - 0x4a,0xa5,0x24,0x25,0xa5,0x94,0xaa,0xa8}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-group-catchup-current.xpm --- a/etc/gnus/gnus-group-catchup-current.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,39 +0,0 @@ -/* XPM */ -static char * icon-catchup_xpm[] = { -"32 32 4 1", -" c #BFBFBFBFBFBF", -". c #000000000000", -"X c #999999999999", -"o c #FFFFFFFFFFFF", -" ", -" ", -" ", -" ", -" .... ", -" .XXXX. .... ", -" .XXXX. .XXXX.", -" .XXX. .XXXX.", -" .........XX. .XXX.", -".ooooooooo.. .........XX. ", -".o....ooooo...... .ooooooooo.. ", -"X. .ooooooooo.X..o....ooooo. ", -"X. .oooo........X. .ooooo. ", -". .oooo. .X. .ooooo. ", -" .oooo. .. .oooo.o. ", -" .oooo. .oooo.o. ", -" ...... .ooooo.oo..", -" .ooooo. ...... ..X.", -" .ooooo. .ooooo. ..", -" .o..ooo. ..oooo. ", -".ooo..ooo.XXXXXXXXX.o..ooo.XXXXX", -"ooo.XX.oo.XXX......ooo..ooo.XXXX", -"oo.XXX.oo.XXX..oooooo.XX.oo.XXXX", -"..XXXX.oo.XXX..ooooo.XXX.oo.XXXX", -"XXXXXXX.oo.XX.......XXX .oo.XXXX", -"XXXXXXX.....X..XXXXXXXXXX.oo.XXX", -"XXXXXXXXXXXXX.XXXXXXXXXXX.....XX", -"XXXXXXXXXXXXXXXXXXXXXXXXX......X", -"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX", -"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX", -"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX", -"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-group-describe-group-up.xbm --- a/etc/gnus/gnus-group-describe-group-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x55,0xb5,0x55,0xb5,0xaa,0x12,0xa9,0x12,0x12,0x55,0x12,0x65,0xa9,0xa4,0x4a, - 0x10,0x55,0x9b,0x15,0xc1,0x55,0x51,0x09,0x00,0x92,0x4a,0x02,0x00,0xa9,0x24, - 0x01,0x00,0x55,0x5b,0x11,0x11,0x92,0xa4,0x00,0x00,0x2a,0x49,0x00,0x00,0x49, - 0x55,0x00,0x00,0x35,0x55,0x11,0x11,0xaa,0xaa,0x00,0x00,0x92,0x44,0x00,0x00, - 0xa5,0x32,0x00,0x00,0x55,0x55,0x11,0x11,0x29,0x55,0x01,0x00,0xaa,0x24,0x01, - 0x00,0x92,0x97,0x00,0x00,0x75,0xba,0x13,0x11,0x2a,0x51,0x04,0x00,0xb2,0xaa, - 0x0a,0x40,0x59,0x75,0x25,0x40,0xb5,0x3d,0x59,0xb5,0xfa,0x77,0xa5,0x2a,0xae, - 0x9a,0x2a,0x49,0xd6,0x5f,0x49,0xa5,0xf7,0x57,0x35,0x55,0x7d,0x29,0x95,0x2a, - 0x7e,0x55,0xa9,0x54,0x5f,0x92,0x94,0x92}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-group-describe-group-up.xpm --- a/etc/gnus/gnus-group-describe-group-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,39 +0,0 @@ -/* XPM */ -static char * icon-describe-group_xpm[] = { -"32 32 4 1", -" c #000000000000", -". c #999999999999 s backgroundToolBarColor", -"X c #FFFFFFFFFFFF", -"o c #BFBFBFBFBFBF", -" ... ... ... ... ... ... ... ...", -"................................", -"................................", -".......................XXXXX....", -" ... ... ... ... ... XXX XXXXX..", -"....................XXXXXXXXXXX.", -"...................XXXXXXXXXXXXX", -"..................XXXXXXXXXXXXXX", -" ... ... ... ... XXX XXX XXX XXX", -"................XXXXXXXXXXXXXXXX", -"................XXXXXXXXXXXXXXXX", -"................XXXXXXXXXXXXXXXX", -" ... ... ... ... XXX XXX XXX XXX", -"................XXXXXXXXXXXXXXXX", -"................XXXXXXXXXXXXXXXX", -"................XXXXXXXXXXXXXXXX", -" ... ... ... ... XXX XXX XXX XXX", -".................XXXXXXXXXXXXXXX", -".................XXXXXXXXXXXXXXX", -"....... .......XXXXXXXXXXXXXX", -" ... . oooo ... ..X XXX XXX XXX", -"..... o...oo .......XXXXXXXXXXX.", -".... .o....o. .......XXXXXXXXX..", -".... o . ... .........XXXXX....", -" ... o .. . .. ... ... ... ...", -"... o . . ..................", -".. X . . . ...................", -". o . . ....................", -" o . ... ... ... ... ...", -" o .........................", -"o . ...o......................", -" ..........................."}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-group-exit-up.xbm --- a/etc/gnus/gnus-group-exit-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x00,0x00,0x40,0x00,0x00,0x30,0x30,0x00,0x00,0x68,0x38,0x00,0x38,0x60,0x48, - 0x00,0xd4,0x91,0xde,0x07,0x68,0xcf,0xb7,0x1a,0x80,0xb4,0x6e,0x05,0x00,0xe2, - 0x07,0x00,0x00,0xde,0x1d,0x00,0xe0,0xfd,0x77,0x00,0xb0,0x6a,0xf3,0x00,0x20, - 0x9c,0xa5,0x03,0x00,0xaa,0x86,0x02,0x00,0x65,0x06,0x02,0xab,0x6f,0xaf,0x59, - 0x80,0x62,0x0c,0x00,0xaa,0xab,0xba,0x4a,0x40,0x21,0x10,0x10,0xea,0x45,0x4a, - 0x42,0x40,0x89,0x90,0x28,0xd2,0x21,0x02,0x82,0xa4,0x8a,0x44,0x20,0xf0,0x10, - 0x10,0x85,0xa4,0x04,0x4a,0x20,0xe2,0x22,0x80,0x80,0xbc,0x4b,0x09,0x2a,0xee, - 0x8e,0x32,0x80,0xeb,0x73,0x85,0x28,0x56,0xaa,0xb5,0x02,0xff,0xff,0x85,0x48, - 0x08,0x94,0x11,0x01,0x42,0x02,0x48,0x54}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-group-exit-up.xpm --- a/etc/gnus/gnus-group-exit-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,39 +0,0 @@ -/* XPM */ -static char * icon-exit-gnus_xpm[] = { -"32 32 4 1", -" c #FFFFFFFFFFFF s backgroundToolBarColor", -". c #000000000000", -"X c #999999999999", -"o c #BFBFBFBFBFBF", -" . ", -" .. .. ", -" . .. ... ", -" ... .. . . ", -" . . ... . . .... ..... ", -" . .. .... ..... .. . . .. ", -" . . .. . ... .. . . ", -" . ...... ", -" .... ... ... ", -" .... ......... ... ", -" .. . . .X.. .. .... ", -" . .X. .. . . ... ", -" .X. . . .. . . ", -" .X. .. .. . ", -".. . . ..X.. .. .... . .. .. . ", -"ooooooo.X.ooo..ooo..oo ooooooooo", -"oooo oo.X.ooo.ooooo..oooooooo oo", -"o oooo.X.ooooooo ooo.ooooooooooo", -"oooooo.X.ooooooooooooooo ooooooo", -"ooo oo.X.ooo ooooooooooooooooooo", -"oooooo.X.oooooooooo oooooo ooo", -"ooooo.X.ooooooooooooooo ooooooo", -"o ooo.X.oooooo ooooooooooooooooo", -"ooooo.X.oooo o ooooooooo ooooo", -"ooooo.X.ooooooooooo oooo o ooo", -"oo....X...ooooooo o oooooooooo", -"o..XX...XX..ooo.o.oo.oo oooooooo", -".XX.XX..X.XX...ooo.oo o oooooo", -"X.XX.XXXXXXXXXX..oooo.o.oooooo o", -".................o.o oo.oooo o ", -"oooooo ooo.oo oo.o . ooooooooo", -"oooo o oo o oooooooooooooooo"}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-group-get-new-news-this-group-up.xbm --- a/etc/gnus/gnus-group-get-new-news-this-group-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x20,0x00,0x40,0x88,0xff,0x57,0x15,0x22,0x02,0x0c,0xa0,0x88,0x02,0xa4,0x0a, - 0x22,0x02,0x04,0xf0,0x84,0x03,0x54,0xdd,0x21,0x02,0x1e,0x14,0x97,0x02,0x66, - 0xcd,0x02,0x02,0x7c,0x14,0x2b,0x03,0x9c,0xad,0x41,0x02,0x54,0xb1,0x0a,0x02, - 0x2c,0xff,0x47,0x02,0xe4,0x14,0x2d,0xff,0x4f,0xa5,0x0a,0x48,0xa0,0x4a,0xb4, - 0x12,0x0a,0x51,0x1b,0x40,0xa1,0x96,0x36,0x2a,0x10,0x4a,0x56,0x80,0x4a,0x57, - 0x1b,0x55,0x00,0x92,0x52,0x00,0x55,0x26,0x17,0xa9,0x00,0xab,0x5a,0x04,0x2a, - 0xfe,0x1f,0x41,0x41,0xcb,0x48,0x14,0x14,0x95,0x2f,0x82,0x42,0x53,0x09,0x28, - 0x08,0xa5,0xaf,0x84,0xa2,0x75,0x06,0x12,0x04,0xd3,0x54,0x40,0x51,0xdf,0x0f, - 0x0a,0x82,0xae,0x23,0xa0,0x28,0x8a,0x4a}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-group-get-new-news-this-group-up.xpm --- a/etc/gnus/gnus-group-get-new-news-this-group-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,39 +0,0 @@ -/* XPM */ -static char * icon-get-new-news-this-group_xpm[] = { -"32 32 4 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -"o c #999999999999", -" ", -" .......... ", -" .XXXXXXXX. ", -" .XXXXXXXX. ", -" .XXXXXXXX. .... ", -" .XXXXXXXX. .oooo. ", -" .XXXXXXX.... .oooooo. ", -" .XXXXXXX.. . .oooooo. ", -" .XXXXXXXX...o. .oooooo. ", -" .XXXXXXXX..ooo. .oooo. ", -" .XXXXXXXX. .ooo. .oo. ", -" .XXXXXXXX. .ooo.....o.... ", -" .XXXXXXXX. .oooooooooooo. ", -" .......... .oooooooooooo. ", -" .oooooooooooo. ", -" .oooooooo.oo. ", -" .ooooooo.oo. ", -" .ooooooo.oo. ", -" .ooooooo.oo. ", -" .ooooooo.oo. ", -" .ooooooo.oo. ", -" .ooooooo.oo. ", -" ............ ", -" .oooooo. . ", -" .ooooooo.. . ", -" .ooooooo. . ", -" .oooo.oo... ", -" .oooo.oooo. ", -" .ooo. .ooo. ", -" ..... ..... ", -" .o. .o. ", -" .o. .o. "}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-group-get-new-news-up.xbm --- a/etc/gnus/gnus-group-get-new-news-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x00,0x81,0x00,0x08,0xff,0x2b,0xa8,0x42,0x01,0x42,0x05,0x14,0x01,0x16,0x50, - 0x41,0x01,0xa2,0x7a,0x0a,0x01,0x0a,0xcc,0x40,0x01,0xaf,0x92,0x15,0x01,0x13, - 0x56,0x43,0x01,0xbe,0x2a,0x09,0x01,0x6e,0xcc,0x52,0x01,0xca,0x69,0x80,0x01, - 0x32,0xdf,0x2b,0x01,0x66,0x55,0x85,0xff,0x33,0xa9,0x2e,0x24,0xc9,0x92,0x88, - 0x09,0x82,0x4a,0x2e,0xa0,0x28,0xfd,0xf9,0x14,0x42,0x07,0x8d,0x42,0x08,0x85, - 0x8d,0x20,0x52,0x87,0x85,0x8a,0x80,0x45,0x86,0x20,0x2a,0xc7,0x82,0x8a,0x00, - 0xe7,0x82,0x41,0xd4,0x15,0x81,0x14,0x81,0xe6,0x81,0x81,0xa8,0x3d,0xff,0x14, - 0x82,0xfa,0x02,0x42,0xd1,0x52,0x57,0x08,0x8a,0xad,0x82,0xa2,0xa0,0xef,0x2b, - 0x04,0x05,0x55,0x81,0x51,0x50,0xc7,0x2b}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-group-get-new-news-up.xpm --- a/etc/gnus/gnus-group-get-new-news-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,39 +0,0 @@ -/* XPM */ -static char * icon-get-new-news_xpm[] = { -"32 32 4 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -"o c #999999999999", -" ", -".......... ", -".XXXXXXXX. ", -".XXXXXXXX. ", -".XXXXXXXX. .... ", -".XXXXXXXX. .oooo. ", -".XXXXXXX.... .oooooo. ", -".XXXXXXX.. . .oooooo. ", -".XXXXXXXX...o. .oooooo. ", -".XXXXXXXX..ooo. .oooo. ", -".XXXXXXXX. .ooo. .oo. ", -".XXXXXXXX. .ooo.....o.... ", -".XXXXXXXX. .oooooooooooo. ", -".......... .oooooooooooo. ", -" .oooooooooooo. ", -" .ooooooooooo. ", -" .o.......oo.....", -" .o.XXXXX.oo.XXX.", -" .o.XXXX.ooo.XXX.", -" .o.XXXX.oo.XXXX.", -" .o.XXX.ooo.XXXX.", -" .o.XXX.oo.XXXXX.", -" ...XX...o.XXXXX.", -" .oo.X. .XXXXXX.", -" .oo.XX.. .XXXXXX.", -" .oo.... ........", -" .oooo.o..o. ", -" .oooo.oooo. ", -" .ooo. .ooo. ", -" ..... ..... ", -" .o. .o. ", -" .o. .o. "}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-group-kill-group-up.xbm --- a/etc/gnus/gnus-group-kill-group-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x00,0x04,0x20,0x20,0x54,0xa1,0x0a,0x4a,0x02,0x0a,0x50,0x01,0xa0,0x40,0x05, - 0x54,0xca,0xff,0x7f,0x00,0x50,0x00,0x60,0x55,0x42,0x00,0xa0,0x80,0x68,0xc0, - 0x21,0x2b,0x42,0xe0,0xe3,0x83,0x50,0xb0,0x06,0x2a,0x4a,0xf0,0x07,0x42,0x60, - 0x70,0x07,0x16,0x42,0xe0,0x03,0x42,0x68,0x40,0x01,0x2a,0x42,0x40,0x01,0x82, - 0x50,0xc8,0x05,0x2a,0x4a,0x0c,0x0c,0x82,0x60,0x30,0x03,0x2a,0x4a,0xc0,0x00, - 0x82,0x40,0xc0,0x00,0x2a,0x6a,0x30,0x03,0x42,0x41,0x0c,0x0c,0x16,0x54,0x08, - 0x04,0x22,0x41,0x00,0x00,0x4a,0x54,0x00,0x00,0x02,0x41,0x00,0x00,0x56,0x54, - 0x00,0x00,0x02,0x42,0x00,0x00,0x52,0xe8,0xff,0xff,0x0b,0x04,0x84,0x00,0x42, - 0x52,0x11,0xaa,0x28,0x00,0xa4,0x04,0x04}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-group-kill-group-up.xpm --- a/etc/gnus/gnus-group-kill-group-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -/* XPM */ -static char * icon-killfile_xpm[] = { -"32 32 3 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -" ", -" ", -" ", -" ", -" ................ ", -" .XXXXXXXXXXXXXX.. ", -" .XXXXXXXXXXXXXX.X. ", -" .XXXXXXX...XXXX.XX. ", -" .XXXXXX.....XXX..... ", -" .XXXXX..X.X..XXXXXX. ", -" .XXXXX.......XXXXXX. ", -" .XXXXX...X...XXXXXX. ", -" .XXXXXX.....XXXXXXX. ", -" .XXXXXXX.X.XXXXXXXX. ", -" .XXXXXXX.X.XXXXXXXX. ", -" .XXXX.XX...X.XXXXXX. ", -" .XXX..XXXXXX..XXXXX. ", -" .XXXXX..XX..XXXXXXX. ", -" .XXXXXXX..XXXXXXXXX. ", -" .XXXXXXX..XXXXXXXXX. ", -" .XXXXX..XX..XXXXXXX. ", -" .XXX..XXXXXX..XXXXX. ", -" .XXXX.XXXXXX.XXXXXX. ", -" .XXXXXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXXXXX. ", -" .................... ", -" ", -" ", -" "}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-group-subscribe-up.xbm --- a/etc/gnus/gnus-group-subscribe-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x08,0x04,0x00,0x40,0x22,0x51,0x55,0x15,0x88,0x04,0x00,0x20,0x22,0xa0,0xaa, - 0x4a,0xc4,0xff,0x3f,0x00,0x61,0x80,0x60,0x55,0x54,0x8a,0xa0,0x80,0x42,0x84, - 0x20,0x2b,0x68,0x8a,0xe0,0x83,0x42,0x80,0x00,0x2a,0xd4,0xff,0x00,0x42,0x41, - 0x80,0x00,0x16,0x54,0x8a,0x00,0x42,0x41,0x84,0x00,0x2a,0x54,0x8a,0x00,0x82, - 0x41,0x80,0x00,0x2a,0xd4,0xff,0x00,0x82,0x42,0x80,0x00,0x2a,0x68,0x8a,0x00, - 0x82,0x44,0x84,0x00,0x2a,0x52,0x8a,0x00,0x42,0x40,0x80,0x00,0x16,0xea,0xff, - 0x00,0x22,0x40,0x80,0x00,0x4a,0x4a,0x80,0x00,0x02,0x61,0x80,0x00,0x56,0x44, - 0x80,0x00,0x02,0x51,0x80,0x00,0x52,0xc4,0xff,0xff,0x0b,0xa1,0x04,0x00,0x42, - 0x14,0xa8,0xaa,0x88,0x82,0x02,0x00,0x22}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-group-subscribe-up.xpm --- a/etc/gnus/gnus-group-subscribe-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -/* XPM */ -static char * icon-unsubscribe_xpm[] = { -"32 32 3 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -" ", -" ", -" ", -" ", -" ................ ", -" .XXXXXXXX.XXXXX.. ", -" .XX.X.XXX.XXXXX.X. ", -" .XXX.XXXX.XXXXX.XX. ", -" .XX.X.XXX.XXXXX..... ", -" .XXXXXXXX.XXXXXXXXX. ", -" ..........XXXXXXXXX. ", -" .XXXXXXXX.XXXXXXXXX. ", -" .XX.X.XXX.XXXXXXXXX. ", -" .XXX.XXXX.XXXXXXXXX. ", -" .XX.X.XXX.XXXXXXXXX. ", -" .XXXXXXXX.XXXXXXXXX. ", -" ..........XXXXXXXXX. ", -" .XXXXXXXX.XXXXXXXXX. ", -" .XX.X.XXX.XXXXXXXXX. ", -" .XXX.XXXX.XXXXXXXXX. ", -" .XX.X.XXX.XXXXXXXXX. ", -" .XXXXXXXX.XXXXXXXXX. ", -" ..........XXXXXXXXX. ", -" .XXXXXXXX.XXXXXXXXX. ", -" .XXXXXXXX.XXXXXXXXX. ", -" .XXXXXXXX.XXXXXXXXX. ", -" .XXXXXXXX.XXXXXXXXX. ", -" .XXXXXXXX.XXXXXXXXX. ", -" .................... ", -" ", -" ", -" "}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-group-unsubscribe-up.xbm --- a/etc/gnus/gnus-group-unsubscribe-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x08,0x04,0x00,0x40,0x22,0x51,0x55,0x15,0x88,0x04,0x00,0x20,0x22,0xa0,0xaa, - 0x4a,0xc4,0xff,0x3f,0x00,0x61,0x80,0x60,0x55,0x54,0xa0,0xa0,0x80,0x42,0x90, - 0x20,0x2b,0x68,0x8a,0xe0,0x83,0x42,0x84,0x00,0x2a,0xd4,0xff,0x00,0x42,0x41, - 0x80,0x00,0x16,0x54,0xa0,0x00,0x42,0x41,0x90,0x00,0x2a,0x54,0x8a,0x00,0x82, - 0x41,0x84,0x00,0x2a,0xd4,0xff,0x00,0x82,0x42,0x80,0x00,0x2a,0x68,0xa0,0x00, - 0x82,0x44,0x90,0x00,0x2a,0x52,0x8a,0x00,0x42,0x40,0x84,0x00,0x16,0xea,0xff, - 0x00,0x22,0x40,0x80,0x00,0x4a,0x4a,0x80,0x00,0x02,0x61,0x80,0x00,0x56,0x44, - 0x80,0x00,0x02,0x51,0x80,0x00,0x52,0xc4,0xff,0xff,0x0b,0xa1,0x04,0x00,0x42, - 0x14,0xa8,0xaa,0x88,0x82,0x02,0x00,0x22}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-group-unsubscribe-up.xpm --- a/etc/gnus/gnus-group-unsubscribe-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -/* XPM */ -static char * icon-subscribe_xpm[] = { -"32 32 3 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -" ", -" ", -" ", -" ", -" ................ ", -" .XXXXXXXX.XXXXX.. ", -" .XXXXXX.X.XXXXX.X. ", -" .XXXXX.XX.XXXXX.XX. ", -" .XX.X.XXX.XXXXX..... ", -" .XXX.XXXX.XXXXXXXXX. ", -" ..........XXXXXXXXX. ", -" .XXXXXXXX.XXXXXXXXX. ", -" .XXXXXX.X.XXXXXXXXX. ", -" .XXXXX.XX.XXXXXXXXX. ", -" .XX.X.XXX.XXXXXXXXX. ", -" .XXX.XXXX.XXXXXXXXX. ", -" ..........XXXXXXXXX. ", -" .XXXXXXXX.XXXXXXXXX. ", -" .XXXXXX.X.XXXXXXXXX. ", -" .XXXXX.XX.XXXXXXXXX. ", -" .XX.X.XXX.XXXXXXXXX. ", -" .XXX.XXXX.XXXXXXXXX. ", -" ..........XXXXXXXXX. ", -" .XXXXXXXX.XXXXXXXXX. ", -" .XXXXXXXX.XXXXXXXXX. ", -" .XXXXXXXX.XXXXXXXXX. ", -" .XXXXXXXX.XXXXXXXXX. ", -" .XXXXXXXX.XXXXXXXXX. ", -" .................... ", -" ", -" ", -" "}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-pointer.xbm --- a/etc/gnus/gnus-pointer.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,6 +0,0 @@ -#define noname_width 18 -#define noname_height 13 -static char noname_bits[] = { - 0x00,0x00,0x00,0xc0,0x0c,0x00,0xe0,0x1f,0x00,0x92,0x39,0x00,0x0e,0x71,0x02, - 0x46,0xe0,0x03,0x20,0xc0,0x01,0x00,0x08,0x00,0x10,0x0d,0x00,0xc4,0x08,0x00, - 0x78,0x08,0x00,0x18,0x89,0x00,0x00,0x08,0x00}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-pointer.xpm --- a/etc/gnus/gnus-pointer.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,22 +0,0 @@ -/* XPM */ -static char *gnus-pointer[] = { -/* width height num_colors chars_per_pixel */ -" 18 13 2 1", -/* colors */ -". c #0000ff", -"# c #ebebeb s backgroundToolBarColor", -/* pixels */ -"##################", -"######..##..######", -"#####........#####", -"#.##.##..##...####", -"#...####.###...##.", -"#..###.######.....", -"#####.########...#", -"###########.######", -"####.###.#..######", -"######..###.######", -"###....####.######", -"###..######.######", -"###########.######" -}; \ No newline at end of file diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-caesar-message-up.xbm --- a/etc/gnus/gnus-summary-caesar-message-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x40,0x40,0x10,0x01,0x15,0x15,0x45,0x50,0x40,0x40,0x08,0x05,0x14,0x14,0xa2, - 0x50,0xe2,0xff,0x3f,0x82,0x48,0x00,0xe0,0x28,0x62,0xe6,0xb8,0x82,0x48,0x29, - 0x25,0x29,0x62,0xa9,0xe4,0x83,0x48,0x2f,0x05,0x2a,0x42,0xe9,0x38,0x42,0x60, - 0x00,0x00,0x16,0x4a,0x82,0x10,0x22,0x50,0x00,0x00,0x4a,0x42,0xcb,0x1c,0x02, - 0x68,0x2b,0x25,0x56,0x42,0x2d,0x1d,0x02,0x50,0x2d,0x05,0x52,0x4a,0xc9,0x04, - 0x0a,0x40,0x00,0x00,0x42,0x6a,0x18,0x00,0x16,0x41,0x3c,0x00,0x42,0x54,0xe6, - 0x3f,0x0a,0x41,0xe6,0x3f,0x52,0x54,0x3c,0x2a,0x06,0x42,0x18,0x2a,0x42,0x68, - 0x00,0x08,0x2a,0x44,0x00,0x00,0x06,0xd2,0xff,0xff,0x53,0x20,0x84,0x20,0x04, - 0x8a,0x10,0x8a,0xa8,0x20,0x4a,0x21,0x02}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-caesar-message-up.xpm --- a/etc/gnus/gnus-summary-caesar-message-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -/* XPM */ -static char * icon-rot13_xpm[] = { -"32 32 3 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -" ", -" ", -" ", -" ", -" ................ ", -" .XXXXXXXXXXXXXX.. ", -" .XX..XX...XXX...X. ", -" .X.XX.X.XX.X.XX.XX. ", -" .X.XX.X.X.XX.XX..... ", -" .X....X.XX.X.XXXXXX. ", -" .X.XX.X...XXX...XXX. ", -" .XXXXXXXXXXXXXXXXXX. ", -" .XX.XXXXX.XXXX.XXXX. ", -" .XXXXXXXXXXXXXXXXXX. ", -" .X..X.XX..XX...XXXX. ", -" .X..X.X.XX.X.XX.XXX. ", -" .X.X..X.XX.X...XXXX. ", -" .X.X..X.XX.X.XXXXXX. ", -" .X.XX.XX..XX.XXXXXX. ", -" .XXXXXXXXXXXXXXXXXX. ", -" .XXXX..XXXXXXXXXXXX. ", -" .XXX....XXXXXXXXXXX. ", -" .XX..XX.........XXX. ", -" .XX..XX.........XXX. ", -" .XXX....XXX.X.X.XXX. ", -" .XXXX..XXXX.X.X.XXX. ", -" .XXXXXXXXXXXX.XXXXX. ", -" .XXXXXXXXXXXXXXXXXX. ", -" .................... ", -" ", -" ", -" "}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-cancel-article-up.xbm --- a/etc/gnus/gnus-summary-cancel-article-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x11,0x11,0x01,0x11,0x54,0x4a,0xa9,0x52,0x82,0x10,0x04,0x08,0x28,0x24,0xa1, - 0x42,0x91,0x91,0x0f,0x19,0x25,0xaa,0xa9,0x44,0x88,0x60,0x18,0x11,0x42,0x1c, - 0x56,0x44,0x19,0x07,0x97,0x31,0x44,0x01,0x23,0x0a,0x12,0x81,0x60,0x50,0x80, - 0x02,0x42,0x05,0x3b,0x05,0x78,0x59,0x00,0x0a,0x56,0x12,0xaa,0xf4,0x05,0x41, - 0x00,0x54,0x51,0x10,0x5b,0x51,0x95,0x55,0x10,0x15,0x00,0x11,0x42,0x40,0x55, - 0x44,0x10,0x2a,0x00,0x21,0x5b,0x91,0x5b,0x95,0x80,0x24,0x00,0x21,0x12,0x92, - 0x2a,0x14,0x44,0x01,0x80,0x42,0x11,0xb5,0x35,0x19,0x54,0x11,0x08,0x42,0x02, - 0x44,0xa1,0x08,0xa8,0x22,0x14,0x52,0x11,0x99,0x51,0x11,0x4a,0x22,0x14,0x4a, - 0x20,0x89,0x42,0x10,0x15,0x40,0x20,0x45}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-cancel-article-up.xpm --- a/etc/gnus/gnus-summary-cancel-article-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,39 +0,0 @@ -/* XPM */ -static char * icon-cancel-post_xpm[] = { -"32 32 4 1", -" c #000000000000", -". c #BFBFBFBFBFBF s backgroundToolBarColor", -"X c #FFFFFFFFFFFF", -"o c #999999999999", -" ... ... ... ... ....... ... ...", -"................................", -"................................", -"................................", -" ... ... ... ... .... ... ...", -"............... XX ............", -"............. XXXX ...........", -"........... XXXX X ...........", -" ... .... XXXXX X ... ... ...", -"........ XXXXXXX XXX ..........", -"........ XXXXXX oXXXX ..........", -"........o XXXXXXXoXXXX .........", -" ... ...oo XXXXXXXX . ... ...", -".........oo XXXXX oooo.........", -"..........oo o..............", -"..........ooooooo...............", -" ... ... ... oo. ... ... ... ...", -"................................", -"................................", -"................................", -" ... ... ... ... ... ... ... ...", -"................................", -"................................", -"................................", -" ... ... ... ... ... ... ... ...", -"................................", -"................................", -"................................", -" ... ... ... ... ... ... ... ...", -"................................", -"................................", -"................................"}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-catchup-and-exit-up.xbm --- a/etc/gnus/gnus-summary-catchup-and-exit-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x08,0x81,0x00,0x04,0x42,0x28,0x52,0x51,0x14,0x85,0x08,0x04,0x81,0x20,0x42, - 0x49,0x14,0x8a,0x08,0x20,0x41,0x21,0x52,0x15,0x14,0x44,0x00,0x40,0x41,0x91, - 0xbf,0x2a,0x14,0xda,0x10,0x80,0x81,0x94,0x90,0x2a,0x14,0x73,0xf0,0x80,0xe1, - 0x60,0x90,0x2b,0xc4,0x60,0x08,0x43,0xa2,0xf0,0x0f,0x15,0x88,0x11,0xfc,0x21, - 0xd2,0x11,0x8c,0x4a,0x80,0x12,0x84,0x00,0xd5,0x13,0x84,0x55,0x00,0x17,0x74, - 0x80,0x54,0xfb,0xcf,0x2a,0x02,0x9a,0x24,0x40,0x54,0x9f,0xbc,0x36,0xa9,0xf4, - 0x77,0x49,0x94,0x96,0x94,0xa4,0x25,0x95,0x35,0x15,0xa9,0xfe,0xbf,0xa4,0x92, - 0xdc,0x5c,0x29,0x4a,0x9e,0x3d,0x95,0xaa,0xfe,0x4f,0x52,0x24,0xf9,0xaf,0x4a, - 0xa9,0x52,0x91,0x94,0x25,0x29,0x55,0x52}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-catchup-and-exit-up.xpm --- a/etc/gnus/gnus-summary-catchup-and-exit-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,39 +0,0 @@ -/* XPM */ -static char * icon-catchup_xpm[] = { -"32 32 4 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -"o c #999999999999", -" ", -" ", -" ", -" ", -" ", -" ", -" ", -" ...... ", -" .. .XXXX. ", -" .X. .XXXX. ", -" ..XX...XXXXX.... ", -" ..XXXXX..XXXXX.XX... ", -" ..XXXXX..XXXX.XXXX.. ", -" .XXXX........XXXX. ", -" ..XXX.XXXXX....... ", -" ..XXX.XXXXX..XXX. ", -" .X.XX.XXXXX.XXXX. ", -" ...XX.XXXXX.XXXX. ", -" ...X.XXXXX.X... ", -" .X.........XX. ", -" . .XX.XX.XX. ", -"ooooooooo....XX.XX....oooooooooo", -"oooooooooo. ....... .oooooooooo", -"oooooooooo.X.XX.X .X.ooooooooooo", -"oooooooooo. .X . . .ooooooooooo", -"oooooooooo...........ooooooooooo", -"oooooooooo...X..XX...ooooooooooo", -"oooooooooo...X ..X...ooooooooooo", -"oooooooooo..........oooooooooooo", -"oooooooooooo.......ooooooooooooo", -"oooooooooooooooooooooooooooooooo", -"oooooooooooooooooooooooooooooooo"}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-catchup-up.xbm --- a/etc/gnus/gnus-summary-catchup-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x11,0x91,0x11,0x95,0x54,0x25,0x54,0x21,0x02,0x90,0x00,0x84,0xa0,0x0a,0x54, - 0x29,0x1b,0xb1,0x11,0x91,0x40,0x0a,0x4a,0x25,0x8a,0xa0,0x20,0x88,0x20,0x14, - 0x0e,0x22,0x9b,0x51,0xb7,0x99,0x20,0x14,0x0b,0x02,0x42,0xc1,0x22,0x28,0x14, - 0x92,0x48,0x45,0x51,0x19,0x11,0x11,0x14,0x42,0xaa,0x54,0x42,0x88,0x00,0x02, - 0x90,0x72,0xaa,0x56,0x15,0x71,0x11,0x17,0x42,0x3a,0x49,0x4b,0x28,0x49,0xa4, - 0x22,0x04,0x30,0x02,0x09,0xb1,0xdb,0x59,0xb5,0x15,0xa0,0xd3,0xff,0x40,0x05, - 0xbf,0x02,0x2a,0xd3,0x08,0x54,0x91,0x53,0x77,0x7f,0xc8,0xa9,0xd4,0x8a,0x62, - 0x22,0x86,0x35,0xc8,0x5b,0x4b,0x67,0x93,0xfd,0x91,0x39,0x24,0x18,0xff,0x7a, - 0x90,0x46,0xc5,0xcf,0x25,0x94,0x21,0xf1}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-catchup-up.xpm --- a/etc/gnus/gnus-summary-catchup-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,37 +0,0 @@ -/* XPM */ -static char * icon-catchup2_xpm[] = { -"32 32 2 1", -" c #000000000000", -". c #BFBFBFBFBFBF s backgroundToolBarColor", -" ... ... ... ... ... ... ... ...", -"................................", -"................................", -"................................", -" ... ... ... ... ... ... ... ...", -"................................", -"................................", -"................. .............", -" ... ... ... ... . ... ... ...", -"................ ..............", -"............... ................", -"................................", -" ... ... ... ... ... ... ... ...", -"................................", -"................................", -"............. .......... .....", -" ... ... ... . ... ... . ...", -"............ .......... ......", -"........... ........... ........", -"............ .......... .......", -" ... ... ... . . ... ... ... ...", -"............... ..... ", -"................ ... ......", -"........ ..... ... ...... .....", -" ... .. .. . . . . .. . .", -"....... .... .... ... .. . ... ", -"...... ...... ... ..... ... ...", -"...... .. .... ...... .. ..", -" ... ... . ... .. .. ..", -"........... .... . .... .", -".......... ..... ..... .. .", -".......... ..... ....... ... "}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-exit-up.xbm --- a/etc/gnus/gnus-summary-exit-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x19,0x51,0x91,0x11,0x82,0x14,0x2a,0x48,0x28,0x42,0x40,0x25,0x82,0x10,0x15, - 0x00,0x59,0xfa,0xff,0x5b,0x12,0x4b,0xfe,0x21,0x40,0x21,0xf1,0x93,0x2a,0x0b, - 0xf8,0x05,0x91,0xb5,0xf2,0x31,0x24,0x01,0xf1,0x4b,0x12,0x54,0xfa,0x01,0x80, - 0x83,0xf0,0x55,0x5b,0x35,0xf2,0x11,0x00,0x8b,0xfe,0x4b,0x2a,0x21,0xf7,0x21, - 0x80,0x0b,0xf6,0x13,0x5b,0xb5,0xf4,0x59,0x10,0x03,0xf1,0x01,0x42,0x2b,0xf4, - 0x55,0x90,0x40,0xf3,0x03,0x13,0x1a,0xf8,0x59,0xa8,0x83,0xf2,0x11,0x02,0x2b, - 0x5c,0x43,0x50,0xe3,0xee,0x10,0x93,0xfc,0x55,0x5b,0x48,0x92,0x92,0x00,0x22, - 0x49,0x48,0xaa,0x08,0x00,0x84,0x00,0xb5,0xbb,0x31,0x5b,0x01,0x00,0x0a,0x00, - 0x54,0x25,0x51,0x55,0x01,0x48,0x04,0x00}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-exit-up.xpm --- a/etc/gnus/gnus-summary-exit-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,37 +0,0 @@ -/* XPM */ -static char * icon-exit-summary_xpm[] = { -"32 32 2 1", -" c #000000000000", -". c #BFBFBFBFBFBF s backgroundToolBarColor", -" ... ... ... ... ... ... ... ...", -"................................", -"................................", -"................................", -" ... ...... ... ...", -"........ ....... .......", -"........ ........... .......", -"........ .......... .......", -" ... ... ... ....... ... ...", -"................ ... .......", -".................... .......", -"........ .......... .......", -" ... ... ... ....... ... ...", -"........ ....... . .......", -"........ ....... . .......", -"........ ....... . .......", -" ... ... ... ....... ... ...", -"........ .......... .......", -"........ ........... .......", -"................ ... .......", -" ... ....... ....... ... ...", -"........ .......... .......", -"........ ........ . . .......", -"........ .... . . . . ........", -" ... .. .. . . . . ... ...", -"................................", -"................................", -"................................", -" ... ... ... ... ... ... ... ...", -"................................", -"................................", -"................................"}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-followup-up.xbm --- a/etc/gnus/gnus-summary-followup-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x00,0x00,0x40,0x08,0xb6,0x76,0x37,0x63,0x20,0x02,0x00,0x04,0x8a,0x48,0x55, - 0x51,0x10,0x22,0x0e,0x82,0xa6,0xaa,0xa9,0x36,0x12,0x62,0x38,0x20,0xa0,0x18, - 0x96,0x4a,0x0a,0x07,0x17,0x00,0xa2,0x01,0xa3,0x76,0x6a,0x80,0x60,0x00,0x60, - 0x00,0x40,0x55,0x52,0x00,0x40,0x00,0xa6,0x00,0x80,0x6b,0x90,0xe1,0x80,0x04, - 0x24,0x9a,0x00,0x51,0x82,0x86,0x01,0x85,0xaa,0x61,0x01,0x32,0x60,0x70,0x01, - 0x42,0x1d,0x30,0x02,0x14,0x04,0x08,0x02,0x4c,0x06,0x00,0x02,0x28,0x06,0x00, - 0x04,0xac,0x08,0x00,0x08,0x0b,0x0a,0x00,0xc8,0x22,0x12,0x00,0x70,0x6a,0x1a, - 0x00,0x10,0x01,0x20,0x00,0x60,0x52,0x32,0x00,0x20,0x08,0x46,0x00,0x40,0x63, - 0x50,0x00,0x40,0x04,0x85,0x00,0x80,0x52}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-followup-up.xpm --- a/etc/gnus/gnus-summary-followup-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -/* XPM */ -static char * icon-followup_xpm[] = { -"32 32 3 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -" ", -" . . . . . . . . ", -" ", -" ", -" ... ", -" . . . . ..XX. . . . ", -" ..XXXX.. ", -" ..XXXX..X. ", -" ..XXXXX...X. ", -" . . ..XXXXXXX..XXX. . . ", -" ..XXXXXXXX.XXXXX. ", -" .XXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXX. ", -" . . .XXXXXXXXXXXXXXX. . . ", -" .XXXX...XXXXXXX. ", -" .X..XX.XXXXXXXX. ", -" ..XXXX..XXXXXXX. ", -" . ..XXXX..X.XXXXXXXX. . ", -" ..XXXXX...X.XXXXXXXX. ", -" ..XXXXXXX..XXX.XXXXXXXX. ", -" .XXXXXXXX.XXXXX.XXXXXXXX. ", -" ..XXXXXXXXXXXXXX.XXXXXXXXX. . ", -" .XXXXXXXXXXXXXXX.XXXXXXX.. ", -" .XXXXXXXXXXXXXXX.XXXX.. ", -" .XXXXXXXXXXXXXXX.XX.. ", -" . .XXXXXXXXXXXXXXX.. . . ", -" .XXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXX. ", -" . .XXXXXXXXXXXXXXX. . . ", -" .XXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXX. "}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-followup-with-original-up.xbm --- a/etc/gnus/gnus-summary-followup-with-original-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x04,0x40,0x10,0x00,0xa3,0x36,0xa6,0x76,0x54,0x40,0x11,0x02,0x01,0x2a,0x88, - 0x48,0x54,0x81,0x22,0x22,0x22,0x6a,0xaa,0x2a,0x4a,0x02,0x21,0xa0,0x90,0x50, - 0x8e,0x0a,0x02,0x0a,0x27,0x50,0xb2,0xa2,0xab,0x26,0x42,0xaa,0x00,0x92,0x94, - 0x00,0xaa,0x20,0x00,0xaa,0x00,0x85,0xb6,0x22,0x76,0x32,0x20,0xea,0x80,0x44, - 0x8a,0x98,0x2a,0x11,0x10,0x87,0x00,0x44,0xa6,0x71,0x6b,0x33,0x60,0xcc,0x22, - 0x44,0x1d,0xe3,0x0a,0x11,0xc8,0xe0,0x24,0x44,0x3e,0x90,0x6c,0x2b,0x08,0x00, - 0x09,0xa0,0x06,0x00,0x49,0x0a,0x04,0x00,0x92,0x50,0x0b,0x00,0x32,0x26,0x0c, - 0x00,0xa4,0x90,0x11,0x00,0x24,0x24,0x14,0x00,0xc8,0x82,0x22,0x00,0x48,0x32, - 0x2a,0x00,0x90,0x42,0x50,0x00,0x90,0x28}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-followup-with-original-up.xpm --- a/etc/gnus/gnus-summary-followup-with-original-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -/* XPM */ -static char * icon-followup-w-orig_xpm[] = { -"32 32 3 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -" ", -" . . . . . . . . ", -" ", -" ", -" ", -" . . . . . . . . ", -" ", -" .. ", -" ... ", -" . . . . .. . . . ", -" . ", -" ", -" ", -" . . . . . . . . ", -" .. ", -" ..XX. ", -" ..XXXX. ", -" . ..XXX...X. . . . ", -" ..XXX..XX..X. ", -" ..XXX..XXX...X. ", -" .XX..XXXXX...XX. ", -" . ...XXXXXX.XX.XX. . . . ", -" .XXXXXXXXXXXX.XX. ", -" .XXXXXXXXXXXXX.XX. ", -" .XXXXXXXXXXXXXX.XX. ", -" . .XXXXXXXXXXXXX.XX. . . ", -" .XXXXXXXXXXXXXX.XX. ", -" .XXXXXXXXXXXXX.XX. ", -" .XXXXXXXXXXXXXX.XX. ", -" . .XXXXXXXXXXXXX.XX. . . ", -" .XXXXXXXXXXXXXX.XX. ", -" .XXXXXXXXXXXXX.XX. "}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-mail-copy-up.xbm --- a/etc/gnus/gnus-summary-mail-copy-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x00,0x20,0x20,0x40,0xaa,0x8a,0x0a,0x15,0xfe,0xff,0xff,0x27,0x0e,0x00,0x80, - 0x4d,0x32,0x00,0x60,0x04,0xc2,0x00,0x18,0x54,0x02,0x03,0x06,0x04,0x03,0x8c, - 0x01,0x54,0x02,0x74,0x02,0x04,0x02,0x03,0x0c,0x54,0x82,0x00,0x10,0x84,0xf2, - 0xff,0xff,0x3f,0x52,0x00,0x00,0x6c,0x9b,0x01,0x00,0x23,0x16,0x06,0xc0,0x60, - 0x1e,0x18,0x30,0x20,0x14,0x60,0x0c,0xa0,0x11,0xa0,0x0b,0x20,0x14,0x10,0x30, - 0x60,0x11,0x0c,0x40,0x20,0x14,0x02,0x80,0xa0,0x12,0x01,0x00,0x23,0xd8,0x00, - 0x00,0x64,0x32,0x00,0x00,0x38,0xf8,0xff,0xff,0xbf,0x02,0x00,0x40,0x24,0x54, - 0x55,0x15,0x11,0x01,0x00,0x40,0x44,0x54,0x55,0x15,0x11,0x01,0x00,0x40,0x44, - 0x54,0x55,0x05,0x11,0x02,0x00,0x50,0x44}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-mail-copy-up.xpm --- a/etc/gnus/gnus-summary-mail-copy-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -/* XPM */ -static char * icon-mail-copy_xpm[] = { -"32 32 3 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -" ", -" ", -" .......................... ", -" ...XXXXXXXXXXXXXXXXXXX..X. ", -" .XX..XXXXXXXXXXXXXXX..XXX. ", -" .XXXX..XXXXXXXXXXX..XXXXX. ", -" .XXXXXX..XXXXXXX..XXXXXXX. ", -" .XXXXXXXX..XXX..XXXXXXXXX. ", -" .XXXXXXXX.X...XX.XXXXXXXX. ", -" .XXXXXX..XXXXXXXX..XXXXXX. ", -" .XXXXX.XXXXXXXXXXXX.XXXXX. ", -" .XX.......................... ", -" .XX.X.XXXXXXXXXXXXXXXXXXX..X. ", -" .X..XX..XXXXXXXXXXXXXXX..XXX. ", -" ..X.XXXX..XXXXXXXXXXX..XXXXX. ", -" ....XXXXXX..XXXXXXX..XXXXXXX. ", -" .XXXXXXXX..XXX..XXXXXXXXX. ", -" .XXXXXXXX.X...X.XXXXXXXXX. ", -" .XXXXXXX.XXXXXXX..XXXXXXX. ", -" .XXXXX..XXXXXXXXXX.XXXXXX. ", -" .XXXX.XXXXXXXXXXXXX.XXXXX. ", -" .XXX.XXXXXXXXXXXXXXX..XXX. ", -" .X..XXXXXXXXXXXXXXXXXX.XX. ", -" ..XXXXXXXXXXXXXXXXXXXXX... ", -" .......................... ", -" ", -" ", -" ", -" ", -" ", -" ", -" "}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-mail-delete-up.xbm --- a/etc/gnus/gnus-summary-mail-delete-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x08,0x00,0x80,0x00,0xa2,0xaa,0x2a,0x54,0x08,0x00,0x40,0x81,0xf2,0xab,0x2a, - 0x28,0x5c,0x03,0x80,0x82,0x2d,0x56,0xf5,0x28,0x84,0x06,0x98,0x8b,0x5d,0x5e, - 0xe7,0x2c,0x1c,0x1f,0x1f,0xba,0xf1,0xf3,0xa7,0xc9,0x44,0xa8,0x90,0x88,0xf1, - 0xf3,0x8b,0x08,0x1c,0x5f,0x7f,0x09,0xad,0x1e,0xff,0x08,0x04,0x46,0x08,0x04, - 0xae,0x26,0x06,0x04,0x18,0x8b,0x02,0x06,0xfa,0x23,0xc1,0x01,0x20,0x88,0x38, - 0x00,0x95,0x62,0x07,0x80,0x40,0xe4,0x00,0x40,0x14,0xd1,0x00,0x20,0x42,0x44, - 0x03,0x60,0x10,0x11,0x05,0x10,0x4a,0x44,0x1c,0xa8,0x00,0x11,0x61,0x0c,0x2a, - 0x42,0xa4,0x25,0x81,0x14,0x09,0x42,0x14,0x20,0x50,0x15,0xa1,0x4a,0x05,0x40, - 0x04,0x00,0xa8,0x0a,0x51,0x55,0x05,0x50}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-mail-delete-up.xpm --- a/etc/gnus/gnus-summary-mail-delete-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,39 +0,0 @@ -/* XPM */ -static char * icon-mail-delete_xpm[] = { -"32 32 4 1", -" c #BEBEBEBEBEBE s backgroundToolBarColor", -"X c #000000000000", -"o c #E7E7E7E7E7E7", -"O c #FFFFFFFFFFFF", -" ", -" ", -" ", -" XXXXX ", -" XX XX ", -" XX XX XXX ", -" X X XXooXX X ", -" XX XXX XXooXX XX ", -" XX XXXXX XXXXX XOXXX ", -" XXXXX XXXXXX XOOXOOXX", -" XOX XOOOXOOOX", -" XXXXX XXXXXX XOOOXOOOO", -" XX XXXXX XXXXXX XOOXOOOO", -" XX XXX XXXXXXXOOOXOOOO", -" X X XOOOOOOXOOOOO", -" XX XX XOOOOOOOXOOOOO", -" XX XX XOOOOOOOXXOOOOO", -" XXXXX XOOOOOXXXOOOOOOO", -" XOOOXXXOOOOOOOOOO", -" XOXXXOOOOOOOOOOOOX", -" XXXOOOOOOOOOOOOOOX ", -" XXOOOOOOOOOOOOOX ", -" XXOOOOOOOOOOOX ", -" XOOOOOOOOOX ", -" XXOOOOOOX ", -" XXOOOX ", -" XXOX ", -" X ", -" ", -" ", -" ", -" "}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-mail-forward-up.xbm --- a/etc/gnus/gnus-summary-mail-forward-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x10,0x42,0x80,0x20,0x84,0x10,0x2a,0x14,0x3a,0xa5,0x40,0x41,0x64,0x08,0x14, - 0x28,0xd6,0xa0,0x62,0x85,0x80,0x15,0xe8,0x20,0xca,0x41,0x39,0x8b,0xb0,0x2a, - 0x24,0x22,0xd2,0x86,0x12,0x86,0x58,0x24,0x11,0x2c,0xd2,0x8c,0x08,0x98,0x34, - 0x75,0x08,0x10,0x30,0x14,0x08,0x60,0x8a,0x0e,0x04,0x20,0x10,0x05,0xfc,0x7f, - 0x45,0x02,0x02,0x60,0x10,0x01,0x03,0x18,0xca,0xe0,0x01,0x44,0x20,0x3e,0x00, - 0x0a,0xf4,0x21,0x00,0x53,0x32,0x20,0x80,0x80,0x10,0x10,0x40,0x2a,0x2a,0x10, - 0xb0,0x80,0x60,0x10,0x28,0x2a,0xea,0x10,0x84,0x40,0x81,0x10,0x2a,0x14,0x94, - 0x11,0x41,0x21,0x21,0xca,0x2a,0x48,0x84,0xac,0x80,0x02,0x21,0x3d,0x54,0x50, - 0x14,0x84,0x00,0x05,0x42,0x21,0xaa,0x50}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-mail-forward-up.xpm --- a/etc/gnus/gnus-summary-mail-forward-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -/* XPM */ -static char * icon-mail-forward_xpm[] = { -"32 32 3 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -" ", -" ", -" ... ", -" . . ", -" . . . ", -" . ... ", -" ... ...XX. ", -" . . . .XX.XXX. ", -" . . . .XX.XXXX.. ", -" . . . .XXX.XXXXX.. ", -" . . . .XXX.XXXXXXX. ", -" .. . ..XXXX.XXXXXXXX. ", -" . . .XXXXXX.XXXXXXXXX. ", -" . .XXXXXX.XXXXXXXXXX. ", -" .XXXXXXX............. ", -" .XXXXXXX.XXXXXXXXXXX. ", -" .XXXXXXX..XXXXXXXXX.. ", -" ..XXXXX....XXXXXXXXX. ", -" .XXX.....XXXXXXXXXXX. ", -" ....XXXX.XXXXXXXXXX. ", -" ..XXXXXXX.XXXXXXXXX. ", -" .XXXXXXX.XXXXXXXXX. ", -" .XXXXXX.XXXXXXX.. ", -" ..XXXXX.XXXXXX. ", -" ..XXXX.XXXXX. ", -" .XXXX.XXXX. ", -" .XXX.XXX. ", -" .X.XX.. ", -" ..X. ", -" ... ", -" ", -" "}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-mail-get-up.xbm --- a/etc/gnus/gnus-summary-mail-get-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x48,0x00,0x11,0x02,0x12,0x54,0x84,0x50,0x40,0x81,0x50,0x82,0x2a,0x28,0x0a, - 0x28,0x80,0x42,0xa0,0x82,0xaa,0x13,0x3d,0x28,0x40,0x46,0xd4,0x42,0xb5,0x28, - 0x86,0x10,0x50,0xda,0x51,0x47,0x99,0xb0,0x09,0x13,0x14,0x50,0x01,0x45,0x21, - 0x18,0x82,0x21,0x74,0x4c,0xc7,0x94,0x81,0x13,0x78,0x02,0x94,0x44,0x05,0x29, - 0xf1,0xff,0xff,0x7f,0x74,0x00,0x00,0x2c,0x91,0x01,0x00,0x23,0x14,0x06,0xc0, - 0xa0,0x11,0x18,0x30,0x20,0x14,0x60,0x0c,0x60,0x12,0x90,0x0b,0x20,0x18,0x0c, - 0x30,0xa0,0x12,0x02,0x40,0x20,0x18,0x01,0x80,0xa0,0xd2,0x00,0x00,0x23,0x38, - 0x00,0x00,0x64,0x12,0x00,0x00,0x38,0xf8,0xff,0xff,0xbf,0x02,0x00,0x00,0x20, - 0xa8,0xaa,0xaa,0x8a,0x05,0x00,0x40,0x20}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-mail-get-up.xpm --- a/etc/gnus/gnus-summary-mail-get-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -/* XPM */ -static char * icon-mail-get_xpm[] = { -"32 32 3 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -" ", -" ", -" ", -" ", -" ", -" ... ... ", -" . . . . ", -" . . . . ", -" . . . . .. ", -" . .. .. .. ", -" .XXXXXXX. .XXXXXXX. ", -" .XXXXX. .XXXXX. ", -" ..XXX.. ..XXX.. ", -" ... ... ", -" ", -" .......................... ", -" ...XXXXXXXXXXXXXXXXXXX..X. ", -" .XX..XXXXXXXXXXXXXXX..XXX. ", -" .XXXX..XXXXXXXXXXX..XXXXX. ", -" .XXXXXX..XXXXXXX..XXXXXXX. ", -" .XXXXXXXX..XXX..XXXXXXXXX. ", -" .XXXXXXX.XX...X.XXXXXXXXX. ", -" .XXXXX..XXXXXXXX..XXXXXXX. ", -" .XXXX.XXXXXXXXXXXX.XXXXXX. ", -" .XXX.XXXXXXXXXXXXXX.XXXXX. ", -" .X..XXXXXXXXXXXXXXXX..XXX. ", -" ..XXXXXXXXXXXXXXXXXXXX.XX. ", -" .XXXXXXXXXXXXXXXXXXXXXX... ", -" .......................... ", -" ", -" ", -" "}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-mail-originate-up.xbm --- a/etc/gnus/gnus-summary-mail-originate-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x04,0x42,0x08,0x10,0xa1,0x10,0x42,0x05,0x14,0xa2,0xff,0xaf,0x01,0x89,0x00, - 0x14,0x54,0xa4,0x00,0x64,0x02,0xc1,0x00,0x3c,0xf8,0xff,0x1f,0xa0,0x6d,0x10, - 0x68,0x20,0xf8,0xff,0x1f,0x60,0x12,0x84,0x00,0x20,0x48,0xd1,0x00,0xa0,0x02, - 0x88,0xfc,0x21,0xfc,0xff,0x00,0x60,0x1e,0x80,0x6c,0x21,0x64,0x80,0x00,0xa0, - 0x86,0x81,0x00,0x20,0x04,0x86,0x00,0x60,0x05,0x98,0x00,0x20,0x04,0xe4,0x00, - 0xa0,0x06,0x83,0x80,0x25,0x84,0x80,0x00,0x60,0x46,0x80,0x00,0x20,0x34,0x80, - 0x00,0xa0,0x0d,0x80,0xff,0x3f,0x04,0x00,0x00,0x2e,0xfe,0xff,0xff,0x4f,0x48, - 0x92,0x44,0x12,0x92,0x08,0x11,0x44,0x00,0x21,0x44,0x11,0x55,0x48,0x21,0x44, - 0x80,0x02,0x8a,0x10,0x2a,0xa8,0x40,0x44}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-mail-originate-up.xpm --- a/etc/gnus/gnus-summary-mail-originate-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -/* XPM */ -static char * icon-mail-originate_xpm[] = { -"32 32 3 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -" ", -" ", -" ............. ", -" .XXXXXXXXXX.X. ", -" .XXXXXXXXXX.XX. ", -" .XXXXXXXXXX.... ", -" ..................XXXXXXXX. ", -" .X. X X X X X X .X..XXXXXX. ", -" ..................XXXXXXXX. ", -" .XXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXX. ", -" .XX.......XXXX. ", -" ..............XXXXXXXXXXXXX. ", -" ...XXXXXXXXXX.XX..X..X.XXXX. ", -" .XX..XXXXXXXX.XXXXXXXXXXXXX. ", -" .XXXX..XXXXXX.XXXXXXXXXXXXX. ", -" .XXXXXX..XXXX.XXXXXXXXXXXXX. ", -" .XXXXXXXX..XX.XXXXXXXXXXXXX. ", -" .XXXXXXX.XX...XXXXXXXXXXXXX. ", -" .XXXXX..XXXXX.XXXXXXX..X.XX. ", -" .XXXX.XXXXXXX.XXXXXXXXXXXXX. ", -" .XXX.XXXXXXXX.XXXXXXXXXXXXX. ", -" .X..XXXXXXXXX.XXXXXXXXXXXXX. ", -" ..XXXXXXXXXXX............... ", -" .XXXXXXXXXXXXXXXXXXXXXX... ", -" .......................... ", -" ", -" ", -" ", -" ", -" ", -" "}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-mail-reply-up.xbm --- a/etc/gnus/gnus-summary-mail-reply-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x00,0x40,0x40,0x20,0xaa,0x2a,0x7a,0x0a,0x00,0x80,0x88,0x51,0xaa,0x2a,0x06, - 0x06,0x00,0xc0,0x05,0x58,0xaa,0x3a,0x12,0x08,0x00,0x0c,0x11,0x2c,0xaa,0x03, - 0x09,0x42,0xc0,0x80,0x04,0x06,0x35,0x40,0x04,0x57,0x98,0x49,0x80,0x18,0x3a, - 0x20,0x41,0x56,0xc8,0x10,0xc1,0x11,0x0c,0x93,0x60,0x50,0x0a,0x1c,0x18,0x90, - 0x08,0x30,0x06,0x30,0x0a,0xc8,0x05,0x90,0x08,0x06,0x18,0x30,0x0a,0x01,0x20, - 0x10,0x88,0x00,0x40,0x50,0x6a,0x00,0x80,0x11,0x19,0x00,0x00,0x52,0x0c,0x00, - 0x00,0x1c,0xf9,0xff,0xff,0x5f,0x44,0x44,0x44,0x24,0x11,0x11,0x11,0x09,0x44, - 0x44,0x44,0xa0,0x11,0x11,0x11,0x15,0x44,0x44,0x44,0x40,0x11,0x11,0x91,0x14, - 0x44,0x44,0x04,0xa2,0x11,0x22,0xa2,0x08}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-mail-reply-up.xpm --- a/etc/gnus/gnus-summary-mail-reply-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -/* XPM */ -static char * icon-mail-reply_xpm[] = { -"32 32 3 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -" ", -" ... ", -" .XXX.. ", -" .XXXXXX.. ", -" ... .XXXXXXXX. ", -" ..XXX.XX.XXXXXX. ", -" ..XXXX.XXX.XXXXX. ", -" ..XXXXXX.XX.XXXXX. ", -" ..XXXXXXX.XX.XXXXXX. ", -" .XXXXXXXX.XXX.XXXXX... ", -" ..XX..XX.XX.XXXXXXXX.XXX.. ", -" ...XXXXXXX.XX.XXXXX.XX..X. ", -" .XX..XXXX.XXX.XXXXX...XXX. ", -" .XXXX..XX.XX.XXXXX..XXXXX. ", -" .XXXXXX...XXXXXX..XXXXXXX. ", -" .XXXXXXXX..XXX..XXXXXXXXX. ", -" .XXXXXXX.XX...X.XXXXXXXXX. ", -" .XXXXX..XXXXXXXX..XXXXXXX. ", -" .XXXX.XXXXXXXXXXXX.XXXXXX. ", -" .XXX.XXXXXXXXXXXXXX.XXXXX. ", -" .X..XXXXXXXXXXXXXXXX..XXX. ", -" ..XXXXXXXXXXXXXXXXXXXX.XX. ", -" .XXXXXXXXXXXXXXXXXXXXXX... ", -" .......................... ", -" ", -" ", -" ", -" ", -" ", -" ", -" ", -" "}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-mail-save-up.xbm --- a/etc/gnus/gnus-summary-mail-save-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x00,0x10,0x10,0x00,0x55,0x45,0x45,0x55,0x00,0x10,0x08,0x00,0xd4,0xff,0xff, - 0x7f,0x82,0x03,0x00,0xf0,0xd0,0x0c,0x00,0x4c,0x82,0x30,0x00,0x43,0xd4,0xc0, - 0xc0,0x40,0x80,0x80,0x33,0xc0,0xaa,0x60,0xcc,0x40,0xc0,0x10,0x00,0x41,0x95, - 0x08,0x00,0x46,0xc0,0x06,0x00,0xd8,0xfe,0xff,0x0f,0x60,0x2c,0x00,0x0b,0x40, - 0x35,0x10,0xfd,0x7f,0x2c,0x02,0x2b,0x49,0x35,0x40,0x4d,0x12,0xac,0x00,0x0b, - 0xa0,0x35,0x00,0xad,0x0a,0x2c,0x24,0x09,0x90,0x2d,0x00,0x5d,0x25,0xf4,0xff, - 0x0b,0x80,0xa6,0x55,0xad,0x2a,0x4c,0xaa,0x08,0x40,0xf5,0xff,0x5d,0x15,0x6c, - 0x35,0x0b,0x20,0x66,0x37,0xab,0x4a,0x6c,0x2d,0x0d,0x00,0xb9,0x35,0x4b,0x55, - 0xf4,0xff,0x1f,0x80,0x01,0x40,0x80,0x2a}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-mail-save-up.xpm --- a/etc/gnus/gnus-summary-mail-save-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,41 +0,0 @@ -/* XPM */ -static char * icon-save-mail_xpm[] = { -"32 32 6 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -"o c #999999999999", -"O c #E5E5E5E5E5E5", -"+ c #666666666666", -" ", -" ", -" ", -" ........................ ", -" ...XXXXXXXXXXXXXXXXXX... ", -" .XX..XXXXXXXXXXXXXX..XX. ", -" .XXXX..XXXXXXXXXX..XXXX. ", -" .XXXXXX..XXXXXX..XXXXXX. ", -" .XXXXXXX...XX..XXXXXXXX. ", -" .XXXXX..XXX..XX..XXXXXX. ", -" .XXXX.XXXXXXXXXXX.XXXXX. ", -" .XXX.XXXXXXXXXXXXX..XXX. ", -" .X..XXXXXXXXXXXXXXXX..X. ", -" ..................XXXXXXXXX.. ", -" .oo.OOOOOOOOOO.oo.XXXXXXXXXX. ", -" .oo.OOOOOOOOOO.oo............ ", -" .oo.OOOOOOOOOO.oo. ", -" .oo.OOOOOOOOOO.oo. ", -" .oo.OOOOOOOOOO.oo. ", -" .oo.OOOOOOOOOO.oo. ", -" .oo.OOOOOOOOOO.oo. ", -" .oo.OOOOOOOOOO.oo. ", -" .oo............oo. ", -" .oooooooooooooooo. ", -" .oooooooooooooooo. ", -" .oo............oo. ", -" .oo.+++++++.OO.oo. ", -" .oo.+++++++.OO.oo. ", -" .oo.+++++++.OO.oo. ", -" .o.+++++++.OO.oo. ", -" ................ ", -" "}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-next-unread-up.xbm --- a/etc/gnus/gnus-summary-next-unread-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x08,0x10,0x20,0x00,0xa3,0x66,0xab,0x76,0x14,0x11,0x04,0x02,0x41,0x04,0xa1, - 0x48,0x14,0x51,0x1e,0x22,0x62,0xa6,0xa9,0x2a,0x0a,0x71,0x18,0xa0,0x40,0x18, - 0xb6,0x0a,0x8a,0x06,0x17,0x50,0xb2,0x01,0x63,0x27,0x62,0x80,0x20,0x90,0x50, - 0x00,0x40,0x25,0x4a,0x00,0x40,0x80,0xe2,0x00,0x80,0x36,0x12,0xe1,0x80,0x41, - 0x84,0x9a,0x00,0x29,0x10,0x87,0x01,0x85,0xa6,0x61,0x01,0x32,0x62,0x70,0x01, - 0x42,0x18,0x30,0x02,0x14,0x06,0x08,0x02,0x4c,0x06,0x00,0x02,0x28,0x04,0x00, - 0x04,0xac,0xca,0x07,0x7c,0x0b,0x68,0x0d,0xea,0x20,0x1b,0x12,0x93,0x6b,0xb4, - 0x54,0x29,0x03,0x91,0xba,0x95,0x51,0x74,0x19,0x53,0x0b,0x6a,0x0a,0xd6,0x62, - 0xe0,0x07,0x7c,0x09,0x8a,0x00,0x80,0x42}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-next-unread-up.xpm --- a/etc/gnus/gnus-summary-next-unread-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,39 +0,0 @@ -/* XPM */ -static char * icon-next-unread_xpm[] = { -"32 32 4 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -"o c #999999999999", -" ", -" . . . . . . . . ", -" ", -" ", -" ... ", -" . . . . ..XX. . . . ", -" ..XXXX.. ", -" ..XXXX..X. ", -" ..XXXXX...X. ", -" . . ..XXXXXXX..XXX. . . ", -" ..XXXXXXXX.XXXXX. ", -" .XXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXX. ", -" . . .XXXXXXXXXXXXXXX. . . ", -" .XXXX...XXXXXXX. ", -" .X..XX.XXXXXXXX. ", -" ..XXXX..XXXXXXX. ", -" . ..XXXX..X.XXXXXXXX. . ", -" ..XXXXX...X.XXXXXXXX. ", -" ..XXXXXXX..XXX.XXXXXXXX. ", -" .XXXXXXXX.XXXXX.XXXXXXXX. ", -" ..XXXXXXXXXXXXXX.XXXXXXXXX. . ", -" .XXXXXXXXXXXXXXX.XXXXXXX.. ", -" .XX.....XXXXXXX.....X.. ", -" .X.ooooo.XXXXX.oooo.. ", -" . .oXooooo.XXX.oXooooo.. . ", -" .ooooooo.X.X.ooooooo. ", -" .ooooooo..X..ooooooo. ", -" ..oooooo.XXX.ooooooo. ", -" . ..oooo.XXXXX.oooo.. . . ", -" .....XXXXXXX..... ", -" .XXXXXXXXXXXXXXX. "}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-post-news-up.xbm --- a/etc/gnus/gnus-summary-post-news-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x00,0x10,0x10,0x01,0x6b,0xa7,0x66,0x72,0x04,0x10,0x02,0x05,0xa1,0x8a,0x50, - 0x48,0x04,0x20,0x8f,0x20,0x72,0xab,0x39,0x2b,0x02,0x64,0x58,0xa4,0x50,0x19, - 0x16,0x01,0x0a,0x06,0x57,0x54,0xe2,0x01,0x23,0x23,0x72,0x80,0x20,0x94,0x44, - 0x00,0x40,0x01,0x50,0x00,0xc0,0x54,0xa6,0x00,0x80,0x22,0x92,0x00,0x80,0x4a, - 0x40,0x01,0x00,0x11,0x8a,0x01,0x00,0x45,0x32,0x02,0x00,0x2a,0x42,0x02,0x00, - 0xa2,0x10,0x05,0x00,0x0c,0x4a,0x06,0x00,0x24,0x22,0x0a,0x00,0x68,0xaa,0x0c, - 0x00,0x0c,0x00,0x11,0x80,0x53,0x2a,0x14,0x40,0x05,0x22,0x23,0x70,0x62,0x92, - 0x34,0x0e,0x09,0x24,0xc0,0x4b,0x52,0x80,0x0a,0x21,0x80,0x6b,0x62,0xaa,0x36, - 0x04,0x15,0x01,0x42,0x51,0x80,0xa8,0x28}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-post-news-up.xpm --- a/etc/gnus/gnus-summary-post-news-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -/* XPM */ -static char * icon-post_xpm[] = { -"32 32 3 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -" ", -" . . . . . . . . ", -" ", -" ", -" ... ", -" . . . . ..XX. . . . ", -" ..XXXX.. ", -" ..XXXX..X. ", -" ..XXXXX...X. ", -" . . ..XXXXXXX..XXX. . . ", -" ..XXXXXXXX.XXXXX. ", -" .XXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXX. ", -" . . .XXXXXXXXXXXXXXX. . . ", -" .XXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXX. ", -" . . .XXXXXXXXXXXXXXX. . ", -" .XXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXX. ", -" . . . .XXXXXXXXXXXXXXX. . ", -" .XXXXXXXXXXXXXX.. ", -" .XXXXXXXXXX... ", -" .XXXXXXXXX. ", -" . . . .XXXXXX.. . . ", -" .XXX... ", -" .... ", -" ", -" . . . . . . . . ", -" ", -" "}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-prev-unread-up.xbm --- a/etc/gnus/gnus-summary-prev-unread-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x08,0x08,0x40,0x20,0x23,0x63,0x2b,0x2b,0x54,0x14,0x24,0xa4,0x01,0x02,0x09, - 0x01,0x54,0xa9,0x2e,0x2a,0x22,0xa2,0xa9,0x62,0x4a,0x6a,0x18,0x12,0x90,0x18, - 0xb6,0x04,0x02,0x06,0x17,0x50,0xea,0x01,0x63,0x2b,0x64,0x80,0x20,0x44,0x51, - 0x00,0x40,0x21,0x44,0x00,0x40,0x8a,0xe2,0x00,0xc0,0x22,0x0a,0xe1,0xc0,0x2f, - 0xd0,0x9f,0x20,0x4d,0x42,0x87,0xb1,0x1a,0xea,0x61,0x15,0x72,0x60,0x70,0xbb, - 0x14,0x1d,0x30,0xb1,0x5a,0x04,0x08,0x22,0x0d,0x06,0x00,0xc2,0x6f,0x06,0x00, - 0x84,0x20,0x08,0x00,0x64,0x0a,0x0a,0x00,0x58,0x50,0x12,0x00,0x10,0x27,0x1a, - 0x00,0x50,0x90,0x20,0x00,0xa0,0x24,0x32,0x00,0x20,0x82,0x26,0x00,0xc0,0x32, - 0x40,0x00,0x40,0x44,0xaa,0x00,0x80,0x11}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-prev-unread-up.xpm --- a/etc/gnus/gnus-summary-prev-unread-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,39 +0,0 @@ -/* XPM */ -static char * icon-prev-unread_xpm[] = { -"32 32 4 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -"o c #999999999999", -" ", -" . . . . . . . . ", -" ", -" ", -" ... ", -" . . . . ..XX. . . . ", -" ..XXXX.. ", -" ..XXXX..X. ", -" ..XXXXX...X. ", -" . . ..XXXXXXX..XXX. . . ", -" ..XXXXXXXX.XXXXX. ", -" .XXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXX. ", -" . . .XXXXXXXXXXXXXX. . . ", -" .XXXX...XXXXXX..... ", -" ...o..XX.XXXXX.oooo.. ", -" .oo..XXXX..XXX.oXooooo. ", -" . .o..XXXX..X.X.X.ooooooo.. ", -" ..XXXXX...X..X..ooooooo. ", -" ..XXXXXXX..XX.XXX.ooooooo. ", -" .XXXXXXXX.XXXXX.XXX.oooo.. ", -" ..XXXXXXXXXXXXXX.XXXX..... . ", -" .XXXXXXXXXXXXXXX.XXXX. ", -" .XXXXXXXXXXXXXX.XX.. ", -" .XXXXXXXXXXXXXXX.. ", -" . .XXXXXXXXXXXXXXX. . . ", -" .XXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXX. ", -" . .XXXXXXXXXXXXXXXX. . . ", -" .XXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXX. "}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-reply-up.xbm --- a/etc/gnus/gnus-summary-reply-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x10,0x00,0x11,0x88,0x45,0x55,0x84,0x22,0x08,0x80,0x10,0x88,0x42,0x55,0xa4, - 0x22,0x28,0x00,0x01,0x84,0x05,0x55,0x5a,0x21,0x50,0x00,0x35,0x8a,0x09,0xf5, - 0xc2,0x20,0x24,0x18,0x81,0x85,0x01,0x87,0x00,0x2a,0xd4,0x41,0x00,0x43,0x61, - 0x40,0x80,0x17,0x1c,0x20,0x80,0x58,0xb5,0x1a,0xc0,0x3f,0x0c,0x08,0x60,0xb0, - 0x75,0x08,0xb0,0x2e,0x84,0x04,0xb8,0xa1,0x06,0x03,0x4c,0x20,0x04,0x0c,0x36, - 0x60,0x06,0x10,0x0f,0x20,0x06,0x70,0x07,0x60,0x05,0xc8,0x09,0xa0,0x04,0x04, - 0x10,0xa0,0x06,0x02,0x20,0x60,0x85,0x01,0xc0,0xa0,0x44,0x00,0x00,0x61,0x25, - 0x00,0x00,0x22,0x1e,0x00,0x00,0xbc,0x0e,0x00,0x00,0x70,0xfd,0xff,0xff,0x3f, - 0x94,0x52,0x55,0x55,0x4a,0x29,0x22,0xa2}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-reply-up.xpm --- a/etc/gnus/gnus-summary-reply-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,39 +0,0 @@ -/* XPM */ -static char * icon-follow-up_xpm[] = { -"32 32 4 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -"o c #999999999999", -" ", -" ", -" ", -" ", -" ", -" . ", -" .X.. ", -" ... .XXXX. ", -" ..XXX.XXXXXX.. ", -" ..XXXX.XXXXXXXXX. ", -" ..XXXXX.XXXXXXXXX.. ", -" ..XXXXXXX.XXXXXXXX.... ", -" ..XXXXXXXX.XXXXXXXXX.oXX.. ", -" .X..X.X.X..XXXXXXXXX..o...o. ", -" ..XXXXXXX.XXXXXXXXX..ooXXX.. ", -" .X...XXXX.XXXXXXXX..ooX...X. ", -" .XXXX.XX.XXXXXXXX..oX..XXXX. ", -" .XXXXX..XXXXXXXX..oX.XXXXXX. ", -" .XXXXXXX..XXXXX..X..XXXXXXX. ", -"oo.XXXXXXXXX.XXX....XXXXXXXXX.oo", -"oo.XXXXXXXXX...X...XXXXXXXXXX.oo", -"oo.XXXXXXXX.XX...XX.XXXXXXXXX.oo", -"oo.XXXXXXX.XXXXXXXXX.XXXXXXXX.oo", -"oo.XXXXXX.XXXXXXXXXXX.XXXXXXX.oo", -"oo.XXXX..XXXXXXXXXXXXX..XXXXX.oo", -"oo.XXX.XXXXXXXXXXXXXXXXX.XXXX.oo", -"oo.XX.XXXXXXXXXXXXXXXXXXX.XXX.oo", -"oo...XXXXXXXXXXXXXXXXXXXXX....oo", -"oo..XXXXXXXXXXXXXXXXXXXXXXXX..oo", -"oo............................oo", -"oooooooooooooooooooooooooooooooo", -"oooooooooooooooooooooooooooooooo"}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-reply-with-original-up.xbm --- a/etc/gnus/gnus-summary-reply-with-original-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x00,0x08,0x00,0x20,0xaa,0x82,0xaa,0x4a,0x00,0x54,0x00,0x00,0xaa,0x02,0x54, - 0x55,0x00,0xa8,0x07,0x00,0x54,0x85,0x5a,0x55,0x02,0x50,0x32,0x80,0x50,0x25, - 0xc2,0x2a,0x02,0x18,0x81,0x41,0x54,0x17,0x01,0x17,0x80,0x09,0xc1,0x23,0x75, - 0x04,0x3d,0x4f,0x18,0xc3,0x83,0x18,0x85,0x40,0xc0,0x61,0x4c,0x7c,0x60,0x30, - 0xf6,0x23,0xb0,0x6e,0x84,0x20,0x98,0x21,0x05,0x13,0x5c,0x20,0x04,0x1c,0x36, - 0x60,0x06,0x30,0x0f,0x60,0x06,0x70,0x07,0xa0,0x05,0xc8,0x09,0x20,0x06,0x04, - 0x10,0x60,0x04,0x02,0x20,0xa0,0x85,0x01,0xc0,0x20,0x46,0x00,0x00,0xa1,0x24, - 0x00,0x00,0x62,0x1e,0x00,0x00,0x7c,0x0d,0x00,0x00,0xb0,0xfc,0xff,0xff,0x3f, - 0x55,0x55,0x4a,0x55,0x24,0x89,0x52,0xa2}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-reply-with-original-up.xpm --- a/etc/gnus/gnus-summary-reply-with-original-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,39 +0,0 @@ -/* XPM */ -static char * icon-follow-up-incl_xpm[] = { -"32 32 4 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -"o c #999999999999", -" ", -" ", -" ", -" ", -" ... ", -" .X.X. ", -" .XX.XX.. ", -" .XXX.XXXX. ", -" ..XXX.XXXXXX.. ", -" ..X.XXX.XXXXXXX.. ", -" ..XX.XXXX.XXXXX.... ", -" ..XXX.XXXXX.X....XX... ", -" ..XXX..XXXX....XXXXX.oXX.. ", -" .XXXX.XXXXXX.XXXXXXX..oXXXo. ", -" ..XX.XXX.....XXXXXX..ooXXX.. ", -" .X......XXX.XXXXXX..ooX...X. ", -" .XXXX.XXXXX.XXXXX..oX..XXXX. ", -" .XXXXX..XX.XXXXX..oX.XXXXXX. ", -" .XXXXXXX...XXXX..X..XXXXXXX. ", -"oo.XXXXXXXXX..XX....XXXXXXXXX.oo", -"oo.XXXXXXXXX...X...XXXXXXXXXX.oo", -"oo.XXXXXXXX.XX...XX.XXXXXXXXX.oo", -"oo.XXXXXXX.XXXXXXXXX.XXXXXXXX.oo", -"oo.XXXXXX.XXXXXXXXXXX.XXXXXXX.oo", -"oo.XXXX..XXXXXXXXXXXXX..XXXXX.oo", -"oo.XXX.XXXXXXXXXXXXXXXXX.XXXX.oo", -"oo.XX.XXXXXXXXXXXXXXXXXXX.XXX.oo", -"oo...XXXXXXXXXXXXXXXXXXXXX....oo", -"oo..XXXXXXXXXXXXXXXXXXXXXXXX..oo", -"oo............................oo", -"oooooooooooooooooooooooooooooooo", -"oooooooooooooooooooooooooooooooo"}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-save-article-file-up.xbm --- a/etc/gnus/gnus-summary-save-article-file-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x20,0x08,0x08,0x82,0x8a,0x82,0xa2,0x20,0x20,0x14,0x04,0x15,0x14,0xfd,0xff, - 0x43,0x42,0x04,0x00,0x0d,0x10,0x05,0x00,0x49,0x22,0x06,0x00,0x31,0x88,0x04, - 0x00,0x1f,0x22,0x06,0x00,0x50,0x88,0x04,0x00,0x10,0x22,0x04,0x00,0xb0,0x88, - 0x06,0x00,0x10,0x22,0x04,0x00,0x50,0xfc,0xff,0x0f,0x10,0x36,0x00,0x0b,0xb0, - 0x2c,0x02,0x0d,0x10,0x34,0x10,0x0b,0x50,0x2d,0x00,0x0b,0x10,0x34,0x41,0x0d, - 0xb0,0x2d,0x08,0x09,0x10,0x34,0x00,0x0b,0x50,0x2d,0x01,0x0d,0x10,0xf4,0xff, - 0x0b,0xb0,0xad,0xda,0x0a,0x10,0x44,0x22,0x0d,0x50,0xf6,0xff,0xf9,0x1f,0x6c, - 0x3b,0x4b,0x52,0xb5,0x2d,0x1d,0x08,0x6c,0x35,0x4b,0xa1,0x6a,0x3b,0x29,0x14, - 0xf8,0xff,0x8f,0x40,0x02,0x40,0x2a,0x15}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-save-article-file-up.xpm --- a/etc/gnus/gnus-summary-save-article-file-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,41 +0,0 @@ -/* XPM */ -static char * icon-save-text_xpm[] = { -"32 32 6 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -"o c #999999999999", -"O c #E5E5E5E5E5E5", -"+ c #666666666666", -" ", -" ", -" ", -" ................ ", -" .XXXXXXXXXXXXX.X. ", -" .XXXXXXXXXXXXX.XX. ", -" .XXXXXXXXXXXXX.XXX. ", -" .XXXXXXXXXXXXX..... ", -" .XXXXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXXXX. ", -" ..................XXXXXXXX. ", -" .oo.OOOOOOOOOO.oo.XXXXXXXX. ", -" .oo.OOOOOOOOOO.oo.XXXXXXXX. ", -" .oo.OOOOOOOOOO.oo.XXXXXXXX. ", -" .oo.OOOOOOOOOO.oo.XXXXXXXX. ", -" .oo.OOOOOOOOOO.oo.XXXXXXXX. ", -" .oo.OOOOOOOOOO.oo.XXXXXXXX. ", -" .oo.OOOOOOOOOO.oo.XXXXXXXX. ", -" .oo.OOOOOOOOOO.oo.XXXXXXXX. ", -" .oo............oo.XXXXXXXX. ", -" .oooooooooooooooo.XXXXXXXX. ", -" .oooooooooooooooo.XXXXXXXX. ", -" .oo............oo.......... ", -" .oo.+++++++.OO.oo. ", -" .oo.+++++++.OO.oo. ", -" .oo.+++++++.OO.oo. ", -" .o.+++++++.OO.oo. ", -" ................ ", -" "}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-save-article-up.xbm --- a/etc/gnus/gnus-summary-save-article-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x10,0x81,0x04,0x01,0x45,0x28,0x40,0x50,0x88,0x42,0x15,0x05,0xa2,0xff,0xff, - 0x7f,0x88,0x03,0x00,0xf0,0xa2,0x0c,0x00,0x4c,0x88,0x30,0x00,0x43,0xc5,0xc0, - 0xc0,0x40,0x90,0x80,0x33,0xc0,0xa4,0x60,0xcc,0x40,0x82,0x10,0x00,0x41,0xd0, - 0x08,0x00,0x46,0x82,0x06,0x00,0xd8,0xfc,0xff,0x0f,0x60,0x2e,0x00,0x0d,0x40, - 0x34,0x02,0xfb,0x7f,0x36,0x10,0x0d,0x91,0xac,0x00,0x4b,0x24,0x34,0x00,0x2d, - 0x81,0x2d,0x48,0x4b,0x28,0x34,0x02,0x0d,0x85,0x2d,0x00,0xab,0x20,0xf4,0xff, - 0x0d,0x8a,0xa6,0xaa,0xaa,0x20,0x4c,0x55,0x0a,0x85,0xf5,0xff,0x5b,0x20,0x6c, - 0x35,0x8d,0x8a,0xad,0x36,0x2b,0x20,0xf4,0x2a,0x89,0x8a,0x6a,0x3b,0x5d,0x20, - 0xf8,0xff,0x0f,0x85,0x02,0x40,0xa2,0x20}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-summary-save-article-up.xpm --- a/etc/gnus/gnus-summary-save-article-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,41 +0,0 @@ -/* XPM */ -static char * icon-save-mail_xpm[] = { -"32 32 6 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -"o c #999999999999", -"O c #E5E5E5E5E5E5", -"+ c #666666666666", -" ", -" ", -" ", -" ........................ ", -" ...XXXXXXXXXXXXXXXXXX... ", -" .XX..XXXXXXXXXXXXXX..XX. ", -" .XXXX..XXXXXXXXXX..XXXX. ", -" .XXXXXX..XXXXXX..XXXXXX. ", -" .XXXXXXX...XX..XXXXXXXX. ", -" .XXXXX..XXX..XX..XXXXXX. ", -" .XXXX.XXXXXXXXXXX.XXXXX. ", -" .XXX.XXXXXXXXXXXXX..XXX. ", -" .X..XXXXXXXXXXXXXXXX..X. ", -" ..................XXXXXXXXX.. ", -" .oo.OOOOOOOOOO.oo.XXXXXXXXXX. ", -" .oo.OOOOOOOOOO.oo............ ", -" .oo.OOOOOOOOOO.oo. ", -" .oo.OOOOOOOOOO.oo. ", -" .oo.OOOOOOOOOO.oo. ", -" .oo.OOOOOOOOOO.oo. ", -" .oo.OOOOOOOOOO.oo. ", -" .oo.OOOOOOOOOO.oo. ", -" .oo............oo. ", -" .oooooooooooooooo. ", -" .oooooooooooooooo. ", -" .oo............oo. ", -" .oo.+++++++.OO.oo. ", -" .oo.+++++++.OO.oo. ", -" .oo.+++++++.OO.oo. ", -" .o.+++++++.OO.oo. ", -" ................ ", -" "}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-uu-decode-uu-up.xbm --- a/etc/gnus/gnus-uu-decode-uu-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x00,0x08,0x10,0x01,0xaa,0x42,0x45,0x54,0x00,0x14,0x10,0x01,0x55,0x41,0x45, - 0x50,0x00,0x0a,0x88,0x0a,0xaa,0xa0,0x22,0x40,0x80,0xff,0xff,0x17,0xaa,0x95, - 0x54,0x43,0x80,0x2a,0xa5,0x0a,0xaa,0xfd,0x7f,0x53,0xc0,0x06,0x40,0x06,0x94, - 0x04,0x40,0x43,0xc2,0x05,0xc0,0x2a,0x90,0x86,0xc0,0x06,0xa2,0x64,0x4b,0x53, - 0x88,0x96,0x44,0x06,0xd2,0x45,0xc0,0x52,0x84,0x25,0xc1,0x06,0x90,0xe6,0x41, - 0x53,0x8a,0x05,0x42,0x06,0xa0,0x06,0xc4,0x52,0x95,0x04,0xc0,0x06,0xc0,0x05, - 0x40,0x53,0x94,0x06,0x40,0x06,0xa2,0x05,0xc0,0x52,0x88,0xfc,0xff,0x06,0xa2, - 0x95,0x12,0x53,0x88,0x4a,0xa9,0x06,0xa2,0xff,0xff,0x53,0x90,0x10,0x00,0x04, - 0x42,0x42,0x55,0x50,0x14,0x28,0x80,0x0a}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-uu-decode-uu-up.xpm --- a/etc/gnus/gnus-uu-decode-uu-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,39 +0,0 @@ -/* XPM */ -static char * icon-decode-view_xpm[] = { -"32 32 4 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #999999999999", -"o c #FFFFFFFFFFFF", -" ", -" ", -" ", -" ", -" ", -" ", -" ................... ", -" .XXXXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXXXX. ", -" .XX.............XX. ", -" .XX.ooooooooooo.XX. ", -" .XX.ooooooooooo.XX. ", -" .XX.ooooooooooo.XX. ", -" .XX.oooo.oooooo.XX. ", -" .XX.oo..o..o.oo.XX. ", -" .XX.o.oo.oo.ooo.XX. ", -" .XX.ooo.ooooooo.XX. ", -" .XX.oo.oo.ooooo.XX. ", -" .XX.oo....ooooo.XX. ", -" .XX.oooooo.oooo.XX. ", -" .XX.ooooooo.ooo.XX. ", -" .XX.ooooooooooo.XX. ", -" .XX.ooooooooooo.XX. ", -" .XX.ooooooooooo.XX. ", -" .XX.ooooooooooo.XX. ", -" .XX.............XX. ", -" .XXXXXXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXXXXXX. ", -" ................... ", -" ", -" ", -" "}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-uu-post-news-up.xbm --- a/etc/gnus/gnus-uu-post-news-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x11,0x11,0x19,0x51,0x4a,0x95,0x82,0x14,0x20,0x40,0x29,0x42,0x0a,0xd5,0x86, - 0x10,0x31,0x31,0x3b,0x53,0x08,0x9d,0xe8,0x10,0xa2,0x43,0x82,0x4b,0x88,0xff, - 0xff,0x03,0xb3,0xaa,0x54,0xbb,0x88,0x55,0xaa,0x02,0xa2,0xfc,0x7f,0x4b,0x88, - 0x06,0xc0,0x12,0xb1,0x05,0x40,0x56,0x8a,0x05,0x40,0x03,0xd0,0x86,0xc0,0xaa, - 0x85,0x64,0x4b,0x06,0xb1,0x95,0xc4,0x32,0x8a,0x46,0x40,0x4b,0xd0,0x24,0x41, - 0x03,0x84,0xe6,0xc1,0x56,0xd9,0x05,0x42,0x12,0x82,0x04,0x44,0x4b,0x94,0x07, - 0xc0,0x22,0xc1,0x04,0x40,0x16,0x95,0x05,0xc0,0x52,0xa0,0x06,0x40,0x13,0x8a, - 0xfd,0xff,0x46,0xd0,0x94,0x52,0x12,0x93,0x29,0xa5,0x5a,0xa4,0xff,0xff,0x03, - 0x10,0x02,0x08,0x55,0x85,0xa8,0xa2,0x00}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus-uu-post-news-up.xpm --- a/etc/gnus/gnus-uu-post-news-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,39 +0,0 @@ -/* XPM */ -static char * icon-post-pic_xpm[] = { -"32 32 4 1", -" c #000000000000", -". c #BFBFBFBFBFBF s backgroundToolBarColor", -"X c #999999999999", -"o c #FFFFFFFFFFFF", -" ... ... ... ... ... ... ... ...", -"................................", -"................ ...............", -".............. . .............", -" ... ... ... .. .. ... ... ...", -".......... ......... .........", -"........ ............. .......", -"....... ......", -" ... .. XXXXXXXXXXXXXXXXX .. ...", -"....... XXXXXXXXXXXXXXXXX ......", -"....... XX XX ......", -"....... XX ooooooooooo XX ......", -" ... .. XX ooooooooooo XX .. ...", -"....... XX ooooooooooo XX ......", -"....... XX oooo oooooo XX ......", -"....... XX oo o o oo XX ......", -" ... .. XX o oo oo ooo XX .. ...", -"....... XX ooo ooooooo XX ......", -"....... XX oo oo ooooo XX ......", -"....... XX oo ooooo XX ......", -" ... .. XX oooooo oooo XX .. ...", -"....... XX ooooooo ooo XX ......", -"....... XX ooooooooooo XX ......", -"....... XX ooooooooooo XX ......", -" ... .. XX ooooooooooo XX .. ...", -"....... XX ooooooooooo XX ......", -"....... XX XX ......", -"....... XXXXXXXXXXXXXXXXX ......", -" ... .. XXXXXXXXXXXXXXXXX .. ...", -"....... ......", -"................................", -"................................"}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus.xbm --- a/etc/gnus/gnus.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,622 +0,0 @@ -#define noname_width 271 -#define noname_height 273 -static char noname_bits[] = { - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xfa,0xff,0xff,0x7f,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x49,0xe0,0xff, - 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0x97,0xaa,0x8a,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0x57,0x2a,0x41,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa9,0x52,0x16,0xfe,0x7f,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x4a,0x49,0x05, - 0xf9,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0x7f,0x95,0xaa,0x58,0xf4,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0x7f,0xa5,0x54,0x26,0xe1,0x7f,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x54,0x49,0x49,0xe4,0x7f,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x2a,0xa5, - 0x2a,0xd1,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2f,0xd5,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xaf,0x52,0x95,0x54,0xc4,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xab, - 0x24,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0x57,0x29,0xa9,0x92,0x11,0x7f,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0x57,0xd5,0xfa,0xff,0xff,0xab,0xea,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x97,0x4a,0x55,0x2a,0x41,0x7f, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x25,0x29,0xe5,0xff,0xff,0x95,0xa4,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa7,0xa4, - 0x24,0xa5,0x14,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x4a,0xa5,0xd4,0xff, - 0x3f,0x52,0xa9,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0x29,0x55,0x55,0x55,0x41,0x7e,0xff,0xff,0xff,0xff,0xff,0xff,0x7f, - 0xa9,0x54,0xea,0xff,0xdf,0x2a,0x55,0xf1,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0x55,0x55,0x4a,0x49,0x12,0x7e,0xff,0xff,0xff, - 0xff,0xff,0xff,0x7f,0x55,0xa5,0x92,0xff,0x23,0xa5,0x4a,0xd6,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa5,0xa4,0x94,0xaa,0x42, - 0x7d,0xff,0xff,0xff,0xff,0xff,0xff,0x9f,0x4a,0x2a,0xa9,0xff,0xad,0x92,0x24, - 0xa9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2a, - 0x95,0x52,0x52,0x29,0x7c,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x52,0x49,0x55, - 0xfe,0x91,0x54,0x55,0x55,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0x7f,0x49,0x29,0x55,0x25,0x85,0x7c,0xff,0xff,0xff,0xff,0xff,0xff, - 0x4f,0x95,0xaa,0x92,0x7e,0x55,0x55,0xa9,0x4a,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2a,0x50,0x95,0xaa,0x24,0x7e,0xff,0xff, - 0xff,0xff,0xff,0xff,0x57,0x2a,0x95,0x54,0x79,0x95,0x92,0x92,0x94,0xfc,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0xb9,0x62,0x29,0x49, - 0x85,0x7c,0xff,0xff,0xff,0xff,0xff,0xff,0x4b,0x49,0x49,0x95,0xba,0xa4,0x54, - 0xaa,0x52,0xfd,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf, - 0x1a,0xf8,0xa7,0xaa,0x22,0x7c,0xff,0xff,0xff,0xff,0xff,0xff,0x55,0x55,0x52, - 0x2a,0x75,0x55,0xa5,0x24,0xa5,0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xbf,0x5a,0xfd,0x57,0x92,0x94,0x7e,0xff,0xff,0xff,0xff,0xff, - 0xff,0x4a,0x4a,0x55,0x49,0x89,0x92,0x94,0xaa,0x94,0xf4,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x1a,0xfc,0x2f,0x55,0x05,0x7c,0xff, - 0xff,0xff,0xff,0xff,0xff,0x55,0xa9,0x4a,0x55,0x2a,0x55,0x55,0x55,0x55,0xe5, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0x4e,0xfd,0x5f, - 0x29,0xa5,0x7c,0xff,0xff,0xff,0xff,0xff,0xff,0xa4,0x54,0x52,0x4a,0x55,0xa9, - 0xa4,0x24,0xa5,0x94,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0x2f,0x1d,0xfe,0x3f,0x95,0x04,0x7c,0xff,0xfd,0xff,0xff,0xff,0x3f,0x49,0xa5, - 0x54,0xa9,0xa4,0x92,0x4a,0x49,0x4a,0x55,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xaf,0x44,0xfe,0x5f,0xa9,0x52,0x7d,0xff,0xe5,0xff,0xff, - 0xff,0x5f,0x55,0x92,0x2a,0x95,0x52,0x4a,0x52,0xaa,0x52,0x4a,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x97,0x16,0xff,0xbf,0x4a,0x05,0x7c, - 0xff,0xd9,0xff,0xff,0xff,0x5f,0x95,0x42,0xa5,0x52,0x95,0xaa,0xaa,0xaa,0x94, - 0x54,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x57,0x43,0xfe, - 0xbf,0x54,0x52,0x7d,0x7f,0x25,0xff,0xff,0xff,0xa7,0xa4,0x28,0x92,0x54,0x4a, - 0xa5,0x4a,0x92,0xaa,0x4a,0xf9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xab,0x12,0xfe,0x7f,0xa5,0x02,0x7c,0x7f,0x55,0xfd,0xff,0xff,0x95,0x2a, - 0x82,0x54,0xa5,0x54,0x2a,0xa9,0x2a,0xa5,0x52,0xf5,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0x27,0x4b,0xff,0xff,0x4a,0x29,0x7d,0xff,0x92,0xfe, - 0xff,0xff,0x55,0x92,0x20,0xa8,0x94,0x2a,0xa5,0x94,0x52,0x29,0xa9,0xf4,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x97,0x01,0xff,0x7f,0x52,0x42, - 0x7c,0xff,0x25,0xf9,0xff,0x7f,0xaa,0x02,0x8a,0x40,0x29,0x49,0x09,0x41,0x4a, - 0x55,0x25,0xe5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x57,0x57, - 0xff,0xff,0x95,0x12,0x7d,0xff,0xa9,0xfa,0xff,0x7f,0x25,0xa9,0x20,0x2a,0xa5, - 0xaa,0x42,0x92,0x54,0x92,0x54,0x95,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xaf,0x83,0xff,0xff,0xa9,0x42,0x7e,0xff,0xaa,0xf4,0xff,0xaf,0x54, - 0x01,0x82,0x80,0xaa,0x54,0x14,0x08,0xa2,0xaa,0x4a,0xd2,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xef,0xcf,0xd7,0xff,0xff,0x52,0x12,0x7f,0xff,0x4a, - 0xea,0xff,0x57,0x92,0xaa,0x28,0x24,0x29,0x25,0x81,0x82,0x08,0x49,0x52,0x55, - 0xff,0xff,0xff,0xff,0xbf,0xff,0xff,0xff,0xff,0xdf,0xef,0xe7,0xff,0xff,0x2a, - 0x05,0x7e,0xff,0x55,0xd5,0xff,0xa5,0x2a,0x00,0x8e,0x10,0x4a,0x89,0x24,0x28, - 0xa0,0xaa,0x2a,0x49,0xff,0xff,0xff,0xff,0xbf,0xff,0xff,0xff,0xff,0xe7,0xff, - 0xef,0xff,0xff,0xa5,0x50,0x7e,0xff,0x25,0xe5,0xff,0x2a,0xa5,0x52,0x7f,0x85, - 0x54,0x35,0x08,0x82,0x0a,0x55,0x95,0xaa,0xfc,0xff,0xff,0xff,0xcf,0xff,0xff, - 0xff,0xff,0xd7,0xff,0xff,0xff,0x7f,0x52,0x85,0x7e,0xff,0xab,0x94,0x1e,0x55, - 0x2a,0xc8,0xff,0x10,0x90,0x92,0xa0,0x08,0x20,0x24,0x52,0x25,0xfd,0xff,0xff, - 0xff,0xef,0xff,0xff,0xff,0xff,0xe9,0xff,0xff,0xff,0xff,0x94,0x10,0x7e,0xff, - 0x93,0xaa,0x6a,0x49,0x49,0xf2,0xff,0x85,0x52,0x09,0x0a,0xa2,0x4a,0x92,0x29, - 0xa9,0xf2,0xff,0xff,0xff,0xd3,0xff,0xff,0xff,0xff,0xeb,0xff,0xff,0xff,0x7f, - 0x55,0x25,0x7f,0xff,0x55,0x49,0x49,0x95,0x0a,0xf9,0xff,0x17,0x48,0x26,0x50, - 0x08,0x00,0xa9,0x4a,0x95,0xfa,0xff,0xff,0xff,0xeb,0xff,0xff,0xff,0xff,0xf2, - 0xff,0xff,0xff,0xff,0x92,0x80,0x7e,0xff,0xa7,0x54,0xaa,0xa4,0x52,0xfc,0xff, - 0xaf,0x42,0x89,0xfa,0xbf,0x54,0x20,0xa9,0xa4,0xd4,0xff,0xff,0xff,0xcb,0xff, - 0xff,0xff,0xff,0xf5,0xff,0xff,0xff,0xff,0x54,0x29,0x7f,0xff,0x4b,0xa5,0x92, - 0x2a,0x01,0xff,0xff,0x1f,0xa8,0x22,0xff,0xff,0x01,0xa5,0x2a,0x55,0xa9,0xff, - 0xff,0xff,0xd4,0xff,0xff,0xff,0x7f,0xfa,0xff,0xff,0xff,0x7f,0xa5,0x04,0x7f, - 0xff,0x57,0x2a,0x55,0xa9,0x54,0xfe,0xff,0x3f,0x05,0x89,0xff,0xff,0x5f,0x48, - 0x92,0x2a,0x95,0xff,0xff,0xff,0xea,0xff,0xff,0xff,0xff,0xd2,0xff,0xff,0xff, - 0x7f,0x2a,0x91,0x7f,0xff,0xa9,0x54,0x4a,0x52,0x02,0xff,0xff,0xff,0x50,0xd1, - 0xff,0xff,0x1f,0x81,0xaa,0xa4,0x52,0xfe,0xff,0x3f,0xe9,0xff,0xff,0xff,0x7f, - 0x1d,0xff,0xff,0xff,0xff,0x54,0x41,0x7f,0xff,0x93,0x92,0x52,0x95,0xc8,0xff, - 0xff,0xff,0x8b,0xc4,0xff,0xff,0x7f,0x24,0xa5,0x2a,0x49,0xf9,0xff,0x7f,0xd5, - 0xff,0xff,0xff,0xbf,0x4a,0xff,0xff,0xff,0xff,0x4a,0x14,0x7f,0xff,0x28,0xa5, - 0x94,0x2a,0xa0,0xff,0xff,0x7f,0x22,0xf0,0xff,0xff,0x7f,0x12,0x94,0xa4,0xaa, - 0xea,0xff,0xaf,0xea,0xff,0xff,0xff,0x5f,0x8e,0xff,0xff,0xff,0x7f,0xa9,0x40, - 0x7f,0xff,0x48,0x55,0x55,0x12,0xca,0xff,0xff,0xff,0x0a,0xf5,0xff,0xff,0xff, - 0x80,0x52,0x95,0x54,0xaa,0xfe,0x55,0xc4,0xff,0xff,0xff,0x5f,0xa5,0xff,0xff, - 0xff,0xff,0x94,0x14,0x7f,0xff,0x52,0x2a,0xa9,0x4a,0xe1,0xff,0xff,0xbf,0x24, - 0xf0,0xff,0xff,0xff,0x0b,0x28,0xa9,0x92,0x24,0x55,0x49,0xe5,0xd7,0xff,0xff, - 0xa7,0x8a,0xff,0xff,0xff,0x7f,0xa5,0xc0,0x7f,0xff,0x50,0x49,0x95,0x04,0xf8, - 0xff,0xff,0x5f,0x1f,0xfd,0xff,0xff,0xff,0x47,0x45,0x55,0xaa,0xaa,0x4a,0xaa, - 0xea,0xaf,0xff,0xff,0x2b,0xc3,0xff,0xff,0xff,0x7f,0x55,0x94,0x7f,0x7f,0x4a, - 0x55,0x52,0x51,0xfe,0xff,0xff,0x5f,0x4e,0xf8,0xff,0xff,0xff,0x1f,0x50,0x92, - 0x52,0x49,0xa9,0x92,0xe4,0xd3,0xff,0xff,0x4b,0xd5,0xff,0xff,0xff,0xff,0x94, - 0xc0,0x7f,0x3f,0xa0,0xa4,0xaa,0x04,0xfe,0xff,0xff,0xa7,0x1d,0xfd,0xff,0xff, - 0xff,0x9f,0x84,0xaa,0x4a,0xaa,0x24,0x55,0xf2,0x2b,0xff,0x7f,0xa9,0xc1,0xff, - 0xff,0xff,0x7f,0x4a,0x95,0x7f,0xbf,0x2a,0x95,0x24,0x50,0xff,0xff,0xff,0x97, - 0x5e,0xfe,0xff,0xff,0xff,0x3f,0x92,0x24,0x95,0x92,0xaa,0xa4,0xf2,0xcb,0xff, - 0x5f,0xd5,0xe5,0xff,0xff,0xff,0xff,0x52,0x80,0x7f,0x3f,0xa0,0x52,0x15,0x85, - 0xff,0xff,0xff,0xd7,0x38,0xfe,0xff,0xff,0xff,0xff,0x20,0xaa,0x52,0x55,0x55, - 0x55,0xf9,0x29,0xfd,0xab,0xa4,0xf0,0xff,0xff,0xff,0x7f,0x29,0xa9,0x7f,0xff, - 0x42,0x25,0x49,0xe8,0xff,0xff,0xff,0x69,0x7a,0xff,0xff,0xff,0xff,0xff,0x82, - 0x52,0xaa,0x24,0x89,0x4a,0xf8,0x55,0x2a,0x49,0x95,0xf5,0xff,0xff,0xff,0xbf, - 0x2a,0xc4,0x7f,0x7f,0x90,0x54,0x15,0xe2,0xff,0xff,0xff,0x25,0xbc,0xff,0xff, - 0xff,0xff,0xff,0x29,0x48,0x49,0xaa,0xaa,0xa4,0xfa,0x95,0x92,0x54,0x52,0xf0, - 0xff,0xff,0xff,0xbf,0x4a,0xd1,0x7f,0xff,0x05,0xaa,0x40,0xf8,0xff,0xff,0x7f, - 0xaa,0xfc,0xff,0xff,0xff,0xff,0xff,0x43,0xa9,0xaa,0x4a,0x52,0xa9,0xf8,0xa4, - 0xaa,0x52,0x95,0xfc,0xff,0xff,0xff,0x7f,0x52,0xc0,0x7f,0xff,0xa1,0x00,0x24, - 0xfa,0xff,0xff,0xff,0x0a,0xfe,0xff,0xff,0xff,0xff,0xff,0x17,0x92,0x24,0xa5, - 0x2a,0x55,0xfe,0xaa,0xa4,0x2a,0x29,0xf9,0xff,0xff,0xff,0xbf,0x2a,0xea,0x7f, - 0xff,0x05,0x92,0x90,0xfc,0xff,0xff,0xbf,0xa4,0xff,0xff,0xff,0xff,0xff,0xff, - 0x4f,0xa0,0xaa,0x54,0x49,0x25,0x7c,0x49,0x95,0xa4,0x12,0xfc,0xff,0xff,0xff, - 0x7f,0x8a,0xe0,0x7f,0xff,0xa3,0x04,0x05,0xfe,0xff,0xff,0xbf,0x06,0xff,0xff, - 0xff,0xff,0xff,0xff,0x1f,0x49,0x95,0x52,0xaa,0x12,0x7f,0x55,0x52,0x55,0x0a, - 0xfd,0xff,0xff,0xff,0x3f,0x29,0xe8,0x7f,0xff,0x0f,0x50,0x50,0xff,0xff,0xff, - 0x5f,0xca,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x04,0xa9,0x4a,0x25,0x45,0x3e, - 0xa9,0x2a,0xa9,0xa2,0xfc,0xff,0xff,0xff,0x7f,0x55,0xe1,0x7f,0xff,0x27,0x05, - 0xc4,0xff,0xff,0xff,0x9f,0x91,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x41,0x4a, - 0x29,0xa9,0x12,0x5e,0x95,0x94,0x4a,0x0a,0xfe,0xff,0xff,0xff,0xbf,0x12,0xf4, - 0x7f,0xff,0x8f,0x50,0xf1,0xff,0xff,0xff,0xa7,0xc2,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0x14,0x92,0xaa,0x4a,0xa2,0xbf,0xa4,0x52,0x95,0x22,0xff,0xff,0xff, - 0xff,0x3f,0x45,0xf2,0x7f,0xff,0x3f,0x04,0xf4,0xff,0xff,0xff,0xd7,0xe8,0xff, - 0xff,0xff,0xff,0x5f,0xff,0xff,0x83,0xa8,0x94,0x54,0x09,0x2f,0x55,0x4a,0x52, - 0x49,0xff,0xff,0xff,0xff,0x5f,0x99,0xf0,0x7f,0xff,0x7f,0x51,0xfc,0xff,0xff, - 0xff,0x6b,0xf1,0xff,0xff,0xff,0xff,0x5f,0xfd,0xff,0x2b,0x2a,0xa9,0x12,0x20, - 0x5f,0xa9,0xaa,0x54,0x00,0xff,0xff,0xff,0xff,0x5f,0x15,0xf2,0x7f,0xff,0xff, - 0x8f,0xff,0xff,0xff,0xff,0x2b,0xfc,0xff,0xff,0xff,0xff,0x2f,0xfd,0xff,0x87, - 0xa0,0x4a,0xaa,0x8a,0x9f,0x4a,0x52,0x15,0xa9,0xff,0xff,0xff,0xff,0x5f,0x8a, - 0xfc,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x94,0xf8,0xff,0xff,0xff,0xff, - 0x57,0xf2,0xff,0x2f,0x82,0x52,0x05,0xd0,0x2f,0x95,0x4a,0x49,0x84,0xff,0xff, - 0xff,0xff,0xbf,0x24,0xf8,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x12,0xfd, - 0xff,0xff,0xff,0xff,0x4b,0xd5,0xff,0x9f,0x28,0x54,0x48,0xc5,0xbf,0x52,0x55, - 0x0a,0xe1,0xff,0xff,0xff,0xff,0x9f,0x4a,0xfa,0x7f,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0x1a,0xfe,0xff,0xff,0xff,0xff,0x57,0xa9,0xff,0x3f,0x82,0x00,0x21, - 0xf0,0x5f,0x2a,0x49,0x21,0xc4,0xff,0xff,0xff,0xff,0xaf,0x1a,0xfd,0x7f,0xff, - 0xff,0xff,0xff,0xff,0xff,0x3f,0x85,0xff,0xff,0xff,0xff,0xff,0x29,0xa5,0xff, - 0xff,0x24,0x52,0x88,0xfc,0xbf,0x92,0x2a,0x09,0xf1,0xff,0xff,0xff,0xff,0x9f, - 0x4c,0xfc,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x15,0xff,0xff,0xff,0x7f, - 0xff,0xa5,0x4a,0xff,0xff,0x90,0x08,0x01,0xfe,0x3f,0x55,0x52,0x24,0xf4,0xff, - 0xff,0xff,0xff,0xaf,0x02,0xfd,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0xc6, - 0xff,0xff,0xff,0xbf,0xfe,0x95,0x54,0xff,0xff,0x05,0x42,0xa8,0xfe,0xbf,0xa4, - 0x2a,0x41,0xf9,0xff,0xff,0xff,0xff,0x5f,0x55,0xfc,0x7f,0xff,0xff,0xff,0xff, - 0xff,0xff,0x4f,0xd0,0xff,0xff,0xff,0xbf,0x7c,0xaa,0x92,0xfc,0xff,0x53,0x08, - 0x01,0xff,0x1f,0x4a,0x01,0x04,0xfc,0xff,0xff,0xff,0xff,0x27,0x05,0xff,0x7f, - 0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0xc5,0xff,0xff,0xff,0x4f,0xbf,0x52,0xaa, - 0xfe,0xff,0x07,0x42,0xea,0xff,0xbf,0x50,0x54,0x51,0xff,0xff,0xff,0xff,0xff, - 0x97,0x56,0xfe,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0xf0,0xff,0xff,0xff, - 0x2f,0x7f,0xa5,0x54,0xfd,0xff,0x3f,0x09,0xe0,0xff,0x1f,0x02,0x01,0x04,0xff, - 0xff,0xff,0xff,0xff,0xaf,0x02,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x4b, - 0xf5,0xff,0xff,0xff,0xab,0x9f,0x94,0x92,0xfc,0xff,0xff,0x40,0xfd,0xff,0x9f, - 0x48,0x48,0xa1,0xff,0xff,0xff,0xff,0xff,0xa7,0x56,0xff,0x7f,0xff,0xff,0xff, - 0xff,0xff,0xff,0x6b,0xf8,0xff,0xff,0xff,0xa4,0x5f,0xa9,0x2a,0xfd,0xff,0xff, - 0xff,0xff,0xff,0x3f,0x22,0x21,0xc4,0xff,0xff,0xff,0xff,0xff,0x2f,0x03,0xff, - 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x2b,0xfa,0xff,0xff,0x7f,0xd5,0x2f,0xa5, - 0xa4,0xfa,0xff,0xff,0xff,0xff,0xff,0xbf,0x08,0x08,0xf9,0xff,0xff,0xff,0xff, - 0xff,0x97,0x4a,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x94,0xfc,0xff,0xff, - 0x7f,0x69,0xac,0x2a,0x55,0xf9,0xff,0xff,0xff,0xff,0xff,0x7f,0xa2,0x22,0xf8, - 0xff,0xff,0xff,0xff,0xff,0x53,0x21,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff, - 0x15,0xfe,0xff,0xff,0x9f,0x2a,0x95,0x94,0x92,0xf4,0xff,0xff,0xff,0xff,0xff, - 0xff,0x08,0x88,0xfe,0xff,0xff,0xff,0xff,0xff,0x57,0x8b,0xff,0x7f,0xff,0xff, - 0xff,0xff,0xff,0x7f,0xa9,0xfe,0xff,0xff,0x5f,0x52,0xbc,0x52,0x55,0xf5,0xff, - 0xff,0xff,0xff,0xff,0xff,0x21,0x21,0xff,0xff,0xff,0xff,0xff,0xff,0x4b,0xa1, - 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0x7f,0x0d,0xff,0xff,0xff,0x57,0x15,0x3f, - 0x55,0x49,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0x4b,0xc8,0xff,0xff,0xff,0xff, - 0xff,0xff,0xd7,0x89,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xbf,0xd6,0xff,0xff, - 0xff,0x4b,0x45,0x3f,0x49,0xaa,0xf4,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0xf9, - 0xff,0xff,0xff,0xff,0xff,0xff,0xc9,0xe2,0xff,0x7f,0xff,0xff,0xff,0xff,0xff, - 0x3f,0x81,0xff,0xff,0xff,0x29,0x11,0x5f,0x28,0x55,0xf5,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xab,0xc8,0xff,0x7f,0xff, - 0xff,0xff,0xff,0xff,0x5f,0xd6,0xff,0xff,0x7f,0xaa,0xc2,0x0f,0x55,0x49,0xea, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa5, - 0xe2,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0x9f,0xe1,0xff,0xff,0xbf,0x4a,0xd1, - 0x5f,0x48,0xa5,0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xe9,0xe0,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0x27,0xf4,0xff, - 0xff,0xbf,0x94,0xc4,0x07,0x91,0x2a,0xf5,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xca,0xea,0xff,0x7f,0xff,0xff,0xff,0xff, - 0xff,0xaf,0xf1,0xff,0xff,0x9f,0x52,0xe0,0x4b,0x44,0x52,0xe9,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x6a,0xe0,0xff,0x7f, - 0xff,0xff,0xff,0xff,0xff,0x4b,0xfc,0xff,0xff,0xab,0x2a,0xf5,0x0f,0x51,0xa5, - 0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f, - 0x69,0xe5,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0x55,0xf8,0xff,0xff,0x95,0x14, - 0xf0,0x5f,0x84,0x54,0xea,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0x7f,0x75,0xf0,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0x13,0xfd, - 0xff,0xff,0xa5,0x42,0xf9,0x7f,0x91,0x4a,0xf5,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xb2,0xfa,0xff,0x7f,0xff,0xff,0xff, - 0xff,0xff,0x54,0xfe,0xff,0x7f,0x52,0x12,0xfa,0xff,0x20,0xa5,0xe4,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x34,0xf8,0xff, - 0x7f,0xff,0xff,0xff,0xff,0xff,0x25,0xff,0xff,0xaf,0xaa,0x48,0xfc,0xff,0x0b, - 0x29,0xf5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0x7f,0xb5,0xf8,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0x52,0xff,0xff,0x2f,0x49, - 0x02,0xfe,0xff,0x43,0xaa,0xea,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0x3f,0x3a,0xfa,0xff,0x7f,0xff,0xff,0xff,0xff,0x7f,0x4a, - 0xff,0xff,0xa5,0x2a,0xa9,0xff,0xff,0x17,0x25,0xe9,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x9a,0xfc,0xff,0x7f,0xff,0xff, - 0xff,0xff,0xff,0x2a,0xff,0x7f,0x95,0x54,0x80,0xff,0xff,0x07,0xa9,0xea,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x1d,0xfc, - 0xff,0x7f,0xff,0xff,0xff,0xff,0x3f,0xa9,0xfe,0x7f,0xa9,0x12,0xe5,0xff,0xff, - 0x5f,0x4a,0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0x5f,0xad,0xfe,0xff,0x7f,0xff,0xff,0xff,0xff,0x7f,0x95,0xea,0x97,0x54, - 0x4a,0xf0,0xff,0xff,0x1f,0xa8,0xea,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0x5f,0x0e,0xfe,0xff,0x7f,0xff,0xff,0xff,0xff,0x5f, - 0x52,0x55,0xa9,0x92,0x02,0xfd,0xff,0xff,0x5f,0x53,0xf5,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0x5e,0xfe,0xff,0x7f,0xff, - 0xff,0xff,0xff,0xbf,0x2a,0x49,0x4a,0x55,0x49,0xfc,0xff,0xff,0x3f,0x94,0xf8, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2f,0x0f, - 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x4f,0xa5,0xaa,0x92,0xa4,0x20,0xff,0xff, - 0xff,0xbf,0xa4,0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0x5f,0x57,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x5f,0x52,0x52,0xaa, - 0x2a,0x0a,0xff,0xff,0xff,0x7f,0x54,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0x8f,0x07,0xff,0xff,0x7f,0xff,0xff,0xff,0xff, - 0xa7,0x94,0x4a,0x55,0x4a,0xa0,0xff,0xff,0xff,0xff,0xa8,0xfa,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x57,0x57,0xff,0xff,0x7f, - 0xff,0xff,0xff,0xff,0x2f,0x55,0xa9,0x92,0x12,0xe9,0xff,0xff,0xff,0x7f,0x24, - 0xf5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf, - 0x87,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x57,0xa5,0x4a,0xaa,0x44,0xf4,0xff, - 0xff,0xff,0xff,0x55,0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xa7,0xab,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xab,0x94,0xa4, - 0x92,0x12,0xf9,0xff,0xff,0xff,0xff,0xa8,0xfa,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xdf,0xff,0xff,0xff,0xff,0xff,0xab,0x83,0xff,0xff,0x7f,0xff,0xff,0xff, - 0xff,0x47,0xa9,0x2a,0x55,0x40,0xfc,0xff,0xff,0xff,0xff,0x25,0xf5,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xe7,0xff,0xff,0xff,0xff,0xff,0xd7,0x97,0xff,0xff, - 0x7f,0xff,0xff,0xff,0xff,0x33,0x55,0xa9,0x24,0x15,0xfe,0xff,0xff,0xff,0xff, - 0x95,0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xeb,0xff,0xff,0xff,0xff,0xff, - 0x93,0xc3,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x57,0x25,0xa5,0x2a,0x40,0xff, - 0xff,0xff,0xff,0xff,0xa9,0xf4,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xe3,0xff, - 0xff,0xff,0xff,0xff,0xe7,0xd5,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x4b,0x92, - 0x54,0x92,0xd4,0xff,0xff,0xff,0xff,0xff,0x55,0xf5,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xe9,0xff,0xff,0xff,0xff,0xff,0xd5,0xc1,0xff,0xff,0x7f,0xff,0xff, - 0xff,0xff,0x97,0xaa,0x4a,0x05,0xe2,0xff,0xff,0xff,0xff,0xff,0x25,0xf1,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xe3,0xfd,0xff,0xff,0xff,0xff,0xd5,0xea,0xff, - 0xff,0x7f,0xff,0xff,0xff,0xff,0x57,0x55,0x25,0xa1,0xf0,0xff,0xff,0xff,0xff, - 0xff,0x95,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xe8,0xfa,0xff,0xff,0xff, - 0xff,0xea,0xe0,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xa7,0x24,0x59,0x04,0xfa, - 0xff,0xff,0xff,0xff,0xff,0xa9,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xe2, - 0xfd,0xff,0xff,0xff,0xff,0xc9,0xe9,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x4f, - 0x52,0x05,0xa1,0xfc,0xff,0xff,0xff,0xff,0xff,0xa5,0xfa,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0x70,0xf9,0xff,0xff,0xff,0xff,0x74,0xe2,0xff,0xff,0x7f,0xff, - 0xff,0xff,0xff,0x47,0x95,0x92,0x04,0xff,0xff,0xff,0xff,0xff,0xff,0x95,0xf8, - 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xe2,0xfa,0xff,0xff,0xff,0xff,0x72,0xe8, - 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x97,0xaa,0x20,0xd0,0xff,0xff,0xff,0xff, - 0xff,0xff,0x55,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0xb8,0xfc,0xff,0xff, - 0xff,0xff,0xea,0xe2,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x07,0x04,0x82,0xc2, - 0xff,0xff,0xff,0xff,0xff,0xff,0x29,0xfd,0xff,0xff,0xff,0xff,0xff,0xff,0x7f, - 0x71,0xfd,0xff,0xff,0xff,0x7f,0x2a,0xf8,0xff,0xff,0x7f,0xff,0xff,0xff,0xff, - 0x4f,0x91,0x28,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0x4b,0xfc,0xff,0xff,0xff, - 0xff,0xff,0xff,0x1f,0x54,0xfe,0xff,0xff,0xff,0x7f,0x75,0xf2,0xff,0xff,0x7f, - 0xff,0xff,0xff,0xff,0x27,0x44,0x82,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0x29, - 0xfd,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0xb8,0xfc,0xff,0xff,0xff,0xbf,0x14, - 0xf1,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x0f,0x11,0x20,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0x55,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x9a,0xfe,0xff, - 0xff,0xff,0x7f,0x5a,0xf8,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x5f,0x40,0x85, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x09,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0x4f,0x2d,0xfd,0xff,0xff,0xff,0x9f,0x12,0xf9,0xff,0xff,0x7f,0xff,0xff,0xff, - 0xff,0x3f,0x14,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x55,0xfe,0xff,0xff, - 0xff,0xff,0xff,0xff,0x07,0xa6,0xfe,0xff,0xff,0xff,0x5f,0x4d,0xfa,0xff,0xff, - 0x7f,0xff,0xff,0xff,0xff,0xff,0x40,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0x09,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2b,0x4b,0xfe,0xff,0xff,0xff,0xbf, - 0x2c,0xf8,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xf5,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0x43,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x57,0xff, - 0xff,0xff,0xff,0x5f,0x0a,0xfe,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x89,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xd5,0xa9,0xff,0xff,0xff,0xff,0xaf,0x5a,0xfc,0xff,0xff,0x7f,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa3,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0x81,0x95,0xff,0xff,0xff,0xff,0x9f,0x06,0xfd,0xff, - 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xc9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xca,0xa5,0xff,0xff,0xff,0xff, - 0x2f,0x95,0xfc,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xc1,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xe0,0xea, - 0xff,0xff,0xff,0xff,0xaf,0x26,0xfe,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xd5,0xff,0xff,0xff,0xff,0xff, - 0xff,0x7f,0xf5,0xf4,0xff,0xff,0xff,0xff,0xaf,0x86,0xfe,0xff,0xff,0x7f,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xc1,0xff, - 0xff,0xff,0xff,0xff,0xff,0x7f,0x70,0xe5,0xff,0xff,0xff,0xff,0x4f,0x2e,0xfe, - 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xeb,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0xb2,0xfa,0xff,0xff,0xff, - 0xff,0x57,0x83,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xf3,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x78, - 0xf2,0xff,0xff,0xff,0xff,0xa7,0x22,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0x5f,0x5d,0xfd,0xff,0xff,0xff,0xff,0x97,0x87,0xff,0xff,0xff,0x7f, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x3c,0xfd,0xff,0xff,0xff,0xff,0x53,0xa3, - 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0xac,0xfe,0xff,0xff, - 0xff,0xff,0x57,0x95,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f, - 0x9e,0xfe,0xff,0xff,0xff,0xff,0x97,0x81,0xff,0xff,0xff,0x7f,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xa7,0x57,0xfe,0xff,0xff,0xff,0xff,0xa9,0xa5,0xff,0xff,0xff, - 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0xaf,0xff,0xff,0xff,0xff,0xff,0x4b, - 0x89,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xab,0x93,0xff,0xff, - 0xff,0xff,0xff,0x95,0xa2,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0x83,0xab,0xff,0xff,0xff,0xff,0xff,0xd3,0xc8,0xff,0xff,0xff,0x7f,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0xff, - 0xff,0xff,0xff,0xff,0xe9,0xa5,0xff,0xff,0xff,0xff,0xff,0xa5,0xe1,0xff,0xff, - 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xc0,0xd5,0xff,0xff,0xff,0xff,0xff, - 0xd5,0xc8,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xdf,0xff,0xff,0xff,0xff,0xff,0xea,0xea,0xff, - 0xff,0xff,0xff,0xff,0x14,0xc1,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xef,0xff,0xff,0xff,0xff, - 0xff,0xe0,0xe4,0xff,0xff,0xff,0xff,0xff,0x65,0xe8,0xff,0xff,0xff,0x7f,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xcf, - 0xff,0xff,0xff,0xff,0x3f,0x72,0xe9,0xff,0xff,0xff,0xff,0xff,0x6a,0xe1,0xff, - 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xef,0xff,0xff,0xff,0xff,0xbf,0xb8,0xfa,0xff,0xff,0xff,0xff, - 0xff,0x52,0xea,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xd3,0xff,0xff,0xff,0xff,0x1f,0x7a,0xf5, - 0xff,0xff,0xff,0xff,0x7f,0x2a,0xe0,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xeb,0xff,0xff,0xff, - 0xff,0x8f,0x58,0xfa,0xff,0xff,0xff,0xff,0x7f,0x25,0xf5,0xff,0xff,0xff,0x7f, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xb5,0xff,0xff,0xdf,0xff,0x57,0x5e,0xfd,0xff,0xff,0xff,0xff,0xff,0x34,0xe0, - 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xca,0xff,0xff,0x8f,0xff,0x07,0xac,0xfc,0xff,0xff,0xff, - 0xff,0x7f,0x2a,0xf5,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xd4,0xff,0xff,0x57,0xff,0x2b,0x2d, - 0xfd,0xff,0xff,0xff,0xff,0xff,0xb2,0xf0,0xff,0xff,0xff,0x7f,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xd2,0xff,0xff, - 0x07,0xff,0x43,0x4a,0xff,0xff,0xff,0xff,0xff,0xbf,0x2a,0xf8,0xff,0xff,0xff, - 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0x3f,0xc5,0xff,0xff,0x2b,0xfe,0x08,0xab,0xfe,0xff,0xff,0xff,0xff,0x7f,0xaa, - 0xf2,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xbf,0xea,0xff,0xff,0x83,0x36,0x20,0x55,0xff,0xff,0xff, - 0xff,0xff,0x3f,0x15,0xf0,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x4f,0xc2,0xff,0xff,0x48,0x4a,0x85, - 0x49,0xff,0xff,0xff,0xff,0xff,0x7f,0x59,0xfa,0xff,0xff,0xff,0x7f,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0xf5,0xff, - 0x7f,0x10,0x29,0x50,0xa5,0xff,0xff,0xff,0xff,0xff,0x3f,0x15,0xf9,0xff,0xff, - 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0x97,0xe4,0xff,0x7f,0x05,0x95,0x42,0xd5,0xff,0xff,0xff,0xff,0xff,0x7f, - 0x35,0xfc,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xab,0xea,0xff,0xbf,0xa0,0x24,0xa8,0xd4,0xff,0xff, - 0xff,0xff,0xff,0x7f,0x19,0xf9,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x27,0xe5,0xff,0x3f,0x92,0xaa, - 0x50,0xe9,0xff,0xff,0xff,0xff,0xff,0x9f,0x4a,0xfc,0xff,0xff,0xff,0x7f,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa9,0xe2, - 0xff,0x9f,0xa0,0xaa,0x2a,0xf5,0xff,0xff,0xff,0xff,0xff,0x5f,0x1a,0xf9,0xff, - 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0x95,0xf8,0xff,0x5f,0x4a,0x92,0x4a,0xf5,0xff,0xff,0xff,0xff,0xff, - 0xbf,0x4a,0xfc,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0x7f,0x52,0xf2,0xff,0x1f,0x20,0x49,0xa5,0xfa,0xff, - 0xff,0xff,0xff,0xff,0x5f,0x1a,0xfd,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaa,0xf8,0xff,0x47,0xa9, - 0x2a,0x29,0xf9,0xff,0xff,0xff,0xff,0xff,0xbf,0x0a,0xfc,0xff,0xff,0xff,0x7f, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x49, - 0xf2,0xff,0x17,0x92,0xaa,0xaa,0xfe,0xff,0xff,0xff,0xff,0xff,0x9f,0xac,0xfe, - 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0x9f,0x2a,0xf8,0xff,0x43,0xa8,0x24,0x25,0xff,0xff,0xff,0xff,0xff, - 0xff,0xaf,0x0a,0xfc,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x94,0xfa,0xff,0x91,0x54,0xaa,0x52,0xff, - 0xff,0xff,0xff,0xff,0xff,0x2f,0x4d,0xfd,0xff,0xff,0xff,0x7f,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2f,0x45,0xfc,0xff,0x03, - 0x92,0x52,0xaa,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x06,0xfc,0xff,0xff,0xff, - 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf, - 0x12,0xfe,0xff,0x50,0xaa,0x2a,0x95,0xff,0xff,0xff,0xff,0xff,0xff,0x4f,0xa5, - 0xfe,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xa7,0x44,0xff,0xff,0x0a,0x25,0xa5,0xa4,0xff,0xff,0xff,0xff, - 0xff,0xff,0x97,0x06,0xfc,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2b,0x15,0xff,0xff,0x40,0xa9,0x92,0xea, - 0xff,0xff,0xff,0xff,0xff,0xff,0x57,0x55,0xfd,0xff,0xff,0xff,0x7f,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x55,0xa1,0xff,0x7f, - 0x92,0x4a,0xaa,0xd4,0xff,0xff,0xff,0xff,0xff,0xff,0x57,0x06,0xfc,0xff,0xff, - 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0x95,0x8a,0xff,0x3f,0x84,0x54,0xa9,0xea,0xff,0xff,0xff,0xff,0xff,0xff,0x2f, - 0x25,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0x52,0xe0,0xff,0xbf,0x50,0xa9,0x4a,0xf2,0xff,0xff,0xff, - 0xff,0xff,0xff,0xa7,0x8e,0xfe,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xa9,0xea,0xff,0x3f,0x24,0x95,0x54, - 0xf5,0xff,0xff,0xff,0xff,0xff,0xff,0x57,0x23,0xfe,0xff,0xff,0xff,0x7f,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x4a,0xf0,0xff, - 0x9f,0x50,0x69,0x49,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0x4f,0x8b,0xff,0xff, - 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0x7f,0xa5,0xf4,0xff,0x0f,0x2d,0x75,0xaa,0xfa,0xff,0xff,0xff,0xff,0xff,0xff, - 0xaf,0x03,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0x9f,0x14,0xfa,0xff,0x2f,0xa8,0xfa,0x25,0xfd,0xff,0xff, - 0xff,0xff,0xff,0xff,0x97,0xd7,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0xaa,0xfc,0xff,0x0f,0x4d,0xfd, - 0xa9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xcf,0x83,0xff,0xff,0xff,0xff,0x7f, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x12,0xfc, - 0xff,0x27,0x92,0xfe,0xcb,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xd7,0xd7,0xff, - 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0x97,0x0a,0xff,0xff,0x83,0x56,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xef,0xc7,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xab,0x24,0xff,0xff,0x2b,0xaa,0xfe,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xe7,0xef,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x4b,0x45,0xff,0xff,0x05,0x95, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xe7,0xff,0xff,0xff,0xff, - 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x95,0x82, - 0xff,0xff,0x51,0xa9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xf7, - 0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xa9,0xe8,0xff,0xff,0x85,0xca,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0x7f,0x52,0xc1,0xff,0xff,0x90,0xd5,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x4d,0xe8,0xff,0xff,0xa5, - 0xe4,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x51, - 0xf2,0xff,0x7f,0x40,0xd5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0x3f,0x95,0xf8,0xff,0x7f,0xa9,0xea,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0x4f,0x15,0xfa,0xff,0x3f,0xa4,0xf4,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0xa4,0xfc,0xff,0x7f, - 0x71,0xe5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2f, - 0x15,0xfe,0xff,0x3f,0x94,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xa7,0x0a,0xff,0xff,0x1f,0x79,0xf2,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xab,0xa4,0xff,0xff,0x5f,0x8c,0xfa,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x53,0x82,0xff,0xff, - 0x1f,0x5c,0xfd,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xa4,0x92,0xff,0xff,0xbf,0x56,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0x9a,0xc4,0xff,0xff,0x0f,0x2e,0xfd,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa2,0xf0,0xff,0xff,0xaf,0xa7,0xfe, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x55,0xe4,0xff, - 0xff,0x0f,0x57,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xbf,0x54,0xf2,0xff,0xff,0x9f,0x4b,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0x9f,0x92,0xf8,0xff,0xff,0xc7,0xab,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x15,0xfe,0xff,0xff,0x97,0xd7, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa7,0x94,0xfc, - 0xff,0xff,0xc7,0xe3,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0x2f,0x05,0xfe,0xff,0xff,0xcf,0xf5,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0x53,0xa9,0xff,0xff,0xff,0xd3,0xeb,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x4b,0x05,0xff,0xff,0xff,0xe3, - 0xe5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x54,0xc2, - 0xff,0xff,0xff,0xeb,0xf9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0x95,0xc8,0xff,0xff,0xff,0xf3,0xfa,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0x7f,0xa5,0xd2,0xff,0xff,0xff,0xff,0xf5,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xaa,0xe0,0xff,0xff,0xff, - 0xff,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x49, - 0xf8,0xff,0xff,0xff,0xff,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0x9f,0x2a,0xf5,0xff,0xff,0xff,0xff,0xfd,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x4a,0xf8,0xff,0xff,0xff,0xff,0xfc,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0x14,0xfd,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x97, - 0x4a,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xab,0x04,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x95,0x52,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x53,0x85,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0x54,0xa2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0x4a,0xc9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xa5,0xe0,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x94,0xe4,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0x5f,0x55,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xbf,0x12,0xf9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x4f,0x54,0xfa,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0x0a,0xfc, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0x53,0x45,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0x97,0x14,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x4b,0x45,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x54,0x82, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0x4a,0xe9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0x52,0xc1,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x55,0xe8,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x24, - 0xf1,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0x7f,0x55,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x24,0xf9,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x15,0xfe,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f, - 0x49,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0x2f,0x95,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x01,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2f,0xd5,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0x57,0x81,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0x97,0xd4,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0xe0,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x93,0xf4,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0x57,0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0x2b,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x89,0xfc,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x55,0xfc, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0x05,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0x49,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x22,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x89, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff, - 0xff,0xff,0x7f,0xe5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f, - 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xc1,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0xe9,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x7f, - 0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff, - 0xff,0xff,0xff,0x9f,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xf9,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xfc,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff, - 0x6f,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff, - 0xff,0xff,0xff,0xff,0xbf,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff, - 0xff,0x9f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff, - 0xff,0xff,0xff,0xff,0xff,0xdf,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xef,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff, - 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f}; diff -r 6866abce6aaf -r 6075d714658b etc/gnus/gnus.xpm Binary file etc/gnus/gnus.xpm has changed diff -r 6866abce6aaf -r 6075d714658b etc/gnusref.tex --- a/etc/gnusref.tex Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,687 +0,0 @@ -% include file for the Gnus refcard and booklet -\def\progver{5.0}\def\refver{5.0} % program and refcard versions -\def\date{16 September 1995} -\def\author{Vladimir Alexiev $<$vladimir@cs.ualberta.ca$>$} -\raggedbottom\raggedright -\newlength{\logowidth}\setlength{\logowidth}{6.861in} -\newlength{\logoheight}\setlength{\logoheight}{7.013in} -\newlength{\keycolwidth} -\newenvironment{keys}[1]% #1 is the widest key - {\nopagebreak%\noindent% - \settowidth{\keycolwidth}{#1}% - \addtolength{\keycolwidth}{\tabcolsep}% - \addtolength{\keycolwidth}{-\columnwidth}% - \begin{tabular}{@{}l@{\hspace{\tabcolsep}}p{-\keycolwidth}@{}}}% - {\end{tabular}\\} -\catcode`\^=12 % allow ^ to be typed literally -\newcommand{\B}[1]{{\bf#1})} % bold l)etter - -\def\Title{ -\begin{center} -{\bf\LARGE Gnus \progver\ Reference \Guide\\} -%{\normalsize \Guide\ version \refver} -\end{center} -} - -\newcommand\Logo[1]{\centerline{ -\makebox[\logoscale\logowidth][l]{\vbox to \logoscale\logoheight -{\vfill\special{psfile=gnuslogo.#1}}\vspace{-\baselineskip}}}} - -\def\CopyRight{ -\begin{center} -Copyright \copyright\ 1995 Free Software Foundation, Inc.\\* -Copyright \copyright\ 1995 \author.\\* -Created from the Gnus manual Copyright \copyright\ 1994 Lars Magne -Ingebrigtsen.\\* -and the Emacs Help Bindings feature (C-h b).\\* -Gnus logo copyright \copyright\ 1995 Luis Fernandes.\\* -\end{center} - -Permission is granted to make and distribute copies of this reference -\guide{} provided the copyright notice and this permission are preserved on -all copies. Please send corrections, additions and suggestions to the -above email address. \Guide{} last edited on \date. -} - -\def\Notes{ -\subsec{Notes} -{\samepage -Gnus is complex. Currently it has some 346 interactive (user-callable) -functions. Of these 279 are in the two major modes (Group and -Summary/Article). Many of these functions have more than one binding, some -have 3 or even 4 bindings. The total number of keybindings is 389. So in -order to save 40\% space, every function is listed only once on this -\guide, under the ``more logical'' binding. Alternative bindings are given -in parentheses in the beginning of the description. - -Many Gnus commands are affected by the numeric prefix. Normally you enter a -prefix by holding the Meta key and typing a number, but in most Gnus modes -you don't need to use Meta since the digits are not self-inserting. The -prefixed behavior of commands is given in [brackets]. Often the prefix is -used to specify: - -\quad [distance] How many objects to move the point over. - -\quad [scope] How many objects to operate on (including the current one). - -\quad [p/p] The ``Process/Prefix Convention'': If a prefix is given then it -determines how many objects to operate on. Else if there are some objects -marked with the process mark \#, these are operated on. Else only the -current object is affected. - -\quad [level] A group subscribedness level. Only groups with a lower or -equal level will be affected by the operation. If no prefix is given, -`gnus-group-default-list-level' is used. If -`gnus-group-use-permanent-levels', then a prefix to the `g' and `l' -commands will also set the default level. - -\quad [score] An article score. If no prefix is given, -`gnus-summary-default-score' is used. -%Some functions were not yet documented at the time of creating this -%\guide and are clearly indicated as such. -\\*[\baselineskip] -\begin{keys}{C-c C-i} -C-c C-i & Go to the Gnus online {\bf info}.\\ -C-c C-b & Send a Gnus {\bf bug} report.\\ -\end{keys} -}} - -\def\GroupLevels{ -\subsec{Group Subscribedness Levels} -The table below assumes that you use the default Gnus levels. -Fill your user-specific levels in the blank cells.\\[1\baselineskip] - -\begin{tabular}{|c|l|l|} -\hline -Level & Groups & Status \\ -\hline -1 & mail groups & \\ -2 & mail groups & \\ -3 & & subscribed \\ -4 & & \\ -5 & default list level & \\ -\hline -6 & & unsubscribed \\ -7 & & \\ -\hline -8 & & zombies \\ -\hline -9 & & killed \\ -\hline -\end{tabular} -} - -\def\Marks{ -\subsec{Mark Indication Characters} -{\samepage If a command directly sets a mark, it is shown in parentheses.\\* -\newlength{\markcolwidth} -\settowidth{\markcolwidth}{` '}% widest character -\addtolength{\markcolwidth}{4\tabcolsep} -\addtolength{\markcolwidth}{-\columnwidth} -\newlength{\markdblcolwidth} -\setlength{\markdblcolwidth}{\columnwidth} -\addtolength{\markdblcolwidth}{-2\tabcolsep} -\begin{tabular}{|c|p{-\markcolwidth}|} -\hline -\multicolumn{2}{|p{\markdblcolwidth}|}{{\bf ``Read'' Marks.} - All these marks appear in the first column of the summary line, and so - are mutually exclusive.}\\ -\hline -` ' & (M-u, M SPC, M c) Not read.\\ -! & (!, M !, M t) Ticked (interesting).\\ -? & (?, M ?) Dormant (only followups are interesting).\\ -C & (C, S c) {\bf Canceled} (only for your own articles).\\ -E & (E, M e, M x) {\bf Expirable}. Only has effect in mail groups.\\ -\hline\hline -\multicolumn{2}{|p{\markdblcolwidth}|}{The marks below mean that the article - is read (killed, uninteresting), and have more or less the same effect. - Some commands however explicitly differentiate between them (e.g.\ M - M-C-r, adaptive scoring).}\\ -\hline -r & (d, M d, M r) Deleted (marked as {\bf read}).\\ -C & (M C; M C-c; M H; c, Z c; Z n; Z C) Killed by {\bf catch-up}.\\ -O & {\bf Old} (marked read in a previous session).\\ -K & (k, M k; C-k, M K) {\bf Killed}.\\ -R & {\bf Read} (viewed in actuality).\\ -X & Killed by a kill file.\\ -Y & Killed due to low score.\\ -\hline\multicolumn{2}{c}{\vspace{1ex}}\\\hline -\multicolumn{2}{|p{\markdblcolwidth}|}{{\bf Other marks}}\\ -\hline -\# & (\#, M \#, M P p) Processable (will be affected by the next operation).\\ -A & {\bf Answered} (followed-up or replied).\\ -+ & Over default score.\\ -$-$ & Under default score.\\ -= & Has children (thread underneath it). Add `\%e' to - `gnus-summary-line-format'.\\ -\hline -\end{tabular} -}} - -\def\GroupMode{ -\sec{Group Mode} -\begin{keys}{C-c M-C-x} -RET & (=) Select this group. [Prefix: how many (read) articles to fetch. -Positive: newest articles, negative: oldest ones.]\\ -SPC & Select this group and display the first unread article. [Same -prefix as above.]\\ -? & Give a very short help message.\\ -$<$ & Go to the beginning of the Group buffer.\\ -$>$ & Go to the end of the Group buffer.\\ -, & Jump to the lowest-level group with unread articles.\\ -. & Jump to the first group with unread articles.\\ -^ & Enter the Server buffer mode.\\ -a & Post an {\bf article} to a group.\\ -b & Find {\bf bogus} groups and delete them.\\ -c & Mark all unticked articles in this group as read ({\bf catch-up}). -[p/p]\\ -g & Check the server for new articles ({\bf get}). [level]\\ -j & {\bf Jump} to a group.\\ -m & {\bf Mail} a message to someone.\\ -n & Go to the {\bf next} group with unread articles. [distance]\\ -p & (DEL) Go to the {\bf previous} group with unread articles. -[distance]\\ -q & {\bf Quit} Gnus.\\ -r & Read the init file ({\bf reset}).\\ -s & {\bf Save} the `.newsrc.eld' file (and `.newsrc' if -`gnus-save-newsrc-file').\\ -z & Suspend (kill all buffers of) Gnus.\\ -B & {\bf Browse} a foreign server.\\ -C & Mark all articles in this group as read ({\bf Catch-up}). [p/p]\\ -F & {\bf Find} new groups and process them.\\ -N & Go to the {\bf next} group. [distance]\\ -P & Go to the {\bf previous} group. [distance]\\ -Q & {\bf Quit} Gnus without saving any startup (.newsrc) files.\\ -R & {\bf Restart} Gnus.\\ -V & Display the Gnus {\bf version} number.\\ -Z & Clear the dribble buffer.\\ -C-c C-d & Show the {\bf description} of this group. [Prefix: re-read it -from the server.]\\ -C-c C-s & {\bf Sort} the groups by name, number of unread articles, or level -(depending on `gnus-group-sort-function').\\ -C-c C-x & Run all expirable articles in this group through the {\bf expiry} -process.\\ -C-c M-C-x & Run all articles in all groups through the {\bf expiry} process.\\ -C-x C-t & {\bf Transpose} two groups.\\ -M-d & {\bf Describe} ALL groups. [Prefix: re-read the description from the -server.]\\ -M-f & Fetch this group's {\bf FAQ} (using ange-ftp).\\ -M-g & Check the server for new articles in this group ({\bf get}). [p/p]\\ -M-n & Go to the {\bf previous} unread group on the same or lower level. -[distance]\\ -M-p & Go to the {\bf next} unread group on the same or lower level. -[distance]\\ -\end{keys} -} - -\def\GroupCommands{ -\subsec{List Groups} -{\samepage -\begin{keys}{A m} -A a & (C-c C-a) List all groups whose names match a regexp ({\bf -apropos}).\\ -A d & List all groups whose names or {\bf descriptions} match a regexp.\\ -A k & (C-c C-l) List all {\bf killed} groups.\\ -A m & List groups that {\bf match} a regexp and have unread articles. -[level]\\ -A s & (l) List {\bf subscribed} groups with unread articles. [level]\\ -A u & (L) List all groups (including {\bf unsubscribed}). [If no prefix -is given, level 7 is the default]\\ -A z & List the {\bf zombie} groups.\\ -A M & List groups that {\bf match} a regexp.\\ -\end{keys} -} - -\subsec{Create/Edit Foreign Groups} -{\samepage -The select methods are indicated in parentheses.\\* -\begin{keys}{G m} -G a & Make the Gnus list {\bf archive} group. (nndir over ange-ftp)\\ -G d & Make a {\bf directory} group (every file must be a posting and files -must have numeric names). (nndir)\\ -G e & (M-e) {\bf Edit} this group's select method.\\ -G f & Make a group based on a {\bf file}. (nndoc)\\ -G h & Make the Gnus {\bf help} (documentation) group. (nndoc)\\ -G k & Make a {\bf kiboze} group. (nnkiboze)\\ -G m & {\bf Make} a new group.\\ -G p & Edit this group's {\bf parameters}.\\ -G v & Add this group to a {\bf virtual} group. [p/p]\\ -G D & Enter a {\bf directory} as a (temporary) group. (nneething without -recording articles read.)\\ -G E & {\bf Edit} this group's info (select method, articles read, etc).\\ -G V & Make a new empty {\bf virtual} group. (nnvirtual)\\ -\end{keys} -You can also create mail-groups and read your mail with Gnus (very useful -if you are subscribed to any mailing lists), using one of the methods -nnmbox, nnbabyl, nnml, nnmh, or nnfolder. Read about it in the online info -(C-c C-i g Reading Mail RET). -} - -%\subsubsec{Soup Commands} -%\begin{keys}{G s w} -%G s b & gnus-group-brew-soup: not documented.\\ -%G s p & gnus-soup-pack-packet: not documented.\\ -%G s r & nnsoup-pack-replies: not documented.\\ -%G s s & gnus-soup-send-replies: not documented.\\ -%G s w & gnus-soup-save-areas: not documented.\\ -%\end{keys} - -\subsec{Mark Groups} -\begin{keys}{M m} -M m & (\#) Set the process {\bf mark} on this group. [scope]\\ -M u & (M-\#) Remove the process mark from this group ({\bf unmark}). -[scope]\\ -M w & Mark all groups in the current region.\\ -\end{keys} - -\subsec{Unsubscribe, Kill and Yank Groups} -\begin{keys}{S w} -S k & (C-k) {\bf Kill} this group.\\ -S l & Set the {\bf level} of this group. [p/p]\\ -S s & (U) Prompt for a group and toggle its {\bf subscription}.\\ -S t & (u) {\bf Toggle} subscription to this group. [p/p]\\ -S w & (C-w) Kill all groups in the region.\\ -S y & (C-y) {\bf Yank} the last killed group.\\ -S z & Kill all {\bf zombie} groups.\\ -\end{keys} -} - -\def\SummaryMode{ -\sec{Summary Mode} %{Summary and Article Modes} -\begin{keys}{SPC} -SPC & (A SPC, A n) Select an article, scroll it one page, move to the -next one.\\ -DEL & (A DEL, A p, b) Scroll this article one page back. [distance]\\ -RET & Scroll this article one line forward. [distance]\\ -= & Expand the Summary window. [Prefix: shrink it to display the -Article window]\\ -$<$ & (A $<$, A b) Scroll to the beginning of this article.\\ -$>$ & (A $>$, A e) Scroll to the end of this article.\\ -\& & Execute a command on all articles matching a regexp. -[Prefix: move backwards.]\\ -j & (G g) Ask for an article number and then {\bf jump} to that summary -line.\\ -C-t & Toggle {\bf truncation} of summary lines.\\ -M-\& & Execute a command on all articles having the process mark.\\ -M-k & Edit this group's {\bf kill} file.\\ -M-n & (G M-n) Go to the {\bf next} summary line of an unread article. -[distance]\\ -M-p & (G M-p) Go to the {\bf previous} summary line of an unread article. -[distance]\\ -M-r & Search through all previous articles for a regexp.\\ -M-s & {\bf Search} through all subsequent articles for a regexp.\\ -M-K & Edit the general {\bf kill} file.\\ -\end{keys} -} - -\def\SortSummary{ -\subsec{Sort the Summary Buffer} -\begin{keys}{C-c C-s C-a} -C-c C-s C-a & Sort the summary by {\bf author}.\\ -C-c C-s C-d & Sort the summary by {\bf date}.\\ -C-c C-s C-i & Sort the summary by article score.\\ -C-c C-s C-n & Sort the summary by article {\bf number}.\\ -C-c C-s C-s & Sort the summary by {\bf subject}.\\ -\end{keys} -} - -\def\Asubmap{ -\subsec{Article Buffer Commands} -\begin{keys}{A m} -A g & (g) (Re)fetch this article ({\bf get}). [Prefix: just show the -article.]\\ -A r & (^, A ^) Go to the parent of this article (the {\bf References} -header).\\ -M-^ & Fetch the article with a given Message-ID.\\ -A s & (s) Perform an i{\bf search} in the article buffer.\\ -A D & (C-d) Un{\bf digestify} this article into a separate group.\\ -\end{keys} -} - -\def\Bsubmap{ -\subsec{Mail-Group Commands} -{\samepage -These commands (except `B c') are only valid in a mail group.\\* -\begin{keys}{B M-C-e} -B DEL & {\bf Delete} the mail article from disk (!). [p/p]\\ -B c & {\bf Copy} this article from any group to a mail group. [p/p]\\ -B e & {\bf Expire} all expirable articles in this group. [p/p]\\ -B i & {\bf Import} a random file into this group.\\ -B m & {\bf Move} the article from one mail group to another. [p/p]\\ -B q & {\bf Query} where will the article go during fancy splitting\\ -B r & {\bf Respool} this mail article. [p/p]\\ -B w & (e) Edit this article.\\ -B M-C-e & {\bf Expunge} (delete from disk) all expirable articles in this group -(!). [p/p]\\ -\end{keys} -}} - -\def\Gsubmap{ -\subsec{Select Articles} -{\samepage -These commands select the target article. They do not understand the prefix.\\* -\begin{keys}{G C-n} -G b & (,) Go to the {\bf best} article (the one with highest score).\\ -G f & (.) Go to the {\bf first} unread article.\\ -G l & (l) Go to the {\bf last} article read.\\ -G n & (n) Go to the {\bf next} unread article.\\ -p & Go to the {\bf previous} unread article.\\ -G p & {\bf Pop} an article off the summary history and go to it.\\ -G N & (N) Go to {\bf the} next article.\\ -G P & (P) Go to the {\bf previous} article.\\ -G C-n & (M-C-n) Go to the {\bf next} article with the same subject.\\ -G C-p & (M-C-p) Go to the {\bf previous} article with the same subject.\\ -\end{keys} -}} - -\def\Hsubmap{ -\subsec{Help Commands} -\begin{keys}{H d} -H d & (C-c C-d) {\bf Describe} this group. [Prefix: re-read the description -from the server.]\\ -H f & Try to fetch the {\bf FAQ} for this group using ange-ftp.\\ -H h & Give a very short {\bf help} message.\\ -H i & (C-c C-i) Go to the Gnus online {\bf info}.\\ -H v & Display the Gnus {\bf version} number.\\ -\end{keys} -} - -\def\Msubmap{ -\subsec{Mark Articles} -\begin{keys}{M M-C-r} -d & (M d, M r) Mark this article as read and move to the next one. -[scope]\\ -D & Mark this article as read and move to the previous one. [scope]\\ -u & (!, M !, M t) Tick this article (mark it as interesting) and move -to the next one. [scope]\\ -U & Tick this article and move to the previous one. [scope]\\ -M-u & (M SPC, M c) Clear all marks from this article and move to the next -one. [scope]\\ -M-U & Clear all marks from this article and move to the previous one. -[scope]\\ -M ? & (?) Mark this article as dormant (only followups are -interesting). [scope]\\ -M b & Set a {\bf bookmark} in this article.\\ -M e & (E, M x) Mark this article as {\bf expirable}. [scope]\\ -M k & (k) {\bf Kill} all articles with the same subject then select the -next one.\\ -M B & Remove the {\bf bookmark} from this article.\\ -M C & {\bf Catch-up} the articles that are not ticked.\\ -M D & Show all {\bf dormant} articles (normally they are hidden unless they -have any followups).\\ -M H & Catch-up (mark read) this group to point ({\bf here}).\\ -M K & (C-k) {\bf Kill} all articles with the same subject as this one.\\ -C-w & Mark all articles between point and mark as read.\\ -M S & (C-c M-C-s) {\bf Show} all expunged articles.\\ -M C-c & {\bf Catch-up} all articles in this group.\\ -M M-r & (x) Expunge all {\bf read} articles from this group.\\ -M M-D & Hide all {\bf dormant} articles.\\ -M M-C-r & Expunge all articles having a given mark.\\ -\end{keys} - -\subsubsec{Mark Based on Score} -\begin{keys}{M s m} -M V c & {\bf Clear} all marks from all high-scored articles. [score]\\ -M V k & {\bf Kill} all low-scored articles. [score]\\ -M V m & Mark all high-scored articles with a given {\bf mark}. [score]\\ -M V u & Mark all high-scored articles as interesting (tick them). [score]\\ -\end{keys} - -\subsubsec{The Process Mark} -{\samepage -These commands set and remove the process mark \#. You only need to use -it if the set of articles you want to operate on is non-contiguous. Else -use a numeric prefix.\\* -\begin{keys}{M P R} -M P a & Mark {\bf all} articles (in series order).\\ -M P p & (\#, M \#) Mark this article.\\ -M P r & Mark all articles in the {\bf region}.\\ -M P s & Mark all articles in the current {\bf series}.\\ -M P t & Mark all articles in this (sub){\bf thread}.\\ -M P u & (M-\#, M M-\#) {\bf Unmark} this article.\\ -M P R & Mark all articles matching a {\bf regexp}.\\ -M P S & Mark all {\bf series} that already contain a marked article.\\ -M P U & {\bf Unmark} all articles.\\ -\end{keys} -}} - -\def\Osubmap{ -\subsec{Output Articles} -\begin{keys}{O m} -O f & Save this article in plain {\bf file} format. [p/p]\\ -O h & Save this article in {\bf mh} folder format. [p/p]\\ -O m & Save this article in {\bf mail} format. [p/p]\\ -O o & (o, C-o) Save this article using the default article saver. [p/p]\\ -O p & ($\mid$) Pipe this article to a shell command. [p/p]\\ -O r & Save this article in {\bf rmail} format. [p/p]\\ -O v & Save this article in {\bf vm} format. [p/p]\\ -\end{keys} -} - -\def\Ssubmap{ -\subsec{Post, Followup, Reply, Forward, Cancel} -{\samepage -These commands put you in a separate post or mail buffer. After -editing the article, send it by pressing C-c C-c. If you are in a -foreign group and want to post the article using the foreign server, give -a prefix to C-c C-c.\\* -\begin{keys}{S O m} -S b & {\bf Both} post a followup to this article, and send a reply.\\ -S c & (C) {\bf Cancel} this article (only works if it is your own).\\ -S f & (f) Post a {\bf followup} to this article.\\ -S m & (m) Send {\bf a} mail to some other person.\\ -S o m & (C-c C-f) Forward this article by {\bf mail} to a person.\\ -S o p & Forward this article as a {\bf post} to a newsgroup.\\ -S p & (a) {\bf Post} an article to this group.\\ -S r & (r) Mail a {\bf reply} to the author of this article.\\ -S s & {\bf Supersede} this article with a new one (only for own -articles).\\ -S u & {\bf Uuencode} a file and post it as a series.\\ -S B & {\bf Both} post a followup, send a reply, and include the -original. [p/p]\\ -S F & (F) Post a {\bf followup} and include the original. [p/p]\\ -S O m & Digest these series and forward by {\bf mail}. [p/p]\\ -S O p & Digest these series and forward as a {\bf post} to a newsgroup. -[p/p]\\ -S R & (R) Mail a {\bf reply} and include the original. [p/p]\\ -\end{keys} -If you want to cancel or supersede an article you just posted (before it -has appeared on the server), go to the *post-news* buffer, change -`Message-ID' to `Cancel' or `Supersedes' and send it again with C-c C-c. -}} - -\def\Tsubmap{ -\subsec{Thread Commands} -\begin{keys}{T \#} -T \# & Mark this thread with the process mark.\\ -T d & Move to the next article in this thread ({\bf down}). [distance]\\ -T h & {\bf Hide} this (sub)thread.\\ -T i & {\bf Increase} the score of this thread.\\ -T k & (M-C-k) {\bf Kill} the current (sub)thread. [Negative prefix: -tick it, positive prefix: unmark it.]\\ -T l & (M-C-l) {\bf Lower} the score of this thread.\\ -T n & (M-C-f) Go to the {\bf next} thread. [distance]\\ -T p & (M-C-b) Go to the {\bf previous} thread. [distance]\\ -T s & {\bf Show} the thread hidden under this article.\\ -T u & Move to the previous article in this thread ({\bf up}). [distance]\\ -T H & {\bf Hide} all threads.\\ -T S & {\bf Show} all hidden threads.\\ -T T & (M-C-t) {\bf Toggle} threading.\\ -\end{keys} -} - -\def\Vsubmap{ -\subsec{Score (Value) Commands} -{\samepage -Read about Adaptive Scoring in the online info.\\* -\begin{keys}{\bf A p m l} -V a & {\bf Add} a new score entry, specifying all elements.\\ -V c & Specify a new score file as {\bf current}.\\ -V e & {\bf Edit} the current score alist.\\ -V f & Edit a score {\bf file} and make it the current one.\\ -V m & {\bf Mark} all articles below a given score as read.\\ -V s & Set the {\bf score} of this article.\\ -V t & Display all score rules applied to this article ({\bf track}).\\ -V x & {\bf Expunge} all low-scored articles. [score]\\ -V C & {\bf Customize} the current score file through a user-friendly -interface.\\ -V S & Display the {\bf score} of this article.\\ -\bf A p m l& Make a scoring entry based on this article.\\ -\end{keys} - -The four letters stand for:\\* -\quad \B{A}ction: I)ncrease, L)ower;\\* -\quad \B{p}art: a)utor (from), s)ubject, x)refs (cross-posting), d)ate, l)ines, -message-i)d, t)references (parent), f)ollowup, b)ody, h)ead (all headers);\\* -\quad \B{m}atch type:\\* -\qquad string: s)ubstring, e)xact, r)egexp, f)uzzy,\\* -\qquad date: b)efore, a)t, n)this,\\* -\qquad number: $<$, =, $>$;\\* -\quad \B{l}ifetime: t)emporary, p)ermanent, i)mmediate. - -If you type the second letter in uppercase, the remaining two are assumed -to be s)ubstring and t)emporary. -If you type the third letter in uppercase, the last one is assumed to be -t)emporary. - -\quad Extra keys for manual editing of a score file:\\* -\begin{keys}{C-c C-c} -C-c C-c & Finish editing the score file.\\ -C-c C-d & Insert the current {\bf date} as number of days.\\ -\end{keys} -}} - -\def\Wsubmap{ -\subsec{Wash the Article Buffer} -\begin{keys}{W C-c} -W b & Make Message-IDs and URLs in the article to mouse-clickable {\bf - buttons}.\\ -W c & Remove extra {\bf CRs} (^M) from the article.\\ -W f & Look for and display any X-{\bf Face} headers.\\ -W l & (w) Remove page breaks ({\bf^L}) from the article.\\ -W m & Toggle {\bf MIME} processing.\\ -W o & Treat {\bf overstrike} or underline (^H\_) in the article.\\ -W q & Treat {\bf quoted}-printable in the article.\\ -W r & (C-c C-r) Do a Caesar {\bf rotate} (rot13) on the article.\\ -W t & (t) {\bf Toggle} the displaying of all headers.\\ -v & Toggle permanent {\bf verbose} displaying of all headers.\\ -W w & Do word {\bf wrap} in the article.\\ -W T e & Convert the article timestamp to time {\bf elapsed} since sent.\\ -W T l & Convert the article timestamp to the {\bf local} timezone.\\ -W T u & (W T z) Convert the article timestamp to {\bf UTC} ({\bf Zulu}, -GMT).\\ -\end{keys} - -\subsubsec{Hide/Highlight Parts of the Article} -\begin{keys}{W W C-c} -W W a & Hide {\bf all} unwanted parts. Calls W W h, W W s, W W C-c.\\ -W W c & Hide article {\bf citation}.\\ -W W h & Hide article {\bf headers}.\\ -W W s & Hide article {\bf signature}.\\ -W W C-c & Hide article {\bf citation} using a more intelligent algorithm.\\ -%\end{keys} -% -%\subsubsec{Highlight Parts of the Article} -%\begin{keys}{W H A} -W H a & Highlight {\bf all} parts. Calls W b, W H c, W H h, W H s.\\ -W H c & Highlight article {\bf citation}.\\ -W H h & Highlight article {\bf headers}.\\ -W H s & Highlight article {\bf signature}.\\ -\end{keys} -} - -\def\Xsubmap{ -\subsec{Extract Series (Uudecode etc)} -{\samepage -Gnus recognizes if the current article is part of a series (multipart -posting whose parts are identified by numbers in their subjects, e.g.{} -1/10\dots10/10) and processes the series accordingly. You can mark and -process more than one series at a time. If the posting contains any -archives, they are expanded and gathered in a new group.\\* -\begin{keys}{X p} -X b & Un-{\bf binhex} these series. [p/p]\\ -X o & Simply {\bf output} these series (no decoding). [p/p]\\ -X p & Unpack these {\bf postscript} series. [p/p]\\ -X s & Un-{\bf shar} these series. [p/p]\\ -X u & {\bf Uudecode} these series. [p/p]\\ -\end{keys} - -Each one of these commands has four variants:\\* -\begin{keys}{X v \bf Z} -X \bf z & Decode these series. [p/p]\\ -X \bf Z & Decode and save these series. [p/p]\\ -X v \bf z & Decode and view these series. [p/p]\\ -X v \bf Z & Decode, save and view these series. [p/p]\\ -\end{keys} -where {\bf z} or {\bf Z} identifies the decoding method (b, o, p, s, u). - -An alternative binding for the most-often used of these commands is\\* -\begin{keys}{C-c C-v C-v} -C-c C-v C-v & (X v u) Uudecode and view these series. [p/p]\\ -\end{keys} -}} - -\def\Zsubmap{ -\subsec{Exit the Current Group} -\begin{keys}{Z G} -Z c & (c) Mark all unticked articles as read ({\bf catch-up}) and exit.\\ -Z n & Mark all articles as read and go to the {\bf next} group.\\ -Z C & Mark all articles as read ({\bf catch-up}) and exit.\\ -Z E & (Q) {\bf Exit} without updating the group information.\\ -Z G & (M-g) Check for new articles in this group ({\bf get}).\\ -Z N & Exit and go to {\bf the} next group.\\ -Z P & Exit and go to the {\bf previous} group.\\ -Z R & Exit this group, and then enter it again ({\bf reenter}). -[Prefix: select all articles, read and unread.]\\ -Z Z & (q, Z Q) Exit this group.\\ -\end{keys} -} - -\def\ArticleMode{ -\sec{Article Mode} -{\samepage -% All keys for Summary mode also work in Article mode. -The normal navigation keys work in Article mode. -Some additional keys are:\\* -\begin{keys}{C-c C-m} -RET & (middle mouse button) Activate the button at point to follow -an URL or Message-ID.\\ -TAB & Move the point to the next button.\\ -h & (s) Go to the {\bf header} line of the article in the {\bf -summary} buffer.\\ -C-c ^ & Get the article with the Message-ID near point.\\ -C-c C-m & {\bf Mail} reply to the address near point (prefix: include the -original).\\ -\end{keys} -}} - -\def\ServerMode{ -\sec{Server Mode} -{\samepage -To enter this mode, press `^' while in Group mode.\\* -\begin{keys}{SPC} -SPC & (RET) Browse this server.\\ -a & {\bf Add} a new server.\\ -c & {\bf Copy} this server.\\ -e & {\bf Edit} a server.\\ -k & {\bf Kill} this server. [scope]\\ -l & {\bf List} all servers.\\ -q & Return to the group buffer ({\bf quit}).\\ -y & {\bf Yank} the previously killed server.\\ -\end{keys} -}} - -\def\BrowseServer{ -\sec{Browse Server Mode} -{\samepage -To enter this mode, press `B' while in Group mode.\\* -\begin{keys}{RET} -RET & Enter the current group.\\ -SPC & Enter the current group and display the first article.\\ -? & Give a very short help message.\\ -n & Go to the {\bf next} group. [distance]\\ -p & Go to the {\bf previous} group. [distance]\\ -q & (l) {\bf Quit} browse mode.\\ -u & Subscribe to the current group. [scope]\\ -\end{keys} -}} diff -r 6866abce6aaf -r 6075d714658b etc/gnusrefcard/Makefile --- a/etc/gnusrefcard/Makefile Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,62 +0,0 @@ -# -*- mode: makefile; tab-width: 4 -*- - -###### variables -sources = README Makefile makelogo gnuslogo.ps gnusref.tex \ - quickref.tex refcard.tex booklet.tex bk-a4.tex bk-lt.tex -targets = quickref.ps refcard.ps $(bk-lt) $(bk-a4) -bk-lt = bk-lt-d.ps bk-lt-s1.ps bk-lt-s2.ps -bk-a4 = bk-a4-d.ps bk-a4-s1.ps bk-a4-s2.ps - x-lt = 10.8in - y-lt = 5.5in -x2-lt = -2.3in -y2-lt = 11.0in - x-a4 = 27.4cm - y-a4 = 14.85cm -x2-a4 = -6.3cm -y2-a4 = 29.7cm - first = -3L($(x-$*),0)+0L($(x-$*),$(y-$*)) - second = 1R($(x2-$*),$(y2-$*))+-2R($(x2-$*),$(y-$*)) -reverse = -1L($(x-$*),0)+2L($(x-$*),$(y-$*)) - -###### user targets -all: $(targets) -quickref: quickref.ps -refcard: refcard.ps -booklet: bk-lt bk-a4 -bk-lt: bk-lt-d bk-lt-s -bk-a4: bk-a4-d bk-a4-s -bk-lt-d: bk-lt-d.ps -bk-lt-s: bk-lt-s1.ps bk-lt-s2.ps -bk-a4-d: bk-a4-d.ps -bk-a4-s: bk-a4-s1.ps bk-a4-s2.ps -clean: - -rm -f *.dvi *.aux *.log *.toc gnuslogo.???* bk-??.ps $(targets) - -###### internal targets -quickref.ps: quickref.tex gnuslogo.quickref - latex quickref.tex - dvips quickref.dvi -refcard.ps: refcard.tex gnusref.tex gnuslogo.refcard - latex refcard.tex - dvips refcard.dvi -bk-lt.ps bk-a4.ps: bk-%.ps: bk-%.tex booklet.tex gnusref.tex gnuslogo.booklet - latex bk-$*.tex; latex bk-$*.tex # twice to make the TOC - dvips bk-$*.dvi -gnuslogo.quickref gnuslogo.refcard gnuslogo.booklet: gnuslogo.%: gnuslogo.ps - ./makelogo $* -bk-lt-d.ps bk-a4-d.ps: bk-%-d.ps: bk-%.ps - pstops '4:$(first),$(second)' bk-$*.ps bk-$*-d.ps -bk-lt-s1.ps bk-a4-s1.ps: bk-%-s1.ps: bk-%.ps - pstops '4:$(first)' bk-$*.ps bk-$*-s1.ps -bk-lt-s2.ps bk-a4-s2.ps: bk-%-s2.ps: bk-%.ps - pstops '4:$(reverse)' bk-$*.ps bk-$*-s2.ps - -dist = /usr/menaik/ftp/pub/oolog/gnus -dist: $(sources) $(targets) - -mkdir $(dist); - -rm -f $(dist)/* - tar cf - $(sources) | gzip > $(dist)/gnusref.tar.gz - for F in $(targets); do gzip -c $$F > $(dist)/$$F.gz; done - cp README $(dist)/README - chmod ogu+r $(dist) $(dist)/* - ls -l $(dist) diff -r 6866abce6aaf -r 6075d714658b etc/gnusrefcard/README --- a/etc/gnusrefcard/README Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,53 +0,0 @@ - - -(ding) Gnus Reference Card --------------------------- -Vladimir Alexiev -Suggestions and corrections are welcome. - -This directory contains reference materials for the Emacs newsreader Gnus. -Three versions of the reference material are provided: - - 16-page booklet (\small font) - - 5-page 2-column reference card (\footnotesize font which is quite small) - - 1-page 2-column quick refcard (\scriptsize font which is even smaller) -The first two contain all Gnus commands; the last contains only the -most-often used commands. - The booklet is provided for single- and double-sided printers, in paper -formats Letter and A4. The other two cards can be printed on both Letter -and A4 printers. - -The following files are available: - bk-lt-d.ps.gz booklet, Letter paper, double-sided - bk-lt-s1.ps.gz booklet, Letter paper, single-sided, first run - bk-lt-s2.ps.gz booklet, Letter paper, single-sided, second run - bk-a4-d.ps.gz booklet, A4 paper, double-sided - bk-a4-s1.ps.gz booklet, A4 paper, single-sided, first run - bk-a4-s2.ps.gz booklet, A4 paper, single-sided, second run - refcard.ps.gz reference card - quickref.ps.gz quick refcard - -To produce the booklet: -1) Print the booklet. - a) If you have a double-sided printer, - - just print bk-??-d.ps - b) If you have a single-sided printer, things are more complicated - - leave only one paper tray in your printer - - print bk-??-s1.ps - - reload the resulting 4-sheet stack back into the printer. Don't - rearrange the stack, just turn it upside down. - - print bk-??-s2.ps -2) **Important** Arrange the printed stack in the correct order. - The pages are numbered, so you can't make a mistake. -3) Fold the booklet in two and staple it in the middle. Enjoy! - -If you want to make the files yourself, you need the following source files: - makelogo gnuslogo.ps gnusref.tex refcard.tex quickref.tex - booklet.tex bk-a4.tex bk-lt.tex -which are included in the archive gnusref.tar.gz, -and the following programs - GNU make 3.70 - LaTeX 2.09, TeX 3.141 - dvips 5.55 - pstops 1.p13 (part of the package "psutils" by - Angus Duggan ) -Earlier versions might also work. diff -r 6866abce6aaf -r 6075d714658b etc/gnusrefcard/bk-a4.tex --- a/etc/gnusrefcard/bk-a4.tex Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,9 +0,0 @@ -% Reference Booklet for (ding) Gnus, A4 format. -% To be processed with latex 2.09 -\documentstyle{article} -\textwidth 4.9in \textheight 7.35in \topmargin -1.0in -\oddsidemargin -0.5in \evensidemargin -0.5in -\begin{document} -\small%\footnotesize -\input{booklet} -\end{document} diff -r 6866abce6aaf -r 6075d714658b etc/gnusrefcard/bk-lt.tex --- a/etc/gnusrefcard/bk-lt.tex Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,9 +0,0 @@ -% Reference Booklet for (ding) Gnus, Letter format. -% To be processed with latex 2.09 -\documentstyle{article} -\textwidth 4.5in \textheight 7.5in \topmargin -1.0in -\oddsidemargin -0.5in \evensidemargin -0.5in -\begin{document} -\small%\footnotesize -\input{booklet} -\end{document} diff -r 6866abce6aaf -r 6075d714658b etc/gnusrefcard/booklet.tex --- a/etc/gnusrefcard/booklet.tex Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,67 +0,0 @@ -% include file for the Reference Booklet (16 pages). -\def\Guide{Booklet}\def\guide{booklet} -\def\logoscale{0.5} -\def\sec{\section} -\def\subsec{\subsection} -\def\subsubsec{\subsubsection} -\def\blankpage{\vspace*{\fill}\par -%\centerline{(This page intentionally left blank.)} -\par\vspace*{\fill}\pagebreak} - -\input{gnusref} - -\setcounter{page}{0} -\thispagestyle{empty} -\vspace*{\fill} -\Title -\vspace{0.4in} -\Logo{booklet} -\vspace*{\fill} -\pagebreak - -\tableofcontents -\pagebreak -\Notes -\GroupLevels -\Marks -\General -\ServerMode -\BrowseServer -\ArticleMode -\pagebreak - -\GroupMode -\ListGroups -\CreateGroups -\SortGroups -\SOUP -\MarkGroups -\Unsubscribe -\GroupTopics -\SummaryMode -\SortSummary -\Article -\MailGroup -\Limit -\GotoArticle -\MarkArticles -\MarkScore -\ProcessMark -\OutputArticles -\Send -\Exit -\Thread -\Score -\Wash -\Hide -\Highlight -\Extract -\PickAndRead - -%\pagebreak -%\sec{Personal Notes} -%\blankpage - -\thispagestyle{empty} -\vspace*{\fill} -\CopyRight diff -r 6866abce6aaf -r 6075d714658b etc/gnusrefcard/gnuslogo.ps --- a/etc/gnusrefcard/gnuslogo.ps Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1055 +0,0 @@ -%!PS-Adobe-2.0 EPSF-2.0 -%%Title: gnuslogo1.ps -%%Creator: XV Version 3.00 Rev: 3/30/93 - by John Bradley -%%BoundingBox: 0 0 493 505 -%%Pages: 1 -%%DocumentFonts: -%%EndComments -%%EndProlog - -%%Page: 1 1 - -% remember original state -/origstate save def - -% build a temporary dictionary -20 dict begin - -% define string to hold a scanline's worth of data -/pix 62 string def - -% lower left corner -0 0 translate - -% size of image (on paper, in 1/72inch coords) -493.0 505.0 scale - -% dimensions of data -493 505 1 - -% mapping matrix -[493 0 0 -505 0 505] - -{currentfile pix readhexstring pop} -image -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffff01fffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffff8003ffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffff0000ffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -ffffffffffffffffffffffffffffffffffffffff8000007ffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -ffffffffffffffffffffffffffffffffffffffff0000003ffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffe0000000ffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffff000000003fff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffff000000000fff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -ffffffffffffffffffffffffffffffffffffffc0000000007ff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -ffffffffffffffffffffffffffffffffffffff80000000003ff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -ffffffffffffffffffffffffffffffffffffff00000000001ff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffe00000000000ff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffc00000000000ff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffff8000000000007f8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffff0000000000003f8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffff0000000000003f8 -fffffffffffffffffffffffffff800ffffffffffffffffffffffffffffffffffffffffff -ffffffffffffffffffffffffffffffffffffe0000000000001f8 -fffffffffffffffffffffffffff0001fffffffffffffffffffffffffffffffffffffffff -ffffffffffffffffffffffffffffffffffffc0000000000000f8 -ffffffffffffffffffffffffffc00007ffffffffffffffffffffffffffffffffffffffff -ffffffffffffffffffffffffffffffffffffc0000000000000f8 -ffffffffffffffffffffffffff000001ffffffffffffffffffffffffffffffffffffffff -ffffffffffffffffffffffffffffffffffff8000000000000078 -fffffffffffffffffffffffffe0000003ffffffffffff0001fffffffffffffffffffffff -ffffffffffffffffffffffffffffffffffff0000000000000038 -fffffffffffffffffffffffffc0000001fffffffffffe00007ffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffe0000000000000038 -fffffffffffffffffffffffff800000007ffffffffff800001ffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffe0000000000000038 -fffffffffffffffffffffffff000000003fffffffffe0000003fffffffffffffffffffff -fffffffffffffffffffffffffffffffffffc0000000000000018 -ffffffffffffffffffffffffe000000001fffffffff80000000fffffffffffffffffffff -fffffffffffffffffffffffffffffffffffc0000000000000018 -ffffffffffffffffffffffffc000000000ffffffffe000000003ffffffffffffffffffff -fffffffffffffffffffffffffffffffffff80000000000000018 -ffffffffffffffffffffffff80000000007fffffff8000000000ffffffffffffffffffff -fffffffffffffffffffffffffffffffffff80000000000000008 -ffffffffffffffffffffffff00000000003fffffff00000000007fffffffffffffffffff -fffffffffffffffffffffffffffffffffff00000000000000008 -fffffffffffffffffffffffe00000000001ffffffe00000000001fffffffffffffffffff -fffffffffffffffffffffffffffffffffff00000000000000008 -fffffffffffffffffffffffc00000000000ffffff8000000000007ffffffffffffffffff -ffffffffffffffffffffffffffffffffffe00000000000000008 -fffffffffffffffffffffff8000000000007fffff0000000000007ffffffffffffffffff -ffffffffffffffffffffffffffffffffffe00000000000000008 -fffffffffffffffffffffff0000000000001ffffe0000000000000ffffffffffffffffff -ffffffffffffffffffffffffffffffffffc00000000000000000 -ffffffffffffffffffffffe0000000000000ffffc00000000000007fffffffffffffffff -ffffffffffffffffffffffffffffffffffc00000000000000000 -ffffffffffffffffffffffc00000000000007fff800000000000001fffffffffffffffff -ffffffffffffffffffffffffffffffffff800000000000000000 -ffffffffffffffffffffff800000000000003fff000000000000000fffffffffffffffff -ffffffffffffffffffffffffffffffffff800000000000000000 -ffffffffffffffffffffff000000000000003fff0000000000000007ffffffffffffffff -ffffffffffffffffffffffffffffffffff000040000000000000 -fffffffffffffffffffffe000000000000000ffe0000000000000001ffffffffffffffff -ffffffffffffffffffffffffffffffffff0007ffc00000000000 -fffffffffffffffffffffc000000000000000ffc0000000000000000ffffffffffffffff -fffffffffffffffffffffffffffffffffe001ffffc0000000000 -fffffffffffffffffffffc0000000000000007fc00000000000000007fffffffffffffff -fffffffffffffffffffffffffffffffffc003ffffe0000000000 -fffffffffffffffffffff80000000000000007f800000000000000003fffffffffffffff -fffffffffffffffffffffffffffffffffc007fffffc000000000 -fffffffffffffffffffff00000000000000001f000000000000000001fffffffffffffff -fffffffffffffffffffffffffffffffff800fffffff000000000 -ffffffffffffffffffffe00000000000000001f000000000000000000fffffffffffffff -fffffffffffffffffffffffffffffffff801fffffff800000000 -ffffffffffffffffffffc00000000000000000e0000000000000000007ffffffffffffff -fffffffffffffffffffffffffffffffff003ffffffff00000000 -ffffffffffffffffffff800000000000000000c0000000000000000003ffffffffffffff -fffffffffffffffffffffffffffffffff007ffffffff00000000 -ffffffffffffffffffff00000000000000000000000000000000000000ffffffffffffff -ffffffffffffffffffffffffffffffffe00fffffffff80000000 -fffffffffffffffffffe00000000000000000000000000000000000000ffffffffffffff -ffffffffffffffffffffffffffffffffe01fffffffffc0000008 -fffffffffffffffffffc000000000000000000000000000000000000007fffffffffffff -ffffffffffffffffffffffffffffffffc03fffffffffc0000008 -fffffffffffffffffff8000000000000000000000000000000000000001fffffffffffff -ffffffffffffffffffffffffffffffffc07ffffffffff0000000 -fff9fffffffffffffff800000fe00000000000000000000000000000001fffffffffffff -ffffffffffffffffffffffffffffffff807ffffffffff0000000 -fff9fffffffffffffff000001ff80000000000000000000000000000000fffffffffffff -ffffffffffffffffffffffffffffffff80fffffffffff0000008 -fff0ffffffffffffffc000007ffc00000000000000000000000000000007ffffffffffff -ffffffffffffffffffffffffffffffff81fffffffffff8000008 -fff0ffffffffffffffc00000fffc00000000000000000000000000000003ffffffffffff -ffffffffffffffffffffffffffffffff01fffffffffff8000008 -ffe07fffffffffffff800001ffff00000000000000000000000000000001ffffffffffff -ffffffffffffffffffffffffffffffff03fffffffffffc000008 -ffe07fffffffffffff00000fffffc0000000000000000000000000000000ffffffffffff -fffffffffffffffffffffffffffffffe03fffffffffffc000008 -ffe03ffffffffffffc00001fffffe00000000000000000000000000000007fffffffffff -fffffffffffffffffffffffffffffffe07fffffffffffe000008 -ffe03ffffffffffff800003ffffff00000000000000000000000000000003fffffffffff -fffffffffffffffffffffffffffffffe07fffffffffffe000008 -ffc03ffffffffffff000007ffffff80000000000000f80000000000000003fffffffffff -fffffffffffffffffffffffffffffffe0ffffffffffffe000008 -ffc01fffffffffffe00001fffffffe000000000000fffe000000000000001fffffffffff -fffffffffffffffffffffffffffffffc0ffffffffffffe000008 -ffc00fffffffffffc00003ffffffff000000000001ffff800000000000000fffffffffff -fffffffffffffffffffffffffffffffc1fffffffffffff000008 -ff800fffffffffff800003ffffffff800000000007ffffc000000000000007ffffffffff -fffffffffffffffffffffffffffffffc3fffffffffffff000008 -ff8007fffffffffe00000fffffffffc0000000001ffffffc00000000000003ffffffffff -fffffffffffffffffffffffffffffff87fffffffffffff000008 -ff8007fffffffffc00000fffffffffe0000000005ffffffe00000000000001ffffffffff -fffffffffffffffffffffffffffffff87fffffffffffff000008 -ff8003fffffffff800001ffffffffff000000000ffffffffc0000000000000ffffffffff -fffffffffffffffffffffffffffffff87fffffffffffff000008 -ff0001fffffffff000003ffffffffffc00000007fffffffff80000000000007fffffffff -fffffffffffffffffffffffffffffff8ffffffffffffff000008 -ff0000ffffffffe000003ffffffffffc0000000ffffffffffc0000000000007fffffffff -fffffffffffffffffffffffffffffffcffffffffffffff000008 -fe00007fffffff800000ffffffffffff0000001ffffffffffe0000000000001fffffffff -ffffffffffffffffffffffffffffe7fdffffffffffffff000008 -fe00007fffffff000001ffffffffffff8000003fffffffffff0000000000001fffffffff -ffffffffffffffffffffffffffffe7fdffffffffffffff000008 -fc00001ffffffc000003ffffffffffffc000007fffffffffffe0000000000007ffffffff -ffffffffffffffffffffffffffffc7ffffffffffffffff000008 -fc00001ffffff0000003ffffffffffffe00000fffffffffffff0000000000007ffffffff -fffffffffeffffffffffffffffff87ffffffffffffffff000008 -f800000fffffe0000007fffffffffffff00000fffffffffffff8000000000003ffffffff -fffffffffcffffffffffffffffff87ffffffffffffffff000008 -f8000003ffff0000000ffffffffffffff80001fffffffffffffc000000000001ffffffff -fffffffff8ffffffffffffffffff07ffffffffffffffff000008 -f8000001fffe0000001ffffffffffffff80001ffffffffffffff000000000000ffffffff -fffffffff8fffffffffffffffffe0fffffffffffffffff000008 -f0000000fff00000003ffffffffffffffc0001ffffffffffffff8000000000007fffffff -fffffffff0fffffffffffffffffe0fffffffffffffffff000018 -e00000001a000000007ffffffffffffffe0003ffffffffffffffc000000000003fffffff -fffffffff0fffffffffffffffffc0fffffffffffffffff000018 -e000000000000000007fffffffffffffff0003ffffffffffffffc000000000003fffffff -ffffffffe0fffffffffffffffffc1fffffffffffffffff000018 -c00000000000000000ffffffffffffffff0007ffffffffffffffe000000000001fffffff -ffffffffe0fffffffffffffffff81fffffffffffffffff000018 -c00000000000000001ffffffffffffffff0007fffffffffffffff0000000000007ffffff -ffffffffc0fffffffffffffffff83fffffffffffffffff000018 -800000000000000007ffffffffffffffff800ffffffffffffffffc000000000003ffffff -ffffffff01fffffffffffffffff03fffffffffffffffff000038 -800000000000000007ffffffffffffffff800ffffffffffffffffe000000000001ffffff -ffffffff01fffffffffffffffff03fffffffffffffffff800038 -00000000000000000fffffffffffffffffc00fffffffffffffffff000000000000ffffff -fffffffe03ffffffffffffffffe07fffffffffffffffff800038 -00000000000000001fffffffffffffffffc01fffffffffffffffff8000000000007fffff -fffffffc03ffffffffffffffffe07fffffffffffffffff800038 -00000000000000003fffffffffffffffffe03fffffffffffffffffc000000000003fffff -fffffff803ffffffffffffffffc07fffffffffffffffff800038 -00000000000000007ffffffffffffffffff03fffffffffffffffffe000000000000fffff -fffffff007ffffffffffffffffc0ffffffffffffffffff800038 -0000000000000000fffffffffffffffffff07ffffffffffffffffff000000000000fffff -fffffff007ffffffffffffffff80ffffffffffffffffff800078 -0000000000000003ffffffffffffffff8ff87ffffffffffffffffff8000000000001ffff -ffffffc00fffffffffffffffff81ffffffffffffffffff800078 -8000000000000007ffffffffffffffff0ff8fffffffffffffffffffc000000000000ffff -ffffffc00fffffffffffffffff01ffffffffffffffffff8000f8 -8000000000000007fffffffffffffffe0ffffffffffffffffffffffe0000000000007fff -ffffff801fffffffffffffffff03ffffffffffffffffff8000f8 -c00000000000001ffffffffffffffffc0fffffffffffffffffffffff0000000000001fff -fffffe001ffffffffffffffffe07ffffffffffffffffff8000f8 -e00000000000007ffffffffffffffff83fffffffffffffffffffffffc0000000000007ff -fffff8003ffffffffffffffffc07ffffffffffffffffff8000f8 -f00000000000007ffffffffffffffff03fffffffffffffffffffffffc0000000000001ff -fffff0003ffffffffffffffff80fffffffffffffffffff8000f8 -f0000000000000fffffffffffffffff07fffffffffffffffffffffffe0000000000000ff -ffffe0003ffffffffffffffff00fffffffffffffffffff8001f8 -f8000000000003ffffffffffffffffe07ffffffffffffffffffffffff00000000000000f -ffff00007fffffffffffffffe01fffffffffffffffffff0001f8 -fc000000000007ffffffffffffffffc07ffffffffffffffffffffffff800000000000007 -fffc00007fffffffffffffffc01fffffffffffffffffff0001f8 -fc000000000007ffffffffffffffffc0fffffffffffffffffffffffff800000000000000 -ffe000007ffffbffffffffff801fffffffffffffffffff0001f8 -fe00000000001fffffffffffffffff03fffffffffffffffffffffffffe00000000000000 -00000000fffff3ffffffffff003fffffffffffffffffff0001f8 -fe00000000003fffffffffffffffff03ffffffffffffffffffffffffff00000000000000 -00000001fffff1fffffffffe003fffffffffffffffffff0003f8 -ff00000000007ffffffffffffffffe03ffffffffffffffffffffffffff00000000000000 -00000001ffffe1fffffffffc007fffffffffffffffffff0003f8 -ff8000000001fffffffffffffffffc07ffffffffffffffffffffffffff80000000000000 -00000003ffffe0fffffffff0007fffffffffffffffffff0003f8 -ffc000000003fffffffffffffffffc0fffffffffffffffffffffffffffc0000000000000 -00000003ffffc0ffffffffe0007fffffffffffffffffff0003f8 -ffe00000000ffffffffffffffffff81fffffffffffffffffffffffffffe0000000000000 -00000007ffffc07fffffff8000ffffffffffffffffffff0003f8 -fff00000003ffffffffffffffffff01ffffffffffffffffffffffffffff0000000000000 -00000007ffff803fffffff0000fffffffffffffffffffe0007f8 -fff8000000ffffffffffffffffffe03ffffffffffffffffffffffffffff8000000000000 -00000007ffff801ffffffc0001fffffffffffffffffffe0007f8 -fffc000001ffffffffffffffffffe07ffffffffffffffffffffffffffffc000000000000 -0000000fffff000ffffff80003fffffffffffffffffffe0007f8 -fffe00000fffffffffffffffffffc07ffffffffffffffffffffffffffffc000000000000 -0000000fffff0007ffffe00003fffffffffffffffffffe0007f8 -ffff80007fffffffffffffffffff80fffffffffffffffffffffffffffffe000000000000 -0000001ffffe0001ffff800007fffffffffffffffffffe000ff8 -ffffe007ffffffffffffffffffff80ffffffffffffffffffffffffffffff000000000000 -0000001ffffe0000fffc000007fffffffffffffffffffe000ff8 -ffffffffffffffffffffffffffff01ffffffffffffffffffffffffffffff800000000000 -0000003ffffe0000000000000ffffffffffffffffffffe000ff8 -fffffffffffffffffffffffffffe03ffffffffffffffffffffffffffffffc00000000000 -0000003ffffc0000000000000ffffffffffffffffffffe000ff8 -fffffffffffffffffffffffffffe03ffffffffffffffffffffffffffffffe00000000000 -0000007ffff80000000000001ffffffffffffffffffffe001ff8 -fffffffffffffffffffffffffffc07fffffffffffffffffffffffffffffff00000000000 -0000007ffff80000000000001ffffffffffffffffffffe001ff8 -fffffffffffffffffffffffffff807fffffffffffffffffffffffffffffff80000000000 -000000fffff80000000000003ffffffffffffffffffffc001ff8 -fffffffffffffffffffffffffff80ffffffffffffffffffffffffffffffffc0000000000 -000003fffff00000000000007ffffffffffffffffffffc001ff8 -fffffffffffffffffffffffffff01ffffffffffffffffffffffffffffffffe0000000000 -000007ffffe00000000000007ffffffffffffffffffffe003ff8 -fffffffffffffffffffffffffff01fffffffffffffffffffffffffffffffff0000000000 -000007ffffe0000000000000fffffffffffffffffffffc003ff8 -ffffffffffffffffffffffffffc07fffffffffffffffffffffffffffffffff8000000000 -00001fffffc0000000000001fffffffffffffffffffffc003ff8 -ffffffffffffffffffffffffffc07fffffffffffffffffffffffffffffffffe000000000 -00001fffffc0000000000003fffffffffffffffffffffc003ff8 -ffffffffffffffffffffffffffc07ffffffffffffffffffffffffffffffffff000000000 -00003fffff80000000000003fffffffffffffffffffffc007ff8 -ffffffffffffffffffffffffff01fffffffffffffffffffffffffffffffffff800000000 -00007fffff80000000000007fffffffffffffffffffffc007ff8 -ffffffffffffffffffffffffff03fffffffffffffffffffffffffffffffffffc00000000 -0000ffffff0000000000000ffffffffffffffffffffffc007ff8 -fffffffffffffffffffffffffe03fffffffffffffffffffffffffffffffffffc00000000 -0001ffffff0000000000001ffffffffffffffffffffffc007ff8 -fffffffffffffffffffffffffc07ffffffffffffffffffffffffffffffffffff00000000 -0003fffffe0000000000001ffffffffffffffffffffff800fff8 -fffffffffffffffffffffffff80fffffffffffffffffffffffffffffffffffff80000000 -0007fffffe0000000000003ffffffffffffffffffffff800fff8 -fffffffffffffffffffffffff01ffffffffffffffffffffffffffffffffffffff0000000 -001ffffffc0000000000007ffffffffffffffffffffff800fff8 -fffffffffffffffffffffffff03ffffffffffffffffffffffffffffffffffffff8000000 -003ffffffc000000000000fffffffffffffffffffffff800fff8 -ffffffffffffffffffffffffe07ffffffffffffffffffffffffffffffffffffffe000000 -00fffffff8000000000003fffffffffffffffffffffff001fff8 -ffffffffffffffffffffffffe07fffffffffffffffffffffffffffffffffffffff800000 -03fffffff8000000000003fffffffffffffffffffffff001fff8 -ffffffffffffffffffffffffc0ffffffffffffffffffffffffffffffffffffffffc00000 -07fffffff0000000000007fffffffffffffffffffffff001fff8 -ffffffffffffffffffffffff80fffffffffffffffffffffffffffffffffffffffffc0000 -3ffffffff000000000000ffffffffffffffffffffffff003fff8 -ffffffffffffffffffffffff01ffffffffffffffffffffffffffffffffffffffffffe03f -fffffffff000000000003ffffffffffffffffffffffff003fff8 -ffffffffffffffffffffffff01ffffffffffffffffffffffffffffffffffffffffffffff -fffffffff800000000007ffffffffffffffffffffffff003fff8 -fffffffffffffffffffffffe03ffffffffffffffffffffffffffffffffffffffffffffff -fffffffff80000000000ffffffffffffffffffffffffe003fff8 -fffffffffffffffffffffffc07ffffffffffffffffffffffffffffffffffffffffffffff -fffffffffc0000000003ffffffffffffffffffffffffe007fff8 -fffffffffffffffffffffffc0fffffffffffffffffffffffffffffffffffffffffffffff -fffffffffe0000000007ffffffffffffffffffffffffe007fff8 -fffffffffffffffffffffff81fffffffffffffffffffffffffffffffffffffffffffffff -fffffffffe000000000fffffffffffffffffffffffffe00ffff8 -fffffffffffffffffffffff01fffffffffffffffffffffffffffffffffffffffffffffff -ffffffffff000000001fffffffffffffffffffffffffe00ffff8 -ffffffffffffffffffffffe03ffffffffffffffffffffffffbffffffffffffffffffffff -ffffffffff800000007fffffffffffffffffffffffffc00ffff8 -ffffffffffffffffffffffe07ffffffffffffffffffdfffff1ffffffffffffffffffffff -ffffffffffc0000000ffffffffffffffffffffffffffc00ffff8 -ffffffffffffffffffffffe07ffffffffffffffffff9fffff07fffffffffffffffffffff -ffffffffffe0000001ffffffffffffffffffffffffffc00ffff8 -ffffffffffffffffffffffc0ffffffffffffffffffe3ffffe03fffffffffffffffffffff -fffffffffff800001fffffffffffffffffffffffffffc01ffff8 -ffffffffffffffffffffff81ffffffffffffffffffc7ffffc00fffffffffffffffffffff -fffffffffffe00007fffffffffffffffffffffffffffc01ffff8 -ffffffffffffffffffffff81ffffffffffffffffff87ffffc007ffffffffffffffffffff -ffffffffffff8003ffffffffffffffffffffffffffff801ffff8 -ffffffffffffffffffffff03ffffffffffffffffff0fffff8007ffffffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffffff803ffff8 -fffffffffffffffffffffe07fffffffffffffffffe0fffff8001ffffffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffffff803ffff8 -fffffffffffffffffffffe07fffffffffffffffffc1fffff0000ffffffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffffff803ffff8 -fffffffffffffffffffffc0ffffffffffffffffff83ffffe00007fffffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffffff007ffff8 -fffffffffffffffffffff81fffffffffffffffffe03ffffe00007fffffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffffff007ffff8 -fffffffffffffffffffff83fffffffffffffffffc07ffffc00003fffffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffffff007ffff8 -fffffffffffffffffffff03fffffffffffffffff80fffff800001fffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffe00fffff8 -ffffffffffffffffffffe07fffffffffffffffff00fffff800000fffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffe00fffff8 -ffffffffffffffffffffe0fffffffffffffffffe01fffff0000007ffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffe00fffff8 -ffffffffffffffffffffc0fffffffffffffffffc01ffffe0000003ffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffe00fffff8 -ffffffffffffffffffff81fffffffffffffffff803ffffe0000003ffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffe01fffff8 -ffffffffffffffffffff81ffffffffffffffffe007ffffc0000003ffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffc01fffff8 -ffffffffffffffffffff83ffffffffffffffffe007ffffc0000001ffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffc01fffff8 -ffffffffffffffffffff07ffffffffffffffff800fffff80000000ffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffc01fffff8 -fffffffffffffffffffe07ffffffffffffffff800fffff00000000ffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffc03fffff8 -fffffffffffffffffffc0ffffffffffffffffe001fffff00000000ffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffff803fffff8 -fffffffffffffffffffc0ffffffffffffffffc003ffffe000000007fffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffff803fffff8 -fffffffffffffffffff81ffffffffffffffff0003ffffc000000007fffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffff007fffff8 -fffffffffffffffffff01fffffffffffffffe0007ffffc000000003fffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffff007fffff8 -fffffffffffffffffff03fffffffffffffffe000fffff8000000001fffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffff007fffff8 -ffffffffffffffffffe07fffffffffffffff8000fffff0000000001fffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffffe00ffffff8 -ffffffffffffffffffc07fffffffffffffff0001fffff0000000001fffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffffe00ffffff8 -ffffffffffffffffffc0fffffffffffffffe0001ffffe0000000000fffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffffe00ffffff8 -ffffffffffffffffff80fffffffffffffff80003ffffe0000000000fffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffffe01ffffff8 -ffffffffffffffffff81fffffffffffffff00007ffffc0000000000fffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffffc01ffffff8 -ffffffffffffffffff81ffffffffffffffe00007ffffc00000000007ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffffc01ffffff8 -ffffffffffffffffff03ffffffffffffffc0000fffffc00000000007ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffffc03ffffff8 -fffffffffffffffffe03ffffffffffffff00000fffffe00000000007ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffff803ffffff8 -fffffffffffffffffc07fffffffffffffe00001ffffff00000000007ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffff803ffffff8 -fffffffffffffffffc07fffffffffffffc00007ffffffc0000000007ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffff807ffffff8 -fffffffffffffffff807fffffffffffff00001fffffffe0000000003ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffff807ffffff8 -fffffffffffffffff807ffffffffffffe00003ffffffff0000000003ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffff007ffffff8 -fffffffffffffffff00fffffffffffff800007ffffffff8000000003ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffff00fffffff8 -fffffffffffffffff00fffffffffffff00000fffffffffc000000001ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffff00fffffff8 -ffffffffffffffffe00ffffffffffffc00003fffffffffe000000001ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffe01fffffff8 -ffffffffffffffffe00ffffffffffff800007ffffffffff000000001ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffe01fffffff8 -ffffffffffffffffc00ffffffffffff00000fffffffffff800000001ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffe01fffffff8 -ffffffffffffffff800fffffffffffc00001fffffffffffc00000001ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffe03fffffff8 -ffffffffffffffff800fffffffffff000007fffffffffffe00000001ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffe03fffffff8 -ffffffffffffffff001ffffffffffe00000fffffffffffff00000001ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffc07fffffff8 -ffffffffffffffff001ffffffffffc00001fffffffffffff80000001ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffc07fffffff8 -fffffffffffffffe000fffffffffe000003fffffffffffff80000001ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffff807fffffff8 -fffffffffffffffe000fffffffffc000007fffffffffffffc0000000ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffff807fffffff8 -fffffffffffffffc000fffffffff800000ffffffffffffffe0000000ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffff80ffffffff8 -fffffffffffffffc0007fffffffe000001fffffffffffffff0000000ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffff80ffffffff8 -fffffffffffffffc0003fffffffc000003fffffffffffffff0000000ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffff01ffffffff8 -fffffffffffffff80001fffffff8000007fffffffffffffff8000000ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffff01ffffffff8 -fffffffffffffff80000ffffffc000001ffffffffffffffff8000000ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffff01ffffffff8 -fffffffffffffff800003fffff0000003ffffffffffffffffc000000ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffe01ffffffff8 -fffffffffffffff000000000000000007ffffffffffffffffc000000ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffe03ffffffff8 -ffffffffffffffe00000000000000000fffffffffffffffffe000000ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffe03ffffffff8 -ffffffffffffffe00000000000000001fffffffffffffffffe000000ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffc07ffffffff8 -ffffffffffffffc00000000000000003fffffffffffffffffe000000ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffc07ffffffff8 -ffffffffffffffc00000000000000007ffffffffffffffffff000000ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffc07ffffffff8 -ffffffffffffffc0000000000000000fffffffffffffffffff000000ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffc0fffffffff8 -ffffffffffffff80000000000000003fffffffffffffffffff800000ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffffc0fffffffff8 -ffffffffffffff80000000000000007fffffffffffffffffff800001ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffff80fffffffff8 -ffffffffffffff8000000000000001ffffffffffffffffffff800001ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffff81fffffffff8 -ffffffffffffff8000000000000001ffffffffffffffffffffc00001ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffff81fffffffff8 -ffffffffffffff8000000000000003ffffffffffffffffffffe00001ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffff01fffffffff8 -ffffffffffffff000000000000000fffffffffffffffffffffe00001ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffff03fffffffff8 -ffffffffffffff000000000000001ffffffffffffffffffffff00001ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffe03fffffffff8 -fffffffffffffe000000000000003ffffffffffffffffffffff00001ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffe03fffffffff8 -fffffffffffffe000000000000007ffffffffffffffffffffff00001ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffe03fffffffff8 -fffffffffffffc00000000000001fffffffffffffffffffffff00001ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffe07fffffffff8 -fffffffffffffc00000000000007fffffffffffffffffffffff00001ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffc07fffffffff8 -fffffffffffffc00000000000007fffffffffffffffffffffff00001ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffc07fffffffff8 -fffffffffffffc0000000000003ffffffffffffffffffffffff80003ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffc0ffffffffff8 -fffffffffffffc0000000000007ffffffffffffffffffffffff80003ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffc0ffffffffff8 -fffffffffffffc000000000000fffffffffffffffffffffffff80003ffffffffffffffff -fffffffffffffffffffffffffffffffffffffff80ffffffffff8 -fffffffffffffc000000000003fffffffffffffffffffffffff80003ffffffffffffffff -fffffffffffffffffffffffffffffffffffffff80ffffffffff8 -fffffffffffffc000000000007fffffffffffffffffffffffff80003ffffffffffffffff -fffffffffffffffffffffffffffffffffffffff00ffffffffff8 -fffffffffffffc00000000001ffffffffffffffffffffffffff80007ffffffffffffffff -fffffffffffffffffffffffffffffffffffffff01ffffffffff8 -fffffffffffffe00000000001ffffffffffffffffffffffffff80007ffffffffffffffff -fffffffffffffffffffffffffffffffffffffff01ffffffffff8 -fffffffffffffe0000000000fffffffffffffffffffffffffff80007ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffe01ffffffffff8 -ffffffffffffff0000000001fffffffffffffffffffffffffff80007ffffffffffffffff -ffffffffffffffffffffffffffffffffffffffe03ffffffffff8 -ffffffffffffff000000000ffffffffffffffffffffffffffff80007ffffffffffffffff -fffffffffffffffffffdffffffffffffffffffe03ffffffffff8 -ffffffffffffff800000003ffffffffffffffffffffffffffff80007ffffffffffffffff -fffffffffffffffffff9ffffffffffffffffffc03ffffffffff8 -ffffffffffffffe0000001fffffffffffffffffffffffffffff80007ffffffffffffffff -fffffffffffffffffff1ffffffffffffffffff807ffffffffff8 -fffffffffffffff0000001fffffffffffffffffffffffffffff8000fffffffffffffffff -fffffffffffffffffff1ffffffffffffffffff807ffffffffff8 -fffffffffffffff800000ffffffffffffffffffffffffffffffc000fffffffffffffffff -fffffffffffffffffff1ffffffffffffffffff807ffffffffff8 -fffffffffffffffe0003fffffffffffffffffffffffffffffffc000fffffffffffffffff -ffffffffffffffffffe1ffffffffffffffffff807ffffffffff8 -ffffffffffffffff4007fffffffffffffffffffffffffffffffc001fffffffffffffffff -ffffffffffffffffffc1ffffffffffffffffff00fffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffc001fffffffffffffffff -ffffffffffffffffff83ffffffffffffffffff00fffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffc001fffffffffffffffff -ffffffffffffffffff83ffffffffffffffffff00fffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffc001fffffffffffffffff -ffffffffffffffffff03ffffffffffffffffff00fffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffc001fffffffffffffffff -ffffffffffffffffff03ffffffffffffffffff01fffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffc003fffffffffffffffff -ffffffffffffffffff07ffffffffffffffffff01fffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffc003fffffffffffffffff -fffffffffffffffffe07fffffffffffffffffe01fffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffc003fffffffffffffffff -fffffffffffffffffc07fffffffffffffffffe03fffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffc007fffffffffffffffff -fffffffffffffffffc07fffffffffffffffffc03fffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffc007fffffffffffffffff -fffffffffffffffff80ffffffffffffffffffc03fffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffe007fffffffffffffffff -fffffffffffffffff80ffffffffffffffffffc03fffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffe007fffffffffffffffff -fffffffffffffffff80ffffffffffffffffffc03fffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffe00ffffffffffffffffff -fffffffffffffffff03ffffffffffffffffff807fffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffe00ffffffffffffffffff -ffffffffffffffffe01ffffffffffffffffff807fffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffe01ffffffffffffffffff -ffffffffffffffffe03ffffffffffffffffff807fffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffe01ffffffffffffffffff -ffffffffffffffffc07ffffffffffffffffff00ffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffe03ffffffffffffffffff -ffffffffffffffffc07ffffffffffffffffff00ffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffe03ffffffffffffffffff -ffffffffffffffff80fffffffffffffffffff00ffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffe07ffffffffffffffffff -ffffffffffffffff80fffffffffffffffffff00ffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffff07ffffffffffffffffff -ffffffffffffffff00ffffffffffffffffffe01ffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffff07ffffffffffffffffff -fffffffffffffffe00ffffffffffffffffffe01ffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffff0fffffffffffffffffff -fffffffffffffffe00ffffffffffffffffffe01ffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffff0fffffffffffffffffff -fffffffffffffffc01ffffffffffffffffffc01ffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffff1fffffffffffffffffff -fffffffffffffffc03ffffffffffffffffffc01ffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffff3fffffffffffffffffff -fffffffffffffffc03ffffffffffffffffffc03ffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffff7fffffffffffffffffff -fffffffffffffff807ffffffffffffffffffc03ffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffff807ffffffffffffffffff803ffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffff00fffffffffffffffffff803ffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffff00fffffffffffffffffff807ffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -ffffffffffffffe01fffffffffffffffffff807ffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -ffffffffffffffe03fffffffffffffffffff807ffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -ffffffffffffffc03fffffffffffffffffff807ffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -ffffffffffffff807fffffffffffffffffff00fffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -ffffffffffffff807fffffffffffffffffff00fffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -ffffffffffffff00ffffffffffffffffffff00fffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -ffffffffffffff00fffffffffffffffffffe00fffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffe01fffffffffffffffffffe01fffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffe03fffffffffffffffffffe01fffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffc03fffffffffffffffffffc01fffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffc07fffffffffffffffffffc01fffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffff807fffffffffffffffffffc03fffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffff00ffffffffffffffffffffc03fffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffff00ffffffffffffffffffff803fffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -ffffffffffffe01ffffffffffffffffffff803fffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -ffffffffffffe01ffffffffffffffffffff803fffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -ffffffffffffc03ffffffffffffffffffff807fffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -ffffffffffffc03ffffffffffffffffffff007fffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -ffffffffffff807ffffffffffffffffffff007fffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -ffffffffffff807ffffffffffffffffffff007fffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -ffffffffffff00fffffffffffffffffffff007fffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffe00ffffffffffffffffffffe00ffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffe01ffffffffffffffffffffe00ffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffff9fffffffffffff -fffffffffffc01ffffffffffffffffffffe00ffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffff1fffffffffffff -fffffffffffc03ffffffffffffffffffffe00ffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffff1fffffffffffff -fffffffffff803ffffffffffffffffffffc00ffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffffffffe1fffffffffffff -fffffffffff807ffffffffffffffffffffc00ffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffffffffc1fffffffffffff -fffffffffff00fffffffffffffffffffffc01ffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffffffffc3fffffffffffff -fffffffffff00fffffffffffffffffffffc01ffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffffffff83fffffffffffff -ffffffffffc01fffffffffffffffffffffc01ffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffffffff07fffffffffffff -ffffffffffc01fffffffffffffffffffffc01ffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffffffff07fffffffffffff -ffffffffff801fffffffffffffffffffff801ffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffffffff07fffffffffffff -ffffffffff803fffffffffffffffffffff801ffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffe0ffffffffffffff -ffffffffff003fffffffffffffffffffff803ffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffc0ffffffffffffff -fffffffffe007fffffffffffffffffffff803ffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffffc1ffffffffffffff -fffffffffc007fffffffffffffffffffff003ffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffff81ffffffffffffff -fffffffffc00ffffffffffffffffffffff003ffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffff01ffffffffffffff -fffffffff800ffffffffffffffffffffff003ffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffff01ffffffffffffff -fffffffff801ffffffffffffffffffffff003ffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffff03ffffffffffffff -fffffffff803ffffffffffffffffffffff007ffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffffffe07ffffffffffffff -fffffffff003fffffffffffffffffffffe007ffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffffffc07ffffffffffffff -ffffffffe007fffffffffffffffffffffe007ffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffffff807ffffffffffffff -ffffffffc007fffffffffffffffffffffe007ffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffffff007ffffffffffffff -ffffffffc007fffffffffffffffffffffe007ffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffffff00fffffffffffffff -ffffffff800ffffffffffffffffffffffe00fffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffffff00fffffffffffffff -ffffffff000ffffffffffffffffffffffe00fffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffe00fffffffffffffff -fffffffe001ffffffffffffffffffffffe00fffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffc01fffffffffffffff -fffffffc003ffffffffffffffffffffffe00fffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffffc01fffffffffffffff -9ffffffc003ffffffffffffffffffffffe00fffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffff803fffffffffffffff -0ffffff8003ffffffffffffffffffffffc01fffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffff003ffffffffffffffe -07fffff0007ffffffffffffffffffffffc01fffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffff003ffffffffffffffe -07ffffe000fffffffffffffffffffffffc01fffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffffe007ffffffffffffff8 -03ffffc000fffffffffffffffffffffffc01fffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffffe007ffffffffffffff0 -03ffff8001fffffffffffffffffffffff801fffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffffc007ffffffffffffff0 -01ffff0003fffffffffffffffffffffff803fffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffff800ffffffffffffffe0 -00fffe0003fffffffffffffffffffffff803fffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffff800ffffffffffffffe0 -00fffe0003fffffffffffffffffffffff803fffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffff001ffffffffffffffc0 -003ffc0007fffffffffffffffffffffff003fffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffe003ffffffffffffff80 -001fe0001ffffffffffffffffffffffff003fffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffe003ffffffffffffff00 -000fc0001ffffffffffffffffffffffff007fffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffffc007fffffffffffffe00 -000000001ffffffffffffffffffffffff007fffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffff8007fffffffffffffe00 -000000003ffffffffffffffffffffffff007fffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffff800ffffffffffffffc00 -000000003ffffffffffffffffffffffff007fffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffff000ffffffffffffff800 -000000007fffffffffffffffffffffffe007fffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffe001ffffffffffffff800 -000000007fffffffffffffffffffffffe007fffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffe001ffffffffffffff000 -00000001ffffffffffffffffffffffffe007fffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffc003ffffffffffffff000 -00000001ffffffffffffffffffffffffe007fffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffffc007fffffffffffffe000 -00000001ffffffffffffffffffffffffe007fffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffff0007fffffffffffffc000 -00000003ffffffffffffffffffffffffc00ffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffff000ffffffffffffffc000 -00000003ffffffffffffffffffffffffc00ffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffe000ffffffffffffff8000 -00000007ffffffffffffffffffffffffc00ffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffc001ffffffffffffff0000 -0000000fffffffffffffffffffffffffc01ffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffffc003ffffffffffffff0000 -0000001fffffffffffffffffffffffffc01ffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffff8003fffffffffffffe0000 -0000001fffffffffffffffffffffffffc01ffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffff0007fffffffffffffe0000 -0000003fffffffffffffffffffffffffc01ffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffe000ffffffffffffffc0000 -0000007fffffffffffffffffffffffff801ffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffe000ffffffffffffff80000 -0000007fffffffffffffffffffffffff801ffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffffc001ffffffffffffff80000 -000000ffffffffffffffffffffffffff801ffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffff8001ffffffffffffff00000 -000001ffffffffffffffffffffffffff801ffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffff0003ffffffffffffff00000 -000001ffffffffffffffffffffffffff801ffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffff0003ffffffffffffff00000 -000003ffffffffffffffffffffffffff801ffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffe0007fffffffffffffe00000 -000003ffffffffffffffffffffffffff801ffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffe000ffffffffffffffe00000 -000007ffffffffffffffffffffffffff803ffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffffc000ffffffffffffffc00000 -00000fffffffffffffffffffffffffff003ffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffff8001ffffffffffffff800000 -00000fffffffffffffffffffffffffff803ffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffff0003ffffffffffffff800000 -00001fffffffffffffffffffffffffff803ffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffff0007ffffffffffffff000200 -00003fffffffffffffffffffffffffff007ffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffe0007fffffffffffffe000700 -00007fffffffffffffffffffffffffff00fffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffffc000ffffffffffffffe001f80 -0000ffffffffffffffffffffffffffff00fffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffff8000ffffffffffffffe001f80 -0001ffffffffffffffffffffffffffff00fffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffff8000ffffffffffffffc003fc0 -0001ffffffffffffffffffffffffffff00fffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffff0001ffffffffffffff8007fe0 -0003ffffffffffffffffffffffffffff01fffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffe0003ffffffffffffff0007fe0 -0007ffffffffffffffffffffffffffff01fffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffe0007ffffffffffffff000fff0 -0007ffffffffffffffffffffffffffff01fffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffffc000ffffffffffffffe003fff8 -001fffffffffffffffffffffffffffff07fffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffff8000ffffffffffffffe003fffc -007fffffffffffffffffffffffffffff07fffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffff8000ffffffffffffffe003fffe -00ffffffffffffffffffffffffffffff07fffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffff0001ffffffffffffffc007ffff -dfffffffffffffffffffffffffffffff0ffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffe0003ffffffffffffff800fffff -fffffffffffffffffffffffffffffffe1ffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffc0007ffffffffffffff800fffff -fffffffffffffffffffffffffffffffe1ffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffffc0007ffffffffffffff001fffff -fffffffffffffffffffffffffffffffe1ffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffff8000fffffffffffffff003fffff -fffffffffffffffffffffffffffffffe3ffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffff0000ffffffffffffffe003fffff -ffffffffffffffffffffffffffffffff3ffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffe0001ffffffffffffffc007fffff -ffffffffffffffffffffffffffffffff3ffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffe0003ffffffffffffffc007fffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffffc0007ffffffffffffffc00ffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffff8000fffffffffffffff800ffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffff8000fffffffffffffff801ffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffe0000fffffffffffffff001ffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffc0001fffffffffffffff003ffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffffc0003ffffffffffffffe007ffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffff80007ffffffffffffffe007ffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffff0000fffffffffffffffc00fffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffff0000fffffffffffffffc00fffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffe0001fffffffffffffffc00fffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffc0001fffffffffffffff801fffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffffc0003fffffffffffffff801fffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffff80003fffffffffffffff003fffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffff0000ffffffffffffffff007fffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffe0000ffffffffffffffff007fffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffc0001fffffffffffffffc007fffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffffc0001fffffffffffffffc00ffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffff80003fffffffffffffffc01ffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffff0000ffffffffffffffff801ffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffe0001ffffffffffffffff801ffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffc0001ffffffffffffffff803ffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffffc0003ffffffffffffffff803ffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffff80003fffffffffffffffe007ffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffff80007fffffffffffffffe007ffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffff0000ffffffffffffffffe00fffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffff0000ffffffffffffffffc00fffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffffc0001ffffffffffffffff801fffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffff80003ffffffffffffffff803fffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffff80003ffffffffffffffff003fffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffff00007ffffffffffffffff003fffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffe0000ffffffffffffffffe007fffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffe0000ffffffffffffffffc007fffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffffc0001ffffffffffffffffc00ffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffff80007ffffffffffffffffc00ffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffff00007ffffffffffffffff801ffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffff00007ffffffffffffffff801ffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffe0000fffffffffffffffff003ffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffffc0001fffffffffffffffff003ffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffff80003ffffffffffffffffe007ffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffff80003ffffffffffffffffe007ffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffe00007ffffffffffffffffc00fffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffe0000fffffffffffffffffc00fffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffffe0000fffffffffffffffffc00fffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffff80001fffffffffffffffff801fffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffff00003fffffffffffffffff801fffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffff00007fffffffffffffffff003fffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffe00007fffffffffffffffff007fffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffc0000ffffffffffffffffff007fffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffffc0001fffffffffffffffffc007fffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffff80003fffffffffffffffffc00ffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffff80007fffffffffffffffffc01ffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffff00007fffffffffffffffff801ffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffff0000ffffffffffffffffff801ffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffffc0001ffffffffffffffffff803ffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffff80003ffffffffffffffffff803ffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffff00007ffffffffffffffffff007ffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffff00007ffffffffffffffffff007ffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffe0000ffffffffffffffffffe00fffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffc0000ffffffffffffffffffe00fffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffffc0001ffffffffffffffffffe01fffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffff80003ffffffffffffffffffc03fffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffff00007ffffffffffffffffffc03fffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffe00007ffffffffffffffffffc03fffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffe00007ffffffffffffffffffc07fffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffffc0001fffffffffffffffffff807fffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffff80003fffffffffffffffffff80ffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffff80003fffffffffffffffffff80ffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffff00007fffffffffffffffffff81ffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffe0000ffffffffffffffffffff01ffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffe0001ffffffffffffffffffff03ffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffffc0003ffffffffffffffffffff03ffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffff80003fffffffffffffffffffe07ffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffff00007fffffffffffffffffffe07ffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffe00007fffffffffffffffffffe0fffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffe0000ffffffffffffffffffffc0fffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffe0000ffffffffffffffffffffc1fffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffffc0001ffffffffffffffffffffc1fffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffff80007ffffffffffffffffffff83fffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffff00007ffffffffffffffffffff83fffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffe00007ffffffffffffffffffff83fffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffe0000fffffffffffffffffffff87fffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffc0001fffffffffffffffffffff87fffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffffc0001fffffffffffffffffffff0ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffff80003fffffffffffffffffffff0ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffff00007fffffffffffffffffffff0ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffff0000ffffffffffffffffffffff1ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffe0000fffffffffffffffffffffe1ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffffc0001fffffffffffffffffffffe3ffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffff80003fffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffff00007fffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffff0000ffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffe0001ffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffe0001ffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffc0003ffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffffc0007ffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffff0000fffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffff0000fffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffe0001fffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffc0003fffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffc0003fffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffffc0007fffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffff8000ffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffff8001ffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffff0001ffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffff0003ffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffff0003ffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffe0007ffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffffc000fffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffff8001fffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffff8001fffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffff8003fffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffff8007fffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffff8007fffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffff0007fffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffe000ffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffe001ffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffc001ffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffc007ffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffc00fffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffffc01fffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffff801fffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffff003fffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffff003fffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffff007fffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffff00ffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffe00ffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffe01ffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffc03ffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffffc03ffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffff807ffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffff807ffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffff80fffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffff00fffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -fffffffffffffffffffffff01fffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffe03fffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffe07fffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffe07fffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffe0ffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffc1ffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffc1ffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffffc3ffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffff83ffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffff87ffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffff8fffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffff8fffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffff1fffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffff1fffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 -ffffffffffffffffffffff3fffffffffffffffffffffffffffffffffffffffffffffffff -fffffffffffffffffffffffffffffffffffffffffffffffffff8 - - -showpage - -% stop using temporary dictionary -end - -% restore original state -origstate restore - -%%Trailer diff -r 6866abce6aaf -r 6075d714658b etc/gnusrefcard/gnusref.tex --- a/etc/gnusrefcard/gnusref.tex Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,814 +0,0 @@ -% -*- mode:LaTeX; eval:(setq LaTeX-version "2"); truncate-lines:t; -*- -% include file for the Gnus refcard and booklet -\def\version{5.4.56} -\def\date{12 June 1997} -\def\author{Vladimir Alexiev $<$vladimir@cs.ualberta.ca$>$} -\raggedbottom\raggedright -\newlength{\logowidth}\setlength{\logowidth}{6.861in} -\newlength{\logoheight}\setlength{\logoheight}{7.013in} -\newlength{\keycolwidth} -\newenvironment{keys}[1]% #1 is the widest key - {\nopagebreak%\noindent% - \settowidth{\keycolwidth}{#1}% - \addtolength{\keycolwidth}{\tabcolsep}% - \addtolength{\keycolwidth}{-\columnwidth}% - \begin{tabular}{@{}l@{\hspace{\tabcolsep}}p{-\keycolwidth}@{}}}% - {\end{tabular}\\} -\catcode`\^=12 % allow ^ to be typed literally -\catcode`\~=12 % allow ~ to be typed literally -\newcommand{\B}[1]{{\bf#1})} % bold l)etter - -\def\Title{ -\begin{center} -{\bf\LARGE Gnus \version\ Reference \Guide\\} -%{\normalsize \Guide\ version \refver} -\end{center} -} - -\newcommand\Logo[1]{\centerline{ -\makebox[\logoscale\logowidth][l]{\vbox to \logoscale\logoheight -{\vfill\special{psfile=gnuslogo.#1}}\vspace{-\baselineskip}}}} - -\def\CopyRight{ -\begin{center} -Copyright \copyright\ 1995 Free Software Foundation, Inc.\\* -Copyright \copyright\ 1995-97 \author.\\* -Created from the Gnus manual Copyright \copyright\ 1994-97 Lars Magne -Ingebrigtsen.\\* -and the Emacs Help Bindings feature (C-h b).\\* -Gnus logo copyright \copyright\ 1995 Luis Fernandes.\\* -\end{center} - -Permission is granted to make and distribute copies of this reference -\guide{} provided the copyright notice and this permission are preserved on -all copies. Please send corrections, additions and suggestions to the -above email address. \Guide{} last edited on \date. -} - -\def\Notes{\subsec{Notes}{\samepage -Gnus is big. Currently it has some 633 interactive (user-callable) -commands. Many of these commands have more than one binding. In order to save -space, every function is listed only once in this \guide, under the ``more -logical'' binding. Alternative bindings are given in parentheses at the -beginning of the description. This \guide{} describes only key-bindings, you -{\em should\/} at least browse the manual to discover many great features - -Many Gnus commands use the numeric prefix. Normally you enter a prefix by -holding the Meta key and typing a number, but in most Gnus modes you don't -need to use Meta since the digits are not self-inserting. The prefixed -behavior of commands is given in [brackets]. Often the prefix is used to -specify: - -\quad [distance] How many objects to move the point over. - -\quad [scope] How many objects to operate on (including the current one). - -\quad [p/p] The ``Process/Prefix Convention'': If a prefix is given then it -determines how many objects to operate on (negative means backwards). Else if -transient-mark-mode or zmacs-regions is set and the region is active, operate -on the region. Else if there are some objects marked with the process mark \#, -operated on them. Else operate only on the current object. - -\quad [level] A group subscribedness level. Only groups with a lower or -equal level will be affected by the operation. If no prefix is given, -`gnus-group-default-list-level' is used. If -`gnus-group-use-permanent-levels', then a prefix to the `g' and `l' -commands will also set the default level. - -\quad [score] An article score. If no prefix is given, -`gnus-summary-default-score' is used. - -\quad [GL rating] Give a GroupLens rating (1-5) to the current article before -moving to another article. - -%Some functions were not yet documented at the time of creating this -%\guide and are clearly indicated as such. -}} - -\def\GroupLevels{\subsec{Group Subscribedness Levels}{\samepage -The table below assumes that you use the default Gnus levels. -Fill your user-specific levels in the blank cells.\\* -\begin{tabular}{|c|l|l|} -\hline -Level & Groups & Status \\ -\hline -1 & mail groups & \\ -2 & mail groups & \\ -3 & default subscribed level & subscribed \\ -4 & & \\ -5 & default list level & \\ -\hline -6 & default unsubscribed level & unsubscribed \\ -7 & & \\ -\hline -8 & & zombies \\ -\hline -9 & & killed \\ -\hline -\end{tabular} -}} - -\def\Marks{\subsec{Mark Indication Characters}{\samepage -If a command directly sets a mark, it is shown in parentheses.\\* -\newlength{\markcolwidth} -\settowidth{\markcolwidth}{` '}% widest character -\addtolength{\markcolwidth}{4\tabcolsep} -\addtolength{\markcolwidth}{-\columnwidth} -\newlength{\markdblcolwidth} -\setlength{\markdblcolwidth}{\columnwidth} -\addtolength{\markdblcolwidth}{-2\tabcolsep} -\begin{tabular}{|c|p{-\markcolwidth}|} -\hline -\multicolumn{2}{|p{\markdblcolwidth}|} -{{\bf ``Read'' Marks.} - All these marks appear in the first column of the summary line, and so - are mutually exclusive.}\\ -\hline -` ' & (M-u, M SPC, M c) Not read.\\ -! & (!, M t) Ticked (interesting).\\ %(M !) -? & (?, M ?) Dormant (only followups are interesting).\\ -E & (E, M e) {\bf Expirable}. Only has effect in mail groups.\\ %(M x) -\hline\hline -\multicolumn{2}{|p{\markdblcolwidth}|}{The marks below mean that the article - is read (killed, uninteresting), and have more or less the same effect. - Some commands however explicitly differentiate between them (e.g.{} M - M-C-r, adaptive scoring).}\\ -\hline -r & (d, M d, M r) Deleted (marked as {\bf read}).\\ -C & (M C; M C-c; M H; c, Z c; Z n; Z C) Killed by {\bf catch-up}.\\ -F & (O s; G s b) SOUPed.\\ -G & (S C, C) Canceled (only for your own articles).\\ -O & {\bf Old} (marked read in a previous session).\\ -K & (k, M k; C-k, M K) {\bf Killed}.\\ -M & Marked by duplicate elimination.\\ -Q & Divined through the building of sparse threads.\\ -R & {\bf Read} (actually viewed).\\ -X & Killed by a kill file.\\ -Y & Killed due to low score.\\ -\hline -%\multicolumn{2}{c}{\vspace{0.2ex}}\\ -\hline -\multicolumn{2}{|p{\markdblcolwidth}|} -{{\bf Other marks}}\\ -\hline -\# & (\#, M P p) Processable (will be affected by the next operation).\\ %(M \#) -* & (*) Persistent (or cached for some other reason).\\ -A & {\bf Answered} (followed-up or replied).\\ -S & (O {\bf x}) {\bf Saved}.\\ -+ & Over default score.\\ -$-$ & Under default score.\\ -= & Has children (thread underneath it). Add `\%e' to `gnus-summary-line-format'.\\ -\hline -\end{tabular} -}} - -\def\General{\sec{(H) General and Help Commands}{\samepage -These commands work everywhere. -\begin{keys}{C-c C-i} -C-c C-i & Go to the Gnus on-line {\bf info}.\\ -C-c C-b & Send a Gnus {\bf bug} report.\\ -\end{keys} - -These commands work in Summary mode, and most also work in Group mode.\\* -\begin{keys}{H d} -H d & (C-c C-d) {\bf Describe} this group. [Prefix: re-read the description -from the server.]\\ -H f & Try to fetch the {\bf FAQ} for this group using ange-ftp.\\ -H h & Give a very short {\bf help} message.\\ -H i & (C-c C-i) Go to the Gnus online {\bf info}.\\ -H v & Display the Gnus {\bf version} number.\\ -\end{keys}}} - -\def\GroupMode{\sec{Group Mode} -\begin{keys}{C-c M-C-x} -RET & (=) Select this group [Prefix: how many (read) articles to fetch. - Positive: newest articles, negative: oldest ones, C-u: ask number]. - Also: fold/unfold a topic.\\ -SPC & Select this group and display the first unread article [Same - prefix as above]. Also: fold/unfold a topic.\\ -M-RET & Select this group quickly (no scoring, expunging, etc).\\ -M-SPC & Select this group, and don't hide dormant articles.\\ -M-C-RET & Select this group ephemerally: no processing and no permanent effect.\\ -? & Give a very short help message.\\ -$<$ & Go to the beginning of the Group buffer.\\ -$>$ & Go to the end of the Group buffer.\\ -, & Jump to the lowest-level group with unread articles.\\ -. & Jump to the first group with unread articles.\\ -^ & Enter the Server buffer mode.\\ -a & Post an {\bf article} to a group.\\ -b & Find {\bf bogus} groups and delete them.\\ -c & Mark all unticked articles in this group as read ({\bf catch-up}). -[p/p]\\ -g & Check the server for new articles ({\bf get}). [level]\\ -j & {\bf Jump} to a specified group (may even be killed).\\ -m & {\bf Mail} a message to someone.\\ -n & Go to the {\bf next} group with unread articles. [distance]\\ -p & (DEL) Go to the {\bf previous} group with unread articles. -[distance]\\ -q & {\bf Quit} Gnus. M-x gnus-unload to remove it from memory.\\ -r & {\bf Re-read} the init file `.gnus'.\\ -s & {\bf Save} the `.newsrc.eld' file (and `.newsrc' if -`gnus-save-newsrc-file').\\ -t & Toggle {\bf Topic} mode. A topic is a hierarchy of groups.\\ -z & Suspend Gnus (kill all buffers except the Group buffer).\\ -B & {\bf Browse} a foreign server (specify method and name).\\ -C & Mark all articles in this group as read ({\bf Catch-up}). [p/p]\\ -F & {\bf Find} new groups and process them. [Prefix: ask-server]\\ -N & Go to the {\bf next} group. [distance]\\ -P & Go to the {\bf previous} group. [distance]\\ -Q & {\bf Quit} Gnus without saving any .newsrc files.\\ -R & {\bf Restart} Gnus.\\ -V & Display the Gnus {\bf version} number.\\ -W f & {\bf Flush} the score caches of all groups.\\ -Z & Clear the dribble buffer.\\ -C-c C-s & {\bf Sort} the groups according to `gnus-group-sort-function'.\\ -C-c C-x & Run all expirable articles in this group through the {\bf expiry} -process.\\ -C-c M-C-x & Run all articles in all groups through the {\bf expiry} process.\\ -C-c M-g & Activate absolutely all groups.\\ -C-x C-t & {\bf Transpose} two groups.\\ -M-\& & Execute a command on all process-marked groups.\\ -M-c & {\bf Clear} this group's data (read and other marks). [p/p] -Use M-x gnus-group-clear-data-on-native-groups to clear all data if you change -servers and article numbers don't match. Or use -M-x gnus-change-server to renumber the articles, but it is slow.\\ -\end{keys} -\begin{keys}{C-c M-C-x} -\newlength{\keywidth}\settowidth{\keywidth}{C-c M-C-x}% -\makebox[\keywidth][l]% -{M-d} & {\bf Describe} {\em all\/} groups. [Prefix: re-read the description -from the server]\\ -M-f & Fetch this group's {\bf FAQ} (using ange-ftp).\\ -M-g & Check the server for new articles in this group ({\bf get}). [p/p]\\ -M-n & Go to the {\bf previous} unread group on the same or lower level. -[distance]\\ -M-p & Go to the {\bf next} unread group on the same or lower level. -[distance]\\ -\end{keys}} - -\def\ListGroups{\subsec{(A) List Groups}{\samepage -\begin{keys}{A m} -A a & (C-c C-a) List all groups whose names match a regexp ({\bf -apropos}).\\ -A d & List all groups whose names or {\bf descriptions} match a regexp.\\ -A k & List all {\bf killed} groups. [Prefix: all groups but [un]subscribed]\\ % (C-c C-l) -A l & List unread groups on a specific {\bf level}. [Prefix: also read groups]\\ -A m & List groups that {\bf match} a regexp and have unread articles. -[level]\\ -A s & (l) List {\bf subscribed} groups with unread articles. [level]\\ -A u & (L) List all groups (including {\bf unsubscribed}). [level, default 7]\\ -A z & List the {\bf zombie} groups.\\ -A A & List all available {\bf active} groups on all servers (may be slow).\\ -A M & List groups that {\bf match} a regexp.\\ -A T & List all active groups arranged in {\bf topics}.\\ -\end{keys}}} - -\def\CreateGroups{\subsec{(G) Create/Edit Foreign Groups}{\samepage -The select methods are indicated in parentheses.\\* -\begin{keys}{G DEL} -G DEL & {\bf Delete} this group. [Prefix: delete {\bf all} articles too]\\ -G a & Make the Gnus list {\bf archive} group. (nndir over ange-ftp)\\ -G c & {\bf Customize} this group's parameters.\\ -G d & Make a {\bf directory} group (every file a posting with numeric name). (nndir)\\ -G e & {\bf Edit} this group's select method.\\ % (M-e) -G f & Make a group based on a {\bf file}. (nndoc: mbox, babyl, digest, - mmdf, news, rnews, clari-briefs, rfc934, rfc822, forward) [Prefix: - don't guess the type]\\ -G h & Make the Gnus {\bf help} (documentation/tutorial) group. (nndoc)\\ -G k & Make a {\bf kiboze} group (specify name, groups, regexps). (nnkiboze)\\ -G m & {\bf Make} a new group (specify name, method, address).\\ -G p & Edit this group/topic's {\bf parameters}.\\ -G r & {\bf Rename} this group (only for mail groups).\\ -G v & Add this group to a {\bf virtual} group. [p/p]\\ -G w & Make a {\bf web}-based group. (nnweb: dejanews, altavista, - reference) [Prefix: permanent group]\\ -G D & Enter a {\bf directory} as a temporary group. (nneething without -recording read marks.)\\ -G E & {\bf Edit} this group's info (select method, articles read, etc).\\ -G V & Make an empty {\bf virtual} group. (nnvirtual)\\ -\end{keys} -You can also create mail-groups and read your mail with Gnus (very useful -if you are subscribed to any mailing lists), using one of the methods -nnmbox, nnbabyl, nnml, nnmh, or nnfolder. Read about it in the online info -(C-c C-i g Reading Mail RET). -}} - -\def\SortGroups{\subsubsec{(G S) Sort Groups}{\samepage -To sort by multiple criteria, first apply the less significant ones, last the -most significant one.\\* -\begin{keys}{G P \bf x} -G S a & Sort {\bf Alphabetically} by group name. [Prefix: reverse order]\\ -G S l & Sort by {\bf level}. [Prefix: reverse order]\\ -G S m & Sort by {\bf method} name. [Prefix: reverse order]\\ -G S r & Sort by rank (level and score). [Prefix: reverse order]\\ -G S u & Sort by number of {\bf unread} articles. [Prefix: reverse order]\\ -G S v & Sort by group score ({\bf value}). [Prefix: reverse order]\\ -\end{keys} -Here {\bf x} can be any one of a,l,m,r,u,v:\\* -\begin{keys}{G P \bf x} -G P \bf x & Sort only the groups selected by [p/p].\\ -T S \bf x & Sort only the current topic.\\ -\end{keys} -}} - -\def\SOUP{\subsubsec{(G s) SOUP Commands}{\samepage -SOUP is a protocol for putting many articles/replies in a packet, transferring -them in bulk and reading/composing them off-line. Use the following commands to -manipulate the packets, and use the nnsoup method to read.\\* -\begin{keys}{G s w} -G s b & Pack all unread articles ({\bf brew} soup). [p/p]\\ -G s p & {\bf Pack} all SOUP data files into a SOUP packet.\\ -G s r & Pack all {\bf replies} into a replies packet.\\ -G s s & {\bf Send} all replies you put in the replies packet.\\ -G s w & {\bf Write} all SOUP data files.\\ -\end{keys}}} - -\def\MarkGroups{\subsec{(M) Mark Groups}{\samepage -\begin{keys}{M m} -M b & Set the process mark on all groups in the {\bf buffer}.\\ -M r & Mark all groups matching a {\bf regexp}.\\ -M m & (\#) {\bf Mark} this group. [scope]\\ -M u & (M-\#) {\bf Unmark} this group. [scope]\\ -M w & Mark all groups in the current region.\\ -M U & {\bf Unmark} all groups in the buffer.\\ -\end{keys}}} - -\def\Unsubscribe{\subsec{(S) (Un)subscribe, Kill and Yank Groups}{\samepage -\begin{keys}{S C-k} -S C-k & {\bf Kill} all groups on a certain level.\\ -S k & (C-k) {\bf Kill} this group/ topic (and all its groups).\\ -S l & Set the {\bf level} of this group. [p/p]\\ -S s & (U) Prompt for a group and toggle its {\bf subscription}.\\ -S t & (u) {\bf Toggle} subscription to this group. [p/p]\\ -S w & (C-w) Kill all groups in the region.\\ -S y & (C-y) {\bf Yank} the last killed group/topic.\\ -S z & Kill all {\bf zombie} groups.\\ -\end{keys}}} - -\def\GroupTopics{\subsec{(T) Group Topics}{\samepage -Topics are hierarchical arrangements of groups with the purpose of easier -reading and management. -\begin{keys}{T TAB} -T TAB & Indent this topic to become a sub-topic of the previous one. - [Prefix: un-dent]\\ -T DEL & {\bf Delete} an empty topic.\\ -T \# & Mark all groups in this topic with the process mark.\\ -T M-\# & Unmark all groups in this topic with the process mark.\\ -T c & {\bf Copy} this group to another topic. [p/p]\\ -T h & Toggle the {\bf hiding} of empty topics.\\ -T m & {\bf Move} this group to another topic. [p/p]\\ -T n & Create a {\bf new} topic.\\ -T r & {\bf Rename} a topic.\\ -T C & {\bf Copy} all groups that match a regexp to a topic.\\ -T D & {\bf Delete} this group from this topic. [p/p]\\ -T M & {\bf Move} all groups that match a regexp to a topic.\\ -\end{keys}}} - -\def\SummaryMode{\sec{Summary Mode}{\samepage -\begin{keys}{M-C-d} -SPC & Select an article, scroll it one page, move to the next one.\\ -%(A SPC, A n) -DEL & (b) Scroll this article one page back. [distance]\\ %(A DEL, A p) -RET & Scroll this article one line forward. [distance]\\ -= & Expand the Summary window. [Prefix: shrink it to display the -Article window]\\ -$<$ & (A $<$) Scroll to the beginning of this article.\\ %(A b) -$>$ & (A $>$) Scroll to the end of this article.\\ %(A e) -\& & Execute a command on all articles matching a regexp. -[Prefix: move backwards.]\\ -k & Give a GroupLens {\bf rating} (1-5) to this thread.\\ -r & Give a GroupLens {\bf rating} (1-5) to this article.\\ -Y g & Re{\bf generate} the summary buffer.\\ -Y c & Pull all {\bf cached} articles into the summary.\\ -C-t & Toggle {\bf truncation} of summary lines.\\ -C-d & Un-{\bf digestify} this article into a separate group.\\ %(A D) -M-C-d & Un-{\bf digestify} all selected articles into one group. [p/p]\\ -M-\& & Execute a command on all articles having the process mark.\\ -M-k & Edit this group's {\bf kill} file.\\ -M-r & Search through previous articles for a regexp.\\ -M-s & {\bf Search} through subsequent articles for a regexp.\\ -M-K & Edit the general {\bf kill} file.\\ -\end{keys}}} - -\def\SortSummary{\subsec{(C-c C-s) Sort the Summary}{\samepage -In thread mode, these commands sort only the thread roots.\\* -\begin{keys}{C-c C-s C-a} -C-c C-s C-a & Sort the summary by {\bf author}.\\ -C-c C-s C-d & Sort the summary by {\bf date}.\\ -C-c C-s C-i & Sort the summary by article score.\\ -C-c C-s C-l & Sort the summary by number of {\bf lines}.\\ -C-c C-s C-n & Sort the summary by article {\bf number}.\\ -C-c C-s C-s & Sort the summary by {\bf subject}.\\ -\end{keys}}} - -\def\Article{\subsec{(A) Article Commands}{\samepage -\begin{keys}{A m} -A g & (g) (Re){\bf get} this article. [Prefix: don't do any processing]\\ -A r & (^) Go to the parent of this article ({\bf References} header). -[Prefix: how many ancestors back; negative: only the $n$-th ancestor]\\ %(A ^) -M-^ & Go to the article with a given Message-ID.\\ -A s & (s) Perform an i{\bf search} in the article buffer.\\ -A P & {\bf Print} the article as postscript.\\ -A R & Fetch all ancestors ({\bf References}) of this article.\\ -\end{keys}}} - -\def\MailGroup{\subsec{(B) Mail-Group Commands}{\samepage -These commands (except `B c') are only valid in a mail group.\\* -\begin{keys}{B M-C-e} -B DEL & {\bf Delete} the mail article from disk. [p/p]\\ -B c & {\bf Copy} this article from any group to a mail group. [p/p]\\ -B e & {\bf Expire} all expirable articles in this group. [p/p]\\ -B i & {\bf Import} any file into this mail group (give From and Subject).\\ -B m & {\bf Move} the article from one mail group to another. [p/p]\\ -B p & Check if a courtesy copy of a message was also {\bf posted}.\\ -B q & {\bf Query} where would the article go if respooled.\\ -B r & {\bf Respool} this mail article. [p/p]\\ -B w & (e) Edit this mail article.\\ -B M-C-e & {\bf Expunge} (from disk) all expirable articles in this group. [p/p]\\ -B C & {\bf Crosspost} this article to another group.\\ -\end{keys}}} - -\def\GotoArticle{\subsec{(G) Go To Article}{\samepage -These commands select the target article. They do not understand the prefix.\\* -\begin{keys}{G C-n} -G b & (,) Go to the {\bf best} article (the one with highest score). [GL rating]\\ -G f & (.) Go to the {\bf first} unread article.\\ -G g & Ask for an article number and then {\bf go to} to that summary -line.\\ -G j & (j) Ask for an article number and then {\bf jump} to that article.\\ -G l & (l) Go to the {\bf last} article read.\\ -G o & Pop an article off the summary history and go to it.\\ -G n & (n) Go to the {\bf next} unread article. [GL rating]\\ -G p & (p) Go to the {\bf previous} unread article.\\ -G N & (N) Go to {\bf the} next article.\\ -G P & (P) Go to the {\bf previous} article.\\ -G C-n & (M-C-n) Go to the {\bf next} article with the same subject.\\ -G C-p & (M-C-p) Go to the {\bf previous} article with the same subject.\\ -G M-n & (M-n) Go to the {\bf next} summary line of an unread article. -[distance]\\ -G M-p & (M-p) Go to the {\bf previous} summary line of an unread article. -[distance]\\ -\end{keys}}} - -\def\MarkArticles{\subsec{(M) Mark Articles}{\samepage -\begin{keys}{M M-C-r} -d & (M d, M r) Mark this article as {\bf read} ({\bf delete} it) -and move to the next one. [scope]\\ -D & Mark this article as read and move to the previous one. [scope]\\ -u & (!, M t) {\bf Tick} this article (mark it as interesting) -and move to the next one. [scope]\\ %(M !) -U & Tick this article and move to the previous one. [scope]\\ -M-u & (M SPC, M c) {\bf Clear} all marks from this article -and move to the next one. [scope]\\ -M-U & Clear all marks from this article and move to the previous one. -[scope]\\ -M ? & (?) Mark this article as dormant (only followups are -interesting). [scope]\\ -* & Make this article persistent. [p/p]\\ -M-* & Make this article non-persistent (and delete it). [p/p]\\ -M b & Set a {\bf bookmark} in this article.\\ -M e & (E) Mark this article as {\bf expirable}. [scope]\\ %(M x) -M k & (k) {\bf Kill} all articles with the same subject then select the -next one.\\ -M B & Remove the {\bf bookmark} from this article.\\ -M C & {\bf Catch-up} (mark read) the articles that are not ticked.\\ -M D & Show all {\bf dormant} articles (normally they are hidden unless they -have any followups).\\ -M H & Catch-up (mark read) this group to point ({\bf here}).\\ -M K & (C-k) {\bf Kill} all articles with the same subject as this one.\\ -C-w & Mark all articles between point and mark as read.\\ -M S & (C-c M-C-s) {\bf Show} all expunged articles.\\ -M C-c & {\bf Catch-up} all articles in this group.\\ -M M-r & (x) Expunge all {\bf read} articles from this group.\\ -M M-D & Hide all {\bf dormant} articles.\\ -M M-C-r & Expunge all articles having a given mark.\\ -\end{keys}}} - -\def\MarkScore{\subsubsec{(M V) Mark Based on Score (Value)}{\samepage -\begin{keys}{M s m} -M V c & {\bf Clear} all marks from all high-scored articles. [score]\\ -M V k & {\bf Kill} all low-scored articles. [score]\\ -M V m & Mark all high-scored articles with a given {\bf mark}. [score]\\ -M V u & Mark all high-scored articles as interesting (tick them). [score]\\ -\end{keys}}} - -\def\ProcessMark{\subsubsec{(M P) The Process Mark}{\samepage -These commands set and remove the process mark \#. You only need to use -it if the set of articles you want to operate on is non-contiguous. Else -use a numeric prefix.\\* -\begin{keys}{M P R} -M P a & Mark {\bf all} articles (in series order).\\ -M P b & Mark all articles in the order they appear in the {\bf buffer}.\\ -M P i & {\bf Invert} all process marks.\\ -M P k & Push all marks on a stack then {\bf kill} them.\\ -M P p & (\#) Mark this article.\\ %(M \#) -M P r & Mark all articles in the {\bf region}.\\ -M P s & Mark all articles in the current {\bf series}.\\ -M P t & Mark all articles in this (sub){\bf thread}.\\ -M P u & (M-\#) {\bf Unmark} this article.\\ %(M M-\#) -M P v & Mark all high-scored articles ({\bf value}). [score]\\ -M P w & Push all marks on a stack.\\ -M P y & {\bf Yank} and restore a mark set from the stack after `M P y', -`M P w' or an operation that cleared the marks.\\ -M P R & Mark all articles matching a {\bf regexp}.\\ -M P S & Mark all {\bf series} that already contain a marked article.\\ -M P T & Unmark all articles in this (sub){\bf thread}.\\ -M P U & {\bf Unmark} all articles.\\ -\end{keys}}} - -\def\OutputArticles{\subsec{(O) Output Articles}{\samepage -\begin{keys}{O m} -O b & Save the article {\bf body} in a plain file. [p/p]\\ -O f & Save this article in a plain {\bf file}. [p/p]\\ -O h & Save this article in {\bf mh} folder format. [p/p]\\ -O m & Save this article in {\bf mail} format. [p/p]\\ -O o & (o, C-o) Save this article using the default article saver. [p/p]\\ -O p & ($\mid$) Pipe this article to a shell command. [p/p]\\ -O r & Save this article in {\bf rmail} format. [p/p]\\ -O s & Add this article to a {\bf SOUP} packet. [p/p]\\ -O v & Save this article in {\bf vm} format. [p/p]\\ -O F & Save this article as plain {\bf file} and overwrite any existing file. [p/p]\\ -\end{keys}}} - -\def\Send{\subsec{(S) Post, Followup, Reply, Forward, Cancel}{\samepage -These commands put you in a separate Message buffer. After editing the -article, send it by pressing C-c C-c. If you are in a foreign group and want -to post the article using the foreign server, give a prefix to C-c C-c. -Set `gnus-post-method' to `nngateway' if your server cannot post [temporarily] -and you wan to post through a mail-to-news gateway.\\* -\begin{keys}{S O m} -S b & {\bf Both} post a followup to this article, and send a reply.\\ -S c & (C) {\bf Cancel} this article (only works if it is your own).\\ -S f & (f) Post a {\bf followup} to this article.\\ -S m & (m) Send a {\bf mail} to someone.\\ -S n & Followup in a {\bf newsgroup} to a message you got through mail.\\ -S o m & (C-c C-f) Forward this article by {\bf mail} to a person. -[Prefix: include full headers]\\ -S o p & Forward this article as a {\bf post} to a newsgroup.\\ -S p & (a) {\bf Post} an article to this group.\\ -S r & (r) Mail a {\bf reply} to the author of this article.\\ -S s & {\bf Supersede} this article with a new one (only for own articles).\\ -S u & {\bf Uuencode} a file, split it into series and post it.\\ -S w & Mail a {\bf wide} reply to the author and the recipients of this -article.\\ -S B & {\bf Both} post a followup, send a reply, and include the -original. [p/p]\\ -S D b & Resend a {\bf bounced} mail after fixing the recipient address. -[Prefix: display the headers of the message this one is a reply to]\\ -S D r & {\bf Resend} this message to another of your addresses.\\ -S F & (F) Post a {\bf followup} and include the original. [p/p]\\ -S N & Followup in a {\bf newsgroup} to a mail message and include the -original [p/p].\\ -S O m & Digest these series and forward by {\bf mail}. [p/p]\\ -S O p & Digest these series and forward as a {\bf post} to a newsgroup. -[p/p]\\ -S R & (R) Mail a {\bf reply} and include the original. [p/p]\\ -S W & Mail a {\bf wide} reply and include the original. [p/p]\\ -S M-c & Send a {\bf complaint} about excessive {\bf crossposting}. [p/p]\\ -\end{keys} -If you want to cancel or supersede an article you just posted (before it -has appeared on the server), go to the *sent \ldots* buffer, change -`Message-ID' to `Cancel' or `Supersedes' and send it again with C-c C-c. -}} - -\def\Thread{\subsec{(T) Thread Commands}{\samepage -\begin{keys}{T M-\#} -T ^ & Make this article child of the previous or precess-marked one.\\ -T \# & Mark this (sub)thread with the process mark.\\ -T M-\# & Remove the process mark from this (sub)thread.\\ -T d & Move {\bf down} this thread. [distance]\\ -T h & {\bf Hide} this (sub)thread.\\ -T i & {\bf Increase} the score of this thread.\\ -T k & (M-C-k) {\bf Kill} the current (sub)thread. [Prefix: -negative--tick, positive--unmark]\\ -T l & (M-C-l) {\bf Lower} the score of this thread.\\ -T n & (M-C-f) Go to the {\bf next} thread. [distance]\\ -T o & Go to the {\bf top} of this thread.\\ -T p & (M-C-b) Go to the {\bf previous} thread. [distance]\\ -T s & {\bf Show} the thread hidden under this article.\\ -T t & Re-{\bf thread} this thread.\\ -T u & Move {\bf up} this thread. [distance]\\ -T H & {\bf Hide} all threads.\\ -T S & {\bf Show} all hidden threads.\\ -T T & (M-C-t) {\bf Toggle} threading.\\ -\end{keys}}} - -\def\Score{\subsec{(V) Score (Value) Commands}{\samepage -Read about Adaptive Scoring in the online info.\\* -\begin{keys}{\bf A p m l} -V a & {\bf Add} a new score entry, specifying all elements.\\ -V c & Select a new score file as {\bf current}.\\ -V e & {\bf Edit} the current score file.\\ -V f & Edit a score {\bf file} and make it the current one.\\ -V m & {\bf Mark} all articles below a given score as read [score].\\ -V s & {\bf Set} the score of this article.\\ -V t & {\bf Trace} all score rules applied to this article.\\ -V x & {\bf Expunge} all low-scored articles. [score]\\ -V F & {\bf Flush} the score cache to put it in sync with files.\\ -V C & {\bf Customize} the current score file using a user-friendly -interface.\\ -V S & {\bf Show} the score of this article.\\ -I C-i & {\bf Increase} the score of this article.\\ -L C-l & {\bf Lower} the score of this article.\\ -\bf A p m l& Make a scoring entry based on this article.\\ -\end{keys} - -The four letters stand for:\\* -\quad \B{A}ction: I)ncrease, L)ower;\\* -\quad \B{p}art: a)uthor (from), b)ody, d)ate, f)ollowups, h)ead (all headers), -message-i)d, l)ines, s)ubject, t)hread (references), x)refs (cross-posting);\\* -\quad \B{m}atch type:\\* -\qquad string: e)xact, f)uzzy, r)egexp, s)ubstring\\* -\qquad date: a)t, b)efore, n)this,\\* -\qquad number: $<$, =, $>$;\\* -\quad \B{l}ifetime: t)emporary, p)ermanent, i)mmediate. - -If you type the second/third letter in uppercase, the remaining letters are -assumed to be s)ubstring and t)emporary. - -\quad Extra keys for manual editing of a score file:\\* -\begin{keys}{C-c C-c} -C-c C-c & Finish editing the score file.\\ -C-c C-d & Insert the current {\bf date} as number of days.\\ -C-c C-p & {\bf Pretty-print} the [adaptive] score file.\\ -\end{keys}}} - -\def\Wash{\subsec{(W) Wash the Article Buffer}{\samepage -\begin{keys}{W C-c} -W b & Make Message-IDs, URLs, citations and signature to mouse-clickable -{\bf buttons}.\\ -W c & Remove extra {\bf CR}s (^M).\\ -W e & Fontify {\bf emphasis}, e.g.{} *this* and \_that\_.\\ -W f & Display any X-{\bf Face} headers.\\ -W l & (w) Remove page breaks ({\bf^L}).\\ -W m & Toggle {\bf MIME} processing before displaying.\\ -W o & Treat {\bf overstrike} (a^Ha) or underline (a^H\_).\\ -W q & Treat {\bf quoted}-printable (=0D etc).\\ -W r & (C-c C-r) Caesar-{\bf rotate} (rot13 decode).\\ -W t & (t) {\bf Toggle} the displaying of all headers.\\ -W v & (v) Toggle permanent {\bf verbose} displaying of all headers.\\ -W w & Do word {\bf wrap}. [Prefix: width to use for filling]\\ -W B & Make headers to mouse-clickable {\bf buttons}.\\ -W E a & Expunge {\bf all} unwanted blank lines.\\ -W E l & Expunge {\bf leading} blank lines.\\ -W E m & Expunge {\bf multiple} blanks lines and replace them with a single -blank.\\ -W E s & Expunge leading {\bf spaces} from every line.\\ -W E t & Expunge {\bf trailing} blank lines.\\ -W T e & Display the date as time {\bf elapsed} since sent.\\ -W T l & Display the date in the {\bf local} timezone.\\ -W T o & Display the {\bf original} date.\\ -W T s & Display the date using `gnus-article-time-format'.\\ -W T u & (W T z) Display the date as {\bf UTC} (aka GMT, Zulu).\\ -\end{keys}}} - -\def\Hide{\subsubsec{(W W) Hide Parts of the Article}{\samepage -Without prefix, these commands toggle hiding; a positive prefix hides and a -negative prefix unhides.\\* -\begin{keys}{W W C} -W W a & Hide {\bf all} unwanted parts.\\ -W W c & Hide {\bf cited} text.\\ -W W h & Hide the {\bf headers}.\\ -W W s & Hide the {\bf signature}.\\ -W W p & Hide {\bf PGP} signatures.\\ -W W C & Hide {\bf cited} text if the article is not a root of a thread.\\ -W W P & Hide {\bf PEM} gruft.\\ -\end{keys}}} - -\def\Highlight{\subsubsec{(W H) Highlight Parts of the Article}{\samepage -\begin{keys}{W H A} -W H a & Highlight {\bf all} parts.\\ -W H c & Highlight {\bf cited} text.\\ -W H h & Highlight the {\bf headers}.\\ -W H s & Highlight the {\bf signature}.\\ -\end{keys}}} - -\def\Extract{\subsec{(X) Extract Series (Uudecode etc)}{\samepage -Gnus recognizes if the current article is part of a series (multipart -posting whose parts are identified by numbers in the subject, e.g.{} -1/10\dots10/10). You can mark and process more than one series at a time. If -the posting contains any archives, they are expanded and gathered in a new -group.\\* -\begin{keys}{X p} -X b & Un-{\bf binhex} these series. [p/p]\\ -X o & Simply {\bf output} these series (no decoding). [p/p]\\ -X p & Unpack these {\bf postscript} series. [p/p]\\ -X s & Un-{\bf shar} these series. [p/p]\\ -X u & {\bf Uudecode} these series. [p/p]\\ -\end{keys} - -Each one of these commands has four variants:\\* -\begin{keys}{X v \bf Z} -X \bf z & Decode these series. [p/p]\\ -X \bf Z & Decode and save these series. [p/p]\\ -X v \bf z & Decode and view these series. [p/p]\\ -X v \bf Z & Decode, save and view these series. [p/p]\\ -\end{keys} -where {\bf z} or {\bf Z} identifies the decoding method (b,o,p,s,u). - -An alternative binding for the most-often used of these commands is\\* -\begin{keys}{C-c C-v C-v} -C-c C-v C-v & (X v u) Uudecode and view these series. [p/p]\\ -\end{keys} -Use `M-x gnus-binary-mode' to do decoding automatically (then use `g' to see -the original text of the article). -}} - -\def\Exit{\subsec{(Z) Exit the Current Group}{\samepage -\begin{keys}{Z G} -Z c & (c) Mark all unticked articles as read ({\bf catch-up}) and exit.\\ -Z n & Mark all articles as read and go to the {\bf next} group.\\ -Z s & {\bf Save} this group's info in the dribble file. [Prefix: also save .newsrc]\\ -Z C & Mark all articles as read ({\bf catch-up}) and exit.\\ -Z E & (Q) {\bf Exit} without updating the group information.\\ -Z G & (M-g) Check for new articles in this group ({\bf get}).\\ -Z N & Exit and go to the {\bf next} group.\\ -Z P & Exit and go to the {\bf previous} group.\\ -Z R & Exit this group, then ({\bf reenter}) it. -[Prefix: select all articles, read and unread.]\\ -Z Z & (q, Z Q) Exit this group.\\ -\end{keys}}} - -\def\Limit{\subsec{(/) Limiting the Summary}{\samepage -\begin{keys}{/ D} -/ a & Limit to a given {\bf author}.\\ -/ c & Hide dormant articles that have no {\bf children} (follow-ups).\\ -/ d & Hide all {\bf dormant} articles.\\ -/ m & Limit to articles not having a given {\bf mark}.\\ -/ n & Limit to the current article.\\ -/ s & (/ /) Limit to a given {\bf subject}.\\ -/ t & Limit by {\bf time} (older than a given number of days). [Prefix: newer]\\ -/ u & (x) Limit to {\bf unread} articles. [Prefix: also remove ! and ? articles]\\ -/ v & Limit to high-scored articles ({\bf value}). [score]\\ -/ w & Pop and restore the previous limit from a stack. [Prefix: pop all limits]\\ -/ C & {\bf Catch-up} all unread articles outside the limit. [Prefix: also ! and ? articles]\\ -/ D & Show all {\bf dormant} articles.\\ -/ E & (M S) {\bf Show} all {\bf expunged} articles.\\ -\end{keys}}} - -\def\PickAndRead{\subsec{Pick-and-Read Mode}{\samepage -Use `M-x gnus-pick-mode' to first choose the articles you like and -only read them after.\\* -\begin{keys}{SPC} -SPC & Scroll the summary a page, if at the end start reading.\\ -RET & Start reading. [Prefix: catch-up all non-picked articles]\\ -. & Pick this article. [Prefix: pick the article with that number]\\ -r & Pick all articles in the {\bf region}.\\ -R & Unpick all articles in the {\bf region}.\\ -t & Pick this {\bf thread}.\\ -u & {\bf Unpick} this article.\\ -T & Unpick this {\bf thread}.\\ -U & {\bf Unpick} all articles.\\ -e & Pick articles that match a regexp.\\ -b & Pick all articles in the {\bf buffer}.\\ -B & Unpick all articles in the {\bf buffer}.\\ -\end{keys}}} - -\def\ArticleMode{\sec{Article Mode}{\samepage -Most keys in Summary mode also work in Article mode (of course, the normal -navigation keys operate on the Article buffer). Additional keys:\\* -\begin{keys}{C-c C-m} -RET & (middle mouse button) Activate the button at point to follow -an URL or Message-ID, hide citation/signature, etc.\\ -TAB & Move point to the next button.\\ -M-TAB & Move point to the previous button.\\ -? & Give a brief help message.\\ -h & (s) Go to the {\bf header} line of the article in the {\bf -summary} buffer.\\ -C-c ^ & (r) Get the article with Message-ID near point ({\bf refer}).\\ -C-c C-m & {\bf Mail} reply to the address near point. [Prefix: cite the -article]\\ -\end{keys}}} - -\def\ServerMode{\sec{Server Mode}{\samepage -To enter this mode, press `^' while in Group mode.\\* -\begin{keys}{SPC} -SPC & (RET) Browse this server.\\ -a & {\bf Add} a new server.\\ -c & {\bf Copy} this server.\\ -e & {\bf Edit} a server.\\ -g & Ask the server to re-{\bf generate} all its data structures.\\ -k & {\bf Kill} this server. [scope]\\ -l & {\bf List} all servers.\\ -q & Return to the group buffer ({\bf quit}).\\ -s & Ask the server to {\bf scan} for new messages.\\ -y & {\bf Yank} the previously killed server.\\ -C & {\bf Close} the connection to this server.\\ -O & (Re-){\bf Open} a connection to this server.\\ -D & Mark this server as unavailable ({\bf deny} it).\\ -R & {\bf Reset} all unavailability (denial) marks.\\ -M-c & {\bf Close} the connections to all servers.\\ -M-o & (Re-){\bf Open} connections to all servers.\\ -\end{keys}}} - -\def\BrowseServer{\sec{Browse Server Mode}{\samepage -To enter this mode, press `B' in Group mode.\\* -\begin{keys}{RET} -RET & Enter the current group.\\ -SPC & Enter the current group and display the first article.\\ -? & Give a very short help message.\\ -n & Go to the {\bf next} group. [distance]\\ -p & Go to the {\bf previous} group. [distance]\\ -q & (l) {\bf Quit} browse mode.\\ -u & {\bf [Un]Subscribe} to the current group. [scope]\\ -\end{keys}}} diff -r 6866abce6aaf -r 6075d714658b etc/gnusrefcard/makelogo --- a/etc/gnusrefcard/makelogo Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,35 +0,0 @@ -#!/bin/csh -f -# Copies gnuslogo.ps to gnuslogo.tmp and fixes the image -# by the scale specified in $1.tex - -echo Scaling-down gnuslogo.ps to gnuslogo.$1 -set bb = `grep "^%%BoundingBox:" gnuslogo.ps` -if ($bb[2] != 0 || $bb[3] != 0) then - echo Please make gnuslogo.ps have zero-based coordinates - exit 1 -endif -set logowidth = $bb[4] -set logoheight = $bb[5] -set logoscale = \ - `grep "\\def\\logoscale{" $1.tex |sed -e "s/\\def\\logoscale{\([^}]*\)}/\1/"` -# check if a program is present -alias executable '(\!* &/dev/null)' -executable calc 0 -if ($status != 1) then # calc is demented and returns 2 on success - # -p is "precision" - set newwidth = `calc -p1 $logowidth \* $logoscale` - set newheight = `calc -p1 $logoheight \* $logoscale` -else if ( { executable dc } ) then - # the k command of dc doesn't seem to have much of an effect - set newwidth = `echo 0 k $logowidth $logoscale \* p | dc` - set newheight = `echo 0 k $logoheight $logoscale \* p | dc` -else if ( { executable bc } ) then - # nor does the scale variable of bc. This will lead to fractional numbers - # in the %%BoundingBox statement of the EPS file. - # Let's hope your dvips doesn't have a problem with it. - set newwidth = `echo "scale=0; $logowidth * $logoscale" | bc` - set newheight = `echo "scale=0; $logoheight * $logoscale" | bc` -endif -sed -e"/%%BoundingBox/{s/$logowidth/$newwidth/;s/$logoheight/$newheight/;}"\ - -e"/scale/{s/$logowidth.0/$newwidth/;s/$logoheight.0/$newheight/;}"\ - gnuslogo.ps >! gnuslogo.$1 diff -r 6866abce6aaf -r 6075d714658b etc/gnusrefcard/quickref.tex --- a/etc/gnusrefcard/quickref.tex Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,409 +0,0 @@ -% Gnus quick refcard -\def\logoscale{0.11} -\def\version{5.4.56} -\def\date{12 June 1997} -\def\author{Vladimir Alexiev $<$vladimir@cs.ualberta.ca$>$} -\raggedbottom%\raggedright -\newlength{\logowidth}\setlength{\logowidth}{6.861in} -\newlength{\logoheight}\setlength{\logoheight}{7.013in} -\newlength{\keycolwidth}\newlength{\descrcolwidth} -\newenvironment{keys}[1]% #1 is the widest key - {\nopagebreak\noindent% - \settowidth{\keycolwidth}{#1}% - \setlength{\descrcolwidth}{\columnwidth} - \addtolength{\descrcolwidth}{-\tabcolsep}% - \addtolength{\descrcolwidth}{-\keycolwidth}% - \begin{tabular}% - {@{}l@{\hspace{\tabcolsep}}p{\descrcolwidth}@{}}}% - {\end{tabular}} -\catcode`\^=12 % allow ^ to be typed literally -\newcommand{\B}[1]{{\bf#1})} % bold l)etter -\setlength{\fboxsep}{0pt} - -\def\Title{\parbox{0.6\columnwidth}{\centering\bf\LARGE% - Gnus \version\\Quick Refcard}} - -\newcommand\Logo[1]{ -\makebox[\logoscale\logowidth]{\parbox{1ex}{\vbox to \logoscale\logoheight -{\vfill\special{psfile=gnuslogo.#1}}}}} - -\def\CopyRight{\begin{center}\tiny -Copyright \copyright\ 1995 Free Software Foundation, Inc.\\* -Copyright \copyright\ 1995 \author.\\* -Created from the Gnus manual Copyright \copyright\ 1994 Lars Magne -Ingebrigtsen.\\* -and the Emacs Help Bindings feature (C-h b).\\* -Gnus logo copyright \copyright\ 1995 Luis Fernandes.\\* -Quick refcard last edited on \date. -\end{center}} - -\def\Notes{ -\sec{Notes} -{\samepage -%Many Gnus commands are affected by the numeric prefix. Normally you enter a -%prefix by holding the Meta key and typing a number, but in most Gnus modes -%you don't need to use Meta since the digits are not self-inserting. -% -The prefixed behavior of commands is given in [brackets]. Often the prefix -is used to specify:\par - [distance] How many objects to move the point over.\par - [scope] How many objects to operate on (including the current one).\par - [p/p] The ``Process/Prefix Convention'': If a prefix is given then it -determines how many objects to operate on (negative means backwards). Else if -transient-mark-mode or zmacs-regions is set and the region is active, operate -on the region. Else if there are some objects marked with the process mark \#, -operated on them. Else operate only on the current object. - [level] A group subscribedness level. Only groups with a lower or -equal level will be affected by the operation. If no prefix is given, -`gnus-group-default-list-level' is used. If -`gnus-group-use-permanent-levels', then a prefix to the `g' and `l' -commands will also set the default level.\par - [score] An article score. If no prefix is given, -`gnus-summary-default-score' is used.\\ - -\begin{keys}{C-c C-i} -C-c C-i & Go to the Gnus online {\bf info}.\\ -C-c C-b & Send a Gnus {\bf bug} report.\\ -\end{keys} -}} - -\def\GroupMode{ -\sec{Group Mode} -\begin{keys}{C-c C-a} -RET & (=) Select this group. [Prefix: how many (read) articles to fetch. -Positive: newest articles, negative: oldest ones.]\\ -SPC & Select this group and display the first unread article. [Same -prefix as above.]\\ -? & Give a very short help message.\\ -$<$ & Go to the beginning of the Group buffer.\\ -$>$ & Go to the end of the Group buffer.\\ -, & Jump to the lowest-level group with unread articles.\\ -. & Jump to the first group with unread articles.\\ -\# & (M m) Set the process mark on this group. [scope]\\ -%^ & Enter the Server buffer mode.\\ -a & Post an {\bf article} to a group.\\ -%b & Find {\bf bogus} groups and delete them.\\ -c & Mark all unticked articles in this group as read ({\bf catch-up}). -[p/p]\\ -g & Check the server for new articles ({\bf get}). [level]\\ -j & {\bf Jump} to a group.\\ -l & (A s) {\bf List} groups with unread articles. [level]\\ -m & {\bf Mail} a message to someone.\\ -n & Go to the {\bf next} group with unread articles. [distance]\\ -p & (DEL) Go to the {\bf previous} group with unread articles. -[distance]\\ -q & {\bf Quit} Gnus.\\ -%r & Read the init file ({\bf reset}).\\ -s & {\bf Save} the `.newsrc.eld' file (and `.newsrc' if -`gnus-save-newsrc-file').\\ -u & (S t) Toggle subscription to this group ({\bf unsibscribe}). [p/p]\\ -%z & Suspend (kill all buffers of) Gnus.\\ -%B & {\bf Browse} a foreign server.\\ -C & Mark all articles in this group as read ({\bf catch-up}). [p/p]\\ -%F & {\bf Find} new groups and process them.\\ -L & (A u) {\bf List} all groups. [If no prefix is given, level 7 is the -default]\\ -%N & Go to the {\bf next} group. [distance]\\ -%P & Go to the {\bf previous} group. [distance]\\ -Q & {\bf Quit} Gnus without saving any startup (.newsrc) files.\\ -%R & {\bf Restart} Gnus.\\ -U & (S s) Prompt for a group and toggle its subscription.\\ -%V & Display the Gnus {\bf version} number.\\ -%Z & Clear the dribble buffer.\\ -C-c C-a & (A a) List all groups whose names match a regexp ({\bf apropos}).\\ -C-c C-d & Show the {\bf description} of this group. [Prefix: re-read it -from the server.]\\ -C-c C-l & (A k) {\bf List} all killed groups.\\ -C-c C-s & {\bf Sort} the groups by name, number of unread articles, or level -(depending on `gnus-group-sort-function').\\ -%C-c C-x & Run all expirable articles in this group through the {\bf expiry} -%process.\\ -%C-c M-C-x & Run all articles in all groups through the {\bf expiry} process.\\ -C-k & (S k) {\bf Kill} this group.\\ -C-w & (S w) Kill all groups in the region.\\ -C-y & (S y) {\bf Yank} the last killed group.\\ -C-x C-t & {\bf Transpose} two groups.\\ -%M-\# & (M u) Remove the process mark from this group. [scope]\\ -%M-d & {\bf Describe} ALL groups. [Prefix: re-read the description from the -%server.]\\ -M-f & Fetch this group's {\bf FAQ} (using ange-ftp).\\ -M-g & Check the server for new articles in this group ({\bf get}). [p/p]\\ -%M-n & Go to the {\bf next} unread group on the same or lower level. -%[distance]\\ -%M-p & Go to the {\bf previous} unread group on the same or lower -%level. [distance]\\ -%A d & List all groups whose names or {\bf descriptions} match a regexp.\\ -%A m & List groups that {\bf match} a regexp and have unread articles. -%[level]\\ -%A M & List groups that {\bf match} a regexp.\\ -A z & List the {\bf zombie} groups.\\ -%G a & Make the Gnus list {\bf archive} group. (nndir over ange-ftp)\\ -%G d & Make a {\bf directory} group (every file must be a posting and files -%must have numeric names). (nndir)\\ -%M-e & (G e) {\bf Edit} this group's select method.\\ -%G f & Make a group based on a {\bf file}. (nndoc)\\ -G h & Make the Gnus {\bf help} (documentation) group.\\ -%G k & Make a {\bf kiboze} group. (nnkiboze)\\ -%G m & {\bf Make} a new group.\\ -%G p & Edit this group's {\bf parameters}.\\ -%G v & Add this group to a {\bf virtual} group. [p/p]\\ -%G D & Enter a {\bf directory} as a (temporary) group. (nneething without -%recording articles read.)\\ -%G E & {\bf Edit} this group's info (select method, articles read, etc).\\ -%G V & Make a new empty {\bf virtual} group. (nnvirtual)\\ -%M w & Mark all groups in the current region.\\ -%S l & Set the {\bf level} of this group. [p/p]\\ -%S z & Kill all {\bf zombie} groups.\\ -\end{keys} -} - -\def\SummaryMode{ -\sec{Summary Mode} % {Summary and Article Modes} -\begin{keys}{C-c C-v} -SPC & (A SPC, A n) Select an article, scroll it one page, move to the -next one.\\ -DEL & (A DEL, A p, b) Scroll this article one page back. [distance]\\ -RET & Scroll this article one line forward. [distance]\\ -= & Expand the Summary window. [Prefix: shrink it to display the -Article window]\\ -^ & (A ^, A r) Go to the parent of this article (the References header).\\ -$<$ & (A $<$, A b) Scroll to the beginning of this article.\\ -$>$ & (A $>$, A e) Scroll to the end of this article.\\ -, & (G b) Go to the best article (the one with highest score).\\ -. & (G f) Go to the first unread article.\\ -! & (u, M !, M t) Tick this article (mark it as interesting) and move -to the next one. [scope]\\ -? & (M ?) Mark this article as dormant (only followups are -interesting). [scope]\\ -\# & (M P p, M \#) Mark this article with the process mark.\\ -$\mid$ & (O p) Pipe this article to a shell command. [p/p]\\ -\& & Execute a command on all articles matching a regexp. -[Prefix: move backwards.]\\ -a & (S p) Post an {\bf article} to this group.\\ -c & (Z c) Mark all unticked articles as read and go to the next group -({\bf catch-up}).\\ -d & (M d, M r) Mark this article as read and move to the next one. -[scope]\\ -e & (B w) {\bf Edit} this article (only in a mail group).\\ -f & (S f) Post a {\bf followup} to this article.\\ -g & (A g) (Re)fetch this article ({\bf get}). [Prefix: just show the -article.]\\ -j & (G g) Ask for an article number and then {\bf jump} that summary -line.\\ -k & (M k) {\bf Kill} all articles with the same subject then select the next -one.\\ -l & (G l) Go to the {\bf last} article read.\\ -m & (S m) Send a {\bf mail} to some other person.\\ -n & (G n) Go to the {\bf next} unread article.\\ -o & (C-o, O o) Save this article using the default article saver ({\bf - output}). [p/p]\\ -p & Go to the {\bf previous} unread article.\\ -q & (Z Z, Z Q) {\bf Quit} this group.\\ -r & (S r) Mail a {\bf reply} to the author of this article.\\ -s & (A s) Perform an i{\bf search} in the article buffer.\\ -t & (W t) {\bf Toggle} the displaying of all headers.\\ -%v & Toggle permanent {\bf verbose} displaying of all headers.\\ -w & (W l) Remove page breaks ({\bf ^L}) from the article.\\ -x & (M M-r) {\bf Expunge} all read articles from this group.\\ -C & (S c) {\bf Cancel} this article (only works if it is your own).\\ -D & Mark this article as read and move to the previous one. [scope]\\ -F & (S F) Post a {\bf followup} and include the original. [p/p]\\ -Q & (Z E) {\bf Quit} without updating the group information.\\ -R & (S R) Mail a {\bf reply} and include the original. [p/p]\\ -U & Tick this article and move to the previous one. [scope]\\ -%N & (G N) Go to the {\bf next} article.\\ -%P & (G P) Go to the {\bf previous} article.\\ -%C-d & (A D) Un{\bf digestify} this article into a separate group.\\ -C-k & (M K) {\bf Kill} all articles with the same subject as this one.\\ -C-t & {\bf Toggle} truncation of summary lines.\\ -C-w & Mark all articles between point and mark as read.\\ -M-^ & Fetch the article with a given Message-ID.\\ -M-\# & (M P u, M M-\#) Unmark this article.\\ -M-\& & Execute a command on all articles having the process mark.\\ -M-g & (Z G) Check for new articles in this group ({\bf get}).\\ -M-k & Edit this group's {\bf kill} file.\\ -%M-n & (G M-n) Go to the {\bf next} summary line of an unread article. -%[distance]\\ -%M-p & (G M-p) Go to the {\bf previous} summary line of an unread article. -%[distance]\\ -M-r & Search through all previous articles for a regexp.\\ -M-s & {\bf Search} through all subsequent articles for a regexp.\\ -M-u & (M SPC, M c) Clear all marks from this article and move to the next -one ({\bf unmark}). [scope]\\ -M-K & Edit the general {\bf kill} file.\\ -M-U & Clear all marks from this article and move to the previous one -({\bf unmark}). [scope]\\ -M-C-b & (T p) Go to the previous thread ({\bf backward}). [distance]\\ -M-C-f & (T n) Go to the next thread ({\bf forward}). [distance]\\ -M-C-k & (T k) {\bf Kill} the current (sub)thread. [Negative prefix: -tick it, positive prefix: unmark it.]\\ -%M-C-l & (T l) {\bf Lower} the score of this thread.\\ -%M-C-n & (G C-n) Go to {\bf the} next article with the same subject.\\ -%M-C-p & (G C-p) Go to the {\bf previous} article with the same subject.\\ -M-C-t & (T T) {\bf Toggle} threading.\\ -C-c C-f & (S o m) {\bf Forward} this article by mail to a person.\\ -\newlength{\foo}\settowidth{\foo}{C-c C-v}% -\makebox[\foo][l]{C-c C-v C-v}&\rule{4ex}{0pt} - (X v u) Uudecode and view these series. [p/p]\\ -C-c C-r & (W r) Do a Caesar {\bf rotate} (rot13) on the article.\\ -%C-c C-s C-a & Sort the summary by {\bf author}.\\ -%C-c C-s C-d & Sort the summary by {\bf date}.\\ -%C-c C-s C-i & Sort the summary by article score.\\ -%C-c C-s C-n & Sort the summary by article {\bf number}.\\ -%C-c C-s C-s & Sort the summary by {\bf subject}.\\ -%C-c M-C-s & (M S) {\bf Show} all expunged articles.\\ -B DEL & {\bf Delete} the mail article from disk (!). [p/p]\\ -B c & {\bf Copy} this article from any group to a mail group. [p/p]\\ -%B e & {\bf Expire} all expirable articles in this group. [p/p]\\ -%B i & {\bf Import} a random file into this group.\\ -B m & {\bf Move} the article from one mail group to another. [p/p]\\ -%B q & {\bf Query} where will the article go during fancy splitting\\ -%B r & {\bf Respool} this mail article. [p/p]\\ -%B M-C-e & {\bf Expunge} (delete from disk) all expirable articles in this -%group %(!). [p/p]\\ -%G p & {\bf Pop} an article off the summary history and go to it.\\ -%H d & (C-c C-d) {\bf Describe} this group. [Prefix: re-read the -%description from the server.]\\ -%H f & Try to fetch the {\bf FAQ} for this group using ange-ftp.\\ -%H h & Give a very short {\bf help} message.\\ -%H i & (C-c C-i) Go to the Gnus online {\bf info}.\\ -%H v & Display the Gnus {\bf version} number.\\ -%M b & Set a {\bf bookmark} in this article.\\ -%E & (M e, M x) Mark this article as {\bf expirable}. [scope]\\ -%M B & Remove the {\bf bookmark} from this article.\\ -%M C & {\bf Catch-Up} the articles that are not ticked.\\ -%M D & Show all {\bf dormant} articles (normally they are hidden unless -%they have any followups).\\ -M H & Catch-Up (mark read) this group to point ({\bf here}).\\ -%M C-c & {\bf Catch-Up} all articles in this group.\\ -%M M-D & Hide all {\bf dormant} articles.\\ -%M M-C-r & Expunge all articles having a given mark.\\ -%M V c & {\bf Clear} all marks from all high-scored articles. [score]\\ -%M V k & {\bf Kill} all low-scored articles. [score]\\ -%M V m & {\bf Mark} all high-scored articles with a given mark. [score]\\ -%M V u & Mark all high-scored articles as interesting (tick them). [score]\\ -%M P a & Mark {\bf all} articles (in series order).\\ -%M P r & Mark all articles in the {\bf region}.\\ -%M P s & Mark all articles in the current {\bf series}.\\ -%M P t & Mark all articles in this (sub){\bf thread}.\\ -%M P R & Mark all articles matching a {\bf regexp}.\\ -%M P S & Mark all {\bf series} that already contain a marked article.\\ -%M P U & {\bf Unmark} all articles.\\ -O \bf z & Save this article in {\bf file}, {\bf mh} folder, {\bf mail}, -{\bf rmail}, {\bf vm} format. [p/p]\\ -%O f & Save this article in plain {\bf file} format. [p/p]\\ -%O h & Save this article in {\bf mh} folder format. [p/p]\\ -%O m & Save this article in {\bf mail} format. [p/p]\\ -%O r & Save this article in {\bf rmail} format. [p/p]\\ -%O v & Save this article in {\bf vm} format. [p/p]\\ -S b & {\bf Both} post a followup to this article, and send a reply.\\ -%S o p & Forward this article as a {\bf post} to a newsgroup.\\ -S s & {\bf Supersede} this article with a new one (only for own -articles).\\ -%S u & {\bf Uuencode} a file and post it as a series.\\ -S B & {\bf Both} post a followup, send a reply, and include the -original. [p/p]\\ -%S O m & Digest these series and forward by {\bf mail}. [p/p]\\ -%S O p & Digest these series and forward as a {\bf post} to a newsgroup. -%[p/p]\\ -%T \# & Mark this thread with the process mark.\\ -%T d & Move to the next article in this thread ({\bf down}). [distance]\\ -T h & {\bf Hide} this (sub)thread.\\ -%T i & {\bf Increase} the score of this thread.\\ -T s & {\bf Show} the thread hidden under this article.\\ -%T u & Move to the previous article in this {\bf thread ({\bf up}). -%[distance]\\ -%T H & {\bf Hide} all threads.\\ -%T S & {\bf Show} all hidden threads.\\ -%V a & {\bf Add} a new score entry, specifying all elements.\\ -%V c & Specify a new score file as {\bf current}.\\ -%V e & {\bf Edit} the current score alist.\\ -%V f & Edit a score {\bf file} and make it the current one.\\ -%V m & {\bf Mark} all articles below a given score as read.\\ -%V s & {\bf Set} the score of this article.\\ -%V t & Display all score rules applied to this article ({\bf trace}).\\ -%V x & {\bf Expunge} all low-scored articles. [score]\\ -%V C & {\bf Customize} the current score file through a user-friendly -%interface.\\ -%V S & Display the {\bf score} of this article.\\ -W b & Make Message-IDs and URLs in the article to mouse-clickable {\bf - buttons}.\\ -%W c & Remove extra {\bf CRs} (^M) from the article.\\ -%W f & Look for and display any X-{\bf Face} headers.\\ -%W m & Toggle {\bf MIME} processing.\\ -%W o & Treat {\bf overstrike} or underline (^H\_) in the article.\\ -%W q & Treat {\bf quoted}-printable in the article.\\ -W w & Do {\bf word} wrap in the article.\\ -W T e & Convert the article timestamp to time {\bf elapsed} since sent.\\ -W T l & Convert the article timestamp to the {\bf local} timezone.\\ -W T u & (W T z) Convert the article timestamp to {\bf UTC} ({\bf Zulu}, -GMT).\\ -W W a & Hide unwanted parts of the article (citation, headers, signature).\\ -%W W c & Hide article {\bf citation}.\\ -%W W h & Hide article {\bf headers}.\\ -%W W s & Hide article {\bf signature}.\\ -%W W C-c & Hide article {\bf citation} using a more intelligent algorithm.\\ -W H a & Highlight {\bf all} parts of the article (citation, headers, -signature).\\ -%W H c & Highlight article {\bf citation}.\\ -%W H h & Highlight article {\bf headers}.\\ -%W H s & Highlight article {\bf signature}.\\ -%X b & Un-{\bf binhex} these series. [p/p]\\ -%X o & Simply {\bf output} these series (no decoding). [p/p]\\ -%X p & Un{\bf pack} these {\bf postscript} series. [p/p]\\ -%X s & Un-{\bf shar} these series. [p/p]\\ -%X u & {\bf Uudecode} these series. [p/p]\\ -%X \bf z & Decode these series. [p/p]\\ -%X \bf Z & Decode and save these series. [p/p]\\ -%X v \bf z & Decode and view these series. [p/p]\\ -%X v \bf Z & Decode, save and view these series. [p/p]\\ -%Z n & Mark all articles as read and go to the {\bf next} group.\\ -%Z C & Mark all articles as read ({\bf catch-up}) and exit.\\ -%Z N & Exit and go to the {\bf next} group.\\ -%Z P & Exit and go to the {\bf previous} group.\\ -%Z R & Exit this group, and then enter it again ({\bf reenter}). [Prefix: -%select all articles, read and unread.]\\ -\end{keys} -} - -\def\ArticleMode{ -\sec{Article Mode} -{\samepage -All keys for Summary mode also work in Article mode. -Additional keys: - -\begin{keys}{C-c C-m} -RET & (middle mouse button) Activate the button at point to follow -an URL or Message-ID.\\ -TAB & Move the point to the next button.\\ -h & (s) Go to the {\bf header} line of the article in the {\bf -summary} buffer.\\ -C-c ^ & Get the article with the Message-ID near point.\\ -C-c C-m & {\bf Mail} reply to the address near point (prefix: include the -original).\\ -\end{keys} -}} - -\def\sec{\subsubsection*} -\catcode`\^=7 % restore ^ - -\documentstyle{article} -\textwidth 7.26in \textheight 10in \topmargin -1.0in -% the same settings work for A4, although there is a bit of space at the -% top and bottom of the page. -\oddsidemargin -0.5in \evensidemargin -0.5in -\begin{document} -\twocolumn\scriptsize\pagestyle{empty} - -{\centering\Logo{quickref}\qquad\qquad\Title} - -\vspace*{\fill} -\Notes -\GroupMode -\ArticleMode -\vspace*{\fill} -\CopyRight -\pagebreak - -\SummaryMode -\end{document} diff -r 6866abce6aaf -r 6075d714658b etc/gnusrefcard/refcard.tex --- a/etc/gnusrefcard/refcard.tex Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,83 +0,0 @@ -% Reference Card for (ding) Gnus, 3 twocolumn pages. -% To be processed with latex 2.09 -\def\Guide{Card}\def\guide{card} -\def\logoscale{0.25} -\def\sec{\section*} -\def\subsec{\subsection*} -\def\subsubsec{\subsubsection*} -\documentstyle{article} -\textwidth 7.26in \textheight 10.3in \topmargin -1.2in -% the same settings work for A4, although there is a bit of space at the -% top and bottom of the page. -\oddsidemargin -0.5in \evensidemargin -0.5in -\begin{document} -\twocolumn\footnotesize\pagestyle{empty} -\input{gnusref} - -\vspace*{\fill} -\Title -\vspace*{2ex} -\Logo{refcard} -\vspace*{\fill} -\Marks -\GroupLevels -\pagebreak - -\Notes -\General -\ArticleMode -\vspace*{\fill} -\CopyRight -\pagebreak - -\GroupMode -\SOUP -\pagebreak - -\ListGroups -\CreateGroups -\SortGroups -\MarkGroups -\pagebreak - -\Unsubscribe -\GroupTopics -\vspace*{\fill} -\SummaryMode -\SortSummary -\Article -\pagebreak - -\MailGroup -\GotoArticle -\Score -\pagebreak - -\MarkArticles -%\vspace*{-0.5ex} -\MarkScore -%\vspace*{-0.5ex} -\ProcessMark -%\vspace*{-0.5ex} -\OutputArticles -\pagebreak - -\Send -%\vspace*{-1.1ex} -\Thread -%\vspace*{-1.1ex} -\Exit -\pagebreak - -\Wash -\Hide -\Highlight -\Extract -\pagebreak - -\Limit -\PickAndRead -\ServerMode -\BrowseServer - -\end{document} diff -r 6866abce6aaf -r 6075d714658b etc/idd/drop --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/idd/drop Mon Aug 13 09:51:16 2007 +0200 @@ -0,0 +1,8 @@ +#define drop_width 16 +#define drop_height 16 +#define drop_x_hot 6 +#define drop_y_hot 4 +static unsigned char drop_bits[] = { + 0x00, 0x00, 0xfe, 0x07, 0x02, 0x04, 0x02, 0x04, 0x42, 0x04, 0xc2, 0x04, + 0xc2, 0x05, 0xc2, 0x07, 0xc2, 0x07, 0xc2, 0x0f, 0xfe, 0x1f, 0xc0, 0x07, + 0xc0, 0x06, 0x00, 0x0c, 0x00, 0x1c, 0x00, 0x08}; diff -r 6866abce6aaf -r 6075d714658b etc/idd/dropmsk --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/idd/dropmsk Mon Aug 13 09:51:16 2007 +0200 @@ -0,0 +1,8 @@ +#define drop_width 16 +#define drop_height 16 +#define drop_x_hot 6 +#define drop_y_hot 4 +static unsigned char drop_bits[] = { + 0x00, 0x00, 0xfe, 0x07, 0x02, 0x04, 0x02, 0x04, 0x42, 0x04, 0xc2, 0x04, + 0xc2, 0x05, 0xc2, 0x07, 0xc2, 0x07, 0xc2, 0x0f, 0xfe, 0x1f, 0xc0, 0x07, + 0xc0, 0x06, 0x00, 0x0c, 0x00, 0x1c, 0x00, 0x08}; diff -r 6866abce6aaf -r 6075d714658b etc/message/message-help-up.xbm --- a/etc/message/message-help-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x80,0x40,0x08,0x00,0x2a,0x14,0x42,0x55,0x40,0xa1,0x14,0x00,0x15,0x08,0x21, - 0x55,0xa0,0x22,0x84,0x80,0x0a,0xd0,0x23,0x28,0x50,0xe5,0x8e,0x82,0x05,0x68, - 0x46,0x28,0xa8,0x22,0x17,0x41,0x02,0xc8,0x81,0x14,0xf8,0xff,0xff,0x5f,0x3d, - 0x00,0x00,0x16,0xc8,0x80,0x81,0xb1,0x0c,0x83,0x61,0x10,0x0a,0x0c,0x18,0x50, - 0x08,0x30,0x06,0x10,0x0a,0xc8,0x05,0x30,0x08,0x06,0x18,0x50,0x0a,0x01,0x20, - 0x10,0x89,0x00,0x40,0x50,0x6c,0x00,0x80,0x11,0x19,0x00,0x00,0x52,0x0c,0x00, - 0x00,0x1c,0xf9,0xff,0xff,0x5f,0x20,0x22,0x92,0x24,0x8a,0x08,0x21,0x10,0x10, - 0x51,0x84,0x42,0x45,0x04,0x51,0x28,0x88,0x28,0x02,0x81,0x22,0x82,0x54,0x2a, - 0x88,0x28,0x00,0x81,0x44,0x04,0x55,0x28}; diff -r 6866abce6aaf -r 6075d714658b etc/message/message-help-up.xpm --- a/etc/message/message-help-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -/* XPM */ -static char * icon-mail-help_xpm[] = { -"32 32 3 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -" ", -" ", -" ", -" ", -" ", -" .... ", -" .. .. ", -" .. .. ", -" .. ", -" .. ", -" .......................... ", -" ...XXXXXXXXXXXXXXXXXXX..X. ", -" .XX..XXXXXXX..XXXXXX..XXX. ", -" .XXXX..XXXXX..XXXX..XXXXX. ", -" .XXXXXX..XXXXXXX..XXXXXXX. ", -" .XXXXXXXX..XXX..XXXXXXXXX. ", -" .XXXXXXX.XX...X.XXXXXXXXX. ", -" .XXXXX..XXXXXXXX..XXXXXXX. ", -" .XXXX.XXXXXXXXXXXX.XXXXXX. ", -" .XXX.XXXXXXXXXXXXXX.XXXXX. ", -" .X..XXXXXXXXXXXXXXXX..XXX. ", -" ..XXXXXXXXXXXXXXXXXXXX.XX. ", -" .XXXXXXXXXXXXXXXXXXXXXX... ", -" .......................... ", -" ", -" ", -" ", -" ", -" ", -" ", -" ", -" "}; diff -r 6866abce6aaf -r 6075d714658b etc/message/message-spell-up.xbm --- a/etc/message/message-spell-up.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,12 +0,0 @@ -#define noname_width 32 -#define noname_height 32 -static char noname_bits[] = { - 0x10,0x40,0x00,0x01,0x44,0x15,0x5e,0x50,0x12,0xa0,0x62,0x05,0x80,0x0a,0x81, - 0x51,0x2a,0x70,0x01,0x0a,0x81,0x8e,0x04,0x42,0x14,0x43,0x04,0x0b,0xc1,0x40, - 0x82,0x50,0x34,0x20,0x81,0x81,0x09,0x10,0xc1,0x2b,0x66,0x12,0x20,0x86,0x0e, - 0x48,0x90,0x25,0x32,0x44,0x70,0x94,0xc3,0x24,0x18,0x04,0x02,0x07,0x06,0xec, - 0x02,0x8c,0x01,0x3c,0x02,0x72,0x01,0x8e,0x83,0x01,0x86,0x27,0x42,0x30,0xe8, - 0x87,0x22,0x70,0xf0,0x2c,0x1a,0xfe,0x79,0x84,0x07,0xf8,0xbd,0x24,0x02,0xf0, - 0x3f,0x97,0xfe,0xff,0xff,0x07,0x92,0xc4,0x07,0x29,0x04,0xa1,0x53,0x44,0x50, - 0x14,0x85,0x10,0x0a,0x01,0x21,0x44,0x20,0x2a,0x94,0x12,0x8a,0x80,0x22,0x40, - 0x10,0x15,0x88,0x0a,0x45,0xa0,0x42,0x40}; diff -r 6866abce6aaf -r 6075d714658b etc/message/message-spell-up.xpm --- a/etc/message/message-spell-up.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,38 +0,0 @@ -/* XPM */ -static char * icon-mail-spell_xpm[] = { -"32 32 3 1", -" c #BFBFBFBFBFBF s backgroundToolBarColor", -". c #000000000000", -"X c #FFFFFFFFFFFF", -" ", -" ... ", -" .XXX.. ", -" .XXXXXX.. ", -" ... .XXXXXXXX. ", -" ..XXX.XX.XXXXXX. ", -" ..XXXX.XXX.XXXXX. ", -" ..XXXXXX.XX.XXXXX. ", -" ..XXXXXXX.XX.XXXXXX. ", -" .XXXXXXXX.XXX.XXXXX... ", -" ..XX..XX.XX.XXXXXXXX.XXX.. ", -" ...XXXXXXX.XX.XXXXX.XX..X. ", -" .XX..XXXX.XXX.XXXXX...XXX. ", -" .XXXX..XX.XX.XXXXX..XXXXX. ", -" .XXXXXX...XXXXXX..XXXXXXX. ..", -" .XXXXXXXX..XXX..XXXXXXXX ....X ", -" .XXXXXXX.XX...X.XXXXXX ...X ", -" .XXXXX..XXXX XXX..XXX ....X ", -" .XXXX.XXXXX . XXXX. ... . ", -" .XXX.XXXX ... XXX .... X. ", -" .X..XXXX ...... X .... XX. ", -" ..XXXXXXX ...... .... .XX. ", -" .XXXXXXXXX ......... XX... ", -" .......................... ", -" X.....X ", -" X... ", -" X.X ", -" ", -" ", -" ", -" ", -" "}; diff -r 6866abce6aaf -r 6075d714658b etc/smilies/FaceAngry.xpm --- a/etc/smilies/FaceAngry.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -/* XPM */ -static char * image_name[] = { -"12 12 5 1", -" c none", -". c #FFFF00 s flesh", -"X c #000000000000 s features", -"E c #000000000000 s circle", -"o c #555555555555 s tongue", -" EEEE ", -" EE....EE ", -" E........E ", -" E.X....X.E ", -"E...X..X...E", -"E...X..X...E", -"E..........E", -"E...XXXX...E", -" E.X....X.E ", -" E........E ", -" EE....EE ", -" EEEE ....", diff -r 6866abce6aaf -r 6075d714658b etc/smilies/FaceGoofy.xpm --- a/etc/smilies/FaceGoofy.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -/* XPM */ -static char * image_name[] = { -"12 12 5 1", -" c none", -". c #FFFF00 s flesh", -"X c #000000000000 s features", -"E c #000000000000 s circle", -"o c #555555555555 s tongue", -" EEEE ", -" EE....EE ", -" E........E ", -" E..X..X..E ", -"E...X..X...E", -"E..........E", -"E.X......X.E", -"E.XXXXXXXX.E", -" E........E ", -" E........E ", -" EE....EE ", -" EEEE ....", diff -r 6866abce6aaf -r 6075d714658b etc/smilies/FaceGrinning.xpm --- a/etc/smilies/FaceGrinning.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -/* XPM */ -static char * image_name[] = { -"12 12 5 1", -" c none", -". c #FFFF00 s flesh", -"X c #000000000000 s features", -"E c #000000000000 s circle", -"o c #555555555555 s tongue", -" EEEE ", -" EE....EE ", -" E........E ", -" E..X..X..E ", -"E...X..X...E", -"E..........E", -"E..XXXXXX..E", -"E..X....X..E", -" E..X..X..E ", -" E...XX...E ", -" EE....EE ", -" EEEE ....", diff -r 6866abce6aaf -r 6075d714658b etc/smilies/FaceHappy.xpm --- a/etc/smilies/FaceHappy.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -/* XPM */ -static char * image_name[] = { -"12 12 5 1", -" c none", -". c #FFFF00 s flesh", -"X c #000000000000 s features", -"E c #000000000000 s circle", -"o c #555555555555 s tongue", -" EEEE ", -" EE....EE ", -" E........E ", -" E..X..X..E ", -"E...X..X...E", -"E..........E", -"E.X......X.E", -"E..XXXXXX..E", -" E..XXXX..E ", -" E........E ", -" EE....EE ", -" EEEE ....", diff -r 6866abce6aaf -r 6075d714658b etc/smilies/FaceIronic.xpm --- a/etc/smilies/FaceIronic.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -/* XPM */ -static char * image_name[] = { -"12 12 5 1", -" c none", -". c #FFFF00 s flesh", -"X c #000000000000 s features", -"E c #000000000000 s circle", -"o c #555555555555 s tongue", -" EEEE ", -" EE....EE ", -" E........E ", -" E..X..X..E ", -"E...X..X...E", -"E..........E", -"E........X.E", -"E...XXXXX..E", -" E.X......E ", -" E........E ", -" EE....EE ", -" EEEE ....", diff -r 6866abce6aaf -r 6075d714658b etc/smilies/FaceKOed.xpm --- a/etc/smilies/FaceKOed.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -/* XPM */ -static char * image_name[] = { -"12 12 5 1", -" c none", -". c #FFFF00 s flesh", -"X c #000000000000 s features", -"E c #000000000000 s circle", -"o c #555555555555 s tongue", -" EEEE ", -" EE....EE ", -" E........E ", -" E.X.XX.X.E ", -"E...X..X...E", -"E..X.XX.X..E", -"E..........E", -"E..........E", -" E.XXXXXX.E ", -" E........E ", -" EE....EE ", -" EEEE ....", diff -r 6866abce6aaf -r 6075d714658b etc/smilies/FaceNyah.xpm --- a/etc/smilies/FaceNyah.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -/* XPM */ -static char * image_name[] = { -"12 12 5 1", -" c none", -". c #FFFF00 s flesh", -"X c #000000000000 s features", -"E c #000000000000 s circle", -"o c #555555555555 s tongue", -" EEEE ", -" EE....EE ", -" E........E ", -" E........E ", -"E..XX..XX..E", -"E..........E", -"E..........E", -"E...XXXX...E", -" E..oooX..E ", -" E...oo...E ", -" EE.Xo.EE ", -" EEEE .Xo.", diff -r 6866abce6aaf -r 6075d714658b etc/smilies/FaceSad.xpm --- a/etc/smilies/FaceSad.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -/* XPM */ -static char * image_name[] = { -"12 12 5 1", -" c none", -". c #FFFF00 s flesh", -"X c #000000000000 s features", -"E c #000000000000 s circle", -"o c #555555555555 s tongue", -" EEEE ", -" EE....EE ", -" E........E ", -" E..X..X..E ", -"E...X..X...E", -"E..........E", -"E..........E", -"E...XXXX...E", -" E.X....X.E ", -" EX......XE ", -" EE....EE ", -" EEEE ....", diff -r 6866abce6aaf -r 6075d714658b etc/smilies/FaceStartled.xpm --- a/etc/smilies/FaceStartled.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -/* XPM */ -static char * image_name[] = { -"12 12 5 1", -" c none", -". c #FFFF00 s flesh", -"X c #000000000000 s features", -"E c #000000000000 s circle", -"o c #555555555555 s tongue", -" EEEE ", -" EE....EE ", -" E........E ", -" E..X..X..E ", -"E...X..X...E", -"E..........E", -"E...XXXX...E", -"E..X....X..E", -" E.X....X.E ", -" E..XXXX..E ", -" EE....EE ", -" EEEE ....", diff -r 6866abce6aaf -r 6075d714658b etc/smilies/FaceStraight.xpm --- a/etc/smilies/FaceStraight.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -/* XPM */ -static char * image_name[] = { -"12 12 5 1", -" c none", -". c #FFFF00 s flesh", -"X c #000000000000 s features", -"E c #000000000000 s circle", -"o c #555555555555 s tongue", -" EEEE ", -" EE....EE ", -" E........E ", -" E..X..X..E ", -"E...X..X...E", -"E..........E", -"E..........E", -"E...XXXX...E", -" E........E ", -" E........E ", -" EE....EE ", -" EEEE ....", diff -r 6866abce6aaf -r 6075d714658b etc/smilies/FaceTalking.xpm --- a/etc/smilies/FaceTalking.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -/* XPM */ -static char * image_name[] = { -"12 12 5 1", -" c none", -". c #FFFF00 s flesh", -"X c #000000000000 s features", -"E c #000000000000 s circle", -"o c #555555555555 s tongue", -" EEEE ", -" EE....EE ", -" E........E ", -" E..X..X..E ", -"E...X..X...E", -"E..........E", -"E..........E", -"E...XXXXX..E", -" E....XXX.E ", -" E....XX..E ", -" EE....EE ", -" EEEE ....", diff -r 6866abce6aaf -r 6075d714658b etc/smilies/FaceTasty.xpm --- a/etc/smilies/FaceTasty.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -/* XPM */ -static char * image_name[] = { -"12 12 5 1", -" c none", -". c #FFFF00 s flesh", -"X c #000000000000 s features", -"E c #000000000000 s circle", -"o c #555555555555 s tongue", -" EEEE ", -" EE....EE ", -" E........E ", -" E..X..X..E ", -"E...X..X...E", -"E..........E", -"E...o......E", -"E..ooo.....E", -" E.XXXXX..E ", -" E........E ", -" EE....EE ", -" EEEE ....", diff -r 6866abce6aaf -r 6075d714658b etc/smilies/FaceWinking.xpm --- a/etc/smilies/FaceWinking.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -/* XPM */ -static char * image_name[] = { -"12 12 5 1", -" c none", -". c #FFFF00 s flesh", -"X c #000000000000 s features", -"E c #000000000000 s circle", -"o c #555555555555 s tongue", -" EEEE ", -" EE....EE ", -" E........E ", -" E..X.....E ", -"E...X.XXX..E", -"E..........E", -"E.X......X.E", -"E..XXXXXX..E", -" E..XXXX..E ", -" E........E ", -" EE....EE ", -" EEEE ....", diff -r 6866abce6aaf -r 6075d714658b etc/smilies/FaceWry.xpm --- a/etc/smilies/FaceWry.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -/* XPM */ -static char * image_name[] = { -"12 12 5 1", -" c none", -". c #FFFF00 s flesh", -"X c #000000000000 s features", -"E c #000000000000 s circle", -"o c #555555555555 s tongue", -" EEEE ", -" EE....EE ", -" E........E ", -" E..X..X..E ", -"E...X..X...E", -"E..........E", -"E..........E", -"E.....XXX..E", -" E..XX....E ", -" E....XX..E ", -" EE....EE ", -" EEEE ....", diff -r 6866abce6aaf -r 6075d714658b etc/smilies/FaceYukky.xpm --- a/etc/smilies/FaceYukky.xpm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -/* XPM */ -static char * image_name[] = { -"12 12 5 1", -" c none", -". c #FFFF00 s flesh", -"X c #000000000000 s features", -"E c #000000000000 s circle", -"o c #555555555555 s tongue", -" EEEE ", -" EE....EE ", -" E........E ", -" E.X....X.E ", -"E...X..X...E", -"E..........E", -"E..........E", -"E..XXXXX...E", -" E..oooX..E ", -" E...oo...E ", -" EE.Xo.EE ", -" EEEE .Xo.", diff -r 6866abce6aaf -r 6075d714658b etc/smilies/WideFaceAse1.xbm --- a/etc/smilies/WideFaceAse1.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -#define Face_ase_width 24 -#define Face_ase_height 16 -static char Face_ase_bits[] = { - 0x00,0x00,0x00, - 0xf8,0xc1,0x0f, - 0x04,0x22,0x10, - 0x00,0x00,0x00, - 0xf0,0xc0,0x03, - 0x68,0xa1,0x05, - 0x68,0xa1,0x05, - 0x68,0xa1,0x05, - 0xf0,0xc0,0x23, - 0x00,0x00,0x20, - 0x00,0x00,0x50, - 0x50,0x40,0x52, - 0x00,0x00,0x50, - 0x20,0x91,0x20, - 0x00,0x0e,0x00, - 0x00,0x00,0x00}; diff -r 6866abce6aaf -r 6075d714658b etc/smilies/WideFaceAse2.xbm --- a/etc/smilies/WideFaceAse2.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -#define Face_ase2_width 32 -#define Face_ase2_height 16 -static char Face_ase2_bits[] = { - 0x00,0x00,0x00,0x00, - 0xf0,0x83,0x1f,0x00, - 0x08,0x44,0x20,0x00, - 0x00,0x00,0x00,0x00, - 0xe0,0x81,0x07,0x00, - 0xd0,0x42,0x0b,0x00, - 0xd0,0x42,0x0b,0x00, - 0xd0,0x42,0x0b,0x00, - 0xe0,0x81,0x87,0x10, - 0x00,0x00,0x80,0x10, - 0x00,0x00,0x40,0x29, - 0xa0,0x80,0x44,0x29, - 0x00,0x00,0x40,0x29, - 0x40,0x22,0x81,0x10, - 0x00,0x1c,0x00,0x00, - 0x00,0x00,0x00,0x00}; diff -r 6866abce6aaf -r 6075d714658b etc/smilies/WideFaceAse3.xbm --- a/etc/smilies/WideFaceAse3.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -#define Face_ase3_width 24 -#define Face_ase3_height 16 -static char Face_ase3_bits[] = { - 0x00,0x00,0x00, - 0xf8,0xc1,0x0f, - 0x04,0x22,0x10, - 0x00,0x00,0x00, - 0x18,0x00,0x07, - 0xe0,0xe0,0x00, - 0xfc,0xf3,0x0f, - 0xc0,0xe1,0x00, - 0x38,0x00,0x27, - 0x00,0x00,0x20, - 0x00,0x00,0x50, - 0x50,0x40,0x52, - 0x00,0x00,0x50, - 0x20,0x91,0x20, - 0x00,0x0e,0x00, - 0x00,0x00,0x00 -}; diff -r 6866abce6aaf -r 6075d714658b etc/smilies/WideFaceSmile.xbm --- a/etc/smilies/WideFaceSmile.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -#define Face_smile_width 24 -#define Face_smile_height 16 -static char Face_smile_bits[] = { - 0x00,0x00,0x00, - 0xf8,0xc1,0x0f, - 0x04,0x22,0x10, - 0x00,0x00,0x00, - 0xf0,0xc0,0x07, - 0x68,0xa1,0x09, - 0x68,0xa1,0x09, - 0x68,0xa1,0x09, - 0xf0,0xc0,0x07, - 0x00,0x00,0x00, - 0x00,0x00,0x00, - 0x50,0x80,0x04, - 0x00,0x00,0x00, - 0x20,0x22,0x01, - 0x00,0x1c,0x00, - 0x00,0x00,0x00}; diff -r 6866abce6aaf -r 6075d714658b etc/smilies/WideFaceWeep.xbm --- a/etc/smilies/WideFaceWeep.xbm Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,20 +0,0 @@ -#define Face_weep_width 24 -#define Face_weep_height 16 -static char Face_weep_bits[] = { - 0x1c,0x00,0x3c, - 0xe2,0x80,0x43, - 0x00,0x63,0x00, - 0x18,0x00,0x18, - 0x60,0x00,0x07, - 0x80,0xe3,0x00, - 0xfc,0xf7,0x3f, - 0x80,0xe3,0x00, - 0x60,0x00,0x07, - 0x58,0x00,0x1a, - 0x40,0x00,0x02, - 0xa0,0x00,0x05, - 0xa0,0x00,0x05, - 0xa0,0x1c,0x05, - 0x40,0x22,0x02, - 0x00,0x00,0x00 -}; diff -r 6866abce6aaf -r 6075d714658b etc/xemacs-fe.sh --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/etc/xemacs-fe.sh Mon Aug 13 09:51:16 2007 +0200 @@ -0,0 +1,316 @@ +#! /bin/sh +# emacs-fe --- front end driver for `emacs' and other programs + +# Copyright (C) 1995, 1996 Noah S. Friedman + +# Author: Noah Friedman +# Created: 1995-09-11 + +# $.Id: emacs-fe,v 1.8 1996/03/07 04:32:33 friedman Exp $ + +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2, or (at your option) +# any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, you can either send email to this +# program's maintainer or write to: The Free Software Foundation, +# Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA. + +# Commentary: + +# Inspired by a similar set of scripts by Charles Sandel , +# but generalized into this single script. + +# Front-end shell script for GNU Emacs, used to manage multiple versions of +# Emacs and its associated utilities. +# +# Strategy: Install this script as "$prefix/bin/[progname]", for each +# program named [progname], (e.g. "emacs", "ispell", "etags", etc). These +# are the commands users would normally execute to run them. + +# Give each version of emacs/xemacs/mule/ispell a separate hierarchy under +# $prefix/[emacs|xemacs|mule|ispell], with the name +# "[emacs|xemacs|mule|ispell]-NN.NN" where NN.NN is the version number. +# This script looks at what versions are available, and selects a version, +# currently whatever is specified by $DEFAULTLVERSION. + +# However, users can specify their own choice to force the selection of a +# particular version by setting the environment variable PROGNAMEVERSION +# (e.g. EMACSVERSION, MULEVERSION, XEMACSVERSION, etc.) to have a value +# which is the version number of the program that they want to use (just +# the numeric value), or to specify either the NEWEST or OLDEST versions. + +# Code: + +# Name by which this script was invoked. +progname=`echo "$0" | sed -e 's/[^\/]*\///g'` + +# To prevent hairy quoting and escaping later. +bq='`' +eq="'" + +case "$progname" in + emacs-fe-print ) + case $# in + 1 ) : ;; + * ) + echo "$progname: Exactly one argument is required." 1>&2 + exit 1 + ;; + esac + + # sed is more portable than `dirname' + dir=`echo "$0" | sed -e 's/\/*$//' -e 's/\/[^\/]*$//'` + if test -f "$dir/$1"; then + EMACS_FE_PRINT=t + export EMACS_FE_PRINT + exec "$dir/$1" + fi + + echo "$progname: $bq$dir/$1$eq does not seem to exist." 1>&2 + exit 1 + ;; +esac + +DEFAULTVERSION="${DEFAULTVERSION-NEWEST}" +VARIANT="${EMACSVARIANT-emacs}" + +if [ "$prefix" = "" ] ; then + # root of the GNU installed tree + prefix=/usr/local/gnu +fi + +if [ ! -d "$prefix" ] ; then + echo "Cannot find root of GNU tree ($prefix)." + exit 1 +fi + +case "$progname" in + emacs | lemacs | xemacs | mule | ispell ) + if [ "$eprefix" = "" ] ; then + # prefix name of the subdirectory + eprefix="${progname}/${progname}-" + fi + ;; + * ) + eprefix="$VARIANT/${VARIANT}-" + ;; +esac + +# Find out which versions are available on the system and sort them +# in numeric order. +# +# The largish sed script prefixes all version numbers with a sort key. +# That key is constructed by padding out any single or double digits to 3 +# digits from the version number, then converting all occurences of `.' to +# `0', and prefixing and suffixing the entire result with an additional +# zero. After sorting, the sort key is stripped from the output. +# We do all this because `sort' cannot numerically sort decimal numbers and +# will stop on the first `.'. +# This may not work correctly if the version number has more than 4 levels +# of minor versions (e.g. "1.2.3.4.5" may cause problems). +availversions=`ls -1d $prefix/${eprefix}*/. 2> /dev/null \ + | sed -n \ + -e "s#^$prefix/$eprefix\([0-9.][0-9.]*\)/\.*#\1#" \ + -e 'h + s/[^.]*[^0-9.][^.]*\.//g + :0 + /[0-9.][0-9.]*\.[0-9.][0-9.]*\.[0-9.][0-9.]*\.[0-9.][0-9.]*/!{ + s/$/.0/ + b 0 + } + s/^/./ + s/$/./ + :1 + s/\.\([0-9]\)\./.00\1./g + s/\.\([0-9][0-9]\)\./.0\1./g + t 1 + s/\./0/g + G + s/\n/ /' \ + -e 'p' \ + | sort -nu \ + | sed -e 's/.* //'` + +if [ "$availversions" = "" ] ; then + echo "No version of $progname found in $prefix/$eprefix*." + exit 1 +fi + +# This sets `oldest' to the oldest version available, and `newest' +# to the newest version available. +# On line 1, we save the original pattern in the hold space and restore it +# in case it is the only line of input. +eval `echo "$availversions" \ + | sed -ne '1{h;s/^/oldest=/p;g;} + ${s/^/newest=/p;} + '` + +# The environment variable [progname]VERSION can have a value which specifies +# a version number, OR it can contain the values "NEWEST" or "OLDEST" to +# specify the newest or oldest version which was found. +sed_upcase='y/abcdefghijklmnopqrstuvwxyz/ABCDEFGHIJKLMNOPQRSTUVWXYZ/' + +PROGNAME=`echo "$progname" | sed -e "$sed_upcase" -e 's/-/_/g'` +eval version=\"\$${PROGNAME}VERSION\" + +# If there is no ETAGSVERSION, EMACSCLIENTVERSION, etc, then look for +# EMACSVERSION, XEMACSVERSION, or whatever the current variant is. +case "$version" in + '' ) + case "$progname" in + ispell ) + # If this is ispell and ISPELLVERSION isn't set, just use 3.1. + # We could run this script recursively with a flag indicating to + # find the current emacs variant and version and just print it out, + # but that is a very pathological case and is a lot of work. + version=3.1 ;; + * ) + variant=`echo "$VARIANT" | sed -e "$sed_upcase"` + eval version=\"\$${variant}VERSION\" + case "$version" in + '' ) version="$DEFAULTVERSION" ;; + esac + ;; + esac +esac + +case "$version" in + [Oo][Ll][Dd][Ee][Ss][Tt]) version="$oldest" ;; + [Nn][Ee][Ww][Ee][Ss][Tt]) version="$newest" ;; + '') version="$oldest" ;; + *) + if [ ! -d "$prefix/$eprefix$version" ] ; then + echo "$progname: $version: Cannot find requested version." 1>&2 + version= + fi + ;; +esac + +# If we don't have a version by now, then give up. +if [ "$version" = "" ] ; then + exec 1>&2 + echo "$progname: Cannot determine which version to use." + case "$availversions" in + */* ) + echo "Available versions are:" + for f in $availversions; do + echo " $f" + done | sort + ;; + * ) + echo "Available versions are:" $availversions + ;; + esac + exit 1 +fi + +case "$progname" in + emacs | lemacs | xemacs | mule ) + EMACSVARIANT=$progname + eval ${PROGNAME}VERSION=$version + eval export EMACSVARIANT ${PROGNAME}VERSION + + case "$EMACSVARIANT-$version" in + emacs-18* ) ISPELLVERSION=4.0 ;; + emacs-19.[0-9] ) ISPELLVERSION=4.0 ;; + emacs-19.1[0-9] ) ISPELLVERSION=4.0 ;; + emacs-19.2[0-2] ) ISPELLVERSION=4.0 ;; + emacs-19.2[3-9] ) ISPELLVERSION=3.1 ;; + emacs-* ) ISPELLVERSION=3.1 ;; + + lemacs-19.[0-9] ) ISPELLVERSION=3.0.09 ;; + lemacs-19.10 ) ISPELLVERSION=3.1 ;; + + xemacs-* ) ISPELLVERSION=3.1 ;; + + mule-* ) ISPELLVERSION=3.1 ;; + esac + export ISPELLVERSION + ;; +esac + +case "$progname" in + xemacs ) + # xemacs expects to use the keysym database in /usr/openwin, but that + # database doesn't define many of the keysyms it uses. Unless the user + # has already defined their own, specify the keysym database in X11. + XKEYSYMDB="${XKEYSYMDB-/usr/local/X11/lib/X11/XKeysymDB}" + export XKEYSYMDB + + # Some versions of xemacs (e.g. 19.12) are dynamically linked against + # the openwin tooltalk library (libtt.so), so add openwin to the + # dynamic load path if necessary. + case "$LD_LIBRARY_PATH" in + *'/usr/openwin/lib'* ) : ;; + '' ) + LD_LIBRARY_PATH=/usr/local/X11R5/lib:/usr/openwin/lib:/lib + export LD_LIBRARY_PATH + ;; + * ) + LD_LIBRARY_PATH="$LD_LIBRARY_PATH:/usr/openwin/lib" + export LD_LIBRARY_PATH + ;; + esac + ;; +esac + +# Set up the MANPATH so that the man pages for this version +# are searched first +if [ -d $prefix/$eprefix$version/man ] ; then + MANPATH=$prefix/$eprefix$version/man:$MANPATH + export MANPATH +fi + +# There is no need to do this, and it can potentially cause problems, +# especially if a program like `xemacs' exists in that directory and gets +# run in subshells instead of this script. +#PATH=$prefix/$eprefix$version/bin:$PATH +#export PATH + +searchdirs=`exec 2> /dev/null + cd $prefix/$eprefix$version \ + && find bin \ + libexec/$VARIANT/$version/* \ + lib/$VARIANT/$version/* \ + lib/$VARIANT-$version/* \ + lib/$VARIANT/etc \ + lib/etc \ + -type d -print` + +for dir in $searchdirs ; do + for p in $progname-$version $progname ; do + prog="$prefix/$eprefix$version/$dir/$p" + + if test -f "$prog" ; then + case "${EMACS_FE_PRINT+set}" in + set ) + echo "$prog" + exit 0 + ;; + esac + + exec "$prog" ${1+"$@"} + fi + done +done + +exec 1>&2 + +echo "$progname: Cannot find $bq$progname-$version$eq or $bq$progname$eq in" + +for d in $searchdirs ; do + ls -1d $prefix/$eprefix$version/$d 2> /dev/null \ + | sed -e "s/^/$progname: /" +done + +exit 1 + +# emacs-fe ends here diff -r 6866abce6aaf -r 6075d714658b info/dir --- a/info/dir Mon Aug 13 09:50:16 2007 +0200 +++ b/info/dir Mon Aug 13 09:51:16 2007 +0200 @@ -57,13 +57,11 @@ * External-Widget:: Use XEmacs as a text widget inside of another program. * Forms:: A package for editing databases by filling in forms. -* Gnus:: A netnews and mail reader for XEmacs. * HM--HTML-Mode:: HTML Editing Mode. * Hyperbole:: A programmable information management and hypertext system. * ILISP:: Multi-dialect inferior LISP interface. * Ispell:: Interactive spelling corrector. * Mailcrypt:: Emacs interface to cryptographic functions for mail and news. -* Message:: Emacs message composition mode. * MH-E:: Emacs interface to MH, a mail-handling package. * OO-Browser:: The Multi-Language Object-Oriented Browser. * PCL-CVS:: An XEmacs-based front end to CVS. @@ -85,9 +83,11 @@ * Widget:: An Emacs Lisp widget library * tm-en:: Tools for Mime (English version) * tm-mh-e-en:: Tools for Mime for MH-E (English version) -* gnus-mime-en::Tools for Mime for Gnus (English version) +* gnus-mime-en:: + Tools for Mime for Gnus (English version) * tm-vm-en:: Tools for Mime for VM * tm-ja:: Tools for Mime (Japanese version) * tm-mh-e-ja:: Tools for Mime for MH-E (Japanese version) -* gnus-mime-ja::Tools for Mime for Gnus (Japanese version) +* gnus-mime-ja:: + Tools for Mime for Gnus (Japanese version) * Locals: diff -r 6866abce6aaf -r 6075d714658b lib-src/ChangeLog --- a/lib-src/ChangeLog Mon Aug 13 09:50:16 2007 +0200 +++ b/lib-src/ChangeLog Mon Aug 13 09:51:16 2007 +0200 @@ -1,3 +1,13 @@ +1997-07-21 SL Baur + + * update-elc.sh (make_special_commands): Remove processing for + Gnus and AUCTeX. + +1997-07-19 SL Baur + + * update-elc.sh (mule_p): Do not attempt to bytecompile + char-table.el and chartblxmas.el. + 1997-07-08 Steven L Baur * update-elc.sh (cc-mode): Don't give cc-mode special treatment. diff -r 6866abce6aaf -r 6075d714658b lib-src/config.values --- a/lib-src/config.values Mon Aug 13 09:50:16 2007 +0200 +++ b/lib-src/config.values Mon Aug 13 09:51:16 2007 +0200 @@ -1,11 +1,11 @@ -CFLAGS "-m486 -O4 -fno-strength-reduce -malign-loops=2 -malign-jumps=2 -malign-functions=2 -fomit-frame-pointer -Wall" +CFLAGS "-m486 -Wall -O4 -fno-strength-reduce -malign-loops=2 -malign-jumps=2 -malign-functions=2 -fomit-frame-pointer" CPPFLAGS "" CXXFLAGS "" DEFS "-DHAVE_CONFIG_H" LDFLAGS "" LIBS "-ldb -lgdbm -lgpm -lncurses -lintl -lm " -exec_prefix "${prefix}" -prefix "/usr/local" +exec_prefix "/usr/src/junk2" +prefix "/usr/src/junk1" program_transform_name "s,x,x," bindir "${exec_prefix}/bin" sbindir "${exec_prefix}/sbin" @@ -43,7 +43,7 @@ INSTALL_ARCH_DEP_SUBDIR " lib-src pkg-src/tree-x" MAKE_SUBDIR " lib-src lwlib pkg-src/tree-x src" SUBDIR_MAKEFILES "lib-src/Makefile lwlib/Makefile pkg-src/tree-x/Makefile src/Makefile" -version "20.3-b14" +version "20.3-b15" configuration "i586-pc-linux" canonical "i586-pc-linux" srcdir "/b/XEmacs/xemacs-20.0" @@ -58,7 +58,7 @@ lockdir "${statedir}/xemacs/lock" lockdir_user_defined "no" archlibdir "${libdir}/xemacs-${version}/${configuration}" -archlibdir_user_defined "no" +archlibdir_user_defined "yes" docdir "" bitmapdir "" extra_objs "debug.o unexelf.o dgif_lib.o gif_err.o gifalloc.o menubar.o scrollbar.o dialog.o toolbar.o gui.o menubar-x.o scrollbar-x.o dialog-x.o toolbar-x.o gui-x.o mule.o mule-ccl.o mule-charset.o mule-coding.o mule-wnnfns.o mule-canna.o realpath.o inline.o console-tty.o device-tty.o event-tty.o frame-tty.o objects-tty.o redisplay-tty.o cm.o terminfo.o gpmevent.o event-unixoid.o database.o" @@ -84,13 +84,13 @@ INSTALL "$INSTALL" EMACS_MAJOR_VERSION 20 EMACS_MINOR_VERSION 3 -EMACS_BETA_VERSION 14 -XEMACS_CODENAME "Vienna" -EMACS_VERSION "20.3-b14" +EMACS_BETA_VERSION 15 +XEMACS_CODENAME "Berlin" +EMACS_VERSION "20.3-b15" DEBUG_XEMACS t USE_ASSERTIONS t MEMORY_USAGE_STATS t -CANONICAL_VERSION 20_3_b14_i586_pc_linux +CANONICAL_VERSION 20_3_b15_i586_pc_linux HAVE_SYS_TIMEB_H t HAVE_SYS_TIME_H t HAVE_UNISTD_H t @@ -219,7 +219,7 @@ HAVE_BERKELEY_DB t HAVE_DATABASE t EMACS_CONFIGURATION "i586-pc-linux" -EMACS_CONFIG_OPTIONS " '--cflags=-m486 -O4 -fno-strength-reduce -malign-loops=2 -malign-jumps=2 -malign-functions=2 -fomit-frame-pointer -Wall' --with-sound=no --error-checking=none --debug=yes --with-mule=yes --with-dialogs=athena3d --with-scrollbars=athena3d --use-union-type=yes --with-xim=no --mail-locking=file" +EMACS_CONFIG_OPTIONS " '--cflags=-m486 -Wall -O4 -fno-strength-reduce -malign-loops=2 -malign-jumps=2 -malign-functions=2 -fomit-frame-pointer' --with-sound=no --error-checking=none --debug=yes --with-mule=yes --with-dialogs=athena3d --with-scrollbars=athena3d --use-union-type=yes --with-xim=no --mail-locking=file --prefix=/usr/src/junk1 --exec-prefix=/usr/src/junk2" config_machfile "m/intel386.h" config_opsysfile "s/linux.h" LD_SWITCH_X_SITE "" diff -r 6866abce6aaf -r 6075d714658b lib-src/gzip-el.sh --- a/lib-src/gzip-el.sh Mon Aug 13 09:50:16 2007 +0200 +++ b/lib-src/gzip-el.sh Mon Aug 13 09:51:16 2007 +0200 @@ -1,7 +1,7 @@ #! /bin/sh ### gzip-el.sh --- compress superfluous installed source lisp -# Author: Jeff Miller +# Author: Jeff Miller # Author: Hrvoje Niksic # Maintainer: Steve Baur # Created: 13 Feb 1997 diff -r 6866abce6aaf -r 6075d714658b lib-src/update-autoloads.sh --- a/lib-src/update-autoloads.sh Mon Aug 13 09:50:16 2007 +0200 +++ b/lib-src/update-autoloads.sh Mon Aug 13 09:51:16 2007 +0200 @@ -70,15 +70,15 @@ echo Yes fi -if test "$mule_p" = nil ; then - make_special auctex autoloads -else - make_special auctex autoloads MULE_EL=tex-jp.elc -fi +## AUCTeX is a Package now +# if test "$mule_p" = nil ; then +# make_special auctex autoloads +# else +# make_special auctex autoloads MULE_EL=tex-jp.elc +# fi #make_special cc-mode autoloads make_special efs autoloads #make_special eos autoloads # EOS doesn't have custom or autoloads -#make_special gnus autoloads make_special hyperbole autoloads # make_special ilisp autoloads make_special oobr HYPB_ELC='' autoloads diff -r 6866abce6aaf -r 6075d714658b lib-src/update-elc.sh --- a/lib-src/update-elc.sh Mon Aug 13 09:50:16 2007 +0200 +++ b/lib-src/update-elc.sh Mon Aug 13 09:51:16 2007 +0200 @@ -69,14 +69,18 @@ # Compute patterns to ignore when searching for files ignore_dirs="" +ignore_pattern='' # Only use Mule XEmacs to compile Mule-specific elisp dirs echon "Checking for Mule support..." lisp_prog='(princ (featurep (quote mule)))' mule_p="`$EMACS -batch -no-site-file -eval \"$lisp_prog\"`" if test "$mule_p" = nil ; then - echo No - ignore_dirs="$ignore_dirs its egg mule language leim" + echo No + ignore_dirs="$ignore_dirs its egg mule language leim" + ignore_pattern='\!/tl/char-table.el$!d +\!/tl/chartblxmas.el$!d +' else echo Yes fi @@ -105,18 +109,16 @@ echo \"lisp/$dir done.\";" } -#make_special vm -#make_special ediff elc -#make_special viper elc -if test "$mule_p" = nil ; then - make_special auctex some -else - make_special auctex some MULE_ELC=tex-jp.elc -fi +## AUCTeX is a package now +# if test "$mule_p" = nil ; then +# make_special auctex some +# else +# make_special auctex some MULE_ELC=tex-jp.elc +# fi #make_special cc-mode all make_special efs x20 make_special eos -k # not strictly necessary... -make_special gnus some +## make_special gnus some # Now this is a package. make_special hyperbole elc # We're not ready for the following, yet. #make_special ilisp XEmacsELC=custom-load.elc elc @@ -124,7 +126,6 @@ make_special oobr HYPB_ELC='' elc make_special w3 xemacs-w3 -ignore_pattern='' for dir in $ignore_dirs ; do ignore_pattern="${ignore_pattern}/\\/$dir\\//d /\\/$dir\$/d @@ -139,7 +140,6 @@ \!/prim/loadup.el$!d \!/prim/loadup-el.el$!d \!/prim/update-elc.el$!d -\!/prim/packages.el$!d \!/prim/list-autoloads.el$!d \!/prim/dumped-lisp.el$!d \!/prim/make-docfile.el$!d diff -r 6866abce6aaf -r 6075d714658b lisp/ChangeLog --- a/lisp/ChangeLog Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/ChangeLog Mon Aug 13 09:51:16 2007 +0200 @@ -1,3 +1,167 @@ +Sat Jul 26 12:24:20 1997 Barry A. Warsaw + + * cc-mode/ Release 5.14 + +Sat Jul 26 16:03:33 1997 Barry A. Warsaw + + * cc-mode/cc-styles.el (c-styles-alist): + In "java" style, set c-hanging-comment-starter-p to + nil to preserve Javadoc starter lines. + +Fri Jul 25 22:17:07 1997 Barry A. Warsaw + + * cc-mode/cc-engine.el (c-beginning-of-statement-1): + When checking for bare semi, don't match + on a semi following a close brace, otherwise the following legal code + fails: + + void foo() + { + static struct Pattern nums + = {1, 2, 3}; + + int j = 2; + } + + This might break some bare semi idioms but those are probably more + rare than static initializers. + + * cc-mode/cc-vars.el (idl-mode-hook): New variable. + + * cc-mode/cc-mode.el (idl-mode): Support for CORBA's IDL language. + + * cc-mode/idl-font-lock.el: Unsupported font-lock definitions for IDL. + This should be merged in with font-lock.el + + * cc-mode/cc-mode.el (c-initialize-cc-mode): + move the calling of c-make-styles-buffer-local + into c-initialize-builtin-style. + + * cc-mode/cc-styles.el (c-set-style-2): + Fixed broken implementation of inherited styles. + + * cc-mode.texi: + Document c-initialization-hook. Also rewrite the "Getting Connected" + section on byte compiling the source. + + * cc-mode/cc-mode.el (c-initialize-cc-mode): + Run the c-initialization-hook, but only once + per Emacs session. + + * cc-mode/cc-vars.el (c-initialization-hook): New variable. + + * cc-mode/cc-engine.el (c-guess-basic-syntax): + CASE 5I: When adding 'inclass syntax, use the + relpos pointing to the class opening brace, unless that hangs on the + right side, in which case, use the start of the class/struct keyword. + +Thu Jul 17 03:36:22 1997 Barry A. Warsaw + + * cc-mode/cc-langs.el (c-symbol-key): + first character must be a letter or underscore + +1997-07-25 SL Baur + + * packages/vc.el (vc-version-diff): Autoload for the menu. + Suggested by Karl M. Hegbloom + +1997-07-24 SL Baur + + * prim/make-docfile.el (docfile-out-of-date): Workaround for NEWOS + process exit handling bug. + Suggested by Katsumi Yamaoka + +1997-07-23 Karl M. Hegbloom + + * packages/info.el: (Info-fontify-node) Allow colons in menu + names. There must be whitespace following the menu ending colon. + +1997-07-23 SL Baur + + * prim/faces.el (invert-face): Make interactive. + Suggested by David Bakhash + +1997-07-21 Karl M. Hegbloom + + * modes/view-process-system-specific.el added + `View-process-field-name-descriptions-linux', transcribed from + man 7 ps_fields. Linux signals fixed to match . + +1997-07-22 SL Baur + + * x11/x-toolbar.el (toolbar-paste-function): Add default as + option. + + * prim/minibuf.el (force-dialog-box-use): Fix typo. + From Pekka Marjola + +1997-07-21 SL Baur + + * prim/packages.el (locate-data-directory): New function to search + for directories in the data-directory-list. + +1997-07-21 Karl M. Hegbloom + + * prim/minibuf.el: New customize variable: + `minibuffer-history-uniquify' + (read-from-minibuffer) Only remove histval from list if + minibuffer-history-uniquify is t. + + * custom/custom.el: Fix typo in (defgroup) docstring. + +1997-07-21 SL Baur + + * prim/startup.el (set-default-load-path): Initialize package + paths as final step if everything else went O.K. + + * prim/help.el: Removed locate-library (moved to packages.el). + + * prim/subr.el: Removed lamda macro (moved to packages.el). + + * prim/packages.el (package-find-packages): New function. Search + package hierarchies for interesting directories. + (package-find-packages-1): Helper function for the above. Do the + searching in exactly 1 directory. + + * packages/vc.el: Add ClearCase maintainer. + +1997-07-21 Karl M. Hegbloom + + * modes/whitespace-mode.el (toplevel) Install toolbar button using + `toolbar-add-item' rather than redefining the whole default + toolbar. If the button is already there, does nothing, so a + custom toolbar containing a whitespace button can made with + `edit-toolbar' once it's been installed the first time. + +1997-07-20 SL Baur + + * utils/speedbar.el: + (speedbar-frame-mode): Autoload. + (speedbar-get-focus): Autoload. + (speedbar): Autoload (correctly). + + (speedbar-frame-width): Test liveness of frame + too. + (speedbar-frame-mode): Avoid some Emacs 20 code. + From Markus Linnala + + * prim/startup.el (find-emacs-root-internal): Search + prefix-directory directly for XEmacs installed stuffs. + + * utils/smtpmail.el (smtpmail-send-it): Autoload. + + * prim/startup.el (command-line): Put advisory text in *scratch* + at startup. + + * packages/info.el (Info-exit): Guard against deletion of only + frame. + From David Bakhash + +1997-07-19 SL Baur + + * utils/elp.el: Spelling correction. + From karlheg+xemacs@inetarena.com (Karl M. Hegbloom) + 1997-07-19 Steven L Baur * prim/about.el: Sundry changes. diff -r 6866abce6aaf -r 6075d714658b lisp/apel/ChangeLog --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/apel/ChangeLog Mon Aug 13 09:51:16 2007 +0200 @@ -0,0 +1,166 @@ +1997-07-14 MORIOKA Tomohiko + + * emu: Version 7.44 was released. + * APEL: Version 3.4 was released. + +1997-07-13 MORIOKA Tomohiko + + * std11-parse.el (std11-parse-ascii-token): Allow non-ASCII + characters in comments. + +1997-06-28 MORIOKA Tomohiko + + * file-detect.el: Add autoload comments for function `add-path', + `add-latest-path', `get-latest-path', `file-installed-p', + `exec-installed-p', `module-installed-p' and variable + `exec-suffix-list'. + +Sat May 10 19:39:12 1997 MORIOKA Tomohiko + + * README.en (What's APEL?): Add std11 and mule-caesar.el. + + +1997-05-09 MORIOKA Tomohiko + + * emu: Version 7.43.1 was released. + * APEL: Version 3.3.2 was released. + +Fri May 9 01:23:44 1997 MORIOKA Tomohiko + + * APEL-ELS: Add mule-caesar.el. + + * mule-caesar.el: New file. + + +1997-04-30 MORIOKA Tomohiko + + * emu: Version 7.43 was released. + * APEL: Version 3.3.1 was released. + +Wed Apr 30 12:40:32 1997 MORIOKA Tomohiko + + * Makefile: add `release'. + +Mon Apr 28 16:47:30 1997 MORIOKA Tomohiko + + * Makefile: `TARFILE' was abolished. + +Thu Apr 3 17:14:39 1997 MORIOKA Tomohiko + + * APEL-ELS: std11.el and std11-parse.el were moved from mu/. + + +1997-03-20 MORIOKA Tomohiko + + * APEL: Version 3.3 was released. + + * APEL-CFG (EMU_PREFIX, EMU_DIR): New variables. + * APEL-MK: install emu. + +Thu Mar 20 06:09:03 1997 MORIOKA Tomohiko + + * Makefile: Add README.en. + +Thu Mar 20 06:08:29 1997 MORIOKA Tomohiko + + * file-detect.el: Header and DOC-strings were modified. + +Thu Mar 20 06:03:51 1997 MORIOKA Tomohiko + + * README.en: New file. + +Thu Mar 20 05:48:02 1997 MORIOKA Tomohiko + + * filename.el: Add DOC-strings. + + * APEL-MK (install-apel): Use `compile-apel'. + + * Makefile (install): Don't depend on `elc'. + +Thu Mar 20 02:04:19 1997 MORIOKA Tomohiko + + * APEL-MK: Setting for load-path and requiring install were moved + from APEL-CFG. + + (install-apel): Compile apel-modules. + + * APEL-CFG: Setting for load-path and requiring install were moved + to APEL-MK. + + +1997-03-14 MORIOKA Tomohiko + + * APEL: Version 3.2 was released. + +Fri Mar 14 09:54:04 1997 MORIOKA Tomohiko + + * file-detect.el (get-latest-path): Check directory is exist or not. + +Fri Mar 14 09:25:15 1997 MORIOKA Tomohiko + + * APEL-ELS: Add install.el. + +Fri Mar 14 07:24:37 1997 MORIOKA Tomohiko + + * Makefile, APEL-MK, APEL-CFG: New file. + +1997-03-10 MORIOKA Tomohiko + + * atype.el (field-unify): fixed. + +1997-03-10 MORIOKA Tomohiko + + * filename.el (filename-filters): Use `exec-installed-p' instead + of `file-installed-p' to search "kakasi". + +1997-03-10 MORIOKA Tomohiko + + * file-detect.el (module-installed-p): Use function + `exec-installed-p'. + + * file-detect.el (exec-suffix-list): New variable. + (exec-installed-p): New function. + +1997-03-04 MORIOKA Tomohiko + + * APEL-ELS (apel-modules): Add filename.el. + + * APEL-ELS: Initial revision + +1997-03-04 MORIOKA Tomohiko + + * filename.el (filename-replacement-alist): Don't use function + `string-to-char-list' and `expand-char-ranges'; Don't require + tl-str. + (filename-special-filter): Use function `assoc-if' instead of + `ASSOC'; Require cl instead of tl-list. + (poly-funcall): New inline-function; copied from tl-list.el. + +1997-03-03 MORIOKA Tomohiko + + * atype.el: Alias `fetch-field', `fetch-field-value', `put-field' + and `delete-field' were abolished. + + Don't require tl-str and tl-list. + + Require alist. + + (field-unify): Don't use function `symbol-concat'. + (assoc-unify): Use function `assoc' directly; use function + `put-alist' directly; use function `del-alist' directly. + + * atype.el: Function `put-fields' was abolished. + + * atype.el: tl-atype.el was renamed to atype.el. + +1997-03-03 MORIOKA Tomohiko + + * atype.el: tl-atype.el was renamed to atype.el. + +1997-03-03 MORIOKA Tomohiko + + * file-detect.el (file-installed-p): Fixed DOC-string. + +1997-02-28 Tomohiko Morioka + + * alist.el: New module; separated from tl-list.el. diff -r 6866abce6aaf -r 6075d714658b lisp/apel/ChangeLog.emu --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/apel/ChangeLog.emu Mon Aug 13 09:51:16 2007 +0200 @@ -0,0 +1,346 @@ +1997-07-14 MORIOKA Tomohiko + + * emu: Version 7.44 was released. + +1997-07-13 MORIOKA Tomohiko + + * emu-e20.el (mime-charset-coding-system-alist): `iso-2022-ss2-7' + -> `iso-2022-7bit-ss2'. (for Emacs 20.0.90) + +1997-06-28 MORIOKA Tomohiko + + * richtext.el: Add autoload comments for `richtext-encode' and + `richtext-decode'. + + * emu.el: Check richtext.el is bundled. + +1997-06-08 MORIOKA Tomohiko + + * emu-x20.el (mime-charset-coding-system-alist): iso-8859-1, + hz-gb-2312, cn-gb-2312, gb2312, cn-big5 and koi8-r were defined as + coding-system. + + * emu-x20.el: Don't require cyrillic. + +Thu May 22 04:46:57 1997 MORIOKA Tomohiko + + * emu-mule.el (make-char): New alias. + + * emu-e20.el: Alias `make-character' was abolished. + + +1997-05-09 MORIOKA Tomohiko + + * emu: Version 7.43.1 was released. + +Thu May 8 22:21:36 1997 MORIOKA Tomohiko + + * emu-x20.el: Use `binary' instead of `no-conversion' temporary. + + +1997-04-30 MORIOKA Tomohiko + + * emu: Version 7.43 was released. + + * emu-x20.el: several changes for XEmacs 20.1-b12. + +Tue Apr 8 09:47:40 1997 MORIOKA Tomohiko + + * emu.el (point-at-eol): New function. + +Sat Apr 5 16:23:23 1997 MORIOKA Tomohiko + + * emu-nemacs.el: `tl:available-face-attribute-alist' -> + `emu:available-face-attribute-alist'. + + * emu-nemacs.el, emu-mule.el: `tl:make-overlay' -> `make-overlay'; + `tl:overlay-put' -> `overlay-put'. + +Sat Apr 5 06:50:48 1997 MORIOKA Tomohiko + + * emu-xemacs.el: Alias `tl:make-overlay', `tl:overlay-put' and + `tl:overlay-buffer' were abolished; Function `tl:move-overlay' + were abolished. + + * emu-19.el: Alias `tl:make-overlay', `tl:overlay-put' and + `tl:overlay-buffer' were abolished. + + * emu-18.el: `tl:overlay-buffer' -> `overlay-buffer'. + + * emu-xemacs.el: Require overlay. + + * emu.el (char-or-char-int-p): New XEmacs 20 emulating alias. + + * emu.el (minibuffer-prompt-width): New function for Emacs 18 and + XEmacs. + + +1997-03-14 MORIOKA Tomohiko + + * emu: Version 7.40.1 was released. + +Fri Mar 14 07:19:59 1997 MORIOKA Tomohiko + + * Makefile, EMU-MK: New file. + + * EMU-ELS: rearrangement. + + * EMU-CFG: New file + +Wed Mar 12 14:18:27 1997 MORIOKA Tomohiko + + * emu-x20.el: Modified for changing XEmacs/mule API about + `file-coding-system' -> `buffer-file-coding-system'. + + +1997-03-10 MORIOKA Tomohiko + + * emu: Version 7.40 was released. + + * emu-x20.el (as-binary-process, as-binary-output-file): Use + `coding-system-for-write' instead of `file-coding-system'. + + (as-binary-input-file, insert-binary-file-contents-literally): Use + `coding-system-for-read' instead of `file-coding-system-for-read'. + + * emu-e20.el (mime-charset-coding-system-alist): Delete + `iso-2022-int-1' and `shift_jis'. + +1997-03-06 MORIOKA Tomohiko + + * emu.el (defmacro-maybe): New macro. + (save-selected-window): Use `defmacro-maybe'. + + * emu-18.el (defsubst): New macro. + +1997-03-06 MORIOKA Tomohiko + + * emu-x20.el: Constant `*ctext*', `*hz*', `*big5', `*euc-kr*' and + `*koi8*' were abolished. + +1997-03-06 MORIOKA Tomohiko + + * emu-19.el: Alias `tl:add-text-properties' was abolished. + + * emu-18.el, emu-xemacs.el: Function `tl:add-text-properties' was + abolished. + +1997-03-06 MORIOKA Tomohiko + + * emu.el (buffer-substring-no-properties): Use + `set-text-properties' instead of `tl:set-text-properties'. + + * emu-19.el: Alias `tl:set-text-properties' was abolished. + + * emu-18.el, emu-xemacs.el: Function `tl:set-text-properties' was + abolished. + +1997-03-04 MORIOKA Tomohiko + + * emu-19.el (find-face): New function. + + +1997-03-03 MORIOKA Tomohiko + + * emu: Version 7.38.1 was released. + +1997-03-03 Oscar Figueiredo + + * emu-xemacs.el (tl:add-text-properties): In tm-ew-d.el, the + function mime/decode-encoded-word calls tl:add-text-properties + with 4 parameters while it is defined in emu-xemacs.el to take 3 + parameters only. (cf. [bug-tm-en:1246]) + + +1997-02-13 MORIOKA Tomohiko + + * emu: Version 7.38 was released. + + * emu.el: Function `insert-binary-file-contents-literally' was + moved to emu-{nemacs|e19|mule|x20|e20}.el. + + * emu-x20.el, emu-e20.el, emu-mule.el, emu-e19.el, emu-nemacs.el + (insert-binary-file-contents-literally): New function; moved from + emu.el. + + +1997-02-12 MORIOKA Tomohiko + + * emu: Version 7.37.7 was released. + +1997-02-12 MORIOKA Tomohiko + + * emu-x20.el: Variable `xemacs-beta-version' was abolished. + +1997-02-12 MORIOKA Tomohiko + + * emu-x20.el (as-binary-process): Variable `file-coding-system' is + effective for `call-process-region'. + + +1997-01-31 MORIOKA Tomohiko + + * emu: Version 7.37.6 was released. + +Thu Jan 30 16:55:00 1997 MORIOKA Tomohiko + + * richtext.el (richtext-decode): Variable + `enriched-fill-after-visiting' is not found in enriched.el bundled + in Emacs 19.34.91-delta. + + +1997-01-30 MORIOKA Tomohiko + + * emu: Version 7.37.5 was released. + +Wed Jan 29 15:48:26 1997 MORIOKA Tomohiko + + * emu-x20.el, emu-e20.el, emu-e19.el, emu-mule.el, emu-nemacs.el + (as-binary-output-file): New macro. + +Mon Jan 27 12:11:32 1997 MORIOKA Tomohiko + + * emu-e20.el (mime-charset-coding-system-alist): Modified for GNU + MULE 19.34.91-delta. + (mime-charset-to-coding-system): Modified for GNU MULE + 19.34.91-delta. + + +1997-01-21 MORIOKA Tomohiko + + * emu: Version 7.37.4 was released. + +Sat Jan 18 09:44:43 1997 MORIOKA Tomohiko + + * emu-x20.el (charsets-mime-charset-alist): Sync with emu-e20.el + 7.9. + (default-mime-charset): Default was changed to `x-ctext'. + (mime-charset-coding-system-alist): Add `x-ctext', `hz-gb-2312', + `cn-gb-2312' and `cn-big5'; `x-iso-2022-jp-2' and `x-shiftjis' was + abolished. + +Sat Jan 18 09:35:35 1997 MORIOKA Tomohiko + + * emu-e20.el: Function `regulate-latin-char' and + `regulate-latin-string' were abolished. + + * emu-e20.el (sset): Function `string-embed-string' was renamed to + `store-substring'. + +Wed Jan 15 18:01:13 1997 MORIOKA Tomohiko + + * emu-e20.el (fontset-pixel-size): modified for GNU MULE 19.34.91. + +Wed Jan 15 16:42:47 1997 MORIOKA Tomohiko + + * emu-e20.el: Alias `charset-columns' was abolished. + Function `charset-iso-class' was abolished. + + * emu-e20.el: for GNU MULE 19.34.91. + +Tue Jan 14 06:35:53 1997 MORIOKA Tomohiko + + * emu-x20.el: Alias `charset-description', `find-charset-string', + `find-charset-region', `char-width', `string-width' and `sref' has + been defined in XEmacs/mule. + + Function `find-non-ascii-charset-string', + `find-non-ascii-charset-region', `char-bytes', `char-length', + `char-columns', `string-columns' and `truncate-string' has been + defined in XEmacs/mule. + + +Mon Dec 23 14:56:40 1996 MORIOKA Tomohiko + + * emu: Version 7.37.3 was released. + +Wed Dec 18 13:12:15 1996 MORIOKA Tomohiko + + * emu-e20.el (as-binary-process): Fixed. + + +Mon Dec 16 14:57:02 1996 MORIOKA Tomohiko + + * emu: Version 7.37.2 was released. + +Thu Dec 12 02:29:18 1996 MORIOKA Tomohiko + + * emu-e20.el: Header was modified. + + +Tue Dec 10 14:41:46 1996 MORIOKA Tomohiko + + * emu: Version 7.37.1 was released. + + * emu-e19.el: `charset-latin-1' -> `charset-latin-iso8859-1'. + + * emu-e19.el: Constants to emulate MULE 2.3 leading-char were + abolished. + (find-charset-string, find-charset-region): Use constant + `charset-latin-1' instead of `lc-ltn1'. + +Sat Dec 7 06:07:15 1996 MORIOKA Tomohiko + + * emu-x20.el: Constants to emulate MULE 2.3 leading-char were + abolished. + + * emu-x20.el: Sync with patch about charset naming rule + (cf. [xemacs-beta:91]) + +Thu Dec 5 15:15:39 1996 MORIOKA Tomohiko + + * emu-x20.el: Sync with XEmacs 20.0 b30. + + +Wed Dec 4 04:55:36 1996 MORIOKA Tomohiko + + * emu: Version 7.37 was released. + +Fri Nov 29 21:22:25 1996 Shuhei KOBAYASHI + + * emu.el (match-string): New function for Emacs 19.28 or earlier. + +Thu Nov 28 19:25:12 1996 MORIOKA Tomohiko + + * richtext.el (richtext-decode): Unused local variable `nc' was + abolished. + + * richtext.el (richtext-decode): Unused local variable `pc' was + abolished. + +Thu Nov 28 19:16:18 1996 MORIOKA Tomohiko + + * emu.el (defun-maybe): New macro. + (buffer-substring-no-properties, add-to-list, buffer-live-p, + functionp): Use macro `defun-maybe' instead of `sysdep-defun'. + + * emu-xemacs.el: Don't use sysdep.el. + + * emu-18.el, emu-19.el: Function `sysdep-defun' was abolished. + +Thu Nov 28 18:02:42 1996 MORIOKA Tomohiko + + * emu.el (buffer-substring-no-properties, add-to-list, + buffer-live-p, functionp): Use `sysdep-defun'. + +Thu Nov 28 17:59:45 1996 MORIOKA Tomohiko + + * emu-xemacs.el: Use sysdep.el. + + * emu-19.el, emu-18.el (sysdep-defun): New macro. + +Wed Nov 27 13:40:42 1996 MORIOKA Tomohiko + + * emu-e20.el (fontset-pixel-size): Renamed from + `fontset-pixel-height'. + + +Sat Nov 16 08:37:04 1996 MORIOKA Tomohiko + + * emu: Version 7.34 was released. + +Fri Nov 15 13:59:53 1996 MORIOKA Tomohiko + + * emu-xemacs.el: Redefine `file-relative-name' if it is broken. + + * EMU-ELS: New file. diff -r 6866abce6aaf -r 6075d714658b lisp/apel/std11-parse.el --- a/lisp/apel/std11-parse.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/apel/std11-parse.el Mon Aug 13 09:51:16 2007 +0200 @@ -5,7 +5,7 @@ ;; Author: MORIOKA Tomohiko ;; Keywords: mail, news, RFC 822, STD 11 ;; Version: -;; $Id: std11-parse.el,v 1.1 1997/06/03 04:18:36 steve Exp $ +;; $Id: std11-parse.el,v 1.2 1997/07/26 22:09:37 steve Exp $ ;; This file is part of MU (Message Utilities). @@ -162,12 +162,12 @@ (let (token itl parsed token-value) (while (and lal (setq token (car lal)) - (if (and (setq token-value (cdr token)) - (find-non-ascii-charset-string token-value) - ) - (setq token nil) - (std11-ignored-token-p token) - )) + (or (std11-ignored-token-p token) + (if (and (setq token-value (cdr token)) + (find-non-ascii-charset-string token-value) + ) + (setq token nil) + ))) (setq lal (cdr lal)) (setq itl (cons token itl)) ) diff -r 6866abce6aaf -r 6075d714658b lisp/apel/tinyrich.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/apel/tinyrich.el Mon Aug 13 09:51:16 2007 +0200 @@ -0,0 +1,166 @@ +;;; +;;; $Id: tinyrich.el,v 1.2 1997/07/26 22:09:38 steve Exp $ +;;; +;;; by MORIOKA Tomohiko +;;; modified by YAMATE Keiichirou +;;; + +(defvar mime-viewer/face-list-for-text/enriched + (cond ((and (>= emacs-major-version 19) window-system) + '(bold italic fixed underline) + ) + ((and (boundp 'NEMACS) NEMACS) + '("bold" "italic" "underline") + ))) + +(defun enriched-decode (beg end) + (interactive "*r") + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char beg) + (while (re-search-forward "[ \t]*\\(\n+\\)[ \t]*" nil t) + (let ((str (buffer-substring (match-beginning 1) + (match-end 1)))) + (if (string= str "\n") + (replace-match " ") + (replace-match (substring str 1)) + ))) + (goto-char beg) + (let (cmd sym str (fb (point)) fe b e) + (while (re-search-forward "<\\(<\\|[^<>\n\r \t]+>\\)" nil t) + (setq b (match-beginning 0)) + (setq cmd (buffer-substring b (match-end 0))) + (if (string= cmd "<<") + (replace-match "<") + (replace-match "") + (setq cmd (downcase (substring cmd 1 (- (length cmd) 1)))) + ) + (setq sym (intern cmd)) + (cond ((eq sym 'param) + (setq b (point)) + (save-excursion + (save-restriction + (if (search-forward "" nil t) + (progn + (replace-match "") + (setq e (point)) + ) + (setq e end) + ))) + (delete-region b e) + ) + ((memq sym mime-viewer/face-list-for-text/enriched) + (setq b (point)) + (save-excursion + (save-restriction + (if (re-search-forward (concat "") nil t) + (progn + (replace-match "") + (setq e (point)) + ) + (setq e end) + ))) + (tm:set-face-region b e sym) + ))) + (goto-char (point-max)) + (if (not (eq (preceding-char) ?\n)) + (insert "\n") + ) + )))) + + +;;; @ text/richtext <-> text/enriched converter +;;; + +(defun richtext-to-enriched-region (beg end) + "Convert the region of text/richtext style to text/enriched style." + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (let (b e i) + (while (re-search-forward "[ \t]*" nil t) + (setq b (match-beginning 0)) + (delete-region b + (if (re-search-forward "[ \t]*" nil t) + (match-end 0) + (point-max) + )) + ) + (goto-char (point-min)) + (while (re-search-forward "\n\n+" nil t) + (replace-match "\n") + ) + (goto-char (point-min)) + (while (re-search-forward "[ \t\n]*[ \t\n]*" nil t) + (setq b (match-beginning 0)) + (setq e (match-end 0)) + (setq i 1) + (while (looking-at "[ \t\n]*[ \t\n]*") + (setq e (match-end 0)) + (setq i (1+ i)) + (goto-char e) + ) + (delete-region b e) + (while (>= i 0) + (insert "\n") + (setq i (1- i)) + )) + (goto-char (point-min)) + (while (search-forward "" nil t) + (replace-match "<<") + ) + )))) + +(defun enriched-to-richtext-region (beg end) + "Convert the region of text/enriched style to text/richtext style." + (save-excursion + (save-restriction + (goto-char beg) + (and (search-forward "text/enriched") + (replace-match "text/richtext")) + (search-forward "\n\n") + (narrow-to-region (match-end 0) end) + (let (str n) + (goto-char (point-min)) + (while (re-search-forward "\n\n+" nil t) + (setq str (buffer-substring (match-beginning 0) + (match-end 0))) + (setq n (1- (length str))) + (setq str "") + (while (> n 0) + (setq str (concat str "\n")) + (setq n (1- n)) + ) + (replace-match str) + ) + (goto-char (point-min)) + (while (search-forward "<<" nil t) + (replace-match "") + ) + )))) + + +;;; @ encoder and decoder +;;; + +(defun richtext-decode (beg end) + (save-restriction + (narrow-to-region beg end) + (richtext-to-enriched-region beg (point-max)) + (enriched-decode beg (point-max)) + )) + +;; (defun richtext-encode (beg end) +;; (save-restriction +;; (narrow-to-region beg end) +;; (enriched-encode beg (point-max)) +;; (enriched-to-richtext-region beg (point-max)) +;; )) + + +;;; @ end +;;; + +(provide 'tinyrich) diff -r 6866abce6aaf -r 6075d714658b lisp/auctex/CHANGES --- a/lisp/auctex/CHANGES Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,5 +0,0 @@ -News in 9.7 -=========== - - * Added minimal support for `sentence-end-double-space'. - diff -r 6866abce6aaf -r 6075d714658b lisp/auctex/ChangeLog --- a/lisp/auctex/ChangeLog Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,998 +0,0 @@ -1997-07-02 Steven L Baur - - * Makefile (autoloads): New targets to automatically rebuild - autoloads and custom-loads. - -1997-06-27 Steven L Baur - - * Makefile (CONTRIBELC): Remove hardcoded dependency on - tex-jp.el -- only bytecompile if running XEmacs/Mule. - - Add byte-compilation of custom-load.el. - -Sat Apr 5 09:40:23 1997 Steven L Baur - - * Makefile (STYLESRC): Move style/*.el files to etc/auctex/style. - - * tex.el (TeX-lisp-directory): Restore previous setting. - -Thu Apr 17 14:25:44 1997 Per Abrahamsen - - * Version 9.7p released. - -Sat Apr 12 22:38:15 1997 Per Abrahamsen - - * tex.el: Added customize information. - * tex-buf.el: Ditto. - -Sun Apr 06 19:28:11 1997 Per Abrahamsen - - * Version 9.7o released. - -Sun Apr 6 19:23:37 1997 Per Abrahamsen - - * latex.el (LaTeX-equation-label): New variable. - (LaTeX-eqnarray-label): New variable. - (LaTeX-label): Support `figure*', `label*', `equation', and - `eqnarray'. - (LaTeX-env-figure): Support `table*'. - Patch by Joes Staal . - -Fri Mar 28 12:23:15 1997 Per Abrahamsen - - * latex.el (LaTeX-down-section): Doc fix. - (LaTeX-section-heading): Ditto. - (LaTeX-section-title): Ditto. - (LaTeX-env-array): Ditto. - (TeX-braces-user-association): Ditto. - (LaTeX-fill-region-as-paragraph): Ditto. - (LaTeX-math-abbrev-prefix): Ditto. - (LaTeX-math-mode): Ditto. - (TeX-arg-right-insert-p): Ditto. - (latex-mode): Ditto. - -Wed Mar 26 21:14:44 1997 Per Abrahamsen - - * Version 9.7n released. - -Wed Mar 26 21:12:53 1997 Per Abrahamsen - - * latex.el (LaTeX-math-default): Fixed hebrew delimiters. - Patch by John Griffith . - -Wed Mar 26 21:09:50 1997 Per Abrahamsen - - * latex.el (LaTeX-209-to-2e): Use `buffer-substring-no-properties'. - Reported by Graham Gough . - -Mon Mar 17 13:35:46 1997 Per Abrahamsen - - * Version 9.7m released. - -Mon Mar 17 13:25:45 1997 Per Abrahamsen - - * tex.el (TeX-auto-generate): Only generate when needed. - (TeX-auto-generate-global): Ditto. - Patch by Helmut Geyer . - - * Makefile (install-contrib): Don't move elc files twice. Patch - by Helmut Geyer . - -Thu Mar 13 12:10:03 1997 Per Abrahamsen - - * style/danish.el: Copied from `style/dk.el'. - * Makefile (STYLESRC): Added `style/danish.el'. - Suggested by Lars Frellesen . - -Tue Mar 04 11:29:23 1997 Per Abrahamsen - - * Version 9.7l released. - -Tue Mar 4 11:27:43 1997 Per Abrahamsen - - * Makefile (some): Don't use `style/*.elc'. - -Thu Feb 27 11:02:24 1997 Per Abrahamsen - - * tex.el (TeX-electric-macro): Default to space after dot. - -Wed Feb 26 23:15:27 1997 Per Abrahamsen - - * Version 9.7k released. - -Wed Feb 26 23:14:43 1997 Per Abrahamsen - - * tex.el (TeX-submit-bug-report): Fix address (sunsite, not iesd!). - -Tue Feb 25 17:36:11 1997 Per Abrahamsen - - * Version 9.7j released. - -Fri Feb 21 09:29:20 1997 Per Abrahamsen - - * Makefile (some): New target. - Suggested by Steven L Baur . - -Thu Feb 20 11:30:50 1997 Per Abrahamsen - - * Version 9.7i released. - -Thu Feb 20 10:59:38 1997 Per Abrahamsen - - * tex.el: Removed autoloads that conflicts with `tex-mode.el'. - (TeX-lisp-directory): Default to data-directory. - -Thu Feb 20 11:30:50 1997 Per Abrahamsen - - * Version 9.7i released. - -Thu Feb 20 10:59:38 1997 Per Abrahamsen - - * tex.el: Removed autoloads that conflicts with `tex-mode.el'. - (TeX-lisp-directory): Default to data-directory. - -Sat Feb 15 18:00:48 1997 Per Abrahamsen - - * Version 9.7h released. - -Sat Feb 15 13:39:30 1997 Per Abrahamsen - - * tex-buf.el (TeX-lisp-directory): Removed. - -Fri Feb 07 14:58:29 1997 Per Abrahamsen - - * Version 9.7g released. - -Thu Feb 6 11:01:35 1997 Karl Eichwalder - - * Makefile (install-lisp): Don't install $(aucdir)/lpath.el and - $(aucdir)/tex-site.el. - (contrib, install-contrib): New targets. - -Thu Jan 30 06:59:57 1997 Per Abrahamsen - - * latex.el (LaTeX-math-default): uparow -> uparrow. Reported by - Kyeong Soo Kim . - -Wed Jan 29 04:57:42 1997 Per Abrahamsen - - * Makefile (AUCSRC): Removed `ltx-help.el'. - -Mon Jan 27 00:52:51 1997 Per Abrahamsen - - * Version 9.7f released. - -Mon Jan 27 00:40:35 1997 Per Abrahamsen - - * latex.el (LaTeX-label-function): New variable. - (LaTeX-label): New function. - (LaTeX-section-label): Use it. - (LaTeX-env-figure): Ditto. - (LaTeX-env-label): Ditto. - Patch supplied by Carsten Dominik for - better RevTeX.el support. - - * latex.el (LaTeX-env-figure): Don't insert \leavevmode, at the - request of David Carlisle . - -Mon Jan 20 18:41:23 1997 Per Abrahamsen - - * Version 9.7e released. - -Mon Jan 20 18:38:58 1997 Per Abrahamsen - - * tex-buf.el (TeX-parse-error): Support LaTeX warnings. Patch by - Frederic Devernay . - (TeX-warning): Ditto. - -Fri Jan 17 17:42:20 1997 Per Abrahamsen - - * Version 9.7d released. - -Fri Jan 17 17:40:39 1997 Per Abrahamsen - - * tex-jp.el: XEmacs 20 support by Soren Dayton - . - -Mon Jan 13 00:52:26 1997 Per Abrahamsen - - * Makefile (CP): Use `cp -p'. Suggested by Graham Gough - . - - * Version 9.7c released. - -Wed Jan 8 15:00:06 1997 Per Abrahamsen - - * doc/intro.texi: Spelling fixes by Franklin Chen . - - * tex-buf.el (TeX-shell-command-option): Insitialize from - shell-command-switch. Suggested by Fabio@Colorado.EDU (Fabio - Somenzi). - - * latex.el (LaTeX-mode-menu): Added sans serif. Patch by Ralf - Fassel . - -Fri Jan 3 13:49:44 1997 Per Abrahamsen - - * Makefile (install-lisp): Also install `.el' files. Requested by - several people. - -Wed Dec 11 07:32:47 1996 Per Abrahamsen - - * Makefile (tex.elc): New entry. - (install-lisp): Use it. Trevor Jim - reported that `make install' wouldn't make the elc files. - -Tue Dec 10 16:48:59 1996 Per Abrahamsen - - * Version 9.7b released. - -Tue Dec 10 07:49:54 1996 Per Abrahamsen - - * tex-buf.el (TeX-run-format): Bind `buffer' before `process' to - avoid side effect. Suggested by Frederic Devernay - . - - * Version 9.7a released. - -Tue Dec 10 07:49:56 1996 Per Abrahamsen - - * latex.el (LaTeX-fill-region-as-para-do): Minimal support for - `sentence-end-double-space'. - -Mon Dec 09 14:58:18 1996 Per Abrahamsen - - * Version 9.6m released. - -Sun Dec 01 17:33:49 1996 Per Abrahamsen - - * Version 9.6l released. - -Sun Dec 1 17:31:48 1996 Per Abrahamsen - - * tex-jp.el: Patch from IKEMOTO Masahiro - . - -Fri Nov 29 18:50:26 1996 Per Abrahamsen - - * Version 9.6k released. - -Fri Nov 22 14:40:05 1996 Per Abrahamsen - - * latex.el (LaTeX-mode-menu): Made `LaTeX-math-mode' a toggle. - -Sat Nov 16 19:24:39 1996 Per Abrahamsen - - * Version 9.6j released. - -Thu Nov 14 15:42:38 1996 Per Abrahamsen - - * latex.el (LaTeX-common-initialization): Added eqref to - LaTeX-label-list. Suggested by Martin Hagstrom - . - -Wed Nov 13 16:15:36 1996 Per Abrahamsen - - * tex-buf.el (TeX-region-create): Disable font lock. Suggested by - several, patch by Christoph Wedler . - -Tue Nov 5 20:21:07 1996 Per Abrahamsen - - * tex.el (TeX-file-extensions): Added "texinfo". - -Mon Sep 30 18:45:42 1996 Per Abrahamsen - - * latex.el (LaTeX-mode-map): Do not overwrite standard binding of - `M-g'. - - * tex.el (popup-mode-menu): Run `LaTeX-menu-update' if present. - Workaround for bug reported by Hendrik Visage - and othors. - - * latex.el (LaTeX-float): Allow nil. - (LaTeX-env-figure): Don't insert float if nil. Feature suggested - by Andre Eickler . - -Mon Sep 16 17:17:59 1996 Per Abrahamsen - - * Version 9.6i released. - -Mon Sep 16 17:15:02 1996 Per Abrahamsen - - * tex.el (TeX-mode-syntax-table): Made `$' have the syntax class - `$' at the suggestion of Mats Bengtsson . - -Sat Aug 31 16:03:52 1996 Per Abrahamsen - - * latex.el (TeX-arg-cite): Use `multi-prompt' when asking for - entries. - (TeX-arg-bibliography): Ditto. - -Thu Aug 29 22:22:14 1996 Per Abrahamsen - - * Makefile: Simplified installation (I hope). - -Wed Aug 28 00:22:11 1996 Per Abrahamsen - - * Makefile: Removed lacheck. - -Fri Aug 23 10:23:45 1996 Per Abrahamsen - - * tex-buf.el (TeX-run-command): Change to master directory before - executing command. - (TeX-region-file): Allow dummy second argument. - (TeX-run-background): Run in master directory. - (TeX-run-interactive): Run in master directory. - - * tex.el (TeX-master-file): Allow second argument `NONDIRECTOPRY'. - (TeX-expand-list): Set second argument `NONDIRECTORY' to file - entries. - (TeX-master-directory): New function. - * tex.el (TeX-auto-write): Write in master directory. - -Thu Aug 22 22:33:45 1996 Per Abrahamsen - - * latex.el (LaTeX-current-environment): Ignore comments. Reported - by Stephen Eglen . - - * tex.el (TeX-directory-absolute-p): Added `windows-nt'. - - * tex-buf.el (TeX-shell): Added `windows-nt'. - (TeX-shell-command-option): Added `emx' and `windows-nt'. - Reported by Ulrich Poetter . - -Wed Aug 21 13:57:43 1996 Per Abrahamsen - - * tex.el (VirTeX-common-initialization): Removed duplicate - initialization of `words-include-escapes'. Reperted by Mark Hovey - . - -Wed Aug 14 19:43:31 1996 Per Abrahamsen - - * Makefile (CONTRIB): Added `font-latex.el'. - -Tue Jul 30 12:19:01 1996 Per Abrahamsen - - * Makefile (aucdir): Changed `lib' to `share' per new emacs - conventions. Reported by "Edward J. Huff" - . - -Tue Jul 16 20:18:59 1996 Per Abrahamsen - - * latex.el (LaTeX-fill-region-as-para-do): Make sure `.}' gets - two spaces at end of sentence when filling. - -Mon Jul 15 12:13:36 1996 Per Abrahamsen - - * tex.el (TeX-parse-path): Ignore tralining //. Suggested by - Göran Uddeborg . - -Sun May 5 11:06:37 1996 Per Abrahamsen - - * all: Use version number instead of CVS id. - - * tex.el (TeX-mode-map): Don't bind `del'. We aren't supposed to - have any tabs in the first place. - -Thu May 2 01:28:52 1996 Per Abrahamsen - - * tex.el (TeX-mark-active, TeX-active-mark) [XEmacs]: The - definition of these two were swapped. Bug reported by - Vladimir Alexiev . - -Thu Apr 25 11:20:03 1996 Per Abrahamsen - - * tex.el (TeX-update-style): Don't run parent style hooks for - files that doesn't match `TeX-one-master'. Suggested by many - people. - -Wed Apr 24 14:44:13 1996 Per Abrahamsen - - * latex.el (LaTeX-close-environment): Bind - `next-line-add-newlines' to t. Patch by Fritz Knabe - . - -Mon Apr 1 16:36:04 1996 Per Abrahamsen - - * latex.el (LaTeX-fill-region-as-para-do): Fill `.}' as a sentence - end. Patch by Fritz Knabe . - -Mon Mar 11 22:56:30 1996 Per Abrahamsen - - * latex.el (LaTeX-math-cal): Use `\mathcal{}' under LaTeX2e. - Reported by Mate Wierdl . - -Tue Mar 5 17:27:39 1996 Per Abrahamsen - - * tex-info.el (texinfo-mode): Rely on texinfo.el to provide the - outline regexp. - -Tue Feb 20 09:43:29 1996 Per Abrahamsen - - * tex.el (TeX-command-menu-queue, TeX-command-menu-queue-entry): - New functions supporting printer queue queries from the menu. By - Ulrik Dickow - (TeX-command-menu-entry): Use them. - -Tue Feb 13 19:50:18 1996 Per Abrahamsen - - * style/swedish.el: Support for Swedish quotation style by "G\vran - Uddeborg" . - -Thu Dec 21 16:49:19 1995 Per Abrahamsen - - * latex.el (LaTeX-math-default): Added more definitions by Mehmet - Balcilar . - -Mon Dec 18 18:58:22 1995 Per Abrahamsen - - * latex.el (LaTeX-fill-region-as-paragraph): Removed old version. - (LaTeX-math-menu): Redefined the math mode menu. - -Thu Dec 14 19:51:15 1995 Per Abrahamsen - - * latex.el (LaTeX-math-menu): New variable. - (LaTeX-mode-menu): Use it. Suggested by Peter S Galbraith - . - -Mon Nov 13 23:49:16 1995 Per Abrahamsen - - * tex.el (VirTeX-common-initialization): Set `comment-multi-line' - to nil. - -Fri Oct 13 14:16:36 1995 Per Abrahamsen - - * PROBLEMS: Some easymenu explanations. - - * tex.el: Require easymenu.el instead of auc-menu.el. - * Makefile (AUCSRC): Removed easymenu.el and auc-menu.el. - (MINMAPSRC): Removed easymenu.el, column.el and cpp.el. - * easymenu.el: File deleted. - * column.el: File deleted. - * cpp.el: File deleted. - - * latex.el (LaTeX-math-insert): Don't check if `TeX-insert-macro' - is defined. - (LaTeX-close-environment): Work better when called on an empty - line. Fixed by David Aspinall . - -Thu Oct 12 15:45:00 1995 Per Abrahamsen - - * tex.el ('LaTeX-math-mode): Autoload from latex.el instead of - ltx-math.el. Reported by Richard Brankin . - -Tue Feb 14 20:36:00 1995 Per Abrahamsen - - * latex.el (LaTeX-fill-region-as-paragraph): Should now format \\ - correctly. Patch by michal@ellpspace.math.ualberta.ca (Michal - Jaegermann). - (LaTeX-fill-region-as-para-do): New function. - (LaTeX-fill-region-as-paragraph): Do not fill paragraphs inside - special environments. - -Sun Feb 12 15:40:15 1995 Per Abrahamsen - - * tex.el (TeX-byte-compile): Make it default to nil. Suggested by - michal@ellpspace.math.ualberta.ca (Michal Jaegermann). - - * tex-buf.el (TeX-command-query): Also offer to save files when - started from a menu. Reported by wscoas@win.tue.nl (Anton - A. Stoorvogel). - (TeX-LaTeX-sentinel): Don't suggest BibTeX if there is no - bibliographies. Suggested by Piet van Oostrum . - -Sat Feb 11 21:44:19 1995 Per Abrahamsen - - * tex-buf.el (TeX-run-format): Protect against being run from a - different buffer. Patch by Michael Kifer - . - - * latex.el (LaTeX-math-default): Moved `Phi' from V to F in - LaTeX-math-mode. Suggested by dak@ind.rwth-aachen.de (David - Kastrup). - * doc/math-ref.tex: Documented it. - -Thu Feb 2 11:24:46 1995 Per Abrahamsen - - * tex-buf.el (TeX-home-buffer): Added interactive, reported by - edavid@lami.univ-evry.fr. - -Wed Feb 1 11:12:35 1995 Per Abrahamsen - - * hilit-LaTeX.el: Upgraded to 1.06. - - * Makefile (CONTRIB, EXTRAFILES): Moved tex-jp.el to CONTRIB. - -Fri Jan 27 21:56:32 1995 Per Abrahamsen - - * latex.el (LaTeX-paragraph-commands): Incorrectly placed - parenthesis. Reported by mic@cs.ucsd.edu (Michelangelo Grigni). - -Thu Jan 26 13:39:56 1995 Per Abrahamsen - - * latex.el (LaTeX-fill-region): Use marker to mark end of region - instead of integer, as the formatting may change the size of the - region. - (LaTeX-common-initialization): Fixed bug in paragraph definitions. - Reported by Steve Anderson . - - * tex.el (save-match-data): Added by koba@flab.fujitsu.co.jp - (Kobayashi Shinji). - (bibtex-mode-hook): Don't use add-hook yet. Reported by - koba@flab.fujitsu.co.jp (Kobayashi Shinji). - -Wed Jan 25 14:59:57 1995 Per Abrahamsen - - * tex.el (change-major-mode-hook): Also clear - `LaTeX-environment-list'. - - * Makefile (AUCSRC): Add `auc-menu.el'. - - * tex.el: Use auc-menu instead of easymenu. - - * tex.el: Inserted comment to mark end of site customization. - Suggested by john@minster.york.ac.uk (John A. Murdie). - - * tex.el (change-major-mode-hook): Forgot a set of parentheses. - Reported by Frederic Devernay . - - * tex-buf.el (TeX-current-pages): Removed extra parentheses. - Reported by mic@cs.ucsd.edu (Michelangelo Grigni). - -Tue Jan 24 23:37:35 1995 Per Abrahamsen (abraham@iesd.auc.dk) - - * tex.el (change-major-mode-hook): Added workaround for error in - XEmacs 19.11's `kill-all-local-variables'. - -Mon Jan 23 16:03:35 1995 Per Abrahamsen - - * latex.el (LaTeX-common-initialization): Removed unnecessary - regexp quotes of `TeX-esc'. - - * style/amsart.el: Move `eqref' definition to `style/amstex.el' - and load that style hook. - * style/amstex.el: New file. - * Makefile (STYLESRC): Added it. - Suggested by vb1890@PLAY.CS.NYU.EDU (Victor Boyko). - -Sun Jan 22 14:18:12 1995 Per Abrahamsen - - * latex.el, ltx-math.el, Makefile: Integrated `ltx-math.el' in - `latex.el'. - * tex-site.el: Removed autoload for `LaTeX-math-mode'. - -Thu Jan 19 12:31:45 1995 Per Abrahamsen - - * latex.el (latex-mode): Epoch fix by Martin Sjolin - . - -Tue Jan 17 15:12:54 1995 Per Abrahamsen - - * bib-cite.el: New file contributed by Peter S. Galbraith - . - - * hilit-LaTeX.el: New file contributed by Peter S. Galbraith - . - - * Makefile (CONTRIB): New macro for user contributed emacs lisp - packages, initialized with `bib-cite.el' and `hilit-LaTeX.el'. - (EXTRAFILES): Added $(CONTRIB) to the list. - - * tex.el (TeX-directory-absolute-p): Moved definition before - `TeX-macro-private'. Reported by Frederic Devernay - . - - * latex.el (LaTeX-common-initialization): Remove extra and wrong - "\\\\par" from `paragraph-separate'. Bug reported by - nijhof@th.rug.nl (Jeroen Nijhof). - -Wed Jan 11 11:43:01 1995 Per Abrahamsen - - * tex-buf.el (TeX-command-region): Comment fix. Patch by - wlang@rs6000.mri.akh-wien.ac.at (Willi Langenberger). - (TeX-region-create): More outline-mode safe. Patch by - wlang@rs6000.mri.akh-wien.ac.at (Willi Langenberger). - - * Makefile (dist): Put version number in WWW page. Suggested by - several people. - - * latex.el (LaTeX-auto-regexp-list): Ignore first optional - argument to newenvironment if there is a second. Problem reported - by schiotz@ltf.dth.dk (Jakob Schiotz). - - * style/amsbook.el: New file. Problem reported by Denby Wong - <3dw16@qlink.queensu.ca>. - -Wed Jan 4 02:34:11 1995 Per Abrahamsen - - * tex-buf.el (TeX-TeX-sentinel-check): New function. Updates - `TeX-current-page' with regexp by dodd@roebling.poly.edu (Lawrence - R. Dodd) - (TeX-current-pages): New function. - (TeX-LaTeX-sentinel, TeX-TeX-sentinel): Use it. -y (TeX-format-filter): Removed unnecessary check before assignment. - -Tue Jan 3 03:38:54 1995 Per Abrahamsen - - * tex-buf.el (TeX-LaTeX-sentinel): Write number of pages even - when labels or citations are missing. Patch by - dodd@roebling.poly.edu (Lawrence R. Dodd). - -Wed Dec 7 11:47:56 1994 Per Abrahamsen - - * tex.el (TeX-directory-absolute-p): New function. Should work on - both Unix and MS DOS. Problem reported by schiotz@ltf.dth.dk - (Jakob Schiotz). - (TeX-parse-path): Use it. - (TeX-auto-generate): Use it. - -Mon Dec 5 12:11:12 1994 Per Abrahamsen - - * latex.el (BibTeX-auto-store): Set TeX-auto-parse-length to - 999999 locally. Problem reported by Christoph Wedler - . - -Fri Dec 2 08:20:10 1994 Per Abrahamsen - - * tex-buf.el (TeX-LaTeX-sentinel): Check whether the ".bbl" file - need to be udpated before setting TeX-command-next to "BibTeX". - (TeX-command-query): Remove previous change. - -Mon Nov 28 01:16:05 1994 Per Abrahamsen - - * latex.el (LaTeX-209-to-2e): New function by - Graham Gough . - - * latex.el (LaTeX-mode-menu): Move many commands to new - "Miscellaneous" submenu. - - * tex-buf.el (TeX-home-buffer): Don't take arg. - - * latex.el (LaTeX-left-right-indent-level): New variable - controling indentation for \left \right blocks. - (LaTeX-indent-level-count): New function. Previously only LaTeX - macros at the beginning of the line would affect indentation. - This problem was reported by many people. - (LaTeX-indent-calculate-last): Call `LaTeX-indent-level-count'. - Take into account that \end and \right at the beginning of the - line has immediate effect. - -Sun Nov 27 21:08:28 1994 Per Abrahamsen - - * latex.el (TeX-global-input-files): New variable. Idea and - sample code by Christophe Mignot . - (TeX-arg-input-file): Use it. - (BibTeX-global-style-files): Mention how it is reset in - `TeX-normal-mode'. - (BibTeX-global-files): Ditto. - - * tex.el (TeX-normal-mode): Reset `BibTeX-global-style-files', - `BibTeX-global-files', and `TeX-global-input-files' if invoked - with an argument. - - * tex-site.el: Ignore trailing `/' when adding TeX-lisp-directory - to load-path. Patch by Michael Ernst - . - - * tex-buf.el (TeX-LaTeX-sentinel): Don't rerun LaTeX on missing - references, unless they have changed. Patch by schiotz@ltf.dth.dk - (Jakob Schiotz). - - * latex.el (LaTeX2e-font-replace): New function. - (LaTeX-common-initialization): Set TeX-font-replace-function to - LaTeX2e-font-replace when using latex2e. - - * tex.el (TeX-font-replace-function): New variable. - (TeX-font): Use it. - - TeX-font-replace-function and LaTeX2e-font-replace were - contributed by Peter Thiemann - . - - -Tue Nov 22 14:21:05 1994 Per Abrahamsen - - * MSDOS: Added. Contributed by schiotz@ltf.dth.dk (Jakob - Schiotz). - - * OEMACS: Removed. - - * tex.el (VirTeX-common-initialization): Make - `words-include-escapes' a local variable before setting it. - Reported by Bo Nygaard Bai . - -Tue Nov 15 11:12:38 1994 Per Abrahamsen - - * tex.el (TeX-auto-store): Change to functions that prevent the - auto file buffer from entering emacs-lisp-mode. - (TeX-auto-insert): Don't rely on emacs-lisp-mode for indentation. - Suggested by Stefan Schöf (schoef@informatik.uni-oldenburg.de). - -Fri Nov 11 16:37:54 1994 Per Abrahamsen - - * tex.el (TeX-macro-global): Change to `standard' path. - -Wed Nov 9 22:35:21 1994 Per Abrahamsen - - * tex-buf.el (TeX-command-query): Suggest TeX-command-default - again if bbl file is newer than dvi file. - -Mon Nov 7 19:16:07 1994 Per Abrahamsen - - * tex.el (TeX-submit-bug-report): Indicate LaTeX-version. - Suggested by schiotz@ltf.dth.dk (Jakob Schiotz). - -Wed Oct 26 15:37:53 1994 Per Abrahamsen - - * Makefile (dist): Automatically update AUC-TeX-version and - AUC-TeX-date in tex.el - - * tex.el (AUC-TeX-version): Added AUC-TeX-version and - AUC-TeX-date from auc-ver.el. - - * auc-ver.el: File removed. - - * tex.el: Added version specific code from seperate files. - - * tex-19.el, tex-18.el, tex-lcd.el: Files removed. - -Tue Oct 25 13:05:36 1994 Per Abrahamsen - - * doc/auc-tex.texi (Projects): Removed an implemented item. - - * tex.el (TeX-command-current): New variable. - (TeX-command-select-master): New function. - (TeX-command-select-buffer): New function. - (TeX-command-select-region): New function. - (TeX-command-menu): Use TeX-command-current instead of explicit - file argument. - (TeX-command-menu-print): Remove file argument. - (TeX-command-menu-printer-entry): Don't pass file argument. - (TeX-command-create-menu): Removed. - (TeX-mode-menu): New menu. - (plain-TeX-mode-menu): Removed entries now in TeX-mode-menu. - (plain-TeX-mode-menu): Use `toggle' for bad boxes. - (plain-TeX-common-initialization): Enable TeX-mode-menu. - - * latex.el (LaTeX-mode-menu): Removed entries now in - TeX-mode-menu. - (LaTeX-mode-menu): Use `toggle' for bad boxes. - (LaTeX-common-initialization): Enable TeX-mode-menu. - - * tex-info.el (TeXinfo-command-menu): New menu. - (TeXinfo-mode-menu): Move commands to new menu. - (TeXinfo-mode-menu): Use `toggle' for bad boxes. - (texinfo-mode): Enable TeXinfo-command-menu. - -Mon Oct 24 22:49:51 1994 Per Abrahamsen - - * Makefile (AUCSRC): Removed auc-menu.el from AUC TeX distribution. - (MINMAPSRC): Added easymenu.el temporarily to min-map distribution. - - * auc-menu.el: Just load easymenu.el when using GNU Emacs. - - * easymenu.el Try to use RMS's easymenu instead of auc-menu. - (easy-menu-define): Call `easy-menu-do-define' to do - the real work. Document XEmacs keyword arguments. - (easy-menu-do-define): New function. - (easy-menu-create-keymaps): Support XEmacs keyword arguments in - menu definition. - (easy-menu-remove): Make is a function instead of a macro. - (easy-menu-add): Ditto. - -Fri Oct 21 14:46:16 1994 Per Abrahamsen - - * doc/auc-tex.texi (Completion): Less confusing BibTeX advice, I hope. - - * tex-jp.el: Added patch from koba@flab.fujitsu.co.jp (Kobayashi - Shinji). - - * latex.el (TeX-arg-insert-braces): Have \left and \right on - different lines. Patch by thiemann@informatik.uni-tuebingen.de - (Peter Thiemann). - - * Makefile (dist): Add CHANGES and ChangeLog files to the ftp - directory. Suggested by Frederic Devernay - . - - * latex.el (LaTeX-indent-calculate): Allow nil second element in - `LaTeX-indent-environment-list'. - (LaTeX-indent-environment-list): Added special environments - suggested by thiemann@informatik.uni-tuebingen.de (Peter - Thiemann). - -Thu Oct 20 22:58:59 1994 Per Abrahamsen - - * tex.el (TeX-auto-list-information): Spelling error. - -Tue Oct 18 13:24:26 1994 Per Abrahamsen - - * latex.el (LaTeX-common-initialization): Make "LaTeX2e" the - default command if you have set `LaTeX-version' to "2" and is - using "\documentclass". - -Thu Oct 6 14:38:52 1994 Per Abrahamsen - - * latex.el (LaTeX-paragraph-commands): End each word with a "\\b" - to avoid accidentally matching longer macros. - - * tex.el (TeX-add-local-master): Use three %'s when adding buffer - local variables. Suggested by Raymond Toy . - - * tex.el (TeX-format-list): Added entry for AmSTeX by Ulf Juergens - . - - * tex.el (ams-tex-mode): Run AmS-TeX-mode-hook, not - plain-TeX-mode-hook. Reported by Ulf Juergens - . - - * tex-buf.el (TeX-format-filter): Add `save-match-data'. Patch by - David Aspinall . - -Wed Sep 14 10:53:15 1994 Per Abrahamsen - - * cpp.el: Use RMS's version. - -Tue Sep 13 10:59:07 1994 Per Abrahamsen - - * doc/history.texi, doc/auc-tex.texi: Fixes from Chris Fearnley - <@vm.uni-c.dk:FEARNLCJ@DUVM>. - -Fri Sep 9 13:15:33 1994 Per Abrahamsen - - * latex.el (LaTeX-insert-environment): Don't fill environments - listed in `LaTeX-indent-environment-list'. Suggestion by Graham - Gough . - - * tex.el (LaTeX-command-style): Made latex2e first in the list. - Suggested by Frederic Devernay . - -Mon Sep 5 05:14:31 1994 Per Abrahamsen - - * tex.el (TeX-file-extensions): Added LaTeX2 `cls' extension after - query by jmv@di.uminho.pt (Jose Manuel Valenca). - -Tue Aug 30 00:05:28 1994 Per Abrahamsen - - * tex-jp.el: New version from koba@flab.fujitsu.co.jp (Kobayashi - Shinji). - - * tex.el (TeX-command-list): Fifth element is now ignored. - - * tex-buf.el (TeX-command-query): Check if region file is newer - than dvi file. - (TeX-command-region): Only query for command _after_ region file - is created. - (TeX-region-create): Only save file if the new content is - different than the original content. - -Mon Aug 29 13:41:59 1994 Per Abrahamsen (abraham@research.att.com) - - * tex-buf.el (TeX-warning): Use offset for line end. Fixed by - ddw2@sunbim.be (Dominique de Waleffe). - -Fri Aug 26 18:17:57 1994 Per Abrahamsen (abraham@iesd.auc.dk) - - * doc/auc-tex.texi (Projects): Removed preceding item from - wishlist. - - * latex.el (LaTeX-common-initialization): Fix to comments - separating paragraphs by koba@flab.fujitsu.co.jp (Kobayashi - Shinji). - - * tex-jp.el (LaTeX-fill-region-as-paragraph): New version for MULE - 2.0 by Tomotake FURUHATA . - - * tex.el (TeX-function-p): Spelling error in doc. - -Tue Aug 23 11:00:35 1994 Per Abrahamsen (abraham@iesd.auc.dk) - - * doc/intro.texi (Contacts): Some reformulations. - -Sun Aug 21 18:47:23 1994 Per Abrahamsen (abraham@iesd.auc.dk) - - * tex-jp.el (TeX-insert-punctuation): Japanese version from - koba@flab.fujitsu.co.jp (Kobayashi Shinji). - -Fri Aug 19 14:59:57 1994 Per Abrahamsen (abraham@iesd.auc.dk) - - * doc/install.texi: The `site-lisp' directory is also available in - Lucide Emacs 19.10. Reported by Tim Geisler - . - -Thu Aug 18 06:56:53 1994 Per Abrahamsen (abraham@iesd.auc.dk) - - * latex.el (TeX-arg-cite): Prompt for multiple keys. Suggested by - Masahiro Kitagawa . - -Wed Aug 17 14:00:16 1994 Per Abrahamsen (abraham@iesd.auc.dk) - - * style/german.el ("german"): Use `TeX-quote-after-quote'. - Suggested by te@informatik.uni-hannover.de (Thomas Esser). - - * latex.el (LaTeX-common-initialization): Error in regexp for - multiple arguments to `\cite', reported by Masahiro Kitagawa - . - -Wed Aug 17 01:24:55 1994 Per Abrahamsen (abraham@iesd.auc.dk) - - * latex.el (LaTeX-env-figure): Put caption inside center - environment. Suggested by Martin Wunderli . - - * tex.el (TeX-strip-extension): If NODIR is set to `path', remove - the directory part iff it is equal to the current directory, or is - a member of either `TeX-macro-global' or `TeX-macro-private'. - (TeX-master-file): Use `path' for NODIR when querying the user for - a file name. Reported finger@brachio.Informatik.Uni-Dortmund.DE - (Bernd Finger). - -Tue Aug 16 12:22:04 1994 Per Abrahamsen (abraham@iesd.auc.dk) - - * latex.el (LaTeX-common-initialization): `eqnarray*' should not - have a label. Reported by dodd@roebling.poly.edu (Lawrence R. - Dodd). - -Thu Aug 11 16:00:18 1994 Per Abrahamsen (abraham@iesd.auc.dk) - - * tex-buf.el (TeX-background-filter): Always show background - output. - -Wed Aug 10 19:14:42 1994 Per Abrahamsen (abraham@iesd.auc.dk) - - * Makefile (MINMAPSRC): Added `all.el'. - - * all.el: New file. - - * tex-buf.el (TeX-LaTeX-sentinel): Write "some" if - TeX-current-page is nil. Reported by Michail Rozman - . - -Tue Aug 9 01:26:58 1994 Per Abrahamsen (abraham@iesd.auc.dk) - - * auc-menu.el (easy-menu-add): Undid previous change. - (top level `cond'): Use Emacs 18 code if `window-system' is nil. - Patch by Patrice Belleville . - -Mon Aug 8 21:40:01 1994 Per Abrahamsen (abraham@iesd.auc.dk) - - * tex.el (TeX-electric-macro): No electricity after `.' or `\'. - -Sat Aug 6 13:53:01 1994 Per Abrahamsen (abraham@iesd.auc.dk) - - * latex.el (LaTeX-paragraph-commands): New variable. - (LaTeX-common-initialization): Use it. Suggested by - liyuan@allwise.research.att.com (Yuan P. Li). - - * auc-menu.el (easy-menu-add): Check that `x-popup-menu' is bound - and that we are running under X before calling it. Reported by - Adrian F. Clark - -Thu Aug 4 19:14:53 1994 Per Abrahamsen (abraham@iesd.auc.dk) - - * tex-jp.el (LaTeX-fill-region-as-paragraph): Patch for Emacs 19 - regexps by koba@flab.fujitsu.co.jp (Kobayashi Shinji) reported by - Uenami Ken'ichi . - - * doc/auc-tex.texi (European): Mention `iso-cvt.el' as suggested - by mike@vlsivie.tuwien.ac.at (Michael Gschwind). - -Wed Aug 3 15:36:02 1994 Per Abrahamsen (abraham@iesd.auc.dk) - - * doc/history.texi: New file. - - * doc/Makefile (HISTORY): Added rule. - - * Makefile (EXTRAFILES): Added `ChangeLog'. - (DOCFILES): Added `history.texi'. - - * doc/auc-tex.texi (History): Made ready for 9.2. Move history to - `history.texi'. - - * doc/changes.texi: Made ready for 9.2. Introduce ChangeLog. - - * Makefile (LispInstall): Use "/bin/pwd" instead of "pwd". - reported by mic@cs.ucsd.edu (Michelangelo Grigni). - - * ChangeLog: New file. - - * Version 9.1 released. - diff -r 6866abce6aaf -r 6075d714658b lisp/auctex/INSTALLATION --- a/lisp/auctex/INSTALLATION Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,117 +0,0 @@ -Installation of AUC TeX -*********************** - -Compiling -========= - -The following describes how to install AUC TeX under Unix. You may -also be able to do use these instructions under some other operating -systems, if you have already installed the proper GNU tools, such as -`make'. - - To install AUC TeX for an entire site (which may just be your own -personal Linux box), issue the following two commands as root: - - make - make lispdir=/usr/local/share/emacs/site-lisp install - - except that instead of /usr/local/... you should use the location of -your sites emacs installation. AUC TeX will then be installed in a -subdirectory named `auctex' of the `site-lisp' directory, and the file -`tex-site.el' will be stored directly in the `site-lisp'. You can now -tell your users to enable AUC TeX by adding - - (require 'tex-site) - - to their `.emacs' file. - - If you use xemacs instead, or if your emacs binary is named something -else than `emacs', specify this by using the commands - - make EMACS=xemacs - make lispdir=/usr/local/share/emacs/site-lisp install - - to install. - - If you want to install AUC TeX in your personal account, you should -chose a directory for all your emacs add-ons, for example an `elisp' -subdirectory in your home directory. You can then install AUC TeX with -the commands - - make - make lispdir=$HOME/elisp install - - You will then need to add the following lines to your `.emacs' file: - - (setq load-path (cons "~/elisp" load-path)) - (require 'tex-site) - -Customizing -=========== - - Next, you should edit the file `tex-site.el' to fit your local site. -You do this by looking at the customization section in the beginning -of `tex.el' and copy the definitions that are wrong for your site to -`tex-site.el'. Do *not* edit `tex.el' directly, or you will have to do -all the work over again when you upgrade AUC TeX. AUC TeX will not -overwrite your old `tex-site.el' file next time you install, so you -will be able to keep all your customizations. - - There are two variables with a special significance. - - - User Option: TeX-lisp-directory - The directory where you want to install the AUC TeX lisp files. - - This variable is set automatically by the `make install' command. -If you don't issue a `make install', for example if you don't want to -install AUC TeX in a different place, you will have to set this -variable manually to the location of the compiled files. - - - User Option: TeX-macro-global - Directories containing the site's TeX style files. - - Normally, AUC TeX will only allow you to complete a short list of -build-in macros and environments and on the macros you define yourself. -If you issue the `M-x TeX-auto-generate-global' command after loading -AUC TeX, you will be able to complete on all macros available in the -standard style files used by your document. To do this, you must set -this variable to a list of directories where the standard style files -are located. The directories will be searched recursively, so there is -no reason to list subsirectories explicitly. - - You probably also need to change `TeX-command-list' to make sure -that the commands used for starting TeX, printing, etc. work on your -system. Copy the definition from `tex.el' to `tex-site.el' and edit -the command names appropriately. - - Finally, copy and edit `TeX-printer-list' to contain the printers -available at your site. - - To extract information from your sites TeX macros, type `M-x -TeX-auto-generate-global' in your emacs. This will only work if you -have set `TeX-macro-global' correctly in `tex-site.el'. - -Contributed files -================= - - There are several files that are not part of AUC TeX proper, but -included in the distribution in case they are useful. - -`hilit-LaTeX.el' - Better highlighting for the obsolete `hilit19' package. - -`font-latex.el' - Better highlighting for the FONT-LOCK package. - -`bib-cite.el' - Better support for bibliographies and much more. - -`tex-jp.el' - Support for Japanese. - -`func-doc.el' - Support for context sensitive online help for various languages. - - Read the comments in the start of each file for more information -about how to install, what they do, and who wrote and maintains them. - diff -r 6866abce6aaf -r 6075d714658b lisp/auctex/Makefile --- a/lisp/auctex/Makefile Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,229 +0,0 @@ -# Makefile - for the AUC TeX distribution. -# -# Maintainer: Per Abrahamsen -# Version: 9.7p -# -# Edit the makefile, type `make', and follow the instructions. - -##---------------------------------------------------------------------- -## YOU MUST EDIT THE FOLLOWING LINES -##---------------------------------------------------------------------- - -# Where local software is found -prefix=/usr/local - -# Where info files go. -infodir = $(prefix)/info - -# Where local lisp files go. -lispdir = $(prefix)/share/emacs/site-lisp - -# Where the AUC TeX emacs lisp files go. -aucdir=$(lispdir)/auctex - -# Name of your emacs binary -EMACS=emacs - -##---------------------------------------------------------------------- -## YOU MAY NEED TO EDIT THESE -##---------------------------------------------------------------------- - -# Do not change the definition of autodir below, unless you also -# update TeX-auto-global in tex-init.el - -# Where the automatically generated lisp files for your site go. -autodir=$(aucdir)/auto - -# Using emacs in batch mode. -BATCH=$(EMACS) -batch -q -l lpath.el - -# Specify the byte-compiler for compiling AUC TeX files -ELC= $(BATCH) -f batch-byte-compile - -# Specify the byte-compiler for generating style files -AUTO= $(EMACS) -batch -l $(aucdir)/tex.elc \ - -l $(aucdir)/latex.elc -f TeX-auto-generate-global - -# Specify the byte-compiler for compiling generated style files -AUTOC= $(ELC) - -# How to move the byte compiled files to their destination. -MV = mv - -# How to copy the lisp files to their distination. -CP = cp -p - -##---------------------------------------------------------------------- -## BELOW THIS LINE ON YOUR OWN RISK! -##---------------------------------------------------------------------- - -.SUFFIXES: .el .elc .texi - -SHELL = /bin/sh - -FTPDIR = /home/ftp/pub/Staff/Per.Abrahamsen/auctex -#FTPDIR = /home/ftp/pub/Staff/Per.Abrahamsen/mirror/ftp/auctex - -WWWDIR = $(HOME)/.public_html/auctex -#WWWDIR = /home/ftp/pub/Staff/Per.Abrahamsen/mirror/www/auctex - -REMOVE = ltx-help.el - -MINMAPSRC = auc-menu.el maniac.el outln-18.el all.el multi-prompt.el - -## MULE_ELC is set by update-elc.sh if bytecompiling for XEmacs/Mule -CONTRIB = bib-cite.el $(MULE_EL) font-latex.el custom-load.el -CONTRIBELC = bib-cite.elc $(MULE_ELC) font-latex.elc custom-load.elc - -AUCSRC = auc-old.el tex.el tex-buf.el latex.el tex-info.el multi-prompt.el -AUCELC = auc-old.elc tex.elc tex-buf.elc latex.elc tex-info.elc \ - multi-prompt.elc - - -STYLESRC = ../../etc/auctex/style/slides.el ../../etc/auctex/style/foils.el ../../etc/auctex/style/amstex.el \ - ../../etc/auctex/style/article.el ../../etc/auctex/style/book.el ../../etc/auctex/style/letter.el \ - ../../etc/auctex/style/report.el ../../etc/auctex/style/amsart.el ../../etc/auctex/style/amsbook.el \ - ../../etc/auctex/style/epsf.el ../../etc/auctex/style/psfig.el ../../etc/auctex/style/latexinfo.el \ - ../../etc/auctex/style/dutch.el ../../etc/auctex/style/german.el ../../etc/auctex/style/dk.el \ - ../../etc/auctex/style/j-article.el ../../etc/auctex/style/j-book.el ../../etc/auctex/style/j-report.el \ - ../../etc/auctex/style/jarticle.el ../../etc/auctex/style/jbook.el ../../etc/auctex/style/jreport.el \ - ../../etc/auctex/style/dinbrief.el ../../etc/auctex/style/virtex.el ../../etc/auctex/style/plfonts.el \ - ../../etc/auctex/style/plhb.el ../../etc/auctex/style/harvard.el ../../etc/auctex/style/swedish.el \ - ../../etc/auctex/style/danish.el - -DOCFILES = doc/Makefile doc/auc-tex.texi doc/intro.texi doc/install.texi \ - doc/changes.texi doc/tex-ref.tex doc/math-ref.tex doc/history.texi - -EXTRAFILES = COPYING PROBLEMS MSDOS VMS OS2 WIN-NT Makefile ChangeLog \ - lpath.el tex-site.el $(CONTRIB) - -all: lisp - -.IGNORE: some - -lisp: - $(ELC) $(AUCSRC) $(STYLESRC) $(CONTRIB) - -some: $(AUCELC) $(CONTRIBELC) $(STYLESRC:.el=.elc) - -install: install-lisp - -contrib: - $(ELC) bib-cite.el - $(ELC) font-latex.el -# $(ELC) tex-jp.el # Doesn't compile without MULE -# $(ELC) hilit-LaTeX.el # Doesn't compile without X - -install-lisp: some - if [ ! -d $(lispdir) ]; then mkdir $(lispdir); else true; fi ; - if [ -f $(lispdir)/tex-site.el ]; \ - then \ - echo "Leaving old tex-site.el alone."; \ - else \ - sed -e 's#@AUCDIR#$(aucdir)/#' tex-site.el \ - > $(lispdir)/tex-site.el ; \ - fi - if [ ! -d $(aucdir) ]; then mkdir $(aucdir); else true; fi ; - if [ `/bin/pwd` != `(cd $(aucdir) && /bin/pwd)` ] ; \ - then \ - if [ ! -d $(aucdir)/style ]; then mkdir $(aucdir)/style; \ - else true; fi ; \ - $(MV) $(AUCELC) $(aucdir) ; \ - $(MV) style/*.elc $(aucdir)/style ; \ - $(CP) $(AUCSRC) $(aucdir) ; \ - $(CP) style/*.el $(aucdir)/style ; \ - else \ - echo "Leaving compiled files in place."; \ - fi - -install-contrib: - $(MV) $(CONTRIBELC) $(aucdir) - $(CP) $(CONTRIB) $(aucdir) - -install-info: - -(cd doc; $(MAKE) install infodir=$(infodir)) - - -install-auto: - @echo "Use \"M-x TeX-auto-generate-global RET\" instead." - - -.el.elc: - $(ELC) $< - -clean: - rm -rf *~ #*# lex.yy.c idetex auctex - (cd doc; $(MAKE) clean) - -wc: - wc $(AUCSRC) $(STYLESRC) - -dist: - @if [ "X$(TAG)" = "X" ]; then echo "*** No tag ***"; exit 1; fi - if [ "X$(OLD)" = "X" ]; then echo "No patch"; exit 1; fi - @echo "**********************************************************" - @echo "** Making distribution of auctex for release $(TAG)" - @echo "**********************************************************" - if [ -d auctex-$(TAG) ]; then rm -r auctex-$(TAG) ; fi - rm -f $(WWWDIR)/version - echo $(TAG) > $(WWWDIR)/version - perl -pi.bak -e "s/Version: $(OLD)/Version: $(TAG)/" \ - $(AUCSRC) $(EXTRAFILES) - mv ChangeLog ChangeLog.old - echo `date "+%a %b %d %T %Y "` \ - " Per Abrahamsen " > ChangeLog - echo >> ChangeLog - echo " * Version" $(TAG) released. >> ChangeLog - echo >> ChangeLog - cat ChangeLog.old >> ChangeLog - cvs commit -m "Release $(OLD)++" tex.el - rm -f tex.el.orig - mv tex.el tex.el.orig - sed -e '/defconst AUC-TeX-date/s/"[^"]*"/"'"`date`"'"/' \ - -e '/defconst AUC-TeX-version/s/"[^"]*"/"'$(TAG)'"/' \ - < tex.el.orig > tex.el - rm -f $(REMOVE) - -cvs remove $(REMOVE) - -cvs add $(AUCSRC) $(EXTRAFILES) - -(cd doc; cvs add `echo $(DOCFILES) | sed -e s@doc/@@g` ) - -(cd style; cvs add `echo $(STYLESRC) | sed -e s@style/@@g` ) - cvs commit -m "Release $(TAG)" - cvs tag release_`echo $(TAG) | sed -e 's/[.]/_/g'` - mkdir auctex-$(TAG) - mkdir auctex-$(TAG)/style - mkdir auctex-$(TAG)/doc - cp $(AUCSRC) $(EXTRAFILES) auctex-$(TAG) - cp $(STYLESRC) auctex-$(TAG)/style - cp $(DOCFILES) auctex-$(TAG)/doc - (cd doc; $(MAKE) dist; cp auctex auctex-* ../auctex-$(TAG)/doc ) - (cd doc; cp INSTALLATION README CHANGES ../auctex-$(TAG)/ ) - cp doc/CHANGES $(FTPDIR)/CHANGES-$(TAG) - cp doc/auc-tex.ps $(FTPDIR) - cp ChangeLog $(FTPDIR) - cp doc/*.html $(WWWDIR)/doc - rm -f $(FTPDIR)/auctex-$(TAG).tar.gz $(FTPDIR)/auctex.tar.gz - rm -f $(FTPDIR)/auctex.tar.Z $(FTPDIR)/auctex.zip - tar -cf - auctex-$(TAG) | gzip --best > $(FTPDIR)/auctex-$(TAG).tar.gz - tar -cf - auctex-$(TAG) | compress > $(FTPDIR)/auctex.tar.Z - zip -r $(FTPDIR)/auctex auctex-$(TAG) - (cd $(FTPDIR); ln -s auctex-$(TAG).tar.gz auctex.tar.gz) - cvs rdiff -r release_`echo $(OLD) | sed -e 's/[.]/_/g'` \ - -r release_`echo $(TAG) | sed -e 's/[.]/_/g'` auctex \ - > $(FTPDIR)/auctex-$(OLD)-to-$(TAG).patch ; exit 0 - -patch: - cvs rdiff -r release_`echo $(OLD) | sed -e 's/[.]/_/g'` \ - -r release_`echo $(TAG) | sed -e 's/[.]/_/g'` auctex - -min-map: - -cvs add $(MINMAPSRC) - cvs commit -m "Update" - cp $(MINMAPSRC) doc/math-ref.tex $(FTPDIR) - -autoloads: auto-autoloads.el - -auto-autoloads.el: $(AUCSRC) $(CONTRIB) - $(EMACS) -batch -q -no-site-file \ - -eval '(setq autoload-target-directory "'`pwd`'/")' \ - -l autoload \ - -f batch-update-autoloads $? diff -r 6866abce6aaf -r 6075d714658b lisp/auctex/PROBLEMS --- a/lisp/auctex/PROBLEMS Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,105 +0,0 @@ -* Your Emacs is missing easymenu.el. - -Please upgrade. - -If that is absolutely impossible, you can try installing - - - -under the name easymenu.el at some place where emacs can find it. -The best place is in the standard Emacs lisp directory, because that -will automatically be removed when you upgrade. - -* Missing menus or menus containing just the word "Bug". - -You probably have an old version of easymenu.el or auc-menu.el. Find -it, delete it, and recompile AUC TeX. If you are using an old Emacs, -the easymenu.el may have been distributed with it. In that case, see -the previous point. - -* You are not using UNIX or can't figure out how to install. - -0. Delete any old version you have. - -1. Edit tex-site.el. Read the comments in the file. - -2. Add (load-file "/tex-site.el") to your .emacs file. - -If you start a fresh emacs, AUC TeX should be loaded now. -The two next steps are optional: - -3. Byte compile the files with "M-x byte-compile-file" for speed. - -4. Do a `M-x TeX-auto-generate-global' to get full macro completion. - -Look also for files with names like MSDOS, OS2, or VMS that might be -applicable for your system. - -* You get errors during byte compilation. - -This often indicates a type in your customizations. If you have -modified `tex-site.el', try to enter that file from Emacs and type -`M-x eval-current-buffer RET' to find the error. - -This is can also be because some old version of AUC TeX gets loaded -during the compilation. Make sure to remove all old versions, and try -again. The Emacs 19 byte-compiler will give warning about free -variables and unknown functions. Ignore them. - -tex-jp.el will fail unless you have an emacs that understands japanese. - -NEmacs-3.3.2 cannot `make install-auto', use `M-x TeX-auto-generate-global' -instead. - -Mule-1.0-KIRITSUBO fails to parse some of the style files. - -* You are using NeXT Emacs. - -NeXT Emacs is broken, a workaround is available by ftp: - -host: sunsite.auc.dk -file: /packages/auctex/get-proc-env.el.z (gzip'ed) - -* You are mixing Emacs 18, FSF Emacs 19, and Lucid Emacs 19. - -Make sure to use the correct byte-compiled files for each version. -You may want to disable the automatic byte compilation by setting - - (setq TeX-byte-compile nil) - -in your .emacs file. - -* None if this completion or multifile stuff works... - -It must be enabled first, insert this in your emacs: - - (setq-default TeX-master nil) - (setq TeX-parse-self t) - (setq TeX-auto-save t) - -Read also the chapters about parsing and multifile documents in the -manual. - -* When I save `foo.bib' AUC TeX forgets the information in `foo.tex'. - -For various reasons, AUC TeX ignores the extension when it store -information about a file, so you should use unique base names for your -files. E.g. rename `foo.bib' to `foob.bib'. - -* (La)TeX Interactive does not work. - -You need comint.el on Emacs 18. Look at your favorite elisp archive. - -* TeX-save-document does not work. - -Make sure TeX-check-path contains "./" somewhere. - -* Ispell does not ignore TeX macros. - -GNU ispell 4.0 does not understand TeX. Upgrade to International -Ispell 3.1 which works much better on TeX documents. - - -% Local Variables: -% mode: outline-minor -% End: diff -r 6866abce6aaf -r 6075d714658b lisp/auctex/README --- a/lisp/auctex/README Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,170 +0,0 @@ -Introduction to AUC TeX -*********************** - -This section of the AUC TeX manual gives a brief overview of what AUC -TeX is, and the section is also available as a `README' file. It is -*not* an attempt to document AUC TeX. Real documentation for AUC TeX -is available in the rest of the manual, which you can find in the `doc' -directory. - - Read the `INSTALLATION' file for information about how to install -AUC TeX. It is identical to the Installation chapter in the AUC TeX -manual. - - If you are upgrading from the previous version of AUC TeX, the -latest changes can be found in the `CHANGES' file. If you are -upgrading from an older version, read the History chapter in the AUC -TeX manual. - - AUC TeX is a comprehensive customizable integrated environment for -writing input files for LaTeX using GNU Emacs. - - AUC TeX lets you run TeX/LaTeX and other LaTeX-related tools, such -as a output filters or post processor from inside Emacs. Especially -`running LaTeX' is interesting, as AUC TeX lets you browse through the -errors TeX reported, while it moves the cursor directly to the reported -error, and displays some documentation for that particular error. This -will even work when the document is spread over several files. - - AUC TeX automatically indents your `LaTeX-source', not only as you -write it -- you can also let it indent and format an entire document. -It has a special outline feature, which can greatly help you `getting an -overview' of a document. - - Apart from these special features, AUC TeX provides an large range of -handy Emacs macros, which in several different ways can help you write -your LaTeX documents fast and painless. - - All features of AUC TeX are documented using the GNU Emacs online -documentation system. That is, documentation for any command is just a -key click away! - - AUC TeX is written entirely in Emacs-Lisp, and hence you can easily -add new features for your own needs. It was not made as part of any -particular employment or project (apart from the AUC TeX project -itself). AUC TeX is distributed under the `GNU Emacs General Public -License' and may therefore almost freely be copied and redistributed. - - The next sections are a short introduction to some `actual' features. -For further information, refer to the build-in online documentation of -AUC TeX. - -Indentation and formatting -========================== - - AUC TeX may automatically indent your document as you write it. By -pressing lfd instead of ret at the end of a line, the current line is -indented by two spaces according to the current environment level, and -the cursor is moved down one line. By pressing tab, the current line -is indented, and the cursor stays where it is. The well-known Emacs -feature `format-paragraph' (`M-q') is reimplemented especially for AUC -TeX to follow the indentation. A special command `LaTeX-fill-buffer' -lets you indent an entire document like the well-known C utility indent -(this time, only according to the LaTeX structure :-). - -Completion -========== - - By studying your `\documentstyle' command (in the top of your -document), and consulting a precompiled list of (La)TeX symbols from a -large number of TeX and LaTeX files, AUC TeX is aware of the LaTeX -commands you should able to use in this particular document. This -`knowledge' of AUC TeX is used for two purposes. - - 1. To make you able to `complete' partly written LaTeX commands. You - may e.g. write `\renew' and press `M-tab' (`TeX-complete-symbol'), - and then AUC TeX will complete the word `\renewcommand' for you. - In case of ambiguity it will display a list of possible - completions. - - 2. To aid you inserting environments, that is \begin - \end pairs. - This is done by pressing C-c C-e (LaTeX-environment), and you will - be prompted for which `environment' to insert. - -Editing your document -===================== - - A number of more or less intelligent keyboard macros have been -defined to aid you editing your document. The most important are -listed here below. - -`LaTeX-environment' - (`C-c C-e') Insert a `\begin{}' -- `\end{}' pair as described - above. - -`LaTeX-section' - (`C-c C-s') Insert one of `\chapter', `\section', etc. - -`TeX-font' - (`C-c C-f C-r', `C-c C-f C-i', `C-c C-f C-b') Insert one of - `{\textrm }'), `{\textit \/}' `{\textbf }' etc. - - A number of additional functions are available. But it would be far -too much to write about here. Refer to the rest of the AUC TeX -documentation for further information. - -Running LaTeX -============= - - When invoking on of the commands `TeX-command-master' (`C-c C-c') or -`TeX-command-region' (`C-c C-r') LaTeX is run on either the entire -current document or a given region of it. The Emacs view is split in -two, and the output of TeX is printed in the second half of the screen, -as you may simultaneously continue editing your document. In case TeX -found any errors when processing your input you can call the function -`TeX-next-error' (`C-c `') which will move the cursor to the first -given error, and display a short explanatory text along with the -message TeX gave. This procedure may be repeated until all errors have -been displayed. By pressing `C-c C-w' (`TeX-toggle-debug-boxes') you -can toggle whether the browser also should notify over-full/under-full -boxes or not. - - Once you've successfully formatted your document, you may preview or -print it by invoking `TeX-command-master' again. - -Outlines -======== - - Along with AUC TeX comes support for outline mode for Emacs, which -lets you browse the sectioning structure of your document, while you -will still be able to use the full power of the rest of the AUC TeX -functionality. - -Availability -============ - - The most recent version is always available by ftp at - - `ftp://ftp.iesd.auc.dk/pub/emacs-lisp/auctex.tar.gz' - - In case you don't have access anonymous ftp, you can get it by email -requests to `'. - - WWW users may want to check out the AUC TeX page at - - `http://www.iesd.auc.dk/~amanda/auctex/' - -Contacts -======== - - There has been established a mailing list for help, bug reports, -feature requests and general discussion about AUC TeX. You're very -welcome to join. Traffic average at an article by day, but they come -in bursts. If you are only interested in information on updates, you -could refer to the newsgroups `comp.text.tex' and `gnu.emacs.sources'. - - If you want to contact the AUC TeX mailing list, send mail to -`' in order to join. Articles should be -send to `'. - - To contact the current maintainers of auc-TeX directly, email -`'. - - AUC TeX development - c/o Kresten Krab Thorup - - Mathematics and Computer Science - University of Aalborg - DK 9000 Aalborg - Denmark - diff -r 6866abce6aaf -r 6075d714658b lisp/auctex/auc-old.el --- a/lisp/auctex/auc-old.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,249 +0,0 @@ -;;; auc-old.el - Compatibility with AUC TeX 6.* -;; -;; Maintainer: Per Abrahamsen -;; Version: 9.7p -;; -;; Copyright (C) 1991 Kresten Krab Thorup -;; Copyright (C) 1993 Per Abrahamsen -;; -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 1, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Commentary: - -;; This file contains an alternative keymapping, compatible with -;; older versions of AUC TeX. You are strongly suggested to try the -;; new keyboard layout, as we would like this file to go away -;; eventually. - -;;; Code: - -(require 'latex) - -;;; Keymaps - -(defun TeX-define-key (key value) - "OBSOLETE: Define KEY to VALUE in TeX and LaTeX mode." - (define-key plain-TeX-mode-map key value) - (define-key LaTeX-mode-map key value)) - -(TeX-define-key "\n" 'TeX-terminate-paragraph) -(TeX-define-key "\e}" 'up-list) -(TeX-define-key "\e{" 'TeX-insert-braces) -(TeX-define-key "\C-c\C-b" 'TeX-bold) -(TeX-define-key "\C-c\C-i" 'TeX-italic) -(TeX-define-key "\C-c\C-s" 'TeX-slanted) -(TeX-define-key "\C-c\C-r" 'TeX-roman) -(TeX-define-key "\C-c\C-e" 'TeX-emphasize) -(TeX-define-key "\C-c\C-t" 'TeX-typewriter) -(TeX-define-key "\C-c\C-y" 'TeX-small-caps) -(TeX-define-key "\C-c\C-d" 'TeX-region) -(TeX-define-key "\C-c\C-a" 'TeX-buffer) -(TeX-define-key "\C-c\C-p" 'TeX-preview) -(TeX-define-key "\C-c\C-n" 'TeX-next-error) -(TeX-define-key "\C-c!" 'TeX-print) -(TeX-define-key "\e\t" 'TeX-complete-symbol) -(TeX-define-key "\C-c$" 'TeX-run-lacheck) - -(define-key LaTeX-mode-map "\C-c\n" 'TeX-terminate-paragraph) -(define-key LaTeX-mode-map "\C-c\C-x" 'LaTeX-section) -(define-key LaTeX-mode-map "\C-c\C-c" 'LaTeX-environment) -(define-key LaTeX-mode-map "\C-c@" 'LaTeX-bibtex) -(define-key LaTeX-mode-map "\C-c#" 'LaTeX-makeindex) -(define-key LaTeX-mode-map "\em" 'LaTeX-math-mode) -(define-key LaTeX-mode-map "\es" 'LaTeX-fill-section) -(define-key LaTeX-mode-map "\e\C-e" 'LaTeX-mark-environment) -(define-key LaTeX-mode-map "\e\C-x" 'LaTeX-mark-section) -(define-key LaTeX-mode-map "\e\C-q" 'LaTeX-fill-environment) - -;;; Buffer - -(defun TeX-region (begin end) - "OBSOLETE: Run TeX-command-default on current region." - (interactive "r") - (require 'tex-buf) - (setq TeX-current-process-region-p t) - (if (nth 4 (assoc TeX-command-default TeX-command-list)) - (TeX-region-create (TeX-region-file "tex") - (buffer-substring begin end) - (file-name-nondirectory (buffer-file-name)) - (count-lines (point-min) begin))) - (TeX-command TeX-command-default 'TeX-region-file)) - -(defun TeX-buffer () - "OBSOLETE: Run TeX-command-default on the current document." - (interactive) - (save-some-buffers) ; added for compatibility reasons - (require 'tex-buf) - (setq TeX-current-process-region-p nil) - (TeX-command TeX-command-default 'TeX-master-file)) - -(defun TeX-old-command (name) - "OBSOLETE: Run command NAME on either the current document or region." - (require 'tex-buf) - (if TeX-current-process-region-p - (TeX-command name 'TeX-region-file) - (TeX-command name 'TeX-master-file))) - -(defun TeX-preview () - "OBSOLETE: Run View command on either the current document or region." - (interactive) - (TeX-old-command "View")) - -(defun TeX-print () - "OBSOLETE: Run Print command on either the current document or region." - (interactive) - (TeX-old-command "Print")) - -(defun TeX-run-lacheck() - "OBSOLETE: Run lacheck command on either the current document or region." - (interactive) - (TeX-old-command "Check")) - -(defun LaTeX-bibtex () - "OBSOLETE: Run BibTeX command on either the current document or region." - (interactive) - (TeX-old-command TeX-command-BibTeX)) - -(defun LaTeX-makeindex () - "OBSOLETE: Run Index command on either the current document or region." - (interactive) - (TeX-old-command "Index")) - -;;; Fonts - -(defun TeX-bold () - (interactive "*") - (insert TeX-grop TeX-esc "bf " TeX-grcl) - (backward-char 1)) - -(defun TeX-italic () - (interactive "*") - (insert TeX-grop TeX-esc "it " TeX-esc "/" TeX-grcl) - (backward-char 3)) - -(defun TeX-slanted () - (interactive "*") - (insert TeX-grop TeX-esc "sl " TeX-esc "/" TeX-grcl) - (backward-char 3)) - -(defun TeX-roman () - (interactive "*") - (insert TeX-grop TeX-esc "rm " TeX-grcl) - (backward-char 1)) - -(defun TeX-emphasize () - (interactive "*") - (insert TeX-grop TeX-esc "em " TeX-esc "/" TeX-grcl) - (backward-char 3)) - -(defun TeX-typewriter () - (interactive "*") - (insert TeX-grop TeX-esc "tt " TeX-grcl) - (backward-char 1)) - -(defun TeX-small-caps () - (interactive "*") - (insert TeX-grop TeX-esc "sc " TeX-grcl) - (backward-char 1)) - -;;; AUC (La)TeX Mode -;; -;; Added by marsj@ida.liu.se Thu Mar 5 17:52:38 1992 to support -;; automatic mode change after using insert-mode-line hook. Also -;; modified regexp to choose tex mode to be more aware of latex -;; (documentstyle is uniq, isn'it) - -(defun insert-mode-line () - "This little macro inserts `% -*- mode-name -*-' if not present. -You should insert this in your TeX-mode-hook!" - (interactive "*") - (save-excursion - (goto-char (point-min)) - (if (not (re-search-forward "-\\*-.*-\\*-" 100 t)) - (insert-string (concat "% -*- " - (substring (symbol-name major-mode) 0 -5) - " -*-\n"))))) - -(defun auc-tex-mode () - "Called when we have a mode line specification in first line." - (interactive) - (plain-tex-mode)) - -(defun auc-latex-mode () - "Called when we have a mode line specification in first line." - (interactive) - (latex-mode)) - -;;; Validation - -(defun TeX-validate-buffer () - "Check current buffer for paragraphs containing mismatched $'s. -As each such paragraph is found, a mark is pushed at its beginning, -and the location is displayed for a few seconds." - (interactive) - (let ((opoint (point))) - (goto-char (point-max)) - ;; Does not use save-excursion - ;; because we do not want to save the mark. - (unwind-protect - (while (and (not (input-pending-p)) (not (bobp))) - (let ((end (point))) - (search-backward "\n\n" nil 'move) - (or (TeX-validate-paragraph (point) end) - (progn - (push-mark (point)) - (message "Mismatch found in pararaph starting here") - (sit-for 4))))) - (goto-char opoint)))) - -(defun TeX-validate-paragraph (start end) - (condition-case () - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char start) - (forward-sexp (- end start)) - t)) - (error nil))) - -(defun TeX-terminate-paragraph (inhibit-validation) - "Insert two newlines, breaking a paragraph for TeX. -Check for mismatched braces/$'s in paragraph being terminated. -A prefix arg inhibits the checking." - (interactive "*P") - (or inhibit-validation - (TeX-validate-paragraph - (save-excursion - (search-backward "\n\n" nil 'move) - (point)) - (point)) - (message "Paragraph being closed appears to contain a mismatch")) - (reindent-then-newline-and-indent) - (newline-and-indent)) - -;;; Miscellaneous - -(defun TeX-cmd-on-region (begin end command) - "Reads a (La)TeX-command. Makes current region a TeX-group. -Inserts command at the start of the group." - (interactive "*r\ns(La)TeX-command on region: ") - (save-excursion - (goto-char end) (insert TeX-grcl) - (goto-char begin) (insert TeX-grop TeX-esc command " "))) - -(provide 'auc-old) -(provide 'auc-tex) - -;;; auc-old.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/auctex/auto-autoloads.el --- a/lisp/auctex/auto-autoloads.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,50 +0,0 @@ -;;; DO NOT MODIFY THIS FILE -(if (not (featurep 'auctex-autoloads)) - (progn - -;;;### (autoloads (BibTeX-auto-store) "latex" "auctex/latex.el") - -(autoload 'BibTeX-auto-store "latex" "\ -This function should be called from bibtex-mode-hook. -It will setup BibTeX to store keys in an auto file." nil nil) - -;;;*** - -;;;### (autoloads nil "tex-info" "auctex/tex-info.el") - -;;;*** - -;;;### (autoloads (TeX-submit-bug-report TeX-insert-quote TeX-auto-generate-global TeX-auto-generate ams-tex-mode) "tex" "auctex/tex.el") - -(autoload 'ams-tex-mode "tex" "\ -Major mode for editing files of input for AmS TeX. -See info under AUC TeX for documentation. - -Special commands: -\\{TeX-mode-map} - -Entering AmS-tex-mode calls the value of text-mode-hook, -then the value of TeX-mode-hook, and then the value -of AmS-TeX-mode-hook." t nil) - -(autoload 'TeX-auto-generate "tex" "\ -Generate style file for TEX and store it in AUTO. -If TEX is a directory, generate style files for all files in the directory." t nil) - -(autoload 'TeX-auto-generate-global "tex" "\ -Create global auto directory for global TeX macro definitions." t nil) - -(autoload 'TeX-insert-quote "tex" "\ -Insert the appropriate quote marks for TeX. -Inserts the value of `TeX-open-quote' (normally ``) or `TeX-close-quote' -\(normally '') depending on the context. If `TeX-quote-after-quote' -is non-nil, this insertion works only after \". -With prefix argument, always inserts \" characters." t nil) - -(autoload 'TeX-submit-bug-report "tex" "\ -Submit via mail a bug report on AUC TeX" t nil) - -;;;*** - -(provide 'auctex-autoloads) -)) diff -r 6866abce6aaf -r 6075d714658b lisp/auctex/bib-cite.el --- a/lisp/auctex/bib-cite.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2722 +0,0 @@ -;; bib-cite.el - Display \cite, \ref or \label / Extract refs from BiBTeX file. - -;; Copyright (C) 1994, 1995, 1996, 1997 Peter S. Galbraith - -;; Author: Peter S. Galbraith -;; Created: 06 July 1994 -;; Version: 2.28 (22 January 97) -;; Keywords: bibtex, cite, auctex, emacs, xemacs - -;; RCS $Id: bib-cite.el,v 1.2 1997/03/08 23:25:42 steve Exp $ -;; Note: RCS version number does not correspond to release number. - -;; Everyone is granted permission to copy, modify and redistribute this -;; file provided: -;; 1. All copies contain this copyright notice. -;; 2. All modified copies shall carry a prominant notice stating who -;; made modifications and the date of such modifications. -;; 3. The name of the modified file be changed. -;; 4. No charge is made for this software or works derived from it. -;; This clause shall not be construed as constraining other software -;; distributed on the same medium as this software, nor is a -;; distribution fee considered a charge. - -;; LCD Archive Entry: -;; bib-cite|Peter Galbraith|galbraith@mixing.qc.dfo.ca| -;; Display \cite, \ref or \label / Extract refs from BiBTeX file.| -;; 22-Jan-1997|2.28|~/misc/bib-cite.el.gz| - -;; ---------------------------------------------------------------------------- -;;; Commentary: - -;; New versions of this package (if they exist) may be found at: -;; ftp://ftp.phys.ocean.dal.ca/users/rhogee/elisp/bib-cite.el - -;; Operating Systems: -;; Works in unix, DOS and OS/2. Developped under Linux. -;; VMS: I have no clue if this works under VMS. I don't know how emacs handle -;; logical names (i.e. for BIBINPUTS) but I am willing to fix this package for -;; VMS if someone if willing to test it and answer questions. - -;; AUC-TEX USERS: -;; auc-tex is a super-charged LaTeX mode for emacs. Get it at: -;; ftp://ftp.iesd.auc.dk/pub/emacs-lisp/auctex.tar.gz <-stable release -;; ftp://ftp.dina.kvl.dk/pub/Staff/Per.Abrahamsen/auctex/ <-alpha release -;; -;; WWW users may want to check out the AUC TeX page at -;; http://www.iesd.auc.dk/~amanda/auctex/ -;; -;; bib-cite.el is included in the auc-tex distribution. Therefore, if -;; you use auc-tex, you probably have an old version of bib-cite.el in -;; your load-path which may get loaded instead of this file (unless this -;; is the auc-tex file!). Make sure you replace that file, or rename it, -;; or delete it!!! - -;; MS-DOS USERS: -;; Multifile documents are supported by bib-cite by using etags (TAGS files) -;; which contains a bug for MSDOS (at least for emacs 19.27 it does). -;; Get the file -;; ftp://ftp.phys.ocean.dal.ca/users/rhogee/elisp/bib-cite.etags-bug-report -;; to see what patches to make to etags.c to fix it. - -;; Description: -;; ~~~~~~~~~~~ -;; This package is used in various TeX modes to display or edit references -;; associated with \cite commands, or matching \ref and \label commands. -;; (so I actually overstep BiBTeX bounds here...) -;; These are the functions: -;; -;; bib-display bib-display-mouse -;; - Display citation, \ref or \label under point -;; bib-find bib-find-mouse -;; - Edit citation, \ref or \label under point -;; bib-make-bibliography - Make BiBTeX file containing only cite keys used. -;; bib-apropos - Search BiBTeX source files for keywords. -;; bib-etags - Refreshes (or builds) the TAGS files for -;; multi-file documents. -;; bib-create-auto-file - Used in bibtex-mode to create cite key -;; completion .el file for auctex. -;; bib-highlight-mouse - Highlight \cite, \ref and \label commands in -;; green when the mouse is over them. - -;; About Cite Commands and related functions: -;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -;; Various flavors of \cite commands are allowed (as long as they contain -;; the word `cite') and they may optionally have bracketed [] options. -;; Bibtex Cross-references are displayed, and @string abbreviations are -;; substituted or included. -;; -;; The \cite text is found (by emacs) in the bibtex source files listed in the -;; \bibliography command. The BiBTeX files can be located in a search path -;; defined by an environment variable (typically BIBINPUTS, but you can change -;; this). -;; -;; All citations used in a buffer can also be listed in a new bibtex buffer by -;; using bib-make-bibliography. This is useful to make a bibtex file for a -;; document from a large bibtex database. In this case, cross-references are -;; included, as well as the @string commands used. The @string abbreviations -;; are not substituted. -;; -;; The bibtex files can also be searched for entries matching a regular -;; expression using bib-apropos. - -;; Usage instructions: -;; ~~~~~~~~~~~~~~~~~~ -;; bib-display Bound to Mouse-3 when specially highlighted. -;; In Hyperbole, bound to the Assist key. -;; Bound to `\C-c b d' -;; -;; bib-display will show the bibtex entry or the corresponding label or -;; ref commands from anywhere within a document. -;; With cursor on the \cite command itslef -;; -> display all citations of the cite command from the BiBTeX source. -;; With cursor on a particular cite key within the brackets -;; -> display that citation's text from the BiBTeX source file(s). -;; -;; Example: -;; -;; \cite{Wadhams81,Bourke.et.al87,SchneiderBudeus94} -;; ^Cursor -> Display-all-citations ^Cursor -> Display-this-citation -;; -;; With cursor on a \label command -;; -> Display first matching \ref command in the document -;; With cursor on a \ref command -;; -> Display environment associated with the matching \label command. -;; -;; Finding a ref or label within a multi-file document requires a TAGS file, -;; which is automatically generated for you. This enables you to then use -;; any tags related emacs features. -;; -;; bib-find Bound to Mouse-2 when specially highlighted. -;; In Hyperbole, bound to the Action key. -;; Bound to `\C-c b f' -;; -;; bib-find will select the buffer and move point to the BiBTeX source file -;; at the proper citation for a cite command, or move point to anywhere -;; within a document for a label or ref command. The ref chosen is the -;; first occurrance within a document (using a TAGS file). If point is -;; moved within the same buffer, mark is set before the move and a message -;; stating so is given. If point is moved to another file, this is done in -;; a new window using tag functions. Within a plain file, the search -;; pattern is set for another similar \ref command (since TAGS file are not -;; used). Within a multi-file document the following tag functions are -;; appropriately setup: -;; -;; C-u M-. Find next alternate definition of last tag specified. -;; -;; C-u - M-. Go back to previous tag found. -;; -;; -;; For multi-file documents, you must be using auctex (so that bib-cite can -;; find the master file) and all \input and \include commands must be first -;; on a line (not preceded by any non-white text). -;; -;; imenu support (Suggested key binding: Shift-Mouse-3) -;; -;; If you want to bind imenu globally to Shift-Mouse-3, do so by adding the -;; following to your ~/.emacs -;; -;; (require 'imenu) -;; (define-key global-map [S-mouse-3] 'imenu) -;; -;; Another good place to define Imenu is in the menu-bar. You can try this -;; manually with -;; -;; M-x imenu-add-to-menubar RET Imenu RET -;; -;; or in a hook such as: -;; -;; (add-hook 'LaTeX-mode-hook '(lambda () (imenu-add-to-menubar "Imenu"))) -;; -;; The imenu facility (distributed with emacs) is supported by bib-cite to -;; move point to a LaTeX section (or chapter) division or to a label -;; declaration. When editing a multi-file document, all such declarations -;; within the document are displayed in the menu (again using a TAGS file). -;; If you do not want to load imenu.el and use these features, set -;; bib-use-imenu to nil. (This feature is disabled in xemacs because I'm -;; told it doesn't have imenu). -;; -;; bib-make-bibliography: Bound to `\C-c b m' -;; -;; Extract citations used in the current document from the \bibliography{} -;; file(s). Put them into a new suitably-named buffer. In a auctex -;; multi-file document, the .aux files are used to find the cite keys (for -;; speed). You will be warned if these are out of date. -;; -;; This buffer is not saved to a file. It is your job to save it to whatever -;; name you wish. Note that auctex has a unique name space for LaTeX and -;; BiBTeX files, so you should *not* name the bib file associated with -;; example.tex as example.bib! Rather, name it something like -;; example-bib.bib. -;; -;; bib-apropos: Bound to `\C-c b a' -;; -;; Searches the \bibliography{} file(s) for entries containing a keyword and -;; display them in the *help* buffer. You can trim down your search by using -;; bib-apropos in the *Help* buffer after the first invocation. the current -;; buffer is also searched for keyword matches if it is in bibtex-mode. -;; -;; It doesn't display cross-references nor does it substitute or display -;; @string commands used. It could easily be added, but it's faster this -;; way. Drop me a line if this would be a useful addition. -;; -;; If you find yourself entering a cite command and have forgotten which key -;; you want, but have entered a few initial characters as in `\cite{Gal', -;; then invoke bib-apropos. It will take that string (in this case `Gal') as -;; an initial response to the apropos prompt. You are free to edit it, or -;; simply press carriage return. -;; -;; bib-etags: Bound to `\C-c b e' -;; -;; Creates a TAGS file for auc-tex's multi-file document (or refreshes it). -;; This is used by bib-find when editing multi-file documents. The TAGS file -;; is created automatically, but it isn't refreshed automatically. So if -;; bib-find can't find something, try running bib-etags again. The *rescan* -;; in imenu also calls bib-etags to refresh the TAGS file, so that is another -;; way to generate it. -;; -;; bib-create-auto-file: -;; -;; Use this when editing a BiBTeX buffer to generate the auc-tex .el file -;; which tell emacs about all its cite keys. I've added this command to -;; bibtex-mode pull-down menu. -;; -;; bib-highlight-mouse: Bound to `\C-c b h' -;; -;; Highlights \cite, \ref and \label commands in green when the mouse is over -;; them. By default, a call to this function is added to LaTeX-mode-hook -;; (via bib-cite-initialize) if you set bib-highlight-mouse-t to true. But -;; you may want to run this command to refresh the highlighting for newly -;; edited text. - -;; Installation instructions: -;; ~~~~~~~~~~~~~~~~~~~~~~~~~ -;; If you use a menued environment (e.g. X Window System), bib-cite must be -;; loaded *after* your LaTeX-mode menus are created in order to bypass an -;; annoying bug in bib-cite. This is done by loading bib-cite via a -;; mode-hook: -;; - If you are using AUC-TeX (http://sunsite.auc.dk/auctex/), add the -;; following lines to your ~/.emacs file: -;; -;; (defun my-LaTeX-mode-hook () -;; (require 'bib-cite)) -;; (add-hook 'LaTeX-mode-hook 'my-LaTeX-mode-hook) -;; -;; - If you are using Emacs' regulare LaTeX-mode, use instead: -;; -;; (defun my-LaTeX-mode-hook () -;; (require 'bib-cite)) -;; (add-hook 'latex-mode-hook 'my-TeX-mode-hook) -;; -;; If you do not use a windowed environment, all you need to do is add this -;; line to your .emacs file: -;; -;; (require 'bib-cite) -;; -;; bib-cite can be used with auctex, or stand-alone. If used with auctex on a -;; multi-file document (and auctex's parsing is used), then all \bibliography -;; commands in the document will be found and used. -;; --- -;; The following variable can be unset (like shown) to tell bib-cite to -;; not give advice messages about which commands to use to find the next -;; occurrence of a search: -;; -;; (setq bib-novice nil) -;; --- -;; By default, bib-cite adds a menu-bar pull-down menu under a separate name. -;; Under emacs' tex-mode and auctex's latex-mode, it can be placed within -;; the existing menu if you set the following: -;; -;; (setq bib-cite-put-menu-separately nil) -;; -;; This variable has no effect under XEmacs. Should I change this? -;; --- -;; The imenu features will be disabled if you set this variable to nil -;; -;; (setq bib-use-imenu nil) -;; -;; This variable has no effect under XEmacs. -;; --- -;; If you use hilit19 (or hl319), then bib-display will use it to highlight -;; the display unless you turn this off with: -;; -;; (setq bib-hilit-if-available nil) -;; -;; If you don't use hilit19, or if this is nil, and if you use font-lock -;; then it will be used by bib-display. -;; --- -;; The variable bib-switch-to-buffer-function sets the function used to -;; select buffers (if they differ from the original) in bib-cite commands -;; bib-make-bibliography, bib-display, bib-find -;; You may use `switch-to-buffer' `switch-to-buffer-other-window' or -;; `switch-to-buffer-other-frame'. -;; --- -;; The following variable determines whether we will attempt to highlight -;; citation, ref and label commands in green when they are under the -;; mouse. When highlighted, the mouse keys work to call bib-display -;; (bound to [mouse-3]) and bib-find (bound to [mouse-2]). If you use a -;; mode other than LaTeX-mode, you'll want to call bib-highlight-mouse with -;; a hook (See how we do this at the end of this file with the add-hook -;; command). -;; -;; (setq bib-highlight-mouse-t nil) -;; --- -;; If you use DOS or OS/2, you may have to set the following variable: -;; -;; (setq bib-dos-or-os2-variable t) -;; -;; if bib-cite.el fails to determine that you are using DOS or OS/2. -;; Try `C-h v bib-dos-or-os2-variable' to see if it needs to be set manually. -;; --- -;; bib-cite needs to call the etags program with its output file option -;; and also with the append option (usually -a). -;; I figured that DOS and OS/2 would use "etags /o=" instead of the unix -;; variant "etags -o ", but users have reported differently. So while the -;; unix notation is used here, you can reset it if you need to like so: -;; -;; (setq bib-etags-command "etags /o=") -;; (setq bib-etags-append-command "etags /a /o=") -;; --- -;; For multi-file documents, a TAGS file is generated by etags. -;; By default, its name is TAGS. You can change this like so: -;; -;; (setq bib-etags-filename "TAGSLaTeX") -;; --- -;; If your environment variable to find BiBTeX files is not BIBINPUTS, then -;; reset it with the following variable (here, assuming it's TEXBIB instead): -;; -;; (setq bib-bibtex-env-variable "TEXBIB") -;; -;; Note that any directory ending in a double slash will cause bib-cite to -;; search recursively through subdirectories for your .bib files. This can -;; be slow, so use this judiciously. -;; e.g. setenv BSTINPUTS .:/home/rhogee/LaTeX/bibinputs// -;; -> all directories below /home/rhogee/LaTeX/bibinputs/ will be -;; searched. -;; --- -;; If you do not wish bib-display to substitute @string abbreviations, -;; then set the following variable like so: -;; -;; (setq bib-substitute-string-in-display nil) -;; --- -;; Warnings are given when @string abbreviations are not defined in your bib -;; files. The exception is for months, usually defined in style files. If you -;; use other definitions in styles file (e.g. journals), then you may add them -;; to the `bib-substitute-string-in-display' list variable. - -;; If you find circumstances in which this package fails, please let me know. - -;; Things for me to do in later versions: -;; - jmv@di.uminho.pt (Jose Manuel Valenca) wants: -;; - prompt for \cite as well as \label and \ref -;; (and use auctex's completion list) -;; - implement string concatenation, with #[ \t\n]*STRING_NAME -;; - Create new command to substitute @string text in any bibtex buffer. - -;; ---------------------------------------------------------------------------- -;;; Change log: -;; V2.28 Jan 22 97 - Peter Galbraith (RCS V1.9) -;; - Bug in bib-create-auto-file. -;; V2.27 Dec 31 96 - Peter Galbraith (RCS V1.8) -;; - allow spaces between cite keys. -;; - Vladimir Alexiev -;; Allow () delimiters as well as {}. -;; Better check on bibtex-menu -;; Erase *bibtex-bibliography* buffer. -;; V2.26 Sep 24 96 - Peter Galbraith (RCS V1.7) -;; imenu bug fix. -;; V2.25 Sep 23 96 - Anders Stenman (RCS V1.6) -;; XEmacs bib-cite-fontify-help-as-latex bug fix. -;; V2.24 Aug 19 96 - Peter Galbraith (RCS V1.3) -;; XEmacs bug fix, minor defvars - Vladimir Alexiev -;; V2.23 Aug 13 96 - Peter Galbraith (RCS V1.2) -;; XEmacs - Add bib-cite entries to bibtex-mode popup menu. -;; V2.22 July 22 96 - Peter Galbraith (RCS V1.1) -;; local-map has `m' for bib-make-bibliography instead of `b' -;; set-buffer-menubar in XEmacs so that menu disappears after use. -;; V2.21 July 12 96 - Peter Galbraith -;; Define `\C-c b' keymap for both plain tex and auctex, in XEmacs and emacs. -;; Separate menu-bar menu in gnu emacs. -;; font-lock support for bib-display'ed citations (bibtex fontification) -;; and for matching \ref{} and \labels (latex fontification). -;; buffer-substring-no-properties in bib-apropos -;; (bug in completing-read with mouse faces) -;; imenu-sort-function made local and nil. -;; imenu--LaTeX-name-and-position fixed for section name containing "\" -;; Various other things... (whitespace within label strings, etc...) -;; V2.20 June 25 96 - Peter Galbraith -;; imenu fixed for emacs-19.31. -;; V2.19 May 13 96 -;; PSG: -;; - @string substitution fixed; bib-edit-citation fixed when buffer exists; -;; Christoph Wedler : -;; - Added bib-switch-to-buffer-function -;; - (setq tags-always-exact nil) for xemacs -;; - removed eval-after-load foe xemacs -;; V2.18 May 06 96 - PSG -;; New eval-after-load from Fred Devernay -;; V2.17 May 03 96 - PSG -;; Fixed bug introduced in V2.16, reported by Dennis Dams -;; V2.16 May 02 96 - Vladimir Alexiev -;; - somewhat compatible with Hyperbole by binding bib-find and bib-display to -;; the Action and Assist keys inside the bib-highlight-mouse-keymap. -;; - makes more liberal provisions for users with a tty. -;; V2.15 Apr 09 96 - -;; - fix "Buffer read-only" error caused by mouse-face text properties -;; patch by Piet van Oostrum -;; - Use tmm non-X menu, patch by Vladimir Alexiev -;; - input{file.txt} would not work. -;; bug report: David Kastrup -;; V2.14 Feb 26 96 - PSG - define eval-after-load for xemacs -;; Frederic Devernay's suggestion. -;; V2.13 Feb 08 96 - Peter Galbraith - Fixed recursive use of bib-apropos. -;; V2.12 Jan 19 96 - Peter Galbraith -;; emacs-19.30's [down-mouse-1] is defined (rather than [mouse-1]), so -;; bib-highlight-mouse-keymap now has [down-mouse-1] defined to override it. -;; V2.11 Nov 21 95 - Peter Galbraith -;; - Fixed bib-create-auto-file when bib file loaded before LaTeX file. -;; - Michal Mnuk's better imenu labels menu -;; - [mouse-1] and [mouse-2] key defs for highlighted regions. -;; - Improve X menus. -;; - Skip over style files in bib-document-TeX-files. -;; - Add menus and mouse highlighting for xemacs -;; Anders Stenman Dima Barsky -;; - Check bib-use-imenu before calling LaTeX-hook-setq-imenu. -;; From: Kurt Hornik -;; - Remove mouse face properties before inserting new ones. -;; From: Peter Whaite -;; V2.10 Aug 17 95 - Peter Galbraith - fatal bugs in bib-make-bibliography. -;; V2.09 Jul 19 95 - Peter Galbraith -;; - Had introduced bug in search-directory-tree. synced with ff-paths.el. -;; V2.08 Jul 13 95 - Peter Galbraith -;; Fred Douglis says etags should be required -;; V2.07 Jul 04 95 - Peter Galbraith -;; - Minor changes with filename manipulations (careful with DOS...) -;; - Problem if auc-tex not already loaded -> LaTeX-mode-map -;; V2.06 Jul 03 95 - Peter Galbraith - Added recursion through BIBINPUTS path. -;; V2.05 Jun 22 95 - Peter Galbraith Bug: Hanno Wirth -;; bib-get-citations would truncate @String{KEY ="J. {\"u} Res."} -;; V2.04 Jun 19 95 - Peter Galbraith - -;; - use bibtex-mode syntax table in bib buffer, else bib-apropos truncates -;; an article if it contains an unbalanced closing parenthesis. -;; - bib-highlight-mouse would mark a buffer modified -;; V2.03 May 16 95 - Peter Galbraith - -;; auc-tec menu compatible with old "AUC TeX" pull-down name -;; V2.02 May 10 95 - Peter Galbraith - -;; bug report by Bodo Huckestein (getenv env) under DOS -;; V2.01 Mar 27 95 - Peter Galbraith - No imenu on xemacs; check BIBINPUT also -;; V2.00 Mar 27 95 - Peter Galbraith -;; - bib-find and bib-display replace bib-edit-citation and -;; bib-display-citation -;; - bib-apropos now take initial guess from start of cite argument at point. -;; - Multi-file support for bib-make-bibliography using .aux files. -;; - \label and \ref functionality for bib-find and bib-display: -;; - \label may appear within an \begin\end or to label a (sub-)section. -;; - Cursor on \label, goto first \ref, set next i-search to pattern. -;; - Cursor on \ref, goto \label or display it's environment or section. -;; - Works on hidden code! -;; V1.08 Jan 16 95 - Peter Galbraith -;; bib-apropos can be used within *Help* buffer to trim a search. -;; V1.07 Dec 13 94 - Peter Galbraith -;; - Fixed: multi-line @string commands in non-inserted display. -;; - Fixed: quoted \ character in @string commands. -;; - BiBTeX comments should not affect bib-cite -;; - Fixed bib-apropos (from Christoph Wedler ) -;; Faster now, and avoids infinite loops. -;; - Added bib-edit-citation to edit a bibtex files about current citation. -;; - Allow space and newlines between citations: \cite{ entry1, entry2} -;; - Added bib-substitute-string-in-display, bib-string-ignored-warning -;; and bib-string-regexp. -;; - bib-display-citation (from Markus Stricker ) -;; Could not find entry with trailing spaces -;; V1.06 Nov 20 94 - Peter Galbraith -;; - Fixed bib-apropos for: -;; hilighting without invoking bibtex mode. -;; display message when no matches found. -;; would search only last bib file listed (forgot to `goto-char 1') -;; - Fixed bib-make-bibliography that would only see first citation in a -;; multi-key \cite command (found by Michail Rozman -;; - bib-make-bibliography didn't see \cite[A-Z]* commands. -;; Found by Richard Stanton -;; ************************************************** -;; - * Completely rewritten code to support crossrefs * -;; ************************************************** -;; - autodetection of OS/2 and DOS for bib-dos-or-os2-variable -;; - Created bib-display-citation-mouse -;; - bib-apropos works in bibtex-mode on the current buffer -;; - bibtex entry may have comma on next line (!) -;; @ARTICLE{Kiryati-91 -;; , YEAR = {1991 } -;; ... -;; V1.05 Nov 02 94 - Peter Galbraith -;; - bug fix by rossmann@TI.Uni-Trier.DE (Jan Rossmann) -;; for (boundp 'TeX-check-path) instead of fboundp. Thanks! -;; - Translate environment variable set by bib-bibtex-env-variable. -;; (suggested by Richard Stanton ) -;; - add bib-dos-or-os2-variable to set environment variable path separator -;; - Add key-defs for any tex-mode and auc-tex menu-bar entries. -;; [in auc-tec TeX-mode-map is common to both TeX and LaTeX at startup -;; (but TeX-mode-map is only copied to LaTeX-mode-map at initilisation) -;; in plain emacs, use tex-mode-map for both TeX and LaTeX.] -;; - Add key def for bibtex-mode to create auc-tex's parsing file. -;; - Fix bugs found by -;; - fix bib-get-citation for options -;; - fix bib-get-citation for commas preceded citation command -;; - better regexp for citations and their keys. -;; - Added @string support for any entry (not just journal entries). -;; (I had to disallow numbers in @string keys because of years. -;; Is that ok?) -;; - added bib-apropos -;; V1.04 Oct 24 94 - Peter Galbraith -;; - Don't require dired-aux, rather define the function we need from it. -;; - Regexp-quote the re-search for keys. -;; - Name the bib-make-bibliography buffer diffently than LaTeX buffer -;; because auc-tex's parsing gets confused if same name base is used. -;; V1.03 Oct 24 94 - Peter Galbraith - require dired-aux for dired-split -;; V1.02 Oct 19 94 - Peter Galbraith -;; - If using auc-tex with parsing activated, use auc-tex's functions -;; to find all \bibliography files in a multi-file document. -;; - Find bib files in pwd, BIBINPUTS environment variable path and -;; TeX-check-path elisp variable path. -;; - Have the parser ignore \bibliography that is on a commented `%' line. -;; (patched by Karl Eichwalder ) -;; - Allow for spaces between entry type and key in bib files: -;; (e.g @Article{ key} ) -;; (suggested by Nathan E. Doss ) -;; - Allows options in \cite command (e.g. agu++ package \cite[e.g.][]{key}) -;; - Includes @String{} abbreviations for `journal' entries -;; V1.01 July 07 94 - Peter Galbraith - \bibliography command may have list of -;; BibTeX files. All must be readable. -;; V1.00 July 06 94 - Peter Galbraith - Created -;; ---------------------------------------------------------------------------- -;;; Code: - -;;>>>>>>User-Modifiable variables start here: - -(defvar bib-novice t - "*Give advice to novice users about what commands to use next.") - -(defvar bib-use-imenu (not (string-match "XEmacs\\|Lucid" emacs-version)) - "*Use imenu package for LaTeX modes (coded in bib-cite).") - -(defvar bib-hilit-if-available t - "*Use hilit19 or hl319 to hilit bib-display if available") - -(defvar bib-switch-to-buffer-function 'switch-to-buffer - "*Function used to select buffers if they differ from the original. -You may use `switch-to-buffer' `switch-to-buffer-other-window' or -`switch-to-buffer-other-frame'.") - -(defvar bib-highlight-mouse-t t - "*Call bib-highlight-mouse from LaTeX-mode-hook to add green highlight.") - -(defvar bib-bibtex-env-variable "BIBINPUTS" - "*Environment variable setting the path where BiBTeX input files are found. -BiBTeX 0.99b manual says this should be TEXBIB. -Another version says it should BSTINPUTS. I don't know anymore! - -The colon character (:) is the default path separator in unix, but you may -use semi-colon (;) for DOS or OS/2 if you set bib-dos-or-os2-variable to `t'.") - -(defvar bib-dos-or-os2-variable (or (equal 'emx system-type) - (equal 'ms-dos system-type)) -;; Under OS/2 system-type equals emx -;; Under DOS system-type equals ms-dos - "*`t' if you use DOS or OS/2 for bib-make-bibliography/bib-display - -It tells bib-make-bibliography and bib-display to translate -the BIBINPUTS environment variable using the \";\" character as -a path separator and to translate DOS' backslash to slash. - -e.g. Use a path like \"c:\\emtex\\bibinput;c:\\latex\\bibinput\" - -(You can change the environment variable which is searched by setting the -elisp variable bib-bibtex-env-variable)") - -(defvar bib-etags-command "etags -o " - "*Variable for the etags command and its output option. -In unix, this is usually \"etags -o \" -In DOS and OS/2, this *may* be \"etags /o=\" If so, set it this variable.") - -(defvar bib-etags-append-command "etags -a -o " - "*Variable for the etags command and its append and output option. -In unix, this is usually \"etags -a -o \" -In DOS and OS/2, this *may* be \"etags /a /o=\" If so, set it this variable.") - -(defvar bib-etags-filename "TAGS" - "*Variable for the filename generated by etags, by defaults this TAGS -but you may want to change this to something like TAGSLaTeX such that it can -coexist with some other tags file in your master file directory.") - -(defvar bib-substitute-string-in-display t - "*Determines if bib-display will substitute @string definitions. -If t, then the @string text is substituted. -If nil, the text is not substituted but the @string entry is included.") - -(defvar bib-string-ignored-warning - '("jan" "feb" "mar" "apr" "may" "jun" "jul" "aug" "sep" "sept" "oct" "nov" - "dec") - "*List of @string abbreviations for which a warning is given if not defined. -These are usually month abbreviations (or journals) defined in a style file.") - -;;<<<<<-]+\\)?" - (2 font-lock-function-name-face) - (3 font-lock-reference-face nil t)) - ;; reference type and reference label - ("^[ \t]*\\(OPT[^\"#%'(),={} \t\n0-9][^\"#%'(),={} \t\n]*\\)[ \t]*=" - 1 font-lock-comment-face) - ;; optional field names (treated as comments) - ("^[ \t]*\\([^\"#%'(),={} \t\n0-9][^\"#%'(),={} \t\n]*\\)[ \t]*=" - 1 font-lock-variable-name-face) - ;; field names - "Default expressions to fontify in BibTeX mode.")) - -(defvar bib-cite-bibtex-mode-syntax-table - (let ((st (make-syntax-table))) - ;; [alarson:19920214.1004CST] make double quote a string quote - (modify-syntax-entry ?\" "\"" st) - (modify-syntax-entry ?$ "$$ " st) - (modify-syntax-entry ?% "< " st) - (modify-syntax-entry ?' "w " st) - (modify-syntax-entry ?@ "w " st) - (modify-syntax-entry ?\\ "\\" st) - (modify-syntax-entry ?\f "> " st) - (modify-syntax-entry ?\n "> " st) - (modify-syntax-entry ?~ " " st) - st)) -;; Code from bibtex.el ends - -;; @string starts with a letter and does not contain any of ""#%'(),={} -;; Here we do not check that the field contains only one string field and -;; nothing else. -(defvar bib-string-regexp - "^[, \t]*[a-zA-Z]+[ \t]*=[ \t]*\\([a-zA-Z][^#%'(),={}\" \t\n]*\\)" - "Regular expression for field containing a @string") - -(defvar bib-ext-list nil - "xemacs buffer-local list of bib-cite extents.") -(make-variable-buffer-local 'bib-ext-list) - -(defun bib-display () - "Display BibTeX citation or matching \\ref or \\label command under point. - -If text under cursor is a \\cite command, then display its BibTeX info from -\\bibliography input file. - Example with cursor located over cite command or arguments: - \cite{Wadhams81,Bourke.et.al87,SchneiderBudeus94} - ^Display-all-citations ^Display-this-citation - -If text under cursor is a \\ref command, then display environment associated -with its matching \\label command. - -If text under cursor is a \\label command, then display the text around -the first matching \\ref command. - -The user is prompted for a \\label or \\ref is nothing suitable is found under -the cursor. The first prompt is for a label. If you answer with an empty -string, a second prompt for a ref will be given. - -A TAGS file is created and used for multi-file documents under auctex." - (interactive) - (let ((cite)) - (save-excursion - (if (not (looking-at "\\\\")) - (re-search-backward "[\\]" nil t)) - (if (looking-at "\\\\[a-zA-Z]*cite") - (setq cite t))) - (if cite - (bib-display-citation) - (bib-display-label)))) - -(defun bib-find () - "Edit BibTeX citation or find matching \\ref or \\label command under point. - -For multi-entry cite commands, the cursor should be on the actual cite key -desired (otherwise a random entry will be selected). -e.g.: \cite{Wadhams81,Bourke.et.al87,SchneiderBudeus94} - ^Display-this-citation - -If text under cursor is a \\ref command, then point is moved to its matching -\\label command. - -If text under cursor is a \\label command, then point is moved to the first -matching \\ref command. - -The user is prompted for a \\label or \\ref is nothing suitable is found under -the cursor. The first prompt is for a label. If you answer with an empty -string, a second prompt for a ref will be given. - -A TAGS file is created and used for multi-file documents under auctex." - (interactive) - (let ((cite)) - (save-excursion - (if (not (looking-at "\\\\")) - (re-search-backward "[ \\\n]" nil t)) - (if (looking-at "\\\\[a-zA-Z]*cite") - (setq cite t))) - (if cite - (bib-edit-citation) - (bib-find-label)))) - -(defun bib-display-mouse (EVENT) - "Display BibTeX citation or matching \\ref or \\label command under mouse. -See bib-display." - (interactive "e") - (mouse-set-point EVENT) - (bib-display)) - -(defun bib-find-mouse (EVENT) - "Edit BibTeX citation or find matching \\ref or \\label command under mouse. -See bib-find." - (interactive "e") - (mouse-set-point EVENT) - (bib-find)) - -(defun bib-apropos () - "Display BibTeX entries containing a keyword from bibliography file. -The files specified in the \\bibliography command are searched unless -the current buffer is in bibtex-mode or is the Help buffer. In those -cases, *it* is searched. This allows you to trim down a search further -by using bib-apropos sequentially." - ;;(interactive "sBibTeX apropos: ") - (interactive) - (let* ((keylist (and (boundp 'TeX-auto-update) ;Avoid error in FRAMEPOP - (fboundp 'LaTeX-bibitem-list) ;Use this if using auctex - (LaTeX-bibitem-list))) - (keyword (bib-apropos-keyword-at-point)) - (keyword (completing-read "BiBTeX apropos: " keylist nil nil keyword)) - (the-text)(key-point)(start-point) - (new-buffer-f (and (not (string-match "^bib" mode-name)) - (not (string-equal "*Help*" (buffer-name))))) - (bib-buffer (or (and new-buffer-f (bib-get-bibliography nil)) - (current-buffer)))) - (save-excursion - (set-buffer bib-buffer) - (goto-char (point-min)) - (while (and (re-search-forward "^[ \t]*@" nil t) - (re-search-forward keyword nil t)) - (setq key-point (point)) ;To make sure this is within entry - (re-search-backward "^[ \t]*@" nil t) - (setq start-point (point)) - (forward-list 1) - (if (< (point) key-point) ;And this is that test... - (goto-char key-point) ;Not within entry, skip it. - (setq the-text - (cons (concat (buffer-substring start-point (point)) "\n") - the-text)))) - (if (not the-text) - (message "Sorry, no matches found.") - (with-output-to-temp-buffer "*Help*" - (mapcar 'princ (nreverse the-text))) - (if bib-novice - (message - (substitute-command-keys - (concat "Use \\[bib-apropos] again in the *help* buffer" - " to trim the search")))) - (cond - ((and bib-hilit-if-available - (fboundp 'hilit-highlight-region)) - (set-buffer "*Help*") - (hilit-highlight-region (point-min) (point-max) 'bibtex-mode t)) - ;; font-lock? - ((featurep 'font-lock) - (set-buffer "*Help*") - (set (make-local-variable 'font-lock-defaults) - '(bib-cite-bibtex-font-lock-keywords - nil t ((?$ . "\"")(?\" . ".")))) - (font-lock-fontify-buffer)))) - (if new-buffer-f - (kill-buffer bib-buffer))))) - -(defvar bib-document-citekeys-obarray-warnings nil - "bib-cite internal variable") - -(defun bib-make-bibliography () - "Extract citations used in the current document from \bibliography{} file(s). -Put them into a buffer named after the current buffer, with extension .bib. - -In an auc-tex multi-file document, parsing must be on and the citation keys -are extracted from the .aux files. - -In a plain LaTeX buffer (not multi-file), the cite keys are extracted from -the text itself. Therefore the text need not have been previously processed -by LaTeX. - -This function is useful when you want to share a LaTeX file, and therefore want -to create a bibtex file containing only the references used in the document." - (interactive) - (let* ((the-keys-obarray (or (bib-document-citekeys-obarray) - (bib-buffer-citekeys-obarray))) - ;1st in case of error - (new-buffer - (create-file-buffer - (concat (substring (buffer-name) 0 - (or (string-match "\\." (buffer-name)) - (length (buffer-name)))) - "-bib.bib"))) - (bib-buffer (bib-get-bibliography nil)) - (the-warnings (bib-get-citations the-keys-obarray - bib-buffer - new-buffer - nil))) - (kill-buffer bib-buffer) -;;; (switch-to-buffer new-buffer) - (funcall bib-switch-to-buffer-function new-buffer) - (bibtex-mode) - (cond - ((and bib-hilit-if-available - (fboundp 'hilit-highlight-region)) - (hilit-highlight-buffer t)) - ((featurep 'font-lock) ;Perhaps let the user's setup determine - (font-lock-fontify-buffer))) ; if font-lock fontifies? - (if (or bib-document-citekeys-obarray-warnings - the-warnings) - (progn - (cond - ((and bib-document-citekeys-obarray-warnings the-warnings) - (with-output-to-temp-buffer "*Help*" - (princ bib-document-citekeys-obarray-warnings the-warnings))) - (bib-document-citekeys-obarray-warnings - (with-output-to-temp-buffer "*Help*" - (princ bib-document-citekeys-obarray-warnings))) - (the-warnings - (with-output-to-temp-buffer "*Help*" (princ the-warnings)))) - (setq bib-document-citekeys-obarray-warnings nil) ;Reset - (bib-cite-fontify-red))) - (if bib-novice - (message - (substitute-command-keys - "Use \\[save-buffer] to save this buffer to a file."))))) - -(defun bib-cite-fontify-red (&optional limit) - "Fontify *Help* buffer in red-bold up to optional limit" - (if (and window-system ;Not exactly correct for XEmacs - (not (facep 'red-bold))) - (progn - (copy-face 'bold 'red-bold) - (set-face-foreground 'red-bold "red"))) - (save-excursion - (set-buffer "*Help*") - (let ((before-change-functions) (after-change-functions)) - (put-text-property (point-min)(or limit (point-max)) - 'face 'red-bold)))) - -(defun bib-cite-fontify-help-as-latex () - (save-excursion - (cond - ((and bib-hilit-if-available - (fboundp 'hilit-highlight-region)) - (set-buffer "*Help*") - (hilit-highlight-region (point-min) (point-max) 'LaTeX-mode t)) - ;; font-lock? - ((and (featurep 'font-lock) - (featurep 'font-latex)) - (set-buffer "*Help*") - (setq font-lock-defaults '(font-latex-keywords-2 nil nil ((?$ . "\"")))) - ;; Add all syntax table for `proper' fontification? - (font-lock-fontify-buffer)) - ((featurep 'font-lock) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(tex-font-lock-keywords nil nil ((?$ . "\"")))) - (set-buffer "*Help*") - (font-lock-fontify-buffer))))) - -(defvar bib-document-TeX-files-warnings nil - "bib-cite internal variable") - -(defun bib-etags (&optional masterdir) - "Invoke etags on all tex files of the document, storing the TAGS file -in the master-directory. Expect errors if you use this outside of auctex -or within a plain single-file document. -Also makes sure that the TAGS buffer is updated. -See variables bib-etags-command and bib-etags-filename" - (interactive) - (require 'etags) - (let* ((the-file-list (bib-document-TeX-files)) - (the-file (car the-file-list)) - (dir (or masterdir (bib-master-directory))) - (the-tags-file (expand-file-name bib-etags-filename dir)) - (the-tags-buffer (get-file-buffer the-tags-file))) - ;; Create TAGS file with first TeX file (master file) - (shell-command (concat bib-etags-command the-tags-file " " the-file)) - (setq the-file-list (cdr the-file-list)) - ;; Append to TAGS file for all other TeX files. - (while the-file-list - (setq the-file (car the-file-list)) - (shell-command - (concat bib-etags-append-command the-tags-file " " the-file)) - (setq the-file-list (cdr the-file-list))) - (if the-tags-buffer ;buffer existed; we must refresh it. - (save-excursion - (set-buffer the-tags-buffer) - (revert-buffer t t))) - - ;; Check value of tags-file-name against the-tags-file - (or (equal the-tags-file tags-file-name) ;make sure it's current - (visit-tags-table the-tags-file)) - - ;(set (make-local-variable 'tags-file-name) the-tags-file)) - ;; above should not be needed - - ;; Weird Bug: - ;; (visit-tags-table-buffer) seems to get called twice when called by - ;; find-tag on an undefined tag. The second time, it's in the TAGS - ;; buffer and returns an error because TAGS buffer does have - ;; tags-file-name set. - ;; To get around this. I'm setting this variable in the TAGS buffer. - ;; Skip this in XEmacs (Changed by Anders Stenman) - (if (not (string-match "XEmacs\\|Lucid" emacs-version)) - (save-excursion - (set-buffer (get-file-buffer the-tags-file)) - (set (make-local-variable 'tags-file-name) the-tags-file)))) - - - (if bib-document-TeX-files-warnings ;free variable loose in emacs! - (progn - (with-output-to-temp-buffer "*Help*" - (princ bib-document-TeX-files-warnings)) - (setq bib-document-TeX-files-warnings nil) ;Reset - (bib-cite-fontify-red) - ;;;(if (and bib-hilit-if-available - ;;; (fboundp 'hilit-region-set-face)) - ;;; (save-excursion - ;;; (set-buffer "*Help*") - ;;; (hilit-region-set-face - ;;; 1 (point-max) - ;;; (cdr (assq 'error hilit-face-translation-table))))) - ))) - -(defun bib-Is-hidden () - "Return true is current point is hidden" - (if (not selective-display) - nil ;Not hidden if not using this... - (save-excursion - (if (not (re-search-backward "[\n\^M]" nil t)) - nil ;Play safe - (if (string-equal (buffer-substring (match-beginning 0)(match-end 0)) - "\n") - nil - t))))) - -(defun bib-highlight-mouse () - "Make that nice green highlight when the mouse is over LaTeX commands" - (interactive) -;;;Comment this out. User should be able to use bib-highlight-mouse -;;;to try it out regardless of bib-highlight-mouse-t. -;;;Check bib-highlight-mouse-t only in automated cases. -;;; -;;; (if (and bib-highlight-mouse-t -;;; ;;window-system) ;Do nothing unless under X -;;; ) -;;; *all of code was here* -;;; ) - (save-excursion - (let ((s)(e)(extent) - (inhibit-read-only t) - (modified (buffer-modified-p))) ;put-text-property changing this? - (goto-char (point-min)) - ;; * peta Wed Nov 8 16:27:29 1995 -- better remove the mouse face - ;; properties first. - (if (string-match "XEmacs\\|Lucid" emacs-version) - (while bib-ext-list - (delete-extent (car bib-ext-list)) - (setq bib-ext-list (cdr bib-ext-list))) - ;; Remove properties for regular emacs - ;; FIXME This detroys all mouse-faces and local-maps! - ;; FIXME Hope no other package is using them in this buffer! - (let ((before-change-functions) (after-change-functions)) - (remove-text-properties (point-min) (point-max) - '(mouse-face t local-map t)))) - (while - (re-search-forward - "\\\\\\(ref\\|label\\|[A-Za-z]*cite[A-Za-z]*\\(\\[.*\\]\\)?\\){[^}]*}" - nil t) - (setq s (match-beginning 0)) - (setq e (match-end 0)) - (cond - ((string-match "XEmacs\\|Lucid" emacs-version) - (setq extent (make-extent s e)) - (setq bib-ext-list (cons extent bib-ext-list)) - (set-extent-property extent 'highlight t) - (set-extent-property extent 'start-open t) - (set-extent-property extent 'keymap bib-highlight-mouse-keymap)) - (t - (let ((before-change-functions) (after-change-functions) - ;;(this-overlay (make-overlay s e)) - ) -;;; Even using overlays doens't help here. If bib-highlight-mouse-keymap -;;; does not include the AucTeX menus, then these disappear when we click -;;; onto a \cite command. Perhaps using bib-cite as a minor mode will fix -;;; this? For now, bib-cite must be loaded after these menus are built. -;;; It must therefore be loaded in a mode-hook. - (put-text-property s e 'local-map bib-highlight-mouse-keymap) - (put-text-property s e 'mouse-face 'highlight) - ;;(overlay-put this-overlay 'local-map bib-highlight-mouse-keymap) - ;;(overlay-put this-overlay 'mouse-face 'highlight) - )))) - (set-buffer-modified-p modified)))) - -(defun bib-toggle-highlight () - (interactive) - (if (setq bib-highlight-mouse-t (not bib-highlight-mouse-t)) - (bib-highlight-mouse) - (let ((modified (buffer-modified-p)) - (inhibit-read-only t)) - (cond - ((string-match "XEmacs\\|Lucid" emacs-version) - (while bib-ext-list - (delete-extent (car bib-ext-list)) - (setq bib-ext-list (cdr bib-ext-list)))) - (t - (let ((before-change-functions) (after-change-functions)) - (remove-text-properties (point-min) (point-max) - '(mouse-face local-map))))) - (set-buffer-modified-p modified)))) - -;;---------------------------------------------------------------------------- -;; Routines to display or edit a citation's bibliography - -(defun bib-display-citation () - "Do the displaying of cite info. Returns t if found cite key, nil otherwise. -Example with cursor located over cite command or arguments: -\cite{Wadhams81,Bourke.et.al87,SchneiderBudeus94} - ^Display-all-citations ^Display-this-citation" - (save-excursion - (let* ((the-keys-obarray (bib-get-citekeys-obarray)) ;1st in case of error - (work-buffer (get-buffer-create "*bibtex-work*")) - (bib-buffer (bib-get-bibliography nil)) - (the-warnings (bib-get-citations - the-keys-obarray - bib-buffer - work-buffer - bib-substitute-string-in-display)) - (the-warn-point)) - (if the-warnings - (progn - (set-buffer work-buffer) - (goto-char 1) - (insert the-warnings) - (setq the-warn-point (point)))) - (with-output-to-temp-buffer - "*Help*" - (set-buffer work-buffer) - (princ (buffer-substring 1 (point-max)))) - (cond - ((and bib-hilit-if-available - (fboundp 'hilit-highlight-region)) - (set-buffer "*Help*") - (hilit-highlight-region (point-min) (point-max) 'bibtex-mode t) - (if the-warn-point - (hilit-region-set-face - 1 the-warn-point - (cdr (assq 'error hilit-face-translation-table))))) - ((featurep 'font-lock) - (set-buffer "*Help*") - (set (make-local-variable 'font-lock-defaults) - '(bib-cite-bibtex-font-lock-keywords - nil t ((?$ . "\"")(?\" . ".")))) - (font-lock-fontify-buffer) - (if the-warn-point - (bib-cite-fontify-red the-warn-point)))) - (kill-buffer bib-buffer) - (kill-buffer work-buffer)))) - -(defun bib-edit-citation () - "Do the edit of cite info. Returns t if found cite key, nil otherwise. -Find and and put edit point in bib file associated with a BibTeX citation -under cursor from \bibliography input file. -In a multi-entry cite command, the cursor should be on the actual cite key -desired (otherwise a random entry will be selected). -e.g.: \cite{Wadhams81,Bourke.et.al87,SchneiderBudeus94} - ^Display-this-citation" - (let ((the-keys-obarray (bib-get-citekeys-obarray)) ;1st in case of error - (bib-buffer (bib-get-bibliography t)) - (the-key)(the-file)) - (save-excursion - (mapatoms ;Do this for each cite-key found... - (function (lambda (cite-key) - (setq the-key (symbol-name cite-key)))) - the-keys-obarray) - (set-buffer bib-buffer) - (goto-char (point-min)) - (if (not (re-search-forward - (concat "@[^{(]+[{(][\t ]*" the-key "[ ,\n]") nil t)) - (progn - (kill-buffer bib-buffer) - (error "Sorry, could not find bib entry for %s" the-key)) - (re-search-backward "%%%Filename: \\([^\n]*\\)" nil t) - (setq the-file (buffer-substring (match-beginning 1)(match-end 1))) - (kill-buffer bib-buffer))) -;;; (find-file the-file) - (funcall bib-switch-to-buffer-function (find-file-noselect the-file)) - (goto-char (point-min)) ;V2.19 fix - (re-search-forward (concat "@[^{(]+[{(][\t ]*" the-key "[ ,\n]") nil t))) - -;;-------------------------------------------------------------------------- -;; Function for bib-apropos - -(defun bib-apropos-keyword-at-point () - ;; Returns the keyword under point for initial input to bib-apropos prompt - (save-excursion - (let ((here (point))) - (cond - ((and (re-search-backward "[\n{, ]" nil t) - (string-equal "{" (buffer-substring (match-beginning 0) - (match-end 0)))) - (if (fboundp 'buffer-substring-no-properties) - (buffer-substring-no-properties (1+ (point)) here) - (buffer-substring (1+ (point)) here))))))) - -;;-------------------------------------------------------------------------- -;; Functions for Displaying or moving to matching \ref or \label command - -(defun bib-display-label () -;; "Display environment associated with a label or first ref assoc. with label -;;The label or ref name is extracted from the text under the cursor, or the -;;user is prompted is nothing suitable is found. The first prompt is for a -;;label. If you answer with an empty string, a second prompt for a ref will -;;be given." - (let ((the-name (bib-guess-or-prompt-for-label))) - (if (not the-name) - (message "No name given") - (bib-display-or-find-label the-name t)))) - -(defun bib-find-label () - "Move to a label, or the first occurance of a ref. -The label or ref name is extracted from the text under the cursor. -;;If nothing suitable is found, the user is prompted. The first prompt is for a -;;label. If you answer with an empty string, a second prompt for a ref will be -;;given. -;; -;;If within a single file document: -;; You can move back with C-x C-x as the mark is set before moving. -;; You can search for next occurrances of a ref command with C-s C-s. -;; -;;If within a multi-file document (in auctex only) -;; You can move back with C-x C-x if within the same buffer. If not, just -;; select your previous buffer. -;; You can search for next occurrances of a ref command with tag commands: -;; C-u M-. Find next alternate definition of last tag specified. -;; C-u - M-. Go back to previous tag found." - (let ((the-name (bib-guess-or-prompt-for-label))) - (if (not the-name) - (message "No name given") - (bib-display-or-find-label the-name nil)))) - -;;-------------------------------------------------------------------------- -;; Functions for Displaying or moving to matching \ref or \label command - -(defun bib-display-or-find-label (the-name displayf) -;; work horse for bib-find-label and bib-display-label - (let* ((masterfile (bib-master-file)) - (masterdir (and masterfile - (file-name-directory masterfile))) - (new-point)(new-buffer)) - (save-excursion - ;; Now we are either in a simple file, or with a multi-file document - (cond - (masterfile ;Multi-file document - (cond - (displayf ;Display only - (set-buffer (bib-etags-find-noselect the-name masterdir)) - (re-search-forward the-name nil t) ;'cos tags puts point line begin - (if (string-match "^\\\\label" the-name) - (bib-display-this-environment) ;display the label's environment - (bib-display-this-ref))) ; display the ref's context - (t ;Move to it - (setq new-buffer (bib-etags-find-noselect the-name masterdir)) - (if bib-novice - (message - (substitute-command-keys - (concat "Use C-u \\[find-tag] to find the next occurrence; " - "Use C-u - \\[find-tag] to find the previous.")))) - (if (equal new-buffer (current-buffer)) - (setq new-point (point))) ;Moving with the same buffer - (and (string-match "^\\\\ref" the-name) - (setq search-ring (cons the-name search-ring)))))) - (t ;Single-file document - (goto-char (point-min)) - (if (search-forward the-name nil t) - (if displayf - (if (string-match "^\\\\label" the-name) - (bib-display-this-environment) ;Display the environment - (bib-display-this-ref)) ; display the ref's context - (setq new-point (match-beginning 0)) ;or move there - (if bib-novice - (message - (substitute-command-keys - (concat - "Use \\[isearch-forward] \\[isearch-forward] to find the " - "next occurrence; Use C-x C-x to go back.")))) - (if (string-match "^\\\\ref" the-name) - (setq search-ring (cons the-name search-ring)) - (setq search-ring (cons (concat "\\ref" (substring the-name 6)) - search-ring)))) - (message "Sorry, cannot find %s" the-name))))) - (if new-point - (progn - (push-mark (point) t nil) ;We've moving there... push mark - (goto-char new-point)) - (if new-buffer ;We've changing buffer -;; (switch-to-buffer new-buffer) - (funcall bib-switch-to-buffer-function new-buffer))) - (if (bib-Is-hidden) - (save-excursion - (beginning-of-line) - (show-entry))))) - -(defvar bib-label-prompt-map nil) -(if bib-label-prompt-map - () - (setq bib-label-prompt-map (copy-keymap minibuffer-local-completion-map)) - (define-key bib-label-prompt-map " " 'self-insert-command)) - -(defun bib-guess-or-prompt-for-label () - ;; Guess from context, or prompt the user for a label command - (save-excursion - (if (not (looking-at "\\\\")) ;If not on beginning of a command - (re-search-backward "[\\]" - (save-excursion (beginning-of-line)(point)) - t)) - (cond - ((looking-at "\\\\ref{") ;On \ref, looking for matching \label - (let ((b (progn (search-forward "{" nil t)(forward-char -1)(point))) - (e (progn (forward-sexp 1)(point)))) - (concat "\\label" (buffer-substring b e)))) - ((looking-at "\\\\label{") ;On \label, looking for matching \ref - (let ((b (progn (search-forward "{" nil t)(forward-char -1)(point))) - (e (progn (forward-sexp 1)(point)))) - (concat "\\ref" (buffer-substring b e)))) - (t ;Prompt the user - (let* ((minibuffer-local-completion-map bib-label-prompt-map) - (the-alist (create-alist-from-list - (cdr (reverse LaTeX-label-list)))) - ;;; LaTeX-label-list example: - ;;; '(("label3" "label4")("label1" "label2") nil) - ;; so let's get rid of that nil part in embedded list. - (the-name - (if (string-equal "18" (substring emacs-version 0 2)) - (completing-read "Label: " the-alist nil nil nil) - (completing-read "Label: " the-alist nil nil nil - 'LaTeX-find-label-hist-alist)))) - (if (not (equal the-name "")) - (concat "\\label{" the-name "}") - ;; else try to get a \ref - (if (string-equal "18" (substring emacs-version 0 2)) - (setq the-name (completing-read "Ref: " the-alist nil nil nil)) - (setq the-name (completing-read "Ref: " the-alist nil nil nil - 'LaTeX-find-label-hist-alist))) - (if (not (equal the-name "")) - (concat "\\ref{" the-name "}") - nil))))))) - -(defun bib-display-this-ref () - "Display a few lines around current point" - (cond - ((bib-Is-hidden) - (with-output-to-temp-buffer "*BiBTemp*" - (princ - (buffer-substring - (save-excursion - (let ((i 3)) - (while (and (> i 0) - (re-search-backward "[\n\^M]" nil t) - (setq i (1- i))))) - (point)) - (save-excursion - (let ((i 3)) - (while (and (> i 0) - (re-search-forward "[\n\^M]" nil t) - (setq i (1- i))))) - (point))))) - (set-buffer "*BiBTemp*") - (while (search-forward "\^M" nil t) - (replace-match "\n" nil t)) - (goto-char 1) - (if (looking-at "\n") ;Remove first empty line... - (delete-char 1)) - (with-output-to-temp-buffer "*Help*" - (princ (buffer-substring 1 (point-max)))) - (bib-cite-fontify-help-as-latex) - (kill-buffer "*BiBTemp*")) - (t - (with-output-to-temp-buffer ; display the ref's context - "*Help*" - (princ - (buffer-substring (save-excursion (forward-line -2)(point)) - (save-excursion (forward-line 3)(point))))) - (bib-cite-fontify-help-as-latex)))) - -(defun bib-display-this-environment () - "Display the environment associated with a label, or its section name -Assumes point is already on the label. -Does not save excursion." -;; Bugs: The method used here to detect the environment is *not* foolproof. -;; It will get confused, for example, between two figure environments, -;; picking out both instead of the section label above them. But since -;; users typically puts their labels next to the section declaration, -;; I'm satisfied with this... for now. -;; I could have used the following auc-tex functions: -;; LaTeX-current-environment -;; Function: Return the name (a string) of the enclosing LaTeX environment. -;; LaTeX-current-section -;; Function: Return the level of the section that contain point. -;; but then this code would only work as part of auc-tex... - (let ((the-point (point)) - (end-point (point)) - (the-environment)(foundf)) - (while (and (not foundf) - (goto-char end-point) ;Past end of last search - (re-search-forward "\\(^\\|\^M\\)[ \t]*\\\\end{\\([^}]*\\)}" - nil t)) - (setq end-point (point)) - (setq the-environment (buffer-substring (match-beginning 2) - (match-end 2))) - (and (not (string-match "document" the-environment)) - (re-search-backward (concat "\\(^\\|\^M\\)[ \t]*\\\\begin{" - (regexp-quote the-environment) "}")) - (<= (point) the-point) - (setq foundf t))) - (if foundf ;A good environment - (progn - (cond ((bib-Is-hidden) ;Better way is: replace-within-string - (with-output-to-temp-buffer "*BiBTemp*" - (princ (buffer-substring (point) end-point))) - (set-buffer "*BiBTemp*") - (while (search-forward "\^M" nil t) - (replace-match "\n" nil t)) - (goto-char 1) - (if (looking-at "\n") ;Remove first empty line... - (delete-char 1)) - (with-output-to-temp-buffer "*Help*" - (princ (buffer-substring 1 (point-max)))) - (kill-buffer "*BiBTemp*")) - (t - (with-output-to-temp-buffer "*Help*" - (princ (buffer-substring (point) end-point))))) - (bib-cite-fontify-help-as-latex)) - ;; Just find the section declaration - (goto-char the-point) - (if (re-search-backward - "\\(^\\|\^M\\)[ \t]*\\\\\\(sub\\)*section{\\([^}]*\\)}" nil t) - (message (buffer-substring (match-beginning 0)(match-end 0))) - (error - "Sorry, could not find an environment or section declaration"))))) - -(defvar LaTeX-find-label-hist-alist nil "History list for LaTeX-find-label") -(defvar LaTeX-label-list nil "Used by auc-tex to store label names") - - -(defun create-alist-from-list (the-list) -;;; Return a single list from a list that may contain either items -;;; or any number of list levels containing items. -;;; e.g. turns -;;; '(("label3" "label4")("label1" "label2") "label") -;;; into -;;; '(("label3") ("label4") ("label1") ("label2") ("label")) - (mapcar 'list (bib-cite-mh-list-to-string the-list))) - -;;; -;;; Following two functions from mh-utils.el (part of GNU emacs) -;;; I have changed the names in case these functions change what they do. -;;; - -(defun bib-cite-mh-list-to-string (l) - ;; Flattens the list L and makes every element of the new list into a string. - (nreverse (bib-cite-mh-list-to-string-1 l))) - -(defun bib-cite-mh-list-to-string-1 (l) - (let ((new-list nil)) - (while l - (cond ((null (car l))) - ((symbolp (car l)) - (setq new-list (cons (symbol-name (car l)) new-list))) - ((numberp (car l)) - (setq new-list (cons (int-to-string (car l)) new-list))) - ((equal (car l) "")) - ((stringp (car l)) (setq new-list (cons (car l) new-list))) - ((listp (car l)) - (setq new-list (nconc (bib-cite-mh-list-to-string-1 (car l)) - new-list))) - (t (error "Bad element in mh-list-to-string: %s" (car l)))) - (setq l (cdr l))) - new-list)) - -;; ------------------------------------------------------------------------- -;; Routines to extract cite keys from text - -;; ... is truly remarkable, as shown in \citeN{Thomson77,Test56}. Every -;; \cite[{\it e.g.}]{Thomson77,Test56} - -(defun bib-get-citations (keys-obarray bib-buffer new-buffer substitute) - "Put citations of KEYS-OBARRAY from BIB-BUFFER into NEW-BUFFER, -Substitute strings if SUBSTITUTE is t -Return the-warnings as text." - (let ((the-warnings) ;The only variable to remember... - (case-fold-search t)) ;All other results go into new-buffer - ;; bibtex is not case-sensitive for keys. - (save-excursion - (let ((the-text)) - (set-buffer bib-buffer) - (mapatoms ;Do this for each cite-key found... - (function - (lambda (cite-key) - (goto-char (point-min)) - (if (re-search-forward - (concat "@[^{(]+[{(][\t ]*" - (regexp-quote (symbol-name cite-key)) - "\\([, ]\\\|$\\)") - ;; ^^ ^ comma, space or end-of-line - nil t) - (setq the-text (concat the-text - (buffer-substring - (progn (beginning-of-line)(point)) - (progn (forward-sexp 2)(point))) - "\n\n")) - (setq the-warnings (concat the-warnings - "Cannot find entry for: " - (symbol-name cite-key) "\n"))))) - keys-obarray) - (if (not the-text) - (error "Sorry, could not find any of the references")) - ;; Insert the citations in the new buffer - (set-buffer new-buffer) - (insert the-text) - (goto-char 1)) - - ;; We are at beginning of new-buffer. - ;; Now handle crossrefs - (let ((crossref-obarray (make-vector 201 0))) - (while (re-search-forward - "[, \t]*crossref[ \t]*=[ \t]*\\(\"\\|\{\\)" nil t) - ;;handle {text} or "text" cases - (if (string-equal "{" (buffer-substring (match-beginning 1) - (match-end 1))) - (re-search-forward "[^\}]+" nil t) - (re-search-forward "[^\"]+" nil t)) - (intern (buffer-substring (match-beginning 0)(match-end 0)) - crossref-obarray)) - ;; Now find the corresponding keys, - ;; but add them only if not already in `keys-obarray' - (set-buffer bib-buffer) - (goto-char 1) - (let ((the-text)) - (mapatoms ;Do this for each crossref key found... - (function - (lambda (crossref-key) - (if (not (intern-soft (symbol-name crossref-key) keys-obarray)) - (progn - ;; Not in keys-obarray, so not yet displayed. - (goto-char (point-min)) - (if (re-search-forward - (concat "@[^{(]+[{(][\t ]*" - (regexp-quote (symbol-name crossref-key)) - "\\(,\\|$\\)") - nil t) - (setq the-text - (concat the-text - (buffer-substring - (progn (beginning-of-line)(point)) - (progn (forward-sexp 2)(point))) - "\n\n")) - (setq the-warnings - (concat the-warnings - "Cannot find crossref entry for: " - (symbol-name crossref-key) "\n"))))))) - crossref-obarray) - ;; Insert the citations in the new buffer - (set-buffer new-buffer) - (goto-char (point-max)) - (if the-text - (insert the-text))) - (goto-char 1)) - - ;; Now we have all citations in new-buffer, collect all used @String keys - ;; Ex: journal = JPO, - (let ((strings-obarray (make-vector 201 0))) - (while (re-search-forward bib-string-regexp nil t) - (intern (buffer-substring (match-beginning 1)(match-end 1)) - strings-obarray)) - ;; Now find the corresponding @String commands - ;; Collect either the @string commands, or the string to substitute - (set-buffer bib-buffer) - (goto-char 1) - (let ((string-alist) - (the-text)) - (mapatoms ;Do this for each string-key found... - (function - (lambda (string-key) - (goto-char (point-min)) - ;; search for @string{ key = {text}} or @string{ key = "text"} - (if (re-search-forward - (concat "^[ \t]*@string[{(]" - (regexp-quote (symbol-name string-key)) - "[\t ]*=[\t ]*\\(\"\\|\{\\)") - nil t) - (let ((the-string-start (1- (match-end 1))) ;catch bracket - ;;handle {text} or "text" cases - (the-string-end - (cond - ((string-equal "\"" - (buffer-substring (match-beginning 1) - (match-end 1))) - - (re-search-forward "[^\\]\"" nil t) - (point)) - (t - (forward-char -1) - (forward-list 1) - (point))))) - (if substitute ;Collect substitutions - (setq string-alist - (append - string-alist - (list - (cons (symbol-name string-key) - (regexp-quote - (buffer-substring the-string-start - the-string-end)))))) - ;;Collect the strings command themseves - (setq the-text - (concat the-text - (buffer-substring - (progn (forward-char 1)(point)) - (re-search-backward "^[ \t]*@string[{(]" - nil t)) - "\n")))) - ;; @string entry not found - (if (not (member (symbol-name string-key) - bib-string-ignored-warning)) - (setq the-warnings - (concat the-warnings - "Cannot find @String entry for: " - (symbol-name string-key) "\n")))))) - strings-obarray) - ;; Now we have `the-text' of @string commands, - ;; or the `string-alist' to substitute. - (set-buffer new-buffer) - (if substitute - (while string-alist - (goto-char 1) - (let ((the-key (car (car string-alist))) - (the-string (cdr (car string-alist)))) - (while (re-search-forward - (concat "\\(^[, \t]*[a-zA-Z]+[ \t]*=[ \t]*\\)" - the-key - "\\([, \t\n]\\)") - nil t) - (replace-match (concat "\\1" the-string "\\2") t))) - (setq string-alist (cdr string-alist))) - ;; substitute is nil; Simply insert text of @string commands - (goto-char 1) - (if the-text - (insert the-text "\n"))) - (goto-char 1)))) - - ;; We are done! - ;; Return the warnings... - the-warnings)) - -(defun bib-get-citekeys-obarray () - "Return obarray of citation key (within curly brackets) under cursor." - (save-excursion - ;; First find *only* a key *within a cite command - (let ((the-point (point)) - (keys-obarray (make-vector 201 0))) - ;; First try to match a cite command - (if (and (skip-chars-backward "a-zA-Z") ;Stops on \ or { - (looking-at "[a-zA-Z]*cite[a-zA-Z]*")) - (progn - ;;skip over any optional arguments to \cite[][]{key} command - (skip-chars-forward "a-zA-Z") - (while (looking-at "\\[") - (forward-list 1)) - (re-search-forward "{[ \n]*\\([^,} \n]+\\)" nil t) - (intern (buffer-substring (match-beginning 1)(match-end 1)) - keys-obarray) - (while (and (skip-chars-forward " \n") ;no effect on while - (looking-at ",")) - (forward-char 1) - ;;The following re-search skips over leading spaces - (re-search-forward "\\([^,} \n]+\\)" nil t) - (intern (buffer-substring (match-beginning 1)(match-end 1)) - keys-obarray))) - - ;; Assume we are on the keyword - (goto-char the-point) - (let ((the-start (re-search-backward "[\n{, ]" nil t)) - (the-end (progn (goto-char the-point) - (re-search-forward "[\n}, ]" nil t)))) - (if (and the-start the-end) - (intern (buffer-substring (1+ the-start) (1- the-end)) - keys-obarray) - ;; Neither... - (error "Sorry, can't find a reference here")))) - keys-obarray))) - -(defun bib-buffer-citekeys-obarray () - "Extract citations keys used in the current buffer" - (let ((keys-obarray (make-vector 201 0))) - (save-excursion - (goto-char (point-min)) - ;; Following must allow for \cite[e.g.][]{key} !!! - ;; regexp for \cite{key1,key2} was "\\\\[a-Z]*cite[a-Z]*{\\([^,}]+\\)" - (while (re-search-forward "\\\\[a-zA-Z]*cite[a-zA-Z]*\\(\\[\\|{\\)" - nil t) - (backward-char 1) - (while (looking-at "\\[") ; ...so skip all bracketted options - (forward-sexp 1)) - ;; then lookup first key - (if (looking-at "{[ \n]*\\([^,} \n]+\\)") - (progn - (intern (buffer-substring (match-beginning 1)(match-end 1)) - keys-obarray) - (goto-char (match-end 1)) - (while (and (skip-chars-forward " \n") - (looking-at ",")) - (forward-char 1) - (re-search-forward "\\([^,} \n]+\\)" nil t) - (intern (buffer-substring (match-beginning 1)(match-end 1)) - keys-obarray))))) - (if keys-obarray - keys-obarray - (error "Sorry, could not find any citation keys in this buffer."))))) - -;;--------------------------------------------------------------------------- -;; Multi-file document programming requirements: -;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -;; bib-make-bibliography -;; bib-document-citekeys-obarray needs the master .aux file to extract -;; citation keys. -;; Included .aux files (corresponding to \include'd LaTeX files) are -;; then specified relative to the master-file-directory. -;; -;; bib-get-bibliography (used by interactive commands to extract bib sources) -;; -;; bibtex source filenames are returned from (LaTeX-bibliography-list) -;; unformatted. Since only a single \bibliogragrphy command is allowed -;; by BiBTeX in a document, it is safe to assume that their path is -;; relative to the master file's directory (since the path is relative -;; to where the BiBTeX program is actually ran). -;; -;; imenu -;; -;; Requires list of all tex files (complete with paths) to call etags on -;; them. -;; I used (TeX-style-list) to get the list of possible tex files, but -;; they are not in sorted order. Therefore the imenu would be somewhat -;; confusing. I'll have to do the scan myself, except that I'll only be -;; looking at the master file for \include statements. - -;; (See TeX-check-files, used in TeX-save-document. All documents related -;; files are returned by (TeX-style-list) and stored in TeX-active-styles. -;; Original idea was to search TeX-check-path for files listed in -;; TeX-active-styles (with possible relative or full paths) that end in .tex.) - -(defun bib-master-directory () -;; Returns the directory associated with the master file. -;; If no master file, then return current default. - (let ((masterfile (bib-master-file))) - (if masterfile - (file-name-directory (expand-file-name (TeX-master-file))) - default-directory))) - -(defun bib-master-file () -;; return master file full path, or nil if not a multi-file document -;; I wish there were a better way to tell about non multi-file documents... - (let ((master - (cond - ((not (boundp 'TeX-master)) - ;; This buffer doesn't know what a master file is, so return now. - nil) - ((and TeX-master ;Set, but not to t - (not (eq TeX-master 't))) ; then we have an actual name - (expand-file-name TeX-master)) - ((and (eq TeX-master 't) ;Test if master file itself - (progn ;But also require at least one \include - (save-excursion - (goto-char 1) ;Too bad I have to do this search... - ;; Require that user uses \input{file} - ;; rather than \input file - (re-search-forward "^[ \t]*\\\\\\(include\\|input\\){" - nil t)))) - (buffer-file-name)) - (t - nil)))) - (cond - ((not master) - nil) - ((string-match ".tex$" master) - master) - (t - (concat master ".tex"))))) - -;; I don't use this one because files are not returned in order... -;; (defun bib-document-TeX-files () -;; ;; Return all tex input files associated with a known multi-file document. -;; (let ((master-directory (bib-master-directory)) -;; (the-list (cons (file-name-nondirectory (TeX-master-file)) -;; (TeX-style-list))) -;; ;; TeX-style-list returns "../master" for the main file if TeX-master -;; ;; was set like that. "../master" would not be found relative -;; ;; to the master-directory! So let's add it to the list w/o directory. -;; (the-result) -;; (the-file)) -;; (while the-list -;; (setq the-file (expand-file-name (car the-list) master-directory)) -;; (setq the-list (cdr the-list)) -;; (and (not (string-match ".tex$" the-file)) -;; (setq the-file (concat the-file ".tex"))) -;; (and (file-readable-p the-file) -;; (not (member the-file the-result)) ;listed already? -;; (setq the-result (cons the-file the-result)))) -;; the-result)) - -(defun bib-document-TeX-files () - ;; For a multi-file document in auctex only. - ;; Return all tex input files associated with a *known* multi-file document. - ;; No checking is done that this is a real multi-file document. - - ;; sets global variable bib-document-TeX-files-warnings - - (setq bib-document-TeX-files-warnings nil) - (let* ((masterfile (bib-master-file)) - (dir (and masterfile (file-name-directory masterfile))) - (tex-buffer (get-buffer-create "*tex-document*")) - (the-list (list masterfile)) - (the-file)) - (if (not masterfile) - (progn - (kill-buffer tex-buffer) - (error - "Sorry, but this is not a multi-file document (Try C-u C-c C-n if using auctex)"))) - (save-excursion - (set-buffer tex-buffer) - ;; set its directory so relative includes work without expanding - (setq default-directory dir) - (insert-file-contents masterfile) - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*\\\\\\(input\\|include\\){\\(.*\\)}" - nil t) - (let ((the-file (buffer-substring (match-beginning 2)(match-end 2)))) - (if (string-match ".sty$" the-file) ;Skip over style files! - nil - (if (and (not (file-readable-p (expand-file-name the-file dir))) - (not (string-match ".tex$" the-file))) - (setq the-file (concat the-file ".tex"))) - (setq the-file (expand-file-name the-file dir)) - (if (not (file-readable-p the-file)) - (setq bib-document-TeX-files-warnings - (concat - bib-document-TeX-files-warnings - (format "Warning: File not found: %s" the-file))) - (setq the-list (cons (expand-file-name the-file dir) the-list)) - (end-of-line)(insert "\n") - (insert-file-contents the-file)))))) - (kill-buffer tex-buffer) - (nreverse the-list))) - -(defun bib-document-citekeys-obarray () -;; Return cite keys obarray for multi-file document, or nil if not a multi-file -;; document. This is a auc-tex supported feature only. -;; Also, see bib-buffer-citekeys-obarray. -;; Sets global variable bib-document-citekeys-obarray-warnings. - (setq bib-document-citekeys-obarray-warnings nil) - (let ((master-tex (bib-master-file)) - (master-aux)) - (if (not master-tex) - nil ;Not a multifile document. No need... - (setq master-aux (bib-return-aux-file-from-tex master-tex "aux")) - (or (file-readable-p master-aux) - (error "Sorry, cannot read file %s" master-aux)) - (and (file-newer-than-file-p master-tex master-aux) - (setq bib-document-citekeys-obarray-warnings - (format "Warning: %s is out of date relative to %s.\n" - master-aux master-tex))) - (let ((work-buffer (get-buffer-create "*bib-cite-work*")) - (keys-obarray (make-vector 201 0))) - (save-excursion - (set-buffer work-buffer) - (insert-file-contents master-aux) - ;; Because we will be looking for \input statements, we need to set - ;; the default directory to that of the master file. - (setq default-directory (file-name-directory master-tex)) - ;; bib-make-bibliography will need this also to find .bib files - ;; look for \@input{chap1/part1.aux} - (while (re-search-forward "^\\\\@input{\\(.*\\)}$" nil t) - (let* ((auxfile (buffer-substring(match-beginning 1)(match-end 1))) - (texfile (bib-return-aux-file-from-tex auxfile "tex"))) - (if (not (file-readable-p auxfile)) - (setq bib-document-citekeys-obarray-warnings - (concat - bib-document-citekeys-obarray-warnings - (format "Warning: %s is not found or readable.\n" - auxfile))) - (if (file-newer-than-file-p texfile auxfile) - (setq bib-document-citekeys-obarray-warnings - (concat - bib-document-citekeys-obarray-warnings - (format - "Warning: %s is out of date relative to %s.\n" - auxfile texfile)))) - (end-of-line)(insert "\n") - (insert-file-contents (buffer-substring (match-beginning 1) - (match-end 1)))))) - (goto-char 1) - ;; look for \citation{gertsenshtein59} - (while (re-search-forward "^\\\\citation{\\(.*\\)}$" nil t) - (intern (buffer-substring (match-beginning 1)(match-end 1)) - keys-obarray))) - (kill-buffer work-buffer) - keys-obarray)))) - -(defun bib-return-aux-file-from-tex (texname ext) -;; given name.name.XXX return name.name.ext - (concat (substring texname 0 -3) ext)) - -(defun bib-etags-find-noselect (tag &optional masterdir) -;; Returns a buffer with point on `tag'. buffer is not selected. -;; Makes sure TAGS file exists, etc. - (require 'etags) - (let* ((master (or masterdir (bib-master-directory))) - (the-buffer (current-buffer)) - (new-buffer) - (the-tags-file-name (expand-file-name bib-etags-filename master))) - (or (file-exists-p the-tags-file-name) ;make sure TAGS exists - (bib-etags master)) - (or (equal the-tags-file-name tags-file-name) ;make sure it's current - (visit-tags-table the-tags-file-name)) - ;; find-tag-noselect should set the TAGS file for the new buffer - ;; that's what C-h f visit-tags-table says... - (if (string-match "XEmacs\\|Lucid" emacs-version) - (progn - (find-tag tag) - (setq new-buffer (current-buffer)) - (set-buffer the-buffer)) - (setq new-buffer (find-tag-noselect tag)) ;Seems to set buffer to TAGS - (set-buffer the-buffer)) - new-buffer)) - -;;--------------------------------------------------------------------------- -;; imenu stuff -;; All of this should only be loaded if imenu is *already* loaded because -;; we redefine imenu here. - -(cond - (bib-use-imenu - (require 'imenu) - (require 'cl) - ;;; Now done at end of this file: - ;;(add-hook 'LaTeX-mode-hook 'LaTeX-hook-setq-imenu) - - (defvar bib-imenu-document-counter nil - "bib-cite internal variable") - -;; FIXME: If bib-cite becomes a minor mode, then this hook will go away -;; and this will be done in the minor-mode function. - (defun LaTeX-hook-setq-imenu () - ;; User who *never* uses multi-file documents could change this to: - ;; 'imenu--create-LaTeX-index-for-buffer - (setq imenu-create-index-function 'imenu--create-LaTeX-index)) - - (defun imenu--create-LaTeX-index () - ;; dispatch to proper function, depending on whether a multi-file document. - (let ((masterfile (bib-master-file))) - (if masterfile - (imenu--create-LaTeX-index-for-document masterfile) - (imenu--create-LaTeX-index-for-buffer)))) - - (defun imenu--create-LaTeX-index-for-document (masterfile) - ;; For a multi-file document in auctex only. - ;; Create imenu--index-alist for master file buffer and use the same - ;; for all input files? This would be faster... Maybe in next version? - (bib-etags) ;Create a new TAGS file, user needs it. - (let ((tex-buffer (get-buffer-create "*imenu-tex*")) - (index-alist '()) - (index-label-alist '()) - (prev-pos)) - (save-excursion - (set-buffer tex-buffer) - ;; set its directory so relative includes work without expanding - (setq default-directory (file-name-directory masterfile)) - (insert-file-contents masterfile) - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*\\\\\\(input\\|include\\){\\([^}]*\\)}" nil t) - (let ((the-file (buffer-substring (match-beginning 2)(match-end 2)))) - (if (and (not (file-readable-p - (expand-file-name the-file default-directory))) - (not (string-match ".tex$" the-file))) - (setq the-file (concat the-file ".tex"))) - (end-of-line)(insert "\n") - (insert-file-contents the-file))) - ;; Now, the document is like any other tex file - (setq bib-imenu-document-counter -99) ;IDs menu entries start at -100 - (goto-char (point-max)) - (imenu-progress-message prev-pos 0 t) - (while - (re-search-backward -;;; "\\\\\\(\\(sub\\)*section\\|chapter\\|label\\){[^}]+}" - "\\(\\\\label\\)\\|\\(^[ ]*\\\\\\(\\(sub\\)*section\\|chapter\\)\\){[^}]+}" - nil t) - (imenu-progress-message prev-pos nil t) - (save-match-data - (save-excursion - (cond - ((looking-at "\\\\label") - (push (imenu--LaTeX-name-and-etags) - index-label-alist)) - (t - (push (imenu--LaTeX-name-and-etags) - index-alist)))))) - (kill-buffer tex-buffer) - (imenu-progress-message prev-pos 100 t) - ;;Michal Mnuk's add-on removes \label - ;;Plus PSG's fix for 19.31 w/o imenu-create-submenu-name - (and index-label-alist - (push (cons (or (and (fboundp 'imenu-create-submenu-name) - (imenu-create-submenu-name "Labels")) - "Labels") - (sort (imenu--remove-LaTeX-keyword-list - index-label-alist) 'imenu--label-cmp)) - index-alist)) - ;;(and index-label-alist - ;; (push (cons (imenu-create-submenu-name "Labels") - ;; index-label-alist) - ;; index-alist)) - index-alist))) - - (defun imenu--create-LaTeX-index-for-buffer () - ;; For non-multi-file documents. - (let ((index-alist '()) - (index-label-alist '()) - prev-pos) - (setq bib-imenu-document-counter -99) ;IDs menu entries starting at -100 - (goto-char (point-max)) - (imenu-progress-message prev-pos 0 t) - (while - (re-search-backward -;;; Better regexp, but slow -;;; "^[^;]*\\(\\\\\\)\\(\\(sub\\)*section\\|chapter\\|label\\){[^}]+}" -;;; Original regexp that would catch commented-out stuff -;;; "\\\\\\(\\(sub\\)*section\\|chapter\\|label\\){[^}]+}" - "\\(\\\\label\\)\\|\\(^[ ]*\\\\\\(\\(sub\\)*section\\|chapter\\)\\){[^}]+}" - nil t) - (imenu-progress-message prev-pos nil t) - (save-match-data - (save-excursion - (cond - ((looking-at "\\\\label") - (push (imenu--LaTeX-name-and-position) - index-label-alist)) - (t - (push (imenu--LaTeX-name-and-position) - index-alist)))))) - (imenu-progress-message prev-pos 100 t) - ;;Michal Mnuk's add-on removes \label - ;;Plus PSG's fix for 19.31 w/o imenu-create-submenu-name - (and index-label-alist - (push (cons (or (and (fboundp 'imenu-create-submenu-name) - (imenu-create-submenu-name "Labels")) - "Labels") - (sort (imenu--remove-LaTeX-keyword-list - index-label-alist) 'imenu--label-cmp)) - index-alist)) - ;;(and index-label-alist - ;; (push (cons (imenu-create-submenu-name "Labels") - ;; index-label-alist) - ;; index-alist)) - index-alist)) - - ;;Michal Mnuk's three routines: - (defun imenu--remove-LaTeX-keyword-list (llist) - "Remove the LaTeX KEYWORD from car's of all elements in LLIST." - (mapcar - (function (lambda (element) - (imenu--remove-LaTeX-keyword-el element "label"))) - llist)) - - (defun imenu--remove-LaTeX-keyword-el (element keyword) - "Remove the LaTeX KEYWORD from car of ELEMENT." - (save-match-data - ;; Shouls I have extra option here: "[ - (string-match (concat "\\\\" keyword "{\\(.*\\)}") (car element)) - (cons - (substring (car element) (match-beginning 1) (match-end 1)) - (cdr element)))) - - (defun imenu--label-cmp (el1 el2) - "Predicate to compare labels in lists produced by - imenu--create-LaTeX-index." - (string< (car el1) (car el2))) - - (defun imenu--LaTeX-name-and-position () - (save-excursion - ;; We're on the opening slash - (let ((beg (point)) - (end (progn (search-forward "{" nil t) - (forward-char -1) - (forward-sexp 1) - (point))) - (marker (make-marker))) - (set-marker marker beg) - (cons (buffer-substring beg end) marker)))) - - (defun imenu--LaTeX-name-and-etags () - (save-excursion - (setq bib-imenu-document-counter (1- bib-imenu-document-counter)) - (cons (buffer-substring (point) - (progn (search-forward "{") - (forward-char -1) - (forward-sexp 1) - (point))) - bib-imenu-document-counter))) - - ;; Updated to imenu in Emacs 19.33 - (defun imenu (index-item) - "Jump to a place in the buffer chosen using a buffer menu or mouse menu. -See `imenu-choose-buffer-index' for more information." - (interactive - (list (save-restriction - (widen) - (imenu-choose-buffer-index)))) - ;; Convert a string to an alist element. - (if (stringp index-item) - (setq index-item (assoc index-item (imenu--make-index-alist)))) - (and index-item - (progn - (push-mark) - (cond - ((markerp (cdr index-item)) - (if (or ( > (marker-position (cdr index-item)) (point-min)) - ( < (marker-position (cdr index-item)) (point-max))) - ;; widen if outside narrowing - (widen)) - (goto-char (marker-position (cdr index-item)))) - ;; PSG - Handle tags - ((and (numberp (cdr index-item)) - (< (cdr index-item) -99)) - (find-tag (car index-item))) - (t - (if (or ( > (cdr index-item) (point-min)) - ( < (cdr index-item) (point-max))) - ;; widen if outside narrowing - (widen)) - (goto-char (cdr index-item))))))) -;;; end of bib-use-imenu stuff - )) -;; -------------------------------------------------------------------------- -;; The following routines make a temporary bibliography buffer -;; holding all bibtex files found. - -(defun bib-get-bibliography (include-filenames-f) - "Returns a new bibliography buffer holding all bibtex files in the document. - -If using auc-tex, and either TeX-parse-self is set or C-c C-n is used to -parse the document, then the entire multifile document will be searched -for \bibliography commands. - -If this fails, the current buffer is searched for the first \bibliography -command. - -If include-filenames-f is true, include as a special header the filename -of each bib file. - -Puts the buffer in text-mode such that forward-sexp works with german \" -accents embeded in bibtex entries." - (let ((bib-list (or (and (fboundp 'LaTeX-bibliography-list) - (boundp 'TeX-auto-update) - (LaTeX-bibliography-list)) -;; LaTeX-bibliography-list (if bound) returns an unformatted list of -;; bib files used in the document, but only if parsing is turned on -;; or C-c C-n was used. - (bib-bibliography-list))) - (bib-buffer (get-buffer-create "*bibtex-bibliography*")) - ;; Path is relative to the master directory - (default-directory (bib-master-directory)) - (the-name)(the-warnings)(the-file)) - (save-excursion - ;; such that forward-sexp works with embeeded \" in german, - ;; and unbalanced () - (set-buffer bib-buffer) - (erase-buffer) - (set-syntax-table text-mode-syntax-table) -;; (if (boundp 'bibtex-mode-syntax-table) -;; (set-syntax-table bibtex-mode-syntax-table) -;; (text-mode)) - ) - ;;We have a list of bib files - ;;Search for them, include them, list those not readable - (while bib-list - (setq the-name (car (car bib-list))) ;Extract the string only - (setq bib-list (cdr bib-list)) - (setq the-name - (substring the-name - (string-match "[^ ]+" the-name) ;remove leading spaces - (string-match "[ ]+$" the-name))) ;remove trailing space - (if (not (string-match "\\.bib$" the-name)) - (setq the-name (concat the-name ".bib"))) - (setq the-file - (or - (and (file-readable-p (expand-file-name (concat "./" the-name))) - (expand-file-name (concat "./" the-name))) - (psg-checkfor-file-list the-name - (psg-list-env bib-bibtex-env-variable)) - ;; Check for BIBINPUT env variable as well (by popular demand!) - (psg-checkfor-file-list the-name (psg-list-env "BIBINPUT")) - (and (boundp 'TeX-check-path) - (psg-checkfor-file-list the-name TeX-check-path)))) - (if the-file - (progn - (save-excursion - (set-buffer bib-buffer) - (goto-char (point-max)) - (if include-filenames-f - (insert "%%%Filename: " the-file "\n")) - (insert-file-contents the-file nil) - (goto-char 1))) - (setq the-warnings - (concat the-warnings "Could not read file: " the-name "\n")))) - (if the-warnings - (progn - (with-output-to-temp-buffer "*Help*" - (princ the-warnings)) - (kill-buffer bib-buffer) - (error - "Sorry, can't find all bibtex files in \\bibliography command")) - bib-buffer))) - -(defun bib-bibliography-list () - "Return list of bib files listed in first \\bibliography command in buffer -Similar output to auc-tex's LaTeX-bibliography-list -The first element may contain trailing whitespace (if there was any in input) -although BiBTeX doesn't allow it!" - (save-excursion - (goto-char 1) - (if (not (re-search-forward "^[ \t]*\\\\bibliography{[ \t]*\\([^},]+\\)" - nil t)) - (error "Sorry, can't find \\bibliography command anywhere") - (let ((the-list (list (buffer-substring - (match-beginning 1)(match-end 1)))) - (doNext t)) - (while doNext - (if (looking-at ",") - (setq the-list - (append the-list - (list (buffer-substring - (progn (skip-chars-forward ", ")(point)) - (progn (re-search-forward "[,}]" nil t) - (backward-char 1) - (skip-chars-backward ", ") - (point)))))) - (setq doNext nil))) - (mapcar 'list the-list))))) - -;; BibTeX-mode key def to create auc-tex's parsing file. -(defun bib-create-auto-file () - "Force the creation of the auc-tex auto file for a bibtex buffer" - (interactive) - (if (not (require 'latex)) - (error "Sorry, This is only useful if you have auc-tex")) - (let ((TeX-auto-save t) - (TeX-auto-update t) - (TeX-auto-regexp-list BibTeX-auto-regexp-list)) - ;; TeX-auto-write - ;; -> calls TeX-auto-store - ;; -> calls TeX-auto-parse - ;; clears LaTeX-auto-bibtem (temporary holding space for bibitems) - ;; searches buffer using regexp in TeX-auto-regexp-list - ;; -> if LaTeX-auto-bibtem (the temporary holding space for bibitems) - ;; holds stuffs like - ;; ("Zimmermann:1991" "Anger_et_al:1993") - ;; as determined by - ;; (member nil (mapcar 'TeX-auto-entry-clear-p TeX-auto-parser)) - ;; then it creates the auto file. - - ;; TeX-auto-write may call TeX-master-file which may fail if - ;; TeX-header-end is unset (by LaTeX-common-initialization in latex-mode) - (if (not TeX-header-end) - (setq TeX-header-end LaTeX-header-end)) - - (TeX-auto-write))) - -;; --------------------------------------------------------------------------- -;; Key definitions start here... - -;; Christoph Wedler -;; Replace eval-after-load (which doesn't work with efs anyway) -;; with add-submenu in bib-cite-initialize - -;;(if ((and (string-match "XEmacs\\|Lucid" emacs-version) -;; (or window-system -;; (fboundp 'smart-menu)) ;text menus by Bob Weiner -;; (not (fboundp 'eval-after-load)))) -;; ;; define eval-after-load for XEmacs -;; (defun eval-after-load (file form) -;; "Arrange that, if FILE is ever loaded, FORM will be run at that -;;time. -;;This makes or adds to an entry on `after-load-alist'. -;;It does nothing if FORM is already on the list for FILE. -;;FILE should be the name of a library, with no directory name." -;; (or (assoc file after-load-alist) -;; (setq after-load-alist (cons (list file) after-load-alist))) -;; (let ((elt (assoc file after-load-alist))) -;; (or (member form (cdr elt)) -;; (nconc elt (list form)))) -;; form)) - -(defvar bib-cite-map - (let ((map (make-sparse-keymap))) - (define-key map "a" 'bib-apropos) - (define-key map "m" 'bib-make-bibliography) - (define-key map "d" 'bib-display) - (define-key map "e" 'bib-etags) - (define-key map "f" 'bib-find) - (define-key map "h" 'bib-highlight-mouse) - map) - "Keymap to bind to \\C-cb in latex keymap") - -(cond - ((and (string-match "XEmacs\\|Lucid" emacs-version) - (or window-system - (fboundp 'smart-menu))) ;text menus by Bob Weiner - ;; - ;; xemacs under X with auc-tex - ;; - - ;; Christoph Wedler - (defvar bib-cite-xemacs-menu - '("Bib-Cite" - ;;"---" - ["Make BibTeX bibliography buffer" bib-make-bibliography t] - ["Display citation or matching \\ref or \\label" bib-display t] - ["Find BibTeX citation or matching \\ref or \\label" bib-find t] - ["Search apropos BibTeX files" bib-apropos t] - ["Build TAGS file for multi-file document" bib-etags (bib-master-file)] - ["Refresh \\cite, \\ref and \\label mouse highlight" - bib-highlight-mouse t]) - "Submenu of LaTeX menu, used by bib-cite.") - -;;; Add to bibtex.el's popup menu - (defvar bib-cite-xemacs-bibtex-mode-menu - '("---" - "Bib-Cite" - "---" - ["Search apropos BibTeX files" bib-apropos t] - ["Create auc-tex auto parsing file" bib-create-auto-file t]) - "Submenu of bibtex-mode menu, used by bib-cite.") - - (if (boundp 'bibtex-menu) - ;; Add menu now - (setq bibtex-menu - (append - bibtex-menu - bib-cite-xemacs-bibtex-mode-menu)) - ;; Setup to add menu later - (defun bib-cite-bibtex-mode-hook () - (if (boundp 'bibtex-menu) - (progn - (setq bibtex-menu - (append - bibtex-menu - bib-cite-xemacs-bibtex-mode-menu)) - (remove-hook 'bibtex-mode-hook 'bib-cite-bibtex-mode-hook)))) - (add-hook 'bibtex-mode-hook 'bib-cite-bibtex-mode-hook)) -;;; Done - Add to bibtex.el's popup menu - -;; (eval-after-load -;; "latex" -;; '(progn -;; (add-menu-button '("LaTeX") ["----" nil t]) -;; (add-menu-button -;; '("LaTeX") ["Make BibTeX bibliography buffer" bib-make-bibliography t]) -;; (add-menu-button -;; '("LaTeX") ["Display citation or matching \\ref or \\label" -;; bib-display t]) -;; (add-menu-button -;; '("LaTeX") ["Find BibTeX citation or matching \\ref or \\label" -;; bib-find t]) -;; (add-menu-button -;; '("LaTeX") ["Search apropos BibTeX files" bib-apropos t]) -;; (add-menu-button -;; '("LaTeX") ["Build TAGS file for multi-file document" bib-etags t]) -;; (add-menu-button -;; '("LaTeX") -;; ["Refresh \\cite, \\ref and \\label mouse highlight" -;; bib-highlight-mouse t]) - - ) - - ((and (not (string-match "XEmacs\\|Lucid" emacs-version)) - (string-equal "19" (substring emacs-version 0 2)) - (or window-system - (fboundp 'tmm-menubar))) ; 19.30 - Will autoload if necessary - ;; - ;; emacs-19 under X-windows (or non-X with tmm) - ;; - - ;; This *almost* makes me want to switch over to XEmacs... - - ;; to auc-tex auto file for a bibtex buffer - (eval-after-load - "bibtex" - '(progn - (cond - ((lookup-key bibtex-mode-map [menu-bar move/edit]) - (define-key-after - (lookup-key bibtex-mode-map [menu-bar move/edit]) - [bib-nil] '("---" . nil) '"--") - (define-key-after - (lookup-key bibtex-mode-map [menu-bar move/edit]) - [bib-apropos] '("Search Apropos" . bib-apropos) 'bib-nil) - (define-key-after - (lookup-key bibtex-mode-map [menu-bar move/edit]) - [auc-tex-parse] - '("Create auc-tex auto parsing file" . bib-create-auto-file) - 'bib-apropos)) - ((lookup-key bibtex-mode-map [menu-bar bibtex-edit]) - (define-key-after - (lookup-key bibtex-mode-map [menu-bar bibtex-edit]) - [bib-nil] '("---" . nil) '"--") - (define-key-after - (lookup-key bibtex-mode-map [menu-bar bibtex-edit]) - [bib-apropos] '("Search Apropos" . bib-apropos) 'bib-nil) - (define-key-after - (lookup-key bibtex-mode-map [menu-bar bibtex-edit]) - [auc-tex-parse] - '("Create auc-tex auto parsing file" . bib-create-auto-file) - 'bib-apropos))))) - - (defvar bib-cite-put-menu-separately t - "*Put bib-cite menubar menu separately, not within LaTeX pull-down menu") - (cond - ((not bib-cite-put-menu-separately) ;Old method - Destroy code? - (defun bib-add-menu-keys (the-key) - (cond - (the-key ;make sure keymap exists - (define-key-after the-key [bib-nil] '("---" . nil) '"--") - (define-key-after the-key [bib-make-bibliography] - '("Make BiBTeX bibliography buffer" . bib-make-bibliography) - 'bib-nil) - (define-key-after the-key [bib-display] - '("Display citation or matching \\ref or \\label" . bib-display) - 'bib-make-bibliography) - (define-key-after the-key [bib-find] - '("Find BiBTeX citation or matching \\ref or \\label" . bib-find) - 'bib-display) - (define-key-after the-key [bib-apropos] - '("Search apropos BiBTeX files" . bib-apropos) 'bib-find) - ;;;(put 'ps-print-region-with-faces 'menu-enable 'mark-active) - ;;;(define-key menu-bar-tools-menu [ps-print-buffer] - ;;; '("Postscript Print Buffer" . ps-print-buffer-with-faces)) - (put 'bib-etags 'menu-enable '(bib-master-file)) - (define-key-after the-key [bib-etags] - '("Build TAGS file for multi-file document" . bib-etags) - 'bib-apropos) - (define-key-after the-key [bib-highlight-mouse] - '("Refresh \\cite, \\ref and \\label mouse highlight" . - bib-highlight-mouse) - 'bib-etags)))) - - ;;for auc-tex's LaTeX-mode - (eval-after-load - "latex" - '(let ((the-key (or (lookup-key LaTeX-mode-map [menu-bar LaTeX]) - (lookup-key LaTeX-mode-map [menu-bar AUC\ TeX])))) - ;;;(define-key LaTeX-mode-map [S-mouse-1] 'bib-display-mouse) - ;;;(define-key LaTeX-mode-map [S-mouse-2] 'bib-find-mouse) - (define-key LaTeX-mode-map "\C-cb" bib-cite-map) - (bib-add-menu-keys the-key))) - - ;;for auc-tex's TeX-mode - (eval-after-load - "tex" - '(let ((the-key (lookup-key TeX-mode-map [menu-bar TeX]))) - ;;;(define-key TeX-mode-map [S-mouse-1] 'bib-display-mouse) - ;;;(define-key TeX-mode-map [S-mouse-2] 'bib-find-mouse) - (define-key TeX-mode-map "\C-cb" bib-cite-map) - (bib-add-menu-keys the-key))) - - ;;for plain tex-mode - (eval-after-load - "tex-mode" - '(progn - (let ((the-key (lookup-key tex-mode-map [menu-bar tex]))) - ;;;(define-key tex-mode-map [S-mouse-1] 'bib-display-mouse) - ;;;(define-key tex-mode-map [S-mouse-2] 'bib-find-mouse) - (define-key tex-mode-map "\C-cb" bib-cite-map) - (bib-add-menu-keys the-key) - (define-key tex-mode-map [menu-bar tex bib-etags] - 'undefined))))) - - (t ;New method - separate menu - (setq bib-cite-menu-map (make-sparse-keymap "bib-cite")) - (define-key bib-cite-menu-map [bib-display] - '("Display citation or matching \\ref or \\label" . bib-display)) - (define-key bib-cite-menu-map [bib-find] - '("Find BiBTeX citation or matching \\ref or \\label" . bib-find)) - (define-key bib-cite-menu-map [bib-make-bibliography] - '("Make BiBTeX bibliography buffer" . bib-make-bibliography)) - (put 'bib-etags 'menu-enable '(bib-master-file)) - (define-key bib-cite-menu-map [bib-etags] - '("Build TAGS file for multi-file document" . bib-etags)) - (define-key bib-cite-menu-map [bib-apropos] - '("Search apropos BiBTeX files" . bib-apropos)) - (define-key bib-cite-menu-map [bib-highlight-mouse] - '("Refresh \\cite, \\ref and \\label mouse highlight" - . bib-highlight-mouse)) - - (eval-after-load - "tex-mode" - '(progn - ;;;(define-key tex-mode-map [S-mouse-1] 'bib-display-mouse) - ;;;(define-key tex-mode-map [S-mouse-2] 'bib-find-mouse) - (define-key tex-mode-map "\C-cb" bib-cite-map) - (define-key tex-mode-map [menu-bar bib-cite-menu-map] - (cons "Bib-Cite" bib-cite-menu-map)) - (define-key tex-mode-map [menu-bar bib-cite-menu-map bib-etags] - 'undefined))) - - ;;for auc-tex's LaTeX-mode - (eval-after-load - "latex" - '(progn - ;;;(define-key LaTeX-mode-map [S-mouse-1] 'bib-display-mouse) - ;;;(define-key LaTeX-mode-map [S-mouse-2] 'bib-find-mouse) - (define-key LaTeX-mode-map "\C-cb" bib-cite-map) - (define-key LaTeX-mode-map [menu-bar bib-cite-menu-map] - (cons "Bib-Cite" bib-cite-menu-map)))) - - ;;for auc-tex's TeX-mode - (eval-after-load - "tex" - '(progn - ;;;(define-key TeX-mode-map [S-mouse-1] 'bib-display-mouse) - ;;;(define-key TeX-mode-map [S-mouse-2] 'bib-find-mouse) - (define-key TeX-mode-map "\C-cb" bib-cite-map))) - )))) - -;; This must be after adding to LaTeX-mode-map because we copy it here. -(defvar bib-highlight-mouse-keymap - ;; First, copy the local keymap so we don't have `disappearing' menus - ;; when the mouse is moved over a \ref, \label or \cite command. - ;; FIXME: **This only works if bib-cite is loaded after TeX keymaps - ;; are constructed. Thus, if bib-cite is loaded in a hook. - - ;; FIXME: Check out (mouse-major-mode-menu) to see how it grabs the local - ;; menus to display. Maybe on `highlighted' commands we could only - ;; display the bib-cite stuff (or a subset of it). - (let ((m (cond - ((boundp 'LaTeX-mode-map) - (copy-keymap LaTeX-mode-map)) - ((boundp 'tex-mode-map) - (copy-keymap tex-mode-map)) - (t - (make-sparse-keymap))))) - (cond - ((string-match "XEmacs\\|Lucid" emacs-version) - (set-keymap-name m 'bib-highlight-mouse-keymap) - (cond - ;; action-key stuff from Vladimir Alexiev - ((commandp 'action-key) - ;; for hyperbole. The Right Way is to define implicit buttons - ;; (defib) bib-cite and label-ref instead of overriding action-key and - ;; assist key, so that eg smart key help can be obtained, but I'm - ;; lazy. - (substitute-key-definition 'action-key 'bib-find m global-map) - (substitute-key-definition 'assist-key 'bib-display m global-map) - (substitute-key-definition 'action-key-depress - 'bib-find-mouse m global-map) - (substitute-key-definition 'assist-key-depress - 'bib-display-mouse m global-map) - (substitute-key-definition 'action-mouse-key nil m global-map) - (substitute-key-definition 'assist-mouse-key nil m global-map)) - (t ; xemacs, not hyperbole - (define-key m "\e\r" 'bib-find-mouse) ; bug Fixed in V2.17 - (define-key m "\e\n" 'bib-display-mouse) ;bug Fixed in V2.17 - ;;(define-key m [(shift button1)] 'bib-display-mouse) - (define-key m [button3] 'bib-display-mouse) - (define-key m [button2] 'bib-find-mouse)))) - (t ; emacs 19 - (cond - ((commandp 'action-key) - (substitute-key-definition 'action-key 'bib-find m global-map) - (substitute-key-definition 'assist-key 'bib-display m global-map) - (substitute-key-definition 'action-mouse-key-emacs19 - 'bib-find-mouse m global-map) - (substitute-key-definition 'assist-mouse-key-emacs19 - 'bib-display-mouse m global-map) - (substitute-key-definition 'action-key-depress-emacs19 - nil m global-map) - (substitute-key-definition 'assist-key-depress-emacs19 - nil m global-map)) - (t ; emacs 19, not hyperbole - (define-key m [down-mouse-3] 'bib-display-mouse) - (define-key m [mouse-2] 'bib-find-mouse))))) - m)) -;; -------------------------------------------------------------------------- -;; The following routines are also defined in other packages... - -;; Must be in sync with function of same name in ff-paths.el -(defun psg-checkfor-file-list (filename list) - "Check for presence of FILENAME in directory LIST. Return 1st found path." - ;;USAGE: (psg-checkfor-file-list "gri.cmd" (psg-list-env "PATH")) - ;;USAGE: (psg-checkfor-file-list "gri-mode.el" load-path) - ;;USAGE: (psg-checkfor-file-list "gri.cmd" (psg-translate-ff-list "gri.tmp")) - (let ((the-list list) - (filespec)) - (while the-list - (if (not (car the-list)) ; it is nil - (setq filespec (expand-file-name filename "~")) - (setq filespec - (concat (file-name-as-directory (car the-list)) filename))) - (if (file-exists-p filespec) - (setq the-list nil) - (setq filespec nil) - (setq the-list (cdr the-list)))) - (if filespec - filespec - ;; If I have not found a file yet, then check if some directories - ;; ended in // and recurse through them. - (let ((the-list list)) - (while the-list - (if (not (string-match "//$" (car the-list))) nil - (setq filespec (car - (search-directory-tree - (substring (car the-list) 0 (match-beginning 0)) - (concat "^" filename "$") - t - t))) - (if filespec ;Success! - (setq the-list nil))) - (setq the-list (cdr the-list))) - filespec)))) - - -(defun search-directory-tree (directories extension-regexp recurse first-file) - "Return a list of all reachable files in DIRECTORIES ending with EXTENSION. -DIRECTORIES is a list or a single-directory string -EXTENSION is actually (any) regexp, usually \\\\.bib$ -If RECURSE is t, then we will recurse into the directory tree, - nil, we will only search the list given. -If FIRST-FILE is t, stop after first file is found." - (or (listp directories) - (setq directories (list directories))) - - (let (match) - (while directories - (let* ((directory (file-name-as-directory (car directories))) - (content (and directory - (file-readable-p directory) - (file-directory-p directory) - (directory-files directory)))) - (setq directories (cdr directories)) - (while content - (let ((file (expand-file-name (car content) directory))) - (cond ((string-match "[.]+$" (car content))) ;This or parent dir - ((not (file-readable-p file))) - ((and recurse - (file-directory-p file)) - (setq directories - (cons (file-name-as-directory file) directories))) - ((string-match extension-regexp - (file-name-nondirectory file)) - (and first-file - (setq content nil - directories nil)) - (setq match (cons file match))))) - (setq content (cdr content))))) - - match)) - -;;; (defun psg-checkfor-file-list (filename list) -;;; (let ((the-list list) -;;; (filespec)) -;;; (while the-list -;;; (if (not (car the-list)) ; it is nil -;;; (setq filespec (concat "~/" filename)) -;;; (setq filespec -;;; (concat (file-name-as-directory (car the-list)) filename))) -;;; (if (file-exists-p filespec) -;;; (setq the-list nil) -;;; (setq filespec nil) -;;; (setq the-list (cdr the-list)))) -;;; filespec)) - -(or (fboundp 'dired-replace-in-string) - ;; This code is part of GNU emacs - (defun dired-replace-in-string (regexp newtext string) - ;; Replace REGEXP with NEWTEXT everywhere in STRING and return result. - ;; NEWTEXT is taken literally---no \\DIGIT escapes will be recognized. - (let ((result "") (start 0) mb me) - (while (string-match regexp string start) - (setq mb (match-beginning 0) - me (match-end 0) - result (concat result (substring string start mb) newtext) - start me)) - (concat result (substring string start))))) - - -;; Could use fset here to equal TeX-split-string to dired-split if only -;; dired-split is defined. That would eliminate a check in psg-list-env. -(and (not (fboundp 'TeX-split-string)) - (not (fboundp 'dired-split)) - ;; This code is part of auc-tex - (defun TeX-split-string (char string) - "Returns a list of strings. given REGEXP the STRING is split into -sections which in string was seperated by REGEXP. - -Examples: - - (TeX-split-string \"\:\" \"abc:def:ghi\") - -> (\"abc\" \"def\" \"ghi\") - - (TeX-split-string \" *\" \"dvips -Plw -p3 -c4 testfile.dvi\") - - -> (\"dvips\" \"-Plw\" \"-p3\" \"-c4\" \"testfile.dvi\") - -If CHAR is nil, or \"\", an error will occur." - - (let ((regexp char) - (start 0) - (result '())) - (while (string-match regexp string start) - (let ((match (string-match regexp string start))) - (setq result (cons (substring string start match) result)) - (setq start (match-end 0)))) - (setq result (cons (substring string start nil) result)) - (nreverse result)))) - -;; Must be in sync with function of same name in ff-paths.el -;; (See also PC-include-file-path in standard emacs ditsribution.) -(defun psg-list-env (env) - "Return a list of directory elements in ENVIRONMENT variable (w/o leading $) -argument may consist of environment variable plus a trailing directory, e.g. -HOME or HOME/bin (trailing directory not supported in dos or OS/2). - -bib-dos-or-os2-variable affects: - path separator used (: or ;) - whether backslashes are converted to slashes" - (if (not (getenv env)) - nil ;Because dired-replace-in-string fails - (let* ((value (if bib-dos-or-os2-variable - (dired-replace-in-string "\\\\" "/" (getenv env)) - (getenv env))) - (sep-char (or (and bib-dos-or-os2-variable ";") ":")) - (entries (and value - (or (and (fboundp 'TeX-split-string) - (TeX-split-string sep-char value)) - (dired-split sep-char value)))) - entry - answers) - (while entries - (setq entry (car entries)) - (setq entries (cdr entries)) - (if (file-directory-p entry) - (setq answers (cons entry answers)))) - (nreverse answers)))) - -;; -;; Create the unified hook to call from LaTeX-mode-hook -;; -(defun bib-cite-initialize () - ;; Christoph Wedler's suggestion for xemacs - ;; Added for version 2.19 - (if (boundp 'tags-always-exact) - (progn - (make-local-variable 'tags-always-exact) - (setq tags-always-exact nil))) - - ;; Christoph Wedler - (and (boundp 'bib-cite-xemacs-menu) - bib-cite-xemacs-menu - (fboundp 'add-submenu) ;Insurance for emacs - ;;;FIXME: I can do this to add a main menu. - ;;(add-submenu nil bib-cite-xemacs-menu) - ;; This makes it buffer-specific so I don't need to remove it. - (set-buffer-menubar (copy-sequence current-menubar)) - (add-submenu '("LaTeX") bib-cite-xemacs-menu)) - - (cond - ((string-match "XEmacs\\|Lucid" emacs-version) - ;; Define keys for XEmacs - ;; Could do all modes like this for emacs also... - (local-set-key "\C-cba" 'bib-apropos) - (local-set-key "\C-cbm" 'bib-make-bibliography) - (local-set-key "\C-cbd" 'bib-display) - (local-set-key "\C-cbe" 'bib-etags) - (local-set-key "\C-cbf" 'bib-find) - (local-set-key "\C-cbh" 'bib-highlight-mouse))) - - (if bib-highlight-mouse-t - (bib-highlight-mouse)) - (if bib-use-imenu - (LaTeX-hook-setq-imenu)) - - ;; Make sure that imenu-sort-function is nil - (and (boundp 'imenu-sort-function) - imenu-sort-function - (make-local-variable 'imenu-sort-function) - (setq imenu-sort-function nil)) - ) - -(add-hook 'LaTeX-mode-hook 'bib-cite-initialize t) ;auctex's latex-mode -(add-hook 'latex-mode-hook 'bib-cite-initialize t) ;emacs' plain latex-mode - -;; If bib-cite.el is loaded in a mode hook, bib-highlight-mouse and -;; LaTeX-hook-setq-imenu are not called on the buffer... -;; so invoke it now for .tex buffers. Same for imenu. -;(if (string-match ".tex$" (buffer-name)) -; (bib-cite-initialize)) - -(if (or (eq major-mode 'latex-mode) - (eq major-mode 'plain-tex-mode)) - (bib-cite-initialize)) - -(provide 'bib-cite) -;;; bib-cite.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/auctex/custom-load.el --- a/lisp/auctex/custom-load.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,11 +0,0 @@ -(custom-put 'AUC-TeX 'custom-loads '("tex")) -(custom-put 'TeX-file 'custom-loads '("tex")) -(custom-put 'TeX-command 'custom-loads '("tex")) -(custom-put 'LaTeX 'custom-loads '("tex" "latex")) -(custom-put 'TeX-output 'custom-loads '("tex" "tex-buf")) -(custom-put 'TeX-command-name 'custom-loads '("tex")) -(custom-put 'LaTeX-environment 'custom-loads '("latex")) -(custom-put 'LaTeX-label 'custom-loads '("latex")) -(custom-put 'LaTeX-indentation 'custom-loads '("latex")) -(custom-put 'LaTeX-math 'custom-loads '("latex")) -(custom-put 'LaTeX-macro 'custom-loads '("latex")) diff -r 6866abce6aaf -r 6075d714658b lisp/auctex/font-latex.el --- a/lisp/auctex/font-latex.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,790 +0,0 @@ -;;; font-latex.el --- LaTeX fontification for Font Lock mode. - -;; Copyright (C) 1996 Peter S. Galbraith - -;; Authors: Peter S. Galbraith -;; Simon Marshall -;; Maintainer: Peter S. Galbraith -;; Created: 06 July 1996 -;; Version: 0.403 *Beta* (19 Nov 96) -;; Keywords: LaTeX faces - -;; RCS $Id: font-latex.el,v 1.1 1997/02/20 02:17:35 steve Exp $ -;; Note: RCS version number does not correspond to release number. - -;; LCD Archive Entry: (Not yet submitted!) -;; font-latex|Peter Galbraith|galbraith@mixing.qc.dfo.ca| -;; LaTeX fontification for font-lock| -;; 06-Jul-1996|0.01|~/modes/font-latex.el| - -;; The archive is archive.cis.ohio-state.edu in /pub/gnu/emacs/elisp-archive. - -;;; This file is not part of GNU Emacs. - -;; This package is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; This package is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; New versions of this package (if they exist) may be found at: -;; ftp://ftp.phys.ocean.dal.ca/users/rhogee/elisp/font-latex.el - -;; Description: -;; This package enhances font-lock fontification patterns for LaTeX. -;; font-lock mode is a minor mode that causes your comments to be -;; displayed in one face, strings in another, reserved words in another, -;; and so on. -;; -;; Please see the accompanying file font-latex.tex for a demo of what -;; font-latex is supposed to do at different fontification levels. - -;; Installation instructions: -;; -;; Put this file in your emacs load-path, and byte-compile it: -;; M-x byte-compile-file -;; ** It runs faster when you byte-compile it! ** -;; -;; Then all you need to do is add this form to your .emacs file: -;; -;; (if window-system -;; (require 'font-latex)) -;; -;; There are two levels of fontification, selected by the value of the -;; font-lock variable font-lock-maximum-decoration. font-latex uses two -;; levels. There are ways documented in font-latex.el to set this -;; differently for each mode that uses font-lock, but if you are unsure and -;; are running on a fast enough machine, try putting this in your ~/.emacs -;; file: -;; (setq font-lock-maximum-decoration t) -;; It probably best to put it before the (require 'font-latex) statement. -;; -;; Lazy-lock users: -;; -;; lazy-lock and font-lock don't work too well together (up to Emacs 19.33 -;; and XEmacs 19.14 anyway). font-latex uses functions to find text to -;; fontify that may span more than one line, and this doesn't suit -;; lazy-lock's search limits too well. -;; -;; Old hilit19 (and hilit-LaTeX) users: -;; -;; If you are upgrading from using hilit-LaTeX.el or were using hilit19, -;; you must disable hilit19 (at least for latex mode) in order to use -;; font-latex.el. Here's how: -;; -;; - If you don't care to use hilit19 at all, don't `load' or `require' it -;; in your ~/.emacs file by removing the "(require 'hilit-LaTeX)" line. -;; - If you wish to use hilit19 everywhere but in latex mode, add the -;; following before your `load' or `require' hilit19: -;; -;; (setq hilit-mode-enable-list '(not latex-mode)) -;; -;; You can tell you using font-latex instead of hilit-LaTeX because: -;; -;; - colours will be different -;; - You'll see a message like `Fontifying font-latex.tex...done' -;; instead of `highlighting 1: \(^\|[^\\]\)\(\\[a-zA-Z\\]+\)' -;; ---------------------------------------------------------------------------- -;;; Change log: -;; V0.403 19Nov96 (RCS V1.37) -;; - Christoph Wedler -;; XEmacs patch for local math-font -;; - Changed scheme for fontification of \section*{...} -;; V0.402 13Nov96 PSG (RCS V1.35) -;; - Embeded comments handled. -;; - Better XEmacs initilisation. -;; V0.401 12Nov96 PSG (RCS V1.34) - Nothing fontified when commented-out. -;; V0.400 11Nov96 PSG (RCS V1.33) -;; - Stab at on-the-fly multiline. -;; - mono support: -;; V0.314 16Oct96 PSG - Support for dark background removed for XEmacs. -;; V0.313 07Oct96 PSG (RCS V1.31) - Support for dark background. -;; V0.312 26Aug96 PSG (RCS V1.30) - Added font-latex-commented-outp. -;; V0.311 22Aug96 PSG (RCS V1.29) - fixed for XEmacs. -;; V0.310 22Aug96 simon (RCS V1.27) -;; - make font-latex-setup run font-lock-make-faces before variable trickery. -;; - set font-latex-string-face to the global value of font-lock-string-face. -;; V0.309 21Aug96 PSG (RCS V1.26) -;; - new font-latex-math-face done by string syntax. User may modify it. -;; - new font-latex-string-face. -;; V0.308 15Aug96 PSG (RCS V1.25) -;; - $$...$$ gets font-latex-math-face -;; - font-latex-match-math-envII fixed. -;; V0.307 14Aug96 PSG (RCS V1.23) - setup okay if loaded in a latex-mode-hook -;; V0.306 14Aug96 PSG (RCS V1.22) - added "item" to font-latex-match-function -;; V0.305 14Aug96 PSG (RCS V1.20) - use keep in font-latex-match-math-envII -;; V0.304 14Aug96 PSG (RCS V1.18) - minor comment edits. -;; V0.303 14Aug96 simon (RCS V1.17) -;; - rewrote font-latex-match-math-envII like font-latex-match-quotation -;; V0.302 12Aug96 PSG (RCS V1.16) -;; - (goto-char end) in condition-case error to avoid infinite loops. -;; V0.301 08Aug96 PSG (RCS V1.14) -;; - Better faces in XEmacs. -;; V0.300 07Aug96 PSG (RCS V1.12) -;; - Changed font-latex-match-font-inside-braces again for stranded \bf -;; - "[a-z]+box" changed -;; - font-latex-match-math-env checks preceding-char for \\[ -;; - use eval-after-compile in font-latex-match-math-envII -;; V0.201 05Aug96 PSG added \\(display\\)?math to Simon's changes -;; V0.200 05Aug96 simon: (RCS V1.10) -;; - fixed font-latex-match-command-outside-arguments -;; - rewrote font-latex-match-font-outside-braces like above -;; - rewrote font-latex-match-font-inside-braces like above -;; V0.101 01Aug96 PSG added \\(display\\)?math -;; V0.100 01Aug96 PSG - massive new test version -;; V0.061 23Jul96 PSG -;; - Removed trailing "\\>" in warning-face regexp (fails with \\ \- \\*) -;; V0.06 23Jul96 PSG -;; - fixed dobib in font-latex-labels. -;; - shorter font regexp in levels 3+4. -;; - removed \item and & from type -;; - fixed font-latex-math-envII regexp -;; V0.05 22Jul96 PSG -;; - changed \ref etc to reference-face. -;; - \\b added in buggy \item[option] regexp (not really fixed). -;; - font-latex-labels regexp bug -;; V0.041 simon: -;; - added font-latex-match-command-outside-arguments -;; - rewrote font-latex-match-quotation and font-latex-bib-highlight-mouse -;; - rewrote then removed bib-cite functionality. -;; - general top-level cleanup -;; V0.04 11Jul96 PSG -;; - added font-lock-comment-start-regexp defined in 19.32 -;; - encoded 8-bit characters to 7-bit. -;; V0.03 10Jul96 PSG -;; - font-latex-bib-cite-mouse-highlight-p can change after font-lock-defaults -;; is constructed. -;; V0.02 09Jul96 PSG -;; - added font-latex-bib-cite-mouse-highlight-p -;; - Fixed `overwrite' flags -;; V0.01 06Jul96 Peter S Galbraith - Created -;; ---------------------------------------------------------------------------- -;;; Code: -(require 'font-lock) - -(defvar font-latex-warning-face 'font-latex-warning-face - "Face to use for LaTeX major keywords.") -(defvar font-latex-sedate-face 'font-latex-sedate-face - "Face to use for LaTeX minor keywords.") -(defvar font-latex-italic-face 'font-latex-italic-face - "Face to use for LaTeX italics.") -(defvar font-latex-bold-face 'font-latex-bold-face - "Face to use for LaTeX bolds.") -(defvar font-latex-math-face 'font-latex-math-face - "Face to use for LaTeX math environments.") - -;; End-User can stop reading here. - -;; Make sure font-latex.el is supported. I don't claim to have tested this... -(if (if (save-match-data (string-match "Lucid\\|XEmacs" (emacs-version))) - (and (= emacs-major-version 19) (< emacs-minor-version 14)) - (and (= emacs-major-version 19) (< emacs-minor-version 29))) - (error "`font-latex' was written for Emacs 19.29/XEmacs 19.14 or later")) - -(defvar font-latex-is-XEmacs - (not (null (save-match-data (string-match "XEmacs\\|Lucid" emacs-version))))) - -(defvar font-latex-string-face nil - "Face to use for strings. This is set by Font LaTeX.") - -(defvar font-lock-comment-start-regexp nil - "Regexp to match the start of a comment.") - -(eval-when-compile - (require 'cl)) - -(cond - ((not font-latex-is-XEmacs) - ;;; emacs: - ;; Otherwise I overwrite fock-lock-face-attributes. - ;; font-lock.el needs a better way to add these faces! - (if (not font-lock-face-attributes) - (font-lock-make-faces)) - (unless (assq 'font-latex-sedate-face font-lock-face-attributes) - (cond - ;; FIXME: Add better conditions for grayscale. - ((memq font-lock-display-type '(mono monochrome grayscale greyscale - grayshade greyshade)) - (setq font-lock-face-attributes - (append - font-lock-face-attributes - (list '(font-latex-bold-face nil nil t nil nil) - '(font-latex-italic-face nil nil nil t nil) - '(font-latex-math-face nil nil nil nil t) - '(font-latex-sedate-face nil nil nil t nil) - (list - 'font-latex-warning-face - (cdr (assq 'background-color (frame-parameters))) - (cdr (assq 'foreground-color (frame-parameters))) - nil nil nil))))) - ((eq font-lock-background-mode 'light) ; light colour background - (setq font-lock-face-attributes - (append - font-lock-face-attributes - ;;;FIXME: These won't follow font-lock-type-face's changes. - ;;; Should I change to a (copy-face) scheme? - '((font-latex-bold-face "DarkOliveGreen" nil t nil nil) - (font-latex-italic-face "DarkOliveGreen" nil nil t nil) - (font-latex-math-face "green4") - (font-latex-sedate-face "grey50") - (font-latex-warning-face "red" nil t nil nil))))) - (t ; dark colour background - (setq font-lock-face-attributes - (append - font-lock-face-attributes - '((font-latex-bold-face "OliveGreen" nil t nil nil) - (font-latex-italic-face "OliveGreen" nil nil t nil) - (font-latex-math-face "LightSeaGreen") - ;; good are > LightSeaGreen, LightCoral, coral, orchid, orange - (font-latex-sedate-face "grey60") - (font-latex-warning-face "red" nil t nil nil)))))))) - (t - ;;; XEmacs: - (make-face 'font-latex-string-face "Face to use for LaTeX string.") - (copy-face 'font-lock-string-face 'font-latex-string-face) - - (make-face 'font-latex-bold-face "Face to use for LaTeX bolds.") - (copy-face 'font-lock-type-face 'font-latex-bold-face) - (make-face-bold 'font-latex-bold-face) - - (make-face 'font-latex-italic-face "Face to use for LaTeX italics.") - (copy-face 'font-lock-type-face 'font-latex-italic-face) - (make-face-italic 'font-latex-italic-face) - - (make-face 'font-latex-math-face "Face to use for LaTeX math.") - (make-face 'font-latex-sedate-face "Face to use for LaTeX minor keywords.") - (make-face 'font-latex-warning-face "Face to use for LaTeX major keywords.") - (make-face-bold 'font-latex-warning-face) - ;; XEmacs uses a tag-list thingy to determine if we are using color - ;; or mono (and I assume a dark background). - (set-face-foreground 'font-latex-math-face "green4" 'global nil 'append) - (set-face-foreground 'font-latex-sedate-face "grey50" 'global nil 'append) - (set-face-foreground 'font-latex-warning-face "red" 'global nil 'append))) - -(defun font-latex-setup () - "Setup this buffer for LaTeX font-lock. Usually called from a hook." - ;; Trickery to make $$ fontification be in `font-latex-math-face' while - ;; strings get whatever `font-lock-string-face' has been set to. - (if font-latex-is-XEmacs - ;; Cool patch from Christoph Wedler... - (let (instance) - (mapcar (function - (lambda (property) - (setq instance - (face-property-instance 'font-latex-math-face property - nil 0 t)) - (if (numberp instance) - (setq instance - (face-property-instance 'default property nil 0))) - (or (numberp instance) - (set-face-property 'font-lock-string-face property - instance (current-buffer))))) - (built-in-face-specifiers))) - (font-lock-make-faces) - (make-local-variable 'font-lock-string-face) - (setq font-lock-string-face font-latex-math-face - font-latex-string-face (default-value 'font-lock-string-face)) - ;; Tell Font Lock about the support. - (make-local-variable 'font-lock-defaults) - ;; Parentheses () are disabled because they should not delimit fontification - ;; in LaTeX text. - (setq font-lock-defaults - '((font-latex-keywords font-latex-keywords-1 font-latex-keywords-2) - nil nil ((?\( . ".") (?\) . ".") (?$ . "\"")) nil - (font-lock-comment-start-regexp . "%") - (font-lock-mark-block-function . mark-paragraph))))) - -(when font-latex-is-XEmacs - (put 'latex-mode 'font-lock-defaults - '((font-latex-keywords font-latex-keywords-1 font-latex-keywords-2) - nil nil ((?\( . ".") (?\) . ".") (?$ . "\"")) nil - (font-lock-comment-start-regexp . "%") - (font-lock-mark-block-function . mark-paragraph))) - (put 'latex-tex-mode 'font-lock-defaults 'latex-mode) - (put 'LaTex-tex-mode 'font-lock-defaults 'latex-mode) - (put 'LaTeX-mode 'font-lock-defaults 'latex-mode) - (put 'japanese-LaTeX-mode 'font-lock-defaults 'latex-mode) - (put 'LATeX-MoDe 'font-lock-defaults 'latex-mode) - (put 'lATEx-mODe 'font-lock-defaults 'latex-mode)) - -(defconst font-latex-keywords-1 - (list - ;; FIXME: Maybe I should put this in a function, use override but let - ;; the function determine if commented-out. - (list (concat "\\\\\\(\\(no\\)?pagebreak\\|\\(new\\|clear\\(double\\)?\\)" - "page\\|enlargethispage\\|\\(no\\)?linebreak\\|newline\\|" - "-\\|\\\\\\(\*\\)?\\|displaybreak\\|allowdisplaybreaks\\)") - '(0 font-latex-warning-face)) - '("\\$\\$\\([^$]+\\)\\$\\$" 1 font-latex-math-face) ;;; $$...$$ - '(font-latex-match-quotation . font-latex-string-face) ;;; ``...'' - '(font-latex-match-font-outside-braces ;;;\textit{text} - (0 font-lock-keyword-face - append ;Override? [t 'keep 'prepend 'append] - ;; Can't use prepend because that overwrites syntax fontification - ;; e.g. comments. - t) ;Laxmatch? if t, do not signal error - (1 font-latex-italic-face append t) - (2 font-latex-bold-face append t) - (3 font-lock-type-face append t)) - '(font-latex-match-font-inside-braces ;;;{\it text} - (0 font-lock-keyword-face append t) - (1 font-latex-italic-face append t) - (2 font-latex-bold-face append t) - (3 font-lock-type-face append t))) - "Subdued level highlighting for LaTeX modes.") - -(defconst font-latex-keywords-2 - (append font-latex-keywords-1 - '((font-latex-match-reference ;;;\cite - (0 font-lock-keyword-face append t) - (1 font-lock-variable-name-face append t) ;;; [opt] - (2 font-lock-reference-face append t)) ;;; {key} - (font-latex-match-function ;;;\section - (0 font-lock-keyword-face append t) - (1 font-lock-variable-name-face append t) ;;; [opt] - (2 font-lock-function-name-face append t)) ;;; {text} - (font-latex-match-variable - (0 font-lock-keyword-face nil t) - (1 font-lock-variable-name-face nil t) - (2 font-lock-variable-name-face nil t)) - (font-latex-match-math-env - (0 font-latex-math-face append t)) ;;;\(...\) - (font-latex-match-math-envII ;;;Math environ. - (0 font-latex-math-face append t)) - ("\\\\[@A-Za-z]+" ;;;Other commands - (0 font-latex-sedate-face append)))) - "High level highlighting for LaTeX modes.") - -(defvar font-latex-keywords font-latex-keywords-1 - "Default expressions to highlight in TeX mode.") - - -(defun font-latex-match-reference (limit) - (font-latex-match-command-outside-arguments - (eval-when-compile - (concat "\\\\" "\\(" - (mapconcat 'identity - '("[A-Za-z]*cite[A-Za-z]*" "label" "\\(page\\|v\\|eq\\)?ref" - "index" "glossary" "\\(footnote\\(mark\\|text\\)?\\)") - "\\|") - "\\)\\>")) - limit nil nil)) - -(defun font-latex-match-function (limit) - "Fontify things like \\section{text}" - (font-latex-match-command-outside-arguments - (eval-when-compile - (concat "\\\\" "\\(" - (mapconcat 'identity - ;; \\*? doesn't work with \\> at the end of the regexp. - ;; Instead, allow `*' for all commands (!) - '("item" ;;;FIXME: does not have an {arg} so should treated elsewhere. - "include" "input" "bibliography" - "part" "chapter" "\\(sub\\)*section" "\\(sub\\)*paragraph" - "begin" "end" - "title" "author" "date" "thanks" "address" - "pagenumbering" - "\\(this\\)?pagestyle" - "nofiles" "includeonly" - "bibliographystyle" "\\(document\\(style\\|class\\)\\)" - "\\(re\\)?new\\(environment\\|command\\|length\\|theorem\\|counter\\)" - "usepackage" "caption" "\\(f\\|m\\|s\\)box" "\\(v\\|h\\)space") - "\\|") - "\\)\\>")) - limit nil t)) - -(defun font-latex-match-variable (limit) - "Fontify things like \\newcommand{stuff}" - (font-latex-match-command-outside-arguments - (eval-when-compile - (concat "\\\\" "\\(" - "set\\(length\\|towidth\\|counter\\)\\|" - "addto\\(length\\|counter\\)" - "\\)\\>")) - limit t nil)) - - -;; FIXME: --About font-latex-commented-outp-- -;; Fontification is *slower* for affected functions (in particular -;; font-latex-match-function), so it will be worth it to increase -;; performance in the algorithm. -;; - don't return (store-match-data (list nil nil)) in -;; font-latex-match-command-outside-arguments, instead skip over -;; commented-out parts internally. -;; - Perhaps handling outlined code is excessive and slows down the -;; search too much? -;; - Is save-match-data expensive? The calling function could store -;; the match-data before it calls (font-latex-commented-outp) knowing -;; that is would trash the list. -(defun font-latex-commented-outp () - "Return t is comment character is found between bol and point." - (save-excursion - (let ((limit (point))) - (save-match-data - ;; Handle outlined code - (re-search-backward "^\\|\C-m" (point-min) t) - (if (re-search-forward "^%\\|[^\\]%" limit t) - t - nil))))) - -(defvar font-latex-match-command-cache-state nil - "Cache state of unterminated match to fontify") -(defvar font-latex-match-command-cache-start nil - "Cache start of unterminated match to fontify") -(defvar font-latex-match-command-cache-limit nil - "Cache end of unterminated match to fontify") -(defvar font-latex-match-command-cache-keywords nil - "Cache keywords of unterminated match to fontify") -(make-variable-buffer-local 'font-latex-match-command-cache-state) -(make-variable-buffer-local 'font-latex-match-command-cache-start) -(make-variable-buffer-local 'font-latex-match-command-cache-limit) -(make-variable-buffer-local 'font-latex-match-command-cache-keywords) - -;; FIXME - Note to myself -;; In call to font-latex-match-command-outside-arguments, I could arrange -;; such that keywords which cannot use [options] have this set to nil. -;; LaTeX code woulldn't fontify if options are used illegally in commands, -;; cuing users in that they are doing something wrong. (See RCS V1.11 for -;; useopt option) -;; -;; NOTE - Without an override flag, font-lock does not re-fontify the -;; option `opt' when the `t' is typed-in in "\cite[opt". The first `o' -;; was fontified and now has a face, which font-lock-apply-highlight -;; won't override. The `p' and `t' get a face as they are typed by -;; inheriting from left-stickyness on the `o'. -;; THEREFORE, I cannot rely on font-lock-apply-highlight to continue -;; multi-line incomplete patterns, because the first character of the -;; pattern on the first line has a face. I must use `prepend'. -(defun font-latex-match-command-outside-arguments (keywords limit twoargs - asterix) - "Search for regexp command KEYWORDS[opt]{arg} before LIMIT. -If TWOARG is t, allow two arguments {arg1}{arg2} -If ASTERIX is t, fontify trailing asterix in command. -Sets `match-data' so that: - subexpression 0 is the keyword, - subexpression 1 is the contents of any following [...] forms - subexpression 2 is the contents of any following {...} forms. -Returns nil if none of KEYWORDS is found." - ;; Prior incomplete match? - (if font-latex-match-command-cache-state - (setq font-latex-match-command-cache-state nil) ;Stop now! - (when (and font-latex-match-command-cache-keywords - (equal font-latex-match-command-cache-keywords keywords) - (>= font-latex-match-command-cache-limit (point)) - (< font-latex-match-command-cache-start (point))) - (goto-char font-latex-match-command-cache-start) - (setq font-latex-match-command-cache-state 'stop)) ;Can only do once - (when (re-search-forward keywords limit t) - (let ((this-start (match-beginning 0))) - (cond - ((font-latex-commented-outp) - ;; Return a nul match such that we skip over this pattern. - ;; (Would be better to skip over internally to this function) - (store-match-data (list nil nil)) - t) - (t - (let ((kbeg (match-beginning 0)) - (kend (+ (match-end 0) - (if (and asterix (eq (following-char) ?\*)) 1 0))) - sbeg send cbeg cend) - (goto-char kend) ;May be moved by asterix - (while (eq (following-char) ?\[) - (save-restriction - ;; Restrict to LIMIT. - (narrow-to-region (point-min) limit) - (setq sbeg (1+ kend)) - (if (condition-case nil - (goto-char (or (scan-sexps (point) 1) (point-max))) - (error)) - (setq send (1- (point))) - (setq send (point-max)) - (goto-char send) - (setq font-latex-match-command-cache-state 'stop)))) - (when (eq (following-char) ?\{) - (save-restriction - ;; Restrict to LIMIT. - (narrow-to-region (point-min) limit) - (setq cbeg (1+ (point))) - (if (condition-case nil - (goto-char (or (scan-sexps (point) 1) (point-max))) - (error)) - (setq cend (1- (point))) - (setq cend (point-max)) - (goto-char cend) - (setq font-latex-match-command-cache-state 'stop)))) - (when (and twoargs (eq (following-char) ?\{)) - (save-restriction - ;; Restrict to LIMIT. - (narrow-to-region (point-min) limit) - (if (condition-case nil - (goto-char (or (scan-sexps (point) 1) (point-max))) - (error)) - (setq cend (1- (point))) - (setq cend (point-max)) - (goto-char cend) - (setq font-latex-match-command-cache-state 'stop)))) - (store-match-data (list kbeg kend sbeg send cbeg cend)) - (when font-latex-match-command-cache-state - (setq font-latex-match-command-cache-start this-start) - (setq font-latex-match-command-cache-limit (point)) - (setq font-latex-match-command-cache-keywords keywords)) - t))))))) - -(defvar font-latex-match-font-cache-state nil - "Cache state of unterminated match to fontify") -(defvar font-latex-match-font-cache-start nil - "Cache start of unterminated match to fontify") -(defvar font-latex-match-font-cache-limit nil - "Cache end of unterminated match to fontify") -(defvar font-latex-match-font-cache-keywords nil - "Cache keywords of unterminated match to fontify") -(make-variable-buffer-local 'font-latex-match-font-cache-state) -(make-variable-buffer-local 'font-latex-match-font-cache-start) -(make-variable-buffer-local 'font-latex-match-font-cache-limit) -(make-variable-buffer-local 'font-latex-match-font-cache-keywords) - -(defun font-latex-match-font-outside-braces (limit) - "Search for font-changing command like \textbf{fubar} before LIMIT. -Sets `match-data' so that: - subexpression 0 is the keyword, - subexpression 1 is the content to fontify in italic. - subexpression 2 is the content to fontify in bold. - subexpression 3 is the content to fontify in type-face. -Returns nil if no font-changing command is found." - (if font-latex-match-font-cache-state - (setq font-latex-match-font-cache-state nil) ;Stop now! - (when (and font-latex-match-font-cache-keywords - (equal font-latex-match-font-cache-keywords keywords) - (>= font-latex-match-font-cache-limit (point)) - (< font-latex-match-font-cache-start (point))) - (goto-char font-latex-match-font-cache-start) - (setq font-latex-match-font-cache-state 'stop)) ;Can only do once - (when (re-search-forward - (eval-when-compile - (concat "\\\\" "\\(" - "\\(emph\\)\\|" ;;; 2 - italic - "\\(text\\(" - "\\(it\\|sl\\)\\|" ;;; 5 - italic - "\\(md\\|rm\\|sf\\|tt\\)\\|" ;;; 6 - type - "\\(bf\\|sc\\|up\\)" ;;; 7 - bold - "\\)\\)\\|" - "\\(boldsymbol\\|pmb\\)" ;;; 8 - bold - "\\)" "{")) - limit t) - (cond - ((font-latex-commented-outp) - ;; Return a nul match such that we skip over this pattern. - ;; (Would be better to skip over internally to this function) - ;; Using `prepend' won't help here, because the problem is that - ;; scan-sexp *fails* to find a commented-out matching bracket! - (store-match-data (list nil nil)) - t) - (t - (let ((kbeg (match-beginning 0)) (kend (match-end 1)) - (beg (match-end 0)) end itbeg itend bfbeg bfend ttbeg ttend) - (goto-char kend) - (save-restriction - ;; Restrict to LIMIT. - (narrow-to-region (point-min) limit) - (if (condition-case nil - (goto-char (or (scan-sexps (point) 1) (point-max))) - (error)) - (setq end (1- (point))) - (setq end (point-max)) - (goto-char end) - (setq font-latex-match-font-cache-state 'stop))) - (cond ((or (match-beginning 2) (match-beginning 5)) - (setq itbeg beg - itend end)) - ((match-beginning 6) - (setq ttbeg beg - ttend end)) - (t - (setq bfbeg beg - bfend end))) - (store-match-data - (list kbeg kend itbeg itend bfbeg bfend ttbeg ttend)) - (when font-latex-match-font-cache-state - (setq font-latex-match-font-cache-start kbeg) - (setq font-latex-match-font-cache-limit (point)) - (setq font-latex-match-font-cache-keywords keywords)) - ;; Start the subsequent search immediately after this keyword. - (goto-char kend) - t)))))) - -(defvar font-latex-match-infont-cache-state nil - "Cache state of unterminated match to fontify") -(defvar font-latex-match-infont-cache-start nil - "Cache start of unterminated match to fontify") -(defvar font-latex-match-infont-cache-limit nil - "Cache end of unterminated match to fontify") -(defvar font-latex-match-infont-cache-keywords nil - "Cache keywords of unterminated match to fontify") -(make-variable-buffer-local 'font-latex-match-infont-cache-state) -(make-variable-buffer-local 'font-latex-match-infont-cache-start) -(make-variable-buffer-local 'font-latex-match-infont-cache-limit) -(make-variable-buffer-local 'font-latex-match-infont-cache-keywords) - -(defun font-latex-match-font-inside-braces (limit) - "Search for font-changing command like {\bf fubar} before LIMIT. -Sets `match-data' so that: - subexpression 0 is the keyword. - subexpression 1 is the content to fontify in italic. - subexpression 2 is the content to fontify in bold. - subexpression 3 is the content to fontify in type-face. -Returns nil if no font-changing command is found." - (if font-latex-match-infont-cache-state - (setq font-latex-match-infont-cache-state nil) ;Stop now! - (when (and font-latex-match-infont-cache-keywords - (equal font-latex-match-infont-cache-keywords keywords) - (>= font-latex-match-infont-cache-limit (point)) - (< font-latex-match-infont-cache-start (point))) - (goto-char font-latex-match-infont-cache-start) - (setq font-latex-match-infont-cache-state 'stop)) ;Can only do once - (when (re-search-forward - (eval-when-compile - (concat "\\\\" "\\(" - ;;; 2 - italic - "\\(em\\|it\\(shape\\)?\\|sl\\(shape\\)?\\)\\|" - ;;; 5 - bold - "\\(bf\\(series\\)?\\|upshape\\|sc\\(shape\\)?\\)\\|" - "mdseries\\|tt\\(family\\)?\\|" - "sf\\(family\\)?\\|rm\\(family\\)?\\|" - "tiny\\|scriptsize\\|footnotesize\\|" - "small\\|normalsize\\|large\\|Large\\|LARGE\\|huge\\|Huge" - "\\)\\>[ \t]*")) - limit t) - (cond - ((font-latex-commented-outp) - ;; Return a nul match such that we skip over this pattern. - ;; (Would be better to skip over internally to this function) - ;; Using `prepend' won't help here, because the problem is that - ;; scan-sexp *fails* to find a commented-out matching bracket! - (store-match-data (list nil nil)) - t) - (t - (let ((kbeg (match-beginning 0)) (kend (match-end 1)) - (beg (match-end 0)) end itbeg itend bfbeg bfend ttbeg ttend) - (goto-char (match-beginning 0)) - (cond - ((not (eq (preceding-char) ?\{)) - ;; Fontify only the keyword as bf/it/type (no argument found). - (cond ((match-beginning 2) (setq itbeg kbeg itend kend)) - ((match-beginning 5) (setq bfbeg kbeg bfend kend)) - (t (setq ttbeg kbeg ttend kend))) - (goto-char (match-end 0)) - (store-match-data - (list nil nil itbeg itend bfbeg bfend ttbeg ttend)) - t) - (t - (condition-case nil - (forward-char -1) - (error)) - (save-restriction - ;; Restrict to LIMIT. - (narrow-to-region (point-min) limit) - (if (condition-case nil - (goto-char (or (scan-sexps (point) 1) (point-max))) - (error)) - (setq end (1- (point))) - (setq end (point-max)) - (goto-char end) - (setq font-latex-match-infont-cache-state 'stop))) - (cond ((match-beginning 2) (setq itbeg beg itend end)) - ((match-beginning 5) (setq bfbeg beg bfend end)) - (t (setq ttbeg beg ttend end))) - (store-match-data - (list kbeg kend itbeg itend bfbeg bfend ttbeg ttend)) - (when font-latex-match-infont-cache-state - (setq font-latex-match-infont-cache-start kbeg) - (setq font-latex-match-infont-cache-limit (point)) - (setq font-latex-match-infont-cache-keywords keywords)) - ;; Start the subsequent search immediately after this keyword. - (goto-char kend))))))))) - -;;; FIXME: Add caches for math-env, math-envII and quotations. -(defun font-latex-match-math-env (limit) - "Used for patterns like: -\\( F = ma \\) -\\ [ F = ma \\] but not \\\\ [len]" - (when (re-search-forward "\\(\\\\(\\)\\|\\(\\\\\\[\\)" limit t) - (goto-char (match-beginning 0)) - (if (eq (preceding-char) ?\\) ; \\[ is not a math environment - (progn - (goto-char (match-end 0)) - (store-match-data (list nil nil)) - t) - (let ((b1start (point))) - (search-forward (cond ((match-beginning 1) "\\)") - (t "\\]")) - limit 'move) - (let ((b2end (or (match-end 0) (point)))) - (store-match-data (list b1start b2end)) - t))))) - -(defun font-latex-match-math-envII (limit) - "Used for patterns like: -\\begin{equation} - fontified stuff -\\end{equation} -The \\begin{equation} and \\end{equation are not fontified here." - (when (re-search-forward - (eval-when-compile - (concat "\\\\begin{\\(\\(display\\)?math\\|equation\\|eqnarray" - "\\|gather\\|multline\\|align\\|x*alignat" - "\\)\\*?}")) - limit t) - (let ((beg (match-end 0)) end) - (if (search-forward (concat "\\end{" (buffer-substring - (match-beginning 1)(match-end 0))) - limit 'move) - (setq end (match-beginning 0)) - (setq end (point))) - (store-match-data (list beg end)) - t))) - -(defun font-latex-match-quotation (limit) - "Used for patterns like: -``this is a normal quote'' and these are multilingual quoted strings: -\"< french \"> and \"`german\"' quotes, << french >> and 8-bit french." - (when (re-search-forward - (eval-when-compile - (concat "\\(``\\)\\|\\(\"<\\)\\|\\(\"`\\)\\|\\(<<\\)\\|" - "\\(" (char-to-string 171) "\\)")) ; An 8-bit "<<" - limit t) - (let ((beg (match-beginning 0))) - (search-forward - (cond ((match-beginning 1) "''") - ((match-beginning 2) "\">") - ((match-beginning 3) "\"'") - ((match-beginning 4) ">>") - ((match-beginning 5) (eval-when-compile (char-to-string 187)))) - limit 'move) - (store-match-data (list beg (point))) - t))) - -;; Install ourselves - -(add-hook 'LaTeX-mode-hook 'font-latex-setup) -(add-hook 'latex-mode-hook 'font-latex-setup) -;; If font-latex is loaded using a latex-mode-hook, then the add-hook above -;; won't be called this time around. Check for this now: -(if (eq major-mode 'latex-mode) - (font-latex-setup)) - -;; Provide ourselves: - -(provide 'font-latex) - -;;; font-latex.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/auctex/latex.el --- a/lisp/auctex/latex.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,3211 +0,0 @@ -;;; latex.el --- Support for LaTeX documents. -;; -;; Maintainer: Per Abrahamsen -;; Version: 9.7p -;; Keywords: wp -;; X-URL: http://sunsite.auc.dk/auctex - -;; Copyright 1991 Kresten Krab Thorup -;; Copyright 1993, 1994, 1995, 1996, 1997 Per Abrahamsen -;; -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 1, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Code: - -(require 'tex) - -;;; Syntax - -(defvar LaTeX-optop "[" - "The LaTeX optional argument opening character.") -(make-variable-buffer-local 'LaTeX-optop) - -(defvar LaTeX-optcl "]" - "The LaTeX optional argument closeing character.") -(make-variable-buffer-local 'LaTeX-optcl) - -;;; Style - -(defcustom LaTeX-default-style "article" - "*Default when creating new documents." - :group 'LaTeX-environment - :type 'string) - - (make-variable-buffer-local 'LaTeX-default-style) - -(defcustom LaTeX-default-options nil - "Default options to documentstyle. -A list of strings." - :group 'LaTeX-environment - :type '(repeat (string :format "%v"))) - - (make-variable-buffer-local 'LaTeX-default-options) - -;;; Syntax Table - -(defvar LaTeX-mode-syntax-table (copy-syntax-table TeX-mode-syntax-table) - "Syntax table used in LaTeX mode.") - -(progn ; set [] to match for LaTeX. - (modify-syntax-entry (string-to-char LaTeX-optop) - (concat "(" LaTeX-optcl) - LaTeX-mode-syntax-table) - (modify-syntax-entry (string-to-char LaTeX-optcl) - (concat ")" LaTeX-optop) - LaTeX-mode-syntax-table)) - -;;; Sections - -(defun LaTeX-section (arg) - "Insert a template for a LaTeX section. -Determinate the type of section to be inserted, by the argument ARG. - -If ARG is nil or missing, use the current level. -If ARG is a list (selected by C-u), go downward one level. -If ARG is negative, go up that many levels. -If ARG is positive or zero, use absolute level: - - 0 : part - 1 : chapter - 2 : section - 3 : subsection - 4 : subsubsection - 5 : paragraph - 6 : subparagraph - -The following variables can be set to customize: - -LaTeX-section-hook Hooks to run when inserting a section. -LaTeX-section-label Prefix to all section labels." - - (interactive "*P") - (let* ((val (prefix-numeric-value arg)) - (level (cond ((null arg) - (LaTeX-current-section)) - ((listp arg) - (LaTeX-down-section)) - ((< val 0) - (LaTeX-up-section (- val))) - (t val))) - (name (LaTeX-section-name level)) - (toc nil) - (title "") - (done-mark (make-marker))) - (newline) - (run-hooks 'LaTeX-section-hook) - (newline) - (if (marker-position done-mark) - (goto-char (marker-position done-mark))) - (set-marker done-mark nil))) - -(defun LaTeX-current-section () - "Return the level of the section that contain point. -See also LaTeX-section for description of levels." - (save-excursion - (max (LaTeX-largest-level) - (if (re-search-backward (LaTeX-outline-regexp) nil t) - (- (LaTeX-outline-level) (LaTeX-outline-offset)) - (LaTeX-largest-level))))) - -(defun LaTeX-down-section () - "Return the value of a section one level under the current. -Tries to find what kind of section that have been used earlier in the -text, if this fail, it will just return one less than the current -section." - (save-excursion - (let ((current (LaTeX-current-section)) - (next nil) - (regexp (LaTeX-outline-regexp))) - (if (not (re-search-backward regexp nil t)) - (1+ current) - (while (not next) - (cond - ((eq (LaTeX-current-section) current) - (if (re-search-forward regexp nil t) - (if (<= (setq next (LaTeX-current-section)) current) ;Wow! - (setq next (1+ current))) - (setq next (1+ current)))) - ((not (re-search-backward regexp nil t)) - (setq next (1+ current))))) - next)))) - -(defun LaTeX-up-section (arg) - "Return the value of the section ARG levels above this one." - (save-excursion - (if (zerop arg) - (LaTeX-current-section) - (let ((current (LaTeX-current-section))) - (while (and (>= (LaTeX-current-section) current) - (re-search-backward (LaTeX-outline-regexp) - nil t))) - (LaTeX-up-section (1- arg)))))) - -(defvar LaTeX-section-list '(("part" 0) - ("chapter" 1) - ("section" 2) - ("subsection" 3) - ("subsubsection" 4) - ("paragraph" 5) - ("subparagraph" 6)) - "List which elements is the names of the sections used by LaTeX.") - -(defun LaTeX-section-name (level) - "Return the name of the section corresponding to LEVEL." - (let ((entry (TeX-member level LaTeX-section-list - (function (lambda (a b) (equal a (nth 1 b))))))) - (if entry - (nth 0 entry) - nil))) - -(defun LaTeX-section-level (name) - "Return the level of the section NAME." - (let ((entry (TeX-member name LaTeX-section-list - (function (lambda (a b) (equal a (nth 0 b))))))) - - (if entry - (nth 1 entry) - nil))) - -(defcustom TeX-outline-extra nil - "List of extra TeX outline levels. - -Each element is a list with two entries. The first entry is the -regular expression matching a header, and the second is the level of -the header. See LaTeX-section-list for existing header levels." - :group 'LaTeX - :type '(repeat (group (regexp :tag "Match") - (integer :tag "Level")))) - -(defun LaTeX-outline-regexp (&optional anywhere) - "Return regexp for LaTeX sections. - -If optional argument ANYWHERE is not nil, do not require that the -header is at the start of a line." - (concat (if anywhere "" "^") - "[ \t]*" - (regexp-quote TeX-esc) - "\\(appendix\\|documentstyle\\|documentclass\\|" - (mapconcat 'car LaTeX-section-list "\\|") - "\\)\\b" - (if TeX-outline-extra - "\\|" - "") - (mapconcat 'car TeX-outline-extra "\\|") - "\\|" TeX-header-end - "\\|" TeX-trailer-start)) - -(defvar LaTeX-largest-level nil - "Largest sectioning level with current document style") - -(make-variable-buffer-local 'LaTeX-largest-level) - -(defun LaTeX-largest-level () - (TeX-update-style) - LaTeX-largest-level) - -(defun LaTeX-outline-offset () - "Offset to add to LaTeX-section-list levels to get outline level." - (- 2 (LaTeX-largest-level))) - -(defun TeX-look-at (list) - "Check if we are looking at the first element of a member of LIST. -If so, return the second element, otherwise return nil." - (while (and list - (not (looking-at (nth 0 (car list))))) - (setq list (cdr list))) - (if list - (nth 1 (car list)) - nil)) - -(defun LaTeX-outline-level () - "Find the level of current outline heading in an LaTeX document." - (cond ((looking-at LaTeX-header-end) 1) - ((looking-at LaTeX-trailer-start) 1) - ((TeX-look-at TeX-outline-extra) - (max 1 (+ (TeX-look-at TeX-outline-extra) - (LaTeX-outline-offset)))) - (t - (save-excursion - (skip-chars-forward " \t") - (forward-char 1) - (cond ((looking-at "appendix") 1) - ((looking-at "documentstyle") 1) - ((looking-at "documentclass") 1) - ((TeX-look-at LaTeX-section-list) - (max 1 (+ (TeX-look-at LaTeX-section-list) - (LaTeX-outline-offset)))) - (t - (error "Unrecognized header"))))))) - -(add-hook 'TeX-remove-style-hook - (function (lambda () (setq LaTeX-largest-level nil)))) - -(defcustom LaTeX-section-hook - '(LaTeX-section-heading - LaTeX-section-title -;; LaTeX-section-toc ; Most people won't want this - LaTeX-section-section - LaTeX-section-label) - "List of hooks to run when a new section is inserted. - -The following variables are set before the hooks are run - -level - numeric section level, see the documentation of `LaTeX-section'. -name - name of the sectioning command, derived from `level'. -title - The title of the section, default to an empty string. -toc - Entry for the table of contents list, default nil. -done-mark - Position of point afterwards, default nil (meaning end). - -The following standard hook exist - - -LaTeX-section-heading: Query the user about the name of the -sectioning command. Modifies `level' and `name'. - -LaTeX-section-title: Query the user about the title of the -section. Modifies `title'. - -LaTeX-section-toc: Query the user for the toc entry. Modifies -`toc'. - -LaTeX-section-section: Insert LaTeX section command according to -`name', `title', and `toc'. If `toc' is nil, no toc entry is -enserted. If `toc' or `title' are empty strings, `done-mark' will be -placed at the point they should be inserted. - -LaTeX-section-label: Insert a label after the section command. -Controled by the variable `LaTeX-section-label'. - -To get a full featured LaTeX-section command, insert - - (setq LaTeX-section-hook - '(LaTeX-section-heading - LaTeX-section-title - LaTeX-section-toc - LaTeX-section-section - LaTeX-section-label)) - -in your .emacs file." - :type 'hook - :options '(LaTeX-section-heading - LaTeX-section-title - LaTeX-section-toc - LaTeX-section-section - LaTeX-section-label)) - - -(defcustom LaTeX-section-label - '(("chapter" . "cha:") - ("section" . "sec:") - ("subsection" . "sec:")) - "Default prefix when asking for a label. - -If it is a string, it it used unchanged for all kinds of sections. -If it is nil, no label is inserted. -If it is a list, the list is searched for a member whose car is equal -to the name of the sectioning command being inserted. The cdr is then -used as the prefix. If the name is not found, or if the cdr is nil, -no label is inserted." - :group 'LaTeX-label - :type '(choice (const :tag "none" nil) - (string :format "%v" :tag "Common") - (repeat :menu-tag "Level specific" - :format "\n%v%i" - (cons :format "%v" - (string :tag "Type") - (choice :tag "Prefix" - (const :tag "none" nil) - (string :format "%v")))))) - -;;; Section Hooks. - -(defun LaTeX-section-heading () - "Hook to prompt for LaTeX section name. -Insert this hook into LaTeX-section-hook to allow the user to change -the name of the sectioning command inserted with `\\[LaTeX-section]'." - (let ((string (completing-read - (concat "Select level: (default " name ") ") - LaTeX-section-list - nil nil nil))) - ; Update name - (if (not (zerop (length string))) - (setq name string)) - ; Update level - (setq level (LaTeX-section-level name)))) - -(defun LaTeX-section-title () - "Hook to prompt for LaTeX section title. -Insert this hook into LaTeX-section-hook to allow the user to change -the title of the section inserted with `\\[LaTeX-section]." - (setq title (read-string "What title: "))) - -(defun LaTeX-section-toc () - "Hook to prompt for the LaTeX section entry in the table of content . -Insert this hook into LaTeX-section-hook to allow the user to insert -a different entry for the section in the table of content." - (setq toc (read-string "Toc Entry: ")) - (if (zerop (length toc)) - (setq toc nil))) - -(defun LaTeX-section-section () - "Hook to insert LaTeX section command into the file. -Insert this hook into LaTeX-section-hook after those hooks which sets -the `name', `title', and `toc' variables, but before those hooks which -assumes the section already is inserted." - (insert TeX-esc name) - (cond ((null toc)) - ((zerop (length toc)) - (insert LaTeX-optop) - (set-marker done-mark (point)) - (insert LaTeX-optcl)) - (t - (insert LaTeX-optop toc LaTeX-optcl))) - (insert TeX-grop) - (if (zerop (length title)) - (set-marker done-mark (point))) - (insert title TeX-grcl) - (newline)) - -(defun LaTeX-section-label () - "Hook to insert a label after the sectioning command. -Insert this hook into LaTeX-section-hook to prompt for a label to be -inserted after the sectioning command. - -The beaviour of this hook is controled by LaTeX-section-label." - (and (LaTeX-label name) - (newline))) - -;;; Environments - -(defgroup LaTeX-environment nil - "Environments in AUC TeX." - :group 'LaTeX-macro) - -(defcustom LaTeX-default-environment "itemize" - "*The default environment when creating new ones with LaTeX-environment." - :group 'LaTeX-environment - :type 'string) - (make-variable-buffer-local 'LaTeX-default-environment) - -(defun LaTeX-environment (arg) - "Make LaTeX environment (\\begin{...}-\\end{...} pair). -With optional ARG, modify current environment. - -It may be customized with the following variables: - -LaTeX-default-environment Your favorite environment. -LaTeX-default-style Your favorite document style. -LaTeX-default-options Your favorite document style options. -LaTeX-float Where you want figures and tables to float. -LaTeX-table-label Your prefix to labels in tables. -LaTeX-figure-label Your prefix to labels in figures. -LaTeX-default-format Format for array and tabular. -LaTeX-default-position Position for array and tabular." - - (interactive "*P") - (let ((environment (completing-read (concat "Environment type: (default " - (if (TeX-near-bobp) - "document" - LaTeX-default-environment) - ") ") - (LaTeX-environment-list)))) - ;; Get default - (cond ((and (zerop (length environment)) - (TeX-near-bobp)) - (setq environment "document")) - ((zerop (length environment)) - (setq environment LaTeX-default-environment)) - (t - (setq LaTeX-default-environment environment))) - - (let ((entry (assoc environment (LaTeX-environment-list)))) - (if (null entry) - (LaTeX-add-environments (list environment))) - - (if arg - (LaTeX-modify-environment environment) - (LaTeX-environment-menu environment))))) - -(defun LaTeX-environment-menu (environment) - ;; Insert ENVIRONMENT around point or region. - (let ((entry (assoc environment (LaTeX-environment-list)))) - (cond ((not (and entry (nth 1 entry))) - (LaTeX-insert-environment environment)) - ((numberp (nth 1 entry)) - (let ((count (nth 1 entry)) - (args "")) - (while (> count 0) - (setq args (concat args TeX-grop TeX-grcl)) - (setq count (- count 1))) - (LaTeX-insert-environment environment args))) - ((stringp (nth 1 entry)) - (let ((prompts (cdr entry)) - (args "")) - (while prompts - (setq args (concat args - TeX-grop - (read-from-minibuffer (concat (car prompts) - ": ")) - TeX-grcl)) - (setq prompts (cdr prompts))) - (LaTeX-insert-environment environment args))) - (t - (apply (nth 1 entry) environment (nthcdr 2 entry)))))) - -(defun LaTeX-close-environment () - "Creates an \\end{...} to match the current environment." - (interactive "*") - (if (> (point) - (save-excursion - (beginning-of-line) - (skip-chars-forward " \t") - (point))) - (insert "\n")) - (insert "\\end{" (LaTeX-current-environment 1) "}") - (LaTeX-indent-line) - (if (not (looking-at "[ \t]*$")) - (insert "\n") - (let ((next-line-add-newlines t)) - (next-line 1) - (beginning-of-line))) - (LaTeX-indent-line)) - -(autoload 'outline-flag-region "outline") - -(defun LaTeX-hide-environment () - "Hide current LaTeX environment using selective display." - (interactive) - (outline-flag-region (save-excursion (LaTeX-find-matching-begin) (point)) - (save-excursion (LaTeX-find-matching-end) (point)) - ?\r)) - -(defun LaTeX-show-environment () - "Show current LaTeX environment." - (interactive) - (outline-flag-region (save-excursion (LaTeX-find-matching-begin) (point)) - (save-excursion (LaTeX-find-matching-end) (point)) - ?\n)) - -(defun LaTeX-insert-environment (environment &optional extra) - "Insert environment of type ENV, with optional argument EXTRA." - (if (and (TeX-active-mark) - (not (eq (mark) (point)))) - (progn - (if (< (mark) (point)) - (exchange-point-and-mark)) - (or (TeX-looking-at-backward "^[ \t]*") - (newline)) - (insert TeX-esc "begin" TeX-grop environment TeX-grcl) - (LaTeX-indent-line) - (if extra (insert extra)) - (newline) - (goto-char (mark)) - (or (TeX-looking-at-backward "^[ \t]*") - (newline)) - (insert TeX-esc "end" TeX-grop environment TeX-grcl) - (or (looking-at "[ \t]*$") - (save-excursion (newline-and-indent))) - (LaTeX-indent-line) - (end-of-line 0) - (or (assoc environment LaTeX-indent-environment-list) - (LaTeX-fill-environment nil))) - (or (TeX-looking-at-backward "^[ \t]*") - (newline)) - (insert TeX-esc "begin" TeX-grop environment TeX-grcl) - (LaTeX-indent-line) - (if extra (insert extra)) - (newline-and-indent) - (newline) - (insert TeX-esc "end" TeX-grop environment TeX-grcl) - (or (looking-at "[ \t]*$") - (save-excursion (newline-and-indent))) - (LaTeX-indent-line) - (end-of-line 0))) - -(defun LaTeX-modify-environment (environment) - ;; Modify current environment. - (save-excursion - (LaTeX-find-matching-end) - (re-search-backward (concat (regexp-quote TeX-esc) - "end" - (regexp-quote TeX-grop) - " *\\([a-zA-Z*]*\\)" - (regexp-quote TeX-grcl)) - (save-excursion (beginning-of-line 1) (point))) - (replace-match (concat TeX-esc "end" TeX-grop environment TeX-grcl) t t) - (beginning-of-line 1) - (LaTeX-find-matching-begin) - (re-search-forward (concat (regexp-quote TeX-esc) - "begin" - (regexp-quote TeX-grop) - " *\\([a-zA-Z*]*\\)" - (regexp-quote TeX-grcl)) - (save-excursion (end-of-line 1) (point))) - (replace-match (concat TeX-esc "begin" TeX-grop environment TeX-grcl) t t))) - -(defun LaTeX-current-environment (&optional arg) - "Return the name (a string) of the enclosing LaTeX environment. -With optional ARG>=1, find that outer level." - (setq arg (if arg (if (< arg 1) 1 arg) 1)) - (save-excursion - (while (and - (/= arg 0) - (re-search-backward - (concat (regexp-quote TeX-esc) "begin" (regexp-quote TeX-grop) - "\\|" - (regexp-quote TeX-esc) "end" (regexp-quote TeX-grop)) - nil t 1)) - (cond ((TeX-in-comment) - (beginning-of-line 1)) - ((looking-at (concat (regexp-quote TeX-esc) - "end" (regexp-quote TeX-grop))) - (setq arg (1+ arg))) - (t - (setq arg (1- arg))))) - (if (/= arg 0) - "document" - (search-forward TeX-grop) - (let ((beg (point))) - (search-forward TeX-grcl) - (backward-char 1) - (buffer-substring beg (point)))))) - -(defun TeX-near-bobp () - ;; Return t iff there's nothing but whitespace between (bob) and (point). - (save-excursion - (skip-chars-backward " \t\n") - (bobp))) - -;;; Environment Hooks - -(defvar LaTeX-document-style-hook nil - "List of hooks to run when inserting a document style environment. - -To insert a hook here, you must insert it in the appropiate style file.") - -(defun LaTeX-env-document (&optional ignore) - "Create new LaTeX document." - - (TeX-insert-macro (if (string-equal LaTeX-version "2") - "documentstyle" - "documentclass")) - - (newline 3) - (end-of-line 0) - (LaTeX-insert-environment "document") - (run-hooks 'LaTeX-document-style-hook) - (setq LaTeX-document-style-hook nil)) - -(defcustom LaTeX-float "htbp" - "*Default float when creating figure and table environments. -Set to nil if you don't want any float." - :group 'LaTeX-environment - :type '(choice (const :tag "none" nil) - (string :format "%v"))) - (make-variable-buffer-local 'LaTeX-float) - -(defgroup LaTeX-label nil - "Adding labels for LaTeX commands in AUC TeX." - :group 'LaTeX) - -(defcustom LaTeX-label-function nil - "*A function inserting a label at point. -Sole argument of the function is the environment. The function has to return -the label inserted, or nil if no label was inserted." - :group 'LaTeX-label - :type 'function) - -(defcustom LaTeX-figure-label "fig:" - "*Default prefix to figure labels." - :group 'LaTeX-label - :group 'LaTeX-environment - :type 'string) - (make-variable-buffer-local 'LaTeX-figure-label) - -(defcustom LaTeX-table-label "tab:" - "*Default prefix to table labels." - :group 'LaTeX-label - :group 'LaTeX-environment - :type 'string) - (make-variable-buffer-local 'LaTeX-table-label) - -(defcustom LaTeX-default-format "" - "Specifies the default format string for array and tabular environments." - :group 'LaTeX-environment - :type 'string) - (make-variable-buffer-local 'LaTeX-default-format) - -(defcustom LaTeX-default-position "" - "Specifies the default position string for array and tabular environments." - :group 'LaTeX-environment - :type 'string) - (make-variable-buffer-local 'LaTeX-default-position) - -(defcustom LaTeX-equation-label "eq:" - "*Default prefix to equation labels." - :group 'LaTeX-label - :type 'string) - (make-variable-buffer-local 'LaTeX-equation-label) - -(defcustom LaTeX-eqnarray-label LaTeX-equation-label - "*Default prefix to eqnarray labels." - :group 'LaTeX-label - :type 'string) - (make-variable-buffer-local 'LaTeX-eqnarray-label) - -(defun LaTeX-env-item (environment) - "Insert ENVIRONMENT and the first item." - (LaTeX-insert-environment environment) - (if (TeX-active-mark) - (progn - (LaTeX-find-matching-begin) - (end-of-line 1)) - (end-of-line 0)) - (delete-char 1) - (delete-horizontal-space) - (LaTeX-insert-item)) - -(defun LaTeX-label (environment) - "Insert a label for ENVIRONMENT at point. -If LaTeX-label-function is a valid function, LaTeX label will transfer the -job to this function." - (let (label) - (if (and (boundp 'LaTeX-label-function) - LaTeX-label-function - (fboundp LaTeX-label-function)) - - (setq label (funcall LaTeX-label-function environment)) - (let ((prefix - (cond - ((string= "figure" environment) LaTeX-figure-label) - ((string= "table" environment) LaTeX-table-label) - ((string= "figure*" environment) LaTeX-figure-label) - ((string= "table*" environment) LaTeX-table-label) - ((string= "equation" environment) LaTeX-equation-label) - ((string= "eqnarray" environment) LaTeX-eqnarray-label) - ((assoc environment LaTeX-section-list) - (cond - ((stringp LaTeX-section-label) LaTeX-section-label) - ((and (listp LaTeX-section-label) - (assoc environment LaTeX-section-label)) - (cdr (assoc environment LaTeX-section-label))) - (t nil))) - (t "")))) - (if prefix - (progn - (setq label (read-string "What label: " prefix)) - (if (string= prefix label) - (setq label nil) ; No label eneterd - (insert TeX-esc "label" TeX-grop label TeX-grcl))))) - (if label - (progn - (LaTeX-add-labels label) - label) - nil)))) - - -(defun LaTeX-env-figure (environment) - "Create ENVIRONMENT with \\label and \\caption commands." - (let ((float (read-string "Float to: " LaTeX-float)) - (caption (read-string "Caption: ")) - (center (y-or-n-p "Center: "))) - - (setq LaTeX-float (if (zerop (length float)) - LaTeX-float - float)) - - (LaTeX-insert-environment environment - (and LaTeX-float - (concat LaTeX-optop - LaTeX-float - LaTeX-optcl))) - - (if center - (progn - (LaTeX-insert-environment "center"))) - - (newline-and-indent) - (LaTeX-label environment) - (end-of-line 0) - (LaTeX-indent-line) - - (if (zerop (length caption)) - () - ;; NOTE: Caption is _inside_ center because that looks best typeset. - (newline-and-indent) - (insert TeX-esc "caption" TeX-grop caption TeX-grcl) - (end-of-line 0) - (LaTeX-indent-line)) - - (if (member environment '("table" "table*")) - (LaTeX-env-array "tabular")))) - -(defun LaTeX-env-array (environment) - "Insert ENVIRONMENT with position and column specifications. -Just like array and tabular." - (let ((pos (read-string "Position: ")) - (fmt (read-string "Format: " LaTeX-default-format))) - (setq LaTeX-default-position pos) - (setq LaTeX-default-format fmt) - (LaTeX-insert-environment environment - (concat - (if (not (zerop (length pos))) - (format "[%s]" pos)) - (format "{%s}" fmt))) - (end-of-line 0) - (next-line 1) - (delete-horizontal-space))) - -(defun LaTeX-env-label (environment) - "Insert ENVIRONMENT and prompt for label." - (LaTeX-insert-environment environment) - (and (LaTeX-label environment) - (newline-and-indent))) - -(defun LaTeX-env-list (environment) - "Insert ENVIRONMENT and the first item." - (let ((label (read-string "Default Label: "))) - (LaTeX-insert-environment environment - (format "{%s}{}" label)) - (end-of-line 0) - (delete-char 1) - (delete-horizontal-space)) - (LaTeX-insert-item)) - -(defun LaTeX-env-minipage (environment) - "Create new LaTeX minipage." - (let ((pos (read-string "Position: " LaTeX-default-position)) - (width (read-string "Width: "))) - (setq LaTeX-default-position pos) - (if (zerop (length width)) - (setq width "4cm")) - (LaTeX-insert-environment environment - (concat (if (not (zerop (length pos))) - (format "[%s]" pos)) - (format "{%s}" width))) - (end-of-line 0) - (next-line 1) - (delete-horizontal-space))) - -(defun LaTeX-env-tabular* (environment) - "Insert ENVIRONMENT with width, position and column specifications." - (let ((width (read-string "Width: ")) - (pos (read-string "Position: " LaTeX-default-position)) - (fmt (read-string "Format: " LaTeX-default-format))) - (setq LaTeX-default-position pos) - (setq LaTeX-default-format fmt) - (LaTeX-insert-environment environment - (concat - (if (not (zerop (length width))) - (format "{%s}" width)) - (if (not (zerop (length pos))) - (format "[%s]" pos)) - (format "{%s}" fmt))) - (end-of-line 0) - (next-line 1) - (delete-horizontal-space))) - -(defun LaTeX-env-picture (environment) - "Insert ENVIRONMENT with width, height specifications." - (let ((width (read-string "Width: ")) - (height (read-string "Height: ")) - (x-offset (read-string "X Offset: ")) - (y-offset (read-string "Y Offset: "))) - (if (zerop (length x-offset)) - (setq x-offset "0")) - (if (zerop (length y-offset)) - (setq y-offset "0")) - (LaTeX-insert-environment environment - (concat (format "(%s,%s)" width height) - (if (not (and (string= x-offset "0") - (string= y-offset "0"))) - (format "(%s,%s)" x-offset y-offset)))) - - (end-of-line 0) - (next-line 1) - (delete-horizontal-space))) - -(defun LaTeX-env-bib (environment) - "Insert ENVIRONMENT with label for bibitem." - (LaTeX-insert-environment environment - (concat TeX-grop - (read-string "Label for BibItem: " "99") - TeX-grcl)) - (end-of-line 0) - (delete-char 1) - (delete-horizontal-space) - (LaTeX-insert-item)) - -;;; Item hooks - -(defvar LaTeX-item-list nil - "An list of environments where items have a special syntax. -The cdr is the name of the function, used to insert this kind of items.") - -(defun LaTeX-insert-item () - "Insert a new item in an environment. -You may use LaTeX-item-list to change the routines used to insert the item." - (interactive "*") - (let ((environment (LaTeX-current-environment))) - (newline) - (if (assoc environment LaTeX-item-list) - (funcall (cdr (assoc environment LaTeX-item-list))) - (TeX-insert-macro "item")) - (LaTeX-indent-line))) - -(defun LaTeX-item-argument () - "Insert a new item with an optional argument." - (let ((TeX-arg-item-label-p t)) - (TeX-insert-macro "item"))) - -(defun LaTeX-item-bib () - "Insert a new bibitem." - (TeX-insert-macro "bibitem")) - -;;; Parser - -(defvar LaTeX-auto-minimal-regexp-list - '(("\\\\document\\(style\\|class\\)\ -\\(\\[\\(\\([^#\\\\\\.%]\\|%[^\n\r]*[\n\r]\\)+\\)\\]\\)?\ -{\\([^#\\\\\\.\n\r]+\\)}" - (3 5 1) LaTeX-auto-style)) - "Minimal list of regular expressions matching LaTeX macro definitions.") - -(defvar LaTeX-auto-label-regexp-list - '(("\\\\label{\\([^\n\r%\\{}]+\\)}" 1 LaTeX-auto-label)) - "List of regular expression matching LaTeX labels only.") - -(defvar LaTeX-auto-regexp-list - (append - '(("\\\\newcommand{?\\\\\\([a-zA-Z]+\\)}?\\[\\([0-9]+\\)\\]\ -\\[\\([^\]\\\\\n\r]+\\)\\]" - (1 2 3) LaTeX-auto-optional) - ("\\\\newcommand{?\\\\\\([a-zA-Z]+\\)}?\\[\\([0-9]+\\)\\]" - (1 2) LaTeX-auto-arguments) - ("\\\\newcommand{?\\\\\\([a-zA-Z]+\\)}?" 1 TeX-auto-symbol) - ("\\\\newenvironment{?\\([a-zA-Z]+\\)}?\\[\\([0-9]+\\)\\]\\[" - 1 LaTeX-auto-environment) - ("\\\\newenvironment{?\\([a-zA-Z]+\\)}?\\[\\([0-9]+\\)\\]" - (1 2) LaTeX-auto-env-args) - ("\\\\newenvironment{?\\([a-zA-Z]+\\)}?" 1 LaTeX-auto-environment) - ("\\\\newtheorem{\\([a-zA-Z]+\\)}" 1 LaTeX-auto-environment) - ("\\\\input{\\(\\.*[^#}%\\\\\\.\n\r]+\\)\\(\\.[^#}%\\\\\\.\n\r]+\\)?}" - 1 TeX-auto-file) - ("\\\\include{\\(\\.*[^#}%\\\\\\.\n\r]+\\)\\(\\.[^#}%\\\\\\.\n\r]+\\)?}" - 1 TeX-auto-file) - ("\\\\usepackage\\(\\[[^\]\\\\]*\\]\\)?\ -{\\(\\([^#}\\\\\\.%]\\|%[^\n\r]*[\n\r]\\)+\\)}" - (2) LaTeX-auto-style) - ("\\\\bibitem{\\([a-zA-Z][^, \n\r\t%\"#'()={}]*\\)}" 1 LaTeX-auto-bibitem) - ("\\\\bibitem\\[[^][\n\r]+\\]{\\([a-zA-Z][^, \n\r\t%\"#'()={}]*\\)}" - 1 LaTeX-auto-bibitem) - ("\\\\bibliography{\\([^#}\\\\\n\r]+\\)}" 1 LaTeX-auto-bibliography)) - LaTeX-auto-label-regexp-list - LaTeX-auto-minimal-regexp-list) - "List of regular expression matching common LaTeX macro definitions.") - -(defun LaTeX-auto-prepare () - ;; Prepare for LaTeX parsing. - (setq LaTeX-auto-arguments nil - LaTeX-auto-optional nil - LaTeX-auto-env-args nil - LaTeX-auto-style nil - LaTeX-auto-end-symbol nil)) - -(add-hook 'TeX-auto-prepare-hook 'LaTeX-auto-prepare) - -(defun LaTeX-auto-cleanup () - ;; Cleanup after LaTeX parsing. - - ;; Cleanup BibTeX files - (setq LaTeX-auto-bibliography - (apply 'append (mapcar (function (lambda (arg) - (TeX-split-string "," arg))) - LaTeX-auto-bibliography))) - - ;; Cleanup document styles and packages - (if (null LaTeX-auto-style) - () - (while LaTeX-auto-style - (let* ((entry (car LaTeX-auto-style)) - (options (nth 0 entry)) - (style (nth 1 entry)) - (class (nth 2 entry))) - - ;; Next document style. - (setq LaTeX-auto-style (cdr LaTeX-auto-style)) - - ;; Get the options. - (setq options (TeX-split-string - "\\([ \t\r\n]\\|%[^\n\r]*[\n\r]\\|,\\)+" - options)) - - ;; Strip empty options. - (if (string-equal (car options) "") - (setq options (cdr options))) - (let ((index options)) - (while (cdr-safe index) - (if (string-equal (car (cdr index)) "") - (setcdr index (cdr (cdr index))) - (setq index (cdr index))))) - - ;; Add them, to the style list. - (setq TeX-auto-file (append options TeX-auto-file)) - - ;; The second argument if present is a normal style file. - (if (null style) - () - (setq TeX-auto-file (cons style TeX-auto-file)) - - ;; And a special "art10" style file combining style and size. - (setq TeX-auto-file - (cons (concat - (cond ((string-equal "article" style) - "art") - ((string-equal "book" style) - "bk") - ((string-equal "report" style) - "rep") - ((string-equal "jarticle" style) - "jart") - ((string-equal "jbook" style) - "jbk") - ((string-equal "jreport" style) - "jrep") - ((string-equal "j-article" style) - "j-art") - ((string-equal "j-book" style) - "j-bk") - ((string-equal "j-report" style ) - "j-rep") - (t style)) - (cond ((member "11pt" options) - "11") - ((member "12pt" options) - "12") - (t - "10"))) - TeX-auto-file))) - - ;; The third argument if "class" indicates LaTeX2e features. - (cond ((equal class "class") - (setq TeX-auto-file (cons "latex2e" TeX-auto-file))) - ((equal class "style") - (setq TeX-auto-file (cons "latex2" TeX-auto-file))))))) - - ;; Cleanup optional arguments - (mapcar (function (lambda (entry) - (setq TeX-auto-symbol - (cons (list (nth 0 entry) - (string-to-int (nth 1 entry))) - TeX-auto-symbol)))) - LaTeX-auto-arguments) - - ;; Cleanup default optional arguments - (mapcar (function (lambda (entry) - (setq TeX-auto-symbol - (cons (list (nth 0 entry) - (vector "argument") - (1- (string-to-int (nth 1 entry)))) - TeX-auto-symbol)))) - LaTeX-auto-optional) - - ;; Cleanup environments arguments - (mapcar (function (lambda (entry) - (setq LaTeX-auto-environment - (cons (list (nth 0 entry) - (string-to-int (nth 1 entry))) - LaTeX-auto-environment)))) - LaTeX-auto-env-args) - - ;; Cleanup use of def to add environments - ;; NOTE: This uses an O(N^2) algorithm, while an O(N log N) - ;; algorithm is possible. - (mapcar (function (lambda (symbol) - (if (not (TeX-member symbol TeX-auto-symbol 'equal)) - ;; No matching symbol, insert in list - (setq TeX-auto-symbol - (cons (concat "end" symbol) TeX-auto-symbol)) - ;; Matching symbol found, remove from list - (if (equal (car TeX-auto-symbol) symbol) - ;; Is it the first symbol? - (setq TeX-auto-symbol (cdr TeX-auto-symbol)) - ;; Nope! Travel the list - (let ((list TeX-auto-symbol)) - (while (consp (cdr list)) - ;; Until we find it. - (if (equal (car (cdr list)) symbol) - ;; Then remove it. - (setcdr list (cdr (cdr list)))) - (setq list (cdr list))))) - ;; and add the symbol as an environment. - (setq LaTeX-auto-environment - (cons symbol LaTeX-auto-environment))))) - LaTeX-auto-end-symbol)) - -(add-hook 'TeX-auto-cleanup-hook 'LaTeX-auto-cleanup) - -(TeX-auto-add-type "label" "LaTeX") -(TeX-auto-add-type "bibitem" "LaTeX") -(TeX-auto-add-type "environment" "LaTeX") -(TeX-auto-add-type "bibliography" "LaTeX" "bibliographies") - -(fset 'LaTeX-add-bibliographies-auto - (symbol-function 'LaTeX-add-bibliographies)) -(defun LaTeX-add-bibliographies (&rest bibliographies) - "Add BIBLIOGRAPHIES to the list of known bibliographies and style files." - (apply 'LaTeX-add-bibliographies-auto bibliographies) - (apply 'TeX-run-style-hooks bibliographies)) - -(fset 'LaTeX-add-environments-auto - (symbol-function 'LaTeX-add-environments)) -(defun LaTeX-add-environments (&rest environments) - "Add ENVIRONMENTS to the list of known environments." - (apply 'LaTeX-add-environments-auto environments) - (setq LaTeX-menu-changed t)) - -;;; BibTeX - -;;;###autoload -(defun BibTeX-auto-store () - "This function should be called from bibtex-mode-hook. -It will setup BibTeX to store keys in an auto file." - ;; We want this to be early in the list, so we do not - ;; add it before we enter BibTeX mode the first time. - (if (boundp 'local-write-file-hooks) - (add-hook 'local-write-file-hooks 'TeX-safe-auto-write) - (add-hook 'write-file-hooks 'TeX-safe-auto-write)) - (make-local-variable 'TeX-auto-update) - (setq TeX-auto-update 'BibTeX) - (make-local-variable 'TeX-auto-untabify) - (setq TeX-auto-untabify nil) - (make-local-variable 'TeX-auto-parse-length) - (setq TeX-auto-parse-length 999999) - (make-local-variable 'TeX-auto-regexp-list) - (setq TeX-auto-regexp-list BibTeX-auto-regexp-list)) - -(defvar BibTeX-auto-regexp-list - '(("@[Ss][Tt][Rr][Ii][Nn][Gg]" 1 ignore) - ("@[a-zA-Z]+[{(][ \t]*\\([a-zA-Z][^, \n\r\t%\"#'()={}]*\\)" - 1 LaTeX-auto-bibitem)) - "List of regexp-list expressions matching BibTeX items.") - -;;; Macro Argument Hooks - -(defun TeX-arg-conditional (optional expr then else) - "Implement if EXPR THEN ELSE. - -If EXPR evaluate to true, parse THEN as an argument list, else parse -ELSE as an argument list." - (TeX-parse-arguments (if (eval expr) then else))) - -(defun TeX-arg-free (optional &optional &rest args) - "Parse its arguments but use no braces when they are inserted." - (let ((< "") - (> "")) - (if (equal (length args) 1) - (TeX-parse-argument optional (car args)) - (TeX-parse-argument optional args)))) - -(defun TeX-arg-literal (optional &optional &rest args) - "Insert its arguments into the buffer. -Used for specifying extra syntax for a macro." - (apply 'insert args)) - -(defun TeX-arg-eval (optional &rest args) - "Evaluate args and insert value in buffer." - (TeX-argument-insert (eval args) optional)) - -(defun TeX-arg-label (optional &optional prompt definition) - "Prompt for a label completing with known labels." - (let ((label (completing-read (TeX-argument-prompt optional prompt "Key") - (LaTeX-label-list)))) - (if (and definition (not (string-equal "" label))) - (LaTeX-add-labels label)) - (TeX-argument-insert label optional optional))) - -(defun TeX-arg-macro (optional &optional prompt definition) - "Prompt for a TeX macro with completion." - (let ((macro (completing-read (TeX-argument-prompt optional prompt - (concat "Macro: " - TeX-esc) - t) - (TeX-symbol-list)))) - (if (and definition (not (string-equal "" macro))) - (TeX-add-symbols macro)) - (TeX-argument-insert macro optional TeX-esc))) - -(defun TeX-arg-environment (optional &optional prompt definition) - "Prompt for a LaTeX environment with completion." - (let ((environment (completing-read (TeX-argument-prompt optional prompt - "Environment") - (TeX-symbol-list)))) - (if (and definition (not (string-equal "" environment))) - (LaTeX-add-environments environment)) - - (TeX-argument-insert environment optional))) - -(defun TeX-arg-cite (optional &optional prompt definition) - "Prompt for a BibTeX citation with completion." - (setq prompt (concat (if optional "(Optional) " "") - (if prompt prompt "Add key") - ": (default none) ")) - (let ((items (multi-prompt "," t prompt (LaTeX-bibitem-list)))) - (apply 'LaTeX-add-bibitems items) - (TeX-argument-insert (mapconcat 'identity items ",") optional optional))) - -(defun TeX-arg-counter (optional &optional prompt definition) - "Prompt for a LaTeX counter." - ;; Completion not implemented yet. - (TeX-argument-insert - (read-string (TeX-argument-prompt optional prompt "Counter")) - optional)) - -(defun TeX-arg-savebox (optional &optional prompt definition) - "Prompt for a LaTeX savebox." - ;; Completion not implemented yet. - (TeX-argument-insert - (read-string (TeX-argument-prompt optional prompt - (concat "Savebox: " TeX-esc) - t)) - optional TeX-esc)) - -(defun TeX-arg-file (optional &optional prompt) - "Prompt for a filename in the current directory." - (TeX-argument-insert (read-file-name (TeX-argument-prompt optional - prompt "File") - "" "" nil) - optional)) - -(defun TeX-arg-define-label (optional &optional prompt) - "Prompt for a label completing with known labels." - (TeX-arg-label optional prompt t)) - -(defun TeX-arg-define-macro (optional &optional prompt) - "Prompt for a TeX macro with completion." - (TeX-arg-macro optional prompt t)) - -(defun TeX-arg-define-environment (optional &optional prompt) - "Prompt for a LaTeX environment with completion." - (TeX-arg-environment optional prompt t)) - -(defun TeX-arg-define-cite (optional &optional prompt) - "Prompt for a BibTeX citation." - (TeX-arg-cite optional prompt t)) - -(defun TeX-arg-define-counter (optional &optional prompt) - "Prompt for a LaTeX counter." - (TeX-arg-counter optional prompt t)) - -(defun TeX-arg-define-savebox (optional &optional prompt) - "Prompt for a LaTeX savebox." - (TeX-arg-savebox optional prompt t)) - -(defcustom LaTeX-style-list '(("book") - ("article") - ("letter") - ("slides") - ("report")) - "List of document styles." - :group 'LaTeX-environment - :type '(repeat (group (string :format "%v")))) - - (make-variable-buffer-local 'LaTeX-style-list) - -(defun TeX-arg-document (optional &optional ignore) - "Insert arguments to documentstyle and documentclass." - (let ((style (completing-read - (concat "Document style: (default " LaTeX-default-style ") ") - LaTeX-style-list)) - (options (read-string "Options: " - (if (stringp LaTeX-default-options) - LaTeX-default-options - (mapconcat 'identity - LaTeX-default-options - ","))))) - (if (zerop (length style)) - (setq style LaTeX-default-style)) - (if (not (zerop (length options))) - (insert LaTeX-optop options LaTeX-optcl)) - (insert TeX-grop style TeX-grcl)) - - ;; remove old information - (TeX-remove-style) - - ;; defined in individual style hooks - (TeX-update-style)) - -(defvar TeX-global-input-files nil - "List of the non-local TeX input files. - -Initialized once at the first time you prompt for an input file. -May be reset with `C-u \\[TeX-normal-mode]'.") - -(defun TeX-arg-input-file (optionel &optional prompt local) - "Prompt for a tex or sty file. - -First optional argument is the promt, the second is a flag. -If the flag is set, only complete with local files." - (if (or TeX-global-input-files local) - () - (message "Searching for files...") - (setq TeX-global-input-files - (mapcar 'list (TeX-search-files (append TeX-macro-private - TeX-macro-global) - TeX-file-extensions t t)))) - (let ((file (if TeX-check-path - (completing-read - (TeX-argument-prompt optionel prompt "File") - (append (mapcar 'list - (TeX-search-files '(".") - TeX-file-extensions - t t)) - (if local - nil - TeX-global-input-files))) - (read-file-name - (TeX-argument-prompt optionel prompt "File"))))) - (if (null file) - (setq file "")) - (if (not (string-equal "" file)) - (TeX-run-style-hooks file)) - (TeX-argument-insert file optionel))) - -(defvar BibTeX-global-style-files nil - "Association list of BibTeX style files. - -Initialized once at the first time you prompt for an input file. -May be reset with `C-u \\[TeX-normal-mode]'.") - -(defun TeX-arg-bibstyle (optional &optional prompt) - "Prompt for a BibTeX style file." - (message "Searching for BibTeX styles...") - (or BibTeX-global-style-files - (setq BibTeX-global-style-files - (mapcar 'list - (TeX-search-files (append TeX-macro-private - TeX-macro-global) - BibTeX-style-extensions t t)))) - - (TeX-argument-insert - (completing-read (TeX-argument-prompt optional prompt "BibTeX style") - (append (mapcar 'list - (TeX-search-files '(".") - BibTeX-style-extensions - t t)) - BibTeX-global-style-files)) - optional)) - -(defvar BibTeX-global-files nil - "Association list of BibTeX files. - -Initialized once at the first time you prompt for an BibTeX file. -May be reset with `C-u \\[TeX-normal-mode]'.") - -(defun TeX-arg-bibliography (optional &optional prompt) - "Prompt for a BibTeX database file." - (message "Searching for BibTeX files...") - (or BibTeX-global-files - (setq BibTeX-global-files - (mapcar 'list (TeX-search-files nil BibTeX-file-extensions t t)))) - - (let ((styles (multi-prompt - "," t - (TeX-argument-prompt optional prompt "BibTeX files") - (append (mapcar 'list - (TeX-search-files '(".") - BibTeX-file-extensions - t t)) - BibTeX-global-files)))) - (apply 'LaTeX-add-bibliographies styles) - (TeX-argument-insert (mapconcat 'identity styles ",") optional))) - -(defun TeX-arg-corner (optional &optional prompt) - "Prompt for a LaTeX side or corner position with completion." - (TeX-argument-insert - (completing-read (TeX-argument-prompt optional prompt "Position") - '(("") ("l") ("r") ("t") ("b") ("tl") ("tr") ("bl") ("br")) - nil t) - optional)) - -(defun TeX-arg-lr (optional &optional prompt) - "Prompt for a LaTeX side with completion." - (TeX-argument-insert - (completing-read (TeX-argument-prompt optional prompt "Position") - '(("") ("l") ("r")) - nil t) - optional)) - -(defun TeX-arg-tb (optional &optional prompt) - "Prompt for a LaTeX side with completion." - (TeX-argument-insert - (completing-read (TeX-argument-prompt optional prompt "Position") - '(("") ("t") ("b")) - nil t) - optional)) - -(defun TeX-arg-pagestyle (optional &optional prompt) - "Prompt for a LaTeX pagestyle with completion." - (TeX-argument-insert - (completing-read (TeX-argument-prompt optional prompt "Pagestyle") - '(("plain") ("empty") ("headings") ("myheadings"))) - optional)) - -(defun TeX-arg-verb (optional &optional ignore) - "Prompt for delimiter and text." - (let ((del (read-quoted-char "Delimiter: ")) - (text (read-from-minibuffer "Text: "))) - (insert del text del))) - -(defun TeX-arg-pair (optional first second) - "Insert a pair of number, prompted by FIRST and SECOND. - -The numbers are surounded by parenthesizes and separated with a -comma." - (insert "(" (read-string (concat first ": ")) "," - (read-string (concat second ": ")) ")")) - -(defun TeX-arg-size (optional) - "Insert width and height as a pair." - (TeX-arg-pair optional "Width" "Height")) - -(defun TeX-arg-coordinate (optional) - "Insert x and y coordinate as a pair." - (TeX-arg-pair optional "X position" "Y position")) - -(defconst TeX-braces-default-association - '(("[" . "]") - ("\\{" . "\\}") - ("(" . ")") - ("|" . "|") - ("\\|" . "\\|") - ("/" . "/") - ("\\backslash" . "\\backslash") - ("\\lfloor" . "\\rfloor") - ("\\lceil" . "\\rceil") - ("\\langle" . "\\rangle"))) - -(defcustom TeX-braces-user-association nil - "A list of your personal association of brace symbols. -These are used for \\left and \\right. - -The car of each entry is the brace used with \\left, -the cdr is the brace used with \\right." - :group 'LaTeX-macro - :group 'LaTeX-math - :type '(repeat (cons :format "%v" - (string :tag "Left") - (string :tag "Right")))) - -(defvar TeX-braces-association - (append TeX-braces-user-association - TeX-braces-default-association) - "A list of association of brace symbols for \\left and \\right. -The car of each entry is the brace used with \\left, -the cdr is the brace used with \\right.") - -(defvar TeX-left-right-braces - '(("[") ("]") ("\\{") ("\\}") ("(") (")") ("|") ("\\|") - ("/") ("\\backslash") ("\\lfloor") ("\\rfloor") - ("\\lceil") ("\\rceil") ("\\langle") ("\\rangle") - ("\\uparrow") ("\\Uparrow") ("\\downarrow") ("\\Downarrow") - ("\\updownarrow") ("\\Updownarrow") (".")) - "List of symbols which can follow the \\left or \\right command") - -(defun TeX-arg-insert-braces (optional &optional prompt) - (save-excursion - (backward-word 1) - (backward-char) - (newline-and-indent) - (beginning-of-line 0) - (if (looking-at "^[ \t]*$") - (progn (delete-horizontal-space) - (delete-char 1)))) - (let ((left-brace (completing-read - (TeX-argument-prompt optional prompt "Which brace") - TeX-left-right-braces))) - (insert left-brace) - (newline-and-indent) - (save-excursion - (let ((right-brace (cdr (assoc left-brace - TeX-braces-association)))) - (newline) - (insert TeX-esc "right") - (if (and TeX-arg-right-insert-p - right-brace) - (insert right-brace) - (insert (completing-read - (TeX-argument-prompt optional prompt "Which brace") - TeX-left-right-braces))) - (LaTeX-indent-line))))) - -;;; Indentation - -(defgroup LaTeX-indentation nil - "Indentation of LaTeX code in AUC TeX" - :group 'LaTeX - :group 'TeX-indentation) - -(defcustom LaTeX-indent-level 2 - "*Indentation of begin-end blocks in LaTeX." - :group 'LaTeX-indentation - :type 'integer) - -(defcustom LaTeX-item-indent (- LaTeX-indent-level) - "*Extra indentation for lines beginning with an item." - :group 'LaTeX-indentation - :type 'integer) - -(defcustom LaTeX-item-regexp "\\(bib\\)?item\\b" - "*Regular expression matching macros considered items." - :group 'LaTeX-indentation - :type 'regexp) - -(defun LaTeX-indent-line () - "Indent the line containing point, as LaTeX source. -Add LaTeX-indent-level indentation in each \\begin{ - \\end{ block. -Lines starting with an item is given an extra indentation of -LaTeX-item-indent." - (interactive) - (let ((indent (LaTeX-indent-calculate))) - (save-excursion - (if (/= (current-indentation) indent) - (let ((beg (progn - (beginning-of-line) - (point)))) - (back-to-indentation) - (delete-region beg (point)) - (indent-to indent)))) - (if (< (current-column) indent) - (back-to-indentation)))) - -(defun LaTeX-fill-region-as-paragraph (from to &optional justify-flag) - "Fill region as one paragraph. -Break lines to fit fill-column, but leave all lines ending with \\\\ -\(plus its optional argument) alone. Prefix arg means justify too. -From program, pass args FROM, TO and JUSTIFY-FLAG." - (interactive "*r\nP") - (or (assoc (LaTeX-current-environment) LaTeX-indent-environment-list) - (save-restriction - (narrow-to-region from to) - (goto-char from) - (while (not (eobp)) - (LaTeX-indent-line) - (forward-line)) - (goto-char from) - (while (not (eobp)) - (if - (re-search-forward (concat "^.*" - (regexp-quote TeX-esc) - (regexp-quote TeX-esc) - "\\(\\s-*\\*\\)?" - "\\(\\s-*\\[[^]]*\\]\\)?\\s-*$") - nil t) - (progn - (goto-char (match-end 0)) - (delete-horizontal-space) - ;; I doubt very much if we want justify - - ;; this is a line with \\ - ;; if you think otherwise - uncomment the next line - ;; (and justify-flag (justify-current-line)) - (forward-char) - ;; keep our position in a buffer - (save-excursion - (LaTeX-fill-region-as-para-do - from (match-beginning 0) justify-flag)) - (setq from (point))) - ;; ELSE part follows - loop termination relies on a fact - ;; that (LaTeX-fill-region-as-para-do) moves point past - ;; the filled region - (LaTeX-fill-region-as-para-do from to justify-flag))) - ;; the following four lines are clearly optional, but I like my - ;; LaTeX code that way - (goto-char (point-min)) - (while (search-forward "$$ " nil t) - (replace-match "$$\n" t t) - (LaTeX-indent-line))))) - -(defun LaTeX-fill-region-as-para-do (from to justify-flag) - "Fill region as one paragraph: break lines to fit fill-column." - (if (< from to) - (progn - ;; (save-restriction) here is likely not needed because - ;; it was done by a caller, but I am not sure - mj - (save-restriction - (goto-char from) - (skip-chars-forward " \n") - (LaTeX-indent-line) - (beginning-of-line) - (narrow-to-region (point) to) - (setq from (point)) - - ;; from is now before the text to fill, - ;; but after any fill prefix on the first line. - - ;; Make sure sentences ending at end of line get an extra space. - (if (or (not (boundp 'sentence-end-double-space)) - sentence-end-double-space) - (progn - (goto-char from) - (while (re-search-forward "[.?!][]})\"']*$" nil t) - (insert ? )))) - ;; The change all newlines to spaces. - (subst-char-in-region from (point-max) ?\n ?\ ) - ;; Flush excess spaces, except in the paragraph indentation. - (goto-char from) - (skip-chars-forward " \t") - (while (re-search-forward " *" nil t) - (delete-region - (+ (match-beginning 0) - (if (save-excursion - (skip-chars-backward " ]})\"'") - (memq (preceding-char) '(?. ?? ?!))) - 2 1)) - (match-end 0))) - (goto-char (point-max)) - (delete-horizontal-space) - (insert " ") - (goto-char (point-min)) - (let ((prefixcol 0)) - (while (not (eobp)) - (move-to-column (1+ fill-column)) - (if (eobp) - nil - (skip-chars-backward "^ \n") - (if (if (zerop prefixcol) - (bolp) - (>= prefixcol (current-column))) - (skip-chars-forward "^ \n") - (forward-char -1))) - (delete-horizontal-space) - (if (equal (preceding-char) ?\\) - (insert ? )) - (insert ?\n) - (LaTeX-indent-line) - (setq prefixcol (current-column)) - (and justify-flag (not (eobp)) - (progn - (forward-line -1) - (justify-current-line) - (forward-line 1))) - ) - (goto-char (point-max)) - (delete-horizontal-space)))))) - -(defun LaTeX-fill-paragraph (prefix) - "Fill and indent paragraph at or after point. -Prefix arg means justify as well." - (interactive "*P") - (save-excursion - (beginning-of-line) - (if (looking-at "[ \t]*%]") - (re-search-forward "^[ \t]*[^% \t\n]")) - (forward-paragraph) - (or (bolp) (newline 1)) - (and (eobp) (open-line 1)) - (let ((end (point-marker)) - (start (progn - (backward-paragraph) - (point)))) - (LaTeX-fill-region-as-paragraph start end prefix)))) - -(defun LaTeX-fill-region (from to &optional justify what) - "Fill and indent each of the paragraphs in the region as LaTeX text. -Prefix arg (non-nil third arg, if called from program) -means justify as well. Fourth arg WHAT is a word to be displayed when -formatting." - (interactive "*r\nP") - (save-restriction - (save-excursion - (let ((length (- to from)) - (to (set-marker (make-marker) to))) - (goto-char from) - (beginning-of-line) - (while (< (point) to) - (message "Formatting%s ... %d%%" - (if (not what) - "" - what) - (/ (* 100 (- (point) from)) length)) - (save-excursion (LaTeX-fill-paragraph justify)) - (forward-paragraph 2) - (if (not (eobp)) - (backward-paragraph))) - (set-marker to nil))) - (message "Finished"))) - -(defun LaTeX-find-matching-end () - "Move point to the \\end of the current environment" - (interactive) - (let ((regexp (concat (regexp-quote TeX-esc) "\\(begin\\|end\\)\\b")) - (level 1)) - (beginning-of-line 1) - (if (looking-at (concat " *" (regexp-quote TeX-esc) "begin\\b")) - (end-of-line 1)) - (while (and (> level 0) (re-search-forward regexp nil t)) - (if (= (char-after (1+ (match-beginning 0))) ?b);;begin - (setq level (1+ level)) - (setq level (1- level)))) - (if (= level 0) - (search-forward "}") - (error "Can't locate end of current environment")))) - -(defun LaTeX-find-matching-begin () - "Move point to the \\begin of the current environment" - (interactive) - (let ((regexp (concat (regexp-quote TeX-esc) "\\(begin\\|end\\)\\b")) - (level 1)) - (beginning-of-line 1) - (if (looking-at (concat " *" (regexp-quote TeX-esc) "begin\\b")) - (end-of-line 1)) - (while (and (> level 0) (re-search-backward regexp nil t)) - (if (= (char-after (1+ (match-beginning 0))) ?e);;end - (setq level (1+ level)) - (setq level (1- level)))) - (or (= level 0) - (error "Can't locate beginning of current environment")))) - -(defun LaTeX-mark-environment () - "Set mark to end of current environment and point to the matching begin -will not work properly if there are unbalanced begin-end pairs in -comments and verbatim environments" - (interactive) - (let ((cur (point))) - (LaTeX-find-matching-end) - (beginning-of-line 2) - (set-mark (point)) - (goto-char cur) - (LaTeX-find-matching-begin) - (TeX-activate-region))) - -(defun LaTeX-fill-environment (justify) - "Fill and indent current environment as LaTeX text." - (interactive "*P") - (save-excursion - (LaTeX-mark-environment) - (re-search-forward "{\\([^}]+\\)}") - (LaTeX-fill-region - (region-beginning) - (region-end) - justify - (concat " environment " (TeX-match-buffer 1))))) - -(defun LaTeX-fill-section (justify) - "Fill and indent current logical section as LaTeX text." - (interactive "*P") - (save-excursion - (LaTeX-mark-section) - (re-search-forward "{\\([^}]+\\)}") - (LaTeX-fill-region - (region-beginning) - (region-end) - justify - (concat " section " (TeX-match-buffer 1))))) - -(defun LaTeX-mark-section () - "Set mark at end of current logical section, and point at top." - (interactive) - (re-search-forward (concat "\\(" (LaTeX-outline-regexp) - "\\|\\'\\)")) - (re-search-backward "^") - (set-mark (point)) - (re-search-backward (concat "\\(" (LaTeX-outline-regexp) - "\\|\\`\\)")) - (TeX-activate-region)) - -(defun LaTeX-fill-buffer (justify) - "Fill and indent current buffer as LaTeX text." - (interactive "*P") - (save-excursion - (LaTeX-fill-region - (point-min) - (point-max) - justify - (concat " buffer " (buffer-name))))) - -(defvar LaTeX-indent-environment-list - '(("verbatim" current-indentation) - ("verbatim*" current-indentation) - ;; The following should have there own, smart indentation function. - ;; Some other day. - ("alltt") - ("array") - ("displaymath") - ("eqnarray") - ("eqnarray*") - ("equation") - ("equation*") - ("picture") - ("tabbing") - ("table") - ("table*") - ("tabular") - ("tabular*")) - "Alist of environments with special indentation. -The second element in each entry is the function to calculate the -indentation level in columns.") - -(defcustom LaTeX-indent-environment-check t - "*If non-nil, check for any special environments." - :group 'LaTeX-indentation - :type 'boolean) - -(defcustom LaTeX-left-comment-regexp "%%%" - "*Regexp matching comments that should be placed on the left margin." - :group 'LaTeX-indentation - :type 'regexp) - -(defcustom LaTeX-right-comment-regexp "%[^%]" - "*Regexp matching comments that should be placed to the right margin." - :group 'LaTeX-indentation - :type 'regexp) - -(defcustom LaTeX-ignore-comment-regexp nil - "*Regexp matching comments that whose indentation should not be touched." - :group 'LaTeX-indentation - :type '(choice (const :tag "none" nil) - (regexp :format "%v"))) - -(defun LaTeX-indent-calculate () - ;; Return the correct indentation of line of LaTeX source. (I hope...) - (save-excursion - (back-to-indentation) - (cond ((looking-at (concat (regexp-quote TeX-esc) - "\\(begin\\|end\\){verbatim\\*?}")) - ;; \end{verbatim} must be flush left, otherwise an unwanted - ;; empty line appears in LaTeX's output. - 0) - ((and LaTeX-left-comment-regexp - (looking-at LaTeX-left-comment-regexp)) - ;; Comments to the left margin. - 0) - ((and LaTeX-right-comment-regexp - (looking-at LaTeX-right-comment-regexp)) - ;; Comments to the right margin. - comment-column) - ((and LaTeX-ignore-comment-regexp - (looking-at LaTeX-ignore-comment-regexp)) - ;; Comments best left alone. - (current-indentation)) - ((and LaTeX-indent-environment-check - ;; Special environments. - (let ((entry (assoc (LaTeX-current-environment) - LaTeX-indent-environment-list))) - (and entry - (nth 1 entry) - (funcall (nth 1 entry)))))) - ((looking-at (concat (regexp-quote TeX-esc) "end\\b")) - ;; Backindent at \end. - (- (LaTeX-indent-calculate-last) LaTeX-indent-level)) - ((looking-at (concat (regexp-quote TeX-esc) "right\\b")) - ;; Backindent at \right. - (- (LaTeX-indent-calculate-last) LaTeX-left-right-indent-level)) - ((looking-at (concat (regexp-quote TeX-esc) LaTeX-item-regexp)) - ;; Items. - (+ (LaTeX-indent-calculate-last) LaTeX-item-indent)) - (t (LaTeX-indent-calculate-last))))) - -(defcustom LaTeX-left-right-indent-level LaTeX-indent-level - "*The level of indentation produced by a \\left macro." - :group 'LaTeX-indentation - :type 'integer) - -(defun LaTeX-indent-level-count () - ;; Count indentation change caused by all \left, \right, \begin, and - ;; \end commands in the current line. - (save-excursion - (save-restriction - (let ((count 0)) - (narrow-to-region (point) - (save-excursion - (re-search-forward (concat "[^" - (regexp-quote TeX-esc) - "]%\\|\n\\|\\'")) - (backward-char) - (point))) - (while (search-forward TeX-esc nil t) - (cond - ((looking-at "left\\b") - (setq count (+ count LaTeX-left-right-indent-level))) - ((looking-at "right\\b") - (setq count (- count LaTeX-left-right-indent-level))) - ((looking-at "begin\\b") - (setq count (+ count LaTeX-indent-level))) - ((looking-at "end\\b") - (setq count (- count LaTeX-indent-level))) - ((looking-at (regexp-quote TeX-esc)) - (forward-char 1)))) - count)))) - -(defun LaTeX-indent-calculate-last () - "Return the correct indentation of a normal line of text. -The point is supposed to be at the beginning of the current line." - (save-restriction - (widen) - (skip-chars-backward "\n\t ") - (move-to-column (current-indentation)) - - ;; Ignore comments. - (while (and (looking-at (regexp-quote comment-start)) (not (bobp))) - (skip-chars-backward "\n\t ") - (if (not (bobp)) - (move-to-column (current-indentation)))) - - (cond ((bobp) 0) - ((looking-at (concat (regexp-quote TeX-esc) "begin{document}")) - ;; I dislike having all of the document indented... - (current-indentation)) - ((looking-at (concat (regexp-quote TeX-esc) "begin *" - (regexp-quote TeX-grop) - "verbatim\\*?" - (regexp-quote TeX-grcl))) - 0) - ((looking-at (concat (regexp-quote TeX-esc) "end" - (regexp-quote TeX-grop) - "verbatim\\*?" - (regexp-quote TeX-grcl))) - ;; If I see an \end{verbatim} in the previous line I skip - ;; back to the preceding \begin{verbatim}. - (save-excursion - (if (re-search-backward (concat (regexp-quote TeX-esc) - "begin *" - (regexp-quote TeX-grop) - "verbatim\\*?" - (regexp-quote TeX-grcl)) 0 t) - (LaTeX-indent-calculate-last) - 0))) - (t (+ (current-indentation) - (TeX-brace-count-line) - (LaTeX-indent-level-count) - (cond ((looking-at (concat (regexp-quote TeX-esc) "end\\b")) - LaTeX-indent-level) - ((looking-at (concat (regexp-quote TeX-esc) "right\\b")) - LaTeX-left-right-indent-level) - ((looking-at (concat (regexp-quote TeX-esc) - LaTeX-item-regexp)) - (- LaTeX-item-indent)) - (t 0))))))) - -;;; Math Minor Mode - -(defgroup LaTeX-math nil - "Mathematics in AUC TeX." - :group 'LaTeX-macro) - -(defcustom LaTeX-math-list nil - "AList of your personal LaTeX math symbols. - -Each entry should be a list with three elements, KEY, VALUE, and MENU. -KEY is the key to be redefined (under `LaTeX-math-abbrev-prefix' in -math minor mode, VALUE can be a string with the name of the macro to -be inserted, or a function to be called. The optional third element is -the name of the submenu where the command should be added. - -See also `LaTeX-math-menu'." - :group 'LaTeX-math - :type '(repeat (group (choice (const :tag "none") - (character :format "%v\n")) - (string :tag "Symbol") - (choice :tag "Menu" - (string :tag "Name" :format "%v") - (repeat :tag "Path" - (string :format "%v")))))) - -(defconst LaTeX-math-default - '((?a "alpha" "greek") - (?b "beta" "greek") - (?c LaTeX-math-cal "Cal-whatever") - (?d "delta" "greek") - (?e "epsilon" "greek") - (?f "phi" "greek") - (?g "gamma" "greek") - (?h "eta" "greek") - (?k "kappa" "greek") - (?l "lambda" "greek") - (?m "mu" "greek") - (?N "nabla" "greek") - (?n "nu" "greek") - (?o "omega" "greek") - (?p "pi" "greek") - (?q "theta" "greek") - (?r "rho" "greek") - (?s "sigma" "greek") - (?t "tau" "greek") - (?u "upsilon" "greek") - (?x "chi" "greek") - (?y "psi" "greek") - (?z "zeta" "greek") - (?D "Delta" "Greek") - (?F "Phi" "Greek") - (?G "Gamma" "Greek") - (?Q "Theta" "Greek") - (?L "Lambda" "Greek") - (?Y "Psi" "Greek") - (?P "Pi" "Greek") - (?S "Sigma" "Greek") - (?U "Upsilon" "Greek") - (?O "Omega" "Greek") - (nil "pm" "Binary Op") - (nil "mp" "Binary Op") - (?* "times" "Binary Op") - (nil "div" "Binary Op") - (nil "ast" "Binary Op") - (nil "star" "Binary Op") - (nil "circ" "Binary Op") - (nil "bullet" "Binary Op") - (?. "cdot" "Binary Op") - (?- "cap" "Binary Op") - (?+ "cup" "Binary Op") - (nil "uplus" "Binary Op") - (nil "sqcap" "Binary Op") - (?| "vee" "Binary Op") - (?& "wedge" "Binary Op") - (?\\ "setminus" "Binary Op") - (nil "wr" "Binary Op") - (nil "diamond" "Binary Op") - (nil "bigtriangleup" "Binary Op") - (nil "bigtriangledown" "Binary Op") - (nil "triangleleft" "Binary Op") - (nil "triangleright" "Binary Op") - (nil "lhd" "Binary Op") - (nil "rhd" "Binary Op") - (nil "unlhd" "Binary Op") - (nil "unrhd" "Binary Op") - (nil "oplus" "Binary Op") - (nil "ominus" "Binary Op") - (nil "otimes" "Binary Op") - (nil "oslash" "Binary Op") - (nil "odot" "Binary Op") - (nil "bigcirc" "Binary Op") - (nil "dagger" "Binary Op") - (nil "ddagger" "Binary Op") - (nil "amalg" "Binary Op") - (?< "leq" "Relational") - (?> "geq" "Relational") - (nil "qed" "Relational") - (nil "equiv" "Relational") - (nil "models" "Relational") - (nil "prec" "Relational") - (nil "succ" "Relational") - (nil "sim" "Relational") - (nil "perp" "Relational") - (nil "preceq" "Relational") - (nil "succeq" "Relational") - (nil "simeq" "Relational") - (nil "mid" "Relational") - (nil "ll" "Relational") - (nil "gg" "Relational") - (nil "asymp" "Relational") - (nil "parallel" "Relational") - (?{ "subset" "Relational") - (?} "supset" "Relational") - (nil "approx" "Relational") - (nil "bowtie" "Relational") - (?\[ "subseteq" "Relational") - (?\] "supseteq" "Relational") - (nil "cong" "Relational") - (nil "Join" "Relational") - (nil "sqsubset" "Relational") - (nil "sqsupset" "Relational") - (nil "neq" "Relational") - (nil "smile" "Relational") - (nil "sqsubseteq" "Relational") - (nil "sqsupseteq" "Relational") - (nil "doteq" "Relational") - (nil "frown" "Relational") - (?i "in" "Relational") - (nil "ni" "Relational") - (nil "propto" "Relational") - (nil "vdash" "Relational") - (nil "dashv" "Relational") - (?\C-b "leftarrow" "Arrows") - (nil "Leftarrow" "Arrows") - (?\C-f "rightarrow" "Arrows") - (nil "Rightarrow" "Arrows") - (nil "leftrightarrow" "Arrows") - (nil "Leftrightarrow" "Arrows") - (nil "mapsto" "Arrows") - (nil "hookleftarrow" "Arrows") - (nil "leftharpoonup" "Arrows") - (nil "leftharpoondown" "Arrows") - (nil "longleftarrow" "Arrows") - (nil "Longleftarrow" "Arrows") - (nil "longrightarrow" "Arrows") - (nil "Longrightarrow" "Arrows") - (nil "longleftrightarrow" "Arrows") - (nil "Longleftrightarrow" "Arrows") - (nil "longmapsto" "Arrows") - (nil "hookrightarrow" "Arrows") - (nil "rightharpoonup" "Arrows") - (nil "rightharpoondown" "Arrows") - (?\C-p "uparrow" "Arrows") - (nil "Uparrow" "Arrows") - (?\C-n "downarrow" "Arrows") - (nil "Downarrow" "Arrows") - (nil "updownarrow" "Arrows") - (nil "Updownarrow" "Arrows") - (nil "nearrow" "Arrows") - (nil "searrow" "Arrows") - (nil "swarrow" "Arrows") - (nil "nwarrow" "Arrows") - (nil "ldots" "Misc Symbol") - (nil "cdots" "Misc Symbol") - (nil "vdots" "Misc Symbol") - (nil "ddots" "Misc Symbol") - (nil "aleph" "Misc Symbol") - (nil "prime" "Misc Symbol") - (?A "forall" "Misc Symbol") - (?I "infty" "Misc Symbol") - (nil "hbar" "Misc Symbol") - (?0 "emptyset" "Misc Symbol") - (?E "exists" "Misc Symbol") - (nil "nabla" "Misc Symbol") - (nil "surd" "Misc Symbol") - (nil "Box" "Misc Symbol") - (nil "triangle" "Misc Symbol") - (nil "Diamond" "Misc Symbol") - (nil "imath" "Misc Symbol") - (nil "jmath" "Misc Symbol") - (nil "ell" "Misc Symbol") - (nil "neg" "Misc Symbol") - (?/ "not" "Misc Symbol") - (nil "top" "Misc Symbol") - (nil "flat" "Misc Symbol") - (nil "natural" "Misc Symbol") - (nil "sharp" "Misc Symbol") - (nil "wp" "Misc Symbol") - (nil "bot" "Misc Symbol") - (nil "clubsuit" "Misc Symbol") - (nil "diamondsuit" "Misc Symbol") - (nil "heartsuit" "Misc Symbol") - (nil "spadesuit" "Misc Symbol") - (nil "mho" "Misc Symbol") - (nil "Re" "Misc Symbol") - (nil "Im" "Misc Symbol") - (nil "angle" "Misc Symbol") - (nil "partial" "Misc Symbol") - (nil "sum" "Var Symbol") - (nil "prod" "Var Symbol") - (nil "coprod" "Var Symbol") - (nil "int" "Var Symbol") - (nil "oint" "Var Symbol") - (nil "bigcap" "Var Symbol") - (nil "bigcup" "Var Symbol") - (nil "bigsqcup" "Var Symbol") - (nil "bigvee" "Var Symbol") - (nil "bigwedge" "Var Symbol") - (nil "bigodot" "Var Symbol") - (nil "bigotimes" "Var Symbol") - (nil "bigoplus" "Var Symbol") - (nil "biguplus" "Var Symbol") - (nil "arccos" "Log-like") - (nil "arcsin" "Log-like") - (nil "arctan" "Log-like") - (nil "arg" "Log-like") - (?\C-c "cos" "Log-like") - (nil "cosh" "Log-like") - (nil "cot" "Log-like") - (nil "coth" "Log-like") - (nil "csc" "Log-like") - (nil "deg" "Log-like") - (?\C-d "det" "Log-like") - (nil "dim" "Log-like") - (?\C-e "exp" "Log-like") - (nil "gcd" "Log-like") - (nil "hom" "Log-like") - (?\C-_ "inf" "Log-like") - (nil "ker" "Log-like") - (nil "lg" "Log-like") - (?\C-l "lim" "Log-like") - (nil "liminf" "Log-like") - (nil "limsup" "Log-like") - (nil "ln" "Log-like") - (nil "log" "Log-like") - (nil "max" "Log-like") - (nil "min" "Log-like") - (nil "Pr" "Log-like") - (nil "sec" "Log-like") - (?\C-s "sin" "Log-like") - (nil "sinh" "Log-like") - (?\C-^ "sup" "Log-like") - (?\C-t "tan" "Log-like") - (nil "tanh" "Log-like") - (nil "uparrow" "delimiters") - (nil "Uparrow" "delimiters") - (nil "downarrow" "delimiters") - (nil "Downarrow" "delimiters") - (nil "{" "delimiters") - (nil "}" "delimiters") - (nil "updownarrow" "delimiters") - (nil "Updownarrow" "delimiters") - (nil "lfloor" "delimiters") - (nil "rfloor" "delimiters") - (nil "lceil" "delimiters") - (nil "rceil" "delimiters") - (?\( "langle" "delimiters") - (?\) "rangle" "delimiters") - (nil "backslash" "delimiters") - (nil "|" "delimiters") - (nil "rmoustache" "Delimiters") - (nil "lmoustache" "Delimiters") - (nil "rgroup" "Delimiters") - (nil "lgroup" "Delimiters") - (nil "arrowvert" "Delimiters") - (nil "Arrowvert" "Delimiters") - (nil "bracevert" "Delimiters") - (nil "widetilde" "Constructs") - (nil "widehat" "Constructs") - (nil "overleftarrow" "Constructs") - (nil "overrightarrow" "Constructs") - (nil "overline" "Constructs") - (nil "underline" "Constructs") - (nil "overbrace" "Constructs") - (nil "underbrace" "Constructs") - (nil "sqrt" "Constructs") - (nil "frac" "Constructs") - (?^ "hat" "Accents") - (nil "acute" "Accents") - (nil "bar" "Accents") - (nil "dot" "Accents") - (nil "breve" "Accents") - (nil "check" "Accents") - (nil "grave" "Accents") - (nil "vec" "Accents") - (nil "ddot" "Accents") - (?~ "tilde" "Accents") - (nil "digamma" ("AMS" "Hebrew")) - (nil "varkappa" ("AMS" "Hebrew")) - (nil "beth" ("AMS" "Hebrew")) - (nil "daleth" ("AMS" "Hebrew")) - (nil "gimel" ("AMS" "Hebrew")) - (nil "dashrightarrow" ("AMS" "Arrows")) - (nil "dashleftarrow" ("AMS" "Arrows")) - (nil "leftleftarrows" ("AMS" "Arrows")) - (nil "leftrightarrows" ("AMS" "Arrows")) - (nil "Lleftarrow" ("AMS" "Arrows")) - (nil "twoheadleftarrow" ("AMS" "Arrows")) - (nil "leftarrowtail" ("AMS" "Arrows")) - (nil "looparrowleft" ("AMS" "Arrows")) - (nil "leftrightharpoons" ("AMS" "Arrows")) - (nil "curvearrowleft" ("AMS" "Arrows")) - (nil "circlearrowleft" ("AMS" "Arrows")) - (nil "Lsh" ("AMS" "Arrows")) - (nil "upuparrows" ("AMS" "Arrows")) - (nil "upharpoonleft" ("AMS" "Arrows")) - (nil "downharpoonleft" ("AMS" "Arrows")) - (nil "multimap" ("AMS" "Arrows")) - (nil "leftrightsquigarrow" ("AMS" "Arrows")) - (nil "looparrowright" ("AMS" "Arrows")) - (nil "rightleftharpoons" ("AMS" "Arrows")) - (nil "curvearrowright" ("AMS" "Arrows")) - (nil "circlearrowright" ("AMS" "Arrows")) - (nil "Rsh" ("AMS" "Arrows")) - (nil "downdownarrows" ("AMS" "Arrows")) - (nil "upharpoonright" ("AMS" "Arrows")) - (nil "downharpoonright" ("AMS" "Arrows")) - (nil "rightsquigarrow" ("AMS" "Arrows")) - (nil "nleftarrow" ("AMS" "Neg Arrows")) - (nil "nrightarrow" ("AMS" "Neg Arrows")) - (nil "nLeftarrow" ("AMS" "Neg Arrows")) - (nil "nRightarrow" ("AMS" "Neg Arrows")) - (nil "nleftrightarrow" ("AMS" "Neg Arrows")) - (nil "nLeftrightarrow" ("AMS" "Neg Arrows")) - (nil "leqq" ("AMS" "Relational I")) - (nil "leqslant" ("AMS" "Relational I")) - (nil "eqslantless" ("AMS" "Relational I")) - (nil "lesssim" ("AMS" "Relational I")) - (nil "lessapprox" ("AMS" "Relational I")) - (nil "approxeq" ("AMS" "Relational I")) - (nil "lessdot" ("AMS" "Relational I")) - (nil "lll" ("AMS" "Relational I")) - (nil "lessgtr" ("AMS" "Relational I")) - (nil "lesseqgtr" ("AMS" "Relational I")) - (nil "lesseqqgtr" ("AMS" "Relational I")) - (nil "doteqdot" ("AMS" "Relational I")) - (nil "risingdotseq" ("AMS" "Relational I")) - (nil "fallingdotseq" ("AMS" "Relational I")) - (nil "backsim" ("AMS" "Relational I")) - (nil "backsimeq" ("AMS" "Relational I")) - (nil "subseteqq" ("AMS" "Relational I")) - (nil "Subset" ("AMS" "Relational I")) - (nil "sqsubset" ("AMS" "Relational I")) - (nil "preccurlyeq" ("AMS" "Relational I")) - (nil "curlyeqprec" ("AMS" "Relational I")) - (nil "precsim" ("AMS" "Relational I")) - (nil "precapprox" ("AMS" "Relational I")) - (nil "vartriangleleft" ("AMS" "Relational I")) - (nil "trianglelefteq" ("AMS" "Relational I")) - (nil "vDash" ("AMS" "Relational I")) - (nil "Vvdash" ("AMS" "Relational I")) - (nil "smallsmile" ("AMS" "Relational I")) - (nil "smallfrown" ("AMS" "Relational I")) - (nil "bumpeq" ("AMS" "Relational I")) - (nil "Bumpeq" ("AMS" "Relational I")) - (nil "geqq" ("AMS" "Relational II")) - (nil "geqslant" ("AMS" "Relational II")) - (nil "eqslantgtr" ("AMS" "Relational II")) - (nil "gtrsim" ("AMS" "Relational II")) - (nil "gtrapprox" ("AMS" "Relational II")) - (nil "gtrdot" ("AMS" "Relational II")) - (nil "ggg" ("AMS" "Relational II")) - (nil "gtrless" ("AMS" "Relational II")) - (nil "gtreqless" ("AMS" "Relational II")) - (nil "gtreqqless" ("AMS" "Relational II")) - (nil "eqcirc" ("AMS" "Relational II")) - (nil "circeq" ("AMS" "Relational II")) - (nil "triangleq" ("AMS" "Relational II")) - (nil "thicksim" ("AMS" "Relational II")) - (nil "thickapprox" ("AMS" "Relational II")) - (nil "supseteqq" ("AMS" "Relational II")) - (nil "Supset" ("AMS" "Relational II")) - (nil "sqsupset" ("AMS" "Relational II")) - (nil "succcurlyeq" ("AMS" "Relational II")) - (nil "curlyeqsucc" ("AMS" "Relational II")) - (nil "succsim" ("AMS" "Relational II")) - (nil "succapprox" ("AMS" "Relational II")) - (nil "vartriangleright" ("AMS" "Relational II")) - (nil "trianglerighteq" ("AMS" "Relational II")) - (nil "Vdash" ("AMS" "Relational II")) - (nil "shortmid" ("AMS" "Relational II")) - (nil "shortparallel" ("AMS" "Relational II")) - (nil "between" ("AMS" "Relational II")) - (nil "pitchfork" ("AMS" "Relational II")) - (nil "varpropto" ("AMS" "Relational II")) - (nil "blacktriangleleft" ("AMS" "Relational II")) - (nil "therefore" ("AMS" "Relational II")) - (nil "backepsilon" ("AMS" "Relational II")) - (nil "blacktriangleright" ("AMS" "Relational II")) - (nil "because" ("AMS" "Relational II")) - (nil "nless" ("AMS" "Neg Rel I")) - (nil "nleq" ("AMS" "Neg Rel I")) - (nil "nleqslant" ("AMS" "Neg Rel I")) - (nil "nleqq" ("AMS" "Neg Rel I")) - (nil "lneq" ("AMS" "Neg Rel I")) - (nil "lneqq" ("AMS" "Neg Rel I")) - (nil "lvertneqq" ("AMS" "Neg Rel I")) - (nil "lnsim" ("AMS" "Neg Rel I")) - (nil "lnapprox" ("AMS" "Neg Rel I")) - (nil "nprec" ("AMS" "Neg Rel I")) - (nil "npreceq" ("AMS" "Neg Rel I")) - (nil "precnsim" ("AMS" "Neg Rel I")) - (nil "precnapprox" ("AMS" "Neg Rel I")) - (nil "nsim" ("AMS" "Neg Rel I")) - (nil "nshortmid" ("AMS" "Neg Rel I")) - (nil "nmid" ("AMS" "Neg Rel I")) - (nil "nvdash" ("AMS" "Neg Rel I")) - (nil "nvDash" ("AMS" "Neg Rel I")) - (nil "ntriangleleft" ("AMS" "Neg Rel I")) - (nil "ntrianglelefteq" ("AMS" "Neg Rel I")) - (nil "nsubseteq" ("AMS" "Neg Rel I")) - (nil "subsetneq" ("AMS" "Neg Rel I")) - (nil "varsubsetneq" ("AMS" "Neg Rel I")) - (nil "subsetneqq" ("AMS" "Neg Rel I")) - (nil "varsubsetneqq" ("AMS" "Neg Rel I")) - (nil "ngtr" ("AMS" "Neg Rel II")) - (nil "ngeq" ("AMS" "Neg Rel II")) - (nil "ngeqslant" ("AMS" "Neg Rel II")) - (nil "ngeqq" ("AMS" "Neg Rel II")) - (nil "gneq" ("AMS" "Neg Rel II")) - (nil "gneqq" ("AMS" "Neg Rel II")) - (nil "gvertneqq" ("AMS" "Neg Rel II")) - (nil "gnsim" ("AMS" "Neg Rel II")) - (nil "gnapprox" ("AMS" "Neg Rel II")) - (nil "nsucc" ("AMS" "Neg Rel II")) - (nil "nsucceq" ("AMS" "Neg Rel II")) - (nil "succnsim" ("AMS" "Neg Rel II")) - (nil "succnapprox" ("AMS" "Neg Rel II")) - (nil "ncong" ("AMS" "Neg Rel II")) - (nil "nshortparallel" ("AMS" "Neg Rel II")) - (nil "nparallel" ("AMS" "Neg Rel II")) - (nil "nvDash" ("AMS" "Neg Rel II")) - (nil "nVDash" ("AMS" "Neg Rel II")) - (nil "ntriangleright" ("AMS" "Neg Rel II")) - (nil "ntrianglerighteq" ("AMS" "Neg Rel II")) - (nil "nsupseteq" ("AMS" "Neg Rel II")) - (nil "nsupseteqq" ("AMS" "Neg Rel II")) - (nil "supsetneq" ("AMS" "Neg Rel II")) - (nil "varsupsetneq" ("AMS" "Neg Rel II")) - (nil "supsetneqq" ("AMS" "Neg Rel II")) - (nil "varsupsetneqq" ("AMS" "Neg Rel II")) - (nil "dotplus" ("AMS" "Binary Op")) - (nil "smallsetminus" ("AMS" "Binary Op")) - (nil "Cap" ("AMS" "Binary Op")) - (nil "Cup" ("AMS" "Binary Op")) - (nil "barwedge" ("AMS" "Binary Op")) - (nil "veebar" ("AMS" "Binary Op")) - (nil "doublebarwedge" ("AMS" "Binary Op")) - (nil "boxminus" ("AMS" "Binary Op")) - (nil "boxtimes" ("AMS" "Binary Op")) - (nil "boxdot" ("AMS" "Binary Op")) - (nil "boxplus" ("AMS" "Binary Op")) - (nil "divideontimes" ("AMS" "Binary Op")) - (nil "ltimes" ("AMS" "Binary Op")) - (nil "rtimes" ("AMS" "Binary Op")) - (nil "leftthreetimes" ("AMS" "Binary Op")) - (nil "rightthreetimes" ("AMS" "Binary Op")) - (nil "curlywedge" ("AMS" "Binary Op")) - (nil "curlyvee" ("AMS" "Binary Op")) - (nil "circleddash" ("AMS" "Binary Op")) - (nil "circledast" ("AMS" "Binary Op")) - (nil "circledcirc" ("AMS" "Binary Op")) - (nil "centerdot" ("AMS" "Binary Op")) - (nil "intercal" ("AMS" "Binary Op")) - (nil "hbar" ("AMS" "Misc")) - (nil "hslash" ("AMS" "Misc")) - (nil "vartriangle" ("AMS" "Misc")) - (nil "triangledown" ("AMS" "Misc")) - (nil "square" ("AMS" "Misc")) - (nil "lozenge" ("AMS" "Misc")) - (nil "circledS" ("AMS" "Misc")) - (nil "angle" ("AMS" "Misc")) - (nil "measuredangle" ("AMS" "Misc")) - (nil "nexists" ("AMS" "Misc")) - (nil "mho" ("AMS" "Misc")) - (nil "Finv" ("AMS" "Misc")) - (nil "Game" ("AMS" "Misc")) - (nil "Bbbk" ("AMS" "Misc")) - (nil "backprime" ("AMS" "Misc")) - (nil "varnothing" ("AMS" "Misc")) - (nil "blacktriangle" ("AMS" "Misc")) - (nil "blacktriangledown" ("AMS" "Misc")) - (nil "blacksquare" ("AMS" "Misc")) - (nil "blacklozenge" ("AMS" "Misc")) - (nil "bigstar" ("AMS" "Misc")) - (nil "sphericalangle" ("AMS" "Misc")) - (nil "complement" ("AMS" "Misc")) - (nil "eth" ("AMS" "Misc")) - (nil "diagup" ("AMS" "Misc")) - (nil "diagdown" ("AMS" "Misc")) - (nil "Hat" ("AMS" "Accents")) - (nil "Check" ("AMS" "Accents")) - (nil "Tilde" ("AMS" "Accents")) - (nil "Acute" ("AMS" "Accents")) - (nil "Grave" ("AMS" "Accents")) - (nil "Dot" ("AMS" "Accents")) - (nil "Ddot" ("AMS" "Accents")) - (nil "Breve" ("AMS" "Accents")) - (nil "Bar" ("AMS" "Accents")) - (nil "Vec" ("AMS" "Accents")) - (nil "dddot" ("AMS" "Accents")) - (nil "ddddot" ("AMS" "Accents")) - (nil "bigl" ("AMS" "Delimiters")) - (nil "bigr" ("AMS" "Delimiters")) - (nil "Bigl" ("AMS" "Delimiters")) - (nil "Bigr" ("AMS" "Delimiters")) - (nil "biggl" ("AMS" "Delimiters")) - (nil "biggr" ("AMS" "Delimiters")) - (nil "Biggl" ("AMS" "Delimiters")) - (nil "Biggr" ("AMS" "Delimiters")) - (nil "lvert" ("AMS" "Delimiters")) - (nil "rvert" ("AMS" "Delimiters")) - (nil "lVert" ("AMS" "Delimiters")) - (nil "rVert" ("AMS" "Delimiters")) - (nil "ulcorner" ("AMS" "Delimiters")) - (nil "urcorner" ("AMS" "Delimiters")) - (nil "llcorner" ("AMS" "Delimiters")) - (nil "lrcorner" ("AMS" "Delimiters")) - (nil "nobreakdash" ("AMS" "Special")) - (nil "leftroot" ("AMS" "Special")) - (nil "uproot" ("AMS" "Special")) - (nil "accentedsymbol" ("AMS" "Special")) - (nil "xleftarrow" ("AMS" "Special")) - (nil "xrightarrow" ("AMS" "Special")) - (nil "overset" ("AMS" "Special")) - (nil "underset" ("AMS" "Special")) - (nil "dfrac" ("AMS" "Special")) - (nil "genfrac" ("AMS" "Special")) - (nil "tfrac" ("AMS" "Special")) - (nil "binom" ("AMS" "Special")) - (nil "dbinom" ("AMS" "Special")) - (nil "tbinom" ("AMS" "Special")) - (nil "smash" ("AMS" "Special")) - (nil "eucal" ("AMS" "Special")) - (nil "boldsymbol" ("AMS" "Special")) - (nil "text" ("AMS" "Special")) - (nil "intertext" ("AMS" "Special")) - (nil "substack" ("AMS" "Special")) - (nil "subarray" ("AMS" "Special")) - (nil "sideset" ("AMS" "Special")))) - -(defcustom LaTeX-math-abbrev-prefix "`" - "Prefix key for use in `LaTeX-math-mode'." - :group 'LaTeX-math - :type 'string) - -(defvar LaTeX-math-keymap (make-sparse-keymap) - "Keymap used for LaTeX-math-mode commands.") - -(defvar LaTeX-math-menu - '("Math" - ("Greek") ("greek") ("Binary Op") ("Relational") ("Arrows") - ("Misc Symbol") ("Var Symbol") ("Log-like") ("delimiters") - ("Delimiters") ("Constructs") ("Accents") ("AMS")) - "Menu containing LaTeX math commands. -The menu entries will be generated dynamically, but you can specify -the sequence by initializing this variable.") - -(define-key LaTeX-math-keymap - (concat LaTeX-math-abbrev-prefix LaTeX-math-abbrev-prefix) - 'LaTeX-math-insert-prefix) - -(let ((math (reverse (append LaTeX-math-list LaTeX-math-default))) - (map (lookup-key LaTeX-math-keymap LaTeX-math-abbrev-prefix))) - (while math - (let* ((entry (car math)) - (key (nth 0 entry)) - value menu name) - (setq math (cdr math)) - (if (listp (cdr entry)) - (setq value (nth 1 entry) - menu (nth 2 entry)) - (setq value (cdr entry) - menu nil)) - (if (stringp value) - (progn - (setq name (intern (concat "LaTeX-math-" value))) - (fset name (list 'lambda (list 'arg) (list 'interactive "*P") - (list 'LaTeX-math-insert value 'arg)))) - (setq name value)) - (if key - (progn - (setq key (if (numberp key) (char-to-string key) (vector key))) - (define-key map key name))) - (if menu - (let ((parent LaTeX-math-menu)) - (if (listp menu) - (progn - (while (cdr menu) - (let ((sub (assoc (car menu) LaTeX-math-menu))) - (if sub - (setq parent sub) - (setcdr parent (cons (list (car menu)) (cdr parent)))) - (setq menu (cdr menu)))) - (setq menu (car menu)))) - (let ((sub (assoc menu parent))) - (if sub - (if (stringp value) - (setcdr sub (cons (vector value name t) (cdr sub))) - (error "Cannot have multiple special math menu items")) - (setcdr parent - (cons (if (stringp value) - (list menu (vector value name t)) - (vector menu name t)) - (cdr parent)))))))))) - -(easy-menu-define LaTeX-math-mode-menu - LaTeX-math-keymap - "Menu used in math minor mode." - LaTeX-math-menu) - -(defvar LaTeX-math-mode nil - "Is `LaTeX-math-mode' on or off? Non nil means on.") - - (make-variable-buffer-local 'LaTeX-math-mode) - -(or (assoc 'LaTeX-math-mode minor-mode-alist) - (setq minor-mode-alist (cons '(LaTeX-math-mode " Math") minor-mode-alist))) - -(or (assoc 'LaTeX-math-mode minor-mode-map-alist) - (setq minor-mode-map-alist - (cons (cons 'LaTeX-math-mode LaTeX-math-keymap) - minor-mode-map-alist))) - -(defun LaTeX-math-mode (&optional arg) - "A minor mode with easy acces to TeX math macros. - -Easy insertion of LaTeX math symbols. If you give a prefix argument, -the symbols will be surrounded by dollar signs. The following -commands are defined: - -\\{LaTeX-math-keymap}" - (interactive "P") - (setq LaTeX-math-mode - (not (or (and (null arg) LaTeX-math-mode) - (<= (prefix-numeric-value arg) 0)))) - (if LaTeX-math-mode - (easy-menu-add LaTeX-math-mode-menu LaTeX-math-keymap) - (easy-menu-remove LaTeX-math-mode-menu)) - (set-buffer-modified-p (buffer-modified-p))) - -(fset 'latex-math-mode 'LaTeX-math-mode) - -(defun LaTeX-math-insert-prefix () - "Insert the value of `LaTeX-math-abbrev-prefix'." - (interactive "*") - (let (LaTeX-math-mode) - (call-interactively (key-binding LaTeX-math-abbrev-prefix)))) - -(defun LaTeX-math-insert (string dollar) - ;; Inserts \STRING{}. If DOLLAR is non-nil, put $'s around it. - (if dollar (insert "$")) - (TeX-insert-macro string) - (if dollar (insert "$"))) - -(defun LaTeX-math-cal (char dollar) - "Inserts a {\\cal CHAR}. If DOLLAR is non-nil, put $'s around it." - (interactive "*c\nP") - (if dollar (insert "$")) - (if (member "latex2e" (TeX-style-list)) - (insert "\\mathcal{" (char-to-string char) "}") - (insert "{\\cal " (char-to-string char) "}")) - (if dollar (insert "$"))) - -(provide 'latex) - -;;; Keymap - -(defvar LaTeX-mode-map - (let ((map (copy-keymap TeX-mode-map))) - - ;; Standard - (define-key map "\n" 'reindent-then-newline-and-indent) - - ;; From latex.el - (define-key map "\t" 'LaTeX-indent-line) - (define-key map "\eq" 'LaTeX-fill-paragraph) ;*** Alias - ;; This key is now used by Emacs for face settings. - ;; (define-key map "\eg" 'LaTeX-fill-region) ;*** Alias - (define-key map "\e\C-e" 'LaTeX-find-matching-end) - (define-key map "\e\C-a" 'LaTeX-find-matching-begin) - - (define-key map "\C-c\C-q\C-p" 'LaTeX-fill-paragraph) - (define-key map "\C-c\C-q\C-r" 'LaTeX-fill-region) - (define-key map "\C-c\C-q\C-s" 'LaTeX-fill-section) - (define-key map "\C-c\C-q\C-e" 'LaTeX-fill-environment) - - (define-key map "\C-c." 'LaTeX-mark-environment) ;*** Dubious - (define-key map "\C-c*" 'LaTeX-mark-section) ;*** Dubious - - (define-key map "\C-c\C-e" 'LaTeX-environment) - (define-key map "\C-c\n" 'LaTeX-insert-item) - (or (key-binding "\e\r") - (define-key map "\e\r" 'LaTeX-insert-item)) ;*** Alias - (define-key map "\C-c]" 'LaTeX-close-environment) - (define-key map "\C-c\C-s" 'LaTeX-section) - - ;; Outline commands... - ;; We want to use the right prefix, if possible. - (let ((outline (cond ((not (boundp 'outline-minor-mode-prefix)) - (lookup-key map "\C-c")) - ((keymapp (lookup-key map outline-minor-mode-prefix)) - (lookup-key map outline-minor-mode-prefix)) - (t - (define-key map - outline-minor-mode-prefix (make-sparse-keymap)) - (lookup-key map outline-minor-mode-prefix))))) - (define-key outline "\C-z" 'LaTeX-hide-environment) - (define-key outline "\C-x" 'LaTeX-show-environment)) - - (define-key map "\C-c~" 'LaTeX-math-mode) ;*** Dubious - - map) - "Keymap used in LaTeX-mode.") - -(defvar LaTeX-environment-menu-name "Insert Environment (C-c C-e)") - -(defun LaTeX-environment-menu-entry (entry) - ;; Create an entry for the environment menu. - (vector (car entry) (list 'LaTeX-environment-menu (car entry)) t)) - -(defvar LaTeX-environment-modify-menu-name "Change Environment (C-u C-c C-e)") - -(defun LaTeX-environment-modify-menu-entry (entry) - ;; Create an entry for the change environment menu. - (vector (car entry) (list 'LaTeX-modify-environment (car entry)) t)) - -(defun LaTeX-section-enable-symbol (LEVEL) - ;; Symbol used to enable section LEVEL in the menu bar. - (intern (concat "LaTeX-section-" (int-to-string (nth 1 entry)) "-enable"))) - -(defun LaTeX-section-enable (entry) - ;; Enable or disable section ENTRY from LaTeX-section-list. - (let ((level (nth 1 entry))) - (set (LaTeX-section-enable-symbol level) - (>= level LaTeX-largest-level)))) - -(defun LaTeX-section-menu (level) - ;; Insert section from menu. - (let ((LaTeX-section-hook (delq 'LaTeX-section-heading - (copy-sequence LaTeX-section-hook)))) - (LaTeX-section level))) - -(defun LaTeX-section-menu-entry (entry) - ;; Create an entry for the section menu. - (let ((enable (LaTeX-section-enable-symbol (nth 1 entry)))) - (set enable t) - (vector (car entry) (list 'LaTeX-section-menu (nth 1 entry)) enable))) - -(defun LaTeX-section-menu-create () - ;; Create a menu over LaTeX sections. - (append '("Section (C-c C-s)") - (mapcar 'LaTeX-section-menu-entry LaTeX-section-list))) - -(defvar LaTeX-menu-changed nil) -;; Need to update LaTeX menu. -(make-variable-buffer-local 'LaTeX-menu-changed) - -(defun LaTeX-menu-update () - ;; Update entries on AUC TeX menu. - (or (not (eq major-mode 'latex-mode)) - (null LaTeX-menu-changed) - (not (fboundp 'easy-menu-change)) - (progn - (TeX-update-style) - (setq LaTeX-menu-changed nil) - (message "Updating section menu...") - (mapcar 'LaTeX-section-enable LaTeX-section-list) - (message "Updating environment menu...") - (easy-menu-change '("LaTeX") LaTeX-environment-menu-name - (mapcar 'LaTeX-environment-menu-entry - (LaTeX-environment-list))) - (message "Updating modify environment menu...") - (easy-menu-change '("LaTeX") LaTeX-environment-modify-menu-name - (mapcar 'LaTeX-environment-modify-menu-entry - (LaTeX-environment-list))) - (message "Updating...done")))) - -(add-hook 'activate-menubar-hook 'LaTeX-menu-update) - -(easy-menu-define LaTeX-mode-menu - LaTeX-mode-map - "Menu used in LaTeX mode." - (list "LaTeX" - (list LaTeX-environment-menu-name "Bug.") - (list LaTeX-environment-modify-menu-name "Bug.") - (LaTeX-section-menu-create) - ["Macro..." TeX-insert-macro t] - ["Complete" TeX-complete-symbol t] - ["Item" LaTeX-insert-item t] - (list "Insert Font" - ["Emphasize" (TeX-font nil ?\C-e) :keys "C-c C-f C-e"] - ["Bold" (TeX-font nil ?\C-b) :keys "C-c C-f C-b"] - ["Typewriter" (TeX-font nil ?\C-t) :keys "C-c C-f C-t"] - ["Small Caps" (TeX-font nil ?\C-c) :keys "C-c C-f C-c"] - ["Sans Serif" (TeX-font nil ?\C-f) :keys "C-c C-f C-f"] - ["Italic" (TeX-font nil ?\C-i) :keys "C-c C-f C-i"] - ["Slanted" (TeX-font nil ?\C-s) :keys "C-c C-f C-s"] - ["Roman" (TeX-font nil ?\C-r) :keys "C-c C-f C-r"]) - (list "Change Font" - ["Emphasize" (TeX-font t ?\C-e) :keys "C-u C-c C-f C-e"] - ["Bold" (TeX-font t ?\C-b) :keys "C-u C-c C-f C-b"] - ["Typewriter" (TeX-font t ?\C-t) :keys "C-u C-c C-f C-t"] - ["Small Caps" (TeX-font t ?\C-c) :keys "C-u C-c C-f C-c"] - ["Sans Serif" (TeX-font t ?\C-f) :keys "C-u C-c C-f C-f"] - ["Italic" (TeX-font t ?\C-i) :keys "C-u C-c C-f C-i"] - ["Slanted" (TeX-font t ?\C-s) :keys "C-u C-c C-f C-s"] - ["Roman" (TeX-font t ?\C-r) :keys "C-u C-c C-f C-r"]) - ["Delete Font" (TeX-font t ?\C-d) :keys "C-c C-f C-d"] - "-" - ["Next Error" TeX-next-error t] - (list "TeX Output" - ["Kill Job" TeX-kill-job t] - ["Debug Bad Boxes" TeX-toggle-debug-boxes - :style toggle :selected TeX-debug-bad-boxes ] - ["Switch to Original File" TeX-home-buffer t] - ["Recenter Output Buffer" TeX-recenter-output-buffer t]) - (list "Formatting and Marking" - ["Format Environment" LaTeX-fill-environment t] - ["Format Paragraph" LaTeX-fill-paragraph t] - ["Format Region" LaTeX-fill-region t] - ["Format Section" LaTeX-fill-section t] - ["Mark Environment" LaTeX-mark-environment t] - ["Mark Section" LaTeX-mark-section t] - ["Beginning of Environment" LaTeX-find-matching-begin t] - ["End of Environment" LaTeX-find-matching-end t] - ["Hide Environment" LaTeX-hide-environment t] - ["Show Environment" LaTeX-show-environment t]) - (list "Miscellaneous" - ["Uncomment Region" TeX-un-comment-region t] - ["Comment Region" TeX-comment-region t] - ["Switch to Master file" TeX-home-buffer t] - ["Save Document" TeX-save-document t] - ["Math Mode" LaTeX-math-mode - :style toggle :selected LaTeX-math-mode ] - ["Documentation" TeX-goto-info-page t] - ["Submit bug report" TeX-submit-bug-report t] - [ "Convert 209 to 2e" LaTeX-209-to-2e - :active (member "latex2" (TeX-style-list)) ] - ["Reset Buffer" TeX-normal-mode t] - ["Reset AUC TeX" (TeX-normal-mode t) :keys "C-u C-c C-n"]))) - -(defcustom LaTeX-font-list - '((?\C-b "\\textbf{" "}") - (?\C-c "\\textsc{" "}") - (?\C-e "\\emph{" "}") - (?\C-f "\\textsf{" "}") - (?\C-i "\\textit{" "}") - (?\C-m "\\textmd{" "}") - (?\C-n "\\textnormal{" "}") - (?\C-r "\\textrm{" "}") - (?\C-s "\\textsl{" "}") - (?\C-t "\\texttt{" "}") - (?\C-u "\\textup{" "}") - (?\C-d "" "" t)) - "Font commands used with LaTeX2e. See `TeX-font-list'." - :group 'LaTeX-macro - :type '(repeat (group (character :tag "Key") - (string :tag "Prefix") - (string :tag "Suffix") - (option (sexp :format "Replace\n" - :value t))))) - -;;; Mode - -(defgroup LaTeX-macro nil - "Special support for LaTeX macros in AUC TeX." - :prefix "TeX-" - :group 'LaTeX - :group 'TeX-macro) - -(defcustom TeX-arg-cite-note-p nil - "*If non-nil, ask for optional note in citations." - :type 'boolean - :group 'LaTeX-macro) - -(defcustom TeX-arg-footnote-number-p nil - "*If non-nil, ask for optional number in footnotes." - :type 'boolean - :group 'LaTeX-macro) - -(defcustom TeX-arg-item-label-p nil - "*If non-nil, always ask for optional label in items. -Otherwise, only ask in description environments." - :type 'boolean - :group 'LaTeX-macro) - -(defcustom TeX-arg-right-insert-p t - "*If non-nil, always insert automatically the corresponding \\right. -This happens when \\left is inserted." - :type 'boolean - :group 'LaTeX-macro) - -(defvar LaTeX-paragraph-commands - (concat "\\[\\|\\]\\|" ; display math delimitors - "begin\\b\\|end\\b\\|part\\b\\|chapter\\b\\|label\\b\\|" - "caption\\b\\|section\\b\\|subsection\\b\\|subsubsection\\b\\|" - "par\\b\\|noindent\\b\\|paragraph\\b\\|include\\b\\|" - "includeonly\\b\\|tableofcontents\\b\\|appendix\\b") - "Regexp matching names of LaTeX macros that should have their own line.") - -;;; Do not ;;;###autoload because of conflict with standard tex-mode.el. -(defun latex-mode () - "Major mode for editing files of input for LaTeX. -See info under AUC TeX for full documentation. - -Special commands: -\\{LaTeX-mode-map} - -Entering LaTeX mode calls the value of `text-mode-hook', -then the value of `TeX-mode-hook', and then the value -of `LaTeX-mode-hook'." - (interactive) - (LaTeX-common-initialization) - (setq mode-name "LaTeX") - (setq major-mode 'latex-mode) - (setq TeX-command-default "LaTeX") - (run-hooks 'text-mode-hook 'TeX-mode-hook 'LaTeX-mode-hook) - - ;; Defeat filladapt if auto-fill-mode is set in text-mode-hook. - (and (boundp 'filladapt-function-table) - (boundp 'auto-fill-function) - (eq auto-fill-function 'do-auto-fill) - (setq auto-fill-function - (cdr (assoc 'do-auto-fill filladapt-function-table))))) - -(defvar LaTeX-header-end - (concat (regexp-quote TeX-esc) "begin *" TeX-grop "document" TeX-grcl) - "Default end of header marker for LaTeX documents.") - -(defvar LaTeX-trailer-start - (concat (regexp-quote TeX-esc) "end *" TeX-grop "document" TeX-grcl) - "Default start of trailer marker for LaTeX documents.") - -(defun LaTeX2e-font-replace (start end) - "Replace LaTeX2e font specification around point with START and END." - (save-excursion - (catch 'done - (while t - (if (/= ?\\ (following-char)) - (skip-chars-backward "a-zA-Z ")) - (skip-chars-backward "\\\\") - (if (looking-at "\\\\\\(emph\\|text[a-z]+\\){") - (throw 'done t) - (up-list -1)))) - (forward-sexp 2) - (save-excursion - (replace-match start t t)) - (delete-backward-char 1) - (insert end))) - -(defun LaTeX-common-initialization () - ;; Common initialization for LaTeX derived modes. - (VirTeX-common-initialization) - (set-syntax-table LaTeX-mode-syntax-table) - (make-local-variable 'indent-line-function) - (setq indent-line-function 'LaTeX-indent-line) - (use-local-map LaTeX-mode-map) - (easy-menu-add TeX-mode-menu LaTeX-mode-map) - (easy-menu-add LaTeX-mode-menu LaTeX-mode-map) - - (or LaTeX-largest-level - (setq LaTeX-largest-level (LaTeX-section-level "section"))) - - (setq TeX-header-end LaTeX-header-end - TeX-trailer-start LaTeX-trailer-start) - - (require 'outline) - (make-local-variable 'outline-level) - (setq outline-level 'LaTeX-outline-level) - (make-local-variable 'outline-regexp) - (setq outline-regexp (LaTeX-outline-regexp t)) - - (make-local-variable 'TeX-auto-full-regexp-list) - (setq TeX-auto-full-regexp-list - (append LaTeX-auto-regexp-list plain-TeX-auto-regexp-list)) - - (setq paragraph-start - (concat - "\\(" - "^.*[^" TeX-esc "\n]%.*$\\|" - "^%.*$\\|" - "^[ \t]*$\\|" - "^[ \t]*" - (regexp-quote TeX-esc) - "\\(" - LaTeX-paragraph-commands - "\\|item\\b" - "\\)" - "\\|" - "^[ \t]*\\$\\$" ; display math delimitor - "\\)" )) - (setq paragraph-separate - (concat - "\\(" - "^.*[^" TeX-esc "\n]%.*$\\|" - "^%.*$\\|" - "^[ \t]*$\\|" - "^[ \t]*" - (regexp-quote TeX-esc) - "\\(" - LaTeX-paragraph-commands - "\\)" - "\\)")) - (setq selective-display t) - - (make-local-variable 'LaTeX-item-list) - (setq LaTeX-item-list '(("description" . LaTeX-item-argument) - ("thebibliography" . LaTeX-item-bib))) - - (setq TeX-complete-list - (append '(("\\\\cite\\[[^]\n\r\\%]*\\]{\\([^{}\n\r\\%,]*\\)" - 1 LaTeX-bibitem-list "}") - ("\\\\cite{\\([^{}\n\r\\%,]*\\)" 1 LaTeX-bibitem-list "}") - ("\\\\cite{\\([^{}\n\r\\%]*,\\)\\([^{}\n\r\\%,]*\\)" - 2 LaTeX-bibitem-list) - ("\\\\nocite{\\([^{}\n\r\\%,]*\\)" 1 LaTeX-bibitem-list "}") - ("\\\\nocite{\\([^{}\n\r\\%]*,\\)\\([^{}\n\r\\%,]*\\)" - 2 LaTeX-bibitem-list) - ("\\\\ref{\\([^{}\n\r\\%,]*\\)" 1 LaTeX-label-list "}") - ("\\\\eqref{\\([^{}\n\r\\%,]*\\)" 1 LaTeX-label-list "}") - ("\\\\pageref{\\([^{}\n\r\\%,]*\\)" 1 LaTeX-label-list "}") - ("\\\\begin{\\([A-Za-z]*\\)" 1 LaTeX-environment-list "}") - ("\\\\end{\\([A-Za-z]*\\)" 1 LaTeX-environment-list "}") - ("\\\\renewcommand{\\\\\\([A-Za-z]*\\)" - 1 LaTeX-symbol-list "}") - ("\\\\renewenvironment{\\([A-Za-z]*\\)" - 1 LaTeX-environment-list "}")) - TeX-complete-list)) - - (LaTeX-add-environments - '("document" LaTeX-env-document) - '("enumerate" LaTeX-env-item) - '("itemize" LaTeX-env-item) - '("list" LaTeX-env-list) - '("trivlist" LaTeX-env-item) - '("picture" LaTeX-env-picture) - '("tabular" LaTeX-env-array) - '("tabular*" LaTeX-env-array) - '("array" LaTeX-env-array) - '("eqnarray" LaTeX-env-label) - '("equation" LaTeX-env-label) - '("minipage" LaTeX-env-minipage) - - ;; The following have no special support, but are included in - ;; case the auto files are missing. - - "sloppypar" "picture" "tabbing" "verbatim" "verbatim*" - "flushright" "flushleft" "displaymath" "math" "quote" "quotation" - "abstract" "center" "titlepage" "verse" "eqnarray*" - - ;; The following are not defined in latex.el, but in a number of - ;; other style files. I'm to lazy to copy them to all the - ;; corresponding .el files right now. - - ;; This means that AUC TeX will complete e.g. - ;; ``thebibliography'' in a letter, but I guess we can live with - ;; that. - - '("description" LaTeX-env-item) - '("figure" LaTeX-env-figure) - '("figure*" LaTeX-env-figure) - '("table" LaTeX-env-figure) - '("table*" LaTeX-env-figure) - '("thebibliography" LaTeX-env-bib) - '("theindex" LaTeX-env-item)) - - (TeX-add-symbols - '("addtocounter" TeX-arg-counter "Value") - '("alph" TeX-arg-counter) - '("arabic" TeX-arg-counter) - '("fnsymbol" TeX-arg-define-counter) - '("newcounter" TeX-arg-define-counter - [ TeX-arg-counter "Within counter" ]) - '("roman" TeX-arg-counter) - '("setcounter" TeX-arg-counter "Value") - '("usecounter" TeX-arg-counter) - '("value" TeX-arg-counter) - '("stepcounter" TeX-arg-counter) - '("refstepcounter" TeX-arg-counter) - '("label" TeX-arg-define-label) - '("pageref" TeX-arg-label) - '("ref" TeX-arg-label) - '("newcommand" TeX-arg-define-macro [ "Number of arguments" ] t) - '("renewcommand" TeX-arg-macro [ "Number of arguments" ] t) - '("newenvironment" TeX-arg-define-environment - [ "Number of arguments"] t t) - '("renewenvironment" TeX-arg-environment - [ "Number of arguments"] t t) - '("newtheorem" TeX-arg-define-environment - [ TeX-arg-environment "Numbered like" ] - t [ (TeX-arg-eval progn (if (eq (save-excursion - (backward-char 2) - (preceding-char)) ?\]) - () - (TeX-arg-counter t "Within counter")) - "") ]) - '("newfont" TeX-arg-define-macro t) - '("circle" "Diameter") - '("circle*" "Diameter") - '("dashbox" "Dash Length" TeX-arg-size - [ TeX-arg-corner ] t) - '("frame" t) - '("framebox" (TeX-arg-conditional - (string-equal (LaTeX-current-environment) "picture") - (TeX-arg-size [ TeX-arg-corner ] t) - ([ "Length" ] [ TeX-arg-lr ] t))) - '("line" (TeX-arg-pair "X slope" "Y slope") "Length") - '("linethickness" "Dimension") - '("makebox" (TeX-arg-conditional - (string-equal (LaTeX-current-environment) "picture") - (TeX-arg-size [ TeX-arg-corner ] t) - ([ "Length" ] [ TeX-arg-lr ] t))) - '("multiput" - TeX-arg-coordinate - (TeX-arg-pair "X delta" "Y delta") - "Number of copies" - t) - '("oval" TeX-arg-size [ TeX-arg-corner "Portion" ]) - '("put" TeX-arg-coordinate t) - '("savebox" TeX-arg-define-savebox - (TeX-arg-conditional - (string-equal (LaTeX-current-environment) "picture") - (TeX-arg-size [ TeX-arg-corner ] t) - ([ "Length" ] [ TeX-arg-lr ] t))) - '("shortstack" [ TeX-arg-lr ] t) - '("vector" (TeX-arg-pair "X slope" "Y slope") "Length") - '("cline" "Span `i-j'") - '("multicolumn" "Columns" "Position" t) - '("item" - (TeX-arg-conditional (or TeX-arg-item-label-p - (string-equal (LaTeX-current-environment) - "description")) - ([ "Item label" ]) - ()) - (TeX-arg-literal " ")) - '("bibitem" [ "Bibitem label" ] TeX-arg-define-cite) - '("cite" - (TeX-arg-conditional TeX-arg-cite-note-p ([ "Note" ]) ()) - TeX-arg-cite) - '("nocite" TeX-arg-cite) - '("bibliographystyle" TeX-arg-bibstyle) - '("bibliography" TeX-arg-bibliography) - '("footnote" - (TeX-arg-conditional TeX-arg-footnote-number-p ([ "Number" ]) nil) - t) - '("footnotetext" - (TeX-arg-conditional TeX-arg-footnote-number-p ([ "Number" ]) nil) - t) - '("footnotemark" - (TeX-arg-conditional TeX-arg-footnote-number-p ([ "Number" ]) nil)) - '("newlength" TeX-arg-define-macro) - '("setlength" TeX-arg-macro "Length") - '("addtolength" TeX-arg-macro "Length") - '("settowidth" TeX-arg-macro t) - '("\\" [ "Space" ]) - '("\\*" [ "Space" ]) - '("hyphenation" t) - '("linebreak" [ "How much [0 - 4]" ]) - '("nolinebreak" [ "How much [0 - 4]" ]) - '("nopagebreak" [ "How much [0 - 4]" ]) - '("pagebreak" [ "How much [0 - 4]" ]) - '("stackrel" t nil) - '("frac" t nil) - '("lefteqn" t) - '("overbrace" t) - '("overline" t) - '("sqrt" [ "Root" ] t) - '("underbrace" t) - '("underline" t) - '("author" t) - '("date" t) - '("thanks" t) - '("title" t) - '("pagenumbering" (TeX-arg-eval - completing-read "Numbering style: " - '(("arabic") ("roman") ("Roman") ("alph") ("Alph")))) - '("pagestyle" TeX-arg-pagestyle) - '("markboth" t nil) - '("markright" t) - '("thispagestyle" TeX-arg-pagestyle) - '("addvspace" "Length") - '("fbox" t) - '("hspace*" "Length") - '("hspace" "Length") - '("mbox" t) - '("newsavebox" TeX-arg-define-savebox) - '("parbox" [ TeX-arg-tb] "Width" t) - '("raisebox" "Raise" [ "Height above" ] [ "Depth below" ] t) - '("rule" [ "Raise" ] "Width" "Thickness") - '("sbox" TeX-arg-define-savebox t) - '("usebox" TeX-arg-savebox) - '("vspace*" "Length") - '("vspace" "Length") - '("documentstyle" TeX-arg-document) - '("include" (TeX-arg-input-file "File" t)) - '("includeonly" t) - '("input" TeX-arg-input-file) - '("addcontentsline" TeX-arg-file - (TeX-arg-eval - completing-read "Numbering style: " LaTeX-section-list) - t) - '("addtocontents" TeX-arg-file t) - '("typeout" t) - '("typein" [ TeX-arg-define-macro ] t) - '("verb" TeX-arg-verb) - '("verb*" TeX-arg-verb) - '("extracolsep" t) - '("index" t) - '("glossary" t) - '("numberline" "Section number" "Heading") - '("caption" t) - '("marginpar" [ "Left margin text" ] "Text") - '("left" TeX-arg-insert-braces) - - ;; These have no special support, but are included in case the - ;; auto files are missing. - - "LaTeX" "SLiTeX" "samepage" "newline" "smallskip" "medskip" - "bigskip" "stretch" "nonumber" "centering" "raggedright" - "raggedleft" "kill" "pushtabs" "poptabs" "protect" "arraystretch" - "hline" "vline" "cline" "thinlines" "thicklines" "and" "makeindex" - "makeglossary" "reversemarginpar" "normalmarginpar" - "raggedbottom" "flushbottom" "sloppy" "fussy" "newpage" - "clearpage" "cleardoublepage" "twocolumn" "onecolumn") - - (TeX-run-style-hooks "LATEX") - - (make-local-variable 'TeX-font-list) - (make-local-variable 'TeX-font-replace-function) - (if (string-equal LaTeX-version "2") - () - (setq TeX-font-list LaTeX-font-list) - (setq TeX-font-replace-function 'LaTeX2e-font-replace) - (TeX-add-symbols - '("newcommand" TeX-arg-define-macro - [ "Number of arguments" ] [ "Default value for first argument" ] t) - '("renewcommand" TeX-arg-macro - [ "Number of arguments" ] [ "Default value for first argument" ] t) - '("usepackage" [ "Options" ] (TeX-arg-input-file "Package")) - '("documentclass" TeX-arg-document))) - - (TeX-add-style-hook "latex2e" - ;; Use new fonts for `\documentclass' documents. - (function (lambda () - (setq TeX-font-list LaTeX-font-list) - (setq TeX-font-replace-function 'LaTeX2e-font-replace) - (if (equal LaTeX-version "2") - (setq TeX-command-default "LaTeX2e")) - (run-hooks 'LaTeX2e-hook)))) - - (TeX-add-style-hook "latex2" - ;; Use old fonts for `\documentstyle' documents. - (function (lambda () - (setq TeX-font-list (default-value 'TeX-font-list)) - (setq TeX-font-replace-function - (default-value 'TeX-font-replace-function)) - (run-hooks 'LaTeX2-hook))))) - -(defvar LaTeX-builtin-opts - '("12pt" "11pt" "10pt" "twocolumn" "twoside" "draft") - "Built in options for LaTeX standard styles") - -(defun LaTeX-209-to-2e () - "Make a stab at changing 2.09 doc header to 2e style." - (interactive) - (TeX-home-buffer) - (let (optstr optlist 2eoptlist 2epackages docline docstyle) - (goto-char (point-min)) - (if - (search-forward-regexp - "\\documentstyle\\[\\([^]]*\\)\\]{\\([^}]*\\)}" - (point-max) t) - (setq optstr (buffer-substring-no-properties (match-beginning 1) (match-end 1)) - docstyle (buffer-substring-no-properties (match-beginning 2) - (match-end 2)) - optlist (TeX-split-string "," optstr)) - (if (search-forward-regexp - "\\documentstyle{\\([^}]*\\)}" - (point-max) t) - (setq docstyle (buffer-substring-no-properties (match-beginning 1) - (match-end 1))) - (error "No documentstyle defined"))) - (beginning-of-line 1) - (setq docline (point)) - (insert "%%%") - (while optlist - (if (member (car optlist) LaTeX-builtin-opts) - (setq 2eoptlist (cons (car optlist) 2eoptlist)) - (setq 2epackages (cons (car optlist) 2epackages))) - (setq optlist (cdr optlist))) - ;;(message (format "%S %S" 2eoptlist 2epackages)) - (goto-char docline) - (next-line 1) - (insert "\\documentclass") - (if 2eoptlist - (insert "[" - (mapconcat (function (lambda (x) x)) - (nreverse 2eoptlist) ",") "]")) - (insert "{" docstyle "}\n") - (if 2epackages - (insert "\\usepackage{" - (mapconcat (function (lambda (x) x)) - (nreverse 2epackages) "}\n\\usepackage{") "}\n")) - (if (equal docstyle "slides") - (progn - (goto-char (point-min)) - (while (re-search-forward "\\\\blackandwhite{" nil t) - (replace-match "\\\\input{" nil nil))))) - (TeX-normal-mode nil)) - -;;; latex.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/auctex/lpath.el --- a/lisp/auctex/lpath.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,8 +0,0 @@ -;;; This file is only used for installing AUC TeX. -;;; It is not a part of AUC TeX itself. - -;; Make sure we get the right files. -(setq load-path (cons "." load-path) - byte-compile-warnings nil - TeX-lisp-directory "") - diff -r 6866abce6aaf -r 6075d714658b lisp/auctex/multi-prompt.el --- a/lisp/auctex/multi-prompt.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,138 +0,0 @@ -;;; multi-prompt.el --- completing read of multiple strings. - -;; Copyright (C) 1996, 1997 Per Abrahamsen. - -;; Author: Per Abrahamsen -;; Keywords: extensions -;; Version: 0.2 -;; Bogus-Bureaucratic-Cruft: How 'bout ESR and the LCD people agreed -;; on a common format? - -;; LCD Archive Entry: -;; multi-prompt|Per Abrahamsen|abraham@dina.kvl.dk| -;; completing read of multiple strings| -;; 1996-08-31|0.1|~/functions/multi-prompt.el.Z| - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Commentary: - -;; This package is written for use in emacs lisp programs, where the -;; user is prompted for a string of the form: -;; -;; FOO,BAR,BAZ -;; -;; where FOO, BAR, and BAZ are elements of some table. The function -;; `multi-prompt' is a replacement `completing-read' that will allow -;; the user to enter a string like the above, yet get completion on -;; both FOO, BAR, and BAZ. - -;;; Change Log: -;; -;; Sat Feb 15 17:58:31 MET 1997 -;; * Version 0.2 released. -;; Renamed predicate to `mp-predicate'. -;; Sat Aug 31 18:32:20 MET DST 1996 -;; * Version 0.1 released. -;; Fixed `predicate' bug. -;; Added provide. -;; Added `multi-prompt-found' variable. -;; Sat Aug 31 16:29:14 MET DST 1996 -;; * Created. - -;;; Code: - -(provide 'multi-prompt) - -(defvar multi-prompt-found nil - "List of entries currently added during a `multi-prompt'.") - -(defun multi-prompt (separator - unique prompt table - &optional mp-predicate require-match initial history) - "Completing prompt for a list of strings. -The first argument SEPARATOR should be the string (of length 1) to -separate the elements in the list. The second argument UNIQUE should -be non-nil, if each element must be unique. The remaining elements -are the arguments to `completing-read'. See that." - (let ((old-map (if require-match - minibuffer-local-must-match-map - minibuffer-local-completion-map)) - (new-map (make-sparse-keymap))) - (if (fboundp 'set-keymap-parent) - ;; `set-keymap-parent' was introduced in Emacs 19.32. - (set-keymap-parent new-map old-map) - (setq new-map (copy-keymap old-map))) - (define-key new-map separator (if require-match - 'multi-prompt-next-must-match - 'multi-prompt-next)) - (define-key new-map "\C-?" 'multi-prompt-delete) - (let* ((minibuffer-local-completion-map new-map) - (minibuffer-local-must-match-map new-map) - (multi-prompt-found nil) - (done nil) - (filter (cond (unique - (lambda (x) - (and (not (member (car x) multi-prompt-found)) - (or (null mp-predicate) - (funcall mp-predicate x))))) - (mp-predicate))) - (answer (catch 'multi-prompt-exit - (while t - (let ((extra (catch 'multi-prompt-next - (throw 'multi-prompt-exit - (completing-read prompt - table - filter - require-match - initial - history))))) - (cond ((eq extra 'back) - (when multi-prompt-found - (setq prompt (substring - prompt 0 - (- 0 (length separator) - (length - (car multi-prompt-found)))) - initial (car multi-prompt-found)) - (setq multi-prompt-found - (cdr multi-prompt-found)))) - (t - (setq prompt (concat prompt extra separator) - initial nil) - (setq multi-prompt-found - (cons extra multi-prompt-found))))))))) - (if answer - (nreverse (cons answer multi-prompt-found)) - multi-prompt-found)))) - -(defun multi-prompt-delete () - (interactive) - (if (bobp) - (throw 'multi-prompt-next 'back) - (call-interactively 'backward-delete-char))) - -(defun multi-prompt-next () - (interactive) - (throw 'multi-prompt-next - (buffer-substring-no-properties (point-min) (point-max)))) - -(defun multi-prompt-next-must-match () - (interactive) - (if (call-interactively 'minibuffer-complete) - (throw 'multi-prompt-next - (buffer-substring-no-properties (point-min) (point-max))))) - -;;; multi-prompt.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/auctex/tex-buf.el --- a/lisp/auctex/tex-buf.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1623 +0,0 @@ -;;; tex-buf.el - External commands for AUC TeX. -;; -;; Maintainer: Per Abrahamsen -;; Version: 9.7p - -;; Copyright (C) 1991 Kresten Krab Thorup -;; Copyright (C) 1993, 1996 Per Abrahamsen -;; -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 1, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Code: - -(require 'tex) - -;;; Customization: - -(defcustom TeX-process-asynchronous (not (eq system-type 'ms-dos)) - "*Use asynchronous processes." - :group 'TeX-commands - :type 'boolean) - -(defcustom TeX-shell - (if (memq system-type '(ms-dos emx windows-nt)) - shell-file-name - "/bin/sh") - "Name of shell used to parse TeX commands." - :group 'TeX-commands - :type 'file) - -(defcustom TeX-shell-command-option - (cond ((memq system-type '(ms-dos emx windows-nt) ) - (cond ((boundp 'shell-command-option) - shell-command-option) - ((boundp 'shell-command-switch) - shell-command-switch) - (t - "/c"))) - (t ;Unix & EMX (Emacs 19 port to OS/2) - "-c")) - "Shell argument indicating that next argument is the command." - :group 'TeX-commands - :type 'string) - -;;; Interactive Commands -;; -;; The general idea is, that there is one process and process buffer -;; associated with each master file, and one process and process buffer -;; for running TeX on a region. Thus, if you have N master files, you -;; can run N + 1 processes simultaneously. -;; -;; Some user commands operates on ``the'' process. The following -;; algorithm determine what ``the'' process is. -;; -;; IF last process started was on a region -;; THEN ``the'' process is the region process -;; ELSE ``the'' process is the master file (of the current buffer) process - -(defun TeX-save-document (name) - "Save all files belonging to the current document. -Return non-nil if document need to be re-TeX'ed." - (interactive (list (TeX-master-file))) - (if (string-equal name "") - (setq name (TeX-master-file))) - - (TeX-check-files (concat name ".dvi") - (cons name (TeX-style-list)) - TeX-file-extensions)) - -(defun TeX-command-master () - "Run command on the current document." - (interactive) - (TeX-command (TeX-command-query (TeX-master-file)) 'TeX-master-file)) - -(defvar TeX-command-region-begin nil) -(defvar TeX-command-region-end nil) -;; Used for marking the last region. - -(make-variable-buffer-local 'TeX-command-region-begin) -(make-variable-buffer-local 'TeX-command-region-end) - -(defun TeX-command-region (&optional old) - "Run TeX on the current region. - -Query the user for a command to run on the temporary file specified by -the variable TeX-region. If the chosen command is so marked in -TeX-command-list, and no argument (or nil) is given to the command, -the region file file be recreated with the current region. If mark is -not active, the new text in the previous used region will be used. - -If the master file for the document has a header, it is written to the -temporary file before the region itself. The document's header is all -text before TeX-header-end. - -If the master file for the document has a trailer, it is written to -the temporary file before the region itself. The document's trailer is -all text after TeX-trailer-start." - (interactive "P") - (if (and (TeX-mark-active) (not old)) - (let ((begin (min (point) (mark))) - (end (max (point) (mark)))) - (if TeX-command-region-begin - () - (setq TeX-command-region-begin (make-marker) - TeX-command-region-end (make-marker))) - (set-marker TeX-command-region-begin begin) - (set-marker TeX-command-region-end end))) - (if (null TeX-command-region-begin) - (error "Mark not set")) - (let ((begin (marker-position TeX-command-region-begin)) - (end (marker-position TeX-command-region-end))) - (TeX-region-create (TeX-region-file TeX-default-extension) - (buffer-substring begin end) - (file-name-nondirectory (buffer-file-name)) - (count-lines (save-restriction (widen) (point-min)) - begin))) - (TeX-command (TeX-command-query (TeX-region-file)) 'TeX-region-file)) - -(defun TeX-command-buffer () - "Run TeX on the current buffer. - -Query the user for a command to run on the temporary file specified by -the variable TeX-region. The region file file be recreated from the -visible part of the buffer." - (interactive) - (let ((TeX-command-region-begin (point-min-marker)) - (TeX-command-region-end (point-max-marker))) - (TeX-command-region t))) - -(defun TeX-recenter-output-buffer (line) - "Redisplay buffer of TeX job output so that most recent output can be seen. -The last line of the buffer is displayed on line LINE of the window, or -at bottom if LINE is nil." - (interactive "P") - (let ((buffer (TeX-active-buffer))) - (if buffer - (let ((old-buffer (current-buffer))) - (pop-to-buffer buffer t) - (bury-buffer buffer) - (goto-char (point-max)) - (recenter (if line - (prefix-numeric-value line) - (/ (window-height) 2))) - (pop-to-buffer old-buffer)) - (message "No process for this document.")))) - -(defun TeX-kill-job () - "Kill the currently running TeX job." - (interactive) - (let ((process (TeX-active-process))) - (if process - (kill-process process) - ;; Should test for TeX background process here. - (error "No TeX process to kill")))) - -(defun TeX-home-buffer () - "Go to the buffer where you last issued a TeX command. -If there is no such buffer, or you already are in that buffer, find -the master file." - (interactive) - (if (or (null TeX-command-buffer) - (eq TeX-command-buffer (current-buffer))) - (find-file (TeX-master-file TeX-default-extension)) - (switch-to-buffer TeX-command-buffer))) - -(defun TeX-next-error (reparse) - "Find the next error in the TeX output buffer. -Prefix by C-u to start from the beginning of the errors." - (interactive "P") - (if (null (TeX-active-buffer)) - (error "No TeX output buffer") - (funcall (TeX-process-get-variable (TeX-active-master) 'TeX-parse-function) - reparse))) - -(defun TeX-toggle-debug-boxes () - "Toggle if the debugger should display \"bad boxes\" too." - (interactive) - (cond (TeX-debug-bad-boxes - (setq TeX-debug-bad-boxes nil)) - (t - (setq TeX-debug-bad-boxes t))) - (message (concat "TeX-debug-bad-boxes: " (cond (TeX-debug-bad-boxes "on") - (t "off"))))) - -;;; Command Query - -(defun TeX-command (name file) - "Run command NAME on the file you get by calling FILE. - -FILE is a function return a file name. It has one optional argument, -the extension to use on the file. - -Use the information in TeX-command-list to determine how to run the -command." - (setq TeX-current-process-region-p (eq file 'TeX-region-file)) - (let ((command (TeX-command-expand (nth 1 (assoc name TeX-command-list)) - file)) - (hook (nth 2 (assoc name TeX-command-list))) - (confirm (nth 3 (assoc name TeX-command-list)))) - - ;; Verify the expanded command - (if confirm - (setq command - (read-from-minibuffer (concat name " command: ") command))) - - ;; Now start the process - (TeX-process-set-variable name 'TeX-command-next TeX-command-Show) - (apply hook name command (apply file nil) nil))) - -(defun TeX-command-expand (command file &optional list) - "Expand COMMAND for FILE as described in LIST. -LIST default to TeX-expand-list." - (if (null list) - (setq list TeX-expand-list)) - (while list - (let ((case-fold-search nil) ; Do not ignore case. - (string (car (car list))) ;First element - (expansion (car (cdr (car list)))) ;Second element - (arguments (cdr (cdr (car list))))) ;Remaining elements - (while (string-match string command) - (let ((prefix (substring command 0 (match-beginning 0))) - (postfix (substring command (match-end 0)))) - (setq command (concat prefix - (cond ((TeX-function-p expansion) - (apply expansion arguments)) - ((boundp expansion) - (apply (eval expansion) arguments)) - (t - (error "Nonexpansion %s" expansion))) - postfix))))) - (setq list (cdr list))) - command) - -(defun TeX-check-files (derived originals extensions) - "Check that DERIVED is newer than any of the ORIGINALS. -Try each original with each member of EXTENSIONS, in all directories -in TeX-check-path." - (let ((found nil) - (regexp (concat "\\`\\(" - (mapconcat (function (lambda (dir) - (regexp-quote (expand-file-name dir)))) - TeX-check-path "\\|") - "\\).*\\(" - (mapconcat 'regexp-quote originals "\\|") - "\\)\\.\\(" - (mapconcat 'regexp-quote extensions "\\|") - "\\)\\'")) - (buffers (buffer-list))) - (while buffers - (let* ((buffer (car buffers)) - (name (buffer-file-name buffer))) - (setq buffers (cdr buffers)) - (if (and name (string-match regexp name)) - (progn - (and (buffer-modified-p buffer) - (or (not TeX-save-query) - (y-or-n-p (concat "Save file " - (buffer-file-name buffer) - "? "))) - (save-excursion (set-buffer buffer) (save-buffer))) - (if (file-newer-than-file-p name derived) - (setq found t)))))) - found)) - -(defcustom TeX-save-query t - "*If non-nil, ask user for permission to save files before starting TeX." - :group 'TeX-commands - :type 'boolean) - -(defun TeX-command-query (name) - "Query the user for a what TeX command to use." - (let* ((default (cond ((if (string-equal name TeX-region) - (TeX-check-files (concat name ".dvi") - (list name) - TeX-file-extensions) - (TeX-save-document (TeX-master-file))) - TeX-command-default) - ((and (eq major-mode 'latex-mode) - (TeX-check-files (concat name ".bbl") - (mapcar 'car - (LaTeX-bibliography-list)) - BibTeX-file-extensions)) - ;; We should check for bst files here as well. - TeX-command-BibTeX) - ((TeX-process-get-variable name - 'TeX-command-next - TeX-command-Show)) - (TeX-command-Show))) - (completion-ignore-case t) - (answer (or TeX-command-force - (completing-read - (concat "Command: (default " default ") ") - TeX-command-list nil t)))) - ;; If the answer "latex" it will not be expanded to "LaTeX" - (setq answer (car-safe (TeX-assoc answer TeX-command-list))) - (if (and answer - (not (string-equal answer ""))) - answer - default))) - -(defvar TeX-command-next nil - "The default command next time TeX-command is invoked.") - - (make-variable-buffer-local 'TeX-command-next) - -(defun TeX-printer-query (&optional command element) - "Query the user for a printer name. -COMMAND is the default command to use if the entry for the printer in -TeX-printer-list does not itself have it specified in the ELEMENT'th -entry." - (or command (setq command TeX-print-command)) - (or element (setq element 1)) - (let ((printer (if TeX-printer-list - (let ((completion-ignore-case t)) - (completing-read (concat "Printer: (default " - TeX-printer-default ") ") - TeX-printer-list)) - ""))) - - (setq printer (or (car-safe (TeX-assoc printer TeX-printer-list)) - printer)) - (if (or (null printer) (string-equal "" printer)) - (setq printer TeX-printer-default) - (setq TeX-printer-default printer)) - - (let ((expansion (let ((entry (assoc printer TeX-printer-list))) - (if (and entry (nth element entry)) - (nth element entry) - command)))) - (if (string-match "%p" printer) - (error "Don't use %s in printer names" "%p")) - (while (string-match "%p" expansion) - (setq expansion (concat (substring expansion 0 (match-beginning 0)) - printer - (substring expansion (match-end 0))))) - expansion))) - -(defun TeX-style-check (styles) - "Check STYLES compared to the current style options." - - (let ((files (TeX-style-list))) - (while (and styles - (not (TeX-member (car (car styles)) files 'string-match))) - (setq styles (cdr styles)))) - (if styles - (nth 1 (car styles)) - "")) - -;;; Command Hooks - -(defvar TeX-after-start-process-function nil - "Hooks to run after starting an asynchronous process. -Used by Japanese TeX to set the coding system.") - -(defcustom TeX-show-compilation nil - "*If non-nil, show output of TeX compilation in other window." - :group 'TeX-commands - :type 'boolean) - -(defun TeX-run-command (name command file) - "Create a process for NAME using COMMAND to process FILE. -Return the new process." - (let ((default TeX-command-default) - (buffer (TeX-process-buffer-name file)) - (dir (TeX-master-directory))) - (TeX-process-check file) ; Check that no process is running - (setq TeX-command-buffer (current-buffer)) - (get-buffer-create buffer) - (set-buffer buffer) - (erase-buffer) - (if dir (cd dir)) - (insert "Running `" name "' on `" file "' with ``" command "''\n") - (setq mode-name name) - (if TeX-show-compilation - (display-buffer buffer) - (message "Type `C-c C-l' to display results of compilation.")) - (setq TeX-parse-function 'TeX-parse-command) - (setq TeX-command-default default) - (setq TeX-sentinel-function - (function (lambda (process name) - (message (concat name ": done."))))) - (if TeX-process-asynchronous - (let ((process (start-process name buffer TeX-shell - TeX-shell-command-option command))) - (if TeX-after-start-process-function - (funcall TeX-after-start-process-function process)) - (TeX-command-mode-line process) - (set-process-filter process 'TeX-command-filter) - (set-process-sentinel process 'TeX-command-sentinel) - (set-marker (process-mark process) (point-max)) - (setq compilation-in-progress (cons process compilation-in-progress)) - process) - (setq mode-line-process ": run") - (set-buffer-modified-p (buffer-modified-p)) - (sit-for 0) ; redisplay - (call-process TeX-shell nil buffer nil - TeX-shell-command-option command)))) - -(defun TeX-run-format (name command file) - "Create a process for NAME using COMMAND to format FILE with TeX." - (let ((buffer (TeX-process-buffer-name file)) - (process (TeX-run-command name command file))) - ;; Hook to TeX debuger. - (save-excursion - (set-buffer buffer) - (TeX-parse-reset) - (setq TeX-parse-function 'TeX-parse-TeX) - (setq TeX-sentinel-function 'TeX-TeX-sentinel) - (if TeX-process-asynchronous - (progn - ;; Updating the mode line. - (setq TeX-current-page "[0]") - (TeX-format-mode-line process) - (set-process-filter process 'TeX-format-filter))) - process))) - -(defun TeX-run-TeX (name command file) - "Create a process for NAME using COMMAND to format FILE with TeX." - (let ((process (TeX-run-format name command file))) - (if TeX-process-asynchronous - process - (TeX-synchronous-sentinel name file process)))) - -(defun TeX-run-LaTeX (name command file) - "Create a process for NAME using COMMAND to format FILE with TeX." - (let ((process (TeX-run-format name command file))) - (setq TeX-sentinel-function 'TeX-LaTeX-sentinel) - (if TeX-process-asynchronous - process - (TeX-synchronous-sentinel name file process)))) - -(defun TeX-run-BibTeX (name command file) - "Create a process for NAME using COMMAND to format FILE with BibTeX." - (let ((process (TeX-run-command name command file))) - (setq TeX-sentinel-function 'TeX-BibTeX-sentinel) - (if TeX-process-asynchronous - process - (TeX-synchronous-sentinel name file process)))) - -(defun TeX-run-compile (name command file) - "Ignore first and third argument, start compile with second argument." - (compile command)) - -(defun TeX-run-shell (name command file) - "Ignore first and third argument, start shell-command with second argument." - (shell-command command) - (if (eq system-type 'ms-dos) - (redraw-display))) - -(defun TeX-run-discard (name command file) - "Start process with second argument, discarding its output." - (process-kill-without-query (start-process (concat name " discard") - nil TeX-shell - TeX-shell-command-option - command))) - -(defun TeX-run-dviout (name command file) - "Call process wbith second argument, discarding its output. With support -for the dviout previewer, especially when used with PC-9801 series." - (if (and (boundp 'dos-machine-type) (eq dos-machine-type 'pc98)) ;if PC-9801 - (send-string-to-terminal "\e[2J")) ; clear screen - (call-process TeX-shell (if (eq system-type 'ms-dos) "con") nil nil - TeX-shell-command-option command) - (if (eq system-type 'ms-dos) - (redraw-display))) - -(defun TeX-run-background (name command file) - "Start process with second argument, show output when and if it arrives." - (let ((dir (TeX-master-directory))) - (set-buffer (get-buffer-create "*TeX background*")) - (if dir (cd dir)) - (erase-buffer) - (let ((process (start-process (concat name " background") - nil TeX-shell - TeX-shell-command-option command))) - (if TeX-after-start-process-function - (funcall TeX-after-start-process-function process)) - (set-process-filter process 'TeX-background-filter) - (process-kill-without-query process)))) - -(defun TeX-run-interactive (name command file) - "Run TeX interactively. -Run command in a buffer (in comint-shell-mode) so that it accepts user -interaction. If you return to the file buffer after the TeX run, -Error parsing on C-x ` should work with a bit of luck." - (require 'comint) - (let ((default TeX-command-default) - (buffer (TeX-process-buffer-name file)) - (process nil) - (dir (TeX-master-directory))) - (TeX-process-check file) ; Check that no process is running - (setq TeX-command-buffer (current-buffer)) - (with-output-to-temp-buffer buffer) - (set-buffer buffer) - (if dir (cd dir)) - (insert "Running `" name "' on `" file "' with ``" command "''\n") - (comint-exec buffer name TeX-shell nil - (list TeX-shell-command-option command)) - (comint-mode) - (setq mode-name name) - (setq TeX-command-default default) - (setq process (get-buffer-process buffer)) - (if TeX-after-start-process-function - (funcall TeX-after-start-process-function process)) - (TeX-command-mode-line process) - (set-process-sentinel process 'TeX-command-sentinel) - (set-marker (process-mark process) (point-max)) - (setq compilation-in-progress (cons process compilation-in-progress)) - (TeX-parse-reset) - (setq TeX-parse-function 'TeX-parse-TeX) - (setq TeX-sentinel-function 'TeX-LaTeX-sentinel))) - -;;; Command Sentinels - -(defun TeX-synchronous-sentinel (name file result) - "Process TeX command output buffer after the process dies." - (let* ((buffer (TeX-process-buffer file))) - (save-excursion - (set-buffer buffer) - - ;; Append post-mortem information to the buffer - (goto-char (point-max)) - (insert "\n" mode-name (if (and result (zerop result)) - " finished" " exited") " at " - (substring (current-time-string) 0 -5)) - (setq mode-line-process ": exit") - - ;; Do command specific actions. - (setq TeX-command-next TeX-command-Show) - (goto-char (point-min)) - (apply TeX-sentinel-function nil name nil) - - ;; Force mode line redisplay soon - (set-buffer-modified-p (buffer-modified-p))))) - -(defun TeX-command-sentinel (process msg) - "Process TeX command output buffer after the process dies." - (let* ((buffer (process-buffer process)) - (name (process-name process))) - (cond ((null (buffer-name buffer)) ; buffer killed - (set-process-buffer process nil) - (set-process-sentinel process nil)) - ((memq (process-status process) '(signal exit)) - (save-excursion - (set-buffer buffer) - - ;; Append post-mortem information to the buffer - (goto-char (point-max)) - (insert "\n" mode-name " " msg) - (forward-char -1) - (insert " at " - (substring (current-time-string) 0 -5)) - (forward-char 1) - - ;; Do command specific actions. - (TeX-command-mode-line process) - (setq TeX-command-next TeX-command-Show) - (goto-char (point-min)) - (apply TeX-sentinel-function process name nil) - - - ;; If buffer and mode line will show that the process - ;; is dead, we can delete it now. Otherwise it - ;; will stay around until M-x list-processes. - (delete-process process) - - ;; Force mode line redisplay soon - (set-buffer-modified-p (buffer-modified-p)))))) - (setq compilation-in-progress (delq process compilation-in-progress))) - - -(defvar TeX-sentinel-function (function (lambda (process name))) - "Hook to cleanup TeX command buffer after temination of PROCESS. -NAME is the name of the process.") - - (make-variable-buffer-local 'TeX-sentinel-function) - -(defun TeX-TeX-sentinel (process name) - "Cleanup TeX output buffer after running TeX." - (if (TeX-TeX-sentinel-check process name) - () - (message (concat name ": formatted " (TeX-current-pages))) - (setq TeX-command-next TeX-command-Show))) - -(defun TeX-current-pages () - ;; String indictating the number of pages formatted. - (cond ((null TeX-current-page) - "some pages.") - ((string-match "[^0-9]1[^0-9]" TeX-current-page) - (concat TeX-current-page " page.")) - (t - (concat TeX-current-page " pages.")))) - -(defun TeX-TeX-sentinel-check (process name) - "Cleanup TeX output buffer after running TeX. -Return nil ifs no errors were found." - (save-excursion - (goto-char (point-max)) - (if (re-search-backward "^Output written on.* (\\([0-9]+\\) page" nil t) - (setq TeX-current-page (concat "{" (TeX-match-buffer 1) "}")))) - (if process (TeX-format-mode-line process)) - (if (re-search-forward "^! " nil t) - (progn - (message (concat name " errors in `" (buffer-name) - "'. Use C-c ` to display.")) - (setq TeX-command-next TeX-command-default) - t) - (setq TeX-command-next TeX-command-Show) - nil)) - -(defun TeX-LaTeX-sentinel (process name) - "Cleanup TeX output buffer after running LaTeX." - (cond ((TeX-TeX-sentinel-check process name)) - ((and (save-excursion - (re-search-forward "^LaTeX Warning: Citation" nil t)) - (let ((current (current-buffer))) - (set-buffer TeX-command-buffer) - (prog1 (and (LaTeX-bibliography-list) - (TeX-check-files (TeX-master-file "bbl") - (TeX-style-list) - (append TeX-file-extensions - BibTeX-file-extensions))) - (set-buffer current)))) - (message (concat "You should run BibTeX to get citations right, " - (TeX-current-pages))) - (setq TeX-command-next TeX-command-BibTeX)) - ((re-search-forward "^LaTeX Warning: Label(s)" nil t) - (message (concat "You should run LaTeX again " - "to get references right, " - (TeX-current-pages))) - (setq TeX-command-next TeX-command-default)) - ((re-search-forward "^LaTeX Warning: Reference" nil t) - (message (concat name ": there were unresolved references, " - (TeX-current-pages))) - (setq TeX-command-next TeX-command-Show)) - ((re-search-forward "^LaTeX Warning: Citation" nil t) - (message (concat name ": there were unresolved citations, " - (TeX-current-pages))) - (setq TeX-command-next TeX-command-Show)) - ((re-search-forward - "^\\(\\*\\* \\)?J?I?p?\\(La\\|Sli\\)TeX\\(2e\\)? \\(Version\\|ver\\.\\|<[0-9/]*>\\)" nil t) - (message (concat name ": successfully formatted " - (TeX-current-pages))) - (setq TeX-command-next TeX-command-Show)) - (t - (message (concat name ": problems after " - (TeX-current-pages))) - (setq TeX-command-next TeX-command-default)))) - -(defun TeX-BibTeX-sentinel (process name) - "Cleanup TeX output buffer after running BibTeX." - (message "You should perhaps run LaTeX again to get citations right.") - (setq TeX-command-next TeX-command-default)) - -;;; Process Control - - -;; This variable is chared with `compile.el'. -(defvar compilation-in-progress nil - "List of compilation processes now running.") - -(or (assq 'compilation-in-progress minor-mode-alist) - (setq minor-mode-alist (cons '(compilation-in-progress " Compiling") - minor-mode-alist))) - -(defun TeX-process-get-variable (name symbol &optional default) - "Return the value in the process buffer for NAME of SYMBOL. - -Return DEFAULT if the process buffer does not exist or SYMBOL is not -defined." - (let ((buffer (TeX-process-buffer name))) - (if buffer - (save-excursion - (set-buffer buffer) - (if (boundp symbol) - (eval symbol) - default)) - default))) - -(defun TeX-process-set-variable (name symbol value) - "Set the variable SYMBOL in the process buffer to VALUE. -Return nil iff no process buffer exist." - (let ((buffer (TeX-process-buffer name))) - (if buffer - (save-excursion - (set-buffer buffer) - (set symbol value) - t) - nil))) - -(defun TeX-process-check (name) - "Check if a process for the TeX document NAME already exist. -If so, give the user the choice of aborting the process or the current -command." - (let ((process (TeX-process name))) - (cond ((null process)) - ((not (eq (process-status process) 'run))) - ((yes-or-no-p (concat "Process `" - (process-name process) - "' for document `" - name - "' running, kill it? ")) - (delete-process process)) - (t - (error "Cannot have two processes for the same document"))))) - -(defun TeX-process-buffer-name (name) - "Return name of AUC TeX buffer associated with the document NAME." - (concat "*" (abbreviate-file-name (expand-file-name name)) " output*")) - -(defun TeX-process-buffer (name) - "Return the AUC TeX buffer associated with the document NAME." - (get-buffer (TeX-process-buffer-name name))) - -(defun TeX-process (name) - "Return AUC TeX process associated with the document NAME." - (and TeX-process-asynchronous - (get-buffer-process (TeX-process-buffer name)))) - -;;; Process Filters - -(defun TeX-command-mode-line (process) - "Format the mode line for a buffer containing output from PROCESS." - (setq mode-line-process (concat ": " - (symbol-name (process-status process)))) - (set-buffer-modified-p (buffer-modified-p))) - -(defun TeX-command-filter (process string) - "Filter to process normal output." - (save-excursion - (set-buffer (process-buffer process)) - (save-excursion - (goto-char (process-mark process)) - (insert-before-markers string) - (set-marker (process-mark process) (point))))) - -(defvar TeX-current-page nil - "The page number currently being formatted, enclosed in brackets.") - - (make-variable-buffer-local 'TeX-current-page) - -(defun TeX-format-mode-line (process) - "Format the mode line for a buffer containing TeX output from PROCESS." - (setq mode-line-process (concat " " TeX-current-page ": " - (symbol-name (process-status process)))) - (set-buffer-modified-p (buffer-modified-p))) - -(defun TeX-format-filter (process string) - "Filter to process TeX output." - (save-excursion - (set-buffer (process-buffer process)) - (save-excursion - (goto-char (process-mark process)) - (insert-before-markers string) - (set-marker (process-mark process) (point))) - (save-excursion - (save-match-data - (if (re-search-backward "\\[[0-9]+\\(\\.[0-9\\.]+\\)?\\]" nil t) - (setq TeX-current-page (TeX-match-buffer 0))))) - (TeX-format-mode-line process))) - -(defvar TeX-parse-function nil - "Function to call to parse content of TeX output buffer.") - (make-variable-buffer-local 'TeX-parse-function) - -(defun TeX-background-filter (process string) - "Filter to process background output." - (let ((old-window (selected-window)) - (pop-up-windows t)) - (pop-to-buffer "*TeX background*") - (goto-char (point-max)) - (insert string) - (select-window old-window))) - - -;;; Active Process - -(defvar TeX-current-process-region-p nil - "This variable is set to t iff the last TeX command is on a region.") - -(defun TeX-active-process () - "Return the active process for the current buffer." - (if TeX-current-process-region-p - (TeX-process (TeX-region-file)) - (TeX-process (TeX-master-file)))) - -(defun TeX-active-buffer () - "Return the buffer of the active process for this buffer." - (if TeX-current-process-region-p - (TeX-process-buffer (TeX-region-file)) - (TeX-process-buffer (TeX-master-file)))) - -(defun TeX-active-master (&optional extension) - "The master file currently being compiled." - (if TeX-current-process-region-p - (TeX-region-file extension) - (TeX-master-file extension))) - -(defvar TeX-command-buffer nil - "The buffer from where the last TeX command was issued.") - -;;; Region File - -(defun TeX-region-create (file region original offset) - "Create a new file named FILE with the string REGION -The region is taken from ORIGINAL starting at line OFFSET. - -The current buffer and master file is searched, in order to ensure -that the TeX header and trailer information is also included. - -The OFFSET is used to provide the debugger with information about the -original file." - (let* (;; We shift buffer a lot, so we must keep track of the buffer - ;; local variables. - (header-end TeX-header-end) - (trailer-start TeX-trailer-start) - - ;; We seach for header and trailer in the master file. - (master-name (TeX-master-file TeX-default-extension)) - (master-buffer (find-file-noselect master-name)) - - ;; Attempt to disable font lock. - (font-lock-defaults-alist nil) - (font-lock-defaults nil) - (font-lock-maximum-size 0) - (font-lock-mode-hook nil) - (font-lock-auto-fontify nil) - (font-lock-mode-enable-list nil) - ;; And insert them into the FILE buffer. - (file-buffer (find-file-noselect file)) - ;; But remember original content. - original-content - - ;; We search for the header from the master file, if it is - ;; not present in the region. - (header (if (string-match header-end region) - "" - (save-excursion - (save-restriction - (set-buffer master-buffer) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - ;; NOTE: We use the local value of - ;; TeX-header-end from the master file. - (if (not (re-search-forward TeX-header-end nil t)) - "" - (re-search-forward "[\r\n]" nil t) - (buffer-substring (point-min) (point))))))))) - - ;; We search for the trailer from the master file, if it is - ;; not present in the region. - (trailer-offset 0) - (trailer (if (string-match trailer-start region) - "" - (save-excursion - (save-restriction - (set-buffer master-buffer) - (save-excursion - (save-restriction - (widen) - (goto-char (point-max)) - ;; NOTE: We use the local value of - ;; TeX-trailer-start from the master file. - (if (not (re-search-backward TeX-trailer-start nil t)) - "" - ;;(beginning-of-line 1) - (re-search-backward "[\r\n]" nil t) - (setq trailer-offset - (count-lines (point-min) (point))) - (buffer-substring (point) (point-max)))))))))) - (save-excursion - (set-buffer file-buffer) - (setq original-content (buffer-string)) - (erase-buffer) - (insert "\\message{ !name(" master-name ")}" - header - "\n\\message{ !name(" original ") !offset(") - (insert (int-to-string (- offset - (count-lines (point-min) (point)))) - ") }\n" - region - "\n\\message{ !name(" master-name ") !offset(") - (insert (int-to-string (- trailer-offset - (count-lines (point-min) (point)))) - ") }\n" - trailer) - (if (string-equal (buffer-string) original-content) - (set-buffer-modified-p nil) - (save-buffer 0))))) - -(defun TeX-region-file (&optional extension nondirectory) - "Return TeX-region file name with EXTENSION. -If optional second argument NONDIRECTORY is nil, do not include -the directory." - (concat (if nondirectory "" (TeX-master-directory)) - (cond ((eq extension t) - (concat TeX-region "." TeX-default-extension)) - (extension - (concat TeX-region "." extension)) - (t - TeX-region)))) - -(defcustom TeX-region "_region_" - "*Base name for temporary file for use with TeX-region." - :group 'TeX-commands - :type 'string) - -;;; Parsing - -;;; - Global Parser Variables - -(defvar TeX-error-point nil - "How far we have parsed until now.") - - (make-variable-buffer-local 'TeX-error-point) - -(defvar TeX-error-file nil - "Stack of files in which errors have occured") - - (make-variable-buffer-local 'TeX-error-file) - -(defvar TeX-error-offset nil - "Add this to any line numbers from TeX. Stack like TeX-error-file.") - - (make-variable-buffer-local 'TeX-error-offset) - -(defun TeX-parse-reset () - "Reset all variables used for parsing TeX output." - (setq TeX-error-point (point-min)) - (setq TeX-error-offset nil) - (setq TeX-error-file nil)) - -;;; - Parsers Hooks - -(defun TeX-parse-command (reparse) - "We can't parse anything but TeX." - (error "I cannot parse %s output, sorry" - (if (TeX-active-process) - (process-name (TeX-active-process)) - "this"))) - -(defun TeX-parse-TeX (reparse) - "Find the next error produced by running TeX. -Prefix by C-u to start from the beginning of the errors. - -If the file occurs in an included file, the file is loaded (if not -already in an Emacs buffer) and the cursor is placed at the error." - - (let ((old-buffer (current-buffer))) - (pop-to-buffer (TeX-active-buffer)) - (if reparse - (TeX-parse-reset)) - (goto-char TeX-error-point) - (TeX-parse-error old-buffer))) - -;;; - Parsing (La)TeX - -(defvar TeX-translate-location-hook nil - "List of functions to be called before showing an error or warning. - -You might want to examine and modify the free variables `file', -`offset', `line', `string', `error', and `context' from this hook.") - -(defun TeX-parse-error (old) - "Goto next error. Pop to OLD buffer if no more errors are found." - (while - (progn - (re-search-forward (concat "\\(" - "^! \\|" - "(\\|" - ")\\|" - "\\'\\|" - "!offset([---0-9]*)\\|" - "!name([^)]*)\\|" - "^.*erfull \\\\.*[0-9]*--[0-9]*\\|" - "^LaTeX Warning: .*[0-9]+\\.$" - "\\)")) - (let ((string (TeX-match-buffer 1))) - - (cond (;; TeX error - (string= string "! ") - (TeX-error) - nil) - - ;; LaTeX warning - ((string-match (concat "\\(" - "^.*erfull \\\\.*[0-9]*--[0-9]*\\|" - "^LaTeX Warning: .*[0-9]+\\.$" - "\\)") - - string) - (TeX-warning string)) - - ;; New file -- Push on stack - ((string= string "(") - (re-search-forward "\\([^()\n \t]*\\)") - (setq TeX-error-file - (cons (TeX-match-buffer 1) TeX-error-file)) - (setq TeX-error-offset (cons 0 TeX-error-offset)) - t) - - ;; End of file -- Pop from stack - ((string= string ")") - (setq TeX-error-file (cdr TeX-error-file)) - (setq TeX-error-offset (cdr TeX-error-offset)) - t) - - ;; Hook to change line numbers - ((string-match "!offset(\\([---0-9]*\\))" string) - (rplaca TeX-error-offset - (string-to-int (substring string - (match-beginning 1) - (match-end 1)))) - t) - - ;; Hook to change file name - ((string-match "!name(\\([^)]*\\))" string) - (rplaca TeX-error-file (substring string - (match-beginning 1) - (match-end 1))) - t) - - ;; No more errors. - (t - (message "No more errors.") - (beep) - (pop-to-buffer old) - nil)))))) - -(defun TeX-error () - "Display an error." - - (let* (;; We need the error message to show the user. - (error (progn - (re-search-forward "\\(.*\\)") - (TeX-match-buffer 1))) - - ;; And the context for the help window. - (context-start (point)) - - ;; And the line number to position the cursor. - (line (if (re-search-forward "l\\.\\([0-9]+\\)" nil t) - (string-to-int (TeX-match-buffer 1)) - 1)) - ;; And a string of the context to search for. - (string (progn - (beginning-of-line) - (re-search-forward " \\(\\([^ \t]*$\\)\\|\\($\\)\\)") - (TeX-match-buffer 1))) - - ;; And we have now found to the end of the context. - (context (buffer-substring context-start (progn - (forward-line 1) - (end-of-line) - (point)))) - ;; We may use these in another buffer. - (offset (car TeX-error-offset) ) - (file (car TeX-error-file))) - - ;; Remember where we was. - (setq TeX-error-point (point)) - - ;; Find the error. - (if (null file) - (error "Error occured after last TeX file closed")) - (run-hooks 'TeX-translate-location-hook) - (find-file-other-window file) - (goto-line (+ offset line)) - (if (not (string= string " ")) - (search-forward string nil t)) - - ;; Explain the error. - (if TeX-display-help - (TeX-help-error error context) - (message (concat "! " error))))) - -(defun TeX-warning (string) - "Display a warning for STRING. -Return nil if we gave a report." - - (let* ((error (concat "** " string)) - - ;; bad-box is nil if this is a "LaTeX Warning" - (bad-box (string-match "^.*erfull \\\\.*[0-9]*--[0-9]*" string)) - ;; line-string: match 1 is beginning line, match 2 is end line - (line-string (if bad-box " \\([0-9]*\\)--\\([0-9]*\\)" - "on input line \\([0-9]*\\)\\.")) - ;; word-string: match 1 is the word - (word-string (if bad-box "[][\\W() ---]\\(\\w+\\)[][\\W() ---]*$" - "`\\(\\w+\\)'")) - - ;; Get error-line (warning) - (line (progn - (re-search-backward line-string) - (string-to-int (TeX-match-buffer 1)))) - (line-end (if bad-box (string-to-int (TeX-match-buffer 2)) - line)) - - ;; Find the context - (context-start (progn (if bad-box (end-of-line) - (beginning-of-line)) - (point))) - - (context (progn - (forward-line 1) - (end-of-line) - (while (equal (current-column) 79) - (forward-line 1) - (end-of-line)) - (buffer-substring context-start (point)))) - - ;; This is where we want to be. - (error-point (point)) - - ;; Now find the error word. - (string (progn - (re-search-backward word-string - context-start t) - (TeX-match-buffer 1))) - - ;; We might use these in another file. - (offset (car TeX-error-offset)) - (file (car TeX-error-file))) - - ;; This is where we start next time. - (goto-char error-point) - (setq TeX-error-point (point)) - - ;; Go back to TeX-buffer - (if TeX-debug-bad-boxes - (progn - (run-hooks 'TeX-translate-location-hook) - (find-file-other-window file) - ;; Find line and string - (goto-line (+ offset line)) - (beginning-of-line 0) - (let ((start (point))) - (goto-line (+ offset line-end)) - (end-of-line) - (search-backward string start t) - (search-forward string nil t)) - ;; Display help - (if TeX-display-help - (TeX-help-error error (if bad-box context (concat "\n" context))) - (message (concat "! " error))) - nil) - t))) - -;;; - Help - -(defun TeX-help-error (error output) - "Print ERROR in context OUTPUT in another window." - - (let ((old-buffer (current-buffer)) - (log-file (TeX-active-master "log")) - (TeX-error-pointer 1)) - - ;; Find help text entry. - (while (not (string-match (car (nth TeX-error-pointer - TeX-error-description-list)) - error)) - (setq TeX-error-pointer (+ TeX-error-pointer 1))) - - (pop-to-buffer (get-buffer-create "*TeX Help*")) - (erase-buffer) - (insert "ERROR: " error - "\n\n--- TeX said ---" - output - "\n--- HELP ---\n" - (save-excursion - (if (and (string= (cdr (nth TeX-error-pointer - TeX-error-description-list)) - "No help available") - (let* ((log-buffer (find-file-noselect log-file))) - (set-buffer log-buffer) - (auto-save-mode nil) - (setq buffer-read-only t) - (goto-line (point-min)) - (search-forward error nil t 1))) - (progn - (re-search-forward "^l.") - (re-search-forward "^ [^\n]+$") - (forward-char 1) - (let ((start (point))) - (re-search-forward "^$") - (concat "From the .log file...\n\n" - (buffer-substring start (point))))) - (cdr (nth TeX-error-pointer - TeX-error-description-list))))) - (goto-char (point-min)) - (pop-to-buffer old-buffer))) - -;;; Error Messages - -(defcustom TeX-error-description-list - '(("Bad \\\\line or \\\\vector argument.*" . -"The first argument of a \\line or \\vector command, which specifies the -slope, is illegal\.") - - ("Bad math environment delimiter.*" . -"TeX has found either a math-mode-starting command such as \\[ or \\( -when it is already in math mode, or else a math-mode-ending command -such as \\) or \\] while in LR or paragraph mode. The problem is caused -by either unmatched math mode delimiters or unbalanced braces\.") - - ("Bad use of \\\\\\\\.*" . -"A \\\\ command appears between paragraphs, where it makes no sense. This -error message occurs when the \\\\ is used in a centering or flushing -environment or else in the scope of a centering or flushing -declaration.") - - ("\\\\begin{[^ ]*} ended by \\\\end{[^ ]*}." . -"LaTeX has found an \\end command that doesn't match the corresponding -\\begin command. You probably misspelled the environment name in the -\\end command, have an extra \\begin, or else forgot an \\end.") - - ("Can be used only in preamble." . -"LaTeX has encountered, after the \\begin{document}, one of the -following commands that should appear only in the preamble: -\\documentstyle, \\nofiles, \\includeonly, \\makeindex, or -\\makeglossary. The error is also caused by an extra \\begin{document} -command.") - - ("Command name [^ ]* already used.*" . -"You are using \\newcommand, \\newenvironment, \\newlength, \\newsavebox, -or \\newtheorem to define a command or environment name that is -already defined, or \\newcounter to define a counter that already -exists. (Defining an environment named gnu automatically defines the -command \\gnu.) You'll have to choose a new name or, in the case of -\\newcommand or \\newenvironment, switch to the \\renew ... command.") - - ("Counter too large." . -"Some object that is numbered with letters, probably an item in a -enumerated list, has received a number greater than 26. Either you're -making a very long list or you've been resetting counter values.") - - ("Environment [^ ]* undefined." . -"LaTeX has encountered a \\begin command for a nonexistent environment. -You probably misspelled the environment name. ") - - ("Float(s) lost." . -"You put a figure or table environment or a \\marginpar command inside a -parbox---either one made with a minipage environment or \\parbox -command, or one constructed by LaTeX in making a footnote, figure, -etc. This is an outputting error, and the offending environment or -command may be quite a way back from the point where LaTeX discovered -the problem. One or more figures, tables, and/or marginal notes have -been lost, but not necessarily the one that caused the error.") - - ("Illegal character in array arg." . -"There is an illegal character in the argument of an array or tabular -environment, or in the second argument of a \\multicolumn command.") - - ("Missing \\\\begin{document}." . -"LaTeX produced printed output before encountering a \\begin{document} -command. Either you forgot the \\begin{document} command or there is -something wrong in the preamble. The problem may be a stray character -or an error in a declaration---for example, omitting the braces around -an argument or forgetting the \\ in a command name.") - - ("Missing p-arg in array arg.*" . -"There is a p that is not followed by an expression in braces in the -argument of an array or tabular environment, or in the second argument -of a \\multicolumn command.") - - ("Missing @-exp in array arg." . -"There is an @ character not followed by an @-expression in the -argument of an array or tabular environment, or in the second argument -of a \\multicolumn command.") - - ("No such counter." . -"You have specified a nonexistent counter in a \\setcounter or -\\addtocounter command. This is probably caused by a simple typing -error. However, if the error occurred while a file with the extension -aux is being read, then you probably used a \\newcounter command -outside the preamble.") - - ("Not in outer par mode." . -"You had a figure or table environment or a \\marginpar command in math -mode or inside a parbox.") - - ("\\\\pushtabs and \\\\poptabs don't match." . -"LaTeX found a \\poptabs with no matching \\pushtabs, or has come to the -\\end{tabbing} command with one or more unmatched \\pushtabs commands.") - - ("Something's wrong--perhaps a missing \\\\item." . -"The most probable cause is an omitted \\item command in a list-making -environment. It is also caused by forgetting the argument of a -thebibliography environment.") - - ("Tab overflow." . -"A \\= command has exceeded the maximum number of tab stops that LaTeX -permits.") - - ("There's no line here to end." . -"A \\newline or \\\\ command appears between paragraphs, where it makes no -sense. If you're trying to ``leave a blank line'', use a \\vspace -command.") - - ("This may be a LaTeX bug." . -"LaTeX has become thoroughly confused. This is probably due to a -previously detected error, but it is possible that you have found an -error in LaTeX itself. If this is the first error message produced by -the input file and you can't find anything wrong, save the file and -contact the person listed in your Local Guide.") - - ("Too deeply nested." . -"There are too many list-making environments nested within one another. -How many levels of nesting are permitted may depend upon what computer -you are using, but at least four levels are provided, which should be -enough.") - - ("Too many unprocessed floats." . -"While this error can result from having too many \\marginpar commands -on a page, a more likely cause is forcing LaTeX to save more figures -and tables than it has room for. When typesetting its continuous -scroll, LaTeX saves figures and tables separately and inserts them as -it cuts off pages. This error occurs when LaTeX finds too many figure -and/or table environments before it is time to cut off a page, a -problem that is solved by moving some of the environments farther -towards the end of the input file. The error can also be caused by a -``logjam''---a figure or table that cannot be printed causing others -to pile up behind it, since LaTeX will not print figures or tables out -of order. The jam can be started by a figure or table that either is -too large to fit on a page or won't fit where its optional placement -argument says it must go. This is likely to happen if the argument -does not contain a p option.") - - ("Undefined tab position." . -"A \\>, \\+, \\-, or \\< command is trying to go to a nonexistent tab -position---one not defined by a \\= command.") - - ("\\\\< in mid line." . -"A \\< command appears in the middle of a line in a tabbing environment. -This command should come only at the beginning of a line.") - - ("Counter too large." . -"Footnotes are being ``numbered'' with letters or footnote symbols and -LaTeX has run out of letters or symbols. This is probably caused by -too many \\thanks commands.") - - ("Double subscript." . -"There are two subscripts in a row in a mathematical -formula---something like x_{2}_{3}, which makes no sense.") - - ("Double superscript." . -"There are two superscripts in a row in a mathematical -formula---something like x^{2}^{3}, which makes no sense.") - - ("Extra alignment tab has been changed to \\\\cr." . -"There are too many separate items (column entries) in a single row of -an array or tabular environment. In other words, there were too many & -'s before the end of the row. You probably forgot the \\\\ at the end of -the preceding row.") - - ("Extra \\}, or forgotten \\$." . -"The braces or math mode delimiters don't match properly. You probably -forgot a {, \\[, \\(, or $.") - - ("Font [^ ]* not loaded: Not enough room left." . -"The document uses more fonts than TeX has room for. If different parts -of the document use different fonts, then you can get around the -problem by processing it in parts.") - - ("I can't find file `.*'." . -"TeX can't find a file that it needs. If the name of the missing file -has the extension tex, then it is looking for an input file that you -specified---either your main file or another file inserted with an -\\input or \\include command. If the missing file has the extension sty -, then you have specified a nonexistent document style or style -option.") - - ("Illegal parameter number in definition of .*" . -"This is probably caused by a \\newcommand, \\renewcommand, -\\newenvironment, or \\renewenvironment command in which a # is used -incorrectly. A # character, except as part of the command name \\#, -can be used only to indicate an argument parameter, as in #2, which -denotes the second argument. This error is also caused by nesting one -of the above four commands inside another, or by putting a parameter -like #2 in the last argument of a \\newenvironment or \\renewenvironment -command.") - - ("Illegal unit of measure ([^ ]* inserted)." . -"If you just got a - - ! Missing number, treated as zero. - -error, then this is part of the same problem. If not, it means that -LaTeX was expecting a length as an argument and found a number -instead. The most common cause of this error is writing 0 instead of -something like 0in for a length of zero, in which case typing return -should result in correct output. However, the error can also be caused -by omitting a command argument.") - - ("Misplaced alignment tab character \\&." . -"The special character &, which should be used only to separate items -in an array or tabular environment, appeared in ordinary text. You -probably meant to type \\&.") - - ("Missing control sequence inserted." . -"This is probably caused by a \\newcommand, \\renewcommand, \\newlength, -or \\newsavebox command whose first argument is not a command name.") - - ("Missing number, treated as zero." . -"This is usually caused by a LaTeX command expecting but not finding -either a number or a length as an argument. You may have omitted an -argument, or a square bracket in the text may have been mistaken for -the beginning of an optional argument. This error is also caused by -putting \\protect in front of either a length command or a command such -as \\value that produces a number.") - - ("Missing [{}] inserted." . -"TeX has become confused. The position indicated by the error locator -is probably beyond the point where the incorrect input is.") - - ("Missing \\$ inserted." . -"TeX probably found a command that can be used only in math mode when -it wasn't in math mode. Remember that unless stated otherwise, all -the commands of Section can be used only in math mode. TeX is not in -math mode when it begins processing the argument of a box-making -command, even if that command is inside a math environment. This error -also occurs if TeX encounters a blank line when it is in math mode.") - - ("Not a letter." . -"Something appears in the argument of a \\hyphenation command that -doesn't belong there.") - - ("Paragraph ended before [^ ]* was complete." . -"A blank line occurred in a command argument that shouldn't contain -one. You probably forgot the right brace at the end of an argument.") - - ("\\\\[^ ]*font [^ ]* is undefined .*" . -"These errors occur when an uncommon font is used in math mode---for -example, if you use a \\sc command in a formula inside a footnote, -calling for a footnote-sized small caps font. This problem is solved -by using a \\load command.") - - ("Font .* not found." . -"You requested a family/series/shape/size combination that is totally -unknown. There are two cases in which this error can occur: - 1) You used the \\size macro to select a size that is not available. - 2) If you did not do that, go to your local `wizard' and - complain fiercely that the font selection tables are corrupted!") - - ("TeX capacity exceeded, sorry .*" . -"TeX has just run out of space and aborted its execution. Before you -panic, remember that the least likely cause of this error is TeX not -having the capacity to process your document. It was probably an -error in your input file that caused TeX to run out of room. The -following discussion explains how to decide whether you've really -exceeded TeX's capacity and, if so, what to do. If the problem is an -error in the input, you may have to use the divide and conquer method -described previously to locate it. LaTeX seldom runs out of space on a -short input file, so if running it on the last few pages before the -error indicator's position still produces the error, then there's -almost certainly something wrong in the input file. - -The end of the error indicator tells what kind of space TeX ran out -of. The more common ones are listed below, with an explanation of -their probable causes. - -buffer size -=========== -Can be caused by too long a piece of text as the argument -of a sectioning, \\caption, \\addcontentsline, or \\addtocontents -command. This error will probably occur when the \\end{document} is -being processed, but it could happen when a \\tableofcontents, -\\listoffigures, or \\listoftables command is executed. To solve this -problem, use a shorter optional argument. Even if you're producing a -table of contents or a list of figures or tables, such a long entry -won't help the reader. - -exception dictionary -==================== -You have used \\hyphenation commands to give TeX -more hyphenation information than it has room for. Remove some of the -less frequently used words from the \\hyphenation commands and insert -\\- commands instead. - -hash size -========= -Your input file defines too many command names and/or uses -too many cross-ref- erencing labels. - -input stack size -================ -This is probably caused by an error in a command -definition. For example, the following command makes a circular -definition, defining \\gnu in terms of itself: - - \\newcommand{\\gnu}{a \\gnu} % This is wrong! - -When TeX encounters this \\gnu command, it will keep chasing its tail -trying to figure out what \\gnu should produce, and eventually run out -of ``input stack''. - -main memory size -================ -This is one kind of space that TeX can run out of when processing a -short file. There are three ways you can run TeX out of main memory -space: (1) defining a lot of very long, complicated commands, (2) -making an index or glossary and having too many \\index or \\glossary -commands on a single page, and (3) creating so complicated a page of -output that TeX can't hold all the information needed to generate it. -The solution to the first two problems is obvious: define fewer -commands or use fewer \\index and \\glossary commands. The third problem -is nastier. It can be caused by large tabbing, tabular, array, and -picture environments. TeX's space may also be filled up with figures -and tables waiting for a place to go. To find out if you've really -exceeded TeX's capacity in this way, put a \\clearpage command in your -input file right before the place where TeX ran out of room and try -running it again. If it doesn't run out of room with the \\clearpage -command there, then you did exceed TeX's capacity. If it still runs -out of room, then there's probably an error in your file. If TeX is -really out of room, you must give it some help. Remember that TeX -processes a complete paragraph before deciding whether to cut the -page. Inserting a \\newpage command in the middle of the paragraph, -where TeX should break the page, may save the day by letting TeX write -the current page before processing the rest of the paragraph. (A -\\pagebreak command won't help.) If the problem is caused by -accumulated figures and tables, you can try to prevent them from -accumulating---either by moving them further towards the end of the -document or by trying to get them to come out sooner. If you are -still writing the document, simply add a \\clearpage command and forget -about the problem until you're ready to produce the final version. -Changes to the input file are likely to make the problem go away. - -pool size -========= -You probably used too many cross-ref-erencing \\labels and/or defined -too many new command names. More precisely, the labels and command -names that you define have too many characters, so this problem can be -solved by using shorter names. However, the error can also be caused -by omitting the right brace that ends the argument of either a counter -command such as \\setcounter, or a \\newenvironment or \\newtheorem -command. - -save size -========= -This occurs when commands, environments, and the scopes of -declarations are nested too deeply---for example, by having the -argument of a \\multiput command contain a picture environment that in -turn has a \\footnotesize declaration whose scope contains a \\multiput -command containing a ....") - - ("Text line contains an invalid character." . -"The input contains some strange character that it shouldn't. A mistake -when creating the file probably caused your text editor to insert this -character. Exactly what could have happened depends upon what text -editor you used. If examining the input file doesn't reveal the -offending character, consult the Local Guide for suggestions.") - - ("Undefined control sequence." . -"TeX encountered an unknown command name. You probably misspelled the -name. If this message occurs when a LaTeX command is being processed, -the command is probably in the wrong place---for example, the error -can be produced by an \\item command that's not inside a list-making -environment. The error can also be caused by a missing \\documentstyle -command.") - - ("Use of [^ ]* doesn't match its definition." . -"It's probably one of the picture-drawing commands, and you have used -the wrong syntax for specifying an argument. If it's \\@array that -doesn't match its definition, then there is something wrong in an -@-expression in the argument of an array or tabular -environment---perhaps a fragile command that is not \\protect'ed.") - - ("You can't use `macro parameter character \\#' in [^ ]* mode." . -"The special character # has appeared in ordinary text. You probably -meant to type \\#.") - - ("Overfull \\\\hbox .*" . -"Because it couldn't find a good place for a line break, TeX put more -on this line than it should.") - - ("Overfull \\\\vbox .*" . -"Because it couldn't find a good place for a page break, TeX put more -on the page than it should. ") - - ("Underfull \\\\hbox .*" . -"Check your output for extra vertical space. If you find some, it was -probably caused by a problem with a \\\\ or \\newline command---for -example, two \\\\ commands in succession. This warning can also be -caused by using the sloppypar environment or \\sloppy declaration, or -by inserting a \\linebreak command.") - - ("Underfull \\\\vbox .*" . -"TeX could not find a good place to break the page, so it produced a -page without enough text on it. ") - -;; New list items should be placed here -;; -;; ("err-regexp" . "context") -;; -;; the err-regexp item should match anything - - (".*" . "No help available")) ; end definition -"A list of the form (\"err-regexp\" . \"context\") used by function -\\{TeX-help-error} to display help-text on an error message or warning. -err-regexp should be a regular expression matching the error message -given from TeX/LaTeX, and context should be some lines describing that -error" - :group 'TeX-output - :type '(repeat (cons :tag "Entry" - (regexp :tag "Match") - (string :format "Description:\n%v")))) - -(provide 'tex-buf) - -;;; tex-buf.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/auctex/tex-info.el --- a/lisp/auctex/tex-info.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,394 +0,0 @@ -;;; tex-info.el - Support for editing TeXinfo source. -;; -;; Maintainer: Per Abrahamsen -;; Version: 9.7p - -;; Copyright (C) 1993, 1994, 1997 Per Abrahamsen -;; -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Code: - -(require 'tex) -(condition-case nil ;Lucid is not providing. - (require 'texinfo) - (error)) - -;;; Environments: - -(defvar TeXinfo-environment-list - '(("cartouche") - ("defcv") - ("deffn") ("defivar") ("defmac") - ("defmethod") ("defop") ("defopt") ("defspec") ("deftp") - ("deftypefn") ("deftypefun") ("deftypevar") ("deftypevr") - ("defun") ("defvar") ("defvr") ("description") ("display") - ("enumerate") ("example") ("ifset") ("ifclear") ("flushleft") - ("flushright") ("format") ("ftable") ("iftex") ("itemize") - ("lisp") ("quotation") ("smallexample") ("smalllisp") ("table") - ("tex") ("titlepage") ("vtable")) - "Alist of TeXinfo environments.") - -(defconst texinfo-environment-regexp - ;; Overwrite version from `texinfo.el'. - (concat "^@\\(" - (mapconcat 'car TeXinfo-environment-list "\\|") - "\\|end\\)") - "Regexp for environment-like TeXinfo list commands. -Subexpression 1 is what goes into the corresponding `@end' statement.") - -(defun TeXinfo-insert-environment (env) - "Insert TeXinfo environment ENV. -When called interactively, prompt for an environment." - (interactive (list (completing-read "Environment: " - TeXinfo-environment-list))) - (insert "@" env "\n\n@end " env "\n") - (if (null (cdr-safe (assoc "defcv" TeXinfo-environment-list))) - (forward-line -2) - ;; apply arguments - )) - -;;; Keymap: - -(defvar TeXinfo-mode-map nil - "Keymap for TeXinfo mode.") - -(if TeXinfo-mode-map - () - (setq TeXinfo-mode-map (make-sparse-keymap)) - - ;; From texinfo.el - - ;; bindings for updating nodes and menus - (define-key TeXinfo-mode-map "\C-c\C-um" 'texinfo-master-menu) - (define-key TeXinfo-mode-map "\C-c\C-u\C-m" 'texinfo-make-menu) - (define-key TeXinfo-mode-map "\C-c\C-u\C-n" 'texinfo-update-node) - (define-key TeXinfo-mode-map "\C-c\C-u\C-e" 'texinfo-every-node-update) - (define-key TeXinfo-mode-map "\C-c\C-u\C-a" 'texinfo-all-menus-update) - - ;; From TeX-mode - - ;; Standard - (define-key TeXinfo-mode-map "\177" 'backward-delete-char-untabify) - (define-key TeXinfo-mode-map "\C-c}" 'up-list) - (define-key TeXinfo-mode-map "\C-c#" 'TeX-normal-mode) - (define-key TeXinfo-mode-map "\C-c\C-n" 'TeX-normal-mode) - (define-key TeXinfo-mode-map "\C-c?" 'describe-mode) - - ;; From tex.el - (define-key TeXinfo-mode-map "\C-c{" 'TeX-insert-braces) - (define-key TeXinfo-mode-map "\C-c\C-f" 'TeX-font) - (define-key TeXinfo-mode-map "\C-c\C-m" 'TeX-insert-macro) - (define-key TeXinfo-mode-map "\e\t" 'TeX-complete-symbol) - - (define-key TeXinfo-mode-map "\C-c;" 'TeX-comment-region) - (define-key TeXinfo-mode-map "\C-c%" 'TeX-comment-paragraph) - (define-key TeXinfo-mode-map "\C-c'" 'TeX-comment-paragraph) ;*** Old way - (define-key TeXinfo-mode-map "\C-c:" 'TeX-un-comment-region) ;*** Old way - (define-key TeXinfo-mode-map "\C-c\"" 'TeX-un-comment) ;*** Old way - - ;; From tex-buf.el - (define-key TeXinfo-mode-map "\C-c\C-c" 'TeX-command-master) - (define-key TeXinfo-mode-map "\C-c\C-k" 'TeX-kill-job) - (define-key TeXinfo-mode-map "\C-c\C-l" 'TeX-recenter-output-buffer) - (define-key TeXinfo-mode-map "\C-c^" 'TeX-home-buffer) - (define-key TeXinfo-mode-map "\C-c`" 'TeX-next-error) - (define-key TeXinfo-mode-map "\C-c\C-w" 'TeX-toggle-debug-boxes) - - ;; From tex.cpl.el - - ;; Simulating LaTeX-mode - - (define-key TeXinfo-mode-map "\C-c\C-e" 'TeXinfo-insert-environment) - (define-key TeXinfo-mode-map "\C-c\n" 'texinfo-insert-@item) - (define-key TeXinfo-mode-map "\C-c\C-s" 'texinfo-insert-@node) - (define-key TeXinfo-mode-map "\C-c]" 'texinfo-insert-@end)) - -(easy-menu-define TeXinfo-mode-menu - TeXinfo-mode-map - "Menu used in TeXinfo mode." - (list "TeXinfo" - ["Environment..." TeXinfo-insert-environment t] - ["Node..." texinfo-insert-@node t] - ["Macro..." TeX-insert-macro t] - ["Complete" TeX-complete-symbol t] - ["Item" texinfo-insert-@item t] - (list "Insert Font" - ["Emphasize" (TeX-font nil ?\C-e) :keys "C-c C-f C-e"] - ["Bold" (TeX-font nil ?\C-b) :keys "C-c C-f C-b"] - ["Typewriter" (TeX-font nil ?\C-t) :keys "C-c C-f C-t"] - ["Small Caps" (TeX-font nil ?\C-c) :keys "C-c C-f C-c"] - ["Italic" (TeX-font nil ?\C-i) :keys "C-c C-f C-i"] - ["Sample" (TeX-font nil ?\C-s) :keys "C-c C-f C-s"] - ["Roman" (TeX-font nil ?\C-r) :keys "C-c C-f C-r"]) - (list "Change Font" - ["Emphasize" (TeX-font t ?\C-e) :keys "C-u C-c C-f C-e"] - ["Bold" (TeX-font t ?\C-b) :keys "C-u C-c C-f C-b"] - ["Typewriter" (TeX-font t ?\C-t) :keys "C-u C-c C-f C-t"] - ["Small Caps" (TeX-font t ?\C-c) :keys "C-u C-c C-f C-c"] - ["Italic" (TeX-font t ?\C-i) :keys "C-u C-c C-f C-i"] - ["Sample" (TeX-font t ?\C-s) :keys "C-u C-c C-f C-s"] - ["Roman" (TeX-font t ?\C-r) :keys "C-u C-c C-f C-r"]) - "-" - ["Save Document" TeX-save-document t] - ["Next Error" TeX-next-error t] - (list "TeX Output" - ["Kill Job" TeX-kill-job t] - ["Debug Bad Boxes" TeX-toggle-debug-boxes - :style toggle :selected TeX-debug-bad-boxes ] - ["Switch to original file" TeX-home-buffer t] - ["Recenter Output Buffer" TeX-recenter-output-buffer t]) - "--" - ["Create Master Menu" texinfo-master-menu t] - ["Create Menu" texinfo-make-menu t] - ["Update Node" texinfo-update-node t] - ["Update Every Node" texinfo-every-node-update t] - ["Update All Menus" texinfo-all-menus-update t] - ["Uncomment Region" TeX-un-comment-region t] - ["Comment Region" TeX-comment-region t] - ["Switch to Master file" TeX-home-buffer t] - ["Submit bug report" TeX-submit-bug-report t] - ["Reset Buffer" TeX-normal-mode t] - ["Reset AUC TeX" (TeX-normal-mode t) :keys "C-u C-c C-n"])) - -(easy-menu-define TeXinfo-command-menu - TeXinfo-mode-map - "Menu used in TeXinfo mode for external commands." - (append '("Command") - (mapcar 'TeX-command-menu-entry TeX-command-list))) - -(defvar TeXinfo-font-list - '((?\C-b "@b{" "}") - (?\C-c "@sc{" "}") - (?\C-e "@emph{" "}") - (?\C-i "@i{" "}") - (?\C-r "@r{" "}") - (?\C-s "@samp{" "}") - (?\C-t "@t{" "}") - (?s "@strong{" "}") - (?\C-f "@file{" "}") - (?\C-d "@dfn{" "}") - (?\C-v "@var{" "}") - (?k "@key{" "}") - (?\C-k "@kbd{" "}") - (?c "@code{" "}") - (?C "@cite{" "}")) - "Font commands used in TeXinfo mode. See `TeX-font-list'.") - -;;; Mode: - -;;; Do not ;;;###autoload because of conflict with standard tex-mode.el. -(defun texinfo-mode () - "Major mode for editing files of input for TeXinfo. - -Special commands: -\\{TeXinfo-mode-map} - -Entering TeXinfo mode calls the value of text-mode-hook, -then the value of TeX-mode-hook, and then the value of -TeXinfo-mode-hook." - (interactive) - ;; Mostly stolen from texinfo.el - (setq mode-name "TeXinfo") - (setq major-mode 'texinfo-mode) - (use-local-map TeXinfo-mode-map) - (set-syntax-table texinfo-mode-syntax-table) - (make-local-variable 'page-delimiter) - (setq page-delimiter - (concat - "^@node [ \t]*[Tt]op\\|^@\\(" - texinfo-chapter-level-regexp - "\\)")) - (make-local-variable 'require-final-newline) - (setq require-final-newline t) - (make-local-variable 'indent-tabs-mode) - (setq indent-tabs-mode nil) - (make-local-variable 'paragraph-separate) - (setq paragraph-separate - (concat "\b\\|^@[a-zA-Z]*[ \n]\\|" paragraph-separate)) - (make-local-variable 'paragraph-start) - (setq paragraph-start - (concat "\b\\|^@[a-zA-Z]*[ \n]\\|" paragraph-start)) - (make-local-variable 'fill-column) - (setq fill-column 72) - (make-local-variable 'comment-start) - (setq comment-start "@c ") - (make-local-variable 'comment-start-skip) - (setq comment-start-skip "@c +\\|@comment +") - (make-local-variable 'words-include-escapes) - (setq words-include-escapes t) - (if (not (boundp 'texinfo-imenu-generic-expression)) - ;; This was introduced in 19.30. - () - (make-local-variable 'imenu-generic-expression) - (setq imenu-generic-expression texinfo-imenu-generic-expression)) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(texinfo-font-lock-keywords t)) - (if (not (boundp 'texinfo-section-list)) - ;; This was included in 19.31. - () - (make-local-variable 'outline-regexp) - (setq outline-regexp - (concat "@\\(" - (mapconcat 'car texinfo-section-list "\\>\\|") - "\\>\\)")) - (make-local-variable 'outline-level) - (setq outline-level 'texinfo-outline-level)) - - ;; Mostly AUC TeX stuff - (easy-menu-add TeXinfo-command-menu TeXinfo-mode-map) - (easy-menu-add TeXinfo-mode-menu TeXinfo-mode-map) - (make-local-variable 'TeX-command-current) - (setq TeX-command-current 'TeX-command-master) - - (setq TeX-default-extension "texi") - (make-local-variable 'TeX-esc) - (setq TeX-esc "@") - - (make-local-variable 'TeX-auto-regexp-list) - (setq TeX-auto-regexp-list 'TeX-auto-empty-regexp-list) - (make-local-variable 'TeX-auto-update) - (setq TeX-auto-update t) - - (setq TeX-command-default "TeX") - (setq TeX-header-end "%**end") - (setq TeX-trailer-start (regexp-quote (concat TeX-esc "bye"))) - - (make-local-variable 'TeX-complete-list) - (setq TeX-complete-list - (list (list "@\\([a-zA-Z]*\\)" 1 'TeX-symbol-list nil) - (list "" TeX-complete-word))) - - (make-local-variable 'TeX-font-list) - (setq TeX-font-list TeXinfo-font-list) - - (TeX-add-symbols - '("appendix" "Title") - '("appendixsec" "Title") - '("appendixsection" "Title") - '("appendixsubsec" "Title") - '("appendixsubsubsec" "Title") - '("asis") - '("author" "Author") - '("b" "Text") - '("bullet") - '("bye") - '("c" "Comment") - '("center" "Line-of-text") - '("chapheading" "Title") - '("chapter" "Title") - '("cindex" "Entry") - '("cite" "Reference") - '("clear" "Flag") - '("code" "Sample-code") - '("comment" "Comment") - '("contents") - '("copyright") - '("defcodeindex" "Index-name") - '("defindex" "Index-name") - '("dfn" "Term") - '("dmn" "Dimension") - '("dots") - '("emph" "Text") - '("equiv") - '("error") - '("evenfooting" TeXinfo-lrc-argument-hook) - '("evenheading" TeXinfo-lrc-argument-hook) - '("everyfooting" TeXinfo-lrc-argument-hook) - '("everyheading" TeXinfo-lrc-argument-hook) - '("exdent" "Line-of-text") - '("expansion") - '("file" "Filename") - '("finalout") - '("findex" "Entry") - '("footnote" "Text-of-footnote") - '("footnotestyle" "Style") - '("group") - '("heading" "Title") - '("headings" "On-off-single-double") - '("i" "Text") - '("ignore") - '("include" "Filename") - '("inforef" "Node-name" "Info-file-name") - '("item") - '("itemx") - '("kbd" "Keyboard-characters") - '("key" "Key-name") - '("kindex" "Entry") - '("majorheading" "Title") - '("menu") - '("minus") - '("need" "N") - '("node" "Name" "Next" "Previous" "Up") - '("noindent") - '("oddfooting" TeXinfo-lrc-argument-hook) - '("oddheading" TeXinfo-lrc-argument-hook) - '("page") - '("paragraphindent" "Indent") - '("pindex" "Entry") - '("point") - '("print") - '("printindex" "Index-name") - '("pxref" "Node-name") - '("r" "Text") - '("ref" "Node-name") - '("refill") - '("result") - '("samp" "Text") - '("sc" "Text") - '("section" "Title") - '("set" "Flag") - '("setchapternewpage" "On-off-odd") - '("setfilename" "Info-file-name") - '("settitle" "Title") - '("shortcontents") - '("smallbook") - '("sp" "N") - '("strong" "Text") - '("subheading" "Title") - '("subsection" "Title") - '("subsubheading" "Title") - '("subsubsection" "Title") - '("subtitle" "Title") - '("summarycontents") - '("syncodeindex" "From-index" "Into-index") - '("synindex" "From-index" "Into-index") - '("t" "Text") - '("TeX") - '("thischapter") - '("thischaptername") - '("thisfile") - '("thispage") - '("tindex" "Entry") - '("title" "Title") - '("titlefont" "Text") - '("titlepage") - '("today") - '("top" "Title") - '("unnumbered" "Title") - '("unnumberedsec" "Title") - '("unnumberedsubsec" "Title") - '("unnumberedsubsubsec" "Title") - '("value" "Flag") - '("var" "Metasyntactic-variable") - '("vindex" "Entry") - '("vskip" "Amount") - '("w" "Text")) - - (run-hooks 'text-mode-hook 'TeXinfo-mode-hook)) - -(provide 'tex-info) - -;;; tex-info.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/auctex/tex-jp.el --- a/lisp/auctex/tex-jp.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1197 +0,0 @@ -;;; tex-jp.el - Support for Japanese TeX. - -;;; Code: - -(require 'latex) - -;;; Customization - -(setq TeX-format-list - (append '(("JLATEX" japanese-latex-mode - "\\\\\\(\\\\documentstyle[^%\n]*{j\\|\\\\documentclass[^%\n]*{j\\)") - ("JTEX" japanese-plain-tex-mode - "-- string likely in Japanese TeX --")) - TeX-format-list)) - -(setq TeX-command-list - (append (list (list "jTeX" "jtex '\\nonstopmode\\input %t'" - 'TeX-run-TeX nil t) - (list "pTeX" "ptex '\\nonstopmode\\input %t'" - 'TeX-run-TeX nil t) - (list "jBibTeX" "jbibtex %s" 'TeX-run-BibTeX nil nil)) - TeX-command-list)) - -(setq LaTeX-command-style - (append (if (string-equal LaTeX-version "2") - '(("^ams" "amsjlatex") - ("^jslides$" "jslitex") - ("^j-?\\(article\\|report\\|book\\)$" "jlatex")) - '(("^j-\\(article\\|report\\|book\\)$" "jlatex") - ("^j\\(article\\|report\\|book\\)$" "platex") - ("." "jlatex"))) - LaTeX-command-style)) - -(setcdr (assoc "%l" TeX-expand-list) - (list 'TeX-style-check LaTeX-command-style)) - -(defvar japanese-TeX-error-messages t - "If non-nil, explain TeX error messages in Japanese.") - -(if (or (boundp 'MULE) - (featurep 'mule)) - (if (string-match "XEmacs" emacs-version) - (progn - (defvar TeX-japanese-process-input-coding-system - (find-coding-system 'euc-japan) - "TeX-process' coding system with standard input.") - (defvar TeX-japanese-process-output-coding-system - (find-coding-system 'junet) - "TeX-process' coding system with standard output.")) - (progn - (defvar TeX-japanese-process-input-coding-system *euc-japan* - "TeX-process' coding system with standard input.") - (defvar TeX-japanese-process-output-coding-system *junet* - "TeX-process' coding system with standard output.")))) - -(if (boundp 'NEMACS) - (defvar TeX-process-kanji-code 2 - "TeX-process' kanji code with standard I/O. -0:No-conversion 1:Shift-JIS 2:JIS 3:EUC/AT&T/DEC")) - -(defvar japanese-LaTeX-default-style "j-article" - "*Default when creating new Japanese documents.") -(make-variable-buffer-local 'japanese-LaTeX-default-style) - -(defvar japanese-LaTeX-style-list - '(("book") - ("article") - ("letter") - ("slides") - ("report") - ("jbook") - ("j-book") - ("jarticle") - ("j-article") - ("jslides") - ("jreport") - ("j-report")) - "*List of Japanese document styles.") -(make-variable-buffer-local 'japanese-LaTeX-style-list) - -;;; Coding system - -(if (boundp 'MULE) - (setq TeX-after-start-process-function - (function (lambda (process) - (set-process-coding-system - process - TeX-japanese-process-input-coding-system - TeX-japanese-process-output-coding-system))))) -(if (boundp 'NEMACS) - (setq TeX-after-start-process-function - (function - (lambda (process) - (set-process-kanji-code process TeX-process-kanji-code))))) - -(if (and (string-match "XEmacs" emacs-version) - (featurep 'mule)) - (setq TeX-after-start-process-function - (function (lambda (process) - (set-process-input-coding-system - process - TeX-japanese-process-input-coding-system) - (set-process-output-coding-system - process - TeX-japanese-process-output-coding-system))))) - -;;; Japanese Parsing - -(if (or (boundp 'MULE) - (featurep 'mule)) -(progn - -(defconst LaTeX-auto-regexp-list - (append - '(("\\\\newcommand{?\\\\\\(\\([a-zA-Z]\\|\\cj\\)+\\)}?\\[\\([0-9]+\\)\\]\ -\\[\\([^\]\\\\\n\r]+\\)\\]" - (1 3 4) LaTeX-auto-optional) - ("\\\\newcommand{?\\\\\\(\\([a-zA-Z]\\|\\cj\\)+\\)}?\\[\\([0-9]+\\)\\]" - (1 3) LaTeX-auto-arguments) - ("\\\\newcommand{?\\\\\\(\\([a-zA-Z]\\|\\cj\\)+\\)}?" 1 TeX-auto-symbol) - ("\\\\newenvironment{?\\(\\([a-zA-Z]\\|\\cj\\)+\\)}?\\[\\([0-9]+\\)\\]" - (1 3) LaTeX-auto-env-args) - ("\\\\newenvironment{?\\(\\([a-zA-Z]\\|\\cj\\)+\\)}?" 1 LaTeX-auto-environment) - ("\\\\newtheorem{\\(\\([a-zA-Z]\\|\\cj\\)+\\)}" 1 LaTeX-auto-environment) - ("\\\\input{\\(\\.*[^#}%\\\\\\.\n\r]+\\)\\(\\.[^#}%\\\\\\.\n\r]+\\)?}" - 1 TeX-auto-file) - ("\\\\include{\\(\\.*[^#}%\\\\\\.\n\r]+\\)\\(\\.[^#}%\\\\\\.\n\r]+\\)?}" - 1 TeX-auto-file) - ("\\\\usepackage\\(\\[[^\]\\\\]*\\]\\)?\ -{\\(\\([^#}\\\\\\.%]\\|%[^\n\r]*[\n\r]\\)+\\)}" - (2) LaTeX-auto-style) - ("\\\\bibitem{\\(\\([a-zA-Z]\\|\\cj\\)[^, \n\r\t%\"#'()={}]*\\)}" 1 LaTeX-auto-bibitem) - ("\\\\bibitem\\[[^][\n\r]+\\]{\\(\\([a-zA-Z]\\|\\cj\\)[^, \n\r\t%\"#'()={}]*\\)}" - 1 LaTeX-auto-bibitem) - ("\\\\bibliography{\\([^#}\\\\\n\r]+\\)}" 1 LaTeX-auto-bibliography)) - LaTeX-auto-label-regexp-list - LaTeX-auto-minimal-regexp-list) - "List of regular expression matching common LaTeX macro definitions.") - -(defconst plain-TeX-auto-regexp-list - '(("\\\\def\\\\\\(\\([a-zA-Z]\\|\\cj\\)+\\)[^a-zA-Z@]" 1 - TeX-auto-symbol-check) - ("\\\\let\\\\\\(\\([a-zA-Z]\\|\\cj\\)+\\)[^a-zA-Z@]" 1 - TeX-auto-symbol-check) - ("\\\\font\\\\\\(\\([a-zA-Z]\\|\\cj\\)+\\)[^a-zA-Z@]" 1 TeX-auto-symbol) - ("\\\\chardef\\\\\\(\\([a-zA-Z]\\|\\cj\\)+\\)[^a-zA-Z@]" 1 TeX-auto-symbol) - ("\\\\new\\(count|dimen|muskip|skip\\)\\\\\\(\\([a-z]\\|\\cj\\)+\\)[^a-zA-Z@]" - 2 TeX-auto-symbol) - ("\\\\newfont{?\\\\\\(\\([a-zA-Z]\\|\\cj\\)+\\)}?" 1 TeX-auto-symbol) - ("\\\\typein\\[\\\\\\(\\([a-zA-Z]\\|\\cj\\)+\\)\\]" 1 TeX-auto-symbol) - ("\\\\input +\\(\\.*[^#%\\\\\\.\n\r]+\\)\\(\\.[^#%\\\\\\.\n\r]+\\)?" - 1 TeX-auto-file) - ("\\\\mathchardef\\\\\\(\\([a-zA-Z]\\|\\cj\\)+\\)[^a-zA-Z@]" 1 - TeX-auto-symbol)) - "List of regular expression matching common LaTeX macro definitions.") - -(defconst BibTeX-auto-regexp-list - '(("@[Ss][Tt][Rr][Ii][Nn][Gg]" 1 ignore) - ("@[a-zA-Z]+[{(][ \t]*\\(\\([a-zA-Z]\\|\\cj\\)[^, \n\r\t%\"#'()={}]*\\)" - 1 LaTeX-auto-bibitem)) - "List of regexp-list expressions matching BibTeX items.") - -)) - -(if (boundp 'NEMACS) -(progn - -(defconst LaTeX-auto-regexp-list - (append - '(("\\\\newcommand{?\\\\\\(\\([a-zA-Z]\\|\\z\\)+\\)}?\\[\\([0-9]+\\)\\]\ -\\[\\([^\]\\\\\n\r]+\\)\\]" - (1 3 4) LaTeX-auto-optional) - ("\\\\newcommand{?\\\\\\(\\([a-zA-Z]\\|\\z\\)+\\)}?\\[\\([0-9]+\\)\\]" - (1 3) LaTeX-auto-arguments) - ("\\\\newcommand{?\\\\\\(\\([a-zA-Z]\\|\\z\\)+\\)}?" 1 TeX-auto-symbol) - ("\\\\newenvironment{?\\(\\([a-zA-Z]\\|\\z\\)+\\)}?\\[\\([0-9]+\\)\\]" - (1 3) LaTeX-auto-env-args) - ("\\\\newenvironment{?\\(\\([a-zA-Z]\\|\\z\\)+\\)}?" 1 LaTeX-auto-environment) - ("\\\\newtheorem{\\(\\([a-zA-Z]\\|\\z\\)+\\)}" 1 LaTeX-auto-environment) - ("\\\\input{\\(\\.*[^#}%\\\\\\.\n\r]+\\)\\(\\.[^#}%\\\\\\.\n\r]+\\)?}" - 1 TeX-auto-file) - ("\\\\include{\\(\\.*[^#}%\\\\\\.\n\r]+\\)\\(\\.[^#}%\\\\\\.\n\r]+\\)?}" - 1 TeX-auto-file) - ("\\\\usepackage\\(\\[[^\]\\\\]*\\]\\)?\ -{\\(\\([^#}\\\\\\.%]\\|%[^\n\r]*[\n\r]\\)+\\)}" - (2) LaTeX-auto-style) - ("\\\\bibitem{\\(\\([a-zA-Z]\\|\\z\\)[^, \n\r\t%\"#'()={}]*\\)}" 1 LaTeX-auto-bibitem) - ("\\\\bibitem\\[[^][\n\r]+\\]{\\(\\([a-zA-Z]\\|\\z\\)[^, \n\r\t%\"#'()={}]*\\)}" - 1 LaTeX-auto-bibitem) - ("\\\\bibliography{\\([^#}\\\\\n\r]+\\)}" 1 LaTeX-auto-bibliography)) - LaTeX-auto-label-regexp-list - LaTeX-auto-minimal-regexp-list) - "List of regular expression matching common LaTeX macro definitions.") - -(defconst plain-TeX-auto-regexp-list - '(("\\\\def\\\\\\(\\([a-zA-Z]\\|\\z\\)+\\)[^a-zA-Z@]" 1 - TeX-auto-symbol-check) - ("\\\\let\\\\\\(\\([a-zA-Z]\\|\\z\\)+\\)[^a-zA-Z@]" 1 - TeX-auto-symbol-check) - ("\\\\font\\\\\\(\\([a-zA-Z]\\|\\z\\)+\\)[^a-zA-Z@]" 1 TeX-auto-symbol) - ("\\\\chardef\\\\\\(\\([a-zA-Z]\\|\\z\\)+\\)[^a-zA-Z@]" 1 TeX-auto-symbol) - ("\\\\new\\(count|dimen|muskip|skip\\)\\\\\\(\\([a-z]\\|\\z\\)+\\)[^a-zA-Z@]" - 2 TeX-auto-symbol) - ("\\\\newfont{?\\\\\\(\\([a-zA-Z]\\|\\z\\)+\\)}?" 1 TeX-auto-symbol) - ("\\\\typein\\[\\\\\\(\\([a-zA-Z]\\|\\z\\)+\\)\\]" 1 TeX-auto-symbol) - ("\\\\input +\\(\\.*[^#%\\\\\\.\n\r]+\\)\\(\\.[^#%\\\\\\.\n\r]+\\)?" - 1 TeX-auto-file) - ("\\\\mathchardef\\\\\\(\\([a-zA-Z]\\|\\z\\)+\\)[^a-zA-Z@]" 1 - TeX-auto-symbol)) - "List of regular expression matching common LaTeX macro definitions.") - -(defconst BibTeX-auto-regexp-list - '(("@[Ss][Tt][Rr][Ii][Nn][Gg]" 1 ignore) - ("@[a-zA-Z]+[{(][ \t]*\\(\\([a-zA-Z]\\|\\z\\)[^, \n\r\t%\"#'()={}]*\\)" - 1 LaTeX-auto-bibitem)) - "List of regexp-list expressions matching BibTeX items.") - -)) - -(defconst TeX-auto-full-regexp-list - (append LaTeX-auto-regexp-list plain-TeX-auto-regexp-list) - "Full list of regular expression matching TeX macro definitions.") - -;;; Japanese TeX modes - -(defvar japanese-TeX-mode nil - "Flag to determine if Japanese initialization is needed.") - -(add-hook 'plain-TeX-mode-hook 'japanese-plain-tex-mode-initialization) - -;;;###autoload -(defun japanese-plain-tex-mode () - "Major mode for editing files of input for Japanese plain TeX. -Set japanese-TeX-mode to t, and enters plain-tex-mode." - (interactive) - (setq japanese-TeX-mode t) - (plain-tex-mode)) - -(defun japanese-plain-tex-mode-initialization () - "Japanese plain-TeX specific initializations." - (if japanese-TeX-mode - (setq TeX-command-default "jTeX"))) - -(add-hook 'LaTeX-mode-hook 'japanese-latex-mode-initialization) - -;;;###autoload -(defun japanese-latex-mode () - "Major mode for editing files of input for Japanese plain TeX. -Set japanese-TeX-mode to t, and enters latex-mode." - (interactive) - (setq japanese-TeX-mode t) - (latex-mode)) - -(defun japanese-latex-mode-initialization () - "Japanese LaTeX specific initializations." - (if japanese-TeX-mode - (progn - (setq LaTeX-default-style japanese-LaTeX-default-style) - (setq LaTeX-style-list japanese-LaTeX-style-list) - (setq TeX-command-BibTeX "jBibTeX") - (setq japanese-TeX-mode nil)))) - -;;; MULE and NEMACS paragraph filling. - -(if (boundp 'MULE) -(if (string-lessp emacs-version "19") -(defun LaTeX-fill-region-as-paragraph (from to &optional justify-flag) - "Fill region as one paragraph: break lines to fit fill-column. -Prefix arg means justify too. -From program, pass args FROM, TO and JUSTIFY-FLAG." - (interactive "*r\nP") - (save-restriction - (goto-char from) - (skip-chars-forward "\n") - (LaTeX-indent-line) - (beginning-of-line) - (narrow-to-region (point) to) - (setq from (point)) - - ;; Delete whitespace at beginning of line from every line, - ;; except the first line. - (goto-char (point-min)) - (forward-line 1) - (while (not (eobp)) - (delete-horizontal-space) - (forward-line 1)) - - ;; Ignore the handling routine related with `fill-prefix'. - - ;; from is now before the text to fill, - ;; but after any fill prefix on the first line. - - ;; Make sure sentences ending at end of line get an extra space. - (goto-char from) - ;;; patch by S.Tomura 88-Jun-30 - ;;$B!cE}9g!d(B - ;; . + CR ==> . + SPC + SPC - ;; . + SPC + CR + ==> . + SPC + - ;;(while (re-search-forward "[.?!][])""']*$" nil t) - ;; (insert ? )) - (while (re-search-forward "[.?!][])\"']*$" nil t) - (if (eobp) - nil - ;; replace CR by two spaces. - (delete-char 1) ; delete newline - (insert " "))) - ;; end of patch - ;; The change all newlines to spaces. - ;; patched by S.Tomura 87-Dec-7 - ;; bug fixed by S.Tomura 88-May-25 - ;; modified by S.Tomura 88-Jun-21 - ;;(subst-char-in-region from (point-max) ?\n ?\ ) - ;; modified by K.Handa 92-Mar-2 - ;; Spacing is not necessary for characters of no word-separator. - ;; The regexp word-across-newline is used for this check. - (if (not (stringp word-across-newline)) - (subst-char-in-region from (point-max) ?\n ?\ ) - (goto-char from) - (end-of-line) - (while (not (eobp)) - (delete-char 1) - (if (eobp) nil ; 92.6.30 by K.Handa - (if (not (looking-at word-across-newline)) - (progn - (forward-char -1) - (if (and (not (eq (following-char) ? )) - (not (looking-at word-across-newline))) - (progn - (forward-char 1) - (insert ? )) - (forward-char 1)))) - (end-of-line)))) - ;; After the following processing, there's two spaces at end of sentence - ;; and single space at end of line within sentence. - ;; end of patch - ;; Flush excess spaces, except in the paragraph indentation. - (goto-char from) - (skip-chars-forward " \t") - (while (re-search-forward " *" nil t) - (delete-region - (+ (match-beginning 0) - (if (save-excursion - (skip-chars-backward " ])\"'") - (memq (preceding-char) '(?. ?? ?!))) - 2 1)) - (match-end 0))) - (goto-char (point-max)) - (delete-horizontal-space) - (insert " ") - (goto-char (point-min)) - (let ((prefixcol 0) - ;; patch by K.Handa 92-Mar-2 - (re-break-point (concat "[ \t\n]\\|" word-across-newline)) - ;; end of patch - ) - (while (not (eobp)) - (move-to-column (1+ fill-column)) - (if (eobp) - nil - ;; patched by S.Tomura 87-Jun-2 - ;; Big change by K.Handa 92-Mar-2 - ;; Move back to start of word. - ;; (skip-chars-backward "^ \n") - ;; (if (if (zerop prefixcol) (bolp) (>= prefixcol (current-column))) - ;; ;; Move back over whitespace before the word. - ;; (skip-chars-forward "^ \n") - ;; ;; Normally, move back over the single space between the words. - ;; (forward-char -1)) - - ;; At first, find breaking point at the left of fill-column, - ;; but after kinsoku-shori, the point may be right of fill-column. - ;; 92.4.15 by K.Handa -- re-search-backward will back to prev line. - ;; 92.4.27 by T.Enami -- We might have gone back too much... - (let ((p (point)) ch) - (re-search-backward re-break-point nil 'mv) - (setq ch (following-char)) - (if (or (= ch ? ) (= ch ?\t)) - (skip-chars-backward " \t") - (forward-char 1) - (if (<= p (point)) - (forward-char -1)))) - (kinsoku-shori) - ;; Check if current column is at the right of prefixcol. - ;; If not, find break-point at the right of fill-column. - ;; This time, force kinsoku-shori-nobashi. - (if (>= prefixcol (current-column)) - (progn - (move-to-column (1+ fill-column)) - ;; 92.4.15 by K.Handa -- suppress error in re-search-forward - (re-search-forward re-break-point nil t) - (forward-char -1) - (kinsoku-shori-nobashi)))) - ;; end of patch S.Tomura - - ;; Replace all whitespace here with one newline. - ;; Insert before deleting, so we don't forget which side of - ;; the whitespace point or markers used to be on. - ;; patch by S. Tomura 88-Jun-20 - ;; 92.4.27 by K.Handa - (skip-chars-backward " \t") - (if mc-flag - ;; $B!cJ,3d!d(B WAN means chars which match word-across-newline. - ;; (0) | SPC + SPC* --> NL - ;; (1) WAN | SPC + SPC* --> WAN + SPC + NL - ;; (2) | SPC + SPC* + WAN --> SPC + NL + WAN - ;; (3) '.' | SPC + nonSPC --> '.' + SPC + NL + nonSPC - ;; (4) '.' | SPC + SPC --> '.' + NL - ;; (5) | SPC* --> NL - (let ((start (point)) ; 92.6.30 by K.Handa - (ch (following-char))) - (if (and (= ch ? ) - (progn ; not case (0) -- 92.6.30 by K.Handa - (skip-chars-forward " \t") - (not (eobp))) - (or - (progn ; case (1) - (goto-char start) - (forward-char -1) - (looking-at word-across-newline)) - (progn ; case (2) - (goto-char start) - (skip-chars-forward " \t") - (and (not (eobp)) - (looking-at word-across-newline))) - (progn ; case (3) - (goto-char (1+ start)) - (and (not (eobp)) - (/= (following-char) ? ) - (progn - (skip-chars-backward " ])\"'") - (memq (preceding-char) '(?. ?? ?!))))))) - ;; We should keep one SPACE before NEWLINE. (1),(2),(3) - (goto-char (1+ start)) - ;; We should delete all SPACES around break point. (4),(5) - (goto-char start)))) - ;; end of patch - (if (equal (preceding-char) ?\\) - (insert ? )) - (insert ?\n) - (delete-horizontal-space) - - ;; Ignore the handling routine related with `fill-prefix'. - - (LaTeX-indent-line) - (setq prefixcol (current-column)) - ;; Justify the line just ended, if desired. - (and justify-flag (not (eobp)) - (progn - (forward-line -1) - (justify-current-line) - (forward-line 1))) - ) - (goto-char (point-max)) - (delete-horizontal-space)))) -(defun LaTeX-fill-region-as-paragraph (from to &optional justify-flag) - "Fill region as one paragraph: break lines to fit fill-column.\n\ -Prefix arg means justify too.\n\ -From program, pass args FROM, TO and JUSTIFY-FLAG." - (interactive "*r\nP") - (save-restriction - (goto-char from) - (skip-chars-forward " \n") - (LaTeX-indent-line) - (beginning-of-line) - (narrow-to-region (point) to) - (setq from (point)) - - ;; Delete whitespace at beginning of line from every line, - ;; except the first line. - (goto-char (point-min)) - (forward-line 1) - (while (not (eobp)) - (delete-horizontal-space) - (forward-line 1)) - - ;; from is now before the text to fill, - ;; but after any fill prefix on the first line. - - ;; Make sure sentences ending at end of line get an extra space. - (goto-char from) - ;; patch by S.Tomura 88-Jun-30 - ;;$B!cE}9g!d(B - ;; . + CR ==> . + SPC + SPC - ;; . + SPC + CR + ==> . + SPC + - ;; (while (re-search-forward "[.?!][])\"']*$" nil t) - ;; (insert ? )) - (while (re-search-forward "[.?!][])}\"']*$" nil t) - (if (eobp) - nil - ;; replace CR by two spaces. - ;; insert before delete to preserve marker. - (insert " ") - ;; delete newline - (delete-char 1))) - ;; end of patch - ;; The change all newlines to spaces. - ;; (subst-char-in-region from (point-max) ?\n ?\ ) - ;; patched by S.Tomura 87-Dec-7 - ;; bug fixed by S.Tomura 88-May-25 - ;; modified by S.Tomura 88-Jun-21 - ;; modified by K.Handa 92-Mar-2 - ;; Spacing is not necessary for characters of no word-separator. - ;; The regexp word-across-newline is used for this check. - (if (not (stringp word-across-newline)) - (subst-char-in-region from (point-max) ?\n ?\ ) - ;; - ;; WAN +NL+WAN --> WAN + WAN - ;; not(WAN)+NL+WAN --> not(WAN) + WAN - ;; WAN +NL+not(WAN) --> WAN + not(WAN) - ;; SPC +NL+not(WAN) --> SPC + not(WAN) - ;; not(WAN)+NL+not(WAN) --> not(WAN) + SPC + not(WAN) - ;; - (goto-char from) - (end-of-line) - (while (not (eobp)) - ;; 92.8.26 , 92.8.30 by S. Tomura - - ;; Insert SPC only when point is between nonWAN. Insert - ;; before deleting to preserve marker if possible. - (if (or (prog2 ; check following char. - (forward-char) ; skip newline - (or (eobp) - (looking-at word-across-newline)) - (forward-char -1)) - (prog2 ; check previous char. - (forward-char -1) - (or (eq (following-char) ?\ ) - (looking-at word-across-newline)) - (forward-char))) - nil - (insert ?\ )) - (delete-char 1) ; delete newline - (end-of-line))) - ;; Flush excess spaces, except in the paragraph indentation. - (goto-char from) - (skip-chars-forward " \t") - (while (re-search-forward " *" nil t) - (delete-region - (+ (match-beginning 0) - (if (save-excursion - (skip-chars-backward " ])\"'") - (memq (preceding-char) '(?. ?? ?!))) - 2 1)) - (match-end 0))) - (goto-char (point-max)) - (delete-horizontal-space) - (insert " ") - (goto-char (point-min)) - (let ((prefixcol 0) linebeg - ;; patch by K.Handa 92-Mar-2 - (re-break-point (concat "[ \n]\\|" word-across-newline)) - ;; end of patch - ) - (while (not (eobp)) - (setq linebeg (point)) - (move-to-column (1+ fill-column)) - (if (eobp) - nil - ;;(skip-chars-backward "^ \n") - (fill-move-backward-to-break-point re-break-point) - (if sentence-end-double-space - (while (and (> (point) (+ linebeg 2)) - (eq (preceding-char) ?\ ) - (not (eq (following-char) ?\ )) - (eq (char-after (- (point) 2)) ?\.)) - (forward-char -2) - (fill-move-backward-to-break-point re-break-point linebeg))) - (kinsoku-shori) - (if (if (zerop prefixcol) - (save-excursion - (skip-chars-backward " " linebeg) - (bolp)) - (>= prefixcol (current-column))) - ;; Keep at least one word even if fill prefix exceeds margin. - ;; This handles all but the first line of the paragraph. - ;; Meanwhile, don't stop at a period followed by one space. - (let ((first t)) - (move-to-column prefixcol) - (while (and (not (eobp)) - (or first - (and (not (bobp)) - sentence-end-double-space - (save-excursion (forward-char -1) - (and (looking-at "\\. ") - (not (looking-at "\\. "))))))) - (skip-chars-forward " ") - ;; (skip-chars-forward "^ \n") - (fill-move-forward-to-break-point re-break-point) - (setq first nil))) - ;; Normally, move back over the single space between the words. - (if (eq (preceding-char) ? ) - (forward-char -1)))) - (if mc-flag - ;; $B!cJ,3d!d(B WAN means chars which match word-across-newline. - ;; (0) | SPC + SPC* --> NL - ;; (1) WAN | SPC + SPC* --> WAN + SPC + NL - ;; (2) | SPC + SPC* + WAN --> SPC + NL + WAN - ;; (3) '.' | SPC + nonSPC --> '.' + SPC + NL + nonSPC - ;; (4) '.' | SPC + SPC --> '.' + NL - ;; (5) | SPC* --> NL - (let ((start (point)) ; 92.6.30 by K.Handa - (ch (following-char))) - (if (and (= ch ? ) - (progn ; not case (0) -- 92.6.30 by K.Handa - (skip-chars-forward " \t") - (not (eobp))) - (or - (progn ; case (1) - (goto-char start) - (forward-char -1) - (looking-at word-across-newline)) - (progn ; case (2) - (goto-char start) - (skip-chars-forward " \t") - (and (not (eobp)) - (looking-at word-across-newline) - ;; never leave space after the end of sentence - (not (fill-end-of-sentence-p)))) - (progn ; case (3) - (goto-char (1+ start)) - (and (not (eobp)) - (/= (following-char) ? ) - (fill-end-of-sentence-p))))) - ;; We should keep one SPACE before NEWLINE. (1),(2),(3) - (goto-char (1+ start)) - ;; We should delete all SPACES around break point. (4),(5) - (goto-char start)))) - ;; end of patch - (delete-horizontal-space) - (if (equal (preceding-char) ?\\) - (insert ? )) - (insert ?\n) - (LaTeX-indent-line) - (setq prefixcol (current-column)) - (and justify-flag (not (eobp)) - (progn - (forward-line -1) - (justify-current-line) - (forward-line 1))) - ) - (goto-char (point-max)) - (delete-horizontal-space)))))) - -(if (boundp 'NEMACS) -(defun LaTeX-fill-region-as-paragraph (from to &optional justify-flag) - "Fill region as one paragraph: break lines to fit fill-column. -Prefix arg means justify too. -From program, pass args FROM, TO and JUSTIFY-FLAG." - (interactive "r\nP") - (save-restriction - (goto-char from) - (skip-chars-forward " \n") - (LaTeX-indent-line) - (beginning-of-line) - (narrow-to-region (point) to) - (setq from (point)) - - ;; Delete whitespace at beginning of line from every line, - ;; except the first line. - (goto-char (point-min)) - (forward-line 1) - (while (not (eobp)) - (delete-horizontal-space) - (forward-line 1)) - - ;; from is now before the text to fill, - ;; but after any fill prefix on the first line. - - ;; Make sure sentences ending at end of line get an extra space. - (goto-char from) - ;;; patch by S.Tomura 88-Jun-30 - ;;$B!cE}9g!d(B - ;; . + CR ==> . + SPC + SPC - ;; . + SPC + CR + ==> . + SPC + - ;;(while (re-search-forward "[.?!][])""']*$" nil t) - ;; (insert ? )) - (while (re-search-forward "[.?!][])""']*$" nil t) - (if (eobp) - nil - (delete-char 1) - (insert " "))) ;; replace CR by two spaces. - ;; end of patch - ;; The change all newlines to spaces. - ;; patched by S.Tomura 87-Dec-7 - ;; bug fixed by S.Tomura 88-May-25 - ;; modified by S.Tomura 88-Jun-21 - ;;(subst-char-in-region from (point-max) ?\n ?\ ) - ;;$BF|K\8l$N8l$N8e$K$O6uGr$O$J$$!#(B - (goto-char from) - (end-of-line) - (while (not (eobp)) - (delete-char 1) - (if (and (< ? (preceding-char)) ;; + SPC + CR + X ==> + SPC + X - (< (preceding-char) 128) - (<= ? (following-char)) - (< (following-char) 128)) - (insert ?\ )) - (end-of-line)) - ;; $Bl9g$K$O(Bfill-column$B$h$jBg$-$/$J$k$3$H$,$"$k!#(B - (or (>= fill-column (current-column)) (backward-char 1)) - ;; end of patch - (if (eobp) - nil - ;; patched by S.Tomura 87-Jun-2 - ;;(skip-chars-backward "^ \n") - ;;(if (if (zerop prefixcol) (bolp) (>= prefixcol (current-column))) - ;; (skip-chars-forward "^ \n") - ;; (forward-char -1))) - ;; $B86B'$H$7$F(Bfill-column$B$h$j:8B&$KJ,3dE@$rC5$9!#(B - ;; Find a point to break lines - (skip-chars-backward " \t") ;; skip SPC and TAB - (if (or (<= 128 (preceding-char)) - (<= 128 (following-char)) ;; 88-Aug-25 - (= (following-char) ? ) - (= (following-char) ?\t)) - (kinsoku-shori) - (if(re-search-backward "[ \t\n]\\|\\z" ;; 89-Nov-17 - (point-min) (point-min)) - (forward-char 1)) - (skip-chars-backward " \t") - (kinsoku-shori)) - ;; prifixcol$B$h$j1&B&$KJ,3dE@$rC5$9!#(B - ;; $B$3$N>l9g$OJ,3dE@$O(Bfill-column$B$h$j1&B&$K$J$k!#(B - (if (>= prefixcol (current-column)) - (progn - (move-to-column prefixcol) - (if (re-search-forward "[ \t]\\|\\z" ;; 89-Nov-17 - (point-max) (point-max)) - (backward-char 1)) - (skip-chars-backward " \t") - (kinsoku-shori) - ;; $B$=$l$bBLL\$J$iJ,3d$rD|$a$k!#(B - (if (>= prefixcol (current-column)) (goto-char (point-max)))))) - ;; end of patch S.Tomura - ;; patch by S. Tomura 88-Jun-20 - ;;(delete-horizontal-space) - ;;$B!cJ,3d!d(B - ;; $BA43Q(B | SPC + SPC$B!v(B --> $BA43Q(B + SPC + CR - ;; | SPC + SPC* + $BA43Q(B --> SPC + CR + $BA43Q(B - ;; . | SPC + SPC + --> . + CR - ;; . | SPC + nonSPC --> . + SPC + CR + nonSPC - ;; - ;; . | $BH>3Q(B --> $BJ,3d$7$J$$(B - ;; . | $BA43Q(B --> $BJ,3d$7$J$$(B - (if (not kanji-flag) (delete-horizontal-space) - (let ((start) (end)) - (skip-chars-backward " \t") - (setq start (point)) - (skip-chars-forward " \t") - (setq end (point)) - (delete-region start end) - (if (and (not - (and (save-excursion - (skip-chars-backward " ])\"'") - (memq (preceding-char) '(?. ?? ?!))) - (= end (+ start 2)))) - (or (and (or (<= 128 (preceding-char)) - (<= 128 (following-char))) - (< start end) - (not (eobp))) - (and (memq (preceding-char) '(?. ?? ?!)) - (= (1+ start) end) - (not (eobp))))) - (insert ? )))) - ;; end of patch - (if (equal (preceding-char) ?\\) - (insert ? )) - (insert ?\n) - (LaTeX-indent-line) - (setq prefixcol (current-column)) - (and justify-flag (not (eobp)) - (progn - (forward-line -1) - (justify-current-line) - (forward-line 1))) - ) - (goto-char (point-max)) - (delete-horizontal-space))))) - -;;; Support for various self-insert-command - -(cond ((fboundp 'can-n-egg-self-insert-command) - (fset 'tex-jp-self-insert-command 'can-n-egg-self-insert-command)) - ((fboundp 'egg-self-insert-command) - (fset 'tex-jp-self-insert-command 'egg-self-insert-command)) - ((fboundp 'canna-self-insert-command) - (fset 'tex-jp-self-insert-command 'canna-self-insert-command)) - (t - (fset 'tex-jp-self-insert-command 'self-insert-command))) - -(defun TeX-insert-punctuation () - "Insert point or comma, cleaning up preceding space." - (interactive) - (if (TeX-looking-at-backward "\\\\/\\(}+\\)" 50) - (replace-match "\\1" t)) - (call-interactively 'tex-jp-self-insert-command)) - -;;; Error Messages - -(if japanese-TeX-error-messages - (setq TeX-error-description-list - '(("Bad \\\\line or \\\\vector argument.*" . -"$B@~$N79$-$r;XDj$9$k!$(B\\line$B$^$?$O(B\\vector$B$N:G=i$N0z?t$,IT@5$G$9!%(B") - - ("Bad math environment delimiter.*" . -"$B?t<0%b!<%ICf$G?t<0%b!<%I3+;O%3%^%s%I(B\\[$B$^$?$O(B\\($B!$$^$?$O!$?t<0%b!<%I30$G(B -$B?t<0%b!<%I=*N;%3%^%s%I(B\\[$B$^$?$O(B\\($B$r(BTeX$B$,8+$D$1$^$7$?!%$3$NLdBj$O!$?t<0%b!<(B -$B%I$N%G%j%_%?$,%^%C%A$7$F$$$J$+$C$?$j!$3g8L$N%P%i%s%9$,$H$l$F$$$J$+$C$?$j$9(B -$B$k$?$a$K@8$8$^$9!%(B") - - ("Bad use of \\\\\\\\.*" . -"\\\\$B%3%^%s%I$,%Q%i%0%i%UCf$K$"$j$^$7$?!%$3$N;H$$$+$?$OL50UL#$G$9!%(B -$B$3$N%(%i!<%a%C%;!<%8$O(B\\\\$B$,(Bcentering$B4D6-$d(Bflushing$B4D6-$G;H$o$l$?(B -$B;~!$$"$k$$$O(Bcentering/flushing$B@k8@$,M-8z$J$H$3$m$G;H$o$l$?;~$K@8$8$^$9!%(B") - - ("\\\\begin{[^ ]*} ended by \\\\end{[^ ]*}." . -"$BBP1~$9$k(B\\begin$BL?Na$N$J$$(B\\end$BL?Na$r(BLaTeX$B$,8+$D$1$^$7$?!%(B\\end$BL?Na$N4D(B -$B6-L>$r4V0c$($?$+!$M>J,$J(B\\begin$BL?Na$,$"$k$+!$(B\\end$BL?Na$r$o$9$l$?$+$N$$$:(B -$B$l$+$G$7$g$&!%(B") - - ("Can be used only in preamble." . -"$B%W%j%"%s%V%k$G$7$+;H$($J$$(B\\documentstyle$B!&(B\\nofiles$B!&(B\\includeonly -\\makeindex$B!&(B\\makeglossary$B$N$&$A$N$$$:$l$+$,(B\\begin{document}$B$h$j$b(B -$B8e$G;H$o$l$F$$$k$N$r(BLaTeX$B$,8!=P$7$^$7$?!%$3$N%(%i!<$O(B\\begin{document} -$B$,M>J,$K$"$C$?;~$K$b@8$8$^$9!%(B") - - ("Command name [^ ]* already used.*" . -"$B$9$G$KDj5A$5$l$F$$$kL?NaL>$^$?$O4D6-L>$KBP$7$F(B\\newcommand$B!&(B -\\newenvironment$B!&(B\\newlength$B!&(B\\newsavebox$B!&(B\\newtheorem$B$N$&$A$N$$$:(B -$B$l$+$rA0$NL?Na$,<+F0(B -$BE*$KDj5A$5$l$k$N$G!$4{$KB8:_$9$k4D6-$HF1L>$NL?Na$ODj5A$G$-$^$;$s(B)$B!%?7(B -$B$7$$L>A0$r9M$($k$+!$(B\\newcommand$B$+(B\\newenvironment$B$N>l9g$J$iBP1~$9$k(B -\\renew...$BL?Na$r;H$o$J$1$l$P$J$j$^$;$s!%(B") - - ("Counter too large." . -"$BJ8;z$G=g=xIU$1$5$l$?$b$N!$$?$V$sHV9fIU$1$5$l$?%j%9%H4D6-$N%i%Y%k$,!$(B -26$B$h$j$bBg$-$$HV9f$ro$KD9$$%j%9%H$r;H$C$F$$$k$+!$(B -$B%+%&%s%?$r:F@_Dj$7$F$7$^$C$?$+$N$$$:$l$+$G$7$g$&!%(B") - - ("Environment [^ ]* undefined." . -"$BDj5A$5$l$F$$$J$$4D6-$KBP$9$k(B\\begin$BL?Na$r(BLaTeX$B$,8+$D$1$^$7$?!%$*$=$i$/(B -$B4D6-L>$r4V0c$($?$N$G$7$g$&!%(B") - - ("Float(s) lost." . -"parbox$B$N$J$+$K(Bfigure$B4D6-!&(Btable$B4D6-$^$?$O(B\\marginpar$BL?Na$,$"$j$^$7$?(B -\($B$J$*!$(Bparbox$B$O(Bminipage$B4D6-$+(B\\parbox$BL?Na$K$h$C$F:n$i$l$k$+!$5SCm$d?^(B -$B$J$I$KBP$7$F(BLaTeX$B$,@8@.$9$k$b$N$G$9(B\)$B!%$3$l$O=PNO;~$N%(%i!<$J$N$G!$860x(B -$B$H$J$C$F$$$k4D6-$"$k$$$OL?Na$O!$(BLaTeX$B$,LdBj$rH/8+$7$?>l=j$h$j$b$@$$$V(B -$B$sA0$K$"$k2DG=@-$,$"$j$^$9!%=PNO$5$l$F$$$J$$?^!&I=!&K5Cm$J$I$,$$$/$D$+(B -$B$"$k$+$b$7$l$^$;$s$,!$$=$l$i$,860x$G$"$k$H$O8B$j$^$;$s!%(B") - - ("Illegal character in array arg." . -"array$B4D6-$^$?$O(Btabular$B4D6-$N0z?t!$$^$?$O(B\\multicolumn$BL?Na$NBh(B2$B0z?t(B -$B$NCf$KIT@5$JJ8;z$,$"$j$^$7$?!%(B") - - ("Missing \\\\begin{document}." . -"\\begin{document}$BL?Na$h$jA0$K(BLaTeX$B$,=PNO$r9T$J$C$F$7$^$$$^$7$?!%(B -\\begin{document}$BL?Na$rK:$l$?$+!$%W%j%"%s%V%k$K2?$+4V0c$$$,$"$k$N$G$7$g$&!%(B -$BBG$A4V0c$$$K$h$kJ8;z$d!$@k8@$N8m$j$K$h$k2DG=@-$b$"$j$^$9!%Nc$($P!$0z?t$r(B -$B0O$`3g8L$rH4$+$7$?$H$+!$L?NaL>$N(B\\$B$rK:$l$?>l9g$J$I$G$9!%(B") - - ("Missing p-arg in array arg.*" . -"array$B4D6-!&(Btabular$B4D6-$N0z?t!$$"$k$$$O(B\\multicolumn$BL?Na$NBh(B2$B0z?t$NCf$K!$(B -$B3g8L$K0O$^$l$?I=8=$N$D$$$F$$$J$$(Bp$B$,$"$j$^$7$?!%(B") - - ("Missing @-exp in array arg." . -"array$B4D6-!&(Btabular$B4D6-$N0z?t!$$"$k$$$O(B\\multicolumn$BL?Na$NBh(B2$B0z?t$NCf$K!$(B -@$BI=8=$N$D$$$F$$$J$$(B@$B$,$"$j$^$7$?!%(B") - - ("No such counter." . -"\\setcounter$BL?Na$^$?$O(B\\addtocounter$BL?Na$G!$B8:_$7$J$$%+%&%s%?$,;XDj$5$l(B -$B$^$7$?!%$*$=$i$/$?$@$N%?%$%W%_%9$G$7$g$&!%$?$@$7!$%(%i!<$,(Baux$B%U%!%$%k$NCf(B -$B$G@8$8$?>l9g$O!$(B\\newcounter$BL?Na$r%W%j%"%s%V%k$N30$G;H$C$?$N$@$H;W$o$l$^$9!%(B") - - ("Not in outer par mode." . -"figure$B4D6-!&(Btable$B4D6-$"$k$$$O(B\\marginpar$BL?Na$,?t<0%b!<%I$^$?$O(Bparbox$B$NCf(B -$B$G;H$o$l$^$7$?!%(B") - - ("\\\\pushtabs and \\\\poptabs don't match." . -"\\pushtabs$B$HBP1~$7$J$$(B\\poptabs$B$,$_$D$+$C$?$+!$$^$?$O!$BP1~$9$k(B\\poptabs -$B$r$b$?$J$$(B\\pushtabs$B$,$"$k$N$K(B\\end{tabbing}$B$,8=$l$F$7$^$$$^$7$?!%(B") - - ("Something's wrong--perhaps a missing \\\\item." . -"$B%j%9%H4D6-$NCf$K(B\\item$BL?Na$,$J$$$N$,:G$b$"$j$=$&$J%1!<%9$G$9!%(B -thebibliography$B4D6-$G0z?t$rK:$l$?>l9g$K$b@8$8$^$9!%(B") - - ("Tab overflow." . -"\\=$B$,!$(BLaTeX$B$G5v$5$l$k%?%V%9%H%C%W$N:GBg?t$rD6$($F$$$^$9!%(B") - - ("There's no line here to end." . -"\\newline$BL?Na$^$?$O(B\\\\$BL?Na$,%Q%i%0%i%U4V$K$"$j$^$9!%$3$N;H$$$+$?$O(B -$BL50UL#$G$9!%$b$76u9T$r$"$1$?$$$N$G$7$?$i!$(B\\vspace$B$r;H$C$F$/$@$5$$!%(B") - - ("This may be a LaTeX bug." . -"$B$^$C$?$/$o$1$,$o$+$i$J$/$J$C$F$7$^$$$^$7$?!%$?$V$s$3$l0JA0$K8!=P$5$l$?(B -$B%(%i!<$N$;$$$@$H;W$o$l$^$9!%$7$+$7!$(BLaTeX$B<+BN$N%P%0$G$"$k2DG=@-$b$"$j$^$9!%(B -$B$b$7$3$N%(%i!<$,F~NO%U%!%$%k$KBP$9$k:G=i$N%(%i!<$G$"$j!$2?$b4V0c$$$,8+$D(B -$B$+$i$J$$>l9g$O!$$=$N%U%!%$%k$rJ]B8$7$F!$%m!<%+%k%,%$%I$K=q$+$l$F$$$k@UG$(B -$B/$J$/$H$b(B4$BCJ3,$^$G$O5v$5$l$F$$$^$9(B($BIaDL$O(B -$B$=$l$G==J,$G$7$g$&(B)$B!%(B") - - ("Too many unprocessed floats." . -"$B$3$N%(%i!<$O(B1$B%Z!<%8Cf$N(B\\marginpar$BL?Na$,B?$9$.$k$?$a$K@8$8$k>l9g$b$"(B -$B$j$^$9$,!$$b$C$H$"$j$=$&$J$N$O!$8B3&$rD6$($F?^$dI=$rJ]B8$7$h$&$H$7$?>l(B -$B9g$G$9!%D9$$J8=q$rAHHG$7$F$$$/$H$-!$(BLaTeX$B$O?^$dI=$r8D!9$KJ]B8$7!$%Z!<(B -$B%8$NJ,3d$r9T$J$&;~$K$=$l$i$rA^F~$7$^$9!%$3$N%(%i!<$O!$%Z!<%8$X$NJ,3d$,(B -$B9T$J$o$l$kA0$K!$$"$^$j$K$bB?$/$N(Bfigure$B4D6-$d(Btable$B4D6-$,8+$D$+$C$?>l9g(B -$B$K@8$8$^$9!%$3$NLdBj$O4D6-$N$&$A$N$$$/$D$+$rJ8=q$N=*$o$j$NJ}$K0\F0$9$l(B -$B$P2r7h$G$-$^$9!%$^$?!$$3$N%(%i!<$O(B``logjam''$B$K$h$C$F@8$8$k$3$H$b$"$j$^(B -$B$9!%(B``logjam''$B$H$O!$(BLaTeX$B$,=P8==g=xDL$j$K$7$+?^I=$r=PNO$G$-$J$$$;$$$G!$(B -$B$D$^$C$F$$$k8e$m$N?^I=$N$?$a$KA0$N?^I=$r=PNO$G$-$J$/$J$k$3$H$r$$$$$^$9!%(B -$B$3$N%8%c%`$N860x$O!$Bg$-$9$.$F(B1$B%Z!<%8$J$$$7$O;XDj$5$l$?NN0h$K<}$^$i$J(B -$B$$$h$&$J?^$dI=$G$"$k2DG=@-$,$"$j$^$9!%$3$l$O!$0z?t$K(Bp$B%*%W%7%g%s$,;XDj(B -$B$5$l$F$$$J$$$H5/$-$d$9$/$J$j$^$9!%(B") - - ("Undefined tab position." . -"\\>$B!&(B\\+$B!&(B\\-$B$^$?$O(B\\<$BL?Na$G!$B8:_$7$J$$%?%V0LCV!$$9$J$o$A(B\\=$BL?Na$GDj(B -$B5A$5$l$F$$$J$$%?%V0LCV$r;XDj$7$h$&$H$7$F$$$^$9!%(B") - - ("\\\\< in mid line." . -"\\<$BL?Na$,(Btabbing$B4D6-$N9T$NESCf$K8=$l$^$7$?!%$3$NL?Na$O9T$N@hF,$K$J$1$l$P(B -$B$J$j$^$;$s!%(B") - - ("Counter too large." . -"$B5SCm$,J8;z$^$?$O5SCm5-9f$G=g=x$E$1$5$l$F$$$^$9$,!$J8;z$^$?$O5-9f$r;H$$(B -$B@Z$C$F$7$^$$$^$7$?!%$*$=$i$/(B\\thanks$BL?Na$N;H$$$9$.$G$9!%(B") - - ("Double subscript." . -"$B?t<0Cf$N(B1$B$D$NNs$K(B2$B$D$N2eIU$-J8;z$,$D$$$F$$$^$9!%Nc$($P(Bx^{2}^{3}$B$N$h$&$K!%(B -$B$3$N$h$&$JI=8=$OL50UL#$G$9!%(B") - - ("Extra alignment tab has been changed to \\\\cr." . -"array$B4D6-$^$?$O(Btabular$B4D6-$N(B1$BNsCf$K$"$k9`L\$,B?$9$.$^$9!%8@$$49$($k$H!$(B -$BNs$N=*$o$j$^$G$K$"$k(B&$B$N?t$,B?$9$.$^$9!%$*$=$i$/A0$NNs$N:G8e$K(B\\\\$B$r$D$1(B -$B$k$N$rK:$l$?$N$G$7$g$&!%(B") - - ("Extra \\}, or forgotten \\$." . -"$B3g8L$^$?$O?t<0%b!<%I$N%G%j%_%?$,@5$7$/BP1~$7$F$$$^$;$s!%$*$=$i$/(B{$B!&(B\\[$B!&(B -\\($B$"$k$$$O(B$$B$N$&$A$N$$$:$l$+$r=q$-K:$l$?$N$G$7$g$&!%(B") - - ("Font [^ ]* not loaded: Not enough room left." . -"$B$3$NJ8=q$O8B3&$h$j$bB?$/$N%U%)%s%H$r;H$C$F$$$^$9!%$b$7J8=q$NItJ,$4$H$K(B -$BJL!9$N%U%)%s%H$,;H$o$l$F$$$k$N$J$i!$J,3d$7$F=hM}$9$l$PLdBj$O2r7h$5$l$^$9!%(B") - - ("I can't find file `.*'." . -"$BI,MW$J%U%!%$%k$,8+$D$+$j$^$;$s$G$7$?!%$b$78+$D$+$i$J$$%U%!%$%k$N3HD%;R(B -$B$,(Btex$B$N>l9g!$$"$J$?$,;XDj$7$?%U%!%$%k!$$9$J$o$A%a%$%s%U%!%$%k$^$?$O(B -\\input$BL?Na!&(B\\include$BL?Na$GA^F~$5$l$k%U%!%$%k$,8+$D$+$i$J$$$N$G$9!%(B -$B3HD%;R$,(Bsty$B$G$"$l$P!$B8:_$7$J$$J8=q%9%?%$%k$^$?$O%9%?%$%k%*%W%7%g%s$r(B -$B;XDj$7$h$&$H$7$F$$$^$9!%(B") - - ("Illegal parameter number in definition of .*" . -"$B$3$l$O$*$=$i$/!$(B\\newcommand$B!&(B\\renewcommand$B!&(B\\newenvironment$B$^$?$O(B -\\renewenvironment$BL?Na$N$J$+$G(B#$B$,@5$7$/;H$o$l$J$+$C$?$?$a$K@8$8$?%(%i!<(B -$B$G$9!%(B\\#$BL?Na$H$7$F;H$o$l$k>l9g$r=|$1$P!$(B#$B$H$$$&J8;z$O!$Nc$($P(B2$BHVL\$N(B -$B0z?t$r;XDj$9$k(B#2$B$N$h$&$K!$0z?t%Q%i%a!<%?$H$7$F$7$+;H$($^$;$s!%$^$?!$(B -$B$3$N%(%i!<$O!$>e$K$"$2$?(B4$B$D$N%3%^%s%I$,$*8_$$$KF~$l;R$K$J$C$F$$$k>l9g(B -$B$d!$(B\\newenvironment$BL?Na!&(B\\renewenvironment$BL?Na$G(B#2$B$N$h$&$J%Q%i%a!<%?(B -$B$,:G8e$N0z?t$NCf$G;H$o$l$F$$$k>l9g$K$b@8$8$^$9!%(B") - - ("Illegal unit of measure ([^ ]* inserted)." . -"$B$b$7(B - ! Missing number, treated as zero. -$B$H$$$&%(%i!<$,5/$-$?D>8e$G$"$l$P!$$3$N%(%i!<$N860x$b$=$l$HF1$8$G$9!%(B -$B$=$&$G$J$$>l9g$O!$(BLaTeX$B$,0z?t$H$7$F(Blength$B$r4|BT$7$F$$$k$N$K(Bnumber$B$,(B -$B8=$l$?$3$H$r0UL#$7$F$$$^$9!%$3$N%(%i!<$N:G$b$"$j$,$A$J860x$OD9$5(B0$B$r(B -$BI=$o$9(B0in$B$N$h$&$JI=8=$NBe$o$j$K(B0$B$H$+$$$F$7$^$&$3$H$K$"$j$^$9!%$?$@$7!$(B -$BL?Na$N0z?t$r=q$-K:$l$?>l9g$K$b$3$N%(%i!<$,@8$8$k$3$H$,$"$j$^$9!%(B") - - ("Misplaced alignment tab character \\&." . -"array$B$^$?$O(Btabular$B4D6-$G$N9`L\6h@Z$j$K$N$_;H$o$l$k$Y$-J8;z(B&$B$,IaDL$NJ8(B -$B$NCf$K$"$j$^$7$?!%$?$V$s(B\\&$B$HF~NO$7$?$+$C$?$N$G$7$g$&!%(B") - - ("Missing control sequence inserted." . -"$B$3$N%(%i!<$O!$$*$=$i$/L?NaL>$G$J$$$b$N$r(B\\newcommand$B!&(B\\renewcommand$B!&(B -\\newlength$B$^$?$O(B\\newsavebox$B$NBh(B1$B0z?t$H$7$F;H$C$?$?$a$K@8$8$?$N$G$7$g$&!%(B") - - ("Missing number, treated as zero." . -"$B$3$N%(%i!<$O$?$$$F$$!$0z?t$H$7$F(Bnumber$B$^$?$O(Blength$B$rI,MW$H$7$F$$$kL?Na$K(B -$BBP$7$F0z?t$,M?$($i$l$J$+$C$?$?$a$K@8$8$^$9!%0z?t$r=q$-K:$l$?$N$+!$%F%-%9%H(B -$B$NCf$NBg3g8L(B([])$B$,%*%W%7%g%s0z?t$N;XDj$H4V0c$($i$l$F$7$^$C$?$+$N$I$A$i$+$G(B -$B$7$g$&!%$^$?!$?t$r@8@.$9$k(B\\value$B$N$h$&$JL?Na$d(Blength$BL?Na$NA0$K(B\\protect$B$r(B -$BCV$$$?>l9g$K$b$3$N%(%i!<$O@8$8$^$9!%(B") - - ("Missing [{}] inserted." . -"TeX$B$O4{$K$o$1$,$o$+$i$J$/$J$C$F$$$^$9!%%(%i!<%a%C%;!<%8$K$h$C$F<($5$l$F(B -$B$$$k>l=j$O$?$V$sF~NO$K4V0c$$$,$"$C$?$H$3$m$h$j$b8e$m$K$J$C$F$7$^$C$F$$$k(B -$B$G$7$g$&!%(B") - - ("Missing \\$ inserted." . -"$B$*$=$i$/!$?t<0%b!<%ICf$G$7$+;H$($J$$L?Na$r(BTeX$B$,?t<0%b!<%I30$G8!=P$7$?(B -$B$N$@$H;W$o$l$^$9!%FC$K5-=R$5$l$F$$$J$$8B$j!$(BLaTeX Book(Lamport$BCx(B,$BLu=q(B -$B$O%"%9%-!<=PHG(B)$B$N(B3.3$B@a$K$"$kE:;z!&J,?t!&?t3X5-9f$J$I$N%3%^%s%I$O$9$Y$F(B -$B?t<0%b!<%I$G$7$+;H$($J$$$N$@$H$$$&$3$H$KCm0U$7$F$/$@$5$$!%$?$H$(L?Na$,(B -$B?t<04D6-$NCf$K$"$C$?$H$7$F$b!$(Bbox$B$r@8@.$9$kL?Na$N0z?t$r=hM}$7$O$8$a$?(B -$B;~E@$G$O!$(BTeX$B$O$^$@?t<0%b!<%I$KF~$C$F$$$J$$$N$G$9!%$^$?!$$3$N%(%i!<$O!$(B -$B?t<0%b!<%ICf$G(BTeX$B$,6u9T$r8!=P$7$?>l9g$K$b@8$8$^$9!%(B") - - ("Not a letter." . -"\\hyphenation$BL?Na$N0z?t$NCf$K$J$K$+@5$7$/$J$$$b$N$,$"$j$^$9!%(B") - - ("Paragraph ended before [^ ]* was complete." . -"$BL?Na$N0z?t$NCf$KIT@5$J6u9T$,F~$C$F$7$^$C$F$$$^$9!%$*$=$i$/0z?t$N=*$o$j(B -$B$KJD$83g8L$r$D$1$k$N$rK:$l$?$N$G$7$g$&!%(B") - - ("\\\\[^ ]*font [^ ]* is undefined .*" . -"$B$3$N%(%i!<$O$"$^$j0lHLE*$G$J$$%U%)%s%H$,?t<0%b!<%I$G;H$o$l$?;~$K@8$8(B -$B$^$9!%Nc$($P!$5SCm$NCf$N?t<0$G(B\\sc$BL?Na$,;H$o$l$k$H!$(Bfootnotesize$B$N(B -small caps$B%U%)%s%H$,8F$S$@$5$l$k$3$H$K$J$j$^$9!%$3$NLdBj$O(B\\load$BL?Na$r(B -$B;H$($P2r7h$G$-$^$9!%(B") - - ("Font .* not found." . -"$BL$CN$N(Bfamily/series/shape/size$B$NAH$_9g$o$;$N%U%)%s%H$,;XDj$5$l$^$7$?!%(B -$B$3$N%(%i!<$,5/$-$k%1!<%9$O(B2$B$D9M$($i$l$^$9!%(B - 1) \\size$B%^%/%m$G;H$($J$$%5%$%:$rA*Br$7$h$&$H$7$?!%(B - 2) $B$=$&$G$J$1$l$P!$4IM}l9g$I$&$9$l(B -$B$P$$$$$N$+$rH=CG$9$kJ}K!$r0J2<$K@bL@$7$^$9!%$b$7LdBj$,F~NO%U%!%$%kCf$N(B -$B%(%i!<$K$"$k>l9g$O!$8D!9$N%(%i!<$r2r7h$7$F$$$/J}K!$r$H$k$N$,$h$$$G$7$g(B -$B$&!%(BLaTeX$B$,C;$$%U%!%$%k$G%a%b%j$r;H$$$-$k$3$H$O$a$C$?$K$"$j$^$;$s$+$i!$(B -$B%(%i!<$N5/$-$?0LCV$h$jA0$K=hM}$7$?%Z!<%8$,?t%Z!<%8$7$+$J$1$l$P!$$^$:4V(B -$B0c$$$J$/F~NO%U%!%$%k$KLdBj$,$"$k$O$:$G$9!%(B - -$B%(%i!<%a%C%;!<%8$N:G8e$K!$(BTeX$B$,;H$$$-$C$F$7$^$C$?%a%b%j$NO@a!&(B\\caption$B!&(B\\addcontentsline$B$"$k$$$O(B\\addtocontents$BL?Na$N0z?t$H(B -$B$7$FM?$($?%F%-%9%H$,D9$9$.$k>l9g$K@8$8$k$3$H$,$"$j$^$9!%$3$N%(%i!<$O(B -$B$?$$$F$$(B\\end{document}$B$r=hM}$7$F$$$k;~$K@8$8$^$9$,!$(B\\tableofcontents$B!&(B -\\listoffigures$B$"$k$$$O(B\\listoftables$BL?Na$rl9g$K$b5/$-$k(B -$B$3$H$,$"$j$^$9!%$3$NLdBj$r2r7h$9$k$K$O!$$b$C$HC;$$%F%-%9%H$r%*%W%7%g%s(B -$B0z?t$H$7$FM?$($F$/$@$5$$!%L\e$K%O%$%U%M!<%7%g%s>pJs$rM?$($h$&$H$7$F$$$^$9!%(B -$B$"$^$j;H$o$J$$C18l$N(B\\hyphenation$BL?Na$r$NDj5A$^$?$OAj8_;2>H%i%Y%k$NDj5A$,B?$9$.$^$9!%(B - -input stack size -================ -$B$3$N%(%i!<$O$*$=$i$/L?NaDj5ACf$N8m$j$K$h$k$b$N$G$9!%Nc$($P!$l9g$N$$$:$l$+$G$9!%(B -\(1\)$BHs>o$KD9$/J#;($JL?Na$r?tB?$/Dj5A$7$?!%(B(2)index$B$^$?$O(Bglossary$B$r:n$C(B -$B$F$$$k$H$-!$(B1$B%Z!<%8Cf$K$"$^$j$K$bB?$/$N(B\\index$B$^$?$O(B\\glossary$BL?Na$,$"(B -$B$k!%(B(3)$B@8@.$N$?$a$N>pJs$r(BTeX$B$,J];}$7$-$l$J$$$h$&$J!$$"$^$j$K$bJ#;($J%Z!<(B -$B%8$r@8@.$7$h$&$H$7$?!%:G=i$N(B2$B$D$NLdBj$N2r7hJ}K!$OL@$i$+$G$9!%L?NaDj5A(B -$B$N?t$"$k$$$O(B\\index$B!&(B\\glossary$BL?Na$N?t$r8:$i$9$3$H$G$9!%(B3$BHVL\$NLdBj$O(B -$B$A$g$C$HLq2p$G$9!%$3$l$O!$Bg$-$J(Btabbin$B!&(Btabular$B!&(Barray$B!&(Bpicture$B4D6-$N(B -$B$;$$$G@8$8$k$3$H$,$"$j$^$9!%=PNO0LCV$,7hDj$5$l$k$N$rBT$C$F$$$k?^$dI=$G(B -TeX$B$N%a%b%j$,$$$C$Q$$$K$J$C$F$$$k$N$+$b$7$l$^$;$s!%K\Ev$K(BTeX$B$NMFNL$rD6(B -$B$($F$7$^$C$?$N$+$I$&$+D4$Y$k$?$a$K$O!$%(%i!<$N5/$3$C$?>l=j$ND>A0$K(B -\\clearpage$BL?Na$rF~$l$F$b$&0lEY%3%s%Q%$%k$rM5$,$G$-$k$+$b$7$l$^$;$s(B(\\pagebreak$BL?Na$G$O$@$a$G$9(B)$B!%$b$7?^$dI=(B -$B$,N/$^$C$F$$$k$3$H$,LdBj$J$N$J$i$P!$?^I=$r$b$C$H8e$m$NJ}$K0\F0$9$k$H$+!$(B -$B$"$k$$$O$b$C$HA0$N;~E@$G=PNO$5$l$k$h$&$K$9$l$P2sHr$G$-$^$9!%$b$7$^$@J8(B -$B=q$r:n@.$7$F$$$kESCf$J$i!$$H$j$"$($:(B\\clearpage$BL?Na$rF~$l$F$*$$$F!$:G(B -$B=*HG$r:n$k;~$^$G$3$NLdBj$OC*>e$2$7$F$*$-$^$7$g$&!%F~NO%U%!%$%k$,JQ$o$k(B -$B$HLdBj$,2r>C$5$l$k>l9g$b$"$k$N$G$9!%(B - -pool size -========= -$BAj8_;2>H$N(B\\label$B$,B?$9$.$k$+!$L?Na$NDj5A$,B?$9$.$k$+$N$I$A$i$+$G$9!%(B -$B@53N$K$$$($P!$Dj5A$7$?%i%Y%kL>$*$h$SL?NaL>$K;H$C$?J8;z?t$,B?$9$.$k$H$$(B -$B$&$3$H$G$9!%$G$9$+$i!$$b$C$HC;$$L>A0$r;H$($P$3$NLdBj$O2r7h$7$^$9!%$?$@(B -$B$7!$$3$N%(%i!<$O!$(B\\setcounter$B$J$I$N%+%&%s%?L?Na$d(B\\newenvironment$B!&(B -\\newtheorem$BL?Na$N0z?t$N=*$o$j$r<($91&3g8L$rK:$l$?>l9g$K$b@8$8$^$9!%(B - -save size -========= -$B$3$N%(%i!<$O!$@k8@$NM-8zHO0O$dL?Na!&4D6-$,$"$^$j$K$b?<$/F~$l;R$K$J$C$F(B -$B$$$k>l9g$K@8$8$^$9!%$?$H$($P!$(B\\multiput$BL?Na$N0z?t$K(Bpicture$B4D6-$,$"$j!$(B -$B$=$N$J$+$K(B\\footnotesize$B@k8@$,$"$j!$$=$N@k8@$NM-8zHO0O$K(B\\multiput$BL?Na(B -$B$,$"$C$F!$$=$N0z?t$K(B... $B$H$$$&$h$&$J>l9g$G$9!%(B") - - ("Text line contains an invalid character." . -"$BF~NOCf$KIT@5$JJ8;z$,4^$^$l$F$$$^$9!%%U%!%$%k:n@.$N8m$j$K$h$C$F%F%-%9%H(B -$B%(%G%#%?$,$3$NJ8;z$rA^F~$7$F$7$^$C$?$N$G$7$g$&!%l9g$K$O%m!<%+%k%,%$%I$r8+$F$/$@$5$$!%(B") - - ("Undefined control sequence." . -"TeX$B$,L$Dj5A$NL?NaL>$rH/8+$7$^$7$?!%$*$=$i$/F~NO$N8m$j$G$7$g$&!%$b$7$3(B -$B$N%(%i!<$,(BLaTeX$BL?Na$N=hM}Cf$K@8$8$?>l9g$O!$$=$NL?Na$O4V0c$C$?0LCV$KCV$+(B -$B$l$F$$$^$9!%Nc$($P!$%j%9%H4D6-$NCf$G$J$$$N$K(B\\item$BL?Na$,;H$o$l$?>l9g$J$I(B -$B$G$9!%$^$?!$(B\\documentstyle$BL?Na$,$J$$>l9g$K$b$3$N%(%i!<$,@8$8$^$9!%(B") - - ("Use of [^ ]* doesn't match its definition." . -"$B$*$=$i$/IA2h$N$?$a$NL?Na$@$H;W$o$l$^$9$,!$0z?t$N;H$$$+$?$,4V0c$C$F$$(B -$B$^$9!%4V0c$C$F$$$k$N$,(B\\@array$BL?Na$N>l9g$O!$(Barray$B4D6-$+(Btabular$B4D6-$G$N(B -@$BI=8=$N0z?t$K$J$K$+8m$j$,$"$k$N$G$7$g$&!%(Bfragile$B$JL?Na$,(B\\protect$B$5$l$F(B -$B$$$J$$$N$+$b$7$l$^$;$s!%(B") - - ("You can't use `macro parameter character \\#' in [^ ]* mode." . -"$BFCl=j$,8+$D$+$i$J$+$C$?$N$G!$(B1$B9T$K<}$^$k$Y$-J,NL0J>e(B -$B$N=PNO$,9T$J$o$l$F$7$^$$$^$7$?!%(B") - - ("Overfull \\\\vbox .*" . -"$B%Z!<%8J,3d$N$?$a$NE,@Z$J>l=j$,8+$D$+$i$J$+$C$?$N$G!$(B1$B%Z!<%8$K<}$^$k$Y$-(B -$BJ,NL0J>e$N=PNO$,9T$J$o$l$F$7$^$$$^$7$?!%(B") - - ("Underfull \\\\hbox .*" . -"$BM>J,$J?bD>%9%Z!<%9$,$J$$$+$I$&$+=PNO$r3N$+$a$F$/$@$5$$!%$b$7$"$l$P!$$=(B -$B$l$O(B\\\\$BL?Na$^$?$O(B\\newline$BL?Na$K4X78$9$kLdBj$N$?$a$K@8$8$?$b$N$G$9!%Nc(B -$B$($P(B2$B$D$N(B\\\\$BL?Na$,B3$$$F$$$k>l9g$J$I$G$9!%$3$N7Y9p$O(Bsloppypar$B4D6-$d(B -\\sloppy$B@k8@$N;HMQ!$$"$k$$$O(B\\linebreak$BL?Na$NA^F~$J$I$K$h$k>l9g$b$"$j$^$9!%(B") - - ("Underfull \\\\vbox .*" . -"$B%Z!<%8$rJ,3d$9$k$?$a$NE,@Z$J>l=j$,8+$D$1$i$l$:!$==J,$J%F%-%9%H$N$J$$(B -$B%Z!<%8$,$G$-$F$7$^$$$^$7$?!%(B") - -;; New list items should be placed here -;; -;; ("err-regexp" . "context") -;; -;; the err-regexp item should match anything - - (".*" . "$B$4$a$s$J$5$$!%3:Ev$9$k%X%k%W%a%C%;!<%8$,$"$j$^$;$s!%(B")))) - -(provide 'tex-jp) - -;;; tex-jp.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/auctex/tex-site.el --- a/lisp/auctex/tex-site.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,61 +0,0 @@ -;;; tex-site.el - Select AUC TeX as your tex mode. - -;; Copyright (C) 1991 Kresten Krab Thorup -;; Copyright (C) 1993, 1994, 1997 Per Abrahamsen - -;; Author: Per Abrahamsen -;; Maintainer: Per Abrahamsen -;; Version: 9.7p (XEmacs) -;; Keywords: wp - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Commentary: - -;; This file contains variables customized for the local site. - -;; It also contains all necessary autoloads, so the user can simple -;; enable AUC TeX by putting (load "tex-site") in his .emacs file, -;; or the administrator can insert it in the site-start.el file. -;; -;; The ideal place for this file is in the `site-lisp' directory. - -;;; Code: - -(defvar no-doc - "This function is part of AUC TeX, but has not yet been loaded. -Full documentation will be available after autoloading the function." - "Documentation for autoload functions.") - -;;; Customization: -;; -;; Copy variables you need to change from the start of `tex.el' and -;; insert them here. - -;;; Autoloads: - -;; This hook will store bibitems when you save a BibTeX buffer. -(add-hook 'bibtex-mode-hook 'BibTeX-auto-store) - -;; Load from AUC TeX files instead of standard files. -(autoload 'tex-mode "tex" no-doc t) -(autoload 'plain-tex-mode "tex" no-doc t) -(autoload 'tex-insert-quote "tex" no-doc t) -(autoload 'texinfo-mode "tex-info" no-doc t) -(autoload 'latex-mode "latex" no-doc t) - -(provide 'tex-site) - -;;; tex-site.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/auctex/tex.el --- a/lisp/auctex/tex.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2891 +0,0 @@ -;;; tex.el --- Support for TeX documents. - -;; Maintainer: Per Abrahamsen -;; Version: 9.7p -;; Keywords: wp -;; X-URL: http://sunsite.auc.dk/auctex - -;; Copyright (C) 1985, 1986 Free Software Foundation, Inc. -;; Copyright (C) 1987 Lars Peter Fischer -;; Copyright (C) 1991 Kresten Krab Thorup -;; Copyright (C) 1993, 1994, 1996, 1997 Per Abrahamsen -;; -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 1, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Code: - -(eval-and-compile - (condition-case () - (require 'custom) - (error nil)) - (if (and (featurep 'custom) (fboundp 'custom-declare-variable)) - nil ;; We've got what we needed - ;; We have the old custom-library, hack around it! - (defmacro defgroup (&rest args) - nil) - (defmacro defcustom (var value doc &rest args) - (` (defvar (, var) (, value) (, doc)))))) - -(defgroup AUC-TeX nil - "A (La)TeX environment." - :tag "AUC TeX" - :link '(custom-manual "(auctex)Top") - :link '(url-link :tag "Home Page" "http://sunsite.auc.dk/auctex/") - :prefix "TeX-" - :group 'tex) - -(defgroup TeX-file nil - "Files used by AUC TeX." - :group 'AUC-TeX) - -(defgroup TeX-command nil - "Calling external commands from AUC TeX." - :group 'AUC-TeX) - -(defgroup LaTeX nil - "LaTeX support in AUC TeX." - :tag "LaTeX" - :group 'AUC-TeX) - -;;; Site Customization -;; -;; The following variables are likely to need to be changed for your -;; site. It is suggested that you do this by *not* changing this -;; file, but instead copy those definitions you need to change to -;; `tex-site.el'. - -(defcustom TeX-lisp-directory (concat data-directory "auctex/") - "*The directory where the AUC TeX lisp files are located." - :group 'TeX-file - :type 'directory) - -;; Change this to point to the place where the TeX macros are stored -;; at yourt site. [Ignore when bundled with XEmacs] -(defcustom TeX-macro-global '("/usr/lib/texmf/tex/") - "*Directories containing the sites TeX macro files and style files. -The directory names *must* end with a slash." - :group 'TeX-file - :type '(repeat (directory :format "%v"))) - -;; How to print. - -(defcustom TeX-print-command "dvips %s -P%p" - "*Command used to print a file. - -First %p is expanded to the printer name, then ordinary expansion is -performed as specified in TeX-expand-list." - :group 'TeX-command - :type 'string) - -(defcustom TeX-queue-command "lpq -P%p" - "*Command used to show the status of a printer queue. - -First %p is expanded to the printer name, then ordinary expansion is -performed as specified in TeX-expand-list." - :group 'TeX-command - :type 'string) - -;; This is the major configuration variable. Most sites will only -;; need to change the second string in each entry, which is the name -;; of a command to send to the shell. If you use other formatters -;; like AMSLaTeX or AMSTeX, you can add those to the list. See -;; TeX-expand-list for a description of the % escapes - -(defcustom TeX-command-list - ;; You may have to remove the single quotes around the command - ;; arguments if you use DOS. - (list (list "TeX" "tex '\\nonstopmode\\input %t'" 'TeX-run-TeX nil t) - (list "TeX Interactive" "tex %t" 'TeX-run-interactive nil t) - (list "LaTeX" "%l '\\nonstopmode\\input{%t}'" - 'TeX-run-LaTeX nil t) - (list "LaTeX Interactive" "%l %t" 'TeX-run-interactive nil t) - (list "LaTeX2e" "latex2e '\\nonstopmode\\input{%t}'" - 'TeX-run-LaTeX nil t) - (if (or window-system (getenv "DISPLAY")) - (list "View" "%v " 'TeX-run-background t nil) - (list "View" "dvi2tty -q -w 132 %s " 'TeX-run-command t nil)) - (list "Print" "%p " 'TeX-run-command t nil) - (list "Queue" "%q" 'TeX-run-background nil nil) - (list "File" "dvips %d -o %f " 'TeX-run-command t nil) - (list "BibTeX" "bibtex %s" 'TeX-run-BibTeX nil nil) - (list "Index" "makeindex %s" 'TeX-run-command nil t) - ;; (list "Check" "chktex -v3 %s" 'TeX-run-compile nil t) - ;; Uncomment the above line and comment out the next line to - ;; use `chktex' instead of `lacheck'. - (list "Check" "lacheck %s" 'TeX-run-compile nil t) - (list "Spell" "" 'TeX-run-ispell nil nil) - (list "Other" "" 'TeX-run-command t t) - ;; Not part of standard TeX. - (list "Makeinfo" "makeinfo %t" 'TeX-run-compile nil t) - (list "AmSTeX" "amstex '\\nonstopmode\\input %t'" - 'TeX-run-TeX nil t)) - "List of commands to execute on the current document. - -Each element is a list, whose first element is the name of the command -as it will be presented to the user. - -The second element is the string handed to the shell after being -expanded. The expansion is done using the information found in -TeX-expand-list. - -The third element is the function which actually start the process. -Several such hooks has been defined: - -TeX-run-command: Start up the process and show the output in a -separate buffer. Check that there is not two commands running for the -same file. Return the process object. - -TeX-run-format: As TeX-run-command, but assume the output is created -by a TeX macro package. Return the process object. - -TeX-run-TeX: For TeX output. - -TeX-run-LaTeX: For LaTeX output. - -TeX-run-interactive: Run TeX or LaTeX interactively. - -TeX-run-BibTeX: For BibTeX output. - -TeX-run-compile: Use `compile' to run the process. - -TeX-run-shell: Use `shell-command' to run the process. - -TeX-run-discard: Start the process in the background, discarding its -output. - -TeX-run-background: Start the process in the background, show output -in other window. - -TeX-run-dviout: Special hook for the Japanese dviout previewer for -PC-9801. - -To create your own hook, define a function taking three arguments: The -name of the command, the command string, and the name of the file to -process. It might be useful to use TeX-run-command in order to -create an asynchronous process. - -If the fourth element is non-nil, the user will get a chance to -modify the expanded string. - -The fifth element is obsolete and ignored." - :group 'TeX-command - :type '(repeat (group (string :tag "Name") - (string :tag "Command") - (choice :tag "How" - :value TeX-run-command - (function-item TeX-run-command) - (function-item TeX-run-format) - (function-item TeX-run-TeX) - (function-item TeX-run-LaTeX) - (function-item TeX-run-interactive) - (function-item TeX-run-BibTeX) - (function-item TeX-run-compile) - (function-item TeX-run-shell) - (function-item TeX-run-discard) - (function-item TeX-run-background) - (function-item TeX-run-dviout) - (function :tag "Other")) - (boolean :tag "Prompt") - (sexp :format "End\n")))) - - -;; You may want to change the default LaTeX version for your site. -(defcustom LaTeX-version "2e" - "Default LaTeX version. Currently recognized is \"2\" and \"2e\"." - :group 'LaTeX - :type '(radio (const :format "%v\n%h" - :doc "\ -The executable `latex' is LaTeX version 2." - "2") - (const :format "%v\n%h" - :doc "\ -The executable `latex' is LaTeX version 2e. -Do *not* select this if you need to run `latex2e' in order to get -LaTeX version 2e." - "2e") - (string :tag "Other"))) - - -;; You may want special options to the view command depending on the -;; style options. Only works if parsing is enabled. - -(defcustom LaTeX-command-style - (if (string-equal LaTeX-version "2") - ;; There is a lot of different LaTeX 2 based formats. - '(("^latex2e$" "latex2e") - ("^foils$" "foiltex") - ("^ams" "amslatex") - ("^slides$" "slitex") - ("^plfonts\\|plhb$" "platex") - ("." "latex")) - ;; They have all been combined in LaTeX 2e. - '(("." "latex"))) - "List of style options and LaTeX commands. - -If the first element (a regular expresion) matches the name of one of -the style files, any occurrence of the string %l in a command in -TeX-command-list will be replaced with the second element. The first -match is used, if no match is found the %l is replaced with the empty -string." - :group 'TeX-command - :type '(repeat (group :value ("" "") - regexp (string :tag "Style")))) - -;; Enter the names of the printers available at your site, or nil if -;; you only have one printer. - -(defcustom TeX-printer-list - '(("Local" "dvips -f %s | lpr" "lpq") - ("lw") ("ps")) - "List of available printers. - -The first element of each entry is the printer name. - -The second element is the command used to print to this -printer. It defaults to the value of TeX-print-command. - -The third element is the command used to examine the print queue for -this printer. It defaults to the value of TeX-queue-command. - -Any occurence of `%p' in the second or third element is expanded to -the printer name given in the first element, then ordinary expansion -is performed as specified in TeX-expand-list." - :group 'TeX-command - :type '(repeat (group (string :tag "Name") - (option (group :inline t - :extra-offset -4 - (choice :tag "Print" - (const :tag "default") - (string :format "%v")) - (option (choice :tag "Queue" - (const :tag "default") - (string - :format "%v")))))))) - -;; The name of the most used printer. - -(defcustom TeX-printer-default (or (getenv "PRINTER") - (and TeX-printer-list - (car (car TeX-printer-list))) - "lw") - "*Default printer to use with TeX-command." - :group 'TeX-command - :type 'string) - -;; You may want special options to the view command depending on the -;; style options. Only works if parsing is enabled. - -(defcustom TeX-view-style '(("^a5$" "xdvi %d -paper a5") - ("^landscape$" "xdvi %d -paper a4r -s 4") - ;; The latest xdvi can show embedded postscript. - ;; If you don't have that, uncomment next line. - ;; ("^epsf$" "ghostview %f") - ("." "xdvi %d")) - "List of style options and view options. - -If the first element (a regular expresion) matches the name of one of -the style files, any occurrence of the string %v in a command in -TeX-command-list will be replaced with the second element. The first -match is used, if no match is found the %v is replaced with the empty -string." - :group 'TeX-command - :type '(repeat (group regexp (string :tag "Command")))) - -;; This is the list of expansion for the commands in -;; TeX-command-list. Not likely to be changed, but you may e.g. want -;; to handle .ps files. - -(defcustom TeX-expand-list - (list (list "%p" 'TeX-printer-query) ;%p must be the first entry - (list "%q" (function (lambda () - (TeX-printer-query TeX-queue-command 2)))) - (list "%v" 'TeX-style-check TeX-view-style) - (list "%l" 'TeX-style-check LaTeX-command-style) - (list "%s" 'file nil t) - (list "%t" 'file 't t) - (list "%d" 'file "dvi" t) - (list "%f" 'file "ps" t)) - "List of expansion strings for TeX command names. - -Each entry is a list with two or more elements. The first element is -the string to be expanded. The second element is the name of a -function returning the expanded string when called with the remaining -elements as arguments. The special value `file' will be expanded to -the name of the file being processed, with an optional extension." - :group 'TeX-command - :type '(repeat (group (string :tag "Key") - (sexp :tag "Expander") - (repeat :inline t - :tag "Arguments" - (sexp :format "%v"))))) - -;; End of Site Customization. - -;;; Import - -(or (assoc TeX-lisp-directory (mapcar 'list load-path)) ;No `member' yet. - (setq load-path (cons TeX-lisp-directory load-path))) - -(defvar no-doc - "This function is part of AUC TeX, but has not yet been loaded. -Full documentation will be available after autoloading the function." - "Documentation for autoload functions.") - -;; This hook will store bibitems when you save a BibTeX buffer. -(defvar bibtex-mode-hook nil) -(or (memq 'BibTeX-auto-store bibtex-mode-hook) ;No `add-hook' yet. - (setq bibtex-mode-hook (cons 'BibTeX-auto-store bibtex-mode-hook))) - -(autoload 'BibTeX-auto-store "latex" no-doc t) - -(autoload 'LaTeX-math-mode "latex" no-doc t) -(autoload 'japanese-plain-tex-mode "tex-jp" no-doc t) -(autoload 'japanese-latex-mode "tex-jp" no-doc t) -(autoload 'japanese-slitex-mode "tex-jp" no-doc t) -(autoload 'texinfo-mode "tex-info" no-doc t) -(autoload 'latex-mode "latex" no-doc t) - -(autoload 'multi-prompt "multi-prompt" no-doc nil) - -;;; Portability. - -(require 'easymenu) - -;; An GNU Emacs 19 function. -(or (fboundp 'set-text-properties) - (fset 'set-text-properties (symbol-function 'ignore))) - -;; An GNU Emacs 19 variable. -(defvar minor-mode-map-alist nil) - -;;; Special support for Emacs 18 - -(cond ((< (string-to-int emacs-version) 19) - -(condition-case error - (require 'outline) ;No provide in Emacs 18 outline.el - (error (provide 'outline))) - -;; Emacs 18 grok this regexp, but you loose the ability to use -;; whitespace anywhere in your documentstyle command. -(defvar LaTeX-auto-minimal-regexp-list - '(("\\\\documentstyle\\[\\([^#\\\\\\.\n\r]+\\)\\]{\\([^#\\\\\\.\n\r]+\\)}" - (1 2) LaTeX-auto-style) - ("\\\\documentstyle{\\([^#\\\\\\.\n\r]+\\)}" (1) LaTeX-auto-style) - ("\\\\documentclass\\[\\([^#\\\\\\.\n\r]+\\)\\]{\\([^#\\\\\\.\n\r]+\\)}" - (1 2) LaTeX-auto-style) - ("\\\\documentclass{\\([^#\\\\\\.\n\r]+\\)}" (1) LaTeX-auto-style)) - "Minimal list of regular expressions matching LaTeX macro definitions.") - -;; The Emacs 19 definition of `comment-region'. -(defun comment-region (beg end &optional arg) - "Comment the region; third arg numeric means use ARG comment characters. -If ARG is negative, delete that many comment characters instead. -Comments are terminated on each line, even for syntax in which newline does -not end the comment. Blank lines do not get comments." - ;; if someone wants it to only put a comment-start at the beginning and - ;; comment-end at the end then typing it, C-x C-x, closing it, C-x C-x - ;; is easy enough. No option is made here for other than commenting - ;; every line. - (interactive "r\np") - (or comment-start (error "No comment syntax is defined")) - (if (> beg end) (let (mid) (setq mid beg beg end end mid))) - (save-excursion - (save-restriction - (let ((cs comment-start) (ce comment-end)) - (cond ((not arg) (setq arg 1)) - ((> arg 1) - (while (> (setq arg (1- arg)) 0) - (setq cs (concat cs comment-start) - ce (concat ce comment-end))))) - (narrow-to-region beg end) - (goto-char beg) - (while (not (eobp)) - (if (< arg 0) - (let ((count arg)) - (while (and (> 1 (setq count (1+ count))) - (looking-at (regexp-quote cs))) - (delete-char (length cs))) - (if (string= "" ce) () - (setq count arg) - (while (> 1 (setq count (1+ count))) - (end-of-line) - ;; this is questionable if comment-end ends in whitespace - ;; that is pretty brain-damaged though - (skip-chars-backward " \t") - (backward-char (length ce)) - (if (looking-at (regexp-quote ce)) - (delete-char (length ce))))) - (forward-line 1)) - (if (looking-at "[ \t]*$") () - (insert cs) - (if (string= "" ce) () - (end-of-line) - (insert ce))) - (search-forward "\n" nil 'move))))))) - -;; The Emacs 19 definition of `add-hook'. -(defun add-hook (hook function &optional append) - "Add to the value of HOOK the function FUNCTION. -FUNCTION is not added if already present. -FUNCTION is added (if necessary) at the beginning of the hook list -unless the optional argument APPEND is non-nil, in which case -FUNCTION is added at the end. - -HOOK should be a symbol, and FUNCTION may be any valid function. If -HOOK is void, it is first set to nil. If HOOK's value is a single -function, it is changed to a list of functions." - (or (boundp hook) (set hook nil)) - ;; If the hook value is a single function, turn it into a list. - (let ((old (symbol-value hook))) - (if (or (not (listp old)) (eq (car old) 'lambda)) - (set hook (list old)))) - (or (if (consp function) - ;; Clever way to tell whether a given lambda-expression - ;; is equal to anything in the hook. - (let ((tail (assoc (cdr function) (symbol-value hook)))) - (equal function tail)) - (memq function (symbol-value hook))) - (set hook - (if append - (nconc (symbol-value hook) (list function)) - (cons function (symbol-value hook)))))) - -;; An Emacs 19 function. -(defun make-directory (dir) - "Create the directory DIR." - (shell-command (concat "mkdir " (if (string-match "/$" dir) - (substring dir 0 -1) - dir)))) - -;; An Emacs 19 function. -(defun abbreviate-file-name (name) - name) - -;; Different interface for each variant. -(defun TeX-active-mark () - ;; Emacs 18 does not have active marks. - nil) - -;; Different interface for each variant. -(defun TeX-mark-active () - ;; In Emacs 18 (mark) returns nil when not active. - (mark)) - -;; An Emacs 19 function. -(defun member (elt list) - "Return non-nil if ELT is an element of LIST. Comparison done with EQUAL. -The value is actually the tail of LIST whose car is ELT." - (while (and list (not (equal elt (car list)))) - (setq list (cdr list))) - list) - -;; An Emacs 19 macro. -(defmacro save-match-data (&rest body) - "Execute the BODY forms, restoring the global value of the match data." - (let ((original (make-symbol "match-data"))) - (list - 'let (list (list original '(match-data))) - (list 'unwind-protect - (cons 'progn body) - (list 'store-match-data original))))) - -) - -;;; Special support for XEmacs - -((or (string-match "Lucid" emacs-version) - (string-match "XEmacs" emacs-version)) - -(if (eq emacs-minor-version 13) - ;; XEmacs 19.13 had a partial defintion of set-text-properties. - (defadvice set-text-properties (around ignore-strings activate) - "Ignore strings." - (or (stringp (ad-get-arg 3)) - ad-do-it))) - -(defadvice popup-mode-menu (before LaTeX-update activate) - "Run `LaTeX-menu-update' before showing menu." - (and (fboundp 'LaTeX-menu-update) - (LaTeX-menu-update))) - -(defun TeX-mark-active () - ;; In Lucid (mark) returns nil when not active. - (if zmacs-regions - (mark) - (mark t))) - -(defun TeX-active-mark () - (and zmacs-regions (mark))) - -;; Lucid 19.11 have no idea what `kill-all-local-variables' is -;; supposed to do. I have to explicitly clear `TeX-symbol-list' -;; despite it being buffer local. You can verify this by removing the -;; hook below, setting a breakpoint just after the call to -;; `kill-all-local-variables' in `VirTeX-common-initialization' and -;; examine the local and global value of `TeX-symbol-list'. Make sure -;; you have a `%%% mode: latex' line in your file variable section, -;; and have latex-mode as your default mode for ".tex" files. -;; Unfortunately I have been unable to isolate the error further. -(add-hook 'change-major-mode-hook - '(lambda () (setq TeX-symbol-list nil - LaTeX-environment-list nil))) - -;; Lucid 19.6 grok this regexp, but you loose the ability to use -;; whitespace in your documentstyle command. -(string-match "\\`[0-9]+\\.\\([0-9]+\\)" emacs-version) -(or (> (string-to-int (substring emacs-version - (match-beginning 1) (match-end 1))) - 8) - (> (string-to-int emacs-version) 19) - (boundp 'LaTeX-auto-minimal-regexp-list) - (setq LaTeX-auto-minimal-regexp-list - '(("\\\\documentstyle\\[\\([^#\\\\\\.\n\r]+\\)\\]{\\([^#\\\\\\.\n\r]+\\)}" - (1 2) LaTeX-auto-style) - ("\\\\documentstyle{\\([^#\\\\\\.\n\r]+\\)}" (1) LaTeX-auto-style) - ("\\\\documentclass\\[\\([^#\\\\\\.\n\r]+\\)\\]{\\([^#\\\\\\.\n\r]+\\)}" - (1 2) LaTeX-auto-style) - ("\\\\documentclass{\\([^#\\\\\\.\n\r]+\\)}" (1) LaTeX-auto-style)))) - -;; Lucid only -(fset 'TeX-activate-region (symbol-function 'zmacs-activate-region)) - -) -;;; Special support for GNU Emacs 19 - -(t - -(defun TeX-mark-active () - ;; In FSF 19 mark-active indicates if mark is active. - mark-active) - -(defun TeX-active-mark () - (and transient-mark-mode mark-active)) - -(defun TeX-activate-region ()) - -)) - -;;; Version - -;; These two variables are automatically updated with "make dist", so -;; be careful before changing anything. - -(defconst AUC-TeX-version "9.7p" - "AUC TeX version number") - -(defconst AUC-TeX-date "Thu Apr 17 14:25:49 MET DST 1997" - "AUC TeX release date") - -;;; Buffer - -(defgroup TeX-output nil - "Parsing TeX output." - :prefix "TeX-" - :group 'AUC-TeX) - -(defcustom TeX-display-help t - "*Non-nil means popup help when stepping thrugh errors with -\\[TeX-next-error]" - :group 'TeX-output - :type 'boolean) - -(defcustom TeX-debug-bad-boxes nil - "*Non-nil means also find overfull/underfull boxes warnings with -TeX-next-error" - :group 'TeX-output - :type 'boolean) - -(defgroup TeX-command-name nil - "Names for external commands in AUC TeX." - :group 'TeX-command) - -(defcustom TeX-command-BibTeX "BibTeX" - "*The name of the BibTeX entry in TeX-command-list." - :group 'TeX-command-name - :type 'string) - (make-variable-buffer-local 'TeX-command-BibTeX) - -(defcustom TeX-command-Show "View" - "*The default command to show (view or print) a TeX file. -Must be the car of an entry in TeX-command-list." - :group 'TeX-command-name - :type 'string) - (make-variable-buffer-local 'TeX-command-Show) - -(defcustom TeX-command-Print "Print" - "The name of the Print entry in TeX-command-Print." - :group 'TeX-command-name - :type 'string) - -(defcustom TeX-command-Queue "Queue" - "The name of the Queue entry in TeX-command-Queue." - :group 'TeX-command-name - :type 'string) - -(autoload 'TeX-region-create "tex-buf" no-doc nil) -(autoload 'TeX-save-document "tex-buf" no-doc t) -(autoload 'TeX-home-buffer "tex-buf" no-doc t) -(autoload 'TeX-command-region "tex-buf" no-doc t) -(autoload 'TeX-command-buffer "tex-buf" no-doc t) -(autoload 'TeX-command-master "tex-buf" no-doc t) -(autoload 'TeX-command "tex-buf" no-doc nil) -(autoload 'TeX-kill-job "tex-buf" no-doc t) -(autoload 'TeX-recenter-output-buffer "tex-buf" no-doc t) -(autoload 'TeX-next-error "tex-buf" no-doc t) -(autoload 'TeX-toggle-debug-boxes "tex-buf" no-doc t) -(autoload 'TeX-region-file "tex-buf" no-doc nil) - -(defvar TeX-trailer-start nil - "Regular expression delimiting start of trailer in a TeX file.") - - (make-variable-buffer-local 'TeX-trailer-start) - -(defvar TeX-header-end nil - "Regular expression delimiting end of header in a TeX file.") - - (make-variable-buffer-local 'TeX-header-end) - -(defvar TeX-command-default nil - "The default command for TeX-command in the current major mode.") - - (make-variable-buffer-local 'TeX-command-default) - - -;;; Master File - -(defcustom TeX-one-master "\\.tex$" - "*Regular expression matching ordinary TeX files. - -You should set this variable to match the name of all files, where -automatically adding a file variable with the name of the master file -is a good idea. When AUC TeX add the name of the master file as a -file variable, it does not need to ask next time you edit the file. - -If you dislike AUC TeX automatically modifying your files, you can set -this variable to \"\"." - :group 'TeX-command - :type 'regexp) - -(defun TeX-master-file (&optional extension nondirectory) - "Return the name of the master file for the current document. - -If optional argument EXTENSION is non-nil, add that file extension to -the name. Special value `t' means use `TeX-default-extension'. - -If optional second argument NONDIRECTORY is non-nil, do not include -the directory. - -Currently is will check for the presence of a ``Master:'' line in -the beginning of the file, but that feature will be phased out." - (if (eq extension t) - (setq extension TeX-default-extension)) - (let ((my-name (if (buffer-file-name) - (TeX-strip-extension nil (list TeX-default-extension) t) - ""))) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (cond - ;; Special value 't means it is own master (a free file). - ((equal TeX-master my-name) - (setq TeX-master t)) - - ;; For files shared between many documents. - ((eq 'shared TeX-master) - (setq TeX-master - (TeX-strip-extension - (read-file-name "Master file: (default this file) " - nil "///") - (list TeX-default-extension) - 'path)) - (if (or (string-equal TeX-master "///") - (string-equal TeX-master "")) - (setq TeX-master t))) - - ;; We might already know the name. - (TeX-master) - - ;; Support the ``Master:'' line (under protest!) - ((re-search-forward - "^%% *[Mm]aster:?[ \t]*\\([^ \t\n]+\\)" 500 t) - (setq TeX-master - (TeX-strip-extension (TeX-match-buffer 1) - (list TeX-default-extension))) - (if TeX-convert-master - (progn - (beginning-of-line) - (kill-line 1) - (TeX-add-local-master)))) - - ;; Is this a master file? - ((re-search-forward TeX-header-end 10000 t) - (setq TeX-master my-name)) - - ;; Ask the user (but add it as a local variable). - (t - (setq TeX-master - (TeX-strip-extension - (condition-case name - (read-file-name "Master file: (default this file) " - nil "") - (quit "")) - (list TeX-default-extension) - 'path)) - (cond ((string-equal TeX-master "") - (setq TeX-master t)) - ((or (string-equal TeX-master "") - (string-equal TeX-master "")) - (setq TeX-master t) - (TeX-add-local-master)) - (t - (TeX-add-local-master))))))) - - (let ((name (if (eq TeX-master t) - my-name - TeX-master))) - - (if (TeX-match-extension name) - ;; If it already have an extension... - (if (equal extension TeX-default-extension) - ;; Use instead of the default extension - (setq extension nil) - ;; Otherwise drop it. - (setq name (TeX-strip-extension name)))) - - ;; Remove directory if needed. - (if nondirectory - (setq name (file-name-nondirectory name))) - - (if extension - (concat name "." extension) - name)))) - -(defun TeX-master-directory () - "Directory of master file." - (abbreviate-file-name - (expand-file-name - (concat (file-name-directory buffer-file-name) - (file-name-directory (TeX-master-file)))))) - -(defcustom TeX-master t - "*The master file associated with the current buffer. -If the file being edited is actually included from another file, you -can tell AUC TeX the name of the master file by setting this variable. -If there are multiple levels of nesting, specify the top level file. - -If this variable is nil, AUC TeX will query you for the name. - -If the variable is t, AUC TeX will assume the file is a master file -itself. - -If the variable is 'shared, AUC TeX will query for the name, but not -change the file. - -It is suggested that you use the File Variables (see the info node in -the Emacs manual) to set this variable permanently for each file." - :group 'TeX-command - :group 'TeX-parse - :type '(choice (const :tag "Query" nil) - (const :tag "This file" t) - (const :tag "Shared" shared) - (string :format "%v"))) - - (make-variable-buffer-local 'TeX-master) - -(defvar TeX-convert-master t - "*If not nil, automatically convert ``Master:'' lines to file variables. -This will be done when AUC TeX first try to use the master file.") - -(defun TeX-add-local-master () - "Add local variable for TeX-master." - - (if (and (buffer-file-name) - (string-match TeX-one-master - (file-name-nondirectory (buffer-file-name))) - (not buffer-read-only)) - (progn - (goto-char (point-max)) - (if (re-search-backward (concat "^\\([^\n]+\\)Local " "Variables:") - (- (point-max) 3000) t) - (let ((prefix (TeX-match-buffer 1))) - (re-search-forward (regexp-quote (concat prefix - "End:"))) - (beginning-of-line 1) - (insert prefix "TeX-master: " (prin1-to-string TeX-master) "\n")) - (insert "\n%%% Local " "Variables: \n" - "%%% mode: " (substring (symbol-name major-mode) 0 -5) - "\n" - "%%% TeX-master: " (prin1-to-string TeX-master) "\n" - "%%% End: \n"))))) - -;;; Style Paths - -(or (string-match "/\\'" TeX-lisp-directory) - (setq TeX-lisp-directory (concat TeX-lisp-directory "/"))) - -(defcustom TeX-auto-global (concat TeX-lisp-directory "auto/") - "*Directory containing automatically generated information. -Must end with a slash. - -For storing automatic extracted information about the TeX macros -shared by all users of a site." - :group 'TeX-file - :type 'directory) - -(defcustom TeX-style-global (concat TeX-lisp-directory "style/") - "*Directory containing hand generated TeX information. -Must end with a slash. - -These correspond to TeX macros shared by all users of a site." - :group 'TeX-file - :type 'directory) - -(defcustom TeX-auto-local "auto/" - "*Directory containing automatically generated TeX information. -Must end with a slash. - -This correspond to TeX macros found in the current directory." - :group 'TeX-file - :type 'string) - -(defcustom TeX-style-local "style/" - "*Directory containing hand generated TeX information. -Must end with a slash. - -These correspond to TeX macros found in the current directory." - :group 'TeX-file - :type 'string) - -(defun TeX-split-string (regexp string) - "Returns a list of strings. given REGEXP the STRING is split into -sections which in string was seperated by REGEXP. - -Examples: - - (TeX-split-string \"\:\" \"abc:def:ghi\") - -> (\"abc\" \"def\" \"ghi\") - - (TeX-split-string \" *\" \"dvips -Plw -p3 -c4 testfile.dvi\") - - -> (\"dvips\" \"-Plw\" \"-p3\" \"-c4\" \"testfile.dvi\") - -If REGEXP is nil, or \"\", an error will occur." - - (let ((start 0) - (result '())) - (while (string-match regexp string start) - (let ((match (string-match regexp string start))) - (setq result (cons (substring string start match) result)) - (setq start (match-end 0)))) - (setq result (cons (substring string start nil) result)) - (nreverse result))) - -(defun TeX-directory-absolute-p (dir) - ;; Non-nil iff DIR is the name of an absolute directory. - (if (memq system-type '(ms-dos emx windows-nt)) - (string-match "^\\([A-Za-z]:\\)?/" dir) - (string-match "^/" dir))) - -(defun TeX-parse-path (env) - ;; Return a list if private TeX directories found in environment - ;; variable ENV. - (let* ((value (getenv env)) - (entries (and value (TeX-split-string ":" value))) - entry - answers) - (while entries - (setq entry (car entries)) - (setq entries (cdr entries)) - (or (string-match "/$" entry) - (setq entry (concat entry "/"))) - (and (string-match "//$" entry) - (setq entry (substring entry 0 -1))) - (or (not (TeX-directory-absolute-p entry)) - (member entry TeX-macro-global) - (string-equal "/" entry) - (setq answers (cons entry answers)))) - answers)) - -(defcustom TeX-macro-private (append (TeX-parse-path "TEXINPUTS") - (TeX-parse-path "BIBINPUTS")) - "Directories where you store your personal TeX macros. -Each must end with a slash." - :group 'TeX-file - :type '(repeat (file :format "%v"))) - -(defcustom TeX-auto-private (mapcar (function (lambda (entry) - (concat entry TeX-auto-local))) - TeX-macro-private) - "List of directories containing automatically generated information. -Must end with a slash. - -These correspond to the personal TeX macros." - :group 'TeX-file - :type '(repeat (file :format "%v"))) - -(if (stringp TeX-auto-private) ;Backward compatibility - (setq TeX-auto-private (list TeX-auto-private))) - -(defcustom TeX-style-private (mapcar (function (lambda (entry) - (concat entry - TeX-style-local))) - TeX-macro-private) - "List of directories containing hand generated information. -Must end with a slash. - -These correspond to the personal TeX macros." - :group 'TeX-file - :type '(repeat (file :format "%v"))) - -(if (stringp TeX-style-private) ;Backward compatibility - (setq TeX-style-private (list TeX-style-private))) - -(defcustom TeX-style-path - (let ((path)) - (mapcar (function (lambda (file) (if file (setq path (cons file path))))) - (append (list TeX-auto-global TeX-style-global) - TeX-auto-private TeX-style-private - (list TeX-auto-local TeX-style-local))) - path) - "List of directories to search for AUC TeX style files." - :group 'TeX-file - :type '(repeat (file :format "%v"))) - -(defcustom TeX-check-path - (append (list "./") TeX-macro-private TeX-macro-global) - "Directory path to search for dependencies. - -If nil, just check the current file. -Used when checking if any files have changed." - :group 'TeX-file - :type '(repeat (file :format "%v"))) - -;;; Style Files - -(defvar TeX-style-hook-list nil - "List of TeX style hooks currently loaded. - -Each entry is a list where the first element is the name of the style, -and the remaining elements are hooks to be run when that style is -active.") - -(defcustom TeX-byte-compile nil - "*Not nil means try to byte compile auto files before loading." - :group 'TeX-parse - :type 'boolean) - -(defun TeX-load-style (style) - "Search for and load each definition for style in TeX-style-path." - (cond ((assoc style TeX-style-hook-list)) ; We already found it - ((string-match "\\`\\(.+/\\)\\([^/]*\\)\\'" style) ;Complex path - (let* ((dir (substring style (match-beginning 1) (match-end 1))) - (style (substring style (match-beginning 2) (match-end 2))) - (TeX-style-path (append (list (concat dir TeX-auto-local) - (concat dir TeX-style-local)) - TeX-style-path))) - (TeX-load-style style))) - (t ;Relative path - ;; Insert empty list to mark the fact that we have searched. - (setq TeX-style-hook-list (cons (list style) TeX-style-hook-list)) - ;; Now check each element of the path - (mapcar (function (lambda (name) - (TeX-load-style-file (if (string-match "/$" name) - (concat name style) - (concat name "/" style))))) - TeX-style-path)))) - -(defun TeX-load-style-file (file) - ;; Load FILE checking for a lisp extensions. - (let ((el (concat file ".el")) - (elc (concat file ".elc"))) - (cond ((and (null TeX-byte-compile) - (file-readable-p el)) - (load-file el)) - ((file-newer-than-file-p el elc) - (if (not (file-writable-p elc)) - (load-file el) - (byte-compile-file el) - (load-file elc))) - ((file-readable-p elc) - (load-file elc)) - ((file-readable-p el) - (load-file el))))) - -(defun TeX-add-style-hook (style hook) - "Give STYLE yet another HOOK to run." - (let ((entry (assoc style TeX-style-hook-list))) - (if (null entry) - (setq TeX-style-hook-list (cons (list style hook) TeX-style-hook-list)) - (setcdr entry (cons hook (cdr entry)))))) - -(defun TeX-unload-style (style) - "Forget that we once loaded STYLE." - (cond ((null (assoc style TeX-style-hook-list))) - ((equal (car (car TeX-style-hook-list)) style) - (setq TeX-style-hook-list (cdr TeX-style-hook-list))) - (t - (let ((entry TeX-style-hook-list)) - (while (not (equal (car (car (cdr entry))) style)) - (setq entry (cdr entry))) - (setcdr entry (cdr (cdr entry))))))) - -(defcustom TeX-virgin-style (if (and TeX-auto-global - (file-directory-p TeX-auto-global)) - "virtex" - "NoVirtexSymbols") - "Style all documents use." - :group 'TeX-parse - :type 'string) - -(defvar TeX-active-styles nil - "List of styles currently active in the document.") - - (make-variable-buffer-local 'TeX-active-styles) - -(defun TeX-run-style-hooks (&rest styles) - "Run the TeX following style hooks." - (mapcar (function - (lambda (style) - (if (TeX-member style TeX-active-styles 'string-equal) - () ;Avoid recursion. - (setq TeX-active-styles - (cons style TeX-active-styles)) - (TeX-load-style style) - (if (string-match "\\`\\(.+/\\)\\([^/]*\\)\\'" style) - (setq style ; Complex path - (substring style (match-beginning 2) (match-end 2)))) - (mapcar 'funcall - (cdr-safe (assoc style TeX-style-hook-list)))))) - styles)) - -(defcustom TeX-parse-self nil - "Parse file after loading it if no style hook is found for it." - :group 'TeX-parse - :type 'boolean) - -(defvar TeX-style-hook-applied-p nil - "Nil, unless the style specific hooks have been applied.") - (make-variable-buffer-local 'TeX-style-hook-applied-p) - -(defun TeX-update-style (&optional force) - "Run style specific hooks for the current document. - -Only do this if it has not been done before, or if optional argument -FORCE is not nil." - - (if (or (eq TeX-auto-update 'BibTeX) ; Not a real TeX buffer - (and (not force) TeX-style-hook-applied-p)) - () - (setq TeX-style-hook-applied-p t) - (message "Applying style hooks...") - (TeX-run-style-hooks (TeX-strip-extension nil nil t)) - ;; Run parent style hooks if it has a single parent that isn't itself. - (if (or (not (memq TeX-master '(nil t))) - (and (buffer-file-name) - (string-match TeX-one-master - (file-name-nondirectory (buffer-file-name))))) - (TeX-run-style-hooks (TeX-master-file))) - - (if (and TeX-parse-self - (null (cdr-safe (assoc (TeX-strip-extension nil nil t) - TeX-style-hook-list)))) - (TeX-auto-apply)) - - (message "Applying style hooks... done"))) - -(defvar TeX-remove-style-hook nil - "List of hooks to call when we remove the style specific information.") - (make-variable-buffer-local 'TeX-remove-style-hook) - -(defun TeX-remove-style () - "Remnove all style specific information." - (setq TeX-style-hook-applied-p nil) - (run-hooks 'TeX-remove-style-hooks) - (setq TeX-active-styles (list TeX-virgin-style))) - -(defun TeX-style-list () - "Return a list of all styles (subfils) use by the current document." - (TeX-update-style) - TeX-active-styles) - -;;; Special Characters - -(defvar TeX-esc "\\" "The TeX escape character.") - (make-variable-buffer-local 'TeX-esc) - -(defvar TeX-grop "{" "The TeX group opening character.") - (make-variable-buffer-local 'TeX-grop) - -(defvar TeX-grcl "}" "The TeX group closing character.") - (make-variable-buffer-local 'TeX-grcl) - -;;; Symbols - -;; Must be before keymaps. - -(defgroup TeX-macro nil - "Support for TeX macros in AUC TeX." - :prefix "TeX-" - :group 'TeX) - -(defcustom TeX-complete-word 'ispell-complete-word - "*Function to call for completing non-macros in tex-mode." - :group 'TeX-macro) - -(defvar TeX-complete-list nil - "List of ways to complete the preceding text. - -Each entry is a list with the following elements: - -0. Regexp matching the preceding text. -1. A number indicating the subgroup in the regexp containing the text. -2. A function returning an alist of possible completions. -3. Text to append after a succesful completion. - -Or alternatively: - -0. Regexp matching the preceding text. -1. Function to do the actual completion.") - -(defun TeX-complete-symbol () - "Perform completion on TeX/LaTeX symbol preceding point." - (interactive "*") - (let ((list TeX-complete-list) - entry) - (while list - (setq entry (car list) - list (cdr list)) - (if (TeX-looking-at-backward (car entry) 250) - (setq list nil))) - (if (numberp (nth 1 entry)) - (let* ((sub (nth 1 entry)) - (close (nth 3 entry)) - (begin (match-beginning sub)) - (end (match-end sub)) - (pattern (TeX-match-buffer 0)) - (symbol (buffer-substring begin end)) - (list (funcall (nth 2 entry))) - (completion (try-completion symbol list))) - (cond ((eq completion t) - (and close - (not (looking-at (regexp-quote close))) - (insert close))) - ((null completion) - (error "Can't find completion for \"%s\"" pattern)) - ((not (string-equal symbol completion)) - (delete-region begin end) - (insert completion) - (and close - (eq (try-completion completion list) t) - (not (looking-at (regexp-quote close))) - (insert close))) - (t - (message "Making completion list...") - (let ((list (all-completions symbol list nil))) - (with-output-to-temp-buffer "*Completions*" - (display-completion-list list))) - (message "Making completion list...done")))) - (funcall (nth 1 entry))))) - -(defcustom TeX-default-macro "ref" - "*The default macro when creating new ones with TeX-insert-macro." - :group 'TeX-macro - :type 'string) - - (make-variable-buffer-local 'TeX-default-macro) - -(defcustom TeX-insert-braces t - "*If non-nil, append a empty pair of braces after inserting a macro." - :group 'TeX-macro - :type 'string) - -(defun TeX-math-mode-p () - "Are we in TeX math mode?" - ;; This should check for dollar signs, but thats to hard for now. - (and (boundp 'LaTeX-math-mode) LaTeX-math-mode)) - -(defun TeX-insert-macro (symbol) - "Insert TeX macro with completion. - -AUC TeX knows of some macros, and may query for extra arguments." - (interactive (list (completing-read (concat "Macro (default " - TeX-default-macro - "): " - TeX-esc) - (TeX-symbol-list)))) - (cond ((string-equal symbol "") - (setq symbol TeX-default-macro)) - ((interactive-p) - (setq TeX-default-macro symbol))) - (TeX-parse-macro symbol (cdr-safe (assoc symbol (TeX-symbol-list))))) - -(defvar TeX-electric-macro-map nil) - -(if TeX-electric-macro-map - () - (setq TeX-electric-macro-map (copy-keymap minibuffer-local-completion-map)) - (define-key TeX-electric-macro-map " " 'minibuffer-complete-and-exit)) - -(defun TeX-electric-macro () - "Insert TeX macro with completion. - -AUC TeX knows of some macros, and may query for extra arguments. -Space will complete and exit." - (interactive) - (cond ((eq (preceding-char) ?\\) - (call-interactively 'self-insert-command)) - ((eq (preceding-char) ?.) - (let ((TeX-default-macro " ") - (minibuffer-local-completion-map TeX-electric-macro-map)) - (call-interactively 'TeX-insert-macro))) - (t - (let ((minibuffer-local-completion-map TeX-electric-macro-map)) - (call-interactively 'TeX-insert-macro))))) - -(defun TeX-parse-macro (symbol args) - "How to parse TeX macros which takes one or more arguments." - - ;; First argument is the name of the macro. - - ;; If called with no additional arguments, insert macro with point - ;; inside braces. Otherwise, each argument of this function should - ;; match an argument to the TeX macro. What is done depend on the - ;; argument type. - - ;; string: Use the string as a prompt to prompt for the argument. - - ;; number: Insert that many braces, leave point inside the first. - - ;; nil: Insert empty braces. - - ;; t: Insert empty braces, leave point between the braces. - - ;; other symbols: Call the symbol as a function. You can define - ;; your own hook, or use one of the predefined argument hooks. If - ;; you add new hooks, you can assume that point is placed directly - ;; after the previous argument, or after the macro name if this is - ;; the first argument. Please leave point located efter the - ;; argument you are inserting. If you want point to be located - ;; somewhere else after all hooks have been processed, set the value - ;; of `exit-mark'. It will point nowhere, until the argument hook - ;; set it. By convention, these hook all start with `TeX-arg-'. - - ;; list: If the car is a string, insert it as a prompt and the next - ;; element as initial input. Otherwise, call the car of the list - ;; with the remaining elements as arguments. - - ;; vector: Optional argument. If it has more than one element, - ;; parse it as a list, otherwise parse the only element as above. - ;; Use square brackets instead of curly braces, and is not inserted - ;; on empty user input. - - (insert TeX-esc symbol) - (let ((exit-mark (make-marker)) - (position (point))) - (TeX-parse-arguments args) - (cond ((marker-position exit-mark) - (goto-char (marker-position exit-mark)) - (set-marker exit-mark nil)) - ((and TeX-insert-braces - (equal position (point)) - (string-match "[a-zA-Z]+" symbol) - (not (TeX-math-mode-p))) - (insert TeX-grop TeX-grcl))))) - -(defun TeX-arg-string (optional &optional prompt input) - "Prompt for a string." - (TeX-argument-insert - (read-string (TeX-argument-prompt optional prompt "Text") input) - optional)) - -(defun TeX-parse-arguments (args) - "Parse TeX macro arguments. - -See TeX-parse-macro for details." - (let ((last-optional-rejected nil)) - (while args - (if (vectorp (car args)) - (if last-optional-rejected - () - (let ((< LaTeX-optop) - (> LaTeX-optcl)) - (TeX-parse-argument t (if (equal (length (car args)) 1) - (aref (car args) 0) - (append (car args) nil))))) - (let ((< TeX-grop) - (> TeX-grcl)) - (setq last-optional-rejected nil) - (TeX-parse-argument nil (car args)))) - (setq args (cdr args))))) - -(defun TeX-parse-argument (optional arg) - "Depending on OPTIONAL, insert TeX macro argument ARG in curly braces. -If OPTIONAL is set, only insert if there is anything to insert, and -then use scare brackets. - -See TeX-parse-macro for details." - - (cond ((stringp arg) - (TeX-arg-string optional arg)) - ((numberp arg) - (if (< arg 1) - () - (TeX-parse-argument optional t) - (while (> arg 1) - (TeX-parse-argument optional nil) - (setq arg (- arg 1))))) - ((null arg) - (insert < >)) - ((eq arg t) - (insert < ) - (set-marker exit-mark (point)) - (insert >)) - ((symbolp arg) - (funcall arg optional)) - ((listp arg) - (let ((head (car arg)) - (tail (cdr arg))) - (cond ((stringp head) - (apply 'TeX-arg-string optional arg)) - ((symbolp head) - (apply head optional tail)) - (t (error "Unknown list argument type %s" - (prin1-to-string head)))))) - (t (error "Unknown argument type %s" (prin1-to-string arg))))) - -(defun TeX-argument-insert (name optional &optional prefix) - "Insert NAME surrounded by curly braces. - -If OPTIONAL, only insert it if not empty, and then use scuare brackets." - (if (and optional (string-equal name "")) - (setq last-optional-rejected t) - (insert <) - (if prefix - (insert prefix)) - (if (and (string-equal name "") - (null (marker-position exit-mark))) - (set-marker exit-mark (point)) - (insert name)) - (insert >))) - -(defun TeX-argument-prompt (optional prompt default &optional complete) - "Return a argument prompt. - -If OPTIONAL is not nil then the prompt will start with ``(Optional) ''. - -PROMPT will be used if not nil, otherwise use DEFAULT. - -Unless optional argument COMPLETE is non-nil, ``: '' will be appended." - (concat (if optional "(Optional) " "") - (if prompt prompt default) - (if complete "" ": "))) - -;;; The Mode - -(defvar TeX-format-list - '(("AMSTEX" ams-tex-mode - "\\\\document\\b") - ("LATEX" latex-mode - "\\\\\\(begin\\|section\\|chapter\\|documentstyle\\|documentclass\\)\\b") - ("TEX" plain-tex-mode ".")) - "*List of format packages to consider when choosing a TeX mode. - -A list with a entry for each format package available at the site. - -Each entry is a list with three elements. - -1. The name of the format package. -2. The name of the major mode. -3. A regexp typically matched in the beginning of the file. - -When entering tex-mode, each regexp is tried in turn in order to find -when major mode to enter.") - -(defcustom TeX-default-mode 'latex-mode - "*Mode to enter for a new file when it can't be determined whether -the file is plain TeX or LaTeX or what." - :group 'AUC-TeX - :type '(radio (function-item latex-mode) - (function-item plain-tex-mode) - (function :tag "Other"))) - -(defcustom TeX-force-default-mode nil - "*If set to nil, try to infer the mode of the file from its -content." - :group 'AUC-TeX - :type 'boolean) - -;;; Do not ;;;###autoload because of conflict with standard tex-mode.el. -(defun tex-mode () - "Major mode for editing files of input for TeX or LaTeX. -Tries to guess whether this file is for plain TeX or LaTeX. - -The algorithm is as follows: - - 1) if the file is empty or TeX-force-default-mode is not set to nil, - TeX-default-mode is chosen - 2) If \\documentstyle or \\begin{, \\section{, \\part{ or \\chapter{ is - found, latex-mode is selected. - 3) Otherwise, use plain-tex-mode " - (interactive) - - (funcall (if (or (equal (buffer-size) 0) - TeX-force-default-mode) - TeX-default-mode - (save-excursion - (goto-char (point-min)) - (let ((comment-start-skip ;Used by TeX-in-comment - (concat - "\\(\\(^\\|[^\\]\\)\\(" - (regexp-quote TeX-esc) - (regexp-quote TeX-esc) - "\\)*\\)\\(%+ *\\)")) - (entry TeX-format-list) - answer) - (while (and entry (not answer)) - (if (re-search-forward (nth 2 (car entry)) - 10000 t) - (if (not (TeX-in-comment)) - (setq answer (nth 1 (car entry)))) - (setq entry (cdr entry)))) - (if answer - answer - TeX-default-mode)))))) - -;;; Do not ;;;###autoload because of conflict with standard tex-mode.el. -(defun plain-tex-mode () - "Major mode for editing files of input for plain TeX. -See info under AUC TeX for documentation. - -Special commands: -\\{TeX-mode-map} - -Entering plain-tex-mode calls the value of text-mode-hook, -then the value of TeX-mode-hook, and then the value -of plain-TeX-mode-hook." - (interactive) - (plain-TeX-common-initialization) - (setq mode-name "TeX") - (setq major-mode 'plain-tex-mode) - (setq TeX-command-default "TeX") - (run-hooks 'text-mode-hook 'TeX-mode-hook 'plain-TeX-mode-hook)) - -;;;###autoload -(defun ams-tex-mode () - "Major mode for editing files of input for AmS TeX. -See info under AUC TeX for documentation. - -Special commands: -\\{TeX-mode-map} - -Entering AmS-tex-mode calls the value of text-mode-hook, -then the value of TeX-mode-hook, and then the value -of AmS-TeX-mode-hook." - (interactive) - (plain-TeX-common-initialization) - (setq mode-name "AmS TeX") - (setq major-mode 'ams-tex-mode) - (setq TeX-command-default "AmSTeX") - (run-hooks 'text-mode-hook 'TeX-mode-hook 'AmS-TeX-mode-hook)) - -(defun VirTeX-common-initialization () - ;; Initialize - (kill-all-local-variables) - (setq local-abbrev-table text-mode-abbrev-table) - (setq indent-tabs-mode nil) - - ;; Ispell support - (make-local-variable 'ispell-parser) - (setq ispell-parser 'tex) - (make-local-variable 'ispell-tex-p) - (setq ispell-tex-p t) - - ;; Redefine some standard varaibles - (make-local-variable 'paragraph-start) - (make-local-variable 'paragraph-separate) - (make-local-variable 'comment-start) - (setq comment-start "%") - (make-local-variable 'comment-start-skip) - (setq comment-start-skip - (concat - "\\(\\(^\\|[^\\]\\)\\(" - (regexp-quote TeX-esc) - (regexp-quote TeX-esc) - "\\)*\\)\\(%+ *\\)")) - (make-local-variable 'comment-indent-hook) - (setq comment-indent-hook 'TeX-comment-indent) - (make-local-variable 'comment-multi-line) - (setq comment-multi-line nil) - (make-local-variable 'compile-command) - (if (boundp 'compile-command) - () - (setq compile-command "make")) - (make-local-variable 'words-include-escapes) - (setq words-include-escapes nil) - - ;; Make TAB stand out - ;; (make-local-variable 'buffer-display-table) - ;; (setq buffer-display-table (if standard-display-table - ;; (copy-sequence standard-display-table) - ;; (make-display-table))) - ;; (aset buffer-display-table ?\t (apply 'vector (append "" nil))) - - ;; Symbol completion. - (make-local-variable 'TeX-complete-list) - (setq TeX-complete-list - (list (list "\\\\\\([a-zA-Z]*\\)" - 1 'TeX-symbol-list (if TeX-insert-braces "{}")) - (list "" TeX-complete-word))) - - ;; We want this to be early in the list, so we do not add it before - ;; we enter TeX mode the first time. - (if (boundp 'local-write-file-hooks) - (add-hook 'local-write-file-hooks 'TeX-safe-auto-write) - (add-hook 'write-file-hooks 'TeX-safe-auto-write)) - (make-local-variable 'TeX-auto-update) - (setq TeX-auto-update t)) - -(defun plain-TeX-common-initialization () - ;; Common initialization for plain TeX like modes. - (VirTeX-common-initialization) - (use-local-map plain-TeX-mode-map) - (easy-menu-add TeX-mode-menu plain-TeX-mode-map) - (easy-menu-add plain-TeX-mode-menu plain-TeX-mode-map) - (set-syntax-table TeX-mode-syntax-table) - (setq paragraph-start - (concat - "\\(^[ \t]*$" - "\\|" (regexp-quote TeX-esc) "par\\|" - "^[ \t]*" - (regexp-quote TeX-esc) - "\\(" - "begin\\|end\\|part\\|chapter\\|" - "section\\|subsection\\|subsubsection\\|" - "paragraph\\|include\\|includeonly\\|" - "tableofcontents\\|appendix\\|label\\|caption\\|" - "\\[\\|\\]" ; display math delimitors - "\\)" - "\\|" - "^[ \t]*\\$\\$" ; display math delimitor - "\\)" )) - (setq paragraph-separate - (concat - "\\(" - (regexp-quote TeX-esc) - "par\\|" - "^[ \t]*$\\|" - "^[ \t]*" - (regexp-quote TeX-esc) - "\\(" - "begin\\|end\\|label\\|caption\\|part\\|chapter\\|" - "section\\|subsection\\|subsubsection\\|" - "paragraph\\|include\\|includeonly\\|" - "tableofcontents\\|appendix\\|" (regexp-quote TeX-esc) - "\\)" - "\\)")) - (setq TeX-header-end (regexp-quote "%**end of header")) - (setq TeX-trailer-start (regexp-quote (concat TeX-esc "bye"))) - (TeX-run-style-hooks "TEX")) - -;;; Hilighting - -(if (boundp 'hilit-patterns-alist) - (let ((latex-patterns (cdr-safe (assq 'latex-mode hilit-patterns-alist))) - (plain-tex-patterns (cdr-safe (assq 'plain-tex-mode - hilit-patterns-alist)))) - (if (and latex-patterns plain-tex-patterns) - (setq hilit-patterns-alist - (append (list (cons 'ams-tex-mode plain-tex-patterns)) - hilit-patterns-alist))))) - -;;; Parsing - -(defgroup TeX-parse nil - "Parsing TeX files from AUC TeX." - :group 'AUC-TeX) - -(defvar TeX-auto-parser '((styles TeX-auto-file TeX-run-style-hooks))) -;; Alist of parsed information. -;; Each entry is a list with the following elements: -;; -;; 0. Name of information type. -;; 1. Name of temporary variable used when parsing. -;; 2. Name of function to add information to add to #3. -;; 3. Name of variable holding buffer local information. -;; 4. Name of variable indicating that #3 has changed. - - -(defconst TeX-auto-parser-temporary 1) -(defconst TeX-auto-parser-add 2) -(defconst TeX-auto-parser-local 3) -(defconst TeX-auto-parser-change 4) - -(defun TeX-auto-add-type (name prefix &optional plural) - "Add information about name to the parser using PREFIX. - -Optional third argument PLURAL is the plural form of TYPE. -By default just add a `s'. - -This function create a set of variables and functions to maintain a -separate type of information in the parser." - (let* ((names (or plural (concat name "s"))) - (tmp (intern (concat prefix "-auto-" name))) - (add (intern (concat prefix "-add-" names))) - (local (intern (concat prefix "-" name "-list"))) - (change (intern (concat prefix "-" name "-changed")))) - (setq TeX-auto-parser - (cons (list name tmp add local change) TeX-auto-parser)) - (set local nil) - (make-variable-buffer-local local) - (set change nil) - (make-variable-buffer-local change) - (fset add (list 'lambda '(&rest entries) - (concat "Add information about " (upcase name) - " to the current buffer.") - (list 'TeX-auto-add-information name 'entries))) - (fset local (list 'lambda nil - (concat "List of " names - " active in the current buffer.") - (list 'TeX-auto-list-information name))) - (add-hook 'TeX-remove-style-hook - (list 'lambda nil (list 'setq (symbol-name local) nil))))) - -(defun TeX-auto-add-information (name entries) - ;; For NAME in `TeX-auto-parser' add ENTRIES. - (let* ((entry (assoc name TeX-auto-parser)) - (change (nth TeX-auto-parser-change entry)) - (change-value (symbol-value change)) - (local (nth TeX-auto-parser-local entry)) - (local-value (symbol-value local))) - (if change-value - (set local (cons entries local-value)) - (set change t) - (set local (list entries local-value))))) - -(defun TeX-auto-list-information (name) - ;; Return information in `TeX-auto-parser' about NAME. - (TeX-update-style) - (let* ((entry (assoc name TeX-auto-parser)) - (change (nth TeX-auto-parser-change entry)) - (change-value (symbol-value change)) - (local (nth TeX-auto-parser-local entry))) - (if (not change-value) - () - (set change nil) - ;; Sort it - (message "Sorting " name "...") - (set local - (sort (mapcar 'TeX-listify (apply 'append (symbol-value local))) - 'TeX-car-string-lessp)) - ;; Make it unique - (message "Removing duplicates...") - (let ((entry (symbol-value local))) - (while (and entry (cdr entry)) - (let ((this (car entry)) - (next (car (cdr entry)))) - (if (not (string-equal (car this) (car next))) - (setq entry (cdr entry)) - ;; We have two equal symbols. Use the one with - ;; most arguments. - (if (> (length next) (length this)) - (setcdr this (cdr next))) - (setcdr entry (cdr (cdr entry))))))) - (message "Removing duplicates... done")) - (symbol-value local))) - -(TeX-auto-add-type "symbol" "TeX") - -(defvar TeX-auto-apply-hook nil - "Hook run when a buffer is parsed and the information is applied.") - -(defun TeX-auto-apply () - ;; Parse and apply TeX information in the current buffer. - (TeX-auto-parse) - (run-hooks 'TeX-auto-apply-hook) - (mapcar 'TeX-auto-apply-entry TeX-auto-parser)) - -(defun TeX-auto-apply-entry (entry) - ;; Apply the information in an entry in `TeX-auto-parser'. - (let ((value (symbol-value (nth TeX-auto-parser-temporary entry))) - (add (nth TeX-auto-parser-add entry))) - (if value (apply add value)))) - -(defun TeX-safe-auto-write () - ;; Call TeX-auto-write safely - (condition-case name - (and (boundp 'TeX-auto-update) - TeX-auto-update - (TeX-auto-write)) - (error nil)) - ;; Continue with the other write file hooks. - nil) - -(defcustom TeX-auto-save nil - "*Automatically save style information when saving the buffer." - :group 'TeX-parse - :type 'boolean) - -(defcustom TeX-auto-untabify t - "*Automatically untabify when saving the buffer." - :group 'TeX-parse - :type 'boolean) - -(defun TeX-auto-write () - ;; Save all relevant TeX information from the current buffer. - (if TeX-auto-untabify - (untabify (point-min) (point-max))) - (if (and TeX-auto-save TeX-auto-local) - (let* ((file (concat (TeX-master-directory) - TeX-auto-local - (if (string-match "/$" TeX-auto-local) "" "/") - (TeX-strip-extension nil TeX-all-extensions t) - ".el")) - (dir (file-name-directory file))) - ;; Create auto directory if possible. - (if (not (file-exists-p dir)) - (condition-case name - (make-directory (substring dir 0 -1)) - (error nil))) - (if (file-writable-p file) - (save-excursion - (TeX-update-style) - (TeX-auto-store file)) - (message "Can't write style information."))))) - -(defcustom TeX-macro-default (car-safe TeX-macro-private) - "*Default directory to search for TeX macros." - :group 'TeX-file - :type 'directory) - -(defcustom TeX-auto-default (car-safe TeX-auto-private) - "*Default directory to place automatically generated TeX information." - :group 'TeX-file - :type 'directory) - -;;;###autoload -(defun TeX-auto-generate (tex auto) - "Generate style file for TEX and store it in AUTO. -If TEX is a directory, generate style files for all files in the directory." - (interactive (list (setq TeX-macro-default - (expand-file-name (read-file-name - "TeX file or directory: " - TeX-macro-default - TeX-macro-default 'confirm))) - (setq TeX-auto-default - (expand-file-name (read-file-name - "AUTO lisp directory: " - TeX-auto-default - TeX-auto-default 'confirm))))) - (cond ((not (file-readable-p tex))) - ((string-match TeX-ignore-file tex)) - ((file-directory-p tex) - (let ((files (directory-files tex)) - (default-directory (concat (if (TeX-directory-absolute-p tex) - "" - default-directory) - (if (string-match "/$" tex) - tex - (concat tex "/"))))) - (mapcar (function (lambda (file) - (if (or TeX-file-recurse - (not (file-directory-p file))) - (TeX-auto-generate file auto)))) - files))) - ((not (file-newer-than-file-p tex - (concat auto (if (string-match "/$" auto) "" "/") - (TeX-strip-extension tex TeX-all-extensions t) ".el")))) - ((TeX-match-extension tex (append TeX-file-extensions - BibTeX-file-extensions)) - (save-excursion - (set-buffer (find-file-noselect tex)) - (message "Parsing %s..." tex) - (TeX-auto-store (concat auto - (if (string-match "/$" auto) "" "/") - (TeX-strip-extension tex - TeX-all-extensions - t) - ".el")) - (kill-buffer (current-buffer)) - (message "Parsing %s... done" tex))))) - -;;;###autoload -(defun TeX-auto-generate-global () - "Create global auto directory for global TeX macro definitions." - (interactive) - (if (file-directory-p - (if (string-match "/$" TeX-auto-global) - (substring TeX-auto-global 0 -1) - TeX-auto-global)) - nil - (make-directory (if (string-match "/$" TeX-auto-global) - (substring TeX-auto-global 0 -1) - TeX-auto-global))) - (mapcar (function (lambda (macro) (TeX-auto-generate macro TeX-auto-global))) - TeX-macro-global) - (byte-recompile-directory TeX-auto-global 0)) - -(defun TeX-auto-store (file) - ;; Extract information for auc tex from current buffer and store it in FILE. - (TeX-auto-parse) - - (if (member nil (mapcar 'TeX-auto-entry-clear-p TeX-auto-parser)) - (let ((style (TeX-strip-extension nil TeX-all-extensions t))) - (TeX-unload-style style) - (save-excursion - (set-buffer (generate-new-buffer file)) - (erase-buffer) - (insert "(TeX-add-style-hook \"" style "\"\n" - " (function\n" - " (lambda ()") - (mapcar 'TeX-auto-insert TeX-auto-parser) - (insert ")))\n\n") - (write-region (point-min) (point-max) file nil 'silent) - (kill-buffer (current-buffer)))) - (if (file-exists-p (concat file "c")) - (delete-file (concat file "c"))) - (if (file-exists-p file) - (delete-file file)))) - -(defun TeX-auto-entry-clear-p (entry) - ;; Check if the temporary for `TeX-auto-parser' entry ENTRY is clear. - (null (symbol-value (nth TeX-auto-parser-temporary entry)))) - -(defun TeX-auto-insert (entry) - ;; Insert code to initialize ENTRY from `TeX-auto-parser'. - (let ((name (symbol-name (nth TeX-auto-parser-add entry))) - (list (symbol-value (nth TeX-auto-parser-temporary entry)))) - (if (null list) - () - (insert "\n (" name) - (while list - (insert "\n ") - (if (stringp (car list)) - (insert (prin1-to-string (car list))) - (insert "'" (prin1-to-string (car list)))) - (setq list (cdr list))) - (insert ")")))) - -(defvar TeX-auto-ignore - '("csname" "filedate" "fileversion" "docdate" "next" "labelitemi" - "labelitemii" "labelitemiii" "labelitemiv" "labelitemv" - "labelenumi" "labelenumii" "labelenumiii" "labelenumiv" - "labelenumv" "theenumi" "theenumii" "theenumiii" "theenumiv" - "theenumv" "document" "par" "do" "expandafter") - "List of symbols to ignore when scanning a TeX style file.") - -(defun TeX-auto-add-regexp (regexp) - "Add REGEXP to TeX-auto-regexp-list if not already a member." - (if (symbolp TeX-auto-regexp-list) - (setq TeX-auto-regexp-list (symbol-value TeX-auto-regexp-list))) - (or (memq regexp TeX-auto-regexp-list) - (setq TeX-auto-regexp-list (cons regexp TeX-auto-regexp-list)))) - -(defvar TeX-auto-empty-regexp-list - '(("\\(\\'\\`\\)" 1 ignore)) - "List of regular expressions guaranteed to match nothing.") - -(defvar plain-TeX-auto-regexp-list - '(("\\\\def\\\\\\([a-zA-Z]+\\)[^a-zA-Z@]" 1 TeX-auto-symbol-check) - ("\\\\let\\\\\\([a-zA-Z]+\\)[^a-zA-Z@]" 1 TeX-auto-symbol-check) - ("\\\\font\\\\\\([a-zA-Z]+\\)[^a-zA-Z@]" 1 TeX-auto-symbol) - ("\\\\chardef\\\\\\([a-zA-Z]+\\)[^a-zA-Z@]" 1 TeX-auto-symbol) - ("\\\\new\\(count|dimen|muskip|skip\\)\\\\\\([a-z]+\\)[^a-zA-Z@]" - 2 TeX-auto-symbol) - ("\\\\newfont{?\\\\\\([a-zA-Z]+\\)}?" 1 TeX-auto-symbol) - ("\\\\typein\\[\\\\\\([a-zA-Z]+\\)\\]" 1 TeX-auto-symbol) - ("\\\\input +\\(\\.*[^#%\\\\\\.\n\r]+\\)\\(\\.[^#%\\\\\\.\n\r]+\\)?" - 1 TeX-auto-file) - ("\\\\mathchardef\\\\\\([a-zA-Z]+\\)[^a-zA-Z@]" 1 TeX-auto-symbol)) - "List of regular expression matching common LaTeX macro definitions.") - -(defvar TeX-auto-full-regexp-list plain-TeX-auto-regexp-list - "Full list of regular expression matching TeX macro definitions.") - -(defvar TeX-auto-prepare-hook nil - "List of hooks to be called before parsing a TeX file.") - -(defvar TeX-auto-cleanup-hook nil - "List of hooks to be called after parsing a TeX file.") - -(defcustom TeX-auto-parse-length 999999 - "*Maximal length of TeX file that will be parsed." - :group 'TeX-parse - :type 'integer) - (make-variable-buffer-local 'TeX-auto-parse-length) - -(defun TeX-auto-parse () - "Parse TeX information in current buffer. - -Call the functions in TeX-auto-prepare-hook before parsing, and the -functions in TeX-auto-cleanup-hook after parsing." - - (let ((case-fold-search nil) - (regexp-list (if (symbolp TeX-auto-regexp-list) - (symbol-value TeX-auto-regexp-list) - TeX-auto-regexp-list))) - - (mapcar 'TeX-auto-clear-entry TeX-auto-parser) - (run-hooks 'TeX-auto-prepare-hook) - - ;; Parse - (save-excursion - (goto-char (min (point-max) TeX-auto-parse-length)) - ;; Extract the information. - (let ((regexp (concat "\\(" - (mapconcat 'car regexp-list "\\)\\|\\(") - "\\)"))) - (while (re-search-backward regexp nil t) - (if (TeX-in-comment) - () - (let* ((entry (TeX-member nil regexp-list - (function (lambda (a b) - (looking-at (nth 0 b)))))) - (symbol (nth 2 entry)) - (match (nth 1 entry))) - (if (fboundp symbol) - (funcall symbol match) - (set symbol (cons (if (listp match) - (mapcar 'TeX-match-buffer match) - (TeX-match-buffer match)) - (symbol-value symbol))))))))) - - ;; Cleanup ignored symbols. - - ;; NOTE: This is O(N M) where it could be O(N log N + M log M) if we - ;; sorted the lists first. - (while (member (car TeX-auto-symbol) TeX-auto-ignore) - (setq TeX-auto-symbol (cdr TeX-auto-symbol))) - (let ((list TeX-auto-symbol)) - (while (and list (cdr list)) - (if (member (car (cdr list)) TeX-auto-ignore) - (setcdr list (cdr (cdr list))) - (setq list (cdr list))))) - - (run-hooks 'TeX-auto-cleanup-hook))) - -(defun TeX-auto-clear-entry (entry) - ;; Set the temporary variable in ENTRY to nil. - (set (nth TeX-auto-parser-temporary entry) nil)) - -(defvar LaTeX-auto-end-symbol nil) - -(defun TeX-auto-symbol-check (match) - "Add MATCH to TeX-auto-symbols. -Check for potential LaTeX environments." - (let ((symbol (if (listp match) - (mapcar 'TeX-match-buffer match) - (TeX-match-buffer match)))) - (if (and (stringp symbol) - (string-match "^end\\(.+\\)$" symbol)) - (setq LaTeX-auto-end-symbol - (cons (substring symbol (match-beginning 1) (match-end 1)) - LaTeX-auto-end-symbol)) - (setq TeX-auto-symbol (cons symbol TeX-auto-symbol))))) - -;;; Utilities -;; -;; Some of these functions has little to do with TeX, but nonetheless we -;; should use the "TeX-" prefix to avoid name clashes. - -(defcustom TeX-auto-regexp-list 'TeX-auto-full-regexp-list - "*List of regular expresions used for parsing the current file." - :type '(radio (variable-item TeX-auto-empty-regexp-list) - (variable-item TeX-auto-full-regexp-list) - (variable-item plain-TeX-auto-regexp-list) - (variable-item LaTeX-auto-minimal-regexp-list) - (variable-item LaTeX-auto-label-regexp-list) - (variable-item LaTeX-auto-regexp-list) - (symbol :tag "Other") - (repeat :tag "Specify" - (group (regexp :tag "Match") - (sexp :tag "Groups") - symbol))) - :group 'TeX-parse) - (make-variable-buffer-local 'TeX-auto-regexp-list) - -(defgroup TeX-file-extension nil - "File extensions recognized by AUC TeX." - :group 'TeX-file) - -(defcustom TeX-file-extensions '("tex" "sty" "cls" "ltx" "texi" "texinfo") - "*File extensions used by manually generated TeX files." - :group 'TeX-file-extension - :type '(repeat (string :format "%v"))) - -(defcustom TeX-all-extensions '("[^.\n]+") - "All possible file extensions." - :group 'TeX-file-extension - :type '(repeat (regexp :format "%v"))) - -(defcustom TeX-default-extension "tex" - "*Default extension for TeX files." - :group 'TeX-file-extension - :type 'string) - - (make-variable-buffer-local 'TeX-default-extension) - -(defcustom BibTeX-file-extensions '("bib") - "Valid file extensions for BibTeX files." - :group 'TeX-file-extension - :type '(repeat (string :format "%v"))) - -(defcustom BibTeX-style-extensions '("bst") - "Valid file extensions for BibTeX styles." - :group 'TeX-file-extension - :type '(repeat (string :format "%v"))) - -(defcustom TeX-ignore-file "\\(^\\|/\\)\\(\\.\\|\\.\\.\\|RCS\\|SCCS\\|CVS\\)$" - "*Regular expression matching file names to ignore. - -These files or directories will not be considered when searching for -TeX files in a directory." - :group 'TeX-parse - :type 'regexp) - -(defcustom TeX-file-recurse t - "*If not nil, search TeX directories recursivly." - :group 'TeX-parse - :type 'boolean) - -(defun TeX-match-extension (file &optional extensions) - "Return non-nil if FILE has an one of EXTENSIONS. - -If EXTENSIONS is not specified or nil, the value of -TeX-file-extensions is used instead." - - (if (null extensions) - (setq extensions TeX-file-extensions)) - - (let ((regexp (concat "\\.\\(" - (mapconcat 'identity extensions "\\|") - "\\)$"))) - (string-match regexp file))) - -(defun TeX-strip-extension (&optional string extensions nodir nostrip) - "Return STRING without any trailing extension in EXTENSIONS. -If NODIR is `t', also remove directory part of STRING. -If NODIR is `path', remove directory part of STRING if it is equal to -the current directory, TeX-macro-private or TeX-macro-global. -If NOSTRIP is set, do not remove extension after all. -STRING defaults to the name of the current buffer. -EXTENSIONS defaults to TeX-file-extensions." - - (if (null string) - (setq string (or (buffer-file-name) ""))) - - (if (null extensions) - (setq extensions TeX-file-extensions)) - - (let* ((strip (if (and (not nostrip) - (TeX-match-extension string extensions)) - (substring string 0 (match-beginning 0)) - string)) - (dir (file-name-directory (expand-file-name strip)))) - (if (or (eq nodir t) - (string-equal dir (expand-file-name "./")) - (member dir TeX-macro-global) - (member dir TeX-macro-private)) - (file-name-nondirectory strip) - strip))) - -(defun TeX-search-files (&optional directories extensions nodir strip) - "Return a list of all reachable files in DIRECTORIES ending with EXTENSIONS. -If optional argument NODIR is set, remove directory part. -If optional argument STRIP is set, remove file extension. -If optional argument DIRECTORIES is set, search in those directories. -Otherwise, search in all TeX macro directories. -If optional argument EXTENSIONS is not set, use TeX-file-extensions" - - (if (null extensions) - (setq extensions TeX-file-extensions)) - - (if (null directories) - (setq directories - (cons "./" (append TeX-macro-private TeX-macro-global)))) - - (let (match) - - (while directories - (let* ((directory (car directories)) - (content (and directory - (file-readable-p directory) - (file-directory-p directory) - (directory-files directory)))) - - (setq directories (cdr directories)) - - (while content - (let ((file (concat directory (car content)))) - - (setq content (cdr content)) - (cond ((string-match TeX-ignore-file file)) - ((not (file-readable-p file))) - ((file-directory-p file) - (if TeX-file-recurse - (setq directories - (cons (concat file "/") directories)))) - ((TeX-match-extension file extensions) - (setq match (cons (TeX-strip-extension file - extensions - nodir - (not strip)) - match)))))))) - - match)) - -(defun TeX-car-string-lessp (a b) - (string-lessp (car a) (car b))) - -(defun TeX-listify (a) - (if (listp a) a (list a))) - -(defun TeX-member (elt list how) - "Returns the member ELT in LIST. Comparison done with HOW. - -Return nil if ELT is not a member of LIST." - (while (and list (not (funcall how elt (car list)))) - (setq list (cdr list))) - (car-safe list)) - -(defun TeX-assoc (elem list) - "Like assoc, except case incentive." - (let ((case-fold-search t)) - (TeX-member elem list - (function (lambda (a b) - (string-match (concat "^" (regexp-quote a) "$") - (car b))))))) - -(defun TeX-match-buffer (n) - "Return the substring corresponding to the N'th match. -See match-data for details." - (if (match-beginning n) - (let ((str (buffer-substring (match-beginning n) (match-end n)))) - (set-text-properties 0 (length str) nil str) - (copy-sequence str)) - "")) - -(defun TeX-function-p (arg) - "Return non-nil if ARG is callable as a function." - (or (and (fboundp 'byte-code-function-p) - (byte-code-function-p arg)) - (and (listp arg) - (eq (car arg) 'lambda)) - (and (symbolp arg) - (fboundp arg)))) - -(defun TeX-looking-at-backward (regexp &optional limit) - ;; Return non-nil if the text before point matches REGEXP. - ;; Optional second argument LIMIT gives a max number of characters - ;; to look backward for. - (let ((pos (point))) - (save-excursion - (and (re-search-backward regexp - (if limit (max (point-min) (- (point) limit))) - t) - (eq (match-end 0) pos))))) - -;;; Syntax Table - -(defvar TeX-mode-syntax-table (make-syntax-table) - "Syntax table used while in TeX mode.") - - (make-variable-buffer-local 'TeX-mode-syntax-table) - -(progn ; Define TeX-mode-syntax-table. - (modify-syntax-entry (string-to-char TeX-esc) - "\\" TeX-mode-syntax-table) - (modify-syntax-entry ?\f ">" TeX-mode-syntax-table) - (modify-syntax-entry ?\n ">" TeX-mode-syntax-table) - (modify-syntax-entry (string-to-char TeX-grop) - (concat "(" TeX-grcl) - TeX-mode-syntax-table) - (modify-syntax-entry (string-to-char TeX-grcl) - (concat ")" TeX-grop) - TeX-mode-syntax-table) - (modify-syntax-entry ?% "<" TeX-mode-syntax-table) - (modify-syntax-entry ?\" "." TeX-mode-syntax-table) - (modify-syntax-entry ?& "." TeX-mode-syntax-table) - (modify-syntax-entry ?_ "." TeX-mode-syntax-table) - (modify-syntax-entry ?@ "_" TeX-mode-syntax-table) - (modify-syntax-entry ?~ " " TeX-mode-syntax-table) - (modify-syntax-entry ?$ "$" TeX-mode-syntax-table) - (modify-syntax-entry ?' "w" TeX-mode-syntax-table)) - -;;; Menu Support - -(defvar TeX-command-current 'TeX-command-master) -;; Function used to run external command. - -(defun TeX-command-select-master () - (interactive) - (message "Next command will be on the master file") - (setq TeX-command-current 'TeX-command-master)) - -(defun TeX-command-select-buffer () - (interactive) - (message "Next command will be on the buffer") - (setq TeX-command-current 'TeX-command-buffer)) - -(defun TeX-command-select-region () - (interactive) - (message "Next command will be on the region") - (setq TeX-command-current 'TeX-command-region)) - -(defvar TeX-command-force nil) -;; If non-nil, TeX-command-query will return the value of this -;; variable instead of quering the user. - -(defun TeX-command-menu (name) - ;; Execute TeX-command-list NAME from a menu. - (let ((TeX-command-force name)) - (funcall TeX-command-current))) - -(defun TeX-command-menu-print (printer command name) - ;; Print on PRINTER using method COMMAND to run NAME. - (let ((TeX-printer-default printer) - (TeX-printer-list nil) - (TeX-print-command command)) - (TeX-command-menu name))) - -(defun TeX-command-menu-printer-entry (entry) - ;; Return TeX-printer-list ENTRY as a menu item. - (vector (nth 0 entry) - (list 'TeX-command-menu-print - (nth 0 entry) - (or (nth lookup entry) command) - name) - t)) - -;; Begin fix part 1 by Ulrik Dickow 16-Feb-1996, -;; to make queue command usable. Easy but ugly code duplication again. - -(defun TeX-command-menu-queue (printer command name) - ;; Show queue for PRINTER using method COMMAND to run NAME. - (let ((TeX-printer-default printer) - (TeX-printer-list nil) - (TeX-queue-command command)) - (TeX-command-menu name))) - -(defun TeX-command-menu-queue-entry (entry) - ;; Return TeX-printer-list ENTRY as a menu item. - (vector (nth 0 entry) - (list 'TeX-command-menu-queue - (nth 0 entry) - (or (nth lookup entry) command) - name) - t)) - -;; End fix part 1. - -(defun TeX-command-menu-entry (entry) - ;; Return TeX-command-list ENTRY as a menu item. - (let ((name (car entry))) - (cond ((and (string-equal name TeX-command-Print) - TeX-printer-list) - (let ((command TeX-print-command) - (lookup 1)) - (append (list TeX-command-Print) - (mapcar 'TeX-command-menu-printer-entry - TeX-printer-list)))) - ((and (string-equal name TeX-command-Queue) - TeX-printer-list) - (let ((command TeX-queue-command) - (lookup 2)) - (append (list TeX-command-Queue) - (mapcar 'TeX-command-menu-queue-entry ; dickow fix part 2. - TeX-printer-list)))) - (t - (vector name (list 'TeX-command-menu name) t))))) - -;;; Keymap - -(defcustom TeX-electric-escape nil - "If this is non-nil when AUC TeX is loaded, the TeX escape -character ``\\'' will be bound to `TeX-electric-macro'." - :group 'TeX-macro - :type 'boolean) - -(defvar TeX-mode-map nil - "Keymap for common TeX and LaTeX commands.") - -(if TeX-mode-map - () - (setq TeX-mode-map (make-sparse-keymap)) - - ;; Standard - ;; (define-key TeX-mode-map "\177" 'backward-delete-char-untabify) - (define-key TeX-mode-map "\C-c}" 'up-list) - (define-key TeX-mode-map "\C-c#" 'TeX-normal-mode) - (define-key TeX-mode-map "\C-c\C-n" 'TeX-normal-mode) - (define-key TeX-mode-map "\C-c?" 'describe-mode) - (define-key TeX-mode-map "\C-c\C-i" 'TeX-goto-info-page) - - ;; From tex.el - (define-key TeX-mode-map "\"" 'TeX-insert-quote) - (define-key TeX-mode-map "$" 'TeX-insert-dollar) - (define-key TeX-mode-map "." 'TeX-insert-punctuation) - (define-key TeX-mode-map "," 'TeX-insert-punctuation) - (define-key TeX-mode-map "\C-c{" 'TeX-insert-braces) - (define-key TeX-mode-map "\C-c\C-f" 'TeX-font) - (define-key TeX-mode-map "\C-c\C-m" 'TeX-insert-macro) - (if TeX-electric-escape - (define-key TeX-mode-map "\\" 'TeX-electric-macro)) - (define-key TeX-mode-map "\e\t" 'TeX-complete-symbol) ;*** Emacs 19 way - - (define-key TeX-mode-map "\C-c;" 'TeX-comment-region) - (define-key TeX-mode-map "\C-c%" 'TeX-comment-paragraph) - - (define-key TeX-mode-map "\C-c'" 'TeX-comment-paragraph) ;*** Old way - (define-key TeX-mode-map "\C-c:" 'TeX-un-comment-region) ;*** Old way - (define-key TeX-mode-map "\C-c\"" 'TeX-un-comment) ;*** Old way - - ;; From tex-buf.el - (define-key TeX-mode-map "\C-c\C-d" 'TeX-save-document) - (define-key TeX-mode-map "\C-c\C-r" 'TeX-command-region) - (define-key TeX-mode-map "\C-c\C-b" 'TeX-command-buffer) - (define-key TeX-mode-map "\C-c\C-c" 'TeX-command-master) - (define-key TeX-mode-map "\C-c\C-k" 'TeX-kill-job) - (define-key TeX-mode-map "\C-c\C-l" 'TeX-recenter-output-buffer) - (define-key TeX-mode-map "\C-c^" 'TeX-home-buffer) - (define-key TeX-mode-map "\C-c`" 'TeX-next-error) - (define-key TeX-mode-map "\C-c\C-w" 'TeX-toggle-debug-boxes)) - -(easy-menu-define TeX-mode-menu - TeX-mode-map - "Menu used in TeX mode." - (append '("Command") - '(("Command on" - [ "Master File" TeX-command-select-master - :keys "C-c C-c" :style radio - :selected (eq TeX-command-current 'TeX-command-master) ] - [ "Buffer" TeX-command-select-buffer - :keys "C-c C-b" :style radio - :selected (eq TeX-command-current 'TeX-command-buffer) ] - [ "Region" TeX-command-select-region - :keys "C-c C-r" :style radio - :selected (eq TeX-command-current 'TeX-command-region) ])) - (let ((file 'TeX-command-on-current)) - (mapcar 'TeX-command-menu-entry TeX-command-list)))) - -(defvar plain-TeX-mode-map (copy-keymap TeX-mode-map) - "Keymap used in plain TeX mode.") - -(easy-menu-define plain-TeX-mode-menu - plain-TeX-mode-map - "Menu used in plain TeX mode." - (list "TeX" - ["Macro..." TeX-insert-macro t] - ["Complete" TeX-complete-symbol t] - ["Save Document" TeX-save-document t] - ["Next Error" TeX-next-error t] - ["Kill Job" TeX-kill-job t] - ["Debug Bad Boxes" TeX-toggle-debug-boxes - :style toggle :selected TeX-debug-bad-boxes ] - ["Switch to Original File" TeX-home-buffer t] - ["Recenter Output Buffer" TeX-recenter-output-buffer t] - ;; ["Uncomment" TeX-un-comment t] - ["Uncomment Region" TeX-un-comment-region t] - ;; ["Comment Paragraph" TeX-comment-paragraph t] - ["Comment Region" TeX-comment-region t] - ["Switch to Master file" TeX-home-buffer t] - ["Documentation" TeX-goto-info-page t] - ["Submit bug report" TeX-submit-bug-report t] - ["Reset Buffer" TeX-normal-mode t] - ["Reset AUC TeX" (TeX-normal-mode t) :keys "C-u C-c C-n"])) - -;;; Comments - -(defun TeX-un-comment-region (start end level) - "Remove up to LEVEL comment characters from each line in the region." - (interactive "*r\np") - (comment-region start end (- level))) - -(defun TeX-un-comment (level) - "Delete up to LEVEL %'s from the beginning of each line in a comment." - (interactive "*p") - (save-excursion - ; Find first comment line - (re-search-backward (concat "^[^" comment-start "]") nil 'limit) - (let ((beg (point))) - (forward-line 1) - ; Find last comment line - (re-search-forward (concat "^[^" comment-start "]") nil 'limit) - ; Uncomment region - (comment-region beg (point) (- level))))) - -(fset 'TeX-comment-region 'comment-region) - -(defun TeX-comment-paragraph (level) - "Inserts LEVEL %'s at the beginning of every line in the current paragraph." - (interactive "*p") - (if (< level 0) - (TeX-un-comment (- level)) - (save-excursion - (mark-paragraph) - (comment-region (point) (mark) level)))) - -(defun TeX-in-comment () - ;; Return non-nil if point is in a comment. - (if (or (bolp) - (null comment-start-skip) - (eq (preceding-char) ?\r)) - nil - (save-excursion - (let ((pos (point))) - (re-search-backward "^\\|\r" nil t) - (or (looking-at comment-start-skip) - (re-search-forward comment-start-skip pos t)))))) - -;;; Indentation - -(defgroup TeX-indentation nil - "Indentation of TeX buffers in AUC TeX." - :group 'AUC-TeX) - -(defun TeX-brace-count-line () - "Count number of open/closed braces." - (save-excursion - (save-restriction - (let ((count 0)) - (narrow-to-region (point) - (save-excursion - (re-search-forward "[^\\\\]%\\|\n\\|\\'") - (backward-char) - (point))) - - (while (re-search-forward "\\({\\|}\\|\\\\.\\)" nil t) - (cond - ((string= "{" (TeX-match-buffer 1)) - (setq count (+ count TeX-brace-indent-level))) - ((string= "}" (TeX-match-buffer 1)) - (setq count (- count TeX-brace-indent-level))))) - count)))) - -(defcustom TeX-brace-indent-level 2 - "*The level of indentation produced by a open brace." - :group 'TeX-indentation - :type 'integer) - -(defun TeX-comment-indent () - (if (looking-at "%%%") - (current-column) - (skip-chars-backward " \t") - (max (if (bolp) 0 (1+ (current-column))) - comment-column))) - -;;; Fonts - -(defcustom TeX-font-list '((?\C-b "{\\bf " "}") - (?\C-c "{\\sc " "}") - (?\C-e "{\\em " "\\/}") - (?\C-i "{\\it " "\\/}") - (?\C-r "{\\rm " "}") - (?\C-s "{\\sl " "\\/}") - (?\C-t "{\\tt " "}") - (?\C-d "" "" t)) - "List of fonts used by TeX-font. - -Each entry is a list with three elements. The first element is the -key to active the font. The second element is the string to insert -before point, and the third element is the string to insert after -point. An optional fourth element means always replace if not nil." - :group 'TeX-macro - :type '(repeat (group (character :tag "Key") - (string :tag "Prefix") - (string :tag "Suffix") - (option (sexp :format "Replace\n" - :value t))))) - -(defvar TeX-font-replace-function 'TeX-font-replace - "Determines the function which is called when a font should be replaced.") - -(defun TeX-describe-font-entry (entry) - ;; A textual description of an ENTRY in TeX-font-list. - (concat (format "%8s\t" (key-description (char-to-string (nth 0 entry)))) - (if (nth 3 entry) - "-- delete font" - (format "%10s %s" (nth 1 entry) (nth 2 entry))))) - -(defun TeX-font (replace what) - "Insert template for font change command. -If REPLACE is not nil, replace current font. WHAT determines the font -to use, as specified by TeX-font-list." - (interactive "*P\nc") - (TeX-update-style) - (let* ((entry (assoc what TeX-font-list))) - (setq replace (or replace (nth 3 entry))) - (cond ((null entry) - (let ((help (concat "Font list:\n\n" - (mapconcat 'TeX-describe-font-entry - TeX-font-list "\n")))) - (with-output-to-temp-buffer "*Help*" - (set-buffer "*Help*") - (insert help)))) - (replace - (funcall TeX-font-replace-function (nth 1 entry) (nth 2 entry))) - ((TeX-active-mark) - (save-excursion - (cond ((> (mark) (point)) - (insert (nth 1 entry)) - (goto-char (mark)) - (insert (nth 2 entry))) - (t - (insert (nth 2 entry)) - (goto-char (mark)) - (insert (nth 1 entry)))))) - (t - (insert (nth 1 entry)) - (save-excursion - (insert (nth 2 entry))))))) -(defun TeX-font-replace (start end) - "Replace font specification around point with START and END." - (save-excursion - (while (not (looking-at "{\\\\[a-zA-Z]+ ")) - (up-list -1)) - (forward-sexp) - (save-excursion - (replace-match start t t)) - (if (save-excursion - (backward-char 3) - (if (looking-at (regexp-quote "\\/}")) - (progn - (delete-char 3) - nil) - t)) - (delete-backward-char 1)) - (insert end))) - -;;; Dollars -;; -;; Originally stolen from VorTeX. -;; Copyright (C) 1986, 1987, 1988 Pehong Chen (phc@renoir.berkeley.edu) - -(defvar TeX-dollar-sign ?$ - "*Character user to enter and leaver math mode in TeX.") - -(defconst TeX-dollar-string (char-to-string TeX-dollar-sign)) - -(defconst TeX-dollar-regexp - (concat "^" (regexp-quote TeX-dollar-string) "\\|[^" TeX-esc "]" - (regexp-quote TeX-dollar-string))) - -(defvar TeX-dollar-list nil) - (make-variable-buffer-local 'TeX-match-dollar-on) - -(defvar TeX-par-start nil) - (make-variable-buffer-local 'TeX-par-start) - -(defvar TeX-par-end nil) - (make-variable-buffer-local 'TeX-par-end) - -(defvar TeX-symbol-marker nil) - -(defvar TeX-symbol-marker-pos 0) - -(defun TeX-bouncing-point (m) - (save-excursion - (if (pos-visible-in-window-p) - (sit-for 1) - (let* ((pos1 (point)) - (pos2 (+ pos1 m)) - (sym (buffer-substring pos1 pos2)) - (msg1 (progn (beginning-of-line) (buffer-substring (point) pos1))) - (msg2 (progn (end-of-line) (buffer-substring pos2 (point))))) - (message "%s`%s'%s" msg1 sym msg2))))) - -(defun TeX-locate-delimiter (pos sym symlst) - (let ((marker nil) - (marker-pos 0) - (pair t) - (head nil)) - (catch 'loop - (while symlst - (setq marker (car symlst)) - (setq marker-pos (1- (marker-position marker))) - (if (and (/= pos marker-pos) (= (char-after marker-pos) sym)) - (if (> pos marker-pos) - (progn - (setq TeX-symbol-marker-pos marker-pos) - (setq TeX-symbol-marker marker) - (setq head (cons marker head)) - (setq pair (not pair))) - (if pair (setq TeX-symbol-marker nil)) - (throw 'loop (append (reverse head) - (cons (set-marker (make-marker) (1+ pos)) - symlst))))) - (setq symlst (cdr symlst))) - (if pair (setq TeX-symbol-marker nil)) - (reverse (cons (set-marker (make-marker) (1+ pos)) head))))) - -(defun TeX-dollar-verify () - ;; Verify if the current paragraph is the same as last. - ;; If so, do nothing, otherwise reset TeX-par-start and TeX-par-end and - ;; reconstruct the symbol-list. - (let ((start (save-excursion - (if (re-search-backward paragraph-separate nil t) - (point) - 1))) - (end (save-excursion - (if (re-search-forward paragraph-separate nil t) - (1+ (point)) - (1+ (point-max))))) - (init nil)) - (if (null TeX-par-start) - (setq TeX-par-start (set-marker (make-marker) 1))) - (if (/= (marker-position TeX-par-start) start) - (progn - (set-marker TeX-par-start start) - (setq init t))) - (if (null TeX-par-end) - (setq TeX-par-end (set-marker (make-marker) 1))) - (if (/= (marker-position TeX-par-end) end) - (progn - (set-marker TeX-par-end end) - (setq init t))) - (if init - (save-excursion - (setq TeX-dollar-list nil) - (goto-char start) - (while (re-search-forward TeX-dollar-regexp end t) - (setq TeX-dollar-list - (append TeX-dollar-list - (list (set-marker (make-marker) - (if (= (following-char) - TeX-dollar-sign) - (progn - (forward-char 1) - (point)) - (point))))))))))) - -(defun TeX-insert-dollar (&optional arg) - "Insert dollar sign. - -Show matching dollar sign if this dollar sign end the TeX math mode. -Ensure double dollar signs match up correctly by inserting extra -dollar signs when needed. - -With optional ARG, insert that many dollar signs." - (interactive "P") - (if arg - (let ((count (prefix-numeric-value arg))) - (if (listp arg) - (self-insert-command 1) ;C-u always inserts just one - (self-insert-command count))) - (let ((pc (preceding-char)) - (pos (point)) - (pt (point)) - (single t)) - (TeX-dollar-verify) - (if (= pc (string-to-char TeX-esc)) - (insert TeX-dollar-sign) - (if (and (= pc TeX-dollar-sign) - (/= (char-after (- (point) 2)) (string-to-char TeX-esc))) - (progn - (setq single nil) - (if (and (> pos 2) (= (char-after (- pos 2)) TeX-dollar-sign)) - (setq pt (1- pos)) ; Doesn't echo 3rd $, if $$ already - (backward-char 1) - (insert TeX-dollar-sign) - (goto-char (1+ pos)))) - (insert TeX-dollar-sign)) - (setq TeX-dollar-list - (TeX-locate-delimiter pt TeX-dollar-sign TeX-dollar-list)) - (if TeX-symbol-marker - (save-excursion - (goto-char TeX-symbol-marker-pos) - (if (and (= (preceding-char) TeX-dollar-sign) - (/= (char-after (- (point) 2)) TeX-dollar-sign)) - (progn - (backward-char 1) - (if single - (save-excursion - (goto-char pos) - (insert TeX-dollar-sign)))) ; $$foo$`$' - (if (not single) - (progn - (insert TeX-dollar-sign) ; `$'$foo$$ - (backward-char 1)))) - (TeX-bouncing-point (if single 1 2)))))))) - -;;; Simple Commands - -(defun TeX-normal-mode (arg) - "Remove all information about this buffer, and apply the style hooks again. -Save buffer first including style information. -With optional argument, also reload the style hooks." - (interactive "*P") - (if arg - (setq TeX-style-hook-list nil - BibTeX-global-style-files nil - BibTeX-global-files nil - TeX-global-input-files nil)) - (let ((TeX-auto-save t)) - (if (buffer-modified-p) - (save-buffer) - (TeX-auto-write))) - (normal-mode) - (TeX-update-style)) - -(defgroup TeX-quote nil - "Quoting in AUC TeX." - :group 'AUC-TeX) - -(defcustom TeX-open-quote "``" - "*String inserted by typing \\[TeX-insert-quote] to open a quotation." - :group 'TeX-quote - :type 'string) - -(defcustom TeX-close-quote "''" - "*String inserted by typing \\[TeX-insert-quote] to close a quotation." - :group 'TeX-quote - :type 'string) - -(defcustom TeX-quote-after-quote nil - "*Behaviour of \\[TeX-insert-quote]. Nil means standard behaviour; -when non-nil, opening and closing quotes are inserted only after \"." - :group 'TeX-quote - :type 'boolean) - -;;;###autoload -(defun TeX-insert-quote (arg) - "Insert the appropriate quote marks for TeX. -Inserts the value of `TeX-open-quote' (normally ``) or `TeX-close-quote' -\(normally '') depending on the context. If `TeX-quote-after-quote' -is non-nil, this insertion works only after \". -With prefix argument, always inserts \" characters." - (interactive "*P") - (if arg - (self-insert-command (prefix-numeric-value arg)) - (TeX-update-style) - (if TeX-quote-after-quote - (insert (cond ((bobp) - ?\") - ((not (= (preceding-char) ?\")) - ?\") - ((save-excursion - (forward-char -1) - (bobp)) - (delete-backward-char 1) - TeX-open-quote) - ((save-excursion - (forward-char -2) ;;; at -1 there is double quote - (looking-at "[ \t\n]\\|\\s(")) - (delete-backward-char 1) - TeX-open-quote) - (t - (delete-backward-char 1) - TeX-close-quote))) - (insert (cond ((bobp) - TeX-open-quote) - ((= (preceding-char) (string-to-char TeX-esc)) - ?\") - ((= (preceding-char) ?\") - ?\") - ((save-excursion - (forward-char (- (length TeX-open-quote))) - (looking-at (regexp-quote TeX-open-quote))) - (delete-backward-char (length TeX-open-quote)) - ?\") - ((save-excursion - (forward-char (- (length TeX-close-quote))) - (looking-at (regexp-quote TeX-close-quote))) - (delete-backward-char (length TeX-close-quote)) - ?\") - ((save-excursion - (forward-char -1) - (looking-at "[ \t\n]\\|\\s(")) - TeX-open-quote) - (t - TeX-close-quote)))))) - -;; For the sake of BibTeX... -;;; Do not ;;;###autoload because of conflict with standard tex-mode.el. -(fset 'tex-insert-quote 'TeX-insert-quote) - -(defun TeX-insert-punctuation () - "Insert point or comma, cleaning up preceding space." - (interactive) - (if (TeX-looking-at-backward "\\\\/\\(}+\\)" 50) - (replace-match "\\1" t)) - (call-interactively 'self-insert-command)) - -(defun TeX-insert-braces (arg) - "Make a pair of braces around next ARG sexps and leave point inside. -No argument is equivalent to zero: just insert braces and leave point -between." - (interactive "P") - (insert TeX-grop) - (save-excursion - (if arg (forward-sexp (prefix-numeric-value arg))) - (insert TeX-grcl))) - -(defun TeX-goto-info-page () - "Read documentation for AUC TeX in the info system." - (interactive) - (require 'info) - (Info-goto-node "(auctex)")) - -;;;###autoload -(defun TeX-submit-bug-report () - "Submit via mail a bug report on AUC TeX" - (interactive) - (require 'reporter) - (reporter-submit-bug-report - "auc-tex@sunsite.auc.dk" - (concat "AUC TeX " AUC-TeX-version) - (list 'window-system - 'LaTeX-version - 'TeX-style-path - 'TeX-auto-save - 'TeX-parse-self - 'TeX-master) - nil nil - "Remember to cover the basics, that is, what you expected to happen and -what in fact did happen.")) - -;;; Ispell Support - -;; The FSF ispell.el use this. -(defun ispell-tex-buffer-p () - (and (boundp 'ispell-tex-p) ispell-tex-p)) - -;; The FSF ispell.el might one day use this. -(setq ispell-enable-tex-parser t) - -(defun TeX-run-ispell (command string file) - "Run ispell on current TeX buffer." - (cond ((and (string-equal file (TeX-region-file)) - (fboundp 'ispell-region)) - (call-interactively 'ispell-region)) - ((string-equal file (TeX-region-file)) - (call-interactively 'spell-region)) - ((fboundp 'ispell-buffer) - (ispell-buffer)) - ((fboundp 'ispell) - (ispell)) - (t - (spell-buffer)))) - -;; Some versions of ispell 3 use this. -(defvar ispell-tex-major-modes nil) -(setq ispell-tex-major-modes - (append '(plain-tex-mode ams-tex-mode latex-mode) - ispell-tex-major-modes)) - -(provide 'tex) - -;;; tex.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/cc-mode/auto-autoloads.el --- a/lisp/cc-mode/auto-autoloads.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/cc-mode/auto-autoloads.el Mon Aug 13 09:51:16 2007 +0200 @@ -9,7 +9,9 @@ ;;;*** -;;;### (autoloads (java-mode objc-mode c++-mode c-mode) "cc-mode" "cc-mode/cc-mode.el") +;;;### (autoloads (idl-mode java-mode objc-mode c++-mode c-mode c-initialize-cc-mode) "cc-mode" "cc-mode/cc-mode.el") + +(autoload 'c-initialize-cc-mode "cc-mode" nil nil nil) (autoload 'c-mode "cc-mode" "\ Major mode for editing K&R and ANSI C code. @@ -80,6 +82,23 @@ Key bindings: \\{java-mode-map}" t nil) +(autoload 'idl-mode "cc-mode" "\ +Major mode for editing CORBA's IDL code. +To submit a problem report, enter `\\[c-submit-bug-report]' from an +idl-mode buffer. This automatically sets up a mail buffer with +version information already added. You just need to add a description +of the problem, including a reproducible test case, and send the +message. + +To see what version of CC Mode you are running, enter `\\[c-version]'. + +The hook variable `idl-mode-hook' is run with no args, if that +variable is bound and has a non-nil value. Also the hook +`c-mode-common-hook' is run first. + +Key bindings: +\\{idl-mode-map}" t nil) + ;;;*** ;;;### (autoloads (c-add-style c-set-style) "cc-styles" "cc-mode/cc-styles.el") diff -r 6866abce6aaf -r 6075d714658b lisp/cc-mode/cc-align.el --- a/lisp/cc-mode/cc-align.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/cc-mode/cc-align.el Mon Aug 13 09:51:16 2007 +0200 @@ -7,7 +7,7 @@ ;; 1985 Richard M. Stallman ;; Maintainer: cc-mode-help@python.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: 5.13 +;; Version: 5.14 ;; Keywords: c languages oop ;; This file is part of GNU Emacs. diff -r 6866abce6aaf -r 6075d714658b lisp/cc-mode/cc-cmds.el --- a/lisp/cc-mode/cc-cmds.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/cc-mode/cc-cmds.el Mon Aug 13 09:51:16 2007 +0200 @@ -7,7 +7,7 @@ ;; 1985 Richard M. Stallman ;; Maintainer: cc-mode-help@python.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: 5.13 +;; Version: 5.14 ;; Keywords: c languages oop ;; This file is part of GNU Emacs. diff -r 6866abce6aaf -r 6075d714658b lisp/cc-mode/cc-compat.el --- a/lisp/cc-mode/cc-compat.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/cc-mode/cc-compat.el Mon Aug 13 09:51:16 2007 +0200 @@ -5,7 +5,7 @@ ;; Author: 1994-1997 Barry A. Warsaw ;; Maintainer: cc-mode-help@python.org ;; Created: August 1994, split from cc-mode.el -;; Version: 5.13 +;; Version: 5.14 ;; Keywords: c languages oop ;; This file is part of GNU Emacs. diff -r 6866abce6aaf -r 6075d714658b lisp/cc-mode/cc-defs.el --- a/lisp/cc-mode/cc-defs.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/cc-mode/cc-defs.el Mon Aug 13 09:51:16 2007 +0200 @@ -7,7 +7,7 @@ ;; 1985 Richard M. Stallman ;; Maintainer: cc-mode-help@python.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: 5.13 +;; Version: 5.14 ;; Keywords: c languages oop ;; This file is part of GNU Emacs. diff -r 6866abce6aaf -r 6075d714658b lisp/cc-mode/cc-engine.el --- a/lisp/cc-mode/cc-engine.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/cc-mode/cc-engine.el Mon Aug 13 09:51:16 2007 +0200 @@ -7,7 +7,7 @@ ;; 1985 Richard M. Stallman ;; Maintainer: cc-mode-help@python.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: 5.13 +;; Version: 5.14 ;; Keywords: c languages oop ;; This file is part of GNU Emacs. @@ -57,7 +57,7 @@ (setq saved (point)) t)) (progn (c-backward-syntactic-ws lim) - (memq (char-before) '(?\; ?{ ?} ?:))) + (memq (char-before) '(?\; ?{ ?:))) ) (setq last-begin saved) (goto-char last-begin) @@ -1249,6 +1249,8 @@ (if inclass-p (progn (goto-char (aref inclass-p 1)) + (or (= (point) (c-point 'boi)) + (goto-char (aref inclass-p 0))) (if inextern-p (c-add-syntax 'inextern-lang) (c-add-syntax 'inclass (c-point 'boi))))) diff -r 6866abce6aaf -r 6075d714658b lisp/cc-mode/cc-langs.el --- a/lisp/cc-mode/cc-langs.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/cc-mode/cc-langs.el Mon Aug 13 09:51:16 2007 +0200 @@ -7,7 +7,7 @@ ;; 1985 Richard M. Stallman ;; Maintainer: cc-mode-help@python.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: 5.13 +;; Version: 5.14 ;; Keywords: c languages oop ;; This file is part of GNU Emacs. @@ -195,17 +195,8 @@ For use with the variable `java-mode-hook'." (c-set-style "java")) -(defvar c-styles-are-initialized nil) - (defun c-common-init () ;; Common initializations for all modes. - (if c-styles-are-initialized - nil - (require 'cc-styles) - (c-initialize-builtin-style) - (if c-style-variables-are-local-p - (c-make-styles-buffer-local)) - (setq c-styles-are-initialized t)) ;; these variables should always be buffer local; they do not affect ;; indentation style. (make-local-variable 'paragraph-start) @@ -428,7 +419,7 @@ ;; Support for C (defvar c-mode-abbrev-table nil - "Abbrev table in use in c-mode buffers.") + "Abbreviation table used in c-mode buffers.") (define-abbrev-table 'c-mode-abbrev-table ()) (defvar c-mode-map () @@ -466,7 +457,7 @@ ;; Support for C++ (defvar c++-mode-abbrev-table nil - "Abbrev table in use in c++-mode buffers.") + "Abbreviation table used in c++-mode buffers.") (define-abbrev-table 'c++-mode-abbrev-table ()) (defvar c++-mode-map () @@ -504,7 +495,7 @@ ;; Support for Objective-C (defvar objc-mode-abbrev-table nil - "Abbrev table in use in objc-mode buffers.") + "Abbreviation table used in objc-mode buffers.") (define-abbrev-table 'objc-mode-abbrev-table ()) (defvar objc-mode-map () @@ -534,7 +525,7 @@ ;; Support for Java (defvar java-mode-abbrev-table nil - "Abbrev table in use in java-mode buffers.") + "Abbreviation table used in java-mode buffers.") (define-abbrev-table 'java-mode-abbrev-table ()) (defvar java-mode-map () @@ -561,5 +552,34 @@ (c-mode-menu "Java")) +;; Support for CORBA's IDL language + +(defvar idl-mode-abbrev-table nil + "Abbreviation table used in idl-mode buffers.") +(define-abbrev-table 'idl-mode-abbrev-table ()) + +(defvar idl-mode-map () + "Keymap used in idl-mode buffers.") +(if idl-mode-map + nil + (setq idl-mode-map (c-make-inherited-keymap)) + ;; additional bindings + (define-key idl-mode-map "/" 'c-electric-slash)) + +(defvar idl-mode-syntax-table nil + "Syntax table used in idl-mode buffers.") +(if idl-mode-syntax-table + nil + (setq idl-mode-syntax-table (make-syntax-table)) + (c-populate-syntax-table idl-mode-syntax-table) + ;; add extra comment syntax + (c-setup-dual-comments idl-mode-syntax-table) + ) + +(easy-menu-define c-idl-menu idl-mode-map "IDL Mode Commands" + (c-mode-menu "IDL")) + + + (provide 'cc-langs) ;;; cc-langs.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/cc-mode/cc-menus.el --- a/lisp/cc-mode/cc-menus.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/cc-mode/cc-menus.el Mon Aug 13 09:51:16 2007 +0200 @@ -7,7 +7,7 @@ ;; 1985 Richard M. Stallman ;; Maintainer: cc-mode-help@python.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: 5.13 +;; Version: 5.14 ;; Keywords: c languages oop ;; This file is part of GNU Emacs. diff -r 6866abce6aaf -r 6075d714658b lisp/cc-mode/cc-mode.el --- a/lisp/cc-mode/cc-mode.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/cc-mode/cc-mode.el Mon Aug 13 09:51:16 2007 +0200 @@ -7,7 +7,7 @@ ;; 1985 Richard M. Stallman ;; Maintainer: cc-mode-help@python.org ;; Created: a long, long, time ago. adapted from the original c-mode.el -;; Version: 5.13 +;; Version: 5.14 ;; Keywords: c languages oop ;; NOTE: Read the commentary below for the right way to submit bug reports! @@ -33,15 +33,15 @@ ;;; Commentary: ;; This package provides GNU Emacs major modes for editing C, C++, -;; Objective-C, and Java code. As of the latest Emacs and XEmacs +;; Objective-C, Java and IDL code. As of the latest Emacs and XEmacs ;; releases, it is the default package for editing these languages. ;; This package is called "CC Mode", and should be spelled exactly -;; this way. It supports K&R and ANSI C, ANSI C++, Objective-C, and -;; Java, with a consistent indentation model across all modes. This -;; indentation model is intuitive and very flexible, so that almost -;; any desired style of indentation can be supported. Installation, -;; usage, and programming details are contained in an accompanying -;; texinfo manual. +;; this way. It supports K&R and ANSI C, ANSI C++, Objective-C, Java, +;; and CORBA's IDL with a consistent indentation model across all +;; modes. This indentation model is intuitive and very flexible, so +;; that almost any desired style of indentation can be supported. +;; Installation, usage, and programming details are contained in an +;; accompanying texinfo manual. ;; CC Mode's immediate ancestors were, c++-mode.el, cplus-md.el, and ;; cplus-md1.el.. @@ -61,14 +61,6 @@ ;; cc-mode-help@python.org. Please do not send bugs or questions to ;; my personal account. -;; YOU CAN IGNORE ALL BYTE-COMPILER WARNINGS. They are the result of -;; the cross-Emacsen support. GNU Emacs 19 (from the FSF), GNU XEmacs -;; 19 (formerly Lucid Emacs), and GNU Emacs 18 all do things -;; differently and there's no way to shut the byte-compiler up at the -;; necessary granularity. Let me say this again: YOU CAN IGNORE ALL -;; BYTE-COMPILER WARNINGS (you'd be surprised at how many people don't -;; follow this advice :-). - ;; Many, many thanks go out to all the folks on the beta test list. ;; Without their patience, testing, insight, code contributions, and ;; encouragement CC Mode would be a far inferior package. @@ -97,16 +89,24 @@ ;; (require 'cc-mode) ;; (c-initialize-cc-mode) +;;;###autoload (defun c-initialize-cc-mode () ;; make sure all necessary components of CC Mode are loaded in. - (require 'cc-vars) - (require 'cc-engine) - (require 'cc-langs) - (require 'cc-menus) - (require 'cc-align) - (require 'cc-styles) - (require 'cc-cmds)) - + (let ((initprop 'cc-mode-is-initialized)) + (require 'cc-vars) + (require 'cc-engine) + (require 'cc-langs) + (require 'cc-menus) + (require 'cc-align) + (require 'cc-styles) + (require 'cc-cmds) + ;; run the initialization hook, but only once + (or (get 'c-initialize-cc-mode initprop) + (progn + (c-initialize-builtin-style) + (run-hooks 'c-initialization-hook) + (put 'c-initialize-cc-mode initprop t))) + )) ;;;###autoload @@ -277,8 +277,49 @@ (c-update-modeline)) +;;;###autoload +(defun idl-mode () + "Major mode for editing CORBA's IDL code. +To submit a problem report, enter `\\[c-submit-bug-report]' from an +idl-mode buffer. This automatically sets up a mail buffer with +version information already added. You just need to add a description +of the problem, including a reproducible test case, and send the +message. + +To see what version of CC Mode you are running, enter `\\[c-version]'. + +The hook variable `idl-mode-hook' is run with no args, if that +variable is bound and has a non-nil value. Also the hook +`c-mode-common-hook' is run first. + +Key bindings: +\\{idl-mode-map}" + (interactive) + (c-initialize-cc-mode) + (kill-all-local-variables) + (set-syntax-table idl-mode-syntax-table) + (setq major-mode 'idl-mode + mode-name "IDL" + local-abbrev-table idl-mode-abbrev-table) + (use-local-map idl-mode-map) + (c-common-init) + (setq comment-start "// " + comment-end "" + comment-multi-line nil + c-conditional-key c-C++-conditional-key + c-comment-start-regexp c-C++-comment-start-regexp + c-class-key c-C++-class-key + c-access-key c-C++-access-key + c-double-slash-is-comments-p t + c-recognize-knr-p nil) +;; imenu-generic-expression cc-imenu-c++-generic-expression) + (run-hooks 'c-mode-common-hook) + (run-hooks 'idl-mode-hook) + (c-update-modeline)) + + ;; defuns for submitting bug reports -(defconst c-version "5.13" +(defconst c-version "5.14" "CC Mode version number.") (defconst c-mode-help-address diff -r 6866abce6aaf -r 6075d714658b lisp/cc-mode/cc-styles.el --- a/lisp/cc-mode/cc-styles.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/cc-mode/cc-styles.el Mon Aug 13 09:51:16 2007 +0200 @@ -7,7 +7,7 @@ ;; 1985 Richard M. Stallman ;; Maintainer: cc-mode-help@python.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: 5.13 +;; Version: 5.14 ;; Keywords: c languages oop ;; This file is part of GNU Emacs. @@ -128,6 +128,8 @@ ("java" (c-basic-offset . 2) (c-comment-only-line-offset . (0 . 0)) + ;; the following preserves Javadoc starter lines + (c-hanging-comment-starter-p . nil) (c-offsets-alist . ((topmost-intro-cont . +) (statement-block-intro . +) (knr-argdecl-intro . 5) @@ -209,17 +211,19 @@ ;; Recursively set the base style. If no base style is given, the ;; default base style is "cc-mode" and the recursion stops. Be sure ;; to detect loops. - (if (not (string-equal style "cc-mode")) - (let ((base (if (stringp (car basestyles)) - (downcase (car basestyles)) - "cc-mode"))) - (if (memq base basestyles) - (error "Style loop detected: %s in %s" base basestyles)) - (c-set-style-2 base (cons base basestyles)))) (let ((vars (cdr (or (assoc (downcase style) c-style-alist) (assoc (upcase style) c-style-alist) (assoc style c-style-alist) (error "Undefined style: %s" style))))) + (if (not (string-equal style "cc-mode")) + (let ((base (if (stringp (car vars)) + (prog1 + (downcase (car vars)) + (setq vars (cdr vars))) + "cc-mode"))) + (if (memq base basestyles) + (error "Style loop detected: %s in %s" base basestyles)) + (c-set-style-2 base (cons base basestyles)))) (mapcar 'c-set-style-1 vars))) (defvar c-set-style-history nil) @@ -239,6 +243,7 @@ (completing-read prompt c-style-alist nil t (cons c-indentation-style 0) 'c-set-style-history)))) + (c-initialize-builtin-style) (c-set-style-2 stylename nil) (setq c-indentation-style stylename) (c-keep-region-active)) @@ -577,7 +582,10 @@ ))) ;; the default style is now GNU. This can be overridden in ;; c-mode-common-hook or {c,c++,objc,java}-mode-hook. - (c-set-style c-site-default-style)))) + (c-set-style c-site-default-style))) + (if c-style-variables-are-local-p + (c-make-styles-buffer-local))) + (defun c-make-styles-buffer-local () "Make all CC Mode style variables buffer local. diff -r 6866abce6aaf -r 6075d714658b lisp/cc-mode/cc-vars.el --- a/lisp/cc-mode/cc-vars.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/cc-mode/cc-vars.el Mon Aug 13 09:51:16 2007 +0200 @@ -7,7 +7,7 @@ ;; 1985 Richard M. Stallman ;; Maintainer: cc-mode-help@python.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: 5.13 +;; Version: 5.14 ;; Keywords: c languages oop ;; This file is part of GNU Emacs. @@ -353,11 +353,23 @@ :type 'hook :group 'c) +(defcustom idl-mode-hook nil + "*Hook called by `idl-mode'." + :type 'hook + :group 'c) + (defcustom c-mode-common-hook nil "*Hook called by all CC Mode modes for common initializations." :type '(hook :format "%{CC Mode Common Hook%}:\n%v") :group 'c) +(defcustom c-initialization-hook nil + "*Hook called when the CC Mode package gets initialized. +This hook is only run once per Emacs session and can be used as a +`load-hook' or in place of using `eval-after-load'." + :type 'hook + :group 'c) + ;; Non-customizable variables, still part of the interface to CC Mode diff -r 6866abce6aaf -r 6075d714658b lisp/comint/custom-load.el --- a/lisp/comint/custom-load.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/comint/custom-load.el Mon Aug 13 09:51:16 2007 +0200 @@ -1,10 +1,10 @@ -(custom-put 'telnet 'custom-loads '("telnet")) -(custom-put 'ssh 'custom-loads '("ssh")) -(custom-put 'shell-faces 'custom-loads '("shell")) -(custom-put 'shell-directories 'custom-loads '("shell")) +(custom-put 'background 'custom-loads '("background")) +(custom-put 'comint 'custom-loads '("comint-xemacs" "comint" "telnet")) +(custom-put 'comint-completion 'custom-loads '("comint")) +(custom-put 'comint-source 'custom-loads '("comint")) +(custom-put 'rlogin 'custom-loads '("rlogin")) (custom-put 'shell 'custom-loads '("shell")) -(custom-put 'rlogin 'custom-loads '("rlogin")) -(custom-put 'comint-source 'custom-loads '("comint")) -(custom-put 'comint-completion 'custom-loads '("comint")) -(custom-put 'comint 'custom-loads '("comint-xemacs" "comint" "telnet")) -(custom-put 'background 'custom-loads '("background")) +(custom-put 'shell-directories 'custom-loads '("shell")) +(custom-put 'shell-faces 'custom-loads '("shell")) +(custom-put 'ssh 'custom-loads '("ssh")) +(custom-put 'telnet 'custom-loads '("telnet")) diff -r 6866abce6aaf -r 6075d714658b lisp/custom/custom-load.el --- a/lisp/custom/custom-load.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/custom/custom-load.el Mon Aug 13 09:51:16 2007 +0200 @@ -1,53 +1,53 @@ -(custom-put 'widget-button 'custom-loads '("wid-edit")) -(custom-put 'widget-faces 'custom-loads '("wid-edit")) -(custom-put 'widget-documentation 'custom-loads '("wid-edit")) -(custom-put 'widgets 'custom-loads '("wid-browse" "wid-edit")) -(custom-put 'widget-browse 'custom-loads '("wid-browse")) -(custom-put 'custom-magic-faces 'custom-loads '("cus-edit")) -(custom-put 'windows 'custom-loads '()) -(custom-put 'processes-basics 'custom-loads '()) -(custom-put 'auto-save 'custom-loads '()) -(custom-put 'keyboard 'custom-loads '()) -(custom-put 'minibuffer 'custom-loads '()) -(custom-put 'debug 'custom-loads '()) -(custom-put 'limits 'custom-loads '()) -(custom-put 'dired 'custom-loads '()) -(custom-put 'execute 'custom-loads '()) -(custom-put 'display 'custom-loads '()) -(custom-put 'editing-basics 'custom-loads '()) -(custom-put 'fill 'custom-loads '()) -(custom-put 'modeline 'custom-loads '()) -(custom-put 'undo 'custom-loads '()) -(custom-put 'alloc 'custom-loads '()) -(custom-put 'custom-menu 'custom-loads '("cus-edit")) -(custom-put 'custom-buffer 'custom-loads '("cus-edit")) -(custom-put 'custom-browse 'custom-loads '("cus-edit")) -(custom-put 'custom-faces 'custom-loads '("cus-edit")) -(custom-put 'customize 'custom-loads '("cus-edit" "wid-edit" "cus-face")) +(custom-put 'emacs 'custom-loads '("cus-edit")) +(custom-put 'editing 'custom-loads '("cus-edit")) +(custom-put 'abbrev 'custom-loads '("cus-edit")) +(custom-put 'matching 'custom-loads '()) +(custom-put 'mouse 'custom-loads '()) +(custom-put 'external 'custom-loads '("cus-edit")) +(custom-put 'processes 'custom-loads '("cus-edit")) +(custom-put 'programming 'custom-loads '("cus-edit")) +(custom-put 'languages 'custom-loads '("cus-edit")) +(custom-put 'lisp 'custom-loads '()) +(custom-put 'applications 'custom-loads '("cus-edit")) +(custom-put 'calendar 'custom-loads '()) +(custom-put 'development 'custom-loads '("cus-edit")) +(custom-put 'extensions 'custom-loads '("wid-edit")) +(custom-put 'internal 'custom-loads '("cus-edit")) +(custom-put 'maint 'custom-loads '()) +(custom-put 'environment 'custom-loads '("cus-edit")) +(custom-put 'i18n 'custom-loads '("cus-edit")) +(custom-put 'x 'custom-loads '()) +(custom-put 'frames 'custom-loads '()) +(custom-put 'data 'custom-loads '()) +(custom-put 'files 'custom-loads '("cus-edit")) +(custom-put 'wp 'custom-loads '("cus-edit")) +(custom-put 'faces 'custom-loads '("cus-edit" "wid-edit")) +(custom-put 'hypermedia 'custom-loads '("wid-edit")) +(custom-put 'help 'custom-loads '("cus-edit")) (custom-put 'local 'custom-loads '()) -(custom-put 'help 'custom-loads '("cus-edit")) -(custom-put 'hypermedia 'custom-loads '("wid-edit")) -(custom-put 'faces 'custom-loads '("cus-edit" "wid-edit")) -(custom-put 'wp 'custom-loads '("cus-edit")) -(custom-put 'files 'custom-loads '("cus-edit")) -(custom-put 'data 'custom-loads '()) -(custom-put 'frames 'custom-loads '()) -(custom-put 'x 'custom-loads '()) -(custom-put 'i18n 'custom-loads '("cus-edit")) -(custom-put 'environment 'custom-loads '("cus-edit")) -(custom-put 'maint 'custom-loads '()) -(custom-put 'internal 'custom-loads '("cus-edit")) -(custom-put 'extensions 'custom-loads '("wid-edit")) -(custom-put 'development 'custom-loads '("cus-edit")) -(custom-put 'calendar 'custom-loads '()) -(custom-put 'applications 'custom-loads '("cus-edit")) -(custom-put 'lisp 'custom-loads '()) -(custom-put 'languages 'custom-loads '("cus-edit")) -(custom-put 'programming 'custom-loads '("cus-edit")) -(custom-put 'processes 'custom-loads '("cus-edit")) -(custom-put 'external 'custom-loads '("cus-edit")) -(custom-put 'mouse 'custom-loads '()) -(custom-put 'matching 'custom-loads '()) -(custom-put 'abbrev 'custom-loads '("cus-edit")) -(custom-put 'editing 'custom-loads '("cus-edit")) -(custom-put 'emacs 'custom-loads '("cus-edit")) +(custom-put 'customize 'custom-loads '("cus-edit" "wid-edit" "cus-face")) +(custom-put 'custom-faces 'custom-loads '("cus-edit")) +(custom-put 'custom-browse 'custom-loads '("cus-edit")) +(custom-put 'custom-buffer 'custom-loads '("cus-edit")) +(custom-put 'custom-menu 'custom-loads '("cus-edit")) +(custom-put 'alloc 'custom-loads '()) +(custom-put 'undo 'custom-loads '()) +(custom-put 'modeline 'custom-loads '()) +(custom-put 'fill 'custom-loads '()) +(custom-put 'editing-basics 'custom-loads '()) +(custom-put 'display 'custom-loads '()) +(custom-put 'execute 'custom-loads '()) +(custom-put 'dired 'custom-loads '()) +(custom-put 'limits 'custom-loads '()) +(custom-put 'debug 'custom-loads '()) +(custom-put 'minibuffer 'custom-loads '()) +(custom-put 'keyboard 'custom-loads '()) +(custom-put 'auto-save 'custom-loads '()) +(custom-put 'processes-basics 'custom-loads '()) +(custom-put 'windows 'custom-loads '()) +(custom-put 'custom-magic-faces 'custom-loads '("cus-edit")) +(custom-put 'widget-browse 'custom-loads '("wid-browse")) +(custom-put 'widgets 'custom-loads '("wid-browse" "wid-edit")) +(custom-put 'widget-documentation 'custom-loads '("wid-edit")) +(custom-put 'widget-faces 'custom-loads '("wid-edit")) +(custom-put 'widget-button 'custom-loads '("wid-edit")) diff -r 6866abce6aaf -r 6075d714658b lisp/custom/custom.el --- a/lisp/custom/custom.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/custom/custom.el Mon Aug 13 09:51:16 2007 +0200 @@ -292,10 +292,10 @@ Third arg DOC is the group documentation. -MEMBERS should be an alist of the form ((NAME WIDGET)...) where -NAME is a symbol and WIDGET is a widget is a widget for editing that -symbol. Useful widgets are `custom-variable' for editing variables, -`custom-face' for edit faces, and `custom-group' for editing groups. +MEMBERS should be an alist of the form ((NAME WIDGET)...) where NAME +is a symbol and WIDGET is a widget for editing that symbol. Useful +widgets are `custom-variable' for editing variables, `custom-face' for +edit faces, and `custom-group' for editing groups. The remaining arguments should have the form diff -r 6866abce6aaf -r 6075d714658b lisp/ediff/custom-load.el --- a/lisp/ediff/custom-load.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/ediff/custom-load.el Mon Aug 13 09:51:16 2007 +0200 @@ -1,6 +1,6 @@ -(custom-put 'ediff-diff 'custom-loads '("ediff-diff")) -(custom-put 'ediff-merge 'custom-loads '("ediff-merg")) +(custom-put 'ediff 'custom-loads '("ediff-diff" "ediff-merg" "ediff-mult" "ediff-ptch" "ediff-wind" "ediff" "ediff-init")) +(custom-put 'ediff-window 'custom-loads '()) +(custom-put 'ediff-ptch 'custom-loads '("ediff-ptch")) (custom-put 'ediff-mult 'custom-loads '("ediff-mult")) -(custom-put 'ediff-ptch 'custom-loads '("ediff-ptch")) -(custom-put 'ediff-window 'custom-loads '()) -(custom-put 'ediff 'custom-loads '("ediff-diff" "ediff-merg" "ediff-mult" "ediff-ptch" "ediff-wind" "ediff" "ediff-init")) +(custom-put 'ediff-merge 'custom-loads '("ediff-merg")) +(custom-put 'ediff-diff 'custom-loads '("ediff-diff")) diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/ChangeLog --- a/lisp/gnus/ChangeLog Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,6803 +0,0 @@ -1997-07-17 Steven L Baur - - * gnus.el (gnus-simplify-mode-line): Use gnus-mode-line-modified - for the modified string. - * gnus-salt.el (gnus-carpal-mode): Ditto. - - * gnus-ems.el (gnus-mode-line-modified): Refine detection on - whether narrow indicators should be used. - -Sat Jul 12 19:46:22 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.63 is released. - -Sat Jul 12 17:02:30 1997 Lars Magne Ingebrigtsen - - * gnus-undo.el (gnus-undo-mode): Use it. - - * gnus-salt.el (gnus-pick-mode): Use it. - - * gnus-gl.el (gnus-grouplens-mode): Use it. - - * gnus-ems.el (gnus-add-minor-mode): New function. - -Sat Jul 12 16:21:41 1997 Michael R. Cook - - * gnus-topic.el (gnus-topic-toggle-display-empty-topics): List - groups. - -Fri Jul 11 21:12:07 1997 Per Abrahamsen - - * gnus-art.el (gnus-article-treat-html): Use `w3-region'. - -Fri Jul 11 13:20:58 1997 Lars Magne Ingebrigtsen - - * message.el (message-check-news-header-syntax): Check repeated - groups. - - * gnus-move.el (gnus-move-group-to-server): Protect against nil - articles. - -Thu Jul 10 20:01:44 1997 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-check-first-time-used): Force reading the - active file the first time Gnus is used. - - * gnus-group.el (gnus-group-set-mode-line): Conditionalize - modified. - - * gnus-ems.el (gnus-mode-line-modified): New variable. - - * gnus-xmas.el (gnus-summary-toolbar): Typo fix. - -Mon Jul 7 11:06:32 1997 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-check-new-newsgroups): New default. - -Sun Jul 6 17:22:47 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.62 is released. - -Sun Jul 6 12:38:56 1997 Lars Magne Ingebrigtsen - - * nngateway.el (nngateway-request-post): Call sendmail function. - - * message.el (message-send-news): Supply the method to the post - function. - - * gnus.el (gnus-group-auto-expirable-p): Dox fox. - - * message.el (message-clone-locals): Only clone Gnus variables. - - * gnus-nocem.el (gnus-nocem-enter-article): Use real group name. - -Fri Jul 4 13:00:39 1997 enami tsugutomo - - * gnus-group.el (gnus-group-set-mode-line): Use new, shorter - format. - -Fri Jul 4 12:31:18 1997 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-score-headers): Let the score buffer inherit - variables from the summary buffer. - - * message.el (message-clone-locals): Made into own function. - - * gnus.el (gnus-select-method): Changed default. - - * gnus-start.el (gnus-read-active-file): Changed default to - `some'. - -Tue Jul 1 01:51:24 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.61 is released. - -Tue Jul 1 01:33:39 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-adjust-marked-articles): Typo. - -Tue Jul 1 00:56:21 1997 Gary D. Foster - - * gnus-topic.el (gnus-topic-mode-map): [delete]. - -Tue Jul 1 00:53:04 1997 Lars Magne Ingebrigtsen - - * gnus-demon.el (gnus-demon): Make sure Emacs really is idle. - -Sun Jun 29 21:32:13 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.60 is released. - -Sun Jun 29 21:14:27 1997 Hrvoje Niksic - - * gnus-salt.el: Customized. - -1997-06-27 Hrvoje Niksic - - * gnus-salt.el (gnus-tree-show-summary): New function. - (gnus-tree-mode-map): Use it. - -Sun Jun 29 20:19:27 1997 Lars Magne Ingebrigtsen - - * gnus-salt.el (gnus-generate-horizontal-tree): Protect against - nil threads. - - * gnus-sum.el (gnus-adjust-marked-articles): Change. - -Sun Jun 29 20:19:03 1997 Scott Byer - - * gnus-sum.el (gnus-adjust-marked-articles): Improper lists. - -1997-06-24 Hrvoje Niksic - - * gnus-sum.el (gnus-summary-search-article): Inhibit updating tree - buffer. - -Sun Jun 29 19:36:48 1997 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-activate-group): Ignore zero returns. - - * gnus-salt.el (gnus-generate-vertical-tree): Use a safer - line-drawing algorithm. - - * nnml.el (nnml-generate-nov-file): Articles with null bodies are - legal. - -Sun Jun 22 15:44:02 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (article-hide-pgp): Only run hook when hiding pgp. - - * nnfolder.el (nnfolder-save-buffer): Make sure the directory - exists. - - * gnus-uu.el (gnus-uu-post-news-inews): Didn't work when posting - threaded. - (gnus-uu-post-encoded): Include sequence numbers in threaded - posts. - -Sat Jun 21 00:17:16 1997 Lars Magne Ingebrigtsen - - * message.el (message-set-auto-save-file-name): Translate / in - buffer names. - -Wed Jun 18 17:26:35 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.59 is released. - -Wed Jun 18 09:29:15 1997 Andreas Jaeger - - * gnus-xmas.el (gnus-xmas-article-display-xface): Correct setting of - braces. - -1997-06-07 MORIOKA Tomohiko - - * smiley.el (smiley-deformed-regexp-alist): Add Japanese smiley - faces. - -Wed Jun 18 14:15:21 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (article-hide-pgp): Only run hook when there is a - PGP signature. - - * gnus-sum.el (gnus-summary-fetch-faq): Have `C-u' work. - - * gnus-xmas.el (gnus-xmas-summary-set-display-table): Don't nix - out chars that aren't supposed to be nixed out. - - * gnus-art.el (gnus-article-delete-invisible-text): Would bug out - on point-max. - (gnus-article-delete-text-of-type): Ditto. - - * gnus-xmas.el (gnus-xmas-redefine): Switch off horiz scrollbar in - tree buffers. - -Wed Jun 18 01:11:58 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.58 is released. - -Wed Jun 18 01:02:34 1997 Lars Magne Ingebrigtsen - - * gnus.el: Backed out all char-afters which caused bugs all over - the place. - -Wed Jun 18 00:33:41 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.57 is released. - -Wed Jun 18 00:09:35 1997 Lars Magne Ingebrigtsen - - * gnus-demon.el (gnus-demon-add-nocem): Use a numerical idle. - -1997-06-10 Steven L Baur - - * nntp.el (nntp-wait-for): Replace following-char with char-after. - -1997-06-09 Steven L Baur - - * gnus-msg.el (gnus-extended-version): Put XEmacs codename in - default X-Mailer/X-Newsreader if the symbol exists. - -Tue Jun 10 20:24:35 1997 Christoph Wedler - - * message.el (message-checksum): Do not only inspect the last - 32/64 characters; technical: `ash' is no bit-rotate. - -Tue Jun 17 23:45:00 1997 Guy Geens - - * gnus-score.el (gnus-decay-scores): Use the right index. - -Tue Jun 17 23:22:24 1997 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-score-load-file): Set the decay when not - set. - - * gnus-art.el (gnus-article-treat-html): Do w3 setup. - - * gnus.el (gnus-indent-rigidly): Be useful on odd tab widths. - - * gnus-xmas.el (gnus-article-x-face-command): Allow just using - xpm. - -Thu Jun 5 18:33:31 1997 Robert Bihlmeyer - - * gnus-score.el (gnus-score-find-trace): Would bug out for - file-less rules. - -Tue Jun 17 22:57:14 1997 Hrvoje Niksic - - * gnus-xmas.el (gnus-xmas-group-startup-message): Cleanup. - -Tue Jun 17 22:55:14 1997 Lars Magne Ingebrigtsen - - * nntp.el (nntp-request-head): Guess at article number. - -Tue Jun 17 22:40:49 1997 David Moore - - * gnus-xmas.el (gnus-xmas-set-text-properties): New version. - -Tue Jun 17 21:30:37 1997 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-search-forward): Ignore topic lines. - -Tue Jun 17 18:06:09 1997 "Karl M. Hegbloom" - - * gnus.el: ebola fixes. - -Wed Jun 11 19:23:09 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (t): Moved pop article keystroke. - -Tue Jun 10 06:32:52 1997 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-search-unix-mail-delim-backward): Allow - several "From "'s. - (nnmail-search-unix-mail-delim): Ditto. - -Fri Jun 6 19:31:10 1997 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-make-web-group): Use default prompt - instead of string. - - * gnus.el (gnus-string-or): New macro. - (gnus-string-or-1): New function. - -Sat May 31 15:41:09 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.56 is released. - -Sat May 31 14:51:37 1997 Shuhei KOBAYASHI - - * message.el (message-make-in-reply-to): Make valid In-Reply-To. - -Sat May 31 14:45:54 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-header-button-alist): Check for URLs in the - Subject. - -Sat May 31 14:42:53 1997 Hrvoje Niksic - - * gnus-xmas.el: Cleanup. - -Sat May 31 14:34:39 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-output-to-file): Return t. - -Sat May 31 14:14:40 1997 Guy Geens - - * gnus-score.el (gnus-decay-score): Make decay work on negative - scores. - -Sat May 31 14:07:53 1997 Kurt Swanson - - * nnmail.el (nnmail-article-group): Handle junk properly. - -Sat May 31 14:03:32 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-limit-children): Typo. Wouldn't - marked NoCeM'ed out messages as read. - -Sat May 31 13:46:49 1997 Darren Stalder - - * gnus-util.el (gnus-encode-date): Fix time zone. - -Sat May 31 13:38:02 1997 Lars Magne Ingebrigtsen - - * gnus-move.el (gnus-move-group-to-server): Don't sort nil lists. - -Tue May 27 16:03:12 1997 Paul Franklin - - * nnmail.el (nnmail-keep-last-article): clarify docstring - -Tue May 27 15:03:30 1997 Danny Siu - - * gnus-picon.el (gnus-group-display-picons): use - gnus-group-real-name so that picons for foreign groups display - correctly. - -Fri May 30 22:03:39 1997 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-mode): Nix out topic missing group - function when switching off. - - * gnus-salt.el (gnus-pick-start-reading): Don't prompt. - -Mon May 26 11:49:53 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-hack-decode-rfc1522): New function. - - * gnus-sum.el (gnus-parse-headers-hook): New default. - -Sun May 25 17:08:16 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.55 is released. - -Sun May 25 15:13:45 1997 Michael R. Cook - - * gnus-art.el (gnus-button-alist): Typo fix. - -Sun May 25 14:44:38 1997 Lars Magne Ingebrigtsen - - * gnus-salt.el (gnus-pick-start-reading): Mark unpicked as read. - - * gnus-sum.el (gnus-summary-move-article): Don't scan. - - * gnus-group.el (gnus-group-get-new-news-this-group): Accept an - optional non-scan parameter. - -Sun May 25 14:33:47 1997 Jan Vroonhof - - * gnus-cite.el (gnus-cite-attribution-prefix): Typo. - -Sat May 24 12:57:46 1997 Lars Magne Ingebrigtsen - - * gnus-nocem.el (gnus-nocem-verify-issuer): Ignore errors when - verifying. - -Sat May 24 11:55:04 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.54 is released. - -Sat May 24 10:35:40 1997 Lars Magne Ingebrigtsen - - * message.el (message-set-auto-save-file-name): Don't use "*" in - autosave name. - - * gnus-art.el (gnus-article-delete-text-of-type): New version. - -Sat May 24 10:33:43 1997 Dan Christensen - - * gnus-art.el (gnus-article-delete-invisible-text): New version. - -Sat May 24 10:26:34 1997 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-article-group): Remove all 'junk splits. - -Wed May 21 16:18:03 1997 Per Abrahamsen - - * gnus-cite.el (gnus-cite-attribution-prefix): Recognize - Microsoft/Agent style attribution lines. - (gnus-cite-attribution-suffix): Ditto. - -Sat May 24 05:23:46 1997 Lars Magne Ingebrigtsen - - * gnus-cache.el (gnus-cache-read-active): Would generate cache - active file too often. - (gnus-cache-possibly-alter-active): Test statement removed. - (gnus-cache-articles-in-group): Would destroy hashtb. - - * gnus-sum.el (gnus-summary-limit-mark-excluded-as-read): Don't - mark everything as read. - - * gnus-cite.el (gnus-article-fill-cited-article): Nix out - gnus-cite-article. - -Tue May 20 21:43:31 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-move-article): Don't suppress moved - articles. - - * gnus-start.el (gnus-dribble-read-file): Check that the dribble - file exists. - - * gnus-cache.el (gnus-cache-articles-in-group): Update cache - active file. - -Mon May 19 02:04:01 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-search-article): Typo. - - * nnml.el (nnml-update-file-alist): Allow forcing. - - * nnheaderxm.el (nnheader-xmas-find-file-noselect): Removed. - (nnheader-xmas-cancel-timer): Removed. - (nnheader-xmas-cancel-function-timers): Removed. - -Sun May 18 07:35:43 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.53 is released. - -Sun May 18 06:20:57 1997 Lars Magne Ingebrigtsen - - * message.el (message-set-auto-save-file-name): Create unique auto - save file names. - - * gnus-topic.el (gnus-topic-tallied-groups): Removed. - (gnus-topic-prepare-topic): Output right number of articles in - each sub-topic. - - * gnus-sum.el (gnus-summary-next-group): Don't pass on killed - buffers. - - * nnmail.el (nnmail-article-group): When crossposted to `junk', do - `junk'. - - * gnus-util.el (gnus-kill-all-overlays): Remove nil overlays from - list. - - * gnus-art.el (gnus-article-treat-html): Don't kill buf. - - * gnus-group.el (gnus-group-find-new-newsgroups): Newish function. - -Sun May 18 06:16:41 1997 Kim-Minh Kaplan - - * gnus-picon.el (gnus-picons-has-modeline-p): new user variable. - (gnus-picons-set-buffer): new function. - (gnus-picons-prepare-for-annotations): use it. - (gnus-picons-network-display-internal): ditto. - (gnus-picons-make-annotation): new function. - (gnus-picons-display-x-face): use it. - (gnus-article-display-picons): ditto. - (gnus-picons-display-picon-or-name): ditto. - (gnus-picons-display-pairs): ditto. Remember the correct - order of insertion of annotations. - (gnus-picons-display-glyph): use gnus-picons-make-annotation. - (gnus-article-display-picons): move group annotations in article - buffer to the correct place if displaying in article buffer. - (gnus-picons-network-search-internal): don't display "@" if there - is no domain picon works again. Check that the picons still - need be displayed. Add the bar bar.xpm separator if - gnus-picons-display-as-address. - (gnus-picons-network-display-callback): check that the picon still - need be displayed. - (gnus-picons-lock): function deleted. - (gnus-picons-remove): don't use it. New way of locking. - (gnus-picons-next-job-internal): new way of locking. Handle - new tag 'bar. - (gnus-picons-next-job): new way of locking. - (gnus-picons-buffer): variable deleted. - (gnus-picons-remove-all): modified accordingly. - (gnus-group-annotations-lock): variable deleted. - (gnus-article-annotations-lock): variable deleted. - (gnus-x-face-annotations-lock): variable deleted. - (gnus-picons-news-directories): renamed, was - gnus-picons-news-directory. - (gnus-picons-url-retrieve): do not change url-show-status. - (gnus-picons-clear-cache): also clear gnus-picons-url-alist. - -Sun May 18 05:57:31 1997 Michael R. Cook - - * gnus-topic.el (gnus-topic-toggle-display-empty-topics): New - function. - -Sun May 18 05:52:59 1997 Lars Magne Ingebrigtsen - - * nnfolder.el (nnfolder-request-create-group): Read folder. - -Sat May 17 22:45:07 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-search-article): Require gnus-asynch. - - * nnweb.el (nnweb-dejanews-wash-article): Remove "More Headers". - -Sun May 11 20:07:21 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (article-hide-pgp): Run hook. - (gnus-article-hide-pgp-hook): New variable. - -Sat May 10 00:37:32 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.52 is released. - -Sat May 10 00:13:30 1997 Lars Magne Ingebrigtsen - - * nnfolder.el (nnfolder-possibly-change-group): Set wrong - variable. - - * gnus-art.el (gnus-article-edit-article): Remove invisible text - under XEmacs. - (gnus-article-treat-html): Insert string. - -Thu May 8 10:53:12 1997 Steven L Baur - - * gnus-msg.el (gnus-summary-mail-crosspost-complaint): - `deactivate-mark' doesn't exist in XEmacs. - -Fri May 9 23:50:01 1997 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-create-topic): Added doc. - - * gnus-sum.el (gnus-summary-refer-article): Insert sparse - non-displayed articles properly. - (gnus-cut-thread): Exclude non-displayed sparse articles. - -Thu May 8 17:37:38 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.51 is released. - -Thu May 8 15:58:43 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-execute-command): Place point at start of - prompt. - - * gnus-int.el (gnus-request-replace-article): Don't bug out on - unknown groups. - - * gnus-sum.el (gnus-summary-update-info): Force undo boundary here. - (gnus-update-read-articles): ... and not here. - - * gnus-art.el (article-display-x-face): Would only show one X-Face. - -Wed May 7 05:23:20 1997 Kim-Minh Kaplan - - * gnus-picon.el: (gnus-picons-url-alist): new variable. - (gnus-picons-jobs-alist): new variable. - (gnus-picons-remove): clean this new variable. FIXME: race - condition. - (gnus-picons-job-already-running): new variable. - (gnus-article-display-picons): use the job queue if using the - network. - (gnus-group-display-picons): ditto. - (gnus-picons-make-path): function deleted. - (gnus-picons-lookup-internal): modified accordingly. - (gnus-picons-lookup-user-internal): take the LETs out of the - loops. - (gnus-picons-lookup-pairs): take constant calculation outside of - loop. - (gnus-picons-display-picon-or-name): use COND instead of nested IFs - (gnus-picons-display-pairs): take the LET outside of loop. - (gnus-picons-try-face): ditto. - (gnus-picons-users-image-alist): variable deleted. - (gnus-picons-clear-cache): don't clear it. - (gnus-picons-retrieve-limit): variable deleted. - (gnus-picons-url-retrieve): clear url-request-method - (gnus-picons-retrieve-user-callback): function deleted. - (gnus-picons-retrieve-user): function deleted. - (gnus-picons-retrieve-domain-callback): function deleted - (gnus-picons-retrieve-domain-internal): function deleted. - (gnus-picons-parse-value): new function. - (gnus-picons-parse-filenames): new function. - (gnus-picons-network-display-internal): new function. - (gnus-picons-network-display-callback): new function. - (gnus-picons-network-display): new function. - (gnus-picons-network-search-internal): new function. - (gnus-picons-network-search-callback): new function. - (gnus-picons-network-search): new function. - (gnus-picons-next-job-internal): new function. - (gnus-picons-next-job): new function. - -Wed May 7 22:14:32 1997 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-setup-news): Don't fold case. - -Sat May 3 16:55:25 1997 Kim-Minh Kaplan - - * gnus-picon.el: * gnus-picons-clear-cache-on-shutdown: new variable. - * gnus-picons-piconsearch-cache-user: variable deleted. - * gnus-picons-clear-cache: new function. - * gnus-picons-close: only clear cache if - gnus-picons-clear-cache-on-shutdown. - * gnus-picons-url-retrieve: set url-package-name and - url-package-version. - * gnus-picons-users-image-alist: new variable. - * gnus-picons-retrieve-user-callback: use it. - * Added support for network retrieval of picons. - * gnus-picons-map: removed. - * gnus-picons-remove: removed case to handle processes. - * gnus-picons-processes-alist: new variable - * gnus-picons-x-face-sentinel: simplified. Use processes alist. - * gnus-picons-display-x-face: explicitly request an xface image. - Always call gnus-picons-prepare-for-annotations. Use processes - alist. - * gnus-picons-lookup-internal: new function. - * gnus-picons-lookup: use it. - * gnus-picons-lookup-user-internal: ditto. - * gnus-picons-display-picon-or-name: no more xface-p argument. - * gnus-picons-try-suffixes: removed. - * gnus-picons-try-face: new function. Does the caching in - gnus-picons-glyph-alist. - * gnus-picons-try-to-find-face: take a glyph argument instead of a - path. No more xface-p argument. Only use one annotation even if - gnus-picons-display-as-address. - * gnus-picons-toggle-extent: changed into an annotation action. - -Sat May 3 00:59:39 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.50 is released. - -Sat May 3 00:30:12 1997 Kim-Minh Kaplan - - * gnus-picon.el (gnus-picons-prepare-for-annotations): New - function, and many changes. - -Sat May 3 00:03:51 1997 Lars Magne Ingebrigtsen - - * nnfolder.el (nnfolder-possibly-change-group): Wouldn't always - switch buffers. - - * gnus-sum.el (gnus-update-read-articles): Force boundary. - - * gnus-undo.el (gnus-force-undo-boundary): New function. - -Fri May 2 23:44:54 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-treat-html): w3-parse-buffer - incompatibility. - -Thu May 1 17:56:05 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.49 is released. - -Sat Apr 19 16:13:03 1997 Erik Toubro Nielsen - - * gnus-sum.el (gnus-summary-exit): Returned to the wrong topic in - certain obscure cases if selected group occured in multiple - topics. - - * gnus-topic.el (gnus-topic-update-topic): Did not preserve point - on the same instance of a group if group occured in multiple - topics. Caused gnus-summary-exit to return to wrong topic if the - selected group was in more than one topic. - - Above two bugs happened only if the window configuration for - summary mode caused the group buffer not to be shown in a window. - -Thu May 1 14:28:20 1997 Lars Magne Ingebrigtsen - - * message.el (message-send): Would pretend to have sent. - - * nnmh.el (nnmh-request-list-1): Don't use truename. - -Sun Apr 27 15:16:16 1997 Steven L Baur - - * gnus-xmas.el: Undo previous change, and restore the version from - 5.4.46 (without the require 'gnus-art). - -Tue Apr 29 11:08:27 1997 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-summary-increase-score): Better error - messages. - -Sun Apr 27 23:15:58 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.48 is released. - -Sun Apr 27 11:40:57 1997 Steven L Baur - - * gnus-xmas.el (gnus-art): (require 'gnus-art) introduces a - circular dependency on gnus-xmas-define and gnus-xmas-redefine. - Brute force it away. - -Sun Apr 27 12:32:13 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.47 is released. - -Sun Apr 27 10:42:08 1997 Lars Magne Ingebrigtsen - - * gnus-cache.el (gnus-cache-move-cache): Allow entering directory - name. - - * nntp.el (nntp-telnet-command, nntp-telnet-switches): New - variables. - - * gnus-score.el (gnus-summary-increase-score): Refuse illegal - match types. - -Fri Apr 25 06:16:05 1997 Arne Georg Gleditsch - - * gnus-sum.el (gnus-summary-refer-article): Go to article when - expunged. - -Wed Apr 23 19:48:43 1997 Per Abrahamsen - - * gnus-ems.el (gnus-article-x-face-command): Removed bogus - declaration. - -Mon Apr 21 16:44:00 1997 Paul Franklin - - * nnmail.el (nnmail-move-inbox): fewer (0?) file calls on inbox if - popmail. - -Thu Apr 24 14:04:31 1997 Lars Magne Ingebrigtsen - - * message.el (message-font-lock-keywords): Be more conservative in - determining headers. - - * nnmh.el (nnmh-request-list-1): Use truenames. - - * gnus-undo.el (gnus-undo-mode): Don't infest - gnus-summary-exit-hook. - - * gnus-sum.el (gnus-update-read-articles): Force an undo - boundary. - - * nnweb.el (nnweb-fetch-url): Don't rely on return values from - url-insert-file-contents. - -Sat Apr 19 06:11:31 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.46 is released. - -Sat Apr 19 05:40:40 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-read-save-file-name): Expand file name i save - dir. - -Fri Apr 18 14:25:21 1997 Hrvoje Niksic - - * gnus-art.el (gnus-signature-face): New face; use it. - -Sat Apr 19 05:32:43 1997 Kim-Minh Kaplan - - * gnus-picon.el (gnus-picons-insert-face-if-exists): Add picons to - list. - -Tue Apr 15 14:08:32 1997 Hrvoje Niksic - - * message.el (message-font-lock-keywords): Be a little bit more - case-insensitive. - -Wed Apr 16 02:41:31 1997 Hrvoje Niksic - - * message.el (message-insert-to): New argument FORCE. - -Sat Apr 19 05:18:10 1997 Lars Magne Ingebrigtsen - - * message.el (message-setup): Nix out undo list. - -Sat Apr 19 05:00:06 1997 Katsumi Yamaoka - - * gnus-sum.el: Redefine. - -Sat Apr 19 04:53:29 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (article-display-x-face): Display all XFace - headers. - - * gnus-ems.el: appt, not appt.el. - -Sat Apr 19 04:04:42 1997 Hrvoje Niksic - - * gnus-xmas.el (gnus-xmas-summary-set-display-table): Don't nix - out in Latin1. - -Sat Apr 19 02:55:45 1997 Lars Magne Ingebrigtsen - - * message.el (message-cancel-news): Only say we cancel if we - cancel. - - * gnus-msg.el (gnus-summary-mail-crosspost-complaint): Deactivate - mark. - -Thu Apr 17 21:37:22 1997 Lars Magne Ingebrigtsen - - * message.el (message-mail-alias-type): New variable. - (message-mode): Use it. - -Wed Apr 16 00:03:37 1997 Lars Magne Ingebrigtsen - - * gnus-demon.el (gnus-demon): Ignore errors. - -Tue Apr 15 23:50:02 1997 Brad Howes - - * gnus-demon.el (gnus-demon-time-to-step): New version. - -Tue Apr 15 23:32:58 1997 Lars Magne Ingebrigtsen - - * message.el (message-send-method-alist): New variable. - (message-send): Use it. - (message-send-via-news): New function. - (message-send-via-mail): New function. - -Sun Apr 13 18:22:02 1997 Jens Lautenbacher - - * gnus.el (gnus-article-display-hook): Fix. - -Sun Apr 13 02:07:33 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-get-newsgroup-headers): Protect against bogus - Lines headers. - - * gnus-cache.el (gnus-cache-possibly-enter-article): Check number - not nil. - -Sat Apr 12 23:28:30 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.45 is released. - -Sat Apr 12 02:00:51 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-update-article-line): Insert the - subject. - - * gnus-msg.el (gnus-post-news): Use it. - - * message.el (message-wide-reply): Accept ignore-reply-to. - - * gnus-sum.el (gnus-thread-loop-p): Don't recurse; use a stack. - - * message.el (message-generate-headers): Don't insert incomlete - Senders in mail-only messages. - (message-check-news-header-syntax): Check subject first. - -Sat Apr 12 01:42:42 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.44 is released. - -Sat Apr 12 01:10:31 1997 Lars Magne Ingebrigtsen - - * nnweb.el (nnweb-request-scan): Init nnweb-hashtb. - -Thu Apr 10 20:05:13 1997 Sudish Joseph - - * gnus-art.el (gnus-article-delete-invisible-text): Do an entire - region instead a single char in each pass. It's faster and - doesn't confuse ps-print. - (gnus-article-delete-text-of-type): Ditto. - -Sat Apr 12 00:35:07 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-adjust-marked-articles): Wouldn't remove - `expire' marks. - -Thu Apr 10 22:07:46 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.43 is released. - -Thu Apr 10 21:47:08 1997 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-save-newsrc-file): Message less. - -Thu Apr 10 21:35:45 1997 ISO-2022-JP - - * gnus-sum.el (gnus-summary-show-article): Bind gnus-show-mime. - -Thu Apr 10 21:26:19 1997 Lars Magne Ingebrigtsen - - * gnus.el: Removed gnus-add-hook. - -Thu Apr 3 21:08:57 1997 Hrvoje Niksic - - * gnus-xmas.el (gnus-xmas-summary-set-display-table): Don't change - the values that are non-nil in the default table. - (gnus-xmas-add-hook): Removed it. - -Thu Apr 10 20:44:46 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-show-summary): Error better. - - * message.el (message-indent-citation): Tippy-foot when deleting - leading empty lines. - - * gnus-sum.el (gnus-summary-move-article): Update group lines. - - * gnus-srvr.el (gnus-server-exit): Configure windows. - - * gnus-group.el: Added gnus-version to help map. - -Thu Apr 10 20:41:11 1997 Hrvoje Niksic - - * gnus-xmas.el: Customized. - -Thu Apr 10 19:58:40 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-next-group): Selected deleted group. - - * gnus-art.el (article-treat-overstrike): Don't bug out on empty - articles. - -Thu Apr 10 19:52:27 1997 David Moore - - * nnvirtual.el (nnvirtual-partition-sequence): Style fix. - -Thu Apr 10 19:45:30 1997 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-kill-group): Kill more carefully. - -Tue Apr 8 23:02:30 1997 Michael Welsh Duggan - - * message.el (message-insert-to): Fetch reply field. - -Tue Apr 8 21:41:13 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-refer-article): Accept prefix. - -Sun Apr 6 14:08:03 1997 Steven L Baur - - * gnus-xmas.el (gnus-xmas-summary-set-display-table): Add - missing paren. - (gnus-xmas-summary-set-display-table): current-display-table can - be nil. - -Sun Apr 6 23:17:21 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.42 is released. - -Sun Apr 6 23:13:50 1997 Lars Magne Ingebrigtsen - - * gnus-xmas.el (gnus-xmas-summary-set-display-table): There isn't - always a default table, it seems. - -Sun Apr 6 22:45:52 1997 Aaron M. Ucko - - * gnus-xmas.el (gnus-xmas-summary-set-display-table): Typo. - -Sun Apr 6 22:26:52 1997 Lars Magne Ingebrigtsen - - * gnus-group.el: All the sorting commands were shadowed. - -Sun Apr 6 21:46:05 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.41 is released. - -Sun Apr 6 20:58:38 1997 Kim-Minh Kaplan - - * gnus-picon.el (gnus-picons-insert-face-if-exists): "." instead - of "". - -Sun Apr 6 20:19:49 1997 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-sort-groups): Touch dribble. - -Sun Apr 6 19:28:19 1997 Stainless Steel Rat - - * pop3.el (pop3-quit): New version. - -Fri Apr 4 21:46:34 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-page-broken): New variable. - (gnus-article-prepare): Use it. - -Fri Apr 4 05:08:00 1997 Gunnar Horrigmo - - * gnus-art.el (article-treat-overstrike): Search from beginning of - article. - -Thu Apr 3 15:16:05 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-hidden-text-p): Be more thorough. - -Thu Apr 3 12:23:44 1997 Per Abrahamsen - - * gnus-score.el: (gnus-score-default-duration): Accept nil in - :type. - -Thu Apr 3 05:49:56 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-next-group): Make sure buffer is alive - before switching to it. - -Wed Apr 2 12:39:15 1997 Steven L Baur - - * gnus-util.el (gnus-kill-all-overlays): Force Gnus to use extents - even when overlays are available. (From a patch by MORIOKA - Tomohiko). - -Thu Apr 3 05:28:03 1997 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-goto-missing-group): Make sure topic - exists. - - * gnus-srvr.el (gnus-browse-group-name): Remove text props. - - * gnus-sum.el (gnus-summary-move-article): Enter into dribble. - -Wed Apr 2 14:12:45 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.40 is released. - -Wed Apr 2 13:17:16 1997 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-check-bogus-newsgroups): Supply a help - param. - - * message.el (message-bounce): Remove the right portion of - "simple" bounces. - - * gnus-art.el (gnus-read-save-file-name): Would bug out when - saving multiple articles. - - * gnus-sum.el (gnus-summary-update-article-line): Insert the - correct subject. - -Tue Apr 1 11:21:48 1997 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-score-find-hierarchical): Translate file - chars. - - * gnus-topic.el (gnus-topic-goto-missing-topic): Bugola. - (gnus-topic-forward-topic): New function. - (gnus-topic-goto-missing-topic): Use it. - - * nnmh.el (nnmh-active-number): Make sure the directory exist. - (nnmh-request-accept-article): Bizarre problem. - - * gnus-topic.el (gnus-topic-goto-missing-group): Don't double - topics. - -Mon Mar 31 17:30:10 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.39 is released. - -Mon Mar 31 17:29:13 1997 Lars Magne Ingebrigtsen - - * nntp.el (nntp-connection-alist): Ooize. - -Mon Mar 31 16:34:37 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.38 is released. - -Mon Mar 31 16:12:31 1997 Hrvoje Niksic - - * message.el (message-add-header): New function. - - * gnus-art.el (gnus-sorted-header-list): List `Followup-To' after - `Newsgroups'. - - * gnus-undo.el (gnus-undo-mode-map): Bind `gnus-undo' to `C-_', - `C-x u' and `C-/'. - -Mon Mar 31 16:02:47 1997 Toby Speight - - * gnus-art.el (gnus-article-add-buttons): Eval the right element. - -Mon Mar 31 15:57:17 1997 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-add-to-list): New variable. - (gnus-post-news): Use it. - -Mon Mar 31 15:46:34 1997 Francois Felix Ingrand - - * gnus-start.el (gnus-slave-save-newsrc): Get modes right. - -Mon Mar 31 15:43:29 1997 Michael Sperber - - * message.el (message-functionp): Recognize compiled functions. - -Mon Mar 31 15:43:57 1997 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-functionp): Ditto. - -Mon Mar 31 15:18:11 1997 Katsumi Yamaoka - - * gnus-ems.el (gnus-ems-redefine): Don't change display table. - -Mon Mar 24 11:33:59 1997 Michael Welsh Duggan - - * message.el (message-insert-to): Use mail-copies-to. - -Mon Mar 31 12:35:12 1997 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-goto-missing-topic): New function. - (gnus-topic-goto-missing-group): Use it. - - * gnus-msg.el (gnus-debug): Scan gnus-topic.el. - - * message.el (message-reply): Don't insert extra , when not to - header. - - * nntp.el (nntp-connection-alist): Un-voo. - -Sun Mar 30 09:48:41 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-mode-syntax-table): Make <> paren - chars. - (gnus-emphasis-alist): Use it. - - * gnus.el (gnus-maintainer): Changed. - - * nnfolder.el (nnfolder-request-accept-article): Ask before - junking. - (nnfolder-save-mail): Make buffer read/write. - - * nnmh.el (nnmh-request-accept-article): Ditto. - * nnbabyl.el (nnbabyl-request-accept-article): Ditto. - * nnmbox.el (nnmbox-request-accept-article): Ditto. - * nnml.el (nnml-request-accept-article): Ditto. - -Mon Mar 24 16:57:26 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.37 is released. - -Mon Mar 24 01:16:15 1997 Hrvoje Niksic - - * gnus-xmas.el (gnus-xmas-redefine): Use it. - - * gnus-xmas.el (gnus-xmas-summary-set-display-table): New function. - - * gnus-sum.el (gnus-summary-mode): Use it. - - * gnus-sum.el (gnus-summary-set-display-table): New function. - -Mon Mar 24 16:27:46 1997 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-buffer-live-p): Reinstated. - -Mon Mar 24 01:24:27 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.36 is released. - -Sun Mar 23 18:51:00 1997 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-list-groups): Doc fix. - - * gnus-demon.el (gnus-inhibit-demon): New variable. - (gnus-demon): Use it. - -Sun Mar 23 18:42:55 1997 David Moore - - * gnus-nocem.el (gnus-nocem-already-running): New variable. - -Sun Mar 23 17:27:17 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-select-newsgroup): Revert to old duplicate - behavior for nnvirtual groups. - - * gnus-util.el (gnus-buffer-live-p): Removed. - -Sat Mar 22 22:11:28 1997 Steven L Baur - - * gnus-msg.el (gnus-setup-message): Mark buffer unmodified as last - step of setting message buffer up. - - * message.el (message-kill-buffer): Make prompt look more like the - one in kill-buffer. - Only prompt if the buffer has been changed. - -Sun Mar 23 02:52:51 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.35 is released. - -Sun Mar 23 01:09:23 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-read-save-file-name): Tweaked definition. - (gnus-summary-save-in-rmail): Use it. - (gnus-summary-save-in-file): Ditto. - (gnus-summary-save-in-mail): Ditto. - (gnus-summary-save-body-in-file): Ditto. - - * gnus-vm.el (gnus-summary-save-in-vm): Ditto. - - * gnus-sum.el (gnus-summary-enter-digest-group): Add group param. - - * gnus-art.el (gnus-split-methods): New default. - (gnus-article-nndoc-name): New function. - -Sat Mar 22 15:47:14 1997 Lars Magne Ingebrigtsen - - * nnmh.el (nnmh-request-accept-article): Do 'junk. - * nnbabyl.el (nnbabyl-request-accept-article): Ditto. - * nnmbox.el (nnmbox-request-accept-article): Ditto. - * nnfolder.el (nnfolder-request-accept-article): Ditto. - -Sat Mar 22 15:42:53 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.34 is released. - -Sat Mar 22 01:37:00 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-move-article): Understand 'junk. - - * nnml.el (nnml-request-accept-article): Return 'junk when legal. - - * gnus-sum.el (gnus-summary-respool-query): Message better, and - return right value. - - * nnmail.el (nnmail-split-abbrev-alist): New `to' and `from' - abbrevs. - -Wed Mar 19 19:36:25 1997 Dewey M. Sasser - - * message.el (message-make-from): Changed so that - message-from-style value is captured from message buffer instead - of temp buffer. - -Sat Mar 22 00:47:39 1997 Lars Magne Ingebrigtsen - - * gnus-srvr.el (gnus-browse-foreign-server): Understand server - names. - - * gnus-group.el (gnus-group-browse-foreign-server): Down methodize - the server. - -Thu Mar 20 22:49:16 1997 Lars Magne Ingebrigtsen - - * nnfolder.el (nnfolder-read-folder): Do checking if there are new - articles after the last nnfolder marker. - -Thu Mar 20 17:33:54 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.33 is released. - -Thu Mar 20 16:01:38 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-build-get-header): Don't fold case. - - * nnfolder.el (nnfolder-read-folder): Would always parse the - entire mbox. - - * gnus-sum.el (gnus-summary-read-group-1): Return right value. - - * gnus-start.el (gnus-slave-save-newsrc): Set file modes. - - * nneething.el (nneething-open-server): New function. - (nneething-possibly-change-directory): Redefined. - -Wed Mar 19 21:16:48 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.32 is released. - -Wed Mar 19 21:06:07 1997 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-cache-accepted-message-ids): Bogus. - -Wed Mar 19 20:53:34 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.31 is released. - -Wed Mar 19 14:29:26 1997 Lars Magne Ingebrigtsen - - * nnmh.el (nnmh-request-accept-article): Ditto. - - * nnbabyl.el (nnbabyl-request-accept-article): Ditto. - - * nnmbox.el (nnmbox-request-accept-article): Ditto. - - * nnfolder.el (nnfolder-request-accept-article): Ditto. - - * nnml.el (nnml-request-accept-article): Cache or not. - - * gnus-sum.el (gnus-summary-read-group): Don't recurse. - (gnus-summary-ignore-duplicates): New variable. - (gnus-get-newsgroup-headers): Use it. - (gnus-nov-parse-line): Ditto. - - * message.el (message-reply): Remove excessive white space in - headers. - - * nnfolder.el (nnfolder-read-folder): Work when ignoring active - file. - - * nnmail.el (nnmail-process-unix-mail-format): Narrow to the right - portion. - (nnmail-process-mmdf-mail-format): Ditto. - - * gnus.el (gnus-group-remove-parameter): New function. - (gnus-group-set-parameter): Use it. - (gnus-group-add-parameter): Ditto. - - * gnus-msg.el (gnus-post-news): Check first whether - to-list/to-address exists before adding. - -Tue Mar 18 23:54:17 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.30 is released. - -Tue Mar 18 23:43:50 1997 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-subscribe): Doc fix. - -Tue Mar 18 23:39:08 1997 Lance A. Brown - - * gnus-sum.el (gnus-update-marks): Articles->list. - -Tue Mar 18 23:07:35 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-update-article-line): Don't pass nil - on as subject string. - - * gnus-group.el (gnus-group-read-group): Revert to old - definition. - - * gnus-sum.el (gnus-summary-read-group-1): New function. - (gnus-summary-read-group): Use it. - -Tue Mar 18 17:56:26 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.29 is released. - -Tue Mar 18 14:29:49 1997 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-read-ephemeral-group): Would set virt - ser too much. - (gnus-group-read-group): Return right value. - - * nnml.el (nnml-generate-nov-databases-1): Save active. - - * gnus-msg.el (gnus-summary-supersede-article): Place point in the - with buffer. - (gnus-inews-add-to-address): Prompt before adding. - - * gnus-art.el (article-strip-leading-space): Not a new command - and keystroke (HTDW Jaari fix). - - * nnfolder.el (nnfolder-close-group): Don't push bogus entries - onto alist. - -Tue Mar 18 14:28:27 1997 Jan Vroonhof - - * nnfolder.el (nnfolder-request-scan): Check whether buffer really - is live. - -Tue Mar 18 13:53:00 1997 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-read-group): Iterate instead of - recurse. - - * nnfolder.el (nnfolder-request-accept-article): Don't insert into - Message-ID cache. - * nnbabyl.el (nnbabyl-request-accept-article): Ditto. - * nnmbox.el (nnmbox-request-accept-article): Ditto. - * nnml.el (nnml-request-accept-article): Ditto. - * nnmh.el (nnmh-request-accept-article): Ditto. - -Tue Mar 18 00:35:06 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.28 is released. - -Mon Mar 17 18:36:11 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-update-marks): Use `list' instead of - `articles'. - - * nndoc.el (nndoc-rfc822-forward-type-p): Renamed. - (nndoc-rfc822-forward-body-end-function): Ditto. - -Mon Mar 17 17:35:35 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.27 is released. - -Mon Mar 17 15:59:11 1997 Lars Magne Ingebrigtsen - - * nndoc.el (nndoc-x400-forward-type-p): New function. - (nndoc-x400-forward-body-end-function): Ditto. - - * nnfolder.el (nnfolder-adjust-min-active): Be in the right - buffer. - -Sat Mar 15 16:09:44 1997 Steven L Baur - - * message.el (message-post-method): Fix typo. - - * gnus-load.el (message-sending): Fix typo. - -Mon Mar 17 15:47:59 1997 Gordon Matzigkeit - - * message.el (message-set-auto-save-file-name): Expand before - temping. - -Mon Mar 17 15:05:44 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-update-marks): Get rid of article entries of - articles with the default score. - - * gnus-group.el (gnus-group-read-ephemeral-group): Be more careful - when uniquifying methods. - - * gnus-sum.el (gnus-execute-command): Insert asynch into buffer. - - * nnfolder.el (nnfolder-possibly-change-group): Didn't set the - current group. - -Mon Mar 17 15:03:02 1997 Paul Stodghill - - * gnus-srvr.el (gnus-server-prepare): Would infloop. - -Mon Mar 17 06:37:07 1997 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-crosspost-link-function): Change default on - NT. - -Fri Mar 14 12:07:12 1997 Steven L Baur - - * gnus-msg.el (gnus-extended-version): Add XEmacs beta # to - default X-Mailer/X-Newsreader. - -Fri Mar 14 20:57:03 1997 Lars Magne Ingebrigtsen - - * nnfolder.el (nnfolder-possibly-change-group): Check folder - buffer. - - * nnheader.el (nnheader-parse-head): Understand Message-ID with - spaces. - * gnus-sum.el (gnus-get-newsgroup-headers): Ditto. - (gnus-group-make-articles-read): Doc fix. - - * nnml.el (nnml-generate-nov-databases-1): Made interactive. - - * gnus-msg.el (gnus-inews-narrow-to-headers): Removed. - (gnus-post-news): Add `to-list' to the right group. - -Fri Mar 14 20:11:01 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.26 is released. - -Fri Mar 14 19:57:41 1997 Lars Magne Ingebrigtsen - - * gnus-setup.el (gnus-use-sc): Changed default. - -Fri Mar 14 19:53:05 1997 Kurt Swanson - - * gnus-art.el (gnus-article-goto-next-page): Place point. - -Fri Mar 14 18:46:54 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-mode-syntax-table): Make "-" - word-constituant. - - * gnus-sum.el (gnus-article-sort-by-author): Don't bug out on - Froms without names. - - * messagexmas.el (message-xmas-make-caesar-translation-table): Use - char-int. - -Fri Mar 14 18:44:33 1997 Per Abrahamsen - - * message.el (message-faces): New group. - -Fri Mar 14 18:43:16 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-limit-to-unread): Also exclude souped - articles. - -Fri Mar 14 18:35:06 1997 Matt Armstrong - - * gnus-score.el (gnus-all-score-files): Remove duplicates. - -Fri Mar 14 18:21:07 1997 Andy Norman - - * gnus-xmas.el (gnus-xmas-switch-horizontal-scrollbar-off): Check - whether we have a scrollbar first. - -Fri Mar 14 18:15:32 1997 Lars Magne Ingebrigtsen - - * nnfolder.el (nnfolder-save-mail): Don't fold case when doing - From_. - -Wed Mar 12 06:51:49 1997 Lars Magne Ingebrigtsen - - * nnfolder.el (nnfolder-possibly-change-group): Accept a - dont-check param. - (nnfolder-request-group): Don't load folder. - - * gnus.el (gnus-home-directory): New variable. - -Tue Mar 11 17:25:46 1997 Lars Magne Ingebrigtsen - - * gnus-async.el (gnus-async-prefetch-article): Raise the level of - the message. - -Mon Mar 10 06:30:59 1997 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-score-find-trace): Would clobber the score - of other articles. - - * nneething.el (nneething-create-mapping): Make sure - nneething-directory exists. - - * nnfolder.el (nnfolder-adjust-min-active): New function. - (nnfolder-request-expire-articles): Use it. - (nnfolder-request-move-article): Ditto. - (nnfolder-request-scan): Switch to the right server first. - -Mon Mar 10 06:28:58 1997 Joev Dubach - - * nnfolder.el (nnfolder-generate-active-file): Didn't work. - -Sun Mar 9 18:38:37 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.25 is released. - -Sun Mar 9 04:11:02 1997 Lars Magne Ingebrigtsen - - * gnus.el: Inlined and defsubsts various functions. - - * nnmail.el (nnmail-search-unix-mail-delim): Made into subst. - - * nnfolder.el (nnfolder-request-scan): Don't do anything when not - getting mail. - - * nnmh.el (nnmh-request-accept-article): Return the correct - value. - - * gnus-group.el (gnus-group-kill-all-zombies): Touch dribble. - - * gnus-score.el (gnus-score-find-trace): Message default score. - -Sat Mar 8 18:17:53 1997 Steven L Baur - - * gnus-util.el (gnus-byte-code): Use better (and still compatible) - name of `compiled-function-p'. - -Sat Mar 8 18:17:53 1997 Steven L Baur - - * messagexmas.el (message-xmas-make-caesar-translation-table): - char-int is a braindamaged and stupid name for a conversion - function. - -Sun Mar 9 01:51:16 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.24 is released. - -Sun Mar 9 00:52:47 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-set-local-parameters): Ignore errors. - -Sat Mar 8 08:55:52 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-prev-page): Return a proper value. - - * gnus-sum.el (gnus-summary-prev-page-or-article): New command. - * gnus-xmas.el (gnus-summary-toolbar): Use it. - -Sat Mar 8 08:34:22 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.23 is released. - -Sat Mar 8 02:09:53 1997 Lars Magne Ingebrigtsen - - * message.el (message-font-lock-keywords): Recognize continuation - headers. - - * gnus-group.el (gnus-group-expire-articles): Touch dribble - buffer. - - * gnus-sum.el (gnus-summary-default-score): Doc fix. - - * gnus.el (gnus-local-organization): Doc fix. - - * gnus-spec.el (gnus-compile): Don't work under XEmacs. - - * gnus-art.el (gnus-article-highlight-headers): Work on bodiless - articles. - -Fri Mar 7 23:33:34 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.22 is released. - -Fri Mar 7 08:25:20 1997 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-inews-do-gcc): Made interactive. - - * gnus-sum.el (gnus-read-move-group-name): Beep on empty names. - - * nnmail.el (nnmail-check-duplication): Don't rename Message-ID. - (nnmail-cache-message-id-when-accepting): Removed. - - * gnus-sum.el (gnus-nov-parse-line): Allow showing of multiple - articles with the same Message-ID. - (gnus-get-newsgroup-headers): Ditto. - - * gnus.el: Removed trailing spaces throughout. - - * gnus-art.el (gnus-header-name-face): Made easier on the eyes. - (gnus-article-add-buttons): Make buffer read/write before doing - anything. - - * message.el (message-font-lock-keywords): Changed expression and - faces. - -Fri Mar 7 07:36:14 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.21 is released. - -Fri Mar 7 04:17:40 1997 Lars Magne Ingebrigtsen - - * nnfolder.el (nnfolder-request-accept-article): Switch to the - right folder. - - * Makefile (gnus-load.el): cus-edit. - - * gnus.el: Removed all compilation warnings under both Emacs and - XEmacs. - - * cus-face.el: Moved variable defintions around a bit to avoid - compilation warnings. - - * nnmail.el (nnmail-cache-message-id-when-accepting): New - variable. - - * nnfolder.el (nnfolder-dont-cache-message-id): Removed. - * nnmh.el (nnmh-request-accept-article): Ditto. - * nnbabyl.el (nnbabyl-request-accept-article): Ditto. - * nnml.el (nnml-request-accept-article): Ditto. - * nnmbox.el (nnmbox-request-accept-article): Use it. - -Thu Mar 6 18:22:29 1997 Steven L Baur - - * nnfolder.el (nnfolder-dont-cache-message-id): Variable to allow - backwards compatibility with respect to saved messages. - (nnfolder-request-accept-article): Use it. - -Fri Mar 7 04:10:21 1997 Lars Magne Ingebrigtsen - - * nnmail.el: Autoload pop3. - -Fri Mar 7 01:33:34 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.20 is released. - -Fri Mar 7 00:12:39 1997 Lars Magne Ingebrigtsen - - * message.el (message-header-to-face): New faces. - (message-font-lock-keywords): Use them. - - * gnus-sum.el (gnus-summary-make-menu-bar): No addition. - (gnus-summary-move-article): When crossposting, get the Xrefs - header right. - - * nnfolder.el (nnfolder-request-accept-article): Work when - respooling. - -Thu Mar 6 08:41:16 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.19 is released. - -Thu Mar 6 08:00:31 1997 Lars Magne Ingebrigtsen - - * message.el (message-newgroups-header-regexp): Include Gcc - header. - - * gnus-sum.el (gnus-summary-delete-article): Message errors. - - * gnus-group.el (gnus-group-unsubscribe-group): Work on ranked - groups. - -Thu Mar 6 07:46:56 1997 Katsumi Yamaoka - - * nnmail.el (nnmail-move-inbox): Protect against nil results. - -Thu Mar 6 04:23:11 1997 Lars Magne Ingebrigtsen - - * message.el (message-kill-buffer): Ask before killing. - - * nnfolder.el (nnfolder-possibly-activate-groups): Removed. - (nnfolder-request-group): Changed servers too late. - (nnfolder-active-timestamp): New variable. - - * gnus-sum.el (gnus-summary-respool-query): Narrow to head instead - of body. - - * nntp.el (nntp-accept-process-output): Inhibit logging. - - * gnus-group.el (gnus-group-sort-groups): Doc fix. - - * nnfolder.el (nnfolder-request-accept-article): Insert Message-ID - into cache. - * nnmh.el (nnmh-request-accept-article): Ditto. - * nnml.el (nnml-request-accept-article): Ditto. - * nnbabyl.el (nnbabyl-request-accept-article): Ditto. - * nnmbox.el (nnmbox-request-accept-article): Ditto. - - * nnmail.el (nnmail-cache-close): Kill buffer. - (nnmail-cache-insert): Make sure the cache is open. - (nnmail-fetch-field): New function. - -Thu Mar 6 02:19:31 1997 James LewisMoss - - * smiley.el (smiley-deformed-regexp-alist): Fix FaceIronic. - -Wed Mar 5 09:15:04 1997 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-check-duplication): Ditto. - -Wed Mar 5 09:14:12 1997 Carsten Leonhardt - - * nnmail.el (nnmail-check-duplication): Use a different - Message-ID. - -Sun Mar 2 16:58:16 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.18 is released. - -Sun Mar 2 05:48:56 1997 Lars Magne Ingebrigtsen - - * gnus-load.el (customize): Load `cus-edit'. - -Sun Mar 2 04:40:48 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.17 is released. - -Sun Mar 2 04:01:29 1997 Lars Magne Ingebrigtsen - - * message.el (message-mail): Don't `list' other-headers. - -Sat Mar 1 22:46:37 1997 Per Abrahamsen - - * gnus.el: Added mail keyword. - (gnus): Add to mail and news customization groups. - (gnus-visual): Added to the faces customization group. - * message.el (message): Add to mail and news customization groups. - - * gnus-cus.el (wid-edit): Changed from widget-edit. - -Sun Mar 2 03:44:07 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-respool-query): Use it. - - * gnus.el (gnus-narrow-to-body): New function. - - * nnfolder.el (nnfolder-active-number): Simplify. - -Sun Mar 2 03:26:57 1997 Joev Dubach - - * gnus-art.el (article-make-date-line): Add "Date: ". - -Sun Mar 2 02:54:13 1997 Lars Magne Ingebrigtsen - - * gnus-uu.el (gnus-quote-arg-for-sh-or-csh): Also escape {}. - - * gnus-srvr.el (gnus-server-prepare): Don't insert servers twice. - - * nnmail.el (nnmail-read-passwd): Conditionalize - `ange-ftp-read-passwd'. - -Sat Mar 1 17:53:05 1997 Hrvoje Niksic - - * gnus-xmas.el (gnus-xmas-read-event-char): Exit on button-press - event. - - * nnml.el (nnml-retrieve-headers): Make sure file is non-nil. - -Sun Mar 2 02:43:46 1997 Lars Magne Ingebrigtsen - - * nndoc.el (nndoc-type-alist): Have rfc934 separators handled - better. - - * nnmail.el (nnmail-move-inbox): Take heed of the return value - from movemail. - -Fri Feb 21 19:54:24 1997 Hrvoje Niksic - - * gnus-xmas.el (gnus-xmas-redefine): Use `region-active-p'. - (gnus-xmas-region-active-p): Removed. - -Sun Mar 2 02:16:38 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-update-article-line): Only insert - Subject string when needed. - - * gnus-util.el (gnus-output-to-mail): Quote all "From " lines. - -Sun Mar 2 02:13:17 1997 David Martin - - * nndir.el (nndir): Use `nnml-close-group'. - -Sun Mar 2 01:51:21 1997 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-init-file): Changed default. - - * gnus-group.el (gnus-ephemeral-group-server): New server. - (gnus-group-read-ephemeral-group): Use it to use unique servers. - -Sat Mar 1 04:06:11 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-mode): Made `gnus-button-marker-list' - buffer-local. - (gnus-article-add-buttons): Don't buttonize the same article - twice. - - * gnus-sum.el (gnus-set-mode-line): Chop better. - - * gnus-art.el (gnus-article-treat-html): Not a new function. - Uh-uh. No way. I don't even exist. - - * gnus-cite.el (gnus-article-fill-cited-article): Bind - filladapt-mode to nil. - -Sat Mar 1 03:51:18 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.16 is released. - -Sat Mar 1 00:04:09 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-set-mode-line): Possibly take into account the - buffer name. - - * gnus-srvr.el (gnus-server-prepare): Try to make sure we only - insert servers once. - - * gnus-sum.el (gnus-summary-walk-group-buffer): Don't move point - much. - - * gnus-group.el (gnus-group-update-group): Don't move point. - - * gnus-xmas.el (gnus-xmas-force-redisplay): Changed default to - nil. - (gnus-xmas-switch-horizontal-scrollbar-off): New function. - (gnus-xmas-redefine): Use it. - - * nnfolder.el (nnfolder-active-number): Don't save active here. - - * gnus-sum.el (gnus-summary-reparent-thread): Use the original - article. - -Fri Feb 28 01:01:33 1997 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-1): Pass ARG on to listing. - (gnus-started-hook): New. - (gnus-1): Use it. - - * gnus-group.el (gnus-group-get-new-news): List using ARG if ARG - is higher than current listing. - -Tue Feb 25 23:28:47 1997 Lars Magne Ingebrigtsen - - * nntp.el (nntp-retrieve-headers): Go to the next-to-last line. - -Fri Feb 21 00:28:37 1997 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-rename-group): Rename to right name. - - * nnmail.el (nnmail-process-babyl-mail-format): Allow continuation - Message-IDs. - (nnmail-process-unix-mail-format): Ditto. - (nnmail-process-mmdf-mail-format): Ditto. - - * nnml.el (nnml-update-file-alist): New function. - (nnml-retrieve-headers): Use it. - (nnml-request-move-article): Delete zipped files. - (nnml-request-replace-article): Write to gzipped, if wanted. - -Thu Feb 20 18:36:22 1997 Lars Magne Ingebrigtsen - - * gnus-picon.el (gnus-picons-display-where): Doc fix. - - * gnus-start.el (gnus-read-newsrc-el-file): Offer to break. - - * nnmail.el (nnmail-search-unix-mail-delim): Exclude newlines from - matches. - -Thu Feb 20 04:16:50 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.15 is released. - -Thu Feb 20 03:28:00 1997 Lars Magne Ingebrigtsen - - * gnus-xmas.el (gnus-xmas-mode-line-buffer-identification): - Respect non-standard mode line settings. - - * gnus-group.el (gnus-group-line-format): Doc fix. - - * nndoc.el (nndoc-rfc934-type-p): New function. - (nndoc-type-alist): Define RFC934 type. - -Wed Feb 19 05:18:06 1997 Hrvoje Niksic - - * gnus-group.el (gnus-group-set-mode-line): Mark the change with - two asterisks. - -Thu Feb 20 03:19:28 1997 Joev Dubach - - * gnus-topic.el (gnus-topic-prepare-topic): Show empty topics. - -Thu Feb 20 02:30:27 1997 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-process-prefix): Use - `gnus-region-active-p'. - - * gnus-score.el (gnus-hierarchial-home-score-file): Respect short - file names. - (gnus-hierarchial-home-adapt-file): Ditto. - -Wed Feb 19 00:44:41 1997 Lars Magne Ingebrigtsen - - * nnml.el (nnml-request-regenerate): Return t. - - * gnus-srvr.el (gnus-server-regenerate-server): Better messaging. - - * gnus.el: Autoload gnus-quote-arg-for-sh-or-csh. - -Tue Feb 18 23:26:28 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.14 is released. - -Tue Feb 18 21:47:18 1997 Lars Magne Ingebrigtsen - - * gnus-xmas.el (gnus-xmas-modeline-glyph): Didn't work when the - etc dir couldn't be found. - - * gnus-topic.el (gnus-topic-fold): Enter into dribble. - - * nnbabyl.el (nnbabyl-request-scan): Put things in right dir. - * nnmbox.el (nnmbox-request-scan): Ditto. - - * gnus-sum.el (gnus-offer-save-summaries): Use - `switch-to-buffer'. - - * nnkiboze.el (nnkiboze-enter-nov): Removed debug. - - * gnus-sum.el (gnus-summary-insert-pseudos): Quote when not - viewing separately. - -Sun Feb 16 23:43:19 1997 Hrvoje Niksic - - * gnus-topic.el (gnus-topic-edit-parameters): Print the topic - name. - - * gnus-group.el (gnus-group-edit-group): Print the group name. - -Sun Feb 16 18:30:27 1997 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-score-adaptive): Respect score adapt - settings. - - * gnus-sum.el (gnus-summary-prev-page): Search all frames for - window. - (gnus-summary-next-page): Ditto. - -Sun Feb 16 18:12:01 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.13 is released. - -Sun Feb 16 16:20:33 1997 Lars Magne Ingebrigtsen - - * gnus-nocem.el (gnus-nocem-scan-groups): Allow NULL references. - - * message.el (message-make-caesar-translation-table): New function. - (message-caesar-region): Use it. - - * messagexmas.el (message-xmas-make-caesar-translation-table): New - function. - - * gnus-art.el (gnus-article-add-buttons): Respect previous - buttons. - (gnus-button-in-region-p): New function. - (gnus-article-add-buttons): Use it. - - * nnweb.el (nnweb-max-hits): Fixed default. - -Tue Feb 11 20:25:42 1997 Hrvoje Niksic - - * gnus-srvr.el (gnus-server-regenerate-server): Typo. - -Sun Feb 16 15:24:40 1997 Lars Magne Ingebrigtsen - - * message.el: Removed `message-point-at-bol' and `eol'. - - * gnus-start.el (gnus-read-active-file): Allow FORCE argument. - (gnus-check-bogus-newsgroups): Use it. - - * gnus-srvr.el (gnus-server-copy-server): Allow copying of - unreadable servers. - -Thu Feb 13 19:44:33 1997 Steven L Baur - - * gnus-util.el (gnus-output-to-mail): Make sure `From ' lines in - saved messages are preceded by a newline. - -Wed Feb 12 05:28:32 1997 Zlatko Calusic - - * gnus-sum.el (gnus-summary-copy-article): Use TO-NEWSGROUP. - -Sat Feb 15 21:48:23 1997 Per Abrahamsen - - * nnmail.el: Organized customization options. - * gnus.el: Updated. - -Wed Feb 12 18:06:11 1997 Per Abrahamsen - - * gnus-kill.el: Reorganized customization - options. - * gnus-sum.el: Ditto. - * gnus-score.el: Ditto. - * gnus-start.el: Ditto. - * gnus.el: Ditto. - -Fri Feb 14 09:30:42 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (article-strip-multiple-blank-lines): Inhibit - point-motion hooks. - (article-hide-pgp): Don't hide the leading newline. - - * gnus-group.el (gnus-group-quick-select-group): Bind - gnus-home-score-file to nil. - - * gnus-start.el (gnus-dribble-read-file): Changed prompt. - -Wed Feb 12 09:39:53 1997 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-get-new-mail): Make sure we're using directory - file names. - -Tue Feb 11 14:00:56 1997 Lars Magne Ingebrigtsen - - * message.el (message-followup): Respect Posted-To. - -Tue Feb 11 08:15:38 1997 Rich Pieri - - * nnmail.el (nnmail-pop3-movemail): New function. - -Tue Feb 11 03:44:43 1997 Karl Kleinpaste - - * gnus-art.el (gnus-emphasis-alist): Made compounds available - again. - -Mon Feb 10 08:54:09 1997 Steven L Baur - - * dgnushack.el (dgnushack-compile): XEmacs doesn't complain about - portability variables any more. - -Mon Feb 10 14:19:55 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.12 is released. - -Mon Feb 10 12:47:41 1997 Lars Magne Ingebrigtsen - - * message.el (message-fetch-field): Accept an optional param. - (message-reply): Only fetch the first Message-ID. - - * gnus-score.el (gnus-summary-score-effect): Update mode line. - -Mon Feb 10 12:32:38 1997 Hrvoje Niksic - - * gnus-art.el: Simplify. - -Mon Feb 10 12:23:48 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-prev-page): Don't scroll when the - article buffer isn't visible. - - * gnus.el ((featurep 'gnus-xmas)): Removed - `gnus-make-local-hook'. - -Mon Feb 10 12:08:31 1997 Adrian Aichner - - * gnus-util.el (gnus-turn-off-edit-menu): Doc fix. - -Mon Feb 10 07:42:37 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-prepare-unthreaded): Make sure point - is at bol. - - * gnus-srvr.el (gnus-browse-mode-map): Define gnus-bug. - (gnus-server-mode-map): Ditto. - - * gnus-sum.el (gnus-summary-edit-article-done): Update original - article buffer. - - * gnus-uu.el (gnus-uu-digest-mail-forward): Restore window - config. - - * nnmail.el (nnmail-move-inbox): Make sure tofile exists before - setting modes. - - * gnus-xmas.el (gnus-xmas-region-active-p): New function. - - * gnus-ems.el (gnus-region-active-p): New function. - -Mon Feb 10 07:40:45 1997 Hrvoje Niksic - - * gnus-sum.el (gnus-summary-work-articles): Use zmacs-region. - -Mon Feb 10 07:06:44 1997 Lars Magne Ingebrigtsen - - * message.el (message-mode): Nix out all local variables. - - * gnus-art.el (gnus-summary-save-in-mail): Don't ask. - - * gnus-sum.el (gnus-ps-print-hook): New hook. - (gnus-summary-print-article): Use it. - - * message.el (message-reply): Make sure there is something - inserted as a To. - -Mon Feb 10 05:54:28 1997 Paul Franklin - - * gnus-group.el (gnus-group-edit-group): Ignore errors while - closing group. - -Mon Feb 10 05:22:09 1997 Steven L. Baur - - * messagexmas.el (message-xmas-maybe-fontify): New function. - (message-mode-hook): Use it. - -Sat Feb 8 21:18:25 1997 Lars Magne Ingebrigtsen - - * message.el (message-user-organization): Only use string values - of `gnus-local-organization'. - -Tue Feb 4 20:26:20 1997 Paul Franklin - - * nnmail.el (nnmail-get-spool-files): Don't call file-directory-p - on pop spool specifiers. - -Wed Feb 5 01:56:07 1997 Lars Magne Ingebrigtsen - - * message.el (message-delete-mh-headers): Changed default. - (message-send-mail-with-mh): Use it. - (message-mh-deletable-headers): Renamed. - - * gnus-sum.el (gnus-read-header): Don't do anything if the article - can't be requested. - -Wed Feb 5 01:51:07 1997 Joev Dubach - - * gnus-sum.el (gnus-select-newsgroup): Update group line. - -Tue Feb 4 20:23:30 1997 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-output-to-mail): Insert a newline before the - "From ". - - * nnml.el (nnml-request-move-article): Update active ranges. - (nnml-nov-delete-article): Update active ranges. - -Tue Feb 4 17:54:09 1997 HISASHIGE Kenji - - * gnus-msg.el (gnus-summary-reply-with-original): Pass on the - `wide' param. - -Tue Feb 4 03:49:59 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.11 is released. - -Tue Feb 4 01:57:56 1997 Lars Magne Ingebrigtsen - - * nnvirtual.el (nnvirtual-last-accessed-component-group): New - variable. - (nnvirtual-request-article): Use it and allow fetching by - Message-ID. - - * gnus-dup.el (gnus-dup-enter-articles): Don't enter canceled - articles into dup lists. - - * nnvirtual.el (nnvirtual-update-read-and-marked): Check that we - have a current group. - - * message.el (message-mode): Add "field" menu under XEmacs. - -Mon Feb 3 07:46:33 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.10 is released. - -Mon Feb 3 05:48:09 1997 Lars Magne Ingebrigtsen - - * message.el (message-fcc-handler-function): Doc fix. - (message-do-fcc): Revert to 5.4.8 behavior. - - * gnus-util.el ((fboundp 'point-at-bol)): Made into defun. - - * gnus-topic.el (gnus-topic-check-topology): Skip "dummy.group". - (gnus-group-sort-topic): Delete "dummy.group". - - * gnus-art.el (article-make-date-line): Add a newline. - - * nnkiboze.el (nnkiboze-generate-group): Check that the nov file - exists. - - * gnus-sum.el (gnus-summary-make-menu-bar): Moved some. - - * gnus-art.el (gnus-article-make-menu-bar): Exclude the summary - menu. - - * gnus.el (gnus-similar-server-opened): New function. - (gnus-server-extend-method): Use it. - - * gnus-sum.el (gnus-data-set-header): New macro. - (gnus-summary-edit-article-done): Update when the Message-ID is - edited. - - * nnml.el (nnml-request-article): Return the correct group name. - -Sat Feb 1 21:29:56 1997 Lars Magne Ingebrigtsen - - * smiley.el (smiley-buffer): Use the `smiley-mouse-face' variable, - not face. - -Sat Feb 1 14:19:54 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.9 is released. - -Sat Feb 1 13:30:33 1997 Hrvoje Niksic - - * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Insert - "-*- emacs-lisp -*-" at the first line. - -Sat Feb 1 13:23:19 1997 Mark Borges - - * gnus-xmas.el (gnus-xmas-define): Do the right characterp thing. - -Sat Feb 1 12:28:33 1997 Lars Magne Ingebrigtsen - - * smiley.el (smiley-mouse-face): New variable. - (smiley-buffer): Use it. - - * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Use gnus-prin1. - - * gnus-util.el (gnus-prin1): Bind print-level and print-length to - nil - - * gnus-art.el (gnus-button-alist): Let mailto: be less greedy. - (gnus-button-alist): Ditto with news:. - - * gnus-topic.el (gnus-topic-unmark-topic): Let groups be unmarked. - - * gnus.el (gnus-read-group): Place point at bol. - - * gnus-util.el ((fboundp 'point-at-bol)): Use the functions if - they exist. - - * gnus-msg.el (gnus-summary-supersede-article): Mark article as - canceled. - -Wed Jan 29 22:28:44 1997 Steven L Baur - - * gnus-xmas.el (gnus-xmas-define): Correct XEmacs version test to - handle v20. - -Sat Feb 1 12:19:14 1997 Katsumi Yamaoka - - * nnml.el (nnml-generate-active-info): Don't bug out. - -Sat Feb 1 00:52:03 1997 Lars Magne Ingebrigtsen - - * message.el (message-fcc-handler-function): Changed default. - (message-output): New function. - (message-do-fcc): Use it. - - * gnus-util.el (gnus-convert-article-to-rmail, - gnus-output-to-rmail): Moved here. - - * message.el (message-check-news-header-syntax): Allow trailing - periods. - (message-check-news-header-syntax): Don't allow trailing periods. - -Fri Jan 31 22:18:03 1997 Lars Magne Ingebrigtsen - - * message.el (message-resend): Rename "From ". - - * nntp.el (nntp-accept-process-output): Use nnheader-message. - -Fri Jan 31 11:51:18 1997 Katsumi Yamaoka - - * nnml.el (nnml-generate-nov-databases-1): Sort the file alist. - -Thu Jan 30 13:13:39 1997 Per Abrahamsen - - * gnus.el: More cleanup of customization groups. - -Thu Jan 30 04:33:01 1997 Sudish Joseph - - * gnus-xmas.el (gnus-xmas-define): Use `char-or-char-int-p'. - -Thu Jan 30 04:15:28 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.8 is released. - -Thu Jan 30 02:07:13 1997 Lars Magne Ingebrigtsen - - * message.el (message-indent-citation): Place point the right - place when indenting. - - * nnml.el (nnml-generate-active-info): Don't enter conses into - lists. - - * gnus-score.el (gnus-score-file-rank): All global score files - have low ranks. - - * nnweb.el (nnweb-possibly-change-server): Read active file. - (nnweb-dejanews-create-mapping): Respect .overview. - (nnweb-reference-create-mapping): Ditto. - (nnweb-altavista-create-mapping): Ditto. - -Wed Jan 29 04:52:31 1997 Katsumi Yamaoka - - * nnml.el (nnml-generate-nov-databases-1): Generate NOV files in - the right order. - -Tue Jan 28 23:28:49 1997 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-list-groups): Position point. - -Tue Jan 28 22:11:36 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.7 is released. - -Tue Jan 28 19:48:54 1997 Lars Magne Ingebrigtsen - - * nnmh.el (nnmh-deletable-article-p): Never allow deleting the - last article in the group. - - * nnweb.el (nnweb-definition): Accept an optional noerror - argument. - (nnweb-request-article): Don't bug out when requesting by MsgId. - - * gnus-topic.el (gnus-group-prepare-topics): Return the number of - unread articles in the buffer. - - * gnus-group.el (gnus-group-list-groups): On empty buffers, let - point go to the beginning. - (gnus-group-list-groups): Give "No news" message when using - topics. - - * gnus-topic.el (gnus-topic-goto-next-group): Let point remain - at the end of the buffer. - - * gnus-group.el (gnus-group-rename-group): Check group name - syntax. - - * gnus.el (gnus-read-group): Accept an optional default. - -Tue Jan 28 18:11:54 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.6 is released. - -Tue Jan 28 13:55:12 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-check-hidden-text): Widen before doing - anything. - - * gnus.el (gnus-visual): Doc fix. - - * gnus-art.el (gnus-visible-headers): Just include "Resent-From". - -Mon Jan 27 19:40:37 1997 Paul Franklin - - * gnus-sum.el (gnus-read-header): Make sure nntp-server-buffer is - empty on failure. - -Tue Jan 28 00:33:27 1997 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-delete-incoming): Changed default. - - * gnus-topic.el (gnus-topic-mark-topic): Let groups be marked. - (gnus-topic-unmark-topic): Ditto. - - * nnmail.el (nnmail-process-babyl-mail-format): Unquote ">From ". - - * gnus-sum.el (gnus-summary-read-group): Only beep dead groups. - -Mon Jan 27 18:24:27 1997 Lars Magne Ingebrigtsen - - * nnml.el (nnml-generate-nov-databases-1): Work properly on - compressed files. - (nnml-generate-nov-file): Ditto. - - * gnus.el (gnus-article-mode-map): Don't unconditionally suppress - all the major keymaps. - - * gnus-sum.el (gnus-summary-read-group): Beep dead non-native - groups can't be entered. - -Mon Jan 27 18:03:17 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.5 is released. - -Mon Jan 27 17:35:21 1997 Lars Magne Ingebrigtsen - - * message.el (message-expand-group): Don't skip over ":". - - * gnus-score.el (gnus-score-find-bnews): Wouldn't find "nntp+" - score files. - - * gnus-art.el (t): Define `M-^'. - -Mon Jan 27 15:00:11 1997 Hrvoje Niksic - - * gnus-sum.el (gnus-summary-search-article): Inhibit forced - redisplay on XEmacs. - -Mon Jan 27 08:54:55 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.4 is released. - -Mon Jan 27 07:29:30 1997 Lars Magne Ingebrigtsen - - * nnsoup.el (nnsoup-file-name): Also find AREAS. - -Mon Jan 27 07:09:13 1997 Joev Dubach - - * message.el (message-use-followup-to): Doc fix. - -Mon Jan 27 06:59:14 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-read-summary-keys): Don't mess up when - using pick mode. - - * gnus-undo.el (gnus-undo-mode): Set undo boundary. - - * gnus-sum.el (gnus-summary-exit-hook): Doc fix. - -Sun Jan 26 13:20:42 1997 Lars Magne Ingebrigtsen - - * gnus.el: Autoload gnus-add-configuration. - -Sun Jan 26 13:01:07 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.3 is released. - -Sun Jan 26 12:52:11 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.2 is released. - -Sun Jan 26 09:28:31 1997 Per Abrahamsen - - * gnus-group.el: Organized customization options, and moved group - definitions to `gnus.el'. - * gnus-sum.el: Ditto. - * gnus.el: Ditto. - -Sun Jan 26 07:37:40 1997 Lars Magne Ingebrigtsen - - * gnus.el: Autoload topic function. - - * gnus-topic.el (gnus-topic-set-parameters): Quote strings to - enter into dribble file. - - * gnus-salt.el (gnus-pick-setup-message): Also restore right - config on sending. - - * gnus.el (gnus-group-startup-message): Add a space to the - beginning of the version string. - -Sat Jan 25 12:17:56 1997 Lars Magne Ingebrigtsen - - * gnus.el: Gnus v5.4.1 is released. - -Sat Jan 25 10:59:31 1997 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.84 is released. - -Fri Jan 24 20:31:25 1997 Paul Franklin - - * gnus-sum.el (gnus-summary-next-article): There's no - reason not to select the current article if it's what should - be selected. - -Sat Jan 25 01:03:59 1997 Per Abrahamsen - - * gnus-art.el: Organized customization options. - * gnus-sum.el: Adjusted. - * gnus-cite.el: Ditto. - * gnus.el: Ditto. - -Sat Jan 25 09:49:40 1997 Lars Magne Ingebrigtsen - - * gnus-demon.el (gnus-demon): Disable demons when the minibuffer - window is active. - - * gnus-art.el (gnus-article-read-summary-keys): Disable pick mode - commands. - -Sat Jan 25 09:42:41 1997 Kurt Swanson - - * message.el (message-pipe-buffer-body): New function. - - * gnus-sum.el (gnus-summary-pipe-message): New command and - keystroke. - -Fri Jan 24 11:01:06 1997 Per Abrahamsen - - * gnus-uu.el: Cleaned up customization groups. - -Fri Jan 24 15:45:48 1997 Kurt Swanson - - * gnus-sum.el (gnus-summary-make-menu-bar): Moved cache menu. - -Fri Jan 24 10:05:49 1997 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-summary-resend-message): Accept - process/prefix. - - * gnus-cite.el (gnus-article-fill-cited-article): Accept a width - prefix. - - * gnus-art.el (gnus-article-read-summary-keys): Disable pick mode - map. - - * gnus-sum.el (gnus-summary-make-menu-bar): Duplication removed. - -Fri Jan 24 08:33:42 1997 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.83 is released. - -Fri Jan 24 05:05:38 1997 Lars Magne Ingebrigtsen - - * gnus.el (gnus-article-display-hook): Removed emphasize. - - * gnus-score.el (gnus-score-edit-current-scores): Set global - vars. - - * nnml.el (nnml-possibly-change-directory): Return nil when the - group can't be selected. - - * gnus-art.el (gnus-emphasis-alist): Don't underline - all-underscore words. - - * gnus-topic.el (gnus-topic-unindent): Give the right number of - unread articles. - (gnus-topic-indent): Ditto. - - * gnus-msg.el (gnus-summary-wide-reply-with-original): New command - and keystroke. - (gnus-summary-wide-reply): Ditto. - -Fri Jan 24 04:57:07 1997 Joe Wells - - * gnus-uu.el (gnus-quote-arg-for-sh-or-csh): New function. - (gnus-uu-command): Use it. - -Fri Jan 24 04:55:10 1997 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-mark-topic): Also bound to `#'. - -Fri Jan 24 04:44:10 1997 Greg Klanderman - - * message.el (message-do-send-housekeeping): Check for nil - message-buffer-list. - -Fri Jan 24 02:55:33 1997 Kurt Swanson - - * gnus-util.el (gnus-eval-in-buffer-window): Set buffer. - -Thu Jan 23 03:39:48 1997 Lars Magne Ingebrigtsen - - * nnsoup.el (nnsoup-file-name): New function. - (nnsoup-read-areas): Use it. - (nnsoup-dissect-buffer): New function. - (nnsoup-number-of-articles): Use it. - (nnsoup-narrow-to-article): Ditto. - (nnsoup-header): Removed. - - * gnus.el (gnus-check-backend-function): Doc fix. - - * gnus-art.el (gnus-article-goto-prev-page): Went to next article, - not prev. - - * gnus-group.el (gnus-group-insert-group-line-info): Display "*" - on unknown groups. - - * gnus-art.el (article-hide-boring-headers): Ignore errors in - `mail-extract-address-components'. - - * nnmail.el (nnmail-date-to-time): Parse zone correctly. - (nnmail-date-to-time): Seconds, dammit, seconds! - -Tue Jan 21 09:31:55 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-url-mailto): Didn't accept mailto links. - - * gnus-score.el (gnus-summary-score-effect): Doc fix. - - * nnmail.el (nnmail-move-inbox): Don't prin1 password. - -Mon Jan 20 18:06:19 1997 Paul Franklin - - * gnus-sum.el (gnus-simplify-buffer-fuzzy-step): New function. - (gnus-simplify-buffer-fuzzy): Use it. - - * gnus-sum.el (gnus-simplify-buffer-fuzzy): Fix while condition. - Add self-discipline tags. - -Tue Jan 21 05:28:05 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-get-newsgroup-headers-xover): Would return - nil from NoCeM. - -Mon Jan 20 04:59:53 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-button-alist): Only on word boundaries. - - * message.el (message-check-news-header-syntax): Don't prompt when - not read active file. - - * gnus-msg.el (gnus-setup-message): Always set actions. - -Sat Jan 18 07:23:41 1997 Lars Magne Ingebrigtsen - - * nntp.el (nntp-have-messaged): New variable. - (nntp-accept-process-output): Use it. - (nntp-wait-for): Ditto. - -Sat Jan 18 02:44:53 1997 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.82 is released. - -Fri Jan 17 00:04:47 1997 Lars Magne Ingebrigtsen - - * nnheader.el (nnheader-find-nov-line): Do the right thing with - short buffers. - - * nnkiboze.el (nnkiboze-generate-group): Supress duplicate - suppression. - (nnkiboze-generate-group): Message better. - - * gnus-sum.el (gnus-get-newsgroup-headers-xover): Don't always - fetch more heads. - (gnus-select-newsgroup): Use it. - - * nnmail.el (nnmail-get-new-mail): Weird file-truename problem. - - * gnus-sum.el (gnus-summary-caesar-message): Dox fix. - (gnus-articles-to-read): Limit length of prompt. - - * message.el (message-followup): Fold case before comparing - "world" to Distribution. - - * gnus-sum.el (gnus-summary-save-newsrc): Save dribble buffer. - - * nnfolder.el (nnfolder-request-expire-articles): Better message. - - * gnus-nocem.el (gnus-nocem-load-cache): Interactive. - -Thu Jan 16 23:48:05 1997 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-move-inbox): Use `nnmail-pop-password'. - -Wed Jan 15 18:41:42 1997 Lars Magne Ingebrigtsen - - * nnml.el (nnml-request-expire-articles): Typo. - (nnml-request-expire-articles): Don't blank out messages so - often. - - * nnsoup.el (nnsoup-request-type): Let commands like `a' work - better. - -Wed Jan 15 05:33:23 1997 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.81 is released. - -Wed Jan 15 02:57:18 1997 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-indent): Don't remove all groups from - topic. - (gnus-topic-unindent): Ditto. - - * gnus-sum.el (gnus-summary-respool-query): Don't mark anything as - read. - - * gnus-art.el (gnus-button-alist): Move news:mesg-id up. - - * gnus.el (gnus-article-display-hook): Emphasize by default. - - * gnus-topic.el (gnus-topic-rename): Mark newsrc as dirty. - - * gnus-sum.el (gnus-summary-next-page): When the article window - isn't displayed, don't scroll. - -Wed Jan 15 02:19:56 1997 Markus Linnala - - * gnus-cite.el (gnus-cite-reply-regexp, gnus-cite-always-check): - New variables. - -Wed Jan 15 02:02:03 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (article-date-user): New command and keystroke. - -Wed Jan 15 02:01:15 1997 David Moore - - * gnus-art.el (gnus-article-time-format): New variable. - (article-make-date-line): Use it. - -Wed Jan 15 01:44:15 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-emphasis-alist): Allow emphasis around - sentences. - (gnus-button-url-regexp): Don't allow empty URLs. - -Sun Jan 12 19:27:23 1997 Thor Kristoffersen - - * nntp.el (nntp-request-head): Work when using rlogin. - -Sun Jan 12 15:17:16 1997 Chris Bone - - * nntp.el (nntp-accept-process-output): Give numerical messages. - (nntp-wait-for): Search less. - -Fri Jan 10 17:38:38 1997 Erik Toubro Nielsen - - * gnus-art.el (gnus-Numeric-save-name): Doc fix. - -Thu Jan 9 21:51:59 1997 Dan Schmidt - - * nnmail.el (nnmail-move-inbox): Quote password. - -Thu Jan 9 18:24:32 1997 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-move-inbox): Don't nix out - nnmail-internal-password. - - * nnml.el (nnml-request-expire-articles): Also expire gzipped - articles. - - * gnus-art.el (article-emphasize): Wouldn't toggle. - -Thu Jan 9 18:18:26 1997 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.80 is released. - -Thu Jan 9 12:00:21 1997 Wesley Hardaker - - * acronym.el: New package. - -Thu Jan 9 11:43:28 1997 Lars Magne Ingebrigtsen - - * gnus.el: Updated copyrights. - - * nnoo.el (nnoo-push-server): Only push the first server. - -Wed Jan 8 11:34:07 1997 David Moore - - * nnoo.el (nnoo-push-server): Revert to 0.77 behaviour. - - * nnvirtual.el (nnvirtual-info-installed): New variable. - (nnvirtual-open-server): Use it. - (nnvirtual-request-update-info): ditto. - (nnvirtual-create-mapping): ditto. - - * gnus-group.el (gnus-group-edit-group): Close the group before - editing it. - (gnus-group-add-to-virtual): ditto. - -Thu Jan 9 11:32:13 1997 Lars Magne Ingebrigtsen - - * gnus-art.el: Redefine ems. - -Wed Jan 8 20:34:09 1997 John McClary Prevost - - * message.el (message-sendmail-f-is-evil): New variable. - (message-elide-elipsis): Ditto. - -Wed Jan 8 17:19:02 1997 Paul Stodghill - - * gnus-demon.el (gnus-demon): Don't run when not idle. - -Wed Jan 8 12:58:23 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-work-articles): Accept non-numerical - prefix values. - -Wed Jan 8 12:52:53 1997 Jason Rumney - - * nnmail.el (nnmail-move-inbox): Use `nnmail-internal-password'. - -Tue Jan 7 15:41:35 1997 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-show-hidden-text): Would bug out on - signatures. - -Mon Jan 6 23:46:53 1997 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.79 is released. - -Mon Jan 6 11:23:05 1997 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-process-babyl-mail-format): Widen at the right - place. - - * nnfolder.el (nnfolder-possibly-change-group): Set current group - before reading folder. - - * message.el (message-send-mail-with-mh): Expand file name. - (message-mode-menu): Check whether mark-active exists. - - * gnus-group.el (gnus-group-get-new-news): Don't pass ARG to the - listing function. - - * gnus-xmas.el (gnus-xmas-article-show-hidden-text): Deleted. - -Sun Jan 5 21:35:37 1997 Sudish Joseph - - * gnus-xmas.el (gnus-xmas-article-show-hidden-text): Use - 'article-type as the textprop of interest. Speed fix. - - * gnus-art.el (gnus-article-show-hidden-text): Speed fix. - -Sun Jan 5 11:43:08 1997 Lars Magne Ingebrigtsen - - * nnml.el (nnml-retrieve-headers-with-nov): Use faster method for - finding the right range. - - * gnus-demon.el (gnus-demon): Would fire off even if not idle. - - * gnus-srvr.el (gnus-server-add-server): Error when defining an - existing server. - - * gnus-start.el (gnus-get-unread-articles): Update info for native - groups. - - * gnus-load.el (gnus-nocem): New file. - - * gnus-sum.el (gnus-get-newsgroup-headers-xover): Make sure the - group name isn't nil. - -Sun Jan 5 11:18:22 1997 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.78 is released. - -Sun Jan 5 09:39:14 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-exit-no-update): Prompt change. - (gnus-summary-limit-to-author): Ditto. - (gnus-summary-limit-to-subject): Ditto. - - * gnus-cite.el (gnus-dissect-cited-text): Recognize articles that - end with cited text. - - * gnus-topic.el (gnus-group-sort-topic): Remove nil elements. - - * nnoo.el (nnoo-push-server): When switching from the nil server, - update all the default values of the variables. - - * nnkiboze.el (nnkiboze-generate-group): Protect against nil - infos. - - * lpath.el: Included. - -Sun Jan 5 09:36:57 1997 Martin Buchholz - - * dgnushack.el (bytecomp): Required. - -Sat Jan 4 11:45:45 1997 Lars Magne Ingebrigtsen - - * gnus-art.el: Rename some functions back. - - * gnus-sum.el (gnus-summary-save-newsrc): Don't nix out scores. - - * gnus-async.el (gnus-async-prefetched-article-entry): Would - hang Emacs. - -Sat Jan 4 11:28:24 1997 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.77 is released. - -Sat Jan 4 08:35:06 1997 Lars Magne Ingebrigtsen - - * gnus-cache.el (gnus-start): Don't require gnus-sum. - - * gnus-art.el: All article functions moved here. - - * article.el: Elided. - - * gnus-async.el (gnus-async-prefetched-article-entry): Check for - empty articles. - - * gnus-art.el (gnus-read-save-file-name): Expand file name in - article save dir. - -Fri Jan 3 21:22:21 1997 Paul Stodghill - - * gnus-demon.el (gnus-demon): Use `gnus-demon-idle-time'. - -Tue Dec 31 10:38:43 1996 - - * pop3.el: version 1.3 - - * pop3.el: (pop3-retr): added bill@attmail.com's big buffer sleeps - to save wear and tear on he heap. - -Thu Aug 01 11:53:48 1996 - - * pop3.el: version 1.2 - - * pop3.el: (pop3-apop): minor changes to support XEmacs built-in - md5, or William Perry's modified md5.el. - - * pop3.el: (pop3-movemail): changed to use - pop3-authentication-scheme instead of pop3-use-apop. - - * pop3.el: pop3-use-appop: transformed into - pop3-authentication-scheme. - - * pop3.el: version 1.1 - - * pop3.el: (pop3-apop): new function. Send alternate - authentication information to the server. Requires md5.el. - - * pop3.el: (pop3-open-server): set pop3-timestamp if server - returns one. - - * pop3.el: (pop3-movemail): use APOP authentication if - pop3-use-apop non-nil. - - * pop3.el: pop3-timestamp: added variable - - * pop3.el: pop3-use-apop: added variable - -Fri Jan 3 18:52:23 1997 Wesley Hardaker - - * gnus-group.el (gnus-group-get-new-news): Pass the ARG on to the - listing function. - -Fri Jan 3 18:32:24 1997 Lars Magne Ingebrigtsen - - * article.el (article-hide-boring-headers): Respect - gnus-show-all-headers. - - * gnus-sum.el (gnus-summary-save-article): Update the mode line. - -Fri Jan 3 18:30:50 1997 Erik Toubro Nielsen - - * nnmail.el (nnmail-remove-leading-whitespace): Replacing should - be non-literal. - -Fri Jan 3 18:18:30 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-expire-articles-now): Use - "yes-or-no". - (gnus-summary-delete-article): Ditto. - -Fri Jan 3 18:16:27 1997 Peter Skov Knudsen - - * gnus-win.el (gnus-buffer-configuration): Don't create picons - frame unless needed. - -Fri Jan 3 17:21:30 1997 Lars Magne Ingebrigtsen - - * message.el (message-elide-region): New command and keystroke. - - * gnus-salt.el (gnus-generate-vertical-tree): Check whether we can - go backwards. - - * gnus-group.el (gnus-group-catchup-current): Prompt better. - - * gnus-undo.el (gnus-undo-make-menu-bar): Nonsense. - -Fri Jan 3 16:52:22 1997 Rajappa Iyer - - * gnus-salt.el (gnus-pick-start-reading): Possibly catch up all - unpicked articles. - -Fri Jan 3 12:12:22 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-get-newsgroup-headers-xover): Try to get the - few last headers using HEAD in any case to work around a bug in - inn. - - * gnus-xmas.el (gnus-xmas-define): Redefined. - - * gnus.el (gnus-characterp): Made into func. - -Thu Jan 2 16:21:47 1997 Sudish Joseph - - * gnus-util.el (gnus-characterp): New function. - -Wed Dec 18 18:15:39 1996 Jan Vroonhof - - * gnus-start.el (gnus-dribble-enter): Make sure we write at the - end of the dribble file - -Thu Jan 2 16:01:58 1997 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-limit-children): Make NoCeM'ed - articles read. - -Tue Dec 17 20:24:40 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-save-newsrc): Respect the prefix. - -Mon Dec 16 23:47:30 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.76 is released. - -Mon Dec 16 14:33:58 1996 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-bug): Insert nntp server type. - (gnus-copy-article-buffer): Remove prev/next buttons. - - * gnus-cache.el (gnus-jog-cache): Let the call func be - interactive. - - * gnus-art.el (gnus-summary-save-in-pipe): Include number of - articles. - (gnus-article-add-buttons): Don't add buttons to already - buttonized areas. - - * nntp.el (nntp-open-connection): Allow `C-g' to continue. - - * nnbabyl.el (nnbabyl-retrieve-headers): Wouldn't find all - articles sometimes. - - * gnus-sum.el (gnus-data-compute-positions): Reinstated. - (gnus-remove-thread): Do the right thing with dummy roots. - - * nndoc.el (nndoc-request-article): Only return valid articles. - - * nnfolder.el (nnfolder-delete-mail): Wouldn't delete From lines. - - * gnus-topic.el (gnus-topic-find-groups): Ignore nil groups. - - * nnfolder.el (nnfolder-save-mail): Quote all "From " lines. - -Sat Dec 14 11:49:21 1996 David Moore - - * gnus-nocem.el (gnus-nocem-groups): - news.admin.net-abuse.bulletins is to replace - news.admin.net-abuse.announce for nocemish postings. - -Mon Dec 16 13:38:38 1996 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-move-inbox): Message at end. - - * gnus-sum.el (gnus-summary-refer-parent-article): Use - "in-reply-to" header. - - * gnus-topic.el (gnus-topic-set-parameters): Enter into dribble. - - * gnus-sum.el (gnus-summary-save-newsrc): Change. - (gnus-summary-catchup): Only catch up the limited articles. - (gnus-simplify-subject-fuzzy-regexp): Changed to nil. - (gnus-simplify-buffer-fuzzy): Ignore nil - gnus-simplify-subject-fuzzy-regexp. - - * gnus-srvr.el (gnus-server-prepare): Don't insert servers twice. - -Thu Dec 12 18:18:11 1996 David Moore - - * gnus-start.el (gnus-setup-news): Use gnus-make-hashtable. - (gnus-update-active-hashtb-from-killed): ditto. - (gnus-newsrc-to-gnus-format): ditto. - - * gnus-bcklg.el (gnus-backlog-setup): ditto. - - * gnus-sum.el (gnus-create-xref-hashtb): ditto. - - * gnus-move.el (gnus-move-group-to-server): ditto. - - * gnus-util.el (gnus-create-hash-size): Power of 2 hashtables can - be _significantly_ faster than 2^x-1 tables on many risc - machines. Any gains of 2^x-1 are comparably small on other - machines. - -Fri Dec 13 05:05:03 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.75 is released. - -Fri Dec 13 04:49:21 1996 Andre Deparade - - * gnus-cite.el (gnus-cited-text-button-line-format-alist): Make %b - and %e usable. - -Fri Dec 13 01:06:09 1996 Lars Magne Ingebrigtsen - - * article.el (article-decode-rfc1522): Would collate subsequent - encodings. - - * gnus-start.el (gnus-check-bogus-newsgroups): Use - `map-y-or-n-p'. - - * gnus-topic.el (gnus-topic-kill-group): Save topic contents. - (gnus-topic-yank-group): Insert topic contents. - - * gnus-sum.el (gnus-simplify-subject-fuzzy-regexp): Changed - default to "". - - * gnus-score.el (gnus-score-find-favourite-words): Put point at bob. - - * gnus-sum.el (gnus-summary-limit-to-age): Dox fix & interactive - spec. - -Fri Dec 13 01:01:46 1996 David Moore - - * gnus-sum.el (gnus-summary-limit-to-age): New function and - keystroke. - -Tue Dec 10 23:42:00 1996 David Moore - - * gnus-nocem.el (gnus-nocem-groups): news.lists.filters is to - replace alt.nocem.misc - -Wed Dec 11 01:15:31 1996 Lars Magne Ingebrigtsen - - * nnfolder.el (nnfolder-request-expire-articles): Better message. - (nnfolder-delete-mail): Actually delete. - - * gnus-sum.el (gnus-summary-update-info): Don't run - `gnus-exit-group-hook'. - (gnus-summary-expire-articles): Do it. - (gnus-summary-exit): Ditto. - (gnus-summary-save-newsrc): New command and keystroke. - -Wed Dec 11 00:38:12 1996 Stainless Steel Rat - - * gnus-sum.el (gnus-simplify-buffer-fuzzy): New version. - -Mon Dec 9 21:00:09 1996 David Moore - - * gnus-sum.el (gnus-summary-catchup): Out dated catchup code - removed. - - * nnvirtual.el (nnvirtual-update-read-and-marked): Work around a - cache of active count in gnus-update-read-articles. - -Mon Dec 9 22:55:56 1996 Lars Magne Ingebrigtsen - - * article.el (article-emphasize): Use it. - - * gnus-util.el (gnus-put-text-property-excluding-newlines): New - function. - -Mon Dec 9 08:38:08 1996 Per Abrahamsen - - * gnus-sum.el: Split customize groups and added links to the manual. - -1996-12-08 Dave Love - - * gnus-vis.el (gnus-button-alist): Allow whitespace in ` match. - -Mon Dec 9 02:18:35 1996 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-button-embedded-url): New function. - (gnus-button-alist): Use it. - - * gnus-util.el (gnus-strip-whitespace): New function. - -Mon Dec 9 00:04:24 1996 Richard Stallman - - * gnus-start.el (gnus-read-init-file): Don't read init file when - started with "emacs -q". - -Sun Dec 8 18:25:34 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.74 is released. - -Fri Dec 6 12:47:24 1996 Wes Hardaker - - * gnus-picon.el (gnus-picons-insert-face-if-exists): Don't reverse - domains. - -Fri Dec 6 11:33:44 1996 Lars Magne Ingebrigtsen - - * nnfolder.el (nnfolder-request-article): Use it. - (nnfolder-retrieve-headers): Wouldn't find the right header. - - * nnmail.el (nnmail-search-unix-mail-delim-backward): New function. - -Thu Dec 5 21:51:03 1996 Lars Magne Ingebrigtsen - - * gnus.el (gnus-server-add-address): Don't add "*-address" to all - servers. - -Thu Dec 5 21:01:22 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.73 is released. - -Thu Dec 5 19:29:50 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-get-newsgroup-headers-xover): Message the line - number. - - * nnml.el (nnml-request-scan): Change server. - -Sat Nov 30 00:42:39 1996 Steven L Baur - - * earcon.el: Added Customization. - -Thu Dec 5 11:24:15 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-prepare-threads): Don't output - articles outside the limit. - - * gnus-group.el (gnus-group-level): New function. - (gnus-group-list-active): Faster implementation. - (gnus-group-list-all-matching): Accept a `C-u' prefix. - - * message.el (message-news): Make sure newsey things are done. - - * gnus-kill.el (gnus-execute-1): Eval forms properly. - - * gnus-score.el (gnus-score-find-bnews): Treat "+" like ordinary - characters. - - * gnus-sum.el (gnus-summary-make-menu-bar): Update. - - * nndoc.el (nndoc-forward-type-p): Don't give false positives. - - * message.el (message-user-mail-address): Bypass mail-extr. - (message-make-forward-subject): Only fetch the first Subject. - - * gnus-art.el (gnus-button-alist): Reconize news:group urls. - - * gnus-start.el (gnus-group-change-level): Didn't quote strings - entered into dribble. - - * gnus-util.el (gnus-prin1-to-string): Use print-quoted- - - * nnbabyl.el (nnbabyl-request-article): Wouldn't find first - article properly. - (nnbabyl-delete-mail): Ditto. - -Thu Dec 5 06:16:25 1996 Per Abrahamsen - - * nnmail.el (nnmail-split-history): Use - `with-output-to-temp-buffer'. - -Thu Dec 5 08:46:26 1996 Shuhei KOBAYASHI - - * gnus-sum.el (gnus-nov-parse-line): unwind-protect the - narrowing. - -Tue Dec 3 14:06:17 1996 Lars Magne Ingebrigtsen - - * nnheader.el (nnheader-find-file-noselect): Disable local - variables. - - * gnus-group.el (gnus-group-fetch-faq): Ditto. - -Mon Dec 2 17:12:26 1996 Ralph Schleicher - - * gnus-demon.el (gnus-demon-time-to-step): Make it work. - -Sun Dec 1 07:35:32 1996 Lars Magne Ingebrigtsen - - * nntp.el (nntp-retrieve-articles): New function. - (nntp-next-result-arrived-p): New function. - -Sat Nov 30 13:50:15 1996 Lars Magne Ingebrigtsen - - * nnfolder.el (nnfolder-retrieve-headers): Parse unix mboxes better. - (nnfolder-request-article): Ditto. - - * message.el (message-rename-buffer): Make sure the renamed buffer - is valid. - -Sat Nov 30 12:06:47 1996 Lars Magne Ingebrigtsen - - * gnus-cache.el (gnus-cache-enter-article): Warn when trying to - cache negative articles. - -Sat Nov 30 08:53:48 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.72 is released. - -1996-11-30 Markus Linnala - - * gnus-sum.el (gnus-summary-refer-parent-article): Work when there - are no references. - -1996-11-30 Lars Magne Ingebrigtsen - - * message.el (message-fetch-field): Fetch all headers. - - * gnus-sum.el (gnus-cut-thread): Would cut off the wrong - children. - - * gnus-score.el (gnus-all-score-files): Take an optional group - param. - - * gnus-start.el (gnus-dribble-touch): New function. - (gnus-master-read-slave-newsrc): Use it. - - * gnus-salt.el (gnus-generate-vertical-tree): Would bug out on - sparse articles. - - * gnus-sum.el (gnus-summary-search-article): Would infloop. - - * gnus-nocem.el: Ignore invalid entries. - - * gnus-sum.el (gnus-data-remove): Wouldn't update properly when - treating the first article in the buffer. - (gnus-rebuild-thread): Would compute the wrong offset. - (gnus-summary-move-article): Don't mark as read. - -1996-11-28 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-thread-loop-p): New function. - (gnus-make-threads): Avoid inflooped references. - - * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bind - print-length to nil. - -Wed Nov 27 02:41:31 1996 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-process-babyl-mail-format): Goto-char placed - wrongly. - - * gnus-group.el (gnus-group-select-group-emphemerally): New - command and keystroke. - - * gnus-sum.el (gnus-read-header): Fold continuation lines. - -Tue Nov 26 18:43:29 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-update-info): Don't change buffer. - -Tue Nov 26 17:56:19 1996 Hrvoje Niksic - - * gnus-sum.el (gnus-summary-print-article): Prompt for file name. - -Tue Nov 26 17:08:07 1996 Lars Magne Ingebrigtsen - - * article.el (article-date-ut): Use original date. - -Tue Nov 26 08:36:38 1996 Wes Hardaker - - * gnus-picon.el: Customize. - - * smiley.el: Customize. Change artist's email address in comments. - -Tue Nov 26 04:37:54 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.71 is released. - -Tue Nov 26 00:58:25 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-get-split-value): Expand file names in save - dir. - -Mon Nov 25 22:50:19 1996 Jens Lautenbacher - - * gnus-group.el (gnus-group-make-menu-bar): Moved customize. - -Mon Nov 25 15:27:41 1996 Per Abrahamsen - - * gnus.el (custom-facep): Removed. - - * gnus-topic.el (gnus-topic-line-format): Added customize - support. - - * gnus.el (gnus-article-display-hook): Moved - `gnus-article-treat-overstrike' last. - -Mon Nov 25 11:21:15 1996 Wes Hardaker - - * gnus-picon.el: (gnus-picons-try-to-find-face): New param: rightp. - (gnus-picons-insert-face-if-exists): Use it and own new param. - More properly detect location of bar and dots. - (gnus-group-display-picons): Use above. - (gnus-article-display-picons): ditto. - -Mon Nov 25 04:17:03 1996 Lars Magne Ingebrigtsen - - * nnfolder.el (nnfolder-read-folder): Make buffer read/write. - - * gnus-sum.el (gnus-summary-print-article): Delete invisible text - first. - - * article.el (article-delete-invisible-text): New function. - - * nntp.el (nntp-possibly-change-group): Would abort async - fetches. - - * gnus-sum.el (gnus-summary-print-article): New command and - keystroke. - (gnus-summary-move-article): Select the article first. - - * message.el (message-user-agent): Define the message mail user - agent. - -Sun Nov 24 02:28:56 1996 Lars Magne Ingebrigtsen - - * nntp.el (nntp-possibly-change-group): Would get confused. - - * gnus-art.el (gnus-button-url-regexp): Allow all word-constituent - characters to be part of urls. - - * nntp.el (nntp-possibly-change-group): Wait until the status line - arrives and delete it. - -Sun Nov 24 01:36:45 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.70 is released. - -Sat Nov 23 23:22:27 1996 Per Abrahamsen - - * message.el (message-mode-menu): Added `message-caesar-region'. - (message-mode-field-menu): Added `message-insert-to' and - `message-insert-newsgroups'. - -Sat Nov 23 19:53:30 1996 Lars Magne Ingebrigtsen - - * nnkiboze.el: Would destroy all component group infos. - - * gnus-xmas.el (gnus-summary-mail-toolbar): Reversed cathup. - - * gnus-sum.el (gnus-summary-article-unread-p): New function. - (gnus-remove-thread-1): Avoid `text-propery-any'. - (gnus-summary-insert-subject): Ditto. - (gnus-data-compute-positions): Removed. - - * gnus-dup.el (gnus-dup-suppress-articles): Didn't do anything. - - * gnus-group.el (gnus-group-restart): Just start up Gnus - properly. - -Sat Nov 23 07:16:39 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.69 is released. - -Sat Nov 23 05:00:36 1996 Lars Magne Ingebrigtsen - - * gnus-cache.el (gnus-cache-update-active): Wouldn't mark the - cache active file as changed. - - * gnus-start.el (gnus-setup-news): Slaves shouldn't check for new - newsgroups. - - * gnus-sum.el (gnus-group-make-articles-read): Update group line - on undo. - - * gnus-move.el (gnus-move-group-to-server): Check whether - to-active is nil. - - * gnus-score.el (gnus-score-find-hierarchical): Do the right thing - for prefixed group names. - - * nnml.el (nnml-generate-nov-databases-1): Don't infloop. - -Sat Nov 23 04:58:49 1996 Steven L. Baur - - * gnus-score.el (gnus-score-score-files-1): Don't infloop. - -Sat Nov 23 04:40:55 1996 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-make-menu-bar): Protect against - undefined menu vars. - - * gnus-group.el (gnus-group-rename-group): Prompt fix. - -Fri Nov 22 12:17:14 1996 David Moore - - * nnml.el (nnml-generate-nov-databases-1): Don't infloop. - - * gnus-score.el (gnus-score-score-files-1): Don't infloop, be - slightly faster. - -Fri Nov 22 22:18:52 1996 Lars Magne Ingebrigtsen - - * gnus-move.el (gnus-move-group-to-server): Looking-at bug. - (gnus-move-group-to-server): Extend. - - * message.el (message-check-news-header-syntax): Change shoot-me - line. - -Thu Nov 21 18:31:56 1996 David Moore - - * gnus-util.el (gnus-atomic-progn, gnus-atomic-progn-assign, - gnus-atomic-setq): Routines to help protect against corruption to - internal Gnus datastructures from C-g or error signals. - - * gnus-util.el (gnus-atomic-be-safe): Variable which can set to - nil to disable the C-g atomic protection. - - * nnvirtual.el (nnvirtual-update-read-and-marked): Replaces - nnvirtual-update-reads and nnvirtual-update-marked. Does updates - to component groups atomically. - (nnvirtual-request-update-info): Update the virtual group - atomically. - -Fri Nov 22 00:19:23 1996 Lars Magne Ingebrigtsen - - * gnus.el: Create menu bar even when not using menu-bar-mode. - - * gnus-start.el (gnus-1): Don't paint picture gnu twice. - - * gnus-sum.el (gnus-group-make-articles-read): Undo in the right - buffer. - (gnus-update-read-articles): Ditto. - -Fri Nov 22 00:04:59 1996 Raja R. Harinath - - * nnheader.el (nnheader-generate-fake-message-id): Interact better - with duplicate suppression. - -Thu Nov 21 23:31:30 1996 Lars Magne Ingebrigtsen - - * gnus.el (gnus-info-set-entry): Wouldn't extend far enough. - - * gnus-salt.el (gnus-tree-minimize): Ignore errors. - - * gnus-sum.el (gnus-summary-article-sparse-p): New macro. - (gnus-summary-article-ancient-p): Ditto. - (gnus-summary-search-article): Skip sparse articles. - - * article.el (article-date-ut): Wouldn't pick out the date right. - -Thu Nov 21 23:07:34 1996 Raja R. Harinath - - * gnus-dup.el (gnus-dup-enter-articles): Ignore sparse articles. - -Thu Nov 21 21:57:52 1996 Lars Magne Ingebrigtsen - - * gnus-dup.el (gnus-dup-suppress-articles): Only suppress read - articles. - - * article.el (article-delete-text-of-type): Would bug out. - -Thu Nov 21 11:02:36 1996 David Moore - - * nnoo.el (nnoo-change-server): Only preserve un-ooed variables if - they exist globally. - -Thu Nov 21 10:52:39 1996 Steven L Baur - - * article.el (article-date-ut): Extend date header recognition to - deal with systems that put a TAB after the colon. - -Thu Nov 21 19:50:26 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.68 is released. - -Thu Nov 21 05:33:24 1996 Lars Magne Ingebrigtsen - - * nnoo.el (nnoo-change-server): Protect against void vars. - -Thu Nov 21 00:00:29 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.67 is released. - -Wed Nov 20 22:54:34 1996 Lars Magne Ingebrigtsen - - * message.el (message-mode-field-menu): Separated. - - * nnoo.el (nnoo-change-server): Preserve un-ooed variables as - well. - - * nnbabyl.el (nnbabyl-read-mbox): Understand movemailed babyl - files. - -Wed Nov 20 19:25:40 1996 Kurt Swanson - - * gnus-art.el (gnus-article-make-menu-bar): Fix menu bar. - -Wed Nov 20 05:27:45 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-article-sort-by-lines, - gnus-thread-sort-by-lines): New functions. - (gnus-summary-sort-by-lines): New command and keystroke. - - * gnus.el (gnus-other-frame): Be a bit more clever. - - * gnus-group.el (gnus-group-get-new-news): Check for new - newsgroups. - - * nnheader.el (nnheader-insert-file-contents-literally): Bind - `default-major-mode' to nil. - - * gnus-sum.el (gnus-group-make-articles-read): Yet another undo - bug. - - * nnmail.el (nnmail-article-group): Wrong `junk' check. - -Wed Nov 20 05:13:05 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.66 is released. - -Wed Nov 20 01:57:31 1996 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-article-group): Would lose mail when using - advanced splitting! - - * gnus-sum.el (gnus-update-read-articles): Undo fix. - -Tue Nov 19 22:56:56 1996 Lars Magne Ingebrigtsen - - * nnheader.el (nnheader-auto-mode-alist): New function. - -Tue Nov 19 21:57:29 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.65 is released. - -Tue Nov 19 17:41:17 1996 Lars Magne Ingebrigtsen - - * message.el (message-do-fcc): Supply FROM-GNUS param to - rmail-output. - - * gnus-msg.el (gnus-setup-message): Use the buffer name instead of - the buffer. - - * nnmail.el (nnmail-article-group): Respect `junk' advanced - splits. - - * gnus-group.el (gnus-group-restart): Clear system. - - * nnfolder.el (nnfolder-read-folder): Handle zipped files. - - * nnheader.el (nnheader-find-file-noselect): New definition. - - * gnus-art.el (gnus-article-make-menu-bar): Use the menu bar. - - * gnus-score.el (gnus-all-score-files): Would still get the score - files in wrong order. - - * gnus-start.el (gnus-find-new-newsgroups): End message on wrong - level. - - * gnus-srvr.el (gnus-server-prepare): Don't list servers twice. - - * gnus-xmas.el (gnus-xmas-read-event-char): Mystery hanging bug. - - * gnus-score.el (gnus-all-score-files): Expand all files in the - kill files directory. - - * gnus-sum.el (gnus-group-make-articles-read): Register with undo - properly. - (gnus-update-read-articles): Ditto. - - * gnus-msg.el (gnus-debug): Include gnus-async in variables. - -Tue Nov 19 00:07:14 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.64 is released. - -Mon Nov 18 21:42:40 1996 Loren Schall - - * gnus-sum.el (gnus-summary-insert-line): Pick apart the From - header in reversed order. - -Mon Nov 18 02:00:33 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-refer-references): Protect against nil - References. - - * gnus-score.el (gnus-all-score-files): Remove duplicate score - files from the end first. - - * gnus-start.el (gnus-after-getting-new-news-hook, - gnus-get-new-news-hook): Switched defaults. - - * gnus-score.el (gnus-all-score-files): Returned score files in - reverse order. - - * gnus-util.el (gnus-make-directory): Protect against nil dirs. - - * gnus-art.el (gnus-decode-encoded-word-method): Default to - 'gnus-article-de-quoted-unreadable. - - * gnus.el (gnus-read-group): Prohibit : in group name. - (gnus-article-display-hook): Removed - `gnus-article-de-quoted-unreadable'. - - * article.el (gnus-emphasis-alist): Accept "-" as word marker. - - * messagexmas.el (message-xmas-dont-activate-region): Changed - default to t. - -Sun Nov 17 01:09:21 1996 Per Abrahamsen - - * message.el: Added customize support. - -Sun Nov 17 23:42:03 1996 Raja R. Harinath - - * gnus-gl.el (bbb-extract-token-number): Fix. - -Sun Nov 17 12:18:27 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-next-article): Use it. - (gnus-group-make-articles-read): Quote undo forms. - (gnus-update-read-articles): Ditto. - - * gnus.el (gnus-key-press-event-p): New alias. - -Sat Nov 16 22:05:24 1996 Steven L Baur - - * gnus-sum.el (gnus-summary-next-article): XEmacs doesn't use - integers for keyboard events. - -Sun Nov 17 12:09:44 1996 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-set-timestamp): Protect against nil - gnus-newsgroup-name. - -Sun Nov 17 01:09:21 1996 Per Abrahamsen - - * nnmail.el: Added customize support. - -Sat Nov 16 22:59:47 1996 Lars Magne Ingebrigtsen - - * gnus.el (gnus-summary-line-format): Dox fix. - - * nnfolder.el (nnfolder-save-mail): Would insert extra newline at - the start. - -Sat Nov 16 19:43:22 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.63 is released. - -Sat Nov 16 11:32:43 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-next-article): Ignore non-keyboard - events before starting to walk. - - * gnus-topic.el (gnus-topic-prepare-topic): Insert topics that - have 0 unread if there is anything under. - - * gnus-sum.el (gnus-summary-move-article): Do `B B' properly. - - * gnus-topic.el (gnus-topic-parameters): Return nil on - non-existant topics. - - * nntp.el (nntp-possibly-change-group): Would nix out async buffer - when switching groups. - - * gnus-sum.el (gnus-summary-expire-articles): Update info before - expiring. - - * article.el (article-strip-leading-blank-lines): Would strip too - much. - - * gnus-sum.el (gnus-summary-mode): Update specs after running - hook. - - * gnus-util.el (gnus-boundp): New function. - - * gnus-start.el (gnus-get-new-news-hook): Default to updating - display-time, if present. - -Fri Nov 15 13:59:16 1996 Steven L Baur - - * gnus-xmas.el (gnus-xmas-define): Better fix for dealing with - scroll-in-place, which will be preloaded in XEmacs 19.15. - - * gnus-art.el (gnus-article-prev-page): Guard scroll-(up|down) - against scroll-in-place package. - (gnus-article-next-page): Ditto. - - * gnus-salt.el (gnus-pick-next-page): Ditto. - -Fri Nov 15 21:40:12 1996 Lars Magne Ingebrigtsen - - * nnweb.el (gnus): Required. - - * gnus-group.el (gnus-group-clear-data-on-native-groups): Offer to - move cache. - - * gnus-cache.el (gnus-cache-move-cache): New command. - - * nnvirtual.el (nnvirtual-create-mapping): Handle groups with no - articles. - - * gnus-group.el (gnus-group-insert-group-line-info): Compute the - right number for dead groups. - - * nnvirtual.el: Complete-first-sentence-in-first-line-of-doc fix. - -Thu Nov 14 10:20:44 1996 Per Abrahamsen - - * gnus-win.el: Added customize support. - - * gnus-uu.el: Added customize support. - -Thu Nov 14 17:50:12 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.62 is released. - -Thu Nov 14 12:25:23 1996 Lars Magne Ingebrigtsen - - * gnus.el (gnus-article-display-hook): Add - `gnus-article-de-quoted-unreadable' to default value. - - * gnus-art.el (gnus-summary-article-menu): Dummy define. - - * article.el (custom): Require first. - - * dgnushack.el (require): New implementation. - - * article.el (gnus-emphasis-alist): Recognize emphasis inside - quotes. - -Thu Nov 14 10:20:44 1996 Per Abrahamsen - - * nnmail.el (nnmail-split-abbrev-alist): Added `uucp' to `mail'. - -Thu Nov 14 11:25:51 1996 Samuel Tardieu - - * nnmail.el (nnmail-search-unix-mail-delim): Skip past ">From " - after "From ". - -Thu Nov 14 10:08:27 1996 Raja R. Harinath - - * gnus-gl.el (bbb-connect-to-bbbd): Only connect if we have the - token. - -Thu Nov 14 08:46:31 1996 Lars Magne Ingebrigtsen - - * message.el (message-insert-to): Deny with "never" - courtesy-copies-to header. - - * dgnushack.el (require): Try both the uncompiled and the compiled - versions. - - * nntp.el (nntp-send-authinfo): Hide password. - -Wed Nov 13 12:00:43 1996 David Moore - - * gnus-start.el (gnus-parse-active): Correct range parsing - restored. - -Tue Nov 12 14:09:15 1996 David Moore - - * gnus-nocem.el (gnus-nocem-enter-article): Don't store the same - message id in the cache twice. - (gnus-nocem-liberal-fetch): - - * gnus-nocem.el (gnus-nocem-liberal-fetch): New Variable. - - * gnus-nocem.el (gnus-nocem-check-article, - gnus-nocem-scan-groups): Don't re-fetch a crossposted @@NCM - posting that we've alread verified and scanned. - -Wed Nov 13 23:38:00 1996 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-parse-active): Gave wrong results. - - * gnus-win.el (gnus-buffer-configuration): Doc fix. - -Wed Nov 13 13:52:20 1996 Per Abrahamsen - - * gnus-topic.el: Added customize support. - - * gnus-group.el (gnus-group-mode-hook): Added `gnus-topic-mode' - option. - - * gnus-util.el (gnus-verbose): Made customizable. - - * gnus.el (gnus-summary-line-format): Customize. - - * gnus-sum.el (gnus-summary-respool-default-method): Customize. - - * gnus.el (gnus-select-method-name): New widget. - (gnus-select-method): Use it. - -Wed Nov 13 14:19:48 1996 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-info-clear-data): Quote lists. - - * nntp.el (nntp-send-authinfo): Prompt right. - -Tue Nov 12 19:33:00 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.61 is released. - -Tue Nov 12 17:55:17 1996 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-move-inbox): Delete empty crash box. - - * gnus-art.el (gnus-article-make-menu-bar): Define summary article - map. - - * gnus-group.el (gnus-group-set-timestamp): Removed reference to - free variable `group'. - -Mon Nov 11 16:29:00 1996 David Moore - - * gnus-group.el (gnus-group-timestamp-delta): New function. - - * gnus-demon.el (gnus-demon-add-scan-timestamps, - gnus-demon-scan-timestamps): New functions. - -Mon Nov 11 05:27:20 1996 Lars Magne Ingebrigtsen - - * article.el (gnus-emphasis-alist): Added ":" as sentence-end. - -Mon Nov 11 05:14:02 1996 David Moore - - * nnvirtual.el: New version. - -Mon Nov 11 05:09:14 1996 Lars Magne Ingebrigtsen - - * article.el (gnus-emphasis-underline-bold): Renamed. - -Mon Nov 11 05:05:09 1996 Alexandre Oliva - - * nntp.el (nntp-possibly-change-group): Bind - `nnheader-callback-function' to nil. - -Sun Nov 10 12:13:08 1996 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-parse-active): Give correct answer. - - * nntp.el (nntp-snarf-error-message): Massage the message. - -Sun Nov 10 11:49:33 1996 Joe Wells - - * dgnushack.el (require): Load .el files only. - -Sun Nov 10 10:06:12 1996 Lars Magne Ingebrigtsen - - * gnus-move.el (gnus-move-group-to-server): Would pass wrong - params to `gnus-retrieve-headers'. - - * nntp.el (nntp-wait-for): Accept a `discard' param. - (nntp-open-connection): Would mix it up when establishing asynch - connections. - - * nnml.el (nnml-find-id): Would report false positives. - - * gnus-spec.el (gnus-update-format-specifications): Do all - computations in the right buffer. - - * nnweb.el (nnweb-type-definition): Moved search engine. - (nnweb-fetch-form): Use "POST" instead of `POST'. - - * gnus-undo.el (gnus-undo-register): Entered malformed undo - statements. - - * smiley.el (smiley-nosey-regexp-alist): Add a devilish face. - -Sun Nov 10 06:38:38 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.60 is released. - -Sun Nov 10 06:31:36 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.59 is released. - -Sun Nov 10 06:09:37 1996 Lars Magne Ingebrigtsen - - * nntp.el (nntp-decode-text): Erased everything. - - * article.el (article-remove-trailing-blank-lines): Would - infloop. - -Sun Nov 10 06:06:31 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.58 is released. - -Sun Nov 10 06:02:51 1996 Alexandre Oliva - - * nntp.el (nntp-possibly-change-group): Bind callback function to - nil. - -Sun Nov 10 05:35:25 1996 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-remove-topic): Remove from alist. - - * gnus-score.el (gnus-score-string): Didn't trace fuzzies and - words. - -Sat Nov 9 18:14:42 1996 Lars Magne Ingebrigtsen - - * nnweb.el (nnweb-set-hashtb): Typo. - (nnweb-read-overview): Typo. - - * nnheader.el (nnheader-skeleton-replace): New macro. - (nnheader-replace-string): Use it. - (nnheader-replace-regexp): Use it. - (nnheader-strip-cr): Use it. - - * nntp.el (nntp-retrieve-headers): Be faster. - (nntp-decode-text): Use faster algorithm. - - * nnheader.el (nnheader-replace-string): New function. - -Sat Nov 9 17:22:16 1996 Hrvoje Niksic - - * article.el (gnus-emphasis-alist): Doc fix. - -Sat Nov 9 16:27:27 1996 Per Abrahamsen - - * nnmail.el (nnmail-split-it): Fix bug in abbrev handling. - -Sat Nov 9 05:59:02 1996 Lars Magne Ingebrigtsen - - * nnweb.el (nnweb-set-hashtb): Typo. - - * article.el (gnus-emphasis-alist): One ' too many. - - * gnus-async.el (gnus-async-prefetch-article): Only message when - in the summary buffer. - - * gnus-msg.el (gnus-post-news): Handle `newsgroup' param. - (gnus-debug): Be `defcustom' aware. - -Sat Nov 9 05:41:27 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.57 is released. - -Fri Nov 8 22:56:59 1996 Per Abrahamsen - - * gnus.el: Added customize support. - -Sat Nov 9 05:14:58 1996 David Moore - - * nnmail.el (nnmail-expand-newtext): New version. - -Sat Nov 9 04:28:42 1996 Lars Magne Ingebrigtsen - - * gnus-xmas.el (gnus-xmas-force-redisplay): New variable. - (gnus-xmas-summary-recenter): Use it. - - * gnus-art.el (gnus-button-url): Removed seconds param since old - versions of `browse-url.el' don't support it. - (gnus-article-make-menu-bar): Add article menu to article menu. - - * article.el (gnus-emphasis-alist): Use ")" as a sentence end - marker. - -Fri Nov 8 05:33:08 1996 Lars Magne Ingebrigtsen - - * article.el (gnus-emphasis-alist): Recognize "_this_here_". - - * gnus-art.el (gnus-article-save): Save the right buffer after - stripping headers. - - * nntp.el (nntp-wait-for): Nix out "nntp reading...." message. - - * article.el (article-narrow-to-signature): Typo. - - * nntp.el (nntp-try-list-active): Would guess wrong on `some'. - - * gnus.el: condition-case -> ignore-errors. - - * nntp.el (nntp-request-close): Protect against errors. - -Fri Nov 8 03:23:02 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.56 is released. - -Fri Nov 8 02:45:21 1996 David S. Goldberg - - * gnus-art.el (gnus-button-url): Respect - `browse-url-new-window-p'. - -Fri Nov 8 02:34:31 1996 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-process-unix-mail-format): Fold searches. - -Thu Nov 7 09:07:32 1996 Steven L Baur - - * nnmail.el (nnmail-search-unix-mail-delim): Take better care in - ignoring bogus From_ lines. - -Fri Nov 8 02:01:06 1996 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-move-inbox): Cleaned up code. - - * gnus-int.el (gnus-request-regenerate): New function. - - * nnml.el (nnml-request-regenerate): New function. - - * gnus-srvr.el (gnus-server-regenerate-server): New command and - keystroke. - -Thu Nov 7 16:12:30 1996 Per Abrahamsen - - * gnus-start.el: Added customize support. - -Fri Nov 8 01:47:16 1996 David S. Goldberg - - * gnus-win.el (gnus-delete-windows-in-gnusey-frames): Would bug - out on nil variables. - -Fri Nov 8 01:45:06 1996 Kurt Swanson - - * gnus-sum.el (gnus-handle-ephemeral-exit): Go to the next - article. - -Thu Nov 7 16:12:30 1996 Per Abrahamsen - - * article.el (gnus-visible-headers): Convert string to list of - strings. - -Fri Nov 8 01:40:38 1996 Kurt Swanson - - * gnus-sum.el (gnus-summary-first-article): New function. - - * gnus-salt.el (gnus-pick-start-reading): Use it. - -Thu Nov 7 09:42:17 1996 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-catchup): Better message. - - * gnus-util.el (gnus-date-get-time): Protect against "" Dates. - - * article.el (article-strip-leading-blank-lines): Would infloop. - - * gnus-msg.el (gnus-debug): Protect against odd load-paths. - -Fri Nov 8 05:30:51 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-get-newsgroup-headers): `ref' should never be - nil. - - * gnus-msg.el (gnus-summary-followup-to-mail, - gnus-summary-followup-to-mail-with-original): New commands. - - * nnmail.el (nnmail-split-it): Use `replace-match'. - -Fri Nov 8 05:30:46 1996 David Moore - - * nnmail.el (nnmail-split-it): New version. - -Fri Nov 8 03:44:10 1996 Lars Magne Ingebrigtsen - - * gnus.el (gnus-article-display-hook): Customized. - - * article.el (gnus-emphasis-alist): Define more combinations. - (gnus-emphasis-underline-bold-italic): New face. - -Fri Nov 8 00:20:29 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.55 is released. - -Thu Nov 7 00:14:45 1996 Lars Magne Ingebrigtsen - - * gnus-win.el (gnus-delete-windows-in-gnusey-frames): New function. - (gnus-configure-windows): Use it. - - * nntp.el (nntp-possibly-change-group): Erased wrong buffer. - - * gnus-score.el (gnus-score-find-bnews): Anchor mathces. - - * gnus-group.el (gnus-group-insert-group-line): Would bug out on - on gnus-moderated-hashtb. - -Wed Nov 6 22:54:41 1996 Sudish Joseph - - * gnus-nocem.el (gnus-sum): Required. - -Wed Nov 6 09:13:34 1996 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-date-to-time): Trap errors. - - * nntp.el (nntp-open-connection): Erase contents of the right - buffer. - - * gnus-sum.el (gnus-summary-first-article-p): New function. - - * gnus-topic.el (gnus-topic-remove-group): Didn't use - process/prefix. - - * gnus-group.el (gnus-group-iterate): New macro. - - * gnus-sum.el (gnus-summary-prev-unread-article): Respect - `gnus-summary-goto-unread' `never'. - -Wed Nov 6 06:55:03 1996 Hrvoje Niksic - - * article.el (gnus-emphasis-alist): New version. - -Wed Nov 6 06:26:34 1996 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-syntax-table): New variable. - (gnus-article-mode): Use it. - - * article.el (article-strip-leading-blank-lines): Didn't do much. - -Wed Nov 6 05:51:56 1996 Kevin Buhr - - * gnus-sum.el (gnus-summary-respool-article): Get the right - servers. - -Wed Nov 6 04:00:48 1996 Lars Magne Ingebrigtsen - - * nnheader.el (nnheader-header-value): Use old definition. - - * message.el: Removed many autoloads. - -Wed Nov 6 03:44:44 1996 ISO-2022-JP - - * gnus-ems.el (gnus-ems-redefine): New Mule definition. - -Wed Nov 6 03:02:25 1996 Lars Magne Ingebrigtsen - - * gnus-xmas.el (gnus-xmas-summary-recenter): Force redisplay. - - * gnus.el (gnus-check-backend-function): Protect against errors. - - * gnus-start.el (gnus-group-change-level): Enter info into dribble - file. - -Wed Nov 6 01:58:46 1996 Hrvoje Niksic - - * article.el (gnus-emphasis-alist): New default. - -Wed Nov 6 01:47:17 1996 Joe Wells - - * gnus-uu.el (gnus-uu-reginize-string): Buggy. - (gnus-uu-uustrip-article): Temp name mixup. - -Wed Nov 6 01:27:54 1996 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-make-group): Use new function. - - * gnus.el (gnus-read-group): New function. - - * dgnushack.el: Less error messages under XEmacs. - -Tue Nov 5 23:59:40 1996 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-search-unix-mail-delim): New implementation. - -Tue Nov 5 23:43:34 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.54 is released. - -Tue Nov 5 22:34:01 1996 Lars Magne Ingebrigtsen - - * message.el (message-goto-signature): Place point better. - - * gnus-art.el (gnus-summary-save-body-in-file): Restored. - - * nntp.el (nntp-send-authinfo): Better password prompting. - - * nnmail.el (nnmail-read-passwd): Allow format strings. - -Tue Nov 5 22:10:20 1996 David Moore - - * gnus-sum.el (gnus-valid-move-group-p): New function. - (gnus-read-move-group-name): Faster implementation. - -Tue Nov 5 12:35:40 1996 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-remove-topic): Would wipe out topic - parameters. - - * gnus-sum.el (gnus-summary-stop-page-breaking): Remove all - buttons. - - * nnweb.el (nnweb-set-hashtb): Typo. - -Tue Nov 5 10:43:24 1996 Randal Schwartz - - * gnus-uu.el (gnus-uu-be-dangerous): New variable. - (gnus-uu-save-files): Use it. - -Tue Nov 5 10:19:39 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-read-document): Doc fix. - (gnus-summary-catchup-and-exit): Don't exit when replying "n". - - * gnus-art.el (gnus-summary-write-to-file): Doc fix. - - * gnus-uu.el (gnus-uu-get-list-of-articles): Get numerical prefix - value. - -Tue Nov 5 10:14:02 1996 David Moore - - * gnus-start.el (gnus-groups-to-gnus-format): Simplified and made - faster. - -Tue Nov 5 04:56:33 1996 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-search-unix-mail-delim): Protect against - regexp overflows. - - * nnheader.el (nnheader-header-value): New definition. - - * nntp.el (nntp-open-connection): Erase buffer. - (nntp-possibly-change-group): Ditto. - - * nnvirtual.el (nnvirtual-create-mapping): Would ignore groups - with just one article. - -Tue Nov 5 03:41:30 1996 David Moore - - * gnus-nocem.el (gnus-nocem-enter-article): Would bug out on some - lines. - -Tue Nov 5 03:36:03 1996 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-score-find-favourite-words): Put point at - bob. - -Tue Nov 5 03:33:04 1996 jeff sparkes - - * gnus-kill.el (gnus-batch-score): Run in slave mode. - -Mon Nov 4 03:16:18 1996 Lars Magne Ingebrigtsen - - * nnheader.el (nnheader-directory-regular-files): New function. - - * nnmail.el (nnmail-get-spool-files): Allow nnmail-spool-file to - be a directory. - - * gnus-sum.el (gnus-summary-next-group): Halt prefetch. - - * gnus-async.el (gnus-async-halt-prefetch): New function. - - * message.el (message-check-news-header-syntax): Anchor - multiple-searches. - - * gnus-topic.el (gnus-topic-mode): Reset sorting function. - -Tue Oct 29 20:42:07 1996 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-remove-topic): Fold properly. - -Tue Oct 29 19:45:25 1996 Lars Magne Ingebrigtsen - - * message.el (message-generate-new-buffer-clone-locals): Bugged - out under XEmacs. - -Tue Oct 29 19:21:47 1996 David Moore - - * gnus.el: Fixed autoloads. - -Tue Oct 29 17:21:42 1996 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-url-mailto): `message-goto-subject' takes no - args. - -Mon Oct 28 15:42:21 1996 Lars Magne Ingebrigtsen - - * gnus.el: Autoload gnus-score-followup-thread. - (gnus-inhibit-startup-message): Doc fix. - -Sat Oct 26 15:48:28 1996 Lars Magne Ingebrigtsen - - * gnus-xmas.el (gnus-xmas-topic-menu-add): Add menu. - - * gnus-topic.el (gnus-topic-kill-group): Enter into dribble. - - * gnus-sum.el (gnus-summary-universal-argument): Bind - `gnus-newsgroup-process-marked' to nil before calling functions. - -Sat Oct 26 15:31:18 1996 David Moore - - * nnmail.el (nnmail-activate): Faster version. - -Fri Oct 25 09:02:08 1996 Lars Magne Ingebrigtsen - - * nnsoup.el (nnsoup-pack-replies): Error empty dirs. - - * gnus-msg.el (gnus-summary-mail-forward): Allow prefix to forward - full headers. - -Thu Oct 24 07:20:30 1996 Lars Magne Ingebrigtsen - - * gnus-nocem.el (gnus-nocem-enter-article): Would enter unbound - symbols into hashtb. - -Thu Oct 24 07:12:23 1996 Michael R. Cook - - * nnmh.el (nnmh-active-number): Misplaced paren. - -Thu Oct 24 07:02:54 1996 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-list-groups): Clear inboxes. - - * gnus-async.el (gnus-make-async-article-function): Use the - success param. - - * nntp.el (nntp-after-change-function-callback): Pass along the - right success param. - -Wed Oct 23 18:33:15 1996 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-summary-increase-score): Spud. - -Wed Oct 23 07:55:42 1996 William Perry - - * gnus-art.el (gnus-url-mailto): New function. - -Wed Oct 23 06:57:10 1996 Lars Magne Ingebrigtsen - - * nnbabyl.el (nnbabyl-create-mbox): New function. - (nnbabyl-open-server): Create mbox. - - * nnmbox.el (nnmbox-create-mbox): New function. - -Tue Oct 22 07:30:12 1996 Lars Magne Ingebrigtsen - - * nnml.el (nnml-request-list): Always return t. - -Tue Oct 22 03:16:27 1996 Felix Lee - - * gnus-score.el (gnus-score-adaptive): Use the right syntax - table. - -Tue Oct 22 03:08:30 1996 Lars Magne Ingebrigtsen - - * message.el (message-generate-headers): Rename Original-Sender as - well. - (message-send-news): Typo. - (message-send-news): Don't message. - -Tue Oct 22 03:06:49 1996 Felix Lee - - * gnus-score.el (gnus-score-adaptive): gnus-score-adaptive will do - line scoring or word scoring, but not both. - -Tue Oct 22 02:48:08 1996 Lars Magne Ingebrigtsen - - * message.el (message-send-news): Use it. - (message-send-mail): Ditto. - -Tue Oct 22 02:40:14 1996 Joev Dubach - - * message.el (message-generate-new-buffer-clone-locals): New - function. - -Tue Oct 22 01:19:47 1996 Lars Magne Ingebrigtsen - - * message.el: Removed `lisp-indent-hook' throughout all files. - - * gnus.el (gnus-sethash): Fix edebug form spec. - - * gnus-cache.el (gnus-cache-file-name): Translate file chars. - -Sun Oct 20 03:41:47 1996 Lars Magne Ingebrigtsen - - * nntp.el (nntp-read-server-type): Fold case. - -Sat Oct 19 08:03:17 1996 Michael Ernst - - * article.el (article-hide-headers): Do the right thing on - articles with no bodies. - (article-narrow-to-signature): Doc fix. - -Sat Oct 19 07:53:49 1996 Lars Magne Ingebrigtsen - - * nnsoup.el (nnsoup-pack-replies): Refuse to pack when there is - nothing to pack. - (nnsoup-read-areas): Don't bug out on empty packets. - - * gnus-soup.el (gnus-soup-pack-packet): Refuse to pack empty - packets. - -Sat Oct 19 07:43:33 1996 Kees de Bruin - - * gnus-sum.el (gnus-auto-center-summary): Fix. - -Sat Oct 19 07:32:27 1996 Marc Horowitz - - * gnus-topic.el (gnus-topic-remove-topic): Would clobber - duplicates. - -Sat Oct 19 07:01:14 1996 Lars Magne Ingebrigtsen - - * message.el (message-send-mail-hook): New hook. - (message-send-news-hook): Ditto. - - * gnus-art.el (gnus-summary-write-to-file): New function. - -Sat Oct 19 06:56:34 1996 Kees de Bruin - - * gnus-sum.el (gnus-summary-save-article-mail-overwrite): New - command and keystroke. - -Thu Oct 17 06:25:55 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-article-sort-by-date): Use faster - implementation. - - * gnus-util.el (gnus-string-get-time): New macro. - - * message.el (message-check-news-syntax): Check more thorougly the - From header. - (message-check): New macro. - -Thu Oct 17 06:03:56 1996 Carsten Leonhardt - - * gnus-ems.el (gnus-xemacs): Avoid clobbering functions. - -Thu Oct 17 05:34:15 1996 Lars Magne Ingebrigtsen - - * message.el (message-cite-function): Initialize from - mail-citation-hook. - -Thu Oct 17 02:45:47 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.52 is released. - -Wed Oct 16 21:01:41 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-catchup): Return t. - -Wed Oct 16 20:32:53 1996 Kees de Bruin - - * gnus-group.el (gnus-group-mail-low-empty-face): Face fix. - -Wed Oct 16 20:00:15 1996 Lars Magne Ingebrigtsen - - * message.el (message-mode): Doc fix. - - * nnml.el (nnml-request-group): Re-read directory. - -Wed Oct 16 04:01:27 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.51 is released. - -Wed Oct 16 03:49:12 1996 Alexandre Oliva - - * gnus-start.el (gnus-setup-news): Make sure - `gnus-group-line-format' is bound. - -Wed Oct 16 02:57:37 1996 Lars Magne Ingebrigtsen - - * nntp.el (nntp-after-change-function-callback): Would delete the - first line of all articles. - -Mon Oct 14 21:31:42 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-limit-to-marks): Accept prefix. - -Sun Oct 13 16:37:05 1996 Lars Magne Ingebrigtsen - - * gnus-srvr.el (gnus-browse-foreign-server): Message better. - -Sat Oct 12 19:33:01 1996 Lars Magne Ingebrigtsen - - * message.el (message-indent-citation): Would infloop on empty - articles. - -Sat Oct 12 19:21:05 1996 Raja R. Harinath - - * gnus.el: Autoload more functions. - -Sat Oct 12 19:09:12 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-catchup): Don't move point. - (gnus-summary-limit-exclude-marks): New command. - -Fri Oct 11 15:26:02 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.50 is released. - -Thu Oct 10 23:36:32 1996 Jan Vroonhof - - * gnus-nocem.el (gnus-nocem): Typo. - -Thu Oct 10 23:16:57 1996 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-clear-data-on-native-groups): Only - clear data on native groups. - -Thu Oct 10 14:11:18 1996 Per Abrahamsen - - * gnus-cus.el (gnus-group-customize): Allow unknown entries. - (gnus-score-customize): Ditto. - (gnus-score-string-convert): Ditto. - (gnus-score-parameters): Added `touched'. - -Thu Oct 10 23:06:42 1996 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-read-active-file): Don't bug out on null - methods. - -Thu Oct 10 22:29:05 1996 Randell Jesup - - * article.el (article-hide-boring-headers): Reversed `date' - check. - -Thu Oct 10 15:24:08 1996 Lars Magne Ingebrigtsen - - * gnus-xmas.el (gnus-xmas-define): Removed gnus-display-type. - - * gnus-group.el (gnus-group-new-mail): Strip prefix. - - * nnmail.el (nnmail-new-mail-p): Didn't work. - - * gnus-score.el (gnus-score-adaptive): Use - gnus-adaptive-word-score-alist. - - * nnoo.el (nnoo-define-skeleton-1): Define - request-list-newsgroups. - - * nnweb.el (w3-forms): Removed. - - * gnus-uu.el (gnus-uu-digest-mail-forward): Use directory form. - -Tue Oct 8 14:30:53 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.49 is released. - -Tue Oct 8 00:15:04 1996 Per Abrahamsen - - * gnus-nocem.el: Added customize support. - -Tue Oct 8 11:48:25 1996 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-mail-3-empty-face): Use magenta4. - - * gnus.el (gnus-short-group-name): Would bug out on complex group - names. - (gnus-splash-face): New face. - (gnus-group-startup-message): Use it. - - * nnvirtual.el (nnvirtual-request-group): Respect - `always-rescan'. - - * gnus-load.el: Removed. - - * gnus.el (gnus-check-backend-function): Require before - checking... - - * gnus-sum.el (gnus-summary-respool-article): Use it. - - * gnus-load.el (gnus-mail-method-history): New variable. - - * gnus-sum.el (gnus-summary-normal-unread-face): Use default - face. - -Mon Oct 7 15:00:58 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.48 is released. - -Mon Oct 7 02:24:02 1996 Per Abrahamsen - - * gnus-sum.el: Added customize support. - -Sat Oct 5 01:29:20 1996 Per Abrahamsen - - * gnus-async.el: Added customize support. - * gnus-cache.el: Ditto. - * gnus-cite.el: Ditto. - * gnus-demon.el: Ditto. - * gnus-dup.el: Ditto. - * gnus-eform.el: Ditto. - * gnus-group.el: Ditto. - * gnus-int.el: Ditto. - * gnus-kill.el: Ditto. - * gnus-load.el (gnus-make-face, gnus-face-light-name-list, - gnus-face-dark-name-list): Removed. - -Fri Oct 4 07:17:09 1996 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-setup-news): Slaves should read the slave - files. - - * gnus-art.el (gnus-request-article-this-buffer): Removed - reference to doing-request. - -Thu Oct 3 05:06:53 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.47 is released. - -Thu Oct 3 02:04:37 1996 Lars Magne Ingebrigtsen - - * gnus-int.el (gnus-request-head): Use the cache. - -Wed Oct 2 00:57:22 1996 Lars Magne Ingebrigtsen - - * message.el (message-resend): Message. - - * gnus-group.el (gnus-group-timestamp-string): New function. - - * gnus-util.el (gnus-time-iso8601): New function. - - * gnus-group.el (gnus-group-set-timestamp): New function. - (gnus-group-timestamp): New subst. - - * gnus-start.el (gnus-subscribe-hierarchical-interactive): Accept - RET as default. - -Tue Oct 1 05:13:57 1996 Martin Buchholz - - * gnus-sum.el (gnus-summary-insert-pseudos): Error takes a format - string. - -Tue Oct 1 05:12:29 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.46 is released. - -Tue Oct 1 03:41:17 1996 Lars Magne Ingebrigtsen - - * gnus-picon.el (gnus-picons-glyph-hashtb): Made into hashtb. - -Tue Oct 1 01:50:10 1996 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-new-mail): New function. - (gnus-new-mail-mark): New variable. - - * nnmail.el (nnmail-new-mail-p): New function. - - * gnus-xmas.el (gnus-xmas-splash): New function. - -Tue Oct 1 01:36:17 1996 Raja R. Harinath - - * gnus-score.el (gnus-all-score-files): Didn't handle alist. - - * gnus-gl.el: Dropped `bbb-alist'. Changed cl-hashtable to obarray, - using gnus-{get,set}hash to access it. Dropped a few temp. bindings - Changed (aref (assoc "message-id" ...) ...) to (mail-header-id ...). - -Mon Sep 30 00:02:13 1996 Lars Magne Ingebrigtsen - - * gnus.el: General (and major) indentation, breaking, - if/when/unless/and/or, push revision. - - * gnus-sum.el (gnus-read-header): Set buffer before changing - vars. - -Sun Sep 29 23:20:26 1996 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-write-buffer): New function. - -Sun Sep 29 23:05:33 1996 Kurt Swanson - - * gnus-sum.el (gnus-handle-ephemeral-exit): New function. - -Sun Sep 29 22:41:01 1996 Lars Magne Ingebrigtsen - - * gnus-cache.el (gnus-cache-possibly-enter-article): Allow making - articles persistent in uncacheable groups. - -Sun Sep 29 01:23:43 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.45 is released. - -Sun Sep 29 00:57:13 1996 Dave Disser - - * gnus-sum.el (gnus-summary-display-article): Don't show tree - unless using threads. - -Sun Sep 29 00:19:35 1996 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-all-score-files): Remove duplicates. - -Sat Sep 28 23:47:43 1996 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-summary-increase-score): Wouldn't do regexp - bodies. - - * gnus-topic.el (gnus-topic-group-indentation): Give the right - indentation always. - -Sat Sep 28 23:23:58 1996 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-quick-select-group): Require - gnus-score. - - * gnus-score.el (gnus-score-thread): New function. - -Sat Sep 28 00:41:54 1996 Per Abrahamsen - - * gnus-cus.el: New file. - -Sat Sep 28 21:32:52 1996 Kevin Buhr - - * nnbabyl.el (nnbabyl-request-article): Would delete wrong - articles. - -Fri Sep 27 21:54:30 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.44 is released. - -Fri Sep 27 21:24:46 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-nov-parse-line): Would double articles. - -Fri Sep 27 20:52:31 1996 Shlomo Mahlab - - * gnus-cache.el (gnus-jog-cache): Call with function name. - - * gnus-group.el (gnus-group-universal-argument): Shadowed `func'. - -Fri Sep 27 19:48:52 1996 Lars Magne Ingebrigtsen - - * gnus-cite.el (gnus-article-fill-cited-article): Nix out data - after filling. - - * gnus-group.el (gnus-group-unsubscribe-current-group): Accept - second param. - (gnus-group-unsubscribe): New function. - (gnus-group-subscribe): New function. - -Fri Sep 27 17:36:31 1996 Kurt Swanson - - * gnus-sum.el (gnus-get-newsgroup-headers-xover): Never add nil - headers. - -Fri Sep 27 17:33:30 1996 Stephen Peters - - * gnus-art.el (gnus-header-face-alist): Typo. - -Fri Sep 27 04:10:21 1996 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-summary-mail-crosspost-complaint): Add a tag - to the subject. - (gnus-mail-yank-original): Elided. - (gnus-inews-yank-articles): Would yank articles in reverse order. - -Thu Sep 26 22:39:45 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.43 is released. - -Thu Sep 26 22:13:00 1996 Lars Magne Ingebrigtsen - - * nnweb.el (nnweb-altavista-wash-article): Didn't remove all - markup. - - * gnus-nocem.el (gnus-nocem-check-article): Fix security hole. - -Thu Sep 26 20:23:11 1996 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-make-group): Accept an ARGS param. - - * nnheader.el (nnheader-concat): Accept many file names. - -Thu Sep 26 19:53:09 1996 Kurt Swanson - - * gnus-art.el (gnus-header-content-face): Buggy color names. - -Thu Sep 26 14:57:38 1996 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-save-active): Rewrite. - (nnmail-generate-active): New function. - - * gnus-util.el (gnus-delete-assq): New macro. - (gnus-delete-assoc): Ditto. - -Wed Sep 25 23:44:40 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-get-newsgroup-headers-xover): Just use one - single condition-case. - -Wed Sep 25 21:15:59 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.42 is released. - -Wed Sep 25 19:40:34 1996 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-header-newsgroups-face): Yucky on light - backgrounds. - -Wed Sep 25 19:25:27 1996 Michael R. Cook - - * message.el (message-ignored-news-headers): Strip Resent-Fcc. - -Wed Sep 25 19:12:59 1996 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-jump-to-group): Use - `gnus-group-goto-group'. - - * gnus-xmas.el (gnus-xmas-mode-line-buffer-identification): Don't - chop off half line when no colon. - -Mon Sep 23 22:12:10 1996 Lars Magne Ingebrigtsen - - * gnus-nocem.el (gnus-nocem-verifyer): Change to `mc-verify'. - -Mon Sep 23 21:43:47 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.41 is released. - -Mon Sep 23 21:10:37 1996 Lars Magne Ingebrigtsen - - * article.el (article-hide-headers): Don't ignore - gnus-visible-headers. - -Mon Sep 23 19:10:20 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-goto-subject): Made into command. - -Mon Sep 23 18:26:47 1996 Tonny Madsen - - * nnmail.el (nnmail-default-file-modes): Use integer. - -Tue Sep 24 18:39:41 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-respool-query): Better message. - -Sun Sep 22 15:12:54 1996 Per Abrahamsen - - * gnus-art.el: Customized. - - * gnus.el (gnus-inhibit-startup-message): Changed type to - boolean. - (gnus-play-startup-jingle): Ditto. - -Sun Sep 22 12:58:57 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.40 is released. - -Sun Sep 22 11:48:02 1996 Lars Magne Ingebrigtsen - - * custom.el (defcustom): Eval and compile. - * widget.el (define-widget-keywords): Ditto. - -Sat Sep 21 09:29:54 1996 Lars Magne Ingebrigtsen - - * article.el (article-strip-multiple-blank-lines): Would strip all - blank lines. - -Fri Sep 20 06:52:07 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.39 is released. - -Thu Sep 19 18:57:59 1996 Lars Magne Ingebrigtsen - - * message.el (message-ignored-cited-headers): Doc fix. - -Thu Sep 19 03:05:01 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.38 is released. - -Thu Sep 19 03:05:01 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.37 is released. - -Wed Sep 18 10:36:08 1996 Lars Magne Ingebrigtsen - - * gnus-async.el (gnus-async-prefetch-article-p): New variable. - (gnus-async-prefetch-article): Use it. - (gnus-async-unread-p): New function. - -Tue Sep 17 14:41:56 1996 Per Abrahamsen - - * gnus-cite.el (gnus-custom-import-cite-face-list): Removed. - -Wed Sep 18 04:28:16 1996 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-split-history): mapcar instead of mapconcat. - -Tue Sep 17 14:41:56 1996 Per Abrahamsen - - * gnus.el: Customized. - - * dgnushack.el (custom-file): Removed. - -Wed Sep 18 03:04:17 1996 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-check-duplication): Do splitting after - duplicate suppression. - - * gnus-salt.el (gnus-pick-mode): Don't go to unread article. - - * gnus-dup.el (gnus-dup-enter-articles): Don't enter Message-IDs - ento lists multiple times. - -Tue Sep 17 03:44:08 1996 Lars Magne Ingebrigtsen - - * gnus-uu.el (gnus-uu-grab-articles): Don't prefetch. Ask before - deleting. - - * gnus.el: Red Gnus v0.37 is released. - -Tue Sep 17 03:15:26 1996 Lars Magne Ingebrigtsen - - * custom.el: 0.9 included. - - * gnus-art.el (browse-url): Required. - - * gnus.el: Red Gnus v0.36 is released. - -Tue Sep 17 02:37:26 1996 Lars Magne Ingebrigtsen - - * gnus-edit.el: Removed. - - * custom.el: Removed. - - * gnus-cus.el: Removed. - -Mon Sep 16 05:59:45 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.35 is released. - -Sun Sep 15 00:47:08 1996 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-default-file-modes): New default. - -Sat Sep 14 01:48:58 1996 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-make-doc-group): Typo. - (gnus-useful-groups): New format. - - * gnus-cache.el (gnus-jog-cache): Doc fix. - -Fri Sep 13 02:28:47 1996 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-get-new-news): Read slave files here. - -Fri Sep 13 01:04:50 1996 Per Abrahamsen - - * article.el (article-decode-rfc1522): New version. - -Fri Sep 13 00:00:25 1996 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-crosspost-complaint): Added a newline. - (gnus-summary-mail-crosspost-complaint): Insert message at the - head of the message. - -Thu Sep 12 01:56:07 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.34 is released. - -Thu Sep 12 01:16:38 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.33 is released. - -Wed Sep 11 00:22:01 1996 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-adaptive-word-syntax-table): Modified - standard syntax table. - - * nntp.el (nntp-read-server-type): Worked in the wrong buffer. - - * gnus-demon.el (gnus-demon-cancel): Put - nnheader-cancel-function-timers back in again. - - * gnus.el: Red Gnus v0.32 is released. - -Tue Sep 10 19:10:09 1996 Lars Magne Ingebrigtsen - - * gnus-kill.el (gnus-batch-score): Didn't work at all. - - * gnus-msg.el (gnus-summary-mail-nastygram): Place point at - appropriate place. - - * gnus-util.el (gnus-make-sort-function): Would nix out the - sorting list. - - * gnus-demon.el (gnus-demon-cancel): Don't run - `cancel-function-timers'. - - * message.el (message-header-format-alist): Don't fill References - headers. - -Mon Sep 9 21:51:46 1996 Lars Magne Ingebrigtsen - - * nntp.el (nntp-server-action-alist): Don't try LIST ACTIVE GROUP - on Netscape's brain-dead nntp server. - - * message.el (message-dont-send): Take proper actions. - -Mon Sep 9 21:46:44 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.31 is released. - -Mon Sep 9 21:16:11 1996 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-copy-article-buffer): Decode headers after - copying. - - * gnus-picon.el (gnus-picons-refresh-before-display): New - variable. - (gnus-picons-insert-face-if-exists): Put bar back in. - -Mon Sep 9 20:31:56 1996 Lars Magne Ingebrigtsen - - * gnus-uu.el (gnus-uu-digest-mail-forward): Use the newsgroup name. - -Mon Sep 9 20:04:35 1996 Kurt Swanson - - * gnus-salt.el (gnus-pick-mouse-pick-region): New function. - -Mon Sep 9 18:37:07 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-enter-digest-group): Bugged. - - * gnus-score.el (gnus-adaptive-word-syntax-table): Make ' a - word-constituant character. - -Sun Sep 8 14:46:01 1996 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-make-useful-group): New command and - keystroke. - (gnus-useful-groups): New variable. - -Sun Sep 8 14:46:01 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.30 is released. - -Sun Sep 8 13:26:36 1996 Lars Magne Ingebrigtsen - - * nndoc.el (nndoc-article-begin-function): Defvarred. - - * gnus-srvr.el (gnus-browse-unsubscribe-group): Would sometimes be - somewhat tricky. - - * gnus.el (gnus-kill-ephemeral-group): New function. - - * gnus-art.el (gnus-button-alist): Recognize group-news urls. - - * nndoc.el (nndoc-dissect-buffer): Wouldn't dissect an mbox - properly. - (nndoc-article-begin): New function. - (nndoc-mbox-body-end): Use it. - (nndoc-mbox-article-begin): Would bug out. - -Sun Sep 8 13:10:28 1996 Lars Magne Ingebrigtsen - - * gnus.el (gnus-other-frame): Always pop up a frame. - -Sun Sep 8 12:57:03 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.29 is released. - -Sun Sep 8 12:24:11 1996 Lars Magne Ingebrigtsen - - * nntp.el (nntp-accept-process-output): Don't message so - obsessively. - - * gnus.el: Fixed indentation and stuff. - -Sun Sep 8 12:23:56 1996 Sudish Joseph - - * nnweb.el (nnweb-fetch-form): Return t. - -Sat Sep 7 15:15:42 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.28 is released. - -Sat Sep 7 14:33:17 1996 Lars Magne Ingebrigtsen - - * nntp.el (nntp-after-change-function-callback): Renamed. - - * nnweb.el (nnweb-reference-search): Nix out file name. - -Sat Sep 7 14:07:13 1996 Lars Magne Ingebrigtsen - - * nnweb.el (nnweb-altavista-search): Nix out buffer file name. - - * gnus-async.el (gnus-asynch-with-semaphore): New macro. - (gnus-make-async-article-function): Nix out prefetch list when the - summary buffer dies. - - * nnweb.el (nnweb-altavista-create-mapping): Would search forever - when not getting any matches. - -Sat Sep 7 12:43:24 1996 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-inews-yank-articles): Goto body before - yanking. - - * nnheader.el (nnheader-insert-file-contents-literally): New - definition. - (nnheader-insert-head): Use new definition. - -Sat Sep 7 12:35:37 1996 Kurt Swanson - - * gnus-salt.el (gnus-pick-elegant-flow): New variable. - -Sat Sep 7 12:03:00 1996 Lars Magne Ingebrigtsen - - * nnheader.el (nnheader-insert-head): Don't use - `insert-file-contents-literally'. - (nnheader-head-chop-length): New variable. - - * gnus-sum.el (gnus-summary-read-document): Prepend "nnvirtual:" - to group name. - -Sat Sep 7 11:12:26 1996 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-score-save): Don't check result from - gnus-make-directory. - - * gnus-util.el (gnus-make-directory): Return t. - -Fri Sep 6 17:55:48 1996 Lars Magne Ingebrigtsen - - * gnus-range.el (gnus-copy-sequence): Didn't work for all - sequences. - -Fri Sep 6 14:38:54 1996 Wes Hardaker - - * gnus-picons.el (gnus-picons-display-as-address): New variable. - (gnus-picons-map): New keymap for picons. - (gnus-picons-toggle-extent): New function. - (gnus-article-display-picons): use them. - (gnus-picons-insert-face-if-exists): ditto. - (gnus-picons-try-to-find-face): ditto. - (gnus-group-display-picons): let display catch up. - (gnus-article-display-picons): ditto. - -Fri Sep 6 08:11:02 1996 Lars Magne Ingebrigtsen - - * nnkiboze.el (nnkiboze-close-group): Rewrite. - (nnkiboze-request-list, nnkiboze-request-newgroups, - nnkiboze-request-list-newsgroups): Removed. - (nnkiboze-request-scan): New function. - (nnkiboze-directory): New default. - - * gnus-sum.el (gnus-article-read-p): New function. - - * nnkiboze.el (nnkiboze-retrieve-headers): Rewrite. - (nnkiboze-open-server): Removed. - (nnkiboze-server-opened): Ditto. - - * nnheader.el (nnheader-find-nov-line): Renamed. - (nnheader-nov-delete-outside-range): New function. - - * gnus-uu.el (gnus-uu-invert-processable): New command and - keystroke. - - * gnus-load.el (gnus-predefined-server-alist): New variable. - - * gnus.el (gnus-server-to-method): Use it. - (gnus-read-method): Ditto. - - * gnus-sum.el (t): "M V" commands weren't defined. - - * gnus-cache.el (gnus-summary-insert-cached-articles): New command - and keystroke. - - * gnus-score.el (gnus-sort-score-files): New function. - (gnus-score-file-rank): New function. - (gnus-score-find-bnews): Use it. - - * gnus-topic.el (gnus-topic-mode-map): New sort submap. - (gnus-topic-sort-groups, gnus-topic-sort-groups-by-alphabet, - gnus-topic-sort-groups-by-unread, gnus-topic-sort-groups-by-level, - gnus-topic-sort-groups-by-score, gnus-topic-sort-groups-by-rank, - gnus-topic-sort-groups-by-method): New commands and keystrokes. - - * gnus-group.el (gnus-group-sort-selected): New command. - (gnus-group-sort-selected-flat): New function. - (gnus-group-sort-selected-groups-by-alphabet, - gnus-group-sort-selected-groups-by-unread, - gnus-group-sort-selected-groups-by-level, - gnus-group-sort-selected-groups-by-score, - gnus-group-sort-selected-groups-by-rank, - gnus-group-sort-selected-groups-by-method): New commands and - keystrokes. - (gnus-group-make-menu-bar): Updated. - - * gnus-util.el (gnus-make-sort-function): Create a complete - function. - (gnus-make-sort-function-1): Renamed. - - * gnus-topic.el (gnus-group-sort-topic): New function. - - * gnus-group.el (gnus-group-sort-flat): Made into own function. - (gnus-group-sort-alist-function): New variable. - - * nnmail.el (nnmail-split-history): New variable. - (nnmail-split-history): New command. - - * gnus-score.el (gnus-score-adaptive): Don't do any work on - pseudos. - - * gnus-msg.el (gnus-post-method): Allow easier posting from mail - groups. - -Thu Sep 5 19:56:41 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.27 is released. - -Thu Sep 5 19:50:19 1996 Lars Magne Ingebrigtsen - - * gnus-xmas.el (gnus-xmas-modeline-glyph): Set string properly. - -Thu Sep 5 18:39:47 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-edit-article-done): Make params - optional. - - * nntp.el (nntp-list-active-group): Don't change group first. - - * gnus-util.el (gnus-make-directory): New function. - - * gnus-msg.el (gnus-post-method): Do the right thing in - `to-group' groups. - -Fri Sep 6 08:05:53 1996 ISO-2022-JP - - * nnheader.el (nnheader-insert-head): Use - nnheader-insert-file-contents-literally. - -Thu Sep 5 08:29:08 1996 Lars Magne Ingebrigtsen - - * gnus-win.el (gnus-always-force-window-configuration): New - variable. - (gnus-configure-windows): Use it. - - * gnus-sum.el (gnus-summary-save-article): Give better prompts. - - * gnus-load.el (gnus-valid-select-methods): Update. - - * gnus-score.el (gnus-score-find-favourite-words): Didn't find any - words. - - * gnus-sum.el (gnus-scores-exclude-files): Defined. - - * gnus-async.el (gnus-async-prefetch-next): Don't do so much on - un-asynch groups. - -Thu Sep 5 08:26:11 1996 jeff sparkes - - * gnus-win.el (gnus-buffer-configuration): Bad cut'n'paste. - -Thu Sep 5 07:41:08 1996 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-list-groups): Update format specs. - -Thu Sep 5 07:11:18 1996 Jan Vroonhof - - * gnus-sum.el (gnus-summary-read-document): Generated wrong nndoc - group names. - -Thu Sep 5 06:53:07 1996 Lars Magne Ingebrigtsen - - * nnvirtual.el (nnvirtual-close-group): Don't update ephemeral - groups. - - * gnus.el (gnus-group-auto-expirable-p): Allow nil expiry params. - -Wed Sep 4 06:46:03 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.26 is released. - -Wed Sep 4 06:42:34 1996 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-move-inbox): Reverse logic. - -Wed Sep 4 06:35:05 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.25 is released. - -Wed Sep 4 05:19:58 1996 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-move-inbox): Refuse to move if - nnmail-crash-box can't be written. - - * gnus-art.el (gnus-button-url-regexp): Include : and ; in - regexp. - - * gnus-score.el (gnus-adaptive-word-score-alist): New variable. - - * nnmail.el (nnmail-move-inbox): Set file modes on wrong file. - -Tue Sep 3 06:44:36 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.24 is released. - -Tue Sep 3 05:30:02 1996 Lars Magne Ingebrigtsen - - * gnus-async.el (gnus-async-prefetch-article): Reset async list - when the summary buffer is killed. - - * gnus-xmas.el (gnus-xmas-modeline-glyph): Don't use glyph under - tty. - - * gnus-msg.el (gnus-copy-article-buffer): Deleted text in article - buffer. - -Tue Sep 3 05:10:19 1996 Kurt Swanson - - * gnus-sum.el (gnus-group-no-more-groups-hook): New variable. - -Tue Sep 3 04:44:31 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-exit): Would bug out when using a - single article buffer. - -Mon Sep 2 05:50:07 1996 Lars Magne Ingebrigtsen - - * gnus-audio.el (gnus-audio-play): Give the sound-file argument as - ARG in addition to stdin. - -Mon Sep 2 05:28:26 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.23 is released. - -Mon Sep 2 05:16:46 1996 Lars Magne Ingebrigtsen - - * gnus-audio.el: Renamed from "gnus-sound". - -Mon Sep 2 05:06:17 1996 Lars Magne Ingebrigtsen - - * gnus-ems.el (gnus-xemacs): New variable. - -Mon Sep 2 03:18:18 1996 Lars Magne Ingebrigtsen - - * gnus-async.el (gnus-async-prefetch-next): Don't start fetching - the next article until we have been idle a while. - - * gnus-group.el (gnus-group-make-help-group): Use the new find-etc - function. - - * nnheader.el (nnheader-find-etc-directory): Accept a FILE - parameter. - - * gnus-msg.el (gnus-debug): Use `locate-library' instead of doing - things the hard way. - - * gnus-sum.el (gnus-set-global-variables): Copy - -Mon Sep 2 03:01:27 1996 Lars Magne Ingebrigtsen - - * gnus.el (gnus-splash): Play jingle. - - * gnus-sound.el (gnus-startup-jingle): New variable. - (gnus-play-jingle): New command. - - * gnus.el (gnus-play-startup-jingle): New variable. - -Sun Sep 1 06:38:45 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.22 is released. - -Sun Sep 1 05:45:59 1996 Lars Magne Ingebrigtsen - - * gnus.el: Removed unreferenced let bindings from all files. - -Sun Sep 1 02:10:28 1996 Lars Magne Ingebrigtsen - - * gnus.el ((load)): Only do the initial splash on "gnus" - commands. - - * gnus-cus.el (gnus-face-dark-name-list): Don't use "dark blue". - - * nntp.el (nntp-retrieve-headers): Would infloop sometimes. - - * gnus-group.el (gnus-group-insert-group-line-info): Indent - properly. - - * gnus-sum.el (gnus-gather-threads-by-references): Avoid - infloops. - - * gnus-salt.el (gnus-mouse-pick): Changed name. - - * nntp.el (nntp-retrieve-groups): Didn't do the right thing on - servers that don't support LIST ACTIVE. - - * gnus-win.el (gnus-current-window-configuration): New variable. - (gnus-configure-windows): Use it. - - * gnus-art.el (gnus-article-read-summary-keys): Let `C-d' work - properly. - - * gnus-sum.el (gnus-list-of-unread-articles): Active group. - -Sat Aug 31 05:05:14 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.21 is released. - -Sat Aug 31 02:54:39 1996 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-goto-next-group): Go to the proper - group when listing. - - * gnus-start.el (gnus-get-killed-groups): Mark .newsrc as needing - saving. - - * nnmail.el (nnmail-remove-tabs): New function. - -Fri Aug 30 06:26:37 1996 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-set-default-directory): Set to directory - file name. - - * nnmail.el (nnmail-remove-list-identifiers): New function. - (nnmail-list-identifiers): New variable. - (nnmail-prepare-incoming-message-hook): New variable. - (nnmail-move-inbox): Allow nnmail-movemail-program to be a - function. - - * article.el (article-mime-decode-quoted-printable-buffer): New - function. - - * nnmail.el (nnmail-prepare-incoming-header-hook): New variable. - (nnmail-clean-whitespace-from-headers): New function. - - * nntp.el (nntp-connection-alist): New variable. - (nntp-open-connection): Use it. - (nntp-request-close): New function. - - * gnus-demon.el (timer): Required. - - * message.el (message-reply): Bugged out on wide replies. - -Fri Aug 30 03:51:39 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.20 is released. - -Fri Aug 30 01:36:10 1996 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-inews-insert-archive-gcc): Use - `gnus-group-find-parameter'. - - * nndoc.el (nndoc-mbox-article-begin): New function. - - * gnus-sum.el (gnus-summary-search-article): Would expose the - first hidden thread. - - * gnus-msg.el (gnus-copy-article-buffer): Delete annotations - before following up. - - * gnus-cite.el (gnus-article-hide-citation): Mark buttons as - annotations. - - * article.el (article-delete-text-of-type): New function. - - * nndoc.el (nndoc-type-alist): Be slightly more permissive. - - * gnus-sum.el (gnus-summary-enter-digest-group): Would nix out - quit-conf. - (gnus-summary-read-document): Ditto. - - * nndoc.el (nndoc-dissect-buffer): Escape errors in overflows. - - * message.el (message-send-news): Give a message after not - posting. - (message-reply): Remove leading spaces from Cc. - -Fri Aug 30 01:32:27 1996 Jack Vinson - - * nnmail.el (nnmail-get-split-group): New version. - -Fri Aug 30 00:47:17 1996 Jens Lautenbacher - - * gnus.texi (Group Parameters): Updated documentation - - * gnus-msg.el (gnus-inews-insert-archive-gcc): Updated to use the - topic's value of gcc-self if no group value present. - -Fri Aug 30 00:19:43 1996 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-set-default-directory): Expand default - directory. - - * gnus-group.el (gnus-group-make-web-group): Changed keystroke. - - * gnus-sum.el (gnus-summary-verbose-headers): Show article after - toggling. - -Thu Aug 29 23:50:54 1996 Lars Magne Ingebrigtsen - - * gnus-demon.el (gnus-demon-add-rescan): New function. - (gnus-demon-scan-news): New function. - -Thu Aug 29 05:34:40 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.19 is released. - -Thu Aug 29 02:04:35 1996 Lars Magne Ingebrigtsen - - * nndoc.el (nndoc-babyl-body-begin): Would skip empty messages. - - * nntp.el (nntp-retrieve-groups): Would infloop on some servers. - - * gnus-sum.el (gnus-nov-parse-line): Don't let messages refer back - to themselves. - - * gnus-util.el (gnus-parent-id): Don't bug out on nil references. - - * gnus-cite.el (gnus-article-hide-citation): Hide/unhide better. - - * article.el (article-hide-text-of-type): New function. - (article-hidden-text-type-p): New function. - - * gnus-cite.el (gnus-article-hide-citation): Marked the hidden - text with wrong type. - (gnus-article-hide-citation-maybe): Ditto. - (gnus-article-hide-citation): Toggle. - - * gnus-dup.el (gnus-dup-enter-articles): Would bug out on - pseudo-articles. - - * nntp.el (nntp-server-opened-hook): Send mode reader as a - default. - (nntp-retrieve-data): Format error. - -Thu Aug 29 01:52:19 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-display-article): Check whether - `gnus-current-article' is nil. - -Wed Aug 28 08:44:22 1996 Lars Magne Ingebrigtsen - - * gnus-async.el (gnus-async-prefetch-article): Would clobber - fetches in progress. - - * gnus-sum.el (gnus-summary-prepare): Made into command. - - * gnus-srvr.el (gnus-server-scan-server): New command and - keystroke. - - * gnus-group.el (gnus-group-read-group): Accept a 0 prefix to not - generate buffer. - -Sun Jul 21 14:56:28 1996 Steven L Baur - - * earcon.el (earcon-regexp-alist): Plonk! - -Wed Aug 28 04:14:36 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.18 is released. - -Wed Aug 28 02:09:20 1996 Lars Magne Ingebrigtsen - - * nnweb.el (nnweb-dejanews-create-mapping): Would just fetch the - first 100 hits. - (nnweb-close-group): Set file name to nil before killing. - (nnweb-altavista-create-mapping): Fetch the required number of - articles. - - * gnus-group.el (gnus-group-read-ephemeral-group): Don't call the - activation several times. - - * gnus-sum.el (gnus-summary-enter-digest-group): Copy the parent's - params to the nndoc group. - (gnus-summary-read-document): Ditto. - - * message.el (message-followup): Would produce buggy messages when - replying to messages without Message-IDs. - -Sat Aug 10 23:41:07 1996 Per Abrahamsen - - * gnus.el (gnus-decode-rfc1522): Start decoding from beginning of - headers instead of end. - -Wed Aug 28 01:35:26 1996 Lars Magne Ingebrigtsen - - * gnus-demon.el (gnus-demon-cancel): Cancel function timers. - - * nnheaderxm.el (nnheader-xmas-cancel-function-timers): New - function. - - * nnheader.el (nnheader-cancel-function-timers): New alias. - - * gnus-topic.el (gnus-topic-mode): Update groups. - (gnus-topic-remove-group): Update topic. - - * gnus-group.el (gnus-group-update-group-function): New variable. - (gnus-group-update-group): Use it. - - * gnus-topic.el (gnus-topic-update-topics-containing-group): New - function. - -Tue Aug 27 14:35:01 1996 Ken Raeburn - - * nnmail.el (nnmail-move-inbox): Don't try setting modes on - "po:$USER". - -Tue Aug 27 21:45:14 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-number-of-articles-in-thread): Would - bug out on unthreadeds. - -Tue Aug 27 21:38:13 1996 Kurt Swanson - - * gnus-salt.el (gnus-pick-mode-map): Typo. - -Tue Aug 27 21:35:58 1996 Lars Magne Ingebrigtsen - - * gnus-load.el: Removed gnus-vis thingies. - -Tue Aug 27 00:54:05 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.17 is released. - -Tue Aug 27 00:46:48 1996 Lars Magne Ingebrigtsen - - * nnweb.el (nnweb-dejanews-create-mapping): Dummy function. - -Tue Aug 27 00:43:33 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.16 is released. - -Tue Aug 27 00:36:58 1996 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-set-parameters): Bugout. - -Mon Aug 26 22:41:04 1996 Lars Magne Ingebrigtsen - - * nntp.el (nntp-retrieve-groups): Didn't inhibit erasing. - - * nnweb.el (nnweb-callback): Ignore if the callback buffer is - dead. - - * gnus-async.el (gnus-async-prefetch-article): Don't do anything - if Gnus is dead. - -Mon Aug 26 00:57:06 1996 Lars Magne Ingebrigtsen - - * nnweb.el (nnweb-dejanews-create-mapping): Fold search. - (nnweb-reference-create-mapping): Ditto. - (nnweb-altavista-create-mapping): Ditto. - - * gnus-async.el (gnus-asynchronous): New variable. - (gnus-async-prefetch-article): Use it. - (gnus-async-prefetch-headers): Ditto. - - * nnweb.el (nnweb-close-group): New function. - - * gnus-topic.el (gnus-topic-clean-alist): Would remove foreign - groups from topics. - -Mon Aug 26 00:10:40 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.15 is released. - -Sun Aug 25 23:09:18 1996 Lars Magne Ingebrigtsen - - * message.el (message-send-mail-with-qmail): Use - `message-qmail-program', which doesn't exist. - - * nndoc.el (nndoc-type-alist): Slack digests are guessable. - -Sun Aug 25 21:27:17 1996 Lars Magne Ingebrigtsen - - * gnus-salt.el (gnus-pick-mode): Nixed out the format. - (gnus-summary-pick-line-format): Buggy def. - - * gnus-sum.el (gnus-summary-read-document): Provide a quit-conf. - (gnus-summary-read-document): Do better names. - - * nnvirtual.el (nnvirtual-close-group): Don't do the unread - setting on ephemeral groups. - - * nntp.el (nntp-retrieve-groups): Would infloop. - -Sun Aug 25 02:52:11 1996 Sudish Joseph - - * message.el (message-qmail-inject-program): New variable. - (message-qmail-inject-args): New variable. - (message-send-mail-with-qmail): New function, suitable for use - as message-send-mail-function. - -Sun Aug 25 20:41:45 1996 Lars Magne Ingebrigtsen - - * nnweb.el (nnweb-fetch-form): Clear buffer file name. - - * nntp.el (nntp-request-article): Would try to copy to the same - buffer. - - * gnus-group.el (gnus-group-read-ephemeral-group): Better error - message. - - * nnweb.el (nnweb-request-group): Better error report. - - * gnus-score.el (gnus-score-load-file): Gave `nil' as a day param. - -Sun Aug 25 03:32:51 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.14 is released. - -Sun Aug 25 00:16:44 1996 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-prin1): New function. - (gnus-prin1-to-string): New function. - - * gnus-sum.el (gnus-summary-refer-parent-article): Bugout. - - * nndb.el (nndb-request-accept-article): Use new nntp functions. - - * pop3.el: Make MD5 defined when compiling. - - * article.el (article-strip-blank-lines): Called Gnus functions. - - * nnweb.el (nnweb-init): Create a better buffer name. - (nnweb-altavista-search): Wasn't defined. - (nnweb-reference-search): Use advanced search. - - * nnfolder.el (nnfolder-request-accept-article): Wrong params to - `save-mail'. - * nnbabyl.el (nnbabyl-request-accept-article): Ditto. - * nnmbox.el (nnmbox-request-accept-article): Ditto. - * nnmh.el (nnmh-request-accept-article): Ditto. - * nnml.el (nnml-request-accept-article): Ditto. - -Sat Aug 24 23:53:32 1996 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-get-new-mail): Tried calling nonexisting - functions. - -Sat Aug 24 23:30:07 1996 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-enter-directory): Temporarily bound - `nneething-read-only'. - -Fri Aug 23 23:22:16 1996 Katsumi Yamaoka - - * gnus-ems.el (gnus-ems-redefine): Set - `gnus-summary-display-table' to nil. - -Fri Aug 23 22:55:09 1996 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-summary-save-in-file): Didn't check before - creating dir. - (gnus-summary-save-in-rmail): Ditto. - (gnus-summary-save-body-in-file): Ditto. - - * message.el (message-check-news-syntax): Faulty Newsgroups - regexp. - -Thu Aug 22 20:47:48 1996 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-split-hook): New variable. - - * nnmh.el (nnmh-update-gnus-unreads): cl-nged. - (nnmh-active-number): Find the largest article number. - -Thu Aug 22 20:39:10 1996 Sam Falkner - - * nnmh.el (nnmh-update-gnus-unreads): Check all articles. - -Thu Aug 22 16:49:35 1996 Lars Magne Ingebrigtsen - - * gnus-kill.el (gnus-execute): Ignored read articles. - - * gnus-sum.el (gnus-summary-execute-command): Give a form, not a - function. - - * gnus-kill.el (gnus-execute-1): Evaled functions instead of - calling them. - - * nnmail.el (nnmail-move-inbox): Allow continuation after error. - - * gnus-score.el (gnus-adaptive-word-syntax-table): New variable. - (gnus-score-adaptive): Use it. - - * nnbabyl.el (nnbabyl-request-scan): Change group. - - * nnmbox.el (nnmbox-request-scan): Change group. - - * gnus-score.el (gnus-ignored-adaptive-words): Renamed. - (gnus-ignored-adaptive-words): New variable. - (gnus-score-adaptive): Use it. - (gnus-score-adaptive): Bugged out on undefined symbols. - (gnus-summary-score-entry): Accept numerical DATE. - (gnus-score-adaptive): Pos in wrong buf. - (gnus-score-string): Didn't accept word matches. - (gnus-enter-score-words-into-hashtb): Wrong sequence. - (gnus-score-string): Word matches inflooped. - -Wed Aug 21 15:06:47 1996 - - * smiley.el (smiley-buffer): Added some additional extent parameters. - (smiley-toggle-extent): rewrote to use above. - -Mon Aug 19 20:19:59 1996 Lars Magne Ingebrigtsen - - * gnus-spec.el (gnus-tilde-cut-form): Cut off wrong part. - -Mon Aug 19 20:09:44 1996 Samuel Tardieu - - * gnus-cache.el (gnus-cache-write-active): Would try to create - existing directory. - -Mon Aug 19 00:12:11 1996 Lars Magne Ingebrigtsen - - * article.el (article-strip-multiple-blank-lines): New command and - keystroke. - (article-strip-blank-lines): New command and keystroke. - - * nnmail.el (nnmail-move-inbox): Set file permissions on the - Incoming files. - - * gnus-group.el (gnus-group-fetch-faq): Go through the FAQ dirs - until we manage to open one. - - * nntp.el (nntp-send-authinfo-function): New variable. - (nntp-wait-for): Handle authinfo requests better. - - * gnus-sum.el (gnus-summary-article-posted-p): New command and - keystroke. - - * gnus-topic.el (gnus-topic-display-empty-topics): New variable. - - * gnus-msg.el (gnus-setup-message): Make `gnus-newsgroup-name' - local to the message buffers. - - * gnus-int.el (gnus-remove-denial): New function. - - * gnus-sum.el (gnus-summary-refer-parent-article): Allow negative - prefixes. - (gnus-summary-refer-parent-article): Allow skipping past canceled - articles. - - * gnus-util.el (gnus-parent-id): Take an optional N ancestor - param. - - * gnus-async.el (gnus-async-prefetch-article): Don't clobber async - fetches already in progress. - - * nnmail.el (nnmail-check-duplication): Allow /dev/null mail - filing. - - * gnus-sum.el (gnus-summary-catchup): Didn't do suppression. - (gnus-summary-limit-children): Never hide ticked articles. - (gnus-highlight-selected-summary): Selected face spans the entire - %(-%) area. - -Sun Aug 18 22:05:00 1996 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-restart): Better prompt. - - * gnus-async.el (gnus-async-prefetch-article): Don't try to fetch - old-fetched articles. - -Sun Aug 18 22:02:17 1996 Raja R. Harinath - - * gnus-gl.el (gnus-grouplens-mode): Make hooks local. - -Sun Aug 18 16:53:19 1996 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-get-new-news): Don't move point. - - * nnweb.el (nndejagnus): Renamed from nndejagnus. - (nnweb-remove-markup): New function. - -Sun Aug 18 14:53:55 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.13 is released. - -Tue Aug 20 17:30:00 1996 - - * smiley.el (smiley-map): New keymap for smileys. - (smiley-toggle-extent): New function to toggle smiley invisibility. - (smiley-buffer): Use them. - -Sun Aug 18 12:46:12 1996 Lars Magne Ingebrigtsen - - * nnoo.el (nnoo-define-skeleton-1): Defined too many functions. - -Sat Aug 17 18:43:22 1996 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-make-dejanews-group): New command and - keystroke. - - * gnus-start.el (gnus-site-init-file): New variable. - (gnus-read-init-file): Use it. - - * nndejanews.el: New file. - - * nnheader.el (make-full-mail-header): New function. - - * nngateway.el (nngateway-open-server): Used nntp vars. - -Sat Aug 17 15:35:28 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.12 is released. - -Sat Aug 17 12:58:28 1996 Lars Magne Ingebrigtsen - - * gnus-win.el (gnus-window-configuration-element): New function. - (gnus-windows-old-to-new): Use it. - (gnus-windows-old-to-new): Produced bogus results. - - * message.el (message-cancel-message): New variable. - - * gnus-srvr.el (gnus-server-mode-map): Buggy keymap. - - * gnus-group.el (gnus-group-get-new-news-this-group): Illegal - gnus-error value. - -Fri Aug 16 21:22:12 1996 Lars Magne Ingebrigtsen - - * nnmail.el (nnmail-replace-status, nnmail-decode-status, - nnmail-encode-status): New variables. - - * nnml.el (nnml-article-to-file): New function. - -Fri Aug 16 20:26:12 1996 Kurt Swanson - - * nnfolder.el (nnfolder-generate-active-file): Test the right - files. - -Fri Aug 16 19:30:57 1996 Lars Magne Ingebrigtsen - - * gnus-salt.el (gnus-possibly-generate-tree): Would bug out on - unthreaded buffers. - - * gnus-xmas.el (gnus-xmas-modeline-right-extent): Disabled. - (gnus-xmas-modeline-left-extent): Ditto. - - * gnus-group.el (gnus-group-make-menu-bar): Bugged out on - undefined variable. - - * gnus.el (gnus-read-method): Return the virtual server name if - possible. - -Thu Aug 15 18:15:58 1996 Lars Magne Ingebrigtsen - - * nngateway.el: New file. - - * nnoo.el (nnoo-define-skeleton): New macro. - (nnoo-define-skeleton-1): New function. - - * gnus-start.el (gnus-strip-killed-list): New function. - (gnus-gnus-to-quick-newsrc-format): Use it. - - * gnus-sum.el (gnus-summary-process-mark-set): New function. - (gnus-summary-yank-process-mark, gnus-summary-kill-process-mark, - gnus-summary-save-process-mark): New commands and keystrokes. - - * nnml.el (nnml-generate-nov-file): Set modes. - - * nnmail.el (nnmail-default-file-modes): New variable. - (nnmail-write-region): New function. - - * gnus-score.el (gnus-score-score-files-1): Bind case-fold-search - to nil. - -Wed Aug 14 21:20:07 1996 Lars Magne Ingebrigtsen - - * gnus-soup.el (gnus-soup-send-packet): Disable syntax checks. - -Wed Aug 14 20:28:09 1996 Fred Johansen - - * gnus-logic.el (gnus-advanced-score-rule): `and' rules were - treated improperly. - -Wed Aug 14 15:29:39 1996 Lars Magne Ingebrigtsen - - * gnus-salt.el (gnus-mouse-pick-article): New command. - - * gnus-art.el (gnus-button-url): Call with one argument. - - * gnus-start.el (gnus-set-default-directory): New function. - - * gnus-load.el (gnus-default-directory): New variable. - -Wed Aug 14 15:03:01 1996 Sudish Joseph - - * gnus-score.el (gnus-home-score-file): Changed syntax. - -Tue Aug 13 22:07:11 1996 Jan Vroonhof - - * nndoc.el (nndoc-dissect-buffer): Went into infinite loop if end - of file token wasn't properly detected. - (nndoc-type-alist): Better end-of-header regexp for - lanl.gov preprints - (nndoc-article-type): Updated doc string - -Mon Aug 12 21:01:25 1996 Sudish Joseph - - * nntp.el (nntp-request-newgroups): Switch to nntp-server-buffer - first. - -Tue Aug 13 09:44:46 1996 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-group-sort-by-real-name): New function. - - * gnus-sum.el (gnus-summary-save-article): Pass on number of - articles to be saved. - - * gnus-art.el (gnus-article-edit-article): Remove all text props. - (gnus-read-save-file-name): Take an optional defaultish parameter. - - * nntp.el (nntp-retrieve-groups): Saved. - - * message.el (message-forward): Didn't work well with multi-line - separators. - - * gnus-msg.el (gnus-summary-mail-crosspost-complaint): Check - wheteher followup-to was restricted. - - * nnsoup.el (nnsoup-store-reply): Would insert double courtesy - headers. - - * gnus-group.el (gnus-group-highlight-line): New `total' number. - -Mon Aug 12 06:25:00 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.11 is released. - -Mon Aug 12 03:51:57 1996 Lars Magne Ingebrigtsen - - * gnus-async.el (gnus-make-async-article-function): New function. - (gnus-async-prefetch-article): Use it. - -Sat Aug 10 07:16:29 1996 Greg Stark - - * gnus-start.el (gnus-activate-level): Doc fix. - -Sun Aug 11 03:33:02 1996 Lars Magne Ingebrigtsen - - * gnus-msg.el (gnus-summary-mail-crosspost-complaint): New command. - (gnus-crosspost-message): New variable. - - * gnus-vis.el: Removed file -- functions spread out over - gnus-group.el, gnus-sum.el and gnus-art.el. - - * gnus-util.el (gnus-turn-off-edit-menu): Renamed function. - - * gnus-salt.el (gnus-carpal-mode): Moved to this file. - - * gnus-vis.el (gnus-score-set-default): Removed. - (gnus-visual-score-map): Removed. - - * nntp.el (nntp-send-nosy-authinfo): Don't echo password. - - * gnus-srvr.el (gnus-server-open-all-servers): New command and - keystroke. - (gnus-server-close-all-servers): Ditto. - - * gnus-async.el (gnus-async-get-semaphore): New function. - (gnus-async-release-semaphore): New function. - (gnus-async-prefetch-article): Use them. - - * nntp.el (nntp-make-process-buffer): New function. - (nntp-retrieve-data): Use after-change instead of filter. - (nntp-after-change-function): New function. - - * gnus.el (gnus-read-method): Intern method. - - * gnus-cache.el (gnus-cache-save-buffers): Didn't check before - making dir. - -Sat Aug 10 14:55:33 1996 Sudish Joseph - - * gnus-win.el (gnus-buffer-configuration): Don't create picon - frame if gnus-picons-display-where is 'article. - -Sun Aug 11 02:47:30 1996 Lars Magne Ingebrigtsen - - * gnus-vis.el (gnus-highlight-selected-summary): Would bug out on - some lines. - - * gnus-spec.el (gnus-tilde-cut-form): Typo. - (gnus-parse-simple-format): Forgot to check `max-right' and - `max-left'. - (gnus-compile): Don't issue warnings. - -Fri Aug 2 14:53:02 1996 Christoph Wedler - - * smiley.el (smiley-buffer): `smiley-regexp-alist' can be a symbol - now. - -Sun Aug 11 02:37:57 1996 Greg Stark - - * gnus-msg.el (gnus-post-method): Tested the wrong variable. - -Sun Aug 11 02:28:30 1996 Lars Magne Ingebrigtsen - - * message.el (message-check-news-syntax): Messaged wrong number. - -Sat Aug 10 11:26:56 1996 Lars Magne Ingebrigtsen - - * message.el (message-y-or-n-p): Moved to before usage. - -Fri Aug 9 16:42:52 1996 Danny Siu - - * gnus-picon.el (gnus-article-display-picons): display picon even if - From line doesn't have full domain name. - -Sat Aug 10 10:11:21 1996 Lars Magne Ingebrigtsen - - * message.el (message-reply): Didn't narrow properly to the head. - (message-indent-citation): Remove all blank lines at the start. - -Sat Aug 10 07:00:34 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.9 is released. - -Sat Aug 10 06:03:07 1996 Lars Magne Ingebrigtsen - - * gnus-soup.el (gnus-soup-write-prefixes): Protect against - existing dirs. - - * gnus-topic.el (gnus-topic-parameters): Third parameter instead - of second. - (gnus-topic-set-parameters): Ditto. - -Sat Aug 10 05:22:43 1996 Lee Iverson - - * message.el (message-send-mail-with-mh): Didn't work. - -Sat Aug 10 03:57:42 1996 Lars Magne Ingebrigtsen - - * gnus-dup.el (gnus-dup-unsuppress-article): Data instead of - ingo. - (gnus-dup-unsuppress-article): Set the wrong variable. - -Sat Aug 10 00:52:26 1996 Jack Vinson - - * gnus.el (gnus-short-group-name): Bug in dotless names. - -Sat Aug 10 00:45:32 1996 Jens Lautenbacher - - * gnus-msg.el (gnus-inews-insert-archive-gcc): Use the `gcc-self' - parameter. - -Sat Aug 10 00:28:41 1996 François Pinard - - * gnus-load.el (gnus-info-nodes): Add info node for - `mime/viewer-mode'. - -Sat Aug 10 00:25:51 1996 Lars Magne Ingebrigtsen - - * message.el (message-reply): Don't include first empty line. - -Sat Aug 10 00:11:52 1996 François Pinard - - * gnus-sum.el (gnus-summary-prev-unread-article): Doc fix. - -Sat Aug 10 00:08:42 1996 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-date-iso8601): Protect against buggy Dates. - -Fri Aug 9 06:39:22 1996 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-mode): Hook into parameter thingies. - (gnus-topic-parameters): Buggy definition. - - * gnus-group.el (gnus-group-get-parameter-function): New - variable. - - * gnus.el (gnus-group-find-parameter): New function. - - * gnus-sum.el (gnus-summary-read-document): New command and - keystroke. - - * gnus-group.el (gnus-group-clear-data-on-native-groups): New - command. - (gnus-group-read-ephemeral-group): Accept an ACTIVATE-ONLY - parameter. - - * gnus-score.el (gnus-decay-score): New function. - (gnus-decay-scores): New function. - (gnus-decay-score-function): New variable. - (gnus-score-date): Accept a `regexp' match. - - * gnus-util.el (gnus-time-to-day): New function. - - * gnus-score.el (gnus-decay-scores): New variable. - (gnus-score-decay-constant): New variable. - (gnus-score-decay-scale): New variable. - - * gnus-sum.el (gnus-group-make-articles-read): Register undo. - - * gnus-group.el (gnus-update-read-articles): Register undo. - - * gnus-undo.el (gnus-undo-register-1): Renamed. - (gnus-undo-register): New macro. - - * gnus-group.el (gnus-group-yank-group): Be undoable. - (gnus-group-kill-group): Be undoable. - (gnus-undo): Required. - (gnus-group-clear-data): New keystroke. - - * gnus-undo.el (gnus-undo-last-command): New variable. - (gnus-undo): Didn't work. - (gnus-undo-boundary): Keep track of whether the last command did a - boundary. - (gnus-undo): Set boundary. - -Thu Aug 8 19:43:02 1996 Lars Magne Ingebrigtsen - - * gnus-spec.el (gnus-tilde-cut-form): New function. - (gnus-tilde-max-form): New definition. - (gnus-tilde-ignore-form): New function. - (gnus-parse-format): Rewrite to accept extended syntax. - - * gnus-topic.el (gnus-topic-goto-missing-group): Try to be a bit - faster. - - * gnus-group.el (gnus-group-goto-group): Accept optional FAR - parameter. - - * gnus-int.el (gnus-request-newgroups): Don't bug out on servers - that don't support this. - - * gnus.el (gnus-server-extend-method): Would bug out on non-known - methods. - - * gnus-group.el (gnus-group-get-new-news): Put point in the group - buffer. - -Wed Aug 7 15:40:44 1996 Jan Vroonhof - - * nntp.el (nntp-open-rlogin): Now can be used as - nntp-open-connection function - (nntp-open-telnet): Ditto - (nntp-open-rlogin): Needed to remove telnet junk from nntp buffer - to make new nntp-wait-for happy - all: required carriage return for end of line - -Tue Aug 6 21:58:26 1996 Jan Vroonhof - - * nndoc.el (nndoc-generate-lanl-gov-head): New function - (nndoc-transform-lanl-gov-announce): New function - (nndoc-lanl-gov-announce-type-p): New function - (nndoc-type-alist): Added support for preprint announcements - (nndoc-type-alist): Only use 'slack-digests' if forced to. - -Tue Aug 6 20:41:02 1996 Jan Vroonhof - - * nndoc.el (nndoc-type-alist): tried to call nndoc-guess-type-p - -Thu Aug 8 05:40:28 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-walk-group-buffer): Put cursor in echo - area. - - * gnus-dup.el (gnus-dup-unsuppress-article): New function. - - * gnus-sum.el (gnus-mark-article-as-unread): Unsuppress - duplicates. - - * gnus-msg.el (gnus-debug): Scan gnus-load.el. - -Thu Aug 8 01:48:57 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.8 is released. - -Thu Aug 8 01:36:34 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.7 is released. - -Thu Aug 8 01:29:56 1996 Lars Magne Ingebrigtsen - - * message.el (message-deletable-headers): Have Lines be - deletable. - -Wed Aug 7 23:41:26 1996 Richard Pieri - - * gnus.el (gnus-short-group-name): New version. - -Wed Aug 7 19:55:25 1996 Lars Magne Ingebrigtsen - - * gnus-start.el (gnus-declare-backend): New function. - - * gnus-xmas.el (gnus-xmas-pointer-glyph): New variable. - (gnus-xmas-modeline-glyph): New variable. - (gnus-xmas-mode-line-buffer-identification): New definition. - - * nntp.el (nntp-request-article): Would sometimes return nil - falsely. - (nntp-find-group-and-number): Saved function. - (nntp-request-article): Use it. - (nntp-request-head): Saved. - - * gnus-dup.el (gnus-dup-suppress-articles): Message. - - * gnus-group.el (gnus-group-mark-group): Used string instead of - char. - -Wed Aug 7 02:52:55 1996 Lars Magne Ingebrigtsen - - * gnus-util.el: Use `format-time-string'. - - * gnus-sum.el (gnus-summary-edit-article-postpone): Defined - again. - - * article.el (article-make-date-line): Would say "unknown" on - "now" dates. - -Wed Aug 7 02:48:12 1996 Katsumi Yamaoka - - * message.el (message-rename-buffer): Set proper outsave name. - -Wed Aug 7 00:28:44 1996 Lars Magne Ingebrigtsen - - * nnheader.el (nnheader-temp-write): Always use - `fundamental-mode'. - - * gnus-util.el (gnus-date-iso8601): Illegal format. - - * gnus-group.el (gnus-group-make-doc-group): Full name in server - name. - - * gnus-undo.el (gnus-undo): Typo. - - * gnus-group.el (gnus-group-mark-group): Don't touch props. - - * gnus-score.el (gnus-score-headers): Don't root out 0 scores when - saving. - - * gnus-art.el (gnus-narrow-to-page): Don't do a "next-page" if - `^L' is the last char. - - * gnus.el (gnus): Autoload. - -Tue Aug 6 23:00:01 1996 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-score-string): Wouldn't do word and fuzzy - matching properly. - -Mon Aug 5 22:23:03 1996 Raja R. Harinath - - * gnus-gl.el (gnus-grouplens-mode): Clear proper variables. - -Mon Aug 5 20:27:11 1996 Lars Magne Ingebrigtsen - - * gnus-art.el (gnus-article-edit-exit): Would move point. - (gnus-article-edit): New command. - - * nnml.el (nnml-request-rename-group): Copy over .overview file. - (nnml-request-group): Better error message. - -Sat Aug 3 17:52:01 1996 Steven L Baur - - * gnus-setup.el (message): Can't require 'message until we know - where the Gnus .elcs are. - -Mon Aug 5 20:07:11 1996 François Pinard - - * gnus-util.el (gnus-date-iso8601): New function. - -Mon Aug 5 19:14:12 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-search-article-forward): Show thread - when finding matches. - - * nnmail.el (nnmail-get-spool-files): Sort procmail files. - -Mon Aug 5 02:25:06 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.6 is released. - -Mon Aug 5 01:12:24 1996 Lars Magne Ingebrigtsen - - * nntp.el (nntp-request-type): Defined again. - -Mon Aug 5 01:01:15 1996 Ralph Schleicher - - * gnus-score.el (gnus-ignored-adaptive-words): New value. - -Mon Aug 5 00:12:54 1996 Lars Magne Ingebrigtsen - - * gnus-util.el (gnus-group-real-name): Tweaked definition. - - * gnus-eform.el (gnus-edit-form-done): Didn't call the right - function. - -Sun Aug 4 23:30:52 1996 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-score-load-files): Returned nil. - -Sun Aug 4 06:11:02 1996 Lars Magne Ingebrigtsen - - * gnus-load.el (gnus-use-undo): New variable. - - * gnus-undo.el: New file. - - * gnus-score.el (gnus-default-adaptive-word-score-alist): New - variable. - (gnus-score-adaptive): Adaptivity on words. - (gnus-ignored-adaptive-words): New variable. - (gnus-all-score-files): Made into own function. - (gnus-score-load-files): Ditto. - (gnus-score-find-favourite-words): New command and keystroke. - - * gnus-load.el (gnus-use-adaptive-scoring): Doc fix. - - * gnus-score.el (gnus-enter-score-words-into-hashtb): New - function. - (gnus-score-build-cons): Removed. - (gnus-score-string): Score words. - -Sun Aug 4 01:33:31 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.5 is released. - -Sun Aug 4 00:17:51 1996 Lars Magne Ingebrigtsen - - * nntp.el (nntp-wait-for): Goto point-max before inserting. - (nntp-retrieve-headers): Didn't inhibit Erasure. - - * gnus-eform.el (gnus-edit-form-mode-map): Buggy. - - * nntp.el (nntp-send-command-nodelete): New function. - -Sat Aug 3 22:21:24 1996 Lars Magne Ingebrigtsen - - * article.el (article-date-ut): Wouldn't do anything much. - - * nntp.el (nntp-wait-for): Wouldn't allow posting. - - * nnmail.el (nnmail-delete-incoming): Set to nil. - -Sat Aug 3 01:31:24 1996 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-home-score-file): New variable. - (gnus-home-score-file): New function. - (gnus-hierarchial-home-score-file): New function. - (gnus-possibly-score-headers): Use `adapt-file' param. - (gnus-home-adapt-file): New variable. - (gnus-hierarchial-home-adapt-file): New function. - - * gnus-load.el (gnus-original-article-buffer): Moved here. - - * gnus-sum.el (gnus-article-mark): New macro. - (gnus-summary-prepare-unthreaded): Use it. - (gnus-summary-prepare-threads): Ditto. - - * gnus-win.el (gnus-buffer-configuration): New `edit-article' - setting. - - * gnus-sum.el (gnus-summary-edit-article): Don't move point in the - article buffer. - (gnus-summary-edit-article-done): Don't move point after editing. - (gnus-summary-edit-article-postpone): Removed. - (gnus-summary-update-article-line): New function. - - * gnus-art.el (gnus-article-edit-mode-map): Buggy map. - -Fri Aug 2 22:36:40 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.4 is released. - -Wed Jul 31 15:23:54 1996 Ken Olstad - - * gnus-xmas.el (gnus-xmas-redefine): Disable XFace when running - under tty. - -Wed Jul 31 14:21:38 1996 Lars Magne Ingebrigtsen - - * gnus.el (gnus-group-read-group): Use `gnus-range-length' instead - of `length'. - -Fri Aug 2 21:48:17 1996 Lars Magne Ingebrigtsen - - * gnus-dup.el (gnus-dup-suppress-articles): Wouldn't mark articles - properly. - -Fri Aug 2 21:40:33 1996 Glenn Coombs - - * gnus-vis.el (gnus-button-url): New definition. - -Fri Aug 2 19:08:55 1996 Lars Magne Ingebrigtsen - - * gnus-group.el (gnus-update-read-articles): Moved here. - - * gnus-sum.el (gnus-update-read-articles): Moved here. - - * gnus-async.el (gnus-async-request-fetched-article): Would bug - out on Message-IDs. - - * gnus-score.el (gnus-score-save): Would kill wrong buffer. - - * nntp.el (nntp-process-filter): Insert at point-max. - - * nnheader.el (nnheader-set-temp-buffer): Accept a noerase param. - -Fri Aug 2 00:14:16 1996 Lars Magne Ingebrigtsen - - * gnus-topic.el (gnus-topic-edit-parameters): New command. - (gnus-group-topic-parameters): New function. - (gnus-topic-set-parameters): New function. - (gnus-topic-parameters): New function. - - * gnus-group.el (gnus-group-edit-group-done): Newish definition. - - * gnus-srvr.el (gnus-server-edit-server): Use new edit function. - (gnus-server-edit-server-done): Removed. - - * gnus-group.el: Use new edit function. - - * gnus-eform.el (gnus-eform): New file. - - * gnus-group.el (gnus-group-goto-group): Tippy-toe around some - more to find the most likely instance of the group. - (gnus-edit-form): New function. - (gnus-edit-form-mode): New command. - (gnus-edit-form-make-menu-bar): New function. - (gnus-edit-form-mode-hook): New variable. - (gnus-edit-form-exit): New command and keystroke. - (gnus-edit-form-done): Ditto. - - * gnus-topic.el: Moved functions around. - (gnus-current-topic): Renamed. - (gnus-current-topics): New function. - (gnus-group-parent-topic): New function. - - * article.el (gnus-signature-separator): New default. - (gnus-signature-limit): Extended value. - (article-narrow-to-signature): Use it. - - * gnus-cite.el (gnus-cite-parse): Use new signature functions. - - * article.el (article-search-signature): New function. - (gnus-signature-separator): Allow wider syntax. - - * gnus-async.el (gnus-use-header-prefetch): New variable. - (gnus-async-set-article-buffer): Removed. - (gnus-async-prefetch-headers): New function. - (gnus-async-retrieve-fetched-headers): New function. - (gnus-async-prefetch-headers-buffer): New variable. - - * gnus-salt.el (gnus-summary-pick-line-format): New variable. - (gnus-pick-mode): Use it. - (gnus-pick-line-number): New function. - (gnus-pick-article): New command and keystroke. - (gnus-pick-mode-map): Changed " " to `gnus-pick-next-page'. - (gnus-pick-next-page): New command and keystroke. - (gnus-mark-unpicked-articles-as-read): New variable. - (gnus-pick-start-reading): Use it. - - * gnus-sum.el (gnus-summary-line-format-alist): Add pick line - number. - -Thu Aug 1 23:32:15 1996 Lars Magne Ingebrigtsen - - * nntp.el (nntp-request-list): Decode. - (nntp-request-list-newsgroups): Ditto. - - * gnus-gl.el (gnus-grouplens-mode): Update summary line specs. - - * gnus-msg.el (gnus-debug): Would bug out. - -Thu Aug 1 23:24:48 1996 Glenn Coombs - - * gnus-sum.el (gnus-summary-update-mark): Work on hidden threads. - -Thu Aug 1 00:00:16 1996 Lars Magne Ingebrigtsen - - * gnus-score.el (gnus-score-save): Wouldn't save scores. - - * gnus-load.el (gnus-summary-line-format): Moved here. - - * gnus.el (gnus-alive-p): More thorough definition. - (gnus-info-set-entry): New macro. - - * gnus-move.el: New file. - (gnus-move-group-to-server): New function. - (gnus-change-server): New command. - (gnus-group-move-group-to-server): New command. - - * gnus-start.el (gnus-parse-active): New function. - - * gnus.el (gnus-read-method): Mew function. - * gnus-group.el: Use it. - - * gnus-load.el (gnus-suppress-duplicates): New variable. - - * gnus-dup.el: New file. - - * gnus-sum.el (gnus-data-read-p): New macro. - (gnus-duplicate-mark): New variable. - -Wed Jul 31 23:09:35 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.3 is released. - -Wed Jul 31 21:38:08 1996 Lars Magne Ingebrigtsen - - * nntp.el (nntp-retrieve-headers-with-xover): Didn't work. - - * gnus-load.el (gnus-suppress-keymap): New function. - -Wed Jul 31 01:20:58 1996 Sudish Joseph - - * gnus-picon.el (gnus-group-display-picons): Delete just the live - extents. - -Wed Jul 31 21:15:01 1996 Lars Magne Ingebrigtsen - - * gnus.el ((load)): Only eval splash when loading. - - * gnus-group.el (gnus-group-quit): Always kill group buffer. - - * nntp.el (nntp-open-connection): Escape errors. - -Wed Jul 31 16:09:22 1996 Lars Magne Ingebrigtsen - - * nnml.el (nnml-request-rename-group): Would move subgroups as - well. - * nnmh.el: Ditto. - - * gnus-group.el (gnus-group-rename-group): Use current group name - as default. - (gnus-group-rename-group): Added doc string. - - * gnus-sum.el (gnus-general-simplify-subject): Renamed. - -Wed Jul 31 16:05:06 1996 Paul Franklin - - * gnus-sum.el (gnus-pdf-simplify-subject): New version. - -Wed Jul 31 15:59:04 1996 Raja R. Harinath - - * nntp.el (nntp-retrieve-headers-with-xover): `last' returns cdr. - -Wed Jul 31 15:18:33 1996 Lars Magne Ingebrigtsen - - * nntp.el (nntp-retrieve-headers-with-xover): Put the result in - the right buffer. - (nntp-request-body): Decode. - - * gnus.el (gnus-no-server): Would bug out when gnus-start wasn't - loaded. - - * gnus-art.el (gnus-article-edit-mode): New command. - (gnus-article-edit-mode-hook): New variable. - (gnus-article-edit-mode-map): New variable. - -Wed Jul 31 15:18:26 1996 François Pinard - - * gnus-art.el (gnus-article-edit-full-stops): New command. - -Wed Jul 31 13:03:48 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-edit-wash): New command and keystroke. - - * message.el (message-sort-headers-1): Sort properly on totally - empty headers. - - * article.el (article-hide-boring-headers): Didn't hide completely - empty headers. - - * nntp.el (nntp-encode-text): Rescued. - (nntp-send-buffer): New function. - (nntp-request-post): New function. - - * gnus-util.el (gnus-define-keys-safe): New macro. - (gnus-define-keys-1): Accept `safe' param. - - * gnus-load.el (gnus-summary-mode-map): Define the main three - keymaps prematurely here. - -Wed Jul 31 12:48:23 1996 Steven L. Baur - - * gnus-load.el (gnus-default-nntp-server): Moved. - -Wed Jul 31 03:15:02 1996 Lars Magne Ingebrigtsen - - * nndoc.el (nndoc-add-type): Remove old type definition. - - * article.el: Changed variable names back to `gnus-'. - -Tue Jul 30 23:07:04 1996 Lars Magne Ingebrigtsen - - * nntp.el (nntp-connection-alist): Define as oo. - - * nndoc.el (nndoc-add-type): Wrong number of args. - (nndoc-set-delims): Free var. - -Tue Jul 30 23:02:51 1996 Lars Magne Ingebrigtsen - - * gnus.el: Red Gnus v0.1 is released. - -Tue Jul 30 22:34:11 1996 Lars Magne Ingebrigtsen - - * nntp.el (nntp-find-connection-buffer): New function. - (nntp-retrieve-headers): Use it. - -Tue Jul 30 00:00:28 1996 Lars Magne Ingebrigtsen - - * nndoc.el (nndoc-add-type): New function. - (nndoc-guess-type): New function. - (nndoc-set-delims): New definition. - - * nntp.el (nntp-open-server): Init server buffer. - - * gnus.el (gnus-group-prefixed-name): Do the right thing with nil - methods. - (gnus-group-rename-group): Would act oddly when renaming native - groups. - -Mon Jul 29 14:17:30 1996 Lars Magne Ingebrigtsen - - * gnus-load.el (gnus-startup-hook): Removed hilit removal. - - * gnus-async.el: New file. - - * gnus-int.el (gnus-asynchronous-p): New function. - - * nntp.el: Replaced with new, asynchronous version. - -Mon Jul 29 11:48:07 1996 Paul Franklin - - * gnus-sum.el (gnus-pdf-simplify-subject): New function. - (gnus-summary-simplify-subject-query): New command. - -Mon Jul 29 10:05:30 1996 Lars Magne Ingebrigtsen - - * gnus-sum.el (gnus-summary-mode-map): Command for emphasis. - - * gnus-art.el (gnus-article-wash-status): Report emphasis. - - * article.el (article-unhide-text-type): New function. - (article-emphasize): New function. - (article-emphasis-alist): New variable. - - * gnus-score.el (gnus-score-headers): Hook into advanced scoring. - - * gnus-logic.el: New file. - - * article.el (article-treat-overstrike): Mark hiding type. - -Mon Jul 29 10:00:52 1996 d. hall - - * gnus-art.el (gnus-article-wash-status): New function. - -Sun Jul 28 15:20:19 1996 Lars Magne Ingebrigtsen - - * article.el (article-hidden-arg): Renamed all variables and - functions to `article-'. - - * gnus.el: Split file into gnus-start.el, gnus-group.el, - gnus-sum.el, gnus-art.el, gnus-win.el, gnus-load.el, gnus-util.el, - gnus-bcklg.el, gnus-spec.el, article.el, and gnus-int.el. - diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/Makefile --- a/lisp/gnus/Makefile Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,40 +0,0 @@ -SHELL = /bin/sh -EMACS=emacs -FLAGS=-batch -q -no-site-file -l ./dgnushack.el - -total: - rm -f *.elc ; $(EMACS) $(FLAGS) -f dgnushack-compile - -all: - rm -f *.elc ; $(EMACS) $(FLAGS) -f dgnushack-compile - -clever: - $(EMACS) $(FLAGS) -f dgnushack-compile - -some: - $(EMACS) $(FLAGS) -f dgnushack-recompile - -tags: - etags *.el - -separately: - rm -f *.elc ; for i in *.el; do $(EMACS) $(FLAGS) -f batch-byte-compile $$i; done - -pot: - xpot -drgnus -r`cat ./version` *.el > rgnus.pot - -gnus-load.el: - echo ";;; gnus-load.el --- automatically extracted custom dependencies" > gnus-load.el - echo ";;" >> gnus-load.el - echo ";;; Code:" >> gnus-load.el - echo >> gnus-load.el - $(EMACS) $(FLAGS) -l ./dgnushack.el -l cus-edit.el *.el \ - -f custom-make-dependencies >> gnus-load.el - echo >> gnus-load.el - echo "(provide 'gnus-load)" >> gnus-load.el - echo >> gnus-load.el - echo ";;; gnus-load.el ends here" >> gnus-load.el - -distclean: - rm -f *.orig *.rej *.elc *~ - diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/auto-autoloads.el --- a/lisp/gnus/auto-autoloads.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,313 +0,0 @@ -;;; DO NOT MODIFY THIS FILE -(if (not (featurep 'gnus-autoloads)) - (progn - -;;;### (autoloads (gnus-earcon-display) "earcon" "gnus/earcon.el") - -(autoload 'gnus-earcon-display "earcon" "\ -Play sounds in message buffers." t nil) - -;;;*** - -;;;### (autoloads (gnus-audio-play) "gnus-audio" "gnus/gnus-audio.el") - -(autoload 'gnus-audio-play "gnus-audio" "\ -Play a sound through the speaker." t nil) - -;;;*** - -;;;### (autoloads (gnus-cache-generate-nov-databases gnus-cache-generate-active gnus-jog-cache) "gnus-cache" "gnus/gnus-cache.el") - -(autoload 'gnus-jog-cache "gnus-cache" "\ -Go through all groups and put the articles into the cache. - -Usage: -$ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache" t nil) - -(autoload 'gnus-cache-generate-active "gnus-cache" "\ -Generate the cache active file." t nil) - -(autoload 'gnus-cache-generate-nov-databases "gnus-cache" "\ -Generate NOV files recursively starting in DIR." t nil) - -;;;*** - -;;;### (autoloads (gnus-fetch-group) "gnus-group" "gnus/gnus-group.el") - -(autoload 'gnus-fetch-group "gnus-group" "\ -Start Gnus if necessary and enter GROUP. -Returns whether the fetching was successful or not." t nil) - -;;;*** - -;;;### (autoloads (gnus-batch-score) "gnus-kill" "gnus/gnus-kill.el") - -(defalias 'gnus-batch-kill 'gnus-batch-score) - -(autoload 'gnus-batch-score "gnus-kill" "\ -Run batched scoring. -Usage: emacs -batch -l gnus -f gnus-batch-score ... -Newsgroups is a list of strings in Bnews format. If you want to score -the comp hierarchy, you'd say \"comp.all\". If you would not like to -score the alt hierarchy, you'd say \"!alt.all\"." t nil) - -;;;*** - -;;;### (autoloads (gnus-change-server) "gnus-move" "gnus/gnus-move.el") - -(autoload 'gnus-change-server "gnus-move" "\ -Move from FROM-SERVER to TO-SERVER. -Update the .newsrc.eld file to reflect the change of nntp server." t nil) - -;;;*** - -;;;### (autoloads (gnus-batch-brew-soup) "gnus-soup" "gnus/gnus-soup.el") - -(autoload 'gnus-batch-brew-soup "gnus-soup" "\ -Brew a SOUP packet from groups mention on the command line. -Will use the remaining command line arguments as regular expressions -for matching on group names. - -For instance, if you want to brew on all the nnml groups, as well as -groups with \"emacs\" in the name, you could say something like: - -$ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\"" t nil) - -;;;*** - -;;;### (autoloads (gnus-update-format) "gnus-spec" "gnus/gnus-spec.el") - -(autoload 'gnus-update-format "gnus-spec" "\ -Update the format specification near point." t nil) - -;;;*** - -;;;### (autoloads (gnus-declare-backend gnus-unload) "gnus-start" "gnus/gnus-start.el") - -(autoload 'gnus-unload "gnus-start" "\ -Unload all Gnus features." t nil) - -(autoload 'gnus-declare-backend "gnus-start" "\ -Declare backend NAME with ABILITIES as a Gnus backend." nil nil) - -;;;*** - -;;;### (autoloads (gnus-add-configuration) "gnus-win" "gnus/gnus-win.el") - -(autoload 'gnus-add-configuration "gnus-win" "\ -Add the window configuration CONF to `gnus-buffer-configuration'." nil nil) - -;;;*** - -;;;### (autoloads (gnus gnus-other-frame gnus-slave gnus-no-server gnus-slave-no-server) "gnus" "gnus/gnus.el") - -(autoload 'gnus-slave-no-server "gnus" "\ -Read network news as a slave, without connecting to local server" t nil) - -(autoload 'gnus-no-server "gnus" "\ -Read network news. -If ARG is a positive number, Gnus will use that as the -startup level. If ARG is nil, Gnus will be started at level 2. -If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use. -As opposed to `gnus', this command will not connect to the local server." t nil) - -(autoload 'gnus-slave "gnus" "\ -Read news as a slave." t nil) - -(autoload 'gnus-other-frame "gnus" "\ -Pop up a frame to read news." t nil) - -(autoload 'gnus "gnus" "\ -Read network news. -If ARG is non-nil and a positive number, Gnus will use that as the -startup level. If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use." t nil) - -;;;*** - -;;;### (autoloads (unbold-region bold-region message-news-other-frame message-news-other-window message-mail-other-frame message-mail-other-window message-bounce message-resend message-forward message-recover message-supersede message-cancel-news message-followup message-wide-reply message-reply message-news message-mail message-mode) "message" "gnus/message.el") - -(defcustom message-from-style 'default "*Specifies how \"From\" headers look.\n\nIf `nil', they contain just the return address like:\n king@grassland.com\nIf `parens', they look like:\n king@grassland.com (Elvis Parsley)\nIf `angles', they look like:\n Elvis Parsley \n\nOtherwise, most addresses look like `angles', but they look like\n`parens' if `angles' would need quoting and `parens' would not." :type '(choice (const :tag "simple" nil) (const parens) (const angles) (const default)) :group 'message-headers) - -(defcustom message-signature-separator "^-- *$" "Regexp matching the signature separator." :type 'regexp :group 'message-various) - -(defcustom message-user-organization-file "/usr/lib/news/organization" "*Local news organization file." :type 'file :group 'message-headers) - -(defcustom message-send-mail-function 'message-send-mail-with-sendmail "Function to call to send the current buffer as mail.\nThe headers should be delimited by a line whose contents match the\nvariable `mail-header-separator'.\n\nLegal values include `message-send-mail-with-sendmail' (the default),\n`message-send-mail-with-mh' and `message-send-mail-with-qmail'." :type '(radio (function-item message-send-mail-with-sendmail) (function-item message-send-mail-with-mh) (function-item message-send-mail-with-qmail) (function :tag "Other")) :group 'message-sending :group 'message-mail) - -(defcustom message-citation-line-function 'message-insert-citation-line "*Function called to insert the \"Whomever writes:\" line." :type 'function :group 'message-insertion) - -(defcustom message-yank-prefix "> " "*Prefix inserted on the lines of yanked messages.\nnil means use indentation." :type 'string :group 'message-insertion) - -(defcustom message-cite-function (if (and (boundp 'mail-citation-hook) mail-citation-hook) mail-citation-hook 'message-cite-original) "*Function for citing an original message." :type '(radio (function-item message-cite-original) (function-item sc-cite-original) (function :tag "Other")) :group 'message-insertion) - -(defcustom message-indent-citation-function 'message-indent-citation "*Function for modifying a citation just inserted in the mail buffer.\nThis can also be a list of functions. Each function can find the\ncitation between (point) and (mark t). And each function should leave\npoint and mark around the citation text as modified." :type 'function :group 'message-insertion) - -(defcustom message-signature t "*String to be inserted at the end of the message buffer.\nIf t, the `message-signature-file' file will be inserted instead.\nIf a function, the result from the function will be used instead.\nIf a form, the result from the form will be used instead." :type 'sexp :group 'message-insertion) - -(defcustom message-signature-file "~/.signature" "*File containing the text inserted at end of message buffer." :type 'file :group 'message-insertion) - -(autoload 'message-mode "message" "\ -Major mode for editing mail and news to be sent. -Like Text Mode but with these additional commands: -C-c C-s message-send (send the message) C-c C-c message-send-and-exit -C-c C-f move to a header field (and create it if there isn't): - C-c C-f C-t move to To C-c C-f C-s move to Subject - C-c C-f C-c move to Cc C-c C-f C-b move to Bcc - C-c C-f C-w move to Fcc C-c C-f C-r move to Reply-To - C-c C-f C-u move to Summary C-c C-f C-n move to Newsgroups - C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution - C-c C-f C-f move to Followup-To -C-c C-t message-insert-to (add a To header to a news followup) -C-c C-n message-insert-newsgroups (add a Newsgroup header to a news reply) -C-c C-b message-goto-body (move to beginning of message text). -C-c C-i message-goto-signature (move to the beginning of the signature). -C-c C-w message-insert-signature (insert `message-signature-file' file). -C-c C-y message-yank-original (insert current message, if any). -C-c C-q message-fill-yanked-message (fill what was yanked). -C-c C-e message-elide-region (elide the text between point and mark). -C-c C-r message-caesar-buffer-body (rot13 the message body)." t nil) - -(autoload 'message-mail "message" "\ -Start editing a mail message to be sent." t nil) - -(autoload 'message-news "message" "\ -Start editing a news article to be sent." t nil) - -(autoload 'message-reply "message" "\ -Start editing a reply to the article in the current buffer." t nil) - -(autoload 'message-wide-reply "message" "\ -Make a \"wide\" reply to the message in the current buffer." t nil) - -(autoload 'message-followup "message" "\ -Follow up to the message in the current buffer. -If TO-NEWSGROUPS, use that as the new Newsgroups line." t nil) - -(autoload 'message-cancel-news "message" "\ -Cancel an article you posted." t nil) - -(autoload 'message-supersede "message" "\ -Start composing a message to supersede the current message. -This is done simply by taking the old article and adding a Supersedes -header line with the old Message-ID." t nil) - -(autoload 'message-recover "message" "\ -Reread contents of current buffer from its last auto-save file." t nil) - -(autoload 'message-forward "message" "\ -Forward the current message via mail. -Optional NEWS will use news to forward instead of mail." t nil) - -(autoload 'message-resend "message" "\ -Resend the current article to ADDRESS." t nil) - -(autoload 'message-bounce "message" "\ -Re-mail the current message. -This only makes sense if the current message is a bounce message than -contains some mail you have written which has been bounced back to -you." t nil) - -(autoload 'message-mail-other-window "message" "\ -Like `message-mail' command, but display mail buffer in another window." t nil) - -(autoload 'message-mail-other-frame "message" "\ -Like `message-mail' command, but display mail buffer in another frame." t nil) - -(autoload 'message-news-other-window "message" "\ -Start editing a news article to be sent." t nil) - -(autoload 'message-news-other-frame "message" "\ -Start editing a news article to be sent." t nil) - -(autoload 'bold-region "message" "\ -Bold all nonblank characters in the region. -Works by overstriking characters. -Called from program, takes two arguments START and END -which specify the range to operate on." t nil) - -(autoload 'unbold-region "message" "\ -Remove all boldness (overstruck characters) in the region. -Called from program, takes two arguments START and END -which specify the range to operate on." t nil) - -;;;*** - -;;;### (autoloads nil "messcompat" "gnus/messcompat.el") - -(defvar message-signature-file mail-signature-file "\ -*File containing the text inserted at end of message. buffer.") - -;;;*** - -;;;### (autoloads (nndoc-add-type) "nndoc" "gnus/nndoc.el") - -(autoload 'nndoc-add-type "nndoc" "\ -Add document DEFINITION to the list of nndoc document definitions. -If POSITION is nil or `last', the definition will be added -as the last checked definition, if t or `first', add as the -first definition, and if any other symbol, add after that -symbol in the alist." nil nil) - -;;;*** - -;;;### (autoloads (nnfolder-generate-active-file) "nnfolder" "gnus/nnfolder.el") - -(autoload 'nnfolder-generate-active-file "nnfolder" "\ -Look for mbox folders in the nnfolder directory and make them into groups." t nil) - -;;;*** - -;;;### (autoloads (nnkiboze-generate-groups) "nnkiboze" "gnus/nnkiboze.el") - -(autoload 'nnkiboze-generate-groups "nnkiboze" "\ -Usage: emacs -batch -l nnkiboze -f nnkiboze-generate-groups -Finds out what articles are to be part of the nnkiboze groups." t nil) - -;;;*** - -;;;### (autoloads (nnml-generate-nov-databases) "nnml" "gnus/nnml.el") - -(autoload 'nnml-generate-nov-databases "nnml" "\ -Generate NOV databases in all nnml directories." t nil) - -;;;*** - -;;;### (autoloads (nnsoup-revert-variables nnsoup-set-variables nnsoup-pack-replies) "nnsoup" "gnus/nnsoup.el") - -(autoload 'nnsoup-pack-replies "nnsoup" "\ -Make an outbound package of SOUP replies." t nil) - -(autoload 'nnsoup-set-variables "nnsoup" "\ -Use the SOUP methods for posting news and mailing mail." t nil) - -(autoload 'nnsoup-revert-variables "nnsoup" "\ -Revert posting and mailing methods to the standard Emacs methods." t nil) - -;;;*** - -;;;### (autoloads (gnus-score-mode) "score-mode" "gnus/score-mode.el") - -(autoload 'gnus-score-mode "score-mode" "\ -Mode for editing Gnus score files. -This mode is an extended emacs-lisp mode. - -\\{gnus-score-mode-map}" t nil) - -;;;*** - -;;;### (autoloads (gnus-smiley-display smiley-buffer smiley-region) "smiley" "gnus/smiley.el") - -(autoload 'smiley-region "smiley" "\ -Smilify the region between point and mark." t nil) - -(autoload 'smiley-buffer "smiley" nil t nil) - -(autoload 'gnus-smiley-display "smiley" "\ -Display \"smileys\" as small graphical icons." t nil) - -;;;*** - -(provide 'gnus-autoloads) -)) diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/custom-load.el --- a/lisp/gnus/custom-load.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,79 +0,0 @@ -(custom-put 'earcon 'custom-loads '("earcon")) -(custom-put 'gnus-article 'custom-loads '("gnus-art" "gnus-cite")) -(custom-put 'gnus-article-hiding 'custom-loads '("gnus-art" "gnus-sum")) -(custom-put 'gnus-article-highlight 'custom-loads '("gnus-art")) -(custom-put 'gnus-article-signature 'custom-loads '("gnus-art")) -(custom-put 'gnus-article-headers 'custom-loads '("gnus-art" "gnus-sum")) -(custom-put 'gnus-article-washing 'custom-loads '("gnus-xmas" "gnus-art")) -(custom-put 'gnus-article-emphasis 'custom-loads '("gnus-art")) -(custom-put 'gnus-article-saving 'custom-loads '("gnus-art")) -(custom-put 'gnus-article-mime 'custom-loads '("gnus-art" "gnus-sum")) -(custom-put 'gnus-article-buttons 'custom-loads '("gnus-art")) -(custom-put 'gnus-article-various 'custom-loads '("gnus-art" "gnus-sum")) -(custom-put 'gnus-asynchronous 'custom-loads '("gnus-async")) -(custom-put 'gnus-cite 'custom-loads '("gnus-cite")) -(custom-put 'gnus-demon 'custom-loads '("gnus-demon")) -(custom-put 'gnus-duplicate 'custom-loads '("gnus-dup")) -(custom-put 'gnus-edit-form 'custom-loads '("gnus-eform")) -(custom-put 'gnus-nocem 'custom-loads '("gnus-nocem")) -(custom-put 'picons 'custom-loads '("gnus-picon")) -(custom-put 'gnus-topic 'custom-loads '("gnus-topic")) -(custom-put 'gnus-extract 'custom-loads '("gnus" "gnus-uu")) -(custom-put 'gnus-extract-view 'custom-loads '("gnus-sum" "gnus-uu")) -(custom-put 'gnus-extract-archive 'custom-loads '("gnus-uu")) -(custom-put 'gnus-extract-post 'custom-loads '("gnus-uu")) -(custom-put 'gnus-windows 'custom-loads '("gnus-win")) -(custom-put 'gnus-xmas 'custom-loads '("gnus-xmas")) -(custom-put 'gnus 'custom-loads '("gnus-art" "gnus-async" "gnus-cache" "gnus-demon" "gnus-dup" "gnus-eform" "gnus-uu" "gnus-win" "gnus-xmas" "gnus" "nnmail")) -(custom-put 'gnus-start 'custom-loads '("gnus-group" "gnus-int" "gnus-start" "gnus-util" "gnus")) -(custom-put 'gnus-group 'custom-loads '("gnus-topic" "gnus")) -(custom-put 'gnus-group-foreign 'custom-loads '("gnus-group")) -(custom-put 'gnus-group-levels 'custom-loads '("gnus-group")) -(custom-put 'gnus-group-select 'custom-loads '("gnus-sum")) -(custom-put 'gnus-group-listing 'custom-loads '("gnus-group")) -(custom-put 'gnus-group-various 'custom-loads '("gnus-group")) -(custom-put 'gnus-summary 'custom-loads '("gnus-sum" "gnus")) -(custom-put 'gnus-summary-exit 'custom-loads '("gnus-sum")) -(custom-put 'gnus-summary-marks 'custom-loads '("gnus-sum")) -(custom-put 'gnus-thread 'custom-loads '("gnus-sum")) -(custom-put 'gnus-summary-format 'custom-loads '("gnus-sum")) -(custom-put 'gnus-summary-choose 'custom-loads '("gnus-sum")) -(custom-put 'gnus-summary-maneuvering 'custom-loads '("gnus-sum")) -(custom-put 'gnus-summary-mail 'custom-loads '("gnus-sum")) -(custom-put 'gnus-summary-sort 'custom-loads '("gnus-sum")) -(custom-put 'gnus-summary-visual 'custom-loads '("gnus-sum" "gnus")) -(custom-put 'gnus-summary-various 'custom-loads '("gnus-sum")) -(custom-put 'gnus-summary-pick 'custom-loads '("gnus-salt")) -(custom-put 'gnus-summary-tree 'custom-loads '("gnus-salt")) -(custom-put 'gnus-score 'custom-loads '("gnus-nocem" "gnus")) -(custom-put 'gnus-score-kill 'custom-loads '("gnus-kill")) -(custom-put 'gnus-score-adapt 'custom-loads '("gnus-score")) -(custom-put 'gnus-score-default 'custom-loads '("gnus-score" "gnus-sum")) -(custom-put 'gnus-score-expire 'custom-loads '("gnus-kill" "gnus-score")) -(custom-put 'gnus-score-decay 'custom-loads '("gnus-score")) -(custom-put 'gnus-score-files 'custom-loads '("gnus-score")) -(custom-put 'gnus-visual 'custom-loads '("earcon" "gnus-art" "gnus-picon" "gnus" "smiley")) -(custom-put 'gnus-files 'custom-loads '("gnus" "nnmail")) -(custom-put 'gnus-message 'custom-loads '("message")) -(custom-put 'gnus-various 'custom-loads '("gnus-sum")) -(custom-put 'message 'custom-loads '("message")) -(custom-put 'message-various 'custom-loads '("message")) -(custom-put 'message-buffers 'custom-loads '("message")) -(custom-put 'message-sending 'custom-loads '("message")) -(custom-put 'message-interface 'custom-loads '("message")) -(custom-put 'message-forwarding 'custom-loads '("message")) -(custom-put 'message-insertion 'custom-loads '("message")) -(custom-put 'message-headers 'custom-loads '("message")) -(custom-put 'message-news 'custom-loads '("message")) -(custom-put 'message-mail 'custom-loads '("message")) -(custom-put 'message-faces 'custom-loads '("message")) -(custom-put 'nnmail 'custom-loads '("nnmail")) -(custom-put 'nnmail-retrieve 'custom-loads '("nnmail")) -(custom-put 'nnmail-prepare 'custom-loads '("nnmail")) -(custom-put 'nnmail-duplicate 'custom-loads '("nnmail")) -(custom-put 'nnmail-split 'custom-loads '("nnmail")) -(custom-put 'nnmail-files 'custom-loads '("nnmail")) -(custom-put 'nnmail-expire 'custom-loads '("nnmail")) -(custom-put 'nnmail-procmail 'custom-loads '("nnmail")) -(custom-put 'nnmail-various 'custom-loads '("nnmail")) -(custom-put 'smiley 'custom-loads '()) diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/dgnushack.el --- a/lisp/gnus/dgnushack.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,77 +0,0 @@ -;;; dgnushack.el --- a hack to set the load path for byte-compiling -;; Copyright (C) 1994,95,96,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Version: 4.19 -;; Keywords: news, path - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(fset 'facep 'ignore) - -(require 'cl) -(require 'bytecomp) -(push "." load-path) -(require 'lpath) - -(defalias 'device-sound-enabled-p 'ignore) -(defalias 'play-sound-file 'ignore) -(defalias 'nndb-request-article 'ignore) -(defalias 'efs-re-read-dir 'ignore) -(defalias 'ange-ftp-re-read-dir 'ignore) -(defalias 'define-mail-user-agent 'ignore) - -(eval-and-compile - (unless (string-match "XEmacs" emacs-version) - (fset 'get-popup-menu-response 'ignore) - (fset 'event-object 'ignore) - (fset 'x-defined-colors 'ignore) - (fset 'read-color 'ignore))) - -(setq byte-compile-warnings - '(free-vars unresolved callargs redefine obsolete)) - -(defun dgnushack-compile () - ;;(setq byte-compile-dynamic t) - (let ((files (directory-files "." nil ".el$")) - (xemacs (string-match "XEmacs" emacs-version)) - ;;(byte-compile-generate-call-tree t) - byte-compile-warnings file elc) - (condition-case () - (require 'w3-forms) - (error (setq files (delete "nnweb.el" files)))) - (while (setq file (pop files)) - (when (or (not (member file '("gnus-xmas.el" "gnus-picon.el" - "messagexmas.el" "nnheaderxm.el" - "smiley.el"))) - xemacs) - (when (or (not (file-exists-p (setq elc (concat file "c")))) - (file-newer-than-file-p file elc)) - (ignore-errors - (byte-compile-file file))))))) - -(defun dgnushack-recompile () - (require 'gnus) - (byte-recompile-directory "." 0)) - -;;; dgnushack.el ends here - diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/earcon.el --- a/lisp/gnus/earcon.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,245 +0,0 @@ -;;; earcon.el --- Sound effects for messages -;; Copyright (C) 1996 Free Software Foundation - -;; Author: Steven L. Baur -;; Keywords: news fun sound - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: -;; This file provides access to sound effects in Gnus. - -;;; Code: - -(if (null (boundp 'running-xemacs)) - (defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))) - -(require 'gnus) -(require 'gnus-audio) -(require 'gnus-art) -(eval-when-compile (require 'cl)) - -(defgroup earcon nil - "Turn ** sounds ** into noise." - :group 'gnus-visual) - -(defcustom earcon-auto-play nil - "When True, automatically play sounds as well as buttonize them." - :type 'boolean - :group 'earcon) - -(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.au") - ("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. - (save-excursion - (set-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) - (save-excursion - (set-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 diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-art.el --- a/lisp/gnus/gnus-art.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,3114 +0,0 @@ -;;; gnus-art.el --- article mode commands for Gnus -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'custom) -(require 'gnus) -(require 'gnus-sum) -(require 'gnus-spec) -(require 'gnus-int) -(require 'browse-url) - -(defgroup gnus-article nil - "Article display." - :link '(custom-manual "(gnus)The Article Buffer") - :group 'gnus) - -(defgroup gnus-article-hiding nil - "Hiding article parts." - :link '(custom-manual "(gnus)Article Hiding") - :group 'gnus-article) - -(defgroup gnus-article-highlight nil - "Article highlighting." - :link '(custom-manual "(gnus)Article Highlighting") - :group 'gnus-article - :group 'gnus-visual) - -(defgroup gnus-article-signature nil - "Article signatures." - :link '(custom-manual "(gnus)Article Signature") - :group 'gnus-article) - -(defgroup gnus-article-headers nil - "Article headers." - :link '(custom-manual "(gnus)Hiding Headers") - :group 'gnus-article) - -(defgroup gnus-article-washing nil - "Special commands on articles." - :link '(custom-manual "(gnus)Article Washing") - :group 'gnus-article) - -(defgroup gnus-article-emphasis nil - "Fontisizing articles." - :link '(custom-manual "(gnus)Article Fontisizing") - :group 'gnus-article) - -(defgroup gnus-article-saving nil - "Saving articles." - :link '(custom-manual "(gnus)Saving Articles") - :group 'gnus-article) - -(defgroup gnus-article-mime nil - "Worshiping the MIME wonder." - :link '(custom-manual "(gnus)Using MIME") - :group 'gnus-article) - -(defgroup gnus-article-buttons nil - "Pushable buttons in the article buffer." - :link '(custom-manual "(gnus)Article Buttons") - :group 'gnus-article) - -(defgroup gnus-article-various nil - "Other article options." - :link '(custom-manual "(gnus)Misc Article") - :group 'gnus-article) - -(defcustom gnus-ignored-headers - '("^Path:" "^Posting-Version:" "^Article-I.D.:" "^Expires:" - "^Date-Received:" "^References:" "^Control:" "^Xref:" "^Lines:" - "^Posted:" "^Relay-Version:" "^Message-ID:" "^Nf-ID:" "^Nf-From:" - "^Approved:" "^Sender:" "^Received:" "^Mail-from:") - "All headers that match this regexp will be hidden. -This variable can also be a list of regexps of headers to be ignored. -If `gnus-visible-headers' is non-nil, this variable will be ignored." - :type '(choice :custom-show nil - regexp - (repeat regexp)) - :group 'gnus-article-hiding) - -(defcustom gnus-visible-headers - "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From" - "All headers that do not match this regexp will be hidden. -This variable can also be a list of regexp of headers to remain visible. -If this variable is non-nil, `gnus-ignored-headers' will be ignored." - :type '(repeat :value-to-internal (lambda (widget value) - (custom-split-regexp-maybe value)) - :match (lambda (widget value) - (or (stringp value) - (widget-editable-list-match widget value))) - regexp) - :group 'gnus-article-hiding) - -(defcustom gnus-sorted-header-list - '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" - "^Followup-To:" "^To:" "^Cc:" "^Date:" "^Organization:") - "This variable is a list of regular expressions. -If it is non-nil, headers that match the regular expressions will -be placed first in the article buffer in the sequence specified by -this list." - :type '(repeat regexp) - :group 'gnus-article-hiding) - -(defcustom gnus-boring-article-headers '(empty followup-to reply-to) - "Headers that are only to be displayed if they have interesting data. -Possible values in this list are `empty', `newsgroups', `followup-to', -`reply-to', and `date'." - :type '(set (const :tag "Headers with no content." empty) - (const :tag "Newsgroups with only one group." newsgroups) - (const :tag "Followup-to identical to newsgroups." followup-to) - (const :tag "Reply-to identical to from." reply-to) - (const :tag "Date less than four days old." date)) - :group 'gnus-article-hiding) - -(defcustom gnus-signature-separator '("^-- $" "^-- *$") - "Regexp matching signature separator. -This can also be a list of regexps. In that case, it will be checked -from head to tail looking for a separator. Searches will be done from -the end of the buffer." - :type '(repeat string) - :group 'gnus-article-signature) - -(defcustom gnus-signature-limit nil - "Provide a limit to what is considered a signature. -If it is a number, no signature may not be longer (in characters) than -that number. If it is a floating point number, no signature may be -longer (in lines) than that number. If it is a function, the function -will be called without any parameters, and if it returns nil, there is -no signature in the buffer. If it is a string, it will be used as a -regexp. If it matches, the text in question is not a signature." - :type '(choice integer number function regexp) - :group 'gnus-article-signature) - -(defcustom gnus-hidden-properties '(invisible t intangible t) - "Property list to use for hiding text." - :type 'sexp - :group 'gnus-article-hiding) - -(defcustom gnus-article-x-face-command - "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -" - "String or function to be executed to display an X-Face header. -If it is a string, the command will be executed in a sub-shell -asynchronously. The compressed face will be piped to this command." - :type 'string ;Leave function case to Lisp. - :group 'gnus-article-washing) - -(defcustom gnus-article-x-face-too-ugly nil - "Regexp matching posters whose face shouldn't be shown automatically." - :type 'regexp - :group 'gnus-article-washing) - -(defcustom gnus-emphasis-alist - (let ((format - "\\(\\s-\\|^\\|[-\"]\\|\\s(\\|\\s)\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\\(\\s-\\|[-?!.,;:\"]\\|\\s(\\|\\s)\\)") - (types - '(("_" "_" underline) - ("/" "/" italic) - ("\\*" "\\*" bold) - ("_/" "/_" underline-italic) - ("_\\*" "\\*_" underline-bold) - ("\\*/" "/\\*" bold-italic) - ("_\\*/" "/\\*_" underline-bold-italic)))) - `(("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)" - 2 3 gnus-emphasis-underline) - ,@(mapcar - (lambda (spec) - (list - (format format (car spec) (cadr spec)) - 2 3 (intern (format "gnus-emphasis-%s" (caddr spec))))) - types))) - "Alist that says how to fontify certain phrases. -Each item looks like this: - - (\"_\\\\(\\\\w+\\\\)_\" 0 1 'underline) - -The first element is a regular expression to be matched. The second -is a number that says what regular expression grouping used to find -the entire emphasized word. The third is a number that says what -regexp grouping should be displayed and highlighted. The fourth -is the face used for highlighting." - :type '(repeat (list :value ("" 0 0 default) - regexp - (integer :tag "Match group") - (integer :tag "Emphasize group") - face)) - :group 'gnus-article-emphasis) - -(defface gnus-emphasis-bold '((t (:bold t))) - "Face used for displaying strong emphasized text (*word*)." - :group 'gnus-article-emphasis) - -(defface gnus-emphasis-italic '((t (:italic t))) - "Face used for displaying italic emphasized text (/word/)." - :group 'gnus-article-emphasis) - -(defface gnus-emphasis-underline '((t (:underline t))) - "Face used for displaying underlined emphasized text (_word_)." - :group 'gnus-article-emphasis) - -(defface gnus-emphasis-underline-bold '((t (:bold t :underline t))) - "Face used for displaying underlined bold emphasized text (_*word*_)." - :group 'gnus-article-emphasis) - -(defface gnus-emphasis-underline-italic '((t (:italic t :underline t))) - "Face used for displaying underlined italic emphasized text (_*word*_)." - :group 'gnus-article-emphasis) - -(defface gnus-emphasis-bold-italic '((t (:bold t :italic t))) - "Face used for displaying bold italic emphasized text (/*word*/)." - :group 'gnus-article-emphasis) - -(defface gnus-emphasis-underline-bold-italic - '((t (:bold t :italic t :underline t))) - "Face used for displaying underlined bold italic emphasized text. -Esample: (_/*word*/_)." - :group 'gnus-article-emphasis) - -(defcustom gnus-article-time-format "%a, %b %d %Y %T %Z" - "Format for display of Date headers in article bodies. -See `format-time-zone' for the possible values." - :type 'string - :link '(custom-manual "(gnus)Article Date") - :group 'gnus-article-washing) - -(eval-and-compile - (autoload 'hexl-hex-string-to-integer "hexl") - (autoload 'timezone-make-date-arpa-standard "timezone") - (autoload 'mail-extract-address-components "mail-extr")) - -(defcustom gnus-save-all-headers t - "*If non-nil, don't remove any headers before saving." - :group 'gnus-article-saving - :type 'boolean) - -(defcustom gnus-prompt-before-saving 'always - "*This variable says how much prompting is to be done when saving articles. -If it is nil, no prompting will be done, and the articles will be -saved to the default files. If this variable is `always', each and -every article that is saved will be preceded by a prompt, even when -saving large batches of articles. If this variable is neither nil not -`always', there the user will be prompted once for a file name for -each invocation of the saving commands." - :group 'gnus-article-saving - :type '(choice (item always) - (item :tag "never" nil) - (sexp :tag "once" :format "%t"))) - -(defcustom gnus-saved-headers gnus-visible-headers - "Headers to keep if `gnus-save-all-headers' is nil. -If `gnus-save-all-headers' is non-nil, this variable will be ignored. -If that variable is nil, however, all headers that match this regexp -will be kept while the rest will be deleted before saving." - :group 'gnus-article-saving - :type '(repeat string)) - -(defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail - "A function to save articles in your favourite format. -The function must be interactively callable (in other words, it must -be an Emacs command). - -Gnus provides the following functions: - -* gnus-summary-save-in-rmail (Rmail format) -* gnus-summary-save-in-mail (Unix mail format) -* gnus-summary-save-in-folder (MH folder) -* gnus-summary-save-in-file (article format) -* gnus-summary-save-in-vm (use VM's folder format) -* gnus-summary-write-to-file (article format -- overwrite)." - :group 'gnus-article-saving - :type '(radio (function-item gnus-summary-save-in-rmail) - (function-item gnus-summary-save-in-mail) - (function-item gnus-summary-save-in-folder) - (function-item gnus-summary-save-in-file) - (function-item gnus-summary-save-in-vm) - (function-item gnus-summary-write-to-file))) - -(defcustom gnus-rmail-save-name 'gnus-plain-save-name - "A function generating a file name to save articles in Rmail format. -The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE." - :group 'gnus-article-saving - :type 'function) - -(defcustom gnus-mail-save-name 'gnus-plain-save-name - "A function generating a file name to save articles in Unix mail format. -The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE." - :group 'gnus-article-saving - :type 'function) - -(defcustom gnus-folder-save-name 'gnus-folder-save-name - "A function generating a file name to save articles in MH folder. -The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER." - :group 'gnus-article-saving - :type 'function) - -(defcustom gnus-file-save-name 'gnus-numeric-save-name - "A function generating a file name to save articles in article format. -The function is called with NEWSGROUP, HEADERS, and optional -LAST-FILE." - :group 'gnus-article-saving - :type 'function) - -(defcustom gnus-split-methods - '((gnus-article-archive-name) - (gnus-article-nndoc-name)) - "Variable used to suggest where articles are to be saved. -For instance, if you would like to save articles related to Gnus in -the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\", -you could set this variable to something like: - - '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\") - (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\")) - -This variable is an alist where the where the key is the match and the -value is a list of possible files to save in if the match is non-nil. - -If the match is a string, it is used as a regexp match on the -article. If the match is a symbol, that symbol will be funcalled -from the buffer of the article to be saved with the newsgroup as the -parameter. If it is a list, it will be evaled in the same buffer. - -If this form or function returns a string, this string will be used as -a possible file name; and if it returns a non-nil list, that list will -be used as possible file names." - :group 'gnus-article-saving - :type '(repeat (choice (list function) - (cons regexp (repeat string)) - sexp))) - -(defcustom gnus-strict-mime t - "*If nil, MIME-decode even if there is no Mime-Version header." - :group 'gnus-article-mime - :type 'boolean) - -(defcustom gnus-show-mime-method 'metamail-buffer - "Function to process a MIME message. -The function is called from the article buffer." - :group 'gnus-article-mime - :type 'function) - -(defcustom gnus-decode-encoded-word-method 'gnus-article-de-quoted-unreadable - "*Function to decode MIME encoded words. -The function is called from the article buffer." - :group 'gnus-article-mime - :type 'function) - -(defcustom gnus-page-delimiter "^\^L" - "*Regexp describing what to use as article page delimiters. -The default value is \"^\^L\", which is a form linefeed at the -beginning of a line." - :type 'regexp - :group 'gnus-article-various) - -(defcustom gnus-article-mode-line-format "Gnus: %%b %S" - "*The format specification for the article mode line. -See `gnus-summary-mode-line-format' for a closer description." - :type 'string - :group 'gnus-article-various) - -(defcustom gnus-article-mode-hook nil - "*A hook for Gnus article mode." - :type 'hook - :group 'gnus-article-various) - -(defcustom gnus-article-menu-hook nil - "*Hook run after the creation of the article mode menu." - :type 'hook - :group 'gnus-article-various) - -(defcustom gnus-article-prepare-hook nil - "*A hook called after an article has been prepared in the article buffer. -If you want to run a special decoding program like nkf, use this hook." - :type 'hook - :group 'gnus-article-various) - -(defcustom gnus-article-hide-pgp-hook nil - "*A hook called after successfully hiding a PGP signature." - :type 'hook - :group 'gnus-article-various) - -(defcustom gnus-article-button-face 'bold - "Face used for highlighting buttons in the article buffer. - -An article button is a piece of text that you can activate by pressing -`RET' or `mouse-2' above it." - :type 'face - :group 'gnus-article-buttons) - -(defcustom gnus-article-mouse-face 'highlight - "Face used for mouse highlighting in the article buffer. - -Article buttons will be displayed in this face when the cursor is -above them." - :type 'face - :group 'gnus-article-buttons) - -(defcustom gnus-signature-face 'gnus-signature-face - "Face used for highlighting a signature in the article buffer. -Obsolete; use the face `gnus-signature-face' for customizations instead." - :type 'face - :group 'gnus-article-highlight - :group 'gnus-article-signature) - -(defface gnus-signature-face - '((((type x)) - (:italic t))) - "Face used for highlighting a signature in the article buffer." - :group 'gnus-article-highlight - :group 'gnus-article-signature) - -(defface gnus-header-from-face - '((((class color) - (background dark)) - (:foreground "spring green" :bold t)) - (((class color) - (background light)) - (:foreground "red3" :bold t)) - (t - (:bold t :italic t))) - "Face used for displaying from headers." - :group 'gnus-article-headers - :group 'gnus-article-highlight) - -(defface gnus-header-subject-face - '((((class color) - (background dark)) - (:foreground "SeaGreen3" :bold t)) - (((class color) - (background light)) - (:foreground "red4" :bold t)) - (t - (:bold t :italic t))) - "Face used for displaying subject headers." - :group 'gnus-article-headers - :group 'gnus-article-highlight) - -(defface gnus-header-newsgroups-face - '((((class color) - (background dark)) - (:foreground "yellow" :bold t :italic t)) - (((class color) - (background light)) - (:foreground "MidnightBlue" :bold t :italic t)) - (t - (:bold t :italic t))) - "Face used for displaying newsgroups headers." - :group 'gnus-article-headers - :group 'gnus-article-highlight) - -(defface gnus-header-name-face - '((((class color) - (background dark)) - (:foreground "SeaGreen")) - (((class color) - (background light)) - (:foreground "maroon")) - (t - (:bold t))) - "Face used for displaying header names." - :group 'gnus-article-headers - :group 'gnus-article-highlight) - -(defface gnus-header-content-face - '((((class color) - (background dark)) - (:foreground "forest green" :italic t)) - (((class color) - (background light)) - (:foreground "indianred4" :italic t)) - (t - (:italic t))) "Face used for displaying header content." - :group 'gnus-article-headers - :group 'gnus-article-highlight) - -(defcustom gnus-header-face-alist - '(("From" nil gnus-header-from-face) - ("Subject" nil gnus-header-subject-face) - ("Newsgroups:.*," nil gnus-header-newsgroups-face) - ("" gnus-header-name-face gnus-header-content-face)) - "Controls highlighting of article header. - -An alist of the form (HEADER NAME CONTENT). - -HEADER is a regular expression which should match the name of an -header header and NAME and CONTENT are either face names or nil. - -The name of each header field will be displayed using the face -specified by the first element in the list where HEADER match the -header name and NAME is non-nil. Similarly, the content will be -displayed by the first non-nil matching CONTENT face." - :group 'gnus-article-headers - :group 'gnus-article-highlight - :type '(repeat (list (regexp :tag "Header") - (choice :tag "Name" - (item :tag "skip" nil) - (face :value default)) - (choice :tag "Content" - (item :tag "skip" nil) - (face :value default))))) - -;;; Internal variables - -(defvar gnus-article-mode-syntax-table - (let ((table (copy-syntax-table text-mode-syntax-table))) - (modify-syntax-entry ?- "w" table) - (modify-syntax-entry ?> ")" table) - (modify-syntax-entry ?< "(" table) - table) - "Syntax table used in article mode buffers. -Initialized from `text-mode-syntax-table.") - -(defvar gnus-save-article-buffer nil) - -(defvar gnus-article-mode-line-format-alist - (nconc '((?w (gnus-article-wash-status) ?s)) - gnus-summary-mode-line-format-alist)) - -(defvar gnus-number-of-articles-to-be-saved nil) - -(defvar gnus-inhibit-hiding nil) - -(defsubst gnus-article-hide-text (b e props) - "Set text PROPS on the B to E region, extending `intangible' 1 past B." - (add-text-properties b e props) - (when (memq 'intangible props) - (put-text-property - (max (1- b) (point-min)) - b 'intangible (cddr (memq 'intangible props))))) - -(defsubst gnus-article-unhide-text (b e) - "Remove hidden text properties from region between B and E." - (remove-text-properties b e gnus-hidden-properties) - (when (memq 'intangible gnus-hidden-properties) - (put-text-property (max (1- b) (point-min)) - b 'intangible nil))) - -(defun gnus-article-hide-text-type (b e type) - "Hide text of TYPE between B and E." - (gnus-article-hide-text - b e (cons 'article-type (cons type gnus-hidden-properties)))) - -(defun gnus-article-unhide-text-type (b e type) - "Hide text of TYPE between B and E." - (remove-text-properties - b e (cons 'article-type (cons type gnus-hidden-properties))) - (when (memq 'intangible gnus-hidden-properties) - (put-text-property (max (1- b) (point-min)) - b 'intangible nil))) - -(defun gnus-article-hide-text-of-type (type) - "Hide text of TYPE in the current buffer." - (save-excursion - (let ((b (point-min)) - (e (point-max))) - (while (setq b (text-property-any b e 'article-type type)) - (add-text-properties b (incf b) gnus-hidden-properties))))) - -(defun gnus-article-delete-text-of-type (type) - "Delete text of TYPE in the current buffer." - (save-excursion - (let ((b (point-min))) - (while (setq b (text-property-any b (point-max) 'article-type type)) - (delete-region - b (or (text-property-not-all b (point-max) 'article-type type) - (point-max))))))) - -(defun gnus-article-delete-invisible-text () - "Delete all invisible text in the current buffer." - (save-excursion - (let ((b (point-min))) - (while (setq b (text-property-any b (point-max) 'invisible t)) - (delete-region - b (or (text-property-not-all b (point-max) 'invisible t) - (point-max))))))) - -(defun gnus-article-text-type-exists-p (type) - "Say whether any text of type TYPE exists in the buffer." - (text-property-any (point-min) (point-max) 'article-type type)) - -(defsubst gnus-article-header-rank () - "Give the rank of the string HEADER as given by `gnus-sorted-header-list'." - (let ((list gnus-sorted-header-list) - (i 0)) - (while list - (when (looking-at (car list)) - (setq list nil)) - (setq list (cdr list)) - (incf i)) - i)) - -(defun article-hide-headers (&optional arg delete) - "Toggle whether to hide unwanted headers and possibly sort them as well. -If given a negative prefix, always show; if given a positive prefix, -always hide." - (interactive (gnus-article-hidden-arg)) - (if (gnus-article-check-hidden-text 'headers arg) - ;; Show boring headers as well. - (gnus-article-show-hidden-text 'boring-headers) - ;; This function might be inhibited. - (unless gnus-inhibit-hiding - (save-excursion - (save-restriction - (let ((buffer-read-only nil) - (props (nconc (list 'article-type 'headers) - gnus-hidden-properties)) - (max (1+ (length gnus-sorted-header-list))) - (ignored (when (not gnus-visible-headers) - (cond ((stringp gnus-ignored-headers) - gnus-ignored-headers) - ((listp gnus-ignored-headers) - (mapconcat 'identity gnus-ignored-headers - "\\|"))))) - (visible - (cond ((stringp gnus-visible-headers) - gnus-visible-headers) - ((and gnus-visible-headers - (listp gnus-visible-headers)) - (mapconcat 'identity gnus-visible-headers "\\|")))) - (inhibit-point-motion-hooks t) - want-list beg) - ;; First we narrow to just the headers. - (widen) - (goto-char (point-min)) - ;; Hide any "From " lines at the beginning of (mail) articles. - (while (looking-at "From ") - (forward-line 1)) - (unless (bobp) - (if delete - (delete-region (point-min) (point)) - (gnus-article-hide-text (point-min) (point) props))) - ;; Then treat the rest of the header lines. - (narrow-to-region - (point) - (if (search-forward "\n\n" nil t) ; if there's a body - (progn (forward-line -1) (point)) - (point-max))) - ;; Then we use the two regular expressions - ;; `gnus-ignored-headers' and `gnus-visible-headers' to - ;; select which header lines is to remain visible in the - ;; article buffer. - (goto-char (point-min)) - (while (re-search-forward "^[^ \t]*:" nil t) - (beginning-of-line) - ;; Mark the rank of the header. - (put-text-property - (point) (1+ (point)) 'message-rank - (if (or (and visible (looking-at visible)) - (and ignored - (not (looking-at ignored)))) - (gnus-article-header-rank) - (+ 2 max))) - (forward-line 1)) - (message-sort-headers-1) - (when (setq beg (text-property-any - (point-min) (point-max) 'message-rank (+ 2 max))) - ;; We make the unwanted headers invisible. - (if delete - (delete-region beg (point-max)) - ;; Suggested by Sudish Joseph . - (gnus-article-hide-text-type beg (point-max) 'headers)) - ;; Work around XEmacs lossage. - (put-text-property (point-min) beg 'invisible nil)))))))) - -(defun article-hide-boring-headers (&optional arg) - "Toggle hiding of headers that aren't very interesting. -If given a negative prefix, always show; if given a positive prefix, -always hide." - (interactive (gnus-article-hidden-arg)) - (when (and (not (gnus-article-check-hidden-text 'boring-headers arg)) - (not gnus-show-all-headers)) - (save-excursion - (save-restriction - (let ((buffer-read-only nil) - (list gnus-boring-article-headers) - (inhibit-point-motion-hooks t) - elem) - (nnheader-narrow-to-headers) - (while list - (setq elem (pop list)) - (goto-char (point-min)) - (cond - ;; Hide empty headers. - ((eq elem 'empty) - (while (re-search-forward "^[^:]+:[ \t]*\n[^ \t]" nil t) - (forward-line -1) - (gnus-article-hide-text-type - (progn (beginning-of-line) (point)) - (progn - (end-of-line) - (if (re-search-forward "^[^ \t]" nil t) - (match-beginning 0) - (point-max))) - 'boring-headers))) - ;; Hide boring Newsgroups header. - ((eq elem 'newsgroups) - (when (equal (gnus-fetch-field "newsgroups") - (gnus-group-real-name - (if (boundp 'gnus-newsgroup-name) - gnus-newsgroup-name - ""))) - (gnus-article-hide-header "newsgroups"))) - ((eq elem 'followup-to) - (when (equal (message-fetch-field "followup-to") - (message-fetch-field "newsgroups")) - (gnus-article-hide-header "followup-to"))) - ((eq elem 'reply-to) - (let ((from (message-fetch-field "from")) - (reply-to (message-fetch-field "reply-to"))) - (when (and - from reply-to - (ignore-errors - (equal - (nth 1 (mail-extract-address-components from)) - (nth 1 (mail-extract-address-components reply-to))))) - (gnus-article-hide-header "reply-to")))) - ((eq elem 'date) - (let ((date (message-fetch-field "date"))) - (when (and date - (< (gnus-days-between (current-time-string) date) - 4)) - (gnus-article-hide-header "date"))))))))))) - -(defun gnus-article-hide-header (header) - (save-excursion - (goto-char (point-min)) - (when (re-search-forward (concat "^" header ":") nil t) - (gnus-article-hide-text-type - (progn (beginning-of-line) (point)) - (progn - (end-of-line) - (if (re-search-forward "^[^ \t]" nil t) - (match-beginning 0) - (point-max))) - 'boring-headers)))) - -;; Written by Per Abrahamsen . -(defun article-treat-overstrike () - "Translate overstrikes into bold text." - (interactive) - (save-excursion - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (let ((buffer-read-only nil)) - (while (search-forward "\b" nil t) - (let ((next (following-char)) - (previous (char-after (- (point) 2)))) - ;; We do the boldification/underlining by hiding the - ;; overstrikes and putting the proper text property - ;; on the letters. - (cond - ((eq next previous) - (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike) - (put-text-property (point) (1+ (point)) 'face 'bold)) - ((eq next ?_) - (gnus-article-hide-text-type - (1- (point)) (1+ (point)) 'overstrike) - (put-text-property - (- (point) 2) (1- (point)) 'face 'underline)) - ((eq previous ?_) - (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike) - (put-text-property - (point) (1+ (point)) 'face 'underline))))))))) - -(defun article-fill () - "Format too long lines." - (interactive) - (save-excursion - (let ((buffer-read-only nil)) - (widen) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (end-of-line 1) - (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$") - (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?") - (adaptive-fill-mode t)) - (while (not (eobp)) - (and (>= (current-column) (min fill-column (window-width))) - (/= (preceding-char) ?:) - (fill-paragraph nil)) - (end-of-line 2)))))) - -(defun article-remove-cr () - "Remove carriage returns from an article." - (interactive) - (save-excursion - (let ((buffer-read-only nil)) - (goto-char (point-min)) - (while (search-forward "\r" nil t) - (replace-match "" t t))))) - -(defun article-remove-trailing-blank-lines () - "Remove all trailing blank lines from the article." - (interactive) - (save-excursion - (let ((buffer-read-only nil)) - (goto-char (point-max)) - (delete-region - (point) - (progn - (while (and (not (bobp)) - (looking-at "^[ \t]*$")) - (forward-line -1)) - (forward-line 1) - (point)))))) - -(defun article-display-x-face (&optional force) - "Look for an X-Face header and display it if present." - (interactive (list 'force)) - (save-excursion - ;; Delete the old process, if any. - (when (process-status "article-x-face") - (delete-process "article-x-face")) - (let ((inhibit-point-motion-hooks t) - (case-fold-search nil) - from) - (save-restriction - (nnheader-narrow-to-headers) - (setq from (message-fetch-field "from")) - (goto-char (point-min)) - (while (and gnus-article-x-face-command - (or force - ;; Check whether this face is censored. - (not gnus-article-x-face-too-ugly) - (and gnus-article-x-face-too-ugly from - (not (string-match gnus-article-x-face-too-ugly - from)))) - ;; Has to be present. - (re-search-forward "^X-Face: " nil t)) - ;; We now have the area of the buffer where the X-Face is stored. - (save-excursion - (let ((beg (point)) - (end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t)))) - ;; We display the face. - (if (symbolp gnus-article-x-face-command) - ;; The command is a lisp function, so we call it. - (if (gnus-functionp gnus-article-x-face-command) - (funcall gnus-article-x-face-command beg end) - (error "%s is not a function" gnus-article-x-face-command)) - ;; The command is a string, so we interpret the command - ;; as a, well, command, and fork it off. - (let ((process-connection-type nil)) - (process-kill-without-query - (start-process - "article-x-face" nil shell-file-name shell-command-switch - gnus-article-x-face-command)) - (process-send-region "article-x-face" beg end) - (process-send-eof "article-x-face")))))))))) - -(defun gnus-hack-decode-rfc1522 () - "Emergency hack function for avoiding problems when decoding." - (let ((buffer-read-only nil)) - (goto-char (point-min)) - ;; Remove encoded TABs. - (while (search-forward "=09" nil t) - (replace-match " " t t)) - ;; Remove encoded newlines. - (goto-char (point-min)) - (while (search-forward "=10" nil t) - (replace-match " " t t)))) - -(defalias 'gnus-decode-rfc1522 'article-decode-rfc1522) -(defalias 'gnus-article-decode-rfc1522 'article-decode-rfc1522) -(defun article-decode-rfc1522 () - "Hack to remove QP encoding from headers." - (let ((case-fold-search t) - (inhibit-point-motion-hooks t) - (buffer-read-only nil) - string) - (save-restriction - (narrow-to-region - (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point-max))) - (goto-char (point-min)) - (while (re-search-forward - "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t) - (setq string (match-string 1)) - (save-restriction - (narrow-to-region (match-beginning 0) (match-end 0)) - (delete-region (point-min) (point-max)) - (insert string) - (article-mime-decode-quoted-printable - (goto-char (point-min)) (point-max)) - (subst-char-in-region (point-min) (point-max) ?_ ? ) - (goto-char (point-max))) - (goto-char (point-min)))))) - -(defun article-de-quoted-unreadable (&optional force) - "Do a naive translation of a quoted-printable-encoded article. -This is in no way, shape or form meant as a replacement for real MIME -processing, but is simply a stop-gap measure until MIME support is -written. -If FORCE, decode the article whether it is marked as quoted-printable -or not." - (interactive (list 'force)) - (save-excursion - (let ((case-fold-search t) - (buffer-read-only nil) - (type (gnus-fetch-field "content-transfer-encoding"))) - (gnus-article-decode-rfc1522) - (when (or force - (and type (string-match "quoted-printable" (downcase type)))) - (goto-char (point-min)) - (search-forward "\n\n" nil 'move) - (article-mime-decode-quoted-printable (point) (point-max)))))) - -(defun article-mime-decode-quoted-printable-buffer () - "Decode Quoted-Printable in the current buffer." - (article-mime-decode-quoted-printable (point-min) (point-max))) - -(defun article-mime-decode-quoted-printable (from to) - "Decode Quoted-Printable in the region between FROM and TO." - (interactive "r") - (goto-char from) - (while (search-forward "=" to t) - (cond ((eq (following-char) ?\n) - (delete-char -1) - (delete-char 1)) - ((looking-at "[0-9A-F][0-9A-F]") - (subst-char-in-region - (1- (point)) (point) ?= - (hexl-hex-string-to-integer - (buffer-substring (point) (+ 2 (point))))) - (delete-char 2)) - ((looking-at "=") - (delete-char 1)) - ((gnus-message 3 "Malformed MIME quoted-printable message"))))) - -(defun article-hide-pgp (&optional arg) - "Toggle hiding of any PGP headers and signatures in the current article. -If given a negative prefix, always show; if given a positive prefix, -always hide." - (interactive (gnus-article-hidden-arg)) - (unless (gnus-article-check-hidden-text 'pgp arg) - (save-excursion - (let ((inhibit-point-motion-hooks t) - buffer-read-only beg end) - (widen) - (goto-char (point-min)) - ;; Hide the "header". - (when (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t) - (gnus-article-hide-text-type (1+ (match-beginning 0)) - (match-end 0) 'pgp) - (setq beg (point)) - ;; Hide the actual signature. - (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t) - (setq end (1+ (match-beginning 0))) - (gnus-article-hide-text-type - end - (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t) - (match-end 0) - ;; Perhaps we shouldn't hide to the end of the buffer - ;; if there is no end to the signature? - (point-max)) - 'pgp)) - ;; Hide "- " PGP quotation markers. - (when (and beg end) - (narrow-to-region beg end) - (goto-char (point-min)) - (while (re-search-forward "^- " nil t) - (gnus-article-hide-text-type - (match-beginning 0) (match-end 0) 'pgp)) - (widen)) - (run-hooks 'gnus-article-hide-pgp-hook)))))) - -(defun article-hide-pem (&optional arg) - "Toggle hiding of any PEM headers and signatures in the current article. -If given a negative prefix, always show; if given a positive prefix, -always hide." - (interactive (gnus-article-hidden-arg)) - (unless (gnus-article-check-hidden-text 'pem arg) - (save-excursion - (let (buffer-read-only end) - (widen) - (goto-char (point-min)) - ;; hide the horrendously ugly "header". - (and (search-forward "\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n" - nil - t) - (setq end (1+ (match-beginning 0))) - (gnus-article-hide-text-type - end - (if (search-forward "\n\n" nil t) - (match-end 0) - (point-max)) - 'pem)) - ;; hide the trailer as well - (and (search-forward "\n-----END PRIVACY-ENHANCED MESSAGE-----\n" - nil - t) - (gnus-article-hide-text-type - (match-beginning 0) (match-end 0) 'pem)))))) - -(defun article-hide-signature (&optional arg) - "Hide the signature in the current article. -If given a negative prefix, always show; if given a positive prefix, -always hide." - (interactive (gnus-article-hidden-arg)) - (unless (gnus-article-check-hidden-text 'signature arg) - (save-excursion - (save-restriction - (let ((buffer-read-only nil)) - (when (gnus-article-narrow-to-signature) - (gnus-article-hide-text-type - (point-min) (point-max) 'signature))))))) - -(defun article-strip-leading-blank-lines () - "Remove all blank lines from the beginning of the article." - (interactive) - (save-excursion - (let ((inhibit-point-motion-hooks t) - buffer-read-only) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (while (and (not (eobp)) - (looking-at "[ \t]*$")) - (gnus-delete-line)))))) - -(defun article-strip-multiple-blank-lines () - "Replace consecutive blank lines with one empty line." - (interactive) - (save-excursion - (let ((inhibit-point-motion-hooks t) - buffer-read-only) - ;; First make all blank lines empty. - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (while (re-search-forward "^[ \t]+$" nil t) - (replace-match "" nil t)) - ;; Then replace multiple empty lines with a single empty line. - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (while (re-search-forward "\n\n\n+" nil t) - (replace-match "\n\n" t t))))) - -(defun article-strip-leading-space () - "Remove all white space from the beginning of the lines in the article." - (interactive) - (save-excursion - (let ((inhibit-point-motion-hooks t) - buffer-read-only) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (while (re-search-forward "^[ \t]+" nil t) - (replace-match "" t t))))) - -(defun article-strip-blank-lines () - "Strip leading, trailing and multiple blank lines." - (interactive) - (article-strip-leading-blank-lines) - (article-remove-trailing-blank-lines) - (article-strip-multiple-blank-lines)) - -(defvar mime::preview/content-list) -(defvar mime::preview-content-info/point-min) -(defun gnus-article-narrow-to-signature () - "Narrow to the signature; return t if a signature is found, else nil." - (widen) - (when (and (boundp 'mime::preview/content-list) - mime::preview/content-list) - ;; We have a MIMEish article, so we use the MIME data to narrow. - (let ((pcinfo (car (last mime::preview/content-list)))) - (ignore-errors - (narrow-to-region - (funcall (intern "mime::preview-content-info/point-min") pcinfo) - (point-max))))) - - (when (gnus-article-search-signature) - (forward-line 1) - ;; Check whether we have some limits to what we consider - ;; to be a signature. - (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit - (list gnus-signature-limit))) - limit limited) - (while (setq limit (pop limits)) - (if (or (and (integerp limit) - (< (- (point-max) (point)) limit)) - (and (floatp limit) - (< (count-lines (point) (point-max)) limit)) - (and (gnus-functionp limit) - (funcall limit)) - (and (stringp limit) - (not (re-search-forward limit nil t)))) - () ; This limit did not succeed. - (setq limited t - limits nil))) - (unless limited - (narrow-to-region (point) (point-max)) - t)))) - -(defun gnus-article-search-signature () - "Search the current buffer for the signature separator. -Put point at the beginning of the signature separator." - (let ((cur (point))) - (goto-char (point-max)) - (if (if (stringp gnus-signature-separator) - (re-search-backward gnus-signature-separator nil t) - (let ((seps gnus-signature-separator)) - (while (and seps - (not (re-search-backward (car seps) nil t))) - (pop seps)) - seps)) - t - (goto-char cur) - nil))) - -(eval-and-compile - (autoload 'w3-display "w3-parse") - (autoload 'w3-do-setup "w3" "" t)) - -(defun gnus-article-treat-html () - "Render HTML." - (interactive) - (let ((cbuf (current-buffer))) - (set-buffer gnus-article-buffer) - (let (buf buffer-read-only b e) - (w3-do-setup) - (goto-char (point-min)) - (narrow-to-region - (if (search-forward "\n\n" nil t) - (setq b (point)) - (point-max)) - (setq e (point-max))) - (nnheader-temp-write nil - (insert-buffer-substring gnus-article-buffer b e) - (require 'url) - (save-window-excursion - (w3-region (point-min) (point-max)) - (setq buf (buffer-substring-no-properties (point-min) (point-max))))) - (when buf - (delete-region (point-min) (point-max)) - (insert buf)) - (widen) - (goto-char (point-min)) - (set-window-start (get-buffer-window (current-buffer)) (point-min)) - (set-buffer cbuf)))) - -(defun gnus-article-hidden-arg () - "Return the current prefix arg as a number, or 0 if no prefix." - (list (if current-prefix-arg - (prefix-numeric-value current-prefix-arg) - 0))) - -(defun gnus-article-check-hidden-text (type arg) - "Return nil if hiding is necessary. -Arg can be nil or a number. Nil and positive means hide, negative -means show, 0 means toggle." - (save-excursion - (save-restriction - (widen) - (let ((hide (gnus-article-hidden-text-p type))) - (cond - ((or (null arg) - (> arg 0)) - nil) - ((< arg 0) - (gnus-article-show-hidden-text type)) - (t - (if (eq hide 'hidden) - (gnus-article-show-hidden-text type) - nil))))))) - -(defun gnus-article-hidden-text-p (type) - "Say whether the current buffer contains hidden text of type TYPE." - (let ((start (point-min)) - (pos (text-property-any (point-min) (point-max) 'article-type type))) - (while (and pos - (not (get-text-property pos 'invisible))) - (setq pos - (text-property-any (1+ pos) (point-max) 'article-type type))) - (if pos - 'hidden - 'shown))) - -(defun gnus-article-show-hidden-text (type &optional hide) - "Show all hidden text of type TYPE. -If HIDE, hide the text instead." - (save-excursion - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (end (point-min)) - beg) - (while (setq beg (text-property-any end (point-max) 'article-type type)) - (goto-char beg) - (setq end (or - (text-property-not-all beg (point-max) 'article-type type) - (point-max))) - (if hide - (gnus-article-hide-text beg end gnus-hidden-properties) - (gnus-article-unhide-text beg end)) - (goto-char end)) - t))) - -(defconst article-time-units - `((year . ,(* 365.25 24 60 60)) - (week . ,(* 7 24 60 60)) - (day . ,(* 24 60 60)) - (hour . ,(* 60 60)) - (minute . 60) - (second . 1)) - "Mapping from time units to seconds.") - -(defun article-date-ut (&optional type highlight header) - "Convert DATE date to universal time in the current article. -If TYPE is `local', convert to local time; if it is `lapsed', output -how much time has lapsed since DATE." - (interactive (list 'ut t)) - (let* ((header (or header - (mail-header-date gnus-current-headers) - (message-fetch-field "date") - "")) - (date (if (vectorp header) (mail-header-date header) - header)) - (date-regexp "^Date:[ \t]\\|^X-Sent:[ \t]") - (inhibit-point-motion-hooks t) - bface eface) - (when (and date (not (string= date ""))) - (save-excursion - (save-restriction - (nnheader-narrow-to-headers) - (let ((buffer-read-only nil)) - ;; Delete any old Date headers. - (if (re-search-forward date-regexp nil t) - (progn - (setq bface (get-text-property (gnus-point-at-bol) 'face) - eface (get-text-property (1- (gnus-point-at-eol)) - 'face)) - (message-remove-header date-regexp t) - (beginning-of-line)) - (goto-char (point-max))) - (insert (article-make-date-line date type)) - ;; Do highlighting. - (forward-line -1) - (when (looking-at "\\([^:]+\\): *\\(.*\\)$") - (put-text-property (match-beginning 1) (match-end 1) - 'face bface) - (put-text-property (match-beginning 2) (match-end 2) - 'face eface)))))))) - -(defun article-make-date-line (date type) - "Return a DATE line of TYPE." - (cond - ;; Convert to the local timezone. We have to slap a - ;; `condition-case' round the calls to the timezone - ;; functions since they aren't particularly resistant to - ;; buggy dates. - ((eq type 'local) - (concat "Date: " (condition-case () - (timezone-make-date-arpa-standard date) - (error date)) - "\n")) - ;; Convert to Universal Time. - ((eq type 'ut) - (concat "Date: " - (condition-case () - (timezone-make-date-arpa-standard date nil "UT") - (error date)) - "\n")) - ;; Get the original date from the article. - ((eq type 'original) - (concat "Date: " date "\n")) - ;; Let the user define the format. - ((eq type 'user) - (concat - "Date: " - (format-time-string gnus-article-time-format - (ignore-errors - (gnus-encode-date - (timezone-make-date-arpa-standard - date nil "UT")))) - "\n")) - ;; Do an X-Sent lapsed format. - ((eq type 'lapsed) - ;; If the date is seriously mangled, the timezone functions are - ;; liable to bug out, so we ignore all errors. - (let* ((now (current-time)) - (real-time - (ignore-errors - (gnus-time-minus - (gnus-encode-date - (timezone-make-date-arpa-standard - (current-time-string now) - (current-time-zone now) "UT")) - (gnus-encode-date - (timezone-make-date-arpa-standard - date nil "UT"))))) - (real-sec (and real-time - (+ (* (float (car real-time)) 65536) - (cadr real-time)))) - (sec (and real-time (abs real-sec))) - num prev) - (cond - ((null real-time) - "X-Sent: Unknown\n") - ((zerop sec) - "X-Sent: Now\n") - (t - (concat - "X-Sent: " - ;; This is a bit convoluted, but basically we go - ;; through the time units for years, weeks, etc, - ;; and divide things to see whether that results - ;; in positive answers. - (mapconcat - (lambda (unit) - (if (zerop (setq num (ffloor (/ sec (cdr unit))))) - ;; The (remaining) seconds are too few to - ;; be divided into this time unit. - "" - ;; It's big enough, so we output it. - (setq sec (- sec (* num (cdr unit)))) - (prog1 - (concat (if prev ", " "") (int-to-string - (floor num)) - " " (symbol-name (car unit)) - (if (> num 1) "s" "")) - (setq prev t)))) - article-time-units "") - ;; If dates are odd, then it might appear like the - ;; article was sent in the future. - (if (> real-sec 0) - " ago\n" - " in the future\n")))))) - (t - (error "Unknown conversion type: %s" type)))) - -(defun article-date-local (&optional highlight) - "Convert the current article date to the local timezone." - (interactive (list t)) - (article-date-ut 'local highlight)) - -(defun article-date-original (&optional highlight) - "Convert the current article date to what it was originally. -This is only useful if you have used some other date conversion -function and want to see what the date was before converting." - (interactive (list t)) - (article-date-ut 'original highlight)) - -(defun article-date-lapsed (&optional highlight) - "Convert the current article date to time lapsed since it was sent." - (interactive (list t)) - (article-date-ut 'lapsed highlight)) - -(defun article-date-user (&optional highlight) - "Convert the current article date to the user-defined format. -This format is defined by the `gnus-article-time-format' variable." - (interactive (list t)) - (article-date-ut 'user highlight)) - -(defun article-show-all () - "Show all hidden text in the article buffer." - (interactive) - (save-excursion - (let ((buffer-read-only nil)) - (gnus-article-unhide-text (point-min) (point-max))))) - -(defun article-emphasize (&optional arg) - "Emphasize text according to `gnus-emphasis-alist'." - (interactive (gnus-article-hidden-arg)) - (unless (gnus-article-check-hidden-text 'emphasis arg) - (save-excursion - (let ((alist gnus-emphasis-alist) - (buffer-read-only nil) - (props (append '(article-type emphasis) - gnus-hidden-properties)) - regexp elem beg invisible visible face) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (setq beg (point)) - (while (setq elem (pop alist)) - (goto-char beg) - (setq regexp (car elem) - invisible (nth 1 elem) - visible (nth 2 elem) - face (nth 3 elem)) - (while (re-search-forward regexp nil t) - (when (and (match-beginning visible) (match-beginning invisible)) - (gnus-article-hide-text - (match-beginning invisible) (match-end invisible) props) - (gnus-article-unhide-text-type - (match-beginning visible) (match-end visible) 'emphasis) - (gnus-put-text-property-excluding-newlines - (match-beginning visible) (match-end visible) 'face face) - (goto-char (match-end invisible))))))))) - -(defvar gnus-summary-article-menu) -(defvar gnus-summary-post-menu) - -;;; Saving functions. - -(defun gnus-article-save (save-buffer file &optional num) - "Save the currently selected article." - (unless gnus-save-all-headers - ;; Remove headers according to `gnus-saved-headers'. - (let ((gnus-visible-headers - (or gnus-saved-headers gnus-visible-headers)) - (gnus-article-buffer save-buffer)) - (gnus-article-hide-headers 1 t))) - (save-window-excursion - (if (not gnus-default-article-saver) - (error "No default saver is defined") - ;; !!! Magic! The saving functions all save - ;; `gnus-original-article-buffer' (or so they think), but we - ;; bind that variable to our save-buffer. - (set-buffer gnus-article-buffer) - (let* ((gnus-save-article-buffer save-buffer) - (filename - (cond - ((not gnus-prompt-before-saving) 'default) - ((eq gnus-prompt-before-saving 'always) nil) - (t file))) - (gnus-number-of-articles-to-be-saved - (when (eq gnus-prompt-before-saving t) - num))) ; Magic - (set-buffer gnus-summary-buffer) - (funcall gnus-default-article-saver filename))))) - -(defun gnus-read-save-file-name (prompt &optional filename - function group headers variable) - (let ((default-name - (funcall function group headers (symbol-value variable))) - result) - (setq - result - (cond - ((eq filename 'default) - default-name) - ((eq filename t) - default-name) - (filename filename) - (t - (let* ((split-name (gnus-get-split-value gnus-split-methods)) - (prompt - (format prompt - (if (and gnus-number-of-articles-to-be-saved - (> gnus-number-of-articles-to-be-saved 1)) - (format "these %d articles" - gnus-number-of-articles-to-be-saved) - "this article"))) - (file - ;; Let the split methods have their say. - (cond - ;; No split name was found. - ((null split-name) - (read-file-name - (concat prompt " (default " - (file-name-nondirectory default-name) ") ") - (file-name-directory default-name) - default-name)) - ;; A single group name is returned. - ((stringp split-name) - (setq default-name - (funcall function split-name headers - (symbol-value variable))) - (read-file-name - (concat prompt " (default " - (file-name-nondirectory default-name) ") ") - (file-name-directory default-name) - default-name)) - ;; A single split name was found - ((= 1 (length split-name)) - (let* ((name (expand-file-name - (car split-name) gnus-article-save-directory)) - (dir (cond ((file-directory-p name) - (file-name-as-directory name)) - ((file-exists-p name) name) - (t gnus-article-save-directory)))) - (read-file-name - (concat prompt " (default " name ") ") - dir name))) - ;; A list of splits was found. - (t - (setq split-name (nreverse split-name)) - (let (result) - (let ((file-name-history - (nconc split-name file-name-history))) - (setq result - (expand-file-name - (read-file-name - (concat prompt " (`M-p' for defaults) ") - gnus-article-save-directory - (car split-name)) - gnus-article-save-directory))) - (car (push result file-name-history))))))) - ;; Create the directory. - (gnus-make-directory (file-name-directory file)) - ;; If we have read a directory, we append the default file name. - (when (file-directory-p file) - (setq file (concat (file-name-as-directory file) - (file-name-nondirectory default-name)))) - ;; Possibly translate some characters. - (nnheader-translate-file-chars file))))) - (gnus-make-directory (file-name-directory result)) - (set variable result))) - -(defun gnus-article-archive-name (group) - "Return the first instance of an \"Archive-name\" in the current buffer." - (let ((case-fold-search t)) - (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t) - (nnheader-concat gnus-article-save-directory - (match-string 1))))) - -(defun gnus-article-nndoc-name (group) - "If GROUP is an nndoc group, return the name of the parent group." - (when (eq (car (gnus-find-method-for-group group)) 'nndoc) - (gnus-group-get-parameter group 'save-article-group))) - -(defun gnus-summary-save-in-rmail (&optional filename) - "Append this article to Rmail file. -Optional argument FILENAME specifies file name. -Directory to save to is default to `gnus-article-save-directory'." - (interactive) - (gnus-set-global-variables) - (setq filename (gnus-read-save-file-name - "Save %s in rmail file:" filename - gnus-rmail-save-name gnus-newsgroup-name - gnus-current-headers 'gnus-newsgroup-last-rmail)) - (gnus-eval-in-buffer-window gnus-save-article-buffer - (save-excursion - (save-restriction - (widen) - (gnus-output-to-rmail filename))))) - -(defun gnus-summary-save-in-mail (&optional filename) - "Append this article to Unix mail file. -Optional argument FILENAME specifies file name. -Directory to save to is default to `gnus-article-save-directory'." - (interactive) - (gnus-set-global-variables) - (setq filename (gnus-read-save-file-name - "Save %s in Unix mail file:" filename - gnus-mail-save-name gnus-newsgroup-name - gnus-current-headers 'gnus-newsgroup-last-mail)) - (gnus-eval-in-buffer-window gnus-save-article-buffer - (save-excursion - (save-restriction - (widen) - (if (and (file-readable-p filename) - (mail-file-babyl-p filename)) - (gnus-output-to-rmail filename t) - (gnus-output-to-mail filename)))))) - -(defun gnus-summary-save-in-file (&optional filename overwrite) - "Append this article to file. -Optional argument FILENAME specifies file name. -Directory to save to is default to `gnus-article-save-directory'." - (interactive) - (gnus-set-global-variables) - (setq filename (gnus-read-save-file-name - "Save %s in file:" filename - gnus-file-save-name gnus-newsgroup-name - gnus-current-headers 'gnus-newsgroup-last-file)) - (gnus-eval-in-buffer-window gnus-save-article-buffer - (save-excursion - (save-restriction - (widen) - (when (and overwrite - (file-exists-p filename)) - (delete-file filename)) - (gnus-output-to-file filename))))) - -(defun gnus-summary-write-to-file (&optional filename) - "Write this article to a file. -Optional argument FILENAME specifies file name. -The directory to save in defaults to `gnus-article-save-directory'." - (interactive) - (gnus-summary-save-in-file nil t)) - -(defun gnus-summary-save-body-in-file (&optional filename) - "Append this article body to a file. -Optional argument FILENAME specifies file name. -The directory to save in defaults to `gnus-article-save-directory'." - (interactive) - (gnus-set-global-variables) - (setq filename (gnus-read-save-file-name - "Save %s body in file:" filename - gnus-file-save-name gnus-newsgroup-name - gnus-current-headers 'gnus-newsgroup-last-file)) - (gnus-eval-in-buffer-window gnus-save-article-buffer - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (narrow-to-region (point) (point-max))) - (gnus-output-to-file filename))))) - -(defun gnus-summary-save-in-pipe (&optional command) - "Pipe this article to subprocess." - (interactive) - (gnus-set-global-variables) - (setq command - (cond ((eq command 'default) - gnus-last-shell-command) - (command command) - (t (read-string - (format - "Shell command on %s: " - (if (and gnus-number-of-articles-to-be-saved - (> gnus-number-of-articles-to-be-saved 1)) - (format "these %d articles" - gnus-number-of-articles-to-be-saved) - "this article")) - gnus-last-shell-command)))) - (when (string-equal command "") - (setq command gnus-last-shell-command)) - (gnus-eval-in-buffer-window gnus-article-buffer - (save-restriction - (widen) - (shell-command-on-region (point-min) (point-max) command nil))) - (setq gnus-last-shell-command command)) - -;;; Article file names when saving. - -(defun gnus-capitalize-newsgroup (newsgroup) - "Capitalize NEWSGROUP name." - (when (not (zerop (length newsgroup))) - (concat (char-to-string (upcase (aref newsgroup 0))) - (substring newsgroup 1)))) - -(defun gnus-Numeric-save-name (newsgroup headers &optional last-file) - "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. -If variable `gnus-use-long-file-name' is non-nil, it is ~/News/News.group/num. -Otherwise, it is like ~/News/news/group/num." - (let ((default - (expand-file-name - (concat (if (gnus-use-long-file-name 'not-save) - (gnus-capitalize-newsgroup newsgroup) - (gnus-newsgroup-directory-form newsgroup)) - "/" (int-to-string (mail-header-number headers))) - gnus-article-save-directory))) - (if (and last-file - (string-equal (file-name-directory default) - (file-name-directory last-file)) - (string-match "^[0-9]+$" (file-name-nondirectory last-file))) - default - (or last-file default)))) - -(defun gnus-numeric-save-name (newsgroup headers &optional last-file) - "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. -If variable `gnus-use-long-file-name' is non-nil, it is -~/News/news.group/num. Otherwise, it is like ~/News/news/group/num." - (let ((default - (expand-file-name - (concat (if (gnus-use-long-file-name 'not-save) - newsgroup - (gnus-newsgroup-directory-form newsgroup)) - "/" (int-to-string (mail-header-number headers))) - gnus-article-save-directory))) - (if (and last-file - (string-equal (file-name-directory default) - (file-name-directory last-file)) - (string-match "^[0-9]+$" (file-name-nondirectory last-file))) - default - (or last-file default)))) - -(defun gnus-Plain-save-name (newsgroup headers &optional last-file) - "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. -If variable `gnus-use-long-file-name' is non-nil, it is -~/News/News.group. Otherwise, it is like ~/News/news/group/news." - (or last-file - (expand-file-name - (if (gnus-use-long-file-name 'not-save) - (gnus-capitalize-newsgroup newsgroup) - (concat (gnus-newsgroup-directory-form newsgroup) "/news")) - gnus-article-save-directory))) - -(defun gnus-plain-save-name (newsgroup headers &optional last-file) - "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. -If variable `gnus-use-long-file-name' is non-nil, it is -~/News/news.group. Otherwise, it is like ~/News/news/group/news." - (or last-file - (expand-file-name - (if (gnus-use-long-file-name 'not-save) - newsgroup - (concat (gnus-newsgroup-directory-form newsgroup) "/news")) - gnus-article-save-directory))) - -(eval-and-compile - (mapcar - (lambda (func) - (let (afunc gfunc) - (if (consp func) - (setq afunc (car func) - gfunc (cdr func)) - (setq afunc func - gfunc (intern (format "gnus-%s" func)))) - (fset gfunc - (if (not (fboundp afunc)) - nil - `(lambda (&optional interactive &rest args) - ,(documentation afunc t) - (interactive (list t)) - (save-excursion - (set-buffer gnus-article-buffer) - (if interactive - (call-interactively ',afunc) - (apply ',afunc args)))))))) - '(article-hide-headers - article-hide-boring-headers - article-treat-overstrike - (article-fill . gnus-article-word-wrap) - article-remove-cr - article-display-x-face - article-de-quoted-unreadable - article-mime-decode-quoted-printable - article-hide-pgp - article-hide-pem - article-hide-signature - article-remove-trailing-blank-lines - article-strip-leading-blank-lines - article-strip-multiple-blank-lines - article-strip-leading-space - article-strip-blank-lines - article-date-local - article-date-original - article-date-ut - article-date-user - article-date-lapsed - article-emphasize - (article-show-all . gnus-article-show-all-headers)))) - -;;; -;;; Gnus article mode -;;; - -(put 'gnus-article-mode 'mode-class 'special) - -(gnus-define-keys gnus-article-mode-map - " " gnus-article-goto-next-page - "\177" gnus-article-goto-prev-page - [delete] gnus-article-goto-prev-page - "\C-c^" gnus-article-refer-article - "h" gnus-article-show-summary - "s" gnus-article-show-summary - "\C-c\C-m" gnus-article-mail - "?" gnus-article-describe-briefly - gnus-mouse-2 gnus-article-push-button - "\r" gnus-article-press-button - "\t" gnus-article-next-button - "\M-\t" gnus-article-prev-button - "e" gnus-article-edit - "<" beginning-of-buffer - ">" end-of-buffer - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug - - "\C-d" gnus-article-read-summary-keys - "\M-*" gnus-article-read-summary-keys - "\M-#" gnus-article-read-summary-keys - "\M-^" gnus-article-read-summary-keys - "\M-g" gnus-article-read-summary-keys) - -(substitute-key-definition - 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map) - -(defun gnus-article-make-menu-bar () - (gnus-turn-off-edit-menu 'article) - (unless (boundp 'gnus-article-article-menu) - (easy-menu-define - gnus-article-article-menu gnus-article-mode-map "" - '("Article" - ["Scroll forwards" gnus-article-goto-next-page t] - ["Scroll backwards" gnus-article-goto-prev-page t] - ["Show summary" gnus-article-show-summary t] - ["Fetch Message-ID at point" gnus-article-refer-article t] - ["Mail to address at point" gnus-article-mail t])) - - (easy-menu-define - gnus-article-treatment-menu gnus-article-mode-map "" - '("Treatment" - ["Hide headers" gnus-article-hide-headers t] - ["Hide signature" gnus-article-hide-signature t] - ["Hide citation" gnus-article-hide-citation t] - ["Treat overstrike" gnus-article-treat-overstrike t] - ["Remove carriage return" gnus-article-remove-cr t] - ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t])) - - (when nil - (when (boundp 'gnus-summary-article-menu) - (define-key gnus-article-mode-map [menu-bar commands] - (cons "Commands" gnus-summary-article-menu)))) - - (when (boundp 'gnus-summary-post-menu) - (define-key gnus-article-mode-map [menu-bar post] - (cons "Post" gnus-summary-post-menu))) - - (run-hooks 'gnus-article-menu-hook))) - -(defun gnus-article-mode () - "Major mode for displaying an article. - -All normal editing commands are switched off. - -The following commands are available in addition to all summary mode -commands: -\\ -\\[gnus-article-next-page]\t Scroll the article one page forwards -\\[gnus-article-prev-page]\t Scroll the article one page backwards -\\[gnus-article-refer-article]\t Go to the article referred to by an article id near point -\\[gnus-article-show-summary]\t Display the summary buffer -\\[gnus-article-mail]\t Send a reply to the address near point -\\[gnus-article-describe-briefly]\t Describe the current mode briefly -\\[gnus-info-find-node]\t Go to the Gnus info node" - (interactive) - (when (gnus-visual-p 'article-menu 'menu) - (gnus-article-make-menu-bar)) - (kill-all-local-variables) - (gnus-simplify-mode-line) - (setq mode-name "Article") - (setq major-mode 'gnus-article-mode) - (make-local-variable 'minor-mode-alist) - (unless (assq 'gnus-show-mime minor-mode-alist) - (push (list 'gnus-show-mime " MIME") minor-mode-alist)) - (use-local-map gnus-article-mode-map) - (gnus-update-format-specifications nil 'article-mode) - (set (make-local-variable 'page-delimiter) gnus-page-delimiter) - (set (make-local-variable 'gnus-page-broken) nil) - (set (make-local-variable 'gnus-button-marker-list) nil) - (gnus-set-default-directory) - (buffer-disable-undo (current-buffer)) - (setq buffer-read-only t) - (set-syntax-table gnus-article-mode-syntax-table) - (run-hooks 'gnus-article-mode-hook)) - -(defun gnus-article-setup-buffer () - "Initialize the article buffer." - (let* ((name (if gnus-single-article-buffer "*Article*" - (concat "*Article " gnus-newsgroup-name "*"))) - (original - (progn (string-match "\\*Article" name) - (concat " *Original Article" - (substring name (match-end 0)))))) - (setq gnus-article-buffer name) - (setq gnus-original-article-buffer original) - ;; This might be a variable local to the summary buffer. - (unless gnus-single-article-buffer - (save-excursion - (set-buffer gnus-summary-buffer) - (setq gnus-article-buffer name) - (setq gnus-original-article-buffer original) - (gnus-set-global-variables))) - ;; Init original article buffer. - (save-excursion - (set-buffer (get-buffer-create gnus-original-article-buffer)) - (buffer-disable-undo (current-buffer)) - (setq major-mode 'gnus-original-article-mode) - (gnus-add-current-to-buffer-list) - (make-local-variable 'gnus-original-article)) - (if (get-buffer name) - (save-excursion - (set-buffer name) - (buffer-disable-undo (current-buffer)) - (setq buffer-read-only t) - (gnus-add-current-to-buffer-list) - (unless (eq major-mode 'gnus-article-mode) - (gnus-article-mode)) - (current-buffer)) - (save-excursion - (set-buffer (get-buffer-create name)) - (gnus-add-current-to-buffer-list) - (gnus-article-mode) - (make-local-variable 'gnus-summary-buffer) - (current-buffer))))) - -;; Set article window start at LINE, where LINE is the number of lines -;; from the head of the article. -(defun gnus-article-set-window-start (&optional line) - (set-window-start - (get-buffer-window gnus-article-buffer t) - (save-excursion - (set-buffer gnus-article-buffer) - (goto-char (point-min)) - (if (not line) - (point-min) - (gnus-message 6 "Moved to bookmark") - (search-forward "\n\n" nil t) - (forward-line line) - (point))))) - -(defun gnus-article-prepare (article &optional all-headers header) - "Prepare ARTICLE in article mode buffer. -ARTICLE should either be an article number or a Message-ID. -If ARTICLE is an id, HEADER should be the article headers. -If ALL-HEADERS is non-nil, no headers are hidden." - (save-excursion - ;; Make sure we start in a summary buffer. - (unless (eq major-mode 'gnus-summary-mode) - (set-buffer gnus-summary-buffer)) - (setq gnus-summary-buffer (current-buffer)) - ;; Make sure the connection to the server is alive. - (unless (gnus-server-opened - (gnus-find-method-for-group gnus-newsgroup-name)) - (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) - (gnus-request-group gnus-newsgroup-name t)) - (let* ((gnus-article (if header (mail-header-number header) article)) - (summary-buffer (current-buffer)) - (internal-hook gnus-article-internal-prepare-hook) - (group gnus-newsgroup-name) - result) - (save-excursion - (gnus-article-setup-buffer) - (set-buffer gnus-article-buffer) - ;; Deactivate active regions. - (when (and (boundp 'transient-mark-mode) - transient-mark-mode) - (setq mark-active nil)) - (if (not (setq result (let ((buffer-read-only nil)) - (gnus-request-article-this-buffer - article group)))) - ;; There is no such article. - (save-excursion - (when (and (numberp article) - (not (memq article gnus-newsgroup-sparse))) - (setq gnus-article-current - (cons gnus-newsgroup-name article)) - (set-buffer gnus-summary-buffer) - (setq gnus-current-article article) - (gnus-summary-mark-article article gnus-canceled-mark)) - (unless (memq article gnus-newsgroup-sparse) - (gnus-error - 1 "No such article (may have expired or been canceled)"))) - (if (or (eq result 'pseudo) (eq result 'nneething)) - (progn - (save-excursion - (set-buffer summary-buffer) - (setq gnus-last-article gnus-current-article - gnus-newsgroup-history (cons gnus-current-article - gnus-newsgroup-history) - gnus-current-article 0 - gnus-current-headers nil - gnus-article-current nil) - (if (eq result 'nneething) - (gnus-configure-windows 'summary) - (gnus-configure-windows 'article)) - (gnus-set-global-variables)) - (gnus-set-mode-line 'article)) - ;; The result from the `request' was an actual article - - ;; or at least some text that is now displayed in the - ;; article buffer. - (when (and (numberp article) - (not (eq article gnus-current-article))) - ;; Seems like a new article has been selected. - ;; `gnus-current-article' must be an article number. - (save-excursion - (set-buffer summary-buffer) - (setq gnus-last-article gnus-current-article - gnus-newsgroup-history (cons gnus-current-article - gnus-newsgroup-history) - gnus-current-article article - gnus-current-headers - (gnus-summary-article-header gnus-current-article) - gnus-article-current - (cons gnus-newsgroup-name gnus-current-article)) - (unless (vectorp gnus-current-headers) - (setq gnus-current-headers nil)) - (gnus-summary-show-thread) - (run-hooks 'gnus-mark-article-hook) - (gnus-set-mode-line 'summary) - (when (gnus-visual-p 'article-highlight 'highlight) - (run-hooks 'gnus-visual-mark-article-hook)) - ;; Set the global newsgroup variables here. - ;; Suggested by Jim Sisolak - ;; . - (gnus-set-global-variables) - (setq gnus-have-all-headers - (or all-headers gnus-show-all-headers)) - (and gnus-use-cache - (vectorp (gnus-summary-article-header article)) - (gnus-cache-possibly-enter-article - group article - (gnus-summary-article-header article) - (memq article gnus-newsgroup-marked) - (memq article gnus-newsgroup-dormant) - (memq article gnus-newsgroup-unreads))))) - (when (or (numberp article) - (stringp article)) - ;; Hooks for getting information from the article. - ;; This hook must be called before being narrowed. - (let (buffer-read-only) - (run-hooks 'internal-hook) - (run-hooks 'gnus-article-prepare-hook) - ;; Decode MIME message. - (when gnus-show-mime - (if (or (not gnus-strict-mime) - (gnus-fetch-field "Mime-Version")) - (funcall gnus-show-mime-method) - (funcall gnus-decode-encoded-word-method))) - ;; Perform the article display hooks. - (run-hooks 'gnus-article-display-hook)) - ;; Do page break. - (goto-char (point-min)) - (setq gnus-page-broken - (when gnus-break-pages - (gnus-narrow-to-page) - t))) - (gnus-set-mode-line 'article) - (gnus-configure-windows 'article) - (goto-char (point-min)) - t)))))) - -(defun gnus-article-wash-status () - "Return a string which display status of article washing." - (save-excursion - (set-buffer gnus-article-buffer) - (let ((cite (gnus-article-hidden-text-p 'cite)) - (headers (gnus-article-hidden-text-p 'headers)) - (boring (gnus-article-hidden-text-p 'boring-headers)) - (pgp (gnus-article-hidden-text-p 'pgp)) - (pem (gnus-article-hidden-text-p 'pem)) - (signature (gnus-article-hidden-text-p 'signature)) - (overstrike (gnus-article-hidden-text-p 'overstrike)) - (emphasis (gnus-article-hidden-text-p 'emphasis)) - (mime gnus-show-mime)) - (format "%c%c%c%c%c%c%c" - (if cite ?c ? ) - (if (or headers boring) ?h ? ) - (if (or pgp pem) ?p ? ) - (if signature ?s ? ) - (if overstrike ?o ? ) - (if mime ?m ? ) - (if emphasis ?e ? ))))) - -(defun gnus-article-hide-headers-if-wanted () - "Hide unwanted headers if `gnus-have-all-headers' is nil. -Provided for backwards compatibility." - (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers) - gnus-inhibit-hiding - (gnus-article-hide-headers))) - -;;; Article savers. - -(defun gnus-output-to-file (file-name) - "Append the current article to a file named FILE-NAME." - (let ((artbuf (current-buffer))) - (nnheader-temp-write nil - (insert-buffer-substring artbuf) - ;; Append newline at end of the buffer as separator, and then - ;; save it to file. - (goto-char (point-max)) - (insert "\n") - (append-to-file (point-min) (point-max) file-name) - t))) - -(defun gnus-narrow-to-page (&optional arg) - "Narrow the article buffer to a page. -If given a numerical ARG, move forward ARG pages." - (interactive "P") - (setq arg (if arg (prefix-numeric-value arg) 0)) - (save-excursion - (set-buffer gnus-article-buffer) - (goto-char (point-min)) - (widen) - ;; Remove any old next/prev buttons. - (when (gnus-visual-p 'page-marker) - (let ((buffer-read-only nil)) - (gnus-remove-text-with-property 'gnus-prev) - (gnus-remove-text-with-property 'gnus-next))) - (when - (cond ((< arg 0) - (re-search-backward page-delimiter nil 'move (1+ (abs arg)))) - ((> arg 0) - (re-search-forward page-delimiter nil 'move arg))) - (goto-char (match-end 0))) - (narrow-to-region - (point) - (if (re-search-forward page-delimiter nil 'move) - (match-beginning 0) - (point))) - (when (and (gnus-visual-p 'page-marker) - (not (= (point-min) 1))) - (save-excursion - (goto-char (point-min)) - (gnus-insert-prev-page-button))) - (when (and (gnus-visual-p 'page-marker) - (< (+ (point-max) 2) (buffer-size))) - (save-excursion - (goto-char (point-max)) - (gnus-insert-next-page-button))))) - -;; Article mode commands - -(defun gnus-article-goto-next-page () - "Show the next page of the article." - (interactive) - (when (gnus-article-next-page) - (goto-char (point-min)) - (gnus-article-read-summary-keys nil (gnus-character-to-event ?n)))) - -(defun gnus-article-goto-prev-page () - "Show the next page of the article." - (interactive) - (if (bobp) (gnus-article-read-summary-keys nil (gnus-character-to-event ?p)) - (gnus-article-prev-page nil))) - -(defun gnus-article-next-page (&optional lines) - "Show the next page of the current article. -If end of article, return non-nil. Otherwise return nil. -Argument LINES specifies lines to be scrolled up." - (interactive "p") - (move-to-window-line -1) - (if (save-excursion - (end-of-line) - (and (pos-visible-in-window-p) ;Not continuation line. - (eobp))) - ;; Nothing in this page. - (if (or (not gnus-page-broken) - (save-excursion - (save-restriction - (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer? - t ;Nothing more. - (gnus-narrow-to-page 1) ;Go to next page. - nil) - ;; More in this page. - (let ((scroll-in-place nil)) - (condition-case () - (scroll-up lines) - (end-of-buffer - ;; Long lines may cause an end-of-buffer error. - (goto-char (point-max))))) - (move-to-window-line 0) - nil)) - -(defun gnus-article-prev-page (&optional lines) - "Show previous page of current article. -Argument LINES specifies lines to be scrolled down." - (interactive "p") - (move-to-window-line 0) - (if (and gnus-page-broken - (bobp) - (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer? - (progn - (gnus-narrow-to-page -1) ;Go to previous page. - (goto-char (point-max)) - (recenter -1)) - (let ((scroll-in-place nil)) - (prog1 - (condition-case () - (scroll-down lines) - (beginning-of-buffer - (goto-char (point-min)))) - (move-to-window-line 0))))) - -(defun gnus-article-refer-article () - "Read article specified by message-id around point." - (interactive) - (let ((point (point))) - (search-forward ">" nil t) ;Move point to end of "<....>". - (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t) - (let ((message-id (match-string 1))) - (goto-char point) - (set-buffer gnus-summary-buffer) - (gnus-summary-refer-article message-id)) - (goto-char (point)) - (error "No references around point")))) - -(defun gnus-article-show-summary () - "Reconfigure windows to show summary buffer." - (interactive) - (if (not (gnus-buffer-live-p gnus-summary-buffer)) - (error "There is no summary buffer for this article buffer") - (gnus-configure-windows 'article) - (gnus-summary-goto-subject gnus-current-article))) - -(defun gnus-article-describe-briefly () - "Describe article mode commands briefly." - (interactive) - (gnus-message 6 - (substitute-command-keys "\\\\[gnus-article-goto-next-page]:Next page \\[gnus-article-goto-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help"))) - -(defun gnus-article-summary-command () - "Execute the last keystroke in the summary buffer." - (interactive) - (let ((obuf (current-buffer)) - (owin (current-window-configuration)) - func) - (switch-to-buffer gnus-summary-buffer 'norecord) - (setq func (lookup-key (current-local-map) (this-command-keys))) - (call-interactively func) - (set-buffer obuf) - (set-window-configuration owin) - (set-window-point (get-buffer-window (current-buffer)) (point)))) - -(defun gnus-article-summary-command-nosave () - "Execute the last keystroke in the summary buffer." - (interactive) - (let (func) - (pop-to-buffer gnus-summary-buffer 'norecord) - (setq func (lookup-key (current-local-map) (this-command-keys))) - (call-interactively func))) - -(defun gnus-article-read-summary-keys (&optional arg key not-restore-window) - "Read a summary buffer key sequence and execute it from the article buffer." - (interactive "P") - (let ((nosaves - '("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F" - "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP" - "=" "^" "\M-^" "|")) - (nosave-but-article - '("A\r")) - (nosave-in-article - '("\C-d")) - keys) - (save-excursion - (set-buffer gnus-summary-buffer) - (let (gnus-pick-mode) - (push (or key last-command-event) unread-command-events) - (setq keys (read-key-sequence nil)))) - (message "") - - (if (or (member keys nosaves) - (member keys nosave-but-article) - (member keys nosave-in-article)) - (let (func) - (save-window-excursion - (pop-to-buffer gnus-summary-buffer 'norecord) - ;; We disable the pick minor mode commands. - (let (gnus-pick-mode) - (setq func (lookup-key (current-local-map) keys)))) - (if (not func) - (ding) - (unless (member keys nosave-in-article) - (set-buffer gnus-summary-buffer)) - (call-interactively func)) - (when (member keys nosave-but-article) - (pop-to-buffer gnus-article-buffer 'norecord))) - ;; These commands should restore window configuration. - (let ((obuf (current-buffer)) - (owin (current-window-configuration)) - (opoint (point)) - func in-buffer) - (if not-restore-window - (pop-to-buffer gnus-summary-buffer 'norecord) - (switch-to-buffer gnus-summary-buffer 'norecord)) - (setq in-buffer (current-buffer)) - ;; We disable the pick minor mode commands. - (if (setq func (let (gnus-pick-mode) - (lookup-key (current-local-map) keys))) - (call-interactively func) - (ding)) - (when (eq in-buffer (current-buffer)) - (set-buffer obuf) - (unless not-restore-window - (set-window-configuration owin)) - (set-window-point (get-buffer-window (current-buffer)) opoint)))))) - -(defun gnus-article-hide (&optional arg force) - "Hide all the gruft in the current article. -This means that PGP stuff, signatures, cited text and (some) -headers will be hidden. -If given a prefix, show the hidden text instead." - (interactive (list current-prefix-arg 'force)) - (gnus-article-hide-headers arg) - (gnus-article-hide-pgp arg) - (gnus-article-hide-citation-maybe arg force) - (gnus-article-hide-signature arg)) - -(defun gnus-article-maybe-highlight () - "Do some article highlighting if `article-visual' is non-nil." - (when (gnus-visual-p 'article-highlight 'highlight) - (gnus-article-highlight-some))) - -(defun gnus-request-article-this-buffer (article group) - "Get an article and insert it into this buffer." - (let (do-update-line) - (prog1 - (save-excursion - (erase-buffer) - (gnus-kill-all-overlays) - (setq group (or group gnus-newsgroup-name)) - - ;; Open server if it has closed. - (gnus-check-server (gnus-find-method-for-group group)) - - ;; Using `gnus-request-article' directly will insert the article into - ;; `nntp-server-buffer' - so we'll save some time by not having to - ;; copy it from the server buffer into the article buffer. - - ;; We only request an article by message-id when we do not have the - ;; headers for it, so we'll have to get those. - (when (stringp article) - (let ((gnus-override-method gnus-refer-article-method)) - (gnus-read-header article))) - - ;; If the article number is negative, that means that this article - ;; doesn't belong in this newsgroup (possibly), so we find its - ;; message-id and request it by id instead of number. - (when (and (numberp article) - gnus-summary-buffer - (get-buffer gnus-summary-buffer) - (buffer-name (get-buffer gnus-summary-buffer))) - (save-excursion - (set-buffer gnus-summary-buffer) - (let ((header (gnus-summary-article-header article))) - (when (< article 0) - (cond - ((memq article gnus-newsgroup-sparse) - ;; This is a sparse gap article. - (setq do-update-line article) - (setq article (mail-header-id header)) - (let ((gnus-override-method gnus-refer-article-method)) - (gnus-read-header article)) - (setq gnus-newsgroup-sparse - (delq article gnus-newsgroup-sparse))) - ((vectorp header) - ;; It's a real article. - (setq article (mail-header-id header))) - (t - ;; It is an extracted pseudo-article. - (setq article 'pseudo) - (gnus-request-pseudo-article header)))) - - (let ((method (gnus-find-method-for-group - gnus-newsgroup-name))) - (if (not (eq (car method) 'nneething)) - () - (let ((dir (concat (file-name-as-directory (nth 1 method)) - (mail-header-subject header)))) - (when (file-directory-p dir) - (setq article 'nneething) - (gnus-group-enter-directory dir)))))))) - - (cond - ;; Refuse to select canceled articles. - ((and (numberp article) - gnus-summary-buffer - (get-buffer gnus-summary-buffer) - (buffer-name (get-buffer gnus-summary-buffer)) - (eq (cdr (save-excursion - (set-buffer gnus-summary-buffer) - (assq article gnus-newsgroup-reads))) - gnus-canceled-mark)) - nil) - ;; We first check `gnus-original-article-buffer'. - ((and (get-buffer gnus-original-article-buffer) - (numberp article) - (save-excursion - (set-buffer gnus-original-article-buffer) - (and (equal (car gnus-original-article) group) - (eq (cdr gnus-original-article) article)))) - (insert-buffer-substring gnus-original-article-buffer) - 'article) - ;; Check the backlog. - ((and gnus-keep-backlog - (gnus-backlog-request-article group article (current-buffer))) - 'article) - ;; Check asynchronous pre-fetch. - ((gnus-async-request-fetched-article group article (current-buffer)) - (gnus-async-prefetch-next group article gnus-summary-buffer) - 'article) - ;; Check the cache. - ((and gnus-use-cache - (numberp article) - (gnus-cache-request-article article group)) - 'article) - ;; Get the article and put into the article buffer. - ((or (stringp article) (numberp article)) - (let ((gnus-override-method - (and (stringp article) gnus-refer-article-method)) - (buffer-read-only nil)) - (erase-buffer) - (gnus-kill-all-overlays) - (when (gnus-request-article article group (current-buffer)) - (when (numberp article) - (gnus-async-prefetch-next group article gnus-summary-buffer) - (when gnus-keep-backlog - (gnus-backlog-enter-article - group article (current-buffer)))) - 'article))) - ;; It was a pseudo. - (t article))) - - ;; Take the article from the original article buffer - ;; and place it in the buffer it's supposed to be in. - (when (and (get-buffer gnus-article-buffer) - ;;(numberp article) - (equal (buffer-name (current-buffer)) - (buffer-name (get-buffer gnus-article-buffer)))) - (save-excursion - (if (get-buffer gnus-original-article-buffer) - (set-buffer (get-buffer gnus-original-article-buffer)) - (set-buffer (get-buffer-create gnus-original-article-buffer)) - (buffer-disable-undo (current-buffer)) - (setq major-mode 'gnus-original-article-mode) - (setq buffer-read-only t) - (gnus-add-current-to-buffer-list)) - (let (buffer-read-only) - (erase-buffer) - (insert-buffer-substring gnus-article-buffer)) - (setq gnus-original-article (cons group article)))) - - ;; Update sparse articles. - (when (and do-update-line - (or (numberp article) - (stringp article))) - (let ((buf (current-buffer))) - (set-buffer gnus-summary-buffer) - (gnus-summary-update-article do-update-line) - (gnus-summary-goto-subject do-update-line nil t) - (set-window-point (get-buffer-window (current-buffer) t) - (point)) - (set-buffer buf)))))) - -;;; -;;; Article editing -;;; - -(defcustom gnus-article-edit-mode-hook nil - "Hook run in article edit mode buffers." - :group 'gnus-article-various - :type 'hook) - -(defvar gnus-article-edit-done-function nil) - -(defvar gnus-article-edit-mode-map nil) - -(unless gnus-article-edit-mode-map - (setq gnus-article-edit-mode-map (copy-keymap text-mode-map)) - - (gnus-define-keys gnus-article-edit-mode-map - "\C-c\C-c" gnus-article-edit-done - "\C-c\C-k" gnus-article-edit-exit) - - (gnus-define-keys (gnus-article-edit-wash-map - "\C-c\C-w" gnus-article-edit-mode-map) - "f" gnus-article-edit-full-stops)) - -(defun gnus-article-edit-mode () - "Major mode for editing articles. -This is an extended text-mode. - -\\{gnus-article-edit-mode-map}" - (interactive) - (kill-all-local-variables) - (setq major-mode 'gnus-article-edit-mode) - (setq mode-name "Article Edit") - (use-local-map gnus-article-edit-mode-map) - (make-local-variable 'gnus-article-edit-done-function) - (make-local-variable 'gnus-prev-winconf) - (setq buffer-read-only nil) - (buffer-enable-undo) - (widen) - (run-hooks 'text-mode 'gnus-article-edit-mode-hook)) - -(defun gnus-article-edit (&optional force) - "Edit the current article. -This will have permanent effect only in mail groups. -If FORCE is non-nil, allow editing of articles even in read-only -groups." - (interactive "P") - (when (and (not force) - (gnus-group-read-only-p)) - (error "The current newsgroup does not support article editing")) - (gnus-article-edit-article - `(lambda () - (gnus-summary-edit-article-done - ,(or (mail-header-references gnus-current-headers) "") - ,(gnus-group-read-only-p) ,gnus-summary-buffer)))) - -(defun gnus-article-edit-article (exit-func) - "Start editing the contents of the current article buffer." - (let ((winconf (current-window-configuration))) - (set-buffer gnus-article-buffer) - (gnus-article-edit-mode) - (gnus-set-text-properties (point-min) (point-max) nil) - (gnus-configure-windows 'edit-article) - (setq gnus-article-edit-done-function exit-func) - (setq gnus-prev-winconf winconf) - (gnus-message 6 "C-c C-c to end edits"))) - -(defun gnus-article-edit-done () - "Update the article edits and exit." - (interactive) - (let ((func gnus-article-edit-done-function) - (buf (current-buffer)) - (start (window-start))) - (gnus-article-edit-exit) - (save-excursion - (set-buffer buf) - (let ((buffer-read-only nil)) - (funcall func))) - (set-buffer buf) - (set-window-start (get-buffer-window buf) start) - (set-window-point (get-buffer-window buf) (point)))) - -(defun gnus-article-edit-exit () - "Exit the article editing without updating." - (interactive) - ;; We remove all text props from the article buffer. - (let ((buf (format "%s" (buffer-string))) - (curbuf (current-buffer)) - (p (point)) - (window-start (window-start))) - (erase-buffer) - (insert buf) - (let ((winconf gnus-prev-winconf)) - (gnus-article-mode) - ;; The cache and backlog have to be flushed somewhat. - (when gnus-use-cache - (gnus-cache-update-article - (car gnus-article-current) (cdr gnus-article-current))) - (when gnus-keep-backlog - (gnus-backlog-remove-article - (car gnus-article-current) (cdr gnus-article-current))) - ;; Flush original article as well. - (save-excursion - (when (get-buffer gnus-original-article-buffer) - (set-buffer gnus-original-article-buffer) - (setq gnus-original-article nil))) - (set-window-configuration winconf) - ;; Tippy-toe some to make sure that point remains where it was. - (let ((buf (current-buffer))) - (set-buffer curbuf) - (set-window-start (get-buffer-window (current-buffer)) window-start) - (goto-char p) - (set-buffer buf))))) - -(defun gnus-article-edit-full-stops () - "Interactively repair spacing at end of sentences." - (interactive) - (save-excursion - (goto-char (point-min)) - (search-forward-regexp "^$" nil t) - (let ((case-fold-search nil)) - (query-replace-regexp "\\([.!?][])}]* \\)\\([[({A-Z]\\)" "\\1 \\2")))) - -;;; -;;; Article highlights -;;; - -;; Written by Per Abrahamsen . - -;;; Internal Variables: - -(defcustom gnus-button-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?\\([-a-zA-Z0-9_=!?#$@~`%&*+|\\/:;.,]\\|\\w\\)+\\([-a-zA-Z0-9_=#$@~`%&*+|\\/]\\|\\w\\)" - "Regular expression that matches URLs." - :group 'gnus-article-buttons - :type 'regexp) - -(defcustom gnus-button-alist - `(("<\\(url: ?\\)?news:\\([^>\n\t ]*@[^>\n\t ]*\\)>" 0 t - gnus-button-message-id 2) - ("\\bnews:\\([^>\n\t ]*@[^>\n\t ]*\\)" 0 t gnus-button-message-id 1) - ("\\(\\b<\\(url: ?\\)?news:\\(//\\)?\\([^>\n\t ]*\\)>\\)" 1 t - gnus-button-fetch-group 4) - ("\\bnews:\\(//\\)?\\([^>\n\t ]+\\)" 0 t gnus-button-fetch-group 2) - ("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 - t gnus-button-message-id 3) - ("\\( \n\t]+\\)>" 0 t gnus-url-mailto 1) - ("\\bmailto:\\([^ \n\t]+\\)" 0 t gnus-url-mailto 2) - ;; This is how URLs _should_ be embedded in text... - ("]*\\)>" 0 t gnus-button-embedded-url 1) - ;; Raw URLs. - (,gnus-button-url-regexp 0 t gnus-button-url 0)) - "Alist of regexps matching buttons in article bodies. - -Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where -REGEXP: is the string matching text around the button, -BUTTON: is the number of the regexp grouping actually matching the button, -FORM: is a lisp expression which must eval to true for the button to -be added, -CALLBACK: is the function to call when the user push this button, and each -PAR: is a number of a regexp grouping whose text will be passed to CALLBACK. - -CALLBACK can also be a variable, in that case the value of that -variable it the real callback function." - :group 'gnus-article-buttons - :type '(repeat (list regexp - (integer :tag "Button") - (sexp :tag "Form") - (function :tag "Callback") - (repeat :tag "Par" - :inline t - (integer :tag "Regexp group"))))) - -(defcustom gnus-header-button-alist - `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>" - 0 t gnus-button-message-id 0) - ("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$" 1 t gnus-button-reply 1) - ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+" - 0 t gnus-button-mailto 0) - ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t gnus-button-url 0) - ("^Subject:" ,gnus-button-url-regexp 0 t gnus-button-url 0) - ("^[^:]+:" ,gnus-button-url-regexp 0 t gnus-button-url 0) - ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t - gnus-button-message-id 3)) - "Alist of headers and regexps to match buttons in article heads. - -This alist is very similar to `gnus-button-alist', except that each -alist has an additional HEADER element first in each entry: - -\(HEADER REGEXP BUTTON FORM CALLBACK PAR) - -HEADER is a regexp to match a header. For a fuller explanation, see -`gnus-button-alist'." - :group 'gnus-article-buttons - :group 'gnus-article-headers - :type '(repeat (list (regexp :tag "Header") - regexp - (integer :tag "Button") - (sexp :tag "Form") - (function :tag "Callback") - (repeat :tag "Par" - :inline t - (integer :tag "Regexp group"))))) - -(defvar gnus-button-regexp nil) -(defvar gnus-button-marker-list nil) -;; Regexp matching any of the regexps from `gnus-button-alist'. - -(defvar gnus-button-last nil) -;; The value of `gnus-button-alist' when `gnus-button-regexp' was build. - -;;; Commands: - -(defun gnus-article-push-button (event) - "Check text under the mouse pointer for a callback function. -If the text under the mouse pointer has a `gnus-callback' property, -call it with the value of the `gnus-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 'gnus-data)) - (fun (get-text-property pos 'gnus-callback))) - (when fun - (funcall fun data)))) - -(defun gnus-article-press-button () - "Check text at point for a callback function. -If the text at point has a `gnus-callback' property, -call it with the value of the `gnus-data' text property." - (interactive) - (let* ((data (get-text-property (point) 'gnus-data)) - (fun (get-text-property (point) 'gnus-callback))) - (when fun - (funcall fun data)))) - -(defun gnus-article-prev-button (n) - "Move point to N buttons backward. -If N is negative, move forward instead." - (interactive "p") - (gnus-article-next-button (- n))) - -(defun gnus-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) 'gnus-callback) - (goto-char (funcall function (point) 'gnus-callback nil limit))) - ;; Go to the next (or previous) button. - (gnus-goto-char (funcall function (point) 'gnus-callback nil limit)) - ;; Put point at the start of the button. - (when (and backward (not (get-text-property (point) 'gnus-callback))) - (goto-char (funcall function (point) 'gnus-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 gnus-article-highlight (&optional force) - "Highlight current article. -This function calls `gnus-article-highlight-headers', -`gnus-article-highlight-citation', -`gnus-article-highlight-signature', and `gnus-article-add-buttons' to -do the highlighting. See the documentation for those functions." - (interactive (list 'force)) - (gnus-article-highlight-headers) - (gnus-article-highlight-citation force) - (gnus-article-highlight-signature) - (gnus-article-add-buttons force) - (gnus-article-add-buttons-to-head)) - -(defun gnus-article-highlight-some (&optional force) - "Highlight current article. -This function calls `gnus-article-highlight-headers', -`gnus-article-highlight-signature', and `gnus-article-add-buttons' to -do the highlighting. See the documentation for those functions." - (interactive (list 'force)) - (gnus-article-highlight-headers) - (gnus-article-highlight-signature) - (gnus-article-add-buttons)) - -(defun gnus-article-highlight-headers () - "Highlight article headers as specified by `gnus-header-face-alist'." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (save-restriction - (let ((alist gnus-header-face-alist) - (buffer-read-only nil) - (case-fold-search t) - (inhibit-point-motion-hooks t) - entry regexp header-face field-face from hpoints fpoints) - (message-narrow-to-head) - (while (setq entry (pop alist)) - (goto-char (point-min)) - (setq regexp (concat "^\\(" - (if (string-equal "" (nth 0 entry)) - "[^\t ]" - (nth 0 entry)) - "\\)") - header-face (nth 1 entry) - field-face (nth 2 entry)) - (while (and (re-search-forward regexp nil t) - (not (eobp))) - (beginning-of-line) - (setq from (point)) - (unless (search-forward ":" nil t) - (forward-char 1)) - (when (and header-face - (not (memq (point) hpoints))) - (push (point) hpoints) - (gnus-put-text-property from (point) 'face header-face)) - (when (and field-face - (not (memq (setq from (point)) fpoints))) - (push from fpoints) - (if (re-search-forward "^[^ \t]" nil t) - (forward-char -2) - (goto-char (point-max))) - (gnus-put-text-property from (point) 'face field-face)))))))) - -(defun gnus-article-highlight-signature () - "Highlight the signature in an article. -It does this by highlighting everything after -`gnus-signature-separator' using `gnus-signature-face'." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t)) - (save-restriction - (when (and gnus-signature-face - (gnus-article-narrow-to-signature)) - (gnus-overlay-put (gnus-make-overlay (point-min) (point-max)) - 'face gnus-signature-face) - (widen) - (gnus-article-search-signature) - (let ((start (match-beginning 0)) - (end (set-marker (make-marker) (1+ (match-end 0))))) - (gnus-article-add-button start (1- end) 'gnus-signature-toggle - end))))))) - -(defun gnus-button-in-region-p (b e prop) - "Say whether PROP exists in the region." - (text-property-not-all b e prop nil)) - -(defun gnus-article-add-buttons (&optional force) - "Find external references in the article and make buttons of them. -\"External references\" are things like Message-IDs and URLs, as -specified by `gnus-button-alist'." - (interactive (list 'force)) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (case-fold-search t) - (alist gnus-button-alist) - beg entry regexp) - ;; Remove all old markers. - (let (marker entry) - (while (setq marker (pop gnus-button-marker-list)) - (goto-char marker) - (when (setq entry (gnus-button-entry)) - (put-text-property (match-beginning (nth 1 entry)) - (match-end (nth 1 entry)) - 'gnus-callback nil)) - (set-marker marker nil))) - ;; We skip the headers. - (goto-char (point-min)) - (unless (search-forward "\n\n" nil t) - (goto-char (point-max))) - (setq beg (point)) - (while (setq entry (pop alist)) - (setq regexp (car entry)) - (goto-char beg) - (while (re-search-forward regexp nil t) - (let* ((start (and entry (match-beginning (nth 1 entry)))) - (end (and entry (match-end (nth 1 entry)))) - (from (match-beginning 0))) - (when (and (or (eq t (nth 2 entry)) - (eval (nth 2 entry))) - (not (gnus-button-in-region-p - start end 'gnus-callback))) - ;; That optional form returned non-nil, so we add the - ;; button. - (gnus-article-add-button - start end 'gnus-button-push - (car (push (set-marker (make-marker) from) - gnus-button-marker-list)))))))))) - -;; Add buttons to the head of an article. -(defun gnus-article-add-buttons-to-head () - "Add buttons to the head of the article." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (case-fold-search t) - (alist gnus-header-button-alist) - entry beg end) - (nnheader-narrow-to-headers) - (while alist - ;; Each alist entry. - (setq entry (car alist) - alist (cdr alist)) - (goto-char (point-min)) - (while (re-search-forward (car entry) nil t) - ;; Each header matching the entry. - (setq beg (match-beginning 0)) - (setq end (or (and (re-search-forward "^[^ \t]" nil t) - (match-beginning 0)) - (point-max))) - (goto-char beg) - (while (re-search-forward (nth 1 entry) end t) - ;; Each match within a header. - (let* ((entry (cdr entry)) - (start (match-beginning (nth 1 entry))) - (end (match-end (nth 1 entry))) - (form (nth 2 entry))) - (goto-char (match-end 0)) - (when (eval form) - (gnus-article-add-button - start end (nth 3 entry) - (buffer-substring (match-beginning (nth 4 entry)) - (match-end (nth 4 entry))))))) - (goto-char end)))) - (widen))) - -;;; External functions: - -(defun gnus-article-add-button (from to fun &optional data) - "Create a button between FROM and TO with callback FUN and data DATA." - (when 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))))) - -;;; Internal functions: - -(defun gnus-signature-toggle (end) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t)) - (if (get-text-property end 'invisible) - (gnus-article-unhide-text end (point-max)) - (gnus-article-hide-text end (point-max) gnus-hidden-properties))))) - -(defun gnus-button-entry () - ;; Return the first entry in `gnus-button-alist' matching this place. - (let ((alist gnus-button-alist) - (entry nil)) - (while alist - (setq entry (pop alist)) - (if (looking-at (car entry)) - (setq alist nil) - (setq entry nil))) - entry)) - -(defun gnus-button-push (marker) - ;; Push button starting at MARKER. - (save-excursion - (set-buffer gnus-article-buffer) - (goto-char marker) - (let* ((entry (gnus-button-entry)) - (inhibit-point-motion-hooks t) - (fun (nth 3 entry)) - (args (mapcar (lambda (group) - (let ((string (match-string group))) - (gnus-set-text-properties - 0 (length string) nil string) - string)) - (nthcdr 4 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))))))) - -(defun gnus-button-message-id (message-id) - "Fetch MESSAGE-ID." - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-summary-refer-article message-id))) - -(defun gnus-button-fetch-group (address) - "Fetch GROUP specified by ADDRESS." - (if (not (string-match "[:/]" address)) - ;; This is just a simple group url. - (gnus-group-read-ephemeral-group address gnus-select-method) - (if (not (string-match "^\\([^:/]+\\)\\(:\\([^/]+\\)/\\)?\\(.*\\)$" - address)) - (error "Can't parse %s" address) - (gnus-group-read-ephemeral-group - (match-string 4 address) - `(nntp ,(match-string 1 address) - (nntp-address ,(match-string 1 address)) - (nntp-port-number ,(if (match-end 3) - (match-string 3 address) - "nntp"))))))) - -(defun gnus-split-string (string pattern) - "Return a list of substrings of STRING which are separated by PATTERN." - (let (parts (start 0)) - (while (string-match pattern string start) - (setq parts (cons (substring string start (match-beginning 0)) parts) - start (match-end 0))) - (nreverse (cons (substring string start) parts)))) - -(defun gnus-url-parse-query-string (query &optional downcase) - (let (retval pairs cur key val) - (setq pairs (gnus-split-string query "&")) - (while pairs - (setq cur (car pairs) - pairs (cdr pairs)) - (if (not (string-match "=" cur)) - nil ; Grace - (setq key (gnus-url-unhex-string (substring cur 0 (match-beginning 0))) - val (gnus-url-unhex-string (substring cur (match-end 0) nil))) - (if downcase - (setq key (downcase key))) - (setq cur (assoc key retval)) - (if cur - (setcdr cur (cons val (cdr cur))) - (setq retval (cons (list key val) retval))))) - retval)) - -(defun gnus-url-unhex (x) - (if (> x ?9) - (if (>= x ?a) - (+ 10 (- x ?a)) - (+ 10 (- x ?A))) - (- x ?0))) - -(defun gnus-url-unhex-string (str &optional allow-newlines) - "Remove %XXX embedded spaces, etc in a url. -If optional second argument ALLOW-NEWLINES is non-nil, then allow the -decoding of carriage returns and line feeds in the string, which is normally -forbidden in URL encoding." - (setq str (or str "")) - (let ((tmp "") - (case-fold-search t)) - (while (string-match "%[0-9a-f][0-9a-f]" str) - (let* ((start (match-beginning 0)) - (ch1 (gnus-url-unhex (elt str (+ start 1)))) - (code (+ (* 16 ch1) - (gnus-url-unhex (elt str (+ start 2)))))) - (setq tmp (concat - tmp (substring str 0 start) - (cond - (allow-newlines - (char-to-string code)) - ((or (= code ?\n) (= code ?\r)) - " ") - (t (char-to-string code)))) - str (substring str (match-end 0))))) - (setq tmp (concat tmp str)) - tmp)) - -(defun gnus-url-mailto (url) - ;; Send mail to someone - (when (string-match "mailto:/*\\(.*\\)" url) - (setq url (substring url (match-beginning 1) nil))) - (let (to args source-url subject func) - (if (string-match (regexp-quote "?") url) - (setq to (gnus-url-unhex-string (substring url 0 (match-beginning 0))) - args (gnus-url-parse-query-string - (substring url (match-end 0) nil) t)) - (setq to (gnus-url-unhex-string url))) - (setq args (cons (list "to" to) args) - subject (cdr-safe (assoc "subject" args))) - (message-mail) - (while args - (setq func (intern-soft (concat "message-goto-" (downcase (caar args))))) - (if (fboundp func) - (funcall func) - (message-position-on-field (caar args))) - (insert (mapconcat 'identity (cdar args) ", ")) - (setq args (cdr args))) - (if subject - (message-goto-body) - (message-goto-subject)))) - -(defun gnus-button-mailto (address) - ;; Mail to ADDRESS. - (set-buffer (gnus-copy-article-buffer)) - (message-reply address)) - -(defun gnus-button-reply (address) - ;; Reply to ADDRESS. - (message-reply address)) - -(defun gnus-button-url (address) - "Browse ADDRESS." - (funcall browse-url-browser-function address)) - -(defun gnus-button-embedded-url (address) - "Browse ADDRESS." - (funcall browse-url-browser-function (gnus-strip-whitespace address))) - -;;; Next/prev buttons in the article buffer. - -(defvar gnus-next-page-line-format "%{%(Next page...%)%}\n") -(defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n") - -(defvar gnus-prev-page-map nil) -(unless gnus-prev-page-map - (setq gnus-prev-page-map (make-sparse-keymap)) - (define-key gnus-prev-page-map gnus-mouse-2 'gnus-button-prev-page) - (define-key gnus-prev-page-map "\r" 'gnus-button-prev-page)) - -(defun gnus-insert-prev-page-button () - (let ((buffer-read-only nil)) - (gnus-eval-format - gnus-prev-page-line-format nil - `(gnus-prev t local-map ,gnus-prev-page-map - gnus-callback gnus-article-button-prev-page)))) - -(defvar gnus-next-page-map nil) -(unless gnus-next-page-map - (setq gnus-next-page-map (make-keymap)) - (suppress-keymap gnus-prev-page-map) - (define-key gnus-next-page-map gnus-mouse-2 'gnus-button-next-page) - (define-key gnus-next-page-map "\r" 'gnus-button-next-page)) - -(defun gnus-button-next-page () - "Go to the next page." - (interactive) - (let ((win (selected-window))) - (select-window (get-buffer-window gnus-article-buffer t)) - (gnus-article-next-page) - (select-window win))) - -(defun gnus-button-prev-page () - "Go to the prev page." - (interactive) - (let ((win (selected-window))) - (select-window (get-buffer-window gnus-article-buffer t)) - (gnus-article-prev-page) - (select-window win))) - -(defun gnus-insert-next-page-button () - (let ((buffer-read-only nil)) - (gnus-eval-format gnus-next-page-line-format nil - `(gnus-next t local-map ,gnus-next-page-map - gnus-callback - gnus-article-button-next-page)))) - -(defun gnus-article-button-next-page (arg) - "Go to the next page." - (interactive "P") - (let ((win (selected-window))) - (select-window (get-buffer-window gnus-article-buffer t)) - (gnus-article-next-page) - (select-window win))) - -(defun gnus-article-button-prev-page (arg) - "Go to the prev page." - (interactive "P") - (let ((win (selected-window))) - (select-window (get-buffer-window gnus-article-buffer t)) - (gnus-article-prev-page) - (select-window win))) - -(gnus-ems-redefine) - -(provide 'gnus-art) - -(run-hooks 'gnus-art-load-hook) - -;;; gnus-art.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-async.el --- a/lisp/gnus/gnus-async.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,315 +0,0 @@ -;;; gnus-async.el --- asynchronous support for Gnus -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-sum) -(require 'nntp) - -(defgroup gnus-asynchronous nil - "Support for asynchronous operations." - :group 'gnus) - -(defcustom gnus-asynchronous t - "*If nil, inhibit all Gnus asynchronicity. -If non-nil, let the other asynch variables be heeded." - :group 'gnus-asynchronous - :type 'boolean) - -(defcustom gnus-use-article-prefetch 30 - "*If non-nil, prefetch articles in groups that allow this. -If a number, prefetch only that many articles forward; -if t, prefetch as many articles as possible." - :group 'gnus-asynchronous - :type '(choice (const :tag "off" nil) - (const :tag "all" t) - (integer :tag "some" 0))) - -(defcustom gnus-prefetched-article-deletion-strategy '(read exit) - "List of symbols that say when to remove articles from the prefetch buffer. -Possible values in this list are `read', which means that -articles are removed as they are read, and `exit', which means -that all articles belonging to a group are removed on exit -from that group." - :group 'gnus-asynchronous - :type '(set (const read) (const exit))) - -(defcustom gnus-use-header-prefetch nil - "*If non-nil, prefetch the headers to the next group." - :group 'gnus-asynchronous - :type 'boolean) - -(defcustom gnus-async-prefetch-article-p 'gnus-async-unread-p - "Function called to say whether an article should be prefetched or not. -The function is called with one parameter -- the article data. -It should return non-nil if the article is to be prefetched." - :group 'gnus-asynchronous - :type 'function) - -;;; Internal variables. - -(defvar gnus-async-prefetch-article-buffer " *Async Prefetch Article*") -(defvar gnus-async-article-alist nil) -(defvar gnus-async-article-semaphore '(nil)) -(defvar gnus-async-fetch-list nil) - -(defvar gnus-async-prefetch-headers-buffer " *Async Prefetch Headers*") -(defvar gnus-async-header-prefetched nil) - -;;; Utility functions. - -(defun gnus-group-asynchronous-p (group) - "Say whether GROUP is fetched from a server that supports asynchronicity." - (gnus-asynchronous-p (gnus-find-method-for-group group))) - -;;; Somewhat bogus semaphores. - -(defun gnus-async-get-semaphore (semaphore) - "Wait until SEMAPHORE is released." - (while (/= (length (nconc (symbol-value semaphore) (list nil))) 2) - (sleep-for 1))) - -(defun gnus-async-release-semaphore (semaphore) - "Release SEMAPHORE." - (setcdr (symbol-value semaphore) nil)) - -(defmacro gnus-async-with-semaphore (&rest forms) - `(unwind-protect - (progn - (gnus-async-get-semaphore 'gnus-async-article-semaphore) - ,@forms) - (gnus-async-release-semaphore 'gnus-async-article-semaphore))) - -(put 'gnus-asynch-with-semaphore 'lisp-indent-function 0) -(put 'gnus-asynch-with-semaphore 'edebug-form-spec '(body)) - -;;; -;;; Article prefetch -;;; - -(gnus-add-shutdown 'gnus-async-close 'gnus) -(defun gnus-async-close () - (gnus-kill-buffer gnus-async-prefetch-article-buffer) - (gnus-kill-buffer gnus-async-prefetch-headers-buffer) - (setq gnus-async-article-alist nil - gnus-async-header-prefetched nil)) - -(defun gnus-async-set-buffer () - (nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t)) - -(defun gnus-async-halt-prefetch () - "Stop prefetching." - (setq gnus-async-fetch-list nil)) - -(defun gnus-async-prefetch-next (group article summary) - "Possibly prefetch several articles starting with the article after ARTICLE." - (when (and (gnus-buffer-live-p summary) - gnus-asynchronous - (gnus-group-asynchronous-p group)) - (save-excursion - (set-buffer gnus-summary-buffer) - (let ((next (caadr (gnus-data-find-list article)))) - (when next - (if (not (fboundp 'run-with-idle-timer)) - ;; This is either an older Emacs or XEmacs, so we - ;; do this, which leads to slightly slower article - ;; buffer display. - (gnus-async-prefetch-article group next summary) - (run-with-idle-timer - 0.1 nil 'gnus-async-prefetch-article group next summary))))))) - -(defun gnus-async-prefetch-article (group article summary &optional next) - "Possibly prefetch several articles starting with ARTICLE." - (if (not (gnus-buffer-live-p summary)) - (gnus-async-with-semaphore - (setq gnus-async-fetch-list nil)) - (when (and gnus-asynchronous - (gnus-alive-p)) - (when next - (gnus-async-with-semaphore - (pop gnus-async-fetch-list))) - (let ((do-fetch next) - (do-message t)) ;(eq major-mode 'gnus-summary-mode))) - (when (and (gnus-group-asynchronous-p group) - (gnus-buffer-live-p summary) - (or (not next) - gnus-async-fetch-list)) - (gnus-async-with-semaphore - (unless next - (setq do-fetch (not gnus-async-fetch-list)) - ;; Nix out any outstanding requests. - (setq gnus-async-fetch-list nil) - ;; Fill in the new list. - (let ((n gnus-use-article-prefetch) - (data (gnus-data-find-list article)) - d) - (while (and (setq d (pop data)) - (if (numberp n) - (natnump (decf n)) - n)) - (unless (or (gnus-async-prefetched-article-entry - group (setq article (gnus-data-number d))) - (not (natnump article)) - (not (funcall gnus-async-prefetch-article-p d))) - ;; Not already fetched -- so we add it to the list. - (push article gnus-async-fetch-list))) - (setq gnus-async-fetch-list - (nreverse gnus-async-fetch-list)))) - - (when do-fetch - (setq article (car gnus-async-fetch-list)))) - - (when (and do-fetch article) - ;; We want to fetch some more articles. - (save-excursion - (set-buffer summary) - (let (mark) - (gnus-async-set-buffer) - (goto-char (point-max)) - (setq mark (point-marker)) - (let ((nnheader-callback-function - (gnus-make-async-article-function - group article mark summary next)) - (nntp-server-buffer - (get-buffer gnus-async-prefetch-article-buffer))) - (when do-message - (gnus-message 9 "Prefetching article %d in group %s" - article group)) - (gnus-request-article article group)))))))))) - -(defun gnus-make-async-article-function (group article mark summary next) - "Return a callback function." - `(lambda (arg) - (save-excursion - (when arg - (gnus-async-set-buffer) - (gnus-async-with-semaphore - (push (list ',(intern (format "%s-%d" group article)) - ,mark (set-marker (make-marker) (point-max)) - ,group ,article) - gnus-async-article-alist))) - (if (not (gnus-buffer-live-p ,summary)) - (gnus-async-with-semaphore - (setq gnus-async-fetch-list nil)) - (gnus-async-prefetch-article ,group ,next ,summary t))))) - -(defun gnus-async-unread-p (data) - "Return non-nil if DATA represents an unread article." - (gnus-data-unread-p data)) - -(defun gnus-async-request-fetched-article (group article buffer) - "See whether we have ARTICLE from GROUP and put it in BUFFER." - (when (numberp article) - (let ((entry (gnus-async-prefetched-article-entry group article))) - (when entry - (save-excursion - (gnus-async-set-buffer) - (copy-to-buffer buffer (cadr entry) (caddr entry)) - ;; Remove the read article from the prefetch buffer. - (when (memq 'read gnus-prefetched-article-deletion-strategy) - (gnus-async-delete-prefected-entry entry)) - t))))) - -(defun gnus-async-delete-prefected-entry (entry) - "Delete ENTRY from buffer and alist." - (ignore-errors - (delete-region (cadr entry) (caddr entry)) - (set-marker (cadr entry) nil) - (set-marker (caddr entry) nil)) - (gnus-async-with-semaphore - (setq gnus-async-article-alist - (delq entry gnus-async-article-alist)))) - -(defun gnus-async-prefetch-remove-group (group) - "Remove all articles belonging to GROUP from the prefetch buffer." - (when (and (gnus-group-asynchronous-p group) - (memq 'exit gnus-prefetched-article-deletion-strategy)) - (let ((alist gnus-async-article-alist)) - (save-excursion - (gnus-async-set-buffer) - (while alist - (when (equal group (nth 3 (car alist))) - (gnus-async-delete-prefected-entry (car alist))) - (pop alist)))))) - -(defun gnus-async-prefetched-article-entry (group article) - "Return the entry for ARTICLE in GROUP iff it has been prefetched." - (let ((entry (assq (intern (format "%s-%d" group article)) - gnus-async-article-alist))) - ;; Perhaps something has emptied the buffer? - (if (and entry - (= (cadr entry) (caddr entry))) - (progn - (ignore-errors - (set-marker (cadr entry) nil) - (set-marker (caddr entry) nil)) - (setq gnus-async-article-alist - (delq entry gnus-async-article-alist)) - nil) - entry))) - -;;; -;;; Header prefetch -;;; - -(defun gnus-async-prefetch-headers (group) - "Prefetch the headers for group GROUP." - (save-excursion - (let (unread) - (when (and gnus-use-header-prefetch - gnus-asynchronous - (gnus-group-asynchronous-p group) - (listp gnus-async-header-prefetched) - (setq unread (gnus-list-of-unread-articles group))) - ;; Mark that a fetch is in progress. - (setq gnus-async-header-prefetched t) - (nnheader-set-temp-buffer gnus-async-prefetch-headers-buffer t) - (erase-buffer) - (let ((nntp-server-buffer (current-buffer)) - (nnheader-callback-function - `(lambda (arg) - (setq gnus-async-header-prefetched - ,(cons group unread))))) - (gnus-retrieve-headers unread group gnus-fetch-old-headers)))))) - -(defun gnus-async-retrieve-fetched-headers (articles group) - "See whether we have prefetched headers." - (when (and gnus-use-header-prefetch - (gnus-group-asynchronous-p group) - (listp gnus-async-header-prefetched) - (equal group (car gnus-async-header-prefetched)) - (equal articles (cdr gnus-async-header-prefetched))) - (save-excursion - (nnheader-set-temp-buffer gnus-async-prefetch-headers-buffer t) - (nntp-decode-text) - (copy-to-buffer nntp-server-buffer (point-min) (point-max)) - (erase-buffer) - (setq gnus-async-header-prefetched nil) - t))) - -(provide 'gnus-async) - -;;; gnus-async.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-audio.el --- a/lisp/gnus/gnus-audio.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,132 +0,0 @@ -;;; gnus-audio.el --- Sound effects for Gnus -;; Copyright (C) 1996 Free Software Foundation - -;; Author: Steven L. Baur -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: -;; This file provides access to sound effects in Gnus. -;; Prerelease: This file is partially stripped to support earcons.el -;; You can safely ignore most of it until Red Gnus. **Evil Laugh** -;;; Code: - -(when (null (boundp 'running-xemacs)) - (defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))) - -(require 'nnheader) -(eval-when-compile (require 'cl)) - -(defvar gnus-audio-inline-sound - (and (fboundp 'device-sound-enabled-p) - (device-sound-enabled-p)) - "When t, we will not spawn a subprocess to play sounds.") - -(defvar gnus-audio-directory (nnheader-find-etc-directory "sounds") - "The directory containing the Sound Files.") - -(defvar gnus-audio-au-player "/usr/bin/showaudio" - "Executable program for playing sun AU format sound files") -(defvar gnus-audio-wav-player "/usr/local/bin/play" - "Executable program for playing WAV files") - - -;;; The following isn't implemented yet. Wait for Red 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) -; (run-hooks gnus-audio-enable-hooks)) - -;;;###autoload - ;(defun gnus-audio-disable-sound () -; "Disable Sound Effects for Gnus." -; (interactive) -; (setq gnus-audio-effects-enabled nil) -; (run-hooks gnus-audio-disable-hooks)) - -;;;###autoload -(defun gnus-audio-play (file) - "Play a sound through the speaker." - (interactive) - (let ((sound-file (if (file-exists-p file) - file - (concat gnus-audio-directory file)))) - (when (file-exists-p sound-file) - (if gnus-audio-inline-sound - (play-sound-file sound-file) - (cond ((string-match "\\.wav$" sound-file) - (call-process gnus-audio-wav-player - sound-file - 0 - nil - sound-file)) - ((string-match "\\.au$" 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 diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-bcklg.el --- a/lisp/gnus/gnus-bcklg.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,152 +0,0 @@ -;;; gnus-bcklg.el --- backlog functions for Gnus -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) - -;;; -;;; Buffering of read articles. -;;; - -(defvar gnus-backlog-buffer " *Gnus Backlog*") -(defvar gnus-backlog-articles nil) -(defvar gnus-backlog-hashtb nil) - -(defun gnus-backlog-buffer () - "Return the backlog buffer." - (or (get-buffer gnus-backlog-buffer) - (save-excursion - (set-buffer (get-buffer-create gnus-backlog-buffer)) - (buffer-disable-undo (current-buffer)) - (setq buffer-read-only t) - (gnus-add-current-to-buffer-list) - (get-buffer gnus-backlog-buffer)))) - -(defun gnus-backlog-setup () - "Initialize backlog variables." - (unless gnus-backlog-hashtb - (setq gnus-backlog-hashtb (gnus-make-hashtable 1024)))) - -(gnus-add-shutdown 'gnus-backlog-shutdown 'gnus) - -(defun gnus-backlog-shutdown () - "Clear all backlog variables and buffers." - (when (get-buffer gnus-backlog-buffer) - (kill-buffer gnus-backlog-buffer)) - (setq gnus-backlog-hashtb nil - gnus-backlog-articles nil)) - -(defun gnus-backlog-enter-article (group number buffer) - (gnus-backlog-setup) - (let ((ident (intern (concat group ":" (int-to-string number)) - gnus-backlog-hashtb)) - b) - (if (memq ident gnus-backlog-articles) - () ; It's already kept. - ;; Remove the oldest article, if necessary. - (and (numberp gnus-keep-backlog) - (>= (length gnus-backlog-articles) gnus-keep-backlog) - (gnus-backlog-remove-oldest-article)) - (push ident gnus-backlog-articles) - ;; Insert the new article. - (save-excursion - (set-buffer (gnus-backlog-buffer)) - (let (buffer-read-only) - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (setq b (point)) - (insert-buffer-substring buffer) - ;; Tag the beginning of the article with the ident. - (gnus-put-text-property b (1+ b) 'gnus-backlog ident)))))) - -(defun gnus-backlog-remove-oldest-article () - (save-excursion - (set-buffer (gnus-backlog-buffer)) - (goto-char (point-min)) - (if (zerop (buffer-size)) - () ; The buffer is empty. - (let ((ident (get-text-property (point) 'gnus-backlog)) - buffer-read-only) - ;; Remove the ident from the list of articles. - (when ident - (setq gnus-backlog-articles (delq ident gnus-backlog-articles))) - ;; Delete the article itself. - (delete-region - (point) (next-single-property-change - (1+ (point)) 'gnus-backlog nil (point-max))))))) - -(defun gnus-backlog-remove-article (group number) - "Remove article NUMBER in GROUP from the backlog." - (when (numberp number) - (gnus-backlog-setup) - (let ((ident (intern (concat group ":" (int-to-string number)) - gnus-backlog-hashtb)) - beg end) - (when (memq ident gnus-backlog-articles) - ;; It was in the backlog. - (save-excursion - (set-buffer (gnus-backlog-buffer)) - (let (buffer-read-only) - (when (setq beg (text-property-any - (point-min) (point-max) 'gnus-backlog - ident)) - ;; Find the end (i. e., the beginning of the next article). - (setq end - (next-single-property-change - (1+ beg) 'gnus-backlog (current-buffer) (point-max))) - (delete-region beg end) - ;; Return success. - t))))))) - -(defun gnus-backlog-request-article (group number buffer) - (when (numberp number) - (gnus-backlog-setup) - (let ((ident (intern (concat group ":" (int-to-string number)) - gnus-backlog-hashtb)) - beg end) - (when (memq ident gnus-backlog-articles) - ;; It was in the backlog. - (save-excursion - (set-buffer (gnus-backlog-buffer)) - (if (not (setq beg (text-property-any - (point-min) (point-max) 'gnus-backlog - ident))) - ;; It wasn't in the backlog after all. - (ignore - (setq gnus-backlog-articles (delq ident gnus-backlog-articles))) - ;; Find the end (i. e., the beginning of the next article). - (setq end - (next-single-property-change - (1+ beg) 'gnus-backlog (current-buffer) (point-max))))) - (let ((buffer-read-only nil)) - (erase-buffer) - (insert-buffer-substring gnus-backlog-buffer beg end) - t))))) - -(provide 'gnus-bcklg) - -;;; gnus-bcklg.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-cache.el --- a/lisp/gnus/gnus-cache.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,663 +0,0 @@ -;;; gnus-cache.el --- cache interface for Gnus -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-int) -(require 'gnus-range) -(require 'gnus-start) -(eval-when-compile - (require 'gnus-sum)) - -(defgroup gnus-cache nil - "Cache interface." - :group 'gnus) - -(defcustom gnus-cache-directory - (nnheader-concat gnus-directory "cache/") - "*The directory where cached articles will be stored." - :group 'gnus-cache - :type 'directory) - -(defcustom gnus-cache-active-file - (concat (file-name-as-directory gnus-cache-directory) "active") - "*The cache active file." - :group 'gnus-cache - :type 'file) - -(defcustom gnus-cache-enter-articles '(ticked dormant) - "Classes of articles to enter into the cache." - :group 'gnus-cache - :type '(set (const ticked) (const dormant) (const unread) (const read))) - -(defcustom gnus-cache-remove-articles '(read) - "Classes of articles to remove from the cache." - :group 'gnus-cache - :type '(set (const ticked) (const dormant) (const unread) (const read))) - -(defcustom gnus-uncacheable-groups nil - "*Groups that match this regexp will not be cached. - -If you want to avoid caching your nnml groups, you could set this -variable to \"^nnml\"." - :group 'gnus-cache - :type '(choice (const :tag "off" nil) - regexp)) - - - -;;; Internal variables. - -(defvar gnus-cache-removable-articles nil) -(defvar gnus-cache-buffer nil) -(defvar gnus-cache-active-hashtb nil) -(defvar gnus-cache-active-altered nil) - -(eval-and-compile - (autoload 'nnml-generate-nov-databases-1 "nnml") - (autoload 'nnvirtual-find-group-art "nnvirtual")) - - - -;;; Functions called from Gnus. - -(defun gnus-cache-open () - "Initialize the cache." - (when (or (file-exists-p gnus-cache-directory) - (and gnus-use-cache - (not (eq gnus-use-cache 'passive)))) - (gnus-cache-read-active))) - -;; Complexities of byte-compiling make this kludge necessary. Eeek. -(ignore-errors - (gnus-add-shutdown 'gnus-cache-close 'gnus)) - -(defun gnus-cache-close () - "Shut down the cache." - (gnus-cache-write-active) - (gnus-cache-save-buffers) - (setq gnus-cache-active-hashtb nil)) - -(defun gnus-cache-save-buffers () - ;; save the overview buffer if it exists and has been modified - ;; delete empty cache subdirectories - (when gnus-cache-buffer - (let ((buffer (cdr gnus-cache-buffer)) - (overview-file (gnus-cache-file-name - (car gnus-cache-buffer) ".overview"))) - ;; write the overview only if it was modified - (when (buffer-modified-p buffer) - (save-excursion - (set-buffer buffer) - (if (> (buffer-size) 0) - ;; Non-empty overview, write it to a file. - (gnus-write-buffer overview-file) - ;; Empty overview file, remove it - (when (file-exists-p overview-file) - (delete-file overview-file)) - ;; If possible, remove group's cache subdirectory. - (condition-case nil - ;; FIXME: we can detect the error type and warn the user - ;; of any inconsistencies (articles w/o nov entries?). - ;; for now, just be conservative...delete only if safe -- sj - (delete-directory (file-name-directory overview-file)) - (error nil))))) - ;; Kill the buffer -- it's either unmodified or saved. - (gnus-kill-buffer buffer) - (setq gnus-cache-buffer nil)))) - -(defun gnus-cache-possibly-enter-article - (group article headers ticked dormant unread &optional force) - (when (and (or force (not (eq gnus-use-cache 'passive))) - (numberp article) - (> article 0) - (vectorp headers)) ; This might be a dummy article. - ;; If this is a virtual group, we find the real group. - (when (gnus-virtual-group-p group) - (let ((result (nnvirtual-find-group-art - (gnus-group-real-name group) article))) - (setq group (car result) - headers (copy-sequence headers)) - (mail-header-set-number headers (cdr result)))) - (let ((number (mail-header-number headers)) - file dir) - (when (and number - (> number 0) ; Reffed article. - (or force - (and (or (not gnus-uncacheable-groups) - (not (string-match - gnus-uncacheable-groups group))) - (gnus-cache-member-of-class - gnus-cache-enter-articles ticked dormant unread))) - (not (file-exists-p (setq file (gnus-cache-file-name - group number))))) - ;; Possibly create the cache directory. - (gnus-make-directory (setq dir (file-name-directory file))) - ;; Save the article in the cache. - (if (file-exists-p file) - t ; The article already is saved. - (save-excursion - (set-buffer nntp-server-buffer) - (let ((gnus-use-cache nil)) - (gnus-request-article-this-buffer number group)) - (when (> (buffer-size) 0) - (gnus-write-buffer file) - (gnus-cache-change-buffer group) - (set-buffer (cdr gnus-cache-buffer)) - (goto-char (point-max)) - (forward-line -1) - (while (condition-case () - (when (not (bobp)) - (> (read (current-buffer)) number)) - (error - ;; The line was malformed, so we just remove it!! - (gnus-delete-line) - t)) - (forward-line -1)) - (if (bobp) - (if (not (eobp)) - (progn - (beginning-of-line) - (when (< (read (current-buffer)) number) - (forward-line 1))) - (beginning-of-line)) - (forward-line 1)) - (beginning-of-line) - ;; [number subject from date id references chars lines xref] - (insert (format "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t\n" - (mail-header-number headers) - (mail-header-subject headers) - (mail-header-from headers) - (mail-header-date headers) - (mail-header-id headers) - (or (mail-header-references headers) "") - (or (mail-header-chars headers) "") - (or (mail-header-lines headers) "") - (or (mail-header-xref headers) ""))) - ;; Update the active info. - (set-buffer gnus-summary-buffer) - (gnus-cache-update-active group number) - (push article gnus-newsgroup-cached) - (gnus-summary-update-secondary-mark article)) - t)))))) - -(defun gnus-cache-enter-remove-article (article) - "Mark ARTICLE for later possible removal." - (when article - (push article gnus-cache-removable-articles))) - -(defun gnus-cache-possibly-remove-articles () - "Possibly remove some of the removable articles." - (if (not (gnus-virtual-group-p gnus-newsgroup-name)) - (gnus-cache-possibly-remove-articles-1) - (let ((arts gnus-cache-removable-articles) - ga) - (while arts - (when (setq ga (nnvirtual-find-group-art - (gnus-group-real-name gnus-newsgroup-name) (pop arts))) - (let ((gnus-cache-removable-articles (list (cdr ga))) - (gnus-newsgroup-name (car ga))) - (gnus-cache-possibly-remove-articles-1))))) - (setq gnus-cache-removable-articles nil))) - -(defun gnus-cache-possibly-remove-articles-1 () - "Possibly remove some of the removable articles." - (unless (eq gnus-use-cache 'passive) - (let ((articles gnus-cache-removable-articles) - (cache-articles gnus-newsgroup-cached) - article) - (gnus-cache-change-buffer gnus-newsgroup-name) - (while articles - (when (memq (setq article (pop articles)) cache-articles) - ;; The article was in the cache, so we see whether we are - ;; supposed to remove it from the cache. - (gnus-cache-possibly-remove-article - article (memq article gnus-newsgroup-marked) - (memq article gnus-newsgroup-dormant) - (or (memq article gnus-newsgroup-unreads) - (memq article gnus-newsgroup-unselected)))))) - ;; The overview file might have been modified, save it - ;; safe because we're only called at group exit anyway. - (gnus-cache-save-buffers))) - -(defun gnus-cache-request-article (article group) - "Retrieve ARTICLE in GROUP from the cache." - (let ((file (gnus-cache-file-name group article)) - (buffer-read-only nil)) - (when (file-exists-p file) - (erase-buffer) - (gnus-kill-all-overlays) - (insert-file-contents file) - t))) - -(defun gnus-cache-possibly-alter-active (group active) - "Alter the ACTIVE info for GROUP to reflect the articles in the cache." - (when gnus-cache-active-hashtb - (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb))) - (when cache-active - (when (< (car cache-active) (car active)) - (setcar active (car cache-active))) - (when (> (cdr cache-active) (cdr active)) - (setcdr active (cdr cache-active))))))) - -(defun gnus-cache-retrieve-headers (articles group &optional fetch-old) - "Retrieve the headers for ARTICLES in GROUP." - (let ((cached - (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group)))) - (if (not cached) - ;; No cached articles here, so we just retrieve them - ;; the normal way. - (let ((gnus-use-cache nil)) - (gnus-retrieve-headers articles group fetch-old)) - (let ((uncached-articles (gnus-sorted-intersection - (gnus-sorted-complement articles cached) - articles)) - (cache-file (gnus-cache-file-name group ".overview")) - type) - ;; We first retrieve all the headers that we don't have in - ;; the cache. - (let ((gnus-use-cache nil)) - (when uncached-articles - (setq type (and articles - (gnus-retrieve-headers - uncached-articles group fetch-old))))) - (gnus-cache-save-buffers) - ;; Then we insert the cached headers. - (save-excursion - (cond - ((not (file-exists-p cache-file)) - ;; There are no cached headers. - type) - ((null type) - ;; There were no uncached headers (or retrieval was - ;; unsuccessful), so we use the cached headers exclusively. - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-file-contents cache-file) - 'nov) - ((eq type 'nov) - ;; We have both cached and uncached NOV headers, so we - ;; braid them. - (gnus-cache-braid-nov group cached) - type) - (t - ;; We braid HEADs. - (gnus-cache-braid-heads group (gnus-sorted-intersection - cached articles)) - type))))))) - -(defun gnus-cache-enter-article (&optional n) - "Enter the next N articles into the cache. -If not given a prefix, use the process marked articles instead. -Returns the list of articles entered." - (interactive "P") - (gnus-set-global-variables) - (let ((articles (gnus-summary-work-articles n)) - article out) - (while (setq article (pop articles)) - (if (natnump article) - (when (gnus-cache-possibly-enter-article - gnus-newsgroup-name article - (gnus-summary-article-header article) - nil nil nil t) - (push article out)) - (gnus-message 2 "Can't cache article %d" article)) - (gnus-summary-remove-process-mark article) - (gnus-summary-update-secondary-mark article)) - (gnus-summary-next-subject 1) - (gnus-summary-position-point) - (nreverse out))) - -(defun gnus-cache-remove-article (n) - "Remove the next N articles from the cache. -If not given a prefix, use the process marked articles instead. -Returns the list of articles removed." - (interactive "P") - (gnus-set-global-variables) - (gnus-cache-change-buffer gnus-newsgroup-name) - (let ((articles (gnus-summary-work-articles n)) - article out) - (while articles - (setq article (pop articles)) - (when (gnus-cache-possibly-remove-article article nil nil nil t) - (push article out)) - (gnus-summary-remove-process-mark article) - (gnus-summary-update-secondary-mark article)) - (gnus-summary-next-subject 1) - (gnus-summary-position-point) - (nreverse out))) - -(defun gnus-cached-article-p (article) - "Say whether ARTICLE is cached in the current group." - (memq article gnus-newsgroup-cached)) - -(defun gnus-summary-insert-cached-articles () - "Insert all the articles cached for this group into the current buffer." - (interactive) - (let ((cached gnus-newsgroup-cached) - (gnus-verbose (max 6 gnus-verbose))) - (unless cached - (error "No cached articles for this group")) - (while cached - (gnus-summary-goto-subject (pop cached) t)))) - -;;; Internal functions. - -(defun gnus-cache-change-buffer (group) - (and gnus-cache-buffer - ;; See if the current group's overview cache has been loaded. - (or (string= group (car gnus-cache-buffer)) - ;; Another overview cache is current, save it. - (gnus-cache-save-buffers))) - ;; if gnus-cache buffer is nil, create it - (unless gnus-cache-buffer - ;; Create cache buffer - (save-excursion - (setq gnus-cache-buffer - (cons group - (set-buffer (get-buffer-create " *gnus-cache-overview*")))) - (buffer-disable-undo (current-buffer)) - ;; Insert the contents of this group's cache overview. - (erase-buffer) - (let ((file (gnus-cache-file-name group ".overview"))) - (when (file-exists-p file) - (nnheader-insert-file-contents file))) - ;; We have a fresh (empty/just loaded) buffer, - ;; mark it as unmodified to save a redundant write later. - (set-buffer-modified-p nil)))) - -;; Return whether an article is a member of a class. -(defun gnus-cache-member-of-class (class ticked dormant unread) - (or (and ticked (memq 'ticked class)) - (and dormant (memq 'dormant class)) - (and unread (memq 'unread class)) - (and (not unread) (not ticked) (not dormant) (memq 'read class)))) - -(defun gnus-cache-file-name (group article) - (concat (file-name-as-directory gnus-cache-directory) - (file-name-as-directory - (nnheader-translate-file-chars - (if (gnus-use-long-file-name 'not-cache) - group - (let ((group (nnheader-replace-chars-in-string group ?/ ?_))) - ;; Translate the first colon into a slash. - (when (string-match ":" group) - (aset group (match-beginning 0) ?/)) - (nnheader-replace-chars-in-string group ?. ?/))))) - (if (stringp article) article (int-to-string article)))) - -(defun gnus-cache-update-article (group article) - "If ARTICLE is in the cache, remove it and re-enter it." - (when (gnus-cache-possibly-remove-article article nil nil nil t) - (let ((gnus-use-cache nil)) - (gnus-cache-possibly-enter-article - gnus-newsgroup-name article (gnus-summary-article-header article) - nil nil nil t)))) - -(defun gnus-cache-possibly-remove-article (article ticked dormant unread - &optional force) - "Possibly remove ARTICLE from the cache." - (let ((group gnus-newsgroup-name) - (number article) - file) - ;; If this is a virtual group, we find the real group. - (when (gnus-virtual-group-p group) - (let ((result (nnvirtual-find-group-art - (gnus-group-real-name group) article))) - (setq group (car result) - number (cdr result)))) - (setq file (gnus-cache-file-name group number)) - (when (and (file-exists-p file) - (or force - (gnus-cache-member-of-class - gnus-cache-remove-articles ticked dormant unread))) - (save-excursion - (delete-file file) - (set-buffer (cdr gnus-cache-buffer)) - (goto-char (point-min)) - (when (or (looking-at (concat (int-to-string number) "\t")) - (search-forward (concat "\n" (int-to-string number) "\t") - (point-max) t)) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point))))) - (setq gnus-newsgroup-cached - (delq article gnus-newsgroup-cached)) - (gnus-summary-update-secondary-mark article) - t))) - -(defun gnus-cache-articles-in-group (group) - "Return a sorted list of cached articles in GROUP." - (let ((dir (file-name-directory (gnus-cache-file-name group 1))) - articles) - (when (file-exists-p dir) - (setq articles - (sort (mapcar (lambda (name) (string-to-int name)) - (directory-files dir nil "^[0-9]+$" t)) - '<)) - ;; Update the cache active file, just to synch more. - (when articles - (gnus-cache-update-active group (car articles) t) - (gnus-cache-update-active group (car (last articles)))) - articles))) - -(defun gnus-cache-braid-nov (group cached &optional file) - (let ((cache-buf (get-buffer-create " *gnus-cache*")) - beg end) - (gnus-cache-save-buffers) - (save-excursion - (set-buffer cache-buf) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert-file-contents (or file (gnus-cache-file-name group ".overview"))) - (goto-char (point-min)) - (insert "\n") - (goto-char (point-min))) - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while cached - (while (and (not (eobp)) - (< (read (current-buffer)) (car cached))) - (forward-line 1)) - (beginning-of-line) - (save-excursion - (set-buffer cache-buf) - (if (search-forward (concat "\n" (int-to-string (car cached)) "\t") - nil t) - (setq beg (progn (beginning-of-line) (point)) - end (progn (end-of-line) (point))) - (setq beg nil))) - (when beg - (insert-buffer-substring cache-buf beg end) - (insert "\n")) - (setq cached (cdr cached))) - (kill-buffer cache-buf))) - -(defun gnus-cache-braid-heads (group cached) - (let ((cache-buf (get-buffer-create " *gnus-cache*"))) - (save-excursion - (set-buffer cache-buf) - (buffer-disable-undo (current-buffer)) - (erase-buffer)) - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while cached - (while (and (not (eobp)) - (looking-at "2.. +\\([0-9]+\\) ") - (< (progn (goto-char (match-beginning 1)) - (read (current-buffer))) - (car cached))) - (search-forward "\n.\n" nil 'move)) - (beginning-of-line) - (save-excursion - (set-buffer cache-buf) - (erase-buffer) - (insert-file-contents (gnus-cache-file-name group (car cached))) - (goto-char (point-min)) - (insert "220 ") - (princ (car cached) (current-buffer)) - (insert " Article retrieved.\n") - (search-forward "\n\n" nil 'move) - (delete-region (point) (point-max)) - (forward-char -1) - (insert ".")) - (insert-buffer-substring cache-buf) - (setq cached (cdr cached))) - (kill-buffer cache-buf))) - -;;;###autoload -(defun gnus-jog-cache () - "Go through all groups and put the articles into the cache. - -Usage: -$ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache" - (interactive) - (let ((gnus-mark-article-hook nil) - (gnus-expert-user t) - (nnmail-spool-file nil) - (gnus-use-dribble-file nil) - (gnus-novice-user nil) - (gnus-large-newsgroup nil)) - ;; Start Gnus. - (gnus) - ;; Go through all groups... - (gnus-group-mark-buffer) - (gnus-group-universal-argument - nil nil - (lambda () - (interactive) - (gnus-summary-read-group (gnus-group-group-name) nil t) - ;; ... and enter the articles into the cache. - (when (eq major-mode 'gnus-summary-mode) - (gnus-uu-mark-buffer) - (gnus-cache-enter-article) - (kill-buffer (current-buffer))))))) - -(defun gnus-cache-read-active (&optional force) - "Read the cache active file." - (gnus-make-directory gnus-cache-directory) - (if (or (not (file-exists-p gnus-cache-active-file)) - force) - ;; There is no active file, so we generate one. - (gnus-cache-generate-active) - ;; We simply read the active file. - (save-excursion - (gnus-set-work-buffer) - (insert-file-contents gnus-cache-active-file) - (gnus-active-to-gnus-format - nil (setq gnus-cache-active-hashtb - (gnus-make-hashtable - (count-lines (point-min) (point-max))))) - (setq gnus-cache-active-altered nil)))) - -(defun gnus-cache-write-active (&optional force) - "Write the active hashtb to the active file." - (when (or force - (and gnus-cache-active-hashtb - gnus-cache-active-altered)) - (nnheader-temp-write gnus-cache-active-file - (mapatoms - (lambda (sym) - (when (and sym (boundp sym)) - (insert (format "%s %d %d y\n" - (symbol-name sym) (cdr (symbol-value sym)) - (car (symbol-value sym)))))) - gnus-cache-active-hashtb)) - ;; Mark the active hashtb as unaltered. - (setq gnus-cache-active-altered nil))) - -(defun gnus-cache-update-active (group number &optional low) - "Update the upper bound of the active info of GROUP to NUMBER. -If LOW, update the lower bound instead." - (let ((active (gnus-gethash group gnus-cache-active-hashtb))) - (if (null active) - ;; We just create a new active entry for this group. - (gnus-sethash group (cons number number) gnus-cache-active-hashtb) - ;; Update the lower or upper bound. - (if low - (setcar active number) - (setcdr active number))) - ;; Mark the active hashtb as altered. - (setq gnus-cache-active-altered t))) - -;;;###autoload -(defun gnus-cache-generate-active (&optional directory) - "Generate the cache active file." - (interactive) - (let* ((top (null directory)) - (directory (expand-file-name (or directory gnus-cache-directory))) - (files (directory-files directory 'full)) - (group - (if top - "" - (string-match - (concat "^" (file-name-as-directory - (expand-file-name gnus-cache-directory))) - (directory-file-name directory)) - (nnheader-replace-chars-in-string - (substring (directory-file-name directory) (match-end 0)) - ?/ ?.))) - nums alphs) - (when top - (gnus-message 5 "Generating the cache active file...") - (setq gnus-cache-active-hashtb (gnus-make-hashtable 123))) - ;; Separate articles from all other files and directories. - (while files - (if (string-match "^[0-9]+$" (file-name-nondirectory (car files))) - (push (string-to-int (file-name-nondirectory (pop files))) nums) - (push (pop files) alphs))) - ;; If we have nums, then this is probably a valid group. - (when (setq nums (sort nums '<)) - (gnus-sethash group (cons (car nums) (gnus-last-element nums)) - gnus-cache-active-hashtb)) - ;; Go through all the other files. - (while alphs - (when (and (file-directory-p (car alphs)) - (not (string-match "^\\.\\.?$" - (file-name-nondirectory (car alphs))))) - ;; We descend directories. - (gnus-cache-generate-active (car alphs))) - (setq alphs (cdr alphs))) - ;; Write the new active file. - (when top - (gnus-cache-write-active t) - (gnus-message 5 "Generating the cache active file...done")))) - -;;;###autoload -(defun gnus-cache-generate-nov-databases (dir) - "Generate NOV files recursively starting in DIR." - (interactive (list gnus-cache-directory)) - (gnus-cache-close) - (let ((nnml-generate-active-function 'identity)) - (nnml-generate-nov-databases-1 dir))) - -(defun gnus-cache-move-cache (dir) - "Move the cache tree to somewhere else." - (interactive "FMove the cache tree to: ") - (rename-file gnus-cache-directory dir)) - -(provide 'gnus-cache) - -;;; gnus-cache.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-cite.el --- a/lisp/gnus/gnus-cite.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,913 +0,0 @@ -;;; gnus-cite.el --- parse citations in articles for Gnus -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Per Abrahamsen -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-art) -(require 'gnus-range) - -;;; Customization: - -(defgroup gnus-cite nil - "Citation." - :prefix "gnus-cite-" - :link '(custom-manual "(gnus)Article Highlighting") - :group 'gnus-article) - -(defcustom gnus-cite-reply-regexp - "^\\(Subject: Re\\|In-Reply-To\\|References\\):" - "If headers match this regexp it is reasonable to believe that -article has citations." - :group 'gnus-cite - :type 'string) - -(defcustom gnus-cite-always-check nil - "Check article always for citations. Set it t to check all articles." - :group 'gnus-cite - :type '(choice (const :tag "no" nil) - (const :tag "yes" t))) - -(defcustom gnus-cited-text-button-line-format "%(%{[...]%}%)\n" - "Format of cited text buttons." - :group 'gnus-cite - :type 'string) - -(defcustom gnus-cited-lines-visible nil - "The number of lines of hidden cited text to remain visible." - :group 'gnus-cite - :type '(choice (const :tag "none" nil) - integer)) - -(defcustom gnus-cite-parse-max-size 25000 - "Maximum article size (in bytes) where parsing citations is allowed. -Set it to nil to parse all articles." - :group 'gnus-cite - :type '(choice (const :tag "all" nil) - integer)) - -(defcustom gnus-cite-prefix-regexp - "^[]>|:}+ ]*[]>|:}+]\\(.*>\\)?\\|^.*>" - "Regexp matching the longest possible citation prefix on a line." - :group 'gnus-cite - :type 'regexp) - -(defcustom gnus-cite-max-prefix 20 - "Maximum possible length for a citation prefix." - :group 'gnus-cite - :type 'integer) - -(defcustom gnus-supercite-regexp - (concat "^\\(" gnus-cite-prefix-regexp "\\)? *" - ">>>>> +\"\\([^\"\n]+\\)\" +==") - "Regexp matching normal Supercite attribution lines. -The first grouping must match prefixes added by other packages." - :group 'gnus-cite - :type 'regexp) - -(defcustom gnus-supercite-secondary-regexp "^.*\"\\([^\"\n]+\\)\" +==" - "Regexp matching mangled Supercite attribution lines. -The first regexp group should match the Supercite attribution." - :group 'gnus-cite - :type 'regexp) - -(defcustom gnus-cite-minimum-match-count 2 - "Minimum number of identical prefixes before we believe it's a citation." - :group 'gnus-cite - :type 'integer) - -(defcustom gnus-cite-attribution-prefix - "in article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\)," - "Regexp matching the beginning of an attribution line." - :group 'gnus-cite - :type 'regexp) - -(defcustom gnus-cite-attribution-suffix - "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\)[ ]*$" - "Regexp matching the end of an attribution line. -The text matching the first grouping will be used as a button." - :group 'gnus-cite - :type 'regexp) - -(defface gnus-cite-attribution-face '((t - (:underline t))) - "Face used for attribution lines.") - -(defcustom gnus-cite-attribution-face 'gnus-cite-attribution-face - "Face used for attribution lines. -It is merged with the face for the cited text belonging to the attribution." - :group 'gnus-cite - :type 'face) - -(defface gnus-cite-face-1 '((((class color) - (background dark)) - (:foreground "light blue")) - (((class color) - (background light)) - (:foreground "MidnightBlue")) - (t - (:italic t))) - "Citation face.") - -(defface gnus-cite-face-2 '((((class color) - (background dark)) - (:foreground "light cyan")) - (((class color) - (background light)) - (:foreground "firebrick")) - (t - (:italic t))) - "Citation face.") - -(defface gnus-cite-face-3 '((((class color) - (background dark)) - (:foreground "light yellow")) - (((class color) - (background light)) - (:foreground "dark green")) - (t - (:italic t))) - "Citation face.") - -(defface gnus-cite-face-4 '((((class color) - (background dark)) - (:foreground "light pink")) - (((class color) - (background light)) - (:foreground "OrangeRed")) - (t - (:italic t))) - "Citation face.") - -(defface gnus-cite-face-5 '((((class color) - (background dark)) - (:foreground "pale green")) - (((class color) - (background light)) - (:foreground "dark khaki")) - (t - (:italic t))) - "Citation face.") - -(defface gnus-cite-face-6 '((((class color) - (background dark)) - (:foreground "beige")) - (((class color) - (background light)) - (:foreground "dark violet")) - (t - (:italic t))) - "Citation face.") - -(defface gnus-cite-face-7 '((((class color) - (background dark)) - (:foreground "orange")) - (((class color) - (background light)) - (:foreground "SteelBlue4")) - (t - (:italic t))) - "Citation face.") - -(defface gnus-cite-face-8 '((((class color) - (background dark)) - (:foreground "magenta")) - (((class color) - (background light)) - (:foreground "magenta")) - (t - (:italic t))) - "Citation face.") - -(defface gnus-cite-face-9 '((((class color) - (background dark)) - (:foreground "violet")) - (((class color) - (background light)) - (:foreground "violet")) - (t - (:italic t))) - "Citation face.") - -(defface gnus-cite-face-10 '((((class color) - (background dark)) - (:foreground "medium purple")) - (((class color) - (background light)) - (:foreground "medium purple")) - (t - (:italic t))) - "Citation face.") - -(defface gnus-cite-face-11 '((((class color) - (background dark)) - (:foreground "turquoise")) - (((class color) - (background light)) - (:foreground "turquoise")) - (t - (:italic t))) - "Citation face.") - -(defcustom gnus-cite-face-list - '(gnus-cite-face-1 gnus-cite-face-2 gnus-cite-face-3 gnus-cite-face-4 - gnus-cite-face-5 gnus-cite-face-6 gnus-cite-face-7 gnus-cite-face-8 - gnus-cite-face-9 gnus-cite-face-10 gnus-cite-face-11) - "List of faces used for highlighting citations. - -When there are citations from multiple articles in the same message, -Gnus will try to give each citation from each article its own face. -This should make it easier to see who wrote what." - :group 'gnus-cite - :type '(repeat face)) - -(defcustom gnus-cite-hide-percentage 50 - "Only hide excess citation if above this percentage of the body." - :group 'gnus-cite - :type 'number) - -(defcustom gnus-cite-hide-absolute 10 - "Only hide excess citation if above this number of lines in the body." - :group 'gnus-cite - :type 'integer) - -;;; Internal Variables: - -(defvar gnus-cite-article nil) - -(defvar gnus-cite-prefix-alist nil) -;; Alist of citation prefixes. -;; The cdr is a list of lines with that prefix. - -(defvar gnus-cite-attribution-alist nil) -;; Alist of attribution lines. -;; The car is a line number. -;; The cdr is the prefix for the citation started by that line. - -(defvar gnus-cite-loose-prefix-alist nil) -;; Alist of citation prefixes that have no matching attribution. -;; The cdr is a list of lines with that prefix. - -(defvar gnus-cite-loose-attribution-alist nil) -;; Alist of attribution lines that have no matching citation. -;; Each member has the form (WROTE IN PREFIX TAG), where -;; WROTE: is the attribution line number -;; IN: is the line number of the previous line if part of the same attribution, -;; PREFIX: Is the citation prefix of the attribution line(s), and -;; TAG: Is a Supercite tag, if any. - -(defvar gnus-cited-text-button-line-format-alist - `((?b (marker-position beg) ?d) - (?e (marker-position end) ?d) - (?l (- end beg) ?d))) -(defvar gnus-cited-text-button-line-format-spec nil) - -;;; Commands: - -(defun gnus-article-highlight-citation (&optional force) - "Highlight cited text. -Each citation in the article will be highlighted with a different face. -The faces are taken from `gnus-cite-face-list'. -Attribution lines are highlighted with the same face as the -corresponding citation merged with `gnus-cite-attribution-face'. - -Text is considered cited if at least `gnus-cite-minimum-match-count' -lines matches `gnus-cite-prefix-regexp' with the same prefix. - -Lines matching `gnus-cite-attribution-suffix' and perhaps -`gnus-cite-attribution-prefix' are considered attribution lines." - (interactive (list 'force)) - (save-excursion - (set-buffer gnus-article-buffer) - (gnus-cite-parse-maybe force) - (let ((buffer-read-only nil) - (alist gnus-cite-prefix-alist) - (faces gnus-cite-face-list) - (inhibit-point-motion-hooks t) - face entry prefix skip numbers number face-alist) - ;; Loop through citation prefixes. - (while alist - (setq entry (car alist) - alist (cdr alist) - prefix (car entry) - numbers (cdr entry) - face (car faces) - faces (or (cdr faces) gnus-cite-face-list) - face-alist (cons (cons prefix face) face-alist)) - (while numbers - (setq number (car numbers) - numbers (cdr numbers)) - (and (not (assq number gnus-cite-attribution-alist)) - (not (assq number gnus-cite-loose-attribution-alist)) - (gnus-cite-add-face number prefix face)))) - ;; Loop through attribution lines. - (setq alist gnus-cite-attribution-alist) - (while alist - (setq entry (car alist) - alist (cdr alist) - number (car entry) - prefix (cdr entry) - skip (gnus-cite-find-prefix number) - face (cdr (assoc prefix face-alist))) - ;; Add attribution button. - (goto-line number) - (when (re-search-forward gnus-cite-attribution-suffix - (save-excursion (end-of-line 1) (point)) - t) - (gnus-article-add-button (match-beginning 1) (match-end 1) - 'gnus-cite-toggle prefix)) - ;; Highlight attribution line. - (gnus-cite-add-face number skip face) - (gnus-cite-add-face number skip gnus-cite-attribution-face)) - ;; Loop through attribution lines. - (setq alist gnus-cite-loose-attribution-alist) - (while alist - (setq entry (car alist) - alist (cdr alist) - number (car entry) - skip (gnus-cite-find-prefix number)) - (gnus-cite-add-face number skip gnus-cite-attribution-face))))) - -(defun gnus-dissect-cited-text () - "Dissect the article buffer looking for cited text." - (save-excursion - (set-buffer gnus-article-buffer) - (gnus-cite-parse-maybe) - (let ((alist gnus-cite-prefix-alist) - prefix numbers number marks m) - ;; Loop through citation prefixes. - (while alist - (setq numbers (pop alist) - prefix (pop numbers)) - (while numbers - (setq number (pop numbers)) - (goto-char (point-min)) - (forward-line number) - (push (cons (point-marker) "") marks) - (while (and numbers - (= (1- number) (car numbers))) - (setq number (pop numbers))) - (goto-char (point-min)) - (forward-line (1- number)) - (push (cons (point-marker) prefix) marks))) - ;; Skip to the beginning of the body. - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (push (cons (point-marker) "") marks) - ;; Find the end of the body. - (goto-char (point-max)) - (gnus-article-search-signature) - (push (cons (point-marker) "") marks) - ;; Sort the marks. - (setq marks (sort marks (lambda (m1 m2) (< (car m1) (car m2))))) - (let ((omarks marks)) - (setq marks nil) - (while (cdr omarks) - (if (= (caar omarks) (caadr omarks)) - (progn - (unless (equal (cdar omarks) "") - (push (car omarks) marks)) - (unless (equal (cdadr omarks) "") - (push (cadr omarks) marks)) - (unless (and (equal (cdar omarks) "") - (equal (cdadr omarks) "") - (not (cddr omarks))) - (setq omarks (cdr omarks)))) - (push (car omarks) marks)) - (setq omarks (cdr omarks))) - (when (car omarks) - (push (car omarks) marks)) - (setq marks (setq m (nreverse marks))) - (while (cddr m) - (if (and (equal (cdadr m) "") - (equal (cdar m) (cdaddr m)) - (goto-char (caadr m)) - (forward-line 1) - (= (point) (caaddr m))) - (setcdr m (cdddr m)) - (setq m (cdr m)))) - marks)))) - -(defun gnus-article-fill-cited-article (&optional force width) - "Do word wrapping in the current article. -If WIDTH (the numerical prefix), use that text width when filling." - (interactive (list t current-prefix-arg)) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (marks (gnus-dissect-cited-text)) - (adaptive-fill-mode nil) - (filladapt-mode nil) - (fill-column (if width (prefix-numeric-value width) fill-column))) - (save-restriction - (while (cdr marks) - (widen) - (narrow-to-region (caar marks) (caadr marks)) - (let ((adaptive-fill-regexp - (concat "^" (regexp-quote (cdar marks)) " *")) - (fill-prefix (cdar marks))) - (fill-region (point-min) (point-max))) - (set-marker (caar marks) nil) - (setq marks (cdr marks))) - (when marks - (set-marker (caar marks) nil)) - ;; All this information is now incorrect. - (setq gnus-cite-prefix-alist nil - gnus-cite-attribution-alist nil - gnus-cite-loose-prefix-alist nil - gnus-cite-loose-attribution-alist nil - gnus-cite-article nil))))) - -(defun gnus-article-hide-citation (&optional arg force) - "Toggle hiding of all cited text except attribution lines. -See the documentation for `gnus-article-highlight-citation'. -If given a negative prefix, always show; if given a positive prefix, -always hide." - (interactive (append (gnus-article-hidden-arg) (list 'force))) - (setq gnus-cited-text-button-line-format-spec - (gnus-parse-format gnus-cited-text-button-line-format - gnus-cited-text-button-line-format-alist t)) - (save-excursion - (set-buffer gnus-article-buffer) - (cond - ((gnus-article-check-hidden-text 'cite arg) - t) - ((gnus-article-text-type-exists-p 'cite) - (let ((buffer-read-only nil)) - (gnus-article-hide-text-of-type 'cite))) - (t - (let ((buffer-read-only nil) - (marks (gnus-dissect-cited-text)) - (inhibit-point-motion-hooks t) - (props (nconc (list 'article-type 'cite) - gnus-hidden-properties)) - beg end) - (while marks - (setq beg nil - end nil) - (while (and marks (string= (cdar marks) "")) - (setq marks (cdr marks))) - (when marks - (setq beg (caar marks))) - (while (and marks (not (string= (cdar marks) ""))) - (setq marks (cdr marks))) - (when marks - (setq end (caar marks))) - ;; Skip past lines we want to leave visible. - (when (and beg end gnus-cited-lines-visible) - (goto-char beg) - (forward-line gnus-cited-lines-visible) - (if (>= (point) end) - (setq beg nil) - (setq beg (point-marker)))) - (when (and beg end) - (gnus-add-text-properties beg end props) - (goto-char beg) - (unless (save-excursion (search-backward "\n\n" nil t)) - (insert "\n")) - (put-text-property - (point) - (progn - (gnus-article-add-button - (point) - (progn (eval gnus-cited-text-button-line-format-spec) (point)) - `gnus-article-toggle-cited-text (cons beg end)) - (point)) - 'article-type 'annotation) - (set-marker beg (point))))))))) - -(defun gnus-article-toggle-cited-text (region) - "Toggle hiding the text in REGION." - (let (buffer-read-only) - (funcall - (if (text-property-any - (car region) (1- (cdr region)) - (car gnus-hidden-properties) (cadr gnus-hidden-properties)) - 'remove-text-properties 'gnus-add-text-properties) - (car region) (cdr region) gnus-hidden-properties))) - -(defun gnus-article-hide-citation-maybe (&optional arg force) - "Toggle hiding of cited text that has an attribution line. -If given a negative prefix, always show; if given a positive prefix, -always hide. -This will do nothing unless at least `gnus-cite-hide-percentage' -percent and at least `gnus-cite-hide-absolute' lines of the body is -cited text with attributions. When called interactively, these two -variables are ignored. -See also the documentation for `gnus-article-highlight-citation'." - (interactive (append (gnus-article-hidden-arg) (list 'force))) - (unless (gnus-article-check-hidden-text 'cite arg) - (save-excursion - (set-buffer gnus-article-buffer) - (gnus-cite-parse-maybe force) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (let ((start (point)) - (atts gnus-cite-attribution-alist) - (buffer-read-only nil) - (inhibit-point-motion-hooks t) - (hiden 0) - total) - (goto-char (point-max)) - (gnus-article-search-signature) - (setq total (count-lines start (point))) - (while atts - (setq hiden (+ hiden (length (cdr (assoc (cdar atts) - gnus-cite-prefix-alist)))) - atts (cdr atts))) - (when (or force - (and (> (* 100 hiden) (* gnus-cite-hide-percentage total)) - (> hiden gnus-cite-hide-absolute))) - (setq atts gnus-cite-attribution-alist) - (while atts - (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist)) - atts (cdr atts)) - (while total - (setq hiden (car total) - total (cdr total)) - (goto-line hiden) - (unless (assq hiden gnus-cite-attribution-alist) - (gnus-add-text-properties - (point) (progn (forward-line 1) (point)) - (nconc (list 'article-type 'cite) - gnus-hidden-properties)))))))))) - -(defun gnus-article-hide-citation-in-followups () - "Hide cited text in non-root articles." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((article (cdr gnus-article-current))) - (unless (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-article-displayed-root-p article)) - (gnus-article-hide-citation))))) - -;;; Internal functions: - -(defun gnus-cite-parse-maybe (&optional force) - ;; Parse if the buffer has changes since last time. - (if (equal gnus-cite-article gnus-article-current) - () - ;;Reset parser information. - (setq gnus-cite-prefix-alist nil - gnus-cite-attribution-alist nil - gnus-cite-loose-prefix-alist nil - gnus-cite-loose-attribution-alist nil) - ;; Parse if not too large. - (if (and (not force) - gnus-cite-parse-max-size - (> (buffer-size) gnus-cite-parse-max-size)) - () - (setq gnus-cite-article (cons (car gnus-article-current) - (cdr gnus-article-current))) - (gnus-cite-parse-wrapper)))) - -(defun gnus-cite-parse-wrapper () - ;; Wrap chopped gnus-cite-parse - (goto-char (point-min)) - (unless (search-forward "\n\n" nil t) - (goto-char (point-max))) - (save-excursion - (gnus-cite-parse-attributions)) - ;; Try to avoid check citation if there is no reason to believe - ;; that article has citations - (if (or gnus-cite-always-check - (save-excursion - (re-search-backward gnus-cite-reply-regexp nil t)) - gnus-cite-loose-attribution-alist) - (progn (save-excursion - (gnus-cite-parse)) - (save-excursion - (gnus-cite-connect-attributions))))) - -(defun gnus-cite-parse () - ;; Parse and connect citation prefixes and attribution lines. - - ;; Parse current buffer searching for citation prefixes. - (let ((line (1+ (count-lines (point-min) (point)))) - (case-fold-search t) - (max (save-excursion - (goto-char (point-max)) - (gnus-article-search-signature) - (point))) - alist entry start begin end numbers prefix) - ;; Get all potential prefixes in `alist'. - (while (< (point) max) - ;; Each line. - (setq begin (point) - end (progn (beginning-of-line 2) (point)) - start end) - (goto-char begin) - ;; Ignore standard Supercite attribution prefix. - (when (looking-at gnus-supercite-regexp) - (if (match-end 1) - (setq end (1+ (match-end 1))) - (setq end (1+ begin)))) - ;; Ignore very long prefixes. - (when (> end (+ (point) gnus-cite-max-prefix)) - (setq end (+ (point) gnus-cite-max-prefix))) - (while (re-search-forward gnus-cite-prefix-regexp (1- end) t) - ;; Each prefix. - (setq end (match-end 0) - prefix (buffer-substring begin end)) - (gnus-set-text-properties 0 (length prefix) nil prefix) - (setq entry (assoc prefix alist)) - (if entry - (setcdr entry (cons line (cdr entry))) - (push (list prefix line) alist)) - (goto-char begin)) - (goto-char start) - (setq line (1+ line))) - ;; We got all the potential prefixes. Now create - ;; `gnus-cite-prefix-alist' containing the oldest prefix for each - ;; line that appears at least gnus-cite-minimum-match-count - ;; times. First sort them by length. Longer is older. - (setq alist (sort alist (lambda (a b) - (> (length (car a)) (length (car b)))))) - (while alist - (setq entry (car alist) - prefix (car entry) - numbers (cdr entry) - alist (cdr alist)) - (cond ((null numbers) - ;; No lines with this prefix that wasn't also part of - ;; a longer prefix. - ) - ((< (length numbers) gnus-cite-minimum-match-count) - ;; Too few lines with this prefix. We keep it a bit - ;; longer in case it is an exact match for an attribution - ;; line, but we don't remove the line from other - ;; prefixes. - (push entry gnus-cite-prefix-alist)) - (t - (push entry - gnus-cite-prefix-alist) - ;; Remove articles from other prefixes. - (let ((loop alist) - current) - (while loop - (setq current (car loop) - loop (cdr loop)) - (setcdr current - (gnus-set-difference (cdr current) numbers))))))))) - -(defun gnus-cite-parse-attributions () - (let (al-alist) - ;; Parse attributions - (while (re-search-forward gnus-cite-attribution-suffix (point-max) t) - (let* ((start (match-beginning 0)) - (end (match-end 0)) - (wrote (count-lines (point-min) end)) - (prefix (gnus-cite-find-prefix wrote)) - ;; Check previous line for an attribution leader. - (tag (progn - (beginning-of-line 1) - (when (looking-at gnus-supercite-secondary-regexp) - (buffer-substring (match-beginning 1) - (match-end 1))))) - (in (progn - (goto-char start) - (and (re-search-backward gnus-cite-attribution-prefix - (save-excursion - (beginning-of-line 0) - (point)) - t) - (not (re-search-forward gnus-cite-attribution-suffix - start t)) - (count-lines (point-min) (1+ (point))))))) - (when (eq wrote in) - (setq in nil)) - (goto-char end) - ;; don't add duplicates - (let ((al (buffer-substring (save-excursion (beginning-of-line 0) - (1+ (point))) - end))) - (if (not (assoc al al-alist)) - (progn - (push (list wrote in prefix tag) - gnus-cite-loose-attribution-alist) - (push (cons al t) al-alist)))))))) - -(defun gnus-cite-connect-attributions () - ;; Connect attributions to citations - - ;; No citations have been connected to attribution lines yet. - (setq gnus-cite-loose-prefix-alist (append gnus-cite-prefix-alist nil)) - - ;; Parse current buffer searching for attribution lines. - ;; Find exact supercite citations. - (gnus-cite-match-attributions 'small nil - (lambda (prefix tag) - (when tag - (concat "\\`" - (regexp-quote prefix) "[ \t]*" - (regexp-quote tag) ">")))) - ;; Find loose supercite citations after attributions. - (gnus-cite-match-attributions 'small t - (lambda (prefix tag) - (when tag - (concat "\\<" - (regexp-quote tag) - "\\>")))) - ;; Find loose supercite citations anywhere. - (gnus-cite-match-attributions 'small nil - (lambda (prefix tag) - (when tag - (concat "\\<" - (regexp-quote tag) - "\\>")))) - ;; Find nested citations after attributions. - (gnus-cite-match-attributions 'small-if-unique t - (lambda (prefix tag) - (concat "\\`" (regexp-quote prefix) ".+"))) - ;; Find nested citations anywhere. - (gnus-cite-match-attributions 'small nil - (lambda (prefix tag) - (concat "\\`" (regexp-quote prefix) ".+"))) - ;; Remove loose prefixes with too few lines. - (let ((alist gnus-cite-loose-prefix-alist) - entry) - (while alist - (setq entry (car alist) - alist (cdr alist)) - (when (< (length (cdr entry)) gnus-cite-minimum-match-count) - (setq gnus-cite-prefix-alist - (delq entry gnus-cite-prefix-alist) - gnus-cite-loose-prefix-alist - (delq entry gnus-cite-loose-prefix-alist))))) - ;; Find flat attributions. - (gnus-cite-match-attributions 'first t nil) - ;; Find any attributions (are we getting desperate yet?). - (gnus-cite-match-attributions 'first nil nil)) - -(defun gnus-cite-match-attributions (sort after fun) - ;; Match all loose attributions and citations (SORT AFTER FUN) . - ;; - ;; If SORT is `small', the citation with the shortest prefix will be - ;; used, if it is `first' the first prefix will be used, if it is - ;; `small-if-unique' the shortest prefix will be used if the - ;; attribution line does not share its own prefix with other - ;; loose attribution lines, otherwise the first prefix will be used. - ;; - ;; If AFTER is non-nil, only citations after the attribution line - ;; will be considered. - ;; - ;; If FUN is non-nil, it will be called with the arguments (WROTE - ;; PREFIX TAG) and expected to return a regular expression. Only - ;; citations whose prefix matches the regular expression will be - ;; considered. - ;; - ;; WROTE is the attribution line number. - ;; PREFIX is the attribution line prefix. - ;; TAG is the Supercite tag on the attribution line. - (let ((atts gnus-cite-loose-attribution-alist) - (case-fold-search t) - att wrote in prefix tag regexp limit smallest best size) - (while atts - (setq att (car atts) - atts (cdr atts) - wrote (nth 0 att) - in (nth 1 att) - prefix (nth 2 att) - tag (nth 3 att) - regexp (if fun (funcall fun prefix tag) "") - size (cond ((eq sort 'small) t) - ((eq sort 'first) nil) - (t (< (length (gnus-cite-find-loose prefix)) 2))) - limit (if after wrote -1) - smallest 1000000 - best nil) - (let ((cites gnus-cite-loose-prefix-alist) - cite candidate numbers first compare) - (while cites - (setq cite (car cites) - cites (cdr cites) - candidate (car cite) - numbers (cdr cite) - first (apply 'min numbers) - compare (if size (length candidate) first)) - (and (> first limit) - regexp - (string-match regexp candidate) - (< compare smallest) - (setq best cite - smallest compare)))) - (if (null best) - () - (setq gnus-cite-loose-attribution-alist - (delq att gnus-cite-loose-attribution-alist)) - (push (cons wrote (car best)) gnus-cite-attribution-alist) - (when in - (push (cons in (car best)) gnus-cite-attribution-alist)) - (when (memq best gnus-cite-loose-prefix-alist) - (let ((loop gnus-cite-prefix-alist) - (numbers (cdr best)) - current) - (setq gnus-cite-loose-prefix-alist - (delq best gnus-cite-loose-prefix-alist)) - (while loop - (setq current (car loop) - loop (cdr loop)) - (if (eq current best) - () - (setcdr current (gnus-set-difference (cdr current) numbers)) - (when (null (cdr current)) - (setq gnus-cite-loose-prefix-alist - (delq current gnus-cite-loose-prefix-alist) - atts (delq current atts))))))))))) - -(defun gnus-cite-find-loose (prefix) - ;; Return a list of loose attribution lines prefixed by PREFIX. - (let* ((atts gnus-cite-loose-attribution-alist) - att line lines) - (while atts - (setq att (car atts) - line (car att) - atts (cdr atts)) - (when (string-equal (gnus-cite-find-prefix line) prefix) - (push line lines))) - lines)) - -(defun gnus-cite-add-face (number prefix face) - ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line. - (when face - (let ((inhibit-point-motion-hooks t) - from to) - (goto-line number) - (unless (eobp);; Sometimes things become confused. - (forward-char (length prefix)) - (skip-chars-forward " \t") - (setq from (point)) - (end-of-line 1) - (skip-chars-backward " \t") - (setq to (point)) - (when (< from to) - (gnus-overlay-put (gnus-make-overlay from to) 'face face)))))) - -(defun gnus-cite-toggle (prefix) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - (numbers (cdr (assoc prefix gnus-cite-prefix-alist))) - (inhibit-point-motion-hooks t) - number) - (while numbers - (setq number (car numbers) - numbers (cdr numbers)) - (goto-line number) - (cond ((get-text-property (point) 'invisible) - (remove-text-properties (point) (progn (forward-line 1) (point)) - gnus-hidden-properties)) - ((assq number gnus-cite-attribution-alist)) - (t - (gnus-add-text-properties - (point) (progn (forward-line 1) (point)) - (nconc (list 'article-type 'cite) - gnus-hidden-properties)))))))) - -(defun gnus-cite-find-prefix (line) - ;; Return citation prefix for LINE. - (let ((alist gnus-cite-prefix-alist) - (prefix "") - entry) - (while alist - (setq entry (car alist) - alist (cdr alist)) - (when (memq line (cdr entry)) - (setq prefix (car entry)))) - prefix)) - -(gnus-add-shutdown 'gnus-cache-close 'gnus) - -(defun gnus-cache-close () - (setq gnus-cite-prefix-alist nil)) - -(gnus-ems-redefine) - -(provide 'gnus-cite) - -;;; gnus-cite.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-cus.el --- a/lisp/gnus/gnus-cus.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,650 +0,0 @@ -;;; gnus-cus.el --- customization commands for Gnus -;; -;; Copyright (C) 1996 Free Software Foundation, Inc. - -;; Author: Per Abrahamsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'wid-edit) -(require 'gnus-score) - -;;; Widgets: - -;; There should be special validation for this. -(define-widget 'gnus-email-address 'string - "An email address") - -(defun gnus-custom-mode () - "Major mode for editing Gnus customization buffers. - -The following commands are available: - -\\[widget-forward] Move to next button or editable field. -\\[widget-backward] Move to previous button or editable field. -\\[widget-button-click] Activate button under the mouse pointer. -\\[widget-button-press] Activate button under point. - -Entry to this mode calls the value of `gnus-custom-mode-hook' -if that value is non-nil." - (kill-all-local-variables) - (setq major-mode 'gnus-custom-mode - mode-name "Gnus Customize") - (use-local-map widget-keymap) - (run-hooks 'gnus-custom-mode-hook)) - -;;; Group Customization: - -(defconst gnus-group-parameters - '((to-address (gnus-email-address :tag "To Address") "\ -This will be used when doing followups and posts. - -This is primarily useful in mail groups that represent closed -mailing lists--mailing lists where it's expected that everybody that -writes to the mailing list is subscribed to it. Since using this -parameter ensures that the mail only goes to the mailing list itself, -it means that members won't receive two copies of your followups. - -Using `to-address' will actually work whether the group is foreign or -not. Let's say there's a group on the server that is called -`fa.4ad-l'. This is a real newsgroup, but the server has gotten the -articles from a mail-to-news gateway. Posting directly to this group -is therefore impossible--you have to send mail to the mailing list -address instead.") - - (to-list (gnus-email-address :tag "To List") "\ -This address will be used when doing a `a' in the group. - -It is totally ignored when doing a followup--except that if it is -present in a news group, you'll get mail group semantics when doing -`f'.") - - (broken-reply-to (const :tag "Broken Reply To" t) "\ -Ignore `Reply-To' headers in this group. - -That can be useful if you're reading a mailing list group where the -listserv has inserted `Reply-To' headers that point back to the -listserv itself. This is broken behavior. So there!") - - (to-group (string :tag "To Group") "\ -All posts will be send to the specified group.") - - (gcc-self (choice :tag "GCC" - :value t - (const t) - (const none) - (string :format "%v" :hide-front-space t)) "\ -Specify default value for GCC header. - -If this symbol is present in the group parameter list and set to `t', -new composed messages will be `Gcc''d to the current group. If it is -present and set to `none', no `Gcc:' header will be generated, if it -is present and a string, this string will be inserted literally as a -`gcc' header (this symbol takes precedence over any default `Gcc' -rules as described later).") - - (auto-expire (const :tag "Automatic Expire" t) "\ -All articles that are read will be marked as expirable.") - - (total-expire (const :tag "Total Expire" t) "\ -All read articles will be put through the expiry process - -This happens even if they are not marked as expirable. -Use with caution.") - - (expiry-wait (choice :tag "Expire Wait" - :value never - (const never) - (const immediate) - (number :hide-front-space t - :format "%v")) "\ -When to expire. - -Overrides any `nnmail-expiry-wait' and `nnmail-expiry-wait-function' -when expiring expirable messages. The value can either be a number of -days (not necessarily an integer) or the symbols `never' or -`immediate'.") - - (score-file (file :tag "Score File") "\ -Make the specified file into the current score file. -This means that all score commands you issue will end up in this file.") - - (adapt-file (file :tag "Adapt File") "\ -Make the specified file into the current adaptive file. -All adaptive score entries will be put into this file.") - - (admin-address (gnus-email-address :tag "Admin Address") "\ -Administration address for a mailing list. - -When unsubscribing to a mailing list you should never send the -unsubscription notice to the mailing list itself. Instead, you'd -send messages to the administrative address. This parameter allows -you to put the admin address somewhere convenient.") - - (display (choice :tag "Display" - :value default - (const all) - (const default)) "\ -Which articles to display on entering the group. - -`all' - Display all articles, both read and unread. - -`default' - Display the default visible articles, which normally includes - unread and ticked articles.") - - (comment (string :tag "Comment") "\ -An arbitrary comment on the group.")) - "Alist of valid group parameters. - -Each entry has the form (NAME TYPE DOC), where NAME is the parameter -itself (a symbol), TYPE is the parameters type (a sexp widget), and -DOC is a documentation string for the parameter.") - -(defvar gnus-custom-params) -(defvar gnus-custom-method) -(defvar gnus-custom-group) - -(defun gnus-group-customize (group &optional part) - "Edit the group on the current line." - (interactive (list (gnus-group-group-name))) - (let ((part (or part 'info)) - info - (types (mapcar (lambda (entry) - `(cons :format "%v%h\n" - :doc ,(nth 2 entry) - (const :format "" ,(nth 0 entry)) - ,(nth 1 entry))) - gnus-group-parameters))) - (unless group - (error "No group on current line")) - (unless (setq info (gnus-get-info group)) - (error "Killed group; can't be edited")) - ;; Ready. - (kill-buffer (get-buffer-create "*Gnus Customize*")) - (switch-to-buffer (get-buffer-create "*Gnus Customize*")) - (gnus-custom-mode) - (make-local-variable 'gnus-custom-group) - (setq gnus-custom-group group) - (widget-insert "Customize the ") - (widget-create 'info-link - :help-echo "Push me to learn more." - :tag "group parameters" - "(gnus)Group Parameters") - (widget-insert " for <") - (widget-insert group) - (widget-insert "> and press ") - (widget-create 'push-button - :tag "done" - :help-echo "Push me when done customizing." - :action 'gnus-group-customize-done) - (widget-insert ".\n\n") - (make-local-variable 'gnus-custom-params) - (setq gnus-custom-params - (widget-create 'group - :value (gnus-info-params info) - `(set :inline t - :greedy t - :tag "Parameters" - :format "%t:\n%h%v" - :doc "\ -These special paramerters are recognized by Gnus. -Check the [ ] for the parameters you want to apply to this group, then -edit the value to suit your taste." - ,@types) - '(repeat :inline t - :tag "Variables" - :format "%t:\n%h%v%i\n\n" - :doc "\ -Set variables local to the group you are entering. - -If you want to turn threading off in `news.answers', you could put -`(gnus-show-threads nil)' in the group parameters of that group. -`gnus-show-threads' will be made into a local variable in the summary -buffer you enter, and the form `nil' will be `eval'ed there. - -This can also be used as a group-specific hook function, if you'd -like. If you want to hear a beep when you enter a group, you could -put something like `(dummy-variable (ding))' in the parameters of that -group. `dummy-variable' will be set to the result of the `(ding)' -form, but who cares?" - (group :value (nil nil) - (symbol :tag "Variable") - (sexp :tag - "Value"))) - - '(repeat :inline t - :tag "Unknown entries" - sexp))) - (widget-insert "\n\nYou can also edit the ") - (widget-create 'info-link - :tag "select method" - :help-echo "Push me to learn more about select methods." - "(gnus)Select Methods") - (widget-insert " for the group.\n") - (setq gnus-custom-method - (widget-create 'sexp - :tag "Method" - :value (gnus-info-method info))) - (use-local-map widget-keymap) - (widget-setup))) - -(defun gnus-group-customize-done (&rest ignore) - "Apply changes and bury the buffer." - (interactive) - (gnus-group-edit-group-done 'params gnus-custom-group - (widget-value gnus-custom-params)) - (gnus-group-edit-group-done 'method gnus-custom-group - (widget-value gnus-custom-method)) - (bury-buffer)) - -;;; Score Customization: - -(defconst gnus-score-parameters - '((mark (number :tag "Mark") "\ -The value of this entry should be a number. -Any articles with a score lower than this number will be marked as read.") - - (expunge (number :tag "Expunge") "\ -The value of this entry should be a number. -Any articles with a score lower than this number will be removed from -the summary buffer.") - - (mark-and-expunge (number :tag "Mark-and-expunge") "\ -The value of this entry should be a number. -Any articles with a score lower than this number will be marked as -read and removed from the summary buffer.") - - (thread-mark-and-expunge (number :tag "Thread-mark-and-expunge") "\ -The value of this entry should be a number. -All articles that belong to a thread that has a total score below this -number will be marked as read and removed from the summary buffer. -`gnus-thread-score-function' says how to compute the total score -for a thread.") - - (files (repeat :tag "Files" file) "\ -The value of this entry should be any number of file names. -These files are assumed to be score files as well, and will be loaded -the same way this one was.") - - (exclude-files (repeat :tag "Exclude-files" file) "\ -The clue of this entry should be any number of files. -These files will not be loaded, even though they would normally be so, -for some reason or other.") - - (eval (sexp :tag "Eval" :value nil) "\ -The value of this entry will be `eval'el. -This element will be ignored when handling global score files.") - - (read-only (boolean :tag "Read-only" :value t) "\ -Read-only score files will not be updated or saved. -Global score files should feature this atom.") - - (orphan (number :tag "Orphan") "\ -The value of this entry should be a number. -Articles that do not have parents will get this number added to their -scores. Imagine you follow some high-volume newsgroup, like -`comp.lang.c'. Most likely you will only follow a few of the threads, -also want to see any new threads. - -You can do this with the following two score file entries: - - (orphan -500) - (mark-and-expunge -100) - -When you enter the group the first time, you will only see the new -threads. You then raise the score of the threads that you find -interesting (with `I T' or `I S'), and ignore (`C y') the rest. -Next time you enter the group, you will see new articles in the -interesting threads, plus any new threads. - -I.e.---the orphan score atom is for high-volume groups where there -exist a few interesting threads which can't be found automatically -by ordinary scoring rules.") - - (adapt (choice :tag "Adapt" - (const t) - (const ignore) - (sexp :format "%v" - :hide-front-space t)) "\ -This entry controls the adaptive scoring. -If it is `t', the default adaptive scoring rules will be used. If it -is `ignore', no adaptive scoring will be performed on this group. If -it is a list, this list will be used as the adaptive scoring rules. -If it isn't present, or is something other than `t' or `ignore', the -default adaptive scoring rules will be used. If you want to use -adaptive scoring on most groups, you'd set `gnus-use-adaptive-scoring' -to `t', and insert an `(adapt ignore)' in the groups where you do not -want adaptive scoring. If you only want adaptive scoring in a few -groups, you'd set `gnus-use-adaptive-scoring' to `nil', and insert -`(adapt t)' in the score files of the groups where you want it.") - - (adapt-file (file :tag "Adapt-file") "\ -All adaptive score entries will go to the file named by this entry. -It will also be applied when entering the group. This atom might -be handy if you want to adapt on several groups at once, using the -same adaptive file for a number of groups.") - - (local (repeat :tag "Local" - (group :value (nil nil) - (symbol :tag "Variable") - (sexp :tag "Value"))) "\ -The value of this entry should be a list of `(VAR VALUE)' pairs. -Each VAR will be made buffer-local to the current summary buffer, -and set to the value specified. This is a convenient, if somewhat -strange, way of setting variables in some groups if you don't like -hooks much.") - (touched (sexp :format "Touched\n") "Internal variable.")) - "Alist of valid symbolic score parameters. - -Each entry has the form (NAME TYPE DOC), where NAME is the parameter -itself (a symbol), TYPE is the parameters type (a sexp widget), and DOC is a -documentation string for the parameter.") - -(define-widget 'gnus-score-string 'group - "Edit score entries for string-valued headers." - :convert-widget 'gnus-score-string-convert) - -(defun gnus-score-string-convert (widget) - ;; Set args appropriately. - (let* ((tag (widget-get widget :tag)) - (item `(const :format "" :value ,(downcase tag))) - (match '(string :tag "Match")) - (score '(choice :tag "Score" - (const :tag "default" nil) - (integer :format "%v" - :hide-front-space t))) - (expire '(choice :tag "Expire" - (const :tag "off" nil) - (integer :format "%v" - :hide-front-space t))) - (type '(choice :tag "Type" - :value s - ;; I should really create a forgiving :match - ;; function for each type below, that only - ;; looked at the first letter. - (const :tag "Regexp" r) - (const :tag "Regexp (fixed case)" R) - (const :tag "Substring" s) - (const :tag "Substring (fixed case)" S) - (const :tag "Exact" e) - (const :tag "Exact (fixed case)" E) - (const :tag "Word" w) - (const :tag "Word (fixed case)" W) - (const :tag "default" nil))) - (group `(group ,match ,score ,expire ,type)) - (doc (concat (or (widget-get widget :doc) - (concat "Change score based on the " tag - " header.\n")) - " -You can have an arbitrary number of score entries for this header, -each score entry has four elements: - -1. The \"match element\". This should be the string to look for in the - header. - -2. The \"score element\". This number should be an integer in the - neginf to posinf interval. This number is added to the score - of the article if the match is successful. If this element is - not present, the `gnus-score-interactive-default-score' number - will be used instead. This is 1000 by default. - -3. The \"date element\". This date says when the last time this score - entry matched, which provides a mechanism for expiring the - score entries. It this element is not present, the score - entry is permanent. The date is represented by the number of - days since December 31, 1 ce. - -4. The \"type element\". This element specifies what function should - be used to see whether this score entry matches the article. - - There are the regexp, as well as substring types, and exact match, - and word match types. If this element is not present, Gnus will - assume that substring matching should be used. There is case - sensitive variants of all match types."))) - (widget-put widget :args `(,item - (repeat :inline t - :indent 0 - :tag ,tag - :doc ,doc - :format "%t:\n%h%v%i\n\n" - (choice :format "%v" - :value ("" nil nil s) - ,group - sexp))))) - widget) - -(define-widget 'gnus-score-integer 'group - "Edit score entries for integer-valued headers." - :convert-widget 'gnus-score-integer-convert) - -(defun gnus-score-integer-convert (widget) - ;; Set args appropriately. - (let* ((tag (widget-get widget :tag)) - (item `(const :format "" :value ,(downcase tag))) - (match '(integer :tag "Match")) - (score '(choice :tag "Score" - (const :tag "default" nil) - (integer :format "%v" - :hide-front-space t))) - (expire '(choice :tag "Expire" - (const :tag "off" nil) - (integer :format "%v" - :hide-front-space t))) - (type '(choice :tag "Type" - :value < - (const <) - (const >) - (const =) - (const >=) - (const <=))) - (group `(group ,match ,score ,expire ,type)) - (doc (concat (or (widget-get widget :doc) - (concat "Change score based on the " tag - " header."))))) - (widget-put widget :args `(,item - (repeat :inline t - :indent 0 - :tag ,tag - :doc ,doc - :format "%t:\n%h%v%i\n\n" - ,group)))) - widget) - -(define-widget 'gnus-score-date 'group - "Edit score entries for date-valued headers." - :convert-widget 'gnus-score-date-convert) - -(defun gnus-score-date-convert (widget) - ;; Set args appropriately. - (let* ((tag (widget-get widget :tag)) - (item `(const :format "" :value ,(downcase tag))) - (match '(string :tag "Match")) - (score '(choice :tag "Score" - (const :tag "default" nil) - (integer :format "%v" - :hide-front-space t))) - (expire '(choice :tag "Expire" - (const :tag "off" nil) - (integer :format "%v" - :hide-front-space t))) - (type '(choice :tag "Type" - :value regexp - (const regexp) - (const before) - (const at) - (const after))) - (group `(group ,match ,score ,expire ,type)) - (doc (concat (or (widget-get widget :doc) - (concat "Change score based on the " tag - " header.")) - " -For the Date header we have three kinda silly match types: `before', -`at' and `after'. I can't really imagine this ever being useful, but, -like, it would feel kinda silly not to provide this function. Just in -case. You never know. Better safe than sorry. Once burnt, twice -shy. Don't judge a book by its cover. Never not have sex on a first -date. (I have been told that at least one person, and I quote, -\"found this function indispensable\", however.) - -A more useful match type is `regexp'. With it, you can match the date -string using a regular expression. The date is normalized to ISO8601 -compact format first---`YYYYMMDDTHHMMSS'. If you want to match all -articles that have been posted on April 1st in every year, you could -use `....0401.........' as a match string, for instance. (Note that -the date is kept in its original time zone, so this will match -articles that were posted when it was April 1st where the article was -posted from. Time zones are such wholesome fun for the whole family, -eh?"))) - (widget-put widget :args `(,item - (repeat :inline t - :indent 0 - :tag ,tag - :doc ,doc - :format "%t:\n%h%v%i\n\n" - ,group)))) - widget) - -(defvar gnus-custom-scores) -(defvar gnus-custom-score-alist) - -(defun gnus-score-customize (file) - "Customize score file FILE." - (interactive (list gnus-current-score-file)) - (let ((scores (gnus-score-load file)) - (types (mapcar (lambda (entry) - `(group :format "%v%h\n" - :doc ,(nth 2 entry) - (const :format "" ,(nth 0 entry)) - ,(nth 1 entry))) - gnus-score-parameters))) - ;; Ready. - (kill-buffer (get-buffer-create "*Gnus Customize*")) - (switch-to-buffer (get-buffer-create "*Gnus Customize*")) - (gnus-custom-mode) - (make-local-variable 'gnus-custom-score-alist) - (setq gnus-custom-score-alist scores) - (widget-insert "Customize the ") - (widget-create 'info-link - :help-echo "Push me to learn more." - :tag "score entries" - "(gnus)Score File Format") - (widget-insert " for\n\t") - (widget-insert file) - (widget-insert "\nand press ") - (widget-create 'push-button - :tag "done" - :help-echo "Push me when done customizing." - :action 'gnus-score-customize-done) - (widget-insert ".\n -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 - (widget-create 'group - :value scores - `(checklist :inline t - :greedy t - (gnus-score-string :tag "From") - (gnus-score-string :tag "Subject") - (gnus-score-string :tag "References") - (gnus-score-string :tag "Xref") - (gnus-score-string :tag "Message-ID") - (gnus-score-integer :tag "Lines") - (gnus-score-integer :tag "Chars") - (gnus-score-date :tag "Date") - (gnus-score-string :tag "Head" - :doc "\ -Match all headers in the article. - -Using one of `Head', `Body', `All' will slow down scoring considerable. -") - (gnus-score-string :tag "Body" - :doc "\ -Match the body sans header of the article. - -Using one of `Head', `Body', `All' will slow down scoring considerable. -") - (gnus-score-string :tag "All" - :doc "\ -Match the entire article, including both headers and body. - -Using one of `Head', `Body', `All' will slow down scoring -considerable. -") - (gnus-score-string :tag - "Followup" - :doc "\ -Score all followups to the specified authors. - -This entry is somewhat special, in that it will match the `From:' -header, and affect the score of not only the matching articles, but -also all followups to the matching articles. This allows you -e.g. increase the score of followups to your own articles, or decrease -the score of followups to the articles of some known trouble-maker. -") - (gnus-score-string :tag "Thread" - :doc "\ -Add a score entry on all articles that are part of a thread. - -This match key works along the same lines as the `Followup' match key. -If you say that you want to score on a (sub-)thread that is started by -an article with a `Message-ID' X, then you add a `thread' match. This -will add a new `thread' match for each article that has X in its -`References' header. (These new `thread' matches will use the -`Message-ID's of these matching articles.) This will ensure that you -can raise/lower the score of an entire thread, even though some -articles in the thread may not have complete `References' headers. -Note that using this may lead to undeterministic scores of the -articles in the thread. -") - ,@types) - '(repeat :inline t - :tag "Unknown entries" - sexp))) - (use-local-map widget-keymap) - (widget-setup))) - -(defun gnus-score-customize-done (&rest ignore) - "Reset the score alist with the present value." - (let ((alist gnus-custom-score-alist) - (value (widget-value gnus-custom-scores))) - (setcar alist (car value)) - (setcdr alist (cdr value)) - (gnus-score-set 'touched '(t) alist)) - (bury-buffer)) - -;;; The End: - -(provide 'gnus-cus) - -;;; gnus-cus.el ends here - diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-demon.el --- a/lisp/gnus/gnus-demon.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,306 +0,0 @@ -;;; gnus-demon.el --- daemonic Gnus behaviour -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-int) -(require 'nnheader) -(eval-and-compile - (if (string-match "XEmacs" (emacs-version)) - (require 'itimer) - (require 'timer))) - -(defgroup gnus-demon nil - "Demonic behaviour." - :group 'gnus) - -(defcustom gnus-demon-handlers nil - "Alist of daemonic handlers to be run at intervals. -Each handler is a list on the form - -\(FUNCTION TIME IDLE) - -FUNCTION is the function to be called. -TIME is the number of `gnus-demon-timestep's between each call. -If nil, never call. If t, call each `gnus-demon-timestep'. -If IDLE is t, only call if Emacs has been idle for a while. If IDLE -is a number, only call when Emacs has been idle more than this number -of `gnus-demon-timestep's. If IDLE is nil, don't care about -idleness. If IDLE is a number and TIME is nil, then call once each -time Emacs has been idle for IDLE `gnus-demon-timestep's." - :group 'gnus-demon - :type '(repeat (list function - (choice :tag "Time" - (const :tag "never" nil) - (const :tag "one" t) - (integer :tag "steps" 1)) - (choice :tag "Idle" - (const :tag "don't care" nil) - (const :tag "for a while" t) - (integer :tag "steps" 1))))) - -(defcustom gnus-demon-timestep 60 - "*Number of seconds in each demon timestep." - :group 'gnus-demon - :type 'integer) - -;;; Internal variables. - -(defvar gnus-demon-timer nil) -(defvar gnus-demon-idle-has-been-called nil) -(defvar gnus-demon-idle-time 0) -(defvar gnus-demon-handler-state nil) -(defvar gnus-demon-last-keys nil) -(defvar gnus-inhibit-demon nil - "*If non-nil, no daemonic function will be run.") - -(eval-and-compile - (autoload 'timezone-parse-date "timezone") - (autoload 'timezone-make-arpa-date "timezone")) - -;;; Functions. - -(defun gnus-demon-add-handler (function time idle) - "Add the handler FUNCTION to be run at TIME and IDLE." - ;; First remove any old handlers that use this function. - (gnus-demon-remove-handler function) - ;; Then add the new one. - (push (list function time idle) gnus-demon-handlers) - (gnus-demon-init)) - -(defun gnus-demon-remove-handler (function &optional no-init) - "Remove the handler FUNCTION from the list of handlers." - (setq gnus-demon-handlers - (delq (assq function gnus-demon-handlers) - gnus-demon-handlers)) - (unless no-init - (gnus-demon-init))) - -(defun gnus-demon-init () - "Initialize the Gnus daemon." - (interactive) - (gnus-demon-cancel) - (if (null gnus-demon-handlers) - () ; Nothing to do. - ;; Set up timer. - (setq gnus-demon-timer - (nnheader-run-at-time - gnus-demon-timestep gnus-demon-timestep 'gnus-demon)) - ;; Reset control variables. - (setq gnus-demon-handler-state - (mapcar - (lambda (handler) - (list (car handler) (gnus-demon-time-to-step (nth 1 handler)) - (nth 2 handler))) - gnus-demon-handlers)) - (setq gnus-demon-idle-time 0) - (setq gnus-demon-idle-has-been-called nil) - (setq gnus-use-demon t))) - -(gnus-add-shutdown 'gnus-demon-cancel 'gnus) - -(defun gnus-demon-cancel () - "Cancel any Gnus daemons." - (interactive) - (when gnus-demon-timer - (nnheader-cancel-timer gnus-demon-timer)) - (setq gnus-demon-timer nil - gnus-use-demon nil) - (condition-case () - (nnheader-cancel-function-timers 'gnus-demon) - (error t))) - -(defun gnus-demon-is-idle-p () - "Whether Emacs is idle or not." - ;; We do this simply by comparing the 100 most recent keystrokes - ;; with the ones we had last time. If they are the same, one might - ;; guess that Emacs is indeed idle. This only makes sense if one - ;; calls this function seldom -- like once a minute, which is what - ;; we do here. - (let ((keys (recent-keys))) - (or (equal keys gnus-demon-last-keys) - (progn - (setq gnus-demon-last-keys keys) - nil)))) - -(defun gnus-demon-time-to-step (time) - "Find out how many seconds to TIME, which is on the form \"17:43\"." - (if (not (stringp time)) - time - (let* ((now (current-time)) - ;; obtain NOW as discrete components -- make a vector for speed - (nowParts (apply 'vector (decode-time now))) - ;; obtain THEN as discrete components - (thenParts (timezone-parse-time time)) - (thenHour (string-to-int (elt thenParts 0))) - (thenMin (string-to-int (elt thenParts 1))) - ;; convert time as elements into number of seconds since EPOCH. - (then (encode-time 0 - thenMin - thenHour - ;; If THEN is earlier than NOW, make it - ;; same time tomorrow. Doc for encode-time - ;; says that this is OK. - (+ (elt nowParts 3) - (if (or (< thenHour (elt nowParts 2)) - (and (= thenHour (elt nowParts 2)) - (<= thenMin (elt nowParts 1)))) - 1 0)) - (elt nowParts 4) - (elt nowParts 5) - (elt nowParts 6) - (elt nowParts 7) - (elt nowParts 8))) - ;; calculate number of seconds between NOW and THEN - (diff (+ (* 65536 (- (car then) (car now))) - (- (cadr then) (cadr now))))) - ;; return number of timesteps in the number of seconds - (round (/ diff gnus-demon-timestep))))) - -(defun gnus-demon () - "The Gnus daemon that takes care of running all Gnus handlers." - ;; Increase or reset the time Emacs has been idle. - (if (gnus-demon-is-idle-p) - (incf gnus-demon-idle-time) - (setq gnus-demon-idle-time 0) - (setq gnus-demon-idle-has-been-called nil)) - ;; Disable all daemonic stuff if we're in the minibuffer - (when (and (not (window-minibuffer-p (selected-window))) - (not gnus-inhibit-demon)) - ;; Then we go through all the handler and call those that are - ;; sufficiently ripe. - (let ((handlers gnus-demon-handler-state) - (gnus-inhibit-demon t) - handler time idle) - (while handlers - (setq handler (pop handlers)) - (cond - ((numberp (setq time (nth 1 handler))) - ;; These handlers use a regular timeout mechanism. We decrease - ;; the timer if it hasn't reached zero yet. - (unless (zerop time) - (setcar (nthcdr 1 handler) (decf time))) - (and (zerop time) ; If the timer now is zero... - ;; Test for appropriate idleness - (progn - (setq idle (nth 2 handler)) - (cond - ((null idle) t) ; Don't care about idle. - ((numberp idle) ; Numerical idle... - (< idle gnus-demon-idle-time)) ; Idle timed out. - (t (< 0 gnus-demon-idle-time)))) ; Or just need to be idle. - ;; So we call the handler. - (progn - (ignore-errors (funcall (car handler))) - ;; And reset the timer. - (setcar (nthcdr 1 handler) - (gnus-demon-time-to-step - (nth 1 (assq (car handler) gnus-demon-handlers))))))) - ;; These are only supposed to be called when Emacs is idle. - ((null (setq idle (nth 2 handler))) - ;; We do nothing. - ) - ((and (not (numberp idle)) - (gnus-demon-is-idle-p)) - ;; We want to call this handler each and every time that - ;; Emacs is idle. - (ignore-errors (funcall (car handler)))) - (t - ;; We want to call this handler only if Emacs has been idle - ;; for a specified number of timesteps. - (and (not (memq (car handler) gnus-demon-idle-has-been-called)) - (< idle gnus-demon-idle-time) - (gnus-demon-is-idle-p) - (progn - (ignore-errors (funcall (car handler))) - ;; Make sure the handler won't be called once more in - ;; 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)) - -(defun gnus-demon-close-connections () - (save-window-excursion - (gnus-close-backends))) - -(defun gnus-demon-add-scanmail () - "Add daemonic scanning of mail from the mail backends." - (gnus-demon-add-handler 'gnus-demon-scan-mail 120 60)) - -(defun gnus-demon-scan-mail () - (save-window-excursion - (let ((servers gnus-opened-servers) - server) - (while (setq server (car (pop servers))) - (and (gnus-check-backend-function 'request-scan (car server)) - (or (gnus-server-opened server) - (gnus-open-server server)) - (gnus-request-scan nil server)))))) - -(defun gnus-demon-add-rescan () - "Add daemonic scanning of new articles from all backends." - (gnus-demon-add-handler 'gnus-demon-scan-news 120 60)) - -(defun gnus-demon-scan-news () - (save-window-excursion - (when (gnus-alive-p) - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-group-get-new-news))))) - -(defun gnus-demon-add-scan-timestamps () - "Add daemonic updating of timestamps in empty newgroups." - (gnus-demon-add-handler 'gnus-demon-scan-timestamps nil 30)) - -(defun gnus-demon-scan-timestamps () - "Set the timestamp on all newsgroups with no unread and no ticked articles." - (when (gnus-alive-p) - (let ((cur-time (current-time)) - (newsrc (cdr gnus-newsrc-alist)) - info group unread has-ticked) - (while (setq info (pop newsrc)) - (setq group (gnus-info-group info) - unread (gnus-group-unread group) - has-ticked (cdr (assq 'tick (gnus-info-marks info)))) - (when (and (numberp unread) - (= unread 0) - (not has-ticked)) - (gnus-group-set-parameter group 'timestamp cur-time)))))) - -(provide 'gnus-demon) - -;;; gnus-demon.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-dup.el --- a/lisp/gnus/gnus-dup.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,158 +0,0 @@ -;;; gnus-dup.el --- suppression of duplicate articles in Gnus -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This package tries to mark articles as read the second time the -;; user reads a copy. This is useful if the server doesn't support -;; Xref properly, or if the user reads the same group from several -;; servers. - -;;; Code: - -(require 'gnus) -(require 'gnus-art) - -(defgroup gnus-duplicate nil - "Suppression of duplicate articles." - :group 'gnus) - -(defcustom gnus-save-duplicate-list nil - "*If non-nil, save the duplicate list when shutting down Gnus. -If nil, duplicate suppression will only work on duplicates -seen in the same session." - :group 'gnus-duplicate - :type 'boolean) - -(defcustom gnus-duplicate-list-length 10000 - "*The number of Message-IDs to keep in the duplicate suppression list." - :group 'gnus-duplicate - :type 'integer) - -(defcustom gnus-duplicate-file (nnheader-concat gnus-directory "suppression") - "*The name of the file to store the duplicate suppression list." - :group 'gnus-duplicate - :type 'file) - -;;; Internal variables - -(defvar gnus-dup-list nil) -(defvar gnus-dup-hashtb nil) - -(defvar gnus-dup-list-dirty nil) - -;;; -;;; Starting and stopping -;;; - -(gnus-add-shutdown 'gnus-dup-close 'gnus) - -(defun gnus-dup-close () - "Possibly save the duplicate suppression list and shut down the subsystem." - (gnus-dup-save) - (setq gnus-dup-list nil - gnus-dup-hashtb nil - gnus-dup-list-dirty nil)) - -(defun gnus-dup-open () - "Possibly read the duplicate suppression list and start the subsystem." - (if gnus-save-duplicate-list - (gnus-dup-read) - (setq gnus-dup-list nil)) - (setq gnus-dup-hashtb (gnus-make-hashtable gnus-duplicate-list-length)) - ;; Enter all Message-IDs into the hash table. - (let ((list gnus-dup-list) - (obarray gnus-dup-hashtb)) - (while list - (intern (pop list))))) - -(defun gnus-dup-read () - "Read the duplicate suppression list." - (setq gnus-dup-list nil) - (when (file-exists-p gnus-duplicate-file) - (load gnus-duplicate-file t t t))) - -(defun gnus-dup-save () - "Save the duplicate suppression list." - (when (and gnus-save-duplicate-list - gnus-dup-list-dirty) - (nnheader-temp-write gnus-duplicate-file - (gnus-prin1 `(setq gnus-dup-list ',gnus-dup-list)))) - (setq gnus-dup-list-dirty nil)) - -;;; -;;; Interface functions -;;; - -(defun gnus-dup-enter-articles () - "Enter articles from the current group for future duplicate suppression." - (unless gnus-dup-list - (gnus-dup-open)) - (setq gnus-dup-list-dirty t) ; mark list for saving - (let ((data gnus-newsgroup-data) - datum msgid) - ;; Enter the Message-IDs of all read articles into the list - ;; and hash table. - (while (setq datum (pop data)) - (when (and (not (gnus-data-pseudo-p datum)) - (> (gnus-data-number datum) 0) - (gnus-data-read-p datum) - (not (= (gnus-data-mark datum) gnus-canceled-mark)) - (setq msgid (mail-header-id (gnus-data-header datum))) - (not (nnheader-fake-message-id-p msgid)) - (not (intern-soft msgid gnus-dup-hashtb))) - (push msgid gnus-dup-list) - (intern msgid gnus-dup-hashtb)))) - ;; Chop off excess Message-IDs from the list. - (let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list))) - (when end - (setcdr end nil)))) - -(defun gnus-dup-suppress-articles () - "Mark duplicate articles as read." - (unless gnus-dup-list - (gnus-dup-open)) - (gnus-message 6 "Suppressing duplicates...") - (let ((headers gnus-newsgroup-headers) - number header) - (while (setq header (pop headers)) - (when (and (intern-soft (mail-header-id header) gnus-dup-hashtb) - (gnus-summary-article-unread-p (mail-header-number header))) - (setq gnus-newsgroup-unreads - (delq (setq number (mail-header-number header)) - gnus-newsgroup-unreads)) - (push (cons number gnus-duplicate-mark) - gnus-newsgroup-reads)))) - (gnus-message 6 "Suppressing duplicates...done")) - -(defun gnus-dup-unsuppress-article (article) - "Stop suppression of ARTICLE." - (let ((id (mail-header-id (gnus-data-header (gnus-data-find article))))) - (when id - (setq gnus-dup-list-dirty t) - (setq gnus-dup-list (delete id gnus-dup-list)) - (unintern id gnus-dup-hashtb)))) - -(provide 'gnus-dup) - -;;; gnus-dup.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-eform.el --- a/lisp/gnus/gnus-eform.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,130 +0,0 @@ -;;; gnus-eform.el --- a mode for editing forms for Gnus -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-win) - -;;; -;;; Editing forms -;;; - -(defgroup gnus-edit-form nil - "A mode for editing forms." - :group 'gnus) - -(defcustom gnus-edit-form-mode-hook nil - "Hook run in `gnus-edit-form-mode' buffers." - :group 'gnus-edit-form - :type 'hook) - -(defcustom gnus-edit-form-menu-hook nil - "Hook run when creating menus in `gnus-edit-form-mode' buffers." - :group 'gnus-edit-form - :type 'hook) - -;;; Internal variables - -(defvar gnus-edit-form-done-function nil) -(defvar gnus-edit-form-buffer "*Gnus edit form*") - -(defvar gnus-edit-form-mode-map nil) -(unless gnus-edit-form-mode-map - (setq gnus-edit-form-mode-map (copy-keymap emacs-lisp-mode-map)) - (gnus-define-keys gnus-edit-form-mode-map - "\C-c\C-c" gnus-edit-form-done - "\C-c\C-k" gnus-edit-form-exit)) - -(defun gnus-edit-form-make-menu-bar () - (unless (boundp 'gnus-edit-form-menu) - (easy-menu-define - gnus-edit-form-menu gnus-edit-form-mode-map "" - '("Edit Form" - ["Exit and save changes" gnus-edit-form-done t] - ["Exit" gnus-edit-form-exit t])) - (run-hooks 'gnus-edit-form-menu-hook))) - -(defun gnus-edit-form-mode () - "Major mode for editing forms. -It is a slightly enhanced emacs-lisp-mode. - -\\{gnus-edit-form-mode-map}" - (interactive) - (when (gnus-visual-p 'group-menu 'menu) - (gnus-edit-form-make-menu-bar)) - (kill-all-local-variables) - (setq major-mode 'gnus-edit-form-mode) - (setq mode-name "Edit Form") - (use-local-map gnus-edit-form-mode-map) - (make-local-variable 'gnus-edit-form-done-function) - (make-local-variable 'gnus-prev-winconf) - (run-hooks 'gnus-edit-form-mode-hook)) - -(defun gnus-edit-form (form documentation exit-func) - "Edit FORM in a new buffer. -Call EXIT-FUNC on exit. Display DOCUMENTATION in the beginning -of the buffer." - (let ((winconf (current-window-configuration))) - (set-buffer (get-buffer-create gnus-edit-form-buffer)) - (gnus-configure-windows 'edit-form) - (gnus-add-current-to-buffer-list) - (gnus-edit-form-mode) - (setq gnus-prev-winconf winconf) - (setq gnus-edit-form-done-function exit-func) - (erase-buffer) - (insert documentation) - (unless (bolp) - (insert "\n")) - (goto-char (point-min)) - (while (not (eobp)) - (insert ";;; ") - (forward-line 1)) - (insert ";; Type `C-c C-c' after you've finished editing.\n") - (insert "\n") - (let ((p (point))) - (pp form (current-buffer)) - (insert "\n") - (goto-char p)))) - -(defun gnus-edit-form-done () - "Update changes and kill the current buffer." - (interactive) - (goto-char (point-min)) - (let ((form (read (current-buffer))) - (func gnus-edit-form-done-function)) - (gnus-edit-form-exit) - (funcall func form))) - -(defun gnus-edit-form-exit () - "Kill the current buffer." - (interactive) - (let ((winconf gnus-prev-winconf)) - (kill-buffer (current-buffer)) - (set-window-configuration winconf))) - -(provide 'gnus-eform) - -;;; gnus-eform.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-ems.el --- a/lisp/gnus/gnus-ems.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,220 +0,0 @@ -;;; gnus-ems.el --- functions for making Gnus work under different Emacsen -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -;;; Function aliases later to be redefined for XEmacs usage. - -(defvar gnus-xemacs (string-match "XEmacs\\|Lucid" emacs-version) - "Non-nil if running under XEmacs.") - -(defvar gnus-mouse-2 [mouse-2]) -(defvar gnus-down-mouse-2 [down-mouse-2]) -(defvar gnus-mode-line-modified - (if (or gnus-xemacs - (< emacs-major-version 20)) - '("--**-" . "-----") - '("**" "--"))) - -(eval-and-compile - (autoload 'gnus-xmas-define "gnus-xmas") - (autoload 'gnus-xmas-redefine "gnus-xmas") - (autoload 'appt-select-lowest-window "appt")) - -(or (fboundp 'mail-file-babyl-p) - (fset 'mail-file-babyl-p 'rmail-file-p)) - -;;; Mule functions. - -(defun gnus-mule-cite-add-face (number prefix face) - ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line. - (when face - (let ((inhibit-point-motion-hooks t) - from to) - (goto-line number) - (if (boundp 'MULE) - (forward-char (chars-in-string prefix)) - (forward-char (length prefix))) - (skip-chars-forward " \t") - (setq from (point)) - (end-of-line 1) - (skip-chars-backward " \t") - (setq to (point)) - (when (< from to) - (gnus-overlay-put (gnus-make-overlay from to) 'face face))))) - -(defun gnus-mule-max-width-function (el max-width) - (` (let* ((val (eval (, el))) - (valstr (if (numberp val) - (int-to-string val) val))) - (if (> (length valstr) (, max-width)) - (truncate-string valstr (, max-width)) - valstr)))) - -(eval-and-compile - (if (string-match "XEmacs\\|Lucid" emacs-version) - nil - - (defvar gnus-mouse-face-prop 'mouse-face - "Property used for highlighting mouse regions.")) - - (cond - ((string-match "XEmacs\\|Lucid" emacs-version) - (gnus-xmas-define)) - - ((or (not (boundp 'emacs-minor-version)) - (< emacs-minor-version 30)) - ;; Remove the `intangible' prop. - (let ((props (and (boundp 'gnus-hidden-properties) - gnus-hidden-properties))) - (while (and props (not (eq (car (cdr props)) 'intangible))) - (setq props (cdr props))) - (when props - (setcdr props (cdr (cdr (cdr props)))))) - (unless (fboundp 'buffer-substring-no-properties) - (defun buffer-substring-no-properties (beg end) - (format "%s" (buffer-substring beg end))))) - - ((boundp 'MULE) - (provide 'gnusutil)))) - -(eval-and-compile - (cond - ((not window-system) - (defun gnus-dummy-func (&rest args)) - (let ((funcs '(mouse-set-point set-face-foreground - set-face-background x-popup-menu))) - (while funcs - (unless (fboundp (car funcs)) - (fset (car funcs) 'gnus-dummy-func)) - (setq funcs (cdr funcs)))))) - (unless (fboundp 'file-regular-p) - (defun file-regular-p (file) - (and (not (file-directory-p file)) - (not (file-symlink-p file)) - (file-exists-p file)))) - (unless (fboundp 'face-list) - (defun face-list (&rest args)))) - -(eval-and-compile - (let ((case-fold-search t)) - (cond - ((string-match "windows-nt\\|os/2\\|emx" (format "%s" system-type)) - (setq nnheader-file-name-translation-alist - (append nnheader-file-name-translation-alist - '((?: . ?_) - (?+ . ?-)))))))) - -(defvar gnus-tmp-unread) -(defvar gnus-tmp-replied) -(defvar gnus-tmp-score-char) -(defvar gnus-tmp-indentation) -(defvar gnus-tmp-opening-bracket) -(defvar gnus-tmp-lines) -(defvar gnus-tmp-name) -(defvar gnus-tmp-closing-bracket) -(defvar gnus-tmp-subject-or-nil) - -(defun gnus-ems-redefine () - (cond - ((string-match "XEmacs\\|Lucid" emacs-version) - (gnus-xmas-redefine)) - - ((featurep 'mule) - ;; Mule and new Emacs definitions - - ;; [Note] Now there are three kinds of mule implementations, - ;; original MULE, XEmacs/mule and beta version of Emacs including - ;; some mule features. Unfortunately these API are different. In - ;; particular, Emacs (including original MULE) and XEmacs are - ;; quite different. - ;; Predicates to check are following: - ;; (boundp 'MULE) is t only if MULE (original; anything older than - ;; Mule 2.3) is running. - ;; (featurep 'mule) is t when every mule variants are running. - - ;; These implementations may be able to share between original - ;; MULE and beta version of new Emacs. In addition, it is able to - ;; detect XEmacs/mule by (featurep 'mule) and to check variable - ;; `emacs-version'. In this case, implementation for XEmacs/mule - ;; may be able to share between XEmacs and XEmacs/mule. - - (defalias 'gnus-truncate-string 'truncate-string) - - (defvar gnus-summary-display-table nil - "Display table used in summary mode buffers.") - (fset 'gnus-cite-add-face 'gnus-mule-cite-add-face) - (fset 'gnus-max-width-function 'gnus-mule-max-width-function) - (fset 'gnus-summary-set-display-table 'ignore) - - (when (boundp 'gnus-check-before-posting) - (setq gnus-check-before-posting - (delq 'long-lines - (delq 'control-chars gnus-check-before-posting)))) - - (defun gnus-summary-line-format-spec () - (insert gnus-tmp-unread gnus-tmp-replied - gnus-tmp-score-char gnus-tmp-indentation) - (put-text-property - (point) - (progn - (insert - gnus-tmp-opening-bracket - (format "%4d: %-20s" - gnus-tmp-lines - (if (> (length gnus-tmp-name) 20) - (truncate-string gnus-tmp-name 20) - gnus-tmp-name)) - gnus-tmp-closing-bracket) - (point)) - gnus-mouse-face-prop gnus-mouse-face) - (insert " " gnus-tmp-subject-or-nil "\n")) - ))) - -(defun gnus-region-active-p () - "Say whether the region is active." - (and (boundp 'transient-mark-mode) - transient-mark-mode - (boundp 'mark-active) - mark-active)) - -(defun gnus-add-minor-mode (mode name map) - (if (fboundp 'add-minor-mode) - (add-minor-mode mode name map) - (unless (assq mode minor-mode-alist) - (push `(,mode ,name) minor-mode-alist)) - (unless (assq mode minor-mode-map-alist) - (push (cons mode map) - minor-mode-map-alist)))) - -(provide 'gnus-ems) - -;; Local Variables: -;; byte-compile-warnings: '(redefine callargs) -;; End: - -;;; gnus-ems.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-gl.el --- a/lisp/gnus/gnus-gl.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,859 +0,0 @@ -;;; gnus-gl.el --- an interface to GroupLens for Gnus -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Brad Miller -;; Keywords: news, score - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; GroupLens software and documentation is copyright (c) 1995 by Paul -;; Resnick (Massachusetts Institute of Technology); Brad Miller, John -;; Riedl, Jon Herlocker, and Joseph Konstan (University of Minnesota), -;; and David Maltz (Carnegie-Mellon University). -;; -;; Permission to use, copy, modify, and distribute this documentation -;; for non-commercial and commercial purposes without fee is hereby -;; granted provided that this copyright notice and permission notice -;; appears in all copies and that the names of the individuals and -;; institutions holding this copyright are not used in advertising or -;; publicity pertaining to this software without specific, written -;; prior permission. The copyright holders make no representations -;; about the suitability of this software and documentation for any -;; purpose. It is provided ``as is'' without express or implied -;; warranty. -;; -;; The copyright holders request that they be notified of -;; modifications of this code. Please send electronic mail to -;; grouplens@cs.umn.edu for more information or to announce derived -;; works. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Author: Brad Miller -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; User Documentation: -;; To use GroupLens you must load this file. -;; You must also register a pseudonym with the Better Bit Bureau. -;; http://www.cs.umn.edu/Research/GroupLens -;; -;; ---------------- For your .emacs or .gnus file ---------------- -;; -;; As of version 2.5, grouplens now works as a minor mode of -;; gnus-summary-mode. To get make that work you just need a couple of -;; hooks. -;; (setq gnus-use-grouplens t) -;; (setq grouplens-pseudonym "") -;; (setq grouplens-bbb-host "grouplens.cs.umn.edu") -;; -;; (setq gnus-summary-default-score 0) -;; -;; USING GROUPLENS -;; How do I Rate an article?? -;; Before you type n to go to the next article, hit a number from 1-5 -;; Type r in the summary buffer and you will be prompted. -;; Note that when you're in grouplens-minor-mode 'r' masks the -;; usual reply binding for 'r' -;; -;; What if, Gasp, I find a bug??? -;; Please type M-x gnus-gl-submit-bug-report. This will set up a -;; mail buffer with the state of variables and buffers that will help -;; me debug the problem. A short description up front would help too! -;; -;; How do I display the prediction for an article: -;; If you set the gnus-summary-line-format as shown above, the score -;; (prediction) will be shown automatically. -;; -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Programmer Notes -;; 10/9/95 -;; gnus-scores-articles contains the articles -;; When scoring is done, the call tree looks something like: -;; gnus-possibly-score-headers -;; ==> gnus-score-headers -;; ==> gnus-score-load-file -;; ==> get-all-mids (from the eval form) -;; -;; it would be nice to have one that gets called after all the other -;; headers have been scored. -;; we may want a variable gnus-grouplens-scale-factor -;; and gnus-grouplens-offset this would probably be either -3 or 0 -;; to make the scores centered around zero or not. -;; Notes 10/12/95 -;; According to Lars, Norse god of gnus, the simple way to insert a -;; call to an external function is to have a function added to the -;; variable gnus-score-find-files-function This new function -;; gnus-grouplens-score-alist will return a core alist that -;; has (("message-id" ("" score) ("" score)) -;; This seems like it would be pretty inefficient, though workable. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; TODO -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; 3. Add some more ways to rate messages -;; 4. Better error handling for token timeouts. -;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; bugs -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; - -;;; Code: - -(require 'gnus-score) -(require 'cl) -(require 'gnus) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; User variables -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar gnus-summary-grouplens-line-format - "%U\%R\%z%l%I\%(%[%4L: %-20,20n%]%) %s\n" - "*The line format spec in summary GroupLens mode buffers.") - -(defvar grouplens-pseudonym "" - "User's pseudonym. -This pseudonym is obtained during the registration process") - -(defvar grouplens-bbb-host "grouplens.cs.umn.edu" - "Host where the bbbd is running" ) - -(defvar grouplens-bbb-port 9000 - "Port where the bbbd is listening" ) - -(defvar grouplens-newsgroups - '("comp.groupware" "comp.human-factors" "comp.lang.c++" - "comp.lang.java" "comp.os.linux.admin" "comp.os.linux.advocacy" - "comp.os.linux.announce" "comp.os.linux.answers" - "comp.os.linux.development" "comp.os.linux.development.apps" - "comp.os.linux.development.system" "comp.os.linux.hardware" - "comp.os.linux.help" "comp.os.linux.m68k" "comp.os.linux.misc" - "comp.os.linux.networking" "comp.os.linux.setup" "comp.os.linux.x" - "mn.general" "rec.arts.movies" "rec.arts.movies.current-films" - "rec.food.recipes" "rec.humor") - "*Groups that are part of the GroupLens experiment.") - -(defvar grouplens-prediction-display 'prediction-spot - "valid values are: - prediction-spot -- an * corresponding to the prediction between 1 and 5, - confidence-interval -- a numeric confidence interval - prediction-bar -- |##### | the longer the bar, the better the article, - confidence-bar -- | ----- } the prediction is in the middle of the bar, - confidence-spot -- ) * | the spot gets bigger with more confidence, - prediction-num -- plain-old numeric value, - confidence-plus-minus -- prediction +/i confidence") - -(defvar grouplens-score-offset 0 - "Offset the prediction by this value. -Setting this variable to -2 would have the following effect on -GroupLens scores: - - 1 --> -2 - 2 --> -1 - 3 --> 0 - 4 --> 1 - 5 --> 2 - -The reason is that a user might want to do this is to combine -GroupLens predictions with scores calculated by other score methods.") - -(defvar grouplens-score-scale-factor 1 - "This variable allows the user to magnify the effect of GroupLens scores. -The scale factor is applied after the offset.") - -(defvar gnus-grouplens-override-scoring 'override - "Tell GroupLens to override the normal Gnus scoring mechanism. -GroupLens scores can be combined with gnus scores in one of three ways. -'override -- just use grouplens predictions for grouplens groups -'combine -- combine grouplens scores with gnus scores -'separate -- treat grouplens scores completely separate from gnus") - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Program global variables -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar grouplens-bbb-token nil - "Current session token number") - -(defvar grouplens-bbb-process nil - "Process Id of current bbbd network stream process") - -(defvar grouplens-bbb-buffer nil - "Buffer associated with the BBBD process") - -(defvar grouplens-rating-alist nil - "Current set of message-id rating pairs") - -(defvar grouplens-current-hashtable nil - "A hashtable to hold predictions from the BBB") - -(defvar grouplens-current-group nil) - -;;(defvar bbb-alist nil) - -(defvar bbb-timeout-secs 10 - "Number of seconds to wait for some response from the BBB. -If this times out we give up and assume that something has died..." ) - -(defvar grouplens-previous-article nil - "Message-ID of the last article read.") - -(defvar bbb-read-point) -(defvar bbb-response-point) - -(defun bbb-renew-hash-table () - (setq grouplens-current-hashtable (make-vector 100 0))) - -(bbb-renew-hash-table) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Utility Functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun bbb-connect-to-bbbd (host port) - (unless grouplens-bbb-buffer - (setq grouplens-bbb-buffer - (get-buffer-create (format " *BBBD trace: %s*" host))) - (save-excursion - (set-buffer grouplens-bbb-buffer) - (make-local-variable 'bbb-read-point) - (make-local-variable 'bbb-response-point) - (setq bbb-read-point (point-min)))) - - ;; if an old process is still running for some reason, kill it - (when grouplens-bbb-process - (ignore-errors - (when (eq 'open (process-status grouplens-bbb-process)) - (set-process-buffer grouplens-bbb-process nil) - (delete-process grouplens-bbb-process)))) - - ;; clear the trace buffer of old output - (save-excursion - (set-buffer grouplens-bbb-buffer) - (erase-buffer)) - - ;; open the connection to the server - (catch 'done - (condition-case error - (setq grouplens-bbb-process - (open-network-stream "BBBD" grouplens-bbb-buffer host port)) - (error (gnus-message 3 "Error: Failed to connect to BBB") - nil)) - (and (null grouplens-bbb-process) - (throw 'done nil)) - (save-excursion - (set-buffer grouplens-bbb-buffer) - (setq bbb-read-point (point-min)) - (or (bbb-read-response grouplens-bbb-process) - (throw 'done nil)))) - - ;; return the process - grouplens-bbb-process) - -(defun bbb-send-command (process command) - (goto-char (point-max)) - (insert command) - (insert "\r\n") - (setq bbb-read-point (point)) - (setq bbb-response-point (point)) - (set-marker (process-mark process) (point)) ; process output also comes here - (process-send-string process command) - (process-send-string process "\r\n") - (process-send-eof process)) - -(defun bbb-read-response (process) - "This function eats the initial response of OK or ERROR from the BBB." - (let ((case-fold-search nil) - match-end) - (goto-char bbb-read-point) - (while (and (not (search-forward "\r\n" nil t)) - (accept-process-output process bbb-timeout-secs)) - (goto-char bbb-read-point)) - (setq match-end (point)) - (goto-char bbb-read-point) - (setq bbb-read-point match-end) - (looking-at "OK"))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Login Functions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defun bbb-login () - "return the token number if login is successful, otherwise return nil" - (interactive) - (setq grouplens-bbb-token nil) - (if (not (equal grouplens-pseudonym "")) - (let ((bbb-process - (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port))) - (if bbb-process - (save-excursion - (set-buffer (process-buffer bbb-process)) - (bbb-send-command bbb-process - (concat "login " grouplens-pseudonym)) - (if (bbb-read-response bbb-process) - (setq grouplens-bbb-token (bbb-extract-token-number)) - (gnus-message 3 "Error: GroupLens login failed"))))) - (gnus-message 3 "Error: you must set a pseudonym")) - grouplens-bbb-token) - -(defun bbb-extract-token-number () - (let ((token-pos (search-forward "token=" nil t))) - (when (looking-at "[0-9]+") - (buffer-substring token-pos (match-end 0))))) - -(gnus-add-shutdown 'bbb-logout 'gnus) - -(defun bbb-logout () - "logout of bbb session" - (when grouplens-bbb-token - (let ((bbb-process - (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port))) - (when bbb-process - (save-excursion - (set-buffer (process-buffer bbb-process)) - (bbb-send-command bbb-process (concat "logout " grouplens-bbb-token)) - (bbb-read-response bbb-process)))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Get Predictions -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun bbb-build-mid-scores-alist (groupname) - "this function can be called as part of the function to return the -list of score files to use. See the gnus variable -gnus-score-find-score-files-function. - -*Note:* If you want to use grouplens scores along with calculated scores, -you should see the offset and scale variables. At this point, I don't -recommend using both scores and grouplens predictions together." - (setq grouplens-current-group groupname) - (when (member groupname grouplens-newsgroups) - (setq grouplens-previous-article nil) - ;; scores-alist should be a list of lists: - ;; ((("message-id" ("" score1 nil s) (" score2 nil s)))) - ;;`((("message-id" . ,predict-list))) ; Yes, this is the return value - (list - (list - (list (append (list "message-id") - (bbb-get-predictions (bbb-get-all-mids) groupname))))))) - -(defun bbb-get-predictions (midlist groupname) - "Ask the bbb for predictions, and build up the score alist." - (gnus-message 5 "Fetching Predictions...") - (if grouplens-bbb-token - (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host - grouplens-bbb-port))) - (when bbb-process - (save-excursion - (set-buffer (process-buffer bbb-process)) - (bbb-send-command bbb-process - (bbb-build-predict-command midlist groupname - grouplens-bbb-token)) - (if (bbb-read-response bbb-process) - (bbb-get-prediction-response bbb-process) - (gnus-message 1 "Invalid Token, login and try again") - (ding))))) - (gnus-message 3 "Error: You are not logged in to a BBB") - (ding))) - -(defun bbb-get-all-mids () - (mapcar (function (lambda (x) (mail-header-id x))) gnus-newsgroup-headers)) - -(defun bbb-build-predict-command (mlist grpname token) - (concat "getpredictions " token " " grpname "\r\n" - (mapconcat 'identity mlist "\r\n") "\r\n.\r\n")) - -(defun bbb-get-prediction-response (process) - (let ((case-fold-search nil)) - (goto-char bbb-read-point) - (while (and (not (search-forward ".\r\n" nil t)) - (accept-process-output process bbb-timeout-secs)) - (goto-char bbb-read-point)) - (goto-char (+ bbb-response-point 4));; we ought to be right before OK - (bbb-build-response-alist))) - -;; build-response-alist assumes that the cursor has been positioned at -;; the first line of the list of mid/rating pairs. -(defun bbb-build-response-alist () - (let (resp mid pred) - (while - (cond - ((looking-at "\\(<.*>\\) :nopred=") - ;;(push `(,(bbb-get-mid) ,gnus-summary-default-score nil s) resp) - (forward-line 1) - t) - ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\) :conflow=\\([0-9]\.[0-9][0-9]\\) :confhigh=\\([0-9]\.[0-9][0-9]\\)") - (setq mid (bbb-get-mid) - pred (bbb-get-pred)) - (push `(,mid ,pred nil s) resp) - (gnus-sethash mid (list pred (bbb-get-confl) (bbb-get-confh)) - grouplens-current-hashtable) - (forward-line 1) - t) - ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\)") - (setq mid (bbb-get-mid) - pred (bbb-get-pred)) - (push `(,mid ,pred nil s) resp) - (gnus-sethash mid (list pred 0 0) grouplens-current-hashtable) - (forward-line 1) - t) - (t nil))) - resp)) - -;; these "get" functions assume that there is an active match lying -;; around. Where the first parenthesized expression is the -;; message-id, and the second is the prediction, the third and fourth -;; are the confidence interval -;; -;; Since gnus assumes that scores are integer values?? we round the -;; prediction. -(defun bbb-get-mid () - (buffer-substring (match-beginning 1) (match-end 1))) - -(defun bbb-get-pred () - (let ((tpred (string-to-number (buffer-substring (match-beginning 2) - (match-end 2))))) - (if (> tpred 0) - (round (* grouplens-score-scale-factor - (+ grouplens-score-offset tpred))) - 1))) - -(defun bbb-get-confl () - (string-to-number (buffer-substring (match-beginning 4) (match-end 4)))) - -(defun bbb-get-confh () - (string-to-number (buffer-substring (match-beginning 4) (match-end 4)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Prediction Display -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defconst grplens-rating-range 4.0) -(defconst grplens-maxrating 5) -(defconst grplens-minrating 1) -(defconst grplens-predstringsize 12) - -(defvar gnus-tmp-score) -(defun bbb-grouplens-score (header) - (if (eq gnus-grouplens-override-scoring 'separate) - (bbb-grouplens-other-score header) - (let* ((rate-string (make-string 12 ?\ )) - (mid (mail-header-id header)) - (hashent (gnus-gethash mid grouplens-current-hashtable)) - (iscore gnus-tmp-score) - (low (car (cdr hashent))) - (high (car (cdr (cdr hashent))))) - (aset rate-string 0 ?|) - (aset rate-string 11 ?|) - (unless (member grouplens-current-group grouplens-newsgroups) - (unless (equal grouplens-prediction-display 'prediction-num) - (cond ((< iscore 0) - (setq iscore 1)) - ((> iscore 5) - (setq iscore 5)))) - (setq low 0) - (setq high 0)) - (if (and (bbb-valid-score iscore) - (not (null mid))) - (cond - ;; prediction-spot - ((equal grouplens-prediction-display 'prediction-spot) - (setq rate-string (bbb-fmt-prediction-spot rate-string iscore))) - ;; confidence-interval - ((equal grouplens-prediction-display 'confidence-interval) - (setq rate-string (bbb-fmt-confidence-interval iscore low high))) - ;; prediction-bar - ((equal grouplens-prediction-display 'prediction-bar) - (setq rate-string (bbb-fmt-prediction-bar rate-string iscore))) - ;; confidence-bar - ((equal grouplens-prediction-display 'confidence-bar) - (setq rate-string (format "| %4.2f |" iscore))) - ;; confidence-spot - ((equal grouplens-prediction-display 'confidence-spot) - (setq rate-string (format "| %4.2f |" iscore))) - ;; prediction-num - ((equal grouplens-prediction-display 'prediction-num) - (setq rate-string (bbb-fmt-prediction-num iscore))) - ;; confidence-plus-minus - ((equal grouplens-prediction-display 'confidence-plus-minus) - (setq rate-string (bbb-fmt-confidence-plus-minus iscore low high)) - ) - (t (gnus-message 3 "Invalid prediction display type"))) - (aset rate-string 5 ?N) (aset rate-string 6 ?A)) - rate-string))) - -;; Gnus user format function that doesn't depend on -;; bbb-build-mid-scores-alist being used as the score function, but is -;; instead called from gnus-select-group-hook. -- LAB -(defun bbb-grouplens-other-score (header) - (if (not (member grouplens-current-group grouplens-newsgroups)) - ;; Return an empty string - "" - (let* ((rate-string (make-string 12 ?\ )) - (mid (mail-header-id header)) - (hashent (gnus-gethash mid grouplens-current-hashtable)) - (pred (or (nth 0 hashent) 0)) - (low (nth 1 hashent)) - (high (nth 2 hashent))) - ;; Init rate-string - (aset rate-string 0 ?|) - (aset rate-string 11 ?|) - (unless (equal grouplens-prediction-display 'prediction-num) - (cond ((< pred 0) - (setq pred 1)) - ((> pred 5) - (setq pred 5)))) - ;; If no entry in BBB hash mark rate string as NA and return - (cond - ((null hashent) - (aset rate-string 5 ?N) - (aset rate-string 6 ?A) - rate-string) - - ((equal grouplens-prediction-display 'prediction-spot) - (bbb-fmt-prediction-spot rate-string pred)) - - ((equal grouplens-prediction-display 'confidence-interval) - (bbb-fmt-confidence-interval pred low high)) - - ((equal grouplens-prediction-display 'prediction-bar) - (bbb-fmt-prediction-bar rate-string pred)) - - ((equal grouplens-prediction-display 'confidence-bar) - (format "| %4.2f |" pred)) - - ((equal grouplens-prediction-display 'confidence-spot) - (format "| %4.2f |" pred)) - - ((equal grouplens-prediction-display 'prediction-num) - (bbb-fmt-prediction-num pred)) - - ((equal grouplens-prediction-display 'confidence-plus-minus) - (bbb-fmt-confidence-plus-minus pred low high)) - - (t - (gnus-message 3 "Invalid prediction display type") - (aset rate-string 0 ?|) - (aset rate-string 11 ?|) - rate-string))))) - -(defun bbb-valid-score (score) - (or (equal grouplens-prediction-display 'prediction-num) - (and (>= score grplens-minrating) - (<= score grplens-maxrating)))) - -(defun bbb-requires-confidence (format-type) - (or (equal format-type 'confidence-plus-minus) - (equal format-type 'confidence-spot) - (equal format-type 'confidence-interval))) - -(defun bbb-have-confidence (clow chigh) - (not (or (null clow) - (null chigh)))) - -(defun bbb-fmt-prediction-spot (rate-string score) - (aset rate-string - (round (* (/ (- score grplens-minrating) grplens-rating-range) - (+ (- grplens-predstringsize 4) 1.49))) - ?*) - rate-string) - -(defun bbb-fmt-confidence-interval (score low high) - (if (bbb-have-confidence low high) - (format "|%4.2f-%4.2f |" low high) - (bbb-fmt-prediction-num score))) - -(defun bbb-fmt-confidence-plus-minus (score low high) - (if (bbb-have-confidence low high) - (format "|%3.1f+/-%4.2f|" score (/ (- high low) 2.0)) - (bbb-fmt-prediction-num score))) - -(defun bbb-fmt-prediction-bar (rate-string score) - (let* ((i 1) - (step (/ grplens-rating-range (- grplens-predstringsize 4))) - (half-step (/ step 2)) - (loc (- grplens-minrating half-step))) - (while (< i (- grplens-predstringsize 2)) - (if (> score loc) - (aset rate-string i ?#) - (aset rate-string i ?\ )) - (setq i (+ i 1)) - (setq loc (+ loc step))) - ) - rate-string) - -(defun bbb-fmt-prediction-num (score) - (format "| %4.2f |" score)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; Put Ratings -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun bbb-put-ratings () - (if (and grouplens-bbb-token - grouplens-rating-alist - (member gnus-newsgroup-name grouplens-newsgroups)) - (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host - grouplens-bbb-port)) - (rate-command (bbb-build-rate-command grouplens-rating-alist))) - (if bbb-process - (save-excursion - (set-buffer (process-buffer bbb-process)) - (gnus-message 5 "Sending Ratings...") - (bbb-send-command bbb-process rate-command) - (if (bbb-read-response bbb-process) - (setq grouplens-rating-alist nil) - (gnus-message 1 - "Token timed out: call bbb-login and quit again") - (ding)) - (gnus-message 5 "Sending Ratings...Done")) - (gnus-message 3 "No BBB connection"))) - (setq grouplens-rating-alist nil))) - -(defun bbb-build-rate-command (rate-alist) - (concat "putratings " grouplens-bbb-token " " grouplens-current-group " \r\n" - (mapconcat '(lambda (this) ; form (mid . (score . time)) - (concat (car this) - " :rating=" (cadr this) ".00" - " :time=" (cddr this))) - rate-alist "\r\n") - "\r\n.\r\n")) - -;; Interactive rating functions. -(defun bbb-summary-rate-article (rating &optional midin) - (interactive "nRating: ") - (when (member gnus-newsgroup-name grouplens-newsgroups) - (let ((mid (or midin (bbb-get-current-id)))) - (if (and rating - (>= rating grplens-minrating) - (<= rating grplens-maxrating) - mid) - (let ((oldrating (assoc mid grouplens-rating-alist))) - (if oldrating - (setcdr oldrating (cons rating 0)) - (push `(,mid . (,rating . 0)) grouplens-rating-alist)) - (gnus-summary-mark-article nil (int-to-string rating))) - (gnus-message 3 "Invalid rating"))))) - -(defun grouplens-next-unread-article (rating) - "Select unread article after current one." - (interactive "P") - (when rating - (bbb-summary-rate-article rating)) - (gnus-summary-next-unread-article)) - -(defun grouplens-best-unread-article (rating) - "Select unread article after current one." - (interactive "P") - (when rating - (bbb-summary-rate-article rating)) - (gnus-summary-best-unread-article)) - -(defun grouplens-summary-catchup-and-exit (rating) - "Mark all articles not marked as unread in this newsgroup as read, - then exit. If prefix argument ALL is non-nil, all articles are - marked as read." - (interactive "P") - (when rating - (bbb-summary-rate-article rating)) - (if (numberp rating) - (gnus-summary-catchup-and-exit) - (gnus-summary-catchup-and-exit rating))) - -(defun grouplens-score-thread (score) - "Raise the score of the articles in the current thread with SCORE." - (interactive "nRating: ") - (let (e) - (save-excursion - (let ((articles (gnus-summary-articles-in-thread)) - article) - (while (setq article (pop articles)) - (gnus-summary-goto-subject article) - (gnus-set-global-variables) - (bbb-summary-rate-article score - (mail-header-id - (gnus-summary-article-header article))))) - (setq e (point))) - (let ((gnus-summary-check-current t)) - (or (zerop (gnus-summary-next-subject 1 t)) - (goto-char e)))) - (gnus-summary-recenter) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary)) - -(defun bbb-exit-group () - (bbb-put-ratings) - (bbb-renew-hash-table)) - -(defun bbb-get-current-id () - (if gnus-current-headers - (mail-header-id gnus-current-headers) - (gnus-message 3 "You must select an article before you rate it"))) - -(defun bbb-grouplens-group-p (group) - "Say whether GROUP is a GroupLens group." - (if (member group grouplens-newsgroups) " (GroupLens Enhanced)" "")) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; TIME SPENT READING -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar grouplens-current-starting-time nil) - -(defun grouplens-start-timer () - (setq grouplens-current-starting-time (current-time))) - -(defun grouplens-elapsed-time () - (let ((et (bbb-time-float (current-time)))) - (- et (bbb-time-float grouplens-current-starting-time)))) - -(defun bbb-time-float (timeval) - (+ (* (car timeval) 65536) - (cadr timeval))) - -(defun grouplens-do-time () - (when (member gnus-newsgroup-name grouplens-newsgroups) - (when grouplens-previous-article - (let ((elapsed-time (grouplens-elapsed-time)) - (oldrating (assoc grouplens-previous-article - grouplens-rating-alist))) - (if (not oldrating) - (push `(,grouplens-previous-article . (0 . ,elapsed-time)) - grouplens-rating-alist) - (setcdr oldrating (cons (cadr oldrating) elapsed-time))))) - (grouplens-start-timer) - (setq grouplens-previous-article (bbb-get-current-id)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; BUG REPORTING -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defconst gnus-gl-version "gnus-gl.el 2.50") -(defconst gnus-gl-maintainer-address "grouplens-bug@cs.umn.edu") -(defun gnus-gl-submit-bug-report () - "Submit via mail a bug report on gnus-gl" - (interactive) - (require 'reporter) - (reporter-submit-bug-report gnus-gl-maintainer-address - (concat "gnus-gl.el " gnus-gl-version) - (list 'grouplens-pseudonym - 'grouplens-bbb-host - 'grouplens-bbb-port - 'grouplens-newsgroups - 'grouplens-bbb-token - 'grouplens-bbb-process - 'grouplens-current-group - 'grouplens-previous-article) - nil - 'gnus-gl-get-trace)) - -(defun gnus-gl-get-trace () - "Insert the contents of the BBBD trace buffer" - (when grouplens-bbb-buffer - (insert-buffer grouplens-bbb-buffer))) - -;; -;; GroupLens minor mode -;; - -(defvar gnus-grouplens-mode nil - "Minor mode for providing a GroupLens interface in Gnus summary buffers.") - -(defvar gnus-grouplens-mode-map nil) - -(unless gnus-grouplens-mode-map - (setq gnus-grouplens-mode-map (make-keymap)) - (gnus-define-keys - gnus-grouplens-mode-map - "n" grouplens-next-unread-article - "r" bbb-summary-rate-article - "k" grouplens-score-thread - "c" grouplens-summary-catchup-and-exit - "," grouplens-best-unread-article)) - -(defun gnus-grouplens-make-menu-bar () - (unless (boundp 'gnus-grouplens-menu) - (easy-menu-define - gnus-grouplens-menu gnus-grouplens-mode-map "" - '("GroupLens" - ["Login" bbb-login t] - ["Rate" bbb-summary-rate-article t] - ["Next article" grouplens-next-unread-article t] - ["Best article" grouplens-best-unread-article t] - ["Raise thread" grouplens-score-thread t] - ["Report bugs" gnus-gl-submit-bug-report t])))) - -(defun gnus-grouplens-mode (&optional arg) - "Minor mode for providing a GroupLens interface in Gnus summary buffers." - (interactive "P") - (when (and (eq major-mode 'gnus-summary-mode) - (member gnus-newsgroup-name grouplens-newsgroups)) - (make-local-variable 'gnus-grouplens-mode) - (setq gnus-grouplens-mode - (if (null arg) (not gnus-grouplens-mode) - (> (prefix-numeric-value arg) 0))) - (when gnus-grouplens-mode - (make-local-hook 'gnus-select-article-hook) - (add-hook 'gnus-select-article-hook 'grouplens-do-time nil 'local) - (make-local-hook 'gnus-exit-group-hook) - (add-hook 'gnus-exit-group-hook 'bbb-exit-group nil 'local) - (make-local-variable 'gnus-score-find-score-files-function) - - (cond - ((eq gnus-grouplens-override-scoring 'combine) - ;; either add bbb-buld-mid-scores-alist to a list - ;; or make a list - (if (listp gnus-score-find-score-files-function) - (setq gnus-score-find-score-files-function - (append 'bbb-build-mid-scores-alist - gnus-score-find-score-files-function)) - (setq gnus-score-find-score-files-function - (list gnus-score-find-score-files-function - 'bbb-build-mid-scores-alist)))) - ;; leave the gnus-score-find-score-files variable alone - ((eq gnus-grouplens-override-scoring 'separate) - (add-hook 'gnus-select-group-hook - (lambda () - (bbb-get-predictions (bbb-get-all-mids) - gnus-newsgroup-name)))) - ;; default is to override - (t - (setq gnus-score-find-score-files-function - 'bbb-build-mid-scores-alist))) - - ;; Change how summary lines look - (make-local-variable 'gnus-summary-line-format) - (make-local-variable 'gnus-summary-line-format-spec) - (setq gnus-summary-line-format gnus-summary-grouplens-line-format) - (setq gnus-summary-line-format-spec nil) - (gnus-update-format-specifications nil 'summary) - (gnus-update-summary-mark-positions) - - ;; Set up the menu. - (when (and menu-bar-mode - (gnus-visual-p 'grouplens-menu 'menu)) - (gnus-grouplens-make-menu-bar)) - (gnus-add-minor-mode - 'gnus-grouplens-mode " GroupLens" gnus-grouplens-mode-map) - (run-hooks 'gnus-grouplens-mode-hook)))) - -(provide 'gnus-gl) - -;;; gnus-gl.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-group.el --- a/lisp/gnus/gnus-group.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,3345 +0,0 @@ -;;; gnus-group.el --- group mode commands for Gnus -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-start) -(require 'nnmail) -(require 'gnus-spec) -(require 'gnus-int) -(require 'gnus-range) -(require 'gnus-win) -(require 'gnus-undo) - -(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 news is no news" - "*Message displayed by Gnus when no groups are available." - :group 'gnus-start - :type 'string) - -(defcustom gnus-keep-same-level nil - "*Non-nil means that the next newsgroup after the current will be on the same level. -When you type, for instance, `n' after reading the last article in the -current newsgroup, you will go to the next newsgroup. If this variable -is nil, the next newsgroup will be the next from the group -buffer. -If this variable is non-nil, Gnus will either put you in the -next newsgroup with the same level, or, if no such newsgroup is -available, the next newsgroup with the lowest possible level higher -than the current level. -If this variable is `best', Gnus will make the next newsgroup the one -with the best level." - :group 'gnus-group-levels - :type '(choice (const nil) - (const best) - (sexp :tag "other" t))) - -(defcustom gnus-group-goto-unread t - "*If non-nil, movement commands will go to the next unread and subscribed group." - :link '(custom-manual "(gnus)Group Maneuvering") - :group 'gnus-group-various - :type 'boolean) - -(defcustom gnus-goto-next-group-when-activating t - "*If non-nil, the \\\\[gnus-group-get-new-news-this-group] command will advance point to the next group." - :link '(custom-manual "(gnus)Scanning New Messages") - :group 'gnus-group-various - :type 'boolean) - -(defcustom gnus-permanently-visible-groups nil - "*Regexp to match groups that should always be listed in the group buffer. -This means that they will still be listed when there are no unread -articles in the groups." - :group 'gnus-group-listing - :type 'regexp) - -(defcustom gnus-list-groups-with-ticked-articles t - "*If non-nil, list groups that have only ticked articles. -If nil, only list groups that have unread articles." - :group 'gnus-group-listing - :type 'boolean) - -(defcustom gnus-group-default-list-level gnus-level-subscribed - "*Default listing level. -Ignored if `gnus-group-use-permanent-levels' is non-nil." - :group 'gnus-group-listing - :type 'integer) - -(defcustom gnus-group-list-inactive-groups t - "*If non-nil, inactive groups will be listed." - :group 'gnus-group-listing - :group 'gnus-group-levels - :type 'boolean) - -(defcustom gnus-group-sort-function 'gnus-group-sort-by-alphabet - "*Function used for sorting the group buffer. -This function will be called with group info entries as the arguments -for the groups to be sorted. Pre-made functions include -`gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name', -`gnus-group-sort-by-unread', `gnus-group-sort-by-level', -`gnus-group-sort-by-score', `gnus-group-sort-by-method', and -`gnus-group-sort-by-rank'. - -This variable can also be a list of sorting functions. In that case, -the most significant sort function should be the last function in the -list." - :group 'gnus-group-listing - :link '(custom-manual "(gnus)Sorting Groups") - :type '(radio (function-item gnus-group-sort-by-alphabet) - (function-item gnus-group-sort-by-real-name) - (function-item gnus-group-sort-by-unread) - (function-item gnus-group-sort-by-level) - (function-item gnus-group-sort-by-score) - (function-item gnus-group-sort-by-method) - (function-item gnus-group-sort-by-rank) - (function :tag "other" nil))) - -(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l\n" - "*Format of group lines. -It works along the same lines as a normal formatting string, -with some simple extensions. - -%M Only marked articles (character, \"*\" or \" \") -%S Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \") -%L Level of subscribedness (integer) -%N Number of unread articles (integer) -%I Number of dormant articles (integer) -%i Number of ticked and dormant (integer) -%T Number of ticked articles (integer) -%R Number of read articles (integer) -%t Estimated total number of articles (integer) -%y Number of unread, unticked articles (integer) -%G Group name (string) -%g Qualified group name (string) -%D Group description (string) -%s Select method (string) -%o Moderated group (char, \"m\") -%p Process mark (char) -%O Moderated group (string, \"(m)\" or \"\") -%P Topic indentation (string) -%m Whether there is new(ish) mail in the group (char, \"%\") -%l Whether there are GroupLens predictions for this group (string) -%n Select from where (string) -%z A string that look like `<%s:%n>' if a foreign select method is used -%d The date the group was last entered. -%u User defined specifier. The next character in the format string should - be a letter. Gnus will call the function gnus-user-format-function-X, - where X is the letter following %u. The function will be passed the - current header as argument. The function should return a string, which - will be inserted into the buffer just like information from any other - group specifier. - -Text between %( and %) will be highlighted with `gnus-mouse-face' when -the mouse point move inside the area. There can only be one such area. - -Note that this format specification is not always respected. For -reasons of efficiency, when listing killed groups, this specification -is ignored altogether. If the spec is changed considerably, your -output may end up looking strange when listing both alive and killed -groups. - -If you use %o or %O, reading the active file will be slower and quite -a bit of extra memory will be used. %D will also worsen performance. -Also note that if you change the format specification to include any -of these specs, you must probably re-start Gnus to see them go into -effect." - :group 'gnus-group-visual - :type 'string) - -(defcustom gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}" - "*The format specification for the group mode line. -It works along the same lines as a normal formatting string, -with some simple extensions: - -%S The native news server. -%M The native select method. -%: \":\" if %S isn't \"\"." - :group 'gnus-group-visual - :type 'string) - -(defcustom gnus-group-mode-hook nil - "Hook for Gnus group mode." - :group 'gnus-group-various - :options '(gnus-topic-mode) - :type 'hook) - -(defcustom gnus-group-menu-hook nil - "Hook run after the creation of the group mode menu." - :group 'gnus-group-various - :type 'hook) - -(defcustom gnus-group-catchup-group-hook nil - "Hook run when catching up a group from the group buffer." - :group 'gnus-group-various - :link '(custom-manual "(gnus)Group Data") - :type 'hook) - -(defcustom gnus-group-update-group-hook nil - "Hook called when updating group lines." - :group 'gnus-group-visual - :type 'hook) - -(defcustom gnus-group-prepare-function 'gnus-group-prepare-flat - "*A function that is called to generate the group buffer. -The function is called with three arguments: The first is a number; -all group with a level less or equal to that number should be listed, -if the second is non-nil, empty groups should also be displayed. If -the third is non-nil, it is a number. No groups with a level lower -than this number should be displayed. - -The only current function implemented is `gnus-group-prepare-flat'." - :group 'gnus-group-listing - :type 'function) - -(defcustom gnus-group-prepare-hook nil - "Hook called after the group buffer has been generated. -If you want to modify the group buffer, you can use this hook." - :group 'gnus-group-listing - :type 'hook) - -(defcustom gnus-suspend-gnus-hook nil - "Hook called when suspending (not exiting) Gnus." - :group 'gnus-exit - :type 'hook) - -(defcustom gnus-exit-gnus-hook nil - "Hook called when exiting Gnus." - :group 'gnus-exit - :type 'hook) - -(defcustom gnus-after-exiting-gnus-hook nil - "Hook called after exiting Gnus." - :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." - :group 'gnus-group-visual - :type 'hook) - -(defcustom gnus-useful-groups - `(("(ding) mailing list mirrored at sunsite.auc.dk" - "emacs.ding" - (nntp "sunsite.auc.dk" - (nntp-address "sunsite.auc.dk"))) - ("Gnus help group" - "gnus-help" - (nndoc "gnus-help" - (nndoc-article-type mbox) - (eval `(nndoc-address - ,(let ((file (nnheader-find-etc-directory - "gnus-tut.txt" t))) - (unless file - (error "Couldn't find doc group")) - file)))))) - "Alist of useful group-server pairs." - :group 'gnus-group-listing - :type '(repeat (list (string :tag "Description") - (string :tag "Name") - (sexp :tag "Method")))) - -(defcustom gnus-group-highlight - '(;; News. - ((and (= unread 0) (not mailp) (eq level 1)) . - gnus-group-news-1-empty-face) - ((and (not mailp) (eq level 1)) . - gnus-group-news-1-face) - ((and (= unread 0) (not mailp) (eq level 2)) . - gnus-group-news-2-empty-face) - ((and (not mailp) (eq level 2)) . - gnus-group-news-2-face) - ((and (= unread 0) (not mailp) (eq level 3)) . - gnus-group-news-3-empty-face) - ((and (not mailp) (eq level 3)) . - gnus-group-news-3-face) - ((and (= unread 0) (not mailp)) . - gnus-group-news-low-empty-face) - ((and (not mailp)) . - gnus-group-news-low-face) - ;; Mail. - ((and (= unread 0) (eq level 1)) . - gnus-group-mail-1-empty-face) - ((eq level 1) . - gnus-group-mail-1-face) - ((and (= unread 0) (eq level 2)) . - gnus-group-mail-2-empty-face) - ((eq level 2) . - gnus-group-mail-2-face) - ((and (= unread 0) (eq level 3)) . - gnus-group-mail-3-empty-face) - ((eq level 3) . - gnus-group-mail-3-face) - ((= unread 0) . - gnus-group-mail-low-empty-face) - (t . - gnus-group-mail-low-face)) - "Controls the highlighting of group buffer lines. - -Below is a list of `Form'/`Face' pairs. When deciding how a a -particular group line should be displayed, each form is -evaluated. The content of the face field after the first true form is -used. You can change how those group lines are displayed by -editing the face field. - -It is also possible to change and add form fields, but currently that -requires an understanding of Lisp expressions. Hopefully this will -change in a future release. For now, you can use the following -variables in the Lisp expression: - -group: The name of the group. -unread: The number of unread articles in the group. -method: The select method used. -mailp: Whether it's a mail group or not. -level: The level of the group. -score: The score of the group. -ticked: The number of ticked articles." - :group 'gnus-group-visual - :type '(repeat (cons (sexp :tag "Form") face))) - -(defcustom gnus-new-mail-mark ?% - "Mark used for groups with new mail." - :group 'gnus-group-visual - :type 'character) - -;;; Internal variables - -(defvar gnus-group-sort-alist-function 'gnus-group-sort-flat - "Function for sorting the group buffer.") - -(defvar gnus-group-sort-selected-function 'gnus-group-sort-selected-flat - "Function for sorting the selected groups in the group buffer.") - -(defvar gnus-group-indentation-function nil) -(defvar gnus-goto-missing-group-function nil) -(defvar gnus-group-update-group-function nil) -(defvar gnus-group-goto-next-group-function nil - "Function to override finding the next group after listing groups.") - -(defvar gnus-group-edit-buffer nil) - -(defvar gnus-group-line-format-alist - `((?M gnus-tmp-marked-mark ?c) - (?S gnus-tmp-subscribed ?c) - (?L gnus-tmp-level ?d) - (?N (cond ((eq number t) "*" ) - ((numberp number) - (int-to-string - (+ number - (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) - (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))))) - (t number)) ?s) - (?R gnus-tmp-number-of-read ?s) - (?t gnus-tmp-number-total ?d) - (?y gnus-tmp-number-of-unread ?s) - (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d) - (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d) - (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) - (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d) - (?g gnus-tmp-group ?s) - (?G gnus-tmp-qualified-group ?s) - (?c (gnus-short-group-name gnus-tmp-group) ?s) - (?D gnus-tmp-newsgroup-description ?s) - (?o gnus-tmp-moderated ?c) - (?O gnus-tmp-moderated-string ?s) - (?p gnus-tmp-process-marked ?c) - (?s gnus-tmp-news-server ?s) - (?n gnus-tmp-news-method ?s) - (?P gnus-group-indentation ?s) - (?l gnus-tmp-grouplens ?s) - (?z gnus-tmp-news-method-string ?s) - (?m (gnus-group-new-mail gnus-tmp-group) ?c) - (?d (gnus-group-timestamp-string gnus-tmp-group) ?s) - (?u gnus-tmp-user-defined ?s))) - -(defvar gnus-group-mode-line-format-alist - `((?S gnus-tmp-news-server ?s) - (?M gnus-tmp-news-method ?s) - (?u gnus-tmp-user-defined ?s) - (?: gnus-tmp-colon ?s))) - -(defvar gnus-topic-topology nil - "The complete topic hierarchy.") - -(defvar gnus-topic-alist nil - "The complete topic-group alist.") - -(defvar gnus-group-marked nil) - -(defvar gnus-group-list-mode nil) - -;;; -;;; Gnus group mode -;;; - -(put 'gnus-group-mode 'mode-class 'special) - -(when t - (gnus-define-keys gnus-group-mode-map - " " gnus-group-read-group - "=" gnus-group-select-group - "\r" gnus-group-select-group - "\M-\r" gnus-group-quick-select-group - [(meta control return)] gnus-group-select-group-ephemerally - "j" gnus-group-jump-to-group - "n" gnus-group-next-unread-group - "p" gnus-group-prev-unread-group - "\177" gnus-group-prev-unread-group - [delete] gnus-group-prev-unread-group - "N" gnus-group-next-group - "P" gnus-group-prev-group - "\M-n" gnus-group-next-unread-group-same-level - "\M-p" gnus-group-prev-unread-group-same-level - "," gnus-group-best-unread-group - "." gnus-group-first-unread-group - "u" gnus-group-unsubscribe-current-group - "U" gnus-group-unsubscribe-group - "c" gnus-group-catchup-current - "C" gnus-group-catchup-current-all - "\M-c" gnus-group-clear-data - "l" gnus-group-list-groups - "L" gnus-group-list-all-groups - "m" gnus-group-mail - "g" gnus-group-get-new-news - "\M-g" gnus-group-get-new-news-this-group - "R" gnus-group-restart - "r" gnus-group-read-init-file - "B" gnus-group-browse-foreign-server - "b" gnus-group-check-bogus-groups - "F" gnus-group-find-new-groups - "\C-c\C-d" gnus-group-describe-group - "\M-d" gnus-group-describe-all-groups - "\C-c\C-a" gnus-group-apropos - "\C-c\M-\C-a" gnus-group-description-apropos - "a" gnus-group-post-news - "\ek" gnus-group-edit-local-kill - "\eK" gnus-group-edit-global-kill - "\C-k" gnus-group-kill-group - "\C-y" gnus-group-yank-group - "\C-w" gnus-group-kill-region - "\C-x\C-t" gnus-group-transpose-groups - "\C-c\C-l" gnus-group-list-killed - "\C-c\C-x" gnus-group-expire-articles - "\C-c\M-\C-x" gnus-group-expire-all-groups - "V" gnus-version - "s" gnus-group-save-newsrc - "z" gnus-group-suspend - "q" gnus-group-exit - "Q" gnus-group-quit - "?" gnus-group-describe-briefly - "\C-c\C-i" gnus-info-find-node - "\M-e" gnus-group-edit-group-method - "^" gnus-group-enter-server-mode - gnus-mouse-2 gnus-mouse-pick-group - "<" beginning-of-buffer - ">" end-of-buffer - "\C-c\C-b" gnus-bug - "\C-c\C-s" gnus-group-sort-groups - "t" gnus-topic-mode - "\C-c\M-g" gnus-activate-all-groups - "\M-&" gnus-group-universal-argument - "#" gnus-group-mark-group - "\M-#" gnus-group-unmark-group) - - (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map) - "m" gnus-group-mark-group - "u" gnus-group-unmark-group - "w" gnus-group-mark-region - "m" gnus-group-mark-buffer - "r" gnus-group-mark-regexp - "U" gnus-group-unmark-all-groups) - - (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map) - "d" gnus-group-make-directory-group - "h" gnus-group-make-help-group - "u" gnus-group-make-useful-group - "a" gnus-group-make-archive-group - "k" gnus-group-make-kiboze-group - "m" gnus-group-make-group - "E" gnus-group-edit-group - "e" gnus-group-edit-group-method - "p" gnus-group-edit-group-parameters - "v" gnus-group-add-to-virtual - "V" gnus-group-make-empty-virtual - "D" gnus-group-enter-directory - "f" gnus-group-make-doc-group - "w" gnus-group-make-web-group - "r" gnus-group-rename-group - "c" gnus-group-customize - "\177" gnus-group-delete-group - [delete] gnus-group-delete-group) - - (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map) - "b" gnus-group-brew-soup - "w" gnus-soup-save-areas - "s" gnus-soup-send-replies - "p" gnus-soup-pack-packet - "r" nnsoup-pack-replies) - - (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map) - "s" gnus-group-sort-groups - "a" gnus-group-sort-groups-by-alphabet - "u" gnus-group-sort-groups-by-unread - "l" gnus-group-sort-groups-by-level - "v" gnus-group-sort-groups-by-score - "r" gnus-group-sort-groups-by-rank - "m" gnus-group-sort-groups-by-method) - - (gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map) - "s" gnus-group-sort-selected-groups - "a" gnus-group-sort-selected-groups-by-alphabet - "u" gnus-group-sort-selected-groups-by-unread - "l" gnus-group-sort-selected-groups-by-level - "v" gnus-group-sort-selected-groups-by-score - "r" gnus-group-sort-selected-groups-by-rank - "m" gnus-group-sort-selected-groups-by-method) - - (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map) - "k" gnus-group-list-killed - "z" gnus-group-list-zombies - "s" gnus-group-list-groups - "u" gnus-group-list-all-groups - "A" gnus-group-list-active - "a" gnus-group-apropos - "d" gnus-group-description-apropos - "m" gnus-group-list-matching - "M" gnus-group-list-all-matching - "l" gnus-group-list-level) - - (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map) - "f" gnus-score-flush-cache) - - (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map) - "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) - "l" gnus-group-set-current-level - "t" gnus-group-unsubscribe-current-group - "s" gnus-group-unsubscribe-group - "k" gnus-group-kill-group - "y" gnus-group-yank-group - "w" gnus-group-kill-region - "\C-k" gnus-group-kill-level - "z" gnus-group-kill-all-zombies)) - -(defun gnus-group-make-menu-bar () - (gnus-turn-off-edit-menu 'group) - (unless (boundp 'gnus-group-reading-menu) - - (easy-menu-define - gnus-group-reading-menu gnus-group-mode-map "" - '("Group" - ["Read" gnus-group-read-group (gnus-group-group-name)] - ["Select" gnus-group-select-group (gnus-group-group-name)] - ["See old articles" (gnus-group-select-group 'all) - :keys "C-u SPC" :active (gnus-group-group-name)] - ["Catch up" gnus-group-catchup-current (gnus-group-group-name)] - ["Catch up all articles" gnus-group-catchup-current-all - (gnus-group-group-name)] - ["Check for new articles" gnus-group-get-new-news-this-group - (gnus-group-group-name)] - ["Toggle subscription" gnus-group-unsubscribe-current-group - (gnus-group-group-name)] - ["Kill" gnus-group-kill-group (gnus-group-group-name)] - ["Yank" gnus-group-yank-group gnus-list-of-killed-groups] - ["Describe" gnus-group-describe-group (gnus-group-group-name)] - ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)] - ;; Actually one should check, if any of the marked groups gives t for - ;; (gnus-check-backend-function 'request-expire-articles ...) - ["Expire articles" gnus-group-expire-articles - (or (and (gnus-group-group-name) - (gnus-check-backend-function - 'request-expire-articles - (gnus-group-group-name))) gnus-group-marked)] - ["Set group level" gnus-group-set-current-level - (gnus-group-group-name)] - ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)] - ["Customize" gnus-group-customize (gnus-group-group-name)] - ("Edit" - ["Parameters" gnus-group-edit-group-parameters - (gnus-group-group-name)] - ["Select method" gnus-group-edit-group-method - (gnus-group-group-name)] - ["Info" gnus-group-edit-group (gnus-group-group-name)] - ["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)] - ["Global kill file" gnus-group-edit-global-kill t]))) - - (easy-menu-define - gnus-group-group-menu gnus-group-mode-map "" - '("Groups" - ("Listing" - ["List unread subscribed groups" gnus-group-list-groups t] - ["List (un)subscribed groups" gnus-group-list-all-groups t] - ["List killed groups" gnus-group-list-killed gnus-killed-list] - ["List zombie groups" gnus-group-list-zombies gnus-zombie-list] - ["List level..." gnus-group-list-level t] - ["Describe all groups" gnus-group-describe-all-groups t] - ["Group apropos..." gnus-group-apropos t] - ["Group and description apropos..." gnus-group-description-apropos t] - ["List groups matching..." gnus-group-list-matching t] - ["List all groups matching..." gnus-group-list-all-matching t] - ["List active file" gnus-group-list-active t]) - ("Sort" - ["Default sort" gnus-group-sort-groups t] - ["Sort by method" gnus-group-sort-groups-by-method t] - ["Sort by rank" gnus-group-sort-groups-by-rank t] - ["Sort by score" gnus-group-sort-groups-by-score t] - ["Sort by level" gnus-group-sort-groups-by-level t] - ["Sort by unread" gnus-group-sort-groups-by-unread t] - ["Sort by name" gnus-group-sort-groups-by-alphabet t]) - ("Sort process/prefixed" - ["Default sort" gnus-group-sort-selected-groups - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by method" gnus-group-sort-selected-groups-by-method - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by rank" gnus-group-sort-selected-groups-by-rank - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by score" gnus-group-sort-selected-groups-by-score - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by level" gnus-group-sort-selected-groups-by-level - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by unread" gnus-group-sort-selected-groups-by-unread - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))] - ["Sort by name" gnus-group-sort-selected-groups-by-alphabet - (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]) - ("Mark" - ["Mark group" gnus-group-mark-group - (and (gnus-group-group-name) - (not (memq (gnus-group-group-name) gnus-group-marked)))] - ["Unmark group" gnus-group-unmark-group - (and (gnus-group-group-name) - (memq (gnus-group-group-name) gnus-group-marked))] - ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked] - ["Mark regexp..." gnus-group-mark-regexp t] - ["Mark region" gnus-group-mark-region t] - ["Mark buffer" gnus-group-mark-buffer t] - ["Execute command" gnus-group-universal-argument - (or gnus-group-marked (gnus-group-group-name))]) - ("Subscribe" - ["Subscribe to a group" gnus-group-unsubscribe-group t] - ["Kill all newsgroups in region" gnus-group-kill-region t] - ["Kill all zombie groups" gnus-group-kill-all-zombies - gnus-zombie-list] - ["Kill all groups on level..." gnus-group-kill-level t]) - ("Foreign groups" - ["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 kiboze group" gnus-group-make-kiboze-group t] - ["Make a virtual group" gnus-group-make-empty-virtual t] - ["Add a group to a virtual" gnus-group-add-to-virtual t] - ["Rename group" gnus-group-rename-group - (gnus-check-backend-function - 'request-rename-group (gnus-group-group-name))] - ["Delete group" gnus-group-delete-group - (gnus-check-backend-function - 'request-delete-group (gnus-group-group-name))]) - ("Move" - ["Next" gnus-group-next-group t] - ["Previous" gnus-group-prev-group t] - ["Next unread" gnus-group-next-unread-group t] - ["Previous unread" gnus-group-prev-unread-group t] - ["Next unread same level" gnus-group-next-unread-group-same-level t] - ["Previous unread same level" - gnus-group-prev-unread-group-same-level t] - ["Jump to group" gnus-group-jump-to-group t] - ["First unread group" gnus-group-first-unread-group t] - ["Best unread group" gnus-group-best-unread-group t]) - ["Delete bogus groups" gnus-group-check-bogus-groups t] - ["Find new newsgroups" gnus-group-find-new-groups t] - ["Transpose" gnus-group-transpose-groups - (gnus-group-group-name)] - ["Read a directory as a group..." gnus-group-enter-directory t])) - - (easy-menu-define - gnus-group-misc-menu gnus-group-mode-map "" - '("Misc" - ("SOUP" - ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)] - ["Send replies" gnus-soup-send-replies - (fboundp 'gnus-soup-pack-packet)] - ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)] - ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)] - ["Brew SOUP" gnus-soup-brew-soup (fboundp 'gnus-soup-pack-packet)]) - ["Send a bug report" gnus-bug t] - ["Send a mail" gnus-group-mail t] - ["Post an article..." gnus-group-post-news t] - ["Check for new news" gnus-group-get-new-news t] - ["Activate all groups" gnus-activate-all-groups t] - ["Restart Gnus" gnus-group-restart t] - ["Read init file" gnus-group-read-init-file t] - ["Browse foreign server" gnus-group-browse-foreign-server t] - ["Enter server buffer" gnus-group-enter-server-mode t] - ["Expire all expirable articles" gnus-group-expire-all-groups t] - ["Generate any kiboze groups" nnkiboze-generate-groups t] - ["Gnus version" gnus-version t] - ["Save .newsrc files" gnus-group-save-newsrc t] - ["Suspend Gnus" gnus-group-suspend t] - ["Clear dribble buffer" gnus-group-clear-dribble t] - ["Read manual" gnus-info-find-node t] - ["Flush score cache" gnus-score-flush-cache t] - ["Toggle topics" gnus-topic-mode t] - ["Exit from Gnus" gnus-group-exit t] - ["Exit without saving" gnus-group-quit t])) - - (run-hooks 'gnus-group-menu-hook))) - -(defun gnus-group-mode () - "Major mode for reading news. - -All normal editing commands are switched off. -\\ -The group buffer lists (some of) the groups available. For instance, -`\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]' -lists all zombie groups. - -Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To subscribe -to a group not displayed, type `\\[gnus-group-unsubscribe-group]'. - -For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]'). - -The following commands are available: - -\\{gnus-group-mode-map}" - (interactive) - (when (gnus-visual-p 'group-menu 'menu) - (gnus-group-make-menu-bar)) - (kill-all-local-variables) - (gnus-simplify-mode-line) - (setq major-mode 'gnus-group-mode) - (setq mode-name "Group") - (gnus-group-set-mode-line) - (setq mode-line-process nil) - (use-local-map gnus-group-mode-map) - (buffer-disable-undo (current-buffer)) - (setq truncate-lines t) - (setq buffer-read-only t) - (gnus-set-default-directory) - (gnus-update-format-specifications nil 'group 'group-mode) - (gnus-update-group-mark-positions) - (make-local-hook 'post-command-hook) - (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) - (when gnus-use-undo - (gnus-undo-mode 1)) - (run-hooks 'gnus-group-mode-hook)) - -(defun gnus-update-group-mark-positions () - (save-excursion - (let ((gnus-process-mark 128) - (gnus-group-marked '("dummy.group")) - (gnus-active-hashtb (make-vector 10 0))) - (gnus-set-active "dummy.group" '(0 . 0)) - (gnus-set-work-buffer) - (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil) - (goto-char (point-min)) - (setq gnus-group-mark-positions - (list (cons 'process (and (search-forward "\200" nil t) - (- (point) 2)))))))) - -(defun gnus-clear-inboxes-moved () - (setq nnmail-moved-inboxes nil)) - -(defun gnus-mouse-pick-group (e) - "Enter the group under the mouse pointer." - (interactive "e") - (mouse-set-point e) - (gnus-group-read-group nil)) - -;; Look at LEVEL and find out what the level is really supposed to be. -;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens -;; will depend on whether `gnus-group-use-permanent-levels' is used. -(defun gnus-group-default-level (&optional level number-or-nil) - (cond - (gnus-group-use-permanent-levels - (or (setq gnus-group-use-permanent-levels - (or level (if (numberp gnus-group-use-permanent-levels) - gnus-group-use-permanent-levels - (or gnus-group-default-list-level - gnus-level-subscribed)))) - gnus-group-default-list-level gnus-level-subscribed)) - (number-or-nil - level) - (t - (or level gnus-group-default-list-level gnus-level-subscribed)))) - -(defun gnus-group-setup-buffer () - (switch-to-buffer gnus-group-buffer) - (unless (eq major-mode 'gnus-group-mode) - (gnus-add-current-to-buffer-list) - (gnus-group-mode) - (when gnus-carpal - (gnus-carpal-setup-buffer 'group)))) - -(defun gnus-group-list-groups (&optional level unread lowest) - "List newsgroups with level LEVEL or lower that have unread articles. -Default is all subscribed groups. -If argument UNREAD is non-nil, groups with no unread articles are also -listed. - -Also see the `gnus-group-use-permanent-levels' variable." - (interactive - (list (if current-prefix-arg - (prefix-numeric-value current-prefix-arg) - (or - (gnus-group-default-level nil t) - gnus-group-default-list-level - gnus-level-subscribed)))) - ;; Just do this here, for no particular good reason. - (gnus-clear-inboxes-moved) - (unless level - (setq level (car gnus-group-list-mode) - unread (cdr gnus-group-list-mode))) - (setq level (gnus-group-default-level level)) - (gnus-group-setup-buffer) - (gnus-update-format-specifications nil 'group 'group-mode) - (let ((case-fold-search nil) - (props (text-properties-at (gnus-point-at-bol))) - (empty (= (point-min) (point-max))) - (group (gnus-group-group-name)) - number) - (set-buffer gnus-group-buffer) - (setq number (funcall gnus-group-prepare-function level unread lowest)) - (when (or (and (numberp number) - (zerop number)) - (zerop (buffer-size))) - ;; No groups in the buffer. - (gnus-message 5 gnus-no-groups-message)) - ;; We have some groups displayed. - (goto-char (point-max)) - (when (or (not gnus-group-goto-next-group-function) - (not (funcall gnus-group-goto-next-group-function - group props))) - (cond - (empty - (goto-char (point-min))) - ((not group) - ;; Go to the first group with unread articles. - (gnus-group-search-forward t)) - (t - ;; Find the right group to put point on. If the current group - ;; has disappeared in the new listing, try to find the next - ;; one. If no next one can be found, just leave point at the - ;; first newsgroup in the buffer. - (when (not (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe - group gnus-active-hashtb)))) - (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb)))) - (while (and newsrc - (not (gnus-goto-char - (text-property-any - (point-min) (point-max) 'gnus-group - (gnus-intern-safe - (caar newsrc) gnus-active-hashtb))))) - (setq newsrc (cdr newsrc))) - (unless newsrc - (goto-char (point-max)) - (forward-line -1))))))) - ;; Adjust cursor point. - (gnus-group-position-point))) - -(defun gnus-group-list-level (level &optional all) - "List groups on LEVEL. -If ALL (the prefix), also list groups that have no unread articles." - (interactive "nList groups on level: \nP") - (gnus-group-list-groups level all level)) - -(defun gnus-group-prepare-flat (level &optional all lowest regexp) - "List all newsgroups with unread articles of level LEVEL or lower. -If ALL is non-nil, list groups that have no unread articles. -If LOWEST is non-nil, list all newsgroups of level LOWEST or higher. -If REGEXP, only list groups matching REGEXP." - (set-buffer gnus-group-buffer) - (let ((buffer-read-only nil) - (newsrc (cdr gnus-newsrc-alist)) - (lowest (or lowest 1)) - info clevel unread group params) - (erase-buffer) - (when (< lowest gnus-level-zombie) - ;; List living groups. - (while newsrc - (setq info (car newsrc) - group (gnus-info-group info) - params (gnus-info-params info) - newsrc (cdr newsrc) - unread (car (gnus-gethash group gnus-newsrc-hashtb))) - (and unread ; This group might be bogus - (or (not regexp) - (string-match regexp group)) - (<= (setq clevel (gnus-info-level info)) level) - (>= clevel lowest) - (or all ; We list all groups? - (if (eq unread t) ; Unactivated? - gnus-group-list-inactive-groups ; We list unactivated - (> unread 0)) ; We list groups with unread articles - (and gnus-list-groups-with-ticked-articles - (cdr (assq 'tick (gnus-info-marks info)))) - ; And groups with tickeds - ;; Check for permanent visibility. - (and gnus-permanently-visible-groups - (string-match gnus-permanently-visible-groups - group)) - (memq 'visible params) - (cdr (assq 'visible params))) - (gnus-group-insert-group-line - group (gnus-info-level info) - (gnus-info-marks info) unread (gnus-info-method info))))) - - ;; List dead groups. - (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie) - (gnus-group-prepare-flat-list-dead - (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) - gnus-level-zombie ?Z - regexp)) - (and (>= level gnus-level-killed) (<= lowest gnus-level-killed) - (gnus-group-prepare-flat-list-dead - (setq gnus-killed-list (sort gnus-killed-list 'string<)) - gnus-level-killed ?K regexp)) - - (gnus-group-set-mode-line) - (setq gnus-group-list-mode (cons level all)) - (run-hooks 'gnus-group-prepare-hook) - t)) - -(defun gnus-group-prepare-flat-list-dead (groups level mark regexp) - ;; List zombies and killed lists somewhat faster, which was - ;; suggested by Jack Vinson . It does - ;; this by ignoring the group format specification altogether. - (let (group) - (if regexp - ;; This loop is used when listing groups that match some - ;; regexp. - (while groups - (setq group (pop groups)) - (when (string-match regexp group) - (gnus-add-text-properties - (point) (prog1 (1+ (point)) - (insert " " mark " *: " group "\n")) - (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) - 'gnus-unread t - 'gnus-level level)))) - ;; This loop is used when listing all groups. - (while groups - (gnus-add-text-properties - (point) (prog1 (1+ (point)) - (insert " " mark " *: " - (setq group (pop groups)) "\n")) - (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) - 'gnus-unread t - 'gnus-level level)))))) - -(defun gnus-group-update-group-line () - "Update the current line in the group buffer." - (let* ((buffer-read-only nil) - (group (gnus-group-group-name)) - (entry (and group (gnus-gethash group gnus-newsrc-hashtb))) - gnus-group-indentation) - (when group - (and entry - (not (gnus-ephemeral-group-p group)) - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string (nth 2 entry)) - ")"))) - (setq gnus-group-indentation (gnus-group-group-indentation)) - (gnus-delete-line) - (gnus-group-insert-group-line-info group) - (forward-line -1) - (gnus-group-position-point)))) - -(defun gnus-group-insert-group-line-info (group) - "Insert GROUP on the current line." - (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) - (gnus-group-indentation (gnus-group-group-indentation)) - active info) - (if entry - (progn - ;; (Un)subscribed group. - (setq info (nth 2 entry)) - (gnus-group-insert-group-line - group (gnus-info-level info) (gnus-info-marks info) - (or (car entry) t) (gnus-info-method info))) - ;; This group is dead. - (gnus-group-insert-group-line - group - (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed) - nil - (if (setq active (gnus-active group)) - (if (zerop (cdr active)) - 0 - (- (1+ (cdr active)) (car active))) - nil) - nil)))) - -(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level - gnus-tmp-marked number - gnus-tmp-method) - "Insert a group line in the group buffer." - (let* ((gnus-tmp-active (gnus-active gnus-tmp-group)) - (gnus-tmp-number-total - (if gnus-tmp-active - (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active))) - 0)) - (gnus-tmp-number-of-unread - (if (numberp number) (int-to-string (max 0 number)) - "*")) - (gnus-tmp-number-of-read - (if (numberp number) - (int-to-string (max 0 (- gnus-tmp-number-total number))) - "*")) - (gnus-tmp-subscribed - (cond ((<= gnus-tmp-level gnus-level-subscribed) ? ) - ((<= gnus-tmp-level gnus-level-unsubscribed) ?U) - ((= gnus-tmp-level gnus-level-zombie) ?Z) - (t ?K))) - (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group)) - (gnus-tmp-newsgroup-description - (if gnus-description-hashtb - (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "") - "")) - (gnus-tmp-moderated - (if (and gnus-moderated-hashtb - (gnus-gethash gnus-tmp-group gnus-moderated-hashtb)) - ?m ? )) - (gnus-tmp-moderated-string - (if (eq gnus-tmp-moderated ?m) "(m)" "")) - (gnus-tmp-method - (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) - (gnus-tmp-news-server (or (cadr gnus-tmp-method) "")) - (gnus-tmp-news-method (or (car gnus-tmp-method) "")) - (gnus-tmp-news-method-string - (if gnus-tmp-method - (format "(%s:%s)" (car gnus-tmp-method) - (cadr gnus-tmp-method)) "")) - (gnus-tmp-marked-mark - (if (and (numberp number) - (zerop number) - (cdr (assq 'tick gnus-tmp-marked))) - ?* ? )) - (gnus-tmp-process-marked - (if (member gnus-tmp-group gnus-group-marked) - gnus-process-mark ? )) - (gnus-tmp-grouplens - (or (and gnus-use-grouplens - (bbb-grouplens-group-p gnus-tmp-group)) - "")) - (buffer-read-only nil) - header gnus-tmp-header) ; passed as parameter to user-funcs. - (beginning-of-line) - (gnus-add-text-properties - (point) - (prog1 (1+ (point)) - ;; Insert the text. - (eval gnus-group-line-format-spec)) - `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb) - gnus-unread ,(if (numberp number) - (string-to-int gnus-tmp-number-of-unread) - t) - gnus-marked ,gnus-tmp-marked-mark - gnus-indentation ,gnus-group-indentation - gnus-level ,gnus-tmp-level)) - (when (inline (gnus-visual-p 'group-highlight 'highlight)) - (forward-line -1) - (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 (progn (end-of-line) (point))) - ;; 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 (gnus-server-get-method group (gnus-info-method info))) - (marked (gnus-info-marks info)) - (mailp (memq 'mail (assoc (symbol-name - (car (or method gnus-select-method))) - gnus-valid-select-methods))) - (level (or (gnus-info-level info) 9)) - (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)) - ;; 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 - beg end 'face - (setq face (if (boundp face) (symbol-value face) face))) - (gnus-extent-start-open beg))) - (goto-char p))) - -(defun gnus-group-update-group (group &optional visible-only) - "Update all lines where GROUP appear. -If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't -already." - ;; Can't use `save-excursion' here, so we do it manually. - (let ((buf (current-buffer)) - mark) - (set-buffer gnus-group-buffer) - (setq mark (point-marker)) - ;; The buffer may be narrowed. - (save-restriction - (widen) - (let ((ident (gnus-intern-safe group gnus-active-hashtb)) - (loc (point-min)) - found buffer-read-only) - ;; Enter the current status into the dribble buffer. - (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) - (when (and entry (not (gnus-ephemeral-group-p group))) - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string (nth 2 entry)) - ")")))) - ;; Find all group instances. If topics are in use, each group - ;; may be listed in more than once. - (while (setq loc (text-property-any - loc (point-max) 'gnus-group ident)) - (setq found t) - (goto-char loc) - (let ((gnus-group-indentation (gnus-group-group-indentation))) - (gnus-delete-line) - (gnus-group-insert-group-line-info group) - (save-excursion - (forward-line -1) - (run-hooks 'gnus-group-update-group-hook))) - (setq loc (1+ loc))) - (unless (or found visible-only) - ;; No such line in the buffer, find out where it's supposed to - ;; go, and insert it there (or at the end of the buffer). - (if gnus-goto-missing-group-function - (funcall gnus-goto-missing-group-function group) - (let ((entry (cddr (gnus-gethash group gnus-newsrc-hashtb)))) - (while (and entry (car entry) - (not - (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe - (caar entry) gnus-active-hashtb))))) - (setq entry (cdr entry))) - (or entry (goto-char (point-max))))) - ;; Finally insert the line. - (let ((gnus-group-indentation (gnus-group-group-indentation))) - (gnus-group-insert-group-line-info group) - (save-excursion - (forward-line -1) - (run-hooks 'gnus-group-update-group-hook)))) - (when gnus-group-update-group-function - (funcall gnus-group-update-group-function group)) - (gnus-group-set-mode-line))) - (goto-char mark) - (set-marker mark nil) - (set-buffer buf))) - -(defun gnus-group-set-mode-line () - "Update the mode line in the group buffer." - (when (memq 'group gnus-updated-mode-lines) - ;; Yes, we want to keep this mode line updated. - (save-excursion - (set-buffer gnus-group-buffer) - (let* ((gformat (or gnus-group-mode-line-format-spec - (setq gnus-group-mode-line-format-spec - (gnus-parse-format - gnus-group-mode-line-format - gnus-group-mode-line-format-alist)))) - (gnus-tmp-news-server (cadr gnus-select-method)) - (gnus-tmp-news-method (car gnus-select-method)) - (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":")) - (max-len 60) - gnus-tmp-header ;Dummy binding for user-defined formats - ;; Get the resulting string. - (modified - (and gnus-dribble-buffer - (buffer-name gnus-dribble-buffer) - (buffer-modified-p gnus-dribble-buffer) - (save-excursion - (set-buffer gnus-dribble-buffer) - (not (zerop (buffer-size)))))) - (mode-string (eval gformat))) - ;; Say whether the dribble buffer has been modified. - (setq mode-line-modified - (if modified (car gnus-mode-line-modified) - (cdr gnus-mode-line-modified))) - ;; If the line is too long, we chop it off. - (when (> (length mode-string) max-len) - (setq mode-string (substring mode-string 0 (- max-len 4)))) - (prog1 - (setq mode-line-buffer-identification - (gnus-mode-line-buffer-identification - (list mode-string))) - (set-buffer-modified-p modified)))))) - -(defun gnus-group-group-name () - "Get the name of the newsgroup on the current line." - (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group))) - (and group (symbol-name group)))) - -(defun gnus-group-group-level () - "Get the level of the newsgroup on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-level)) - -(defun gnus-group-group-indentation () - "Get the indentation of the newsgroup on the current line." - (or (get-text-property (gnus-point-at-bol) 'gnus-indentation) - (and gnus-group-indentation-function - (funcall gnus-group-indentation-function)) - "")) - -(defun gnus-group-group-unread () - "Get the number of unread articles of the newsgroup on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-unread)) - -(defun gnus-group-new-mail (group) - (if (nnmail-new-mail-p (gnus-group-real-name group)) - gnus-new-mail-mark - ? )) - -(defun gnus-group-level (group) - "Return the estimated level of GROUP." - (or (gnus-info-level (gnus-get-info group)) - (and (member group gnus-zombie-list) 8) - 9)) - -(defun gnus-group-search-forward (&optional backward all level first-too) - "Find the next newsgroup with unread articles. -If BACKWARD is non-nil, find the previous newsgroup instead. -If ALL is non-nil, just find any newsgroup. -If LEVEL is non-nil, find group with level LEVEL, or higher if no such -group exists. -If FIRST-TOO, the current line is also eligible as a target." - (let ((way (if backward -1 1)) - (low gnus-level-killed) - (beg (point)) - pos found lev) - (if (and backward (progn (beginning-of-line)) (bobp)) - nil - (unless first-too - (forward-line way)) - (while (and - (not (eobp)) - (not (setq - found - (and - (get-text-property (point) 'gnus-group) - (or all - (and - (let ((unread - (get-text-property (point) 'gnus-unread))) - (and (numberp unread) (> unread 0))) - (setq lev (get-text-property (point) - 'gnus-level)) - (<= lev gnus-level-subscribed))) - (or (not level) - (and (setq lev (get-text-property (point) - 'gnus-level)) - (or (= lev level) - (and (< lev low) - (< level lev) - (progn - (setq low lev) - (setq pos (point)) - nil)))))))) - (zerop (forward-line way))))) - (if found - (progn (gnus-group-position-point) t) - (goto-char (or pos beg)) - (and pos t)))) - -;;; Gnus group mode commands - -;; Group marking. - -(defun gnus-group-mark-group (n &optional unmark no-advance) - "Mark the current group." - (interactive "p") - (let ((buffer-read-only nil) - group) - (while (and (> n 0) - (not (eobp))) - (when (setq group (gnus-group-group-name)) - ;; Go to the mark position. - (beginning-of-line) - (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2)) - (subst-char-in-region - (point) (1+ (point)) (following-char) - (if unmark - (progn - (setq gnus-group-marked (delete group gnus-group-marked)) - ? ) - (setq gnus-group-marked - (cons group (delete group gnus-group-marked))) - gnus-process-mark))) - (unless no-advance - (gnus-group-next-group 1)) - (decf n)) - (gnus-summary-position-point) - n)) - -(defun gnus-group-unmark-group (n) - "Remove the mark from the current group." - (interactive "p") - (gnus-group-mark-group n 'unmark) - (gnus-group-position-point)) - -(defun gnus-group-unmark-all-groups () - "Unmark all groups." - (interactive) - (let ((groups gnus-group-marked)) - (save-excursion - (while groups - (gnus-group-remove-mark (pop groups))))) - (gnus-group-position-point)) - -(defun gnus-group-mark-region (unmark beg end) - "Mark all groups between point and mark. -If UNMARK, remove the mark instead." - (interactive "P\nr") - (let ((num (count-lines beg end))) - (save-excursion - (goto-char beg) - (- num (gnus-group-mark-group num unmark))))) - -(defun gnus-group-mark-buffer (&optional unmark) - "Mark all groups in the buffer. -If UNMARK, remove the mark instead." - (interactive "P") - (gnus-group-mark-region unmark (point-min) (point-max))) - -(defun gnus-group-mark-regexp (regexp) - "Mark all groups that match some regexp." - (interactive "sMark (regexp): ") - (let ((alist (cdr gnus-newsrc-alist)) - group) - (while alist - (when (string-match regexp (setq group (gnus-info-group (pop alist)))) - (gnus-group-set-mark group)))) - (gnus-group-position-point)) - -(defun gnus-group-remove-mark (group) - "Remove the process mark from GROUP and move point there. -Return nil if the group isn't displayed." - (if (gnus-group-goto-group group) - (save-excursion - (gnus-group-mark-group 1 'unmark t) - t) - (setq gnus-group-marked - (delete group gnus-group-marked)) - nil)) - -(defun gnus-group-set-mark (group) - "Set the process mark on GROUP." - (if (gnus-group-goto-group group) - (save-excursion - (gnus-group-mark-group 1 nil t)) - (setq gnus-group-marked (cons group (delete group gnus-group-marked))))) - -(defun gnus-group-universal-argument (arg &optional groups func) - "Perform any command on all groups according to the process/prefix convention." - (interactive "P") - (if (eq (setq func (or func - (key-binding - (read-key-sequence - (substitute-command-keys - "\\\\[gnus-group-universal-argument]"))))) - 'undefined) - (gnus-error 1 "Undefined key") - (gnus-group-iterate arg - (lambda (group) - (command-execute func)))) - (gnus-group-position-point)) - -(defun gnus-group-process-prefix (n) - "Return a list of groups to work on. -Take into consideration N (the prefix) and the list of marked groups." - (cond - (n - (setq n (prefix-numeric-value n)) - ;; There is a prefix, so we return a list of the N next - ;; groups. - (let ((way (if (< n 0) -1 1)) - (n (abs n)) - group groups) - (save-excursion - (while (and (> n 0) - (setq group (gnus-group-group-name))) - (push group groups) - (setq n (1- n)) - (gnus-group-next-group way))) - (nreverse groups))) - ((gnus-region-active-p) - ;; Work on the region between point and mark. - (let ((max (max (point) (mark))) - groups) - (save-excursion - (goto-char (min (point) (mark))) - (while - (and - (push (gnus-group-group-name) groups) - (zerop (gnus-group-next-group 1)) - (< (point) max))) - (nreverse groups)))) - (gnus-group-marked - ;; No prefix, but a list of marked articles. - (reverse gnus-group-marked)) - (t - ;; Neither marked articles or a prefix, so we return the - ;; current group. - (let ((group (gnus-group-group-name))) - (and group (list group)))))) - -(defun gnus-group-iterate (arg function) - "Iterate FUNCTION over all process/prefixed groups. -FUNCTION will be called with the group name as the paremeter -and with point over the group in question." - (let ((groups (gnus-group-process-prefix arg)) - group) - (while (setq group (pop groups)) - (gnus-group-remove-mark group) - (funcall function group)))) - -(put 'gnus-group-iterate 'lisp-indent-function 1) - -;; Selecting groups. - -(defun gnus-group-read-group (&optional all no-article group) - "Read news in this newsgroup. -If the prefix argument ALL is non-nil, already read articles become -readable. IF ALL is a number, fetch this number of articles. If the -optional argument NO-ARTICLE is non-nil, no article will be -auto-selected upon group entry. If GROUP is non-nil, fetch that -group." - (interactive "P") - (let ((no-display (eq all 0)) - (group (or group (gnus-group-group-name))) - number active marked entry) - (when (eq all 0) - (setq all nil)) - (unless group - (error "No group on current line")) - (setq marked (gnus-info-marks - (nth 2 (setq entry (gnus-gethash - group gnus-newsrc-hashtb))))) - ;; This group might be a dead group. In that case we have to get - ;; the number of unread articles from `gnus-active-hashtb'. - (setq number - (cond ((numberp all) all) - (entry (car entry)) - ((setq active (gnus-active group)) - (- (1+ (cdr active)) (car active))))) - (gnus-summary-read-group - group (or all (and (numberp number) - (zerop (+ number (gnus-range-length - (cdr (assq 'tick marked))) - (gnus-range-length - (cdr (assq 'dormant marked))))))) - no-article nil no-display))) - -(defun gnus-group-select-group (&optional all) - "Select this newsgroup. -No article is selected automatically. -If ALL is non-nil, already read articles become readable. -If ALL is a number, fetch this number of articles." - (interactive "P") - (gnus-group-read-group all t)) - -(defun gnus-group-quick-select-group (&optional all) - "Select the current group \"quickly\". -This means that no highlighting or scoring will be performed. -If ALL (the prefix argument) is 0, don't even generate the summary -buffer." - (interactive "P") - (require 'gnus-score) - (let (gnus-visual - gnus-score-find-score-files-function - gnus-home-score-file - gnus-apply-kill-hook - gnus-summary-expunge-below) - (gnus-group-read-group all t))) - -(defun gnus-group-visible-select-group (&optional all) - "Select the current group without hiding any articles." - (interactive "P") - (let ((gnus-inhibit-limiting t)) - (gnus-group-read-group all t))) - -(defun gnus-group-select-group-ephemerally () - "Select the current group without doing any processing whatsoever. -You will actually be entered into a group that's a copy of -the current group; no changes you make while in this group will -be permanent." - (interactive) - (require 'gnus-score) - (let* (gnus-visual - gnus-score-find-score-files-function gnus-apply-kill-hook - gnus-summary-expunge-below gnus-show-threads gnus-suppress-duplicates - gnus-summary-mode-hook gnus-select-group-hook - (group (gnus-group-group-name)) - (method (gnus-find-method-for-group group))) - (setq method - `(,(car method) ,(concat (cadr method) "-ephemeral") - (,(intern (format "%s-address" (car method))) ,(cadr method)) - ,@(cddr method))) - (gnus-group-read-ephemeral-group - (gnus-group-prefixed-name group method) method))) - -;;;###autoload -(defun gnus-fetch-group (group) - "Start Gnus if necessary and enter GROUP. -Returns whether the fetching was successful or not." - (interactive "sGroup name: ") - (unless (get-buffer gnus-group-buffer) - (gnus)) - (gnus-group-read-group nil nil group)) - -(defvar gnus-ephemeral-group-server 0) - -;; Enter a group that is not in the group buffer. Non-nil is returned -;; if selection was successful. -(defun gnus-group-read-ephemeral-group (group method &optional activate - quit-config request-only) - "Read GROUP from METHOD as an ephemeral group. -If ACTIVATE, request the group first. -If QUIT-CONFIG, use that window configuration when exiting from the -ephemeral group. -If REQUEST-ONLY, don't actually read the group; just request it. - -Return the name of the group is selection was successful." - ;; Transform the select method into a unique server. - (let ((saddr (intern (format "%s-address" (car method))))) - (setq method (gnus-copy-sequence method)) - (require (car method)) - (when (boundp saddr) - (unless (assq saddr method) - (nconc method `((,saddr ,(cadr method)))) - (setf (cadr method) (format "%s-%d" (cadr method) - (incf gnus-ephemeral-group-server)))))) - (let ((group (if (gnus-group-foreign-p group) group - (gnus-group-prefixed-name group method)))) - (gnus-sethash - group - `(-1 nil (,group - ,gnus-level-default-subscribed nil nil ,method - ((quit-config . - ,(if quit-config quit-config - (cons gnus-summary-buffer - gnus-current-window-configuration)))))) - gnus-newsrc-hashtb) - (set-buffer gnus-group-buffer) - (unless (gnus-check-server method) - (error "Unable to contact server: %s" (gnus-status-message method))) - (when activate - (gnus-activate-group group 'scan) - (unless (gnus-request-group group) - (error "Couldn't request group: %s" - (nnheader-get-report (car method))))) - (if request-only - group - (condition-case () - (when (gnus-group-read-group t t group) - group) - ;;(error nil) - (quit nil))))) - -(defun gnus-group-jump-to-group (group) - "Jump to newsgroup GROUP." - (interactive - (list (completing-read - "Group: " gnus-active-hashtb nil - (gnus-read-active-file-p) - nil - 'gnus-group-history))) - - (when (equal group "") - (error "Empty group name")) - - (unless (gnus-ephemeral-group-p group) - ;; Either go to the line in the group buffer... - (unless (gnus-group-goto-group group) - ;; ... or insert the line. - (gnus-group-update-group group) - (gnus-group-goto-group group))) - ;; Adjust cursor point. - (gnus-group-position-point)) - -(defun gnus-group-goto-group (group &optional far) - "Goto to newsgroup GROUP. -If FAR, it is likely that the group is not on the current line." - (when group - (if far - (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe group gnus-active-hashtb))) - (beginning-of-line) - (cond - ;; It's quite likely that we are on the right line, so - ;; we check the current line first. - ((eq (get-text-property (point) 'gnus-group) - (gnus-intern-safe group gnus-active-hashtb)) - (point)) - ;; Previous and next line are also likely, so we check them as well. - ((save-excursion - (forward-line -1) - (eq (get-text-property (point) 'gnus-group) - (gnus-intern-safe group gnus-active-hashtb))) - (forward-line -1) - (point)) - ((save-excursion - (forward-line 1) - (eq (get-text-property (point) 'gnus-group) - (gnus-intern-safe group gnus-active-hashtb))) - (forward-line 1) - (point)) - (t - ;; Search through the entire buffer. - (gnus-goto-char - (text-property-any - (point-min) (point-max) - 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))))) - -(defun gnus-group-next-group (n &optional silent) - "Go to next N'th newsgroup. -If N is negative, search backward instead. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-group-next-unread-group n t nil silent)) - -(defun gnus-group-next-unread-group (n &optional all level silent) - "Go to next N'th unread newsgroup. -If N is negative, search backward instead. -If ALL is non-nil, choose any newsgroup, unread or not. -If LEVEL is non-nil, choose the next group with level LEVEL, or, if no -such group can be found, the next group with a level higher than -LEVEL. -Returns the difference between N and the number of skips actually -made." - (interactive "p") - (let ((backward (< n 0)) - (n (abs n))) - (while (and (> n 0) - (gnus-group-search-forward - backward (or (not gnus-group-goto-unread) all) level)) - (setq n (1- n))) - (when (and (/= 0 n) - (not silent)) - (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread") - (if level " on this level or higher" ""))) - n)) - -(defun gnus-group-prev-group (n) - "Go to previous N'th newsgroup. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-group-next-unread-group (- n) t)) - -(defun gnus-group-prev-unread-group (n) - "Go to previous N'th unread newsgroup. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-group-next-unread-group (- n))) - -(defun gnus-group-next-unread-group-same-level (n) - "Go to next N'th unread newsgroup on the same level. -If N is negative, search backward instead. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-group-next-unread-group n t (gnus-group-group-level)) - (gnus-group-position-point)) - -(defun gnus-group-prev-unread-group-same-level (n) - "Go to next N'th unread newsgroup on the same level. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-group-next-unread-group (- n) t (gnus-group-group-level)) - (gnus-group-position-point)) - -(defun gnus-group-best-unread-group (&optional exclude-group) - "Go to the group with the highest level. -If EXCLUDE-GROUP, do not go to that group." - (interactive) - (goto-char (point-min)) - (let ((best 100000) - unread best-point) - (while (not (eobp)) - (setq unread (get-text-property (point) 'gnus-unread)) - (when (and (numberp unread) (> unread 0)) - (when (and (get-text-property (point) 'gnus-level) - (< (get-text-property (point) 'gnus-level) best) - (or (not exclude-group) - (not (equal exclude-group (gnus-group-group-name))))) - (setq best (get-text-property (point) 'gnus-level)) - (setq best-point (point)))) - (forward-line 1)) - (when best-point - (goto-char best-point)) - (gnus-summary-position-point) - (and best-point (gnus-group-group-name)))) - -(defun gnus-group-first-unread-group () - "Go to the first group with unread articles." - (interactive) - (prog1 - (let ((opoint (point)) - unread) - (goto-char (point-min)) - (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active. - (and (numberp unread) ; Not a topic. - (not (zerop unread))) ; Has unread articles. - (zerop (gnus-group-next-unread-group 1))) ; Next unread group. - (point) ; Success. - (goto-char opoint) - nil)) ; Not success. - (gnus-group-position-point))) - -(defun gnus-group-enter-server-mode () - "Jump to the server buffer." - (interactive) - (gnus-enter-server-buffer)) - -(defun gnus-group-make-group (name &optional method address args) - "Add a new newsgroup. -The user will be prompted for a NAME, for a select METHOD, and an -ADDRESS." - (interactive - (list - (gnus-read-group "Group name: ") - (gnus-read-method "From method: "))) - - (let* ((meth (when (and method - (not (gnus-server-equal method gnus-select-method))) - (if address (list (intern method) address) - method))) - (nname (if method (gnus-group-prefixed-name name meth) name)) - backend info) - (when (gnus-gethash nname gnus-newsrc-hashtb) - (error "Group %s already exists" nname)) - ;; Subscribe to the new group. - (gnus-group-change-level - (setq info (list t nname gnus-level-default-subscribed nil nil meth)) - gnus-level-default-subscribed gnus-level-killed - (and (gnus-group-group-name) - (gnus-gethash (gnus-group-group-name) - gnus-newsrc-hashtb)) - t) - ;; Make it active. - (gnus-set-active nname (cons 1 0)) - (unless (gnus-ephemeral-group-p name) - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string (cdr info)) ")"))) - ;; Insert the line. - (gnus-group-insert-group-line-info nname) - (forward-line -1) - (gnus-group-position-point) - - ;; Load the backend and try to make the backend create - ;; the group as well. - (when (assoc (symbol-name (setq backend (car (gnus-server-get-method - nil meth)))) - gnus-valid-select-methods) - (require backend)) - (gnus-check-server meth) - (when (gnus-check-backend-function 'request-create-group nname) - (gnus-request-create-group nname nil args)) - t)) - -(defun gnus-group-delete-group (group &optional force) - "Delete the current group. Only meaningful with mail groups. -If FORCE (the prefix) is non-nil, all the articles in the group will -be deleted. This is \"deleted\" as in \"removed forever from the face -of the Earth\". There is no undo. The user will be prompted before -doing the deletion." - (interactive - (list (gnus-group-group-name) - current-prefix-arg)) - (unless group - (error "No group to rename")) - (unless (gnus-check-backend-function 'request-delete-group group) - (error "This backend does not support group deletion")) - (prog1 - (if (not (gnus-yes-or-no-p - (format - "Do you really want to delete %s%s? " - group (if force " and all its contents" "")))) - () ; Whew! - (gnus-message 6 "Deleting group %s..." group) - (if (not (gnus-request-delete-group group force)) - (gnus-error 3 "Couldn't delete group %s" group) - (gnus-message 6 "Deleting group %s...done" group) - (gnus-group-goto-group group) - (gnus-group-kill-group 1 t) - (gnus-sethash group nil gnus-active-hashtb) - t)) - (gnus-group-position-point))) - -(defun gnus-group-rename-group (group new-name) - "Rename group from GROUP to NEW-NAME. -When used interactively, GROUP is the group under point -and NEW-NAME will be prompted for." - (interactive - (list - (gnus-group-group-name) - (progn - (unless (gnus-check-backend-function - 'request-rename-group (gnus-group-group-name)) - (error "This backend does not support renaming groups")) - (gnus-read-group "Rename group to: " - (gnus-group-real-name (gnus-group-group-name)))))) - - (unless (gnus-check-backend-function 'request-rename-group group) - (error "This backend does not support renaming groups")) - (unless group - (error "No group to rename")) - (when (equal (gnus-group-real-name group) new-name) - (error "Can't rename to the same name")) - - ;; We find the proper prefixed name. - (setq new-name - (if (gnus-group-native-p group) - ;; Native group. - new-name - ;; Foreign group. - (gnus-group-prefixed-name - (gnus-group-real-name new-name) - (gnus-info-method (gnus-get-info group))))) - - (gnus-message 6 "Renaming group %s to %s..." group new-name) - (prog1 - (if (not (gnus-request-rename-group group new-name)) - (gnus-error 3 "Couldn't rename group %s to %s" group new-name) - ;; We rename the group internally by killing it... - (gnus-group-goto-group group) - (gnus-group-kill-group) - ;; ... changing its name ... - (setcar (cdar gnus-list-of-killed-groups) new-name) - ;; ... and then yanking it. Magic! - (gnus-group-yank-group) - (gnus-set-active new-name (gnus-active group)) - (gnus-message 6 "Renaming group %s to %s...done" group new-name) - new-name) - (gnus-group-position-point))) - -(defun gnus-group-edit-group (group &optional part) - "Edit the group on the current line." - (interactive (list (gnus-group-group-name))) - (let ((part (or part 'info)) - info) - (unless group - (error "No group on current line")) - (unless (setq info (gnus-get-info group)) - (error "Killed group; can't be edited")) - (ignore-errors - (gnus-close-group group)) - (gnus-edit-form - ;; Find the proper form to edit. - (cond ((eq part 'method) - (or (gnus-info-method info) "native")) - ((eq part 'params) - (gnus-info-params info)) - (t info)) - ;; The proper documentation. - (format - "Editing the %s for `%s'." - (cond - ((eq part 'method) "select method") - ((eq part 'params) "group parameters") - (t "group info")) - group) - `(lambda (form) - (gnus-group-edit-group-done ',part ,group form))))) - -(defun gnus-group-edit-group-method (group) - "Edit the select method of GROUP." - (interactive (list (gnus-group-group-name))) - (gnus-group-edit-group group 'method)) - -(defun gnus-group-edit-group-parameters (group) - "Edit the group parameters of GROUP." - (interactive (list (gnus-group-group-name))) - (gnus-group-edit-group group 'params)) - -(defun gnus-group-edit-group-done (part group form) - "Update variables." - (let* ((method (cond ((eq part 'info) (nth 4 form)) - ((eq part 'method) form) - (t nil))) - (info (cond ((eq part 'info) form) - ((eq part 'method) (gnus-get-info group)) - (t nil))) - (new-group (if info - (if (or (not method) - (gnus-server-equal - gnus-select-method method)) - (gnus-group-real-name (car info)) - (gnus-group-prefixed-name - (gnus-group-real-name (car info)) method)) - nil))) - (when (and new-group - (not (equal new-group group))) - (when (gnus-group-goto-group group) - (gnus-group-kill-group 1)) - (gnus-activate-group new-group)) - ;; Set the info. - (if (not (and info new-group)) - (gnus-group-set-info form (or new-group group) part) - (setq info (gnus-copy-sequence info)) - (setcar info new-group) - (unless (gnus-server-equal method "native") - (unless (nthcdr 3 info) - (nconc info (list nil nil))) - (unless (nthcdr 4 info) - (nconc info (list nil))) - (gnus-info-set-method info method)) - (gnus-group-set-info info)) - (gnus-group-update-group (or new-group group)) - (gnus-group-position-point))) - -(defun gnus-group-make-useful-group (group method) - (interactive - (let ((entry (assoc (completing-read "Create group: " gnus-useful-groups - nil t) - gnus-useful-groups))) - (list (cadr entry) (caddr entry)))) - (setq method (gnus-copy-sequence method)) - (let (entry) - (while (setq entry (memq (assq 'eval method) method)) - (setcar entry (eval (cadar entry))))) - (gnus-group-make-group group method)) - -(defun gnus-group-make-help-group () - "Create the Gnus documentation group." - (interactive) - (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help"))) - (file (nnheader-find-etc-directory "gnus-tut.txt" t)) - dir) - (when (gnus-gethash name gnus-newsrc-hashtb) - (error "Documentation group already exists")) - (if (not file) - (gnus-message 1 "Couldn't find doc group") - (gnus-group-make-group - (gnus-group-real-name name) - (list 'nndoc "gnus-help" - (list 'nndoc-address file) - (list 'nndoc-article-type 'mbox))))) - (gnus-group-position-point)) - -(defun gnus-group-make-doc-group (file type) - "Create a group that uses a single file as the source." - (interactive - (list (read-file-name "File name: ") - (and current-prefix-arg 'ask))) - (when (eq type 'ask) - (let ((err "") - char found) - (while (not found) - (message - "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [mbdfag]: " - err) - (setq found (cond ((= (setq char (read-char)) ?m) 'mbox) - ((= char ?b) 'babyl) - ((= char ?d) 'digest) - ((= char ?f) 'forward) - ((= char ?a) 'mmfd) - (t (setq err (format "%c unknown. " char)) - nil)))) - (setq type found))) - (let* ((file (expand-file-name file)) - (name (gnus-generate-new-group-name - (gnus-group-prefixed-name - (file-name-nondirectory file) '(nndoc ""))))) - (gnus-group-make-group - (gnus-group-real-name name) - (list 'nndoc file - (list 'nndoc-address file) - (list 'nndoc-article-type (or type 'guess)))))) - -(defvar nnweb-type-definition) -(defvar gnus-group-web-type-history nil) -(defvar gnus-group-web-search-history nil) -(defun gnus-group-make-web-group (&optional solid) - "Create an ephemeral nnweb group. -If SOLID (the prefix), create a solid group." - (interactive "P") - (require 'nnweb) - (let* ((group - (if solid (gnus-read-group "Group name: ") - (message-unique-id))) - (default-type (or (car gnus-group-web-type-history) - (symbol-name (caar nnweb-type-definition)))) - (type - (gnus-string-or - (completing-read - (format "Search engine type (default %s): " default-type) - (mapcar (lambda (elem) (list (symbol-name (car elem)))) - nnweb-type-definition) - nil t nil 'gnus-group-web-type-history) - default-type)) - (search - (read-string - "Search string: " - (cons (or (car gnus-group-web-search-history) "") 0) - 'gnus-group-web-search-history)) - (method - `(nnweb ,group (nnweb-search ,search) - (nnweb-type ,(intern type)) - (nnweb-ephemeral-p t)))) - (if solid - (gnus-group-make-group group "nnweb" "" `(,(intern type) ,search)) - (gnus-group-read-ephemeral-group - group method t - (cons (current-buffer) - (if (eq major-mode 'gnus-summary-mode) 'summary 'group)))))) - -(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-gethash group gnus-newsrc-hashtb) - (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 -directory will be used as a newsgroup. The directory should contain -mail messages or news articles in files that have numeric names." - (interactive - (list (read-file-name "Create group from directory: "))) - (unless (file-exists-p dir) - (error "No such directory")) - (unless (file-directory-p dir) - (error "Not a directory")) - (let ((ext "") - (i 0) - group) - (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb)) - (setq group - (gnus-group-prefixed-name - (concat (file-name-as-directory (directory-file-name dir)) - ext) - '(nndir ""))) - (setq ext (format "<%d>" (setq i (1+ i))))) - (gnus-group-make-group - (gnus-group-real-name group) - (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir))))) - -(defun gnus-group-make-kiboze-group (group address scores) - "Create an nnkiboze group. -The user will be prompted for a name, a regexp to match groups, and -score file entries for articles to include in the group." - (interactive - (list - (read-string "nnkiboze group name: ") - (read-string "Source groups (regexp): ") - (let ((headers (mapcar (lambda (group) (list group)) - '("subject" "from" "number" "date" "message-id" - "references" "chars" "lines" "xref" - "followup" "all" "body" "head"))) - scores header regexp regexps) - (while (not (equal "" (setq header (completing-read - "Match on header: " headers nil t)))) - (setq regexps nil) - (while (not (equal "" (setq regexp (read-string - (format "Match on %s (string): " - header))))) - (push (list regexp nil nil 'r) regexps)) - (push (cons header regexps) scores)) - scores))) - (gnus-group-make-group group "nnkiboze" address) - (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group)) - (let (emacs-lisp-mode-hook) - (pp scores (current-buffer))))) - -(defun gnus-group-add-to-virtual (n vgroup) - "Add the current group to a virtual group." - (interactive - (list current-prefix-arg - (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t - "nnvirtual:"))) - (unless (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual) - (error "%s is not an nnvirtual group" vgroup)) - (gnus-close-group vgroup) - (let* ((groups (gnus-group-process-prefix n)) - (method (gnus-info-method (gnus-get-info vgroup)))) - (setcar (cdr method) - (concat - (nth 1 method) "\\|" - (mapconcat - (lambda (s) - (gnus-group-remove-mark s) - (concat "\\(^" (regexp-quote s) "$\\)")) - groups "\\|")))) - (gnus-group-position-point)) - -(defun gnus-group-make-empty-virtual (group) - "Create a new, fresh, empty virtual group." - (interactive "sCreate new, empty virtual group: ") - (let* ((method (list 'nnvirtual "^$")) - (pgroup (gnus-group-prefixed-name group method))) - ;; Check whether it exists already. - (when (gnus-gethash pgroup gnus-newsrc-hashtb) - (error "Group %s already exists" pgroup)) - ;; Subscribe the new group after the group on the current line. - (gnus-subscribe-group pgroup (gnus-group-group-name) method) - (gnus-group-update-group pgroup) - (forward-line -1) - (gnus-group-position-point))) - -(defun gnus-group-enter-directory (dir) - "Enter an ephemeral nneething group." - (interactive "DDirectory to read: ") - (let* ((method (list 'nneething dir '(nneething-read-only t))) - (leaf (gnus-group-prefixed-name - (file-name-nondirectory (directory-file-name dir)) - method)) - (name (gnus-generate-new-group-name leaf))) - (unless (gnus-group-read-ephemeral-group - name method t - (cons (current-buffer) - (if (eq major-mode 'gnus-summary-mode) - 'summary 'group))) - (error "Couldn't enter %s" dir)))) - -;; Group sorting commands -;; Suggested by Joe Hildebrand . - -(defun gnus-group-sort-groups (func &optional reverse) - "Sort the group buffer according to FUNC. -When used interactively, the sorting function used will be -determined by the `gnus-group-sort-function' variable. -If REVERSE (the prefix), reverse the sorting order." - (interactive (list gnus-group-sort-function current-prefix-arg)) - (funcall gnus-group-sort-alist-function - (gnus-make-sort-function func) reverse) - (gnus-group-list-groups) - (gnus-dribble-touch)) - -(defun gnus-group-sort-flat (func reverse) - ;; We peel off the dummy group from the alist. - (when func - (when (equal (gnus-info-group (car gnus-newsrc-alist)) "dummy.group") - (pop gnus-newsrc-alist)) - ;; Do the sorting. - (setq gnus-newsrc-alist - (sort gnus-newsrc-alist func)) - (when reverse - (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))) - ;; Regenerate the hash table. - (gnus-make-hashtable-from-newsrc-alist))) - -(defun gnus-group-sort-groups-by-alphabet (&optional reverse) - "Sort the group buffer alphabetically by group name. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse)) - -(defun gnus-group-sort-groups-by-unread (&optional reverse) - "Sort the group buffer by number of unread articles. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse)) - -(defun gnus-group-sort-groups-by-level (&optional reverse) - "Sort the group buffer by group level. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-level reverse)) - -(defun gnus-group-sort-groups-by-score (&optional reverse) - "Sort the group buffer by group score. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-score reverse)) - -(defun gnus-group-sort-groups-by-rank (&optional reverse) - "Sort the group buffer by group rank. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse)) - -(defun gnus-group-sort-groups-by-method (&optional reverse) - "Sort the group buffer alphabetically by backend name. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-groups 'gnus-group-sort-by-method reverse)) - -;;; Selected group sorting. - -(defun gnus-group-sort-selected-groups (n func &optional reverse) - "Sort the process/prefixed groups." - (interactive (list current-prefix-arg gnus-group-sort-function)) - (let ((groups (gnus-group-process-prefix n))) - (funcall gnus-group-sort-selected-function - groups (gnus-make-sort-function func) reverse) - (gnus-group-list-groups))) - -(defun gnus-group-sort-selected-flat (groups func reverse) - (let (entries infos) - ;; First find all the group entries for these groups. - (while groups - (push (nthcdr 2 (gnus-gethash (pop groups) gnus-newsrc-hashtb)) - entries)) - ;; Then sort the infos. - (setq infos - (sort - (mapcar - (lambda (entry) (car entry)) - (setq entries (nreverse entries))) - func)) - (when reverse - (setq infos (nreverse infos))) - ;; Go through all the infos and replace the old entries - ;; with the new infos. - (while infos - (setcar entries (pop infos)) - (pop entries)) - ;; Update the hashtable. - (gnus-make-hashtable-from-newsrc-alist))) - -(defun gnus-group-sort-selected-groups-by-alphabet (&optional reverse) - "Sort the group buffer alphabetically by group name. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-selected-groups 'gnus-group-sort-by-alphabet reverse)) - -(defun gnus-group-sort-selected-groups-by-unread (&optional reverse) - "Sort the group buffer by number of unread articles. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-selected-groups 'gnus-group-sort-by-unread reverse)) - -(defun gnus-group-sort-selected-groups-by-level (&optional reverse) - "Sort the group buffer by group level. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-selected-groups 'gnus-group-sort-by-level reverse)) - -(defun gnus-group-sort-selected-groups-by-score (&optional reverse) - "Sort the group buffer by group score. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-selected-groups 'gnus-group-sort-by-score reverse)) - -(defun gnus-group-sort-selected-groups-by-rank (&optional reverse) - "Sort the group buffer by group rank. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-selected-groups 'gnus-group-sort-by-rank reverse)) - -(defun gnus-group-sort-selected-groups-by-method (&optional reverse) - "Sort the group buffer alphabetically by backend name. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-selected-groups 'gnus-group-sort-by-method reverse)) - -;;; Sorting predicates. - -(defun gnus-group-sort-by-alphabet (info1 info2) - "Sort alphabetically." - (string< (gnus-info-group info1) (gnus-info-group info2))) - -(defun gnus-group-sort-by-real-name (info1 info2) - "Sort alphabetically on real (unprefixed) names." - (string< (gnus-group-real-name (gnus-info-group info1)) - (gnus-group-real-name (gnus-info-group info2)))) - -(defun gnus-group-sort-by-unread (info1 info2) - "Sort by number of unread articles." - (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb))) - (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb)))) - (< (or (and (numberp n1) n1) 0) - (or (and (numberp n2) n2) 0)))) - -(defun gnus-group-sort-by-level (info1 info2) - "Sort by level." - (< (gnus-info-level info1) (gnus-info-level info2))) - -(defun gnus-group-sort-by-method (info1 info2) - "Sort alphabetically by backend name." - (string< (symbol-name (car (gnus-find-method-for-group - (gnus-info-group info1) info1))) - (symbol-name (car (gnus-find-method-for-group - (gnus-info-group info2) info2))))) - -(defun gnus-group-sort-by-score (info1 info2) - "Sort by group score." - (< (gnus-info-score info1) (gnus-info-score info2))) - -(defun gnus-group-sort-by-rank (info1 info2) - "Sort by level and score." - (let ((level1 (gnus-info-level info1)) - (level2 (gnus-info-level info2))) - (or (< level1 level2) - (and (= level1 level2) - (> (gnus-info-score info1) (gnus-info-score info2)))))) - -;;; Clearing data - -(defun gnus-group-clear-data (&optional arg) - "Clear all marks and read ranges from the current group." - (interactive "P") - (gnus-group-iterate arg - (lambda (group) - (let (info) - (gnus-info-clear-data (setq info (gnus-get-info group))) - (gnus-get-unread-articles-in-group info (gnus-active group) t) - (when (gnus-group-goto-group group) - (gnus-group-update-group-line)))))) - -(defun gnus-group-clear-data-on-native-groups () - "Clear all marks and read ranges from all native groups." - (interactive) - (when (gnus-yes-or-no-p "Really clear all data from almost all groups? ") - (let ((alist (cdr gnus-newsrc-alist)) - info) - (while (setq info (pop alist)) - (when (gnus-group-native-p (gnus-info-group info)) - (gnus-info-clear-data info))) - (gnus-get-unread-articles) - (gnus-dribble-enter "") - (when (gnus-y-or-n-p - "Move the cache away to avoid problems in the future? ") - (call-interactively 'gnus-cache-move-cache))))) - -(defun gnus-info-clear-data (info) - "Clear all marks and read ranges from INFO." - (let ((group (gnus-info-group info))) - (gnus-undo-register - `(progn - (gnus-info-set-marks ',info ',(gnus-info-marks info) t) - (gnus-info-set-read ',info ',(gnus-info-read info)) - (when (gnus-group-goto-group ,group) - (gnus-group-update-group-line)))) - (gnus-info-set-read info nil) - (when (gnus-info-marks info) - (gnus-info-set-marks info nil)))) - -;; Group catching up. - -(defun gnus-group-catchup-current (&optional n all) - "Mark all articles not marked as unread in current newsgroup as read. -If prefix argument N is numeric, the ARG next newsgroups will be -caught up. If ALL is non-nil, marked articles will also be marked as -read. Cross references (Xref: header) of articles are ignored. -The difference between N and actual number of newsgroups that were -caught up is returned." - (interactive "P") - (unless (gnus-group-group-name) - (error "No group on the current line")) - (let ((groups (gnus-group-process-prefix n)) - (ret 0)) - (if (not - (or (not gnus-interactive-catchup) ;Without confirmation? - gnus-expert-user - (gnus-y-or-n-p - (format - (if all - "Do you really want to mark all articles in %s as read? " - "Mark all unread articles in %s as read? ") - (if (= (length groups) 1) - (car groups) - (format "these %d groups" (length groups))))))) - n - (while groups - ;; Virtual groups have to be given special treatment. - (let ((method (gnus-find-method-for-group (car groups)))) - (when (eq 'nnvirtual (car method)) - (nnvirtual-catchup-group - (gnus-group-real-name (car groups)) (nth 1 method) all))) - (gnus-group-remove-mark (car groups)) - (if (>= (gnus-group-group-level) gnus-level-zombie) - (gnus-message 2 "Dead groups can't be caught up") - (if (prog1 - (gnus-group-goto-group (car groups)) - (gnus-group-catchup (car groups) all)) - (gnus-group-update-group-line) - (setq ret (1+ ret)))) - (setq groups (cdr groups))) - (gnus-group-next-unread-group 1) - ret))) - -(defun gnus-group-catchup-current-all (&optional n) - "Mark all articles in current newsgroup as read. -Cross references (Xref: header) of articles are ignored." - (interactive "P") - (gnus-group-catchup-current n 'all)) - -(defun gnus-group-catchup (group &optional all) - "Mark all articles in GROUP as read. -If ALL is non-nil, all articles are marked as read. -The return value is the number of articles that were marked as read, -or nil if no action could be taken." - (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) - (num (car entry))) - ;; Do the updating only if the newsgroup isn't killed. - (if (not (numberp (car entry))) - (gnus-message 1 "Can't catch up %s; non-active group" group) - ;; Do auto-expirable marks if that's required. - (when (gnus-group-auto-expirable-p group) - (gnus-add-marked-articles - group 'expire (gnus-list-of-unread-articles group)) - (when all - (let ((marks (nth 3 (nth 2 entry)))) - (gnus-add-marked-articles - group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))) - (gnus-add-marked-articles - group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))))) - (when entry - (gnus-update-read-articles group nil) - ;; Also nix out the lists of marks and dormants. - (when all - (gnus-add-marked-articles group 'tick nil nil 'force) - (gnus-add-marked-articles group 'dormant nil nil 'force)) - (let ((gnus-newsgroup-name group)) - (run-hooks 'gnus-group-catchup-group-hook)) - num)))) - -(defun gnus-group-expire-articles (&optional n) - "Expire all expirable articles in the current newsgroup." - (interactive "P") - (let ((groups (gnus-group-process-prefix n)) - group) - (unless groups - (error "No groups to expire")) - (while (setq group (pop groups)) - (gnus-group-remove-mark group) - (when (gnus-check-backend-function 'request-expire-articles group) - (gnus-message 6 "Expiring articles in %s..." group) - (let* ((info (gnus-get-info group)) - (expirable (if (gnus-group-total-expirable-p group) - (cons nil (gnus-list-of-read-articles group)) - (assq 'expire (gnus-info-marks info)))) - (expiry-wait (gnus-group-find-parameter group 'expiry-wait))) - (when expirable - (setcdr - expirable - (gnus-compress-sequence - (if expiry-wait - ;; We set the expiry variables to the group - ;; parameter. - (let ((nnmail-expiry-wait-function nil) - (nnmail-expiry-wait expiry-wait)) - (gnus-request-expire-articles - (gnus-uncompress-sequence (cdr expirable)) group)) - ;; Just expire using the normal expiry values. - (gnus-request-expire-articles - (gnus-uncompress-sequence (cdr expirable)) group)))) - (gnus-close-group group)) - (gnus-message 6 "Expiring articles in %s...done" group))) - (gnus-dribble-touch) - (gnus-group-position-point)))) - -(defun gnus-group-expire-all-groups () - "Expire all expirable articles in all newsgroups." - (interactive) - (save-excursion - (gnus-message 5 "Expiring...") - (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info)) - (cdr gnus-newsrc-alist)))) - (gnus-group-expire-articles nil))) - (gnus-group-position-point) - (gnus-message 5 "Expiring...done")) - -(defun gnus-group-set-current-level (n level) - "Set the level of the next N groups to LEVEL." - (interactive - (list - current-prefix-arg - (string-to-int - (let ((s (read-string - (format "Level (default %s): " - (or (gnus-group-group-level) - gnus-level-default-subscribed))))) - (if (string-match "^\\s-*$" s) - (int-to-string (or (gnus-group-group-level) - gnus-level-default-subscribed)) - s))))) - (unless (and (>= level 1) (<= level gnus-level-killed)) - (error "Illegal level: %d" level)) - (let ((groups (gnus-group-process-prefix n)) - group) - (while (setq group (pop groups)) - (gnus-group-remove-mark group) - (gnus-message 6 "Changed level of %s from %d to %d" - group (or (gnus-group-group-level) gnus-level-killed) - level) - (gnus-group-change-level - group level (or (gnus-group-group-level) gnus-level-killed)) - (gnus-group-update-group-line))) - (gnus-group-position-point)) - -(defun gnus-group-unsubscribe (&optional n) - "Unsubscribe the current group." - (interactive "P") - (gnus-group-unsubscribe-current-group n 'unsubscribe)) - -(defun gnus-group-subscribe (&optional n) - "Subscribe the current group." - (interactive "P") - (gnus-group-unsubscribe-current-group n 'subscribe)) - -(defun gnus-group-unsubscribe-current-group (&optional n do-sub) - "Toggle subscription of the current group. -If given numerical prefix, toggle the N next groups." - (interactive "P") - (let ((groups (gnus-group-process-prefix n)) - group) - (while groups - (setq group (car groups) - groups (cdr groups)) - (gnus-group-remove-mark group) - (gnus-group-unsubscribe-group - group - (cond - ((eq do-sub 'unsubscribe) - gnus-level-default-unsubscribed) - ((eq do-sub 'subscribe) - gnus-level-default-subscribed) - ((<= (gnus-group-group-level) gnus-level-subscribed) - gnus-level-default-unsubscribed) - (t - gnus-level-default-subscribed)) - t) - (gnus-group-update-group-line)) - (gnus-group-next-group 1))) - -(defun gnus-group-unsubscribe-group (group &optional level silent) - "Toggle subscription to GROUP. -Killed newsgroups are subscribed. If SILENT, don't try to update the -group line." - (interactive - (list (completing-read - "Group: " gnus-active-hashtb nil - (gnus-read-active-file-p) - nil - 'gnus-group-history))) - (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) - (cond - ((string-match "^[ \t]$" group) - (error "Empty group name")) - (newsrc - ;; Toggle subscription flag. - (gnus-group-change-level - newsrc (if level level (if (<= (gnus-info-level (nth 2 newsrc)) - gnus-level-subscribed) - (1+ gnus-level-subscribed) - gnus-level-default-subscribed))) - (unless silent - (gnus-group-update-group group))) - ((and (stringp group) - (or (not (gnus-read-active-file-p)) - (gnus-active group))) - ;; Add new newsgroup. - (gnus-group-change-level - group - (if level level gnus-level-default-subscribed) - (or (and (member group gnus-zombie-list) - gnus-level-zombie) - gnus-level-killed) - (when (gnus-group-group-name) - (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb))) - (unless silent - (gnus-group-update-group group))) - (t (error "No such newsgroup: %s" group))) - (gnus-group-position-point))) - -(defun gnus-group-transpose-groups (n) - "Move the current newsgroup up N places. -If given a negative prefix, move down instead. The difference between -N and the number of steps taken is returned." - (interactive "p") - (unless (gnus-group-group-name) - (error "No group on current line")) - (gnus-group-kill-group 1) - (prog1 - (forward-line (- n)) - (gnus-group-yank-group) - (gnus-group-position-point))) - -(defun gnus-group-kill-all-zombies () - "Kill all zombie newsgroups." - (interactive) - (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list)) - (setq gnus-zombie-list nil) - (gnus-dribble-touch) - (gnus-group-list-groups)) - -(defun gnus-group-kill-region (begin end) - "Kill newsgroups in current region (excluding current point). -The killed newsgroups can be yanked by using \\[gnus-group-yank-group]." - (interactive "r") - (let ((lines - ;; Count lines. - (save-excursion - (count-lines - (progn - (goto-char begin) - (beginning-of-line) - (point)) - (progn - (goto-char end) - (beginning-of-line) - (point)))))) - (goto-char begin) - (beginning-of-line) ;Important when LINES < 1 - (gnus-group-kill-group lines))) - -(defun gnus-group-kill-group (&optional n discard) - "Kill the next N groups. -The killed newsgroups can be yanked by using \\[gnus-group-yank-group]. -However, only groups that were alive can be yanked; already killed -groups or zombie groups can't be yanked. -The return value is the name of the group that was killed, or a list -of groups killed." - (interactive "P") - (let ((buffer-read-only nil) - (groups (gnus-group-process-prefix n)) - group entry level out) - (if (< (length groups) 10) - ;; This is faster when there are few groups. - (while groups - (push (setq group (pop groups)) out) - (gnus-group-remove-mark group) - (setq level (gnus-group-group-level)) - (gnus-delete-line) - (when (and (not discard) - (setq entry (gnus-gethash group gnus-newsrc-hashtb))) - (gnus-undo-register - `(progn - (gnus-group-goto-group ,(gnus-group-group-name)) - (gnus-group-yank-group))) - (push (cons (car entry) (nth 2 entry)) - gnus-list-of-killed-groups)) - (gnus-group-change-level - (if entry entry group) gnus-level-killed (if entry nil level))) - ;; If there are lots and lots of groups to be killed, we use - ;; this thing instead. - (let (entry) - (setq groups (nreverse groups)) - (while groups - (gnus-group-remove-mark (setq group (pop groups))) - (gnus-delete-line) - (push group gnus-killed-list) - (setq gnus-newsrc-alist - (delq (assoc group gnus-newsrc-alist) - gnus-newsrc-alist)) - (when gnus-group-change-level-function - (funcall gnus-group-change-level-function group 9 3)) - (cond - ((setq entry (gnus-gethash group gnus-newsrc-hashtb)) - (push (cons (car entry) (nth 2 entry)) - gnus-list-of-killed-groups) - (setcdr (cdr entry) (cdddr entry))) - ((member group gnus-zombie-list) - (setq gnus-zombie-list (delete group gnus-zombie-list))))) - (gnus-make-hashtable-from-newsrc-alist))) - - (gnus-group-position-point) - (if (< (length out) 2) (car out) (nreverse out)))) - -(defun gnus-group-yank-group (&optional arg) - "Yank the last newsgroups killed with \\[gnus-group-kill-group], -inserting it before the current newsgroup. The numeric ARG specifies -how many newsgroups are to be yanked. The name of the newsgroup yanked -is returned, or (if several groups are yanked) a list of yanked groups -is returned." - (interactive "p") - (setq arg (or arg 1)) - (let (info group prev out) - (while (>= (decf arg) 0) - (when (not (setq info (pop gnus-list-of-killed-groups))) - (error "No more newsgroups to yank")) - (push (setq group (nth 1 info)) out) - ;; Find which newsgroup to insert this one before - search - ;; backward until something suitable is found. If there are no - ;; other newsgroups in this buffer, just make this newsgroup the - ;; first newsgroup. - (setq prev (gnus-group-group-name)) - (gnus-group-change-level - info (gnus-info-level (cdr info)) gnus-level-killed - (and prev (gnus-gethash prev gnus-newsrc-hashtb)) - t) - (gnus-group-insert-group-line-info group) - (gnus-undo-register - `(when (gnus-group-goto-group ,group) - (gnus-group-kill-group 1)))) - (forward-line -1) - (gnus-group-position-point) - (if (< (length out) 2) (car out) (nreverse out)))) - -(defun gnus-group-kill-level (level) - "Kill all groups that is on a certain LEVEL." - (interactive "nKill all groups on level: ") - (cond - ((= level gnus-level-zombie) - (setq gnus-killed-list - (nconc gnus-zombie-list gnus-killed-list)) - (setq gnus-zombie-list nil)) - ((and (< level gnus-level-zombie) - (> level 0) - (or gnus-expert-user - (gnus-yes-or-no-p - (format - "Do you really want to kill all groups on level %d? " - level)))) - (let* ((prev gnus-newsrc-alist) - (alist (cdr prev))) - (while alist - (if (= (gnus-info-level (car alist)) level) - (progn - (push (gnus-info-group (car alist)) gnus-killed-list) - (setcdr prev (cdr alist))) - (setq prev alist)) - (setq alist (cdr alist))) - (gnus-make-hashtable-from-newsrc-alist) - (gnus-group-list-groups))) - (t - (error "Can't kill; illegal level: %d" level)))) - -(defun gnus-group-list-all-groups (&optional arg) - "List all newsgroups with level ARG or lower. -Default is gnus-level-unsubscribed, which lists all subscribed and most -unsubscribed groups." - (interactive "P") - (gnus-group-list-groups (or arg gnus-level-unsubscribed) t)) - -;; Redefine this to list ALL killed groups if prefix arg used. -;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom). -(defun gnus-group-list-killed (&optional arg) - "List all killed newsgroups in the group buffer. -If ARG is non-nil, list ALL killed groups known to Gnus. This may -entail asking the server for the groups." - (interactive "P") - ;; Find all possible killed newsgroups if arg. - (when arg - (gnus-get-killed-groups)) - (if (not gnus-killed-list) - (gnus-message 6 "No killed groups") - (let (gnus-group-list-mode) - (funcall gnus-group-prepare-function - gnus-level-killed t gnus-level-killed)) - (goto-char (point-min))) - (gnus-group-position-point)) - -(defun gnus-group-list-zombies () - "List all zombie newsgroups in the group buffer." - (interactive) - (if (not gnus-zombie-list) - (gnus-message 6 "No zombie groups") - (let (gnus-group-list-mode) - (funcall gnus-group-prepare-function - gnus-level-zombie t gnus-level-zombie)) - (goto-char (point-min))) - (gnus-group-position-point)) - -(defun gnus-group-list-active () - "List all groups that are available from the server(s)." - (interactive) - ;; First we make sure that we have really read the active file. - (unless (gnus-read-active-file-p) - (let ((gnus-read-active-file t)) - (gnus-read-active-file))) - ;; Find all groups and sort them. - (let ((groups - (sort - (let (list) - (mapatoms - (lambda (sym) - (and (boundp sym) - (symbol-value sym) - (push (symbol-name sym) list))) - gnus-active-hashtb) - list) - 'string<)) - (buffer-read-only nil) - group) - (erase-buffer) - (while groups - (gnus-add-text-properties - (point) (prog1 (1+ (point)) - (insert " *: " - (setq group (pop groups)) "\n")) - (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) - 'gnus-unread t - 'gnus-level (inline (gnus-group-level group))))) - (goto-char (point-min)))) - -(defun gnus-activate-all-groups (level) - "Activate absolutely all groups." - (interactive (list 7)) - (let ((gnus-activate-level level) - (gnus-activate-foreign-newsgroups level)) - (gnus-group-get-new-news))) - -(defun gnus-group-get-new-news (&optional arg) - "Get newly arrived articles. -If ARG is a number, it specifies which levels you are interested in -re-scanning. If ARG is non-nil and not a number, this will force -\"hard\" re-reading of the active files from all servers." - (interactive "P") - (let ((gnus-inhibit-demon t)) - (run-hooks 'gnus-get-new-news-hook) - - ;; Read any slave files. - (unless gnus-slave - (gnus-master-read-slave-newsrc)) - - ;; We might read in new NoCeM messages here. - (when (and gnus-use-nocem - (null arg)) - (gnus-nocem-scan-groups)) - ;; If ARG is not a number, then we read the active file. - (when (and arg (not (numberp arg))) - (let ((gnus-read-active-file t)) - (gnus-read-active-file)) - (setq arg nil) - - ;; If the user wants it, we scan for new groups. - (when (eq gnus-check-new-newsgroups 'always) - (gnus-find-new-newsgroups))) - - (setq arg (gnus-group-default-level arg t)) - (if (and gnus-read-active-file (not arg)) - (progn - (gnus-read-active-file) - (gnus-get-unread-articles arg)) - (let ((gnus-read-active-file (if arg nil gnus-read-active-file))) - (gnus-get-unread-articles arg))) - (run-hooks 'gnus-after-getting-new-news-hook) - (gnus-group-list-groups (and (numberp arg) - (max (car gnus-group-list-mode) arg))))) - -(defun gnus-group-get-new-news-this-group (&optional n dont-scan) - "Check for newly arrived news in the current group (and the N-1 next groups). -The difference between N and the number of newsgroup checked is returned. -If N is negative, this group and the N-1 previous groups will be checked." - (interactive "P") - (let* ((groups (gnus-group-process-prefix n)) - (ret (if (numberp n) (- n (length groups)) 0)) - (beg (unless n - (point))) - group) - (while (setq group (pop groups)) - (gnus-group-remove-mark group) - ;; Bypass any previous denials from the server. - (gnus-remove-denial (gnus-find-method-for-group group)) - (if (gnus-activate-group group (if dont-scan nil 'scan)) - (progn - (gnus-get-unread-articles-in-group - (gnus-get-info group) (gnus-active group) t) - (unless (gnus-virtual-group-p group) - (gnus-close-group group)) - (gnus-group-update-group group)) - (if (eq (gnus-server-status (gnus-find-method-for-group group)) - 'denied) - (gnus-error 3 "Server denied access") - (gnus-error 3 "%s error: %s" group (gnus-status-message group))))) - (when beg - (goto-char beg)) - (when gnus-goto-next-group-when-activating - (gnus-group-next-unread-group 1 t)) - (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 (lambda (file) (list file)) - 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))) - (setq file (concat (file-name-as-directory dir) - (gnus-group-real-name group))) - (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-describe-group (force &optional group) - "Display a description of the current newsgroup." - (interactive (list current-prefix-arg (gnus-group-group-name))) - (let* ((method (gnus-find-method-for-group group)) - (mname (gnus-group-prefixed-name "" method)) - desc) - (when (and force - gnus-description-hashtb) - (gnus-sethash mname nil gnus-description-hashtb)) - (unless group - (error "No group name given")) - (when (or (and gnus-description-hashtb - ;; We check whether this group's method has been - ;; queried for a description file. - (gnus-gethash mname gnus-description-hashtb)) - (setq desc (gnus-group-get-description group)) - (gnus-read-descriptions-file method)) - (gnus-message 1 - (or desc (gnus-gethash group gnus-description-hashtb) - "No description available"))))) - -;; Suggested by Per Abrahamsen . -(defun gnus-group-describe-all-groups (&optional force) - "Pop up a buffer with descriptions of all newsgroups." - (interactive "P") - (when force - (setq gnus-description-hashtb nil)) - (when (not (or gnus-description-hashtb - (gnus-read-all-descriptions-files))) - (error "Couldn't request descriptions file")) - (let ((buffer-read-only nil) - b) - (erase-buffer) - (mapatoms - (lambda (group) - (setq b (point)) - (insert (format " *: %-20s %s\n" (symbol-name group) - (symbol-value group))) - (gnus-add-text-properties - b (1+ b) (list 'gnus-group group - 'gnus-unread t 'gnus-marked nil - 'gnus-level (1+ gnus-level-subscribed)))) - gnus-description-hashtb) - (goto-char (point-min)) - (gnus-group-position-point))) - -;; Suggested by Daniel Quinlan . -(defun gnus-group-apropos (regexp &optional search-description) - "List all newsgroups that have names that match a regexp." - (interactive "sGnus apropos (regexp): ") - (let ((prev "") - (obuf (current-buffer)) - groups des) - ;; Go through all newsgroups that are known to Gnus. - (mapatoms - (lambda (group) - (and (symbol-name group) - (string-match regexp (symbol-name group)) - (push (symbol-name group) groups))) - gnus-active-hashtb) - ;; Also go through all descriptions that are known to Gnus. - (when search-description - (mapatoms - (lambda (group) - (and (string-match regexp (symbol-value group)) - (gnus-active (symbol-name group)) - (push (symbol-name group) groups))) - gnus-description-hashtb)) - (if (not groups) - (gnus-message 3 "No groups matched \"%s\"." regexp) - ;; Print out all the groups. - (save-excursion - (pop-to-buffer "*Gnus Help*") - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (setq groups (sort groups 'string<)) - (while groups - ;; Groups may be entered twice into the list of groups. - (when (not (string= (car groups) prev)) - (insert (setq prev (car groups)) "\n") - (when (and gnus-description-hashtb - (setq des (gnus-gethash (car groups) - gnus-description-hashtb))) - (insert " " des "\n"))) - (setq groups (cdr groups))) - (goto-char (point-min)))) - (pop-to-buffer obuf))) - -(defun gnus-group-description-apropos (regexp) - "List all newsgroups that have names or descriptions that match a regexp." - (interactive "sGnus description apropos (regexp): ") - (when (not (or gnus-description-hashtb - (gnus-read-all-descriptions-files))) - (error "Couldn't request descriptions file")) - (gnus-group-apropos regexp t)) - -;; Suggested by Per Abrahamsen . -(defun gnus-group-list-matching (level regexp &optional all lowest) - "List all groups with unread articles that match REGEXP. -If the prefix LEVEL is non-nil, it should be a number that says which -level to cut off listing groups. -If ALL, also list groups with no unread articles. -If LOWEST, don't list groups with level lower than LOWEST. - -This command may read the active file." - (interactive "P\nsList newsgroups matching: ") - ;; First make sure active file has been read. - (when (and level - (> (prefix-numeric-value level) gnus-level-killed)) - (gnus-get-killed-groups)) - (gnus-group-prepare-flat - (or level gnus-level-subscribed) all (or lowest 1) regexp) - (goto-char (point-min)) - (gnus-group-position-point)) - -(defun gnus-group-list-all-matching (level regexp &optional lowest) - "List all groups that match REGEXP. -If the prefix LEVEL is non-nil, it should be a number that says which -level to cut off listing groups. -If LOWEST, don't list groups with level lower than LOWEST." - (interactive "P\nsList newsgroups matching: ") - (when level - (setq level (prefix-numeric-value level))) - (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest)) - -;; Suggested by Jack Vinson . -(defun gnus-group-save-newsrc (&optional force) - "Save the Gnus startup files. -If FORCE, force saving whether it is necessary or not." - (interactive "P") - (gnus-save-newsrc-file force)) - -(defun gnus-group-restart (&optional arg) - "Force Gnus to read the .newsrc file." - (interactive "P") - (when (gnus-yes-or-no-p - (format "Are you sure you want to restart Gnus? ")) - (gnus-save-newsrc-file) - (gnus-clear-system) - (gnus))) - -(defun gnus-group-read-init-file () - "Read the Gnus elisp init file." - (interactive) - (gnus-read-init-file)) - -(defun gnus-group-check-bogus-groups (&optional silent) - "Check bogus newsgroups. -If given a prefix, don't ask for confirmation before removing a bogus -group." - (interactive "P") - (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user))) - (gnus-group-list-groups)) - -(defun gnus-group-find-new-groups (&optional arg) - "Search for new groups and add them. -Each new group will be treated with `gnus-subscribe-newsgroup-method.' -If ARG (the prefix), use the `ask-server' method to query -the server for new groups." - (interactive "P") - (gnus-find-new-newsgroups arg) - (gnus-group-list-groups)) - -(defun gnus-group-edit-global-kill (&optional article group) - "Edit the global kill file. -If GROUP, edit that local kill file instead." - (interactive "P") - (setq gnus-current-kill-article article) - (gnus-kill-file-edit-file group) - (gnus-message - 6 - (substitute-command-keys - (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)" - (if group "local" "global"))))) - -(defun gnus-group-edit-local-kill (article group) - "Edit a local kill file." - (interactive (list nil (gnus-group-group-name))) - (gnus-group-edit-global-kill article group)) - -(defun gnus-group-force-update () - "Update `.newsrc' file." - (interactive) - (gnus-save-newsrc-file)) - -(defun gnus-group-suspend () - "Suspend the current Gnus session. -In fact, cleanup buffers except for group mode buffer. -The hook gnus-suspend-gnus-hook is called before actually suspending." - (interactive) - (run-hooks 'gnus-suspend-gnus-hook) - ;; Kill Gnus buffers except for group mode buffer. - (let* ((group-buf (get-buffer gnus-group-buffer)) - ;; Do this on a separate list in case the user does a ^G before we finish - (gnus-buffer-list - (delete group-buf (delete gnus-dribble-buffer - (append gnus-buffer-list nil))))) - (while gnus-buffer-list - (gnus-kill-buffer (pop gnus-buffer-list))) - (gnus-kill-gnus-frames) - (when group-buf - (setq gnus-buffer-list (list group-buf)) - (bury-buffer group-buf) - (delete-windows-on group-buf t)))) - -(defun gnus-group-clear-dribble () - "Clear all information from the dribble buffer." - (interactive) - (gnus-dribble-clear) - (gnus-message 7 "Cleared dribble buffer")) - -(defun gnus-group-exit () - "Quit reading news after updating .newsrc.eld and .newsrc. -The hook `gnus-exit-gnus-hook' is called before actually exiting." - (interactive) - (when - (or noninteractive ;For gnus-batch-kill - (not gnus-interactive-exit) ;Without confirmation - gnus-expert-user - (gnus-y-or-n-p "Are you sure you want to quit reading news? ")) - (run-hooks 'gnus-exit-gnus-hook) - ;; Offer to save data from non-quitted summary buffers. - (gnus-offer-save-summaries) - ;; Save the newsrc file(s). - (gnus-save-newsrc-file) - ;; Kill-em-all. - (gnus-close-backends) - ;; Reset everything. - (gnus-clear-system) - ;; Allow the user to do things after cleaning up. - (run-hooks 'gnus-after-exiting-gnus-hook))) - -(defun gnus-group-quit () - "Quit reading news without updating .newsrc.eld or .newsrc. -The hook `gnus-exit-gnus-hook' is called before actually exiting." - (interactive) - (when (or noninteractive ;For gnus-batch-kill - (zerop (buffer-size)) - (not (gnus-server-opened gnus-select-method)) - gnus-expert-user - (not gnus-current-startup-file) - (gnus-yes-or-no-p - (format "Quit reading news without saving %s? " - (file-name-nondirectory gnus-current-startup-file)))) - (run-hooks 'gnus-exit-gnus-hook) - (gnus-configure-windows 'group t) - (gnus-dribble-save) - (gnus-close-backends) - (gnus-clear-system) - (gnus-kill-buffer gnus-group-buffer) - ;; Allow the user to do things after cleaning up. - (run-hooks 'gnus-after-exiting-gnus-hook))) - -(defun gnus-group-describe-briefly () - "Give a one line description of the group mode commands." - (interactive) - (gnus-message 7 (substitute-command-keys "\\\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help"))) - -(defun gnus-group-browse-foreign-server (method) - "Browse a foreign news server. -If called interactively, this function will ask for a select method - (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). -If not, METHOD should be a list where the first element is the method -and the second element is the address." - (interactive - (list (let ((how (completing-read - "Which backend: " - (append gnus-valid-select-methods gnus-server-alist) - nil t (cons "nntp" 0) 'gnus-method-history))) - ;; We either got a backend name or a virtual server name. - ;; If the first, we also need an address. - (if (assoc how gnus-valid-select-methods) - (list (intern how) - ;; Suggested by mapjph@bath.ac.uk. - (completing-read - "Address: " - (mapcar (lambda (server) (list server)) - gnus-secondary-servers))) - ;; We got a server name. - how)))) - (gnus-browse-foreign-server method)) - -(defun gnus-group-set-info (info &optional method-only-group part) - (let* ((entry (gnus-gethash - (or method-only-group (gnus-info-group info)) - gnus-newsrc-hashtb)) - (part-info info) - (info (if method-only-group (nth 2 entry) info)) - method) - (when method-only-group - (unless entry - (error "Trying to change non-existent group %s" method-only-group)) - ;; We have received parts of the actual group info - either the - ;; select method or the group parameters. We first check - ;; whether we have to extend the info, and if so, do that. - (let ((len (length info)) - (total (if (eq part 'method) 5 6))) - (when (< len total) - (setcdr (nthcdr (1- len) info) - (make-list (- total len) nil))) - ;; Then we enter the new info. - (setcar (nthcdr (1- total) info) part-info))) - (unless entry - ;; This is a new group, so we just create it. - (save-excursion - (set-buffer gnus-group-buffer) - (setq method (gnus-info-method info)) - (when (gnus-server-equal method "native") - (setq method nil)) - (save-excursion - (set-buffer gnus-group-buffer) - (if method - ;; It's a foreign group... - (gnus-group-make-group - (gnus-group-real-name (gnus-info-group info)) - (if (stringp method) method - (prin1-to-string (car method))) - (and (consp method) - (nth 1 (gnus-info-method info)))) - ;; It's a native group. - (gnus-group-make-group (gnus-info-group info)))) - (gnus-message 6 "Note: New group created") - (setq entry - (gnus-gethash (gnus-group-prefixed-name - (gnus-group-real-name (gnus-info-group info)) - (or (gnus-info-method info) gnus-select-method)) - gnus-newsrc-hashtb)))) - ;; Whether it was a new group or not, we now have the entry, so we - ;; can do the update. - (if entry - (progn - (setcar (nthcdr 2 entry) info) - (when (and (not (eq (car entry) t)) - (gnus-active (gnus-info-group info))) - (setcar entry (length (gnus-list-of-unread-articles (car info)))))) - (error "No such group: %s" (gnus-info-group info))))) - -(defun gnus-group-set-method-info (group select-method) - (gnus-group-set-info select-method group 'method)) - -(defun gnus-group-set-params-info (group params) - (gnus-group-set-info params group 'params)) - -(defun gnus-add-marked-articles (group type articles &optional info force) - ;; Add ARTICLES of TYPE to the info of GROUP. - ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't - ;; add, but replace marked articles of TYPE with ARTICLES. - (let ((info (or info (gnus-get-info group))) - (uncompressed '(score bookmark killed)) - marked m) - (or (not info) - (and (not (setq marked (nthcdr 3 info))) - (or (null articles) - (setcdr (nthcdr 2 info) - (list (list (cons type (gnus-compress-sequence - articles t))))))) - (and (not (setq m (assq type (car marked)))) - (or (null articles) - (setcar marked - (cons (cons type (gnus-compress-sequence articles t) ) - (car marked))))) - (if force - (if (null articles) - (setcar (nthcdr 3 info) - (delq (assq type (car marked)) (car marked))) - (setcdr m (gnus-compress-sequence articles t))) - (setcdr m (gnus-compress-sequence - (sort (nconc (gnus-uncompress-range (cdr m)) - (copy-sequence articles)) '<) t)))))) - -;;; -;;; Group timestamps -;;; - -(defun gnus-group-set-timestamp () - "Change the timestamp of the current group to the current time. -This function can be used in hooks like `gnus-select-group-hook' -or `gnus-group-catchup-group-hook'." - (when gnus-newsgroup-name - (let ((time (current-time))) - (setcdr (cdr time) nil) - (gnus-group-set-parameter gnus-newsgroup-name 'timestamp time)))) - -(defsubst gnus-group-timestamp (group) - "Return the timestamp for GROUP." - (gnus-group-get-parameter group 'timestamp)) - -(defun gnus-group-timestamp-delta (group) - "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number." - (let* ((time (or (gnus-group-timestamp group) - (list 0 0))) - (delta (gnus-time-minus (current-time) time))) - (+ (* (nth 0 delta) 65536.0) - (nth 1 delta)))) - -(defun gnus-group-timestamp-string (group) - "Return a string of the timestamp for GROUP." - (let ((time (gnus-group-timestamp group))) - (if (not time) - "" - (gnus-time-iso8601 time)))) - -(provide 'gnus-group) - -;;; gnus-group.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-int.el --- a/lisp/gnus/gnus-int.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,438 +0,0 @@ -;;; gnus-int.el --- backend interface functions for Gnus -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) - -(defcustom gnus-open-server-hook nil - "Hook called just before opening connection to the news server." - :group 'gnus-start - :type 'hook) - -;;; -;;; Server Communication -;;; - -(defun gnus-start-news-server (&optional confirm) - "Open a method for getting news. -If CONFIRM is non-nil, the user will be asked for an NNTP server." - (let (how) - (if gnus-current-select-method - ;; Stream is already opened. - nil - ;; Open NNTP server. - (unless gnus-nntp-service - (setq gnus-nntp-server nil)) - (when confirm - ;; Read server name with completion. - (setq gnus-nntp-server - (completing-read "NNTP server: " - (mapcar (lambda (server) (list server)) - (cons (list gnus-nntp-server) - gnus-secondary-servers)) - nil nil gnus-nntp-server))) - - (when (and gnus-nntp-server - (stringp gnus-nntp-server) - (not (string= gnus-nntp-server ""))) - (setq gnus-select-method - (cond ((or (string= gnus-nntp-server "") - (string= gnus-nntp-server "::")) - (list 'nnspool (system-name))) - ((string-match "^:" gnus-nntp-server) - (list 'nnmh gnus-nntp-server - (list 'nnmh-directory - (file-name-as-directory - (expand-file-name - (concat "~/" (substring - gnus-nntp-server 1))))) - (list 'nnmh-get-new-mail nil))) - (t - (list 'nntp gnus-nntp-server))))) - - (setq how (car gnus-select-method)) - (cond - ((eq how 'nnspool) - (require 'nnspool) - (gnus-message 5 "Looking up local news spool...")) - ((eq how 'nnmh) - (require 'nnmh) - (gnus-message 5 "Looking up mh spool...")) - (t - (require 'nntp))) - (setq gnus-current-select-method gnus-select-method) - (run-hooks 'gnus-open-server-hook) - (or - ;; gnus-open-server-hook might have opened it - (gnus-server-opened gnus-select-method) - (gnus-open-server gnus-select-method) - (gnus-y-or-n-p - (format - "%s (%s) open error: '%s'. Continue? " - (car gnus-select-method) (cadr gnus-select-method) - (gnus-status-message gnus-select-method))) - (gnus-error 1 "Couldn't open server on %s" - (nth 1 gnus-select-method)))))) - -(defun gnus-check-group (group) - "Try to make sure that the server where GROUP exists is alive." - (let ((method (gnus-find-method-for-group group))) - (or (gnus-server-opened method) - (gnus-open-server method)))) - -(defun gnus-check-server (&optional method silent) - "Check whether the connection to METHOD is down. -If METHOD is nil, use `gnus-select-method'. -If it is down, start it up (again)." - (let ((method (or method gnus-select-method))) - ;; Transform virtual server names into select methods. - (when (stringp method) - (setq method (gnus-server-to-method method))) - (if (gnus-server-opened method) - ;; The stream is already opened. - t - ;; Open the server. - (unless silent - (gnus-message 5 "Opening %s server%s..." (car method) - (if (equal (nth 1 method) "") "" - (format " on %s" (nth 1 method))))) - (run-hooks 'gnus-open-server-hook) - (prog1 - (gnus-open-server method) - (unless silent - (message "")))))) - -(defun gnus-get-function (method function &optional noerror) - "Return a function symbol based on METHOD and FUNCTION." - ;; Translate server names into methods. - (unless method - (error "Attempted use of a nil select method")) - (when (stringp method) - (setq method (gnus-server-to-method method))) - (let ((func (intern (format "%s-%s" (car method) function)))) - ;; If the functions isn't bound, we require the backend in - ;; question. - (unless (fboundp func) - (require (car method)) - (when (and (not (fboundp func)) - (not noerror)) - ;; This backend doesn't implement this function. - (error "No such function: %s" func))) - func)) - - -;;; -;;; Interface functions to the backends. -;;; - -(defun gnus-open-server (method) - "Open a connection to METHOD." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (let ((elem (assoc method gnus-opened-servers))) - ;; If this method was previously denied, we just return nil. - (if (eq (nth 1 elem) 'denied) - (progn - (gnus-message 1 "Denied server") - nil) - ;; Open the server. - (let ((result - (funcall (gnus-get-function method 'open-server) - (nth 1 method) (nthcdr 2 method)))) - ;; If this hasn't been opened before, we add it to the list. - (unless elem - (setq elem (list method nil) - gnus-opened-servers (cons elem gnus-opened-servers))) - ;; Set the status of this server. - (setcar (cdr elem) (if result 'ok 'denied)) - ;; Return the result from the "open" call. - result)))) - -(defun gnus-close-server (method) - "Close the connection to METHOD." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (funcall (gnus-get-function method 'close-server) (nth 1 method))) - -(defun gnus-request-list (method) - "Request the active file from METHOD." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (funcall (gnus-get-function method 'request-list) (nth 1 method))) - -(defun gnus-request-list-newsgroups (method) - "Request the newsgroups file from METHOD." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method))) - -(defun gnus-request-newgroups (date method) - "Request all new groups since DATE from METHOD." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (let ((func (gnus-get-function method 'request-newgroups t))) - (when func - (funcall func date (nth 1 method))))) - -(defun gnus-server-opened (method) - "Check whether a connection to METHOD has been opened." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (funcall (inline (gnus-get-function method 'server-opened)) (nth 1 method))) - -(defun gnus-status-message (method) - "Return the status message from METHOD. -If METHOD is a string, it is interpreted as a group name. The method -this group uses will be queried." - (let ((method (if (stringp method) (gnus-find-method-for-group method) - method))) - (funcall (gnus-get-function method 'status-message) (nth 1 method)))) - -(defun gnus-request-regenerate (method) - "Request a data generation from METHOD." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (funcall (gnus-get-function method 'request-regenerate) (nth 1 method))) - -(defun gnus-request-group (group &optional dont-check method) - "Request GROUP. If DONT-CHECK, no information is required." - (let ((method (or method (inline (gnus-find-method-for-group group))))) - (when (stringp method) - (setq method (inline (gnus-server-to-method method)))) - (funcall (inline (gnus-get-function method 'request-group)) - (gnus-group-real-name group) (nth 1 method) dont-check))) - -(defun gnus-list-active-group (group) - "Request active information on GROUP." - (let ((method (gnus-find-method-for-group group)) - (func 'list-active-group)) - (when (gnus-check-backend-function func group) - (funcall (gnus-get-function method func) - (gnus-group-real-name group) (nth 1 method))))) - -(defun gnus-request-group-description (group) - "Request a description of GROUP." - (let ((method (gnus-find-method-for-group group)) - (func 'request-group-description)) - (when (gnus-check-backend-function func group) - (funcall (gnus-get-function method func) - (gnus-group-real-name group) (nth 1 method))))) - -(defun gnus-close-group (group) - "Request the GROUP be closed." - (let ((method (inline (gnus-find-method-for-group group)))) - (funcall (gnus-get-function method 'close-group) - (gnus-group-real-name group) (nth 1 method)))) - -(defun gnus-retrieve-headers (articles group &optional fetch-old) - "Request headers for ARTICLES in GROUP. -If FETCH-OLD, retrieve all headers (or some subset thereof) in the group." - (let ((method (gnus-find-method-for-group group))) - (if (and gnus-use-cache (numberp (car articles))) - (gnus-cache-retrieve-headers articles group fetch-old) - (funcall (gnus-get-function method 'retrieve-headers) - articles (gnus-group-real-name group) (nth 1 method) - fetch-old)))) - -(defun gnus-retrieve-groups (groups method) - "Request active information on GROUPS from METHOD." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method))) - -(defun gnus-request-type (group &optional article) - "Return the type (`post' or `mail') of GROUP (and ARTICLE)." - (let ((method (gnus-find-method-for-group group))) - (if (not (gnus-check-backend-function 'request-type (car method))) - 'unknown - (funcall (gnus-get-function method 'request-type) - (gnus-group-real-name group) article)))) - -(defun gnus-request-update-mark (group article mark) - "Return the type (`post' or `mail') of GROUP (and ARTICLE)." - (let ((method (gnus-find-method-for-group group))) - (if (not (gnus-check-backend-function 'request-update-mark (car method))) - mark - (funcall (gnus-get-function method 'request-update-mark) - (gnus-group-real-name group) article mark)))) - -(defun gnus-request-article (article group &optional buffer) - "Request the ARTICLE in GROUP. -ARTICLE can either be an article number or an article Message-ID. -If BUFFER, insert the article in that group." - (let ((method (gnus-find-method-for-group group))) - (funcall (gnus-get-function method 'request-article) - article (gnus-group-real-name group) (nth 1 method) buffer))) - -(defun gnus-request-head (article group) - "Request the head of ARTICLE in GROUP." - (let* ((method (gnus-find-method-for-group group)) - (head (gnus-get-function method 'request-head t)) - res clean-up) - (cond - ;; Check the cache. - ((and gnus-use-cache - (numberp article) - (gnus-cache-request-article article group)) - (setq res (cons group article) - clean-up t)) - ;; Use `head' function. - ((fboundp head) - (setq res (funcall head article (gnus-group-real-name group) - (nth 1 method)))) - ;; Use `article' function. - (t - (setq res (gnus-request-article article group) - clean-up t))) - (when clean-up - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (delete-region (1- (point)) (point-max))) - (nnheader-fold-continuation-lines))) - res)) - -(defun gnus-request-body (article group) - "Request the body of ARTICLE in GROUP." - (let ((method (gnus-find-method-for-group group))) - (funcall (gnus-get-function method 'request-body) - article (gnus-group-real-name group) (nth 1 method)))) - -(defun gnus-request-post (method) - "Post the current buffer using METHOD." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (funcall (gnus-get-function method 'request-post) (nth 1 method))) - -(defun gnus-request-scan (group method) - "Request a SCAN being performed in GROUP from METHOD. -If GROUP is nil, all groups on METHOD are scanned." - (let ((method (if group (gnus-find-method-for-group group) method)) - (gnus-inhibit-demon t)) - (funcall (gnus-get-function method 'request-scan) - (and group (gnus-group-real-name group)) (nth 1 method)))) - -(defsubst gnus-request-update-info (info method) - "Request that METHOD update INFO." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (when (gnus-check-backend-function 'request-update-info (car method)) - (funcall (gnus-get-function method 'request-update-info) - (gnus-group-real-name (gnus-info-group info)) - info (nth 1 method)))) - -(defun gnus-request-expire-articles (articles group &optional force) - (let ((method (gnus-find-method-for-group group))) - (funcall (gnus-get-function method 'request-expire-articles) - articles (gnus-group-real-name group) (nth 1 method) - force))) - -(defun gnus-request-move-article - (article group server accept-function &optional last) - (let ((method (gnus-find-method-for-group group))) - (funcall (gnus-get-function method 'request-move-article) - article (gnus-group-real-name group) - (nth 1 method) accept-function last))) - -(defun gnus-request-accept-article (group method &optional last) - ;; Make sure there's a newline at the end of the article. - (when (stringp method) - (setq method (gnus-server-to-method method))) - (when (and (not method) - (stringp group)) - (setq method (gnus-group-name-to-method group))) - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (let ((func (car (or method (gnus-find-method-for-group group))))) - (funcall (intern (format "%s-request-accept-article" func)) - (if (stringp group) (gnus-group-real-name group) group) - (cadr method) - last))) - -(defun gnus-request-replace-article (article group buffer) - (let ((func (car (gnus-group-name-to-method group)))) - (funcall (intern (format "%s-request-replace-article" func)) - article (gnus-group-real-name group) buffer))) - -(defun gnus-request-associate-buffer (group) - (let ((method (gnus-find-method-for-group group))) - (funcall (gnus-get-function method 'request-associate-buffer) - (gnus-group-real-name group)))) - -(defun gnus-request-restore-buffer (article group) - "Request a new buffer restored to the state of ARTICLE." - (let ((method (gnus-find-method-for-group group))) - (funcall (gnus-get-function method 'request-restore-buffer) - article (gnus-group-real-name group) (nth 1 method)))) - -(defun gnus-request-create-group (group &optional method args) - (when (stringp method) - (setq method (gnus-server-to-method method))) - (let ((method (or method (gnus-find-method-for-group group)))) - (funcall (gnus-get-function method 'request-create-group) - (gnus-group-real-name group) (nth 1 method) args))) - -(defun gnus-request-delete-group (group &optional force) - (let ((method (gnus-find-method-for-group group))) - (funcall (gnus-get-function method 'request-delete-group) - (gnus-group-real-name group) force (nth 1 method)))) - -(defun gnus-request-rename-group (group new-name) - (let ((method (gnus-find-method-for-group group))) - (funcall (gnus-get-function method 'request-rename-group) - (gnus-group-real-name group) - (gnus-group-real-name new-name) (nth 1 method)))) - -(defun gnus-close-backends () - ;; Send a close request to all backends that support such a request. - (let ((methods gnus-valid-select-methods) - (gnus-inhibit-demon t) - func method) - (while (setq method (pop methods)) - (when (fboundp (setq func (intern - (concat (car method) "-request-close")))) - (funcall func))))) - -(defun gnus-asynchronous-p (method) - (let ((func (gnus-get-function method 'asynchronous-p t))) - (when (fboundp func) - (funcall func)))) - -(defun gnus-remove-denial (method) - (when (stringp method) - (setq method (gnus-server-to-method method))) - (let* ((elem (assoc method gnus-opened-servers)) - (status (cadr elem))) - ;; If this hasn't been opened before, we add it to the list. - (when (eq status 'denied) - ;; Set the status of this server. - (setcar (cdr elem) 'closed)))) - -(provide 'gnus-int) - -;;; gnus-int.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-kill.el --- a/lisp/gnus/gnus-kill.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,717 +0,0 @@ -;;; gnus-kill.el --- kill commands for Gnus -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-art) -(require 'gnus-range) - -(defcustom gnus-kill-file-mode-hook nil - "Hook for Gnus kill file mode." - :group 'gnus-score-kill - :type 'hook) - -(defcustom gnus-kill-expiry-days 7 - "*Number of days before expiring unused kill file entries." - :group 'gnus-score-kill - :group 'gnus-score-expire - :type 'integer) - -(defcustom gnus-kill-save-kill-file nil - "*If non-nil, will save kill files after processing them." - :group 'gnus-score-kill - :type 'boolean) - -(defcustom gnus-winconf-kill-file nil - "What does this do, Lars?" - :group 'gnus-score-kill - :type 'sexp) - -(defcustom gnus-kill-killed t - "*If non-nil, Gnus will apply kill files to already killed articles. -If it is nil, Gnus will never apply kill files to articles that have -already been through the scoring process, which might very well save lots -of time." - :group 'gnus-score-kill - :type 'boolean) - - - -(defmacro gnus-raise (field expression level) - `(gnus-kill ,field ,expression - (function (gnus-summary-raise-score ,level)) t)) - -(defmacro gnus-lower (field expression level) - `(gnus-kill ,field ,expression - (function (gnus-summary-raise-score (- ,level))) t)) - -;;; -;;; Gnus Kill File Mode -;;; - -(defvar gnus-kill-file-mode-map nil) - -(unless gnus-kill-file-mode-map - (gnus-define-keymap (setq gnus-kill-file-mode-map - (copy-keymap emacs-lisp-mode-map)) - "\C-c\C-k\C-s" gnus-kill-file-kill-by-subject - "\C-c\C-k\C-a" gnus-kill-file-kill-by-author - "\C-c\C-k\C-t" gnus-kill-file-kill-by-thread - "\C-c\C-k\C-x" gnus-kill-file-kill-by-xref - "\C-c\C-a" gnus-kill-file-apply-buffer - "\C-c\C-e" gnus-kill-file-apply-last-sexp - "\C-c\C-c" gnus-kill-file-exit)) - -(defun gnus-kill-file-mode () - "Major mode for editing kill files. - -If you are using this mode - you probably shouldn't. Kill files -perform badly and paint with a pretty broad brush. Score files, on -the other hand, are vastly faster (40x speedup) and give you more -control over what to do. - -In addition to Emacs-Lisp Mode, the following commands are available: - -\\{gnus-kill-file-mode-map} - - A kill file contains Lisp expressions to be applied to a selected -newsgroup. The purpose is to mark articles as read on the basis of -some set of regexps. A global kill file is applied to every newsgroup, -and a local kill file is applied to a specified newsgroup. Since a -global kill file is applied to every newsgroup, for better performance -use a local one. - - A kill file can contain any kind of Emacs Lisp expressions expected -to be evaluated in the Summary buffer. Writing Lisp programs for this -purpose is not so easy because the internal working of Gnus must be -well-known. For this reason, Gnus provides a general function which -does this easily for non-Lisp programmers. - - The `gnus-kill' function executes commands available in Summary Mode -by their key sequences. `gnus-kill' should be called with FIELD, -REGEXP and optional COMMAND and ALL. FIELD is a string representing -the header field or an empty string. If FIELD is an empty string, the -entire article body is searched for. REGEXP is a string which is -compared with FIELD value. COMMAND is a string representing a valid -key sequence in Summary mode or Lisp expression. COMMAND defaults to -'(gnus-summary-mark-as-read nil \"X\"). Make sure that COMMAND is -executed in the Summary buffer. If the second optional argument ALL -is non-nil, the COMMAND is applied to articles which are already -marked as read or unread. Articles which are marked are skipped over -by default. - - For example, if you want to mark articles of which subjects contain -the string `AI' as read, a possible kill file may look like: - - (gnus-kill \"Subject\" \"AI\") - - If you want to mark articles with `D' instead of `X', you can use -the following expression: - - (gnus-kill \"Subject\" \"AI\" \"d\") - -In this example it is assumed that the command -`gnus-summary-mark-as-read-forward' is assigned to `d' in Summary Mode. - - It is possible to delete unnecessary headers which are marked with -`X' in a kill file as follows: - - (gnus-expunge \"X\") - - If the Summary buffer is empty after applying kill files, Gnus will -exit the selected newsgroup normally. If headers which are marked -with `D' are deleted in a kill file, it is impossible to read articles -which are marked as read in the previous Gnus sessions. Marks other -than `D' should be used for articles which should really be deleted. - -Entry to this mode calls emacs-lisp-mode-hook and -gnus-kill-file-mode-hook with no arguments, if that value is non-nil." - (interactive) - (kill-all-local-variables) - (use-local-map gnus-kill-file-mode-map) - (set-syntax-table emacs-lisp-mode-syntax-table) - (setq major-mode 'gnus-kill-file-mode) - (setq mode-name "Kill") - (lisp-mode-variables nil) - (run-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook)) - -(defun gnus-kill-file-edit-file (newsgroup) - "Begin editing a kill file for NEWSGROUP. -If NEWSGROUP is nil, the global kill file is selected." - (interactive "sNewsgroup: ") - (let ((file (gnus-newsgroup-kill-file newsgroup))) - (gnus-make-directory (file-name-directory file)) - ;; Save current window configuration if this is first invocation. - (or (and (get-file-buffer file) - (get-buffer-window (get-file-buffer file))) - (setq gnus-winconf-kill-file (current-window-configuration))) - ;; Hack windows. - (let ((buffer (find-file-noselect file))) - (cond ((get-buffer-window buffer) - (pop-to-buffer buffer)) - ((eq major-mode 'gnus-group-mode) - (gnus-configure-windows 'group) ;Take all windows. - (pop-to-buffer buffer)) - ((eq major-mode 'gnus-summary-mode) - (gnus-configure-windows 'article) - (pop-to-buffer gnus-article-buffer) - (bury-buffer gnus-article-buffer) - (switch-to-buffer buffer)) - (t ;No good rules. - (find-file-other-window file)))) - (gnus-kill-file-mode))) - -;; Fix by Sudish Joseph . -(defun gnus-kill-set-kill-buffer () - (let* ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)) - (buffer (find-file-noselect file))) - (set-buffer buffer) - (gnus-kill-file-mode) - (bury-buffer buffer))) - -(defun gnus-kill-file-enter-kill (field regexp &optional dont-move) - ;; Enter kill file entry. - ;; FIELD: String containing the name of the header field to kill. - ;; REGEXP: The string to kill. - (save-excursion - (let (string) - (unless (eq major-mode 'gnus-kill-file-mode) - (gnus-kill-set-kill-buffer)) - (unless dont-move - (goto-char (point-max))) - (insert (setq string (format "(gnus-kill %S %S)\n" field regexp))) - (gnus-kill-file-apply-string string)))) - -(defun gnus-kill-file-kill-by-subject () - "Kill by subject." - (interactive) - (gnus-kill-file-enter-kill - "Subject" - (if (vectorp gnus-current-headers) - (regexp-quote - (gnus-simplify-subject (mail-header-subject gnus-current-headers))) - "") - t)) - -(defun gnus-kill-file-kill-by-author () - "Kill by author." - (interactive) - (gnus-kill-file-enter-kill - "From" - (if (vectorp gnus-current-headers) - (regexp-quote (mail-header-from gnus-current-headers)) - "") t)) - -(defun gnus-kill-file-kill-by-thread () - "Kill by author." - (interactive) - (gnus-kill-file-enter-kill - "References" - (if (vectorp gnus-current-headers) - (regexp-quote (mail-header-id gnus-current-headers)) - ""))) - -(defun gnus-kill-file-kill-by-xref () - "Kill by Xref." - (interactive) - (let ((xref (and (vectorp gnus-current-headers) - (mail-header-xref gnus-current-headers))) - (start 0) - group) - (if xref - (while (string-match " \\([^ \t]+\\):" xref start) - (setq start (match-end 0)) - (when (not (string= - (setq group - (substring xref (match-beginning 1) (match-end 1))) - gnus-newsgroup-name)) - (gnus-kill-file-enter-kill - "Xref" (concat " " (regexp-quote group) ":") t))) - (gnus-kill-file-enter-kill "Xref" "" t)))) - -(defun gnus-kill-file-raise-followups-to-author (level) - "Raise score for all followups to the current author." - (interactive "p") - (let ((name (mail-header-from gnus-current-headers)) - string) - (save-excursion - (gnus-kill-set-kill-buffer) - (goto-char (point-min)) - (setq name (read-string (concat "Add " level - " to followup articles to: ") - (regexp-quote name))) - (setq - string - (format - "(gnus-kill %S %S '(gnus-summary-temporarily-raise-by-thread %S))\n" - "From" name level)) - (insert string) - (gnus-kill-file-apply-string string)) - (gnus-message - 6 "Added temporary score file entry for followups to %s." name))) - -(defun gnus-kill-file-apply-buffer () - "Apply current buffer to current newsgroup." - (interactive) - (if (and gnus-current-kill-article - (get-buffer gnus-summary-buffer)) - ;; Assume newsgroup is selected. - (gnus-kill-file-apply-string (buffer-string)) - (ding) (gnus-message 2 "No newsgroup is selected."))) - -(defun gnus-kill-file-apply-string (string) - "Apply STRING to current newsgroup." - (interactive) - (let ((string (concat "(progn \n" string "\n)"))) - (save-excursion - (save-window-excursion - (pop-to-buffer gnus-summary-buffer) - (eval (car (read-from-string string))))))) - -(defun gnus-kill-file-apply-last-sexp () - "Apply sexp before point in current buffer to current newsgroup." - (interactive) - (if (and gnus-current-kill-article - (get-buffer gnus-summary-buffer)) - ;; Assume newsgroup is selected. - (let ((string - (buffer-substring - (save-excursion (forward-sexp -1) (point)) (point)))) - (save-excursion - (save-window-excursion - (pop-to-buffer gnus-summary-buffer) - (eval (car (read-from-string string)))))) - (ding) (gnus-message 2 "No newsgroup is selected."))) - -(defun gnus-kill-file-exit () - "Save a kill file, then return to the previous buffer." - (interactive) - (save-buffer) - (let ((killbuf (current-buffer))) - ;; We don't want to return to article buffer. - (when (get-buffer gnus-article-buffer) - (bury-buffer gnus-article-buffer)) - ;; Delete the KILL file windows. - (delete-windows-on killbuf) - ;; Restore last window configuration if available. - (when gnus-winconf-kill-file - (set-window-configuration gnus-winconf-kill-file)) - (setq gnus-winconf-kill-file nil) - ;; Kill the KILL file buffer. Suggested by tale@pawl.rpi.edu. - (kill-buffer killbuf))) - -;; For kill files - -(defun gnus-Newsgroup-kill-file (newsgroup) - "Return the name of a kill file for NEWSGROUP. -If NEWSGROUP is nil, return the global kill file instead." - (cond ((or (null newsgroup) - (string-equal newsgroup "")) - ;; The global kill file is placed at top of the directory. - (expand-file-name gnus-kill-file-name gnus-kill-files-directory)) - (gnus-use-long-file-name - ;; Append ".KILL" to capitalized newsgroup name. - (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup) - "." gnus-kill-file-name) - gnus-kill-files-directory)) - (t - ;; Place "KILL" under the hierarchical directory. - (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) - "/" gnus-kill-file-name) - gnus-kill-files-directory)))) - -(defun gnus-expunge (marks) - "Remove lines marked with MARKS." - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-summary-limit-to-marks marks 'reverse))) - -(defun gnus-apply-kill-file-unless-scored () - "Apply .KILL file, unless a .SCORE file for the same newsgroup exists." - (cond ((file-exists-p (gnus-score-file-name gnus-newsgroup-name)) - ;; Ignores global KILL. - (when (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)) - (gnus-message 3 "Note: Ignoring %s.KILL; preferring .SCORE" - gnus-newsgroup-name)) - 0) - ((or (file-exists-p (gnus-newsgroup-kill-file nil)) - (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))) - (gnus-apply-kill-file-internal)) - (t - 0))) - -(defun gnus-apply-kill-file-internal () - "Apply a kill file to the current newsgroup. -Returns the number of articles marked as read." - (let* ((kill-files (list (gnus-newsgroup-kill-file nil) - (gnus-newsgroup-kill-file gnus-newsgroup-name))) - (unreads (length gnus-newsgroup-unreads)) - (gnus-summary-inhibit-highlight t) - beg) - (setq gnus-newsgroup-kill-headers nil) - ;; If there are any previously scored articles, we remove these - ;; from the `gnus-newsgroup-headers' list that the score functions - ;; will see. This is probably pretty wasteful when it comes to - ;; conses, but is, I think, faster than having to assq in every - ;; single score function. - (let ((files kill-files)) - (while files - (if (file-exists-p (car files)) - (let ((headers gnus-newsgroup-headers)) - (if gnus-kill-killed - (setq gnus-newsgroup-kill-headers - (mapcar (lambda (header) (mail-header-number header)) - headers)) - (while headers - (unless (gnus-member-of-range - (mail-header-number (car headers)) - gnus-newsgroup-killed) - (push (mail-header-number (car headers)) - gnus-newsgroup-kill-headers)) - (setq headers (cdr headers)))) - (setq files nil)) - (setq files (cdr files))))) - (if (not gnus-newsgroup-kill-headers) - () - (save-window-excursion - (save-excursion - (while kill-files - (if (not (file-exists-p (car kill-files))) - () - (gnus-message 6 "Processing kill file %s..." (car kill-files)) - (find-file (car kill-files)) - (gnus-add-current-to-buffer-list) - (goto-char (point-min)) - - (if (consp (ignore-errors (read (current-buffer)))) - (gnus-kill-parse-gnus-kill-file) - (gnus-kill-parse-rn-kill-file)) - - (gnus-message - 6 "Processing kill file %s...done" (car kill-files))) - (setq kill-files (cdr kill-files))))) - - (gnus-set-mode-line 'summary) - - (if beg - (let ((nunreads (- unreads (length gnus-newsgroup-unreads)))) - (or (eq nunreads 0) - (gnus-message 6 "Marked %d articles as read" nunreads)) - nunreads) - 0)))) - -;; Parse a Gnus killfile. -(defun gnus-score-insert-help (string alist idx) - (save-excursion - (pop-to-buffer "*Score Help*") - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert string ":\n\n") - (while alist - (insert (format " %c: %s\n" (caar alist) (nth idx (car alist)))) - (setq alist (cdr alist))))) - -(defun gnus-kill-parse-gnus-kill-file () - (goto-char (point-min)) - (gnus-kill-file-mode) - (let (beg form) - (while (progn - (setq beg (point)) - (setq form (ignore-errors (read (current-buffer))))) - (unless (listp form) - (error "Illegal kill entry (possibly rn kill file?): %s" form)) - (if (or (eq (car form) 'gnus-kill) - (eq (car form) 'gnus-raise) - (eq (car form) 'gnus-lower)) - (progn - (delete-region beg (point)) - (insert (or (eval form) ""))) - (save-excursion - (set-buffer gnus-summary-buffer) - (ignore-errors (eval form))))) - (and (buffer-modified-p) - gnus-kill-save-kill-file - (save-buffer)) - (set-buffer-modified-p nil))) - -;; Parse an rn killfile. -(defun gnus-kill-parse-rn-kill-file () - (goto-char (point-min)) - (gnus-kill-file-mode) - (let ((mod-to-header - '((?a . "") - (?h . "") - (?f . "from") - (?: . "subject"))) - (com-to-com - '((?m . " ") - (?j . "X"))) - pattern modifier commands) - (while (not (eobp)) - (if (not (looking-at "[ \t]*/\\([^/]*\\)/\\([ahfcH]\\)?:\\([a-z=:]*\\)")) - () - (setq pattern (buffer-substring (match-beginning 1) (match-end 1))) - (setq modifier (if (match-beginning 2) (char-after (match-beginning 2)) - ?s)) - (setq commands (buffer-substring (match-beginning 3) (match-end 3))) - - ;; The "f:+" command marks everything *but* the matches as read, - ;; so we simply first match everything as read, and then unmark - ;; PATTERN later. - (when (string-match "\\+" commands) - (gnus-kill "from" ".") - (setq commands "m")) - - (gnus-kill - (or (cdr (assq modifier mod-to-header)) "subject") - pattern - (if (string-match "m" commands) - '(gnus-summary-mark-as-unread nil " ") - '(gnus-summary-mark-as-read nil "X")) - nil t)) - (forward-line 1)))) - -;; Kill changes and new format by suggested by JWZ and Sudish Joseph -;; . -(defun gnus-kill (field regexp &optional exe-command all silent) - "If FIELD of an article matches REGEXP, execute COMMAND. -Optional 1st argument COMMAND is default to - (gnus-summary-mark-as-read nil \"X\"). -If optional 2nd argument ALL is non-nil, articles marked are also applied to. -If FIELD is an empty string (or nil), entire article body is searched for. -COMMAND must be a lisp expression or a string representing a key sequence." - ;; We don't want to change current point nor window configuration. - (let ((old-buffer (current-buffer))) - (save-excursion - (save-window-excursion - ;; Selected window must be summary buffer to execute keyboard - ;; macros correctly. See command_loop_1. - (switch-to-buffer gnus-summary-buffer 'norecord) - (goto-char (point-min)) ;From the beginning. - (let ((kill-list regexp) - (date (current-time-string)) - (command (or exe-command '(gnus-summary-mark-as-read - nil gnus-kill-file-mark))) - kill kdate prev) - (if (listp kill-list) - ;; It is a list. - (if (not (consp (cdr kill-list))) - ;; It's on the form (regexp . date). - (if (zerop (gnus-execute field (car kill-list) - command nil (not all))) - (when (> (gnus-days-between date (cdr kill-list)) - gnus-kill-expiry-days) - (setq regexp nil)) - (setcdr kill-list date)) - (while (setq kill (car kill-list)) - (if (consp kill) - ;; It's a temporary kill. - (progn - (setq kdate (cdr kill)) - (if (zerop (gnus-execute - field (car kill) command nil (not all))) - (when (> (gnus-days-between date kdate) - gnus-kill-expiry-days) - ;; Time limit has been exceeded, so we - ;; remove the match. - (if prev - (setcdr prev (cdr kill-list)) - (setq regexp (cdr regexp)))) - ;; Successful kill. Set the date to today. - (setcdr kill date))) - ;; It's a permanent kill. - (gnus-execute field kill command nil (not all))) - (setq prev kill-list) - (setq kill-list (cdr kill-list)))) - (gnus-execute field kill-list command nil (not all)))))) - (switch-to-buffer old-buffer) - (when (and (eq major-mode 'gnus-kill-file-mode) regexp (not silent)) - (gnus-pp-gnus-kill - (nconc (list 'gnus-kill field - (if (consp regexp) (list 'quote regexp) regexp)) - (when (or exe-command all) - (list (list 'quote exe-command))) - (if all (list t) nil)))))) - -(defun gnus-pp-gnus-kill (object) - (if (or (not (consp (nth 2 object))) - (not (consp (cdr (nth 2 object)))) - (and (eq 'quote (car (nth 2 object))) - (not (consp (cdadr (nth 2 object)))))) - (concat "\n" (gnus-prin1-to-string object)) - (save-excursion - (set-buffer (get-buffer-create "*Gnus PP*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert (format "\n(%S %S\n '(" (nth 0 object) (nth 1 object))) - (let ((klist (cadr (nth 2 object))) - (first t)) - (while klist - (insert (if first (progn (setq first nil) "") "\n ") - (gnus-prin1-to-string (car klist))) - (setq klist (cdr klist)))) - (insert ")") - (and (nth 3 object) - (insert "\n " - (if (and (consp (nth 3 object)) - (not (eq 'quote (car (nth 3 object))))) - "'" "") - (gnus-prin1-to-string (nth 3 object)))) - (when (nth 4 object) - (insert "\n t")) - (insert ")") - (prog1 - (buffer-substring (point-min) (point-max)) - (kill-buffer (current-buffer)))))) - -(defun gnus-execute-1 (function regexp form header) - (save-excursion - (let (did-kill) - (if (null header) - nil ;Nothing to do. - (if function - ;; Compare with header field. - (let (value) - (and header - (progn - (setq value (funcall function header)) - ;; Number (Lines:) or symbol must be converted to string. - (unless (stringp value) - (setq value (gnus-prin1-to-string value))) - (setq did-kill (string-match regexp value))) - (cond ((stringp form) ;Keyboard macro. - (execute-kbd-macro form)) - ((gnus-functionp form) - (funcall form)) - (t - (eval form))))) - ;; Search article body. - (let ((gnus-current-article nil) ;Save article pointer. - (gnus-last-article nil) - (gnus-break-pages nil) ;No need to break pages. - (gnus-mark-article-hook nil)) ;Inhibit marking as read. - (gnus-message - 6 "Searching for article: %d..." (mail-header-number header)) - (gnus-article-setup-buffer) - (gnus-article-prepare (mail-header-number header) t) - (when (save-excursion - (set-buffer gnus-article-buffer) - (goto-char (point-min)) - (setq did-kill (re-search-forward regexp nil t))) - (cond ((stringp form) ;Keyboard macro. - (execute-kbd-macro form)) - ((gnus-functionp form) - (funcall form)) - (t - (eval form))))))) - did-kill))) - -(defun gnus-execute (field regexp form &optional backward unread) - "If FIELD of article header matches REGEXP, execute lisp FORM (or a string). -If FIELD is an empty string (or nil), entire article body is searched for. -If optional 1st argument BACKWARD is non-nil, do backward instead. -If optional 2nd argument UNREAD is non-nil, articles which are -marked as read or ticked are ignored." - (save-excursion - (let ((killed-no 0) - function article header) - (cond - ;; Search body. - ((or (null field) - (string-equal field "")) - (setq function nil)) - ;; Get access function of header field. - ((fboundp - (setq function - (intern-soft - (concat "mail-header-" (downcase field))))) - (setq function `(lambda (h) (,function h)))) - ;; Signal error. - (t - (error "Unknown header field: \"%s\"" field))) - ;; Starting from the current article. - (while (or - ;; First article. - (and (not article) - (setq article (gnus-summary-article-number))) - ;; Find later articles. - (setq article - (gnus-summary-search-forward unread nil backward))) - (and (or (null gnus-newsgroup-kill-headers) - (memq article gnus-newsgroup-kill-headers)) - (vectorp (setq header (gnus-summary-article-header article))) - (gnus-execute-1 function regexp form header) - (setq killed-no (1+ killed-no)))) - ;; Return the number of killed articles. - killed-no))) - -;;;###autoload -(defalias 'gnus-batch-kill 'gnus-batch-score) -;;;###autoload -(defun gnus-batch-score () - "Run batched scoring. -Usage: emacs -batch -l gnus -f gnus-batch-score ... -Newsgroups is a list of strings in Bnews format. If you want to score -the comp hierarchy, you'd say \"comp.all\". If you would not like to -score the alt hierarchy, you'd say \"!alt.all\"." - (interactive) - (let* ((gnus-newsrc-options-n - (gnus-newsrc-parse-options - (concat "options -n " - (mapconcat 'identity command-line-args-left " ")))) - (gnus-expert-user t) - (nnmail-spool-file nil) - (gnus-use-dribble-file nil) - (gnus-batch-mode t) - group newsrc entry - ;; Disable verbose message. - gnus-novice-user gnus-large-newsgroup - gnus-options-subscribe gnus-auto-subscribed-groups - gnus-options-not-subscribe) - ;; Eat all arguments. - (setq command-line-args-left nil) - (gnus-slave) - ;; Apply kills to specified newsgroups in command line arguments. - (setq newsrc (cdr gnus-newsrc-alist)) - (while (setq group (car (pop newsrc))) - (setq entry (gnus-gethash group gnus-newsrc-hashtb)) - (when (and (<= (gnus-info-level (car newsrc)) gnus-level-subscribed) - (and (car entry) - (or (eq (car entry) t) - (not (zerop (car entry))))) - ;;(eq (gnus-matches-options-n group) 'subscribe) - ) - (gnus-summary-read-group group nil t nil t) - (when (eq (current-buffer) (get-buffer gnus-summary-buffer)) - (gnus-summary-exit)))) - ;; Exit Emacs. - (switch-to-buffer gnus-group-buffer) - (gnus-group-save-newsrc))) - -(provide 'gnus-kill) - -;;; gnus-kill.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-load.el --- a/lisp/gnus/gnus-load.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,103 +0,0 @@ -;;; gnus-load.el --- automatically extracted custom dependencies -;; -;;; Code: - -(put 'nnmail 'custom-loads '("nnmail")) -(put 'gnus-article-emphasis 'custom-loads '("gnus-art")) -(put 'gnus-article-headers 'custom-loads '("gnus-sum" "gnus-art")) -(put 'nnmail-procmail 'custom-loads '("nnmail")) -(put 'gnus-score-kill 'custom-loads '("gnus-kill")) -(put 'gnus-visual 'custom-loads '("smiley" "gnus" "gnus-picon" "gnus-art" "earcon")) -(put 'gnus-score-expire 'custom-loads '("gnus-score" "gnus-kill")) -(put 'gnus-summary-maneuvering 'custom-loads '("gnus-sum")) -(put 'gnus-start 'custom-loads '("gnus" "gnus-util" "gnus-start" "gnus-int" "gnus-group")) -(put 'gnus-extract-view 'custom-loads '("gnus-uu" "gnus-sum")) -(put 'gnus-various 'custom-loads '("gnus-sum")) -(put 'gnus-article-washing 'custom-loads '("gnus-art")) -(put 'gnus-score-files 'custom-loads '("gnus-score")) -(put 'message-news 'custom-loads '("message")) -(put 'gnus-thread 'custom-loads '("gnus-sum")) -(put 'languages 'custom-loads '("cus-edit")) -(put 'development 'custom-loads '("cus-edit")) -(put 'gnus-treading 'custom-loads '("gnus-sum")) -(put 'nnmail-various 'custom-loads '("nnmail")) -(put 'extensions 'custom-loads '("wid-edit")) -(put 'message-various 'custom-loads '("message")) -(put 'gnus-summary-exit 'custom-loads '("gnus-sum")) -(put 'news 'custom-loads '("message" "gnus")) -(put 'gnus 'custom-loads '("nnmail" "gnus" "gnus-win" "gnus-uu" "gnus-eform" "gnus-dup" "gnus-demon" "gnus-cache" "gnus-async" "gnus-art")) -(put 'gnus-summary-visual 'custom-loads '("gnus-sum")) -(put 'gnus-group-listing 'custom-loads '("gnus-group")) -(put 'gnus-score 'custom-loads '("gnus" "gnus-nocem")) -(put 'gnus-group-select 'custom-loads '("gnus-sum")) -(put 'message-buffers 'custom-loads '("message")) -(put 'gnus-threading 'custom-loads '("gnus-sum")) -(put 'gnus-score-decay 'custom-loads '("gnus-score")) -(put 'help 'custom-loads '("cus-edit")) -(put 'gnus-nocem 'custom-loads '("gnus-nocem")) -(put 'gnus-cite 'custom-loads '("gnus-cite")) -(put 'gnus-demon 'custom-loads '("gnus-demon")) -(put 'gnus-message 'custom-loads '("message")) -(put 'gnus-score-default 'custom-loads '("gnus-sum" "gnus-score")) -(put 'nnmail-duplicate 'custom-loads '("nnmail")) -(put 'message-interface 'custom-loads '("message")) -(put 'nnmail-files 'custom-loads '("nnmail")) -(put 'gnus-edit-form 'custom-loads '("gnus-eform")) -(put 'emacs 'custom-loads '("cus-edit")) -(put 'gnus-summary-mail 'custom-loads '("gnus-sum")) -(put 'gnus-topic 'custom-loads '("gnus-topic")) -(put 'wp 'custom-loads '("cus-edit")) -(put 'gnus-summary-choose 'custom-loads '("gnus-sum")) -(put 'widget-browse 'custom-loads '("wid-browse")) -(put 'external 'custom-loads '("cus-edit")) -(put 'message-headers 'custom-loads '("message")) -(put 'message-forwarding 'custom-loads '("message")) -(put 'message-faces 'custom-loads '("message")) -(put 'environment 'custom-loads '("cus-edit")) -(put 'gnus-article-mime 'custom-loads '("gnus-sum" "gnus-art")) -(put 'gnus-duplicate 'custom-loads '("gnus-dup")) -(put 'nnmail-retrieve 'custom-loads '("nnmail")) -(put 'widgets 'custom-loads '("wid-edit" "wid-browse")) -(put 'earcon 'custom-loads '("earcon")) -(put 'hypermedia 'custom-loads '("wid-edit")) -(put 'gnus-group-levels 'custom-loads '("gnus-group")) -(put 'gnus-summary-format 'custom-loads '("gnus-sum")) -(put 'gnus-files 'custom-loads '("nnmail" "gnus")) -(put 'gnus-windows 'custom-loads '("gnus-win")) -(put 'gnus-article-buttons 'custom-loads '("gnus-art")) -(put 'gnus-summary 'custom-loads '("gnus" "gnus-sum")) -(put 'gnus-article-hiding 'custom-loads '("gnus-sum" "gnus-art")) -(put 'gnus-group 'custom-loads '("gnus" "gnus-topic")) -(put 'gnus-article-various 'custom-loads '("gnus-sum" "gnus-art")) -(put 'gnus-summary-marks 'custom-loads '("gnus-sum")) -(put 'gnus-article-saving 'custom-loads '("gnus-art")) -(put 'nnmail-expire 'custom-loads '("nnmail")) -(put 'message-mail 'custom-loads '("message")) -(put 'faces 'custom-loads '("wid-edit" "cus-edit" "message" "gnus")) -(put 'gnus-summary-various 'custom-loads '("gnus-sum")) -(put 'applications 'custom-loads '("cus-edit")) -(put 'gnus-extract-archive 'custom-loads '("gnus-uu")) -(put 'message 'custom-loads '("message")) -(put 'message-sending 'custom-loads '("message")) -(put 'editing 'custom-loads '("cus-edit")) -(put 'gnus-score-adapt 'custom-loads '("gnus-score")) -(put 'message-insertion 'custom-loads '("message")) -(put 'gnus-extract-post 'custom-loads '("gnus-uu")) -(put 'mail 'custom-loads '("message" "gnus")) -(put 'gnus-summary-sort 'custom-loads '("gnus-sum")) -(put 'customize 'custom-loads '("wid-edit" "custom" "cus-face" "cus-edit")) -(put 'nnmail-split 'custom-loads '("nnmail")) -(put 'gnus-asynchronous 'custom-loads '("gnus-async")) -(put 'gnus-article-highlight 'custom-loads '("gnus-art")) -(put 'gnus-extract 'custom-loads '("gnus-uu")) -(put 'gnus-article 'custom-loads '("gnus-cite" "gnus-art")) -(put 'gnus-group-foreign 'custom-loads '("gnus-group")) -(put 'programming 'custom-loads '("cus-edit")) -(put 'nnmail-prepare 'custom-loads '("nnmail")) -(put 'picons 'custom-loads '("gnus-picon")) -(put 'gnus-article-signature 'custom-loads '("gnus-art")) -(put 'gnus-group-various 'custom-loads '("gnus-group")) - -(provide 'gnus-load) - -;;; gnus-load.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-logic.el --- a/lisp/gnus/gnus-logic.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,227 +0,0 @@ -;;; gnus-logic.el --- advanced scoring code for Gnus -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-score) -(require 'gnus-util) - -;;; Internal variables. - -(defvar gnus-advanced-headers nil) - -;; To avoid having 8-bit characters in the source file. -(defvar gnus-advanced-not (intern (format "%c" 172))) - -(defconst gnus-advanced-index - ;; Name to index alist. - '(("number" 0 gnus-advanced-integer) - ("subject" 1 gnus-advanced-string) - ("from" 2 gnus-advanced-string) - ("date" 3 gnus-advanced-date) - ("message-id" 4 gnus-advanced-string) - ("references" 5 gnus-advanced-string) - ("chars" 6 gnus-advanced-integer) - ("lines" 7 gnus-advanced-integer) - ("xref" 8 gnus-advanced-string) - ("head" nil gnus-advanced-body) - ("body" nil gnus-advanced-body) - ("all" nil gnus-advanced-body))) - -(eval-and-compile - (autoload 'parse-time-string "parse-time")) - -(defun gnus-score-advanced (rule &optional trace) - "Apply advanced scoring RULE to all the articles in the current group." - (let ((headers gnus-newsgroup-headers) - gnus-advanced-headers score) - (while (setq gnus-advanced-headers (pop headers)) - (when (gnus-advanced-score-rule (car rule)) - ;; This rule was successful, so we add the score to - ;; this article. - (if (setq score (assq (mail-header-number gnus-advanced-headers) - gnus-newsgroup-scored)) - (setcdr score - (+ (cdr score) - (or (nth 1 rule) - gnus-score-interactive-default-score))) - (push (cons (mail-header-number gnus-advanced-headers) - (or (nth 1 rule) - gnus-score-interactive-default-score)) - gnus-newsgroup-scored) - (when trace - (push (cons "A file" rule) - gnus-score-trace))))))) - -(defun gnus-advanced-score-rule (rule) - "Apply RULE to `gnus-advanced-headers'." - (let ((type (car rule))) - (cond - ;; "And" rule. - ((or (eq type '&) (eq type 'and)) - (pop rule) - (if (not rule) - t ; Empty rule is true. - (while (and rule - (gnus-advanced-score-rule (car rule))) - (pop rule)) - ;; If all the rules were true, then `rule' should be nil. - (not rule))) - ;; "Or" rule. - ((or (eq type '|) (eq type 'or)) - (pop rule) - (if (not rule) - nil - (while (and rule - (not (gnus-advanced-score-rule (car rule)))) - (pop rule)) - ;; If one of the rules returned true, then `rule' should be non-nil. - rule)) - ;; "Not" rule. - ((or (eq type '!) (eq type 'not) (eq type gnus-advanced-not)) - (not (gnus-advanced-score-rule (nth 1 rule)))) - ;; This is a `1-'-type redirection rule. - ((and (symbolp type) - (string-match "^[0-9]+-$\\|^\\^+$" (symbol-name type))) - (let ((gnus-advanced-headers - (gnus-parent-headers - gnus-advanced-headers - (if (string-match "^\\([0-9]+\\)-$" (symbol-name type)) - ;; 1- type redirection. - (string-to-number - (substring (symbol-name type) - (match-beginning 0) (match-end 0))) - ;; ^^^ type redirection. - (length (symbol-name type)))))) - (when gnus-advanced-headers - (gnus-advanced-score-rule (nth 1 rule))))) - ;; Plain scoring rule. - ((stringp type) - (gnus-advanced-score-article rule)) - ;; Bug-out time! - (t - (error "Unknown advanced score type: %s" rule))))) - -(defun gnus-advanced-score-article (rule) - ;; `rule' is a semi-normal score rule, so we find out - ;; what function that's supposed to do the actual - ;; processing. - (let* ((header (car rule)) - (func (assoc (downcase header) gnus-advanced-index))) - (if (not func) - (error "No such header: %s" rule) - ;; Call the score function. - (funcall (caddr func) (or (cadr func) header) - (cadr rule) (caddr rule))))) - -(defun gnus-advanced-string (index match type) - "See whether string MATCH of TYPE matches `gnus-advanced-headers' in INDEX." - (let* ((type (or type 's)) - (case-fold-search (not (eq (downcase (symbol-name type)) - (symbol-name type)))) - (header (aref gnus-advanced-headers index))) - (cond - ((memq type '(r R regexp Regexp)) - (string-match match header)) - ((memq type '(s S string String)) - (string-match (regexp-quote match) header)) - ((memq type '(e E exact Exact)) - (string= match header)) - ((memq type '(f F fuzzy Fuzzy)) - (string-match (regexp-quote (gnus-simplify-subject-fuzzy match)) - header)) - (t - (error "No such string match type: %s" type))))) - -(defun gnus-advanced-integer (index match type) - (if (not (memq type '(< > <= >= =))) - (error "No such integer score type: %s" type) - (funcall type match (or (aref gnus-advanced-headers index) 0)))) - -(defun gnus-advanced-date (index match type) - (let ((date (encode-time (parse-time-string - (aref gnus-advanced-headers index)))) - (match (encode-time (parse-time-string match)))) - (cond - ((eq type 'at) - (equal date match)) - ((eq type 'before) - (gnus-time-less match date)) - ((eq type 'after) - (gnus-time-less date match)) - (t - (error "No such date score type: %s" type))))) - -(defun gnus-advanced-body (header match type) - (when (string= header "all") - (setq header "article")) - (save-excursion - (set-buffer nntp-server-buffer) - (let* ((request-func (cond ((string= "head" header) - 'gnus-request-head) - ((string= "body" header) - 'gnus-request-body) - (t 'gnus-request-article))) - ofunc article) - ;; Not all backends support partial fetching. In that case, - ;; we just fetch the entire article. - (unless (gnus-check-backend-function - (intern (concat "request-" header)) - gnus-newsgroup-name) - (setq ofunc request-func) - (setq request-func 'gnus-request-article)) - (setq article (mail-header-number gnus-advanced-headers)) - (gnus-message 7 "Scoring article %s..." article) - (when (funcall request-func article gnus-newsgroup-name) - (goto-char (point-min)) - ;; If just parts of the article is to be searched and the - ;; backend didn't support partial fetching, we just narrow - ;; to the relevant parts. - (when ofunc - (if (eq ofunc 'gnus-request-head) - (narrow-to-region - (point) - (or (search-forward "\n\n" nil t) (point-max))) - (narrow-to-region - (or (search-forward "\n\n" nil t) (point)) - (point-max)))) - (let* ((case-fold-search (not (eq (downcase (symbol-name type)) - (symbol-name type)))) - (search-func - (cond ((memq type '(r R regexp Regexp)) - 're-search-forward) - ((memq type '(s S string String)) - 'search-forward) - (t - (error "Illegal match type: %s" type))))) - (goto-char (point-min)) - (prog1 - (funcall search-func match nil t) - (widen))))))) - -(provide 'gnus-logic) - -;;; gnus-logic.el ends here. diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-mh.el --- a/lisp/gnus/gnus-mh.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,105 +0,0 @@ -;;; gnus-mh.el --- mh-e interface for Gnus -;; Copyright (C) 1994,95,96,97 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Send mail using mh-e. - -;; The following mh-e interface is all cooperative works of -;; tanaka@flab.fujitsu.CO.JP (TANAKA Hiroshi), kawabe@sra.CO.JP -;; (Yoshikatsu Kawabe), and shingu@casund.cpr.canon.co.jp (Toshiaki -;; SHINGU). - -;;; Code: - -(require 'gnus) -(require 'mh-e) -(require 'mh-comp) -(require 'gnus-msg) -(require 'gnus-sum) - -(defun gnus-summary-save-article-folder (&optional arg) - "Append the current article to an mh folder. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead." - (interactive "P") - (let ((gnus-default-article-saver 'gnus-summary-save-in-folder)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-save-in-folder (&optional folder) - "Save this article to MH folder (using `rcvstore' in MH library). -Optional argument FOLDER specifies folder name." - ;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet. - (mh-find-path) - (let ((folder - (cond ((and (eq folder 'default) - gnus-newsgroup-last-folder) - gnus-newsgroup-last-folder) - (folder folder) - (t (mh-prompt-for-folder - "Save article in" - (funcall gnus-folder-save-name gnus-newsgroup-name - gnus-current-headers gnus-newsgroup-last-folder) - t)))) - (errbuf (get-buffer-create " *Gnus rcvstore*")) - ;; Find the rcvstore program. - (exec-path (if mh-lib (cons mh-lib exec-path) exec-path))) - (gnus-eval-in-buffer-window gnus-original-article-buffer - (save-restriction - (widen) - (unwind-protect - (call-process-region - (point-min) (point-max) "rcvstore" nil errbuf nil folder) - (set-buffer errbuf) - (if (zerop (buffer-size)) - (message "Article saved in folder: %s" folder) - (message "%s" (buffer-string))) - (kill-buffer errbuf)))) - (setq gnus-newsgroup-last-folder folder))) - -(defun gnus-Folder-save-name (newsgroup headers &optional last-folder) - "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER. -If variable `gnus-use-long-file-name' is nil, it is +News.group. -Otherwise, it is like +news/group." - (or last-folder - (concat "+" - (if gnus-use-long-file-name - (gnus-capitalize-newsgroup newsgroup) - (gnus-newsgroup-directory-form newsgroup))))) - -(defun gnus-folder-save-name (newsgroup headers &optional last-folder) - "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER. -If variable `gnus-use-long-file-name' is nil, it is +news.group. -Otherwise, it is like +news/group." - (or last-folder - (concat "+" - (if gnus-use-long-file-name - newsgroup - (gnus-newsgroup-directory-form newsgroup))))) - -(provide 'gnus-mh) - -;;; gnus-mh.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-move.el --- a/lisp/gnus/gnus-move.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,176 +0,0 @@ -;;; gnus-move.el --- commands for moving Gnus from one server to another -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-start) -(require 'gnus-int) -(require 'gnus-range) - -;;; -;;; Moving by comparing Message-ID's. -;;; - -;;;###autoload -(defun gnus-change-server (from-server to-server) - "Move from FROM-SERVER to TO-SERVER. -Update the .newsrc.eld file to reflect the change of nntp server." - (interactive - (list gnus-select-method (gnus-read-method "Move to method: "))) - - ;; First start Gnus. - (let ((gnus-activate-level 0) - (nnmail-spool-file nil)) - (gnus)) - - (save-excursion - ;; Go through all groups and translate. - (let ((newsrc gnus-newsrc-alist) - (nntp-nov-gap nil) - info) - (while (setq info (pop newsrc)) - (when (gnus-group-native-p (gnus-info-group info)) - (gnus-move-group-to-server info from-server to-server)))))) - -(defun gnus-move-group-to-server (info from-server to-server) - "Move group INFO from FROM-SERVER to TO-SERVER." - (let ((group (gnus-info-group info)) - to-active hashtb type mark marks - to-article to-reads to-marks article - act-articles) - (gnus-message 7 "Translating %s..." group) - (when (gnus-request-group group nil to-server) - (setq to-active (gnus-parse-active) - hashtb (gnus-make-hashtable 1024) - act-articles (gnus-uncompress-range to-active)) - ;; Fetch the headers from the `to-server'. - (when (and to-active - act-articles - (setq type (gnus-retrieve-headers - act-articles - group to-server))) - ;; Convert HEAD headers. I don't care. - (when (eq type 'headers) - (nnvirtual-convert-headers)) - ;; Create a mapping from Message-ID to article number. - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while (looking-at - "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t") - (gnus-sethash - (buffer-substring (match-beginning 1) (match-end 1)) - (read (current-buffer)) - hashtb) - (forward-line 1)) - ;; Then we read the headers from the `from-server'. - (when (and (gnus-request-group group nil from-server) - (gnus-active group) - (setq type (gnus-retrieve-headers - (gnus-uncompress-range - (gnus-active group)) - group from-server))) - ;; Make it easier to map marks. - (let ((mark-lists (gnus-info-marks info)) - ms type m) - (while mark-lists - (setq type (caar mark-lists) - ms (gnus-uncompress-range (cdr (pop mark-lists)))) - (while ms - (if (setq m (assq (car ms) marks)) - (setcdr m (cons type (cdr m))) - (push (list (car ms) type) marks)) - (pop ms)))) - ;; Convert. - (when (eq type 'headers) - (nnvirtual-convert-headers)) - ;; Go through the headers and map away. - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while (looking-at - "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t") - (setq to-article - (gnus-gethash - (buffer-substring (match-beginning 1) (match-end 1)) - hashtb)) - ;; Add this article to the list of read articles. - (push to-article to-reads) - ;; See if there are any marks and then add them. - (when (setq mark (assq (read (current-buffer)) marks)) - (setq marks (delq mark marks)) - (setcar mark to-article) - (push mark to-marks)) - (forward-line 1)) - ;; Now we know what the read articles are and what the - ;; article marks are. We transform the information - ;; into the Gnus info format. - (setq to-reads - (gnus-range-add - (gnus-compress-sequence (and to-reads (sort to-reads '<)) t) - (cons 1 (1- (car to-active))))) - (gnus-info-set-read info to-reads) - ;; Do the marks. I'm sure y'all understand what's - ;; going on down below, so I won't bother with any - ;; further comments. - (let ((mlists gnus-article-mark-lists) - lists ms a) - (while mlists - (push (list (cdr (pop mlists))) lists)) - (while (setq ms (pop marks)) - (setq article (pop ms)) - (while ms - (setcdr (setq a (assq (pop ms) lists)) - (cons article (cdr a))))) - (setq a lists) - (while a - (setcdr (car a) (gnus-compress-sequence - (and (cdar a) (sort (cdar a) '<)))) - (pop a)) - (gnus-info-set-marks info lists t))))) - (gnus-message 7 "Translating %s...done" group))) - -(defun gnus-group-move-group-to-server (info from-server to-server) - "Move the group on the current line from FROM-SERVER to TO-SERVER." - (interactive - (let ((info (gnus-get-info (gnus-group-group-name)))) - (list info (gnus-find-method-for-group (gnus-info-group info)) - (gnus-read-method (format "Move group %s to method: " - (gnus-info-group info)))))) - (save-excursion - (gnus-move-group-to-server info from-server to-server) - ;; We have to update the group info to point use the right server. - (gnus-info-set-method info to-server t) - ;; We also have to change the name of the group and stuff. - (let* ((group (gnus-info-group info)) - (new-name (gnus-group-prefixed-name - (gnus-group-real-name group) to-server))) - (gnus-info-set-group info new-name) - (gnus-sethash new-name (gnus-gethash group gnus-newsrc-hashtb) - gnus-newsrc-hashtb) - (gnus-sethash group nil gnus-newsrc-hashtb)))) - -(provide 'gnus-move) - -;;; gnus-move.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-msg.el --- a/lisp/gnus/gnus-msg.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1079 +0,0 @@ -;;; gnus-msg.el --- mail and post interface for Gnus -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-ems) -(require 'message) -(require 'gnus-art) - -;; Added by Sudish Joseph . -(defvar gnus-post-method nil - "*Preferred method for posting USENET news. -If this variable is nil, Gnus will use the current method to decide -which method to use when posting. If it is non-nil, it will override -the current method. This method will not be used in mail groups and -the like, only in \"real\" newsgroups. - -The value must be a valid method as discussed in the documentation of -`gnus-select-method'. It can also be a list of methods. If that is -the case, the user will be queried for what select method to use when -posting.") - -(defvar gnus-outgoing-message-group nil - "*All outgoing messages will be put in this group. -If you want to store all your outgoing mail and articles in the group -\"nnml:archive\", you set this variable to that value. This variable -can also be a list of group names. - -If you want to have greater control over what group to put each -message in, you can set this variable to a function that checks the -current newsgroup name and then returns a suitable group name (or list -of names).") - -(defvar gnus-mailing-list-groups nil - "*Regexp matching groups that are really mailing lists. -This is useful when you're reading a mailing list that has been -gatewayed to a newsgroup, and you want to followup to an article in -the group.") - -(defvar gnus-add-to-list nil - "*If non-nil, add a `to-list' parameter automatically.") - -(defvar gnus-sent-message-ids-file - (nnheader-concat gnus-directory "Sent-Message-IDs") - "File where Gnus saves a cache of sent message ids.") - -(defvar gnus-sent-message-ids-length 1000 - "The number of sent Message-IDs to save.") - -(defvar gnus-crosspost-complaint - "Hi, - -You posted the article below with the following Newsgroups header: - -Newsgroups: %s - -The %s group, at least, was an inappropriate recipient -of this message. Please trim your Newsgroups header to exclude this -group before posting in the future. - -Thank you. - -" - "Format string to be inserted when complaining about crossposts. -The first %s will be replaced by the Newsgroups header; -the second with the current group name.") - -(defvar gnus-message-setup-hook nil - "Hook run after setting up a message buffer.") - -;;; Internal variables. - -(defvar gnus-message-buffer "*Mail Gnus*") -(defvar gnus-article-copy nil) -(defvar gnus-last-posting-server nil) - -(defconst gnus-bug-message - "Sending a bug report to the Gnus Towers. -======================================== - -The buffer below is a mail buffer. When you press `C-c C-c', it will -be sent to the Gnus Bug Exterminators. - -At the bottom of the buffer you'll see lots of variable settings. -Please do not delete those. They will tell the Bug People what your -environment is, so that it will be easier to locate the bugs. - -If you have found a bug that makes Emacs go \"beep\", set -debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET') -and include the backtrace in your bug report. - -Please describe the bug in annoying, painstaking detail. - -Thank you for your help in stamping out bugs. -") - -(eval-and-compile - (autoload 'gnus-uu-post-news "gnus-uu" nil t) - (autoload 'news-setup "rnewspost") - (autoload 'news-reply-mode "rnewspost") - (autoload 'rmail-dont-reply-to "mail-utils") - (autoload 'rmail-output "rmailout")) - - -;;; -;;; Gnus Posting Functions -;;; - -(gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map) - "p" gnus-summary-post-news - "f" gnus-summary-followup - "F" gnus-summary-followup-with-original - "c" gnus-summary-cancel-article - "s" gnus-summary-supersede-article - "r" gnus-summary-reply - "R" gnus-summary-reply-with-original - "w" gnus-summary-wide-reply - "W" gnus-summary-wide-reply-with-original - "n" gnus-summary-followup-to-mail - "N" gnus-summary-followup-to-mail-with-original - "m" gnus-summary-mail-other-window - "u" gnus-uu-post-news - "\M-c" gnus-summary-mail-crosspost-complaint - "om" gnus-summary-mail-forward - "op" gnus-summary-post-forward - "Om" gnus-uu-digest-mail-forward - "Op" gnus-uu-digest-post-forward) - -(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map) - "b" gnus-summary-resend-bounced-mail - ;; "c" gnus-summary-send-draft - "r" gnus-summary-resend-message) - -;;; Internal functions. - -(defvar gnus-article-reply nil) -(defmacro gnus-setup-message (config &rest forms) - (let ((winconf (make-symbol "winconf")) - (buffer (make-symbol "buffer")) - (article (make-symbol "article"))) - `(let ((,winconf (current-window-configuration)) - (,buffer (buffer-name (current-buffer))) - (,article (and gnus-article-reply (gnus-summary-article-number))) - (message-header-setup-hook - (copy-sequence message-header-setup-hook))) - (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc) - (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc) - (unwind-protect - ,@forms - (gnus-inews-add-send-actions ,winconf ,buffer ,article) - (setq gnus-message-buffer (current-buffer)) - (make-local-variable 'gnus-newsgroup-name) - (run-hooks 'gnus-message-setup-hook)) - (gnus-configure-windows ,config t) - (set-buffer-modified-p nil)))) - -(defun gnus-inews-add-send-actions (winconf buffer article) - (make-local-hook 'message-sent-hook) - (add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t) - (setq message-post-method - `(lambda (arg) - (gnus-post-method arg ,gnus-newsgroup-name))) - (setq message-newsreader (setq message-mailer (gnus-extended-version))) - (message-add-action - `(set-window-configuration ,winconf) 'exit 'postpone 'kill) - (message-add-action - `(when (buffer-name (get-buffer ,buffer)) - (save-excursion - (set-buffer (get-buffer ,buffer)) - ,(when article - `(gnus-summary-mark-article-as-replied ,article)))) - 'send)) - -(put 'gnus-setup-message 'lisp-indent-function 1) -(put 'gnus-setup-message 'edebug-form-spec '(form body)) - -;;; Post news commands of Gnus group mode and summary mode - -(defun gnus-group-mail () - "Start composing a mail." - (interactive) - (gnus-setup-message 'message - (message-mail))) - -(defun gnus-group-post-news (&optional arg) - "Start composing a news message. -If ARG, post to the group under point. -If ARG is 1, prompt for a group name." - (interactive "P") - ;; Bind this variable here to make message mode hooks - ;; work ok. - (let ((gnus-newsgroup-name - (if arg - (if (= 1 (prefix-numeric-value arg)) - (completing-read "Newsgroup: " gnus-active-hashtb nil - (gnus-read-active-file-p)) - (gnus-group-group-name)) - ""))) - (gnus-post-news 'post gnus-newsgroup-name))) - -(defun gnus-summary-post-news () - "Start composing a news message." - (interactive) - (gnus-set-global-variables) - (gnus-post-news 'post gnus-newsgroup-name)) - -(defun gnus-summary-followup (yank &optional force-news) - "Compose a followup to an article. -If prefix argument YANK is non-nil, original article is yanked automatically." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) - (gnus-set-global-variables) - (when yank - (gnus-summary-goto-subject (car yank))) - (save-window-excursion - (gnus-summary-select-article)) - (let ((headers (gnus-summary-article-header (gnus-summary-article-number))) - (gnus-newsgroup-name gnus-newsgroup-name)) - ;; Send a followup. - (gnus-post-news nil gnus-newsgroup-name - headers gnus-article-buffer - yank nil force-news))) - -(defun gnus-summary-followup-with-original (n &optional force-news) - "Compose a followup to an article and include the original article." - (interactive "P") - (gnus-summary-followup (gnus-summary-work-articles n) force-news)) - -(defun gnus-summary-followup-to-mail (&optional arg) - "Followup to the current mail message via news." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) - (gnus-summary-followup arg t)) - -(defun gnus-summary-followup-to-mail-with-original (&optional arg) - "Followup to the current mail message via news." - (interactive "P") - (gnus-summary-followup (gnus-summary-work-articles arg) t)) - -(defun gnus-inews-yank-articles (articles) - (let (beg article) - (message-goto-body) - (while (setq article (pop articles)) - (save-window-excursion - (set-buffer gnus-summary-buffer) - (gnus-summary-select-article nil nil nil article) - (gnus-summary-remove-process-mark article)) - (gnus-copy-article-buffer) - (let ((message-reply-buffer gnus-article-copy) - (message-reply-headers gnus-current-headers)) - (message-yank-original) - (setq beg (or beg (mark t)))) - (when articles - (insert "\n"))) - (push-mark) - (goto-char beg))) - -(defun gnus-summary-cancel-article (n) - "Cancel an article you posted." - (interactive "P") - (gnus-set-global-variables) - (let ((articles (gnus-summary-work-articles n)) - (message-post-method - `(lambda (arg) - (gnus-post-method nil ,gnus-newsgroup-name))) - article) - (while (setq article (pop articles)) - (when (gnus-summary-select-article t nil nil article) - (when (gnus-eval-in-buffer-window gnus-original-article-buffer - (message-cancel-news)) - (gnus-summary-mark-as-read article gnus-canceled-mark) - (gnus-cache-remove-article 1)) - (gnus-article-hide-headers-if-wanted)) - (gnus-summary-remove-process-mark article)))) - -(defun gnus-summary-supersede-article () - "Compose an article that will supersede a previous article. -This is done simply by taking the old article and adding a Supersedes -header line with the old Message-ID." - (interactive) - (gnus-set-global-variables) - (let ((article (gnus-summary-article-number))) - (gnus-setup-message 'reply-yank - (gnus-summary-select-article t) - (set-buffer gnus-original-article-buffer) - (message-supersede) - (push - `((lambda () - (when (buffer-name (get-buffer ,gnus-summary-buffer)) - (save-excursion - (set-buffer (get-buffer ,gnus-summary-buffer)) - (gnus-cache-possibly-remove-article ,article nil nil nil t) - (gnus-summary-mark-as-read ,article gnus-canceled-mark))))) - message-send-actions)))) - - - -(defun gnus-copy-article-buffer (&optional article-buffer) - ;; make a copy of the article buffer with all text properties removed - ;; this copy is in the buffer gnus-article-copy. - ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used - ;; this buffer should be passed to all mail/news reply/post routines. - (setq gnus-article-copy (get-buffer-create " *gnus article copy*")) - (buffer-disable-undo gnus-article-copy) - (or (memq gnus-article-copy gnus-buffer-list) - (push gnus-article-copy gnus-buffer-list)) - (let ((article-buffer (or article-buffer gnus-article-buffer)) - end beg contents) - (if (not (and (get-buffer article-buffer) - (buffer-name (get-buffer article-buffer)))) - (error "Can't find any article buffer") - (save-excursion - (set-buffer article-buffer) - (save-restriction - ;; Copy over the (displayed) article buffer, delete - ;; hidden text and remove text properties. - (widen) - (copy-to-buffer gnus-article-copy (point-min) (point-max)) - (set-buffer gnus-article-copy) - (gnus-article-delete-text-of-type 'annotation) - (gnus-remove-text-with-property 'gnus-prev) - (gnus-remove-text-with-property 'gnus-next) - (insert - (prog1 - (format "%s" (buffer-string)) - (erase-buffer))) - ;; Find the original headers. - (set-buffer gnus-original-article-buffer) - (goto-char (point-min)) - (while (looking-at message-unix-mail-delimiter) - (forward-line 1)) - (setq beg (point)) - (setq end (or (search-forward "\n\n" nil t) (point))) - ;; Delete the headers from the displayed articles. - (set-buffer gnus-article-copy) - (delete-region (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point))) - ;; Insert the original article headers. - (insert-buffer-substring gnus-original-article-buffer beg end) - (gnus-article-decode-rfc1522))) - gnus-article-copy))) - -(defun gnus-post-news (post &optional group header article-buffer yank subject - force-news) - (when article-buffer - (gnus-copy-article-buffer)) - (let ((gnus-article-reply article-buffer) - (add-to-list gnus-add-to-list)) - (gnus-setup-message (cond (yank 'reply-yank) - (article-buffer 'reply) - (t 'message)) - (let* ((group (or group gnus-newsgroup-name)) - (pgroup group) - to-address to-group mailing-list to-list - newsgroup-p) - (when group - (setq to-address (gnus-group-find-parameter group 'to-address) - to-group (gnus-group-find-parameter group 'to-group) - to-list (gnus-group-find-parameter group 'to-list) - newsgroup-p (gnus-group-find-parameter group 'newsgroup) - mailing-list (when gnus-mailing-list-groups - (string-match gnus-mailing-list-groups group)) - group (gnus-group-real-name group))) - (if (or (and to-group - (gnus-news-group-p to-group)) - newsgroup-p - force-news - (and (gnus-news-group-p - (or pgroup gnus-newsgroup-name) - (if header (mail-header-number header) - gnus-current-article)) - (not mailing-list) - (not to-list) - (not to-address))) - ;; This is news. - (if post - (message-news (or to-group group)) - (set-buffer gnus-article-copy) - (message-followup (if (or newsgroup-p force-news) nil to-group))) - ;; The is mail. - (if post - (progn - (message-mail (or to-address to-list)) - ;; Arrange for mail groups that have no `to-address' to - ;; get that when the user sends off the mail. - (when (and (not to-list) - (not to-address) - add-to-list) - (push (list 'gnus-inews-add-to-address pgroup) - message-send-actions))) - (set-buffer gnus-article-copy) - (message-wide-reply to-address - (gnus-group-find-parameter - gnus-newsgroup-name 'broken-reply-to)))) - (when yank - (gnus-inews-yank-articles yank)))))) - -(defun gnus-post-method (arg group &optional silent) - "Return the posting method based on GROUP and ARG. -If SILENT, don't prompt the user." - (let ((group-method (gnus-find-method-for-group group))) - (cond - ;; If the group-method is nil (which shouldn't happen) we use - ;; the default method. - ((null group-method) - (or gnus-post-method gnus-select-method message-post-method)) - ;; We want this group's method. - ((and arg (not (eq arg 0))) - group-method) - ;; We query the user for a post method. - ((or arg - (and gnus-post-method - (listp (car gnus-post-method)))) - (let* ((methods - ;; Collect all methods we know about. - (append - (when gnus-post-method - (if (listp (car gnus-post-method)) - gnus-post-method - (list gnus-post-method))) - gnus-secondary-select-methods - (list gnus-select-method) - (list group-method))) - method-alist post-methods method) - ;; Weed out all mail methods. - (while methods - (setq method (gnus-server-get-method "" (pop methods))) - (when (or (gnus-method-option-p method 'post) - (gnus-method-option-p method 'post-mail)) - (push method post-methods))) - ;; Create a name-method alist. - (setq method-alist - (mapcar - (lambda (m) - (list (concat (cadr m) " (" (symbol-name (car m)) ")") m)) - post-methods)) - ;; Query the user. - (cadr - (assoc - (setq gnus-last-posting-server - (if (and silent - gnus-last-posting-server) - ;; Just use the last value. - gnus-last-posting-server - (completing-read - "Posting method: " method-alist nil t - (cons (or gnus-last-posting-server "") 0)))) - method-alist)))) - ;; Override normal method. - (gnus-post-method - gnus-post-method) - ;; Use the normal select method. - (t gnus-select-method)))) - -;;; -;;; Check whether the message has been sent already. -;;; - -(defvar gnus-inews-sent-ids nil) - -(defun gnus-inews-reject-message () - "Check whether this message has already been sent." - (when gnus-sent-message-ids-file - (let ((message-id (save-restriction (message-narrow-to-headers) - (mail-fetch-field "message-id"))) - end) - (when message-id - (unless gnus-inews-sent-ids - (ignore-errors - (load t t t))) - (if (member message-id gnus-inews-sent-ids) - ;; Reject this message. - (not (gnus-yes-or-no-p - (format "Message %s already sent. Send anyway? " - message-id))) - (push message-id gnus-inews-sent-ids) - ;; Chop off the last Message-IDs. - (when (setq end (nthcdr gnus-sent-message-ids-length - gnus-inews-sent-ids)) - (setcdr end nil)) - (nnheader-temp-write gnus-sent-message-ids-file - (gnus-prin1 `(setq gnus-inews-sent-ids ',gnus-inews-sent-ids))) - nil))))) - - - -;; Dummy to avoid byte-compile warning. -(defvar nnspool-rejected-article-hook) -(defvar xemacs-codename) - -;;; Since the X-Newsreader/X-Mailer are ``vanity'' headers, they might -;;; as well include the Emacs version as well. -;;; The following function works with later GNU Emacs, and XEmacs. -(defun gnus-extended-version () - "Stringified Gnus version and Emacs version" - (interactive) - (concat - gnus-version - "/" - (cond - ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version) - (concat "Emacs " (substring emacs-version - (match-beginning 1) - (match-end 1)))) - ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)[^(]*\\(\\((beta.*)\\|'\\)\\)?" - emacs-version) - (concat (substring emacs-version - (match-beginning 1) - (match-end 1)) - (format " %d.%d" emacs-major-version emacs-minor-version) - (if (match-beginning 3) - (substring emacs-version - (match-beginning 3) - (match-end 3)) - "") - (if (boundp 'xemacs-codename) - (concat " - \"" xemacs-codename "\"")))) - (t emacs-version)))) - -;; Written by "Mr. Per Persson" . -(defun gnus-inews-insert-mime-headers () - (goto-char (point-min)) - (let ((mail-header-separator - (progn - (goto-char (point-min)) - (if (and (search-forward (concat "\n" mail-header-separator "\n") - nil t) - (not (search-backward "\n\n" nil t))) - mail-header-separator - "")))) - (or (mail-position-on-field "Mime-Version") - (insert "1.0") - (cond ((save-restriction - (widen) - (goto-char (point-min)) - (re-search-forward "[\200-\377]" nil t)) - (or (mail-position-on-field "Content-Type") - (insert "text/plain; charset=ISO-8859-1")) - (or (mail-position-on-field "Content-Transfer-Encoding") - (insert "8bit"))) - (t (or (mail-position-on-field "Content-Type") - (insert "text/plain; charset=US-ASCII")) - (or (mail-position-on-field "Content-Transfer-Encoding") - (insert "7bit"))))))) - - -;;; -;;; Gnus Mail Functions -;;; - -;;; Mail reply commands of Gnus summary mode - -(defun gnus-summary-reply (&optional yank wide) - "Start composing a reply mail to the current message. -If prefix argument YANK is non-nil, the original article is yanked -automatically." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) - ;; Stripping headers should be specified with mail-yank-ignored-headers. - (gnus-set-global-variables) - (when yank - (gnus-summary-goto-subject (car yank))) - (let ((gnus-article-reply t)) - (gnus-setup-message (if yank 'reply-yank 'reply) - (gnus-summary-select-article) - (set-buffer (gnus-copy-article-buffer)) - (message-reply nil wide (gnus-group-find-parameter - gnus-newsgroup-name 'broken-reply-to)) - (when yank - (gnus-inews-yank-articles yank))))) - -(defun gnus-summary-reply-with-original (n &optional wide) - "Start composing a reply mail to the current message. -The original article will be yanked." - (interactive "P") - (gnus-summary-reply (gnus-summary-work-articles n) wide)) - -(defun gnus-summary-wide-reply (&optional yank) - "Start composing a wide reply mail to the current message. -If prefix argument YANK is non-nil, the original article is yanked -automatically." - (interactive - (list (and current-prefix-arg - (gnus-summary-work-articles 1)))) - (gnus-summary-reply yank t)) - -(defun gnus-summary-wide-reply-with-original (n) - "Start composing a wide reply mail to the current message. -The original article will be yanked." - (interactive "P") - (gnus-summary-reply-with-original n t)) - -(defun gnus-summary-mail-forward (&optional full-headers post) - "Forward the current message to another user. -If FULL-HEADERS (the prefix), include full headers when forwarding." - (interactive "P") - (gnus-set-global-variables) - (gnus-setup-message 'forward - (gnus-summary-select-article) - (set-buffer gnus-original-article-buffer) - (let ((message-included-forward-headers - (if full-headers "" message-included-forward-headers))) - (message-forward post)))) - -(defun gnus-summary-resend-message (address n) - "Resend the current article to ADDRESS." - (interactive "sResend message(s) to: \nP") - (let ((articles (gnus-summary-work-articles n)) - article) - (while (setq article (pop articles)) - (gnus-summary-select-article nil nil nil article) - (save-excursion - (set-buffer gnus-original-article-buffer) - (message-resend address))))) - -(defun gnus-summary-post-forward (&optional full-headers) - "Forward the current article to a newsgroup. -If FULL-HEADERS (the prefix), include full headers when forwarding." - (interactive "P") - (gnus-summary-mail-forward full-headers t)) - -(defvar gnus-nastygram-message - "The following article was inappropriately posted to %s.\n\n" - "Format string to insert in nastygrams. -The current group name will be inserted at \"%s\".") - -(defun gnus-summary-mail-nastygram (n) - "Send a nastygram to the author of the current article." - (interactive "P") - (when (or gnus-expert-user - (gnus-y-or-n-p - "Really send a nastygram to the author of the current article? ")) - (let ((group gnus-newsgroup-name)) - (gnus-summary-reply-with-original n) - (set-buffer gnus-message-buffer) - (message-goto-body) - (insert (format gnus-nastygram-message group)) - (message-send-and-exit)))) - -(defun gnus-summary-mail-crosspost-complaint (n) - "Send a complaint about crossposting to the current article(s)." - (interactive "P") - (let ((articles (gnus-summary-work-articles n)) - article) - (while (setq article (pop articles)) - (set-buffer gnus-summary-buffer) - (gnus-summary-goto-subject article) - (let ((group (gnus-group-real-name gnus-newsgroup-name)) - newsgroups followup-to) - (gnus-summary-select-article) - (set-buffer gnus-original-article-buffer) - (if (and (<= (length (message-tokenize-header - (setq newsgroups (mail-fetch-field "newsgroups")) - ", ")) - 1) - (or (not (setq followup-to (mail-fetch-field "followup-to"))) - (not (member group (message-tokenize-header - followup-to ", "))))) - (if followup-to - (gnus-message 1 "Followup-to restricted") - (gnus-message 1 "Not a crossposted article")) - (set-buffer gnus-summary-buffer) - (gnus-summary-reply-with-original 1) - (set-buffer gnus-message-buffer) - (message-goto-body) - (insert (format gnus-crosspost-complaint newsgroups group)) - (message-goto-subject) - (re-search-forward " *$") - (replace-match " (crosspost notification)" t t) - (when (fboundp 'deactivate-mark) - (deactivate-mark)) - (when (gnus-y-or-n-p "Send this complaint? ") - (message-send-and-exit))))))) - -(defun gnus-summary-mail-other-window () - "Compose mail in other window." - (interactive) - (gnus-setup-message 'message - (message-mail))) - -(defun gnus-mail-parse-comma-list () - (let (accumulated - beg) - (skip-chars-forward " ") - (while (not (eobp)) - (setq beg (point)) - (skip-chars-forward "^,") - (while (zerop - (save-excursion - (save-restriction - (let ((i 0)) - (narrow-to-region beg (point)) - (goto-char beg) - (logand (progn - (while (search-forward "\"" nil t) - (incf i)) - (if (zerop i) 2 i)) - 2))))) - (skip-chars-forward ",") - (skip-chars-forward "^,")) - (skip-chars-backward " ") - (push (buffer-substring beg (point)) - accumulated) - (skip-chars-forward "^,") - (skip-chars-forward ", ")) - accumulated)) - -(defun gnus-inews-add-to-address (group) - (let ((to-address (mail-fetch-field "to"))) - (when (and to-address - (gnus-alive-p)) - ;; This mail group doesn't have a `to-list', so we add one - ;; here. Magic! - (when (gnus-y-or-n-p - (format "Do you want to add this as `to-list': %s " to-address)) - (gnus-group-add-parameter group (cons 'to-list to-address)))))) - -(defun gnus-put-message () - "Put the current message in some group and return to Gnus." - (interactive) - (let ((reply gnus-article-reply) - (winconf gnus-prev-winconf) - (group gnus-newsgroup-name)) - - (or (and group (not (gnus-group-read-only-p group))) - (setq group (read-string "Put in group: " nil - (gnus-writable-groups)))) - (when (gnus-gethash group gnus-newsrc-hashtb) - (error "No such group: %s" group)) - - (save-excursion - (save-restriction - (widen) - (message-narrow-to-headers) - (let (gnus-deletable-headers) - (if (message-news-p) - (message-generate-headers message-required-news-headers) - (message-generate-headers message-required-mail-headers))) - (goto-char (point-max)) - (insert "Gcc: " group "\n") - (widen))) - - (gnus-inews-do-gcc) - - (when (get-buffer gnus-group-buffer) - (when (gnus-buffer-exists-p (car-safe reply)) - (set-buffer (car reply)) - (and (cdr reply) - (gnus-summary-mark-article-as-replied - (cdr reply)))) - (when winconf - (set-window-configuration winconf))))) - -(defun gnus-article-mail (yank) - "Send a reply to the address near point. -If YANK is non-nil, include the original article." - (interactive "P") - (let ((address - (buffer-substring - (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point))) - (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point)))))) - (when address - (message-reply address) - (when yank - (gnus-inews-yank-articles (list (cdr gnus-article-current))))))) - -(defvar nntp-server-type) -(defun gnus-bug () - "Send a bug report to the Gnus maintainers." - (interactive) - (unless (gnus-alive-p) - (error "Gnus has been shut down")) - (gnus-setup-message 'bug - (delete-other-windows) - (switch-to-buffer "*Gnus Help Bug*") - (erase-buffer) - (insert gnus-bug-message) - (goto-char (point-min)) - (message-pop-to-buffer "*Gnus Bug*") - (message-setup `((To . ,gnus-maintainer) (Subject . ""))) - (push `(gnus-bug-kill-buffer) message-send-actions) - (goto-char (point-min)) - (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line 1) - (insert (gnus-version) "\n") - (insert (emacs-version) "\n") - (when (and (boundp 'nntp-server-type) - (stringp nntp-server-type)) - (insert nntp-server-type)) - (insert "\n\n\n\n\n") - (gnus-debug) - (goto-char (point-min)) - (search-forward "Subject: " nil t) - (message ""))) - -(defun gnus-bug-kill-buffer () - (when (get-buffer "*Gnus Help Bug*") - (kill-buffer "*Gnus Help Bug*"))) - -(defun gnus-debug () - "Attempts to go through the Gnus source file and report what variables have been changed. -The source file has to be in the Emacs load path." - (interactive) - (let ((files '("gnus.el" "gnus-sum.el" "gnus-group.el" - "gnus-art.el" "gnus-start.el" "gnus-async.el" - "gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el" - "nnmail.el" "message.el")) - file expr olist sym) - (gnus-message 4 "Please wait while we snoop your variables...") - (sit-for 0) - ;; Go through all the files looking for non-default values for variables. - (save-excursion - (set-buffer (get-buffer-create " *gnus bug info*")) - (buffer-disable-undo (current-buffer)) - (while files - (erase-buffer) - (when (and (setq file (locate-library (pop files))) - (file-exists-p file)) - (insert-file-contents file) - (goto-char (point-min)) - (if (not (re-search-forward "^;;* *Internal variables" nil t)) - (gnus-message 4 "Malformed sources in file %s" file) - (narrow-to-region (point-min) (point)) - (goto-char (point-min)) - (while (setq expr (ignore-errors (read (current-buffer)))) - (ignore-errors - (and (or (eq (car expr) 'defvar) - (eq (car expr) 'defcustom)) - (stringp (nth 3 expr)) - (or (not (boundp (nth 1 expr))) - (not (equal (eval (nth 2 expr)) - (symbol-value (nth 1 expr))))) - (push (nth 1 expr) olist))))))) - (kill-buffer (current-buffer))) - (when (setq olist (nreverse olist)) - (insert "------------------ Environment follows ------------------\n\n")) - (while olist - (if (boundp (car olist)) - (condition-case () - (pp `(setq ,(car olist) - ,(if (or (consp (setq sym (symbol-value (car olist)))) - (and (symbolp sym) - (not (or (eq sym nil) - (eq sym t))))) - (list 'quote (symbol-value (car olist))) - (symbol-value (car olist)))) - (current-buffer)) - (error - (format "(setq %s 'whatever)\n" (car olist)))) - (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n")) - (setq olist (cdr olist))) - (insert "\n\n") - ;; Remove any null chars - they seem to cause trouble for some - ;; mailers. (Byte-compiled output from the stuff above.) - (goto-char (point-min)) - (while (re-search-forward "[\000\200]" nil t) - (replace-match "" t t)))) - -;;; Treatment of rejected articles. -;;; Bounced mail. - -(defun gnus-summary-resend-bounced-mail (&optional fetch) - "Re-mail the current message. -This only makes sense if the current message is a bounce message than -contains some mail you have written which has been bounced back to -you. -If FETCH, try to fetch the article that this is a reply to, if indeed -this is a reply." - (interactive "P") - (gnus-summary-select-article t) - (set-buffer gnus-original-article-buffer) - (gnus-setup-message 'compose-bounce - (let* ((references (mail-fetch-field "references")) - (parent (and references (gnus-parent-id references)))) - (message-bounce) - ;; If there are references, we fetch the article we answered to. - (and fetch parent - (gnus-summary-refer-article parent) - (gnus-summary-show-all-headers))))) - -;;; Gcc handling. - -;; Do Gcc handling, which copied the message over to some group. -(defun gnus-inews-do-gcc (&optional gcc) - (interactive) - (when (gnus-alive-p) - (save-excursion - (save-restriction - (message-narrow-to-headers) - (let ((gcc (or gcc (mail-fetch-field "gcc" nil t))) - (cur (current-buffer)) - groups group method) - (when gcc - (message-remove-header "gcc") - (widen) - (setq groups (message-tokenize-header gcc " ,")) - ;; Copy the article over to some group(s). - (while (setq group (pop groups)) - (gnus-check-server - (setq method - (cond ((and (null (gnus-get-info group)) - (eq (car gnus-message-archive-method) - (car - (gnus-server-to-method - (gnus-group-method group))))) - ;; If the group doesn't exist, we assume - ;; it's an archive group... - gnus-message-archive-method) - ;; Use the method. - ((gnus-info-method (gnus-get-info group)) - (gnus-info-method (gnus-get-info group))) - ;; Find the method. - (t (gnus-group-method group))))) - (gnus-check-server method) - (unless (gnus-request-group group t method) - (gnus-request-create-group group method)) - (save-excursion - (nnheader-set-temp-buffer " *acc*") - (insert-buffer-substring cur) - (goto-char (point-min)) - (when (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") - nil t) - (replace-match "" t t )) - (unless (gnus-request-accept-article group method t) - (gnus-message 1 "Couldn't store article in group %s: %s" - group (gnus-status-message method)) - (sit-for 2)) - (kill-buffer (current-buffer)))))))))) - -(defun gnus-inews-insert-gcc () - "Insert Gcc headers based on `gnus-outgoing-message-group'." - (save-excursion - (save-restriction - (message-narrow-to-headers) - (let* ((group gnus-outgoing-message-group) - (gcc (cond - ((gnus-functionp group) - (funcall group)) - ((or (stringp group) (list group)) - group)))) - (when gcc - (insert "Gcc: " - (if (stringp gcc) gcc - (mapconcat 'identity gcc " ")) - "\n")))))) - -(defun gnus-inews-insert-archive-gcc (&optional group) - "Insert the Gcc to say where the article is to be archived." - (let* ((var gnus-message-archive-group) - (group (or group gnus-newsgroup-name "")) - result - gcc-self-val - (groups - (cond - ((null gnus-message-archive-method) - ;; Ignore. - nil) - ((stringp var) - ;; Just a single group. - (list var)) - ((null var) - ;; We don't want this. - nil) - ((and (listp var) (stringp (car var))) - ;; A list of groups. - var) - ((gnus-functionp var) - ;; A function. - (funcall var group)) - (t - ;; An alist of regexps/functions/forms. - (while (and var - (not - (setq result - (cond - ((stringp (caar var)) - ;; Regexp. - (when (string-match (caar var) group) - (cdar var))) - ((gnus-functionp (car var)) - ;; Function. - (funcall (car var) group)) - (t - (eval (car var))))))) - (setq var (cdr var))) - result))) - name) - (when groups - (when (stringp groups) - (setq groups (list groups))) - (save-excursion - (save-restriction - (message-narrow-to-headers) - (goto-char (point-max)) - (insert "Gcc: ") - (if (and gnus-newsgroup-name - (setq gcc-self-val - (gnus-group-find-parameter - gnus-newsgroup-name 'gcc-self))) - (progn - (insert - (if (stringp gcc-self-val) - gcc-self-val - group)) - (if (not (eq gcc-self-val 'none)) - (insert "\n") - (progn - (beginning-of-line) - (kill-line)))) - (while (setq name (pop groups)) - (insert (if (string-match ":" name) - name - (gnus-group-prefixed-name - name gnus-message-archive-method))) - (when groups - (insert " "))) - (insert "\n"))))))) - -(defun gnus-summary-send-draft () - "Enter a mail/post buffer to edit and send the draft." - (interactive) - (gnus-set-global-variables) - (let (buf) - (if (not (setq buf (gnus-request-restore-buffer - (gnus-summary-article-number) gnus-newsgroup-name))) - (error "Couldn't restore the article") - (switch-to-buffer buf) - (when (eq major-mode 'news-reply-mode) - (local-set-key "\C-c\C-c" 'gnus-inews-news)) - ;; Insert the separator. - (goto-char (point-min)) - (search-forward "\n\n") - (forward-char -1) - (insert mail-header-separator) - ;; Configure windows. - (let ((gnus-draft-buffer (current-buffer))) - (gnus-configure-windows 'draft t) - (goto-char (point)))))) - -(gnus-add-shutdown 'gnus-inews-close 'gnus) - -(defun gnus-inews-close () - (setq gnus-inews-sent-ids nil)) - -;;; Allow redefinition of functions. - -(gnus-ems-redefine) - -(provide 'gnus-msg) - -;;; gnus-msg.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-nocem.el --- a/lisp/gnus/gnus-nocem.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,305 +0,0 @@ -;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(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" "news.admin.net-abuse.bulletins" - "alt.nocem.misc" "news.admin.net-abuse.announce") - "List of groups that will be searched for NoCeM messages." - :group 'gnus-nocem - :type '(repeat (string :tag "Group"))) - -(defcustom gnus-nocem-issuers - '("AutoMoose-1" "Automoose-1" ; CancelMoose[tm] - "rbraver@ohww.norman.ok.us" ; Robert Braver - "clewis@ferret.ocunix.on.ca;" ; Chris Lewis - "jem@xpat.com;" ; Despammer from Korea - "snowhare@xmission.com" ; Benjamin "Snowhare" Franz - "red@redpoll.mrfs.oh.us (Richard E. Depew)" ; ARMM! ARMM! - ) - "List of NoCeM issuers to pay attention to." - :group 'gnus-nocem - :type '(repeat string)) - -(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 'mc-verify - "*Function called to verify that the NoCeM message is valid. -One likely value is `mc-verify'. If the function in this variable -isn't bound, the message will be used unconditionally." - :group 'gnus-nocem - :type '(radio (function-item mc-verify) - (function :tag "other"))) - -(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 an previously scanned and verified nocem message." - :group 'gnus-nocem - :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")) - -(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) - (gnus-make-directory gnus-nocem-directory) - ;; Load any previous NoCeM headers. - (gnus-nocem-load-cache) - ;; 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) - (nnheader-temp-write nil - (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)) - (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)))) - (gnus-nocem-check-article group header))))))) - (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. - (gnus-message 7 "Checking article %d in %s for NoCeM..." - (mail-header-number header) group) - (let ((date (mail-header-date header)) - issuer b e) - (when (or (not date) - (nnmail-time-less - (nnmail-time-since (nnmail-date-to-time date)) - (nnmail-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 MESSAGE-----" nil t) - (delete-region (point-min) (match-beginning 0))) - (when (re-search-forward "-----END PGP MESSAGE-----\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")) - (widen) - (and (member issuer gnus-nocem-issuers) ; We like her.... - (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-verify-issuer (person) - "Verify using PGP that the canceler is who she says she is." - (if (fboundp 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 (let ((obarray gnus-active-hashtb)) (read buf))))) - ;; An error. - ) - ((not (symbolp group)) - ;; Ignore invalid entries. - ) - ((not (boundp group)) - ;; Make sure all entries in the hashtb are bound. - (set group nil)) - (t - (when (gnus-gethash (gnus-group-real-name (symbol-name group)) - gnus-newsrc-hashtb) - ;; Valid group. - (beginning-of-line) - (while (= (following-char) ?\t) - (forward-line -1)) - (setq id (buffer-substring (point) (1- (search-forward "\t")))) - (unless (gnus-gethash id gnus-nocem-hashtb) - ;; only store if not already present - (gnus-sethash id t gnus-nocem-hashtb) - (push id ncm)) - (forward-line 1) - (while (= (following-char) ?\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))) - -(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) - (nnheader-temp-write (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." - (nnheader-temp-write (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 (nnmail-days-to-time gnus-nocem-expiry-wait)) - entry) - (setq gnus-nocem-hashtb (gnus-make-hashtable (* (length alist) 51))) - (while (setq entry (car alist)) - (if (not (nnmail-time-less (nnmail-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 - (gnus-sethash (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)) - -(defun gnus-nocem-unwanted-article-p (id) - "Say whether article ID in the current group is wanted." - (gnus-gethash id gnus-nocem-hashtb)) - -(provide 'gnus-nocem) - -;;; gnus-nocem.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-picon.el --- a/lisp/gnus/gnus-picon.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,743 +0,0 @@ -;;; gnus-picon.el --- displaying pretty icons in Gnus -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Wes Hardaker -;; Keywords: news xpm annotation glyph faces - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'xpm) -(require 'annotations) -(require 'custom) -(require 'gnus-art) -(require 'gnus-win) - -;;; User variables: - -(defgroup picons nil - "Show pictures of people, domains, and newsgroups (XEmacs). -For this to work, you must add gnus-group-display-picons to the -gnus-summary-display-hook or to the gnus-article-display-hook -depending on what gnus-picons-display-where is set to. You must -also add gnus-article-display-picons to gnus-article-display-hook." - :group 'gnus-visual) - -(defcustom gnus-picons-display-where 'picons - "Where to display the group and article icons. -Legal values are `article' and `picons'." - :type '(choice symbol string) - :group 'picons) - -(defcustom gnus-picons-has-modeline-p t - "Wether the picons window should have a modeline. -This is only useful if `gnus-picons-display-where' is `picons'." - :type 'boolean - :group 'picons) - -(defcustom gnus-picons-database "/usr/local/faces" - "Defines the location of the faces database. -For information on obtaining this database of pretty pictures, please -see http://www.cs.indiana.edu/picons/ftp/index.html" - :type 'directory - :group 'picons) - -(defcustom gnus-picons-news-directories '("news") - "Sub-directory of the faces database containing the icons for newsgroups." - :type '(repeat string) - :group 'picons) -(define-obsolete-variable-alias 'gnus-picons-news-directory - 'gnus-picons-news-directories) - -(defcustom gnus-picons-user-directories '("local" "users" "usenix" "misc") - "List of directories to search for user faces." - :type '(repeat string) - :group 'picons) - -(defcustom gnus-picons-domain-directories '("domains") - "List of directories to search for domain faces. -Some people may want to add \"unknown\" to this list." - :type '(repeat string) - :group 'picons) - -(defcustom gnus-picons-refresh-before-display nil - "If non-nil, display the article buffer before computing the picons." - :type 'boolean - :group 'picons) - -(defcustom gnus-picons-x-face-file-name - (format "/tmp/picon-xface.%s.xbm" (user-login-name)) - "The name of the file in which to store the converted X-face header." - :type 'string - :group 'picons) - -(defcustom gnus-picons-convert-x-face (format "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | pbmtoxbm > %s" gnus-picons-x-face-file-name) - "Command to convert the x-face header into a xbm file." - :type 'string - :group 'picons) - -(defcustom gnus-picons-display-as-address t - "*If t display textual email addresses along with pictures." - :type 'boolean - :group 'picons) - -(defcustom gnus-picons-file-suffixes - (when (featurep 'x) - (let ((types (list "xbm"))) - (when (featurep 'gif) - (push "gif" types)) - (when (featurep 'xpm) - (push "xpm" types)) - types)) - "List of suffixes on picon file names to try." - :type '(repeat string) - :group 'picons) - -(defcustom gnus-picons-display-article-move-p t - "*Whether to move point to first empty line when displaying picons. -This has only an effect if `gnus-picons-display-where' has value `article'." - :type 'boolean - :group 'picons) - -(defcustom gnus-picons-clear-cache-on-shutdown t - "*Whether to clear the picons cache when exiting gnus. -Gnus caches every picons it finds while it is running. This saves -some time in the search process but eats some memory. If this -variable is set to nil, Gnus will never clear the cache itself; you -will have to manually call `gnus-picons-clear-cache' to clear it. -Otherwise the cache will be cleared every time you exit Gnus." - :type 'boolean - :group 'picons) - -(defcustom gnus-picons-piconsearch-url nil - "*The url to query for picons. Setting this to nil will disable it. -The only plublicly available address currently known is -http://www.cs.indiana.edu:800/piconsearch. If you know of any other, -please tell me so that we can list it." - :type '(choice (const :tag "Disable" :value nil) - (const :tag "www.cs.indiana.edu" - :value "http://www.cs.indiana.edu:800/piconsearch") - (string)) - :group 'picons) - -;;; Internal variables: - -(defvar gnus-picons-processes-alist nil - "Picons processes currently running and their environment.") -(defvar gnus-picons-glyph-alist nil - "Picons glyphs cache. -List of pairs (KEY . GLYPH) where KEY is either a filename or an URL.") -(defvar gnus-picons-url-alist nil - "Picons file names cache. -List of pairs (KEY . NAME) where KEY is (USER HOST DBS) and NAME is an URL.") - -(defvar gnus-group-annotations nil - "List of annotations added/removed when selecting/exiting a group") -(defvar gnus-article-annotations nil - "List of annotations added/removed when selecting an article") -(defvar gnus-x-face-annotations nil - "List of annotations added/removed when selecting an article with an -X-Face.") - -(defvar gnus-picons-jobs-alist nil - "List of jobs that still need be done. -This is a list of (SYM-ANN TAG ARGS...) where SYM-ANN three annotations list, -TAG is one of `picon' or `search' indicating that the job should query a -picon or do a search for picons file names, and ARGS is some additionnal -arguments necessary for the job.") - -(defvar gnus-picons-job-already-running nil - "Lock to ensure only one stream of http requests is running.") - -;;; Functions: - -(defun gnus-picons-remove (symbol) - "Remove all annotations in variable named SYMBOL. -This function is careful to set it to nil before removing anything so that -asynchronous process don't get crazy." - (setq gnus-picons-jobs-alist (remassq symbol gnus-picons-jobs-alist)) - ;; notify running job that it may have been preempted - (if (eq (car gnus-picons-job-already-running) symbol) - (setq gnus-picons-job-already-running t)) - ;; clear all annotations - (mapc (function (lambda (item) - (if (annotationp item) - (delete-annotation item)))) - (prog1 (symbol-value symbol) - (set symbol nil)))) - -(defun gnus-picons-remove-all () - "Removes all picons from the Gnus display(s)." - (interactive) - (gnus-picons-remove 'gnus-article-annotations) - (gnus-picons-remove 'gnus-group-annotations) - (gnus-picons-remove 'gnus-x-face-annotations)) - -(defun gnus-get-buffer-name (variable) - "Returns the buffer name associated with the contents of a variable." - (cond ((symbolp variable) (let ((newvar (cdr (assq variable - gnus-window-to-buffer)))) - (cond ((symbolp newvar) - (symbol-value newvar)) - ((stringp newvar) newvar)))) - ((stringp variable) variable))) - -(defun gnus-picons-set-buffer () - (set-buffer - (get-buffer-create (gnus-get-buffer-name gnus-picons-display-where))) - (gnus-add-current-to-buffer-list) - (goto-char (point-min)) - (if (and (eq gnus-picons-display-where 'article) - gnus-picons-display-article-move-p) - (if (search-forward "\n\n" nil t) - (forward-line -1) - (goto-char (point-max))) - (setq buffer-read-only t) - (unless gnus-picons-has-modeline-p - (set-specifier has-modeline-p - (list (list (current-buffer) - (cons nil gnus-picons-has-modeline-p))))))) - -(defun gnus-picons-prepare-for-annotations (annotations) - "Prepare picons buffer for puting annotations memorized in ANNOTATIONS. -ANNOTATIONS should be a symbol naming a variable wich contains a list of -annotations. Sets buffer to `gnus-picons-display-where'." - ;; let drawing catch up - (when gnus-picons-refresh-before-display - (sit-for 0)) - (gnus-picons-set-buffer) - (gnus-picons-remove annotations)) - -(defsubst gnus-picons-make-annotation (&rest args) - (let ((annot (apply 'make-annotation args))) - (set-extent-property annot 'duplicable nil) - annot)) - -(defun gnus-picons-article-display-x-face () - "Display the x-face header bitmap in the 'gnus-picons-display-where buffer." - ;; delete any old ones. - ;; This is needed here because gnus-picons-display-x-face will not - ;; be called if there is no X-Face header - (gnus-picons-remove 'gnus-x-face-annotations) - ;; display the new one. - (let ((gnus-article-x-face-command 'gnus-picons-display-x-face)) - (gnus-article-display-x-face))) - -(defun gnus-picons-x-face-sentinel (process event) - (let* ((env (assq process gnus-picons-processes-alist)) - (annot (cdr env))) - (setq gnus-picons-processes-alist (remassq process - gnus-picons-processes-alist)) - (when annot - (set-annotation-glyph annot - (make-glyph gnus-picons-x-face-file-name)) - (if (memq annot gnus-x-face-annotations) - (delete-file gnus-picons-x-face-file-name))))) - -(defun gnus-picons-display-x-face (beg end) - "Function to display the x-face header in the picons window. -To use: (setq gnus-article-x-face-command 'gnus-picons-display-x-face)" - (interactive) - (if (featurep 'xface) - ;; Use builtin support - (let ((buf (current-buffer))) - (save-excursion - (gnus-picons-prepare-for-annotations 'gnus-x-face-annotations) - (setq gnus-x-face-annotations - (cons (gnus-picons-make-annotation - (vector 'xface - :data (concat "X-Face: " - (buffer-substring beg end buf))) - nil 'text) - gnus-x-face-annotations)))) - ;; convert the x-face header to a .xbm file - (let* ((process-connection-type nil) - (annot (save-excursion - (gnus-picons-prepare-for-annotations - 'gnus-x-face-annotations) - (gnus-picons-make-annotation nil nil 'text))) - (process (start-process-shell-command "gnus-x-face" nil - gnus-picons-convert-x-face))) - (push annot gnus-x-face-annotations) - (push (cons process annot) gnus-picons-processes-alist) - (process-kill-without-query process) - (set-process-sentinel process 'gnus-picons-x-face-sentinel) - (process-send-region process beg end) - (process-send-eof process)))) - -(defun gnus-article-display-picons () - "Display faces for an author and his/her domain in gnus-picons-display-where." - (interactive) - (let (from at-idx) - (when (and (featurep 'xpm) - (or (not (fboundp 'device-type)) (equal (device-type) 'x)) - (setq from (mail-fetch-field "from")) - (setq from (downcase (or (cadr (mail-extract-address-components - from)) - ""))) - (or (setq at-idx (string-match "@" from)) - (setq at-idx (length from)))) - (save-excursion - (let ((username (downcase (substring from 0 at-idx))) - (addrs (if (eq at-idx (length from)) - (if gnus-local-domain - (message-tokenize-header gnus-local-domain ".")) - (message-tokenize-header (substring from (1+ at-idx)) - ".")))) - (gnus-picons-prepare-for-annotations 'gnus-article-annotations) - ;; if display in article buffer, the group annotations - ;; wrongly placed. Move them here - (if (eq gnus-picons-display-where 'article) - (dolist (ext gnus-group-annotations) - (set-extent-endpoints ext (point) (point)))) - (if (null gnus-picons-piconsearch-url) - (setq gnus-article-annotations - (nconc gnus-article-annotations - (gnus-picons-display-pairs - (gnus-picons-lookup-pairs - addrs gnus-picons-domain-directories) - gnus-picons-display-as-address - "." t) - (if (and gnus-picons-display-as-address addrs) - (list (gnus-picons-make-annotation - [string :data "@"] nil - 'text nil nil nil t))) - (gnus-picons-display-picon-or-name - (gnus-picons-lookup-user username addrs) - username t))) - (push (list 'gnus-article-annotations 'search username addrs - gnus-picons-domain-directories t) - gnus-picons-jobs-alist) - (gnus-picons-next-job)) - - (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all)))))) - -(defun gnus-group-display-picons () - "Display icons for the group in the gnus-picons-display-where buffer." - (interactive) - (when (and (featurep 'xpm) - (or (not (fboundp 'device-type)) (equal (device-type) 'x))) - (save-excursion - (gnus-picons-prepare-for-annotations 'gnus-group-annotations) - (if (null gnus-picons-piconsearch-url) - (setq gnus-group-annotations - (gnus-picons-display-pairs - (gnus-picons-lookup-pairs (reverse (message-tokenize-header - (gnus-group-real-name gnus-newsgroup-name) - ".")) - gnus-picons-news-directories) - t ".")) - (push (list 'gnus-group-annotations 'search nil - (message-tokenize-header - (gnus-group-real-name gnus-newsgroup-name) ".") - (if (listp gnus-picons-news-directories) - gnus-picons-news-directories - (list gnus-picons-news-directories)) - nil) - gnus-picons-jobs-alist) - (gnus-picons-next-job)) - - (add-hook 'gnus-summary-exit-hook 'gnus-picons-remove-all)))) - -(defsubst gnus-picons-lookup-internal (addrs dir) - (setq dir (expand-file-name dir gnus-picons-database)) - (gnus-picons-try-face (dolist (part (reverse addrs) dir) - (setq dir (expand-file-name part dir))))) - -(defun gnus-picons-lookup (addrs dirs) - "Lookup the picon for ADDRS in databases DIRS. -Returns the picon filename or NIL if none found." - (let (result) - (while (and dirs (null result)) - (setq result (gnus-picons-lookup-internal addrs (pop dirs)))) - result)) - -(defun gnus-picons-lookup-user-internal (user domains) - (let ((dirs gnus-picons-user-directories) - domains-tmp dir picon) - (while (and dirs (null picon)) - (setq domains-tmp domains - dir (pop dirs)) - (while (and domains-tmp - (null (setq picon (gnus-picons-lookup-internal - (cons user domains-tmp) dir)))) - (pop domains-tmp)) - ;; Also make a try in MISC subdir - (unless picon - (setq picon (gnus-picons-lookup-internal (list user "MISC") dir)))) - picon)) - -(defun gnus-picons-lookup-user (user domains) - "Lookup the picon for USER at DOMAINS. -USER is a string containing a name. -DOMAINS is a list of strings from the fully qualified domain name." - (or (gnus-picons-lookup-user-internal user domains) - (gnus-picons-lookup-user-internal "unknown" domains))) - -(defun gnus-picons-lookup-pairs (domains directories) - "Lookup picons for DOMAINS and all its parents in DIRECTORIES. -Returns a list of PAIRS whose CAR is the picon filename or NIL if -none, and whose CDR is the corresponding element of DOMAINS." - (let (picons) - (setq directories (if (listp directories) - directories - (list directories))) - (while domains - (push (list (gnus-picons-lookup (cons "unknown" domains) directories) - (pop domains)) - picons)) - picons)) - -(defun gnus-picons-display-picon-or-name (picon name &optional right-p) - (cond (picon (gnus-picons-display-glyph picon name right-p)) - (gnus-picons-display-as-address (list (gnus-picons-make-annotation - (vector 'string :data name) - nil 'text - nil nil nil right-p))))) - -(defun gnus-picons-display-pairs (pairs &optional bar-p dot-p right-p) - "Display picons in list PAIRS." - (let ((domain-p (and gnus-picons-display-as-address dot-p)) - pair picons) - (if (and bar-p domain-p right-p) - (setq picons (gnus-picons-display-glyph - (gnus-picons-try-face gnus-xmas-glyph-directory - "bar.") - nil right-p))) - (while pairs - (setq pair (pop pairs) - picons (nconc picons - (gnus-picons-display-picon-or-name (car pair) - (cadr pair) - right-p) - (if (and domain-p pairs) - (list (gnus-picons-make-annotation - (vector 'string :data dot-p) - nil 'text nil nil nil right-p)))))) - (if (and bar-p domain-p (not right-p)) - (setq picons (nconc picons - (gnus-picons-display-glyph - (gnus-picons-try-face gnus-xmas-glyph-directory - "bar.") - nil right-p)))) - picons)) - -(defun gnus-picons-try-face (dir &optional filebase) - (let* ((dir (file-name-as-directory dir)) - (filebase (or filebase "face.")) - (key (concat dir filebase)) - (glyph (cdr (assoc key gnus-picons-glyph-alist))) - (suffixes gnus-picons-file-suffixes) - f) - (while (and suffixes (null glyph)) - (when (file-exists-p (setq f (expand-file-name (concat filebase - (pop suffixes)) - dir))) - (setq glyph (make-glyph f)) - (push (cons key glyph) gnus-picons-glyph-alist))) - glyph)) - -(defun gnus-picons-display-glyph (glyph &optional part rightp) - (let ((new (gnus-picons-make-annotation glyph (point) - 'text nil nil nil rightp))) - (when (and part gnus-picons-display-as-address) - (set-annotation-data new (cons new - (make-glyph (vector 'string :data part)))) - (set-annotation-action new 'gnus-picons-action-toggle)) - (nconc - (list new) - (if (and (eq major-mode 'gnus-article-mode) - (not gnus-picons-display-as-address) - (not part)) - (list (gnus-picons-make-annotation [string :data " "] (point) - 'text nil nil nil rightp)))))) - -(defun gnus-picons-action-toggle (data) - "Toggle annotation" - (interactive "e") - (let* ((annot (car data)) - (glyph (annotation-glyph annot))) - (set-annotation-glyph annot (cdr data)) - (set-annotation-data annot (cons annot glyph)))) - -(defun gnus-picons-clear-cache () - "Clear the picons cache" - (interactive) - (setq gnus-picons-glyph-alist nil - gnus-picons-url-alist nil)) - -(gnus-add-shutdown 'gnus-picons-close 'gnus) - -(defun gnus-picons-close () - "Shut down the picons." - (if gnus-picons-clear-cache-on-shutdown - (gnus-picons-clear-cache))) - -;;; Query a remote DB. This requires some stuff from w3 ! - -(require 'url) -(require 'w3-forms) - -(defun gnus-picons-url-retrieve (url fn arg) - (let ((old-asynch (default-value 'url-be-asynchronous)) - (url-working-buffer (generate-new-buffer " *picons*")) - (url-package-name "Gnus") - (url-package-version gnus-version-number) - url-request-method) - (setq-default url-be-asynchronous t) - (save-excursion - (set-buffer url-working-buffer) - (setq url-be-asynchronous t - url-current-callback-data arg - url-current-callback-func fn) - (url-retrieve url t)) - (setq-default url-be-asynchronous old-asynch))) - -(defun gnus-picons-make-glyph (type) - "Make a TYPE glyph using current buffer as data. Handles xbm nicely." - (cond ((null type) nil) - ((eq type 'xbm) (let ((fname (make-temp-name "/tmp/picon"))) - (write-region (point-min) (point-max) fname - nil 'quiet) - (prog1 (make-glyph (vector 'xbm :file fname)) - (delete-file fname)))) - (t (make-glyph (vector type :data (buffer-string)))))) - -;;; Parsing of piconsearch result page. - -;; Assumes: -;; 1 - each value field has the form: "key = value" -;; 2 - a "

" separates the keywords from the results -;; 3 - every results begins by the path within the database at the beginning -;; of the line in raw text. -;; 3b - and the href following it is the preferred image type. - -;; if 1 or 2 is not met, it will probably cause an error. The other -;; will go undetected - -(defun gnus-picons-parse-value (name) - (goto-char (point-min)) - (re-search-forward (concat "" - (regexp-quote name) - " *= * *\\([^ <][^<]*\\) *")) - (buffer-substring (match-beginning 1) (match-end 1))) - -(defun gnus-picons-parse-filenames () - ;; returns an alist of ((USER ADDRS DB) . URL) - (let* ((case-fold-search t) - (user (gnus-picons-parse-value "user")) - (host (gnus-picons-parse-value "host")) - (dbs (message-tokenize-header (gnus-picons-parse-value "db") " ")) - (start-re - (concat - ;; dbs - "^\\(" (mapconcat 'identity dbs "\\|") "\\)/" - ;; host - "\\(\\(" (replace-in-string host "\\." "/\\|" t) "/\\|MISC/\\)*\\)" - ;; user - "\\(" (regexp-quote user) "\\|unknown\\)/" - "face\\.")) - cur-db cur-host cur-user types res) - ;; now point will be somewhere in the header. Find beginning of - ;; entries - (re-search-forward "

[ \t\n]*") - (while (re-search-forward start-re nil t) - (setq cur-db (buffer-substring (match-beginning 1) (match-end 1)) - cur-host (buffer-substring (match-beginning 2) (match-end 2)) - cur-user (buffer-substring (match-beginning 4) (match-end 4)) - cur-host (nreverse (message-tokenize-header cur-host "/"))) - ;; XXX - KLUDGE: there is a blank picon in news/MISC/unknown - (unless (and (string-equal cur-db "news") - (string-equal cur-user "unknown") - (equal cur-host '("MISC"))) - ;; ok now we have found an entry (USER HOST DB), find the - ;; corresponding picon URL - (save-restriction - ;; restrict region to this entry - (narrow-to-region (point) (search-forward "
")) - (goto-char (point-min)) - (setq types gnus-picons-file-suffixes) - (while (and types - (not (re-search-forward - (concat " -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -;;; List and range functions - -(defun gnus-last-element (list) - "Return last element of LIST." - (while (cdr list) - (setq list (cdr list))) - (car list)) - -(defun gnus-copy-sequence (list) - "Do a complete, total copy of a list." - (let (out) - (while (consp list) - (if (consp (car list)) - (push (gnus-copy-sequence (pop list)) out) - (push (pop list) out))) - (if list - (nconc (nreverse out) list) - (nreverse out)))) - -(defun gnus-set-difference (list1 list2) - "Return a list of elements of LIST1 that do not appear in LIST2." - (let ((list1 (copy-sequence list1))) - (while list2 - (setq list1 (delq (car list2) list1)) - (setq list2 (cdr list2))) - list1)) - -(defun gnus-sorted-complement (list1 list2) - "Return a list of elements of LIST1 that do not appear in LIST2. -Both lists have to be sorted over <." - (let (out) - (if (or (null list1) (null list2)) - (or list1 list2) - (while (and list1 list2) - (cond ((= (car list1) (car list2)) - (setq list1 (cdr list1) - list2 (cdr list2))) - ((< (car list1) (car list2)) - (setq out (cons (car list1) out)) - (setq list1 (cdr list1))) - (t - (setq out (cons (car list2) out)) - (setq list2 (cdr list2))))) - (nconc (nreverse out) (or list1 list2))))) - -(defun gnus-intersection (list1 list2) - (let ((result nil)) - (while list2 - (when (memq (car list2) list1) - (setq result (cons (car list2) result))) - (setq list2 (cdr list2))) - result)) - -(defun gnus-sorted-intersection (list1 list2) - ;; LIST1 and LIST2 have to be sorted over <. - (let (out) - (while (and list1 list2) - (cond ((= (car list1) (car list2)) - (setq out (cons (car list1) out) - list1 (cdr list1) - list2 (cdr list2))) - ((< (car list1) (car list2)) - (setq list1 (cdr list1))) - (t - (setq list2 (cdr list2))))) - (nreverse out))) - -(defun gnus-set-sorted-intersection (list1 list2) - ;; LIST1 and LIST2 have to be sorted over <. - ;; This function modifies LIST1. - (let* ((top (cons nil list1)) - (prev top)) - (while (and list1 list2) - (cond ((= (car list1) (car list2)) - (setq prev list1 - list1 (cdr list1) - list2 (cdr list2))) - ((< (car list1) (car list2)) - (setcdr prev (cdr list1)) - (setq list1 (cdr list1))) - (t - (setq list2 (cdr list2))))) - (setcdr prev nil) - (cdr top))) - -(defun gnus-compress-sequence (numbers &optional always-list) - "Convert list of numbers to a list of ranges or a single range. -If ALWAYS-LIST is non-nil, this function will always release a list of -ranges." - (let* ((first (car numbers)) - (last (car numbers)) - result) - (if (null numbers) - nil - (if (not (listp (cdr numbers))) - numbers - (while numbers - (cond ((= last (car numbers)) nil) ;Omit duplicated number - ((= (1+ last) (car numbers)) ;Still in sequence - (setq last (car numbers))) - (t ;End of one sequence - (setq result - (cons (if (= first last) first - (cons first last)) - result)) - (setq first (car numbers)) - (setq last (car numbers)))) - (setq numbers (cdr numbers))) - (if (and (not always-list) (null result)) - (if (= first last) (list first) (cons first last)) - (nreverse (cons (if (= first last) first (cons first last)) - result))))))) - -(defalias 'gnus-uncompress-sequence 'gnus-uncompress-range) -(defun gnus-uncompress-range (ranges) - "Expand a list of ranges into a list of numbers. -RANGES is either a single range on the form `(num . num)' or a list of -these ranges." - (let (first last result) - (cond - ((null ranges) - nil) - ((not (listp (cdr ranges))) - (setq first (car ranges)) - (setq last (cdr ranges)) - (while (<= first last) - (setq result (cons first result)) - (setq first (1+ first))) - (nreverse result)) - (t - (while ranges - (if (atom (car ranges)) - (when (numberp (car ranges)) - (setq result (cons (car ranges) result))) - (setq first (caar ranges)) - (setq last (cdar ranges)) - (while (<= first last) - (setq result (cons first result)) - (setq first (1+ first)))) - (setq ranges (cdr ranges))) - (nreverse result))))) - -(defun gnus-add-to-range (ranges list) - "Return a list of ranges that has all articles from both RANGES and LIST. -Note: LIST has to be sorted over `<'." - (if (not ranges) - (gnus-compress-sequence list t) - (setq list (copy-sequence list)) - (unless (listp (cdr ranges)) - (setq ranges (list ranges))) - (let ((out ranges) - ilist lowest highest temp) - (while (and ranges list) - (setq ilist list) - (setq lowest (or (and (atom (car ranges)) (car ranges)) - (caar ranges))) - (while (and list (cdr list) (< (cadr list) lowest)) - (setq list (cdr list))) - (when (< (car ilist) lowest) - (setq temp list) - (setq list (cdr list)) - (setcdr temp nil) - (setq out (nconc (gnus-compress-sequence ilist t) out))) - (setq highest (or (and (atom (car ranges)) (car ranges)) - (cdar ranges))) - (while (and list (<= (car list) highest)) - (setq list (cdr list))) - (setq ranges (cdr ranges))) - (when list - (setq out (nconc (gnus-compress-sequence list t) out))) - (setq out (sort out (lambda (r1 r2) - (< (or (and (atom r1) r1) (car r1)) - (or (and (atom r2) r2) (car r2)))))) - (setq ranges out) - (while ranges - (if (atom (car ranges)) - (when (cdr ranges) - (if (atom (cadr ranges)) - (when (= (1+ (car ranges)) (cadr ranges)) - (setcar ranges (cons (car ranges) - (cadr ranges))) - (setcdr ranges (cddr ranges))) - (when (= (1+ (car ranges)) (caadr ranges)) - (setcar (cadr ranges) (car ranges)) - (setcar ranges (cadr ranges)) - (setcdr ranges (cddr ranges))))) - (when (cdr ranges) - (if (atom (cadr ranges)) - (when (= (1+ (cdar ranges)) (cadr ranges)) - (setcdr (car ranges) (cadr ranges)) - (setcdr ranges (cddr ranges))) - (when (= (1+ (cdar ranges)) (caadr ranges)) - (setcdr (car ranges) (cdadr ranges)) - (setcdr ranges (cddr ranges)))))) - (setq ranges (cdr ranges))) - out))) - -(defun gnus-remove-from-range (ranges list) - "Return a list of ranges that has all articles from LIST removed from RANGES. -Note: LIST has to be sorted over `<'." - ;; !!! This function shouldn't look like this, but I've got a headache. - (gnus-compress-sequence - (gnus-sorted-complement - (gnus-uncompress-range ranges) list))) - -(defun gnus-member-of-range (number ranges) - (if (not (listp (cdr ranges))) - (and (>= number (car ranges)) - (<= number (cdr ranges))) - (let ((not-stop t)) - (while (and ranges - (if (numberp (car ranges)) - (>= number (car ranges)) - (>= number (caar ranges))) - not-stop) - (when (if (numberp (car ranges)) - (= number (car ranges)) - (and (>= number (caar ranges)) - (<= number (cdar ranges)))) - (setq not-stop nil)) - (setq ranges (cdr ranges))) - (not not-stop)))) - -(defun gnus-range-length (range) - "Return the length RANGE would have if uncompressed." - (length (gnus-uncompress-range range))) - -(defun gnus-sublist-p (list sublist) - "Test whether all elements in SUBLIST are members of LIST." - (let ((sublistp t)) - (while sublist - (unless (memq (pop sublist) list) - (setq sublistp nil - sublist nil))) - sublistp)) - -(defun gnus-range-add (range1 range2) - "Add RANGE2 to RANGE1 destructively." - (cond - ;; If either are nil, then the job is quite easy. - ((or (null range1) (null range2)) - (or range1 range2)) - (t - ;; I don't like thinking. - (gnus-compress-sequence - (sort - (nconc - (gnus-uncompress-range range1) - (gnus-uncompress-range range2)) - '<))))) - -(provide 'gnus-range) - -;;; gnus-range.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-salt.el --- a/lisp/gnus/gnus-salt.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1017 +0,0 @@ -;;; gnus-salt.el --- alternate summary mode interfaces for Gnus -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-sum) - -;;; -;;; gnus-pick-mode -;;; - -(defvar gnus-pick-mode nil - "Minor mode for providing a pick-and-read interface in Gnus summary buffers.") - -(defcustom gnus-pick-display-summary nil - "*Display summary while reading." - :type 'boolean - :group 'gnus-summary-pick) - -(defcustom gnus-pick-mode-hook nil - "Hook run in summary pick mode buffers." - :type 'hook - :group 'gnus-summary-pick) - -(defcustom gnus-mark-unpicked-articles-as-read nil - "*If non-nil, mark all unpicked articles as read." - :type 'boolean - :group 'gnus-summary-pick) - -(defcustom gnus-pick-elegant-flow t - "If non-nil, gnus-pick-start-reading will run gnus-summary-next-group when no articles have been picked." - :type 'boolean - :group 'gnus-summary-pick) - -(defcustom gnus-summary-pick-line-format - "%-5P %U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n" - "*The format specification of the lines in pick buffers. -It accepts the same format specs that `gnus-summary-line-format' does." - :type 'string - :group 'gnus-summary-pick) - -;;; Internal variables. - -(defvar gnus-pick-mode-map nil) - -(unless gnus-pick-mode-map - (setq gnus-pick-mode-map (make-sparse-keymap)) - - (gnus-define-keys - gnus-pick-mode-map - "t" gnus-uu-mark-thread - "T" gnus-uu-unmark-thread - " " gnus-pick-next-page - "u" gnus-summary-unmark-as-processable - "U" gnus-summary-unmark-all-processable - "v" gnus-uu-mark-over - "r" gnus-uu-mark-region - "R" gnus-uu-unmark-region - "e" gnus-uu-mark-by-regexp - "E" gnus-uu-mark-by-regexp - "b" gnus-uu-mark-buffer - "B" gnus-uu-unmark-buffer - "." gnus-pick-article - gnus-down-mouse-2 gnus-pick-mouse-pick-region - ;;gnus-mouse-2 gnus-pick-mouse-pick - "X" gnus-pick-start-reading - "\r" gnus-pick-start-reading)) - -(defun gnus-pick-make-menu-bar () - (unless (boundp 'gnus-pick-menu) - (easy-menu-define - gnus-pick-menu gnus-pick-mode-map "" - '("Pick" - ("Pick" - ["Article" gnus-summary-mark-as-processable t] - ["Thread" gnus-uu-mark-thread t] - ["Region" gnus-uu-mark-region t] - ["Regexp" gnus-uu-mark-regexp t] - ["Buffer" gnus-uu-mark-buffer t]) - ("Unpick" - ["Article" gnus-summary-unmark-as-processable t] - ["Thread" gnus-uu-unmark-thread t] - ["Region" gnus-uu-unmark-region t] - ["Regexp" gnus-uu-unmark-regexp t] - ["Buffer" gnus-uu-unmark-buffer t]) - ["Start reading" gnus-pick-start-reading t] - ["Switch pick mode off" gnus-pick-mode gnus-pick-mode])))) - -(defun gnus-pick-mode (&optional arg) - "Minor mode for providing a pick-and-read interface in Gnus summary buffers. - -\\{gnus-pick-mode-map}" - (interactive "P") - (when (eq major-mode 'gnus-summary-mode) - (if (not (set (make-local-variable 'gnus-pick-mode) - (if (null arg) (not gnus-pick-mode) - (> (prefix-numeric-value arg) 0)))) - (remove-hook 'gnus-message-setup-hook 'gnus-pick-setup-message) - ;; Make sure that we don't select any articles upon group entry. - (set (make-local-variable 'gnus-auto-select-first) nil) - ;; Change line format. - (setq gnus-summary-line-format gnus-summary-pick-line-format) - (setq gnus-summary-line-format-spec nil) - (gnus-update-format-specifications nil 'summary) - (gnus-update-summary-mark-positions) - (add-hook 'gnus-message-setup-hook 'gnus-pick-setup-message) - (set (make-local-variable 'gnus-summary-goto-unread) 'never) - ;; Set up the menu. - (when (gnus-visual-p 'pick-menu 'menu) - (gnus-pick-make-menu-bar)) - (gnus-add-minor-mode 'gnus-pick-mode " Pick" gnus-pick-mode-map) - (run-hooks 'gnus-pick-mode-hook)))) - -(defun gnus-pick-setup-message () - "Make Message do the right thing on exit." - (when (and (gnus-buffer-live-p gnus-summary-buffer) - (save-excursion - (set-buffer gnus-summary-buffer) - gnus-pick-mode)) - (message-add-action - '(gnus-configure-windows 'pick t) 'send 'exit 'postpone 'kill))) - -(defvar gnus-pick-line-number 1) -(defun gnus-pick-line-number () - "Return the current line number." - (if (bobp) - (setq gnus-pick-line-number 1) - (incf gnus-pick-line-number))) - -(defun gnus-pick-start-reading (&optional catch-up) - "Start reading the picked articles. -If given a prefix, mark all unpicked articles as read." - (interactive "P") - (if gnus-newsgroup-processable - (progn - (gnus-summary-limit-to-articles nil) - (when (or catch-up gnus-mark-unpicked-articles-as-read) - (gnus-summary-limit-mark-excluded-as-read)) - (gnus-summary-first-article) - (gnus-configure-windows - (if gnus-pick-display-summary 'article 'pick) t)) - (if gnus-pick-elegant-flow - (progn - (when (or catch-up gnus-mark-unpicked-articles-as-read) - (gnus-summary-catchup nil t)) - (if (gnus-group-quit-config gnus-newsgroup-name) - (gnus-summary-exit) - (gnus-summary-next-group))) - (error "No articles have been picked")))) - -(defun gnus-pick-article (&optional arg) - "Pick the article on the current line. -If ARG, pick the article on that line instead." - (interactive "P") - (when arg - (let (pos) - (save-excursion - (goto-char (point-min)) - (when (zerop (forward-line (1- (prefix-numeric-value arg)))) - (setq pos (point)))) - (if (not pos) - (gnus-error 2 "No such line: %s" arg) - (goto-char pos)))) - (gnus-summary-mark-as-processable 1)) - -(defun gnus-pick-mouse-pick (e) - (interactive "e") - (mouse-set-point e) - (save-excursion - (gnus-summary-mark-as-processable 1))) - -(defun gnus-pick-mouse-pick-region (start-event) - "Pick articles that the mouse is dragged over. -This must be bound to a button-down mouse event." - (interactive "e") - (mouse-minibuffer-check start-event) - (let* ((echo-keystrokes 0) - (start-posn (event-start start-event)) - (start-point (posn-point start-posn)) - (start-line (1+ (count-lines 1 start-point))) - (start-window (posn-window start-posn)) - (start-frame (window-frame start-window)) - (bounds (window-edges start-window)) - (top (nth 1 bounds)) - (bottom (if (window-minibuffer-p start-window) - (nth 3 bounds) - ;; Don't count the mode line. - (1- (nth 3 bounds)))) - (click-count (1- (event-click-count start-event)))) - (setq mouse-selection-click-count click-count) - (setq mouse-selection-click-count-buffer (current-buffer)) - (mouse-set-point start-event) - ;; In case the down click is in the middle of some intangible text, - ;; use the end of that text, and put it in START-POINT. - (when (< (point) start-point) - (goto-char start-point)) - (gnus-pick-article) - (setq start-point (point)) - ;; end-of-range is used only in the single-click case. - ;; It is the place where the drag has reached so far - ;; (but not outside the window where the drag started). - (let (event end end-point last-end-point (end-of-range (point))) - (track-mouse - (while (progn - (setq event (read-event)) - (or (mouse-movement-p event) - (eq (car-safe event) 'switch-frame))) - (if (eq (car-safe event) 'switch-frame) - nil - (setq end (event-end event) - end-point (posn-point end)) - (when end-point - (setq last-end-point end-point)) - - (cond - ;; Are we moving within the original window? - ((and (eq (posn-window end) start-window) - (integer-or-marker-p end-point)) - ;; Go to START-POINT first, so that when we move to END-POINT, - ;; if it's in the middle of intangible text, - ;; point jumps in the direction away from START-POINT. - (goto-char start-point) - (goto-char end-point) - (gnus-pick-article) - ;; In case the user moved his mouse really fast, pick - ;; articles on the line between this one and the last one. - (let* ((this-line (1+ (count-lines 1 end-point))) - (min-line (min this-line start-line)) - (max-line (max this-line start-line))) - (while (< min-line max-line) - (goto-line min-line) - (gnus-pick-article) - (setq min-line (1+ min-line))) - (setq start-line this-line)) - (when (zerop (% click-count 3)) - (setq end-of-range (point)))) - (t - (let ((mouse-row (cdr (cdr (mouse-position))))) - (cond - ((null mouse-row)) - ((< mouse-row top) - (mouse-scroll-subr start-window (- mouse-row top))) - ((>= mouse-row bottom) - (mouse-scroll-subr start-window - (1+ (- mouse-row bottom))))))))))) - (when (consp event) - (let ((fun (key-binding (vector (car event))))) - ;; Run the binding of the terminating up-event, if possible. - ;; In the case of a multiple click, it gives the wrong results, - ;; because it would fail to set up a region. - (when nil - ;; (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun)) - ;; In this case, we can just let the up-event execute normally. - (let ((end (event-end event))) - ;; Set the position in the event before we replay it, - ;; because otherwise it may have a position in the wrong - ;; buffer. - (setcar (cdr end) end-of-range) - ;; Delete the overlay before calling the function, - ;; because delete-overlay increases buffer-modified-tick. - (push event unread-command-events)))))))) - -(defun gnus-pick-next-page () - "Go to the next page. If at the end of the buffer, start reading articles." - (interactive) - (let ((scroll-in-place nil)) - (condition-case nil - (scroll-up) - (end-of-buffer (gnus-pick-start-reading))))) - -;;; -;;; gnus-binary-mode -;;; - -(defvar gnus-binary-mode nil - "Minor mode for providing a binary group interface in Gnus summary buffers.") - -(defvar gnus-binary-mode-hook nil - "Hook run in summary binary mode buffers.") - -(defvar gnus-binary-mode-map nil) - -(unless gnus-binary-mode-map - (setq gnus-binary-mode-map (make-sparse-keymap)) - - (gnus-define-keys - gnus-binary-mode-map - "g" gnus-binary-show-article)) - -(defun gnus-binary-make-menu-bar () - (unless (boundp 'gnus-binary-menu) - (easy-menu-define - gnus-binary-menu gnus-binary-mode-map "" - '("Pick" - ["Switch binary mode off" gnus-binary-mode t])))) - -(defun gnus-binary-mode (&optional arg) - "Minor mode for providing a binary group interface in Gnus summary buffers." - (interactive "P") - (when (eq major-mode 'gnus-summary-mode) - (make-local-variable 'gnus-binary-mode) - (setq gnus-binary-mode - (if (null arg) (not gnus-binary-mode) - (> (prefix-numeric-value arg) 0))) - (when gnus-binary-mode - ;; Make sure that we don't select any articles upon group entry. - (make-local-variable 'gnus-auto-select-first) - (setq gnus-auto-select-first nil) - (make-local-variable 'gnus-summary-display-article-function) - (setq gnus-summary-display-article-function 'gnus-binary-display-article) - ;; Set up the menu. - (when (gnus-visual-p 'binary-menu 'menu) - (gnus-binary-make-menu-bar)) - (gnus-add-minor-mode 'gnus-binary-mode " Binary" gnus-binary-mode-map) - (run-hooks 'gnus-binary-mode-hook)))) - -(defun gnus-binary-display-article (article &optional all-header) - "Run ARTICLE through the binary decode functions." - (when (gnus-summary-goto-subject article) - (let ((gnus-view-pseudos 'automatic)) - (gnus-uu-decode-uu)))) - -(defun gnus-binary-show-article (&optional arg) - "Bypass the binary functions and show the article." - (interactive "P") - (let (gnus-summary-display-article-function) - (gnus-summary-show-article arg))) - -;;; -;;; gnus-tree-mode -;;; - -(defcustom gnus-tree-line-format "%(%[%3,3n%]%)" - "Format of tree elements." - :type 'string - :group 'gnus-summary-tree) - -(defcustom gnus-tree-minimize-window t - "If non-nil, minimize the tree buffer window. -If a number, never let the tree buffer grow taller than that number of -lines." - :type 'boolean - :group 'gnus-summary-tree) - -(defcustom gnus-selected-tree-face 'modeline - "*Face used for highlighting selected articles in the thread tree." - :type 'face - :group 'gnus-summary-tree) - -(defvar gnus-tree-brackets '((?\[ . ?\]) (?\( . ?\)) - (?\{ . ?\}) (?< . ?>)) - "Brackets used in tree nodes.") - -(defvar gnus-tree-parent-child-edges '(?- ?\\ ?|) - "Characters used to connect parents with children.") - -(defcustom gnus-tree-mode-line-format "Gnus: %%b %S %Z" - "*The format specification for the tree mode line." - :type 'string - :group 'gnus-summary-tree) - -(defcustom gnus-generate-tree-function 'gnus-generate-vertical-tree - "*Function for generating a thread tree. -Two predefined functions are available: -`gnus-generate-horizontal-tree' and `gnus-generate-vertical-tree'." - :type '(radio (function-item gnus-generate-vertical-tree) - (function-item gnus-generate-horizontal-tree) - (function :tag "Other" nil)) - :group 'gnus-summary-tree) - -(defcustom gnus-tree-mode-hook nil - "*Hook run in tree mode buffers." - :type 'hook - :group 'gnus-summary-tree) - -;;; Internal variables. - -(defvar gnus-tree-line-format-alist - `((?n gnus-tmp-name ?s) - (?f gnus-tmp-from ?s) - (?N gnus-tmp-number ?d) - (?\[ gnus-tmp-open-bracket ?c) - (?\] gnus-tmp-close-bracket ?c) - (?s gnus-tmp-subject ?s))) - -(defvar gnus-tree-mode-line-format-alist gnus-summary-mode-line-format-alist) - -(defvar gnus-tree-mode-line-format-spec nil) -(defvar gnus-tree-line-format-spec nil) - -(defvar gnus-tree-node-length nil) -(defvar gnus-selected-tree-overlay nil) - -(defvar gnus-tree-displayed-thread nil) - -(defvar gnus-tree-mode-map nil) -(put 'gnus-tree-mode 'mode-class 'special) - -(unless gnus-tree-mode-map - (setq gnus-tree-mode-map (make-keymap)) - (suppress-keymap gnus-tree-mode-map) - (gnus-define-keys - gnus-tree-mode-map - "\r" gnus-tree-select-article - gnus-mouse-2 gnus-tree-pick-article - "\C-?" gnus-tree-read-summary-keys - "h" gnus-tree-show-summary - - "\C-c\C-i" gnus-info-find-node) - - (substitute-key-definition - 'undefined 'gnus-tree-read-summary-keys gnus-tree-mode-map)) - -(defun gnus-tree-make-menu-bar () - (unless (boundp 'gnus-tree-menu) - (easy-menu-define - gnus-tree-menu gnus-tree-mode-map "" - '("Tree" - ["Select article" gnus-tree-select-article t])))) - -(defun gnus-tree-mode () - "Major mode for displaying thread trees." - (interactive) - (setq gnus-tree-mode-line-format-spec - (gnus-parse-format gnus-tree-mode-line-format - gnus-summary-mode-line-format-alist)) - (setq gnus-tree-line-format-spec - (gnus-parse-format gnus-tree-line-format - gnus-tree-line-format-alist t)) - (when (gnus-visual-p 'tree-menu 'menu) - (gnus-tree-make-menu-bar)) - (kill-all-local-variables) - (gnus-simplify-mode-line) - (setq mode-name "Tree") - (setq major-mode 'gnus-tree-mode) - (use-local-map gnus-tree-mode-map) - (buffer-disable-undo (current-buffer)) - (setq buffer-read-only t) - (setq truncate-lines t) - (save-excursion - (gnus-set-work-buffer) - (gnus-tree-node-insert (make-mail-header "") nil) - (setq gnus-tree-node-length (1- (point)))) - (run-hooks 'gnus-tree-mode-hook)) - -(defun gnus-tree-read-summary-keys (&optional arg) - "Read a summary buffer key sequence and execute it." - (interactive "P") - (let ((buf (current-buffer)) - win) - (gnus-article-read-summary-keys arg nil t) - (when (setq win (get-buffer-window buf)) - (select-window win) - (when gnus-selected-tree-overlay - (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1))) - (gnus-tree-minimize)))) - -(defun gnus-tree-show-summary () - "Reconfigure windows to show summary buffer." - (interactive) - (if (not (gnus-buffer-live-p gnus-summary-buffer)) - (error "There is no summary buffer for this tree buffer") - (gnus-configure-windows 'article) - (gnus-summary-goto-subject gnus-current-article))) - -(defun gnus-tree-select-article (article) - "Select the article under point, if any." - (interactive (list (gnus-tree-article-number))) - (let ((buf (current-buffer))) - (when article - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-summary-goto-article article)) - (select-window (get-buffer-window buf))))) - -(defun gnus-tree-pick-article (e) - "Select the article under the mouse pointer." - (interactive "e") - (mouse-set-point e) - (gnus-tree-select-article (gnus-tree-article-number))) - -(defun gnus-tree-article-number () - (get-text-property (point) 'gnus-number)) - -(defun gnus-tree-article-region (article) - "Return a cons with BEG and END of the article region." - (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article))) - (when pos - (cons pos (next-single-property-change pos 'gnus-number))))) - -(defun gnus-tree-goto-article (article) - (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article))) - (when pos - (goto-char pos)))) - -(defun gnus-tree-recenter () - "Center point in the tree window." - (let ((selected (selected-window)) - (tree-window (get-buffer-window gnus-tree-buffer t))) - (when tree-window - (select-window tree-window) - (when gnus-selected-tree-overlay - (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1))) - (let* ((top (cond ((< (window-height) 4) 0) - ((< (window-height) 7) 1) - (t 2))) - (height (1- (window-height))) - (bottom (save-excursion (goto-char (point-max)) - (forward-line (- height)) - (point)))) - ;; Set the window start to either `bottom', which is the biggest - ;; possible valid number, or the second line from the top, - ;; whichever is the least. - (set-window-start - tree-window (min bottom (save-excursion - (forward-line (- top)) (point))))) - (select-window selected)))) - -(defun gnus-get-tree-buffer () - "Return the tree buffer properly initialized." - (save-excursion - (set-buffer (get-buffer-create gnus-tree-buffer)) - (unless (eq major-mode 'gnus-tree-mode) - (gnus-add-current-to-buffer-list) - (gnus-tree-mode)) - (current-buffer))) - -(defun gnus-tree-minimize () - (when (and gnus-tree-minimize-window - (not (one-window-p))) - (let ((windows 0) - tot-win-height) - (walk-windows (lambda (window) (incf windows))) - (setq tot-win-height - (- (frame-height) - (* window-min-height (1- windows)) - 2)) - (let* ((window-min-height 2) - (height (count-lines (point-min) (point-max))) - (min (max (1- window-min-height) height)) - (tot (if (numberp gnus-tree-minimize-window) - (min gnus-tree-minimize-window min) - min)) - (win (get-buffer-window (current-buffer))) - (wh (and win (1- (window-height win))))) - (setq tot (min tot tot-win-height)) - (when (and win - (not (eq tot wh))) - (let ((selected (selected-window))) - (when (ignore-errors (select-window win)) - (enlarge-window (- tot wh)) - (select-window selected)))))))) - -;;; Generating the tree. - -(defun gnus-tree-node-insert (header sparse &optional adopted) - (let* ((dummy (stringp header)) - (header (if (vectorp header) header - (progn - (setq header (make-mail-header "*****")) - (mail-header-set-number header 0) - (mail-header-set-lines header 0) - (mail-header-set-chars header 0) - header))) - (gnus-tmp-from (mail-header-from header)) - (gnus-tmp-subject (mail-header-subject header)) - (gnus-tmp-number (mail-header-number header)) - (gnus-tmp-name - (cond - ((string-match "(.+)" gnus-tmp-from) - (substring gnus-tmp-from - (1+ (match-beginning 0)) (1- (match-end 0)))) - ((string-match "<[^>]+> *$" gnus-tmp-from) - (let ((beg (match-beginning 0))) - (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) - (substring gnus-tmp-from (1+ (match-beginning 0)) - (1- (match-end 0)))) - (substring gnus-tmp-from 0 beg)))) - ((memq gnus-tmp-number sparse) - "***") - (t gnus-tmp-from))) - (gnus-tmp-open-bracket - (cond ((memq gnus-tmp-number sparse) - (caadr gnus-tree-brackets)) - (dummy (caaddr gnus-tree-brackets)) - (adopted (car (nth 3 gnus-tree-brackets))) - (t (caar gnus-tree-brackets)))) - (gnus-tmp-close-bracket - (cond ((memq gnus-tmp-number sparse) - (cdadr gnus-tree-brackets)) - (adopted (cdr (nth 3 gnus-tree-brackets))) - (dummy - (cdaddr gnus-tree-brackets)) - (t (cdar gnus-tree-brackets)))) - (buffer-read-only nil) - beg end) - (gnus-add-text-properties - (setq beg (point)) - (setq end (progn (eval gnus-tree-line-format-spec) (point))) - (list 'gnus-number gnus-tmp-number)) - (when (or t (gnus-visual-p 'tree-highlight 'highlight)) - (gnus-tree-highlight-node gnus-tmp-number beg end)))) - -(defun gnus-tree-highlight-node (article beg end) - "Highlight current line according to `gnus-summary-highlight'." - (let ((list gnus-summary-highlight) - face) - (save-excursion - (set-buffer gnus-summary-buffer) - (let* ((score (or (cdr (assq article gnus-newsgroup-scored)) - gnus-summary-default-score 0)) - (default gnus-summary-default-score) - (mark (or (gnus-summary-article-mark article) gnus-unread-mark))) - ;; Eval the cars of the lists until we find a match. - (while (and list - (not (eval (caar list)))) - (setq list (cdr list))))) - (unless (eq (setq face (cdar list)) (get-text-property beg 'face)) - (gnus-put-text-property - beg end 'face - (if (boundp face) (symbol-value face) face))))) - -(defun gnus-tree-indent (level) - (insert (make-string (1- (* (1+ gnus-tree-node-length) level)) ? ))) - -(defvar gnus-tmp-limit) -(defvar gnus-tmp-sparse) -(defvar gnus-tmp-indent) - -(defun gnus-generate-tree (thread) - "Generate a thread tree for THREAD." - (save-excursion - (set-buffer (gnus-get-tree-buffer)) - (let ((buffer-read-only nil) - (gnus-tmp-indent 0)) - (erase-buffer) - (funcall gnus-generate-tree-function thread 0) - (gnus-set-mode-line 'tree) - (goto-char (point-min)) - (gnus-tree-minimize) - (gnus-tree-recenter) - (let ((selected (selected-window))) - (when (get-buffer-window (set-buffer gnus-tree-buffer) t) - (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t)) - (gnus-horizontal-recenter) - (select-window selected)))))) - -(defun gnus-generate-horizontal-tree (thread level &optional dummyp adopted) - "Generate a horizontal tree." - (let* ((dummy (stringp (car thread))) - (do (or dummy - (and (car thread) - (memq (mail-header-number (car thread)) - gnus-tmp-limit)))) - col beg) - (if (not do) - ;; We don't want this article. - (setq thread (cdr thread)) - (if (not (bolp)) - ;; Not the first article on the line, so we insert a "-". - (insert (car gnus-tree-parent-child-edges)) - ;; If the level isn't zero, then we insert some indentation. - (unless (zerop level) - (gnus-tree-indent level) - (insert (cadr gnus-tree-parent-child-edges)) - (setq col (- (setq beg (point)) (gnus-point-at-bol) 1)) - ;; Draw "|" lines upwards. - (while (progn - (forward-line -1) - (forward-char col) - (= (following-char) ? )) - (delete-char 1) - (insert (caddr gnus-tree-parent-child-edges))) - (goto-char beg))) - (setq dummyp nil) - ;; Insert the article node. - (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted)) - (if (null thread) - ;; End of the thread, so we go to the next line. - (unless (bolp) - (insert "\n")) - ;; Recurse downwards in all children of this article. - (while thread - (gnus-generate-horizontal-tree - (pop thread) (if do (1+ level) level) - (or dummyp dummy) dummy))))) - -(defsubst gnus-tree-indent-vertical () - (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent) - (- (point) (gnus-point-at-bol))))) - (when (> len 0) - (insert (make-string len ? ))))) - -(defsubst gnus-tree-forward-line (n) - (while (>= (decf n) 0) - (unless (zerop (forward-line 1)) - (end-of-line) - (insert "\n"))) - (end-of-line)) - -(defun gnus-generate-vertical-tree (thread level &optional dummyp adopted) - "Generate a vertical tree." - (let* ((dummy (stringp (car thread))) - (do (or dummy - (and (car thread) - (memq (mail-header-number (car thread)) - gnus-tmp-limit)))) - beg) - (if (not do) - ;; We don't want this article. - (setq thread (cdr thread)) - (if (not (save-excursion (beginning-of-line) (bobp))) - ;; Not the first article on the line, so we insert a "-". - (progn - (gnus-tree-indent-vertical) - (insert (make-string (/ gnus-tree-node-length 2) ? )) - (insert (caddr gnus-tree-parent-child-edges)) - (gnus-tree-forward-line 1)) - ;; If the level isn't zero, then we insert some indentation. - (unless (zerop gnus-tmp-indent) - (gnus-tree-forward-line (1- (* 2 level))) - (gnus-tree-indent-vertical) - (delete-char -1) - (insert (cadr gnus-tree-parent-child-edges)) - (setq beg (point)) - (forward-char -1) - ;; Draw "-" lines leftwards. - (while (= (char-after (1- (point))) ? ) - (delete-char -1) - (insert (car gnus-tree-parent-child-edges)) - (forward-char -1)) - (goto-char beg) - (gnus-tree-forward-line 1))) - (setq dummyp nil) - ;; Insert the article node. - (gnus-tree-indent-vertical) - (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted) - (gnus-tree-forward-line 1)) - (if (null thread) - ;; End of the thread, so we go to the next line. - (progn - (goto-char (point-min)) - (end-of-line) - (incf gnus-tmp-indent)) - ;; Recurse downwards in all children of this article. - (while thread - (gnus-generate-vertical-tree - (pop thread) (if do (1+ level) level) - (or dummyp dummy) dummy))))) - -;;; Interface functions. - -(defun gnus-possibly-generate-tree (article &optional force) - "Generate the thread tree for ARTICLE if it isn't displayed already." - (when (save-excursion - (set-buffer gnus-summary-buffer) - (and gnus-use-trees - gnus-show-threads - (vectorp (gnus-summary-article-header article)))) - (save-excursion - (let ((top (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-cut-thread - (gnus-remove-thread - (mail-header-id - (gnus-summary-article-header article)) - t)))) - (gnus-tmp-limit gnus-newsgroup-limit) - (gnus-tmp-sparse gnus-newsgroup-sparse)) - (when (or force - (not (eq top gnus-tree-displayed-thread))) - (gnus-generate-tree top) - (setq gnus-tree-displayed-thread top)))))) - -(defun gnus-tree-open (group) - (gnus-get-tree-buffer)) - -(defun gnus-tree-close (group) - ;(gnus-kill-buffer gnus-tree-buffer) - ) - -(defun gnus-highlight-selected-tree (article) - "Highlight the selected article in the tree." - (let ((buf (current-buffer)) - region) - (set-buffer gnus-tree-buffer) - (when (setq region (gnus-tree-article-region article)) - (when (or (not gnus-selected-tree-overlay) - (gnus-extent-detached-p gnus-selected-tree-overlay)) - ;; Create a new overlay. - (gnus-overlay-put - (setq gnus-selected-tree-overlay (gnus-make-overlay 1 2)) - 'face gnus-selected-tree-face)) - ;; Move the overlay to the article. - (gnus-move-overlay - gnus-selected-tree-overlay (goto-char (car region)) (cdr region)) - (gnus-tree-minimize) - (gnus-tree-recenter) - (let ((selected (selected-window))) - (when (get-buffer-window (set-buffer gnus-tree-buffer) t) - (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t)) - (gnus-horizontal-recenter) - (select-window selected)))) - ;; If we remove this save-excursion, it updates the wrong mode lines?!? - (save-excursion - (set-buffer gnus-tree-buffer) - (gnus-set-mode-line 'tree)) - (set-buffer buf))) - -(defun gnus-tree-highlight-article (article face) - (save-excursion - (set-buffer (gnus-get-tree-buffer)) - (let (region) - (when (setq region (gnus-tree-article-region article)) - (gnus-put-text-property (car region) (cdr region) 'face face) - (set-window-point - (get-buffer-window (current-buffer) t) (cdr region)))))) - -;;; -;;; gnus-carpal -;;; - -(defvar gnus-carpal-group-buffer-buttons - '(("next" . gnus-group-next-unread-group) - ("prev" . gnus-group-prev-unread-group) - ("read" . gnus-group-read-group) - ("select" . gnus-group-select-group) - ("catch-up" . gnus-group-catchup-current) - ("new-news" . gnus-group-get-new-news-this-group) - ("toggle-sub" . gnus-group-unsubscribe-current-group) - ("subscribe" . gnus-group-unsubscribe-group) - ("kill" . gnus-group-kill-group) - ("yank" . gnus-group-yank-group) - ("describe" . gnus-group-describe-group) - "list" - ("subscribed" . gnus-group-list-groups) - ("all" . gnus-group-list-all-groups) - ("killed" . gnus-group-list-killed) - ("zombies" . gnus-group-list-zombies) - ("matching" . gnus-group-list-matching) - ("post" . gnus-group-post-news) - ("mail" . gnus-group-mail) - ("rescan" . gnus-group-get-new-news) - ("browse-foreign" . gnus-group-browse-foreign) - ("exit" . gnus-group-exit))) - -(defvar gnus-carpal-summary-buffer-buttons - '("mark" - ("read" . gnus-summary-mark-as-read-forward) - ("tick" . gnus-summary-tick-article-forward) - ("clear" . gnus-summary-clear-mark-forward) - ("expirable" . gnus-summary-mark-as-expirable) - "move" - ("scroll" . gnus-summary-next-page) - ("next-unread" . gnus-summary-next-unread-article) - ("prev-unread" . gnus-summary-prev-unread-article) - ("first" . gnus-summary-first-unread-article) - ("best" . gnus-summary-best-unread-article) - "article" - ("headers" . gnus-summary-toggle-header) - ("uudecode" . gnus-uu-decode-uu) - ("enter-digest" . gnus-summary-enter-digest-group) - ("fetch-parent" . gnus-summary-refer-parent-article) - "mail" - ("move" . gnus-summary-move-article) - ("copy" . gnus-summary-copy-article) - ("respool" . gnus-summary-respool-article) - "threads" - ("lower" . gnus-summary-lower-thread) - ("kill" . gnus-summary-kill-thread) - "post" - ("post" . gnus-summary-post-news) - ("mail" . gnus-summary-mail) - ("followup" . gnus-summary-followup-with-original) - ("reply" . gnus-summary-reply-with-original) - ("cancel" . gnus-summary-cancel-article) - "misc" - ("exit" . gnus-summary-exit) - ("fed-up" . gnus-summary-catchup-and-goto-next-group))) - -(defvar gnus-carpal-server-buffer-buttons - '(("add" . gnus-server-add-server) - ("browse" . gnus-server-browse-server) - ("list" . gnus-server-list-servers) - ("kill" . gnus-server-kill-server) - ("yank" . gnus-server-yank-server) - ("copy" . gnus-server-copy-server) - ("exit" . gnus-server-exit))) - -(defvar gnus-carpal-browse-buffer-buttons - '(("subscribe" . gnus-browse-unsubscribe-current-group) - ("exit" . gnus-browse-exit))) - -(defvar gnus-carpal-group-buffer "*Carpal Group*") -(defvar gnus-carpal-summary-buffer "*Carpal Summary*") -(defvar gnus-carpal-server-buffer "*Carpal Server*") -(defvar gnus-carpal-browse-buffer "*Carpal Browse*") - -(defvar gnus-carpal-attached-buffer nil) - -(defvar gnus-carpal-mode-hook nil - "*Hook run in carpal mode buffers.") - -(defvar gnus-carpal-button-face 'bold - "*Face used on carpal buttons.") - -(defvar gnus-carpal-header-face 'bold-italic - "*Face used on carpal buffer headers.") - -(defvar gnus-carpal-mode-map nil) -(put 'gnus-carpal-mode 'mode-class 'special) - -(if gnus-carpal-mode-map - nil - (setq gnus-carpal-mode-map (make-keymap)) - (suppress-keymap gnus-carpal-mode-map) - (define-key gnus-carpal-mode-map " " 'gnus-carpal-select) - (define-key gnus-carpal-mode-map "\r" 'gnus-carpal-select) - (define-key gnus-carpal-mode-map gnus-mouse-2 'gnus-carpal-mouse-select)) - -(defun gnus-carpal-mode () - "Major mode for clicking buttons. - -All normal editing commands are switched off. -\\ -The following commands are available: - -\\{gnus-carpal-mode-map}" - (interactive) - (kill-all-local-variables) - (setq mode-line-modified (cdr gnus-mode-line-modified)) - (setq major-mode 'gnus-carpal-mode) - (setq mode-name "Gnus Carpal") - (setq mode-line-process nil) - (use-local-map gnus-carpal-mode-map) - (buffer-disable-undo (current-buffer)) - (setq buffer-read-only t) - (make-local-variable 'gnus-carpal-attached-buffer) - (run-hooks 'gnus-carpal-mode-hook)) - -(defun gnus-carpal-setup-buffer (type) - (let ((buffer (symbol-value (intern (format "gnus-carpal-%s-buffer" type))))) - (if (get-buffer buffer) - () - (save-excursion - (set-buffer (get-buffer-create buffer)) - (gnus-carpal-mode) - (setq gnus-carpal-attached-buffer - (intern (format "gnus-%s-buffer" type))) - (gnus-add-current-to-buffer-list) - (let ((buttons (symbol-value - (intern (format "gnus-carpal-%s-buffer-buttons" - type)))) - (buffer-read-only nil) - button) - (while buttons - (setq button (car buttons) - buttons (cdr buttons)) - (if (stringp button) - (gnus-set-text-properties - (point) - (prog2 (insert button) (point) (insert " ")) - (list 'face gnus-carpal-header-face)) - (gnus-set-text-properties - (point) - (prog2 (insert (car button)) (point) (insert " ")) - (list 'gnus-callback (cdr button) - 'face gnus-carpal-button-face - gnus-mouse-face-prop 'highlight)))) - (let ((fill-column (- (window-width) 2))) - (fill-region (point-min) (point-max))) - (set-window-point (get-buffer-window (current-buffer)) - (point-min))))))) - -(defun gnus-carpal-select () - "Select the button under point." - (interactive) - (let ((func (get-text-property (point) 'gnus-callback))) - (if (null func) - () - (pop-to-buffer (symbol-value gnus-carpal-attached-buffer)) - (call-interactively func)))) - -(defun gnus-carpal-mouse-select (event) - "Select the button under the mouse pointer." - (interactive "e") - (mouse-set-point event) - (gnus-carpal-select)) - -;;; Allow redefinition of functions. -(gnus-ems-redefine) - -(provide 'gnus-salt) - -;;; gnus-salt.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-score.el --- a/lisp/gnus/gnus-score.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2762 +0,0 @@ -1;;; gnus-score.el --- scoring code for Gnus -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Per Abrahamsen -;; Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-sum) -(require 'gnus-range) - -(defcustom gnus-global-score-files nil - "List of global score files and directories. -Set this variable if you want to use people's score files. One entry -for each score file or each score file directory. Gnus will decide -by itself what score files are applicable to which group. - -Say you want to use the single score file -\"/ftp.gnus.org@ftp:/pub/larsi/ding/score/soc.motss.SCORE\" and all -score files in the \"/ftp.some-where:/pub/score\" directory. - - (setq gnus-global-score-files - '(\"/ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE\" - \"/ftp.some-where:/pub/score\"))" - :group 'gnus-score-files - :type '(repeat file)) - -(defcustom gnus-score-file-single-match-alist nil - "Alist mapping regexps to lists of score files. -Each element of this alist should be of the form - (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... ) - -If the name of a group is matched by REGEXP, the corresponding scorefiles -will be used for that group. -The first match found is used, subsequent matching entries are ignored (to -use multiple matches, see gnus-score-file-multiple-match-alist). - -These score files are loaded in addition to any files returned by -gnus-score-find-score-files-function (which see)." - :group 'gnus-score-files - :type '(repeat (cons regexp (repeat file)))) - -(defcustom gnus-score-file-multiple-match-alist nil - "Alist mapping regexps to lists of score files. -Each element of this alist should be of the form - (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... ) - -If the name of a group is matched by REGEXP, the corresponding scorefiles -will be used for that group. -If multiple REGEXPs match a group, the score files corresponding to each -match will be used (for only one match to be used, see -gnus-score-file-single-match-alist). - -These score files are loaded in addition to any files returned by -gnus-score-find-score-files-function (which see)." - :group 'gnus-score-files - :type '(repeat (cons regexp (repeat file)))) - -(defcustom gnus-score-file-suffix "SCORE" - "Suffix of the score files." - :group 'gnus-score-files - :type 'string) - -(defcustom gnus-adaptive-file-suffix "ADAPT" - "Suffix of the adaptive score files." - :group 'gnus-score-files - :group 'gnus-score-adapt - :type 'string) - -(defcustom gnus-score-find-score-files-function 'gnus-score-find-bnews - "Function used to find score files. -The function will be called with the group name as the argument, and -should return a list of score files to apply to that group. The score -files do not actually have to exist. - -Predefined values are: - -gnus-score-find-single: Only apply the group's own score file. -gnus-score-find-hierarchical: Also apply score files from parent groups. -gnus-score-find-bnews: Apply score files whose names matches. - -See the documentation to these functions for more information. - -This variable can also be a list of functions to be called. Each -function should either return a list of score files, or a list of -score alists." - :group 'gnus-score-files - :type '(radio (function-item gnus-score-find-single) - (function-item gnus-score-find-hierarchical) - (function-item gnus-score-find-bnews) - (function :tag "Other"))) - -(defcustom gnus-score-interactive-default-score 1000 - "*Scoring commands will raise/lower the score with this number as the default." - :group 'gnus-score-default - :type 'integer) - -(defcustom gnus-score-expiry-days 7 - "*Number of days before unused score file entries are expired. -If this variable is nil, no score file entries will be expired." - :group 'gnus-score-expire - :type '(choice (const :tag "never" nil) - number)) - -(defcustom gnus-update-score-entry-dates t - "*In non-nil, update matching score entry dates. -If this variable is nil, then score entries that provide matches -will be expired along with non-matching score entries." - :group 'gnus-score-expire - :type 'boolean) - -(defcustom gnus-orphan-score nil - "*All orphans get this score added. Set in the score file." - :group 'gnus-score-default - :type 'integer) - -(defcustom gnus-decay-scores nil - "*If non-nil, decay non-permanent scores." - :group 'gnus-score-decay - :type 'boolean) - -(defcustom gnus-decay-score-function 'gnus-decay-score - "*Function called to decay a score. -It is called with one parameter -- the score to be decayed." - :group 'gnus-score-decay - :type '(radio (function-item gnus-decay-score) - (function :tag "Other"))) - -(defcustom gnus-score-decay-constant 3 - "*Decay all \"small\" scores with this amount." - :group 'gnus-score-decay - :type 'integer) - -(defcustom gnus-score-decay-scale .05 - "*Decay all \"big\" scores with this factor." - :group 'gnus-score-decay - :type 'number) - -(defcustom gnus-home-score-file nil - "Variable to control where interactive score entries are to go. -It can be: - - * A string - This file file will be used as the home score file. - - * A function - The result of this function will be used as the home score file. - The function will be passed the name of the group as its - parameter. - - * A list - The elements in this list can be: - - * `(regexp file-name ...)' - If the `regexp' matches the group name, the first `file-name' will - will be used as the home score file. (Multiple filenames are - allowed so that one may use gnus-score-file-single-match-alist to - set this variable.) - - * A function. - If the function returns non-nil, the result will be used - as the home score file. The function will be passed the - name of the group as its parameter. - - * A string. Use the string as the home score file. - - The list will be traversed from the beginning towards the end looking - for matches." - :group 'gnus-score-files - :type '(choice string - (repeat (choice string - (cons regexp (repeat file)) - function)) - function)) - -(defcustom gnus-home-adapt-file nil - "Variable to control where new adaptive score entries are to go. -This variable allows the same syntax as `gnus-home-score-file'." - :group 'gnus-score-adapt - :group 'gnus-score-files - :type '(choice string - (repeat (choice string - (cons regexp (repeat file)) - function)) - function)) - -(defcustom gnus-default-adaptive-score-alist - '((gnus-kill-file-mark) - (gnus-unread-mark) - (gnus-read-mark (from 3) (subject 30)) - (gnus-catchup-mark (subject -10)) - (gnus-killed-mark (from -1) (subject -20)) - (gnus-del-mark (from -2) (subject -15))) -"Alist of marks and scores." -:group 'gnus-score-adapt -:type '(repeat (cons (symbol :tag "Mark") - (repeat (list (choice :tag "Header" - (const from) - (const subject) - (symbol :tag "other")) - (integer :tag "Score")))))) - -(defcustom gnus-ignored-adaptive-words nil - "List of words to be ignored when doing adaptive word scoring." - :group 'gnus-score-adapt - :type '(repeat string)) - -(defcustom gnus-default-ignored-adaptive-words - '("a" "i" "the" "to" "of" "and" "in" "is" "it" "for" "that" "if" "you" - "this" "be" "on" "with" "not" "have" "are" "or" "as" "from" "can" - "but" "by" "at" "an" "will" "no" "all" "was" "do" "there" "my" "one" - "so" "we" "they" "what" "would" "any" "which" "about" "get" "your" - "use" "some" "me" "then" "name" "like" "out" "when" "up" "time" - "other" "more" "only" "just" "end" "also" "know" "how" "new" "should" - "been" "than" "them" "he" "who" "make" "may" "people" "these" "now" - "their" "here" "into" "first" "could" "way" "had" "see" "work" "well" - "were" "two" "very" "where" "while" "us" "because" "good" "same" - "even" "much" "most" "many" "such" "long" "his" "over" "last" "since" - "right" "before" "our" "without" "too" "those" "why" "must" "part" - "being" "current" "back" "still" "go" "point" "value" "each" "did" - "both" "true" "off" "say" "another" "state" "might" "under" "start" - "try" "re") - "Default list of words to be ignored when doing adaptive word scoring." - :group 'gnus-score-adapt - :type '(repeat string)) - -(defcustom gnus-default-adaptive-word-score-alist - `((,gnus-read-mark . 30) - (,gnus-catchup-mark . -10) - (,gnus-killed-mark . -20) - (,gnus-del-mark . -15)) -"Alist of marks and scores." -:group 'gnus-score-adapt -:type '(repeat (cons (character :tag "Mark") - (integer :tag "Score")))) - -(defcustom gnus-score-mimic-keymap nil - "*Have the score entry functions pretend that they are a keymap." - :group 'gnus-score-default - :type 'boolean) - -(defcustom gnus-score-exact-adapt-limit 10 - "*Number that says how long a match has to be before using substring matching. -When doing adaptive scoring, one normally uses fuzzy or substring -matching. However, if the header one matches is short, the possibility -for false positives is great, so if the length of the match is less -than this variable, exact matching will be used. - -If this variable is nil, exact matching will always be used." - :group 'gnus-score-adapt - :type '(choice (const nil) integer)) - -(defcustom gnus-score-uncacheable-files "ADAPT$" - "All score files that match this regexp will not be cached." - :group 'gnus-score-adapt - :group 'gnus-score-files - :type 'regexp) - -(defcustom gnus-score-default-header nil - "Default header when entering new scores. - -Should be one of the following symbols. - - a: from - s: subject - b: body - h: head - i: message-id - t: references - x: xref - l: lines - d: date - f: followup - -If nil, the user will be asked for a header." - :group 'gnus-score-default - :type '(choice (const :tag "from" a) - (const :tag "subject" s) - (const :tag "body" b) - (const :tag "head" h) - (const :tag "message-id" i) - (const :tag "references" t) - (const :tag "xref" x) - (const :tag "lines" l) - (const :tag "date" d) - (const :tag "followup" f))) - -(defcustom gnus-score-default-type nil - "Default match type when entering new scores. - -Should be one of the following symbols. - - s: substring - e: exact string - f: fuzzy string - r: regexp string - b: before date - a: at date - n: this date - <: less than number - >: greater than number - =: equal to number - -If nil, the user will be asked for a match type." - :group 'gnus-score-default - :type '(choice (const :tag "substring" s) - (const :tag "exact string" e) - (const :tag "fuzzy string" f) - (const :tag "regexp string" r) - (const :tag "before date" b) - (const :tag "at date" a) - (const :tag "this date" n) - (const :tag "less than number" <) - (const :tag "greater than number" >) - (const :tag "equal than number" =))) - -(defcustom gnus-score-default-fold nil - "Use case folding for new score file entries iff not nil." - :group 'gnus-score-default - :type 'boolean) - -(defcustom gnus-score-default-duration nil - "Default duration of effect when entering new scores. - -Should be one of the following symbols. - - t: temporary - p: permanent - i: immediate - -If nil, the user will be asked for a duration." - :group 'gnus-score-default - :type '(choice (const :tag "temporary" t) - (const :tag "permanent" p) - (const :tag "immediate" i) - (const :tag "ask" nil))) - -(defcustom gnus-score-after-write-file-function nil - "Function called with the name of the score file just written to disk." - :group 'gnus-score-files - :type 'function) - - - -;; Internal variables. - -(defvar gnus-adaptive-word-syntax-table - (let ((table (copy-syntax-table (standard-syntax-table))) - (numbers '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))) - (while numbers - (modify-syntax-entry (pop numbers) " " table)) - (modify-syntax-entry ?' "w" table) - table) - "Syntax table used when doing adaptive word scoring.") - -(defvar gnus-scores-exclude-files nil) -(defvar gnus-internal-global-score-files nil) -(defvar gnus-score-file-list nil) - -(defvar gnus-short-name-score-file-cache nil) - -(defvar gnus-score-help-winconf nil) -(defvar gnus-adaptive-score-alist gnus-default-adaptive-score-alist) -(defvar gnus-adaptive-word-score-alist gnus-default-adaptive-word-score-alist) -(defvar gnus-score-trace nil) -(defvar gnus-score-edit-buffer nil) - -(defvar gnus-score-alist nil - "Alist containing score information. -The keys can be symbols or strings. The following symbols are defined. - -touched: If this alist has been modified. -mark: Automatically mark articles below this. -expunge: Automatically expunge articles below this. -files: List of other score files to load when loading this one. -eval: Sexp to be evaluated when the score file is loaded. - -String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...) -where HEADER is the header being scored, MATCH is the string we are -looking for, TYPE is a flag indicating whether it should use regexp or -substring matching, SCORE is the score to add and DATE is the date -of the last successful match.") - -(defvar gnus-score-cache nil) -(defvar gnus-scores-articles nil) -(defvar gnus-score-index nil) - - -(defconst gnus-header-index - ;; Name to index alist. - '(("number" 0 gnus-score-integer) - ("subject" 1 gnus-score-string) - ("from" 2 gnus-score-string) - ("date" 3 gnus-score-date) - ("message-id" 4 gnus-score-string) - ("references" 5 gnus-score-string) - ("chars" 6 gnus-score-integer) - ("lines" 7 gnus-score-integer) - ("xref" 8 gnus-score-string) - ("head" -1 gnus-score-body) - ("body" -1 gnus-score-body) - ("all" -1 gnus-score-body) - ("followup" 2 gnus-score-followup) - ("thread" 5 gnus-score-thread))) - -;;; Summary mode score maps. - -(gnus-define-keys (gnus-summary-score-map "V" gnus-summary-mode-map) - "s" gnus-summary-set-score - "a" gnus-summary-score-entry - "S" gnus-summary-current-score - "c" gnus-score-change-score-file - "C" gnus-score-customize - "m" gnus-score-set-mark-below - "x" gnus-score-set-expunge-below - "R" gnus-summary-rescore - "e" gnus-score-edit-current-scores - "f" gnus-score-edit-file - "F" gnus-score-flush-cache - "t" gnus-score-find-trace - "w" gnus-score-find-favourite-words) - -;; Summary score file commands - -;; Much modification of the kill (ahem, score) code and lots of the -;; functions are written by Per Abrahamsen . - -(defun gnus-summary-lower-score (&optional score) - "Make a score entry based on the current article. -The user will be prompted for header to score on, match type, -permanence, and the string to be used. The numerical prefix will be -used as score." - (interactive "P") - (gnus-summary-increase-score (- (gnus-score-default score)))) - -(defun gnus-score-kill-help-buffer () - (when (get-buffer "*Score Help*") - (kill-buffer "*Score Help*") - (when gnus-score-help-winconf - (set-window-configuration gnus-score-help-winconf)))) - -(defun gnus-summary-increase-score (&optional score) - "Make a score entry based on the current article. -The user will be prompted for header to score on, match type, -permanence, and the string to be used. The numerical prefix will be -used as score." - (interactive "P") - (gnus-set-global-variables) - (let* ((nscore (gnus-score-default score)) - (prefix (if (< nscore 0) ?L ?I)) - (increase (> nscore 0)) - (char-to-header - '((?a "from" nil nil string) - (?s "subject" nil nil string) - (?b "body" "" nil body-string) - (?h "head" "" nil body-string) - (?i "message-id" nil t string) - (?t "references" "message-id" nil string) - (?x "xref" nil nil string) - (?l "lines" nil nil number) - (?d "date" nil nil date) - (?f "followup" nil nil string) - (?T "thread" nil nil string))) - (char-to-type - '((?s s "substring" string) - (?e e "exact string" string) - (?f f "fuzzy string" string) - (?r r "regexp string" string) - (?z s "substring" body-string) - (?p r "regexp string" body-string) - (?b before "before date" date) - (?a at "at date" date) - (?n now "this date" date) - (?< < "less than number" number) - (?> > "greater than number" number) - (?= = "equal to number" number))) - (char-to-perm - (list (list ?t (current-time-string) "temporary") - '(?p perm "permanent") '(?i now "immediate"))) - (mimic gnus-score-mimic-keymap) - (hchar (and gnus-score-default-header - (aref (symbol-name gnus-score-default-header) 0))) - (tchar (and gnus-score-default-type - (aref (symbol-name gnus-score-default-type) 0))) - (pchar (and gnus-score-default-duration - (aref (symbol-name gnus-score-default-duration) 0))) - entry temporary type match) - - (unwind-protect - (progn - - ;; First we read the header to score. - (while (not hchar) - (if mimic - (progn - (sit-for 1) - (message "%c-" prefix)) - (message "%s header (%s?): " (if increase "Increase" "Lower") - (mapconcat (lambda (s) (char-to-string (car s))) - char-to-header ""))) - (setq hchar (read-char)) - (when (or (= hchar ??) (= hchar ?\C-h)) - (setq hchar nil) - (gnus-score-insert-help "Match on header" char-to-header 1))) - - (gnus-score-kill-help-buffer) - (unless (setq entry (assq (downcase hchar) char-to-header)) - (if mimic (error "%c %c" prefix hchar) - (error "Illegal header type"))) - - (when (/= (downcase hchar) hchar) - ;; This was a majuscule, so we end reading and set the defaults. - (if mimic (message "%c %c" prefix hchar) (message "")) - (setq tchar (or tchar ?s) - pchar (or pchar ?t))) - - (let ((legal-types - (delq nil - (mapcar (lambda (s) - (if (eq (nth 4 entry) - (nth 3 s)) - s nil)) - char-to-type)))) - ;; We continue reading - the type. - (while (not tchar) - (if mimic - (progn - (sit-for 1) (message "%c %c-" prefix hchar)) - (message "%s header '%s' with match type (%s?): " - (if increase "Increase" "Lower") - (nth 1 entry) - (mapconcat (lambda (s) (char-to-string (car s))) - legal-types ""))) - (setq tchar (read-char)) - (when (or (= tchar ??) (= tchar ?\C-h)) - (setq tchar nil) - (gnus-score-insert-help "Match type" legal-types 2))) - - (gnus-score-kill-help-buffer) - (unless (setq type (nth 1 (assq (downcase tchar) legal-types))) - (if mimic (error "%c %c" prefix hchar) - (error "Illegal match type")))) - - (when (/= (downcase tchar) tchar) - ;; It was a majuscule, so we end reading and use the default. - (if mimic (message "%c %c %c" prefix hchar tchar) - (message "")) - (setq pchar (or pchar ?p))) - - ;; We continue reading. - (while (not pchar) - (if mimic - (progn - (sit-for 1) (message "%c %c %c-" prefix hchar tchar)) - (message "%s permanence (%s?): " (if increase "Increase" "Lower") - (mapconcat (lambda (s) (char-to-string (car s))) - char-to-perm ""))) - (setq pchar (read-char)) - (when (or (= pchar ??) (= pchar ?\C-h)) - (setq pchar nil) - (gnus-score-insert-help "Match permanence" char-to-perm 2))) - - (gnus-score-kill-help-buffer) - (if mimic (message "%c %c %c" prefix hchar tchar pchar) - (message "")) - (unless (setq temporary (cadr (assq pchar char-to-perm))) - ;; Deal with der(r)ided superannuated paradigms. - (when (and (eq (1+ prefix) 77) - (eq (+ hchar 12) 109) - (eq tchar 114) - (eq (- pchar 4) 111)) - (error "You rang?")) - (if mimic - (error "%c %c %c %c" prefix hchar tchar pchar) - (error "Illegal match duration")))) - ;; Always kill the score help buffer. - (gnus-score-kill-help-buffer)) - - ;; We have all the data, so we enter this score. - (setq match (if (string= (nth 2 entry) "") "" - (gnus-summary-header (or (nth 2 entry) (nth 1 entry))))) - - ;; Modify the match, perhaps. - (cond - ((equal (nth 1 entry) "xref") - (when (string-match "^Xref: *" match) - (setq match (substring match (match-end 0)))) - (when (string-match "^[^:]* +" match) - (setq match (substring match (match-end 0)))))) - - (when (memq type '(r R regexp Regexp)) - (setq match (regexp-quote match))) - - (gnus-summary-score-entry - (nth 1 entry) ; Header - match ; Match - type ; Type - (if (eq score 's) nil score) ; Score - (if (eq temporary 'perm) ; Temp - nil - temporary) - (not (nth 3 entry))) ; Prompt - )) - -(defun gnus-score-insert-help (string alist idx) - (setq gnus-score-help-winconf (current-window-configuration)) - (save-excursion - (set-buffer (get-buffer-create "*Score Help*")) - (buffer-disable-undo (current-buffer)) - (delete-windows-on (current-buffer)) - (erase-buffer) - (insert string ":\n\n") - (let ((max -1) - (list alist) - (i 0) - n width pad format) - ;; find the longest string to display - (while list - (setq n (length (nth idx (car list)))) - (unless (> max n) - (setq max n)) - (setq list (cdr list))) - (setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end - (setq n (/ (1- (window-width)) max)) ; items per line - (setq width (/ (1- (window-width)) n)) ; width of each item - ;; insert `n' items, each in a field of width `width' - (while alist - (if (< i n) - () - (setq i 0) - (delete-char -1) ; the `\n' takes a char - (insert "\n")) - (setq pad (- width 3)) - (setq format (concat "%c: %-" (int-to-string pad) "s")) - (insert (format format (caar alist) (nth idx (car alist)))) - (setq alist (cdr alist)) - (setq i (1+ i)))) - ;; display ourselves in a small window at the bottom - (gnus-appt-select-lowest-window) - (split-window) - (pop-to-buffer "*Score Help*") - (let ((window-min-height 1)) - (shrink-window-if-larger-than-buffer)) - (select-window (get-buffer-window gnus-summary-buffer)))) - -(defun gnus-summary-header (header &optional no-err) - ;; Return HEADER for current articles, or error. - (let ((article (gnus-summary-article-number)) - headers) - (if article - (if (and (setq headers (gnus-summary-article-header article)) - (vectorp headers)) - (aref headers (nth 1 (assoc header gnus-header-index))) - (if no-err - nil - (error "Pseudo-articles can't be scored"))) - (if no-err - (error "No article on current line") - nil)))) - -(defun gnus-newsgroup-score-alist () - (or - (let ((param-file (gnus-group-find-parameter - gnus-newsgroup-name 'score-file))) - (when param-file - (gnus-score-load param-file))) - (gnus-score-load - (gnus-score-file-name gnus-newsgroup-name))) - gnus-score-alist) - -(defsubst gnus-score-get (symbol &optional alist) - ;; Get SYMBOL's definition in ALIST. - (cdr (assoc symbol - (or alist - gnus-score-alist - (gnus-newsgroup-score-alist))))) - -(defun gnus-summary-score-entry (header match type score date - &optional prompt silent) - "Enter score file entry. -HEADER is the header being scored. -MATCH is the string we are looking for. -TYPE is the match type: substring, regexp, exact, fuzzy. -SCORE is the score to add. -DATE is the expire date, or nil for no expire, or 'now for immediate expire. -If optional argument `PROMPT' is non-nil, allow user to edit match. -If optional argument `SILENT' is nil, show effect of score entry." - (interactive - (list (completing-read "Header: " - gnus-header-index - (lambda (x) (fboundp (nth 2 x))) - t) - (read-string "Match: ") - (if (y-or-n-p "Use regexp match? ") 'r 's) - (and current-prefix-arg - (prefix-numeric-value current-prefix-arg)) - (cond ((not (y-or-n-p "Add to score file? ")) - 'now) - ((y-or-n-p "Expire kill? ") - (current-time-string)) - (t nil)))) - ;; Regexp is the default type. - (when (eq type t) - (setq type 'r)) - ;; Simplify matches... - (cond ((or (eq type 'r) (eq type 's) (eq type nil)) - (setq match (if match (gnus-simplify-subject-re match) ""))) - ((eq type 'f) - (setq match (gnus-simplify-subject-fuzzy match)))) - (let ((score (gnus-score-default score)) - (header (format "%s" (downcase header))) - new) - (when prompt - (setq match (read-string - (format "Match %s on %s, %s: " - (cond ((eq date 'now) - "now") - ((stringp date) - "temp") - (t "permanent")) - header - (if (< score 0) "lower" "raise")) - (if (numberp match) - (int-to-string match) - match)))) - - ;; Get rid of string props. - (setq match (format "%s" match)) - - ;; If this is an integer comparison, we transform from string to int. - (when (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer) - (setq match (string-to-int match))) - - (unless (eq date 'now) - ;; Add the score entry to the score file. - (when (= score gnus-score-interactive-default-score) - (setq score nil)) - (let ((old (gnus-score-get header)) - elem) - (setq new - (cond - (type - (list match score - (and date (if (numberp date) date - (gnus-day-number date))) - type)) - (date (list match score (gnus-day-number date))) - (score (list match score)) - (t (list match)))) - ;; We see whether we can collapse some score entries. - ;; This isn't quite correct, because there may be more elements - ;; later on with the same key that have matching elems... Hm. - (if (and old - (setq elem (assoc match old)) - (eq (nth 3 elem) (nth 3 new)) - (or (and (numberp (nth 2 elem)) (numberp (nth 2 new))) - (and (not (nth 2 elem)) (not (nth 2 new))))) - ;; Yup, we just add this new score to the old elem. - (setcar (cdr elem) (+ (or (nth 1 elem) - gnus-score-interactive-default-score) - (or (nth 1 new) - gnus-score-interactive-default-score))) - ;; Nope, we have to add a new elem. - (gnus-score-set header (if old (cons new old) (list new)))) - (gnus-score-set 'touched '(t)))) - - ;; Score the current buffer. - (unless silent - (if (and (>= (nth 1 (assoc header gnus-header-index)) 0) - (eq (nth 2 (assoc header gnus-header-index)) - 'gnus-score-string)) - (gnus-summary-score-effect header match type score) - (gnus-summary-rescore))) - - ;; Return the new scoring rule. - new)) - -(defun gnus-summary-score-effect (header match type score) - "Simulate the effect of a score file entry. -HEADER is the header being scored. -MATCH is the string we are looking for. -TYPE is the score type. -SCORE is the score to add." - (interactive (list (completing-read "Header: " - gnus-header-index - (lambda (x) (fboundp (nth 2 x))) - t) - (read-string "Match: ") - (y-or-n-p "Use regexp match? ") - (prefix-numeric-value current-prefix-arg))) - (save-excursion - (unless (and (stringp match) (> (length match) 0)) - (error "No match")) - (goto-char (point-min)) - (let ((regexp (cond ((eq type 'f) - (gnus-simplify-subject-fuzzy match)) - ((eq type 'r) - match) - ((eq type 'e) - (concat "\\`" (regexp-quote match) "\\'")) - (t - (regexp-quote match))))) - (while (not (eobp)) - (let ((content (gnus-summary-header header 'noerr)) - (case-fold-search t)) - (and content - (when (if (eq type 'f) - (string-equal (gnus-simplify-subject-fuzzy content) - regexp) - (string-match regexp content)) - (gnus-summary-raise-score score)))) - (beginning-of-line 2)))) - (gnus-set-mode-line 'summary)) - -(defun gnus-summary-score-crossposting (score date) - ;; Enter score file entry for current crossposting. - ;; SCORE is the score to add. - ;; DATE is the expire date. - (let ((xref (gnus-summary-header "xref")) - (start 0) - group) - (unless xref - (error "This article is not crossposted")) - (while (string-match " \\([^ \t]+\\):" xref start) - (setq start (match-end 0)) - (when (not (string= - (setq group - (substring xref (match-beginning 1) (match-end 1))) - gnus-newsgroup-name)) - (gnus-summary-score-entry - "xref" (concat " " group ":") nil score date t))))) - - -;;; -;;; Gnus Score Files -;;; - -;; All score code written by Per Abrahamsen . - -;; Added by Per Abrahamsen . -(defun gnus-score-set-mark-below (score) - "Automatically mark articles with score below SCORE as read." - (interactive - (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) - (string-to-int (read-string "Mark below: "))))) - (setq score (or score gnus-summary-default-score 0)) - (gnus-score-set 'mark (list score)) - (gnus-score-set 'touched '(t)) - (setq gnus-summary-mark-below score) - (gnus-score-update-lines)) - -(defun gnus-score-update-lines () - "Update all lines in the summary buffer." - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (gnus-summary-update-line) - (forward-line 1)))) - -(defun gnus-score-update-all-lines () - "Update all lines in the summary buffer, even the hidden ones." - (save-excursion - (goto-char (point-min)) - (let (hidden) - (while (not (eobp)) - (when (gnus-summary-show-thread) - (push (point) hidden)) - (gnus-summary-update-line) - (forward-line 1)) - ;; Re-hide the hidden threads. - (while hidden - (goto-char (pop hidden)) - (gnus-summary-hide-thread))))) - -(defun gnus-score-set-expunge-below (score) - "Automatically expunge articles with score below SCORE." - (interactive - (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg)) - (string-to-int (read-string "Set expunge below: "))))) - (setq score (or score gnus-summary-default-score 0)) - (gnus-score-set 'expunge (list score)) - (gnus-score-set 'touched '(t))) - -(defun gnus-score-followup-article (&optional score) - "Add SCORE to all followups to the article in the current buffer." - (interactive "P") - (setq score (gnus-score-default score)) - (when (gnus-buffer-live-p gnus-summary-buffer) - (save-excursion - (save-restriction - (message-narrow-to-headers) - (let ((id (mail-fetch-field "message-id"))) - (when id - (set-buffer gnus-summary-buffer) - (gnus-summary-score-entry - "references" (concat id "[ \t]*$") 'r - score (current-time-string) nil t))))))) - -(defun gnus-score-followup-thread (&optional score) - "Add SCORE to all later articles in the thread the current buffer is part of." - (interactive "P") - (setq score (gnus-score-default score)) - (when (gnus-buffer-live-p gnus-summary-buffer) - (save-excursion - (save-restriction - (goto-char (point-min)) - (let ((id (mail-fetch-field "message-id"))) - (when id - (set-buffer gnus-summary-buffer) - (gnus-summary-score-entry - "references" id 's - score (current-time-string)))))))) - -(defun gnus-score-set (symbol value &optional alist) - ;; Set SYMBOL to VALUE in ALIST. - (let* ((alist - (or alist - gnus-score-alist - (gnus-newsgroup-score-alist))) - (entry (assoc symbol alist))) - (cond ((gnus-score-get 'read-only alist) - ;; This is a read-only score file, so we do nothing. - ) - (entry - (setcdr entry value)) - ((null alist) - (error "Empty alist")) - (t - (setcdr alist - (cons (cons symbol value) (cdr alist))))))) - -(defun gnus-summary-raise-score (n) - "Raise the score of the current article by N." - (interactive "p") - (gnus-set-global-variables) - (gnus-summary-set-score (+ (gnus-summary-article-score) - (or n gnus-score-interactive-default-score )))) - -(defun gnus-summary-set-score (n) - "Set the score of the current article to N." - (interactive "p") - (gnus-set-global-variables) - (save-excursion - (gnus-summary-show-thread) - (let ((buffer-read-only nil)) - ;; Set score. - (gnus-summary-update-mark - (if (= n (or gnus-summary-default-score 0)) ? - (if (< n (or gnus-summary-default-score 0)) - gnus-score-below-mark gnus-score-over-mark)) - 'score)) - (let* ((article (gnus-summary-article-number)) - (score (assq article gnus-newsgroup-scored))) - (if score (setcdr score n) - (push (cons article n) gnus-newsgroup-scored))) - (gnus-summary-update-line))) - -(defun gnus-summary-current-score () - "Return the score of the current article." - (interactive) - (gnus-set-global-variables) - (gnus-message 1 "%s" (gnus-summary-article-score))) - -(defun gnus-score-change-score-file (file) - "Change current score alist." - (interactive - (list (read-file-name "Change to score file: " gnus-kill-files-directory))) - (gnus-score-load-file file) - (gnus-set-mode-line 'summary)) - -(defvar gnus-score-edit-exit-function) -(defun gnus-score-edit-current-scores (file) - "Edit the current score alist." - (interactive (list gnus-current-score-file)) - (gnus-set-global-variables) - (let ((winconf (current-window-configuration))) - (when (buffer-name gnus-summary-buffer) - (gnus-score-save)) - (gnus-make-directory (file-name-directory file)) - (setq gnus-score-edit-buffer (find-file-noselect file)) - (gnus-configure-windows 'edit-score) - (gnus-score-mode) - (setq gnus-score-edit-exit-function 'gnus-score-edit-done) - (make-local-variable 'gnus-prev-winconf) - (setq gnus-prev-winconf winconf)) - (gnus-message - 4 (substitute-command-keys - "\\\\[gnus-score-edit-exit] to save edits"))) - -(defun gnus-score-edit-file (file) - "Edit a score file." - (interactive - (list (read-file-name "Edit score file: " gnus-kill-files-directory))) - (gnus-make-directory (file-name-directory file)) - (when (buffer-name gnus-summary-buffer) - (gnus-score-save)) - (let ((winconf (current-window-configuration))) - (setq gnus-score-edit-buffer (find-file-noselect file)) - (gnus-configure-windows 'edit-score) - (gnus-score-mode) - (setq gnus-score-edit-exit-function 'gnus-score-edit-done) - (make-local-variable 'gnus-prev-winconf) - (setq gnus-prev-winconf winconf)) - (gnus-message - 4 (substitute-command-keys - "\\\\[gnus-score-edit-exit] to save edits"))) - -(defun gnus-score-load-file (file) - ;; Load score file FILE. Returns a list a retrieved score-alists. - (let* ((file (expand-file-name - (or (and (string-match - (concat "^" (expand-file-name - gnus-kill-files-directory)) - (expand-file-name file)) - file) - (concat (file-name-as-directory gnus-kill-files-directory) - file)))) - (cached (assoc file gnus-score-cache)) - (global (member file gnus-internal-global-score-files)) - lists alist) - (if cached - ;; The score file was already loaded. - (setq alist (cdr cached)) - ;; We load the score file. - (setq gnus-score-alist nil) - (setq alist (gnus-score-load-score-alist file)) - ;; We add '(touched) to the alist to signify that it hasn't been - ;; touched (yet). - (unless (assq 'touched alist) - (push (list 'touched nil) alist)) - ;; If it is a global score file, we make it read-only. - (and global - (not (assq 'read-only alist)) - (push (list 'read-only t) alist)) - (push (cons file alist) gnus-score-cache)) - (let ((a alist) - found) - (while a - ;; Downcase all header names. - (when (stringp (caar a)) - (setcar (car a) (downcase (caar a))) - (setq found t)) - (pop a)) - ;; If there are actual scores in the alist, we add it to the - ;; return value of this function. - (when found - (setq lists (list alist)))) - ;; Treat the other possible atoms in the score alist. - (let ((mark (car (gnus-score-get 'mark alist))) - (expunge (car (gnus-score-get 'expunge alist))) - (mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist))) - (files (gnus-score-get 'files alist)) - (exclude-files (gnus-score-get 'exclude-files alist)) - (orphan (car (gnus-score-get 'orphan alist))) - (adapt (gnus-score-get 'adapt alist)) - (thread-mark-and-expunge - (car (gnus-score-get 'thread-mark-and-expunge alist))) - (adapt-file (car (gnus-score-get 'adapt-file alist))) - (local (gnus-score-get 'local alist)) - (decay (car (gnus-score-get 'decay alist))) - (eval (car (gnus-score-get 'eval alist)))) - ;; Perform possible decays. - (when gnus-decay-scores - (when (or (not decay) - (gnus-decay-scores alist (gnus-time-to-day (current-time)))) - (gnus-score-set 'touched '(t) alist) - (gnus-score-set 'decay (list (gnus-time-to-day (current-time)))))) - ;; We do not respect eval and files atoms from global score - ;; files. - (and files (not global) - (setq lists (apply 'append lists - (mapcar (lambda (file) - (gnus-score-load-file file)) - (if adapt-file (cons adapt-file files) - files))))) - (and eval (not global) (eval eval)) - ;; We then expand any exclude-file directives. - (setq gnus-scores-exclude-files - (nconc - (mapcar - (lambda (sfile) - (expand-file-name sfile (file-name-directory file))) - exclude-files) - gnus-scores-exclude-files)) - (if (not local) - () - (save-excursion - (set-buffer gnus-summary-buffer) - (while local - (and (consp (car local)) - (symbolp (caar local)) - (progn - (make-local-variable (caar local)) - (set (caar local) (nth 1 (car local))))) - (setq local (cdr local))))) - (when orphan - (setq gnus-orphan-score orphan)) - (setq gnus-adaptive-score-alist - (cond ((equal adapt '(t)) - (setq gnus-newsgroup-adaptive t) - gnus-default-adaptive-score-alist) - ((equal adapt '(ignore)) - (setq gnus-newsgroup-adaptive nil)) - ((consp adapt) - (setq gnus-newsgroup-adaptive t) - adapt) - (t - ;;(setq gnus-newsgroup-adaptive gnus-use-adaptive-scoring) - gnus-default-adaptive-score-alist))) - (setq gnus-thread-expunge-below - (or thread-mark-and-expunge gnus-thread-expunge-below)) - (setq gnus-summary-mark-below - (or mark mark-and-expunge gnus-summary-mark-below)) - (setq gnus-summary-expunge-below - (or expunge mark-and-expunge gnus-summary-expunge-below)) - (setq gnus-newsgroup-adaptive-score-file - (or adapt-file gnus-newsgroup-adaptive-score-file))) - (setq gnus-current-score-file file) - (setq gnus-score-alist alist) - lists)) - -(defun gnus-score-load (file) - ;; Load score FILE. - (let ((cache (assoc file gnus-score-cache))) - (if cache - (setq gnus-score-alist (cdr cache)) - (setq gnus-score-alist nil) - (gnus-score-load-score-alist file) - (unless gnus-score-alist - (setq gnus-score-alist (copy-alist '((touched nil))))) - (push (cons file gnus-score-alist) gnus-score-cache)))) - -(defun gnus-score-remove-from-cache (file) - (setq gnus-score-cache - (delq (assoc file gnus-score-cache) gnus-score-cache))) - -(defun gnus-score-load-score-alist (file) - "Read score FILE." - (let (alist) - (if (not (file-readable-p file)) - ;; Couldn't read file. - (setq gnus-score-alist nil) - ;; Read file. - (save-excursion - (gnus-set-work-buffer) - (insert-file-contents file) - (goto-char (point-min)) - ;; Only do the loading if the score file isn't empty. - (when (save-excursion (re-search-forward "[()0-9a-zA-Z]" nil t)) - (setq alist - (condition-case () - (read (current-buffer)) - (error - (gnus-error 3.2 "Problem with score file %s" file)))))) - (if (eq (car alist) 'setq) - ;; This is an old-style score file. - (setq gnus-score-alist (gnus-score-transform-old-to-new alist)) - (setq gnus-score-alist alist)) - ;; Check the syntax of the score file. - (setq gnus-score-alist - (gnus-score-check-syntax gnus-score-alist file))))) - -(defun gnus-score-check-syntax (alist file) - "Check the syntax of the score ALIST." - (cond - ((null alist) - nil) - ((not (consp alist)) - (gnus-message 1 "Score file is not a list: %s" file) - (ding) - nil) - (t - (let ((a alist) - sr err s type) - (while (and a (not err)) - (setq - err - (cond - ((not (listp (car a))) - (format "Illegal score element %s in %s" (car a) file)) - ((stringp (caar a)) - (cond - ((not (listp (setq sr (cdar a)))) - (format "Illegal header match %s in %s" (nth 1 (car a)) file)) - (t - (setq type (caar a)) - (while (and sr (not err)) - (setq s (pop sr)) - (setq - err - (cond - ((if (member (downcase type) '("lines" "chars")) - (not (numberp (car s))) - (not (stringp (car s)))) - (format "Illegal match %s in %s" (car s) file)) - ((and (cadr s) (not (integerp (cadr s)))) - (format "Non-integer score %s in %s" (cadr s) file)) - ((and (caddr s) (not (integerp (caddr s)))) - (format "Non-integer date %s in %s" (caddr s) file)) - ((and (cadddr s) (not (symbolp (cadddr s)))) - (format "Non-symbol match type %s in %s" (cadddr s) file))))) - err))))) - (setq a (cdr a))) - (if err - (progn - (ding) - (gnus-message 3 err) - (sit-for 2) - nil) - alist))))) - -(defun gnus-score-transform-old-to-new (alist) - (let* ((alist (nth 2 alist)) - out entry) - (when (eq (car alist) 'quote) - (setq alist (nth 1 alist))) - (while alist - (setq entry (car alist)) - (if (stringp (car entry)) - (let ((scor (cdr entry))) - (push entry out) - (while scor - (setcar scor - (list (caar scor) (nth 2 (car scor)) - (and (nth 3 (car scor)) - (gnus-day-number (nth 3 (car scor)))) - (if (nth 1 (car scor)) 'r 's))) - (setq scor (cdr scor)))) - (push (if (not (listp (cdr entry))) - (list (car entry) (cdr entry)) - entry) - out)) - (setq alist (cdr alist))) - (cons (list 'touched t) (nreverse out)))) - -(defun gnus-score-save () - ;; Save all score information. - (let ((cache gnus-score-cache) - entry score file) - (save-excursion - (setq gnus-score-alist nil) - (nnheader-set-temp-buffer " *Gnus Scores*") - (while cache - (current-buffer) - (setq entry (pop cache) - file (car entry) - score (cdr entry)) - (if (or (not (equal (gnus-score-get 'touched score) '(t))) - (gnus-score-get 'read-only score) - (and (file-exists-p file) - (not (file-writable-p file)))) - () - (setq score (setcdr entry (delq (assq 'touched score) score))) - (erase-buffer) - (let (emacs-lisp-mode-hook) - (if (string-match - (concat (regexp-quote gnus-adaptive-file-suffix) "$") - file) - ;; This is an adaptive score file, so we do not run - ;; it through `pp'. These files can get huge, and - ;; are not meant to be edited by human hands. - (gnus-prin1 score) - ;; This is a normal score file, so we print it very - ;; prettily. - (pp score (current-buffer)))) - (gnus-make-directory (file-name-directory file)) - ;; If the score file is empty, we delete it. - (if (zerop (buffer-size)) - (delete-file file) - ;; There are scores, so we write the file. - (when (file-writable-p file) - (gnus-write-buffer file) - (when gnus-score-after-write-file-function - (funcall gnus-score-after-write-file-function file))))) - (and gnus-score-uncacheable-files - (string-match gnus-score-uncacheable-files file) - (gnus-score-remove-from-cache file))) - (kill-buffer (current-buffer))))) - -(defun gnus-score-load-files (score-files) - "Load all score files in SCORE-FILES." - ;; Load the score files. - (let (scores) - (while score-files - (if (stringp (car score-files)) - ;; It is a string, which means that it's a score file name, - ;; so we load the score file and add the score alist to - ;; the list of alists. - (setq scores (nconc (gnus-score-load-file (car score-files)) scores)) - ;; It is an alist, so we just add it to the list directly. - (setq scores (nconc (car score-files) scores))) - (setq score-files (cdr score-files))) - ;; Prune the score files that are to be excluded, if any. - (when gnus-scores-exclude-files - (let ((s scores) - c) - (while s - (and (setq c (rassq (car s) gnus-score-cache)) - (member (car c) gnus-scores-exclude-files) - (setq scores (delq (car s) scores))) - (setq s (cdr s))))) - scores)) - -(defun gnus-score-headers (score-files &optional trace) - ;; Score `gnus-newsgroup-headers'. - (let (scores news) - ;; PLM: probably this is not the best place to clear orphan-score - (setq gnus-orphan-score nil - gnus-scores-articles nil - gnus-scores-exclude-files nil - scores (gnus-score-load-files score-files)) - (setq news scores) - ;; Do the scoring. - (while news - (setq scores news - news nil) - (when (and gnus-summary-default-score - scores) - (let* ((entries gnus-header-index) - (now (gnus-day-number (current-time-string))) - (expire (and gnus-score-expiry-days - (- now gnus-score-expiry-days))) - (headers gnus-newsgroup-headers) - (current-score-file gnus-current-score-file) - entry header new) - (gnus-message 5 "Scoring...") - ;; Create articles, an alist of the form `(HEADER . SCORE)'. - (while (setq header (pop headers)) - ;; WARNING: The assq makes the function O(N*S) while it could - ;; be written as O(N+S), where N is (length gnus-newsgroup-headers) - ;; and S is (length gnus-newsgroup-scored). - (unless (assq (mail-header-number header) gnus-newsgroup-scored) - (setq gnus-scores-articles ;Total of 2 * N cons-cells used. - (cons (cons header (or gnus-summary-default-score 0)) - gnus-scores-articles)))) - - (save-excursion - (set-buffer (get-buffer-create "*Headers*")) - (buffer-disable-undo (current-buffer)) - (message-clone-locals gnus-summary-buffer) - - ;; Set the global variant of this variable. - (setq gnus-current-score-file current-score-file) - ;; score orphans - (when gnus-orphan-score - (setq gnus-score-index - (nth 1 (assoc "references" gnus-header-index))) - (gnus-score-orphans gnus-orphan-score)) - ;; Run each header through the score process. - (while entries - (setq entry (pop entries) - header (nth 0 entry) - gnus-score-index (nth 1 (assoc header gnus-header-index))) - (when (< 0 (apply 'max (mapcar - (lambda (score) - (length (gnus-score-get header score))) - scores))) - ;; Call the scoring function for this type of "header". - (when (setq new (funcall (nth 2 entry) scores header - now expire trace)) - (push new news)))) - ;; Remove the buffer. - (kill-buffer (current-buffer))) - - ;; Add articles to `gnus-newsgroup-scored'. - (while gnus-scores-articles - (when (or (/= gnus-summary-default-score - (cdar gnus-scores-articles)) - gnus-save-score) - (push (cons (mail-header-number (caar gnus-scores-articles)) - (cdar gnus-scores-articles)) - gnus-newsgroup-scored)) - (setq gnus-scores-articles (cdr gnus-scores-articles))) - - (let (score) - (while (setq score (pop scores)) - (while score - (when (listp (caar score)) - (gnus-score-advanced (car score) trace)) - (pop score)))) - - (gnus-message 5 "Scoring...done")))))) - - -(defun gnus-get-new-thread-ids (articles) - (let ((index (nth 1 (assoc "message-id" gnus-header-index))) - (refind gnus-score-index) - id-list art this tref) - (while articles - (setq art (car articles) - this (aref (car art) index) - tref (aref (car art) refind) - articles (cdr articles)) - (when (string-equal tref "") ;no references line - (push this id-list))) - id-list)) - -;; Orphan functions written by plm@atcmp.nl (Peter Mutsaers). -(defun gnus-score-orphans (score) - (let ((new-thread-ids (gnus-get-new-thread-ids gnus-scores-articles)) - alike articles art arts this last this-id) - - (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) - articles gnus-scores-articles) - - ;;more or less the same as in gnus-score-string - (erase-buffer) - (while articles - (setq art (car articles) - this (aref (car art) gnus-score-index) - articles (cdr articles)) - ;;completely skip if this is empty (not a child, so not an orphan) - (when (not (string= this "")) - (if (equal last this) - ;; O(N*H) cons-cells used here, where H is the number of - ;; headers. - (push art alike) - (when last - ;; Insert the line, with a text property on the - ;; terminating newline referring to the articles with - ;; this line. - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike)) - (setq alike (list art) - last this)))) - (when last ; Bwadr, duplicate code. - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike)) - - ;; PLM: now delete those lines that contain an entry from new-thread-ids - (while new-thread-ids - (setq this-id (car new-thread-ids) - new-thread-ids (cdr new-thread-ids)) - (goto-char (point-min)) - (while (search-forward this-id nil t) - ;; found a match. remove this line - (beginning-of-line) - (kill-line 1))) - - ;; now for each line: update its articles with score by moving to - ;; every end-of-line in the buffer and read the articles property - (goto-char (point-min)) - (while (eq 0 (progn - (end-of-line) - (setq arts (get-text-property (point) 'articles)) - (while arts - (setq art (car arts) - arts (cdr arts)) - (setcdr art (+ score (cdr art)))) - (forward-line)))))) - - -(defun gnus-score-integer (scores header now expire &optional trace) - (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) - entries alist) - - ;; Find matches. - (while scores - (setq alist (car scores) - scores (cdr scores) - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) - (kill (car rest)) - (match (nth 0 kill)) - (type (or (nth 3 kill) '>)) - (score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (found nil) - (match-func (if (or (eq type '>) (eq type '<) (eq type '<=) - (eq type '>=) (eq type '=)) - type - (error "Illegal match type: %s" type))) - (articles gnus-scores-articles)) - ;; Instead of doing all the clever stuff that - ;; `gnus-score-string' does to minimize searches and stuff, - ;; I will assume that people generally will put so few - ;; matches on numbers that any cleverness will take more - ;; time than one would gain. - (while articles - (when (funcall match-func - (or (aref (caar articles) gnus-score-index) 0) - match) - (when trace - (push (cons (car-safe (rassq alist gnus-score-cache)) kill) - gnus-score-trace)) - (setq found t) - (setcdr (car articles) (+ score (cdar articles)))) - (setq articles (cdr articles))) - ;; Update expire date - (cond ((null date)) ;Permanent entry. - ((and found gnus-update-score-entry-dates) ;Match, update date. - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now)) - ((and expire (< date expire)) ;Old entry, remove. - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cdr rest)) - (setq rest entries))) - (setq entries rest))))) - nil) - -(defun gnus-score-date (scores header now expire &optional trace) - (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) - entries alist match match-func article) - - ;; Find matches. - (while scores - (setq alist (car scores) - scores (cdr scores) - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) - (kill (car rest)) - (type (or (nth 3 kill) 'before)) - (score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (found nil) - (articles gnus-scores-articles) - l) - (cond - ((eq type 'after) - (setq match-func 'string< - match (gnus-date-iso8601 (nth 0 kill)))) - ((eq type 'before) - (setq match-func 'gnus-string> - match (gnus-date-iso8601 (nth 0 kill)))) - ((eq type 'at) - (setq match-func 'string= - match (gnus-date-iso8601 (nth 0 kill)))) - ((eq type 'regexp) - (setq match-func 'string-match - match (nth 0 kill))) - (t (error "Illegal match type: %s" type))) - ;; Instead of doing all the clever stuff that - ;; `gnus-score-string' does to minimize searches and stuff, - ;; I will assume that people generally will put so few - ;; matches on numbers that any cleverness will take more - ;; time than one would gain. - (while (setq article (pop articles)) - (when (and - (setq l (aref (car article) gnus-score-index)) - (funcall match-func match (gnus-date-iso8601 l))) - (when trace - (push (cons (car-safe (rassq alist gnus-score-cache)) kill) - gnus-score-trace)) - (setq found t) - (setcdr article (+ score (cdr article))))) - ;; Update expire date - (cond ((null date)) ;Permanent entry. - ((and found gnus-update-score-entry-dates) ;Match, update date. - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now)) - ((and expire (< date expire)) ;Old entry, remove. - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cdr rest)) - (setq rest entries))) - (setq entries rest))))) - nil) - -(defun gnus-score-body (scores header now expire &optional trace) - (save-excursion - (setq gnus-scores-articles - (sort gnus-scores-articles - (lambda (a1 a2) - (< (mail-header-number (car a1)) - (mail-header-number (car a2)))))) - (set-buffer nntp-server-buffer) - (save-restriction - (let* ((buffer-read-only nil) - (articles gnus-scores-articles) - (all-scores scores) - (request-func (cond ((string= "head" header) - 'gnus-request-head) - ((string= "body" header) - 'gnus-request-body) - (t 'gnus-request-article))) - entries alist ofunc article last) - (when articles - (setq last (mail-header-number (caar (last articles)))) - ;; Not all backends support partial fetching. In that case, - ;; we just fetch the entire article. - (unless (gnus-check-backend-function - (and (string-match "^gnus-" (symbol-name request-func)) - (intern (substring (symbol-name request-func) - (match-end 0)))) - gnus-newsgroup-name) - (setq ofunc request-func) - (setq request-func 'gnus-request-article)) - (while articles - (setq article (mail-header-number (caar articles))) - (gnus-message 7 "Scoring on article %s of %s..." article last) - (when (funcall request-func article gnus-newsgroup-name) - (widen) - (goto-char (point-min)) - ;; If just parts of the article is to be searched, but the - ;; backend didn't support partial fetching, we just narrow - ;; to the relevant parts. - (when ofunc - (if (eq ofunc 'gnus-request-head) - (narrow-to-region - (point) - (or (search-forward "\n\n" nil t) (point-max))) - (narrow-to-region - (or (search-forward "\n\n" nil t) (point)) - (point-max)))) - (setq scores all-scores) - ;; Find matches. - (while scores - (setq alist (pop scores) - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) - (kill (car rest)) - (match (nth 0 kill)) - (type (or (nth 3 kill) 's)) - (score (or (nth 1 kill) - gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (found nil) - (case-fold-search - (not (or (eq type 'R) (eq type 'S) - (eq type 'Regexp) (eq type 'String)))) - (search-func - (cond ((or (eq type 'r) (eq type 'R) - (eq type 'regexp) (eq type 'Regexp)) - 're-search-forward) - ((or (eq type 's) (eq type 'S) - (eq type 'string) (eq type 'String)) - 'search-forward) - (t - (error "Illegal match type: %s" type))))) - (goto-char (point-min)) - (when (funcall search-func match nil t) - ;; Found a match, update scores. - (setcdr (car articles) (+ score (cdar articles))) - (setq found t) - (when trace - (push - (cons (car-safe (rassq alist gnus-score-cache)) kill) - gnus-score-trace))) - ;; Update expire date - (unless trace - (cond - ((null date)) ;Permanent entry. - ((and found gnus-update-score-entry-dates) - ;; Match, update date. - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now)) - ((and expire (< date expire)) ;Old entry, remove. - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cdr rest)) - (setq rest entries)))) - (setq entries rest))))) - (setq articles (cdr articles))))))) - nil) - -(defun gnus-score-thread (scores header now expire &optional trace) - (gnus-score-followup scores header now expire trace t)) - -(defun gnus-score-followup (scores header now expire &optional trace thread) - ;; Insert the unique article headers in the buffer. - (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) - (current-score-file gnus-current-score-file) - (all-scores scores) - ;; gnus-score-index is used as a free variable. - alike last this art entries alist articles - new news) - - ;; Change score file to the adaptive score file. All entries that - ;; this function makes will be put into this file. - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-score-load-file - (or gnus-newsgroup-adaptive-score-file - (gnus-score-file-name - gnus-newsgroup-name gnus-adaptive-file-suffix)))) - - (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) - articles gnus-scores-articles) - - (erase-buffer) - (while articles - (setq art (car articles) - this (aref (car art) gnus-score-index) - articles (cdr articles)) - (if (equal last this) - (push art alike) - (when last - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike)) - (setq alike (list art) - last this))) - (when last ; Bwadr, duplicate code. - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike)) - - ;; Find matches. - (while scores - (setq alist (car scores) - scores (cdr scores) - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((rest (cdr entries)) - (kill (car rest)) - (match (nth 0 kill)) - (type (or (nth 3 kill) 's)) - (score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (found nil) - (mt (aref (symbol-name type) 0)) - (case-fold-search - (not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F)))) - (dmt (downcase mt)) - (search-func - (cond ((= dmt ?r) 're-search-forward) - ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) - (t (error "Illegal match type: %s" type)))) - arts art) - (goto-char (point-min)) - (if (= dmt ?e) - (while (funcall search-func match nil t) - (and (= (progn (beginning-of-line) (point)) - (match-beginning 0)) - (= (progn (end-of-line) (point)) - (match-end 0)) - (progn - (setq found (setq arts (get-text-property - (point) 'articles))) - ;; Found a match, update scores. - (while arts - (setq art (car arts) - arts (cdr arts)) - (gnus-score-add-followups - (car art) score all-scores thread)))) - (end-of-line)) - (while (funcall search-func match nil t) - (end-of-line) - (setq found (setq arts (get-text-property (point) 'articles))) - ;; Found a match, update scores. - (while (setq art (pop arts)) - (when (setq new (gnus-score-add-followups - (car art) score all-scores thread)) - (push new news))))) - ;; Update expire date - (cond ((null date)) ;Permanent entry. - ((and found gnus-update-score-entry-dates) ;Match, update date. - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now)) - ((and expire (< date expire)) ;Old entry, remove. - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cdr rest)) - (setq rest entries))) - (setq entries rest)))) - ;; We change the score file back to the previous one. - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-score-load-file current-score-file)) - (list (cons "references" news)))) - -(defun gnus-score-add-followups (header score scores &optional thread) - "Add a score entry to the adapt file." - (save-excursion - (set-buffer gnus-summary-buffer) - (let* ((id (mail-header-id header)) - (scores (car scores)) - entry dont) - ;; Don't enter a score if there already is one. - (while (setq entry (pop scores)) - (and (equal "references" (car entry)) - (or (null (nth 3 (cadr entry))) - (eq 's (nth 3 (cadr entry)))) - (assoc id entry) - (setq dont t))) - (unless dont - (gnus-summary-score-entry - (if thread "thread" "references") - id 's score (current-time-string) nil t))))) - -(defun gnus-score-string (score-list header now expire &optional trace) - ;; Score ARTICLES according to HEADER in SCORE-LIST. - ;; Update matching entries to NOW and remove unmatched entries older - ;; than EXPIRE. - - ;; Insert the unique article headers in the buffer. - (let ((gnus-score-index (nth 1 (assoc header gnus-header-index))) - ;; gnus-score-index is used as a free variable. - alike last this art entries alist articles - fuzzies arts words kill) - - ;; Sorting the articles costs os O(N*log N) but will allow us to - ;; only match with each unique header. Thus the actual matching - ;; will be O(M*U) where M is the number of strings to match with, - ;; and U is the number of unique headers. It is assumed (but - ;; untested) this will be a net win because of the large constant - ;; factor involved with string matching. - (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<) - articles gnus-scores-articles) - - (erase-buffer) - (while (setq art (pop articles)) - (setq this (aref (car art) gnus-score-index)) - (if (equal last this) - ;; O(N*H) cons-cells used here, where H is the number of - ;; headers. - (push art alike) - (when last - ;; Insert the line, with a text property on the - ;; terminating newline referring to the articles with - ;; this line. - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike)) - (setq alike (list art) - last this))) - (when last ; Bwadr, duplicate code. - (insert last ?\n) - (put-text-property (1- (point)) (point) 'articles alike)) - - ;; Go through all the score alists and pick out the entries - ;; for this header. - (while score-list - (setq alist (pop score-list) - ;; There's only one instance of this header for - ;; each score alist. - entries (assoc header alist)) - (while (cdr entries) ;First entry is the header index. - (let* ((kill (cadr entries)) - (match (nth 0 kill)) - (type (or (nth 3 kill) 's)) - (score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (found nil) - (mt (aref (symbol-name type) 0)) - (case-fold-search (not (memq mt '(?R ?S ?E ?F)))) - (dmt (downcase mt)) - (search-func - (cond ((= dmt ?r) 're-search-forward) - ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward) - ((= dmt ?w) nil) - (t (error "Illegal match type: %s" type))))) - (cond - ;; Fuzzy matches. We save these for later. - ((= dmt ?f) - (push (cons entries alist) fuzzies)) - ;; Word matches. Save these for even later. - ((= dmt ?w) - (push (cons entries alist) words)) - ;; Exact matches. - ((= dmt ?e) - ;; Do exact matching. - (goto-char (point-min)) - (while (and (not (eobp)) - (funcall search-func match nil t)) - ;; Is it really exact? - (and (eolp) - (= (gnus-point-at-bol) (match-beginning 0)) - ;; Yup. - (progn - (setq found (setq arts (get-text-property - (point) 'articles))) - ;; Found a match, update scores. - (if trace - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art))) - (push - (cons - (car-safe (rassq alist gnus-score-cache)) - kill) - gnus-score-trace)) - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art))))))) - (forward-line 1))) - ;; Regexp and substring matching. - (t - (goto-char (point-min)) - (when (string= match "") - (setq match "\n")) - (while (and (not (eobp)) - (funcall search-func match nil t)) - (goto-char (match-beginning 0)) - (end-of-line) - (setq found (setq arts (get-text-property (point) 'articles))) - ;; Found a match, update scores. - (if trace - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art))) - (push (cons (car-safe (rassq alist gnus-score-cache)) kill) - gnus-score-trace)) - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art))))) - (forward-line 1)))) - ;; Update expiry date - (if trace - (setq entries (cdr entries)) - (cond - ;; Permanent entry. - ((null date) - (setq entries (cdr entries))) - ;; We have a match, so we update the date. - ((and found gnus-update-score-entry-dates) - (gnus-score-set 'touched '(t) alist) - (setcar (nthcdr 2 kill) now) - (setq entries (cdr entries))) - ;; This entry has expired, so we remove it. - ((and expire (< date expire)) - (gnus-score-set 'touched '(t) alist) - (setcdr entries (cddr entries))) - ;; No match; go to next entry. - (t - (setq entries (cdr entries)))))))) - - ;; Find fuzzy matches. - (when fuzzies - ;; Simplify the entire buffer for easy matching. - (gnus-simplify-buffer-fuzzy) - (while (setq kill (cadaar fuzzies)) - (let* ((match (nth 0 kill)) - (type (nth 3 kill)) - (score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - (mt (aref (symbol-name type) 0)) - (case-fold-search (not (= mt ?F))) - found) - (goto-char (point-min)) - (while (and (not (eobp)) - (search-forward match nil t)) - (when (and (= (gnus-point-at-bol) (match-beginning 0)) - (eolp)) - (setq found (setq arts (get-text-property (point) 'articles))) - (if trace - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art))) - (push (cons - (car-safe (rassq (cdar fuzzies) gnus-score-cache)) - kill) - gnus-score-trace)) - ;; Found a match, update scores. - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art)))))) - (forward-line 1)) - ;; Update expiry date - (cond - ;; Permanent. - ((null date) - ) - ;; Match, update date. - ((and found gnus-update-score-entry-dates) - (gnus-score-set 'touched '(t) (cdar fuzzies)) - (setcar (nthcdr 2 kill) now)) - ;; Old entry, remove. - ((and expire (< date expire)) - (gnus-score-set 'touched '(t) (cdar fuzzies)) - (setcdr (caar fuzzies) (cddaar fuzzies)))) - (setq fuzzies (cdr fuzzies))))) - - (when words - ;; Enter all words into the hashtb. - (let ((hashtb (gnus-make-hashtable - (* 10 (count-lines (point-min) (point-max)))))) - (gnus-enter-score-words-into-hashtb hashtb) - (while (setq kill (cadaar words)) - (let* ((score (or (nth 1 kill) gnus-score-interactive-default-score)) - (date (nth 2 kill)) - found) - (when (setq arts (intern-soft (nth 0 kill) hashtb)) - (setq arts (symbol-value arts)) - (setq found t) - (if trace - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art))) - (push (cons - (car-safe (rassq (cdar words) gnus-score-cache)) - kill) - gnus-score-trace)) - ;; Found a match, update scores. - (while (setq art (pop arts)) - (setcdr art (+ score (cdr art)))))) - ;; Update expiry date - (cond - ;; Permanent. - ((null date) - ) - ;; Match, update date. - ((and found gnus-update-score-entry-dates) - (gnus-score-set 'touched '(t) (cdar words)) - (setcar (nthcdr 2 kill) now)) - ;; Old entry, remove. - ((and expire (< date expire)) - (gnus-score-set 'touched '(t) (cdar words)) - (setcdr (caar words) (cddaar words)))) - (setq words (cdr words)))))) - nil)) - -(defun gnus-enter-score-words-into-hashtb (hashtb) - ;; Find all the words in the buffer and enter them into - ;; the hashtable. - (let ((syntab (syntax-table)) - word val) - (goto-char (point-min)) - (unwind-protect - (progn - (set-syntax-table gnus-adaptive-word-syntax-table) - (while (re-search-forward "\\b\\w+\\b" nil t) - (setq val - (gnus-gethash - (setq word (downcase (buffer-substring - (match-beginning 0) (match-end 0)))) - hashtb)) - (gnus-sethash - word - (append (get-text-property (gnus-point-at-eol) 'articles) val) - hashtb))) - (set-syntax-table syntab)) - ;; Make all the ignorable words ignored. - (let ((ignored (append gnus-ignored-adaptive-words - gnus-default-ignored-adaptive-words))) - (while ignored - (gnus-sethash (pop ignored) nil hashtb))))) - -(defun gnus-score-string< (a1 a2) - ;; Compare headers in articles A2 and A2. - ;; The header index used is the free variable `gnus-score-index'. - (string-lessp (aref (car a1) gnus-score-index) - (aref (car a2) gnus-score-index))) - -(defun gnus-current-score-file-nondirectory (&optional score-file) - (let ((score-file (or score-file gnus-current-score-file))) - (if score-file - (gnus-short-group-name (file-name-nondirectory score-file)) - "none"))) - -(defun gnus-score-adaptive () - "Create adaptive score rules for this newsgroup." - (when gnus-newsgroup-adaptive - ;; We change the score file to the adaptive score file. - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-score-load-file - (or gnus-newsgroup-adaptive-score-file - (gnus-score-file-name - gnus-newsgroup-name gnus-adaptive-file-suffix)))) - ;; Perform ordinary line scoring. - (when (or (not (listp gnus-newsgroup-adaptive)) - (memq 'line gnus-newsgroup-adaptive)) - (save-excursion - (let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist)) - (alist malist) - (date (current-time-string)) - (data gnus-newsgroup-data) - elem headers match) - ;; First we transform the adaptive rule alist into something - ;; that's faster to process. - (while malist - (setq elem (car malist)) - (when (symbolp (car elem)) - (setcar elem (symbol-value (car elem)))) - (setq elem (cdr elem)) - (while elem - (setcdr (car elem) - (cons (if (eq (caar elem) 'followup) - "references" - (symbol-name (caar elem))) - (cdar elem))) - (setcar (car elem) - `(lambda (h) - (,(intern - (concat "mail-header-" - (if (eq (caar elem) 'followup) - "message-id" - (downcase (symbol-name (caar elem)))))) - h))) - (setq elem (cdr elem))) - (setq malist (cdr malist))) - ;; Then we score away. - (while data - (setq elem (cdr (assq (gnus-data-mark (car data)) alist))) - (if (or (not elem) - (gnus-data-pseudo-p (car data))) - () - (when (setq headers (gnus-data-header (car data))) - (while elem - (setq match (funcall (caar elem) headers)) - (gnus-summary-score-entry - (nth 1 (car elem)) match - (cond - ((numberp match) - '=) - ((equal (nth 1 (car elem)) "date") - 'a) - (t - ;; Whether we use substring or exact matches is - ;; controlled here. - (if (or (not gnus-score-exact-adapt-limit) - (< (length match) gnus-score-exact-adapt-limit)) - 'e - (if (equal (nth 1 (car elem)) "subject") - 'f 's)))) - (nth 2 (car elem)) date nil t) - (setq elem (cdr elem))))) - (setq data (cdr data)))))) - - ;; Perform adaptive word scoring. - (when (and (listp gnus-newsgroup-adaptive) - (memq 'word gnus-newsgroup-adaptive)) - (nnheader-temp-write nil - (let* ((hashtb (gnus-make-hashtable 1000)) - (date (gnus-day-number (current-time-string))) - (data gnus-newsgroup-data) - (syntab (syntax-table)) - word d score val) - (unwind-protect - (progn - (set-syntax-table gnus-adaptive-word-syntax-table) - ;; Go through all articles. - (while (setq d (pop data)) - (when (and - (not (gnus-data-pseudo-p d)) - (setq score - (cdr (assq - (gnus-data-mark d) - gnus-adaptive-word-score-alist)))) - ;; This article has a mark that should lead to - ;; adaptive word rules, so we insert the subject - ;; and find all words in that string. - (insert (mail-header-subject (gnus-data-header d))) - (downcase-region (point-min) (point-max)) - (goto-char (point-min)) - (while (re-search-forward "\\b\\w+\\b" nil t) - ;; Put the word and score into the hashtb. - (setq val (gnus-gethash (setq word (match-string 0)) - hashtb)) - (gnus-sethash word (+ (or val 0) score) hashtb)) - (erase-buffer)))) - (set-syntax-table syntab)) - ;; Make all the ignorable words ignored. - (let ((ignored (append gnus-ignored-adaptive-words - gnus-default-ignored-adaptive-words))) - (while ignored - (gnus-sethash (pop ignored) nil hashtb))) - ;; Now we have all the words and scores, so we - ;; add these rules to the ADAPT file. - (set-buffer gnus-summary-buffer) - (mapatoms - (lambda (word) - (when (symbol-value word) - (gnus-summary-score-entry - "subject" (symbol-name word) 'w (symbol-value word) - date nil t))) - hashtb)))))) - -(defun gnus-score-edit-done () - (let ((bufnam (buffer-file-name (current-buffer))) - (winconf gnus-prev-winconf)) - (when winconf - (set-window-configuration winconf)) - (gnus-score-remove-from-cache bufnam) - (gnus-score-load-file bufnam))) - -(defun gnus-score-find-trace () - "Find all score rules that applies to the current article." - (interactive) - (let ((old-scored gnus-newsgroup-scored)) - (let ((gnus-newsgroup-headers - (list (gnus-summary-article-header))) - (gnus-newsgroup-scored nil) - trace) - (save-excursion - (nnheader-set-temp-buffer "*Score Trace*")) - (setq gnus-score-trace nil) - (gnus-possibly-score-headers 'trace) - (if (not (setq trace gnus-score-trace)) - (gnus-error - 1 "No score rules apply to the current article (default score %d)." - gnus-summary-default-score) - (set-buffer "*Score Trace*") - (gnus-add-current-to-buffer-list) - (while trace - (insert (format "%S -> %s\n" (cdar trace) - (if (caar trace) - (file-name-nondirectory (caar trace)) - "(non-file rule)"))) - (setq trace (cdr trace))) - (goto-char (point-min)) - (gnus-configure-windows 'score-trace))) - (set-buffer gnus-summary-buffer) - (setq gnus-newsgroup-scored old-scored))) - -(defun gnus-score-find-favourite-words () - "List words used in scoring." - (interactive) - (let ((alists (gnus-score-load-files (gnus-all-score-files))) - alist rule rules kill) - ;; Go through all the score alists for this group - ;; and find all `w' rules. - (while (setq alist (pop alists)) - (while (setq rule (pop alist)) - (when (and (stringp (car rule)) - (equal "subject" (downcase (pop rule)))) - (while (setq kill (pop rule)) - (when (memq (nth 3 kill) '(w W word Word)) - (push (cons (or (nth 1 kill) - gnus-score-interactive-default-score) - (car kill)) - rules)))))) - (setq rules (sort rules (lambda (r1 r2) - (string-lessp (cdr r1) (cdr r2))))) - ;; Add up words that have appeared several times. - (let ((r rules)) - (while (cdr r) - (if (equal (cdar r) (cdadr r)) - (progn - (setcar (car r) (+ (caar r) (caadr r))) - (setcdr r (cddr r))) - (pop r)))) - ;; Insert the words. - (nnheader-set-temp-buffer "*Score Words*") - (if (not (setq rules (sort rules (lambda (r1 r2) (> (car r1) (car r2)))))) - (gnus-error 3 "No word score rules") - (while rules - (insert (format "%-5d: %s\n" (caar rules) (cdar rules))) - (pop rules)) - (gnus-add-current-to-buffer-list) - (goto-char (point-min)) - (gnus-configure-windows 'score-words)))) - -(defun gnus-summary-rescore () - "Redo the entire scoring process in the current summary." - (interactive) - (gnus-score-save) - (setq gnus-score-cache nil) - (setq gnus-newsgroup-scored nil) - (gnus-possibly-score-headers) - (gnus-score-update-all-lines)) - -(defun gnus-score-flush-cache () - "Flush the cache of score files." - (interactive) - (gnus-score-save) - (setq gnus-score-cache nil - gnus-score-alist nil - gnus-short-name-score-file-cache nil) - (gnus-message 6 "The score cache is now flushed")) - -(gnus-add-shutdown 'gnus-score-close 'gnus) - -(defvar gnus-score-file-alist-cache nil) - -(defun gnus-score-close () - "Clear all internal score variables." - (setq gnus-score-cache nil - gnus-internal-global-score-files nil - gnus-score-file-list nil - gnus-score-file-alist-cache nil)) - -;; Summary score marking commands. - -(defun gnus-summary-raise-same-subject-and-select (score) - "Raise articles which has the same subject with SCORE and select the next." - (interactive "p") - (let ((subject (gnus-summary-article-subject))) - (gnus-summary-raise-score score) - (while (gnus-summary-find-subject subject) - (gnus-summary-raise-score score)) - (gnus-summary-next-article t))) - -(defun gnus-summary-raise-same-subject (score) - "Raise articles which has the same subject with SCORE." - (interactive "p") - (let ((subject (gnus-summary-article-subject))) - (gnus-summary-raise-score score) - (while (gnus-summary-find-subject subject) - (gnus-summary-raise-score score)) - (gnus-summary-next-subject 1 t))) - -(defun gnus-score-default (level) - (if level (prefix-numeric-value level) - gnus-score-interactive-default-score)) - -(defun gnus-summary-raise-thread (&optional score) - "Raise the score of the articles in the current thread with SCORE." - (interactive "P") - (setq score (gnus-score-default score)) - (let (e) - (save-excursion - (let ((articles (gnus-summary-articles-in-thread))) - (while articles - (gnus-summary-goto-subject (car articles)) - (gnus-summary-raise-score score) - (setq articles (cdr articles)))) - (setq e (point))) - (let ((gnus-summary-check-current t)) - (unless (zerop (gnus-summary-next-subject 1 t)) - (goto-char e)))) - (gnus-summary-recenter) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary)) - -(defun gnus-summary-lower-same-subject-and-select (score) - "Raise articles which has the same subject with SCORE and select the next." - (interactive "p") - (gnus-summary-raise-same-subject-and-select (- score))) - -(defun gnus-summary-lower-same-subject (score) - "Raise articles which has the same subject with SCORE." - (interactive "p") - (gnus-summary-raise-same-subject (- score))) - -(defun gnus-summary-lower-thread (&optional score) - "Lower score of articles in the current thread with SCORE." - (interactive "P") - (gnus-summary-raise-thread (- (1- (gnus-score-default score))))) - -;;; Finding score files. - -(defun gnus-score-score-files (group) - "Return a list of all possible score files." - ;; Search and set any global score files. - (when gnus-global-score-files - (unless gnus-internal-global-score-files - (gnus-score-search-global-directories gnus-global-score-files))) - ;; Fix the kill-file dir variable. - (setq gnus-kill-files-directory - (file-name-as-directory gnus-kill-files-directory)) - ;; If we can't read it, there are no score files. - (if (not (file-exists-p (expand-file-name gnus-kill-files-directory))) - (setq gnus-score-file-list nil) - (if (not (gnus-use-long-file-name 'not-score)) - ;; We do not use long file names, so we have to do some - ;; directory traversing. - (setq gnus-score-file-list - (cons nil - (or gnus-short-name-score-file-cache - (prog2 - (gnus-message 6 "Finding all score files...") - (setq gnus-short-name-score-file-cache - (gnus-score-score-files-1 - gnus-kill-files-directory)) - (gnus-message 6 "Finding all score files...done"))))) - ;; We want long file names. - (when (or (not gnus-score-file-list) - (not (car gnus-score-file-list)) - (gnus-file-newer-than gnus-kill-files-directory - (car gnus-score-file-list))) - (setq gnus-score-file-list - (cons (nth 5 (file-attributes gnus-kill-files-directory)) - (nreverse - (directory-files - gnus-kill-files-directory t - (gnus-score-file-regexp))))))) - (cdr gnus-score-file-list))) - -(defun gnus-score-score-files-1 (dir) - "Return all possible score files under DIR." - (let ((files (list (expand-file-name dir))) - (regexp (gnus-score-file-regexp)) - (case-fold-search nil) - seen out file) - (while (setq file (pop files)) - (cond - ;; Ignore "." and "..". - ((member (file-name-nondirectory file) '("." "..")) - nil) - ;; Add subtrees of directory to also be searched. - ((and (file-directory-p file) - (not (member (file-truename file) seen))) - (push (file-truename file) seen) - (setq files (nconc (directory-files file t nil t) files))) - ;; Add files to the list of score files. - ((string-match regexp file) - (push file out)))) - (or out - ;; Return a dummy value. - (list "~/News/this.file.does.not.exist.SCORE")))) - -(defun gnus-score-file-regexp () - "Return a regexp that match all score files." - (concat "\\(" (regexp-quote gnus-score-file-suffix ) - "\\|" (regexp-quote gnus-adaptive-file-suffix) "\\)\\'")) - -(defun gnus-score-find-bnews (group) - "Return a list of score files for GROUP. -The score files are those files in the ~/News/ directory which matches -GROUP using BNews sys file syntax." - (let* ((sfiles (append (gnus-score-score-files group) - gnus-internal-global-score-files)) - (kill-dir (file-name-as-directory - (expand-file-name gnus-kill-files-directory))) - (klen (length kill-dir)) - (score-regexp (gnus-score-file-regexp)) - (trans (cdr (assq ?: nnheader-file-name-translation-alist))) - ofiles not-match regexp) - (save-excursion - (set-buffer (get-buffer-create "*gnus score files*")) - (buffer-disable-undo (current-buffer)) - ;; Go through all score file names and create regexp with them - ;; as the source. - (while sfiles - (erase-buffer) - (insert (car sfiles)) - (goto-char (point-min)) - ;; First remove the suffix itself. - (when (re-search-forward (concat "." score-regexp) nil t) - (replace-match "" t t) - (goto-char (point-min)) - (if (looking-at (regexp-quote kill-dir)) - ;; If the file name was just "SCORE", `klen' is one character - ;; too much. - (delete-char (min (1- (point-max)) klen)) - (goto-char (point-max)) - (search-backward "/") - (delete-region (1+ (point)) (point-min))) - ;; If short file names were used, we have to translate slashes. - (goto-char (point-min)) - (let ((regexp (concat - "[/:" (if trans (char-to-string trans) "") "]"))) - (while (re-search-forward regexp nil t) - (replace-match "." t t))) - ;; Kludge to get rid of "nntp+" problems. - (goto-char (point-min)) - (when (looking-at "nn[a-z]+\\+") - (search-forward "+") - (forward-char -1) - (insert "\\") - (forward-char 1)) - ;; Kludge to deal with "++". - (while (search-forward "+" nil t) - (replace-match "\\+" t t)) - ;; Translate "all" to ".*". - (goto-char (point-min)) - (while (search-forward "all" nil t) - (replace-match ".*" t t)) - (goto-char (point-min)) - ;; Deal with "not."s. - (if (looking-at "not.") - (progn - (setq not-match t) - (setq regexp (concat "^" (buffer-substring 5 (point-max)) "$"))) - (setq regexp (concat "^" (buffer-substring 1 (point-max)) "$")) - (setq not-match nil)) - ;; Finally - if this resulting regexp matches the group name, - ;; we add this score file to the list of score files - ;; applicable to this group. - (when (or (and not-match - (not (string-match regexp group))) - (and (not not-match) - (string-match regexp group))) - (push (car sfiles) ofiles))) - (setq sfiles (cdr sfiles))) - (kill-buffer (current-buffer)) - ;; Slight kludge here - the last score file returned should be - ;; the local score file, whether it exists or not. This is so - ;; that any score commands the user enters will go to the right - ;; file, and not end up in some global score file. - (let ((localscore (gnus-score-file-name group))) - (setq ofiles (cons localscore (delete localscore ofiles)))) - (gnus-sort-score-files (nreverse ofiles))))) - -(defun gnus-score-find-single (group) - "Return list containing the score file for GROUP." - (list (or gnus-newsgroup-adaptive-score-file - (gnus-score-file-name group gnus-adaptive-file-suffix)) - (gnus-score-file-name group))) - -(defun gnus-score-find-hierarchical (group) - "Return list of score files for GROUP. -This includes the score file for the group and all its parents." - (let* ((prefix (gnus-group-real-prefix group)) - (all (list nil)) - (group (gnus-group-real-name group)) - (start 0)) - (while (string-match "\\." group (1+ start)) - (setq start (match-beginning 0)) - (push (substring group 0 start) all)) - (push group all) - (setq all - (nconc - (mapcar (lambda (group) - (gnus-score-file-name group gnus-adaptive-file-suffix)) - (setq all (nreverse all))) - (mapcar 'gnus-score-file-name all))) - (if (equal prefix "") - all - (mapcar - (lambda (file) - (nnheader-translate-file-chars - (concat (file-name-directory file) prefix - (file-name-nondirectory file)))) - all)))) - -(defun gnus-score-file-rank (file) - "Return a number that says how specific score FILE is. -Destroys the current buffer." - (if (member file gnus-internal-global-score-files) - 0 - (when (string-match - (concat "^" (regexp-quote - (expand-file-name - (file-name-as-directory gnus-kill-files-directory)))) - file) - (setq file (substring file (match-end 0)))) - (insert file) - (goto-char (point-min)) - (let ((beg (point)) - elems) - (while (re-search-forward "[./]" nil t) - (push (buffer-substring beg (1- (point))) - elems)) - (erase-buffer) - (setq elems (delete "all" elems)) - (length elems)))) - -(defun gnus-sort-score-files (files) - "Sort FILES so that the most general files come first." - (nnheader-temp-write nil - (let ((alist - (mapcar - (lambda (file) - (cons (inline (gnus-score-file-rank file)) file)) - files))) - (mapcar - (lambda (f) (cdr f)) - (sort alist (lambda (f1 f2) (< (car f1) (car f2)))))))) - -(defun gnus-score-find-alist (group) - "Return list of score files for GROUP. -The list is determined from the variable gnus-score-file-alist." - (let ((alist gnus-score-file-multiple-match-alist) - score-files) - ;; if this group has been seen before, return the cached entry - (if (setq score-files (assoc group gnus-score-file-alist-cache)) - (cdr score-files) ;ensures caching groups with no matches - ;; handle the multiple match alist - (while alist - (when (string-match (caar alist) group) - (setq score-files - (nconc score-files (copy-sequence (cdar alist))))) - (setq alist (cdr alist))) - (setq alist gnus-score-file-single-match-alist) - ;; handle the single match alist - (while alist - (when (string-match (caar alist) group) - ;; progn used just in case ("regexp") has no files - ;; and score-files is still nil. -sj - ;; this can be construed as a "stop searching here" feature :> - ;; and used to simplify regexps in the single-alist - (setq score-files - (nconc score-files (copy-sequence (cdar alist)))) - (setq alist nil)) - (setq alist (cdr alist))) - ;; cache the score files - (push (cons group score-files) gnus-score-file-alist-cache) - score-files))) - -(defun gnus-all-score-files (&optional group) - "Return a list of all score files for the current group." - (let ((funcs gnus-score-find-score-files-function) - (group (or group gnus-newsgroup-name)) - score-files) - ;; Make sure funcs is a list. - (and funcs - (not (listp funcs)) - (setq funcs (list funcs))) - ;; Get the initial score files for this group. - (when funcs - (setq score-files (nreverse (gnus-score-find-alist group)))) - ;; Add any home adapt files. - (let ((home (gnus-home-score-file group t))) - (when home - (push home score-files) - (setq gnus-newsgroup-adaptive-score-file home))) - ;; Check whether there is a `adapt-file' group parameter. - (let ((param-file (gnus-group-find-parameter group 'adapt-file))) - (when param-file - (push param-file score-files) - (setq gnus-newsgroup-adaptive-score-file param-file))) - ;; Go through all the functions for finding score files (or actual - ;; scores) and add them to a list. - (while funcs - (when (gnus-functionp (car funcs)) - (setq score-files - (nconc score-files (nreverse (funcall (car funcs) group))))) - (setq funcs (cdr funcs))) - ;; Add any home score files. - (let ((home (gnus-home-score-file group))) - (when home - (push home score-files))) - ;; Check whether there is a `score-file' group parameter. - (let ((param-file (gnus-group-find-parameter group 'score-file))) - (when param-file - (push param-file score-files))) - ;; Expand all files names. - (let ((files score-files)) - (while files - (when (stringp (car files)) - (setcar files (expand-file-name - (car files) gnus-kill-files-directory))) - (pop files))) - (setq score-files (nreverse score-files)) - ;; Remove any duplicate score files. - (while (and score-files - (member (car score-files) (cdr score-files))) - (pop score-files)) - (let ((files score-files)) - (while (cdr files) - (if (member (cadr files) (cddr files)) - (setcdr files (cddr files)) - (pop files)))) - ;; Do the scoring if there are any score files for this group. - score-files)) - -(defun gnus-possibly-score-headers (&optional trace) - "Do scoring if scoring is required." - (let ((score-files (gnus-all-score-files))) - (when score-files - (gnus-score-headers score-files trace)))) - -(defun gnus-score-file-name (newsgroup &optional suffix) - "Return the name of a score file for NEWSGROUP." - (let ((suffix (or suffix gnus-score-file-suffix))) - (nnheader-translate-file-chars - (cond - ((or (null newsgroup) - (string-equal newsgroup "")) - ;; The global score file is placed at top of the directory. - (expand-file-name - suffix gnus-kill-files-directory)) - ((gnus-use-long-file-name 'not-score) - ;; Append ".SCORE" to newsgroup name. - (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup) - "." suffix) - gnus-kill-files-directory)) - (t - ;; Place "SCORE" under the hierarchical directory. - (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) - "/" suffix) - gnus-kill-files-directory)))))) - -(defun gnus-score-search-global-directories (files) - "Scan all global score directories for score files." - ;; Set the variable `gnus-internal-global-score-files' to all - ;; available global score files. - (interactive (list gnus-global-score-files)) - (let (out) - (while files - (if (string-match "/$" (car files)) - (setq out (nconc (directory-files - (car files) t - (concat (gnus-score-file-regexp) "$")))) - (push (car files) out)) - (setq files (cdr files))) - (setq gnus-internal-global-score-files out))) - -(defun gnus-score-default-fold-toggle () - "Toggle folding for new score file entries." - (interactive) - (setq gnus-score-default-fold (not gnus-score-default-fold)) - (if gnus-score-default-fold - (gnus-message 1 "New score file entries will be case insensitive.") - (gnus-message 1 "New score file entries will be case sensitive."))) - -;;; Home score file. - -(defun gnus-home-score-file (group &optional adapt) - "Return the home score file for GROUP. -If ADAPT, return the home adaptive file instead." - (let ((list (if adapt gnus-home-adapt-file gnus-home-score-file)) - elem found) - ;; Make sure we have a list. - (unless (listp list) - (setq list (list list))) - ;; Go through the list and look for matches. - (while (and (not found) - (setq elem (pop list))) - (setq found - (cond - ;; Simple string. - ((stringp elem) - elem) - ;; Function. - ((gnus-functionp elem) - (funcall elem group)) - ;; Regexp-file cons - ((consp elem) - (when (string-match (car elem) group) - (cadr elem)))))) - (when found - (nnheader-concat gnus-kill-files-directory found)))) - -(defun gnus-hierarchial-home-score-file (group) - "Return the score file of the top-level hierarchy of GROUP." - (if (string-match "^[^.]+\\." group) - (concat (match-string 0 group) gnus-score-file-suffix) - ;; Group name without any dots. - (concat group (if (gnus-use-long-file-name 'not-score) "." "/") - gnus-score-file-suffix))) - -(defun gnus-hierarchial-home-adapt-file (group) - "Return the adapt file of the top-level hierarchy of GROUP." - (if (string-match "^[^.]+\\." group) - (concat (match-string 0 group) gnus-adaptive-file-suffix) - ;; Group name without any dots. - (concat group (if (gnus-use-long-file-name 'not-score) "." "/") - gnus-adaptive-file-suffix))) - -;;; -;;; Score decays -;;; - -(defun gnus-decay-score (score) - "Decay SCORE according to `gnus-score-decay-constant' and `gnus-score-decay-scale'." - (floor - (- score - (* (if (< score 0) 1 -1) - (min (abs score) - (max gnus-score-decay-constant - (* (abs score) - gnus-score-decay-scale))))))) - -(defun gnus-decay-scores (alist day) - "Decay non-permanent scores in ALIST." - (let ((times (- (gnus-time-to-day (current-time)) day)) - kill entry updated score n) - (unless (zerop times) ;Done decays today already? - (while (setq entry (pop alist)) - (when (stringp (car entry)) - (setq entry (cdr entry)) - (while (setq kill (pop entry)) - (when (nth 2 kill) - (setq updated t) - (setq score (or (nth 1 kill) - gnus-score-interactive-default-score) - n times) - (while (natnump (decf n)) - (setq score (funcall gnus-decay-score-function score))) - (setcdr kill (cons score - (cdr (cdr kill))))))))) - ;; Return whether this score file needs to be saved. By Je-haysuss! - updated)) - -(provide 'gnus-score) - -;;; gnus-score.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-setup.el --- a/lisp/gnus/gnus-setup.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,217 +0,0 @@ -;;; gnus-setup.el --- Initialization & Setup for Gnus 5 -;; Copyright (C) 1995, 96 Free Software Foundation, Inc. - -;; Author: Steven L. Baur -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: -;; My head is starting to spin with all the different mail/news packages. -;; Stop The Madness! - -;; Given that Emacs Lisp byte codes may be diverging, it is probably best -;; not to byte compile this, and just arrange to have the .el loaded out -;; of .emacs. - -;;; Code: - -(require 'cl) - -(defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version)) - -(defvar gnus-use-installed-gnus t - "*If non-nil Use installed version of Gnus.") - -(defvar gnus-use-installed-tm running-xemacs - "*If non-nil use installed version of tm.") - -(defvar gnus-use-installed-mailcrypt running-xemacs - "*If non-nil use installed version of mailcrypt.") - -(defvar gnus-emacs-lisp-directory (if running-xemacs - "/usr/local/lib/xemacs/" - "/usr/local/share/emacs/") - "Directory where Emacs site lisp is located.") - -(defvar gnus-gnus-lisp-directory (concat gnus-emacs-lisp-directory - "gnus-5.0.15/lisp/") - "Directory where Gnus Emacs lisp is found.") - -(defvar gnus-tm-lisp-directory (concat gnus-emacs-lisp-directory - "site-lisp/") - "Directory where TM Emacs lisp is found.") - -(defvar gnus-mailcrypt-lisp-directory (concat gnus-emacs-lisp-directory - "site-lisp/mailcrypt-3.4/") - "Directory where Mailcrypt Emacs Lisp is found.") - -(defvar gnus-bbdb-lisp-directory (concat gnus-emacs-lisp-directory - "site-lisp/bbdb-1.51/") - "Directory where Big Brother Database is found.") - -(defvar gnus-use-tm running-xemacs - "Set this if you want MIME support for Gnus") -(defvar gnus-use-mhe nil - "Set this if you want to use MH-E for mail reading") -(defvar gnus-use-rmail nil - "Set this if you want to use RMAIL for mail reading") -(defvar gnus-use-sendmail t - "Set this if you want to use SENDMAIL for mail reading") -(defvar gnus-use-vm nil - "Set this if you want to use the VM package for mail reading") -(defvar gnus-use-sc nil - "Set this if you want to use Supercite") -(defvar gnus-use-mailcrypt t - "Set this if you want to use Mailcrypt for dealing with PGP messages") -(defvar gnus-use-bbdb nil - "Set this if you want to use the Big Brother DataBase") - -(when (and (not gnus-use-installed-gnus) - (null (member gnus-gnus-lisp-directory load-path))) - (push gnus-gnus-lisp-directory load-path)) - -;;; We can't do this until we know where Gnus is. -(require 'message) - -;;; Tools for MIME by -;;; UMEDA Masanobu -;;; MORIOKA Tomohiko - -(when gnus-use-tm - (when (and (not gnus-use-installed-tm) - (null (member gnus-tm-lisp-directory load-path))) - (setq load-path (cons gnus-tm-lisp-directory load-path))) - ;; tm may or may not be dumped with XEmacs. In Sunpro it is, otherwise - ;; it isn't. - (unless (featurep 'mime-setup) - (load "mime-setup"))) - -;;; Mailcrypt by -;;; Jin Choi -;;; Patrick LoPresti - -(when gnus-use-mailcrypt - (when (and (not gnus-use-installed-mailcrypt) - (null (member gnus-mailcrypt-lisp-directory load-path))) - (setq load-path (cons gnus-mailcrypt-lisp-directory load-path))) - (autoload 'mc-install-write-mode "mailcrypt" nil t) - (autoload 'mc-install-read-mode "mailcrypt" nil t) - (add-hook 'message-mode-hook 'mc-install-write-mode) - (add-hook 'gnus-summary-mode-hook 'mc-install-read-mode) - (when gnus-use-mhe - (add-hook 'mh-folder-mode-hook 'mc-install-read-mode) - (add-hook 'mh-letter-mode-hook 'mc-install-write-mode))) - -;;; BBDB by -;;; Jamie Zawinski - -(when gnus-use-bbdb - ;; bbdb will never be installed with emacs. - (when (null (member gnus-bbdb-lisp-directory load-path)) - (setq load-path (cons gnus-bbdb-lisp-directory load-path))) - (autoload 'bbdb "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-name "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-company "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-net "bbdb-com" - "Insidious Big Brother Database" t) - (autoload 'bbdb-notes "bbdb-com" - "Insidious Big Brother Database" t) - - (when gnus-use-vm - (autoload 'bbdb-insinuate-vm "bbdb-vm" - "Hook BBDB into VM" t)) - - (when gnus-use-rmail - (autoload 'bbdb-insinuate-rmail "bbdb-rmail" - "Hook BBDB into RMAIL" t) - (add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail)) - - (when gnus-use-mhe - (autoload 'bbdb-insinuate-mh "bbdb-mh" - "Hook BBDB into MH-E" t) - (add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh)) - - (autoload 'bbdb-insinuate-gnus "bbdb-gnus" - "Hook BBDB into Gnus" t) - (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus) - - (when gnus-use-sendmail - (autoload 'bbdb-insinuate-sendmail "bbdb" - "Insidious Big Brother Database" t) - (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail) - (add-hook 'message-setup-hook 'bbdb-insinuate-sendmail))) - -(when gnus-use-sc - (add-hook 'mail-citation-hook 'sc-cite-original) - (setq message-cite-function 'sc-cite-original) - (autoload 'sc-cite-original "supercite")) - -;;;### (autoloads (gnus gnus-slave gnus-no-server) "gnus" "lisp/gnus.el" (12473 2137)) -;;; Generated autoloads from lisp/gnus.el - -;; Don't redo this if autoloads already exist -(unless (fboundp 'gnus) - (autoload 'gnus-slave-no-server "gnus" "\ -Read network news as a slave without connecting to local server." t nil) - - (autoload 'gnus-no-server "gnus" "\ -Read network news. -If ARG is a positive number, Gnus will use that as the -startup level. If ARG is nil, Gnus will be started at level 2. -If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use. -As opposed to `gnus', this command will not connect to the local server." t nil) - - (autoload 'gnus-slave "gnus" "\ -Read news as a slave." t nil) - - (autoload 'gnus "gnus" "\ -Read network news. -If ARG is non-nil and a positive number, Gnus will use that as the -startup level. If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use." t nil) - -;;;*** - -;;; These have moved out of gnus.el into other files. -;;; FIX FIX FIX: should other things be in gnus-setup? or these not in it? - (autoload 'gnus-update-format "gnus-spec" "\ -Update the format specification near point." t nil) - - (autoload 'gnus-fetch-group "gnus-group" "\ -Start Gnus if necessary and enter GROUP. -Returns whether the fetching was successful or not." t nil) - - (defalias 'gnus-batch-kill 'gnus-batch-score) - - (autoload 'gnus-batch-score "gnus-kill" "\ -Run batched scoring. -Usage: emacs -batch -l gnus -f gnus-batch-score ... -Newsgroups is a list of strings in Bnews format. If you want to score -the comp hierarchy, you'd say \"comp.all\". If you would not like to -score the alt hierarchy, you'd say \"!alt.all\"." t nil)) - -(provide 'gnus-setup) - -(run-hooks 'gnus-setup-load-hook) - -;;; gnus-setup.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-soup.el --- a/lisp/gnus/gnus-soup.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,565 +0,0 @@ -;;; gnus-soup.el --- SOUP packet writing support for Gnus -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Per Abrahamsen -;; Lars Magne Ingebrigtsen -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-art) -(require 'message) -(require 'gnus-start) -(require 'gnus-range) - -;;; User Variables: - -(defvar gnus-soup-directory (nnheader-concat gnus-home-directory "SoupBrew/") - "*Directory containing an unpacked SOUP packet.") - -(defvar gnus-soup-replies-directory - (nnheader-concat gnus-soup-directory "SoupReplies/") - "*Directory where Gnus will do processing of replies.") - -(defvar gnus-soup-prefix-file "gnus-prefix" - "*Name of the file where Gnus stores the last used prefix.") - -(defvar gnus-soup-packer "tar cf - %s | gzip > $HOME/Soupout%d.tgz" - "Format string command for packing a SOUP packet. -The SOUP files will be inserted where the %s is in the string. -This string MUST contain both %s and %d. The file number will be -inserted where %d appears.") - -(defvar gnus-soup-unpacker "gunzip -c %s | tar xvf -" - "*Format string command for unpacking a SOUP packet. -The SOUP packet file name will be inserted at the %s.") - -(defvar gnus-soup-packet-directory gnus-home-directory - "*Where gnus-soup will look for REPLIES packets.") - -(defvar gnus-soup-packet-regexp "Soupin" - "*Regular expression matching SOUP REPLIES packets in `gnus-soup-packet-directory'.") - -(defvar gnus-soup-ignored-headers "^Xref:" - "*Regexp to match headers to be removed when brewing SOUP packets.") - -;;; Internal Variables: - -(defvar gnus-soup-encoding-type ?n - "*Soup encoding type. -`n' is news format, `m' is Unix mbox format, and `M' is MMDF mailbox -format.") - -(defvar gnus-soup-index-type ?c - "*Soup index type. -`n' means no index file and `c' means standard Cnews overview -format.") - -(defvar gnus-soup-areas nil) -(defvar gnus-soup-last-prefix nil) -(defvar gnus-soup-prev-prefix nil) -(defvar gnus-soup-buffers nil) - -;;; Access macros: - -(defmacro gnus-soup-area-prefix (area) - `(aref ,area 0)) -(defmacro gnus-soup-set-area-prefix (area prefix) - `(aset ,area 0 ,prefix)) -(defmacro gnus-soup-area-name (area) - `(aref ,area 1)) -(defmacro gnus-soup-area-encoding (area) - `(aref ,area 2)) -(defmacro gnus-soup-area-description (area) - `(aref ,area 3)) -(defmacro gnus-soup-area-number (area) - `(aref ,area 4)) -(defmacro gnus-soup-area-set-number (area value) - `(aset ,area 4 ,value)) - -(defmacro gnus-soup-encoding-format (encoding) - `(aref ,encoding 0)) -(defmacro gnus-soup-encoding-index (encoding) - `(aref ,encoding 1)) -(defmacro gnus-soup-encoding-kind (encoding) - `(aref ,encoding 2)) - -(defmacro gnus-soup-reply-prefix (reply) - `(aref ,reply 0)) -(defmacro gnus-soup-reply-kind (reply) - `(aref ,reply 1)) -(defmacro gnus-soup-reply-encoding (reply) - `(aref ,reply 2)) - -;;; Commands: - -(defun gnus-soup-send-replies () - "Unpack and send all replies in the reply packet." - (interactive) - (let ((packets (directory-files - gnus-soup-packet-directory t gnus-soup-packet-regexp))) - (while packets - (when (gnus-soup-send-packet (car packets)) - (delete-file (car packets))) - (setq packets (cdr packets))))) - -(defun gnus-soup-add-article (n) - "Add the current article to SOUP packet. -If N is a positive number, add the N next articles. -If N is a negative number, add the N previous articles. -If N is nil and any articles have been marked with the process mark, -move those articles instead." - (interactive "P") - (gnus-set-global-variables) - (let* ((articles (gnus-summary-work-articles n)) - (tmp-buf (get-buffer-create "*soup work*")) - (area (gnus-soup-area gnus-newsgroup-name)) - (prefix (gnus-soup-area-prefix area)) - headers) - (buffer-disable-undo tmp-buf) - (save-excursion - (while articles - ;; Find the header of the article. - (set-buffer gnus-summary-buffer) - (when (setq headers (gnus-summary-article-header (car articles))) - ;; Put the article in a buffer. - (set-buffer tmp-buf) - (when (gnus-request-article-this-buffer - (car articles) gnus-newsgroup-name) - (save-restriction - (message-narrow-to-head) - (message-remove-header gnus-soup-ignored-headers t)) - (gnus-soup-store gnus-soup-directory prefix headers - gnus-soup-encoding-type - gnus-soup-index-type) - (gnus-soup-area-set-number - area (1+ (or (gnus-soup-area-number area) 0))))) - ;; Mark article as read. - (set-buffer gnus-summary-buffer) - (gnus-summary-remove-process-mark (car articles)) - (gnus-summary-mark-as-read (car articles) gnus-souped-mark) - (setq articles (cdr articles))) - (kill-buffer tmp-buf)) - (gnus-soup-save-areas))) - -(defun gnus-soup-pack-packet () - "Make a SOUP packet from the SOUP areas." - (interactive) - (gnus-soup-read-areas) - (unless (file-exists-p gnus-soup-directory) - (message "No such directory: %s" gnus-soup-directory)) - (when (null (directory-files gnus-soup-directory nil "\\.MSG$")) - (message "No files to pack.")) - (gnus-soup-pack gnus-soup-directory gnus-soup-packer)) - -(defun gnus-group-brew-soup (n) - "Make a soup packet from the current group. -Uses the process/prefix convention." - (interactive "P") - (let ((groups (gnus-group-process-prefix n))) - (while groups - (gnus-group-remove-mark (car groups)) - (gnus-soup-group-brew (car groups) t) - (setq groups (cdr groups))) - (gnus-soup-save-areas))) - -(defun gnus-brew-soup (&optional level) - "Go through all groups on LEVEL or less and make a soup packet." - (interactive "P") - (let ((level (or level gnus-level-subscribed)) - (newsrc (cdr gnus-newsrc-alist))) - (while newsrc - (when (<= (nth 1 (car newsrc)) level) - (gnus-soup-group-brew (caar newsrc) t)) - (setq newsrc (cdr newsrc))) - (gnus-soup-save-areas))) - -;;;###autoload -(defun gnus-batch-brew-soup () - "Brew a SOUP packet from groups mention on the command line. -Will use the remaining command line arguments as regular expressions -for matching on group names. - -For instance, if you want to brew on all the nnml groups, as well as -groups with \"emacs\" in the name, you could say something like: - -$ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\"" - (interactive) - nil) - -;;; Internal Functions: - -;; Store the current buffer. -(defun gnus-soup-store (directory prefix headers format index) - ;; Create the directory, if needed. - (gnus-make-directory directory) - (let* ((msg-buf (nnheader-find-file-noselect - (concat directory prefix ".MSG"))) - (idx-buf (if (= index ?n) - nil - (nnheader-find-file-noselect - (concat directory prefix ".IDX")))) - (article-buf (current-buffer)) - from head-line beg type) - (setq gnus-soup-buffers (cons msg-buf (delq msg-buf gnus-soup-buffers))) - (buffer-disable-undo msg-buf) - (when idx-buf - (push idx-buf gnus-soup-buffers) - (buffer-disable-undo idx-buf)) - (save-excursion - ;; Make sure the last char in the buffer is a newline. - (goto-char (point-max)) - (unless (= (current-column) 0) - (insert "\n")) - ;; Find the "from". - (goto-char (point-min)) - (setq from - (gnus-mail-strip-quoted-names - (or (mail-fetch-field "from") - (mail-fetch-field "really-from") - (mail-fetch-field "sender")))) - (goto-char (point-min)) - ;; Depending on what encoding is supposed to be used, we make - ;; a soup header. - (setq head-line - (cond - ((= gnus-soup-encoding-type ?n) - (format "#! rnews %d\n" (buffer-size))) - ((= gnus-soup-encoding-type ?m) - (while (search-forward "\nFrom " nil t) - (replace-match "\n>From " t t)) - (concat "From " (or from "unknown") - " " (current-time-string) "\n")) - ((= gnus-soup-encoding-type ?M) - "\^a\^a\^a\^a\n") - (t (error "Unsupported type: %c" gnus-soup-encoding-type)))) - ;; Insert the soup header and the article in the MSG buf. - (set-buffer msg-buf) - (goto-char (point-max)) - (insert head-line) - (setq beg (point)) - (insert-buffer-substring article-buf) - ;; Insert the index in the IDX buf. - (cond ((= index ?c) - (set-buffer idx-buf) - (gnus-soup-insert-idx beg headers)) - ((/= index ?n) - (error "Unknown index type: %c" type))) - ;; Return the MSG buf. - msg-buf))) - -(defun gnus-soup-group-brew (group &optional not-all) - "Enter GROUP and add all articles to a SOUP package. -If NOT-ALL, don't pack ticked articles." - (let ((gnus-expert-user t) - (gnus-large-newsgroup nil) - (entry (gnus-gethash group gnus-newsrc-hashtb))) - (when (or (null entry) - (eq (car entry) t) - (and (car entry) - (> (car entry) 0)) - (and (not not-all) - (gnus-range-length (cdr (assq 'tick (gnus-info-marks - (nth 2 entry))))))) - (when (gnus-summary-read-group group nil t) - (setq gnus-newsgroup-processable - (reverse - (if (not not-all) - (append gnus-newsgroup-marked gnus-newsgroup-unreads) - gnus-newsgroup-unreads))) - (gnus-soup-add-article nil) - (gnus-summary-exit))))) - -(defun gnus-soup-insert-idx (offset header) - ;; [number subject from date id references chars lines xref] - (goto-char (point-max)) - (insert - (format "%d\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t\t\n" - offset - (or (mail-header-subject header) "(none)") - (or (mail-header-from header) "(nobody)") - (or (mail-header-date header) "") - (or (mail-header-id header) - (concat "soup-dummy-id-" - (mapconcat - (lambda (time) (int-to-string time)) - (current-time) "-"))) - (or (mail-header-references header) "") - (or (mail-header-chars header) 0) - (or (mail-header-lines header) "0")))) - -(defun gnus-soup-save-areas () - (gnus-soup-write-areas) - (save-excursion - (let (buf) - (while gnus-soup-buffers - (setq buf (car gnus-soup-buffers) - gnus-soup-buffers (cdr gnus-soup-buffers)) - (if (not (buffer-name buf)) - () - (set-buffer buf) - (when (buffer-modified-p) - (save-buffer)) - (kill-buffer (current-buffer))))) - (gnus-soup-write-prefixes))) - -(defun gnus-soup-write-prefixes () - (let ((prefixes gnus-soup-last-prefix) - prefix) - (save-excursion - (gnus-set-work-buffer) - (while (setq prefix (pop prefixes)) - (erase-buffer) - (insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdr prefix))) - (gnus-write-buffer (concat (car prefix) gnus-soup-prefix-file)))))) - -(defun gnus-soup-pack (dir packer) - (let* ((files (mapconcat 'identity - '("AREAS" "*.MSG" "*.IDX" "INFO" - "LIST" "REPLIES" "COMMANDS" "ERRORS") - " ")) - (packer (if (< (string-match "%s" packer) - (string-match "%d" packer)) - (format packer files - (string-to-int (gnus-soup-unique-prefix dir))) - (format packer - (string-to-int (gnus-soup-unique-prefix dir)) - files))) - (dir (expand-file-name dir))) - (gnus-make-directory dir) - (setq gnus-soup-areas nil) - (gnus-message 4 "Packing %s..." packer) - (if (zerop (call-process shell-file-name - nil nil nil shell-command-switch - (concat "cd " dir " ; " packer))) - (progn - (call-process shell-file-name nil nil nil shell-command-switch - (concat "cd " dir " ; rm " files)) - (gnus-message 4 "Packing...done" packer)) - (error "Couldn't pack packet")))) - -(defun gnus-soup-parse-areas (file) - "Parse soup area file FILE. -The result is a of vectors, each containing one entry from the AREA file. -The vector contain five strings, - [prefix name encoding description number] -though the two last may be nil if they are missing." - (let (areas) - (save-excursion - (set-buffer (nnheader-find-file-noselect file 'force)) - (buffer-disable-undo (current-buffer)) - (goto-char (point-min)) - (while (not (eobp)) - (push (vector (gnus-soup-field) - (gnus-soup-field) - (gnus-soup-field) - (and (eq (preceding-char) ?\t) - (gnus-soup-field)) - (and (eq (preceding-char) ?\t) - (string-to-int (gnus-soup-field)))) - areas) - (when (eq (preceding-char) ?\t) - (beginning-of-line 2))) - (kill-buffer (current-buffer))) - areas)) - -(defun gnus-soup-parse-replies (file) - "Parse soup REPLIES file FILE. -The result is a of vectors, each containing one entry from the REPLIES -file. The vector contain three strings, [prefix name encoding]." - (let (replies) - (save-excursion - (set-buffer (nnheader-find-file-noselect file)) - (buffer-disable-undo (current-buffer)) - (goto-char (point-min)) - (while (not (eobp)) - (push (vector (gnus-soup-field) (gnus-soup-field) - (gnus-soup-field)) - replies) - (when (eq (preceding-char) ?\t) - (beginning-of-line 2))) - (kill-buffer (current-buffer))) - replies)) - -(defun gnus-soup-field () - (prog1 - (buffer-substring (point) (progn (skip-chars-forward "^\t\n") (point))) - (forward-char 1))) - -(defun gnus-soup-read-areas () - (or gnus-soup-areas - (setq gnus-soup-areas - (gnus-soup-parse-areas (concat gnus-soup-directory "AREAS"))))) - -(defun gnus-soup-write-areas () - "Write the AREAS file." - (interactive) - (when gnus-soup-areas - (nnheader-temp-write (concat gnus-soup-directory "AREAS") - (let ((areas gnus-soup-areas) - area) - (while (setq area (pop areas)) - (insert - (format - "%s\t%s\t%s%s\n" - (gnus-soup-area-prefix area) - (gnus-soup-area-name area) - (gnus-soup-area-encoding area) - (if (or (gnus-soup-area-description area) - (gnus-soup-area-number area)) - (concat "\t" (or (gnus-soup-area-description - area) "") - (if (gnus-soup-area-number area) - (concat "\t" (int-to-string - (gnus-soup-area-number area))) - "")) "")))))))) - -(defun gnus-soup-write-replies (dir areas) - "Write a REPLIES file in DIR containing AREAS." - (nnheader-temp-write (concat dir "REPLIES") - (let (area) - (while (setq area (pop areas)) - (insert (format "%s\t%s\t%s\n" - (gnus-soup-reply-prefix area) - (gnus-soup-reply-kind area) - (gnus-soup-reply-encoding area))))))) - -(defun gnus-soup-area (group) - (gnus-soup-read-areas) - (let ((areas gnus-soup-areas) - (real-group (gnus-group-real-name group)) - area result) - (while areas - (setq area (car areas) - areas (cdr areas)) - (when (equal (gnus-soup-area-name area) real-group) - (setq result area))) - (unless result - (setq result - (vector (gnus-soup-unique-prefix) - real-group - (format "%c%c%c" - gnus-soup-encoding-type - gnus-soup-index-type - (if (gnus-member-of-valid 'mail group) ?m ?n)) - nil nil) - gnus-soup-areas (cons result gnus-soup-areas))) - result)) - -(defun gnus-soup-unique-prefix (&optional dir) - (let* ((dir (file-name-as-directory (or dir gnus-soup-directory))) - (entry (assoc dir gnus-soup-last-prefix)) - gnus-soup-prev-prefix) - (if entry - () - (when (file-exists-p (concat dir gnus-soup-prefix-file)) - (ignore-errors - (load (concat dir gnus-soup-prefix-file) nil t t))) - (push (setq entry (cons dir (or gnus-soup-prev-prefix 0))) - gnus-soup-last-prefix)) - (setcdr entry (1+ (cdr entry))) - (gnus-soup-write-prefixes) - (int-to-string (cdr entry)))) - -(defun gnus-soup-unpack-packet (dir unpacker packet) - "Unpack PACKET into DIR using UNPACKER. -Return whether the unpacking was successful." - (gnus-make-directory dir) - (gnus-message 4 "Unpacking: %s" (format unpacker packet)) - (prog1 - (zerop (call-process - shell-file-name nil nil nil shell-command-switch - (format "cd %s ; %s" (expand-file-name dir) - (format unpacker packet)))) - (gnus-message 4 "Unpacking...done"))) - -(defun gnus-soup-send-packet (packet) - (gnus-soup-unpack-packet - gnus-soup-replies-directory gnus-soup-unpacker packet) - (let ((replies (gnus-soup-parse-replies - (concat gnus-soup-replies-directory "REPLIES")))) - (save-excursion - (while replies - (let* ((msg-file (concat gnus-soup-replies-directory - (gnus-soup-reply-prefix (car replies)) - ".MSG")) - (msg-buf (and (file-exists-p msg-file) - (nnheader-find-file-noselect msg-file))) - (tmp-buf (get-buffer-create " *soup send*")) - beg end) - (cond - ((/= (gnus-soup-encoding-format - (gnus-soup-reply-encoding (car replies))) - ?n) - (error "Unsupported encoding")) - ((null msg-buf) - t) - (t - (buffer-disable-undo msg-buf) - (buffer-disable-undo tmp-buf) - (set-buffer msg-buf) - (goto-char (point-min)) - (while (not (eobp)) - (unless (looking-at "#! *rnews +\\([0-9]+\\)") - (error "Bad header")) - (forward-line 1) - (setq beg (point) - end (+ (point) (string-to-int - (buffer-substring - (match-beginning 1) (match-end 1))))) - (switch-to-buffer tmp-buf) - (erase-buffer) - (insert-buffer-substring msg-buf beg end) - (goto-char (point-min)) - (search-forward "\n\n") - (forward-char -1) - (insert mail-header-separator) - (setq message-newsreader (setq message-mailer - (gnus-extended-version))) - (cond - ((string= (gnus-soup-reply-kind (car replies)) "news") - (gnus-message 5 "Sending news message to %s..." - (mail-fetch-field "newsgroups")) - (sit-for 1) - (let ((message-syntax-checks - 'dont-check-for-anything-just-trust-me)) - (funcall message-send-news-function))) - ((string= (gnus-soup-reply-kind (car replies)) "mail") - (gnus-message 5 "Sending mail to %s..." - (mail-fetch-field "to")) - (sit-for 1) - (message-send-mail)) - (t - (error "Unknown reply kind"))) - (set-buffer msg-buf) - (goto-char end)) - (delete-file (buffer-file-name)) - (kill-buffer msg-buf) - (kill-buffer tmp-buf) - (gnus-message 4 "Sent packet")))) - (setq replies (cdr replies))) - t))) - -(provide 'gnus-soup) - -;;; gnus-soup.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-spec.el --- a/lisp/gnus/gnus-spec.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,528 +0,0 @@ -;;; gnus-spec.el --- format spec functions for Gnus -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) - -;;; Internal variables. - -(defvar gnus-summary-mark-positions nil) -(defvar gnus-group-mark-positions nil) -(defvar gnus-group-indentation "") - -;; Format specs. The chunks below are the machine-generated forms -;; that are to be evaled as the result of the default format strings. -;; We write them in here to get them byte-compiled. That way the -;; default actions will be quite fast, while still retaining the full -;; flexibility of the user-defined format specs. - -;; First we have lots of dummy defvars to let the compiler know these -;; are really dynamic variables. - -(defvar gnus-tmp-unread) -(defvar gnus-tmp-replied) -(defvar gnus-tmp-score-char) -(defvar gnus-tmp-indentation) -(defvar gnus-tmp-opening-bracket) -(defvar gnus-tmp-lines) -(defvar gnus-tmp-name) -(defvar gnus-tmp-closing-bracket) -(defvar gnus-tmp-subject-or-nil) -(defvar gnus-tmp-subject) -(defvar gnus-tmp-marked) -(defvar gnus-tmp-marked-mark) -(defvar gnus-tmp-subscribed) -(defvar gnus-tmp-process-marked) -(defvar gnus-tmp-number-of-unread) -(defvar gnus-tmp-group-name) -(defvar gnus-tmp-group) -(defvar gnus-tmp-article-number) -(defvar gnus-tmp-unread-and-unselected) -(defvar gnus-tmp-news-method) -(defvar gnus-tmp-news-server) -(defvar gnus-tmp-article-number) -(defvar gnus-mouse-face) -(defvar gnus-mouse-face-prop) - -(defun gnus-summary-line-format-spec () - (insert gnus-tmp-unread gnus-tmp-replied - gnus-tmp-score-char gnus-tmp-indentation) - (gnus-put-text-property - (point) - (progn - (insert - gnus-tmp-opening-bracket - (format "%4d: %-20s" - gnus-tmp-lines - (if (> (length gnus-tmp-name) 20) - (substring gnus-tmp-name 0 20) - gnus-tmp-name)) - gnus-tmp-closing-bracket) - (point)) - gnus-mouse-face-prop gnus-mouse-face) - (insert " " gnus-tmp-subject-or-nil "\n")) - -(defvar gnus-summary-line-format-spec - (gnus-byte-code 'gnus-summary-line-format-spec)) - -(defun gnus-summary-dummy-line-format-spec () - (insert "* ") - (gnus-put-text-property - (point) - (progn - (insert ": :") - (point)) - gnus-mouse-face-prop gnus-mouse-face) - (insert " " gnus-tmp-subject "\n")) - -(defvar gnus-summary-dummy-line-format-spec - (gnus-byte-code 'gnus-summary-dummy-line-format-spec)) - -(defun gnus-group-line-format-spec () - (insert gnus-tmp-marked-mark gnus-tmp-subscribed - gnus-tmp-process-marked - gnus-group-indentation - (format "%5s: " gnus-tmp-number-of-unread)) - (gnus-put-text-property - (point) - (progn - (insert gnus-tmp-group "\n") - (1- (point))) - gnus-mouse-face-prop gnus-mouse-face)) -(defvar gnus-group-line-format-spec - (gnus-byte-code 'gnus-group-line-format-spec)) - -(defvar gnus-format-specs - `((version . ,emacs-version) - (group "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec) - (summary-dummy "* %(: :%) %S\n" - ,gnus-summary-dummy-line-format-spec) - (summary "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n" - ,gnus-summary-line-format-spec)) - "Alist of format specs.") - -(defvar gnus-article-mode-line-format-spec nil) -(defvar gnus-summary-mode-line-format-spec nil) -(defvar gnus-group-mode-line-format-spec nil) - -;;; Phew. All that gruft is over, fortunately. - -;;;###autoload -(defun gnus-update-format (var) - "Update the format specification near point." - (interactive - (list - (save-excursion - (eval-defun nil) - ;; Find the end of the current word. - (re-search-forward "[ \t\n]" nil t) - ;; Search backward. - (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t) - (match-string 1))))) - (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var) - (match-string 1 var)))) - (entry (assq type gnus-format-specs)) - value spec) - (when entry - (setq gnus-format-specs (delq entry gnus-format-specs))) - (set - (intern (format "%s-spec" var)) - (gnus-parse-format (setq value (symbol-value (intern var))) - (symbol-value (intern (format "%s-alist" var))) - (not (string-match "mode" var)))) - (setq spec (symbol-value (intern (format "%s-spec" var)))) - (push (list type value spec) gnus-format-specs) - - (pop-to-buffer "*Gnus Format*") - (erase-buffer) - (lisp-interaction-mode) - (insert (pp-to-string spec)))) - -(defun gnus-update-format-specifications (&optional force &rest types) - "Update all (necessary) format specifications." - ;; Make the indentation array. - ;; See whether all the stored info needs to be flushed. - (when (or force - (not (equal emacs-version - (cdr (assq 'version gnus-format-specs))))) - (setq gnus-format-specs nil)) - - ;; Go through all the formats and see whether they need updating. - (let (new-format entry type val) - (while (setq type (pop types)) - ;; Jump to the proper buffer to find out the value of - ;; the variable, if possible. (It may be buffer-local.) - (save-excursion - (let ((buffer (intern (format "gnus-%s-buffer" type))) - val) - (when (and (boundp buffer) - (setq val (symbol-value buffer)) - (get-buffer val) - (buffer-name (get-buffer val))) - (set-buffer (get-buffer val))) - (setq new-format (symbol-value - (intern (format "gnus-%s-line-format" type))))) - (setq entry (cdr (assq type gnus-format-specs))) - (if (and (car entry) - (equal (car entry) new-format)) - ;; Use the old format. - (set (intern (format "gnus-%s-line-format-spec" type)) - (cadr entry)) - ;; This is a new format. - (setq val - (if (not (stringp new-format)) - ;; This is a function call or something. - new-format - ;; This is a "real" format. - (gnus-parse-format - new-format - (symbol-value - (intern (format "gnus-%s-line-format-alist" - (if (eq type 'article-mode) - 'summary-mode type)))) - (not (string-match "mode$" (symbol-name type)))))) - ;; Enter the new format spec into the list. - (if entry - (progn - (setcar (cdr entry) val) - (setcar entry new-format)) - (push (list type new-format val) gnus-format-specs)) - (set (intern (format "gnus-%s-line-format-spec" type)) val))))) - - (unless (assq 'version gnus-format-specs) - (push (cons 'version emacs-version) gnus-format-specs))) - -(defvar gnus-mouse-face-0 'highlight) -(defvar gnus-mouse-face-1 'highlight) -(defvar gnus-mouse-face-2 'highlight) -(defvar gnus-mouse-face-3 'highlight) -(defvar gnus-mouse-face-4 'highlight) - -(defun gnus-mouse-face-function (form type) - `(gnus-put-text-property - (point) (progn ,@form (point)) - gnus-mouse-face-prop - ,(if (equal type 0) - 'gnus-mouse-face - `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type))))))) - -(defvar gnus-face-0 'bold) -(defvar gnus-face-1 'italic) -(defvar gnus-face-2 'bold-italic) -(defvar gnus-face-3 'bold) -(defvar gnus-face-4 'bold) - -(defun gnus-face-face-function (form type) - `(gnus-put-text-property - (point) (progn ,@form (point)) - 'face ',(symbol-value (intern (format "gnus-face-%d" type))))) - -(defun gnus-tilde-max-form (el max-width) - "Return a form that limits EL to MAX-WIDTH." - (let ((max (abs max-width))) - (if (symbolp el) - `(if (> (length ,el) ,max) - ,(if (< max-width 0) - `(substring ,el (- (length el) ,max)) - `(substring ,el 0 ,max)) - ,el) - `(let ((val (eval ,el))) - (if (> (length val) ,max) - ,(if (< max-width 0) - `(substring val (- (length val) ,max)) - `(substring val 0 ,max)) - val))))) - -(defun gnus-tilde-cut-form (el cut-width) - "Return a form that cuts CUT-WIDTH off of EL." - (let ((cut (abs cut-width))) - (if (symbolp el) - `(if (> (length ,el) ,cut) - ,(if (< cut-width 0) - `(substring ,el 0 (- (length el) ,cut)) - `(substring ,el ,cut)) - ,el) - `(let ((val (eval ,el))) - (if (> (length val) ,cut) - ,(if (< cut-width 0) - `(substring val 0 (- (length val) ,cut)) - `(substring val ,cut)) - val))))) - -(defun gnus-tilde-ignore-form (el ignore-value) - "Return a form that is blank when EL is IGNORE-VALUE." - (if (symbolp el) - `(if (equal ,el ,ignore-value) - "" ,el) - `(let ((val (eval ,el))) - (if (equal val ,ignore-value) - "" val)))) - -(defun gnus-parse-format (format spec-alist &optional insert) - ;; This function parses the FORMAT string with the help of the - ;; SPEC-ALIST and returns a list that can be eval'ed to return the - ;; string. If the FORMAT string contains the specifiers %( and %) - ;; the text between them will have the mouse-face text property. - (if (string-match - "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'" - format) - (gnus-parse-complex-format format spec-alist) - ;; This is a simple format. - (gnus-parse-simple-format format spec-alist insert))) - -(defun gnus-parse-complex-format (format spec-alist) - (save-excursion - (gnus-set-work-buffer) - (insert format) - (goto-char (point-min)) - (while (re-search-forward "\"" nil t) - (replace-match "\\\"" nil t)) - (goto-char (point-min)) - (insert "(\"") - (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t) - (let ((number (if (match-beginning 1) - (match-string 1) "0")) - (delim (aref (match-string 2) 0))) - (if (or (= delim ?\() (= delim ?\{)) - (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face") - " " number " \"")) - (replace-match "\")\"")))) - (goto-char (point-max)) - (insert "\")") - (goto-char (point-min)) - (let ((form (read (current-buffer)))) - (cons 'progn (gnus-complex-form-to-spec form spec-alist))))) - -(defun gnus-complex-form-to-spec (form spec-alist) - (delq nil - (mapcar - (lambda (sform) - (if (stringp sform) - (gnus-parse-simple-format sform spec-alist t) - (funcall (intern (format "gnus-%s-face-function" (car sform))) - (gnus-complex-form-to-spec (cddr sform) spec-alist) - (nth 1 sform)))) - form))) - -(defun gnus-parse-simple-format (format spec-alist &optional insert) - ;; This function parses the FORMAT string with the help of the - ;; SPEC-ALIST and returns a list that can be eval'ed to return a - ;; string. - (let ((max-width 0) - spec flist fstring elem result dontinsert user-defined - type value pad-width spec-beg cut-width ignore-value - tilde-form tilde elem-type) - (save-excursion - (gnus-set-work-buffer) - (insert format) - (goto-char (point-min)) - (while (re-search-forward "%" nil t) - (setq user-defined nil - spec-beg nil - pad-width nil - max-width nil - cut-width nil - ignore-value nil - tilde-form nil) - (setq spec-beg (1- (point))) - - ;; Parse this spec fully. - (while - (cond - ((looking-at "\\([-.0-9]+\\)\\(,[-0-9]+\\)?") - (setq pad-width (string-to-number (match-string 1))) - (when (match-beginning 2) - (setq max-width (string-to-number (buffer-substring - (1+ (match-beginning 2)) - (match-end 2))))) - (goto-char (match-end 0))) - ((looking-at "~") - (forward-char 1) - (setq tilde (read (current-buffer)) - type (car tilde) - value (cadr tilde)) - (cond - ((memq type '(pad pad-left)) - (setq pad-width value)) - ((eq type 'pad-right) - (setq pad-width (- value))) - ((memq type '(max-right max)) - (setq max-width value)) - ((eq type 'max-left) - (setq max-width (- value))) - ((memq type '(cut cut-left)) - (setq cut-width value)) - ((eq type 'cut-right) - (setq cut-width (- value))) - ((eq type 'ignore) - (setq ignore-value - (if (stringp value) value (format "%s" value)))) - ((eq type 'form) - (setq tilde-form value)) - (t - (error "Unknown tilde type: %s" tilde))) - t) - (t - nil))) - ;; User-defined spec -- find the spec name. - (when (= (setq spec (following-char)) ?u) - (forward-char 1) - (setq user-defined (following-char))) - (forward-char 1) - (delete-region spec-beg (point)) - - ;; Now we have all the relevant data on this spec, so - ;; we start doing stuff. - (insert "%") - (if (eq spec ?%) - ;; "%%" just results in a "%". - (insert "%") - (cond - ;; Do tilde forms. - ((eq spec ?@) - (setq elem (list tilde-form ?s))) - ;; Treat user defined format specifiers specially. - (user-defined - (setq elem - (list - (list (intern (format "gnus-user-format-function-%c" - user-defined)) - 'gnus-tmp-header) - ?s))) - ;; Find the specification from `spec-alist'. - ((setq elem (cdr (assq spec spec-alist)))) - (t - (setq elem '("*" ?s)))) - (setq elem-type (cadr elem)) - ;; Insert the new format elements. - (when pad-width - (insert (number-to-string pad-width))) - ;; Create the form to be evaled. - (if (or max-width cut-width ignore-value) - (progn - (insert ?s) - (let ((el (car elem))) - (cond ((= (cadr elem) ?c) - (setq el (list 'char-to-string el))) - ((= (cadr elem) ?d) - (setq el (list 'int-to-string el)))) - (when ignore-value - (setq el (gnus-tilde-ignore-form el ignore-value))) - (when cut-width - (setq el (gnus-tilde-cut-form el cut-width))) - (when max-width - (setq el (gnus-tilde-max-form el max-width))) - (push el flist))) - (insert elem-type) - (push (car elem) flist)))) - (setq fstring (buffer-string))) - - ;; Do some postprocessing to increase efficiency. - (setq - result - (cond - ;; Emptyness. - ((string= fstring "") - nil) - ;; Not a format string. - ((not (string-match "%" fstring)) - (list fstring)) - ;; A format string with just a single string spec. - ((string= fstring "%s") - (list (car flist))) - ;; A single character. - ((string= fstring "%c") - (list (car flist))) - ;; A single number. - ((string= fstring "%d") - (setq dontinsert) - (if insert - (list `(princ ,(car flist))) - (list `(int-to-string ,(car flist))))) - ;; Just lots of chars and strings. - ((string-match "\\`\\(%[cs]\\)+\\'" fstring) - (nreverse flist)) - ;; A single string spec at the beginning of the spec. - ((string-match "\\`%[sc][^%]+\\'" fstring) - (list (car flist) (substring fstring 2))) - ;; A single string spec in the middle of the spec. - ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring) - (list (match-string 1 fstring) (car flist) (match-string 2 fstring))) - ;; A single string spec in the end of the spec. - ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring) - (list (match-string 1 fstring) (car flist))) - ;; A more complex spec. - (t - (list (cons 'format (cons fstring (nreverse flist))))))) - - (if insert - (when result - (if dontinsert - result - (cons 'insert result))) - (cond ((stringp result) - result) - ((consp result) - (cons 'concat result)) - (t ""))))) - -(defun gnus-eval-format (format &optional alist props) - "Eval the format variable FORMAT, using ALIST. -If PROPS, insert the result." - (let ((form (gnus-parse-format format alist props))) - (if props - (gnus-add-text-properties (point) (progn (eval form) (point)) props) - (eval form)))) - -(defun gnus-compile () - "Byte-compile the user-defined format specs." - (interactive) - (when gnus-xemacs - (error "Can't compile specs under XEmacs")) - (let ((entries gnus-format-specs) - (byte-compile-warnings '(unresolved callargs redefine)) - entry gnus-tmp-func) - (save-excursion - (gnus-message 7 "Compiling format specs...") - - (while entries - (setq entry (pop entries)) - (if (eq (car entry) 'version) - (setq gnus-format-specs (delq entry gnus-format-specs)) - (when (and (listp (caddr entry)) - (not (eq 'byte-code (caaddr entry)))) - (fset 'gnus-tmp-func `(lambda () ,(caddr entry))) - (byte-compile 'gnus-tmp-func) - (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func))))) - - (push (cons 'version emacs-version) gnus-format-specs) - ;; Mark the .newsrc.eld file as "dirty". - (gnus-dribble-enter " ") - (gnus-message 7 "Compiling user specs...done")))) - -(provide 'gnus-spec) - -;;; gnus-spec.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-srvr.el --- a/lisp/gnus/gnus-srvr.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,753 +0,0 @@ -;;; gnus-srvr.el --- virtual server support for Gnus -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-spec) -(require 'gnus-group) -(require 'gnus-int) -(require 'gnus-range) - -(defvar gnus-server-mode-hook nil - "Hook run in `gnus-server-mode' buffers.") - -(defconst gnus-server-line-format " {%(%h:%w%)} %s\n" - "Format of server lines. -It works along the same lines as a normal formatting string, -with some simple extensions.") - -(defvar gnus-server-mode-line-format "Gnus List of servers" - "The format specification for the server mode line.") - -(defvar gnus-server-exit-hook nil - "*Hook run when exiting the server buffer.") - -;;; Internal variables. - -(defvar gnus-inserted-opened-servers nil) - -(defvar gnus-server-line-format-alist - `((?h how ?s) - (?n name ?s) - (?w where ?s) - (?s status ?s))) - -(defvar gnus-server-mode-line-format-alist - `((?S news-server ?s) - (?M news-method ?s) - (?u user-defined ?s))) - -(defvar gnus-server-line-format-spec nil) -(defvar gnus-server-mode-line-format-spec nil) -(defvar gnus-server-killed-servers nil) - -(defvar gnus-server-mode-map) - -(defvar gnus-server-menu-hook nil - "*Hook run after the creation of the server mode menu.") - -(defun gnus-server-make-menu-bar () - (gnus-turn-off-edit-menu 'server) - (unless (boundp 'gnus-server-server-menu) - (easy-menu-define - gnus-server-server-menu gnus-server-mode-map "" - '("Server" - ["Add" gnus-server-add-server t] - ["Browse" gnus-server-read-server t] - ["Scan" gnus-server-scan-server t] - ["List" gnus-server-list-servers t] - ["Kill" gnus-server-kill-server t] - ["Yank" gnus-server-yank-server t] - ["Copy" gnus-server-copy-server t] - ["Edit" gnus-server-edit-server t] - ["Regenerate" gnus-server-regenerate-server t] - ["Exit" gnus-server-exit t])) - - (easy-menu-define - gnus-server-connections-menu gnus-server-mode-map "" - '("Connections" - ["Open" gnus-server-open-server t] - ["Close" gnus-server-close-server t] - ["Deny" gnus-server-deny-server t] - "---" - ["Open All" gnus-server-open-all-servers t] - ["Close All" gnus-server-close-all-servers t] - ["Reset All" gnus-server-remove-denials t])) - - (run-hooks 'gnus-server-menu-hook))) - -(defvar gnus-server-mode-map nil) -(put 'gnus-server-mode 'mode-class 'special) - -(unless gnus-server-mode-map - (setq gnus-server-mode-map (make-sparse-keymap)) - (suppress-keymap gnus-server-mode-map) - - (gnus-define-keys - gnus-server-mode-map - " " gnus-server-read-server - "\r" gnus-server-read-server - gnus-mouse-2 gnus-server-pick-server - "q" gnus-server-exit - "l" gnus-server-list-servers - "k" gnus-server-kill-server - "y" gnus-server-yank-server - "c" gnus-server-copy-server - "a" gnus-server-add-server - "e" gnus-server-edit-server - "s" gnus-server-scan-server - - "O" gnus-server-open-server - "\M-o" gnus-server-open-all-servers - "C" gnus-server-close-server - "\M-c" gnus-server-close-all-servers - "D" gnus-server-deny-server - "R" gnus-server-remove-denials - - "g" gnus-server-regenerate-server - - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug)) - -(defun gnus-server-mode () - "Major mode for listing and editing servers. - -All normal editing commands are switched off. -\\ -For more in-depth information on this mode, read the manual -(`\\[gnus-info-find-node]'). - -The following commands are available: - -\\{gnus-server-mode-map}" - (interactive) - (when (gnus-visual-p 'server-menu 'menu) - (gnus-server-make-menu-bar)) - (kill-all-local-variables) - (gnus-simplify-mode-line) - (setq major-mode 'gnus-server-mode) - (setq mode-name "Server") - (gnus-set-default-directory) - (setq mode-line-process nil) - (use-local-map gnus-server-mode-map) - (buffer-disable-undo (current-buffer)) - (setq truncate-lines t) - (setq buffer-read-only t) - (run-hooks 'gnus-server-mode-hook)) - -(defun gnus-server-insert-server-line (name method) - (let* ((how (car method)) - (where (nth 1 method)) - (elem (assoc method gnus-opened-servers)) - (status (cond ((eq (nth 1 elem) 'denied) - "(denied)") - ((or (gnus-server-opened method) - (eq (nth 1 elem) 'ok)) - "(opened)") - (t - "(closed)")))) - (beginning-of-line) - (gnus-add-text-properties - (point) - (prog1 (1+ (point)) - ;; Insert the text. - (eval gnus-server-line-format-spec)) - (list 'gnus-server (intern name))))) - -(defun gnus-enter-server-buffer () - "Set up the server buffer." - (gnus-server-setup-buffer) - (gnus-configure-windows 'server) - (gnus-server-prepare)) - -(defun gnus-server-setup-buffer () - "Initialize the server buffer." - (unless (get-buffer gnus-server-buffer) - (save-excursion - (set-buffer (get-buffer-create gnus-server-buffer)) - (gnus-server-mode) - (when gnus-carpal - (gnus-carpal-setup-buffer 'server))))) - -(defun gnus-server-prepare () - (setq gnus-server-mode-line-format-spec - (gnus-parse-format gnus-server-mode-line-format - gnus-server-mode-line-format-alist)) - (setq gnus-server-line-format-spec - (gnus-parse-format gnus-server-line-format - gnus-server-line-format-alist t)) - (let ((alist gnus-server-alist) - (buffer-read-only nil) - (opened gnus-opened-servers) - done server op-ser) - (erase-buffer) - (setq gnus-inserted-opened-servers nil) - ;; First we do the real list of servers. - (while alist - (unless (member (cdar alist) done) - (push (cdar alist) done) - (cdr (setq server (pop alist))) - (when (and server (car server) (cdr server)) - (gnus-server-insert-server-line (car server) (cdr server)))) - (when (member (cdar alist) done) - (pop alist))) - ;; Then we insert the list of servers that have been opened in - ;; this session. - (while opened - (unless (member (caar opened) done) - (push (caar opened) done) - (gnus-server-insert-server-line - (setq op-ser (format "%s:%s" (caaar opened) (nth 1 (caar opened)))) - (caar opened)) - (push (list op-ser (caar opened)) gnus-inserted-opened-servers)) - (setq opened (cdr opened)))) - (goto-char (point-min)) - (gnus-server-position-point)) - -(defun gnus-server-server-name () - (let ((server (get-text-property (gnus-point-at-bol) 'gnus-server))) - (and server (symbol-name server)))) - -(defalias 'gnus-server-position-point 'gnus-goto-colon) - -(defconst gnus-server-edit-buffer "*Gnus edit server*") - -(defun gnus-server-update-server (server) - (save-excursion - (set-buffer gnus-server-buffer) - (let* ((buffer-read-only nil) - (entry (assoc server gnus-server-alist)) - (oentry (assoc (gnus-server-to-method server) - gnus-opened-servers))) - (when entry - (gnus-dribble-enter - (concat "(gnus-server-set-info \"" server "\" '" - (prin1-to-string (cdr entry)) ")\n"))) - (when (or entry oentry) - ;; Buffer may be narrowed. - (save-restriction - (widen) - (when (gnus-server-goto-server server) - (gnus-delete-line)) - (if entry - (gnus-server-insert-server-line (car entry) (cdr entry)) - (gnus-server-insert-server-line - (format "%s:%s" (caar oentry) (nth 1 (car oentry))) - (car oentry))) - (gnus-server-position-point)))))) - -(defun gnus-server-set-info (server info) - ;; Enter a select method into the virtual server alist. - (when (and server info) - (gnus-dribble-enter - (concat "(gnus-server-set-info \"" server "\" '" - (prin1-to-string info) ")")) - (let* ((server (nth 1 info)) - (entry (assoc server gnus-server-alist))) - (if entry (setcdr entry info) - (setq gnus-server-alist - (nconc gnus-server-alist (list (cons server info)))))))) - -;;; Interactive server functions. - -(defun gnus-server-kill-server (server) - "Kill the server on the current line." - (interactive (list (gnus-server-server-name))) - (unless (gnus-server-goto-server server) - (if server (error "No such server: %s" server) - (error "No server on the current line"))) - (unless (assoc server gnus-server-alist) - (error "Read-only server %s" server)) - (gnus-dribble-enter "") - (let ((buffer-read-only nil)) - (gnus-delete-line)) - (push (assoc server gnus-server-alist) gnus-server-killed-servers) - (setq gnus-server-alist (delq (car gnus-server-killed-servers) - gnus-server-alist)) - (gnus-server-position-point)) - -(defun gnus-server-yank-server () - "Yank the previously killed server." - (interactive) - (unless gnus-server-killed-servers - (error "No killed servers to be yanked")) - (let ((alist gnus-server-alist) - (server (gnus-server-server-name)) - (killed (car gnus-server-killed-servers))) - (if (not server) - (setq gnus-server-alist (nconc gnus-server-alist (list killed))) - (if (string= server (caar gnus-server-alist)) - (push killed gnus-server-alist) - (while (and (cdr alist) - (not (string= server (caadr alist)))) - (setq alist (cdr alist))) - (if alist - (setcdr alist (cons killed (cdr alist))) - (setq gnus-server-alist (list killed))))) - (gnus-server-update-server (car killed)) - (setq gnus-server-killed-servers (cdr gnus-server-killed-servers)) - (gnus-server-position-point))) - -(defun gnus-server-exit () - "Return to the group buffer." - (interactive) - (run-hooks 'gnus-server-exit-hook) - (kill-buffer (current-buffer)) - (gnus-configure-windows 'group t)) - -(defun gnus-server-list-servers () - "List all available servers." - (interactive) - (let ((cur (gnus-server-server-name))) - (gnus-server-prepare) - (if cur (gnus-server-goto-server cur) - (goto-char (point-max)) - (forward-line -1)) - (gnus-server-position-point))) - -(defun gnus-server-set-status (method status) - "Make METHOD have STATUS." - (let ((entry (assoc method gnus-opened-servers))) - (if entry - (setcar (cdr entry) status) - (push (list method status) gnus-opened-servers)))) - -(defun gnus-opened-servers-remove (method) - "Remove METHOD from the list of opened servers." - (setq gnus-opened-servers (delq (assoc method gnus-opened-servers) - gnus-opened-servers))) - -(defun gnus-server-open-server (server) - "Force an open of SERVER." - (interactive (list (gnus-server-server-name))) - (let ((method (gnus-server-to-method server))) - (unless method - (error "No such server: %s" server)) - (gnus-server-set-status method 'ok) - (prog1 - (or (gnus-open-server method) - (progn (message "Couldn't open %s" server) nil)) - (gnus-server-update-server server) - (gnus-server-position-point)))) - -(defun gnus-server-open-all-servers () - "Open all servers." - (interactive) - (let ((servers gnus-inserted-opened-servers)) - (while servers - (gnus-server-open-server (car (pop servers)))))) - -(defun gnus-server-close-server (server) - "Close SERVER." - (interactive (list (gnus-server-server-name))) - (let ((method (gnus-server-to-method server))) - (unless method - (error "No such server: %s" server)) - (gnus-server-set-status method 'closed) - (prog1 - (gnus-close-server method) - (gnus-server-update-server server) - (gnus-server-position-point)))) - -(defun gnus-server-close-all-servers () - "Close all servers." - (interactive) - (let ((servers gnus-inserted-opened-servers)) - (while servers - (gnus-server-close-server (car (pop servers)))))) - -(defun gnus-server-deny-server (server) - "Make sure SERVER will never be attempted opened." - (interactive (list (gnus-server-server-name))) - (let ((method (gnus-server-to-method server))) - (unless method - (error "No such server: %s" server)) - (gnus-server-set-status method 'denied)) - (gnus-server-update-server server) - (gnus-server-position-point) - t) - -(defun gnus-server-remove-denials () - "Make all denied servers into closed servers." - (interactive) - (let ((servers gnus-opened-servers)) - (while servers - (when (eq (nth 1 (car servers)) 'denied) - (setcar (nthcdr 1 (car servers)) 'closed)) - (setq servers (cdr servers)))) - (gnus-server-list-servers)) - -(defun gnus-server-copy-server (from to) - (interactive - (list - (or (gnus-server-server-name) - (error "No server on the current line")) - (read-string "Copy to: "))) - (unless from - (error "No server on current line")) - (unless (and to (not (string= to ""))) - (error "No name to copy to")) - (when (assoc to gnus-server-alist) - (error "%s already exists" to)) - (unless (gnus-server-to-method from) - (error "%s: no such server" from)) - (let ((to-entry (cons from (gnus-copy-sequence - (gnus-server-to-method from))))) - (setcar to-entry to) - (setcar (nthcdr 2 to-entry) to) - (push to-entry gnus-server-killed-servers) - (gnus-server-yank-server))) - -(defun gnus-server-add-server (how where) - (interactive - (list (intern (completing-read "Server method: " - gnus-valid-select-methods nil t)) - (read-string "Server name: "))) - (when (assq where gnus-server-alist) - (error "Server with that name already defined")) - (push (list where how where) gnus-server-killed-servers) - (gnus-server-yank-server)) - -(defun gnus-server-goto-server (server) - "Jump to a server line." - (interactive - (list (completing-read "Goto server: " gnus-server-alist nil t))) - (let ((to (text-property-any (point-min) (point-max) - 'gnus-server (intern server)))) - (when to - (goto-char to) - (gnus-server-position-point)))) - -(defun gnus-server-edit-server (server) - "Edit the server on the current line." - (interactive (list (gnus-server-server-name))) - (unless server - (error "No server on current line")) - (unless (assoc server gnus-server-alist) - (error "This server can't be edited")) - (let ((info (cdr (assoc server gnus-server-alist)))) - (gnus-close-server info) - (gnus-edit-form - info "Editing the server." - `(lambda (form) - (gnus-server-set-info ,server form) - (gnus-server-list-servers) - (gnus-server-position-point))))) - -(defun gnus-server-scan-server (server) - "Request a scan from the current server." - (interactive (list (gnus-server-server-name))) - (gnus-message 3 "Scanning %s...done" server) - (gnus-request-scan nil (gnus-server-to-method server)) - (gnus-message 3 "Scanning %s...done" server)) - -(defun gnus-server-read-server (server) - "Browse a server." - (interactive (list (gnus-server-server-name))) - (let ((buf (current-buffer))) - (prog1 - (gnus-browse-foreign-server (gnus-server-to-method server) buf) - (save-excursion - (set-buffer buf) - (gnus-server-update-server (gnus-server-server-name)) - (gnus-server-position-point))))) - -(defun gnus-server-pick-server (e) - (interactive "e") - (mouse-set-point e) - (gnus-server-read-server (gnus-server-server-name))) - - -;;; -;;; Browse Server Mode -;;; - -(defvar gnus-browse-menu-hook nil - "*Hook run after the creation of the browse mode menu.") - -(defvar gnus-browse-mode-hook nil) -(defvar gnus-browse-mode-map nil) -(put 'gnus-browse-mode 'mode-class 'special) - -(unless gnus-browse-mode-map - (setq gnus-browse-mode-map (make-keymap)) - (suppress-keymap gnus-browse-mode-map) - - (gnus-define-keys - gnus-browse-mode-map - " " gnus-browse-read-group - "=" gnus-browse-select-group - "n" gnus-browse-next-group - "p" gnus-browse-prev-group - "\177" gnus-browse-prev-group - [delete] gnus-browse-prev-group - "N" gnus-browse-next-group - "P" gnus-browse-prev-group - "\M-n" gnus-browse-next-group - "\M-p" gnus-browse-prev-group - "\r" gnus-browse-select-group - "u" gnus-browse-unsubscribe-current-group - "l" gnus-browse-exit - "L" gnus-browse-exit - "q" gnus-browse-exit - "Q" gnus-browse-exit - "\C-c\C-c" gnus-browse-exit - "?" gnus-browse-describe-briefly - - "\C-c\C-i" gnus-info-find-node - "\C-c\C-b" gnus-bug)) - -(defun gnus-browse-make-menu-bar () - (gnus-turn-off-edit-menu 'browse) - (unless (boundp 'gnus-browse-menu) - (easy-menu-define - gnus-browse-menu gnus-browse-mode-map "" - '("Browse" - ["Subscribe" gnus-browse-unsubscribe-current-group t] - ["Read" gnus-browse-read-group t] - ["Select" gnus-browse-read-group t] - ["Next" gnus-browse-next-group t] - ["Prev" gnus-browse-next-group t] - ["Exit" gnus-browse-exit t])) - (run-hooks 'gnus-browse-menu-hook))) - -(defvar gnus-browse-current-method nil) -(defvar gnus-browse-return-buffer nil) - -(defvar gnus-browse-buffer "*Gnus Browse Server*") - -(defun gnus-browse-foreign-server (method &optional return-buffer) - "Browse the server METHOD." - (setq gnus-browse-current-method method) - (setq gnus-browse-return-buffer return-buffer) - (when (stringp method) - (setq method (gnus-server-to-method method))) - (let ((gnus-select-method method) - groups group) - (gnus-message 5 "Connecting to %s..." (nth 1 method)) - (cond - ((not (gnus-check-server method)) - (gnus-message - 1 "Unable to contact server: %s" (gnus-status-message method)) - nil) - ((not - (prog2 - (gnus-message 6 "Reading active file...") - (gnus-request-list method) - (gnus-message 6 "Reading active file...done"))) - (gnus-message - 1 "Couldn't request list: %s" (gnus-status-message method)) - nil) - (t - (get-buffer-create gnus-browse-buffer) - (gnus-add-current-to-buffer-list) - (when gnus-carpal - (gnus-carpal-setup-buffer 'browse)) - (gnus-configure-windows 'browse) - (buffer-disable-undo (current-buffer)) - (let ((buffer-read-only nil)) - (erase-buffer)) - (gnus-browse-mode) - (setq mode-line-buffer-identification - (list - (format - "Gnus: %%b {%s:%s}" (car method) (cadr method)))) - (save-excursion - (set-buffer nntp-server-buffer) - (let ((cur (current-buffer))) - (goto-char (point-min)) - (unless (string= gnus-ignored-newsgroups "") - (delete-matching-lines gnus-ignored-newsgroups)) - (while (re-search-forward - "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t) - (goto-char (match-end 1)) - (push (cons (match-string 1) - (max 0 (- (1+ (read cur)) (read cur)))) - groups)))) - (setq groups (sort groups - (lambda (l1 l2) - (string< (car l1) (car l2))))) - (let ((buffer-read-only nil)) - (while groups - (setq group (car groups)) - (insert - (format "K%7d: %s\n" (cdr group) (car group))) - (setq groups (cdr groups)))) - (switch-to-buffer (current-buffer)) - (goto-char (point-min)) - (gnus-group-position-point) - (gnus-message 5 "Connecting to %s...done" (nth 1 method)) - t)))) - -(defun gnus-browse-mode () - "Major mode for browsing a foreign server. - -All normal editing commands are switched off. - -\\ -The only things you can do in this buffer is - -1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group. -The group will be inserted into the group buffer upon exit from this -buffer. - -2) `\\[gnus-browse-read-group]' to read a group ephemerally. - -3) `\\[gnus-browse-exit]' to return to the group buffer." - (interactive) - (kill-all-local-variables) - (when (gnus-visual-p 'browse-menu 'menu) - (gnus-browse-make-menu-bar)) - (gnus-simplify-mode-line) - (setq major-mode 'gnus-browse-mode) - (setq mode-name "Browse Server") - (setq mode-line-process nil) - (use-local-map gnus-browse-mode-map) - (buffer-disable-undo (current-buffer)) - (setq truncate-lines t) - (gnus-set-default-directory) - (setq buffer-read-only t) - (run-hooks 'gnus-browse-mode-hook)) - -(defun gnus-browse-read-group (&optional no-article) - "Enter the group at the current line." - (interactive) - (let ((group (gnus-group-real-name (gnus-browse-group-name)))) - (unless (gnus-group-read-ephemeral-group - group gnus-browse-current-method nil - (cons (current-buffer) 'browse)) - (error "Couldn't enter %s" group)))) - -(defun gnus-browse-select-group () - "Select the current group." - (interactive) - (gnus-browse-read-group 'no)) - -(defun gnus-browse-next-group (n) - "Go to the next group." - (interactive "p") - (prog1 - (forward-line n) - (gnus-group-position-point))) - -(defun gnus-browse-prev-group (n) - "Go to the next group." - (interactive "p") - (gnus-browse-next-group (- n))) - -(defun gnus-browse-unsubscribe-current-group (arg) - "(Un)subscribe to the next ARG groups." - (interactive "p") - (when (eobp) - (error "No group at current line")) - (let ((ward (if (< arg 0) -1 1)) - (arg (abs arg))) - (while (and (> arg 0) - (not (eobp)) - (gnus-browse-unsubscribe-group) - (zerop (gnus-browse-next-group ward))) - (decf arg)) - (gnus-group-position-point) - (when (/= 0 arg) - (gnus-message 7 "No more newsgroups")) - arg)) - -(defun gnus-browse-group-name () - (save-excursion - (beginning-of-line) - (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t) - (gnus-group-prefixed-name - ;; Remove text props. - (format "%s" (match-string 1)) - gnus-browse-current-method)))) - -(defun gnus-browse-unsubscribe-group () - "Toggle subscription of the current group in the browse buffer." - (let ((sub nil) - (buffer-read-only nil) - group) - (save-excursion - (beginning-of-line) - ;; If this group it killed, then we want to subscribe it. - (when (= (following-char) ?K) - (setq sub t)) - (setq group (gnus-browse-group-name)) - ;; Make sure the group has been properly removed before we - ;; subscribe to it. - (gnus-kill-ephemeral-group group) - (delete-char 1) - (if sub - (progn - (gnus-group-change-level - (list t group gnus-level-default-subscribed - nil nil gnus-browse-current-method) - gnus-level-default-subscribed gnus-level-killed - (and (car (nth 1 gnus-newsrc-alist)) - (gnus-gethash (car (nth 1 gnus-newsrc-alist)) - gnus-newsrc-hashtb)) - t) - (insert ? )) - (gnus-group-change-level - group gnus-level-killed gnus-level-default-subscribed) - (insert ?K))) - t)) - -(defun gnus-browse-exit () - "Quit browsing and return to the group buffer." - (interactive) - (when (eq major-mode 'gnus-browse-mode) - (kill-buffer (current-buffer))) - ;; Insert the newly subscribed groups in the group buffer. - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-group-list-groups nil)) - (if gnus-browse-return-buffer - (gnus-configure-windows 'server 'force) - (gnus-configure-windows 'group 'force))) - -(defun gnus-browse-describe-briefly () - "Give a one line description of the group mode commands." - (interactive) - (gnus-message 6 - (substitute-command-keys "\\\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help"))) - -(defun gnus-server-regenerate-server () - "Issue a command to the server to regenerate all its data structures." - (interactive) - (let ((server (gnus-server-server-name))) - (unless server - (error "No server on the current line")) - (if (not (gnus-check-backend-function - 'request-regenerate (car (gnus-server-to-method server)))) - (error "This backend doesn't support regeneration") - (gnus-message 5 "Requesting regeneration of %s..." server) - (if (gnus-request-regenerate server) - (gnus-message 5 "Requesting regeneration of %s...done" server) - (gnus-message 5 "Couldn't regenerate %s" server))))) - -(provide 'gnus-srvr) - -;;; gnus-srvr.el ends here. diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-start.el --- a/lisp/gnus/gnus-start.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2471 +0,0 @@ -;;; gnus-start.el --- startup functions for Gnus -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-win) -(require 'gnus-int) -(require 'gnus-spec) -(require 'gnus-range) -(require 'gnus-util) -(require 'message) - -(defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc") - "Your `.newsrc' file. -`.newsrc-SERVER' will be used instead if that exists." - :group 'gnus-start - :type 'file) - -(defcustom gnus-init-file (nnheader-concat gnus-home-directory ".gnus") - "Your Gnus elisp startup file. -If a file with the .el or .elc suffixes exist, it will be read -instead." - :group 'gnus-start - :type 'file) - -(defcustom gnus-site-init-file - (ignore-errors - (concat (file-name-directory - (directory-file-name installation-directory)) - "site-lisp/gnus-init")) - "The site-wide Gnus elisp startup file. -If a file with the .el or .elc suffixes exist, it will be read -instead." - :group 'gnus-start - :type 'file) - -(defcustom gnus-default-subscribed-newsgroups nil - "This variable lists what newsgroups should be subscribed the first time Gnus is used. -It should be a list of strings. -If it is `t', Gnus will not do anything special the first time it is -started; it'll just use the normal newsgroups subscription methods." - :group 'gnus-start - :type '(repeat string)) - -(defcustom gnus-use-dribble-file t - "*Non-nil means that Gnus will use a dribble file to store user updates. -If Emacs should crash without saving the .newsrc files, complete -information can be restored from the dribble file." - :group 'gnus-dribble-file - :type 'boolean) - -(defcustom gnus-dribble-directory nil - "*The directory where dribble files will be saved. -If this variable is nil, the directory where the .newsrc files are -saved will be used." - :group 'gnus-dribble-file - :type '(choice directory (const nil))) - -(defcustom gnus-check-new-newsgroups 'ask-server - "*Non-nil means that Gnus will run gnus-find-new-newsgroups at startup. -This normally finds new newsgroups by comparing the active groups the -servers have already reported with those Gnus already knows, either alive -or killed. - -When any of the following are true, gnus-find-new-newsgroups will instead -ask the servers (primary, secondary, and archive servers) to list new -groups since the last time it checked: - 1. This variable is `ask-server'. - 2. This variable is a list of select methods (see below). - 3. `gnus-read-active-file' is nil or `some'. - 4. A prefix argument is given to gnus-find-new-newsgroups interactively. - -Thus, if this variable is `ask-server' or a list of select methods or -`gnus-read-active-file' is nil or `some', then the killed list is no -longer necessary, so you could safely set `gnus-save-killed-list' to nil. - -This variable can be a list of select methods which Gnus will query with -the `ask-server' method in addition to the primary, secondary, and archive -servers. - -Eg. - (setq gnus-check-new-newsgroups - '((nntp \"some.server\") (nntp \"other.server\"))) - -If this variable is nil, then you have to tell Gnus explicitly to -check for new newsgroups with \\\\[gnus-find-new-newsgroups]." - :group 'gnus-start - :type '(choice (const :tag "no" nil) - (const :tag "by brute force" t) - (const :tag "ask servers" ask-server) - (repeat :menu-tag "ask additional servers" - :tag "ask additional servers" - :value ((nntp "")) - (sexp :format "%v")))) - -(defcustom gnus-check-bogus-newsgroups nil - "*Non-nil means that Gnus will check and remove bogus newsgroup at startup. -If this variable is nil, then you have to tell Gnus explicitly to -check for bogus newsgroups with \\\\[gnus-group-check-bogus-groups]." - :group 'gnus-start-server - :type 'boolean) - -(defcustom gnus-read-active-file 'some - "*Non-nil means that Gnus will read the entire active file at startup. -If this variable is nil, Gnus will only know about the groups in your -`.newsrc' file. - -If this variable is `some', Gnus will try to only read the relevant -parts of the active file from the server. Not all servers support -this, and it might be quite slow with other servers, but this should -generally be faster than both the t and nil value. - -If you set this variable to nil or `some', you probably still want to -be told about new newsgroups that arrive. To do that, set -`gnus-check-new-newsgroups' to `ask-server'. This may not work -properly with all servers." - :group 'gnus-start-server - :type '(choice (const nil) - (const some) - (const t))) - -(defcustom gnus-level-subscribed 5 - "*Groups with levels less than or equal to this variable are subscribed." - :group 'gnus-group-levels - :type 'integer) - -(defcustom gnus-level-unsubscribed 7 - "*Groups with levels less than or equal to this variable are unsubscribed. -Groups with levels less than `gnus-level-subscribed', which should be -less than this variable, are subscribed." - :group 'gnus-group-levels - :type 'integer) - -(defcustom gnus-level-zombie 8 - "*Groups with this level are zombie groups." - :group 'gnus-group-levels - :type 'integer) - -(defcustom gnus-level-killed 9 - "*Groups with this level are killed." - :group 'gnus-group-levels - :type 'integer) - -(defcustom gnus-level-default-subscribed 3 - "*New subscribed groups will be subscribed at this level." - :group 'gnus-group-levels - :type 'integer) - -(defcustom gnus-level-default-unsubscribed 6 - "*New unsubscribed groups will be unsubscribed at this level." - :group 'gnus-group-levels - :type 'integer) - -(defcustom gnus-activate-level (1+ gnus-level-subscribed) - "*Groups higher than this level won't be activated on startup. -Setting this variable to something low might save lots of time when -you have many groups that you aren't interested in." - :group 'gnus-group-levels - :type 'integer) - -(defcustom gnus-activate-foreign-newsgroups 4 - "*If nil, Gnus will not check foreign newsgroups at startup. -If it is non-nil, it should be a number between one and nine. Foreign -newsgroups that have a level lower or equal to this number will be -activated on startup. For instance, if you want to active all -subscribed newsgroups, but not the rest, you'd set this variable to -`gnus-level-subscribed'. - -If you subscribe to lots of newsgroups from different servers, startup -might take a while. By setting this variable to nil, you'll save time, -but you won't be told how many unread articles there are in the -groups." - :group 'gnus-group-levels - :type 'integer) - -(defcustom gnus-save-newsrc-file t - "*Non-nil means that Gnus will save the `.newsrc' file. -Gnus always saves its own startup file, which is called -\".newsrc.eld\". The file called \".newsrc\" is in a format that can -be readily understood by other newsreaders. If you don't plan on -using other newsreaders, set this variable to nil to save some time on -exit." - :group 'gnus-newsrc - :type 'boolean) - -(defcustom gnus-save-killed-list t - "*If non-nil, save the list of killed groups to the startup file. -If you set this variable to nil, you'll save both time (when starting -and quitting) and space (both memory and disk), but it will also mean -that Gnus has no record of which groups are new and which are old, so -the automatic new newsgroups subscription methods become meaningless. - -You should always set `gnus-check-new-newsgroups' to `ask-server' or -nil if you set this variable to nil. - -This variable can also be a regexp. In that case, all groups that do -not match this regexp will be removed before saving the list." - :group 'gnus-newsrc - :type 'boolean) - -(defcustom gnus-ignored-newsgroups - (purecopy (mapconcat 'identity - '("^to\\." ; not "real" groups - "^[0-9. \t]+ " ; all digits in name - "[][\"#'()]" ; bogus characters - ) - "\\|")) - "A regexp to match uninteresting newsgroups in the active file. -Any lines in the active file matching this regular expression are -removed from the newsgroup list before anything else is done to it, -thus making them effectively non-existent." - :group 'gnus-group-new - :type 'regexp) - -(defcustom gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies - "*Function called with a group name when new group is detected. -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." - :group 'gnus-group-new - :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)) - -;; Suggested by a bug report by Hallvard B Furuseth. -;; . -(defcustom gnus-subscribe-options-newsgroup-method - 'gnus-subscribe-alphabetically - "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines. -If, for instance, you want to subscribe to all newsgroups in the -\"no\" and \"alt\" hierarchies, you'd put the following in your -.newsrc file: - -options -n no.all alt.all - -Gnus will the subscribe all new newsgroups in these hierarchies with -the subscription method in this variable." - :group 'gnus-group-new - :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)) - -(defcustom gnus-subscribe-hierarchical-interactive nil - "*If non-nil, Gnus will offer to subscribe hierarchically. -When a new hierarchy appears, Gnus will ask the user: - -'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys): - -If the user pressed `d', Gnus will descend the hierarchy, `y' will -subscribe to all newsgroups in the hierarchy and `s' will skip this -hierarchy in its entirety." - :group 'gnus-group-new - :type 'boolean) - -(defcustom gnus-auto-subscribed-groups - "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl" - "*All new groups that match this regexp will be subscribed automatically. -Note that this variable only deals with new groups. It has no effect -whatsoever on old groups. - -New groups that match this regexp will not be handled by -`gnus-subscribe-newsgroup-method'. Instead, they will -be subscribed using `gnus-subscribe-options-newsgroup-method'." - :group 'gnus-group-new - :type 'regexp) - -(defcustom gnus-options-subscribe nil - "*All new groups matching this regexp will be subscribed unconditionally. -Note that this variable deals only with new newsgroups. This variable -does not affect old newsgroups. - -New groups that match this regexp will not be handled by -`gnus-subscribe-newsgroup-method'. Instead, they will -be subscribed using `gnus-subscribe-options-newsgroup-method'." - :group 'gnus-group-new - :type '(choice regexp - (const :tag "none" nil))) - -(defcustom gnus-options-not-subscribe nil - "*All new groups matching this regexp will be ignored. -Note that this variable deals only with new newsgroups. This variable -does not affect old (already subscribed) newsgroups." - :group 'gnus-group-new - :type '(choice regexp - (const :tag "none" nil))) - -(defcustom gnus-modtime-botch nil - "*Non-nil means .newsrc should be deleted prior to save. -Its use is due to the bogus appearance that .newsrc was modified on -disc." - :group 'gnus-newsrc - :type 'boolean) - -(defcustom gnus-check-bogus-groups-hook nil - "A hook run after removing bogus groups." - :group 'gnus-start-server - :type 'hook) - -(defcustom gnus-startup-hook nil - "A hook called at startup. -This hook is called after Gnus is connected to the NNTP server." - :group 'gnus-start - :type 'hook) - -(defcustom gnus-started-hook nil - "A hook called as the last thing after startup." - :group 'gnus-start - :type 'hook) - -(defcustom gnus-get-new-news-hook nil - "A hook run just before Gnus checks for new news." - :group 'gnus-group-new - :type 'hook) - -(defcustom gnus-after-getting-new-news-hook - (when (gnus-boundp 'display-time-timer) - '(display-time-event-handler)) - "A hook run after Gnus checks for new news." - :group 'gnus-group-new - :type 'hook) - -(defcustom gnus-save-newsrc-hook nil - "A hook called before saving any of the newsrc files." - :group 'gnus-newsrc - :type 'hook) - -(defcustom gnus-save-quick-newsrc-hook nil - "A hook called just before saving the quick newsrc file. -Can be used to turn version control on or off." - :group 'gnus-newsrc - :type 'hook) - -(defcustom gnus-save-standard-newsrc-hook nil - "A hook called just before saving the standard newsrc file. -Can be used to turn version control on or off." - :group 'gnus-newsrc - :type 'hook) - -;;; Internal variables - -(defvar gnus-newsrc-file-version nil) -(defvar gnus-override-subscribe-method nil) -(defvar gnus-dribble-buffer nil) -(defvar gnus-newsrc-options nil - "Options line in the .newsrc file.") - -(defvar gnus-newsrc-options-n nil - "List of regexps representing groups to be subscribed/ignored unconditionally.") - -(defvar gnus-newsrc-last-checked-date nil - "Date Gnus last asked server for new newsgroups.") - -(defvar gnus-current-startup-file nil - "Startup file for the current host.") - -;; Byte-compiler warning. -(defvar gnus-group-line-format) - -;; Suggested by Brian Edmonds . -(defvar gnus-init-inhibit nil) -(defun gnus-read-init-file (&optional inhibit-next) - ;; Don't load .gnus if the -q option was used. - (when init-file-user - (if gnus-init-inhibit - (setq gnus-init-inhibit nil) - (setq gnus-init-inhibit inhibit-next) - (let ((files (list gnus-site-init-file gnus-init-file)) - file) - (while files - (and (setq file (pop files)) - (or (and (file-exists-p file) - ;; Don't try to load a directory. - (not (file-directory-p file))) - (file-exists-p (concat file ".el")) - (file-exists-p (concat file ".elc"))) - (condition-case var - (load file nil t) - (error - (error "Error in %s: %s" file var))))))))) - -;; For subscribing new newsgroup - -(defun gnus-subscribe-hierarchical-interactive (groups) - (let ((groups (sort groups 'string<)) - prefixes prefix start ans group starts) - (while groups - (setq prefixes (list "^")) - (while (and groups prefixes) - (while (not (string-match (car prefixes) (car groups))) - (setq prefixes (cdr prefixes))) - (setq prefix (car prefixes)) - (setq start (1- (length prefix))) - (if (and (string-match "[^\\.]\\." (car groups) start) - (cdr groups) - (setq prefix - (concat "^" (substring (car groups) 0 (match-end 0)))) - (string-match prefix (cadr groups))) - (progn - (push prefix prefixes) - (message "Descend hierarchy %s? ([y]nsq): " - (substring prefix 1 (1- (length prefix)))) - (while (not (memq (setq ans (read-char)) '(?y ?\n ?\r ?n ?s ?q))) - (ding) - (message "Descend hierarchy %s? ([y]nsq): " - (substring prefix 1 (1- (length prefix))))) - (cond ((= ans ?n) - (while (and groups - (string-match prefix - (setq group (car groups)))) - (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb) - (setq groups (cdr groups))) - (setq starts (cdr starts))) - ((= ans ?s) - (while (and groups - (string-match prefix - (setq group (car groups)))) - (gnus-sethash group group gnus-killed-hashtb) - (gnus-subscribe-alphabetically (car groups)) - (setq groups (cdr groups))) - (setq starts (cdr starts))) - ((= ans ?q) - (while groups - (setq group (car groups)) - (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb) - (setq groups (cdr groups)))) - (t nil))) - (message "Subscribe %s? ([n]yq)" (car groups)) - (while (not (memq (setq ans (read-char)) '(?y ?\n ?\r ?q ?n))) - (ding) - (message "Subscribe %s? ([n]yq)" (car groups))) - (setq group (car groups)) - (cond ((= ans ?y) - (gnus-subscribe-alphabetically (car groups)) - (gnus-sethash group group gnus-killed-hashtb)) - ((= ans ?q) - (while groups - (setq group (car groups)) - (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb) - (setq groups (cdr groups)))) - (t - (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb))) - (setq groups (cdr groups))))))) - -(defun gnus-subscribe-randomly (newsgroup) - "Subscribe new NEWSGROUP by making it the first newsgroup." - (gnus-subscribe-newsgroup newsgroup)) - -(defun gnus-subscribe-alphabetically (newgroup) - "Subscribe new NEWSGROUP and insert it in alphabetical order." - (let ((groups (cdr gnus-newsrc-alist)) - before) - (while (and (not before) groups) - (if (string< newgroup (caar groups)) - (setq before (caar groups)) - (setq groups (cdr groups)))) - (gnus-subscribe-newsgroup newgroup before))) - -(defun gnus-subscribe-hierarchically (newgroup) - "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order." - ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams) - (save-excursion - (set-buffer (nnheader-find-file-noselect gnus-current-startup-file)) - (let ((groupkey newgroup) - before) - (while (and (not before) groupkey) - (goto-char (point-min)) - (let ((groupkey-re - (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]"))) - (while (and (re-search-forward groupkey-re nil t) - (progn - (setq before (match-string 1)) - (string< before newgroup))))) - ;; Remove tail of newsgroup name (eg. a.b.c -> a.b) - (setq groupkey - (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey) - (substring groupkey (match-beginning 1) (match-end 1))))) - (gnus-subscribe-newsgroup newgroup before)) - (kill-buffer (current-buffer)))) - -(defun gnus-subscribe-interactively (group) - "Subscribe the new GROUP interactively. -It is inserted in hierarchical newsgroup order if subscribed. If not, -it is killed." - (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group)) - (gnus-subscribe-hierarchically group) - (push group gnus-killed-list))) - -(defun gnus-subscribe-zombies (group) - "Make the new GROUP into a zombie group." - (push group gnus-zombie-list)) - -(defun gnus-subscribe-killed (group) - "Make the new GROUP a killed group." - (push group gnus-killed-list)) - -(defun gnus-subscribe-newsgroup (newsgroup &optional next) - "Subscribe new NEWSGROUP. -If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made -the first newsgroup." - (save-excursion - (goto-char (point-min)) - ;; We subscribe the group by changing its level to `subscribed'. - (gnus-group-change-level - newsgroup gnus-level-default-subscribed - gnus-level-killed (gnus-gethash (or next "dummy.group") - gnus-newsrc-hashtb)) - (gnus-message 5 "Subscribe newsgroup: %s" newsgroup))) - -(defun gnus-read-active-file-p () - "Say whether the active file has been read from `gnus-select-method'." - (memq gnus-select-method gnus-have-read-active-file)) - -;;; General various misc type functions. - -;; Silence byte-compiler. -(defvar gnus-current-headers) -(defvar gnus-thread-indent-array) -(defvar gnus-newsgroup-name) -(defvar gnus-newsgroup-headers) -(defvar gnus-group-list-mode) -(defvar gnus-group-mark-positions) -(defvar gnus-newsgroup-data) -(defvar gnus-newsgroup-unreads) -(defvar nnoo-state-alist) -(defvar gnus-current-select-method) -(defun gnus-clear-system () - "Clear all variables and buffers." - ;; Clear Gnus variables. - (let ((variables gnus-variable-list)) - (while variables - (set (car variables) nil) - (setq variables (cdr variables)))) - ;; Clear other internal variables. - (setq gnus-list-of-killed-groups nil - gnus-have-read-active-file nil - gnus-newsrc-alist nil - gnus-newsrc-hashtb nil - gnus-killed-list nil - gnus-zombie-list nil - gnus-killed-hashtb nil - gnus-active-hashtb nil - gnus-moderated-hashtb nil - gnus-description-hashtb nil - gnus-current-headers nil - gnus-thread-indent-array nil - gnus-newsgroup-headers nil - gnus-newsgroup-name nil - gnus-server-alist nil - gnus-group-list-mode nil - gnus-opened-servers nil - gnus-group-mark-positions nil - gnus-newsgroup-data nil - gnus-newsgroup-unreads nil - nnoo-state-alist nil - gnus-current-select-method nil) - (gnus-shutdown 'gnus) - ;; Kill the startup file. - (and gnus-current-startup-file - (get-file-buffer gnus-current-startup-file) - (kill-buffer (get-file-buffer gnus-current-startup-file))) - ;; Clear the dribble buffer. - (gnus-dribble-clear) - ;; Kill global KILL file buffer. - (when (get-file-buffer (gnus-newsgroup-kill-file nil)) - (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil)))) - (gnus-kill-buffer nntp-server-buffer) - ;; Kill Gnus buffers. - (while gnus-buffer-list - (gnus-kill-buffer (pop gnus-buffer-list))) - ;; Remove Gnus frames. - (gnus-kill-gnus-frames)) - -(defun gnus-no-server-1 (&optional arg slave) - "Read network news. -If ARG is a positive number, Gnus will use that as the -startup level. If ARG is nil, Gnus will be started at level 2. -If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use. -As opposed to `gnus', this command will not connect to the local server." - (interactive "P") - (let ((val (or arg (1- gnus-level-default-subscribed)))) - (gnus val t slave) - (make-local-variable 'gnus-group-use-permanent-levels) - (setq gnus-group-use-permanent-levels val))) - -(defun gnus-1 (&optional arg dont-connect slave) - "Read network news. -If ARG is non-nil and a positive number, Gnus will use that as the -startup level. If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use." - (interactive "P") - - (if (and (get-buffer gnus-group-buffer) - (save-excursion - (set-buffer gnus-group-buffer) - (eq major-mode 'gnus-group-mode))) - (progn - (switch-to-buffer gnus-group-buffer) - (gnus-group-get-new-news - (and (numberp arg) - (> arg 0) - (max (car gnus-group-list-mode) arg)))) - - (gnus-splash) - (gnus-clear-system) - (nnheader-init-server-buffer) - (gnus-read-init-file) - (setq gnus-slave slave) - - (when (and (string-match "XEmacs" (emacs-version)) - gnus-simple-splash) - (setq gnus-simple-splash nil) - (gnus-xmas-splash)) - - (let ((level (and (numberp arg) (> arg 0) arg)) - did-connect) - (unwind-protect - (progn - (unless dont-connect - (setq did-connect - (gnus-start-news-server (and arg (not level)))))) - (if (and (not dont-connect) - (not did-connect)) - (gnus-group-quit) - (run-hooks 'gnus-startup-hook) - ;; NNTP server is successfully open. - - ;; Find the current startup file name. - (setq gnus-current-startup-file - (gnus-make-newsrc-file gnus-startup-file)) - - ;; Read the dribble file. - (when (or gnus-slave gnus-use-dribble-file) - (gnus-dribble-read-file)) - - ;; Allow using GroupLens predictions. - (when gnus-use-grouplens - (bbb-login) - (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode)) - - ;; Do the actual startup. - (gnus-setup-news nil level dont-connect) - ;; Generate the group buffer. - (gnus-group-list-groups level) - (gnus-group-first-unread-group) - (gnus-configure-windows 'group) - (gnus-group-set-mode-line) - (run-hooks 'gnus-started-hook)))))) - -;;;###autoload -(defun gnus-unload () - "Unload all Gnus features." - (interactive) - (unless (boundp 'load-history) - (error "Sorry, `gnus-unload' is not implemented in this Emacs version")) - (let ((history load-history) - feature) - (while history - (and (string-match "^\\(gnus\\|nn\\)" (caar history)) - (setq feature (cdr (assq 'provide (car history)))) - (unload-feature feature 'force)) - (setq history (cdr history))))) - - -;;; -;;; Dribble file -;;; - -(defvar gnus-dribble-ignore nil) -(defvar gnus-dribble-eval-file nil) - -(defun gnus-dribble-file-name () - "Return the dribble file for the current .newsrc." - (concat - (if gnus-dribble-directory - (concat (file-name-as-directory gnus-dribble-directory) - (file-name-nondirectory gnus-current-startup-file)) - gnus-current-startup-file) - "-dribble")) - -(defun gnus-dribble-enter (string) - "Enter STRING into the dribble buffer." - (when (and (not gnus-dribble-ignore) - gnus-dribble-buffer - (buffer-name gnus-dribble-buffer)) - (let ((obuf (current-buffer))) - (set-buffer gnus-dribble-buffer) - (goto-char (point-max)) - (insert string "\n") - (set-window-point (get-buffer-window (current-buffer)) (point-max)) - (bury-buffer gnus-dribble-buffer) - (set-buffer obuf)))) - -(defun gnus-dribble-touch () - "Touch the dribble buffer." - (gnus-dribble-enter "")) - -(defun gnus-dribble-read-file () - "Read the dribble file from disk." - (let ((dribble-file (gnus-dribble-file-name))) - (save-excursion - (set-buffer (setq gnus-dribble-buffer - (get-buffer-create - (file-name-nondirectory dribble-file)))) - (gnus-add-current-to-buffer-list) - (erase-buffer) - (setq buffer-file-name dribble-file) - (auto-save-mode t) - (buffer-disable-undo (current-buffer)) - (bury-buffer (current-buffer)) - (set-buffer-modified-p nil) - (let ((auto (make-auto-save-file-name)) - (gnus-dribble-ignore t) - modes) - (when (or (file-exists-p auto) (file-exists-p dribble-file)) - ;; Load whichever file is newest -- the auto save file - ;; or the "real" file. - (if (file-newer-than-file-p auto dribble-file) - (nnheader-insert-file-contents auto) - (nnheader-insert-file-contents dribble-file)) - (unless (zerop (buffer-size)) - (set-buffer-modified-p t)) - ;; Set the file modes to reflect the .newsrc file modes. - (save-buffer) - (when (and (file-exists-p gnus-current-startup-file) - (file-exists-p dribble-file) - (setq modes (file-modes gnus-current-startup-file))) - (set-file-modes dribble-file modes)) - ;; Possibly eval the file later. - (when (gnus-y-or-n-p - "Gnus auto-save file exists. Do you want to read it? ") - (setq gnus-dribble-eval-file t))))))) - -(defun gnus-dribble-eval-file () - (when gnus-dribble-eval-file - (setq gnus-dribble-eval-file nil) - (save-excursion - (let ((gnus-dribble-ignore t)) - (set-buffer gnus-dribble-buffer) - (eval-buffer (current-buffer)))))) - -(defun gnus-dribble-delete-file () - (when (file-exists-p (gnus-dribble-file-name)) - (delete-file (gnus-dribble-file-name))) - (when gnus-dribble-buffer - (save-excursion - (set-buffer gnus-dribble-buffer) - (let ((auto (make-auto-save-file-name))) - (when (file-exists-p auto) - (delete-file auto)) - (erase-buffer) - (set-buffer-modified-p nil))))) - -(defun gnus-dribble-save () - (when (and gnus-dribble-buffer - (buffer-name gnus-dribble-buffer)) - (save-excursion - (set-buffer gnus-dribble-buffer) - (save-buffer)))) - -(defun gnus-dribble-clear () - (when (gnus-buffer-exists-p gnus-dribble-buffer) - (save-excursion - (set-buffer gnus-dribble-buffer) - (erase-buffer) - (set-buffer-modified-p nil) - (setq buffer-saved-size (buffer-size))))) - - -;;; -;;; Active & Newsrc File Handling -;;; - -(defun gnus-setup-news (&optional rawfile level dont-connect) - "Setup news information. -If RAWFILE is non-nil, the .newsrc file will also be read. -If LEVEL is non-nil, the news will be set up at level LEVEL." - (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile))))) - - (when init - ;; Clear some variables to re-initialize news information. - (setq gnus-newsrc-alist nil - gnus-active-hashtb nil) - ;; Read the newsrc file and create `gnus-newsrc-hashtb'. - (gnus-read-newsrc-file rawfile)) - - (when (and (not (assoc "archive" gnus-server-alist)) - (gnus-archive-server-wanted-p)) - (push (cons "archive" gnus-message-archive-method) - gnus-server-alist)) - - ;; If we don't read the complete active file, we fill in the - ;; hashtb here. - (when (or (null gnus-read-active-file) - (eq gnus-read-active-file 'some)) - (gnus-update-active-hashtb-from-killed)) - - ;; Read the active file and create `gnus-active-hashtb'. - ;; If `gnus-read-active-file' is nil, then we just create an empty - ;; hash table. The partial filling out of the hash table will be - ;; done in `gnus-get-unread-articles'. - (and gnus-read-active-file - (not level) - (gnus-read-active-file nil dont-connect)) - - (unless gnus-active-hashtb - (setq gnus-active-hashtb (gnus-make-hashtable 4096))) - - ;; Initialize the cache. - (when gnus-use-cache - (gnus-cache-open)) - - ;; Possibly eval the dribble file. - (and init - (or gnus-use-dribble-file gnus-slave) - (gnus-dribble-eval-file)) - - ;; Slave Gnusii should then clear the dribble buffer. - (when (and init gnus-slave) - (gnus-dribble-clear)) - - (gnus-update-format-specifications) - - ;; See whether we need to read the description file. - (when (and (boundp 'gnus-group-line-format) - (let ((case-fold-search nil)) - (string-match "%[-,0-9]*D" gnus-group-line-format)) - (not gnus-description-hashtb) - (not dont-connect) - gnus-read-active-file) - (gnus-read-all-descriptions-files)) - - ;; Find new newsgroups and treat them. - (when (and init gnus-check-new-newsgroups (not level) - (gnus-check-server gnus-select-method) - (not gnus-slave)) - (gnus-find-new-newsgroups)) - - ;; We might read in new NoCeM messages here. - (when (and gnus-use-nocem - (not level) - (not dont-connect)) - (gnus-nocem-scan-groups)) - - ;; Read any slave files. - (gnus-master-read-slave-newsrc) - - ;; Find the number of unread articles in each non-dead group. - (let ((gnus-read-active-file (and (not level) gnus-read-active-file))) - (gnus-get-unread-articles level)) - - (when (and init gnus-check-bogus-newsgroups - gnus-read-active-file (not level) - (gnus-server-opened gnus-select-method)) - (gnus-check-bogus-newsgroups)))) - -(defun gnus-find-new-newsgroups (&optional arg) - "Search for new newsgroups and add them. -Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.' -The `-n' option line from .newsrc is respected. -If ARG (the prefix), use the `ask-server' method to query the server -for new groups." - (interactive "P") - (let ((check (if (or (and arg (not (listp gnus-check-new-newsgroups))) - (null gnus-read-active-file) - (eq gnus-read-active-file 'some)) - 'ask-server gnus-check-new-newsgroups))) - (unless (gnus-check-first-time-used) - (if (or (consp check) - (eq check 'ask-server)) - ;; Ask the server for new groups. - (gnus-ask-server-for-new-groups) - ;; Go through the active hashtb and look for new groups. - (let ((groups 0) - group new-newsgroups) - (gnus-message 5 "Looking for new newsgroups...") - (unless gnus-have-read-active-file - (gnus-read-active-file)) - (setq gnus-newsrc-last-checked-date (current-time-string)) - (unless gnus-killed-hashtb - (gnus-make-hashtable-from-killed)) - ;; Go though every newsgroup in `gnus-active-hashtb' and compare - ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'. - (mapatoms - (lambda (sym) - (if (or (null (setq group (symbol-name sym))) - (not (boundp sym)) - (null (symbol-value sym)) - (gnus-gethash group gnus-killed-hashtb) - (gnus-gethash group gnus-newsrc-hashtb)) - () - (let ((do-sub (gnus-matches-options-n group))) - (cond - ((eq do-sub 'subscribe) - (setq groups (1+ groups)) - (gnus-sethash group group gnus-killed-hashtb) - (funcall gnus-subscribe-options-newsgroup-method group)) - ((eq do-sub 'ignore) - nil) - (t - (setq groups (1+ groups)) - (gnus-sethash group group gnus-killed-hashtb) - (if gnus-subscribe-hierarchical-interactive - (push group new-newsgroups) - (funcall gnus-subscribe-newsgroup-method group))))))) - gnus-active-hashtb) - (when new-newsgroups - (gnus-subscribe-hierarchical-interactive new-newsgroups)) - (if (> groups 0) - (gnus-message 5 "%d new newsgroup%s arrived." - groups (if (> groups 1) "s have" " has")) - (gnus-message 5 "No new newsgroups."))))))) - -(defun gnus-matches-options-n (group) - ;; Returns `subscribe' if the group is to be unconditionally - ;; subscribed, `ignore' if it is to be ignored, and nil if there is - ;; no match for the group. - - ;; First we check the two user variables. - (cond - ((and gnus-options-subscribe - (string-match gnus-options-subscribe group)) - 'subscribe) - ((and gnus-auto-subscribed-groups - (string-match gnus-auto-subscribed-groups group)) - 'subscribe) - ((and gnus-options-not-subscribe - (string-match gnus-options-not-subscribe group)) - 'ignore) - ;; Then we go through the list that was retrieved from the .newsrc - ;; file. This list has elements on the form - ;; `(REGEXP . {ignore,subscribe})'. The first match found (the list - ;; is in the reverse order of the options line) is returned. - (t - (let ((regs gnus-newsrc-options-n)) - (while (and regs - (not (string-match (caar regs) group))) - (setq regs (cdr regs))) - (and regs (cdar regs)))))) - -(defun gnus-ask-server-for-new-groups () - (let* ((date (or gnus-newsrc-last-checked-date (current-time-string))) - (methods (cons gnus-select-method - (nconc - (when (gnus-archive-server-wanted-p) - (list "archive")) - (append - (and (consp gnus-check-new-newsgroups) - gnus-check-new-newsgroups) - gnus-secondary-select-methods)))) - (groups 0) - (new-date (current-time-string)) - group new-newsgroups got-new method hashtb - gnus-override-subscribe-method) - ;; Go through both primary and secondary select methods and - ;; request new newsgroups. - (while (setq method (gnus-server-get-method nil (pop methods))) - (setq new-newsgroups nil) - (setq gnus-override-subscribe-method method) - (when (and (gnus-check-server method) - (gnus-request-newgroups date method)) - (save-excursion - (setq got-new t) - (setq hashtb (gnus-make-hashtable 100)) - (set-buffer nntp-server-buffer) - ;; Enter all the new groups into a hashtable. - (gnus-active-to-gnus-format method hashtb 'ignore)) - ;; Now all new groups from `method' are in `hashtb'. - (mapatoms - (lambda (group-sym) - (if (or (null (setq group (symbol-name group-sym))) - (not (boundp group-sym)) - (null (symbol-value group-sym)) - (gnus-gethash group gnus-newsrc-hashtb) - (member group gnus-zombie-list) - (member group gnus-killed-list)) - ;; The group is already known. - () - ;; Make this group active. - (when (symbol-value group-sym) - (gnus-set-active group (symbol-value group-sym))) - ;; Check whether we want it or not. - (let ((do-sub (gnus-matches-options-n group))) - (cond - ((eq do-sub 'subscribe) - (incf groups) - (gnus-sethash group group gnus-killed-hashtb) - (funcall gnus-subscribe-options-newsgroup-method group)) - ((eq do-sub 'ignore) - nil) - (t - (incf groups) - (gnus-sethash group group gnus-killed-hashtb) - (if gnus-subscribe-hierarchical-interactive - (push group new-newsgroups) - (funcall gnus-subscribe-newsgroup-method group))))))) - hashtb)) - (when new-newsgroups - (gnus-subscribe-hierarchical-interactive new-newsgroups))) - ;; Suggested by Per Abrahamsen . - (when (> groups 0) - (gnus-message 6 "%d new newsgroup%s arrived." - groups (if (> groups 1) "s have" " has"))) - (when got-new - (setq gnus-newsrc-last-checked-date new-date)) - got-new)) - -(defun gnus-check-first-time-used () - (if (or (> (length gnus-newsrc-alist) 1) - (file-exists-p gnus-startup-file) - (file-exists-p (concat gnus-startup-file ".el")) - (file-exists-p (concat gnus-startup-file ".eld"))) - nil - (gnus-message 6 "First time user; subscribing you to default groups") - (unless (gnus-read-active-file-p) - (let ((gnus-read-active-file t)) - (gnus-read-active-file))) - (setq gnus-newsrc-last-checked-date (current-time-string)) - (let ((groups gnus-default-subscribed-newsgroups) - group) - (if (eq groups t) - nil - (setq groups (or groups gnus-backup-default-subscribed-newsgroups)) - (mapatoms - (lambda (sym) - (if (null (setq group (symbol-name sym))) - () - (let ((do-sub (gnus-matches-options-n group))) - (cond - ((eq do-sub 'subscribe) - (gnus-sethash group group gnus-killed-hashtb) - (funcall gnus-subscribe-options-newsgroup-method group)) - ((eq do-sub 'ignore) - nil) - (t - (push group gnus-killed-list)))))) - gnus-active-hashtb) - (while groups - (when (gnus-active (car groups)) - (gnus-group-change-level - (car groups) gnus-level-default-subscribed gnus-level-killed)) - (setq groups (cdr groups))) - (gnus-group-make-help-group) - (when gnus-novice-user - (gnus-message 7 "`A k' to list killed groups")))))) - -(defun gnus-subscribe-group (group previous &optional method) - (gnus-group-change-level - (if method - (list t group gnus-level-default-subscribed nil nil method) - group) - gnus-level-default-subscribed gnus-level-killed previous t)) - -;; `gnus-group-change-level' is the fundamental function for changing -;; subscription levels of newsgroups. This might mean just changing -;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back -;; again, which subscribes/unsubscribes a group, which is equally -;; trivial. Changing from 1-7 to 8-9 means that you kill a group, and -;; from 8-9 to 1-7 means that you remove the group from the list of -;; killed (or zombie) groups and add them to the (kinda) subscribed -;; groups. And last but not least, moving from 8 to 9 and 9 to 8, -;; which is trivial. -;; ENTRY can either be a string (newsgroup name) or a list (if -;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST), -;; otherwise it's a list in the format of the `gnus-newsrc-hashtb' -;; entries. -;; LEVEL is the new level of the group, OLDLEVEL is the old level and -;; PREVIOUS is the group (in hashtb entry format) to insert this group -;; after. -(defun gnus-group-change-level (entry level &optional oldlevel - previous fromkilled) - (let (group info active num) - ;; Glean what info we can from the arguments - (if (consp entry) - (if fromkilled (setq group (nth 1 entry)) - (setq group (car (nth 2 entry)))) - (setq group entry)) - (when (and (stringp entry) - oldlevel - (< oldlevel gnus-level-zombie)) - (setq entry (gnus-gethash entry gnus-newsrc-hashtb))) - (if (and (not oldlevel) - (consp entry)) - (setq oldlevel (gnus-info-level (nth 2 entry))) - (setq oldlevel (or oldlevel 9))) - (when (stringp previous) - (setq previous (gnus-gethash previous gnus-newsrc-hashtb))) - - (if (and (>= oldlevel gnus-level-zombie) - (gnus-gethash group gnus-newsrc-hashtb)) - ;; We are trying to subscribe a group that is already - ;; subscribed. - () ; Do nothing. - - (unless (gnus-ephemeral-group-p group) - (gnus-dribble-enter - (format "(gnus-group-change-level %S %S %S %S %S)" - group level oldlevel (car (nth 2 previous)) fromkilled))) - - ;; Then we remove the newgroup from any old structures, if needed. - ;; If the group was killed, we remove it from the killed or zombie - ;; list. If not, and it is in fact going to be killed, we remove - ;; it from the newsrc hash table and assoc. - (cond - ((>= oldlevel gnus-level-zombie) - (if (= oldlevel gnus-level-zombie) - (setq gnus-zombie-list (delete group gnus-zombie-list)) - (setq gnus-killed-list (delete group gnus-killed-list)))) - (t - (when (and (>= level gnus-level-zombie) - entry) - (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb) - (when (nth 3 entry) - (setcdr (gnus-gethash (car (nth 3 entry)) - gnus-newsrc-hashtb) - (cdr entry))) - (setcdr (cdr entry) (cdddr entry))))) - - ;; Finally we enter (if needed) the list where it is supposed to - ;; go, and change the subscription level. If it is to be killed, - ;; we enter it into the killed or zombie list. - (cond - ((>= level gnus-level-zombie) - ;; Remove from the hash table. - (gnus-sethash group nil gnus-newsrc-hashtb) - ;; We do not enter foreign groups into the list of dead - ;; groups. - (unless (gnus-group-foreign-p group) - (if (= level gnus-level-zombie) - (push group gnus-zombie-list) - (push group gnus-killed-list)))) - (t - ;; If the list is to be entered into the newsrc assoc, and - ;; it was killed, we have to create an entry in the newsrc - ;; hashtb format and fix the pointers in the newsrc assoc. - (if (< oldlevel gnus-level-zombie) - ;; It was alive, and it is going to stay alive, so we - ;; just change the level and don't change any pointers or - ;; hash table entries. - (setcar (cdaddr entry) level) - (if (listp entry) - (setq info (cdr entry) - num (car entry)) - (setq active (gnus-active group)) - (setq num - (if active (- (1+ (cdr active)) (car active)) t)) - ;; Check whether the group is foreign. If so, the - ;; foreign select method has to be entered into the - ;; info. - (let ((method (or gnus-override-subscribe-method - (gnus-group-method group)))) - (if (eq method gnus-select-method) - (setq info (list group level nil)) - (setq info (list group level nil nil method))))) - (unless previous - (setq previous - (let ((p gnus-newsrc-alist)) - (while (cddr p) - (setq p (cdr p))) - p))) - (setq entry (cons info (cddr previous))) - (if (cdr previous) - (progn - (setcdr (cdr previous) entry) - (gnus-sethash group (cons num (cdr previous)) - gnus-newsrc-hashtb)) - (setcdr previous entry) - (gnus-sethash group (cons num previous) - gnus-newsrc-hashtb)) - (when (cdr entry) - (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry)) - (gnus-dribble-enter - (format - "(gnus-group-set-info '%S)" info))))) - (when gnus-group-change-level-function - (funcall gnus-group-change-level-function group level oldlevel))))) - -(defun gnus-kill-newsgroup (newsgroup) - "Obsolete function. Kills a newsgroup." - (gnus-group-change-level - (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed)) - -(defun gnus-check-bogus-newsgroups (&optional confirm) - "Remove bogus newsgroups. -If CONFIRM is non-nil, the user has to confirm the deletion of every -newsgroup." - (let ((newsrc (cdr gnus-newsrc-alist)) - bogus group entry info) - (gnus-message 5 "Checking bogus newsgroups...") - (unless (gnus-read-active-file-p) - (gnus-read-active-file t)) - (when (gnus-read-active-file-p) - ;; Find all bogus newsgroup that are subscribed. - (while newsrc - (setq info (pop newsrc) - group (gnus-info-group info)) - (unless (or (gnus-active group) ; Active - (gnus-info-method info)) ; Foreign - ;; Found a bogus newsgroup. - (push group bogus))) - (if confirm - (map-y-or-n-p - "Remove bogus group %s? " - (lambda (group) - ;; Remove all bogus subscribed groups by first killing them, and - ;; then removing them from the list of killed groups. - (when (setq entry (gnus-gethash group gnus-newsrc-hashtb)) - (gnus-group-change-level entry gnus-level-killed) - (setq gnus-killed-list (delete group gnus-killed-list)))) - bogus '("group" "groups" "remove")) - (while (setq group (pop bogus)) - ;; Remove all bogus subscribed groups by first killing them, and - ;; then removing them from the list of killed groups. - (when (setq entry (gnus-gethash group gnus-newsrc-hashtb)) - (gnus-group-change-level entry gnus-level-killed) - (setq gnus-killed-list (delete group gnus-killed-list))))) - ;; Then we remove all bogus groups from the list of killed and - ;; zombie groups. They are removed without confirmation. - (let ((dead-lists '(gnus-killed-list gnus-zombie-list)) - killed) - (while dead-lists - (setq killed (symbol-value (car dead-lists))) - (while killed - (unless (gnus-active (setq group (pop killed))) - ;; The group is bogus. - ;; !!!Slow as hell. - (set (car dead-lists) - (delete group (symbol-value (car dead-lists)))))) - (setq dead-lists (cdr dead-lists)))) - (run-hooks 'gnus-check-bogus-groups-hook) - (gnus-message 5 "Checking bogus newsgroups...done")))) - -(defun gnus-check-duplicate-killed-groups () - "Remove duplicates from the list of killed groups." - (interactive) - (let ((killed gnus-killed-list)) - (while killed - (gnus-message 9 "%d" (length killed)) - (setcdr killed (delete (car killed) (cdr killed))) - (setq killed (cdr killed))))) - -;; We want to inline a function from gnus-cache, so we cheat here: -(eval-when-compile - (defvar gnus-cache-active-hashtb) - (defun gnus-cache-possibly-alter-active (group active) - "Alter the ACTIVE info for GROUP to reflect the articles in the cache." - (when gnus-cache-active-hashtb - (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb))) - (when cache-active - (when (< (car cache-active) (car active)) - (setcar active (car cache-active))) - (when (> (cdr cache-active) (cdr active)) - (setcdr active (cdr cache-active)))))))) - -(defun gnus-activate-group (group &optional scan dont-check method) - ;; Check whether a group has been activated or not. - ;; If SCAN, request a scan of that group as well. - (let ((method (or method (inline (gnus-find-method-for-group group)))) - active) - (and (inline (gnus-check-server method)) - ;; We escape all bugs and quit here to make it possible to - ;; continue if a group is so out-there that it reports bugs - ;; and stuff. - (progn - (and scan - (gnus-check-backend-function 'request-scan (car method)) - (gnus-request-scan group method)) - t) - (condition-case () - (inline (gnus-request-group group dont-check method)) - (error nil) - (quit nil)) - (setq active (gnus-parse-active)) - ;; If there are no articles in the group, the GROUP - ;; command may have responded with the `(0 . 0)'. We - ;; ignore this if we already have an active entry - ;; for the group. - (unless (and (zerop (car active)) - (zerop (cdr active)) - (gnus-active group)) - (gnus-set-active group active)) - ;; Return the new active info. - active))) - -(defun gnus-get-unread-articles-in-group (info active &optional update) - (when active - ;; Allow the backend to update the info in the group. - (when (and update - (gnus-request-update-info - info (inline (gnus-find-method-for-group - (gnus-info-group info))))) - (gnus-activate-group (gnus-info-group info) nil t)) - (let* ((range (gnus-info-read info)) - (num 0)) - ;; If a cache is present, we may have to alter the active info. - (when (and gnus-use-cache info) - (inline (gnus-cache-possibly-alter-active - (gnus-info-group info) active))) - ;; Modify the list of read articles according to what articles - ;; are available; then tally the unread articles and add the - ;; number to the group hash table entry. - (cond - ((zerop (cdr active)) - (setq num 0)) - ((not range) - (setq num (- (1+ (cdr active)) (car active)))) - ((not (listp (cdr range))) - ;; Fix a single (num . num) range according to the - ;; active hash table. - ;; Fix by Carsten Bormann . - (and (< (cdr range) (car active)) (setcdr range (1- (car active)))) - (and (> (cdr range) (cdr active)) (setcdr range (cdr active))) - ;; Compute number of unread articles. - (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range)))))) - (t - ;; The read list is a list of ranges. Fix them according to - ;; the active hash table. - ;; First peel off any elements that are below the lower - ;; active limit. - (while (and (cdr range) - (>= (car active) - (or (and (atom (cadr range)) (cadr range)) - (caadr range)))) - (if (numberp (car range)) - (setcar range - (cons (car range) - (or (and (numberp (cadr range)) - (cadr range)) - (cdadr range)))) - (setcdr (car range) - (or (and (numberp (nth 1 range)) (nth 1 range)) - (cdadr range)))) - (setcdr range (cddr range))) - ;; Adjust the first element to be the same as the lower limit. - (when (and (not (atom (car range))) - (< (cdar range) (car active))) - (setcdr (car range) (1- (car active)))) - ;; Then we want to peel off any elements that are higher - ;; than the upper active limit. - (let ((srange range)) - ;; Go past all legal elements. - (while (and (cdr srange) - (<= (or (and (atom (cadr srange)) - (cadr srange)) - (caadr srange)) - (cdr active))) - (setq srange (cdr srange))) - (when (cdr srange) - ;; Nuke all remaining illegal elements. - (setcdr srange nil)) - - ;; Adjust the final element. - (when (and (not (atom (car srange))) - (> (cdar srange) (cdr active))) - (setcdr (car srange) (cdr active)))) - ;; Compute the number of unread articles. - (while range - (setq num (+ num (- (1+ (or (and (atom (car range)) (car range)) - (cdar range))) - (or (and (atom (car range)) (car range)) - (caar range))))) - (setq range (cdr range))) - (setq num (max 0 (- (cdr active) num))))) - ;; Set the number of unread articles. - (when info - (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num)) - num))) - -;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb' -;; and compute how many unread articles there are in each group. -(defun gnus-get-unread-articles (&optional level) - (let* ((newsrc (cdr gnus-newsrc-alist)) - (level (or level gnus-activate-level (1+ gnus-level-subscribed))) - (foreign-level - (min - (cond ((and gnus-activate-foreign-newsgroups - (not (numberp gnus-activate-foreign-newsgroups))) - (1+ gnus-level-subscribed)) - ((numberp gnus-activate-foreign-newsgroups) - gnus-activate-foreign-newsgroups) - (t 0)) - level)) - info group active method) - (gnus-message 5 "Checking new news...") - - (while newsrc - (setq active (gnus-active (setq group (gnus-info-group - (setq info (pop newsrc)))))) - - ;; Check newsgroups. If the user doesn't want to check them, or - ;; they can't be checked (for instance, if the news server can't - ;; be reached) we just set the number of unread articles in this - ;; newsgroup to t. This means that Gnus thinks that there are - ;; unread articles, but it has no idea how many. - (if (and (setq method (gnus-info-method info)) - (not (inline - (gnus-server-equal - gnus-select-method - (setq method (gnus-server-get-method nil method))))) - (not (gnus-secondary-method-p method))) - ;; These groups are foreign. Check the level. - (when (<= (gnus-info-level info) foreign-level) - (setq active (gnus-activate-group group 'scan)) - (unless (inline (gnus-virtual-group-p group)) - (inline (gnus-close-group group))) - (when (fboundp (intern (concat (symbol-name (car method)) - "-request-update-info"))) - (inline (gnus-request-update-info info method)))) - ;; These groups are native or secondary. - (when (and (<= (gnus-info-level info) level) - (not gnus-read-active-file)) - (setq active (gnus-activate-group group 'scan)) - (inline (gnus-close-group group)))) - - ;; Get the number of unread articles in the group. - (if active - (inline (gnus-get-unread-articles-in-group info active t)) - ;; The group couldn't be reached, so we nix out the number of - ;; unread articles and stuff. - (gnus-set-active group nil) - (setcar (gnus-gethash group gnus-newsrc-hashtb) t))) - - (gnus-message 5 "Checking new news...done"))) - -;; Create a hash table out of the newsrc alist. The `car's of the -;; alist elements are used as keys. -(defun gnus-make-hashtable-from-newsrc-alist () - (let ((alist gnus-newsrc-alist) - (ohashtb gnus-newsrc-hashtb) - prev) - (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist))) - (setq alist - (setq prev (setq gnus-newsrc-alist - (if (equal (caar gnus-newsrc-alist) - "dummy.group") - gnus-newsrc-alist - (cons (list "dummy.group" 0 nil) alist))))) - (while alist - (gnus-sethash - (caar alist) - ;; Preserve number of unread articles in groups. - (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb))) - prev) - gnus-newsrc-hashtb) - (setq prev alist - alist (cdr alist))))) - -(defun gnus-make-hashtable-from-killed () - "Create a hash table from the killed and zombie lists." - (let ((lists '(gnus-killed-list gnus-zombie-list)) - list) - (setq gnus-killed-hashtb - (gnus-make-hashtable - (+ (length gnus-killed-list) (length gnus-zombie-list)))) - (while lists - (setq list (symbol-value (pop lists))) - (while list - (gnus-sethash (car list) (pop list) gnus-killed-hashtb))))) - -(defun gnus-parse-active () - "Parse active info in the nntp server buffer." - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - ;; Parse the result we got from `gnus-request-group'. - (when (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+") - (goto-char (match-beginning 1)) - (cons (read (current-buffer)) - (read (current-buffer)))))) - -(defun gnus-make-articles-unread (group articles) - "Mark ARTICLES in GROUP as unread." - (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb) - (gnus-gethash (gnus-group-real-name group) - gnus-newsrc-hashtb)))) - (ranges (gnus-info-read info)) - news article) - (while articles - (when (gnus-member-of-range - (setq article (pop articles)) ranges) - (push article news))) - (when news - (gnus-info-set-read - info (gnus-remove-from-range (gnus-info-read info) (nreverse news))) - (gnus-group-update-group group t)))) - -;; Enter all dead groups into the hashtb. -(defun gnus-update-active-hashtb-from-killed () - (let ((hashtb (setq gnus-active-hashtb (gnus-make-hashtable 4096))) - (lists (list gnus-killed-list gnus-zombie-list)) - killed) - (while lists - (setq killed (car lists)) - (while killed - (gnus-sethash (car killed) nil hashtb) - (setq killed (cdr killed))) - (setq lists (cdr lists))))) - -(defun gnus-get-killed-groups () - "Go through the active hashtb and mark all unknown groups as killed." - ;; First make sure active file has been read. - (unless (gnus-read-active-file-p) - (let ((gnus-read-active-file t)) - (gnus-read-active-file))) - (unless gnus-killed-hashtb - (gnus-make-hashtable-from-killed)) - ;; Go through all newsgroups that are known to Gnus - enlarge kill list. - (mapatoms - (lambda (sym) - (let ((groups 0) - (group (symbol-name sym))) - (if (or (null group) - (gnus-gethash group gnus-killed-hashtb) - (gnus-gethash group gnus-newsrc-hashtb)) - () - (let ((do-sub (gnus-matches-options-n group))) - (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore)) - () - (setq groups (1+ groups)) - (push group gnus-killed-list) - (gnus-sethash group group gnus-killed-hashtb)))))) - gnus-active-hashtb) - (gnus-dribble-touch)) - -;; Get the active file(s) from the backend(s). -(defun gnus-read-active-file (&optional force not-native) - (gnus-group-set-mode-line) - (let ((methods - (append - (if (and (not not-native) - (gnus-check-server gnus-select-method)) - ;; The native server is available. - (cons gnus-select-method gnus-secondary-select-methods) - ;; The native server is down, so we just do the - ;; secondary ones. - gnus-secondary-select-methods) - ;; Also read from the archive server. - (when (gnus-archive-server-wanted-p) - (list "archive")))) - list-type) - (setq gnus-have-read-active-file nil) - (save-excursion - (set-buffer nntp-server-buffer) - (while methods - (let* ((method (if (stringp (car methods)) - (gnus-server-get-method nil (car methods)) - (car methods))) - (where (nth 1 method)) - (mesg (format "Reading active file%s via %s..." - (if (and where (not (zerop (length where)))) - (concat " from " where) "") - (car method)))) - (gnus-message 5 mesg) - (when (gnus-check-server method) - ;; Request that the backend scan its incoming messages. - (when (gnus-check-backend-function 'request-scan (car method)) - (gnus-request-scan nil method)) - (cond - ((and (eq gnus-read-active-file 'some) - (gnus-check-backend-function 'retrieve-groups (car method)) - (not force)) - (let ((newsrc (cdr gnus-newsrc-alist)) - (gmethod (gnus-server-get-method nil method)) - groups info) - (while (setq info (pop newsrc)) - (when (inline - (gnus-server-equal - (inline - (gnus-find-method-for-group - (gnus-info-group info) info)) - gmethod)) - (push (gnus-group-real-name (gnus-info-group info)) - groups))) - (when groups - (gnus-check-server method) - (setq list-type (gnus-retrieve-groups groups method)) - (cond - ((not list-type) - (gnus-error - 1.2 "Cannot read partial active file from %s server." - (car method))) - ((eq list-type 'active) - (gnus-active-to-gnus-format method gnus-active-hashtb)) - (t - (gnus-groups-to-gnus-format method gnus-active-hashtb)))))) - ((null method) - t) - (t - (if (not (gnus-request-list method)) - (unless (equal method gnus-message-archive-method) - (gnus-error 1 "Cannot read active file from %s server" - (car method))) - (gnus-message 5 mesg) - (gnus-active-to-gnus-format method gnus-active-hashtb) - ;; We mark this active file as read. - (push method gnus-have-read-active-file) - (gnus-message 5 "%sdone" mesg)))))) - (setq methods (cdr methods)))))) - - -(defun gnus-ignored-newsgroups-has-to-p () - "T only when gnus-ignored-newsgroups includes \"^to\\\\.\" as an element." - ;; note this regexp is the same as: - ;; (concat (regexp-quote "^to\\.") "\\($\\|" (regexp-quote "\\|") "\\)") - (string-match "\\^to\\\\\\.\\($\\|\\\\|\\)" - gnus-ignored-newsgroups)) - -;; Read an active file and place the results in `gnus-active-hashtb'. -(defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors) - (unless method - (setq method gnus-select-method)) - (let ((cur (current-buffer)) - (hashtb (or hashtb - (if (and gnus-active-hashtb - (not (equal method gnus-select-method))) - gnus-active-hashtb - (setq gnus-active-hashtb - (if (equal method gnus-select-method) - (gnus-make-hashtable - (count-lines (point-min) (point-max))) - (gnus-make-hashtable 4096))))))) - ;; Delete unnecessary lines. - (goto-char (point-min)) - (cond ((gnus-ignored-newsgroups-has-to-p) - (delete-matching-lines gnus-ignored-newsgroups)) - ((string= gnus-ignored-newsgroups "") - (delete-matching-lines "^to\\.")) - (t - (delete-matching-lines (concat "^to\\.\\|" - gnus-ignored-newsgroups)))) - - ;; Make the group names readable as a lisp expression even if they - ;; contain special characters. - (goto-char (point-max)) - (while (re-search-backward "[][';?()#]" nil t) - (insert ?\\)) - - ;; If these are groups from a foreign select method, we insert the - ;; group prefix in front of the group names. - (when (not (gnus-server-equal - (gnus-server-get-method nil method) - (gnus-server-get-method nil gnus-select-method))) - (let ((prefix (gnus-group-prefixed-name "" method))) - (goto-char (point-min)) - (while (and (not (eobp)) - (progn (insert prefix) - (zerop (forward-line 1))))))) - ;; Store the active file in a hash table. - (goto-char (point-min)) - (let (group max min) - (while (not (eobp)) - (condition-case () - (progn - (narrow-to-region (point) (gnus-point-at-eol)) - ;; group gets set to a symbol interned in the hash table - ;; (what a hack!!) - jwz - (setq group (let ((obarray hashtb)) (read cur))) - (if (and (numberp (setq max (read cur))) - (numberp (setq min (read cur))) - (progn - (skip-chars-forward " \t") - (not - (or (= (following-char) ?=) - (= (following-char) ?x) - (= (following-char) ?j))))) - (progn - (set group (cons min max)) - ;; if group is moderated, stick in moderation table - (when (= (following-char) ?m) - (unless gnus-moderated-hashtb - (setq gnus-moderated-hashtb (gnus-make-hashtable))) - (gnus-sethash (symbol-name group) t - gnus-moderated-hashtb))) - (set group nil))) - (error - (and group - (symbolp group) - (set group nil)) - (unless ignore-errors - (gnus-message 3 "Warning - illegal active: %s" - (buffer-substring - (gnus-point-at-bol) (gnus-point-at-eol)))))) - (widen) - (forward-line 1))))) - -(defun gnus-groups-to-gnus-format (method &optional hashtb) - ;; Parse a "groups" active file. - (let ((cur (current-buffer)) - (hashtb (or hashtb - (if (and method gnus-active-hashtb) - gnus-active-hashtb - (setq gnus-active-hashtb - (gnus-make-hashtable - (count-lines (point-min) (point-max))))))) - (prefix (and method - (not (gnus-server-equal - (gnus-server-get-method nil method) - (gnus-server-get-method nil gnus-select-method))) - (gnus-group-prefixed-name "" method)))) - - (goto-char (point-min)) - ;; We split this into to separate loops, one with the prefix - ;; and one without to speed the reading up somewhat. - (if prefix - (let (min max opoint group) - (while (not (eobp)) - (condition-case () - (progn - (read cur) (read cur) - (setq min (read cur) - max (read cur) - opoint (point)) - (skip-chars-forward " \t") - (insert prefix) - (goto-char opoint) - (set (let ((obarray hashtb)) (read cur)) - (cons min max))) - (error (and group (symbolp group) (set group nil)))) - (forward-line 1))) - (let (min max group) - (while (not (eobp)) - (condition-case () - (when (= (following-char) ?2) - (read cur) (read cur) - (setq min (read cur) - max (read cur)) - (set (setq group (let ((obarray hashtb)) (read cur))) - (cons min max))) - (error (and group (symbolp group) (set group nil)))) - (forward-line 1)))))) - -(defun gnus-read-newsrc-file (&optional force) - "Read startup file. -If FORCE is non-nil, the .newsrc file is read." - ;; Reset variables that might be defined in the .newsrc.eld file. - (let ((variables gnus-variable-list)) - (while variables - (set (car variables) nil) - (setq variables (cdr variables)))) - (let* ((newsrc-file gnus-current-startup-file) - (quick-file (concat newsrc-file ".el"))) - (save-excursion - ;; We always load the .newsrc.eld file. If always contains - ;; much information that can not be gotten from the .newsrc - ;; file (ticked articles, killed groups, foreign methods, etc.) - (gnus-read-newsrc-el-file quick-file) - - (when (and (file-exists-p gnus-current-startup-file) - (or force - (and (file-newer-than-file-p newsrc-file quick-file) - (file-newer-than-file-p newsrc-file - (concat quick-file "d"))) - (not gnus-newsrc-alist))) - ;; We read the .newsrc file. Note that if there if a - ;; .newsrc.eld file exists, it has already been read, and - ;; the `gnus-newsrc-hashtb' has been created. While reading - ;; the .newsrc file, Gnus will only use the information it - ;; can find there for changing the data already read - - ;; i. e., reading the .newsrc file will not trash the data - ;; already read (except for read articles). - (save-excursion - (gnus-message 5 "Reading %s..." newsrc-file) - (set-buffer (nnheader-find-file-noselect newsrc-file)) - (buffer-disable-undo (current-buffer)) - (gnus-newsrc-to-gnus-format) - (kill-buffer (current-buffer)) - (gnus-message 5 "Reading %s...done" newsrc-file))) - - ;; Convert old to new. - (gnus-convert-old-newsrc)))) - -(defun gnus-convert-old-newsrc () - "Convert old newsrc into the new format, if needed." - (let ((fcv (and gnus-newsrc-file-version - (gnus-continuum-version gnus-newsrc-file-version)))) - (cond - ;; No .newsrc.eld file was loaded. - ((null fcv) nil) - ;; Gnus 5 .newsrc.eld was loaded. - ((< fcv (gnus-continuum-version "September Gnus v0.1")) - (gnus-convert-old-ticks))))) - -(defun gnus-convert-old-ticks () - (let ((newsrc (cdr gnus-newsrc-alist)) - marks info dormant ticked) - (while (setq info (pop newsrc)) - (when (setq marks (gnus-info-marks info)) - (setq dormant (cdr (assq 'dormant marks)) - ticked (cdr (assq 'tick marks))) - (when (or dormant ticked) - (gnus-info-set-read - info - (gnus-add-to-range - (gnus-info-read info) - (nconc (gnus-uncompress-range dormant) - (gnus-uncompress-range ticked))))))))) - -(defun gnus-read-newsrc-el-file (file) - (let ((ding-file (concat file "d"))) - ;; We always, always read the .eld file. - (gnus-message 5 "Reading %s..." ding-file) - (let (gnus-newsrc-assoc) - (condition-case nil - (load ding-file t t t) - (error - (ding) - (unless (gnus-yes-or-no-p - (format "Error in %s; continue? " ding-file)) - (error "Error in %s" ding-file)))) - (when gnus-newsrc-assoc - (setq gnus-newsrc-alist gnus-newsrc-assoc))) - (gnus-make-hashtable-from-newsrc-alist) - (when (file-newer-than-file-p file ding-file) - ;; Old format quick file - (gnus-message 5 "Reading %s..." file) - ;; The .el file is newer than the .eld file, so we read that one - ;; as well. - (gnus-read-old-newsrc-el-file file)))) - -;; Parse the old-style quick startup file -(defun gnus-read-old-newsrc-el-file (file) - (let (newsrc killed marked group m info) - (prog1 - (let ((gnus-killed-assoc nil) - gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc) - (prog1 - (ignore-errors - (load file t t t)) - (setq newsrc gnus-newsrc-assoc - killed gnus-killed-assoc - marked gnus-marked-assoc))) - (setq gnus-newsrc-alist nil) - (while (setq group (pop newsrc)) - (if (setq info (gnus-get-info (car group))) - (progn - (gnus-info-set-read info (cddr group)) - (gnus-info-set-level - info (if (nth 1 group) gnus-level-default-subscribed - gnus-level-default-unsubscribed)) - (push info gnus-newsrc-alist)) - (push (setq info - (list (car group) - (if (nth 1 group) gnus-level-default-subscribed - gnus-level-default-unsubscribed) - (cddr group))) - gnus-newsrc-alist)) - ;; Copy marks into info. - (when (setq m (assoc (car group) marked)) - (unless (nthcdr 3 info) - (nconc info (list nil))) - (gnus-info-set-marks - info (list (cons 'tick (gnus-compress-sequence - (sort (cdr m) '<) t)))))) - (setq newsrc killed) - (while newsrc - (setcar newsrc (caar newsrc)) - (setq newsrc (cdr newsrc))) - (setq gnus-killed-list killed)) - ;; The .el file version of this variable does not begin with - ;; "options", while the .eld version does, so we just add it if it - ;; isn't there. - (when - gnus-newsrc-options - (when (not (string-match "^ *options" gnus-newsrc-options)) - (setq gnus-newsrc-options (concat "options " gnus-newsrc-options))) - (when (not (string-match "\n$" gnus-newsrc-options)) - (setq gnus-newsrc-options (concat gnus-newsrc-options "\n"))) - ;; Finally, if we read some options lines, we parse them. - (unless (string= gnus-newsrc-options "") - (gnus-newsrc-parse-options gnus-newsrc-options))) - - (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)) - (gnus-make-hashtable-from-newsrc-alist))) - -(defun gnus-make-newsrc-file (file) - "Make server dependent file name by catenating FILE and server host name." - (let* ((file (expand-file-name file nil)) - (real-file (concat file "-" (nth 1 gnus-select-method)))) - (if (or (file-exists-p real-file) - (file-exists-p (concat real-file ".el")) - (file-exists-p (concat real-file ".eld"))) - real-file file))) - -(defun gnus-newsrc-to-gnus-format () - (setq gnus-newsrc-options "") - (setq gnus-newsrc-options-n nil) - - (unless gnus-active-hashtb - (setq gnus-active-hashtb (gnus-make-hashtable 4096))) - (let ((buf (current-buffer)) - (already-read (> (length gnus-newsrc-alist) 1)) - group subscribed options-symbol newsrc Options-symbol - symbol reads num1) - (goto-char (point-min)) - ;; We intern the symbol `options' in the active hashtb so that we - ;; can `eq' against it later. - (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil) - (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil) - - (while (not (eobp)) - ;; We first read the first word on the line by narrowing and - ;; then reading into `gnus-active-hashtb'. Most groups will - ;; already exist in that hashtb, so this will save some string - ;; space. - (narrow-to-region - (point) - (progn (skip-chars-forward "^ \t!:\n") (point))) - (goto-char (point-min)) - (setq symbol - (and (/= (point-min) (point-max)) - (let ((obarray gnus-active-hashtb)) (read buf)))) - (widen) - ;; Now, the symbol we have read is either `options' or a group - ;; name. If it is an options line, we just add it to a string. - (cond - ((or (eq symbol options-symbol) - (eq symbol Options-symbol)) - (setq gnus-newsrc-options - ;; This concating is quite inefficient, but since our - ;; thorough studies show that approx 99.37% of all - ;; .newsrc files only contain a single options line, we - ;; don't give a damn, frankly, my dear. - (concat gnus-newsrc-options - (buffer-substring - (gnus-point-at-bol) - ;; Options may continue on the next line. - (or (and (re-search-forward "^[^ \t]" nil 'move) - (progn (beginning-of-line) (point))) - (point))))) - (forward-line -1)) - (symbol - ;; Group names can be just numbers. - (when (numberp symbol) - (setq symbol (intern (int-to-string symbol) gnus-active-hashtb))) - (unless (boundp symbol) - (set symbol nil)) - ;; It was a group name. - (setq subscribed (= (following-char) ?:) - group (symbol-name symbol) - reads nil) - (if (eolp) - ;; If the line ends here, this is clearly a buggy line, so - ;; we put point a the beginning of line and let the cond - ;; below do the error handling. - (beginning-of-line) - ;; We skip to the beginning of the ranges. - (skip-chars-forward "!: \t")) - ;; We are now at the beginning of the list of read articles. - ;; We read them range by range. - (while - (cond - ((looking-at "[0-9]+") - ;; We narrow and read a number instead of buffer-substring/ - ;; string-to-int because it's faster. narrow/widen is - ;; faster than save-restriction/narrow, and save-restriction - ;; produces a garbage object. - (setq num1 (progn - (narrow-to-region (match-beginning 0) (match-end 0)) - (read buf))) - (widen) - ;; If the next character is a dash, then this is a range. - (if (= (following-char) ?-) - (progn - ;; We read the upper bound of the range. - (forward-char 1) - (if (not (looking-at "[0-9]+")) - ;; This is a buggy line, by we pretend that - ;; it's kinda OK. Perhaps the user should be - ;; dinged? - (push num1 reads) - (push - (cons num1 - (progn - (narrow-to-region (match-beginning 0) - (match-end 0)) - (read buf))) - reads) - (widen))) - ;; It was just a simple number, so we add it to the - ;; list of ranges. - (push num1 reads)) - ;; If the next char in ?\n, then we have reached the end - ;; of the line and return nil. - (/= (following-char) ?\n)) - ((= (following-char) ?\n) - ;; End of line, so we end. - nil) - (t - ;; Not numbers and not eol, so this might be a buggy - ;; line... - (unless (eobp) - ;; If it was eob instead of ?\n, we allow it. - ;; The line was buggy. - (setq group nil) - (gnus-error 3.1 "Mangled line: %s" - (buffer-substring (gnus-point-at-bol) - (gnus-point-at-eol)))) - nil)) - ;; Skip past ", ". Spaces are illegal in these ranges, but - ;; we allow them, because it's a common mistake to put a - ;; space after the comma. - (skip-chars-forward ", ")) - - ;; We have already read .newsrc.eld, so we gently update the - ;; data in the hash table with the information we have just - ;; read. - (when group - (let ((info (gnus-get-info group)) - level) - (if info - ;; There is an entry for this file in the alist. - (progn - (gnus-info-set-read info (nreverse reads)) - ;; We update the level very gently. In fact, we - ;; only change it if there's been a status change - ;; from subscribed to unsubscribed, or vice versa. - (setq level (gnus-info-level info)) - (cond ((and (<= level gnus-level-subscribed) - (not subscribed)) - (setq level (if reads - gnus-level-default-unsubscribed - (1+ gnus-level-default-unsubscribed)))) - ((and (> level gnus-level-subscribed) subscribed) - (setq level gnus-level-default-subscribed))) - (gnus-info-set-level info level)) - ;; This is a new group. - (setq info (list group - (if subscribed - gnus-level-default-subscribed - (if reads - (1+ gnus-level-subscribed) - gnus-level-default-unsubscribed)) - (nreverse reads)))) - (push info newsrc))))) - (forward-line 1)) - - (setq newsrc (nreverse newsrc)) - - (if (not already-read) - () - ;; We now have two newsrc lists - `newsrc', which is what we - ;; have read from .newsrc, and `gnus-newsrc-alist', which is - ;; what we've read from .newsrc.eld. We have to merge these - ;; lists. We do this by "attaching" any (foreign) groups in the - ;; gnus-newsrc-alist to the (native) group that precedes them. - (let ((rc (cdr gnus-newsrc-alist)) - (prev gnus-newsrc-alist) - entry mentry) - (while rc - (or (null (nth 4 (car rc))) ; It's a native group. - (assoc (caar rc) newsrc) ; It's already in the alist. - (if (setq entry (assoc (caar prev) newsrc)) - (setcdr (setq mentry (memq entry newsrc)) - (cons (car rc) (cdr mentry))) - (push (car rc) newsrc))) - (setq prev rc - rc (cdr rc))))) - - (setq gnus-newsrc-alist newsrc) - ;; We make the newsrc hashtb. - (gnus-make-hashtable-from-newsrc-alist) - - ;; Finally, if we read some options lines, we parse them. - (unless (string= gnus-newsrc-options "") - (gnus-newsrc-parse-options gnus-newsrc-options)))) - -;; Parse options lines to find "options -n !all rec.all" and stuff. -;; The return value will be a list on the form -;; ((regexp1 . ignore) -;; (regexp2 . subscribe)...) -;; When handling new newsgroups, groups that match a `ignore' regexp -;; will be ignored, and groups that match a `subscribe' regexp will be -;; subscribed. A line like -;; options -n !all rec.all -;; will lead to a list that looks like -;; (("^rec\\..+" . subscribe) -;; ("^.+" . ignore)) -;; So all "rec.*" groups will be subscribed, while all the other -;; groups will be ignored. Note that "options -n !all rec.all" is very -;; different from "options -n rec.all !all". -(defun gnus-newsrc-parse-options (options) - (let (out eol) - (save-excursion - (gnus-set-work-buffer) - (insert (regexp-quote options)) - ;; First we treat all continuation lines. - (goto-char (point-min)) - (while (re-search-forward "\n[ \t]+" nil t) - (replace-match " " t t)) - ;; Then we transform all "all"s into ".+"s. - (goto-char (point-min)) - (while (re-search-forward "\\ball\\b" nil t) - (replace-match ".+" t t)) - (goto-char (point-min)) - ;; We remove all other options than the "-n" ones. - (while (re-search-forward "[ \t]-[^n][^-]*" nil t) - (replace-match " ") - (forward-char -1)) - (goto-char (point-min)) - - ;; We are only interested in "options -n" lines - we - ;; ignore the other option lines. - (while (re-search-forward "[ \t]-n" nil t) - (setq eol - (or (save-excursion - (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t) - (- (point) 2))) - (gnus-point-at-eol))) - ;; Search for all "words"... - (while (re-search-forward "[^ \t,\n]+" eol t) - (if (= (char-after (match-beginning 0)) ?!) - ;; If the word begins with a bang (!), this is a "not" - ;; spec. We put this spec (minus the bang) and the - ;; symbol `ignore' into the list. - (push (cons (concat - "^" (buffer-substring - (1+ (match-beginning 0)) - (match-end 0))) - 'ignore) - out) - ;; There was no bang, so this is a "yes" spec. - (push (cons (concat "^" (match-string 0)) - 'subscribe) - out)))) - - (setq gnus-newsrc-options-n out)))) - -(defun gnus-save-newsrc-file (&optional force) - "Save .newsrc file." - ;; Note: We cannot save .newsrc file if all newsgroups are removed - ;; from the variable gnus-newsrc-alist. - (when (and (or gnus-newsrc-alist gnus-killed-list) - gnus-current-startup-file) - (save-excursion - (if (and (or gnus-use-dribble-file gnus-slave) - (not force) - (or (not gnus-dribble-buffer) - (not (buffer-name gnus-dribble-buffer)) - (zerop (save-excursion - (set-buffer gnus-dribble-buffer) - (buffer-size))))) - (gnus-message 4 "(No changes need to be saved)") - (run-hooks 'gnus-save-newsrc-hook) - (if gnus-slave - (gnus-slave-save-newsrc) - ;; Save .newsrc. - (when gnus-save-newsrc-file - (gnus-message 8 "Saving %s..." gnus-current-startup-file) - (gnus-gnus-to-newsrc-format) - (gnus-message 8 "Saving %s...done" gnus-current-startup-file)) - ;; Save .newsrc.eld. - (set-buffer (get-buffer-create " *Gnus-newsrc*")) - (make-local-variable 'version-control) - (setq version-control 'never) - (setq buffer-file-name - (concat gnus-current-startup-file ".eld")) - (setq default-directory (file-name-directory buffer-file-name)) - (gnus-add-current-to-buffer-list) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file) - (gnus-gnus-to-quick-newsrc-format) - (run-hooks 'gnus-save-quick-newsrc-hook) - (save-buffer) - (kill-buffer (current-buffer)) - (gnus-message - 5 "Saving %s.eld...done" gnus-current-startup-file)) - (gnus-dribble-delete-file) - (gnus-group-set-mode-line))))) - -(defun gnus-gnus-to-quick-newsrc-format () - "Insert Gnus variables such as gnus-newsrc-alist in lisp format." - (let ((print-quoted t)) - (insert ";; -*- emacs-lisp -*-\n") - (insert ";; Gnus startup file.\n") - (insert - ";; Never delete this file - touch .newsrc instead to force Gnus\n") - (insert ";; to read .newsrc.\n") - (insert "(setq gnus-newsrc-file-version " - (prin1-to-string gnus-version) ")\n") - (let* ((gnus-killed-list - (if (and gnus-save-killed-list - (stringp gnus-save-killed-list)) - (gnus-strip-killed-list) - gnus-killed-list)) - (variables - (if gnus-save-killed-list gnus-variable-list - ;; Remove the `gnus-killed-list' from the list of variables - ;; to be saved, if required. - (delq 'gnus-killed-list (copy-sequence gnus-variable-list)))) - ;; Peel off the "dummy" group. - (gnus-newsrc-alist (cdr gnus-newsrc-alist)) - variable) - ;; Insert the variables into the file. - (while variables - (when (and (boundp (setq variable (pop variables))) - (symbol-value variable)) - (insert "(setq " (symbol-name variable) " '") - (gnus-prin1 (symbol-value variable)) - (insert ")\n")))))) - -(defun gnus-strip-killed-list () - "Return the killed list minus the groups that match `gnus-save-killed-list'." - (let ((list gnus-killed-list) - olist) - (while list - (when (string-match gnus-save-killed-list) - (push (car list) olist)) - (pop list)) - (nreverse olist))) - -(defun gnus-gnus-to-newsrc-format () - ;; Generate and save the .newsrc file. - (save-excursion - (set-buffer (create-file-buffer gnus-current-startup-file)) - (let ((newsrc (cdr gnus-newsrc-alist)) - (standard-output (current-buffer)) - info ranges range method) - (setq buffer-file-name gnus-current-startup-file) - (setq default-directory (file-name-directory buffer-file-name)) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - ;; Write options. - (when gnus-newsrc-options - (insert gnus-newsrc-options)) - ;; Write subscribed and unsubscribed. - (while (setq info (pop newsrc)) - ;; Don't write foreign groups to .newsrc. - (when (or (null (setq method (gnus-info-method info))) - (equal method "native") - (inline (gnus-server-equal method gnus-select-method))) - (insert (gnus-info-group info) - (if (> (gnus-info-level info) gnus-level-subscribed) - "!" ":")) - (when (setq ranges (gnus-info-read info)) - (insert " ") - (if (not (listp (cdr ranges))) - (if (= (car ranges) (cdr ranges)) - (princ (car ranges)) - (princ (car ranges)) - (insert "-") - (princ (cdr ranges))) - (while (setq range (pop ranges)) - (if (or (atom range) (= (car range) (cdr range))) - (princ (or (and (atom range) range) (car range))) - (princ (car range)) - (insert "-") - (princ (cdr range))) - (when ranges - (insert ","))))) - (insert "\n"))) - (make-local-variable 'version-control) - (setq version-control 'never) - ;; It has been reported that sometime the modtime on the .newsrc - ;; file seems to be off. We really do want to overwrite it, so - ;; we clear the modtime here before saving. It's a bit odd, - ;; though... - ;; sometimes the modtime clear isn't sufficient. most brute force: - ;; delete the silly thing entirely first. but this fails to provide - ;; such niceties as .newsrc~ creation. - (if gnus-modtime-botch - (delete-file gnus-startup-file) - (clear-visited-file-modtime)) - (run-hooks 'gnus-save-standard-newsrc-hook) - (save-buffer) - (kill-buffer (current-buffer))))) - - -;;; -;;; Slave functions. -;;; - -(defun gnus-slave-save-newsrc () - (save-excursion - (set-buffer gnus-dribble-buffer) - (let ((slave-name - (make-temp-name (concat gnus-current-startup-file "-slave-"))) - (modes (ignore-errors - (file-modes (concat gnus-current-startup-file ".eld"))))) - (gnus-write-buffer slave-name) - (when modes - (set-file-modes slave-name modes))))) - -(defun gnus-master-read-slave-newsrc () - (let ((slave-files - (directory-files - (file-name-directory gnus-current-startup-file) - t (concat - "^" (regexp-quote - (concat - (file-name-nondirectory gnus-current-startup-file) - "-slave-"))) - t)) - file) - (if (not slave-files) - () ; There are no slave files to read. - (gnus-message 7 "Reading slave newsrcs...") - (save-excursion - (set-buffer (get-buffer-create " *gnus slave*")) - (buffer-disable-undo (current-buffer)) - (setq slave-files - (sort (mapcar (lambda (file) - (list (nth 5 (file-attributes file)) file)) - slave-files) - (lambda (f1 f2) - (or (< (caar f1) (caar f2)) - (< (nth 1 (car f1)) (nth 1 (car f2))))))) - (while slave-files - (erase-buffer) - (setq file (nth 1 (car slave-files))) - (insert-file-contents file) - (when (condition-case () - (progn - (eval-buffer (current-buffer)) - t) - (error - (gnus-error 3.2 "Possible error in %s" file) - nil)) - (unless gnus-slave ; Slaves shouldn't delete these files. - (ignore-errors - (delete-file file)))) - (setq slave-files (cdr slave-files)))) - (gnus-dribble-touch) - (gnus-message 7 "Reading slave newsrcs...done")))) - - -;;; -;;; Group description. -;;; - -(defun gnus-read-all-descriptions-files () - (let ((methods (cons gnus-select-method - (nconc - (when (gnus-archive-server-wanted-p) - (list "archive")) - gnus-secondary-select-methods)))) - (while methods - (gnus-read-descriptions-file (car methods)) - (setq methods (cdr methods))) - t)) - -(defun gnus-read-descriptions-file (&optional method) - (let ((method (or method gnus-select-method)) - group) - (when (stringp method) - (setq method (gnus-server-to-method method))) - ;; We create the hashtable whether we manage to read the desc file - ;; to avoid trying to re-read after a failed read. - (unless gnus-description-hashtb - (setq gnus-description-hashtb - (gnus-make-hashtable (length gnus-active-hashtb)))) - ;; Mark this method's desc file as read. - (gnus-sethash (gnus-group-prefixed-name "" method) "Has read" - gnus-description-hashtb) - - (gnus-message 5 "Reading descriptions file via %s..." (car method)) - (cond - ((not (gnus-check-server method)) - (gnus-message 1 "Couldn't open server") - nil) - ((not (gnus-request-list-newsgroups method)) - (gnus-message 1 "Couldn't read newsgroups descriptions") - nil) - (t - (save-excursion - (save-restriction - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (when (or (search-forward "\n.\n" nil t) - (goto-char (point-max))) - (beginning-of-line) - (narrow-to-region (point-min) (point))) - ;; If these are groups from a foreign select method, we insert the - ;; group prefix in front of the group names. - (and method (not (inline - (gnus-server-equal - (gnus-server-get-method nil method) - (gnus-server-get-method - nil gnus-select-method)))) - (let ((prefix (gnus-group-prefixed-name "" method))) - (goto-char (point-min)) - (while (and (not (eobp)) - (progn (insert prefix) - (zerop (forward-line 1))))))) - (goto-char (point-min)) - (while (not (eobp)) - ;; If we get an error, we set group to 0, which is not a - ;; symbol... - (setq group - (condition-case () - (let ((obarray gnus-description-hashtb)) - ;; Group is set to a symbol interned in this - ;; hash table. - (read nntp-server-buffer)) - (error 0))) - (skip-chars-forward " \t") - ;; ... which leads to this line being effectively ignored. - (when (symbolp group) - (set group (buffer-substring - (point) (progn (end-of-line) (point))))) - (forward-line 1)))) - (gnus-message 5 "Reading descriptions file...done") - t)))) - -(defun gnus-group-get-description (group) - "Get the description of a group by sending XGTITLE to the server." - (when (gnus-request-group-description group) - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (when (looking-at "[^ \t]+[ \t]+\\(.*\\)") - (match-string 1))))) - -;;;###autoload -(defun gnus-declare-backend (name &rest abilities) - "Declare backend NAME with ABILITIES as a Gnus backend." - (setq gnus-valid-select-methods - (nconc gnus-valid-select-methods - (list (apply 'list name abilities))))) - -(defun gnus-set-default-directory () - "Set the default directory in the current buffer to `gnus-default-directory'. -If this variable is nil, don't do anything." - (setq default-directory - (if (and gnus-default-directory - (file-exists-p gnus-default-directory)) - (file-name-as-directory (expand-file-name gnus-default-directory)) - default-directory))) - -(provide 'gnus-start) - -;;; gnus-start.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-sum.el --- a/lisp/gnus/gnus-sum.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,8709 +0,0 @@ -;;; gnus-sum.el --- summary mode commands for Gnus -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-group) -(require 'gnus-spec) -(require 'gnus-range) -(require 'gnus-int) -(require 'gnus-undo) - -(defcustom gnus-kill-summary-on-exit t - "*If non-nil, kill the summary buffer when you exit from it. -If nil, the summary will become a \"*Dead Summary*\" buffer, and -it will be killed sometime later." - :group 'gnus-summary-exit - :type 'boolean) - -(defcustom gnus-fetch-old-headers nil - "*Non-nil means that Gnus will try to build threads by grabbing old headers. -If an unread article in the group refers to an older, already read (or -just marked as read) article, the old article will not normally be -displayed in the Summary buffer. If this variable is non-nil, Gnus -will attempt to grab the headers to the old articles, and thereby -build complete threads. If it has the value `some', only enough -headers to connect otherwise loose threads will be displayed. -This variable can also be a number. In that case, no more than that -number of old headers will be fetched. - -The server has to support NOV for any of this to work." - :group 'gnus-thread - :type '(choice (const :tag "off" nil) - (const some) - number - (sexp :menu-tag "other" t))) - -(defcustom gnus-summary-make-false-root 'adopt - "*nil means that Gnus won't gather loose threads. -If the root of a thread has expired or been read in a previous -session, the information necessary to build a complete thread has been -lost. Instead of having many small sub-threads from this original thread -scattered all over the summary buffer, Gnus can gather them. - -If non-nil, Gnus will try to gather all loose sub-threads from an -original thread into one large thread. - -If this variable is non-nil, it should be one of `none', `adopt', -`dummy' or `empty'. - -If this variable is `none', Gnus will not make a false root, but just -present the sub-threads after another. -If this variable is `dummy', Gnus will create a dummy root that will -have all the sub-threads as children. -If this variable is `adopt', Gnus will make one of the \"children\" -the parent and mark all the step-children as such. -If this variable is `empty', the \"children\" are printed with empty -subject fields. (Or rather, they will be printed with a string -given by the `gnus-summary-same-subject' variable.)" - :group 'gnus-thread - :type '(choice (const :tag "off" nil) - (const none) - (const dummy) - (const adopt) - (const empty))) - -(defcustom gnus-summary-gather-exclude-subject "^ *$\\|^(none)$" - "*A regexp to match subjects to be excluded from loose thread gathering. -As loose thread gathering is done on subjects only, that means that -there can be many false gatherings performed. By rooting out certain -common subjects, gathering might become saner." - :group 'gnus-thread - :type 'regexp) - -(defcustom gnus-summary-gather-subject-limit nil - "*Maximum length of subject comparisons when gathering loose threads. -Use nil to compare full subjects. Setting this variable to a low -number will help gather threads that have been corrupted by -newsreaders chopping off subject lines, but it might also mean that -unrelated articles that have subject that happen to begin with the -same few characters will be incorrectly gathered. - -If this variable is `fuzzy', Gnus will use a fuzzy algorithm when -comparing subjects." - :group 'gnus-thread - :type '(choice (const :tag "off" nil) - (const fuzzy) - (sexp :menu-tag "on" t))) - -(defcustom gnus-simplify-ignored-prefixes nil - "*Regexp, matches for which are removed from subject lines when simplifying fuzzily." - :group 'gnus-thread - :type '(choice (const :tag "off" nil) - regexp)) - -(defcustom gnus-build-sparse-threads nil - "*If non-nil, fill in the gaps in threads. -If `some', only fill in the gaps that are needed to tie loose threads -together. If `more', fill in all leaf nodes that Gnus can find. If -non-nil and non-`some', fill in all gaps that Gnus manages to guess." - :group 'gnus-thread - :type '(choice (const :tag "off" nil) - (const some) - (const more) - (sexp :menu-tag "all" t))) - -(defcustom gnus-summary-thread-gathering-function - 'gnus-gather-threads-by-subject - "Function used for gathering loose threads. -There are two pre-defined functions: `gnus-gather-threads-by-subject', -which only takes Subjects into consideration; and -`gnus-gather-threads-by-references', which compared the References -headers of the articles to find matches." - :group 'gnus-thread - :type '(set (function-item gnus-gather-threads-by-subject) - (function-item gnus-gather-threads-by-references) - (function :tag "other"))) - -;; Added by Per Abrahamsen . -(defcustom gnus-summary-same-subject "" - "*String indicating that the current article has the same subject as the previous. -This variable will only be used if the value of -`gnus-summary-make-false-root' is `empty'." - :group 'gnus-summary-format - :type 'string) - -(defcustom gnus-summary-goto-unread t - "*If t, marking commands will go to the next unread article. -If `never', commands that usually go to the next unread article, will -go to the next article, whether it is read or not. -If nil, only the marking commands will go to the next (un)read article." - :group 'gnus-summary-marks - :link '(custom-manual "(gnus)Setting Marks") - :type '(choice (const :tag "off" nil) - (const never) - (sexp :menu-tag "on" t))) - -(defcustom gnus-summary-default-score 0 - "*Default article score level. -All scores generated by the score files will be added to this score. -If this variable is nil, scoring will be disabled." - :group 'gnus-score-default - :type '(choice (const :tag "disable") - integer)) - -(defcustom gnus-summary-zcore-fuzz 0 - "*Fuzziness factor for the zcore in the summary buffer. -Articles with scores closer than this to `gnus-summary-default-score' -will not be marked." - :group 'gnus-summary-format - :type 'integer) - -(defcustom gnus-simplify-subject-fuzzy-regexp nil - "*Strings to be removed when doing fuzzy matches. -This can either be a regular expression or list of regular expressions -that will be removed from subject strings if fuzzy subject -simplification is selected." - :group 'gnus-thread - :type '(repeat regexp)) - -(defcustom gnus-show-threads t - "*If non-nil, display threads in summary mode." - :group 'gnus-thread - :type 'boolean) - -(defcustom gnus-thread-hide-subtree nil - "*If non-nil, hide all threads initially. -If threads are hidden, you have to run the command -`gnus-summary-show-thread' by hand or use `gnus-select-article-hook' -to expose hidden threads." - :group 'gnus-thread - :type 'boolean) - -(defcustom gnus-thread-hide-killed t - "*If non-nil, hide killed threads automatically." - :group 'gnus-thread - :type 'boolean) - -(defcustom gnus-thread-ignore-subject nil - "*If non-nil, ignore subjects and do all threading based on the Reference header. -If nil, which is the default, articles that have different subjects -from their parents will start separate threads." - :group 'gnus-thread - :type 'boolean) - -(defcustom gnus-thread-operation-ignore-subject t - "*If non-nil, subjects will be ignored when doing thread commands. -This affects commands like `gnus-summary-kill-thread' and -`gnus-summary-lower-thread'. - -If this variable is nil, articles in the same thread with different -subjects will not be included in the operation in question. If this -variable is `fuzzy', only articles that have subjects that are fuzzily -equal will be included." - :group 'gnus-thread - :type '(choice (const :tag "off" nil) - (const fuzzy) - (sexp :tag "on" t))) - -(defcustom gnus-thread-indent-level 4 - "*Number that says how much each sub-thread should be indented." - :group 'gnus-thread - :type 'integer) - -(defcustom gnus-auto-extend-newsgroup t - "*If non-nil, extend newsgroup forward and backward when requested." - :group 'gnus-summary-choose - :type 'boolean) - -(defcustom gnus-auto-select-first t - "*If nil, don't select the first unread article when entering a group. -If this variable is `best', select the highest-scored unread article -in the group. If neither nil nor `best', select the first unread -article. - -If you want to prevent automatic selection of the first unread article -in some newsgroups, set the variable to nil in -`gnus-select-group-hook'." - :group 'gnus-group-select - :type '(choice (const :tag "none" nil) - (const best) - (sexp :menu-tag "first" t))) - -(defcustom gnus-auto-select-next t - "*If non-nil, offer to go to the next group from the end of the previous. -If the value is t and the next newsgroup is empty, Gnus will exit -summary mode and go back to group mode. If the value is neither nil -nor t, Gnus will select the following unread newsgroup. In -particular, if the value is the symbol `quietly', the next unread -newsgroup will be selected without any confirmation, and if it is -`almost-quietly', the next group will be selected without any -confirmation if you are located on the last article in the group. -Finally, if this variable is `slightly-quietly', the `Z n' command -will go to the next group without confirmation." - :group 'gnus-summary-maneuvering - :type '(choice (const :tag "off" nil) - (const quietly) - (const almost-quietly) - (const slightly-quietly) - (sexp :menu-tag "on" t))) - -(defcustom gnus-auto-select-same nil - "*If non-nil, select the next article with the same subject." - :group 'gnus-summary-maneuvering - :type 'boolean) - -(defcustom gnus-summary-check-current nil - "*If non-nil, consider the current article when moving. -The \"unread\" movement commands will stay on the same line if the -current article is unread." - :group 'gnus-summary-maneuvering - :type 'boolean) - -(defcustom gnus-auto-center-summary t - "*If non-nil, always center the current summary buffer. -In particular, if `vertical' do only vertical recentering. If non-nil -and non-`vertical', do both horizontal and vertical recentering." - :group 'gnus-summary-maneuvering - :type '(choice (const :tag "none" nil) - (const vertical) - (sexp :menu-tag "both" t))) - -(defcustom gnus-show-all-headers nil - "*If non-nil, don't hide any headers." - :group 'gnus-article-hiding - :group 'gnus-article-headers - :type 'boolean) - -(defcustom gnus-summary-ignore-duplicates nil - "*If non-nil, ignore articles with identical Message-ID headers." - :group 'gnus-summary - :type 'boolean) - -(defcustom gnus-single-article-buffer t - "*If non-nil, display all articles in the same buffer. -If nil, each group will get its own article buffer." - :group 'gnus-article-various - :type 'boolean) - -(defcustom gnus-break-pages t - "*If non-nil, do page breaking on articles. -The page delimiter is specified by the `gnus-page-delimiter' -variable." - :group 'gnus-article-various - :type 'boolean) - -(defcustom gnus-show-mime nil - "*If non-nil, do mime processing of articles. -The articles will simply be fed to the function given by -`gnus-show-mime-method'." - :group 'gnus-article-mime - :type 'boolean) - -(defcustom gnus-move-split-methods nil - "*Variable used to suggest where articles are to be moved to. -It uses the same syntax as the `gnus-split-methods' variable." - :group 'gnus-summary-mail - :type '(repeat (choice (list function) - (cons regexp (repeat string)) - sexp))) - -(defcustom gnus-unread-mark ? - "*Mark used for unread articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-ticked-mark ?! - "*Mark used for ticked articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-dormant-mark ?? - "*Mark used for dormant articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-del-mark ?r - "*Mark used for del'd articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-read-mark ?R - "*Mark used for read articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-expirable-mark ?E - "*Mark used for expirable articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-killed-mark ?K - "*Mark used for killed articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-souped-mark ?F - "*Mark used for killed articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-kill-file-mark ?X - "*Mark used for articles killed by kill files." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-low-score-mark ?Y - "*Mark used for articles with a low score." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-catchup-mark ?C - "*Mark used for articles that are caught up." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-replied-mark ?A - "*Mark used for articles that have been replied to." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-cached-mark ?* - "*Mark used for articles that are in the cache." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-saved-mark ?S - "*Mark used for articles that have been saved to." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-ancient-mark ?O - "*Mark used for ancient articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-sparse-mark ?Q - "*Mark used for sparsely reffed articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-canceled-mark ?G - "*Mark used for canceled articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-duplicate-mark ?M - "*Mark used for duplicate articles." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-score-over-mark ?+ - "*Score mark used for articles with high scores." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-score-below-mark ?- - "*Score mark used for articles with low scores." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-empty-thread-mark ? - "*There is no thread under the article." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-not-empty-thread-mark ?= - "*There is a thread under the article." - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-view-pseudo-asynchronously nil - "*If non-nil, Gnus will view pseudo-articles asynchronously." - :group 'gnus-extract-view - :type 'boolean) - -(defcustom gnus-view-pseudos nil - "*If `automatic', pseudo-articles will be viewed automatically. -If `not-confirm', pseudos will be viewed automatically, and the user -will not be asked to confirm the command." - :group 'gnus-extract-view - :type '(choice (const :tag "off" nil) - (const automatic) - (const not-confirm))) - -(defcustom gnus-view-pseudos-separately t - "*If non-nil, one pseudo-article will be created for each file to be viewed. -If nil, all files that use the same viewing command will be given as a -list of parameters to that command." - :group 'gnus-extract-view - :type 'boolean) - -(defcustom gnus-insert-pseudo-articles t - "*If non-nil, insert pseudo-articles when decoding articles." - :group 'gnus-extract-view - :type 'boolean) - -(defcustom gnus-summary-dummy-line-format - "* %(: :%) %S\n" - "*The format specification for the dummy roots in the summary buffer. -It works along the same lines as a normal formatting string, -with some simple extensions. - -%S The subject" - :group 'gnus-threading - :type 'string) - -(defcustom gnus-summary-mode-line-format "Gnus: %%b [%A] %Z" - "*The format specification for the summary mode line. -It works along the same lines as a normal formatting string, -with some simple extensions: - -%G Group name -%p Unprefixed group name -%A Current article number -%V Gnus version -%U Number of unread articles in the group -%e Number of unselected articles in the group -%Z A string with unread/unselected article counts -%g Shortish group name -%S Subject of the current article -%u User-defined spec -%s Current score file name -%d Number of dormant articles -%r Number of articles that have been marked as read in this session -%E Number of articles expunged by the score files" - :group 'gnus-summary-format - :type 'string) - -(defcustom gnus-summary-mark-below 0 - "*Mark all articles with a score below this variable as read. -This variable is local to each summary buffer and usually set by the -score file." - :group 'gnus-score-default - :type 'integer) - -(defcustom gnus-article-sort-functions '(gnus-article-sort-by-number) - "*List of functions used for sorting articles in the summary buffer. -This variable is only used when not using a threaded display." - :group 'gnus-summary-sort - :type '(repeat (choice (function-item gnus-article-sort-by-number) - (function-item gnus-article-sort-by-author) - (function-item gnus-article-sort-by-subject) - (function-item gnus-article-sort-by-date) - (function-item gnus-article-sort-by-score) - (function :tag "other")))) - -(defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number) - "*List of functions used for sorting threads in the summary buffer. -By default, threads are sorted by article number. - -Each function takes two threads and return non-nil if the first thread -should be sorted before the other. If you use more than one function, -the primary sort function should be the last. You should probably -always include `gnus-thread-sort-by-number' in the list of sorting -functions -- preferably first. - -Ready-made functions include `gnus-thread-sort-by-number', -`gnus-thread-sort-by-author', `gnus-thread-sort-by-subject', -`gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and -`gnus-thread-sort-by-total-score' (see `gnus-thread-score-function')." - :group 'gnus-summary-sort - :type '(repeat (choice (function-item gnus-thread-sort-by-number) - (function-item gnus-thread-sort-by-author) - (function-item gnus-thread-sort-by-subject) - (function-item gnus-thread-sort-by-date) - (function-item gnus-thread-sort-by-score) - (function-item gnus-thread-sort-by-total-score) - (function :tag "other")))) - -(defcustom gnus-thread-score-function '+ - "*Function used for calculating the total score of a thread. - -The function is called with the scores of the article and each -subthread and should then return the score of the thread. - -Some functions you can use are `+', `max', or `min'." - :group 'gnus-summary-sort - :type 'function) - -(defcustom gnus-summary-expunge-below nil - "All articles that have a score less than this variable will be expunged." - :group 'gnus-score-default - :type '(choice (const :tag "off" nil) - integer)) - -(defcustom gnus-thread-expunge-below nil - "All threads that have a total score less than this variable will be expunged. -See `gnus-thread-score-function' for en explanation of what a -\"thread score\" is." - :group 'gnus-treading - :group 'gnus-score-default - :type '(choice (const :tag "off" nil) - integer)) - -(defcustom gnus-summary-mode-hook nil - "*A hook for Gnus summary mode. -This hook is run before any variables are set in the summary buffer." - :group 'gnus-summary-various - :type 'hook) - -(defcustom gnus-summary-menu-hook nil - "*Hook run after the creation of the summary mode menu." - :group 'gnus-summary-visual - :type 'hook) - -(defcustom gnus-summary-exit-hook nil - "*A hook called on exit from the summary buffer. -It will be called with point in the group buffer." - :group 'gnus-summary-exit - :type 'hook) - -(defcustom gnus-summary-prepare-hook nil - "*A hook called after the summary buffer has been generated. -If you want to modify the summary buffer, you can use this hook." - :group 'gnus-summary-various - :type 'hook) - -(defcustom gnus-summary-generate-hook nil - "*A hook run just before generating the summary buffer. -This hook is commonly used to customize threading variables and the -like." - :group 'gnus-summary-various - :type 'hook) - -(defcustom gnus-select-group-hook nil - "*A hook called when a newsgroup is selected. - -If you'd like to simplify subjects like the -`gnus-summary-next-same-subject' command does, you can use the -following hook: - - (setq gnus-select-group-hook - (list - (lambda () - (mapcar (lambda (header) - (mail-header-set-subject - header - (gnus-simplify-subject - (mail-header-subject header) 're-only))) - gnus-newsgroup-headers))))" - :group 'gnus-group-select - :type 'hook) - -(defcustom gnus-select-article-hook nil - "*A hook called when an article is selected." - :group 'gnus-summary-choose - :type 'hook) - -(defcustom gnus-visual-mark-article-hook - (list 'gnus-highlight-selected-summary) - "*Hook run after selecting an article in the summary buffer. -It is meant to be used for highlighting the article in some way. It -is not run if `gnus-visual' is nil." - :group 'gnus-summary-visual - :type 'hook) - -(defcustom gnus-parse-headers-hook - (list 'gnus-hack-decode-rfc1522 'gnus-decode-rfc1522) - "*A hook called before parsing the headers." - :group 'gnus-various - :type 'hook) - -(defcustom gnus-exit-group-hook nil - "*A hook called when exiting (not quitting) summary mode." - :group 'gnus-various - :type 'hook) - -(defcustom gnus-summary-update-hook - (list 'gnus-summary-highlight-line) - "*A hook called when a summary line is changed. -The hook will not be called if `gnus-visual' is nil. - -The default function `gnus-summary-highlight-line' will -highlight the line according to the `gnus-summary-highlight' -variable." - :group 'gnus-summary-visual - :type 'hook) - -(defcustom gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read) - "*A hook called when an article is selected for the first time. -The hook is intended to mark an article as read (or unread) -automatically when it is selected." - :group 'gnus-summary-choose - :type 'hook) - -(defcustom gnus-group-no-more-groups-hook nil - "*A hook run when returning to group mode having no more (unread) groups." - :group 'gnus-group-select - :type 'hook) - -(defcustom gnus-ps-print-hook nil - "*A hook run before ps-printing something from Gnus." - :group 'gnus-summary - :type 'hook) - -(defcustom gnus-summary-selected-face 'gnus-summary-selected-face - "Face used for highlighting the current article in the summary buffer." - :group 'gnus-summary-visual - :type 'face) - -(defcustom gnus-summary-highlight - '(((= mark gnus-canceled-mark) - . gnus-summary-cancelled-face) - ((and (> score default) - (or (= mark gnus-dormant-mark) - (= mark gnus-ticked-mark))) - . gnus-summary-high-ticked-face) - ((and (< score default) - (or (= mark gnus-dormant-mark) - (= mark gnus-ticked-mark))) - . gnus-summary-low-ticked-face) - ((or (= mark gnus-dormant-mark) - (= mark gnus-ticked-mark)) - . gnus-summary-normal-ticked-face) - ((and (> score default) (= mark gnus-ancient-mark)) - . gnus-summary-high-ancient-face) - ((and (< score default) (= mark gnus-ancient-mark)) - . gnus-summary-low-ancient-face) - ((= mark gnus-ancient-mark) - . gnus-summary-normal-ancient-face) - ((and (> score default) (= mark gnus-unread-mark)) - . gnus-summary-high-unread-face) - ((and (< score default) (= mark gnus-unread-mark)) - . gnus-summary-low-unread-face) - ((and (= mark gnus-unread-mark)) - . gnus-summary-normal-unread-face) - ((> score default) - . gnus-summary-high-read-face) - ((< score default) - . gnus-summary-low-read-face) - (t - . gnus-summary-normal-read-face)) - "Controls the highlighting of summary buffer lines. - -A list of (FORM . FACE) pairs. When deciding how a a particular -summary line should be displayed, each form is evaluated. The content -of the face field after the first true form is used. You can change -how those summary lines are displayed, by editing the face field. - -You can use the following variables in the FORM field. - -score: The articles score -default: The default article score. -below: The score below which articles are automatically marked as read. -mark: The articles mark." - :group 'gnus-summary-visual - :type '(repeat (cons (sexp :tag "Form" nil) - face))) - - -;;; Internal variables - -(defvar gnus-scores-exclude-files nil) -(defvar gnus-page-broken nil) - -(defvar gnus-original-article nil) -(defvar gnus-article-internal-prepare-hook nil) -(defvar gnus-newsgroup-process-stack nil) - -(defvar gnus-thread-indent-array nil) -(defvar gnus-thread-indent-array-level gnus-thread-indent-level) - -;; Avoid highlighting in kill files. -(defvar gnus-summary-inhibit-highlight nil) -(defvar gnus-newsgroup-selected-overlay nil) -(defvar gnus-inhibit-limiting nil) -(defvar gnus-newsgroup-adaptive-score-file nil) -(defvar gnus-current-score-file nil) -(defvar gnus-current-move-group nil) -(defvar gnus-current-copy-group nil) -(defvar gnus-current-crosspost-group nil) - -(defvar gnus-newsgroup-dependencies nil) -(defvar gnus-newsgroup-adaptive nil) -(defvar gnus-summary-display-article-function nil) -(defvar gnus-summary-highlight-line-function nil - "Function called after highlighting a summary line.") - -(defvar gnus-summary-line-format-alist - `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d) - (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s) - (?s gnus-tmp-subject-or-nil ?s) - (?n gnus-tmp-name ?s) - (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from))) - ?s) - (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from)) - gnus-tmp-from) ?s) - (?F gnus-tmp-from ?s) - (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s) - (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s) - (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s) - (?o (gnus-date-iso8601 gnus-tmp-header) ?s) - (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s) - (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s) - (?c (or (mail-header-chars gnus-tmp-header) 0) ?d) - (?L gnus-tmp-lines ?d) - (?I gnus-tmp-indentation ?s) - (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s) - (?R gnus-tmp-replied ?c) - (?\[ gnus-tmp-opening-bracket ?c) - (?\] gnus-tmp-closing-bracket ?c) - (?\> (make-string gnus-tmp-level ? ) ?s) - (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s) - (?i gnus-tmp-score ?d) - (?z gnus-tmp-score-char ?c) - (?l (bbb-grouplens-score gnus-tmp-header) ?s) - (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d) - (?U gnus-tmp-unread ?c) - (?t (gnus-summary-number-of-articles-in-thread - (and (boundp 'thread) (car thread)) gnus-tmp-level) - ?d) - (?e (gnus-summary-number-of-articles-in-thread - (and (boundp 'thread) (car thread)) gnus-tmp-level t) - ?c) - (?u gnus-tmp-user-defined ?s) - (?P (gnus-pick-line-number) ?d)) - "An alist of format specifications that can appear in summary lines, -and what variables they correspond with, along with the type of the -variable (string, integer, character, etc).") - -(defvar gnus-summary-dummy-line-format-alist - `((?S gnus-tmp-subject ?s) - (?N gnus-tmp-number ?d) - (?u gnus-tmp-user-defined ?s))) - -(defvar gnus-summary-mode-line-format-alist - `((?G gnus-tmp-group-name ?s) - (?g (gnus-short-group-name gnus-tmp-group-name) ?s) - (?p (gnus-group-real-name gnus-tmp-group-name) ?s) - (?A gnus-tmp-article-number ?d) - (?Z gnus-tmp-unread-and-unselected ?s) - (?V gnus-version ?s) - (?U gnus-tmp-unread-and-unticked ?d) - (?S gnus-tmp-subject ?s) - (?e gnus-tmp-unselected ?d) - (?u gnus-tmp-user-defined ?s) - (?d (length gnus-newsgroup-dormant) ?d) - (?t (length gnus-newsgroup-marked) ?d) - (?r (length gnus-newsgroup-reads) ?d) - (?E gnus-newsgroup-expunged-tally ?d) - (?s (gnus-current-score-file-nondirectory) ?s))) - -(defvar gnus-last-search-regexp nil - "Default regexp for article search command.") - -(defvar gnus-last-shell-command nil - "Default shell command on article.") - -(defvar gnus-newsgroup-begin nil) -(defvar gnus-newsgroup-end nil) -(defvar gnus-newsgroup-last-rmail nil) -(defvar gnus-newsgroup-last-mail nil) -(defvar gnus-newsgroup-last-folder nil) -(defvar gnus-newsgroup-last-file nil) -(defvar gnus-newsgroup-auto-expire nil) -(defvar gnus-newsgroup-active nil) - -(defvar gnus-newsgroup-data nil) -(defvar gnus-newsgroup-data-reverse nil) -(defvar gnus-newsgroup-limit nil) -(defvar gnus-newsgroup-limits nil) - -(defvar gnus-newsgroup-unreads nil - "List of unread articles in the current newsgroup.") - -(defvar gnus-newsgroup-unselected nil - "List of unselected unread articles in the current newsgroup.") - -(defvar gnus-newsgroup-reads nil - "Alist of read articles and article marks in the current newsgroup.") - -(defvar gnus-newsgroup-expunged-tally nil) - -(defvar gnus-newsgroup-marked nil - "List of ticked articles in the current newsgroup (a subset of unread art).") - -(defvar gnus-newsgroup-killed nil - "List of ranges of articles that have been through the scoring process.") - -(defvar gnus-newsgroup-cached nil - "List of articles that come from the article cache.") - -(defvar gnus-newsgroup-saved nil - "List of articles that have been saved.") - -(defvar gnus-newsgroup-kill-headers nil) - -(defvar gnus-newsgroup-replied nil - "List of articles that have been replied to in the current newsgroup.") - -(defvar gnus-newsgroup-expirable nil - "List of articles in the current newsgroup that can be expired.") - -(defvar gnus-newsgroup-processable nil - "List of articles in the current newsgroup that can be processed.") - -(defvar gnus-newsgroup-bookmarks nil - "List of articles in the current newsgroup that have bookmarks.") - -(defvar gnus-newsgroup-dormant nil - "List of dormant articles in the current newsgroup.") - -(defvar gnus-newsgroup-scored nil - "List of scored articles in the current newsgroup.") - -(defvar gnus-newsgroup-headers nil - "List of article headers in the current newsgroup.") - -(defvar gnus-newsgroup-threads nil) - -(defvar gnus-newsgroup-prepared nil - "Whether the current group has been prepared properly.") - -(defvar gnus-newsgroup-ancient nil - "List of `gnus-fetch-old-headers' articles in the current newsgroup.") - -(defvar gnus-newsgroup-sparse nil) - -(defvar gnus-current-article nil) -(defvar gnus-article-current nil) -(defvar gnus-current-headers nil) -(defvar gnus-have-all-headers nil) -(defvar gnus-last-article nil) -(defvar gnus-newsgroup-history nil) - -(defconst gnus-summary-local-variables - '(gnus-newsgroup-name - gnus-newsgroup-begin gnus-newsgroup-end - gnus-newsgroup-last-rmail gnus-newsgroup-last-mail - gnus-newsgroup-last-folder gnus-newsgroup-last-file - gnus-newsgroup-auto-expire gnus-newsgroup-unreads - gnus-newsgroup-unselected gnus-newsgroup-marked - gnus-newsgroup-reads gnus-newsgroup-saved - gnus-newsgroup-replied gnus-newsgroup-expirable - gnus-newsgroup-processable gnus-newsgroup-killed - gnus-newsgroup-bookmarks gnus-newsgroup-dormant - gnus-newsgroup-headers gnus-newsgroup-threads - gnus-newsgroup-prepared gnus-summary-highlight-line-function - gnus-current-article gnus-current-headers gnus-have-all-headers - gnus-last-article gnus-article-internal-prepare-hook - gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay - gnus-newsgroup-scored gnus-newsgroup-kill-headers - gnus-thread-expunge-below - gnus-score-alist gnus-current-score-file gnus-summary-expunge-below - (gnus-summary-mark-below . global) - gnus-newsgroup-active gnus-scores-exclude-files - gnus-newsgroup-history gnus-newsgroup-ancient - gnus-newsgroup-sparse gnus-newsgroup-process-stack - (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-newsgroup-data gnus-newsgroup-data-reverse - gnus-newsgroup-limit gnus-newsgroup-limits) - "Variables that are buffer-local to the summary buffers.") - -;; Byte-compiler warning. -(defvar gnus-article-mode-map) - -;; Subject simplification. - -(defsubst gnus-simplify-subject-re (subject) - "Remove \"Re:\" from subject lines." - (if (string-match "^[Rr][Ee]: *" subject) - (substring subject (match-end 0)) - subject)) - -(defun gnus-simplify-subject (subject &optional re-only) - "Remove `Re:' and words in parentheses. -If RE-ONLY is non-nil, strip leading `Re:'s only." - (let ((case-fold-search t)) ;Ignore case. - ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'. - (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject) - (setq subject (substring subject (match-end 0)))) - ;; Remove uninteresting prefixes. - (when (and (not re-only) - gnus-simplify-ignored-prefixes - (string-match gnus-simplify-ignored-prefixes subject)) - (setq subject (substring subject (match-end 0)))) - ;; Remove words in parentheses from end. - (unless re-only - (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject) - (setq subject (substring subject 0 (match-beginning 0))))) - ;; Return subject string. - subject)) - -;; Remove any leading "re:"s, any trailing paren phrases, and simplify -;; all whitespace. -(defsubst gnus-simplify-buffer-fuzzy-step (regexp &optional newtext) - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (replace-match (or newtext "")))) - -(defun gnus-simplify-buffer-fuzzy () - "Simplify string in the buffer fuzzily. -The string in the accessible portion of the current buffer is simplified. -It is assumed to be a single-line subject. -Whitespace is generally cleaned up, and miscellaneous leading/trailing -matter is removed. Additional things can be deleted by setting -gnus-simplify-subject-fuzzy-regexp." - (let ((case-fold-search t) - (modified-tick)) - (gnus-simplify-buffer-fuzzy-step "\t" " ") - - (while (not (eq modified-tick (buffer-modified-tick))) - (setq modified-tick (buffer-modified-tick)) - (cond - ((listp gnus-simplify-subject-fuzzy-regexp) - (mapcar 'gnus-simplify-buffer-fuzzy-step - gnus-simplify-subject-fuzzy-regexp)) - (gnus-simplify-subject-fuzzy-regexp - (gnus-simplify-buffer-fuzzy-step gnus-simplify-subject-fuzzy-regexp))) - (gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *") - (gnus-simplify-buffer-fuzzy-step - "^ *\\(re\\|fw\\|fwd\\)[[{(^0-9]*[])}]?[:;] *") - (gnus-simplify-buffer-fuzzy-step "^[[].*:\\( .*\\)[]]$" "\\1")) - - (gnus-simplify-buffer-fuzzy-step " *[[{(][^()\n]*[]})] *$") - (gnus-simplify-buffer-fuzzy-step " +" " ") - (gnus-simplify-buffer-fuzzy-step " $") - (gnus-simplify-buffer-fuzzy-step "^ +"))) - -(defun gnus-simplify-subject-fuzzy (subject) - "Simplify a subject string fuzzily. -See gnus-simplify-buffer-fuzzy for details." - (save-excursion - (gnus-set-work-buffer) - (let ((case-fold-search t)) - (insert subject) - (inline (gnus-simplify-buffer-fuzzy)) - (buffer-string)))) - -(defsubst gnus-simplify-subject-fully (subject) - "Simplify a subject string according to gnus-summary-gather-subject-limit." - (cond - ((null gnus-summary-gather-subject-limit) - (gnus-simplify-subject-re subject)) - ((eq gnus-summary-gather-subject-limit 'fuzzy) - (gnus-simplify-subject-fuzzy subject)) - ((numberp gnus-summary-gather-subject-limit) - (gnus-limit-string (gnus-simplify-subject-re subject) - gnus-summary-gather-subject-limit)) - (t - subject))) - -(defsubst gnus-subject-equal (s1 s2 &optional simple-first) - "Check whether two subjects are equal. If optional argument -simple-first is t, first argument is already simplified." - (cond - ((null simple-first) - (equal (gnus-simplify-subject-fully s1) - (gnus-simplify-subject-fully s2))) - (t - (equal s1 - (gnus-simplify-subject-fully s2))))) - -(defun gnus-summary-bubble-group () - "Increase the score of the current group. -This is a handy function to add to `gnus-summary-exit-hook' to -increase the score of each group you read." - (gnus-group-add-score gnus-newsgroup-name)) - - -;;; -;;; Gnus summary mode -;;; - -(put 'gnus-summary-mode 'mode-class 'special) - -(when t - ;; Non-orthogonal keys - - (gnus-define-keys gnus-summary-mode-map - " " gnus-summary-next-page - "\177" gnus-summary-prev-page - [delete] gnus-summary-prev-page - "\r" gnus-summary-scroll-up - "n" gnus-summary-next-unread-article - "p" gnus-summary-prev-unread-article - "N" gnus-summary-next-article - "P" gnus-summary-prev-article - "\M-\C-n" gnus-summary-next-same-subject - "\M-\C-p" gnus-summary-prev-same-subject - "\M-n" gnus-summary-next-unread-subject - "\M-p" gnus-summary-prev-unread-subject - "." gnus-summary-first-unread-article - "," gnus-summary-best-unread-article - "\M-s" gnus-summary-search-article-forward - "\M-r" gnus-summary-search-article-backward - "<" gnus-summary-beginning-of-article - ">" gnus-summary-end-of-article - "j" gnus-summary-goto-article - "^" gnus-summary-refer-parent-article - "\M-^" gnus-summary-refer-article - "u" gnus-summary-tick-article-forward - "!" gnus-summary-tick-article-forward - "U" gnus-summary-tick-article-backward - "d" gnus-summary-mark-as-read-forward - "D" gnus-summary-mark-as-read-backward - "E" gnus-summary-mark-as-expirable - "\M-u" gnus-summary-clear-mark-forward - "\M-U" gnus-summary-clear-mark-backward - "k" gnus-summary-kill-same-subject-and-select - "\C-k" gnus-summary-kill-same-subject - "\M-\C-k" gnus-summary-kill-thread - "\M-\C-l" gnus-summary-lower-thread - "e" gnus-summary-edit-article - "#" gnus-summary-mark-as-processable - "\M-#" gnus-summary-unmark-as-processable - "\M-\C-t" gnus-summary-toggle-threads - "\M-\C-s" gnus-summary-show-thread - "\M-\C-h" gnus-summary-hide-thread - "\M-\C-f" gnus-summary-next-thread - "\M-\C-b" gnus-summary-prev-thread - "\M-\C-u" gnus-summary-up-thread - "\M-\C-d" gnus-summary-down-thread - "&" gnus-summary-execute-command - "c" gnus-summary-catchup-and-exit - "\C-w" gnus-summary-mark-region-as-read - "\C-t" gnus-summary-toggle-truncation - "?" gnus-summary-mark-as-dormant - "\C-c\M-\C-s" gnus-summary-limit-include-expunged - "\C-c\C-s\C-n" gnus-summary-sort-by-number - "\C-c\C-s\C-l" gnus-summary-sort-by-lines - "\C-c\C-s\C-a" gnus-summary-sort-by-author - "\C-c\C-s\C-s" gnus-summary-sort-by-subject - "\C-c\C-s\C-d" gnus-summary-sort-by-date - "\C-c\C-s\C-i" gnus-summary-sort-by-score - "=" gnus-summary-expand-window - "\C-x\C-s" gnus-summary-reselect-current-group - "\M-g" gnus-summary-rescan-group - "w" gnus-summary-stop-page-breaking - "\C-c\C-r" gnus-summary-caesar-message - "\M-t" gnus-summary-toggle-mime - "f" gnus-summary-followup - "F" gnus-summary-followup-with-original - "C" gnus-summary-cancel-article - "r" gnus-summary-reply - "R" gnus-summary-reply-with-original - "\C-c\C-f" gnus-summary-mail-forward - "o" gnus-summary-save-article - "\C-o" gnus-summary-save-article-mail - "|" gnus-summary-pipe-output - "\M-k" gnus-summary-edit-local-kill - "\M-K" gnus-summary-edit-global-kill - ;; "V" gnus-version - "\C-c\C-d" gnus-summary-describe-group - "q" gnus-summary-exit - "Q" gnus-summary-exit-no-update - "\C-c\C-i" gnus-info-find-node - gnus-mouse-2 gnus-mouse-pick-article - "m" gnus-summary-mail-other-window - "a" gnus-summary-post-news - "x" gnus-summary-limit-to-unread - "s" gnus-summary-isearch-article - "t" gnus-article-hide-headers - "g" gnus-summary-show-article - "l" gnus-summary-goto-last-article - "\C-c\C-v\C-v" gnus-uu-decode-uu-view - "\C-d" gnus-summary-enter-digest-group - "\M-\C-d" gnus-summary-read-document - "\C-c\C-b" gnus-bug - "*" gnus-cache-enter-article - "\M-*" gnus-cache-remove-article - "\M-&" gnus-summary-universal-argument - "\C-l" gnus-recenter - "I" gnus-summary-increase-score - "L" gnus-summary-lower-score - - "V" gnus-summary-score-map - "X" gnus-uu-extract-map - "S" gnus-summary-send-map) - - ;; Sort of orthogonal keymap - (gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map) - "t" gnus-summary-tick-article-forward - "!" gnus-summary-tick-article-forward - "d" gnus-summary-mark-as-read-forward - "r" gnus-summary-mark-as-read-forward - "c" gnus-summary-clear-mark-forward - " " gnus-summary-clear-mark-forward - "e" gnus-summary-mark-as-expirable - "x" gnus-summary-mark-as-expirable - "?" gnus-summary-mark-as-dormant - "b" gnus-summary-set-bookmark - "B" gnus-summary-remove-bookmark - "#" gnus-summary-mark-as-processable - "\M-#" gnus-summary-unmark-as-processable - "S" gnus-summary-limit-include-expunged - "C" gnus-summary-catchup - "H" gnus-summary-catchup-to-here - "\C-c" gnus-summary-catchup-all - "k" gnus-summary-kill-same-subject-and-select - "K" gnus-summary-kill-same-subject - "P" gnus-uu-mark-map) - - (gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mark-map) - "c" gnus-summary-clear-above - "u" gnus-summary-tick-above - "m" gnus-summary-mark-above - "k" gnus-summary-kill-below) - - (gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map) - "/" gnus-summary-limit-to-subject - "n" gnus-summary-limit-to-articles - "w" gnus-summary-pop-limit - "s" gnus-summary-limit-to-subject - "a" gnus-summary-limit-to-author - "u" gnus-summary-limit-to-unread - "m" gnus-summary-limit-to-marks - "v" gnus-summary-limit-to-score - "D" gnus-summary-limit-include-dormant - "d" gnus-summary-limit-exclude-dormant - "t" gnus-summary-limit-to-age - "E" gnus-summary-limit-include-expunged - "c" gnus-summary-limit-exclude-childless-dormant - "C" gnus-summary-limit-mark-excluded-as-read) - - (gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map) - "n" gnus-summary-next-unread-article - "p" gnus-summary-prev-unread-article - "N" gnus-summary-next-article - "P" gnus-summary-prev-article - "\C-n" gnus-summary-next-same-subject - "\C-p" gnus-summary-prev-same-subject - "\M-n" gnus-summary-next-unread-subject - "\M-p" gnus-summary-prev-unread-subject - "f" gnus-summary-first-unread-article - "b" gnus-summary-best-unread-article - "j" gnus-summary-goto-article - "g" gnus-summary-goto-subject - "l" gnus-summary-goto-last-article - "o" gnus-summary-pop-article) - - (gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map) - "k" gnus-summary-kill-thread - "l" gnus-summary-lower-thread - "i" gnus-summary-raise-thread - "T" gnus-summary-toggle-threads - "t" gnus-summary-rethread-current - "^" gnus-summary-reparent-thread - "s" gnus-summary-show-thread - "S" gnus-summary-show-all-threads - "h" gnus-summary-hide-thread - "H" gnus-summary-hide-all-threads - "n" gnus-summary-next-thread - "p" gnus-summary-prev-thread - "u" gnus-summary-up-thread - "o" gnus-summary-top-thread - "d" gnus-summary-down-thread - "#" gnus-uu-mark-thread - "\M-#" gnus-uu-unmark-thread) - - (gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map) - "g" gnus-summary-prepare - "c" gnus-summary-insert-cached-articles) - - (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map) - "c" gnus-summary-catchup-and-exit - "C" gnus-summary-catchup-all-and-exit - "E" gnus-summary-exit-no-update - "Q" gnus-summary-exit - "Z" gnus-summary-exit - "n" gnus-summary-catchup-and-goto-next-group - "R" gnus-summary-reselect-current-group - "G" gnus-summary-rescan-group - "N" gnus-summary-next-group - "s" gnus-summary-save-newsrc - "P" gnus-summary-prev-group) - - (gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map) - " " gnus-summary-next-page - "n" gnus-summary-next-page - "\177" gnus-summary-prev-page - [delete] gnus-summary-prev-page - "p" gnus-summary-prev-page - "\r" gnus-summary-scroll-up - "<" gnus-summary-beginning-of-article - ">" gnus-summary-end-of-article - "b" gnus-summary-beginning-of-article - "e" gnus-summary-end-of-article - "^" gnus-summary-refer-parent-article - "r" gnus-summary-refer-parent-article - "R" gnus-summary-refer-references - "g" gnus-summary-show-article - "s" gnus-summary-isearch-article - "P" gnus-summary-print-article) - - (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map) - "b" gnus-article-add-buttons - "B" gnus-article-add-buttons-to-head - "o" gnus-article-treat-overstrike - "e" gnus-article-emphasize - "w" gnus-article-fill-cited-article - "c" gnus-article-remove-cr - "q" gnus-article-de-quoted-unreadable - "f" gnus-article-display-x-face - "l" gnus-summary-stop-page-breaking - "r" gnus-summary-caesar-message - "t" gnus-article-hide-headers - "v" gnus-summary-verbose-headers - "m" gnus-summary-toggle-mime - "h" gnus-article-treat-html) - - (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map) - "a" gnus-article-hide - "h" gnus-article-hide-headers - "b" gnus-article-hide-boring-headers - "s" gnus-article-hide-signature - "c" gnus-article-hide-citation - "p" gnus-article-hide-pgp - "P" gnus-article-hide-pem - "\C-c" gnus-article-hide-citation-maybe) - - (gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map) - "a" gnus-article-highlight - "h" gnus-article-highlight-headers - "c" gnus-article-highlight-citation - "s" gnus-article-highlight-signature) - - (gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map) - "z" gnus-article-date-ut - "u" gnus-article-date-ut - "l" gnus-article-date-local - "e" gnus-article-date-lapsed - "o" gnus-article-date-original - "s" gnus-article-date-user) - - (gnus-define-keys (gnus-summary-wash-empty-map "E" gnus-summary-wash-map) - "t" gnus-article-remove-trailing-blank-lines - "l" gnus-article-strip-leading-blank-lines - "m" gnus-article-strip-multiple-blank-lines - "a" gnus-article-strip-blank-lines - "s" gnus-article-strip-leading-space) - - (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) - - (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map) - "e" gnus-summary-expire-articles - "\M-\C-e" gnus-summary-expire-articles-now - "\177" gnus-summary-delete-article - [delete] gnus-summary-delete-article - "m" gnus-summary-move-article - "r" gnus-summary-respool-article - "w" gnus-summary-edit-article - "c" gnus-summary-copy-article - "B" gnus-summary-crosspost-article - "q" gnus-summary-respool-query - "i" gnus-summary-import-article - "p" gnus-summary-article-posted-p) - - (gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map) - "o" gnus-summary-save-article - "m" gnus-summary-save-article-mail - "F" gnus-summary-write-article-file - "r" gnus-summary-save-article-rmail - "f" gnus-summary-save-article-file - "b" gnus-summary-save-article-body-file - "h" gnus-summary-save-article-folder - "v" gnus-summary-save-article-vm - "p" gnus-summary-pipe-output - "s" gnus-soup-add-article)) - -(defun gnus-summary-make-menu-bar () - (gnus-turn-off-edit-menu 'summary) - - (unless (boundp 'gnus-summary-misc-menu) - - (easy-menu-define - gnus-summary-kill-menu gnus-summary-mode-map "" - (cons - "Score" - (nconc - (list - ["Enter score..." gnus-summary-score-entry t] - ["Customize" gnus-score-customize t]) - (gnus-make-score-map 'increase) - (gnus-make-score-map 'lower) - '(("Mark" - ["Kill below" gnus-summary-kill-below t] - ["Mark above" gnus-summary-mark-above t] - ["Tick above" gnus-summary-tick-above t] - ["Clear above" gnus-summary-clear-above t]) - ["Current score" gnus-summary-current-score t] - ["Set score" gnus-summary-set-score t] - ["Switch current score file..." gnus-score-change-score-file t] - ["Set mark below..." gnus-score-set-mark-below t] - ["Set expunge below..." gnus-score-set-expunge-below t] - ["Edit current score file" gnus-score-edit-current-scores t] - ["Edit score file" gnus-score-edit-file t] - ["Trace score" gnus-score-find-trace t] - ["Find words" gnus-score-find-favourite-words t] - ["Rescore buffer" gnus-summary-rescore t] - ["Increase score..." gnus-summary-increase-score t] - ["Lower score..." gnus-summary-lower-score t])))) - - '(("Default header" - ["Ask" (gnus-score-set-default 'gnus-score-default-header nil) - :style radio - :selected (null gnus-score-default-header)] - ["From" (gnus-score-set-default 'gnus-score-default-header 'a) - :style radio - :selected (eq gnus-score-default-header 'a)] - ["Subject" (gnus-score-set-default 'gnus-score-default-header 's) - :style radio - :selected (eq gnus-score-default-header 's)] - ["Article body" - (gnus-score-set-default 'gnus-score-default-header 'b) - :style radio - :selected (eq gnus-score-default-header 'b )] - ["All headers" - (gnus-score-set-default 'gnus-score-default-header 'h) - :style radio - :selected (eq gnus-score-default-header 'h )] - ["Message-ID" (gnus-score-set-default 'gnus-score-default-header 'i) - :style radio - :selected (eq gnus-score-default-header 'i )] - ["Thread" (gnus-score-set-default 'gnus-score-default-header 't) - :style radio - :selected (eq gnus-score-default-header 't )] - ["Crossposting" - (gnus-score-set-default 'gnus-score-default-header 'x) - :style radio - :selected (eq gnus-score-default-header 'x )] - ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l) - :style radio - :selected (eq gnus-score-default-header 'l )] - ["Date" (gnus-score-set-default 'gnus-score-default-header 'd) - :style radio - :selected (eq gnus-score-default-header 'd )] - ["Followups to author" - (gnus-score-set-default 'gnus-score-default-header 'f) - :style radio - :selected (eq gnus-score-default-header 'f )]) - ("Default type" - ["Ask" (gnus-score-set-default 'gnus-score-default-type nil) - :style radio - :selected (null gnus-score-default-type)] - ;; The `:active' key is commented out in the following, - ;; because the GNU Emacs hack to support radio buttons use - ;; active to indicate which button is selected. - ["Substring" (gnus-score-set-default 'gnus-score-default-type 's) - :style radio - ;; :active (not (memq gnus-score-default-header '(l d))) - :selected (eq gnus-score-default-type 's)] - ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r) - :style radio - ;; :active (not (memq gnus-score-default-header '(l d))) - :selected (eq gnus-score-default-type 'r)] - ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e) - :style radio - ;; :active (not (memq gnus-score-default-header '(l d))) - :selected (eq gnus-score-default-type 'e)] - ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f) - :style radio - ;; :active (not (memq gnus-score-default-header '(l d))) - :selected (eq gnus-score-default-type 'f)] - ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b) - :style radio - ;; :active (eq (gnus-score-default-header 'd)) - :selected (eq gnus-score-default-type 'b)] - ["At date" (gnus-score-set-default 'gnus-score-default-type 'n) - :style radio - ;; :active (eq (gnus-score-default-header 'd)) - :selected (eq gnus-score-default-type 'n)] - ["After date" (gnus-score-set-default 'gnus-score-default-type 'a) - :style radio - ;; :active (eq (gnus-score-default-header 'd)) - :selected (eq gnus-score-default-type 'a)] - ["Less than number" - (gnus-score-set-default 'gnus-score-default-type '<) - :style radio - ;; :active (eq (gnus-score-default-header 'l)) - :selected (eq gnus-score-default-type '<)] - ["Equal to number" - (gnus-score-set-default 'gnus-score-default-type '=) - :style radio - ;; :active (eq (gnus-score-default-header 'l)) - :selected (eq gnus-score-default-type '=)] - ["Greater than number" - (gnus-score-set-default 'gnus-score-default-type '>) - :style radio - ;; :active (eq (gnus-score-default-header 'l)) - :selected (eq gnus-score-default-type '>)]) - ["Default fold" gnus-score-default-fold-toggle - :style toggle - :selected gnus-score-default-fold] - ("Default duration" - ["Ask" (gnus-score-set-default 'gnus-score-default-duration nil) - :style radio - :selected (null gnus-score-default-duration)] - ["Permanent" - (gnus-score-set-default 'gnus-score-default-duration 'p) - :style radio - :selected (eq gnus-score-default-duration 'p)] - ["Temporary" - (gnus-score-set-default 'gnus-score-default-duration 't) - :style radio - :selected (eq gnus-score-default-duration 't)] - ["Immediate" - (gnus-score-set-default 'gnus-score-default-duration 'i) - :style radio - :selected (eq gnus-score-default-duration 'i)])) - - (easy-menu-define - gnus-summary-article-menu gnus-summary-mode-map "" - '("Article" - ("Hide" - ["All" gnus-article-hide t] - ["Headers" gnus-article-hide-headers t] - ["Signature" gnus-article-hide-signature t] - ["Citation" gnus-article-hide-citation t] - ["PGP" gnus-article-hide-pgp t] - ["Boring headers" gnus-article-hide-boring-headers t]) - ("Highlight" - ["All" gnus-article-highlight t] - ["Headers" gnus-article-highlight-headers t] - ["Signature" gnus-article-highlight-signature t] - ["Citation" gnus-article-highlight-citation t]) - ("Date" - ["Local" gnus-article-date-local t] - ["UT" gnus-article-date-ut t] - ["Original" gnus-article-date-original t] - ["Lapsed" gnus-article-date-lapsed t] - ["User-defined" gnus-article-date-user t]) - ("Washing" - ("Remove Blanks" - ["Leading" gnus-article-strip-leading-blank-lines t] - ["Multiple" gnus-article-strip-multiple-blank-lines t] - ["Trailing" gnus-article-remove-trailing-blank-lines t] - ["All of the above" gnus-article-strip-blank-lines t] - ["Leading space" gnus-article-strip-leading-space t]) - ["Overstrike" gnus-article-treat-overstrike t] - ["Emphasis" gnus-article-emphasize t] - ["Word wrap" gnus-article-fill-cited-article t] - ["CR" gnus-article-remove-cr t] - ["Show X-Face" gnus-article-display-x-face t] - ["Quoted-Printable" gnus-article-de-quoted-unreadable t] - ["UnHTMLize" gnus-article-treat-html t] - ["Rot 13" gnus-summary-caesar-message t] - ["Unix pipe" gnus-summary-pipe-message t] - ["Add buttons" gnus-article-add-buttons t] - ["Add buttons to head" gnus-article-add-buttons-to-head t] - ["Stop page breaking" gnus-summary-stop-page-breaking t] - ["Toggle MIME" gnus-summary-toggle-mime t] - ["Verbose header" gnus-summary-verbose-headers t] - ["Toggle header" gnus-summary-toggle-header t]) - ("Output" - ["Save in default format" gnus-summary-save-article t] - ["Save in file" gnus-summary-save-article-file t] - ["Save in Unix mail format" gnus-summary-save-article-mail t] - ["Write to file" gnus-summary-write-article-mail t] - ["Save in MH folder" gnus-summary-save-article-folder t] - ["Save in VM folder" gnus-summary-save-article-vm t] - ["Save in RMAIL mbox" gnus-summary-save-article-rmail t] - ["Save body in file" gnus-summary-save-article-body-file t] - ["Pipe through a filter" gnus-summary-pipe-output t] - ["Add to SOUP packet" gnus-soup-add-article t] - ["Print" gnus-summary-print-article t]) - ("Backend" - ["Respool article..." gnus-summary-respool-article t] - ["Move article..." gnus-summary-move-article - (gnus-check-backend-function - 'request-move-article gnus-newsgroup-name)] - ["Copy article..." gnus-summary-copy-article t] - ["Crosspost article..." gnus-summary-crosspost-article - (gnus-check-backend-function - 'request-replace-article gnus-newsgroup-name)] - ["Import file..." gnus-summary-import-article t] - ["Check if posted" gnus-summary-article-posted-p t] - ["Edit article" gnus-summary-edit-article - (not (gnus-group-read-only-p))] - ["Delete article" gnus-summary-delete-article - (gnus-check-backend-function - 'request-expire-articles gnus-newsgroup-name)] - ["Query respool" gnus-summary-respool-query t] - ["Delete expirable articles" gnus-summary-expire-articles-now - (gnus-check-backend-function - 'request-expire-articles gnus-newsgroup-name)]) - ("Extract" - ["Uudecode" gnus-uu-decode-uu t] - ["Uudecode and save" gnus-uu-decode-uu-and-save t] - ["Unshar" gnus-uu-decode-unshar t] - ["Unshar and save" gnus-uu-decode-unshar-and-save t] - ["Save" gnus-uu-decode-save t] - ["Binhex" gnus-uu-decode-binhex t] - ["Postscript" gnus-uu-decode-postscript t]) - ("Cache" - ["Enter article" gnus-cache-enter-article t] - ["Remove article" gnus-cache-remove-article t]) - ["Enter digest buffer" gnus-summary-enter-digest-group t] - ["Isearch article..." gnus-summary-isearch-article t] - ["Beginning of the article" gnus-summary-beginning-of-article t] - ["End of the article" gnus-summary-end-of-article t] - ["Fetch parent of article" gnus-summary-refer-parent-article t] - ["Fetch referenced articles" gnus-summary-refer-references t] - ["Fetch article with id..." gnus-summary-refer-article t] - ["Redisplay" gnus-summary-show-article t])) - - (easy-menu-define - gnus-summary-thread-menu gnus-summary-mode-map "" - '("Threads" - ["Toggle threading" gnus-summary-toggle-threads t] - ["Hide threads" gnus-summary-hide-all-threads t] - ["Show threads" gnus-summary-show-all-threads t] - ["Hide thread" gnus-summary-hide-thread t] - ["Show thread" gnus-summary-show-thread t] - ["Go to next thread" gnus-summary-next-thread t] - ["Go to previous thread" gnus-summary-prev-thread t] - ["Go down thread" gnus-summary-down-thread t] - ["Go up thread" gnus-summary-up-thread t] - ["Top of thread" gnus-summary-top-thread t] - ["Mark thread as read" gnus-summary-kill-thread t] - ["Lower thread score" gnus-summary-lower-thread t] - ["Raise thread score" gnus-summary-raise-thread t] - ["Rethread current" gnus-summary-rethread-current t] - )) - - (easy-menu-define - gnus-summary-post-menu gnus-summary-mode-map "" - '("Post" - ["Post an article" gnus-summary-post-news t] - ["Followup" gnus-summary-followup t] - ["Followup and yank" gnus-summary-followup-with-original t] - ["Supersede article" gnus-summary-supersede-article t] - ["Cancel article" gnus-summary-cancel-article t] - ["Reply" gnus-summary-reply t] - ["Reply and yank" gnus-summary-reply-with-original t] - ["Wide reply" gnus-summary-wide-reply t] - ["Wide reply and yank" gnus-summary-wide-reply-with-original t] - ["Mail forward" gnus-summary-mail-forward t] - ["Post forward" gnus-summary-post-forward t] - ["Digest and mail" gnus-uu-digest-mail-forward t] - ["Digest and post" gnus-uu-digest-post-forward t] - ["Resend message" gnus-summary-resend-message t] - ["Send bounced mail" gnus-summary-resend-bounced-mail t] - ["Send a mail" gnus-summary-mail-other-window t] - ["Uuencode and post" gnus-uu-post-news t] - ["Followup via news" gnus-summary-followup-to-mail t] - ["Followup via news and yank" - gnus-summary-followup-to-mail-with-original t] - ;;("Draft" - ;;["Send" gnus-summary-send-draft t] - ;;["Send bounced" gnus-resend-bounced-mail t]) - )) - - (easy-menu-define - gnus-summary-misc-menu gnus-summary-mode-map "" - '("Misc" - ("Mark Read" - ["Mark as read" gnus-summary-mark-as-read-forward t] - ["Mark same subject and select" - gnus-summary-kill-same-subject-and-select t] - ["Mark same subject" gnus-summary-kill-same-subject t] - ["Catchup" gnus-summary-catchup t] - ["Catchup all" gnus-summary-catchup-all t] - ["Catchup to here" gnus-summary-catchup-to-here t] - ["Catchup region" gnus-summary-mark-region-as-read t] - ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t]) - ("Mark Various" - ["Tick" gnus-summary-tick-article-forward t] - ["Mark as dormant" gnus-summary-mark-as-dormant t] - ["Remove marks" gnus-summary-clear-mark-forward t] - ["Set expirable mark" gnus-summary-mark-as-expirable t] - ["Set bookmark" gnus-summary-set-bookmark t] - ["Remove bookmark" gnus-summary-remove-bookmark t]) - ("Mark Limit" - ["Marks..." gnus-summary-limit-to-marks t] - ["Subject..." gnus-summary-limit-to-subject t] - ["Author..." gnus-summary-limit-to-author t] - ["Age..." gnus-summary-limit-to-age t] - ["Score" gnus-summary-limit-to-score t] - ["Unread" gnus-summary-limit-to-unread t] - ["Non-dormant" gnus-summary-limit-exclude-dormant t] - ["Articles" gnus-summary-limit-to-articles t] - ["Pop limit" gnus-summary-pop-limit t] - ["Show dormant" gnus-summary-limit-include-dormant t] - ["Hide childless dormant" - gnus-summary-limit-exclude-childless-dormant t] - ;;["Hide thread" gnus-summary-limit-exclude-thread t] - ["Show expunged" gnus-summary-show-all-expunged t]) - ("Process Mark" - ["Set mark" gnus-summary-mark-as-processable t] - ["Remove mark" gnus-summary-unmark-as-processable t] - ["Remove all marks" gnus-summary-unmark-all-processable t] - ["Mark above" gnus-uu-mark-over t] - ["Mark series" gnus-uu-mark-series t] - ["Mark region" gnus-uu-mark-region t] - ["Mark by regexp..." gnus-uu-mark-by-regexp t] - ["Mark all" gnus-uu-mark-all t] - ["Mark buffer" gnus-uu-mark-buffer t] - ["Mark sparse" gnus-uu-mark-sparse t] - ["Mark thread" gnus-uu-mark-thread t] - ["Unmark thread" gnus-uu-unmark-thread t] - ("Process Mark Sets" - ["Kill" gnus-summary-kill-process-mark t] - ["Yank" gnus-summary-yank-process-mark - gnus-newsgroup-process-stack] - ["Save" gnus-summary-save-process-mark t])) - ("Scroll article" - ["Page forward" gnus-summary-next-page t] - ["Page backward" gnus-summary-prev-page t] - ["Line forward" gnus-summary-scroll-up t]) - ("Move" - ["Next unread article" gnus-summary-next-unread-article t] - ["Previous unread article" gnus-summary-prev-unread-article t] - ["Next article" gnus-summary-next-article t] - ["Previous article" gnus-summary-prev-article t] - ["Next unread subject" gnus-summary-next-unread-subject t] - ["Previous unread subject" gnus-summary-prev-unread-subject t] - ["Next article same subject" gnus-summary-next-same-subject t] - ["Previous article same subject" gnus-summary-prev-same-subject t] - ["First unread article" gnus-summary-first-unread-article t] - ["Best unread article" gnus-summary-best-unread-article t] - ["Go to subject number..." gnus-summary-goto-subject t] - ["Go to article number..." gnus-summary-goto-article t] - ["Go to the last article" gnus-summary-goto-last-article t] - ["Pop article off history" gnus-summary-pop-article t]) - ("Sort" - ["Sort by number" gnus-summary-sort-by-number t] - ["Sort by author" gnus-summary-sort-by-author t] - ["Sort by subject" gnus-summary-sort-by-subject t] - ["Sort by date" gnus-summary-sort-by-date t] - ["Sort by score" gnus-summary-sort-by-score t] - ["Sort by lines" gnus-summary-sort-by-lines t]) - ("Help" - ["Fetch group FAQ" gnus-summary-fetch-faq t] - ["Describe group" gnus-summary-describe-group t] - ["Read manual" gnus-info-find-node t]) - ("Modes" - ["Pick and read" gnus-pick-mode t] - ["Binary" gnus-binary-mode t]) - ("Regeneration" - ["Regenerate" gnus-summary-prepare t] - ["Insert cached articles" gnus-summary-insert-cached-articles t] - ["Toggle threading" gnus-summary-toggle-threads t]) - ["Filter articles..." gnus-summary-execute-command t] - ["Run command on subjects..." gnus-summary-universal-argument t] - ["Search articles forward..." gnus-summary-search-article-forward t] - ["Search articles backward..." gnus-summary-search-article-backward t] - ["Toggle line truncation" gnus-summary-toggle-truncation t] - ["Expand window" gnus-summary-expand-window t] - ["Expire expirable articles" gnus-summary-expire-articles - (gnus-check-backend-function - 'request-expire-articles gnus-newsgroup-name)] - ["Edit local kill file" gnus-summary-edit-local-kill t] - ["Edit main kill file" gnus-summary-edit-global-kill t] - ("Exit" - ["Catchup and exit" gnus-summary-catchup-and-exit t] - ["Catchup all and exit" gnus-summary-catchup-and-exit t] - ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] - ["Exit group" gnus-summary-exit t] - ["Exit group without updating" gnus-summary-exit-no-update t] - ["Exit and goto next group" gnus-summary-next-group t] - ["Exit and goto prev group" gnus-summary-prev-group t] - ["Reselect group" gnus-summary-reselect-current-group t] - ["Rescan group" gnus-summary-rescan-group t] - ["Update dribble" gnus-summary-save-newsrc t]))) - - (run-hooks 'gnus-summary-menu-hook))) - -(defun gnus-score-set-default (var value) - "A version of set that updates the GNU Emacs menu-bar." - (set var value) - ;; It is the message that forces the active status to be updated. - (message "")) - -(defun gnus-make-score-map (type) - "Make a summary score map of type TYPE." - (if t - nil - (let ((headers '(("author" "from" string) - ("subject" "subject" string) - ("article body" "body" string) - ("article head" "head" string) - ("xref" "xref" string) - ("lines" "lines" number) - ("followups to author" "followup" string))) - (types '((number ("less than" <) - ("greater than" >) - ("equal" =)) - (string ("substring" s) - ("exact string" e) - ("fuzzy string" f) - ("regexp" r)))) - (perms '(("temporary" (current-time-string)) - ("permanent" nil) - ("immediate" now))) - header) - (list - (apply - 'nconc - (list - (if (eq type 'lower) - "Lower score" - "Increase score")) - (let (outh) - (while headers - (setq header (car headers)) - (setq outh - (cons - (apply - 'nconc - (list (car header)) - (let ((ts (cdr (assoc (nth 2 header) types))) - outt) - (while ts - (setq outt - (cons - (apply - 'nconc - (list (caar ts)) - (let ((ps perms) - outp) - (while ps - (setq outp - (cons - (vector - (caar ps) - (list - 'gnus-summary-score-entry - (nth 1 header) - (if (or (string= (nth 1 header) - "head") - (string= (nth 1 header) - "body")) - "" - (list 'gnus-summary-header - (nth 1 header))) - (list 'quote (nth 1 (car ts))) - (list 'gnus-score-default nil) - (nth 1 (car ps)) - t) - t) - outp)) - (setq ps (cdr ps))) - (list (nreverse outp)))) - outt)) - (setq ts (cdr ts))) - (list (nreverse outt)))) - outh)) - (setq headers (cdr headers))) - (list (nreverse outh)))))))) - - - -(defun gnus-summary-mode (&optional group) - "Major mode for reading articles. - -All normal editing commands are switched off. -\\ -Each line in this buffer represents one article. To read an -article, you can, for instance, type `\\[gnus-summary-next-page]'. To move forwards -and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]', -respectively. - -You can also post articles and send mail from this buffer. To -follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author -of an article, type `\\[gnus-summary-reply]'. - -There are approx. one gazillion commands you can execute in this -buffer; read the info pages for more information (`\\[gnus-info-find-node]'). - -The following commands are available: - -\\{gnus-summary-mode-map}" - (interactive) - (when (gnus-visual-p 'summary-menu 'menu) - (gnus-summary-make-menu-bar)) - (kill-all-local-variables) - (gnus-summary-make-local-variables) - (gnus-make-thread-indent-array) - (gnus-simplify-mode-line) - (setq major-mode 'gnus-summary-mode) - (setq mode-name "Summary") - (make-local-variable 'minor-mode-alist) - (use-local-map gnus-summary-mode-map) - (buffer-disable-undo (current-buffer)) - (setq buffer-read-only t) ;Disable modification - (setq truncate-lines t) - (setq selective-display t) - (setq selective-display-ellipses t) ;Display `...' - (gnus-summary-set-display-table) - (gnus-set-default-directory) - (setq gnus-newsgroup-name group) - (make-local-variable 'gnus-summary-line-format) - (make-local-variable 'gnus-summary-line-format-spec) - (make-local-variable 'gnus-summary-mark-positions) - (make-local-hook 'post-command-hook) - (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) - (run-hooks 'gnus-summary-mode-hook) - (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy) - (gnus-update-summary-mark-positions)) - -(defun gnus-summary-make-local-variables () - "Make all the local summary buffer variables." - (let ((locals gnus-summary-local-variables) - global local) - (while (setq local (pop locals)) - (if (consp local) - (progn - (if (eq (cdr local) 'global) - ;; Copy the global value of the variable. - (setq global (symbol-value (car local))) - ;; Use the value from the list. - (setq global (eval (cdr local)))) - (make-local-variable (car local)) - (set (car local) global)) - ;; Simple nil-valued local variable. - (make-local-variable local) - (set local nil))))) - -(defun gnus-summary-clear-local-variables () - (let ((locals gnus-summary-local-variables)) - (while locals - (if (consp (car locals)) - (and (vectorp (caar locals)) - (set (caar locals) nil)) - (and (vectorp (car locals)) - (set (car locals) nil))) - (setq locals (cdr locals))))) - -;; Summary data functions. - -(defmacro gnus-data-number (data) - `(car ,data)) - -(defmacro gnus-data-set-number (data number) - `(setcar ,data ,number)) - -(defmacro gnus-data-mark (data) - `(nth 1 ,data)) - -(defmacro gnus-data-set-mark (data mark) - `(setcar (nthcdr 1 ,data) ,mark)) - -(defmacro gnus-data-pos (data) - `(nth 2 ,data)) - -(defmacro gnus-data-set-pos (data pos) - `(setcar (nthcdr 2 ,data) ,pos)) - -(defmacro gnus-data-header (data) - `(nth 3 ,data)) - -(defmacro gnus-data-set-header (data header) - `(setf (nth 3 ,data) ,header)) - -(defmacro gnus-data-level (data) - `(nth 4 ,data)) - -(defmacro gnus-data-unread-p (data) - `(= (nth 1 ,data) gnus-unread-mark)) - -(defmacro gnus-data-read-p (data) - `(/= (nth 1 ,data) gnus-unread-mark)) - -(defmacro gnus-data-pseudo-p (data) - `(consp (nth 3 ,data))) - -(defmacro gnus-data-find (number) - `(assq ,number gnus-newsgroup-data)) - -(defmacro gnus-data-find-list (number &optional data) - `(let ((bdata ,(or data 'gnus-newsgroup-data))) - (memq (assq ,number bdata) - bdata))) - -(defmacro gnus-data-make (number mark pos header level) - `(list ,number ,mark ,pos ,header ,level)) - -(defun gnus-data-enter (after-article number mark pos header level offset) - (let ((data (gnus-data-find-list after-article))) - (unless data - (error "No such article: %d" after-article)) - (setcdr data (cons (gnus-data-make number mark pos header level) - (cdr data))) - (setq gnus-newsgroup-data-reverse nil) - (gnus-data-update-list (cddr data) offset))) - -(defun gnus-data-enter-list (after-article list &optional offset) - (when list - (let ((data (and after-article (gnus-data-find-list after-article))) - (ilist list)) - (or data (not after-article) (error "No such article: %d" after-article)) - ;; Find the last element in the list to be spliced into the main - ;; list. - (while (cdr list) - (setq list (cdr list))) - (if (not data) - (progn - (setcdr list gnus-newsgroup-data) - (setq gnus-newsgroup-data ilist) - (when offset - (gnus-data-update-list (cdr list) offset))) - (setcdr list (cdr data)) - (setcdr data ilist) - (when offset - (gnus-data-update-list (cdr list) offset))) - (setq gnus-newsgroup-data-reverse nil)))) - -(defun gnus-data-remove (article &optional offset) - (let ((data gnus-newsgroup-data)) - (if (= (gnus-data-number (car data)) article) - (progn - (setq gnus-newsgroup-data (cdr gnus-newsgroup-data) - gnus-newsgroup-data-reverse nil) - (when offset - (gnus-data-update-list gnus-newsgroup-data offset))) - (while (cdr data) - (when (= (gnus-data-number (cadr data)) article) - (setcdr data (cddr data)) - (when offset - (gnus-data-update-list (cdr data) offset)) - (setq data nil - gnus-newsgroup-data-reverse nil)) - (setq data (cdr data)))))) - -(defmacro gnus-data-list (backward) - `(if ,backward - (or gnus-newsgroup-data-reverse - (setq gnus-newsgroup-data-reverse - (reverse gnus-newsgroup-data))) - gnus-newsgroup-data)) - -(defun gnus-data-update-list (data offset) - "Add OFFSET to the POS of all data entries in DATA." - (while data - (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data)))) - (setq data (cdr data)))) - -(defun gnus-data-compute-positions () - "Compute the positions of all articles." - (let ((data gnus-newsgroup-data) - pos) - (while data - (when (setq pos (text-property-any - (point-min) (point-max) - 'gnus-number (gnus-data-number (car data)))) - (gnus-data-set-pos (car data) (+ pos 3))) - (setq data (cdr data))))) - -(defun gnus-summary-article-pseudo-p (article) - "Say whether this article is a pseudo article or not." - (not (vectorp (gnus-data-header (gnus-data-find article))))) - -(defmacro gnus-summary-article-sparse-p (article) - "Say whether this article is a sparse article or not." - `(memq ,article gnus-newsgroup-sparse)) - -(defmacro gnus-summary-article-ancient-p (article) - "Say whether this article is a sparse article or not." - `(memq ,article gnus-newsgroup-ancient)) - -(defun gnus-article-parent-p (number) - "Say whether this article is a parent or not." - (let ((data (gnus-data-find-list number))) - (and (cdr data) ; There has to be an article after... - (< (gnus-data-level (car data)) ; And it has to have a higher level. - (gnus-data-level (nth 1 data)))))) - -(defun gnus-article-children (number) - "Return a list of all children to NUMBER." - (let* ((data (gnus-data-find-list number)) - (level (gnus-data-level (car data))) - children) - (setq data (cdr data)) - (while (and data - (= (gnus-data-level (car data)) (1+ level))) - (push (gnus-data-number (car data)) children) - (setq data (cdr data))) - children)) - -(defmacro gnus-summary-skip-intangible () - "If the current article is intangible, then jump to a different article." - '(let ((to (get-text-property (point) 'gnus-intangible))) - (and to (gnus-summary-goto-subject to)))) - -(defmacro gnus-summary-article-intangible-p () - "Say whether this article is intangible or not." - '(get-text-property (point) 'gnus-intangible)) - -(defun gnus-article-read-p (article) - "Say whether ARTICLE is read or not." - (not (or (memq article gnus-newsgroup-marked) - (memq article gnus-newsgroup-unreads) - (memq article gnus-newsgroup-unselected) - (memq article gnus-newsgroup-dormant)))) - -;; Some summary mode macros. - -(defmacro gnus-summary-article-number () - "The article number of the article on the current line. -If there isn's an article number here, then we return the current -article number." - '(progn - (gnus-summary-skip-intangible) - (or (get-text-property (point) 'gnus-number) - (gnus-summary-last-subject)))) - -(defmacro gnus-summary-article-header (&optional number) - `(gnus-data-header (gnus-data-find - ,(or number '(gnus-summary-article-number))))) - -(defmacro gnus-summary-thread-level (&optional number) - `(if (and (eq gnus-summary-make-false-root 'dummy) - (get-text-property (point) 'gnus-intangible)) - 0 - (gnus-data-level (gnus-data-find - ,(or number '(gnus-summary-article-number)))))) - -(defmacro gnus-summary-article-mark (&optional number) - `(gnus-data-mark (gnus-data-find - ,(or number '(gnus-summary-article-number))))) - -(defmacro gnus-summary-article-pos (&optional number) - `(gnus-data-pos (gnus-data-find - ,(or number '(gnus-summary-article-number))))) - -(defalias 'gnus-summary-subject-string 'gnus-summary-article-subject) -(defmacro gnus-summary-article-subject (&optional number) - "Return current subject string or nil if nothing." - `(let ((headers - ,(if number - `(gnus-data-header (assq ,number gnus-newsgroup-data)) - '(gnus-data-header (assq (gnus-summary-article-number) - gnus-newsgroup-data))))) - (and headers - (vectorp headers) - (mail-header-subject headers)))) - -(defmacro gnus-summary-article-score (&optional number) - "Return current article score." - `(or (cdr (assq ,(or number '(gnus-summary-article-number)) - gnus-newsgroup-scored)) - gnus-summary-default-score 0)) - -(defun gnus-summary-article-children (&optional number) - (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number)))) - (level (gnus-data-level (car data))) - l children) - (while (and (setq data (cdr data)) - (> (setq l (gnus-data-level (car data))) level)) - (and (= (1+ level) l) - (push (gnus-data-number (car data)) - children))) - (nreverse children))) - -(defun gnus-summary-article-parent (&optional number) - (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number)) - (gnus-data-list t))) - (level (gnus-data-level (car data)))) - (if (zerop level) - () ; This is a root. - ;; We search until we find an article with a level less than - ;; this one. That function has to be the parent. - (while (and (setq data (cdr data)) - (not (< (gnus-data-level (car data)) level)))) - (and data (gnus-data-number (car data)))))) - -(defun gnus-unread-mark-p (mark) - "Say whether MARK is the unread mark." - (= mark gnus-unread-mark)) - -(defun gnus-read-mark-p (mark) - "Say whether MARK is one of the marks that mark as read. -This is all marks except unread, ticked, dormant, and expirable." - (not (or (= mark gnus-unread-mark) - (= mark gnus-ticked-mark) - (= mark gnus-dormant-mark) - (= mark gnus-expirable-mark)))) - -(defmacro gnus-article-mark (number) - `(cond - ((memq ,number gnus-newsgroup-unreads) gnus-unread-mark) - ((memq ,number gnus-newsgroup-marked) gnus-ticked-mark) - ((memq ,number gnus-newsgroup-dormant) gnus-dormant-mark) - ((memq ,number gnus-newsgroup-expirable) gnus-expirable-mark) - (t (or (cdr (assq ,number gnus-newsgroup-reads)) - gnus-ancient-mark)))) - -;; Saving hidden threads. - -(put 'gnus-save-hidden-threads 'lisp-indent-function 0) -(put 'gnus-save-hidden-threads 'edebug-form-spec '(body)) - -(defmacro gnus-save-hidden-threads (&rest forms) - "Save hidden threads, eval FORMS, and restore the hidden threads." - (let ((config (make-symbol "config"))) - `(let ((,config (gnus-hidden-threads-configuration))) - (unwind-protect - (save-excursion - ,@forms) - (gnus-restore-hidden-threads-configuration ,config))))) - -(defun gnus-hidden-threads-configuration () - "Return the current hidden threads configuration." - (save-excursion - (let (config) - (goto-char (point-min)) - (while (search-forward "\r" nil t) - (push (1- (point)) config)) - config))) - -(defun gnus-restore-hidden-threads-configuration (config) - "Restore hidden threads configuration from CONFIG." - (let (point buffer-read-only) - (while (setq point (pop config)) - (when (and (< point (point-max)) - (goto-char point) - (= (following-char) ?\n)) - (subst-char-in-region point (1+ point) ?\n ?\r))))) - -;; Various summary mode internalish functions. - -(defun gnus-mouse-pick-article (e) - (interactive "e") - (mouse-set-point e) - (gnus-summary-next-page nil t)) - -(defun gnus-summary-set-display-table () - ;; Change the display table. Odd characters have a tendency to mess - ;; up nicely formatted displays - we make all possible glyphs - ;; display only a single character. - - ;; We start from the standard display table, if any. - (let ((table (or (copy-sequence standard-display-table) - (make-display-table))) - (i 32)) - ;; Nix out all the control chars... - (while (>= (setq i (1- i)) 0) - (aset table i [??])) - ;; ... but not newline and cr, of course. (cr is necessary for the - ;; selective display). - (aset table ?\n nil) - (aset table ?\r nil) - ;; We nix out any glyphs over 126 that are not set already. - (let ((i 256)) - (while (>= (setq i (1- i)) 127) - ;; Only modify if the entry is nil. - (unless (aref table i) - (aset table i [??])))) - (setq buffer-display-table table))) - -(defun gnus-summary-setup-buffer (group) - "Initialize summary buffer." - (let ((buffer (concat "*Summary " group "*"))) - (if (get-buffer buffer) - (progn - (set-buffer buffer) - (setq gnus-summary-buffer (current-buffer)) - (not gnus-newsgroup-prepared)) - ;; Fix by Sudish Joseph - (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer))) - (gnus-add-current-to-buffer-list) - (gnus-summary-mode group) - (when gnus-carpal - (gnus-carpal-setup-buffer 'summary)) - (unless gnus-single-article-buffer - (make-local-variable 'gnus-article-buffer) - (make-local-variable 'gnus-article-current) - (make-local-variable 'gnus-original-article-buffer)) - (setq gnus-newsgroup-name group) - t))) - -(defun gnus-set-global-variables () - ;; Set the global equivalents of the summary buffer-local variables - ;; to the latest values they had. These reflect the summary buffer - ;; that was in action when the last article was fetched. - (when (eq major-mode 'gnus-summary-mode) - (setq gnus-summary-buffer (current-buffer)) - (let ((name gnus-newsgroup-name) - (marked gnus-newsgroup-marked) - (unread gnus-newsgroup-unreads) - (headers gnus-current-headers) - (data gnus-newsgroup-data) - (summary gnus-summary-buffer) - (article-buffer gnus-article-buffer) - (original gnus-original-article-buffer) - (gac gnus-article-current) - (reffed gnus-reffed-article-number) - (score-file gnus-current-score-file)) - (save-excursion - (set-buffer gnus-group-buffer) - (setq gnus-newsgroup-name name) - (setq gnus-newsgroup-marked marked) - (setq gnus-newsgroup-unreads unread) - (setq gnus-current-headers headers) - (setq gnus-newsgroup-data data) - (setq gnus-article-current gac) - (setq gnus-summary-buffer summary) - (setq gnus-article-buffer article-buffer) - (setq gnus-original-article-buffer original) - (setq gnus-reffed-article-number reffed) - (setq gnus-current-score-file score-file) - ;; The article buffer also has local variables. - (when (gnus-buffer-live-p gnus-article-buffer) - (set-buffer gnus-article-buffer) - (setq gnus-summary-buffer summary)))))) - -(defun gnus-summary-article-unread-p (article) - "Say whether ARTICLE is unread or not." - (memq article gnus-newsgroup-unreads)) - -(defun gnus-summary-first-article-p (&optional article) - "Return whether ARTICLE is the first article in the buffer." - (if (not (setq article (or article (gnus-summary-article-number)))) - nil - (eq article (caar gnus-newsgroup-data)))) - -(defun gnus-summary-last-article-p (&optional article) - "Return whether ARTICLE is the last article in the buffer." - (if (not (setq article (or article (gnus-summary-article-number)))) - t ; All non-existent numbers are the last article. :-) - (not (cdr (gnus-data-find-list article))))) - -(defun gnus-make-thread-indent-array () - (let ((n 200)) - (unless (and gnus-thread-indent-array - (= gnus-thread-indent-level gnus-thread-indent-array-level)) - (setq gnus-thread-indent-array (make-vector 201 "") - gnus-thread-indent-array-level gnus-thread-indent-level) - (while (>= n 0) - (aset gnus-thread-indent-array n - (make-string (* n gnus-thread-indent-level) ? )) - (setq n (1- n)))))) - -(defun gnus-update-summary-mark-positions () - "Compute where the summary marks are to go." - (save-excursion - (when (and gnus-summary-buffer - (get-buffer gnus-summary-buffer) - (buffer-name (get-buffer gnus-summary-buffer))) - (set-buffer gnus-summary-buffer)) - (let ((gnus-replied-mark 129) - (gnus-score-below-mark 130) - (gnus-score-over-mark 130) - (spec gnus-summary-line-format-spec) - thread gnus-visual pos) - (save-excursion - (gnus-set-work-buffer) - (let ((gnus-summary-line-format-spec spec)) - (gnus-summary-insert-line - [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1) - (goto-char (point-min)) - (setq pos (list (cons 'unread (and (search-forward "\200" nil t) - (- (point) 2))))) - (goto-char (point-min)) - (push (cons 'replied (and (search-forward "\201" nil t) - (- (point) 2))) - pos) - (goto-char (point-min)) - (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2))) - pos))) - (setq gnus-summary-mark-positions pos)))) - -(defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number) - "Insert a dummy root in the summary buffer." - (beginning-of-line) - (gnus-add-text-properties - (point) (progn (eval gnus-summary-dummy-line-format-spec) (point)) - (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number))) - -(defun gnus-summary-insert-line (gnus-tmp-header - gnus-tmp-level gnus-tmp-current - gnus-tmp-unread gnus-tmp-replied - gnus-tmp-expirable gnus-tmp-subject-or-nil - &optional gnus-tmp-dummy gnus-tmp-score - gnus-tmp-process) - (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level)) - (gnus-tmp-lines (mail-header-lines gnus-tmp-header)) - (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0)) - (gnus-tmp-score-char - (if (or (null gnus-summary-default-score) - (<= (abs (- gnus-tmp-score gnus-summary-default-score)) - gnus-summary-zcore-fuzz)) - ? - (if (< gnus-tmp-score gnus-summary-default-score) - gnus-score-below-mark gnus-score-over-mark))) - (gnus-tmp-replied - (cond (gnus-tmp-process gnus-process-mark) - ((memq gnus-tmp-current gnus-newsgroup-cached) - gnus-cached-mark) - (gnus-tmp-replied gnus-replied-mark) - ((memq gnus-tmp-current gnus-newsgroup-saved) - gnus-saved-mark) - (t gnus-unread-mark))) - (gnus-tmp-from (mail-header-from gnus-tmp-header)) - (gnus-tmp-name - (cond - ((string-match "<[^>]+> *$" gnus-tmp-from) - (let ((beg (match-beginning 0))) - (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) - (substring gnus-tmp-from (1+ (match-beginning 0)) - (1- (match-end 0)))) - (substring gnus-tmp-from 0 beg)))) - ((string-match "(.+)" gnus-tmp-from) - (substring gnus-tmp-from - (1+ (match-beginning 0)) (1- (match-end 0)))) - (t gnus-tmp-from))) - (gnus-tmp-subject (mail-header-subject gnus-tmp-header)) - (gnus-tmp-number (mail-header-number gnus-tmp-header)) - (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[)) - (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\])) - (buffer-read-only nil)) - (when (string= gnus-tmp-name "") - (setq gnus-tmp-name gnus-tmp-from)) - (unless (numberp gnus-tmp-lines) - (setq gnus-tmp-lines 0)) - (gnus-put-text-property - (point) - (progn (eval gnus-summary-line-format-spec) (point)) - 'gnus-number gnus-tmp-number) - (when (gnus-visual-p 'summary-highlight 'highlight) - (forward-line -1) - (run-hooks 'gnus-summary-update-hook) - (forward-line 1)))) - -(defun gnus-summary-update-line (&optional dont-update) - ;; Update summary line after change. - (when (and gnus-summary-default-score - (not gnus-summary-inhibit-highlight)) - (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion. - (article (gnus-summary-article-number)) - (score (gnus-summary-article-score article))) - (unless dont-update - (if (and gnus-summary-mark-below - (< (gnus-summary-article-score) - gnus-summary-mark-below)) - ;; This article has a low score, so we mark it as read. - (when (memq article gnus-newsgroup-unreads) - (gnus-summary-mark-article-as-read gnus-low-score-mark)) - (when (eq (gnus-summary-article-mark) gnus-low-score-mark) - ;; This article was previously marked as read on account - ;; of a low score, but now it has risen, so we mark it as - ;; unread. - (gnus-summary-mark-article-as-unread gnus-unread-mark))) - (gnus-summary-update-mark - (if (or (null gnus-summary-default-score) - (<= (abs (- score gnus-summary-default-score)) - gnus-summary-zcore-fuzz)) - ? - (if (< score gnus-summary-default-score) - gnus-score-below-mark gnus-score-over-mark)) - 'score)) - ;; Do visual highlighting. - (when (gnus-visual-p 'summary-highlight 'highlight) - (run-hooks 'gnus-summary-update-hook))))) - -(defvar gnus-tmp-new-adopts nil) - -(defun gnus-summary-number-of-articles-in-thread (thread &optional level char) - "Return the number of articles in THREAD. -This may be 0 in some cases -- if none of the articles in -the thread are to be displayed." - (let* ((number - ;; Fix by Luc Van Eycken . - (cond - ((not (listp thread)) - 1) - ((and (consp thread) (cdr thread)) - (apply - '+ 1 (mapcar - 'gnus-summary-number-of-articles-in-thread (cdr thread)))) - ((null thread) - 1) - ((memq (mail-header-number (car thread)) gnus-newsgroup-limit) - 1) - (t 0)))) - (when (and level (zerop level) gnus-tmp-new-adopts) - (incf number - (apply '+ (mapcar - 'gnus-summary-number-of-articles-in-thread - gnus-tmp-new-adopts)))) - (if char - (if (> number 1) gnus-not-empty-thread-mark - gnus-empty-thread-mark) - number))) - -(defun gnus-summary-set-local-parameters (group) - "Go through the local params of GROUP and set all variable specs in that list." - (let ((params (gnus-group-find-parameter group)) - elem) - (while params - (setq elem (car params) - params (cdr params)) - (and (consp elem) ; Has to be a cons. - (consp (cdr elem)) ; The cdr has to be a list. - (symbolp (car elem)) ; Has to be a symbol in there. - (not (memq (car elem) - '(quit-config to-address to-list to-group))) - (ignore-errors ; So we set it. - (make-local-variable (car elem)) - (set (car elem) (eval (nth 1 elem)))))))) - -(defun gnus-summary-read-group (group &optional show-all no-article - kill-buffer no-display) - "Start reading news in newsgroup GROUP. -If SHOW-ALL is non-nil, already read articles are also listed. -If NO-ARTICLE is non-nil, no article is selected initially. -If NO-DISPLAY, don't generate a summary buffer." - (let (result) - (while (and group - (null (setq result - (let ((gnus-auto-select-next nil)) - (gnus-summary-read-group-1 - group show-all no-article - kill-buffer no-display)))) - (eq gnus-auto-select-next 'quietly)) - (set-buffer gnus-group-buffer) - (if (not (equal group (gnus-group-group-name))) - (setq group (gnus-group-group-name)) - (setq group nil))) - result)) - -(defun gnus-summary-read-group-1 (group show-all no-article - kill-buffer no-display) - ;; Killed foreign groups can't be entered. - (when (and (not (gnus-group-native-p group)) - (not (gnus-gethash group gnus-newsrc-hashtb))) - (error "Dead non-native groups can't be entered")) - (gnus-message 5 "Retrieving newsgroup: %s..." group) - (let* ((new-group (gnus-summary-setup-buffer group)) - (quit-config (gnus-group-quit-config group)) - (did-select (and new-group (gnus-select-newsgroup group show-all)))) - (cond - ;; This summary buffer exists already, so we just select it. - ((not new-group) - (gnus-set-global-variables) - (when kill-buffer - (gnus-kill-or-deaden-summary kill-buffer)) - (gnus-configure-windows 'summary 'force) - (gnus-set-mode-line 'summary) - (gnus-summary-position-point) - (message "") - t) - ;; We couldn't select this group. - ((null did-select) - (when (and (eq major-mode 'gnus-summary-mode) - (not (equal (current-buffer) kill-buffer))) - (kill-buffer (current-buffer)) - (if (not quit-config) - (progn - (set-buffer gnus-group-buffer) - (gnus-group-jump-to-group group) - (gnus-group-next-unread-group 1)) - (gnus-handle-ephemeral-exit quit-config))) - (gnus-message 3 "Can't select group") - nil) - ;; The user did a `C-g' while prompting for number of articles, - ;; so we exit this group. - ((eq did-select 'quit) - (and (eq major-mode 'gnus-summary-mode) - (not (equal (current-buffer) kill-buffer)) - (kill-buffer (current-buffer))) - (when kill-buffer - (gnus-kill-or-deaden-summary kill-buffer)) - (if (not quit-config) - (progn - (set-buffer gnus-group-buffer) - (gnus-group-jump-to-group group) - (gnus-group-next-unread-group 1) - (gnus-configure-windows 'group 'force)) - (gnus-handle-ephemeral-exit quit-config)) - ;; Finally signal the quit. - (signal 'quit nil)) - ;; The group was successfully selected. - (t - (gnus-set-global-variables) - ;; Save the active value in effect when the group was entered. - (setq gnus-newsgroup-active - (gnus-copy-sequence - (gnus-active gnus-newsgroup-name))) - ;; You can change the summary buffer in some way with this hook. - (run-hooks 'gnus-select-group-hook) - ;; Set any local variables in the group parameters. - (gnus-summary-set-local-parameters gnus-newsgroup-name) - (gnus-update-format-specifications - nil 'summary 'summary-mode 'summary-dummy) - ;; Do score processing. - (when gnus-use-scoring - (gnus-possibly-score-headers)) - ;; Check whether to fill in the gaps in the threads. - (when gnus-build-sparse-threads - (gnus-build-sparse-threads)) - ;; Find the initial limit. - (if gnus-show-threads - (if show-all - (let ((gnus-newsgroup-dormant nil)) - (gnus-summary-initial-limit show-all)) - (gnus-summary-initial-limit show-all)) - (setq gnus-newsgroup-limit - (mapcar - (lambda (header) (mail-header-number header)) - gnus-newsgroup-headers))) - ;; Generate the summary buffer. - (unless no-display - (gnus-summary-prepare)) - (when gnus-use-trees - (gnus-tree-open group) - (setq gnus-summary-highlight-line-function - 'gnus-tree-highlight-article)) - ;; If the summary buffer is empty, but there are some low-scored - ;; articles or some excluded dormants, we include these in the - ;; buffer. - (when (and (zerop (buffer-size)) - (not no-display)) - (cond (gnus-newsgroup-dormant - (gnus-summary-limit-include-dormant)) - ((and gnus-newsgroup-scored show-all) - (gnus-summary-limit-include-expunged t)))) - ;; Function `gnus-apply-kill-file' must be called in this hook. - (run-hooks 'gnus-apply-kill-hook) - (if (and (zerop (buffer-size)) - (not no-display)) - (progn - ;; This newsgroup is empty. - (gnus-summary-catchup-and-exit nil t) - (gnus-message 6 "No unread news") - (when kill-buffer - (gnus-kill-or-deaden-summary kill-buffer)) - ;; Return nil from this function. - nil) - ;; Hide conversation thread subtrees. We cannot do this in - ;; gnus-summary-prepare-hook since kill processing may not - ;; work with hidden articles. - (and gnus-show-threads - gnus-thread-hide-subtree - (gnus-summary-hide-all-threads)) - ;; Show first unread article if requested. - (if (and (not no-article) - (not no-display) - gnus-newsgroup-unreads - gnus-auto-select-first) - (unless (if (eq gnus-auto-select-first 'best) - (gnus-summary-best-unread-article) - (gnus-summary-first-unread-article)) - (gnus-configure-windows 'summary)) - ;; Don't select any articles, just move point to the first - ;; article in the group. - (goto-char (point-min)) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary) - (gnus-configure-windows 'summary 'force)) - (when kill-buffer - (gnus-kill-or-deaden-summary kill-buffer)) - (when (get-buffer-window gnus-group-buffer t) - ;; Gotta use windows, because recenter does weird stuff if - ;; the current buffer ain't the displayed window. - (let ((owin (selected-window))) - (select-window (get-buffer-window gnus-group-buffer t)) - (when (gnus-group-goto-group group) - (recenter)) - (select-window owin))) - ;; Mark this buffer as "prepared". - (setq gnus-newsgroup-prepared t) - t))))) - -(defun gnus-summary-prepare () - "Generate the summary buffer." - (interactive) - (let ((buffer-read-only nil)) - (erase-buffer) - (setq gnus-newsgroup-data nil - gnus-newsgroup-data-reverse nil) - (run-hooks 'gnus-summary-generate-hook) - ;; Generate the buffer, either with threads or without. - (when gnus-newsgroup-headers - (gnus-summary-prepare-threads - (if gnus-show-threads - (gnus-sort-gathered-threads - (funcall gnus-summary-thread-gathering-function - (gnus-sort-threads - (gnus-cut-threads (gnus-make-threads))))) - ;; Unthreaded display. - (gnus-sort-articles gnus-newsgroup-headers)))) - (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data)) - ;; Call hooks for modifying summary buffer. - (goto-char (point-min)) - (run-hooks 'gnus-summary-prepare-hook))) - -(defsubst gnus-general-simplify-subject (subject) - "Simply subject by the same rules as gnus-gather-threads-by-subject." - (setq subject - (cond - ;; Truncate the subject. - ((numberp gnus-summary-gather-subject-limit) - (setq subject (gnus-simplify-subject-re subject)) - (if (> (length subject) gnus-summary-gather-subject-limit) - (substring subject 0 gnus-summary-gather-subject-limit) - subject)) - ;; Fuzzily simplify it. - ((eq 'fuzzy gnus-summary-gather-subject-limit) - (gnus-simplify-subject-fuzzy subject)) - ;; Just remove the leading "Re:". - (t - (gnus-simplify-subject-re subject)))) - - (if (and gnus-summary-gather-exclude-subject - (string-match gnus-summary-gather-exclude-subject subject)) - nil ; This article shouldn't be gathered - subject)) - -(defun gnus-summary-simplify-subject-query () - "Query where the respool algorithm would put this article." - (interactive) - (gnus-set-global-variables) - (gnus-summary-select-article) - (message (gnus-general-simplify-subject (gnus-summary-article-subject)))) - -(defun gnus-gather-threads-by-subject (threads) - "Gather threads by looking at Subject headers." - (if (not gnus-summary-make-false-root) - threads - (let ((hashtb (gnus-make-hashtable 1024)) - (prev threads) - (result threads) - subject hthread whole-subject) - (while threads - (setq subject (gnus-general-simplify-subject - (setq whole-subject (mail-header-subject - (caar threads))))) - (when subject - (if (setq hthread (gnus-gethash subject hashtb)) - (progn - ;; We enter a dummy root into the thread, if we - ;; haven't done that already. - (unless (stringp (caar hthread)) - (setcar hthread (list whole-subject (car hthread)))) - ;; We add this new gathered thread to this gathered - ;; thread. - (setcdr (car hthread) - (nconc (cdar hthread) (list (car threads)))) - ;; Remove it from the list of threads. - (setcdr prev (cdr threads)) - (setq threads prev)) - ;; Enter this thread into the hash table. - (gnus-sethash subject threads hashtb))) - (setq prev threads) - (setq threads (cdr threads))) - result))) - -(defun gnus-gather-threads-by-references (threads) - "Gather threads by looking at References headers." - (let ((idhashtb (gnus-make-hashtable 1024)) - (thhashtb (gnus-make-hashtable 1024)) - (prev threads) - (result threads) - ids references id gthread gid entered ref) - (while threads - (when (setq references (mail-header-references (caar threads))) - (setq id (mail-header-id (caar threads)) - ids (gnus-split-references references) - entered nil) - (while (setq ref (pop ids)) - (setq ids (delete ref ids)) - (if (not (setq gid (gnus-gethash ref idhashtb))) - (progn - (gnus-sethash ref id idhashtb) - (gnus-sethash id threads thhashtb)) - (setq gthread (gnus-gethash gid thhashtb)) - (unless entered - ;; We enter a dummy root into the thread, if we - ;; haven't done that already. - (unless (stringp (caar gthread)) - (setcar gthread (list (mail-header-subject (caar gthread)) - (car gthread)))) - ;; We add this new gathered thread to this gathered - ;; thread. - (setcdr (car gthread) - (nconc (cdar gthread) (list (car threads))))) - ;; Add it into the thread hash table. - (gnus-sethash id gthread thhashtb) - (setq entered t) - ;; Remove it from the list of threads. - (setcdr prev (cdr threads)) - (setq threads prev)))) - (setq prev threads) - (setq threads (cdr threads))) - result)) - -(defun gnus-sort-gathered-threads (threads) - "Sort subtreads inside each gathered thread by article number." - (let ((result threads)) - (while threads - (when (stringp (caar threads)) - (setcdr (car threads) - (sort (cdar threads) 'gnus-thread-sort-by-number))) - (setq threads (cdr threads))) - result)) - -(defun gnus-thread-loop-p (root thread) - "Say whether ROOT is in THREAD." - (let ((stack (list thread)) - (infloop 0) - th) - (while (setq thread (pop stack)) - (setq th (cdr thread)) - (while (and th - (not (eq (caar th) root))) - (pop th)) - (if th - ;; We have found a loop. - (let (ref-dep) - (setcdr thread (delq (car th) (cdr thread))) - (if (boundp (setq ref-dep (intern "none" - gnus-newsgroup-dependencies))) - (setcdr (symbol-value ref-dep) - (nconc (cdr (symbol-value ref-dep)) - (list (car th)))) - (set ref-dep (list nil (car th)))) - (setq infloop 1 - stack nil)) - ;; Push all the subthreads onto the stack. - (push (cdr thread) stack))) - infloop)) - -(defun gnus-make-threads () - "Go through the dependency hashtb and find the roots. Return all threads." - (let (threads) - (while (catch 'infloop - (mapatoms - (lambda (refs) - ;; Deal with self-referencing References loops. - (when (and (car (symbol-value refs)) - (not (zerop - (apply - '+ - (mapcar - (lambda (thread) - (gnus-thread-loop-p - (car (symbol-value refs)) thread)) - (cdr (symbol-value refs))))))) - (setq threads nil) - (throw 'infloop t)) - (unless (car (symbol-value refs)) - ;; These threads do not refer back to any other articles, - ;; so they're roots. - (setq threads (append (cdr (symbol-value refs)) threads)))) - gnus-newsgroup-dependencies))) - threads)) - -(defun gnus-build-sparse-threads () - (let ((headers gnus-newsgroup-headers) - (deps gnus-newsgroup-dependencies) - header references generation relations - cthread subject child end pthread relation) - ;; First we create an alist of generations/relations, where - ;; generations is how much we trust the relation, and the relation - ;; is parent/child. - (gnus-message 7 "Making sparse threads...") - (save-excursion - (nnheader-set-temp-buffer " *gnus sparse threads*") - (while (setq header (pop headers)) - (when (and (setq references (mail-header-references header)) - (not (string= references ""))) - (insert references) - (setq child (mail-header-id header) - subject (mail-header-subject header)) - (setq generation 0) - (while (search-backward ">" nil t) - (setq end (1+ (point))) - (when (search-backward "<" nil t) - (push (list (incf generation) - child (setq child (buffer-substring (point) end)) - subject) - relations))) - (push (list (1+ generation) child nil subject) relations) - (erase-buffer))) - (kill-buffer (current-buffer))) - ;; Sort over trustworthiness. - (setq relations (sort relations (lambda (r1 r2) (< (car r1) (car r2))))) - (while (setq relation (pop relations)) - (when (if (boundp (setq cthread (intern (cadr relation) deps))) - (unless (car (symbol-value cthread)) - ;; Make this article the parent of these threads. - (setcar (symbol-value cthread) - (vector gnus-reffed-article-number - (cadddr relation) - "" "" - (cadr relation) - (or (caddr relation) "") 0 0 ""))) - (set cthread (list (vector gnus-reffed-article-number - (cadddr relation) - "" "" (cadr relation) - (or (caddr relation) "") 0 0 "")))) - (push gnus-reffed-article-number gnus-newsgroup-limit) - (push gnus-reffed-article-number gnus-newsgroup-sparse) - (push (cons gnus-reffed-article-number gnus-sparse-mark) - gnus-newsgroup-reads) - (decf gnus-reffed-article-number) - ;; Make this new thread the child of its parent. - (if (boundp (setq pthread (intern (or (caddr relation) "none") deps))) - (setcdr (symbol-value pthread) - (nconc (cdr (symbol-value pthread)) - (list (symbol-value cthread)))) - (set pthread (list nil (symbol-value cthread)))))) - (gnus-message 7 "Making sparse threads...done"))) - -(defun gnus-build-old-threads () - ;; Look at all the articles that refer back to old articles, and - ;; fetch the headers for the articles that aren't there. This will - ;; build complete threads - if the roots haven't been expired by the - ;; server, that is. - (let (id heads) - (mapatoms - (lambda (refs) - (when (not (car (symbol-value refs))) - (setq heads (cdr (symbol-value refs))) - (while heads - (if (memq (mail-header-number (caar heads)) - gnus-newsgroup-dormant) - (setq heads (cdr heads)) - (setq id (symbol-name refs)) - (while (and (setq id (gnus-build-get-header id)) - (not (car (gnus-gethash - id gnus-newsgroup-dependencies))))) - (setq heads nil))))) - gnus-newsgroup-dependencies))) - -(defun gnus-build-get-header (id) - ;; Look through the buffer of NOV lines and find the header to - ;; ID. Enter this line into the dependencies hash table, and return - ;; the id of the parent article (if any). - (let ((deps gnus-newsgroup-dependencies) - found header) - (prog1 - (save-excursion - (set-buffer nntp-server-buffer) - (let ((case-fold-search nil)) - (goto-char (point-min)) - (while (and (not found) - (search-forward id nil t)) - (beginning-of-line) - (setq found (looking-at - (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s" - (regexp-quote id)))) - (or found (beginning-of-line 2))) - (when found - (beginning-of-line) - (and - (setq header (gnus-nov-parse-line - (read (current-buffer)) deps)) - (gnus-parent-id (mail-header-references header)))))) - (when header - (let ((number (mail-header-number header))) - (push number gnus-newsgroup-limit) - (push header gnus-newsgroup-headers) - (if (memq number gnus-newsgroup-unselected) - (progn - (push number gnus-newsgroup-unreads) - (setq gnus-newsgroup-unselected - (delq number gnus-newsgroup-unselected))) - (push number gnus-newsgroup-ancient))))))) - -(defun gnus-summary-update-article-line (article header) - "Update the line for ARTICLE using HEADERS." - (let* ((id (mail-header-id header)) - (thread (gnus-id-to-thread id))) - (unless thread - (error "Article in no thread")) - ;; Update the thread. - (setcar thread header) - (gnus-summary-goto-subject article) - (let* ((datal (gnus-data-find-list article)) - (data (car datal)) - (length (when (cdr datal) - (- (gnus-data-pos data) - (gnus-data-pos (cadr datal))))) - (buffer-read-only nil) - (level (gnus-summary-thread-level))) - (gnus-delete-line) - (gnus-summary-insert-line - header level nil (gnus-article-mark article) - (memq article gnus-newsgroup-replied) - (memq article gnus-newsgroup-expirable) - ;; Only insert the Subject string when it's different - ;; from the previous Subject string. - (if (gnus-subject-equal - (condition-case () - (mail-header-subject - (gnus-data-header - (cadr - (gnus-data-find-list - article - (gnus-data-list t))))) - ;; Error on the side of excessive subjects. - (error "")) - (mail-header-subject header)) - "" - (mail-header-subject header)) - nil (cdr (assq article gnus-newsgroup-scored)) - (memq article gnus-newsgroup-processable)) - (when length - (gnus-data-update-list - (cdr datal) (- length (- (gnus-data-pos data) (point)))))))) - -(defun gnus-summary-update-article (article &optional iheader) - "Update ARTICLE in the summary buffer." - (set-buffer gnus-summary-buffer) - (let* ((header (or iheader (gnus-summary-article-header article))) - (id (mail-header-id header)) - (data (gnus-data-find article)) - (thread (gnus-id-to-thread id)) - (references (mail-header-references header)) - (parent - (gnus-id-to-thread - (or (gnus-parent-id - (when (and references - (not (equal "" references))) - references)) - "none"))) - (buffer-read-only nil) - (old (car thread)) - (number (mail-header-number header)) - pos) - (when thread - ;; !!! Should this be in or not? - (unless iheader - (setcar thread nil)) - (when parent - (delq thread parent)) - (if (gnus-summary-insert-subject id header iheader) - ;; Set the (possibly) new article number in the data structure. - (gnus-data-set-number data (gnus-id-to-article id)) - (setcar thread old) - nil)))) - -(defun gnus-rebuild-thread (id) - "Rebuild the thread containing ID." - (let ((buffer-read-only nil) - old-pos current thread data) - (if (not gnus-show-threads) - (setq thread (list (car (gnus-id-to-thread id)))) - ;; Get the thread this article is part of. - (setq thread (gnus-remove-thread id))) - (setq old-pos (gnus-point-at-bol)) - (setq current (save-excursion - (and (zerop (forward-line -1)) - (gnus-summary-article-number)))) - ;; If this is a gathered thread, we have to go some re-gathering. - (when (stringp (car thread)) - (let ((subject (car thread)) - roots thr) - (setq thread (cdr thread)) - (while thread - (unless (memq (setq thr (gnus-id-to-thread - (gnus-root-id - (mail-header-id (caar thread))))) - roots) - (push thr roots)) - (setq thread (cdr thread))) - ;; We now have all (unique) roots. - (if (= (length roots) 1) - ;; All the loose roots are now one solid root. - (setq thread (car roots)) - (setq thread (cons subject (gnus-sort-threads roots)))))) - (let (threads) - ;; We then insert this thread into the summary buffer. - (let (gnus-newsgroup-data gnus-newsgroup-threads) - (if gnus-show-threads - (gnus-summary-prepare-threads (gnus-cut-threads (list thread))) - (gnus-summary-prepare-unthreaded thread)) - (setq data (nreverse gnus-newsgroup-data)) - (setq threads gnus-newsgroup-threads)) - ;; We splice the new data into the data structure. - (gnus-data-enter-list current data (- (point) old-pos)) - (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads))))) - -(defun gnus-number-to-header (number) - "Return the header for article NUMBER." - (let ((headers gnus-newsgroup-headers)) - (while (and headers - (not (= number (mail-header-number (car headers))))) - (pop headers)) - (when headers - (car headers)))) - -(defun gnus-parent-headers (headers &optional generation) - "Return the headers of the GENERATIONeth parent of HEADERS." - (unless generation - (setq generation 1)) - (let (references parent) - (while (and headers (not (zerop generation))) - (setq references (mail-header-references headers)) - (when (and references - (setq parent (gnus-parent-id references)) - (setq headers (car (gnus-id-to-thread parent)))) - (decf generation))) - headers)) - -(defun gnus-id-to-thread (id) - "Return the (sub-)thread where ID appears." - (gnus-gethash id gnus-newsgroup-dependencies)) - -(defun gnus-id-to-article (id) - "Return the article number of ID." - (let ((thread (gnus-id-to-thread id))) - (when (and thread - (car thread)) - (mail-header-number (car thread))))) - -(defun gnus-id-to-header (id) - "Return the article headers of ID." - (car (gnus-id-to-thread id))) - -(defun gnus-article-displayed-root-p (article) - "Say whether ARTICLE is a root(ish) article." - (let ((level (gnus-summary-thread-level article)) - (refs (mail-header-references (gnus-summary-article-header article))) - particle) - (cond - ((null level) nil) - ((zerop level) t) - ((null refs) t) - ((null (gnus-parent-id refs)) t) - ((and (= 1 level) - (null (setq particle (gnus-id-to-article - (gnus-parent-id refs)))) - (null (gnus-summary-thread-level particle))))))) - -(defun gnus-root-id (id) - "Return the id of the root of the thread where ID appears." - (let (last-id prev) - (while (and id (setq prev (car (gnus-gethash - id gnus-newsgroup-dependencies)))) - (setq last-id id - id (gnus-parent-id (mail-header-references prev)))) - last-id)) - -(defun gnus-remove-thread (id &optional dont-remove) - "Remove the thread that has ID in it." - (let ((dep gnus-newsgroup-dependencies) - headers thread last-id) - ;; First go up in this thread until we find the root. - (setq last-id (gnus-root-id id)) - (setq headers (list (car (gnus-id-to-thread last-id)) - (caadr (gnus-id-to-thread last-id)))) - ;; We have now found the real root of this thread. It might have - ;; been gathered into some loose thread, so we have to search - ;; through the threads to find the thread we wanted. - (let ((threads gnus-newsgroup-threads) - sub) - (while threads - (setq sub (car threads)) - (if (stringp (car sub)) - ;; This is a gathered thread, so we look at the roots - ;; below it to find whether this article is in this - ;; gathered root. - (progn - (setq sub (cdr sub)) - (while sub - (when (member (caar sub) headers) - (setq thread (car threads) - threads nil - sub nil)) - (setq sub (cdr sub)))) - ;; It's an ordinary thread, so we check it. - (when (eq (car sub) (car headers)) - (setq thread sub - threads nil))) - (setq threads (cdr threads))) - ;; If this article is in no thread, then it's a root. - (if thread - (unless dont-remove - (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads))) - (setq thread (gnus-gethash last-id dep))) - (when thread - (prog1 - thread ; We return this thread. - (unless dont-remove - (if (stringp (car thread)) - (progn - ;; If we use dummy roots, then we have to remove the - ;; dummy root as well. - (when (eq gnus-summary-make-false-root 'dummy) - (gnus-delete-line) - (gnus-data-compute-positions)) - (setq thread (cdr thread)) - (while thread - (gnus-remove-thread-1 (car thread)) - (setq thread (cdr thread)))) - (gnus-remove-thread-1 thread)))))))) - -(defun gnus-remove-thread-1 (thread) - "Remove the thread THREAD recursively." - (let ((number (mail-header-number (pop thread))) - d) - (setq thread (reverse thread)) - (while thread - (gnus-remove-thread-1 (pop thread))) - (when (setq d (gnus-data-find number)) - (goto-char (gnus-data-pos d)) - (gnus-data-remove - number - (- (gnus-point-at-bol) - (prog1 - (1+ (gnus-point-at-eol)) - (gnus-delete-line))))))) - -(defun gnus-sort-threads (threads) - "Sort THREADS." - (if (not gnus-thread-sort-functions) - threads - (gnus-message 7 "Sorting threads...") - (prog1 - (sort threads (gnus-make-sort-function gnus-thread-sort-functions)) - (gnus-message 7 "Sorting threads...done")))) - -(defun gnus-sort-articles (articles) - "Sort ARTICLES." - (when gnus-article-sort-functions - (gnus-message 7 "Sorting articles...") - (prog1 - (setq gnus-newsgroup-headers - (sort articles (gnus-make-sort-function - gnus-article-sort-functions))) - (gnus-message 7 "Sorting articles...done")))) - -;; Written by Hallvard B Furuseth . -(defmacro gnus-thread-header (thread) - ;; Return header of first article in THREAD. - ;; Note that THREAD must never, ever be anything else than a variable - - ;; using some other form will lead to serious barfage. - (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread))) - ;; (8% speedup to gnus-summary-prepare, just for fun :-) - (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ; - (vector thread) 2)) - -(defsubst gnus-article-sort-by-number (h1 h2) - "Sort articles by article number." - (< (mail-header-number h1) - (mail-header-number h2))) - -(defun gnus-thread-sort-by-number (h1 h2) - "Sort threads by root article number." - (gnus-article-sort-by-number - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defsubst gnus-article-sort-by-lines (h1 h2) - "Sort articles by article Lines header." - (< (mail-header-lines h1) - (mail-header-lines h2))) - -(defun gnus-thread-sort-by-lines (h1 h2) - "Sort threads by root article Lines header." - (gnus-article-sort-by-lines - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defsubst gnus-article-sort-by-author (h1 h2) - "Sort articles by root author." - (string-lessp - (let ((extract (funcall - gnus-extract-address-components - (mail-header-from h1)))) - (or (car extract) (cadr extract) "")) - (let ((extract (funcall - gnus-extract-address-components - (mail-header-from h2)))) - (or (car extract) (cadr extract) "")))) - -(defun gnus-thread-sort-by-author (h1 h2) - "Sort threads by root author." - (gnus-article-sort-by-author - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defsubst gnus-article-sort-by-subject (h1 h2) - "Sort articles by root subject." - (string-lessp - (downcase (gnus-simplify-subject-re (mail-header-subject h1))) - (downcase (gnus-simplify-subject-re (mail-header-subject h2))))) - -(defun gnus-thread-sort-by-subject (h1 h2) - "Sort threads by root subject." - (gnus-article-sort-by-subject - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defsubst gnus-article-sort-by-date (h1 h2) - "Sort articles by root article date." - (gnus-time-less - (gnus-date-get-time (mail-header-date h1)) - (gnus-date-get-time (mail-header-date h2)))) - -(defun gnus-thread-sort-by-date (h1 h2) - "Sort threads by root article date." - (gnus-article-sort-by-date - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defsubst gnus-article-sort-by-score (h1 h2) - "Sort articles by root article score. -Unscored articles will be counted as having a score of zero." - (> (or (cdr (assq (mail-header-number h1) - gnus-newsgroup-scored)) - gnus-summary-default-score 0) - (or (cdr (assq (mail-header-number h2) - gnus-newsgroup-scored)) - gnus-summary-default-score 0))) - -(defun gnus-thread-sort-by-score (h1 h2) - "Sort threads by root article score." - (gnus-article-sort-by-score - (gnus-thread-header h1) (gnus-thread-header h2))) - -(defun gnus-thread-sort-by-total-score (h1 h2) - "Sort threads by the sum of all scores in the thread. -Unscored articles will be counted as having a score of zero." - (> (gnus-thread-total-score h1) (gnus-thread-total-score h2))) - -(defun gnus-thread-total-score (thread) - ;; This function find the total score of THREAD. - (cond ((null thread) - 0) - ((consp thread) - (if (stringp (car thread)) - (apply gnus-thread-score-function 0 - (mapcar 'gnus-thread-total-score-1 (cdr thread))) - (gnus-thread-total-score-1 thread))) - (t - (gnus-thread-total-score-1 (list thread))))) - -(defun gnus-thread-total-score-1 (root) - ;; This function find the total score of the thread below ROOT. - (setq root (car root)) - (apply gnus-thread-score-function - (or (append - (mapcar 'gnus-thread-total-score - (cdr (gnus-gethash (mail-header-id root) - gnus-newsgroup-dependencies))) - (when (> (mail-header-number root) 0) - (list (or (cdr (assq (mail-header-number root) - gnus-newsgroup-scored)) - gnus-summary-default-score 0)))) - (list gnus-summary-default-score) - '(0)))) - -;; Added by Per Abrahamsen . -(defvar gnus-tmp-prev-subject nil) -(defvar gnus-tmp-false-parent nil) -(defvar gnus-tmp-root-expunged nil) -(defvar gnus-tmp-dummy-line nil) - -(defun gnus-summary-prepare-threads (threads) - "Prepare summary buffer from THREADS and indentation LEVEL. -THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])' -or a straight list of headers." - (gnus-message 7 "Generating summary...") - - (setq gnus-newsgroup-threads threads) - (beginning-of-line) - - (let ((gnus-tmp-level 0) - (default-score (or gnus-summary-default-score 0)) - (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight)) - thread number subject stack state gnus-tmp-gathered beg-match - new-roots gnus-tmp-new-adopts thread-end - gnus-tmp-header gnus-tmp-unread - gnus-tmp-replied gnus-tmp-subject-or-nil - gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score - gnus-tmp-score-char gnus-tmp-from gnus-tmp-name - gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket) - - (setq gnus-tmp-prev-subject nil) - - (if (vectorp (car threads)) - ;; If this is a straight (sic) list of headers, then a - ;; threaded summary display isn't required, so we just create - ;; an unthreaded one. - (gnus-summary-prepare-unthreaded threads) - - ;; Do the threaded display. - - (while (or threads stack gnus-tmp-new-adopts new-roots) - - (if (and (= gnus-tmp-level 0) - (not (setq gnus-tmp-dummy-line nil)) - (or (not stack) - (= (caar stack) 0)) - (not gnus-tmp-false-parent) - (or gnus-tmp-new-adopts new-roots)) - (if gnus-tmp-new-adopts - (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1) - thread (list (car gnus-tmp-new-adopts)) - gnus-tmp-header (caar thread) - gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts)) - (when new-roots - (setq thread (list (car new-roots)) - gnus-tmp-header (caar thread) - new-roots (cdr new-roots)))) - - (if threads - ;; If there are some threads, we do them before the - ;; threads on the stack. - (setq thread threads - gnus-tmp-header (caar thread)) - ;; There were no current threads, so we pop something off - ;; the stack. - (setq state (car stack) - gnus-tmp-level (car state) - thread (cdr state) - stack (cdr stack) - gnus-tmp-header (caar thread)))) - - (setq gnus-tmp-false-parent nil) - (setq gnus-tmp-root-expunged nil) - (setq thread-end nil) - - (if (stringp gnus-tmp-header) - ;; The header is a dummy root. - (cond - ((eq gnus-summary-make-false-root 'adopt) - ;; We let the first article adopt the rest. - (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts - (cddar thread))) - (setq gnus-tmp-gathered - (nconc (mapcar - (lambda (h) (mail-header-number (car h))) - (cddar thread)) - gnus-tmp-gathered)) - (setq thread (cons (list (caar thread) - (cadar thread)) - (cdr thread))) - (setq gnus-tmp-level -1 - gnus-tmp-false-parent t)) - ((eq gnus-summary-make-false-root 'empty) - ;; We print adopted articles with empty subject fields. - (setq gnus-tmp-gathered - (nconc (mapcar - (lambda (h) (mail-header-number (car h))) - (cddar thread)) - gnus-tmp-gathered)) - (setq gnus-tmp-level -1)) - ((eq gnus-summary-make-false-root 'dummy) - ;; We remember that we probably want to output a dummy - ;; root. - (setq gnus-tmp-dummy-line gnus-tmp-header) - (setq gnus-tmp-prev-subject gnus-tmp-header)) - (t - ;; We do not make a root for the gathered - ;; sub-threads at all. - (setq gnus-tmp-level -1))) - - (setq number (mail-header-number gnus-tmp-header) - subject (mail-header-subject gnus-tmp-header)) - - (cond - ;; If the thread has changed subject, we might want to make - ;; this subthread into a root. - ((and (null gnus-thread-ignore-subject) - (not (zerop gnus-tmp-level)) - gnus-tmp-prev-subject - (not (inline - (gnus-subject-equal gnus-tmp-prev-subject subject)))) - (setq new-roots (nconc new-roots (list (car thread))) - thread-end t - gnus-tmp-header nil)) - ;; If the article lies outside the current limit, - ;; then we do not display it. - ((not (memq number gnus-newsgroup-limit)) - (setq gnus-tmp-gathered - (nconc (mapcar - (lambda (h) (mail-header-number (car h))) - (cdar thread)) - gnus-tmp-gathered)) - (setq gnus-tmp-new-adopts (if (cdar thread) - (append gnus-tmp-new-adopts - (cdar thread)) - gnus-tmp-new-adopts) - thread-end t - gnus-tmp-header nil) - (when (zerop gnus-tmp-level) - (setq gnus-tmp-root-expunged t))) - ;; Perhaps this article is to be marked as read? - ((and gnus-summary-mark-below - (< (or (cdr (assq number gnus-newsgroup-scored)) - default-score) - gnus-summary-mark-below) - ;; Don't touch sparse articles. - (not (gnus-summary-article-sparse-p number)) - (not (gnus-summary-article-ancient-p number))) - (setq gnus-newsgroup-unreads - (delq number gnus-newsgroup-unreads)) - (if gnus-newsgroup-auto-expire - (push number gnus-newsgroup-expirable) - (push (cons number gnus-low-score-mark) - gnus-newsgroup-reads)))) - - (when gnus-tmp-header - ;; We may have an old dummy line to output before this - ;; article. - (when gnus-tmp-dummy-line - (gnus-summary-insert-dummy-line - gnus-tmp-dummy-line (mail-header-number gnus-tmp-header)) - (setq gnus-tmp-dummy-line nil)) - - ;; Compute the mark. - (setq gnus-tmp-unread (gnus-article-mark number)) - - (push (gnus-data-make number gnus-tmp-unread (1+ (point)) - gnus-tmp-header gnus-tmp-level) - gnus-newsgroup-data) - - ;; Actually insert the line. - (setq - gnus-tmp-subject-or-nil - (cond - ((and gnus-thread-ignore-subject - gnus-tmp-prev-subject - (not (inline (gnus-subject-equal - gnus-tmp-prev-subject subject)))) - subject) - ((zerop gnus-tmp-level) - (if (and (eq gnus-summary-make-false-root 'empty) - (memq number gnus-tmp-gathered) - gnus-tmp-prev-subject - (inline (gnus-subject-equal - gnus-tmp-prev-subject subject))) - gnus-summary-same-subject - subject)) - (t gnus-summary-same-subject))) - (if (and (eq gnus-summary-make-false-root 'adopt) - (= gnus-tmp-level 1) - (memq number gnus-tmp-gathered)) - (setq gnus-tmp-opening-bracket ?\< - gnus-tmp-closing-bracket ?\>) - (setq gnus-tmp-opening-bracket ?\[ - gnus-tmp-closing-bracket ?\])) - (setq - gnus-tmp-indentation - (aref gnus-thread-indent-array gnus-tmp-level) - gnus-tmp-lines (mail-header-lines gnus-tmp-header) - gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored)) - gnus-summary-default-score 0) - gnus-tmp-score-char - (if (or (null gnus-summary-default-score) - (<= (abs (- gnus-tmp-score gnus-summary-default-score)) - gnus-summary-zcore-fuzz)) - ? - (if (< gnus-tmp-score gnus-summary-default-score) - gnus-score-below-mark gnus-score-over-mark)) - gnus-tmp-replied - (cond ((memq number gnus-newsgroup-processable) - gnus-process-mark) - ((memq number gnus-newsgroup-cached) - gnus-cached-mark) - ((memq number gnus-newsgroup-replied) - gnus-replied-mark) - ((memq number gnus-newsgroup-saved) - gnus-saved-mark) - (t gnus-unread-mark)) - gnus-tmp-from (mail-header-from gnus-tmp-header) - gnus-tmp-name - (cond - ((string-match "<[^>]+> *$" gnus-tmp-from) - (setq beg-match (match-beginning 0)) - (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) - (substring gnus-tmp-from (1+ (match-beginning 0)) - (1- (match-end 0)))) - (substring gnus-tmp-from 0 beg-match))) - ((string-match "(.+)" gnus-tmp-from) - (substring gnus-tmp-from - (1+ (match-beginning 0)) (1- (match-end 0)))) - (t gnus-tmp-from))) - (when (string= gnus-tmp-name "") - (setq gnus-tmp-name gnus-tmp-from)) - (unless (numberp gnus-tmp-lines) - (setq gnus-tmp-lines 0)) - (gnus-put-text-property - (point) - (progn (eval gnus-summary-line-format-spec) (point)) - 'gnus-number number) - (when gnus-visual-p - (forward-line -1) - (run-hooks 'gnus-summary-update-hook) - (forward-line 1)) - - (setq gnus-tmp-prev-subject subject))) - - (when (nth 1 thread) - (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack)) - (incf gnus-tmp-level) - (setq threads (if thread-end nil (cdar thread))) - (unless threads - (setq gnus-tmp-level 0))))) - (gnus-message 7 "Generating summary...done")) - -(defun gnus-summary-prepare-unthreaded (headers) - "Generate an unthreaded summary buffer based on HEADERS." - (let (header number mark) - - (beginning-of-line) - - (while headers - ;; We may have to root out some bad articles... - (when (memq (setq number (mail-header-number - (setq header (pop headers)))) - gnus-newsgroup-limit) - ;; Mark article as read when it has a low score. - (when (and gnus-summary-mark-below - (< (or (cdr (assq number gnus-newsgroup-scored)) - gnus-summary-default-score 0) - gnus-summary-mark-below) - (not (gnus-summary-article-ancient-p number))) - (setq gnus-newsgroup-unreads - (delq number gnus-newsgroup-unreads)) - (if gnus-newsgroup-auto-expire - (push number gnus-newsgroup-expirable) - (push (cons number gnus-low-score-mark) - gnus-newsgroup-reads))) - - (setq mark (gnus-article-mark number)) - (push (gnus-data-make number mark (1+ (point)) header 0) - gnus-newsgroup-data) - (gnus-summary-insert-line - header 0 number - mark (memq number gnus-newsgroup-replied) - (memq number gnus-newsgroup-expirable) - (mail-header-subject header) nil - (cdr (assq number gnus-newsgroup-scored)) - (memq number gnus-newsgroup-processable)))))) - -(defun gnus-select-newsgroup (group &optional read-all) - "Select newsgroup GROUP. -If READ-ALL is non-nil, all articles in the group are selected." - (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) - ;;!!! Dirty hack; should be removed. - (gnus-summary-ignore-duplicates - (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual) - t - gnus-summary-ignore-duplicates)) - (info (nth 2 entry)) - articles fetched-articles cached) - - (unless (gnus-check-server - (setq gnus-current-select-method - (gnus-find-method-for-group group))) - (error "Couldn't open server")) - - (or (and entry (not (eq (car entry) t))) ; Either it's active... - (gnus-activate-group group) ; Or we can activate it... - (progn ; Or we bug out. - (when (equal major-mode 'gnus-summary-mode) - (kill-buffer (current-buffer))) - (error "Couldn't request group %s: %s" - group (gnus-status-message group)))) - - (unless (gnus-request-group group t) - (when (equal major-mode 'gnus-summary-mode) - (kill-buffer (current-buffer))) - (error "Couldn't request group %s: %s" - group (gnus-status-message group))) - - (setq gnus-newsgroup-name group) - (setq gnus-newsgroup-unselected nil) - (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group)) - - ;; Adjust and set lists of article marks. - (when info - (gnus-adjust-marked-articles info)) - - ;; Kludge to avoid having cached articles nixed out in virtual groups. - (when (gnus-virtual-group-p group) - (setq cached gnus-newsgroup-cached)) - - (setq gnus-newsgroup-unreads - (gnus-set-difference - (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked) - gnus-newsgroup-dormant)) - - (setq gnus-newsgroup-processable nil) - - (gnus-update-read-articles group gnus-newsgroup-unreads) - (unless (gnus-ephemeral-group-p gnus-newsgroup-name) - (gnus-group-update-group group)) - - (setq articles (gnus-articles-to-read group read-all)) - - (cond - ((null articles) - ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display") - 'quit) - ((eq articles 0) nil) - (t - ;; Init the dependencies hash table. - (setq gnus-newsgroup-dependencies - (gnus-make-hashtable (length articles))) - ;; Retrieve the headers and read them in. - (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name) - (setq gnus-newsgroup-headers - (if (eq 'nov - (setq gnus-headers-retrieved-by - (gnus-retrieve-headers - articles gnus-newsgroup-name - ;; We might want to fetch old headers, but - ;; not if there is only 1 article. - (and gnus-fetch-old-headers - (or (and - (not (eq gnus-fetch-old-headers 'some)) - (not (numberp gnus-fetch-old-headers))) - (> (length articles) 1)))))) - (gnus-get-newsgroup-headers-xover - articles nil nil gnus-newsgroup-name t) - (gnus-get-newsgroup-headers))) - (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name) - - ;; Kludge to avoid having cached articles nixed out in virtual groups. - (when cached - (setq gnus-newsgroup-cached cached)) - - ;; Suppress duplicates? - (when gnus-suppress-duplicates - (gnus-dup-suppress-articles)) - - ;; Set the initial limit. - (setq gnus-newsgroup-limit (copy-sequence articles)) - ;; Remove canceled articles from the list of unread articles. - (setq gnus-newsgroup-unreads - (gnus-set-sorted-intersection - gnus-newsgroup-unreads - (setq fetched-articles - (mapcar (lambda (headers) (mail-header-number headers)) - gnus-newsgroup-headers)))) - ;; Removed marked articles that do not exist. - (gnus-update-missing-marks - (gnus-sorted-complement fetched-articles articles)) - ;; We might want to build some more threads first. - (and gnus-fetch-old-headers - (eq gnus-headers-retrieved-by 'nov) - (gnus-build-old-threads)) - ;; Check whether auto-expire is to be done in this group. - (setq gnus-newsgroup-auto-expire - (gnus-group-auto-expirable-p group)) - ;; Set up the article buffer now, if necessary. - (unless gnus-single-article-buffer - (gnus-article-setup-buffer)) - ;; First and last article in this newsgroup. - (when gnus-newsgroup-headers - (setq gnus-newsgroup-begin - (mail-header-number (car gnus-newsgroup-headers)) - gnus-newsgroup-end - (mail-header-number - (gnus-last-element gnus-newsgroup-headers)))) - ;; GROUP is successfully selected. - (or gnus-newsgroup-headers t))))) - -(defun gnus-articles-to-read (group &optional read-all) - ;; Find out what articles the user wants to read. - (let* ((articles - ;; Select all articles if `read-all' is non-nil, or if there - ;; are no unread articles. - (if (or read-all - (and (zerop (length gnus-newsgroup-marked)) - (zerop (length gnus-newsgroup-unreads))) - (eq (gnus-group-find-parameter group 'display) - 'all)) - (gnus-uncompress-range (gnus-active group)) - (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked - (copy-sequence gnus-newsgroup-unreads)) - '<))) - (scored-list (gnus-killed-articles gnus-newsgroup-killed articles)) - (scored (length scored-list)) - (number (length articles)) - (marked (+ (length gnus-newsgroup-marked) - (length gnus-newsgroup-dormant))) - (select - (cond - ((numberp read-all) - read-all) - (t - (condition-case () - (cond - ((and (or (<= scored marked) (= scored number)) - (numberp gnus-large-newsgroup) - (> number gnus-large-newsgroup)) - (let ((input - (read-string - (format - "How many articles from %s (default %d): " - (gnus-limit-string gnus-newsgroup-name 35) - number)))) - (if (string-match "^[ \t]*$" input) number input))) - ((and (> scored marked) (< scored number) - (> (- scored number) 20)) - (let ((input - (read-string - (format "%s %s (%d scored, %d total): " - "How many articles from" - group scored number)))) - (if (string-match "^[ \t]*$" input) - number input))) - (t number)) - (quit nil)))))) - (setq select (if (stringp select) (string-to-number select) select)) - (if (or (null select) (zerop select)) - select - (if (and (not (zerop scored)) (<= (abs select) scored)) - (progn - (setq articles (sort scored-list '<)) - (setq number (length articles))) - (setq articles (copy-sequence articles))) - - (when (< (abs select) number) - (if (< select 0) - ;; Select the N oldest articles. - (setcdr (nthcdr (1- (abs select)) articles) nil) - ;; Select the N most recent articles. - (setq articles (nthcdr (- number select) articles)))) - (setq gnus-newsgroup-unselected - (gnus-sorted-intersection - gnus-newsgroup-unreads - (gnus-sorted-complement gnus-newsgroup-unreads articles))) - articles))) - -(defun gnus-killed-articles (killed articles) - (let (out) - (while articles - (when (inline (gnus-member-of-range (car articles) killed)) - (push (car articles) out)) - (setq articles (cdr articles))) - out)) - -(defun gnus-uncompress-marks (marks) - "Uncompress the mark ranges in MARKS." - (let ((uncompressed '(score bookmark)) - out) - (while marks - (if (memq (caar marks) uncompressed) - (push (car marks) out) - (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out)) - (setq marks (cdr marks))) - out)) - -(defun gnus-adjust-marked-articles (info) - "Set all article lists and remove all marks that are no longer legal." - (let* ((marked-lists (gnus-info-marks info)) - (active (gnus-active (gnus-info-group info))) - (min (car active)) - (max (cdr active)) - (types gnus-article-mark-lists) - (uncompressed '(score bookmark killed)) - marks var articles article mark) - - (while marked-lists - (setq marks (pop marked-lists)) - (set (setq var (intern (format "gnus-newsgroup-%s" - (car (rassq (setq mark (car marks)) - types))))) - (if (memq (car marks) uncompressed) (cdr marks) - (gnus-uncompress-range (cdr marks)))) - - (setq articles (symbol-value var)) - - ;; All articles have to be subsets of the active articles. - (cond - ;; Adjust "simple" lists. - ((memq mark '(tick dormant expire reply save)) - (while articles - (when (or (< (setq article (pop articles)) min) (> article max)) - (set var (delq article (symbol-value var)))))) - ;; Adjust assocs. - ((memq mark uncompressed) - (when (not (listp (cdr (symbol-value var)))) - (set var (list (symbol-value var)))) - (when (not (listp (cdr articles))) - (setq articles (list articles))) - (while articles - (when (or (not (consp (setq article (pop articles)))) - (< (car article) min) - (> (car article) max)) - (set var (delq article (symbol-value var)))))))))) - -(defun gnus-update-missing-marks (missing) - "Go through the list of MISSING articles and remove them mark lists." - (when missing - (let ((types gnus-article-mark-lists) - var m) - ;; Go through all types. - (while types - (setq var (intern (format "gnus-newsgroup-%s" (car (pop types))))) - (when (symbol-value var) - ;; This list has articles. So we delete all missing articles - ;; from it. - (setq m missing) - (while m - (set var (delq (pop m) (symbol-value var))))))))) - -(defun gnus-update-marks () - "Enter the various lists of marked articles into the newsgroup info list." - (let ((types gnus-article-mark-lists) - (info (gnus-get-info gnus-newsgroup-name)) - (uncompressed '(score bookmark killed)) - type list newmarked symbol) - (when info - ;; Add all marks lists that are non-nil to the list of marks lists. - (while (setq type (pop types)) - (when (setq list (symbol-value - (setq symbol - (intern (format "gnus-newsgroup-%s" - (car type)))))) - - ;; Get rid of the entries of the articles that have the - ;; default score. - (when (and (eq (cdr type) 'score) - gnus-save-score - list) - (let* ((arts list) - (prev (cons nil list)) - (all prev)) - (while arts - (if (or (not (consp (car arts))) - (= (cdar arts) gnus-summary-default-score)) - (setcdr prev (cdr arts)) - (setq prev arts)) - (setq arts (cdr arts))) - (setq list (cdr all)))) - - (push (cons (cdr type) - (if (memq (cdr type) uncompressed) list - (gnus-compress-sequence - (set symbol (sort list '<)) t))) - newmarked))) - - ;; Enter these new marks into the info of the group. - (if (nthcdr 3 info) - (setcar (nthcdr 3 info) newmarked) - ;; Add the marks lists to the end of the info. - (when newmarked - (setcdr (nthcdr 2 info) (list newmarked)))) - - ;; Cut off the end of the info if there's nothing else there. - (let ((i 5)) - (while (and (> i 2) - (not (nth i info))) - (when (nthcdr (decf i) info) - (setcdr (nthcdr i info) nil))))))) - -(defun gnus-set-mode-line (where) - "This function sets the mode line of the article or summary buffers. -If WHERE is `summary', the summary mode line format will be used." - ;; Is this mode line one we keep updated? - (when (memq where gnus-updated-mode-lines) - (let (mode-string) - (save-excursion - ;; We evaluate this in the summary buffer since these - ;; variables are buffer-local to that buffer. - (set-buffer gnus-summary-buffer) - ;; We bind all these variables that are used in the `eval' form - ;; below. - (let* ((mformat (symbol-value - (intern - (format "gnus-%s-mode-line-format-spec" where)))) - (gnus-tmp-group-name gnus-newsgroup-name) - (gnus-tmp-article-number (or gnus-current-article 0)) - (gnus-tmp-unread gnus-newsgroup-unreads) - (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads)) - (gnus-tmp-unselected (length gnus-newsgroup-unselected)) - (gnus-tmp-unread-and-unselected - (cond ((and (zerop gnus-tmp-unread-and-unticked) - (zerop gnus-tmp-unselected)) - "") - ((zerop gnus-tmp-unselected) - (format "{%d more}" gnus-tmp-unread-and-unticked)) - (t (format "{%d(+%d) more}" - gnus-tmp-unread-and-unticked - gnus-tmp-unselected)))) - (gnus-tmp-subject - (if (and gnus-current-headers - (vectorp gnus-current-headers)) - (gnus-mode-string-quote - (mail-header-subject gnus-current-headers)) - "")) - bufname-length max-len - gnus-tmp-header);; passed as argument to any user-format-funcs - (setq mode-string (eval mformat)) - (setq bufname-length (if (string-match "%b" mode-string) - (- (length - (buffer-name - (if (eq where 'summary) - nil - (get-buffer gnus-article-buffer)))) - 2) - 0)) - (setq max-len (max 4 (if gnus-mode-non-string-length - (- (window-width) - gnus-mode-non-string-length - bufname-length) - (length mode-string)))) - ;; We might have to chop a bit of the string off... - (when (> (length mode-string) max-len) - (setq mode-string - (concat (gnus-truncate-string mode-string (- max-len 3)) - "..."))) - ;; Pad the mode string a bit. - (setq mode-string (format (format "%%-%ds" max-len) mode-string)))) - ;; Update the mode line. - (setq mode-line-buffer-identification - (gnus-mode-line-buffer-identification (list mode-string))) - (set-buffer-modified-p t)))) - -(defun gnus-create-xref-hashtb (from-newsgroup headers unreads) - "Go through the HEADERS list and add all Xrefs to a hash table. -The resulting hash table is returned, or nil if no Xrefs were found." - (let* ((virtual (gnus-virtual-group-p from-newsgroup)) - (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup))) - (xref-hashtb (gnus-make-hashtable)) - start group entry number xrefs header) - (while headers - (setq header (pop headers)) - (when (and (setq xrefs (mail-header-xref header)) - (not (memq (setq number (mail-header-number header)) - unreads))) - (setq start 0) - (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start) - (setq start (match-end 0)) - (setq group (if prefix - (concat prefix (substring xrefs (match-beginning 1) - (match-end 1))) - (substring xrefs (match-beginning 1) (match-end 1)))) - (setq number - (string-to-int (substring xrefs (match-beginning 2) - (match-end 2)))) - (if (setq entry (gnus-gethash group xref-hashtb)) - (setcdr entry (cons number (cdr entry))) - (gnus-sethash group (cons number nil) xref-hashtb))))) - (and start xref-hashtb))) - -(defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads) - "Look through all the headers and mark the Xrefs as read." - (let ((virtual (gnus-virtual-group-p from-newsgroup)) - name entry info xref-hashtb idlist method nth4) - (save-excursion - (set-buffer gnus-group-buffer) - (when (setq xref-hashtb - (gnus-create-xref-hashtb from-newsgroup headers unreads)) - (mapatoms - (lambda (group) - (unless (string= from-newsgroup (setq name (symbol-name group))) - (setq idlist (symbol-value group)) - ;; Dead groups are not updated. - (and (prog1 - (setq entry (gnus-gethash name gnus-newsrc-hashtb) - info (nth 2 entry)) - (when (stringp (setq nth4 (gnus-info-method info))) - (setq nth4 (gnus-server-to-method nth4)))) - ;; Only do the xrefs if the group has the same - ;; select method as the group we have just read. - (or (gnus-methods-equal-p - nth4 (gnus-find-method-for-group from-newsgroup)) - virtual - (equal nth4 (setq method (gnus-find-method-for-group - from-newsgroup))) - (and (equal (car nth4) (car method)) - (equal (nth 1 nth4) (nth 1 method)))) - gnus-use-cross-reference - (or (not (eq gnus-use-cross-reference t)) - virtual - ;; Only do cross-references on subscribed - ;; groups, if that is what is wanted. - (<= (gnus-info-level info) gnus-level-subscribed)) - (gnus-group-make-articles-read name idlist)))) - xref-hashtb))))) - -(defun gnus-group-make-articles-read (group articles) - "Update the info of GROUP to say that ARTICLES are read." - (let* ((num 0) - (entry (gnus-gethash group gnus-newsrc-hashtb)) - (info (nth 2 entry)) - (active (gnus-active group)) - range) - ;; First peel off all illegal article numbers. - (when active - (let ((ids articles) - id first) - (while (setq id (pop ids)) - (when (and first (> id (cdr active))) - ;; We'll end up in this situation in one particular - ;; obscure situation. If you re-scan a group and get - ;; a new article that is cross-posted to a different - ;; group that has not been re-scanned, you might get - ;; crossposted article that has a higher number than - ;; Gnus believes possible. So we re-activate this - ;; group as well. This might mean doing the - ;; crossposting thingy will *increase* the number - ;; of articles in some groups. Tsk, tsk. - (setq active (or (gnus-activate-group group) active))) - (when (or (> id (cdr active)) - (< id (car active))) - (setq articles (delq id articles)))))) - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-undo-register - `(progn - (gnus-info-set-marks ',info ',(gnus-info-marks info) t) - (gnus-info-set-read ',info ',(gnus-info-read info)) - (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) - (gnus-group-update-group ,group t)))) - ;; If the read list is nil, we init it. - (and active - (null (gnus-info-read info)) - (> (car active) 1) - (gnus-info-set-read info (cons 1 (1- (car active))))) - ;; Then we add the read articles to the range. - (gnus-info-set-read - info - (setq range - (gnus-add-to-range - (gnus-info-read info) (setq articles (sort articles '<))))) - ;; Then we have to re-compute how many unread - ;; articles there are in this group. - (when active - (cond - ((not range) - (setq num (- (1+ (cdr active)) (car active)))) - ((not (listp (cdr range))) - (setq num (- (cdr active) (- (1+ (cdr range)) - (car range))))) - (t - (while range - (if (numberp (car range)) - (setq num (1+ num)) - (setq num (+ num (- (1+ (cdar range)) (caar range))))) - (setq range (cdr range))) - (setq num (- (cdr active) num)))) - ;; Update the number of unread articles. - (setcar entry num) - ;; Update the group buffer. - (gnus-group-update-group group t)))) - -(defun gnus-methods-equal-p (m1 m2) - (let ((m1 (or m1 gnus-select-method)) - (m2 (or m2 gnus-select-method))) - (or (equal m1 m2) - (and (eq (car m1) (car m2)) - (or (not (memq 'address (assoc (symbol-name (car m1)) - gnus-valid-select-methods))) - (equal (nth 1 m1) (nth 1 m2))))))) - -(defvar gnus-newsgroup-none-id 0) - -(defun gnus-get-newsgroup-headers (&optional dependencies force-new) - (let ((cur nntp-server-buffer) - (dependencies - (or dependencies - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-dependencies))) - headers id id-dep ref-dep end ref) - (save-excursion - (set-buffer nntp-server-buffer) - ;; Translate all TAB characters into SPACE characters. - (subst-char-in-region (point-min) (point-max) ?\t ? t) - (run-hooks 'gnus-parse-headers-hook) - (let ((case-fold-search t) - in-reply-to header p lines) - (goto-char (point-min)) - ;; Search to the beginning of the next header. Error messages - ;; do not begin with 2 or 3. - (while (re-search-forward "^[23][0-9]+ " nil t) - (setq id nil - ref nil) - ;; This implementation of this function, with nine - ;; search-forwards instead of the one re-search-forward and - ;; a case (which basically was the old function) is actually - ;; about twice as fast, even though it looks messier. You - ;; can't have everything, I guess. Speed and elegance - ;; doesn't always go hand in hand. - (setq - header - (vector - ;; Number. - (prog1 - (read cur) - (end-of-line) - (setq p (point)) - (narrow-to-region (point) - (or (and (search-forward "\n.\n" nil t) - (- (point) 2)) - (point)))) - ;; Subject. - (progn - (goto-char p) - (if (search-forward "\nsubject: " nil t) - (nnheader-header-value) "(none)")) - ;; From. - (progn - (goto-char p) - (if (search-forward "\nfrom: " nil t) - (nnheader-header-value) "(nobody)")) - ;; Date. - (progn - (goto-char p) - (if (search-forward "\ndate: " nil t) - (nnheader-header-value) "")) - ;; Message-ID. - (progn - (goto-char p) - (setq id (if (search-forward "\nmessage-id:" nil t) - (buffer-substring - (1- (or (search-forward "<" nil t) (point))) - (or (search-forward ">" nil t) (point))) - ;; If there was no message-id, we just fake one - ;; to make subsequent routines simpler. - (nnheader-generate-fake-message-id)))) - ;; References. - (progn - (goto-char p) - (if (search-forward "\nreferences: " nil t) - (progn - (setq end (point)) - (prog1 - (nnheader-header-value) - (setq ref - (buffer-substring - (progn - (end-of-line) - (search-backward ">" end t) - (1+ (point))) - (progn - (search-backward "<" end t) - (point)))))) - ;; Get the references from the in-reply-to header if there - ;; were no references and the in-reply-to header looks - ;; promising. - (if (and (search-forward "\nin-reply-to: " nil t) - (setq in-reply-to (nnheader-header-value)) - (string-match "<[^>]+>" in-reply-to)) - (setq ref (substring in-reply-to (match-beginning 0) - (match-end 0))) - (setq ref nil)))) - ;; Chars. - 0 - ;; Lines. - (progn - (goto-char p) - (if (search-forward "\nlines: " nil t) - (if (numberp (setq lines (ignore-errors (read cur)))) - lines 0) - 0)) - ;; Xref. - (progn - (goto-char p) - (and (search-forward "\nxref: " nil t) - (nnheader-header-value))))) - (when (equal id ref) - (setq ref nil)) - ;; We do the threading while we read the headers. The - ;; message-id and the last reference are both entered into - ;; the same hash table. Some tippy-toeing around has to be - ;; done in case an article has arrived before the article - ;; which it refers to. - (if (boundp (setq id-dep (intern id dependencies))) - (if (and (car (symbol-value id-dep)) - (not force-new)) - ;; An article with this Message-ID has already been seen. - (if gnus-summary-ignore-duplicates - ;; We ignore this one, except we add - ;; any additional Xrefs (in case the two articles - ;; came from different servers). - (progn - (mail-header-set-xref - (car (symbol-value id-dep)) - (concat (or (mail-header-xref - (car (symbol-value id-dep))) - "") - (or (mail-header-xref header) ""))) - (setq header nil)) - ;; We rename the Message-ID. - (set - (setq id-dep (intern (setq id (nnmail-message-id)) - dependencies)) - (list header)) - (mail-header-set-id header id)) - (setcar (symbol-value id-dep) header)) - (set id-dep (list header))) - (when header - (if (boundp (setq ref-dep (intern (or ref "none") dependencies))) - (setcdr (symbol-value ref-dep) - (nconc (cdr (symbol-value ref-dep)) - (list (symbol-value id-dep)))) - (set ref-dep (list nil (symbol-value id-dep)))) - (push header headers)) - (goto-char (point-max)) - (widen)) - (nreverse headers))))) - -;; The following macros and functions were written by Felix Lee -;; . - -(defmacro gnus-nov-read-integer () - '(prog1 - (if (= (following-char) ?\t) - 0 - (let ((num (ignore-errors (read buffer)))) - (if (numberp num) num 0))) - (unless (eobp) - (forward-char 1)))) - -(defmacro gnus-nov-skip-field () - '(search-forward "\t" eol 'move)) - -(defmacro gnus-nov-field () - '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol))) - -;; (defvar gnus-nov-none-counter 0) - -;; This function has to be called with point after the article number -;; on the beginning of the line. -(defun gnus-nov-parse-line (number dependencies &optional force-new) - (let ((eol (gnus-point-at-eol)) - (buffer (current-buffer)) - header ref id id-dep ref-dep) - - ;; overview: [num subject from date id refs chars lines misc] - (unwind-protect - (progn - (narrow-to-region (point) eol) - (unless (eobp) - (forward-char)) - - (setq header - (vector - number ; number - (gnus-nov-field) ; subject - (gnus-nov-field) ; from - (gnus-nov-field) ; date - (setq id (or (gnus-nov-field) - (nnheader-generate-fake-message-id))) ; id - (progn - (let ((beg (point))) - (search-forward "\t" eol) - (if (search-backward ">" beg t) - (setq ref - (buffer-substring - (1+ (point)) - (search-backward "<" beg t))) - (setq ref nil)) - (goto-char beg)) - (gnus-nov-field)) ; refs - (gnus-nov-read-integer) ; chars - (gnus-nov-read-integer) ; lines - (if (= (following-char) ?\n) - nil - (gnus-nov-field))))) ; misc - - (widen)) - - ;; We build the thread tree. - (when (equal id ref) - ;; This article refers back to itself. Naughty, naughty. - (setq ref nil)) - (if (boundp (setq id-dep (intern id dependencies))) - (if (and (car (symbol-value id-dep)) - (not force-new)) - ;; An article with this Message-ID has already been seen. - (if gnus-summary-ignore-duplicates - ;; We ignore this one, except we add any additional - ;; Xrefs (in case the two articles came from different - ;; servers. - (progn - (mail-header-set-xref - (car (symbol-value id-dep)) - (concat (or (mail-header-xref - (car (symbol-value id-dep))) - "") - (or (mail-header-xref header) ""))) - (setq header nil)) - ;; We rename the Message-ID. - (set - (setq id-dep (intern (setq id (nnmail-message-id)) - dependencies)) - (list header)) - (mail-header-set-id header id)) - (setcar (symbol-value id-dep) header)) - (set id-dep (list header))) - (when header - (if (boundp (setq ref-dep (intern (or ref "none") dependencies))) - (setcdr (symbol-value ref-dep) - (nconc (cdr (symbol-value ref-dep)) - (list (symbol-value id-dep)))) - (set ref-dep (list nil (symbol-value id-dep))))) - header)) - -;; Goes through the xover lines and returns a list of vectors -(defun gnus-get-newsgroup-headers-xover (sequence &optional - force-new dependencies - group also-fetch-heads) - "Parse the news overview data in the server buffer, and return a -list of headers that match SEQUENCE (see `nntp-retrieve-headers')." - ;; Get the Xref when the users reads the articles since most/some - ;; NNTP servers do not include Xrefs when using XOVER. - (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) - (let ((cur nntp-server-buffer) - (dependencies (or dependencies gnus-newsgroup-dependencies)) - number headers header) - (save-excursion - (set-buffer nntp-server-buffer) - ;; Allow the user to mangle the headers before parsing them. - (run-hooks 'gnus-parse-headers-hook) - (goto-char (point-min)) - (while (not (eobp)) - (condition-case () - (while (and sequence (not (eobp))) - (setq number (read cur)) - (while (and sequence - (< (car sequence) number)) - (setq sequence (cdr sequence))) - (and sequence - (eq number (car sequence)) - (progn - (setq sequence (cdr sequence)) - (setq header (inline - (gnus-nov-parse-line - number dependencies force-new)))) - (push header headers)) - (forward-line 1)) - (error - (gnus-error 4 "Strange nov line (%d)" - (count-lines (point-min) (point))))) - (forward-line 1)) - ;; A common bug in inn is that if you have posted an article and - ;; then retrieves the active file, it will answer correctly -- - ;; the new article is included. However, a NOV entry for the - ;; article may not have been generated yet, so this may fail. - ;; We work around this problem by retrieving the last few - ;; headers using HEAD. - (if (or (not also-fetch-heads) - (not sequence)) - ;; We (probably) got all the headers. - (nreverse headers) - (let ((gnus-nov-is-evil t)) - (nconc - (nreverse headers) - (when (gnus-retrieve-headers sequence group) - (gnus-get-newsgroup-headers)))))))) - -(defun gnus-article-get-xrefs () - "Fill in the Xref value in `gnus-current-headers', if necessary. -This is meant to be called in `gnus-article-internal-prepare-hook'." - (let ((headers (save-excursion (set-buffer gnus-summary-buffer) - gnus-current-headers))) - (or (not gnus-use-cross-reference) - (not headers) - (and (mail-header-xref headers) - (not (string= (mail-header-xref headers) ""))) - (let ((case-fold-search t) - xref) - (save-restriction - (nnheader-narrow-to-headers) - (goto-char (point-min)) - (when (or (and (eq (downcase (following-char)) ?x) - (looking-at "Xref:")) - (search-forward "\nXref:" nil t)) - (goto-char (1+ (match-end 0))) - (setq xref (buffer-substring (point) - (progn (end-of-line) (point)))) - (mail-header-set-xref headers xref))))))) - -(defun gnus-summary-insert-subject (id &optional old-header use-old-header) - "Find article ID and insert the summary line for that article." - (let ((header (if (and old-header use-old-header) - old-header (gnus-read-header id))) - (number (and (numberp id) id)) - pos d) - (when header - ;; Rebuild the thread that this article is part of and go to the - ;; article we have fetched. - (when (and (not gnus-show-threads) - old-header) - (when (setq d (gnus-data-find (mail-header-number old-header))) - (goto-char (gnus-data-pos d)) - (gnus-data-remove - number - (- (gnus-point-at-bol) - (prog1 - (1+ (gnus-point-at-eol)) - (gnus-delete-line)))))) - (when old-header - (mail-header-set-number header (mail-header-number old-header))) - (setq gnus-newsgroup-sparse - (delq (setq number (mail-header-number header)) - gnus-newsgroup-sparse)) - (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient)) - (gnus-rebuild-thread (mail-header-id header)) - (gnus-summary-goto-subject number nil t)) - (when (and (numberp number) - (> number 0)) - ;; We have to update the boundaries even if we can't fetch the - ;; article if ID is a number -- so that the next `P' or `N' - ;; command will fetch the previous (or next) article even - ;; if the one we tried to fetch this time has been canceled. - (when (> number gnus-newsgroup-end) - (setq gnus-newsgroup-end number)) - (when (< number gnus-newsgroup-begin) - (setq gnus-newsgroup-begin number)) - (setq gnus-newsgroup-unselected - (delq number gnus-newsgroup-unselected))) - ;; Report back a success? - (and header (mail-header-number header)))) - -;;; Process/prefix in the summary buffer - -(defun gnus-summary-work-articles (n) - "Return a list of articles to be worked upon. The prefix argument, -the list of process marked articles, and the current article will be -taken into consideration." - (cond - (n - ;; A numerical prefix has been given. - (setq n (prefix-numeric-value n)) - (let ((backward (< n 0)) - (n (abs (prefix-numeric-value n))) - articles article) - (save-excursion - (while - (and (> n 0) - (push (setq article (gnus-summary-article-number)) - articles) - (if backward - (gnus-summary-find-prev nil article) - (gnus-summary-find-next nil article))) - (decf n))) - (nreverse articles))) - ((gnus-region-active-p) - ;; Work on the region between point and mark. - (let ((max (max (point) (mark))) - articles article) - (save-excursion - (goto-char (min (point) (mark))) - (while - (and - (push (setq article (gnus-summary-article-number)) articles) - (gnus-summary-find-next nil article) - (< (point) max))) - (nreverse articles)))) - (gnus-newsgroup-processable - ;; There are process-marked articles present. - ;; Save current state. - (gnus-summary-save-process-mark) - ;; Return the list. - (reverse gnus-newsgroup-processable)) - (t - ;; Just return the current article. - (list (gnus-summary-article-number))))) - -(defun gnus-summary-save-process-mark () - "Push the current set of process marked articles on the stack." - (interactive) - (push (copy-sequence gnus-newsgroup-processable) - gnus-newsgroup-process-stack)) - -(defun gnus-summary-kill-process-mark () - "Push the current set of process marked articles on the stack and unmark." - (interactive) - (gnus-summary-save-process-mark) - (gnus-summary-unmark-all-processable)) - -(defun gnus-summary-yank-process-mark () - "Pop the last process mark state off the stack and restore it." - (interactive) - (unless gnus-newsgroup-process-stack - (error "Empty mark stack")) - (gnus-summary-process-mark-set (pop gnus-newsgroup-process-stack))) - -(defun gnus-summary-process-mark-set (set) - "Make SET into the current process marked articles." - (gnus-summary-unmark-all-processable) - (while set - (gnus-summary-set-process-mark (pop set)))) - -;;; Searching and stuff - -(defun gnus-summary-search-group (&optional backward use-level) - "Search for next unread newsgroup. -If optional argument BACKWARD is non-nil, search backward instead." - (save-excursion - (set-buffer gnus-group-buffer) - (when (gnus-group-search-forward - backward nil (if use-level (gnus-group-group-level) nil)) - (gnus-group-group-name)))) - -(defun gnus-summary-best-group (&optional exclude-group) - "Find the name of the best unread group. -If EXCLUDE-GROUP, do not go to this group." - (save-excursion - (set-buffer gnus-group-buffer) - (save-excursion - (gnus-group-best-unread-group exclude-group)))) - -(defun gnus-summary-find-next (&optional unread article backward) - (if backward (gnus-summary-find-prev) - (let* ((dummy (gnus-summary-article-intangible-p)) - (article (or article (gnus-summary-article-number))) - (arts (gnus-data-find-list article)) - result) - (when (and (not dummy) - (or (not gnus-summary-check-current) - (not unread) - (not (gnus-data-unread-p (car arts))))) - (setq arts (cdr arts))) - (when (setq result - (if unread - (progn - (while arts - (when (gnus-data-unread-p (car arts)) - (setq result (car arts) - arts nil)) - (setq arts (cdr arts))) - result) - (car arts))) - (goto-char (gnus-data-pos result)) - (gnus-data-number result))))) - -(defun gnus-summary-find-prev (&optional unread article) - (let* ((eobp (eobp)) - (article (or article (gnus-summary-article-number))) - (arts (gnus-data-find-list article (gnus-data-list 'rev))) - result) - (when (and (not eobp) - (or (not gnus-summary-check-current) - (not unread) - (not (gnus-data-unread-p (car arts))))) - (setq arts (cdr arts))) - (when (setq result - (if unread - (progn - (while arts - (when (gnus-data-unread-p (car arts)) - (setq result (car arts) - arts nil)) - (setq arts (cdr arts))) - result) - (car arts))) - (goto-char (gnus-data-pos result)) - (gnus-data-number result)))) - -(defun gnus-summary-find-subject (subject &optional unread backward article) - (let* ((simp-subject (gnus-simplify-subject-fully subject)) - (article (or article (gnus-summary-article-number))) - (articles (gnus-data-list backward)) - (arts (gnus-data-find-list article articles)) - result) - (when (or (not gnus-summary-check-current) - (not unread) - (not (gnus-data-unread-p (car arts)))) - (setq arts (cdr arts))) - (while arts - (and (or (not unread) - (gnus-data-unread-p (car arts))) - (vectorp (gnus-data-header (car arts))) - (gnus-subject-equal - simp-subject (mail-header-subject (gnus-data-header (car arts))) t) - (setq result (car arts) - arts nil)) - (setq arts (cdr arts))) - (and result - (goto-char (gnus-data-pos result)) - (gnus-data-number result)))) - -(defun gnus-summary-search-forward (&optional unread subject backward) - "Search forward for an article. -If UNREAD, look for unread articles. If SUBJECT, look for -articles with that subject. If BACKWARD, search backward instead." - (cond (subject (gnus-summary-find-subject subject unread backward)) - (backward (gnus-summary-find-prev unread)) - (t (gnus-summary-find-next unread)))) - -(defun gnus-recenter (&optional n) - "Center point in window and redisplay frame. -Also do horizontal recentering." - (interactive "P") - (when (and gnus-auto-center-summary - (not (eq gnus-auto-center-summary 'vertical))) - (gnus-horizontal-recenter)) - (recenter n)) - -(defun gnus-summary-recenter () - "Center point in the summary window. -If `gnus-auto-center-summary' is nil, or the article buffer isn't -displayed, no centering will be performed." - ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). - ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. - (let* ((top (cond ((< (window-height) 4) 0) - ((< (window-height) 7) 1) - (t 2))) - (height (1- (window-height))) - (bottom (save-excursion (goto-char (point-max)) - (forward-line (- height)) - (point))) - (window (get-buffer-window (current-buffer)))) - ;; The user has to want it. - (when gnus-auto-center-summary - (when (get-buffer-window gnus-article-buffer) - ;; Only do recentering when the article buffer is displayed, - ;; Set the window start to either `bottom', which is the biggest - ;; possible valid number, or the second line from the top, - ;; whichever is the least. - (set-window-start - window (min bottom (save-excursion - (forward-line (- top)) (point))))) - ;; Do horizontal recentering while we're at it. - (when (and (get-buffer-window (current-buffer) t) - (not (eq gnus-auto-center-summary 'vertical))) - (let ((selected (selected-window))) - (select-window (get-buffer-window (current-buffer) t)) - (gnus-summary-position-point) - (gnus-horizontal-recenter) - (select-window selected)))))) - -(defun gnus-summary-jump-to-group (newsgroup) - "Move point to NEWSGROUP in group mode buffer." - ;; Keep update point of group mode buffer if visible. - (if (eq (current-buffer) (get-buffer gnus-group-buffer)) - (save-window-excursion - ;; Take care of tree window mode. - (when (get-buffer-window gnus-group-buffer) - (pop-to-buffer gnus-group-buffer)) - (gnus-group-jump-to-group newsgroup)) - (save-excursion - ;; Take care of tree window mode. - (if (get-buffer-window gnus-group-buffer) - (pop-to-buffer gnus-group-buffer) - (set-buffer gnus-group-buffer)) - (gnus-group-jump-to-group newsgroup)))) - -;; This function returns a list of article numbers based on the -;; difference between the ranges of read articles in this group and -;; the range of active articles. -(defun gnus-list-of-unread-articles (group) - (let* ((read (gnus-info-read (gnus-get-info group))) - (active (or (gnus-active group) (gnus-activate-group group))) - (last (cdr active)) - first nlast unread) - ;; If none are read, then all are unread. - (if (not read) - (setq first (car active)) - ;; If the range of read articles is a single range, then the - ;; first unread article is the article after the last read - ;; article. Sounds logical, doesn't it? - (if (not (listp (cdr read))) - (setq first (1+ (cdr read))) - ;; `read' is a list of ranges. - (when (/= (setq nlast (or (and (numberp (car read)) (car read)) - (caar read))) - 1) - (setq first 1)) - (while read - (when first - (while (< first nlast) - (push first unread) - (setq first (1+ first)))) - (setq first (1+ (if (atom (car read)) (car read) (cdar read)))) - (setq nlast (if (atom (cadr read)) (cadr read) (caadr read))) - (setq read (cdr read))))) - ;; And add the last unread articles. - (while (<= first last) - (push first unread) - (setq first (1+ first))) - ;; Return the list of unread articles. - (nreverse unread))) - -(defun gnus-list-of-read-articles (group) - "Return a list of unread, unticked and non-dormant articles." - (let* ((info (gnus-get-info group)) - (marked (gnus-info-marks info)) - (active (gnus-active group))) - (and info active - (gnus-set-difference - (gnus-sorted-complement - (gnus-uncompress-range active) - (gnus-list-of-unread-articles group)) - (append - (gnus-uncompress-range (cdr (assq 'dormant marked))) - (gnus-uncompress-range (cdr (assq 'tick marked)))))))) - -;; Various summary commands - -(defun gnus-summary-universal-argument (arg) - "Perform any operation on all articles that are process/prefixed." - (interactive "P") - (gnus-set-global-variables) - (let ((articles (gnus-summary-work-articles arg)) - func article) - (if (eq - (setq - func - (key-binding - (read-key-sequence - (substitute-command-keys - "\\\\[gnus-summary-universal-argument]" - )))) - 'undefined) - (gnus-error 1 "Undefined key") - (save-excursion - (while articles - (gnus-summary-goto-subject (setq article (pop articles))) - (let (gnus-newsgroup-processable) - (command-execute func)) - (gnus-summary-remove-process-mark article))))) - (gnus-summary-position-point)) - -(defun gnus-summary-toggle-truncation (&optional arg) - "Toggle truncation of summary lines. -With arg, turn line truncation on iff arg is positive." - (interactive "P") - (setq truncate-lines - (if (null arg) (not truncate-lines) - (> (prefix-numeric-value arg) 0))) - (redraw-display)) - -(defun gnus-summary-reselect-current-group (&optional all rescan) - "Exit and then reselect the current newsgroup. -The prefix argument ALL means to select all articles." - (interactive "P") - (gnus-set-global-variables) - (when (gnus-ephemeral-group-p gnus-newsgroup-name) - (error "Ephemeral groups can't be reselected")) - (let ((current-subject (gnus-summary-article-number)) - (group gnus-newsgroup-name)) - (setq gnus-newsgroup-begin nil) - (gnus-summary-exit) - ;; We have to adjust the point of group mode buffer because - ;; point was moved to the next unread newsgroup by exiting. - (gnus-summary-jump-to-group group) - (when rescan - (save-excursion - (gnus-group-get-new-news-this-group 1))) - (gnus-group-read-group all t) - (gnus-summary-goto-subject current-subject nil t))) - -(defun gnus-summary-rescan-group (&optional all) - "Exit the newsgroup, ask for new articles, and select the newsgroup." - (interactive "P") - (gnus-summary-reselect-current-group all t)) - -(defun gnus-summary-update-info (&optional non-destructive) - (save-excursion - (let ((group gnus-newsgroup-name)) - (when gnus-newsgroup-kill-headers - (setq gnus-newsgroup-killed - (gnus-compress-sequence - (nconc - (gnus-set-sorted-intersection - (gnus-uncompress-range gnus-newsgroup-killed) - (setq gnus-newsgroup-unselected - (sort gnus-newsgroup-unselected '<))) - (setq gnus-newsgroup-unreads - (sort gnus-newsgroup-unreads '<))) - t))) - (unless (listp (cdr gnus-newsgroup-killed)) - (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) - (let ((headers gnus-newsgroup-headers)) - (when (and (not gnus-save-score) - (not non-destructive)) - (setq gnus-newsgroup-scored nil)) - ;; Set the new ranges of read articles. - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-undo-force-boundary)) - (gnus-update-read-articles - group (append gnus-newsgroup-unreads gnus-newsgroup-unselected)) - ;; Set the current article marks. - (gnus-update-marks) - ;; Do the cross-ref thing. - (when gnus-use-cross-reference - (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads)) - ;; Do adaptive scoring, and possibly save score files. - (when gnus-newsgroup-adaptive - (gnus-score-adaptive)) - (when gnus-use-scoring - (gnus-score-save)) - ;; Do not switch windows but change the buffer to work. - (set-buffer gnus-group-buffer) - (unless (gnus-ephemeral-group-p gnus-newsgroup-name) - (gnus-group-update-group group)))))) - -(defun gnus-summary-save-newsrc (&optional force) - "Save the current number of read/marked articles in the dribble buffer. -The dribble buffer will then be saved. -If FORCE (the prefix), also save the .newsrc file(s)." - (interactive "P") - (gnus-summary-update-info t) - (if force - (gnus-save-newsrc-file) - (gnus-dribble-save))) - -(defun gnus-summary-exit (&optional temporary) - "Exit reading current newsgroup, and then return to group selection mode. -gnus-exit-group-hook is called with no arguments if that value is non-nil." - (interactive) - (gnus-set-global-variables) - (gnus-kill-save-kill-buffer) - (let* ((group gnus-newsgroup-name) - (quit-config (gnus-group-quit-config gnus-newsgroup-name)) - (mode major-mode) - (group-point nil) - (buf (current-buffer))) - (run-hooks 'gnus-summary-prepare-exit-hook) - ;; If we have several article buffers, we kill them at exit. - (unless gnus-single-article-buffer - (gnus-kill-buffer gnus-original-article-buffer) - (setq gnus-article-current nil)) - (when gnus-use-cache - (gnus-cache-possibly-remove-articles) - (gnus-cache-save-buffers)) - (gnus-async-prefetch-remove-group group) - (when gnus-suppress-duplicates - (gnus-dup-enter-articles)) - (when gnus-use-trees - (gnus-tree-close group)) - ;; Make all changes in this group permanent. - (unless quit-config - (run-hooks 'gnus-exit-group-hook) - (gnus-summary-update-info)) - (gnus-close-group group) - ;; Make sure where we were, and go to next newsgroup. - (set-buffer gnus-group-buffer) - (unless quit-config - (gnus-group-jump-to-group group)) - (run-hooks 'gnus-summary-exit-hook) - (unless quit-config - (gnus-group-next-unread-group 1)) - (setq group-point (point)) - (if temporary - nil ;Nothing to do. - ;; If we have several article buffers, we kill them at exit. - (unless gnus-single-article-buffer - (gnus-kill-buffer gnus-article-buffer) - (gnus-kill-buffer gnus-original-article-buffer) - (setq gnus-article-current nil)) - (set-buffer buf) - (if (not gnus-kill-summary-on-exit) - (gnus-deaden-summary) - ;; We set all buffer-local variables to nil. It is unclear why - ;; this is needed, but if we don't, buffer-local variables are - ;; not garbage-collected, it seems. This would the lead to en - ;; ever-growing Emacs. - (gnus-summary-clear-local-variables) - (when (get-buffer gnus-article-buffer) - (bury-buffer gnus-article-buffer)) - ;; We clear the global counterparts of the buffer-local - ;; variables as well, just to be on the safe side. - (set-buffer gnus-group-buffer) - (gnus-summary-clear-local-variables) - ;; Return to group mode buffer. - (when (eq mode 'gnus-summary-mode) - (gnus-kill-buffer buf))) - (setq gnus-current-select-method gnus-select-method) - (pop-to-buffer gnus-group-buffer) - ;; Clear the current group name. - (if (not quit-config) - (progn - (goto-char group-point) - (gnus-configure-windows 'group 'force)) - (gnus-handle-ephemeral-exit quit-config)) - (unless quit-config - (setq gnus-newsgroup-name nil))))) - -(defalias 'gnus-summary-quit 'gnus-summary-exit-no-update) -(defun gnus-summary-exit-no-update (&optional no-questions) - "Quit reading current newsgroup without updating read article info." - (interactive) - (gnus-set-global-variables) - (let* ((group gnus-newsgroup-name) - (quit-config (gnus-group-quit-config group))) - (when (or no-questions - gnus-expert-user - (gnus-y-or-n-p "Discard changes to this group and exit? ")) - ;; If we have several article buffers, we kill them at exit. - (unless gnus-single-article-buffer - (gnus-kill-buffer gnus-article-buffer) - (gnus-kill-buffer gnus-original-article-buffer) - (setq gnus-article-current nil)) - (if (not gnus-kill-summary-on-exit) - (gnus-deaden-summary) - (gnus-close-group group) - (gnus-summary-clear-local-variables) - (set-buffer gnus-group-buffer) - (gnus-summary-clear-local-variables) - (when (get-buffer gnus-summary-buffer) - (kill-buffer gnus-summary-buffer))) - (unless gnus-single-article-buffer - (setq gnus-article-current nil)) - (when gnus-use-trees - (gnus-tree-close group)) - (gnus-async-prefetch-remove-group group) - (when (get-buffer gnus-article-buffer) - (bury-buffer gnus-article-buffer)) - ;; Return to the group buffer. - (gnus-configure-windows 'group 'force) - ;; Clear the current group name. - (setq gnus-newsgroup-name nil) - (when (equal (gnus-group-group-name) group) - (gnus-group-next-unread-group 1)) - (when quit-config - (gnus-handle-ephemeral-exit quit-config))))) - -(defun gnus-handle-ephemeral-exit (quit-config) - "Handle movement when leaving an ephemeral group. The state -which existed when entering the ephemeral is reset." - (if (not (buffer-name (car quit-config))) - (gnus-configure-windows 'group 'force) - (set-buffer (car quit-config)) - (cond ((eq major-mode 'gnus-summary-mode) - (gnus-set-global-variables)) - ((eq major-mode 'gnus-article-mode) - (save-excursion - ;; The `gnus-summary-buffer' variable may point - ;; to the old summary buffer when using a single - ;; article buffer. - (unless (gnus-buffer-live-p gnus-summary-buffer) - (set-buffer gnus-group-buffer)) - (set-buffer gnus-summary-buffer) - (gnus-set-global-variables)))) - (if (or (eq (cdr quit-config) 'article) - (eq (cdr quit-config) 'pick)) - (progn - ;; The current article may be from the ephemeral group - ;; thus it is best that we reload this article - (gnus-summary-show-article) - (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode)) - (gnus-configure-windows 'pick 'force) - (gnus-configure-windows (cdr quit-config) 'force))) - (gnus-configure-windows (cdr quit-config) 'force)) - (when (eq major-mode 'gnus-summary-mode) - (gnus-summary-next-subject 1 nil t) - (gnus-summary-recenter) - (gnus-summary-position-point)))) - -;;; Dead summaries. - -(defvar gnus-dead-summary-mode-map nil) - -(unless gnus-dead-summary-mode-map - (setq gnus-dead-summary-mode-map (make-keymap)) - (suppress-keymap gnus-dead-summary-mode-map) - (substitute-key-definition - 'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map) - (let ((keys '("\C-d" "\r" "\177" [delete]))) - (while keys - (define-key gnus-dead-summary-mode-map - (pop keys) 'gnus-summary-wake-up-the-dead)))) - -(defvar gnus-dead-summary-mode nil - "Minor mode for Gnus summary buffers.") - -(defun gnus-dead-summary-mode (&optional arg) - "Minor mode for Gnus summary buffers." - (interactive "P") - (when (eq major-mode 'gnus-summary-mode) - (make-local-variable 'gnus-dead-summary-mode) - (setq gnus-dead-summary-mode - (if (null arg) (not gnus-dead-summary-mode) - (> (prefix-numeric-value arg) 0))) - (when gnus-dead-summary-mode - (gnus-add-minor-mode - 'gnus-dead-summary-mode " Dead" gnus-dead-summary-mode-map)))) - -(defun gnus-deaden-summary () - "Make the current summary buffer into a dead summary buffer." - ;; Kill any previous dead summary buffer. - (when (and gnus-dead-summary - (buffer-name gnus-dead-summary)) - (save-excursion - (set-buffer gnus-dead-summary) - (when gnus-dead-summary-mode - (kill-buffer (current-buffer))))) - ;; Make this the current dead summary. - (setq gnus-dead-summary (current-buffer)) - (gnus-dead-summary-mode 1) - (let ((name (buffer-name))) - (when (string-match "Summary" name) - (rename-buffer - (concat (substring name 0 (match-beginning 0)) "Dead " - (substring name (match-beginning 0))) - t)))) - -(defun gnus-kill-or-deaden-summary (buffer) - "Kill or deaden the summary BUFFER." - (when (and (buffer-name buffer) - (not gnus-single-article-buffer)) - (save-excursion - (set-buffer buffer) - (gnus-kill-buffer gnus-article-buffer) - (gnus-kill-buffer gnus-original-article-buffer))) - (cond (gnus-kill-summary-on-exit - (when (and gnus-use-trees - (and (get-buffer buffer) - (buffer-name (get-buffer buffer)))) - (save-excursion - (set-buffer (get-buffer buffer)) - (gnus-tree-close gnus-newsgroup-name))) - (gnus-kill-buffer buffer)) - ((and (get-buffer buffer) - (buffer-name (get-buffer buffer))) - (save-excursion - (set-buffer buffer) - (gnus-deaden-summary))))) - -(defun gnus-summary-wake-up-the-dead (&rest args) - "Wake up the dead summary buffer." - (interactive) - (gnus-dead-summary-mode -1) - (let ((name (buffer-name))) - (when (string-match "Dead " name) - (rename-buffer - (concat (substring name 0 (match-beginning 0)) - (substring name (match-end 0))) - t))) - (gnus-message 3 "This dead summary is now alive again")) - -;; Suggested by Andrew Eskilsson . -(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 (lambda (file) (list file)) - 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 . -(defun gnus-summary-describe-group (&optional force) - "Describe the current newsgroup." - (interactive "P") - (gnus-group-describe-group force gnus-newsgroup-name)) - -(defun gnus-summary-describe-briefly () - "Describe summary mode commands briefly." - (interactive) - (gnus-message 6 - (substitute-command-keys "\\\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help"))) - -;; Walking around group mode buffer from summary mode. - -(defun gnus-summary-next-group (&optional no-article target-group backward) - "Exit current newsgroup and then select next unread newsgroup. -If prefix argument NO-ARTICLE is non-nil, no article is selected -initially. If NEXT-GROUP, go to this group. If BACKWARD, go to -previous group instead." - (interactive "P") - (gnus-set-global-variables) - ;; Stop pre-fetching. - (gnus-async-halt-prefetch) - (let ((current-group gnus-newsgroup-name) - (current-buffer (current-buffer)) - entered) - ;; First we semi-exit this group to update Xrefs and all variables. - ;; We can't do a real exit, because the window conf must remain - ;; the same in case the user is prompted for info, and we don't - ;; want the window conf to change before that... - (gnus-summary-exit t) - (while (not entered) - ;; Then we find what group we are supposed to enter. - (set-buffer gnus-group-buffer) - (gnus-group-jump-to-group current-group) - (setq target-group - (or target-group - (if (eq gnus-keep-same-level 'best) - (gnus-summary-best-group gnus-newsgroup-name) - (gnus-summary-search-group backward gnus-keep-same-level)))) - (if (not target-group) - ;; There are no further groups, so we return to the group - ;; buffer. - (progn - (gnus-message 5 "Returning to the group buffer") - (setq entered t) - (when (gnus-buffer-live-p current-buffer) - (set-buffer current-buffer) - (gnus-summary-exit)) - (run-hooks 'gnus-group-no-more-groups-hook)) - ;; We try to enter the target group. - (gnus-group-jump-to-group target-group) - (let ((unreads (gnus-group-group-unread))) - (if (and (or (eq t unreads) - (and unreads (not (zerop unreads)))) - (gnus-summary-read-group - target-group nil no-article - (and (buffer-name current-buffer) current-buffer))) - (setq entered t) - (setq current-group target-group - target-group nil))))))) - -(defun gnus-summary-prev-group (&optional no-article) - "Exit current newsgroup and then select previous unread newsgroup. -If prefix argument NO-ARTICLE is non-nil, no article is selected initially." - (interactive "P") - (gnus-summary-next-group no-article nil t)) - -;; Walking around summary lines. - -(defun gnus-summary-first-subject (&optional unread) - "Go to the first unread subject. -If UNREAD is non-nil, go to the first unread article. -Returns the article selected or nil if there are no unread articles." - (interactive "P") - (prog1 - (cond - ;; Empty summary. - ((null gnus-newsgroup-data) - (gnus-message 3 "No articles in the group") - nil) - ;; Pick the first article. - ((not unread) - (goto-char (gnus-data-pos (car gnus-newsgroup-data))) - (gnus-data-number (car gnus-newsgroup-data))) - ;; No unread articles. - ((null gnus-newsgroup-unreads) - (gnus-message 3 "No more unread articles") - nil) - ;; Find the first unread article. - (t - (let ((data gnus-newsgroup-data)) - (while (and data - (not (gnus-data-unread-p (car data)))) - (setq data (cdr data))) - (when data - (goto-char (gnus-data-pos (car data))) - (gnus-data-number (car data)))))) - (gnus-summary-position-point))) - -(defun gnus-summary-next-subject (n &optional unread dont-display) - "Go to next N'th summary line. -If N is negative, go to the previous N'th subject line. -If UNREAD is non-nil, only unread articles are selected. -The difference between N and the actual number of steps taken is -returned." - (interactive "p") - (let ((backward (< n 0)) - (n (abs n))) - (while (and (> n 0) - (if backward - (gnus-summary-find-prev unread) - (gnus-summary-find-next unread))) - (setq n (1- n))) - (when (/= 0 n) - (gnus-message 7 "No more%s articles" - (if unread " unread" ""))) - (unless dont-display - (gnus-summary-recenter) - (gnus-summary-position-point)) - n)) - -(defun gnus-summary-next-unread-subject (n) - "Go to next N'th unread summary line." - (interactive "p") - (gnus-summary-next-subject n t)) - -(defun gnus-summary-prev-subject (n &optional unread) - "Go to previous N'th summary line. -If optional argument UNREAD is non-nil, only unread article is selected." - (interactive "p") - (gnus-summary-next-subject (- n) unread)) - -(defun gnus-summary-prev-unread-subject (n) - "Go to previous N'th unread summary line." - (interactive "p") - (gnus-summary-next-subject (- n) t)) - -(defun gnus-summary-goto-subject (article &optional force silent) - "Go the subject line of ARTICLE. -If FORCE, also allow jumping to articles not currently shown." - (interactive "nArticle number: ") - (let ((b (point)) - (data (gnus-data-find article))) - ;; We read in the article if we have to. - (and (not data) - force - (gnus-summary-insert-subject article (and (vectorp force) force) t) - (setq data (gnus-data-find article))) - (goto-char b) - (if (not data) - (progn - (unless silent - (gnus-message 3 "Can't find article %d" article)) - nil) - (goto-char (gnus-data-pos data)) - article))) - -;; Walking around summary lines with displaying articles. - -(defun gnus-summary-expand-window (&optional arg) - "Make the summary buffer take up the entire Emacs frame. -Given a prefix, will force an `article' buffer configuration." - (interactive "P") - (gnus-set-global-variables) - (if arg - (gnus-configure-windows 'article 'force) - (gnus-configure-windows 'summary 'force))) - -(defun gnus-summary-display-article (article &optional all-header) - "Display ARTICLE in article buffer." - (gnus-set-global-variables) - (if (null article) - nil - (prog1 - (if gnus-summary-display-article-function - (funcall gnus-summary-display-article-function article all-header) - (gnus-article-prepare article all-header)) - (run-hooks 'gnus-select-article-hook) - (when (and gnus-current-article - (not (zerop gnus-current-article))) - (gnus-summary-goto-subject gnus-current-article)) - (gnus-summary-recenter) - (when (and gnus-use-trees gnus-show-threads) - (gnus-possibly-generate-tree article) - (gnus-highlight-selected-tree article)) - ;; Successfully display article. - (gnus-article-set-window-start - (cdr (assq article gnus-newsgroup-bookmarks)))))) - -(defun gnus-summary-select-article (&optional all-headers force pseudo article) - "Select the current article. -If ALL-HEADERS is non-nil, show all header fields. If FORCE is -non-nil, the article will be re-fetched even if it already present in -the article buffer. If PSEUDO is non-nil, pseudo-articles will also -be displayed." - ;; Make sure we are in the summary buffer to work around bbdb bug. - (unless (eq major-mode 'gnus-summary-mode) - (set-buffer gnus-summary-buffer)) - (let ((article (or article (gnus-summary-article-number))) - (all-headers (not (not all-headers))) ;Must be T or NIL. - gnus-summary-display-article-function - did) - (and (not pseudo) - (gnus-summary-article-pseudo-p article) - (error "This is a pseudo-article")) - (prog1 - (save-excursion - (set-buffer gnus-summary-buffer) - (if (or (and gnus-single-article-buffer - (or (null gnus-current-article) - (null gnus-article-current) - (null (get-buffer gnus-article-buffer)) - (not (eq article (cdr gnus-article-current))) - (not (equal (car gnus-article-current) - gnus-newsgroup-name)))) - (and (not gnus-single-article-buffer) - (or (null gnus-current-article) - (not (eq gnus-current-article article)))) - force) - ;; The requested article is different from the current article. - (prog1 - (gnus-summary-display-article article all-headers) - (setq did article)) - (when (or all-headers gnus-show-all-headers) - (gnus-article-show-all-headers)) - 'old)) - (when did - (gnus-article-set-window-start - (cdr (assq article gnus-newsgroup-bookmarks))))))) - -(defun gnus-summary-set-current-mark (&optional current-mark) - "Obsolete function." - nil) - -(defun gnus-summary-next-article (&optional unread subject backward push) - "Select the next article. -If UNREAD, only unread articles are selected. -If SUBJECT, only articles with SUBJECT are selected. -If BACKWARD, the previous article is selected instead of the next." - (interactive "P") - (gnus-set-global-variables) - (cond - ;; Is there such an article? - ((and (gnus-summary-search-forward unread subject backward) - (or (gnus-summary-display-article (gnus-summary-article-number)) - (eq (gnus-summary-article-mark) gnus-canceled-mark))) - (gnus-summary-position-point)) - ;; If not, we try the first unread, if that is wanted. - ((and subject - gnus-auto-select-same - (gnus-summary-first-unread-article)) - (gnus-summary-position-point) - (gnus-message 6 "Wrapped")) - ;; Try to get next/previous article not displayed in this group. - ((and gnus-auto-extend-newsgroup - (not unread) (not subject)) - (gnus-summary-goto-article - (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end)) - nil t)) - ;; Go to next/previous group. - (t - (unless (gnus-ephemeral-group-p gnus-newsgroup-name) - (gnus-summary-jump-to-group gnus-newsgroup-name)) - (let ((cmd last-command-char) - (point - (save-excursion - (set-buffer gnus-group-buffer) - (point))) - (group - (if (eq gnus-keep-same-level 'best) - (gnus-summary-best-group gnus-newsgroup-name) - (gnus-summary-search-group backward gnus-keep-same-level)))) - ;; For some reason, the group window gets selected. We change - ;; it back. - (select-window (get-buffer-window (current-buffer))) - ;; Select next unread newsgroup automagically. - (cond - ((or (not gnus-auto-select-next) - (not cmd)) - (gnus-message 7 "No more%s articles" (if unread " unread" ""))) - ((or (eq gnus-auto-select-next 'quietly) - (and (eq gnus-auto-select-next 'slightly-quietly) - push) - (and (eq gnus-auto-select-next 'almost-quietly) - (gnus-summary-last-article-p))) - ;; Select quietly. - (if (gnus-ephemeral-group-p gnus-newsgroup-name) - (gnus-summary-exit) - (gnus-message 7 "No more%s articles (%s)..." - (if unread " unread" "") - (if group (concat "selecting " group) - "exiting")) - (gnus-summary-next-group nil group backward))) - (t - (when (gnus-key-press-event-p last-input-event) - (gnus-summary-walk-group-buffer - gnus-newsgroup-name cmd unread backward point)))))))) - -(defun gnus-summary-walk-group-buffer (from-group cmd unread backward start) - (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1)) - (?\C-p (gnus-group-prev-unread-group 1)))) - (cursor-in-echo-area t) - keve key group ended) - (save-excursion - (set-buffer gnus-group-buffer) - (goto-char start) - (setq group - (if (eq gnus-keep-same-level 'best) - (gnus-summary-best-group gnus-newsgroup-name) - (gnus-summary-search-group backward gnus-keep-same-level)))) - (while (not ended) - (gnus-message - 5 "No more%s articles%s" (if unread " unread" "") - (if (and group - (not (gnus-ephemeral-group-p gnus-newsgroup-name))) - (format " (Type %s for %s [%s])" - (single-key-description cmd) group - (car (gnus-gethash group gnus-newsrc-hashtb))) - (format " (Type %s to exit %s)" - (single-key-description cmd) - gnus-newsgroup-name))) - ;; Confirm auto selection. - (setq key (car (setq keve (gnus-read-event-char)))) - (setq ended t) - (cond - ((assq key keystrokes) - (let ((obuf (current-buffer))) - (switch-to-buffer gnus-group-buffer) - (when group - (gnus-group-jump-to-group group)) - (eval (cadr (assq key keystrokes))) - (setq group (gnus-group-group-name)) - (switch-to-buffer obuf)) - (setq ended nil)) - ((equal key cmd) - (if (or (not group) - (gnus-ephemeral-group-p gnus-newsgroup-name)) - (gnus-summary-exit) - (gnus-summary-next-group nil group backward))) - (t - (push (cdr keve) unread-command-events)))))) - -(defun gnus-summary-next-unread-article () - "Select unread article after current one." - (interactive) - (gnus-summary-next-article - (or (not (eq gnus-summary-goto-unread 'never)) - (gnus-summary-last-article-p (gnus-summary-article-number))) - (and gnus-auto-select-same - (gnus-summary-article-subject)))) - -(defun gnus-summary-prev-article (&optional unread subject) - "Select the article after the current one. -If UNREAD is non-nil, only unread articles are selected." - (interactive "P") - (gnus-summary-next-article unread subject t)) - -(defun gnus-summary-prev-unread-article () - "Select unread article before current one." - (interactive) - (gnus-summary-prev-article - (or (not (eq gnus-summary-goto-unread 'never)) - (gnus-summary-first-article-p (gnus-summary-article-number))) - (and gnus-auto-select-same - (gnus-summary-article-subject)))) - -(defun gnus-summary-next-page (&optional lines circular) - "Show next page of the selected article. -If at the end of the current article, select the next article. -LINES says how many lines should be scrolled up. - -If CIRCULAR is non-nil, go to the start of the article instead of -selecting the next article when reaching the end of the current -article." - (interactive "P") - (setq gnus-summary-buffer (current-buffer)) - (gnus-set-global-variables) - (let ((article (gnus-summary-article-number)) - (article-window (get-buffer-window gnus-article-buffer t)) - endp) - (gnus-configure-windows 'article) - (if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark) - (if (and (eq gnus-summary-goto-unread 'never) - (not (gnus-summary-last-article-p article))) - (gnus-summary-next-article) - (gnus-summary-next-unread-article)) - (if (or (null gnus-current-article) - (null gnus-article-current) - (/= article (cdr gnus-article-current)) - (not (equal (car gnus-article-current) gnus-newsgroup-name))) - ;; Selected subject is different from current article's. - (gnus-summary-display-article article) - (when article-window - (gnus-eval-in-buffer-window gnus-article-buffer - (setq endp (gnus-article-next-page lines))) - (when endp - (cond (circular - (gnus-summary-beginning-of-article)) - (lines - (gnus-message 3 "End of message")) - ((null lines) - (if (and (eq gnus-summary-goto-unread 'never) - (not (gnus-summary-last-article-p article))) - (gnus-summary-next-article) - (gnus-summary-next-unread-article)))))))) - (gnus-summary-recenter) - (gnus-summary-position-point))) - -(defun gnus-summary-prev-page (&optional lines move) - "Show previous page of selected article. -Argument LINES specifies lines to be scrolled down. -If MOVE, move to the previous unread article if point is at -the beginning of the buffer." - (interactive "P") - (gnus-set-global-variables) - (let ((article (gnus-summary-article-number)) - (article-window (get-buffer-window gnus-article-buffer t)) - endp) - (gnus-configure-windows 'article) - (if (or (null gnus-current-article) - (null gnus-article-current) - (/= article (cdr gnus-article-current)) - (not (equal (car gnus-article-current) gnus-newsgroup-name))) - ;; Selected subject is different from current article's. - (gnus-summary-display-article article) - (gnus-summary-recenter) - (when article-window - (gnus-eval-in-buffer-window gnus-article-buffer - (setq endp (gnus-article-prev-page lines))) - (when (and move endp) - (cond (lines - (gnus-message 3 "Beginning of message")) - ((null lines) - (if (and (eq gnus-summary-goto-unread 'never) - (not (gnus-summary-first-article-p article))) - (gnus-summary-prev-article) - (gnus-summary-prev-unread-article)))))))) - (gnus-summary-position-point)) - -(defun gnus-summary-prev-page-or-article (&optional lines) - "Show previous page of selected article. -Argument LINES specifies lines to be scrolled down. -If at the beginning of the article, go to the next article." - (interactive "P") - (gnus-summary-prev-page lines t)) - -(defun gnus-summary-scroll-up (lines) - "Scroll up (or down) one line current article. -Argument LINES specifies lines to be scrolled up (or down if negative)." - (interactive "p") - (gnus-set-global-variables) - (gnus-configure-windows 'article) - (gnus-summary-show-thread) - (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old) - (gnus-eval-in-buffer-window gnus-article-buffer - (cond ((> lines 0) - (when (gnus-article-next-page lines) - (gnus-message 3 "End of message"))) - ((< lines 0) - (gnus-article-prev-page (- lines)))))) - (gnus-summary-recenter) - (gnus-summary-position-point)) - -(defun gnus-summary-next-same-subject () - "Select next article which has the same subject as current one." - (interactive) - (gnus-set-global-variables) - (gnus-summary-next-article nil (gnus-summary-article-subject))) - -(defun gnus-summary-prev-same-subject () - "Select previous article which has the same subject as current one." - (interactive) - (gnus-set-global-variables) - (gnus-summary-prev-article nil (gnus-summary-article-subject))) - -(defun gnus-summary-next-unread-same-subject () - "Select next unread article which has the same subject as current one." - (interactive) - (gnus-set-global-variables) - (gnus-summary-next-article t (gnus-summary-article-subject))) - -(defun gnus-summary-prev-unread-same-subject () - "Select previous unread article which has the same subject as current one." - (interactive) - (gnus-set-global-variables) - (gnus-summary-prev-article t (gnus-summary-article-subject))) - -(defun gnus-summary-first-unread-article () - "Select the first unread article. -Return nil if there are no unread articles." - (interactive) - (gnus-set-global-variables) - (prog1 - (when (gnus-summary-first-subject t) - (gnus-summary-show-thread) - (gnus-summary-first-subject t) - (gnus-summary-display-article (gnus-summary-article-number))) - (gnus-summary-position-point))) - -(defun gnus-summary-first-article () - "Select the first article. -Return nil if there are no articles." - (interactive) - (gnus-set-global-variables) - (prog1 - (when (gnus-summary-first-subject) - (gnus-summary-show-thread) - (gnus-summary-first-subject) - (gnus-summary-display-article (gnus-summary-article-number))) - (gnus-summary-position-point))) - -(defun gnus-summary-best-unread-article () - "Select the unread article with the highest score." - (interactive) - (gnus-set-global-variables) - (let ((best -1000000) - (data gnus-newsgroup-data) - article score) - (while data - (and (gnus-data-unread-p (car data)) - (> (setq score - (gnus-summary-article-score (gnus-data-number (car data)))) - best) - (setq best score - article (gnus-data-number (car data)))) - (setq data (cdr data))) - (prog1 - (if article - (gnus-summary-goto-article article) - (error "No unread articles")) - (gnus-summary-position-point)))) - -(defun gnus-summary-last-subject () - "Go to the last displayed subject line in the group." - (let ((article (gnus-data-number (car (gnus-data-list t))))) - (when article - (gnus-summary-goto-subject article)))) - -(defun gnus-summary-goto-article (article &optional all-headers force) - "Fetch ARTICLE and display it if it exists. -If ALL-HEADERS is non-nil, no header lines are hidden." - (interactive - (list - (string-to-int - (completing-read - "Article number: " - (mapcar (lambda (number) (list (int-to-string number))) - gnus-newsgroup-limit))) - current-prefix-arg - t)) - (prog1 - (if (gnus-summary-goto-subject article force) - (gnus-summary-display-article article all-headers) - (gnus-message 4 "Couldn't go to article %s" article) nil) - (gnus-summary-position-point))) - -(defun gnus-summary-goto-last-article () - "Go to the previously read article." - (interactive) - (prog1 - (when gnus-last-article - (gnus-summary-goto-article gnus-last-article)) - (gnus-summary-position-point))) - -(defun gnus-summary-pop-article (number) - "Pop one article off the history and go to the previous. -NUMBER articles will be popped off." - (interactive "p") - (let (to) - (setq gnus-newsgroup-history - (cdr (setq to (nthcdr number gnus-newsgroup-history)))) - (if to - (gnus-summary-goto-article (car to)) - (error "Article history empty"))) - (gnus-summary-position-point)) - -;; Summary commands and functions for limiting the summary buffer. - -(defun gnus-summary-limit-to-articles (n) - "Limit the summary buffer to the next N articles. -If not given a prefix, use the process marked articles instead." - (interactive "P") - (gnus-set-global-variables) - (prog1 - (let ((articles (gnus-summary-work-articles n))) - (setq gnus-newsgroup-processable nil) - (gnus-summary-limit articles)) - (gnus-summary-position-point))) - -(defun gnus-summary-pop-limit (&optional total) - "Restore the previous limit. -If given a prefix, remove all limits." - (interactive "P") - (gnus-set-global-variables) - (when total - (setq gnus-newsgroup-limits - (list (mapcar (lambda (h) (mail-header-number h)) - gnus-newsgroup-headers)))) - (unless gnus-newsgroup-limits - (error "No limit to pop")) - (prog1 - (gnus-summary-limit nil 'pop) - (gnus-summary-position-point))) - -(defun gnus-summary-limit-to-subject (subject &optional header) - "Limit the summary buffer to articles that have subjects that match a regexp." - (interactive "sLimit to subject (regexp): ") - (unless header - (setq header "subject")) - (when (not (equal "" subject)) - (prog1 - (let ((articles (gnus-summary-find-matching - (or header "subject") subject 'all))) - (unless articles - (error "Found no matches for \"%s\"" subject)) - (gnus-summary-limit articles)) - (gnus-summary-position-point)))) - -(defun gnus-summary-limit-to-author (from) - "Limit the summary buffer to articles that have authors that match a regexp." - (interactive "sLimit to author (regexp): ") - (gnus-summary-limit-to-subject from "from")) - -(defun gnus-summary-limit-to-age (age &optional younger-p) - "Limit the summary buffer to articles that are older than (or equal) AGE days. -If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to -articles that are younger than AGE days." - (interactive "nTime in days: \nP") - (prog1 - (let ((data gnus-newsgroup-data) - (cutoff (nnmail-days-to-time age)) - articles d date is-younger) - (while (setq d (pop data)) - (when (and (vectorp (gnus-data-header d)) - (setq date (mail-header-date (gnus-data-header d)))) - (setq is-younger (nnmail-time-less - (nnmail-time-since (nnmail-date-to-time date)) - cutoff)) - (when (if younger-p is-younger (not is-younger)) - (push (gnus-data-number d) articles)))) - (gnus-summary-limit (nreverse articles))) - (gnus-summary-position-point))) - -(defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) -(make-obsolete - 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) - -(defun gnus-summary-limit-to-unread (&optional all) - "Limit the summary buffer to articles that are not marked as read. -If ALL is non-nil, limit strictly to unread articles." - (interactive "P") - (if all - (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark)) - (gnus-summary-limit-to-marks - ;; Concat all the marks that say that an article is read and have - ;; those removed. - (list gnus-del-mark gnus-read-mark gnus-ancient-mark - gnus-killed-mark gnus-kill-file-mark - gnus-low-score-mark gnus-expirable-mark - gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark - gnus-duplicate-mark gnus-souped-mark) - 'reverse))) - -(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks) -(make-obsolete 'gnus-summary-delete-marked-with - 'gnus-summary-limit-exlude-marks) - -(defun gnus-summary-limit-exclude-marks (marks &optional reverse) - "Exclude articles that are marked with MARKS (e.g. \"DK\"). -If REVERSE, limit the summary buffer to articles that are marked -with MARKS. MARKS can either be a string of marks or a list of marks. -Returns how many articles were removed." - (interactive "sMarks: ") - (gnus-summary-limit-to-marks marks t)) - -(defun gnus-summary-limit-to-marks (marks &optional reverse) - "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\"). -If REVERSE (the prefix), limit the summary buffer to articles that are -not marked with MARKS. MARKS can either be a string of marks or a -list of marks. -Returns how many articles were removed." - (interactive (list (read-string "Marks: ") current-prefix-arg)) - (gnus-set-global-variables) - (prog1 - (let ((data gnus-newsgroup-data) - (marks (if (listp marks) marks - (append marks nil))) ; Transform to list. - articles) - (while data - (when (if reverse (not (memq (gnus-data-mark (car data)) marks)) - (memq (gnus-data-mark (car data)) marks)) - (push (gnus-data-number (car data)) articles)) - (setq data (cdr data))) - (gnus-summary-limit articles)) - (gnus-summary-position-point))) - -(defun gnus-summary-limit-to-score (&optional score) - "Limit to articles with score at or above SCORE." - (interactive "P") - (gnus-set-global-variables) - (setq score (if score - (prefix-numeric-value score) - (or gnus-summary-default-score 0))) - (let ((data gnus-newsgroup-data) - articles) - (while data - (when (>= (gnus-summary-article-score (gnus-data-number (car data))) - score) - (push (gnus-data-number (car data)) articles)) - (setq data (cdr data))) - (prog1 - (gnus-summary-limit articles) - (gnus-summary-position-point)))) - -(defun gnus-summary-limit-include-dormant () - "Display all the hidden articles that are marked as dormant." - (interactive) - (gnus-set-global-variables) - (unless gnus-newsgroup-dormant - (error "There are no dormant articles in this group")) - (prog1 - (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit)) - (gnus-summary-position-point))) - -(defun gnus-summary-limit-exclude-dormant () - "Hide all dormant articles." - (interactive) - (gnus-set-global-variables) - (prog1 - (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse) - (gnus-summary-position-point))) - -(defun gnus-summary-limit-exclude-childless-dormant () - "Hide all dormant articles that have no children." - (interactive) - (gnus-set-global-variables) - (let ((data (gnus-data-list t)) - articles d children) - ;; Find all articles that are either not dormant or have - ;; children. - (while (setq d (pop data)) - (when (or (not (= (gnus-data-mark d) gnus-dormant-mark)) - (and (setq children - (gnus-article-children (gnus-data-number d))) - (let (found) - (while children - (when (memq (car children) articles) - (setq children nil - found t)) - (pop children)) - found))) - (push (gnus-data-number d) articles))) - ;; Do the limiting. - (prog1 - (gnus-summary-limit articles) - (gnus-summary-position-point)))) - -(defun gnus-summary-limit-mark-excluded-as-read (&optional all) - "Mark all unread excluded articles as read. -If ALL, mark even excluded ticked and dormants as read." - (interactive "P") - (let ((articles (gnus-sorted-complement - (sort - (mapcar (lambda (h) (mail-header-number h)) - gnus-newsgroup-headers) - '<) - (sort gnus-newsgroup-limit '<))) - article) - (setq gnus-newsgroup-unreads gnus-newsgroup-limit) - (if all - (setq gnus-newsgroup-dormant nil - gnus-newsgroup-marked nil - gnus-newsgroup-reads - (nconc - (mapcar (lambda (n) (cons n gnus-catchup-mark)) articles) - gnus-newsgroup-reads)) - (while (setq article (pop articles)) - (unless (or (memq article gnus-newsgroup-dormant) - (memq article gnus-newsgroup-marked)) - (push (cons article gnus-catchup-mark) gnus-newsgroup-reads)))))) - -(defun gnus-summary-limit (articles &optional pop) - (if pop - ;; We pop the previous limit off the stack and use that. - (setq articles (car gnus-newsgroup-limits) - gnus-newsgroup-limits (cdr gnus-newsgroup-limits)) - ;; We use the new limit, so we push the old limit on the stack. - (push gnus-newsgroup-limit gnus-newsgroup-limits)) - ;; Set the limit. - (setq gnus-newsgroup-limit articles) - (let ((total (length gnus-newsgroup-data)) - (data (gnus-data-find-list (gnus-summary-article-number))) - (gnus-summary-mark-below nil) ; Inhibit this. - found) - ;; This will do all the work of generating the new summary buffer - ;; according to the new limit. - (gnus-summary-prepare) - ;; Hide any threads, possibly. - (and gnus-show-threads - gnus-thread-hide-subtree - (gnus-summary-hide-all-threads)) - ;; Try to return to the article you were at, or one in the - ;; neighborhood. - (when data - ;; We try to find some article after the current one. - (while data - (when (gnus-summary-goto-subject (gnus-data-number (car data)) nil t) - (setq data nil - found t)) - (setq data (cdr data)))) - (unless found - ;; If there is no data, that means that we were after the last - ;; article. The same goes when we can't find any articles - ;; after the current one. - (goto-char (point-max)) - (gnus-summary-find-prev)) - ;; We return how many articles were removed from the summary - ;; buffer as a result of the new limit. - (- total (length gnus-newsgroup-data)))) - -(defsubst gnus-invisible-cut-children (threads) - (let ((num 0)) - (while threads - (when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit) - (incf num)) - (pop threads)) - (< num 2))) - -(defsubst gnus-cut-thread (thread) - "Go forwards in the thread until we find an article that we want to display." - (when (or (eq gnus-fetch-old-headers 'some) - (eq gnus-build-sparse-threads 'some) - (eq gnus-build-sparse-threads 'more)) - ;; Deal with old-fetched headers and sparse threads. - (while (and - thread - (or - (gnus-summary-article-sparse-p (mail-header-number (car thread))) - (gnus-summary-article-ancient-p - (mail-header-number (car thread)))) - (progn - (if (<= (length (cdr thread)) 1) - (setq gnus-newsgroup-limit - (delq (mail-header-number (car thread)) - gnus-newsgroup-limit) - thread (cadr thread)) - (when (gnus-invisible-cut-children (cdr thread)) - (let ((th (cdr thread))) - (while th - (if (memq (mail-header-number (caar th)) - gnus-newsgroup-limit) - (setq thread (car th) - th nil) - (setq th (cdr th))))))))))) - thread) - -(defun gnus-cut-threads (threads) - "Cut off all uninteresting articles from the beginning of threads." - (when (or (eq gnus-fetch-old-headers 'some) - (eq gnus-build-sparse-threads 'some) - (eq gnus-build-sparse-threads 'more)) - (let ((th threads)) - (while th - (setcar th (gnus-cut-thread (car th))) - (setq th (cdr th))))) - ;; Remove nixed out threads. - (delq nil threads)) - -(defun gnus-summary-initial-limit (&optional show-if-empty) - "Figure out what the initial limit is supposed to be on group entry. -This entails weeding out unwanted dormants, low-scored articles, -fetch-old-headers verbiage, and so on." - ;; Most groups have nothing to remove. - (if (or gnus-inhibit-limiting - (and (null gnus-newsgroup-dormant) - (not (eq gnus-fetch-old-headers 'some)) - (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))) - () ; Do nothing. - (push gnus-newsgroup-limit gnus-newsgroup-limits) - (setq gnus-newsgroup-limit nil) - (mapatoms - (lambda (node) - (unless (car (symbol-value node)) - ;; These threads have no parents -- they are roots. - (let ((nodes (cdr (symbol-value node))) - thread) - (while nodes - (if (and gnus-thread-expunge-below - (< (gnus-thread-total-score (car nodes)) - gnus-thread-expunge-below)) - (gnus-expunge-thread (pop nodes)) - (setq thread (pop nodes)) - (gnus-summary-limit-children thread)))))) - gnus-newsgroup-dependencies) - ;; If this limitation resulted in an empty group, we might - ;; pop the previous limit and use it instead. - (when (and (not gnus-newsgroup-limit) - show-if-empty) - (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits))) - gnus-newsgroup-limit)) - -(defun gnus-summary-limit-children (thread) - "Return 1 if this subthread is visible and 0 if it is not." - ;; First we get the number of visible children to this thread. This - ;; is done by recursing down the thread using this function, so this - ;; will really go down to a leaf article first, before slowly - ;; working its way up towards the root. - (when thread - (let ((children - (if (cdr thread) - (apply '+ (mapcar 'gnus-summary-limit-children - (cdr thread))) - 0)) - (number (mail-header-number (car thread))) - score) - (if (and - (not (memq number gnus-newsgroup-marked)) - (or - ;; If this article is dormant and has absolutely no visible - ;; children, then this article isn't visible. - (and (memq number gnus-newsgroup-dormant) - (zerop children)) - ;; If this is "fetch-old-headered" and there is no - ;; visible children, then we don't want this article. - (and (eq gnus-fetch-old-headers 'some) - (gnus-summary-article-ancient-p number) - (zerop children)) - ;; If this is a sparsely inserted article with no children, - ;; we don't want it. - (and (eq gnus-build-sparse-threads 'some) - (gnus-summary-article-sparse-p number) - (zerop children)) - ;; If we use expunging, and this article is really - ;; low-scored, then we don't want this article. - (when (and gnus-summary-expunge-below - (< (setq score - (or (cdr (assq number gnus-newsgroup-scored)) - gnus-summary-default-score)) - gnus-summary-expunge-below)) - ;; We increase the expunge-tally here, but that has - ;; nothing to do with the limits, really. - (incf gnus-newsgroup-expunged-tally) - ;; We also mark as read here, if that's wanted. - (when (and gnus-summary-mark-below - (< score gnus-summary-mark-below)) - (setq gnus-newsgroup-unreads - (delq number gnus-newsgroup-unreads)) - (if gnus-newsgroup-auto-expire - (push number gnus-newsgroup-expirable) - (push (cons number gnus-low-score-mark) - gnus-newsgroup-reads))) - t) - ;; Check NoCeM things. - (if (and gnus-use-nocem - (gnus-nocem-unwanted-article-p - (mail-header-id (car thread)))) - (progn - (setq gnus-newsgroup-reads - (delq number gnus-newsgroup-reads)) - t)))) - ;; Nope, invisible article. - 0 - ;; Ok, this article is to be visible, so we add it to the limit - ;; and return 1. - (push number gnus-newsgroup-limit) - 1)))) - -(defun gnus-expunge-thread (thread) - "Mark all articles in THREAD as read." - (let* ((number (mail-header-number (car thread)))) - (incf gnus-newsgroup-expunged-tally) - ;; We also mark as read here, if that's wanted. - (setq gnus-newsgroup-unreads - (delq number gnus-newsgroup-unreads)) - (if gnus-newsgroup-auto-expire - (push number gnus-newsgroup-expirable) - (push (cons number gnus-low-score-mark) - gnus-newsgroup-reads))) - ;; Go recursively through all subthreads. - (mapcar 'gnus-expunge-thread (cdr thread))) - -;; Summary article oriented commands - -(defun gnus-summary-refer-parent-article (n) - "Refer parent article N times. -If N is negative, go to ancestor -N instead. -The difference between N and the number of articles fetched is returned." - (interactive "p") - (gnus-set-global-variables) - (let ((skip 1) - error header ref) - (when (not (natnump n)) - (setq skip (abs n) - n 1)) - (while (and (> n 0) - (not error)) - (setq header (gnus-summary-article-header)) - (if (and (eq (mail-header-number header) - (cdr gnus-article-current)) - (equal gnus-newsgroup-name - (car gnus-article-current))) - ;; If we try to find the parent of the currently - ;; displayed article, then we take a look at the actual - ;; References header, since this is slightly more - ;; reliable than the References field we got from the - ;; server. - (save-excursion - (set-buffer gnus-original-article-buffer) - (nnheader-narrow-to-headers) - (unless (setq ref (message-fetch-field "references")) - (setq ref (message-fetch-field "in-reply-to"))) - (widen)) - (setq ref - ;; It's not the current article, so we take a bet on - ;; the value we got from the server. - (mail-header-references header))) - (if (and ref - (not (equal ref ""))) - (unless (gnus-summary-refer-article (gnus-parent-id ref skip)) - (gnus-message 1 "Couldn't find parent")) - (gnus-message 1 "No references in article %d" - (gnus-summary-article-number)) - (setq error t)) - (decf n)) - (gnus-summary-position-point) - n)) - -(defun gnus-summary-refer-references () - "Fetch all articles mentioned in the References header. -Return how many articles were fetched." - (interactive) - (gnus-set-global-variables) - (let ((ref (mail-header-references (gnus-summary-article-header))) - (current (gnus-summary-article-number)) - (n 0)) - (if (or (not ref) - (equal ref "")) - (error "No References in the current article") - ;; For each Message-ID in the References header... - (while (string-match "<[^>]*>" ref) - (incf n) - ;; ... fetch that article. - (gnus-summary-refer-article - (prog1 (match-string 0 ref) - (setq ref (substring ref (match-end 0)))))) - (gnus-summary-goto-subject current) - (gnus-summary-position-point) - n))) - -(defun gnus-summary-refer-article (message-id &optional arg) - "Fetch an article specified by MESSAGE-ID. -If ARG (the prefix), fetch the article using `gnus-refer-article-method' -or `gnus-select-method', no matter what backend the article comes from." - (interactive "sMessage-ID: \nP") - (when (and (stringp message-id) - (not (zerop (length message-id)))) - ;; Construct the correct Message-ID if necessary. - ;; Suggested by tale@pawl.rpi.edu. - (unless (string-match "^<" message-id) - (setq message-id (concat "<" message-id))) - (unless (string-match ">$" message-id) - (setq message-id (concat message-id ">"))) - (let* ((header (gnus-id-to-header message-id)) - (sparse (and header - (gnus-summary-article-sparse-p - (mail-header-number header)) - (memq (mail-header-number header) - gnus-newsgroup-limit)))) - (if (and header - (or (not (gnus-summary-article-sparse-p - (mail-header-number header))) - sparse)) - (prog1 - ;; The article is present in the buffer, so we just go to it. - (gnus-summary-goto-article - (mail-header-number header) nil t) - (when sparse - (gnus-summary-update-article (mail-header-number header)))) - ;; We fetch the article - (let ((gnus-override-method - (cond ((gnus-news-group-p gnus-newsgroup-name) - gnus-refer-article-method) - (arg - (or gnus-refer-article-method gnus-select-method)) - (t nil))) - number) - ;; Start the special refer-article method, if necessary. - (when (and gnus-refer-article-method - (gnus-news-group-p gnus-newsgroup-name)) - (gnus-check-server gnus-refer-article-method)) - ;; Fetch the header, and display the article. - (if (setq number (gnus-summary-insert-subject message-id)) - (gnus-summary-select-article nil nil nil number) - (gnus-message 3 "Couldn't fetch article %s" message-id))))))) - -(defun gnus-summary-enter-digest-group (&optional force) - "Enter an nndoc group based on the current article. -If FORCE, force a digest interpretation. If not, try -to guess what the document format is." - (interactive "P") - (gnus-set-global-variables) - (let ((conf gnus-current-window-configuration)) - (save-excursion - (gnus-summary-select-article)) - (setq gnus-current-window-configuration conf) - (let* ((name (format "%s-%d" - (gnus-group-prefixed-name - gnus-newsgroup-name (list 'nndoc "")) - (save-excursion - (set-buffer gnus-summary-buffer) - gnus-current-article))) - (ogroup gnus-newsgroup-name) - (params (append (gnus-info-params (gnus-get-info ogroup)) - (list (cons 'to-group ogroup)) - (list (cons 'save-article-group ogroup)))) - (case-fold-search t) - (buf (current-buffer)) - dig) - (save-excursion - (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*")) - (insert-buffer-substring gnus-original-article-buffer) - ;; Remove lines that may lead nndoc to misinterpret the - ;; document type. - (narrow-to-region - (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point))) - (goto-char (point-min)) - (delete-matching-lines "^\\(Path\\):\\|^From ") - (widen)) - (unwind-protect - (if (gnus-group-read-ephemeral-group - name `(nndoc ,name (nndoc-address ,(get-buffer dig)) - (nndoc-article-type - ,(if force 'digest 'guess))) t) - ;; Make all postings to this group go to the parent group. - (nconc (gnus-info-params (gnus-get-info name)) - params) - ;; Couldn't select this doc group. - (switch-to-buffer buf) - (gnus-set-global-variables) - (gnus-configure-windows 'summary) - (gnus-message 3 "Article couldn't be entered?")) - (kill-buffer dig))))) - -(defun gnus-summary-read-document (n) - "Open a new group based on the current article(s). -This will allow you to read digests and other similar -documents as newsgroups. -Obeys the standard process/prefix convention." - (interactive "P") - (let* ((articles (gnus-summary-work-articles n)) - (ogroup gnus-newsgroup-name) - (params (append (gnus-info-params (gnus-get-info ogroup)) - (list (cons 'to-group ogroup)))) - article group egroup groups vgroup) - (while (setq article (pop articles)) - (setq group (format "%s-%d" gnus-newsgroup-name article)) - (gnus-summary-remove-process-mark article) - (when (gnus-summary-display-article article) - (save-excursion - (nnheader-temp-write nil - (insert-buffer-substring gnus-original-article-buffer) - ;; Remove some headers that may lead nndoc to make - ;; the wrong guess. - (message-narrow-to-head) - (goto-char (point-min)) - (delete-matching-lines "^\\(Path\\):\\|^From ") - (widen) - (if (setq egroup - (gnus-group-read-ephemeral-group - group `(nndoc ,group (nndoc-address ,(current-buffer)) - (nndoc-article-type guess)) - t nil t)) - (progn - ;; Make all postings to this group go to the parent group. - (nconc (gnus-info-params (gnus-get-info egroup)) - params) - (push egroup groups)) - ;; Couldn't select this doc group. - (gnus-error 3 "Article couldn't be entered")))))) - ;; Now we have selected all the documents. - (cond - ((not groups) - (error "None of the articles could be interpreted as documents")) - ((gnus-group-read-ephemeral-group - (setq vgroup (format - "nnvirtual:%s-%s" gnus-newsgroup-name - (format-time-string "%Y%m%dT%H%M%S" (current-time)))) - `(nnvirtual ,vgroup (nnvirtual-component-groups ,groups)) - t - (cons (current-buffer) 'summary))) - (t - (error "Couldn't select virtual nndoc group"))))) - -(defun gnus-summary-isearch-article (&optional regexp-p) - "Do incremental search forward on the current article. -If REGEXP-P (the prefix) is non-nil, do regexp isearch." - (interactive "P") - (gnus-set-global-variables) - (gnus-summary-select-article) - (gnus-configure-windows 'article) - (gnus-eval-in-buffer-window gnus-article-buffer - ;;(goto-char (point-min)) - (isearch-forward regexp-p))) - -(defun gnus-summary-search-article-forward (regexp &optional backward) - "Search for an article containing REGEXP forward. -If BACKWARD, search backward instead." - (interactive - (list (read-string - (format "Search article %s (regexp%s): " - (if current-prefix-arg "backward" "forward") - (if gnus-last-search-regexp - (concat ", default " gnus-last-search-regexp) - ""))) - current-prefix-arg)) - (gnus-set-global-variables) - (if (string-equal regexp "") - (setq regexp (or gnus-last-search-regexp "")) - (setq gnus-last-search-regexp regexp)) - (if (gnus-summary-search-article regexp backward) - (gnus-summary-show-thread) - (error "Search failed: \"%s\"" regexp))) - -(defun gnus-summary-search-article-backward (regexp) - "Search for an article containing REGEXP backward." - (interactive - (list (read-string - (format "Search article backward (regexp%s): " - (if gnus-last-search-regexp - (concat ", default " gnus-last-search-regexp) - ""))))) - (gnus-summary-search-article-forward regexp 'backward)) - -(defun gnus-summary-search-article (regexp &optional backward) - "Search for an article containing REGEXP. -Optional argument BACKWARD means do search for backward. -`gnus-select-article-hook' is not called during the search." - ;; We have to require this here to make sure that the following - ;; dynamic binding isn't shadowed by autoloading. - (require 'gnus-async) - (let ((gnus-select-article-hook nil) ;Disable hook. - (gnus-article-display-hook nil) - (gnus-mark-article-hook nil) ;Inhibit marking as read. - (gnus-use-article-prefetch nil) - (gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay. - (gnus-use-trees nil) ;Inhibit updating tree buffer. - (sum (current-buffer)) - (found nil) - point) - (gnus-save-hidden-threads - (gnus-summary-select-article) - (set-buffer gnus-article-buffer) - (when backward - (forward-line -1)) - (while (not found) - (gnus-message 7 "Searching article: %d..." (cdr gnus-article-current)) - (if (if backward - (re-search-backward regexp nil t) - (re-search-forward regexp nil t)) - ;; We found the regexp. - (progn - (setq found 'found) - (beginning-of-line) - (set-window-start - (get-buffer-window (current-buffer)) - (point)) - (forward-line 1) - (set-buffer sum) - (setq point (point))) - ;; We didn't find it, so we go to the next article. - (set-buffer sum) - (setq found 'not) - (while (eq found 'not) - (if (not (if backward (gnus-summary-find-prev) - (gnus-summary-find-next))) - ;; No more articles. - (setq found t) - ;; Select the next article and adjust point. - (unless (gnus-summary-article-sparse-p - (gnus-summary-article-number)) - (setq found nil) - (gnus-summary-select-article) - (set-buffer gnus-article-buffer) - (widen) - (goto-char (if backward (point-max) (point-min)))))))) - (gnus-message 7 "")) - ;; Return whether we found the regexp. - (when (eq found 'found) - (goto-char point) - (gnus-summary-show-thread) - (gnus-summary-goto-subject gnus-current-article) - (gnus-summary-position-point) - t))) - -(defun gnus-summary-find-matching (header regexp &optional backward unread - not-case-fold) - "Return a list of all articles that match REGEXP on HEADER. -The search stars on the current article and goes forwards unless -BACKWARD is non-nil. If BACKWARD is `all', do all articles. -If UNREAD is non-nil, only unread articles will -be taken into consideration. If NOT-CASE-FOLD, case won't be folded -in the comparisons." - (let ((data (if (eq backward 'all) gnus-newsgroup-data - (gnus-data-find-list - (gnus-summary-article-number) (gnus-data-list backward)))) - (func `(lambda (h) (,(intern (concat "mail-header-" header)) h))) - (case-fold-search (not not-case-fold)) - articles d) - (unless (fboundp (intern (concat "mail-header-" header))) - (error "%s is not a valid header" header)) - (while data - (setq d (car data)) - (and (or (not unread) ; We want all articles... - (gnus-data-unread-p d)) ; Or just unreads. - (vectorp (gnus-data-header d)) ; It's not a pseudo. - (string-match regexp (funcall func (gnus-data-header d))) ; Match. - (push (gnus-data-number d) articles)) ; Success! - (setq data (cdr data))) - (nreverse articles))) - -(defun gnus-summary-execute-command (header regexp command &optional backward) - "Search forward for an article whose HEADER matches REGEXP and execute COMMAND. -If HEADER is an empty string (or nil), the match is done on the entire -article. If BACKWARD (the prefix) is non-nil, search backward instead." - (interactive - (list (let ((completion-ignore-case t)) - (completing-read - "Header name: " - (mapcar (lambda (string) (list string)) - '("Number" "Subject" "From" "Lines" "Date" - "Message-ID" "Xref" "References" "Body")) - nil 'require-match)) - (read-string "Regexp: ") - (read-key-sequence "Command: ") - current-prefix-arg)) - (when (equal header "Body") - (setq header "")) - (gnus-set-global-variables) - ;; Hidden thread subtrees must be searched as well. - (gnus-summary-show-all-threads) - ;; We don't want to change current point nor window configuration. - (save-excursion - (save-window-excursion - (gnus-message 6 "Executing %s..." (key-description command)) - ;; We'd like to execute COMMAND interactively so as to give arguments. - (gnus-execute header regexp - `(call-interactively ',(key-binding command)) - backward) - (gnus-message 6 "Executing %s...done" (key-description command))))) - -(defun gnus-summary-beginning-of-article () - "Scroll the article back to the beginning." - (interactive) - (gnus-set-global-variables) - (gnus-summary-select-article) - (gnus-configure-windows 'article) - (gnus-eval-in-buffer-window gnus-article-buffer - (widen) - (goto-char (point-min)) - (when gnus-page-broken - (gnus-narrow-to-page)))) - -(defun gnus-summary-end-of-article () - "Scroll to the end of the article." - (interactive) - (gnus-set-global-variables) - (gnus-summary-select-article) - (gnus-configure-windows 'article) - (gnus-eval-in-buffer-window gnus-article-buffer - (widen) - (goto-char (point-max)) - (recenter -3) - (when gnus-page-broken - (gnus-narrow-to-page)))) - -(defun gnus-summary-print-article (&optional filename) - "Generate and print a PostScript image of the article buffer. - -If the optional argument FILENAME is nil, send the image to the printer. -If FILENAME is a string, save the PostScript image in a file with that -name. If FILENAME is a number, prompt the user for the name of the file -to save in." - (interactive (list (ps-print-preprint current-prefix-arg))) - (gnus-summary-select-article) - (gnus-eval-in-buffer-window gnus-article-buffer - (let ((buffer (generate-new-buffer " *print*"))) - (unwind-protect - (progn - (copy-to-buffer buffer (point-min) (point-max)) - (set-buffer buffer) - (gnus-article-delete-invisible-text) - (run-hooks 'gnus-ps-print-hook) - (ps-print-buffer-with-faces filename)) - (kill-buffer buffer))))) - -(defun gnus-summary-show-article (&optional arg) - "Force re-fetching of the current article. -If ARG (the prefix) is non-nil, show the raw article without any -article massaging functions being run." - (interactive "P") - (gnus-set-global-variables) - (if (not arg) - ;; Select the article the normal way. - (gnus-summary-select-article nil 'force) - ;; Bind the article treatment functions to nil. - (let ((gnus-have-all-headers t) - gnus-article-display-hook - gnus-article-prepare-hook - gnus-break-pages - gnus-show-mime - gnus-visual) - (gnus-summary-select-article nil 'force))) - (gnus-summary-goto-subject gnus-current-article) - (gnus-summary-position-point)) - -(defun gnus-summary-verbose-headers (&optional arg) - "Toggle permanent full header display. -If ARG is a positive number, turn header display on. -If ARG is a negative number, turn header display off." - (interactive "P") - (gnus-set-global-variables) - (setq gnus-show-all-headers - (cond ((or (not (numberp arg)) - (zerop arg)) - (not gnus-show-all-headers)) - ((natnump arg) - t))) - (gnus-summary-show-article)) - -(defun gnus-summary-toggle-header (&optional arg) - "Show the headers if they are hidden, or hide them if they are shown. -If ARG is a positive number, show the entire header. -If ARG is a negative number, hide the unwanted header lines." - (interactive "P") - (gnus-set-global-variables) - (save-excursion - (set-buffer gnus-article-buffer) - (let* ((buffer-read-only nil) - (inhibit-point-motion-hooks t) - (hidden (text-property-any - (goto-char (point-min)) (search-forward "\n\n") - 'invisible t)) - e) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (delete-region (point-min) (1- (point)))) - (goto-char (point-min)) - (save-excursion - (set-buffer gnus-original-article-buffer) - (goto-char (point-min)) - (setq e (1- (or (search-forward "\n\n" nil t) (point-max))))) - (insert-buffer-substring gnus-original-article-buffer 1 e) - (let ((article-inhibit-hiding t)) - (run-hooks 'gnus-article-display-hook)) - (when (or (not hidden) (and (numberp arg) (< arg 0))) - (gnus-article-hide-headers))))) - -(defun gnus-summary-show-all-headers () - "Make all header lines visible." - (interactive) - (gnus-set-global-variables) - (gnus-article-show-all-headers)) - -(defun gnus-summary-toggle-mime (&optional arg) - "Toggle MIME processing. -If ARG is a positive number, turn MIME processing on." - (interactive "P") - (gnus-set-global-variables) - (setq gnus-show-mime - (if (null arg) (not gnus-show-mime) - (> (prefix-numeric-value arg) 0))) - (gnus-summary-select-article t 'force)) - -(defun gnus-summary-caesar-message (&optional arg) - "Caesar rotate the current article by 13. -The numerical prefix specifies how many places to rotate each letter -forward." - (interactive "P") - (gnus-set-global-variables) - (gnus-summary-select-article) - (let ((mail-header-separator "")) - (gnus-eval-in-buffer-window gnus-article-buffer - (save-restriction - (widen) - (let ((start (window-start)) - buffer-read-only) - (message-caesar-buffer-body arg) - (set-window-start (get-buffer-window (current-buffer)) start)))))) - -(defun gnus-summary-stop-page-breaking () - "Stop page breaking in the current article." - (interactive) - (gnus-set-global-variables) - (gnus-summary-select-article) - (gnus-eval-in-buffer-window gnus-article-buffer - (widen) - (when (gnus-visual-p 'page-marker) - (let ((buffer-read-only nil)) - (gnus-remove-text-with-property 'gnus-prev) - (gnus-remove-text-with-property 'gnus-next))))) - -(defun gnus-summary-move-article (&optional n to-newsgroup - select-method action) - "Move the current article to a different newsgroup. -If N is a positive number, move the N next articles. -If N is a negative number, move the N previous articles. -If N is nil and any articles have been marked with the process mark, -move those articles instead. -If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. -If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but -re-spool using this method. - -For this function to work, both the current newsgroup and the -newsgroup that you want to move to have to support the `request-move' -and `request-accept' functions." - (interactive "P") - (unless action - (setq action 'move)) - (gnus-set-global-variables) - ;; Disable marking as read. - (let (gnus-mark-article-hook) - (save-window-excursion - (gnus-summary-select-article))) - ;; Check whether the source group supports the required functions. - (cond ((and (eq action 'move) - (not (gnus-check-backend-function - 'request-move-article gnus-newsgroup-name))) - (error "The current group does not support article moving")) - ((and (eq action 'crosspost) - (not (gnus-check-backend-function - 'request-replace-article gnus-newsgroup-name))) - (error "The current group does not support article editing"))) - (let ((articles (gnus-summary-work-articles n)) - (prefix (gnus-group-real-prefix gnus-newsgroup-name)) - (names '((move "Move" "Moving") - (copy "Copy" "Copying") - (crosspost "Crosspost" "Crossposting"))) - (copy-buf (save-excursion - (nnheader-set-temp-buffer " *copy article*"))) - art-group to-method new-xref article to-groups) - (unless (assq action names) - (error "Unknown action %s" action)) - ;; Read the newsgroup name. - (when (and (not to-newsgroup) - (not select-method)) - (setq to-newsgroup - (gnus-read-move-group-name - (cadr (assq action names)) - (symbol-value (intern (format "gnus-current-%s-group" action))) - articles prefix)) - (set (intern (format "gnus-current-%s-group" action)) to-newsgroup)) - (setq to-method (or select-method - (gnus-group-name-to-method to-newsgroup))) - ;; Check the method we are to move this article to... - (unless (gnus-check-backend-function - 'request-accept-article (car to-method)) - (error "%s does not support article copying" (car to-method))) - (unless (gnus-check-server to-method) - (error "Can't open server %s" (car to-method))) - (gnus-message 6 "%s to %s: %s..." - (caddr (assq action names)) - (or (car select-method) to-newsgroup) articles) - (while articles - (setq article (pop articles)) - (setq - art-group - (cond - ;; Move the article. - ((eq action 'move) - ;; Remove this article from future suppression. - (gnus-dup-unsuppress-article article) - (gnus-request-move-article - article ; Article to move - gnus-newsgroup-name ; From newsgroup - (nth 1 (gnus-find-method-for-group - gnus-newsgroup-name)) ; Server - (list 'gnus-request-accept-article - to-newsgroup (list 'quote select-method) - (not articles)) ; Accept form - (not articles))) ; Only save nov last time - ;; Copy the article. - ((eq action 'copy) - (save-excursion - (set-buffer copy-buf) - (gnus-request-article-this-buffer article gnus-newsgroup-name) - (gnus-request-accept-article - to-newsgroup select-method (not articles)))) - ;; Crosspost the article. - ((eq action 'crosspost) - (let ((xref (message-tokenize-header - (mail-header-xref (gnus-summary-article-header article)) - " "))) - (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name) - ":" article)) - (unless xref - (setq xref (list (system-name)))) - (setq new-xref - (concat - (mapconcat 'identity - (delete "Xref:" (delete new-xref xref)) - " ") - " " new-xref)) - (save-excursion - (set-buffer copy-buf) - ;; First put the article in the destination group. - (gnus-request-article-this-buffer article gnus-newsgroup-name) - (when (consp (setq art-group - (gnus-request-accept-article - to-newsgroup select-method (not articles)))) - (setq new-xref (concat new-xref " " (car art-group) - ":" (cdr art-group))) - ;; Now we have the new Xrefs header, so we insert - ;; it and replace the new article. - (nnheader-replace-header "Xref" new-xref) - (gnus-request-replace-article - (cdr art-group) to-newsgroup (current-buffer)) - art-group)))))) - (cond - ((not art-group) - (gnus-message 1 "Couldn't %s article %s" - (cadr (assq action names)) article)) - ((and (eq art-group 'junk) - (eq action 'move)) - (gnus-summary-mark-article article gnus-canceled-mark) - (gnus-message 4 "Deleted article %s" article)) - (t - (let* ((entry - (or - (gnus-gethash (car art-group) gnus-newsrc-hashtb) - (gnus-gethash - (gnus-group-prefixed-name - (car art-group) - (or select-method - (gnus-find-method-for-group to-newsgroup))) - gnus-newsrc-hashtb))) - (info (nth 2 entry)) - (to-group (gnus-info-group info))) - ;; Update the group that has been moved to. - (when (and info - (memq action '(move copy))) - (unless (member to-group to-groups) - (push to-group to-groups)) - - (unless (memq article gnus-newsgroup-unreads) - (gnus-info-set-read - info (gnus-add-to-range (gnus-info-read info) - (list (cdr art-group))))) - - ;; Copy any marks over to the new group. - (let ((marks gnus-article-mark-lists) - (to-article (cdr art-group))) - - ;; See whether the article is to be put in the cache. - (when gnus-use-cache - (gnus-cache-possibly-enter-article - to-group to-article - (let ((header (copy-sequence - (gnus-summary-article-header article)))) - (mail-header-set-number header to-article) - header) - (memq article gnus-newsgroup-marked) - (memq article gnus-newsgroup-dormant) - (memq article gnus-newsgroup-unreads))) - - (when (and (equal to-group gnus-newsgroup-name) - (not (memq article gnus-newsgroup-unreads))) - ;; Mark this article as read in this group. - (push (cons to-article gnus-read-mark) gnus-newsgroup-reads) - (setcdr (gnus-active to-group) to-article) - (setcdr gnus-newsgroup-active to-article)) - - (while marks - (when (memq article (symbol-value - (intern (format "gnus-newsgroup-%s" - (caar marks))))) - ;; If the other group is the same as this group, - ;; then we have to add the mark to the list. - (when (equal to-group gnus-newsgroup-name) - (set (intern (format "gnus-newsgroup-%s" (caar marks))) - (cons to-article - (symbol-value - (intern (format "gnus-newsgroup-%s" - (caar marks))))))) - ;; Copy the marks to other group. - (gnus-add-marked-articles - to-group (cdar marks) (list to-article) info)) - (setq marks (cdr marks))) - - (gnus-dribble-enter - (concat "(gnus-group-set-info '" - (gnus-prin1-to-string (gnus-get-info to-group)) - ")")))) - - ;; Update the Xref header in this article to point to - ;; the new crossposted article we have just created. - (when (eq action 'crosspost) - (save-excursion - (set-buffer copy-buf) - (gnus-request-article-this-buffer article gnus-newsgroup-name) - (nnheader-replace-header "Xref" new-xref) - (gnus-request-replace-article - article gnus-newsgroup-name (current-buffer))))) - - (gnus-summary-goto-subject article) - (when (eq action 'move) - (gnus-summary-mark-article article gnus-canceled-mark)))) - (gnus-summary-remove-process-mark article)) - ;; Re-activate all groups that have been moved to. - (while to-groups - (save-excursion - (set-buffer gnus-group-buffer) - (when (gnus-group-goto-group (car to-groups) t) - (gnus-group-get-new-news-this-group 1 t)) - (pop to-groups))) - - (gnus-kill-buffer copy-buf) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary))) - -(defun gnus-summary-copy-article (&optional n to-newsgroup select-method) - "Move the current article to a different newsgroup. -If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. -If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but -re-spool using this method." - (interactive "P") - (gnus-summary-move-article n to-newsgroup select-method 'copy)) - -(defun gnus-summary-crosspost-article (&optional n) - "Crosspost the current article to some other group." - (interactive "P") - (gnus-summary-move-article n nil nil 'crosspost)) - -(defcustom gnus-summary-respool-default-method nil - "Default method for respooling an article. -If nil, use to the current newsgroup method." - :type 'gnus-select-method-name - :group 'gnus-summary-mail) - -(defun gnus-summary-respool-article (&optional n method) - "Respool the current article. -The article will be squeezed through the mail spooling process again, -which means that it will be put in some mail newsgroup or other -depending on `nnmail-split-methods'. -If N is a positive number, respool the N next articles. -If N is a negative number, respool the N previous articles. -If N is nil and any articles have been marked with the process mark, -respool those articles instead. - -Respooling can be done both from mail groups and \"real\" newsgroups. -In the former case, the articles in question will be moved from the -current group into whatever groups they are destined to. In the -latter case, they will be copied into the relevant groups." - (interactive - (list current-prefix-arg - (let* ((methods (gnus-methods-using 'respool)) - (methname - (symbol-name (or gnus-summary-respool-default-method - (car (gnus-find-method-for-group - gnus-newsgroup-name))))) - (method - (gnus-completing-read - methname "What backend do you want to use when respooling?" - methods nil t nil 'gnus-mail-method-history)) - ms) - (cond - ((zerop (length (setq ms (gnus-servers-using-backend - (intern method))))) - (list (intern method) "")) - ((= 1 (length ms)) - (car ms)) - (t - (let ((ms-alist (mapcar (lambda (m) (cons (cadr m) m)) ms))) - (cdr (assoc (completing-read "Server name: " ms-alist nil t) - ms-alist)))))))) - (gnus-set-global-variables) - (unless method - (error "No method given for respooling")) - (if (assoc (symbol-name - (car (gnus-find-method-for-group gnus-newsgroup-name))) - (gnus-methods-using 'respool)) - (gnus-summary-move-article n nil method) - (gnus-summary-copy-article n nil method))) - -(defun gnus-summary-import-article (file) - "Import a random file into a mail newsgroup." - (interactive "fImport file: ") - (gnus-set-global-variables) - (let ((group gnus-newsgroup-name) - (now (current-time)) - atts lines) - (unless (gnus-check-backend-function 'request-accept-article group) - (error "%s does not support article importing" group)) - (or (file-readable-p file) - (not (file-regular-p file)) - (error "Can't read %s" file)) - (save-excursion - (set-buffer (get-buffer-create " *import file*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert-file-contents file) - (goto-char (point-min)) - (unless (nnheader-article-p) - ;; This doesn't look like an article, so we fudge some headers. - (setq atts (file-attributes file) - lines (count-lines (point-min) (point-max))) - (insert "From: " (read-string "From: ") "\n" - "Subject: " (read-string "Subject: ") "\n" - "Date: " (timezone-make-date-arpa-standard - (current-time-string (nth 5 atts)) - (current-time-zone now) - (current-time-zone now)) - "\n" - "Message-ID: " (message-make-message-id) "\n" - "Lines: " (int-to-string lines) "\n" - "Chars: " (int-to-string (nth 7 atts)) "\n\n")) - (gnus-request-accept-article group nil t) - (kill-buffer (current-buffer))))) - -(defun gnus-summary-article-posted-p () - "Say whether the current (mail) article is available from `gnus-select-method' as well. -This will be the case if the article has both been mailed and posted." - (interactive) - (let ((id (mail-header-references (gnus-summary-article-header))) - (gnus-override-method - (or gnus-refer-article-method gnus-select-method))) - (if (gnus-request-head id "") - (gnus-message 2 "The current message was found on %s" - gnus-override-method) - (gnus-message 2 "The current message couldn't be found on %s" - gnus-override-method) - nil))) - -(defun gnus-summary-expire-articles (&optional now) - "Expire all articles that are marked as expirable in the current group." - (interactive) - (gnus-set-global-variables) - (when (gnus-check-backend-function - 'request-expire-articles gnus-newsgroup-name) - ;; This backend supports expiry. - (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name)) - (expirable (if total - (progn - ;; We need to update the info for - ;; this group for `gnus-list-of-read-articles' - ;; to give us the right answer. - (run-hooks 'gnus-exit-group-hook) - (gnus-summary-update-info) - (gnus-list-of-read-articles gnus-newsgroup-name)) - (setq gnus-newsgroup-expirable - (sort gnus-newsgroup-expirable '<)))) - (expiry-wait (if now 'immediate - (gnus-group-find-parameter - gnus-newsgroup-name 'expiry-wait))) - es) - (when expirable - ;; There are expirable articles in this group, so we run them - ;; through the expiry process. - (gnus-message 6 "Expiring articles...") - ;; The list of articles that weren't expired is returned. - (if expiry-wait - (let ((nnmail-expiry-wait-function nil) - (nnmail-expiry-wait expiry-wait)) - (setq es (gnus-request-expire-articles - expirable gnus-newsgroup-name))) - (setq es (gnus-request-expire-articles - expirable gnus-newsgroup-name))) - (unless total - (setq gnus-newsgroup-expirable es)) - ;; We go through the old list of expirable, and mark all - ;; really expired articles as nonexistent. - (unless (eq es expirable) ;If nothing was expired, we don't mark. - (let ((gnus-use-cache nil)) - (while expirable - (unless (memq (car expirable) es) - (when (gnus-data-find (car expirable)) - (gnus-summary-mark-article - (car expirable) gnus-canceled-mark))) - (setq expirable (cdr expirable))))) - (gnus-message 6 "Expiring articles...done"))))) - -(defun gnus-summary-expire-articles-now () - "Expunge all expirable articles in the current group. -This means that *all* articles that are marked as expirable will be -deleted forever, right now." - (interactive) - (gnus-set-global-variables) - (or gnus-expert-user - (gnus-yes-or-no-p - "Are you really, really, really sure you want to delete all these messages? ") - (error "Phew!")) - (gnus-summary-expire-articles t)) - -;; Suggested by Jack Vinson . -(defun gnus-summary-delete-article (&optional n) - "Delete the N next (mail) articles. -This command actually deletes articles. This is not a marking -command. The article will disappear forever from your life, never to -return. -If N is negative, delete backwards. -If N is nil and articles have been marked with the process mark, -delete these instead." - (interactive "P") - (gnus-set-global-variables) - (unless (gnus-check-backend-function 'request-expire-articles - gnus-newsgroup-name) - (error "The current newsgroup does not support article deletion")) - ;; Compute the list of articles to delete. - (let ((articles (gnus-summary-work-articles n)) - not-deleted) - (if (and gnus-novice-user - (not (gnus-yes-or-no-p - (format "Do you really want to delete %s forever? " - (if (> (length articles) 1) - (format "these %s articles" (length articles)) - "this article"))))) - () - ;; Delete the articles. - (setq not-deleted (gnus-request-expire-articles - articles gnus-newsgroup-name 'force)) - (while articles - (gnus-summary-remove-process-mark (car articles)) - ;; The backend might not have been able to delete the article - ;; after all. - (unless (memq (car articles) not-deleted) - (gnus-summary-mark-article (car articles) gnus-canceled-mark)) - (setq articles (cdr articles))) - (when not-deleted - (gnus-message 4 "Couldn't delete articles %s" not-deleted))) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary) - not-deleted)) - -(defun gnus-summary-edit-article (&optional force) - "Edit the current article. -This will have permanent effect only in mail groups. -If FORCE is non-nil, allow editing of articles even in read-only -groups." - (interactive "P") - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-set-global-variables) - (when (and (not force) - (gnus-group-read-only-p)) - (error "The current newsgroup does not support article editing")) - ;; Select article if needed. - (unless (eq (gnus-summary-article-number) - gnus-current-article) - (gnus-summary-select-article t)) - (gnus-article-edit-article - `(lambda () - (gnus-summary-edit-article-done - ,(or (mail-header-references gnus-current-headers) "") - ,(gnus-group-read-only-p) ,gnus-summary-buffer))))) - -(defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit) - -(defun gnus-summary-edit-article-done (&optional references read-only buffer) - "Make edits to the current article permanent." - (interactive) - ;; Replace the article. - (if (and (not read-only) - (not (gnus-request-replace-article - (cdr gnus-article-current) (car gnus-article-current) - (current-buffer)))) - (error "Couldn't replace article") - ;; Update the summary buffer. - (if (and references - (equal (message-tokenize-header references " ") - (message-tokenize-header - (or (message-fetch-field "references") "") " "))) - ;; We only have to update this line. - (save-excursion - (save-restriction - (message-narrow-to-head) - (let ((head (buffer-string)) - header) - (nnheader-temp-write nil - (insert (format "211 %d Article retrieved.\n" - (cdr gnus-article-current))) - (insert head) - (insert ".\n") - (let ((nntp-server-buffer (current-buffer))) - (setq header (car (gnus-get-newsgroup-headers - (save-excursion - (set-buffer gnus-summary-buffer) - gnus-newsgroup-dependencies) - t)))) - (save-excursion - (set-buffer gnus-summary-buffer) - (gnus-data-set-header - (gnus-data-find (cdr gnus-article-current)) - header) - (gnus-summary-update-article-line - (cdr gnus-article-current) header)))))) - ;; Update threads. - (set-buffer (or buffer gnus-summary-buffer)) - (gnus-summary-update-article (cdr gnus-article-current))) - ;; Prettify the article buffer again. - (save-excursion - (set-buffer gnus-article-buffer) - (run-hooks 'gnus-article-display-hook) - (set-buffer gnus-original-article-buffer) - (gnus-request-article - (cdr gnus-article-current) (car gnus-article-current) (current-buffer))) - ;; Prettify the summary buffer line. - (when (gnus-visual-p 'summary-highlight 'highlight) - (run-hooks 'gnus-visual-mark-article-hook)))) - -(defun gnus-summary-edit-wash (key) - "Perform editing command in the article buffer." - (interactive - (list - (progn - (message "%s" (concat (this-command-keys) "- ")) - (read-char)))) - (message "") - (gnus-summary-edit-article) - (execute-kbd-macro (concat (this-command-keys) key)) - (gnus-article-edit-done)) - -;;; Respooling - -(defun gnus-summary-respool-query (&optional silent) - "Query where the respool algorithm would put this article." - (interactive) - (gnus-set-global-variables) - (let (gnus-mark-article-hook) - (gnus-summary-select-article) - (save-excursion - (set-buffer gnus-original-article-buffer) - (save-restriction - (message-narrow-to-head) - (let ((groups (nnmail-article-group 'identity))) - (unless silent - (if groups - (message "This message would go to %s" - (mapconcat 'car groups ", ")) - (message "This message would go to no groups")) - groups)))))) - -;; Summary marking commands. - -(defun gnus-summary-kill-same-subject-and-select (&optional unmark) - "Mark articles which has the same subject as read, and then select the next. -If UNMARK is positive, remove any kind of mark. -If UNMARK is negative, tick articles." - (interactive "P") - (gnus-set-global-variables) - (when unmark - (setq unmark (prefix-numeric-value unmark))) - (let ((count - (gnus-summary-mark-same-subject - (gnus-summary-article-subject) unmark))) - ;; Select next unread article. If auto-select-same mode, should - ;; select the first unread article. - (gnus-summary-next-article t (and gnus-auto-select-same - (gnus-summary-article-subject))) - (gnus-message 7 "%d article%s marked as %s" - count (if (= count 1) " is" "s are") - (if unmark "unread" "read")))) - -(defun gnus-summary-kill-same-subject (&optional unmark) - "Mark articles which has the same subject as read. -If UNMARK is positive, remove any kind of mark. -If UNMARK is negative, tick articles." - (interactive "P") - (gnus-set-global-variables) - (when unmark - (setq unmark (prefix-numeric-value unmark))) - (let ((count - (gnus-summary-mark-same-subject - (gnus-summary-article-subject) unmark))) - ;; If marked as read, go to next unread subject. - (when (null unmark) - ;; Go to next unread subject. - (gnus-summary-next-subject 1 t)) - (gnus-message 7 "%d articles are marked as %s" - count (if unmark "unread" "read")))) - -(defun gnus-summary-mark-same-subject (subject &optional unmark) - "Mark articles with same SUBJECT as read, and return marked number. -If optional argument UNMARK is positive, remove any kinds of marks. -If optional argument UNMARK is negative, mark articles as unread instead." - (let ((count 1)) - (save-excursion - (cond - ((null unmark) ; Mark as read. - (while (and - (progn - (gnus-summary-mark-article-as-read gnus-killed-mark) - (gnus-summary-show-thread) t) - (gnus-summary-find-subject subject)) - (setq count (1+ count)))) - ((> unmark 0) ; Tick. - (while (and - (progn - (gnus-summary-mark-article-as-unread gnus-ticked-mark) - (gnus-summary-show-thread) t) - (gnus-summary-find-subject subject)) - (setq count (1+ count)))) - (t ; Mark as unread. - (while (and - (progn - (gnus-summary-mark-article-as-unread gnus-unread-mark) - (gnus-summary-show-thread) t) - (gnus-summary-find-subject subject)) - (setq count (1+ count))))) - (gnus-set-mode-line 'summary) - ;; Return the number of marked articles. - count))) - -(defun gnus-summary-mark-as-processable (n &optional unmark) - "Set the process mark on the next N articles. -If N is negative, mark backward instead. If UNMARK is non-nil, remove -the process mark instead. The difference between N and the actual -number of articles marked is returned." - (interactive "p") - (gnus-set-global-variables) - (let ((backward (< n 0)) - (n (abs n))) - (while (and - (> n 0) - (if unmark - (gnus-summary-remove-process-mark - (gnus-summary-article-number)) - (gnus-summary-set-process-mark (gnus-summary-article-number))) - (zerop (gnus-summary-next-subject (if backward -1 1) nil t))) - (setq n (1- n))) - (when (/= 0 n) - (gnus-message 7 "No more articles")) - (gnus-summary-recenter) - (gnus-summary-position-point) - n)) - -(defun gnus-summary-unmark-as-processable (n) - "Remove the process mark from the next N articles. -If N is negative, mark backward instead. The difference between N and -the actual number of articles marked is returned." - (interactive "p") - (gnus-set-global-variables) - (gnus-summary-mark-as-processable n t)) - -(defun gnus-summary-unmark-all-processable () - "Remove the process mark from all articles." - (interactive) - (gnus-set-global-variables) - (save-excursion - (while gnus-newsgroup-processable - (gnus-summary-remove-process-mark (car gnus-newsgroup-processable)))) - (gnus-summary-position-point)) - -(defun gnus-summary-mark-as-expirable (n) - "Mark N articles forward as expirable. -If N is negative, mark backward instead. The difference between N and -the actual number of articles marked is returned." - (interactive "p") - (gnus-set-global-variables) - (gnus-summary-mark-forward n gnus-expirable-mark)) - -(defun gnus-summary-mark-article-as-replied (article) - "Mark ARTICLE replied and update the summary line." - (push article gnus-newsgroup-replied) - (let ((buffer-read-only nil)) - (when (gnus-summary-goto-subject article) - (gnus-summary-update-secondary-mark article)))) - -(defun gnus-summary-set-bookmark (article) - "Set a bookmark in current article." - (interactive (list (gnus-summary-article-number))) - (gnus-set-global-variables) - (when (or (not (get-buffer gnus-article-buffer)) - (not gnus-current-article) - (not gnus-article-current) - (not (equal gnus-newsgroup-name (car gnus-article-current)))) - (error "No current article selected")) - ;; Remove old bookmark, if one exists. - (let ((old (assq article gnus-newsgroup-bookmarks))) - (when old - (setq gnus-newsgroup-bookmarks - (delq old gnus-newsgroup-bookmarks)))) - ;; Set the new bookmark, which is on the form - ;; (article-number . line-number-in-body). - (push - (cons article - (save-excursion - (set-buffer gnus-article-buffer) - (count-lines - (min (point) - (save-excursion - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (point))) - (point)))) - gnus-newsgroup-bookmarks) - (gnus-message 6 "A bookmark has been added to the current article.")) - -(defun gnus-summary-remove-bookmark (article) - "Remove the bookmark from the current article." - (interactive (list (gnus-summary-article-number))) - (gnus-set-global-variables) - ;; Remove old bookmark, if one exists. - (let ((old (assq article gnus-newsgroup-bookmarks))) - (if old - (progn - (setq gnus-newsgroup-bookmarks - (delq old gnus-newsgroup-bookmarks)) - (gnus-message 6 "Removed bookmark.")) - (gnus-message 6 "No bookmark in current article.")))) - -;; Suggested by Daniel Quinlan . -(defun gnus-summary-mark-as-dormant (n) - "Mark N articles forward as dormant. -If N is negative, mark backward instead. The difference between N and -the actual number of articles marked is returned." - (interactive "p") - (gnus-set-global-variables) - (gnus-summary-mark-forward n gnus-dormant-mark)) - -(defun gnus-summary-set-process-mark (article) - "Set the process mark on ARTICLE and update the summary line." - (setq gnus-newsgroup-processable - (cons article - (delq article gnus-newsgroup-processable))) - (when (gnus-summary-goto-subject article) - (gnus-summary-show-thread) - (gnus-summary-update-secondary-mark article))) - -(defun gnus-summary-remove-process-mark (article) - "Remove the process mark from ARTICLE and update the summary line." - (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable)) - (when (gnus-summary-goto-subject article) - (gnus-summary-show-thread) - (gnus-summary-update-secondary-mark article))) - -(defun gnus-summary-set-saved-mark (article) - "Set the process mark on ARTICLE and update the summary line." - (push article gnus-newsgroup-saved) - (when (gnus-summary-goto-subject article) - (gnus-summary-update-secondary-mark article))) - -(defun gnus-summary-mark-forward (n &optional mark no-expire) - "Mark N articles as read forwards. -If N is negative, mark backwards instead. Mark with MARK, ?r by default. -The difference between N and the actual number of articles marked is -returned." - (interactive "p") - (gnus-set-global-variables) - (let ((backward (< n 0)) - (gnus-summary-goto-unread - (and gnus-summary-goto-unread - (not (eq gnus-summary-goto-unread 'never)) - (not (memq mark (list gnus-unread-mark - gnus-ticked-mark gnus-dormant-mark))))) - (n (abs n)) - (mark (or mark gnus-del-mark))) - (while (and (> n 0) - (gnus-summary-mark-article nil mark no-expire) - (zerop (gnus-summary-next-subject - (if backward -1 1) - (and gnus-summary-goto-unread - (not (eq gnus-summary-goto-unread 'never))) - t))) - (setq n (1- n))) - (when (/= 0 n) - (gnus-message 7 "No more %sarticles" (if mark "" "unread "))) - (gnus-summary-recenter) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary) - n)) - -(defun gnus-summary-mark-article-as-read (mark) - "Mark the current article quickly as read with MARK." - (let ((article (gnus-summary-article-number))) - (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) - (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) - (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) - (push (cons article mark) gnus-newsgroup-reads) - ;; Possibly remove from cache, if that is used. - (when gnus-use-cache - (gnus-cache-enter-remove-article article)) - ;; Allow the backend to change the mark. - (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) - ;; Check for auto-expiry. - (when (and gnus-newsgroup-auto-expire - (or (= mark gnus-killed-mark) (= mark gnus-del-mark) - (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) - (= mark gnus-ancient-mark) - (= mark gnus-read-mark) (= mark gnus-souped-mark) - (= mark gnus-duplicate-mark))) - (setq mark gnus-expirable-mark) - (push article gnus-newsgroup-expirable)) - ;; Set the mark in the buffer. - (gnus-summary-update-mark mark 'unread) - t)) - -(defun gnus-summary-mark-article-as-unread (mark) - "Mark the current article quickly as unread with MARK." - (let ((article (gnus-summary-article-number))) - (if (< article 0) - (gnus-error 1 "Unmarkable article") - (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) - (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) - (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) - (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads)) - (cond ((= mark gnus-ticked-mark) - (push article gnus-newsgroup-marked)) - ((= mark gnus-dormant-mark) - (push article gnus-newsgroup-dormant)) - (t - (push article gnus-newsgroup-unreads))) - (setq gnus-newsgroup-reads - (delq (assq article gnus-newsgroup-reads) - gnus-newsgroup-reads)) - - ;; See whether the article is to be put in the cache. - (and gnus-use-cache - (vectorp (gnus-summary-article-header article)) - (save-excursion - (gnus-cache-possibly-enter-article - gnus-newsgroup-name article - (gnus-summary-article-header article) - (= mark gnus-ticked-mark) - (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) - - ;; Fix the mark. - (gnus-summary-update-mark mark 'unread)) - t)) - -(defun gnus-summary-mark-article (&optional article mark no-expire) - "Mark ARTICLE with MARK. MARK can be any character. -Four MARK strings are reserved: `? ' (unread), `?!' (ticked), -`??' (dormant) and `?E' (expirable). -If MARK is nil, then the default character `?D' is used. -If ARTICLE is nil, then the article on the current line will be -marked." - ;; The mark might be a string. - (when (stringp mark) - (setq mark (aref mark 0))) - ;; If no mark is given, then we check auto-expiring. - (and (not no-expire) - gnus-newsgroup-auto-expire - (or (not mark) - (and (gnus-characterp mark) - (or (= mark gnus-killed-mark) (= mark gnus-del-mark) - (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) - (= mark gnus-read-mark) (= mark gnus-souped-mark) - (= mark gnus-duplicate-mark)))) - (setq mark gnus-expirable-mark)) - (let* ((mark (or mark gnus-del-mark)) - (article (or article (gnus-summary-article-number)))) - (unless article - (error "No article on current line")) - (if (or (= mark gnus-unread-mark) - (= mark gnus-ticked-mark) - (= mark gnus-dormant-mark)) - (gnus-mark-article-as-unread article mark) - (gnus-mark-article-as-read article mark)) - - ;; See whether the article is to be put in the cache. - (and gnus-use-cache - (not (= mark gnus-canceled-mark)) - (vectorp (gnus-summary-article-header article)) - (save-excursion - (gnus-cache-possibly-enter-article - gnus-newsgroup-name article - (gnus-summary-article-header article) - (= mark gnus-ticked-mark) - (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) - - (when (gnus-summary-goto-subject article nil t) - (let ((buffer-read-only nil)) - (gnus-summary-show-thread) - ;; Fix the mark. - (gnus-summary-update-mark mark 'unread) - t)))) - -(defun gnus-summary-update-secondary-mark (article) - "Update the secondary (read, process, cache) mark." - (gnus-summary-update-mark - (cond ((memq article gnus-newsgroup-processable) - gnus-process-mark) - ((memq article gnus-newsgroup-cached) - gnus-cached-mark) - ((memq article gnus-newsgroup-replied) - gnus-replied-mark) - ((memq article gnus-newsgroup-saved) - gnus-saved-mark) - (t gnus-unread-mark)) - 'replied) - (when (gnus-visual-p 'summary-highlight 'highlight) - (run-hooks 'gnus-summary-update-hook)) - t) - -(defun gnus-summary-update-mark (mark type) - (let ((forward (cdr (assq type gnus-summary-mark-positions))) - (buffer-read-only nil)) - (re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit) - (when (looking-at "\r") - (incf forward)) - (when (and forward - (<= (+ forward (point)) (point-max))) - ;; Go to the right position on the line. - (goto-char (+ forward (point))) - ;; Replace the old mark with the new mark. - (subst-char-in-region (point) (1+ (point)) (following-char) mark) - ;; Optionally update the marks by some user rule. - (when (eq type 'unread) - (gnus-data-set-mark - (gnus-data-find (gnus-summary-article-number)) mark) - (gnus-summary-update-line (eq mark gnus-unread-mark)))))) - -(defun gnus-mark-article-as-read (article &optional mark) - "Enter ARTICLE in the pertinent lists and remove it from others." - ;; Make the article expirable. - (let ((mark (or mark gnus-del-mark))) - (if (= mark gnus-expirable-mark) - (push article gnus-newsgroup-expirable) - (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))) - ;; Remove from unread and marked lists. - (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) - (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) - (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) - (push (cons article mark) gnus-newsgroup-reads) - ;; Possibly remove from cache, if that is used. - (when gnus-use-cache - (gnus-cache-enter-remove-article article)))) - -(defun gnus-mark-article-as-unread (article &optional mark) - "Enter ARTICLE in the pertinent lists and remove it from others." - (let ((mark (or mark gnus-ticked-mark))) - (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked) - gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant) - gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable) - gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) - - ;; Unsuppress duplicates? - (when gnus-suppress-duplicates - (gnus-dup-unsuppress-article article)) - - (cond ((= mark gnus-ticked-mark) - (push article gnus-newsgroup-marked)) - ((= mark gnus-dormant-mark) - (push article gnus-newsgroup-dormant)) - (t - (push article gnus-newsgroup-unreads))) - (setq gnus-newsgroup-reads - (delq (assq article gnus-newsgroup-reads) - gnus-newsgroup-reads)))) - -(defalias 'gnus-summary-mark-as-unread-forward - 'gnus-summary-tick-article-forward) -(make-obsolete 'gnus-summary-mark-as-unread-forward - 'gnus-summary-tick-article-forward) -(defun gnus-summary-tick-article-forward (n) - "Tick N articles forwards. -If N is negative, tick backwards instead. -The difference between N and the number of articles ticked is returned." - (interactive "p") - (gnus-summary-mark-forward n gnus-ticked-mark)) - -(defalias 'gnus-summary-mark-as-unread-backward - 'gnus-summary-tick-article-backward) -(make-obsolete 'gnus-summary-mark-as-unread-backward - 'gnus-summary-tick-article-backward) -(defun gnus-summary-tick-article-backward (n) - "Tick N articles backwards. -The difference between N and the number of articles ticked is returned." - (interactive "p") - (gnus-summary-mark-forward (- n) gnus-ticked-mark)) - -(defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article) -(make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article) -(defun gnus-summary-tick-article (&optional article clear-mark) - "Mark current article as unread. -Optional 1st argument ARTICLE specifies article number to be marked as unread. -Optional 2nd argument CLEAR-MARK remove any kinds of mark." - (interactive) - (gnus-summary-mark-article article (if clear-mark gnus-unread-mark - gnus-ticked-mark))) - -(defun gnus-summary-mark-as-read-forward (n) - "Mark N articles as read forwards. -If N is negative, mark backwards instead. -The difference between N and the actual number of articles marked is -returned." - (interactive "p") - (gnus-summary-mark-forward n gnus-del-mark t)) - -(defun gnus-summary-mark-as-read-backward (n) - "Mark the N articles as read backwards. -The difference between N and the actual number of articles marked is -returned." - (interactive "p") - (gnus-summary-mark-forward (- n) gnus-del-mark t)) - -(defun gnus-summary-mark-as-read (&optional article mark) - "Mark current article as read. -ARTICLE specifies the article to be marked as read. -MARK specifies a string to be inserted at the beginning of the line." - (gnus-summary-mark-article article mark)) - -(defun gnus-summary-clear-mark-forward (n) - "Clear marks from N articles forward. -If N is negative, clear backward instead. -The difference between N and the number of marks cleared is returned." - (interactive "p") - (gnus-summary-mark-forward n gnus-unread-mark)) - -(defun gnus-summary-clear-mark-backward (n) - "Clear marks from N articles backward. -The difference between N and the number of marks cleared is returned." - (interactive "p") - (gnus-summary-mark-forward (- n) gnus-unread-mark)) - -(defun gnus-summary-mark-unread-as-read () - "Intended to be used by `gnus-summary-mark-article-hook'." - (when (memq gnus-current-article gnus-newsgroup-unreads) - (gnus-summary-mark-article gnus-current-article gnus-read-mark))) - -(defun gnus-summary-mark-read-and-unread-as-read () - "Intended to be used by `gnus-summary-mark-article-hook'." - (let ((mark (gnus-summary-article-mark))) - (when (or (gnus-unread-mark-p mark) - (gnus-read-mark-p mark)) - (gnus-summary-mark-article gnus-current-article gnus-read-mark)))) - -(defun gnus-summary-mark-region-as-read (point mark all) - "Mark all unread articles between point and mark as read. -If given a prefix, mark all articles between point and mark as read, -even ticked and dormant ones." - (interactive "r\nP") - (save-excursion - (let (article) - (goto-char point) - (beginning-of-line) - (while (and - (< (point) mark) - (progn - (when (or all - (memq (setq article (gnus-summary-article-number)) - gnus-newsgroup-unreads)) - (gnus-summary-mark-article article gnus-del-mark)) - t) - (gnus-summary-find-next)))))) - -(defun gnus-summary-mark-below (score mark) - "Mark articles with score less than SCORE with MARK." - (interactive "P\ncMark: ") - (gnus-set-global-variables) - (setq score (if score - (prefix-numeric-value score) - (or gnus-summary-default-score 0))) - (save-excursion - (set-buffer gnus-summary-buffer) - (goto-char (point-min)) - (while - (progn - (and (< (gnus-summary-article-score) score) - (gnus-summary-mark-article nil mark)) - (gnus-summary-find-next))))) - -(defun gnus-summary-kill-below (&optional score) - "Mark articles with score below SCORE as read." - (interactive "P") - (gnus-set-global-variables) - (gnus-summary-mark-below score gnus-killed-mark)) - -(defun gnus-summary-clear-above (&optional score) - "Clear all marks from articles with score above SCORE." - (interactive "P") - (gnus-set-global-variables) - (gnus-summary-mark-above score gnus-unread-mark)) - -(defun gnus-summary-tick-above (&optional score) - "Tick all articles with score above SCORE." - (interactive "P") - (gnus-set-global-variables) - (gnus-summary-mark-above score gnus-ticked-mark)) - -(defun gnus-summary-mark-above (score mark) - "Mark articles with score over SCORE with MARK." - (interactive "P\ncMark: ") - (gnus-set-global-variables) - (setq score (if score - (prefix-numeric-value score) - (or gnus-summary-default-score 0))) - (save-excursion - (set-buffer gnus-summary-buffer) - (goto-char (point-min)) - (while (and (progn - (when (> (gnus-summary-article-score) score) - (gnus-summary-mark-article nil mark)) - t) - (gnus-summary-find-next))))) - -;; Suggested by Daniel Quinlan . -(defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged) -(defun gnus-summary-limit-include-expunged (&optional no-error) - "Display all the hidden articles that were expunged for low scores." - (interactive) - (gnus-set-global-variables) - (let ((buffer-read-only nil)) - (let ((scored gnus-newsgroup-scored) - headers h) - (while scored - (unless (gnus-summary-goto-subject (caar scored)) - (and (setq h (gnus-summary-article-header (caar scored))) - (< (cdar scored) gnus-summary-expunge-below) - (push h headers))) - (setq scored (cdr scored))) - (if (not headers) - (when (not no-error) - (error "No expunged articles hidden")) - (goto-char (point-min)) - (gnus-summary-prepare-unthreaded (nreverse headers)) - (goto-char (point-min)) - (gnus-summary-position-point) - t)))) - -(defun gnus-summary-catchup (&optional all quietly to-here not-mark) - "Mark all unread articles in this newsgroup as read. -If prefix argument ALL is non-nil, ticked and dormant articles will -also be marked as read. -If QUIETLY is non-nil, no questions will be asked. -If TO-HERE is non-nil, it should be a point in the buffer. All -articles before this point will be marked as read. -Note that this function will only catch up the unread article -in the current summary buffer limitation. -The number of articles marked as read is returned." - (interactive "P") - (gnus-set-global-variables) - (prog1 - (save-excursion - (when (or quietly - (not gnus-interactive-catchup) ;Without confirmation? - gnus-expert-user - (gnus-y-or-n-p - (if all - "Mark absolutely all articles as read? " - "Mark all unread articles as read? "))) - (if (and not-mark - (not gnus-newsgroup-adaptive) - (not gnus-newsgroup-auto-expire) - (not gnus-suppress-duplicates)) - (progn - (when all - (setq gnus-newsgroup-marked nil - gnus-newsgroup-dormant nil)) - (setq gnus-newsgroup-unreads nil)) - ;; We actually mark all articles as canceled, which we - ;; have to do when using auto-expiry or adaptive scoring. - (gnus-summary-show-all-threads) - (when (gnus-summary-first-subject (not all)) - (while (and - (if to-here (< (point) to-here) t) - (gnus-summary-mark-article-as-read gnus-catchup-mark) - (gnus-summary-find-next (not all))))) - (gnus-set-mode-line 'summary)) - t)) - (gnus-summary-position-point))) - -(defun gnus-summary-catchup-to-here (&optional all) - "Mark all unticked articles before the current one as read. -If ALL is non-nil, also mark ticked and dormant articles as read." - (interactive "P") - (gnus-set-global-variables) - (save-excursion - (gnus-save-hidden-threads - (let ((beg (point))) - ;; We check that there are unread articles. - (when (or all (gnus-summary-find-prev)) - (gnus-summary-catchup all t beg))))) - (gnus-summary-position-point)) - -(defun gnus-summary-catchup-all (&optional quietly) - "Mark all articles in this newsgroup as read." - (interactive "P") - (gnus-set-global-variables) - (gnus-summary-catchup t quietly)) - -(defun gnus-summary-catchup-and-exit (&optional all quietly) - "Mark all articles not marked as unread in this newsgroup as read, then exit. -If prefix argument ALL is non-nil, all articles are marked as read." - (interactive "P") - (gnus-set-global-variables) - (when (gnus-summary-catchup all quietly nil 'fast) - ;; Select next newsgroup or exit. - (if (eq gnus-auto-select-next 'quietly) - (gnus-summary-next-group nil) - (gnus-summary-exit)))) - -(defun gnus-summary-catchup-all-and-exit (&optional quietly) - "Mark all articles in this newsgroup as read, and then exit." - (interactive "P") - (gnus-set-global-variables) - (gnus-summary-catchup-and-exit t quietly)) - -;; Suggested by "Arne Eofsson" . -(defun gnus-summary-catchup-and-goto-next-group (&optional all) - "Mark all articles in this group as read and select the next group. -If given a prefix, mark all articles, unread as well as ticked, as -read." - (interactive "P") - (gnus-set-global-variables) - (save-excursion - (gnus-summary-catchup all)) - (gnus-summary-next-article t nil nil t)) - -;; Thread-based commands. - -(defun gnus-summary-articles-in-thread (&optional article) - "Return a list of all articles in the current thread. -If ARTICLE is non-nil, return all articles in the thread that starts -with that article." - (let* ((article (or article (gnus-summary-article-number))) - (data (gnus-data-find-list article)) - (top-level (gnus-data-level (car data))) - (top-subject - (cond ((null gnus-thread-operation-ignore-subject) - (gnus-simplify-subject-re - (mail-header-subject (gnus-data-header (car data))))) - ((eq gnus-thread-operation-ignore-subject 'fuzzy) - (gnus-simplify-subject-fuzzy - (mail-header-subject (gnus-data-header (car data))))) - (t nil))) - (end-point (save-excursion - (if (gnus-summary-go-to-next-thread) - (point) (point-max)))) - articles) - (while (and data - (< (gnus-data-pos (car data)) end-point)) - (when (or (not top-subject) - (string= top-subject - (if (eq gnus-thread-operation-ignore-subject 'fuzzy) - (gnus-simplify-subject-fuzzy - (mail-header-subject - (gnus-data-header (car data)))) - (gnus-simplify-subject-re - (mail-header-subject - (gnus-data-header (car data))))))) - (push (gnus-data-number (car data)) articles)) - (unless (and (setq data (cdr data)) - (> (gnus-data-level (car data)) top-level)) - (setq data nil))) - ;; Return the list of articles. - (nreverse articles))) - -(defun gnus-summary-rethread-current () - "Rethread the thread the current article is part of." - (interactive) - (gnus-set-global-variables) - (let* ((gnus-show-threads t) - (article (gnus-summary-article-number)) - (id (mail-header-id (gnus-summary-article-header))) - (gnus-newsgroup-threads (list (gnus-id-to-thread (gnus-root-id id))))) - (unless id - (error "No article on the current line")) - (gnus-rebuild-thread id) - (gnus-summary-goto-subject article))) - -(defun gnus-summary-reparent-thread () - "Make the current article child of the marked (or previous) article. - -Note that the re-threading will only work if `gnus-thread-ignore-subject' -is non-nil or the Subject: of both articles are the same." - (interactive) - (unless (not (gnus-group-read-only-p)) - (error "The current newsgroup does not support article editing")) - (unless (<= (length gnus-newsgroup-processable) 1) - (error "No more than one article may be marked")) - (save-window-excursion - (let ((gnus-article-buffer " *reparent*") - (current-article (gnus-summary-article-number)) - ;; First grab the marked article, otherwise one line up. - (parent-article (if (not (null gnus-newsgroup-processable)) - (car gnus-newsgroup-processable) - (save-excursion - (if (eq (forward-line -1) 0) - (gnus-summary-article-number) - (error "Beginning of summary buffer")))))) - (unless (not (eq current-article parent-article)) - (error "An article may not be self-referential")) - (let ((message-id (mail-header-id - (gnus-summary-article-header parent-article)))) - (unless (and message-id (not (equal message-id ""))) - (error "No message-id in desired parent")) - (gnus-summary-select-article t t nil current-article) - (set-buffer gnus-original-article-buffer) - (let ((buf (format "%s" (buffer-string)))) - (nnheader-temp-write nil - (insert buf) - (goto-char (point-min)) - (if (search-forward-regexp "^References: " nil t) - (insert message-id " " ) - (insert "References: " message-id "\n")) - (unless (gnus-request-replace-article - current-article (car gnus-article-current) - (current-buffer)) - (error "Couldn't replace article")))) - (set-buffer gnus-summary-buffer) - (gnus-summary-unmark-all-processable) - (gnus-summary-rethread-current) - (gnus-message 3 "Article %d is now the child of article %d" - current-article parent-article))))) - -(defun gnus-summary-toggle-threads (&optional arg) - "Toggle showing conversation threads. -If ARG is positive number, turn showing conversation threads on." - (interactive "P") - (gnus-set-global-variables) - (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end))) - (setq gnus-show-threads - (if (null arg) (not gnus-show-threads) - (> (prefix-numeric-value arg) 0))) - (gnus-summary-prepare) - (gnus-summary-goto-subject current) - (gnus-message 6 "Threading is now %s" (if gnus-show-threads "on" "off")) - (gnus-summary-position-point))) - -(defun gnus-summary-show-all-threads () - "Show all threads." - (interactive) - (gnus-set-global-variables) - (save-excursion - (let ((buffer-read-only nil)) - (subst-char-in-region (point-min) (point-max) ?\^M ?\n t))) - (gnus-summary-position-point)) - -(defun gnus-summary-show-thread () - "Show thread subtrees. -Returns nil if no thread was there to be shown." - (interactive) - (gnus-set-global-variables) - (let ((buffer-read-only nil) - (orig (point)) - ;; first goto end then to beg, to have point at beg after let - (end (progn (end-of-line) (point))) - (beg (progn (beginning-of-line) (point)))) - (prog1 - ;; Any hidden lines here? - (search-forward "\r" end t) - (subst-char-in-region beg end ?\^M ?\n t) - (goto-char orig) - (gnus-summary-position-point)))) - -(defun gnus-summary-hide-all-threads () - "Hide all thread subtrees." - (interactive) - (gnus-set-global-variables) - (save-excursion - (goto-char (point-min)) - (gnus-summary-hide-thread) - (while (zerop (gnus-summary-next-thread 1 t)) - (gnus-summary-hide-thread))) - (gnus-summary-position-point)) - -(defun gnus-summary-hide-thread () - "Hide thread subtrees. -Returns nil if no threads were there to be hidden." - (interactive) - (gnus-set-global-variables) - (let ((buffer-read-only nil) - (start (point)) - (article (gnus-summary-article-number))) - (goto-char start) - ;; Go forward until either the buffer ends or the subthread - ;; ends. - (when (and (not (eobp)) - (or (zerop (gnus-summary-next-thread 1 t)) - (goto-char (point-max)))) - (prog1 - (if (and (> (point) start) - (search-backward "\n" start t)) - (progn - (subst-char-in-region start (point) ?\n ?\^M) - (gnus-summary-goto-subject article)) - (goto-char start) - nil) - ;;(gnus-summary-position-point) - )))) - -(defun gnus-summary-go-to-next-thread (&optional previous) - "Go to the same level (or less) next thread. -If PREVIOUS is non-nil, go to previous thread instead. -Return the article number moved to, or nil if moving was impossible." - (let ((level (gnus-summary-thread-level)) - (way (if previous -1 1)) - (beg (point))) - (forward-line way) - (while (and (not (eobp)) - (< level (gnus-summary-thread-level))) - (forward-line way)) - (if (eobp) - (progn - (goto-char beg) - nil) - (setq beg (point)) - (prog1 - (gnus-summary-article-number) - (goto-char beg))))) - -(defun gnus-summary-next-thread (n &optional silent) - "Go to the same level next N'th thread. -If N is negative, search backward instead. -Returns the difference between N and the number of skips actually -done. - -If SILENT, don't output messages." - (interactive "p") - (gnus-set-global-variables) - (let ((backward (< n 0)) - (n (abs n))) - (while (and (> n 0) - (gnus-summary-go-to-next-thread backward)) - (decf n)) - (unless silent - (gnus-summary-position-point)) - (when (and (not silent) (/= 0 n)) - (gnus-message 7 "No more threads")) - n)) - -(defun gnus-summary-prev-thread (n) - "Go to the same level previous N'th thread. -Returns the difference between N and the number of skips actually -done." - (interactive "p") - (gnus-set-global-variables) - (gnus-summary-next-thread (- n))) - -(defun gnus-summary-go-down-thread () - "Go down one level in the current thread." - (let ((children (gnus-summary-article-children))) - (when children - (gnus-summary-goto-subject (car children))))) - -(defun gnus-summary-go-up-thread () - "Go up one level in the current thread." - (let ((parent (gnus-summary-article-parent))) - (when parent - (gnus-summary-goto-subject parent)))) - -(defun gnus-summary-down-thread (n) - "Go down thread N steps. -If N is negative, go up instead. -Returns the difference between N and how many steps down that were -taken." - (interactive "p") - (gnus-set-global-variables) - (let ((up (< n 0)) - (n (abs n))) - (while (and (> n 0) - (if up (gnus-summary-go-up-thread) - (gnus-summary-go-down-thread))) - (setq n (1- n))) - (gnus-summary-position-point) - (when (/= 0 n) - (gnus-message 7 "Can't go further")) - n)) - -(defun gnus-summary-up-thread (n) - "Go up thread N steps. -If N is negative, go up instead. -Returns the difference between N and how many steps down that were -taken." - (interactive "p") - (gnus-set-global-variables) - (gnus-summary-down-thread (- n))) - -(defun gnus-summary-top-thread () - "Go to the top of the thread." - (interactive) - (gnus-set-global-variables) - (while (gnus-summary-go-up-thread)) - (gnus-summary-article-number)) - -(defun gnus-summary-kill-thread (&optional unmark) - "Mark articles under current thread as read. -If the prefix argument is positive, remove any kinds of marks. -If the prefix argument is negative, tick articles instead." - (interactive "P") - (gnus-set-global-variables) - (when unmark - (setq unmark (prefix-numeric-value unmark))) - (let ((articles (gnus-summary-articles-in-thread))) - (save-excursion - ;; Expand the thread. - (gnus-summary-show-thread) - ;; Mark all the articles. - (while articles - (gnus-summary-goto-subject (car articles)) - (cond ((null unmark) - (gnus-summary-mark-article-as-read gnus-killed-mark)) - ((> unmark 0) - (gnus-summary-mark-article-as-unread gnus-unread-mark)) - (t - (gnus-summary-mark-article-as-unread gnus-ticked-mark))) - (setq articles (cdr articles)))) - ;; Hide killed subtrees. - (and (null unmark) - gnus-thread-hide-killed - (gnus-summary-hide-thread)) - ;; If marked as read, go to next unread subject. - (when (null unmark) - ;; Go to next unread subject. - (gnus-summary-next-subject 1 t))) - (gnus-set-mode-line 'summary)) - -;; Summary sorting commands - -(defun gnus-summary-sort-by-number (&optional reverse) - "Sort the summary buffer by article number. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'number reverse)) - -(defun gnus-summary-sort-by-author (&optional reverse) - "Sort the summary buffer by author name alphabetically. -If case-fold-search is non-nil, case of letters is ignored. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'author reverse)) - -(defun gnus-summary-sort-by-subject (&optional reverse) - "Sort the summary buffer by subject alphabetically. `Re:'s are ignored. -If case-fold-search is non-nil, case of letters is ignored. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'subject reverse)) - -(defun gnus-summary-sort-by-date (&optional reverse) - "Sort the summary buffer by date. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'date reverse)) - -(defun gnus-summary-sort-by-score (&optional reverse) - "Sort the summary buffer by score. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'score reverse)) - -(defun gnus-summary-sort-by-lines (&optional reverse) - "Sort the summary buffer by article length. -Argument REVERSE means reverse order." - (interactive "P") - (gnus-summary-sort 'lines reverse)) - -(defun gnus-summary-sort (predicate reverse) - "Sort summary buffer by PREDICATE. REVERSE means reverse order." - (gnus-set-global-variables) - (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate))) - (article (intern (format "gnus-article-sort-by-%s" predicate))) - (gnus-thread-sort-functions - (list - (if (not reverse) - thread - `(lambda (t1 t2) - (,thread t2 t1))))) - (gnus-article-sort-functions - (list - (if (not reverse) - article - `(lambda (t1 t2) - (,article t2 t1))))) - (buffer-read-only) - (gnus-summary-prepare-hook nil)) - ;; We do the sorting by regenerating the threads. - (gnus-summary-prepare) - ;; Hide subthreads if needed. - (when (and gnus-show-threads gnus-thread-hide-subtree) - (gnus-summary-hide-all-threads)))) - -;; Summary saving commands. - -(defun gnus-summary-save-article (&optional n not-saved) - "Save the current article using the default saver function. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead. -The variable `gnus-default-article-saver' specifies the saver function." - (interactive "P") - (gnus-set-global-variables) - (let* ((articles (gnus-summary-work-articles n)) - (save-buffer (save-excursion - (nnheader-set-temp-buffer " *Gnus Save*"))) - (num (length articles)) - header article file) - (while articles - (setq header (gnus-summary-article-header - (setq article (pop articles)))) - (if (not (vectorp header)) - ;; This is a pseudo-article. - (if (assq 'name header) - (gnus-copy-file (cdr (assq 'name header))) - (gnus-message 1 "Article %d is unsaveable" article)) - ;; This is a real article. - (save-window-excursion - (gnus-summary-select-article t nil nil article)) - (save-excursion - (set-buffer save-buffer) - (erase-buffer) - (insert-buffer-substring gnus-original-article-buffer)) - (setq file (gnus-article-save save-buffer file num)) - (gnus-summary-remove-process-mark article) - (unless not-saved - (gnus-summary-set-saved-mark article)))) - (gnus-kill-buffer save-buffer) - (gnus-summary-position-point) - (gnus-set-mode-line 'summary) - n)) - -(defun gnus-summary-pipe-output (&optional arg) - "Pipe the current article to a subprocess. -If N is a positive number, pipe the N next articles. -If N is a negative number, pipe the N previous articles. -If N is nil and any articles have been marked with the process mark, -pipe those articles instead." - (interactive "P") - (gnus-set-global-variables) - (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe)) - (gnus-summary-save-article arg t)) - (gnus-configure-windows 'pipe)) - -(defun gnus-summary-save-article-mail (&optional arg) - "Append the current article to an mail file. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead." - (interactive "P") - (gnus-set-global-variables) - (let ((gnus-default-article-saver 'gnus-summary-save-in-mail)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-save-article-rmail (&optional arg) - "Append the current article to an rmail file. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead." - (interactive "P") - (gnus-set-global-variables) - (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-save-article-file (&optional arg) - "Append the current article to a file. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead." - (interactive "P") - (gnus-set-global-variables) - (let ((gnus-default-article-saver 'gnus-summary-save-in-file)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-write-article-file (&optional arg) - "Write the current article to a file, deleting the previous file. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead." - (interactive "P") - (gnus-set-global-variables) - (let ((gnus-default-article-saver 'gnus-summary-write-to-file)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-save-article-body-file (&optional arg) - "Append the current article body to a file. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead." - (interactive "P") - (gnus-set-global-variables) - (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-pipe-message (program) - "Pipe the current article through PROGRAM." - (interactive "sProgram: ") - (gnus-set-global-variables) - (gnus-summary-select-article) - (let ((mail-header-separator "") - (art-buf (get-buffer gnus-article-buffer))) - (gnus-eval-in-buffer-window gnus-article-buffer - (save-restriction - (widen) - (let ((start (window-start)) - buffer-read-only) - (message-pipe-buffer-body program) - (set-window-start (get-buffer-window (current-buffer)) start)))))) - -(defun gnus-get-split-value (methods) - "Return a value based on the split METHODS." - (let (split-name method result match) - (when methods - (save-excursion - (set-buffer gnus-original-article-buffer) - (save-restriction - (nnheader-narrow-to-headers) - (while methods - (goto-char (point-min)) - (setq method (pop methods)) - (setq match (car method)) - (when (cond - ((stringp match) - ;; Regular expression. - (ignore-errors - (re-search-forward match nil t))) - ((gnus-functionp match) - ;; Function. - (save-restriction - (widen) - (setq result (funcall match gnus-newsgroup-name)))) - ((consp match) - ;; Form. - (save-restriction - (widen) - (setq result (eval match))))) - (setq split-name (append (cdr method) split-name)) - (cond ((stringp result) - (push (expand-file-name - result gnus-article-save-directory) - split-name)) - ((consp result) - (setq split-name (append result split-name))))))))) - split-name)) - -(defun gnus-valid-move-group-p (group) - (and (boundp group) - (symbol-name group) - (memq 'respool - (assoc (symbol-name - (car (gnus-find-method-for-group - (symbol-name group)))) - gnus-valid-select-methods)))) - -(defun gnus-read-move-group-name (prompt default articles prefix) - "Read a group name." - (let* ((split-name (gnus-get-split-value gnus-move-split-methods)) - (minibuffer-confirm-incomplete nil) ; XEmacs - (prom - (format "%s %s to:" - prompt - (if (> (length articles) 1) - (format "these %d articles" (length articles)) - "this article"))) - (to-newsgroup - (cond - ((null split-name) - (gnus-completing-read default prom - gnus-active-hashtb - 'gnus-valid-move-group-p - nil prefix - 'gnus-group-history)) - ((= 1 (length split-name)) - (gnus-completing-read (car split-name) prom - gnus-active-hashtb - 'gnus-valid-move-group-p - nil nil - 'gnus-group-history)) - (t - (gnus-completing-read nil prom - (mapcar (lambda (el) (list el)) - (nreverse split-name)) - nil nil nil - 'gnus-group-history))))) - (when to-newsgroup - (if (or (string= to-newsgroup "") - (string= to-newsgroup prefix)) - (setq to-newsgroup default)) - (unless to-newsgroup - (error "No group name entered")) - (or (gnus-active to-newsgroup) - (gnus-activate-group to-newsgroup) - (if (gnus-y-or-n-p (format "No such group: %s. Create it? " - to-newsgroup)) - (or (and (gnus-request-create-group - to-newsgroup (gnus-group-name-to-method to-newsgroup)) - (gnus-activate-group to-newsgroup nil nil - (gnus-group-name-to-method - to-newsgroup))) - (error "Couldn't create group %s" to-newsgroup))) - (error "No such group: %s" to-newsgroup))) - to-newsgroup)) - -;; Summary extract commands - -(defun gnus-summary-insert-pseudos (pslist &optional not-view) - (let ((buffer-read-only nil) - (article (gnus-summary-article-number)) - after-article b e) - (unless (gnus-summary-goto-subject article) - (error "No such article: %d" article)) - (gnus-summary-position-point) - ;; If all commands are to be bunched up on one line, we collect - ;; them here. - (unless gnus-view-pseudos-separately - (let ((ps (setq pslist (sort pslist 'gnus-pseudos<))) - files action) - (while ps - (setq action (cdr (assq 'action (car ps)))) - (setq files (list (cdr (assq 'name (car ps))))) - (while (and ps (cdr ps) - (string= (or action "1") - (or (cdr (assq 'action (cadr ps))) "2"))) - (push (cdr (assq 'name (cadr ps))) files) - (setcdr ps (cddr ps))) - (when files - (when (not (string-match "%s" action)) - (push " " files)) - (push " " files) - (when (assq 'execute (car ps)) - (setcdr (assq 'execute (car ps)) - (funcall (if (string-match "%s" action) - 'format 'concat) - action - (mapconcat - (lambda (f) - (if (equal f " ") - f - (gnus-quote-arg-for-sh-or-csh f))) - files " "))))) - (setq ps (cdr ps))))) - (if (and gnus-view-pseudos (not not-view)) - (while pslist - (when (assq 'execute (car pslist)) - (gnus-execute-command (cdr (assq 'execute (car pslist))) - (eq gnus-view-pseudos 'not-confirm))) - (setq pslist (cdr pslist))) - (save-excursion - (while pslist - (setq after-article (or (cdr (assq 'article (car pslist))) - (gnus-summary-article-number))) - (gnus-summary-goto-subject after-article) - (forward-line 1) - (setq b (point)) - (insert " " (file-name-nondirectory - (cdr (assq 'name (car pslist)))) - ": " (or (cdr (assq 'execute (car pslist))) "") "\n") - (setq e (point)) - (forward-line -1) ; back to `b' - (gnus-add-text-properties - b (1- e) (list 'gnus-number gnus-reffed-article-number - gnus-mouse-face-prop gnus-mouse-face)) - (gnus-data-enter - after-article gnus-reffed-article-number - gnus-unread-mark b (car pslist) 0 (- e b)) - (push gnus-reffed-article-number gnus-newsgroup-unreads) - (setq gnus-reffed-article-number (1- gnus-reffed-article-number)) - (setq pslist (cdr pslist))))))) - -(defun gnus-pseudos< (p1 p2) - (let ((c1 (cdr (assq 'action p1))) - (c2 (cdr (assq 'action p2)))) - (and c1 c2 (string< c1 c2)))) - -(defun gnus-request-pseudo-article (props) - (cond ((assq 'execute props) - (gnus-execute-command (cdr (assq 'execute props))))) - (let ((gnus-current-article (gnus-summary-article-number))) - (run-hooks 'gnus-mark-article-hook))) - -(defun gnus-execute-command (command &optional automatic) - (save-excursion - (gnus-article-setup-buffer) - (set-buffer gnus-article-buffer) - (setq buffer-read-only nil) - (let ((command (if automatic command - (read-string "Command: " (cons command 0))))) - (erase-buffer) - (insert "$ " command "\n\n") - (if gnus-view-pseudo-asynchronously - (start-process "gnus-execute" (current-buffer) shell-file-name - shell-command-switch command) - (call-process shell-file-name nil t nil - shell-command-switch command))))) - -;; Summary kill commands. - -(defun gnus-summary-edit-global-kill (article) - "Edit the \"global\" kill file." - (interactive (list (gnus-summary-article-number))) - (gnus-set-global-variables) - (gnus-group-edit-global-kill article)) - -(defun gnus-summary-edit-local-kill () - "Edit a local kill file applied to the current newsgroup." - (interactive) - (gnus-set-global-variables) - (setq gnus-current-headers (gnus-summary-article-header)) - (gnus-set-global-variables) - (gnus-group-edit-local-kill - (gnus-summary-article-number) gnus-newsgroup-name)) - -;;; Header reading. - -(defun gnus-read-header (id &optional header) - "Read the headers of article ID and enter them into the Gnus system." - (let ((group gnus-newsgroup-name) - (gnus-override-method - (and (gnus-news-group-p gnus-newsgroup-name) - gnus-refer-article-method)) - where) - ;; First we check to see whether the header in question is already - ;; fetched. - (if (stringp id) - ;; This is a Message-ID. - (setq header (or header (gnus-id-to-header id))) - ;; This is an article number. - (setq header (or header (gnus-summary-article-header id)))) - (if (and header - (not (gnus-summary-article-sparse-p (mail-header-number header)))) - ;; We have found the header. - header - ;; We have to really fetch the header to this article. - (save-excursion - (set-buffer nntp-server-buffer) - (when (setq where (gnus-request-head id group)) - (nnheader-fold-continuation-lines) - (goto-char (point-max)) - (insert ".\n") - (goto-char (point-min)) - (insert "211 ") - (princ (cond - ((numberp id) id) - ((cdr where) (cdr where)) - (header (mail-header-number header)) - (t gnus-reffed-article-number)) - (current-buffer)) - (insert " Article retrieved.\n")) - (if (or (not where) - (not (setq header (car (gnus-get-newsgroup-headers nil t))))) - () ; Malformed head. - (unless (gnus-summary-article-sparse-p (mail-header-number header)) - (when (and (stringp id) - (not (string= (gnus-group-real-name group) - (car where)))) - ;; If we fetched by Message-ID and the article came - ;; from a different group, we fudge some bogus article - ;; numbers for this article. - (mail-header-set-number header gnus-reffed-article-number)) - (save-excursion - (set-buffer gnus-summary-buffer) - (decf gnus-reffed-article-number) - (gnus-remove-header (mail-header-number header)) - (push header gnus-newsgroup-headers) - (setq gnus-current-headers header) - (push (mail-header-number header) gnus-newsgroup-limit))) - header))))) - -(defun gnus-remove-header (number) - "Remove header NUMBER from `gnus-newsgroup-headers'." - (if (and gnus-newsgroup-headers - (= number (mail-header-number (car gnus-newsgroup-headers)))) - (pop gnus-newsgroup-headers) - (let ((headers gnus-newsgroup-headers)) - (while (and (cdr headers) - (not (= number (mail-header-number (cadr headers))))) - (pop headers)) - (when (cdr headers) - (setcdr headers (cddr headers)))))) - -;;; -;;; summary highlights -;;; - -(defun gnus-highlight-selected-summary () - ;; Added by Per Abrahamsen . - ;; Highlight selected article in summary buffer - (when gnus-summary-selected-face - (save-excursion - (let* ((beg (progn (beginning-of-line) (point))) - (end (progn (end-of-line) (point))) - ;; Fix by Mike Dugan . - (from (if (get-text-property beg gnus-mouse-face-prop) - beg - (or (next-single-property-change - beg gnus-mouse-face-prop nil end) - beg))) - (to - (if (= from end) - (- from 2) - (or (next-single-property-change - from gnus-mouse-face-prop nil end) - end)))) - ;; If no mouse-face prop on line we will have to = from = end, - ;; so we highlight the entire line instead. - (when (= (+ to 2) from) - (setq from beg) - (setq to end)) - (if gnus-newsgroup-selected-overlay - ;; Move old overlay. - (gnus-move-overlay - gnus-newsgroup-selected-overlay from to (current-buffer)) - ;; Create new overlay. - (gnus-overlay-put - (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to)) - 'face gnus-summary-selected-face)))))) - -;; New implementation by Christian Limpach . -(defun gnus-summary-highlight-line () - "Highlight current line according to `gnus-summary-highlight'." - (let* ((list gnus-summary-highlight) - (p (point)) - (end (progn (end-of-line) (point))) - ;; now find out where the line starts and leave point there. - (beg (progn (beginning-of-line) (point))) - (article (gnus-summary-article-number)) - (score (or (cdr (assq (or article gnus-current-article) - gnus-newsgroup-scored)) - gnus-summary-default-score 0)) - (mark (or (gnus-summary-article-mark) gnus-unread-mark)) - (inhibit-read-only t)) - ;; Eval the cars of the lists until we find a match. - (let ((default gnus-summary-default-score)) - (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 - beg end 'face - (setq face (if (boundp face) (symbol-value face) face))) - (when gnus-summary-highlight-line-function - (funcall gnus-summary-highlight-line-function article face)))) - (goto-char p))) - -(defun gnus-update-read-articles (group unread) - "Update the list of read articles in GROUP." - (let* ((active (or gnus-newsgroup-active (gnus-active group))) - (entry (gnus-gethash group gnus-newsrc-hashtb)) - (info (nth 2 entry)) - (prev 1) - (unread (sort (copy-sequence unread) '<)) - read) - (if (or (not info) (not active)) - ;; There is no info on this group if it was, in fact, - ;; killed. Gnus stores no information on killed groups, so - ;; there's nothing to be done. - ;; One could store the information somewhere temporarily, - ;; perhaps... Hmmm... - () - ;; Remove any negative articles numbers. - (while (and unread (< (car unread) 0)) - (setq unread (cdr unread))) - ;; Remove any expired article numbers - (while (and unread (< (car unread) (car active))) - (setq unread (cdr unread))) - ;; Compute the ranges of read articles by looking at the list of - ;; unread articles. - (while unread - (when (/= (car unread) prev) - (push (if (= prev (1- (car unread))) prev - (cons prev (1- (car unread)))) - read)) - (setq prev (1+ (car unread))) - (setq unread (cdr unread))) - (when (<= prev (cdr active)) - (push (cons prev (cdr active)) read)) - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-undo-register - `(progn - (gnus-info-set-marks ',info ',(gnus-info-marks info) t) - (gnus-info-set-read ',info ',(gnus-info-read info)) - (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) - (gnus-group-update-group ,group t)))) - ;; Enter this list into the group info. - (gnus-info-set-read - info (if (> (length read) 1) (nreverse read) read)) - ;; Set the number of unread articles in gnus-newsrc-hashtb. - (gnus-get-unread-articles-in-group info (gnus-active group)) - t))) - -(defun gnus-offer-save-summaries () - "Offer to save all active summary buffers." - (save-excursion - (let ((buflist (buffer-list)) - buffers bufname) - ;; Go through all buffers and find all summaries. - (while buflist - (and (setq bufname (buffer-name (car buflist))) - (string-match "Summary" bufname) - (save-excursion - (set-buffer bufname) - ;; We check that this is, indeed, a summary buffer. - (and (eq major-mode 'gnus-summary-mode) - ;; Also make sure this isn't bogus. - gnus-newsgroup-prepared - ;; Also make sure that this isn't a dead summary buffer. - (not gnus-dead-summary-mode))) - (push bufname buffers)) - (setq buflist (cdr buflist))) - ;; Go through all these summary buffers and offer to save them. - (when buffers - (map-y-or-n-p - "Update summary buffer %s? " - (lambda (buf) (switch-to-buffer buf) (gnus-summary-exit)) - buffers))))) - -(gnus-ems-redefine) - -(provide 'gnus-sum) - -(run-hooks 'gnus-sum-load-hook) - -;;; gnus-sum.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-topic.el --- a/lisp/gnus/gnus-topic.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1404 +0,0 @@ -;;; gnus-topic.el --- a folding minor mode for Gnus group buffers -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Ilja Weis -;; Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-group) -(require 'gnus-start) - -(defgroup gnus-topic nil - "Group topics." - :group 'gnus-group) - -(defvar gnus-topic-mode nil - "Minor mode for Gnus group buffers.") - -(defcustom gnus-topic-mode-hook nil - "Hook run in topic mode buffers." - :type 'hook - :group 'gnus-topic) - -(defcustom gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n" - "Format of topic lines. -It works along the same lines as a normal formatting string, -with some simple extensions. - -%i Indentation based on topic level. -%n Topic name. -%v Nothing if the topic is visible, \"...\" otherwise. -%g Number of groups in the topic. -%a Number of unread articles in the groups in the topic. -%A Number of unread articles in the groups in the topic and its subtopics. -" - :type 'string - :group 'gnus-topic) - -(defcustom gnus-topic-indent-level 2 - "*How much each subtopic should be indented." - :type 'integer - :group 'gnus-topic) - -(defcustom gnus-topic-display-empty-topics t - "*If non-nil, display the topic lines even of topics that have no unread articles." - :type 'boolean - :group 'gnus-topic) - -;; Internal variables. - -(defvar gnus-topic-active-topology nil) -(defvar gnus-topic-active-alist nil) - -(defvar gnus-topology-checked-p nil - "Whether the topology has been checked in this session.") - -(defvar gnus-topic-killed-topics nil) -(defvar gnus-topic-inhibit-change-level nil) - -(defconst gnus-topic-line-format-alist - `((?n name ?s) - (?v visible ?s) - (?i indentation ?s) - (?g number-of-groups ?d) - (?a (gnus-topic-articles-in-topic entries) ?d) - (?A total-number-of-articles ?d) - (?l level ?d))) - -(defvar gnus-topic-line-format-spec nil) - -;;; Utility functions - -(defun gnus-group-topic-name () - "The name of the topic on the current line." - (let ((topic (get-text-property (gnus-point-at-bol) 'gnus-topic))) - (and topic (symbol-name topic)))) - -(defun gnus-group-topic-level () - "The level of the topic on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-topic-level)) - -(defun gnus-group-topic-unread () - "The number of unread articles in topic on the current line." - (get-text-property (gnus-point-at-bol) 'gnus-topic-unread)) - -(defun gnus-topic-unread (topic) - "Return the number of unread articles in TOPIC." - (or (save-excursion - (and (gnus-topic-goto-topic topic) - (gnus-group-topic-unread))) - 0)) - -(defun gnus-group-topic-p () - "Return non-nil if the current line is a topic." - (gnus-group-topic-name)) - -(defun gnus-topic-visible-p () - "Return non-nil if the current topic is visible." - (get-text-property (gnus-point-at-bol) 'gnus-topic-visible)) - -(defun gnus-topic-articles-in-topic (entries) - (let ((total 0) - number) - (while entries - (when (numberp (setq number (car (pop entries)))) - (incf total number))) - total)) - -(defun gnus-group-topic (group) - "Return the topic GROUP is a member of." - (let ((alist gnus-topic-alist) - out) - (while alist - (when (member group (cdar alist)) - (setq out (caar alist) - alist nil)) - (setq alist (cdr alist))) - out)) - -(defun gnus-group-parent-topic (group) - "Return the topic GROUP is member of by looking at the group buffer." - (save-excursion - (set-buffer gnus-group-buffer) - (if (gnus-group-goto-group group) - (gnus-current-topic) - (gnus-group-topic group)))) - -(defun gnus-topic-goto-topic (topic) - "Go to TOPIC." - (when topic - (gnus-goto-char (text-property-any (point-min) (point-max) - 'gnus-topic (intern topic))))) - -(defun gnus-current-topic () - "Return the name of the current topic." - (let ((result - (or (get-text-property (point) 'gnus-topic) - (save-excursion - (and (gnus-goto-char (previous-single-property-change - (point) 'gnus-topic)) - (get-text-property (max (1- (point)) (point-min)) - 'gnus-topic)))))) - (when result - (symbol-name result)))) - -(defun gnus-current-topics () - "Return a list of all current topics, lowest in hierarchy first." - (let ((topic (gnus-current-topic)) - topics) - (while topic - (push topic topics) - (setq topic (gnus-topic-parent-topic topic))) - (nreverse topics))) - -(defun gnus-group-active-topic-p () - "Say whether the current topic comes from the active topics." - (save-excursion - (beginning-of-line) - (get-text-property (point) 'gnus-active))) - -(defun gnus-topic-find-groups (topic &optional level all) - "Return entries for all visible groups in TOPIC." - (let ((groups (cdr (assoc topic gnus-topic-alist))) - info clevel unread group lowest params visible-groups entry active) - (setq lowest (or lowest 1)) - (setq level (or level 7)) - ;; We go through the newsrc to look for matches. - (while groups - (when (setq group (pop groups)) - (setq entry (gnus-gethash group gnus-newsrc-hashtb) - info (nth 2 entry) - params (gnus-info-params info) - active (gnus-active group) - unread (or (car entry) - (and (not (equal group "dummy.group")) - active - (- (1+ (cdr active)) (car active)))) - clevel (or (gnus-info-level info) - (if (member group gnus-zombie-list) 8 9)))) - (and - unread ; nil means that the group is dead. - (<= clevel level) - (>= clevel lowest) ; Is inside the level we want. - (or all - (if (eq unread t) - gnus-group-list-inactive-groups - (> unread 0)) - (and gnus-list-groups-with-ticked-articles - (cdr (assq 'tick (gnus-info-marks info)))) - ; Has right readedness. - ;; Check for permanent visibility. - (and gnus-permanently-visible-groups - (string-match gnus-permanently-visible-groups group)) - (memq 'visible params) - (cdr (assq 'visible params))) - ;; Add this group to the list of visible groups. - (push (or entry group) visible-groups))) - (nreverse visible-groups))) - -(defun gnus-topic-previous-topic (topic) - "Return the previous topic on the same level as TOPIC." - (let ((top (cddr (gnus-topic-find-topology - (gnus-topic-parent-topic topic))))) - (unless (equal topic (caaar top)) - (while (and top (not (equal (caaadr top) topic))) - (setq top (cdr top))) - (caaar top)))) - -(defun gnus-topic-parent-topic (topic &optional topology) - "Return the parent of TOPIC." - (unless topology - (setq topology gnus-topic-topology)) - (let ((parent (car (pop topology))) - result found) - (while (and topology - (not (setq found (equal (caaar topology) topic))) - (not (setq result (gnus-topic-parent-topic - topic (car topology))))) - (setq topology (cdr topology))) - (or result (and found parent)))) - -(defun gnus-topic-next-topic (topic &optional previous) - "Return the next sibling of TOPIC." - (let ((parentt (cddr (gnus-topic-find-topology - (gnus-topic-parent-topic topic)))) - prev) - (while (and parentt - (not (equal (caaar parentt) topic))) - (setq prev (caaar parentt) - parentt (cdr parentt))) - (if previous - prev - (caaadr parentt)))) - -(defun gnus-topic-forward-topic (num) - "Go to the next topic on the same level as the current one." - (let* ((topic (gnus-current-topic)) - (way (if (< num 0) 'gnus-topic-previous-topic - 'gnus-topic-next-topic)) - (num (abs num))) - (while (and (not (zerop num)) - (setq topic (funcall way topic))) - (when (gnus-topic-goto-topic topic) - (decf num))) - (unless (zerop num) - (goto-char (point-max))) - num)) - -(defun gnus-topic-find-topology (topic &optional topology level remove) - "Return the topology of TOPIC." - (unless topology - (setq topology gnus-topic-topology) - (setq level 0)) - (let ((top topology) - result) - (if (equal (caar topology) topic) - (progn - (when remove - (delq topology remove)) - (cons level topology)) - (setq topology (cdr topology)) - (while (and topology - (not (setq result (gnus-topic-find-topology - topic (car topology) (1+ level) - (and remove top))))) - (setq topology (cdr topology))) - result))) - -(defvar gnus-tmp-topics nil) -(defun gnus-topic-list (&optional topology) - "Return a list of all topics in the topology." - (unless topology - (setq topology gnus-topic-topology - gnus-tmp-topics nil)) - (push (caar topology) gnus-tmp-topics) - (mapcar 'gnus-topic-list (cdr topology)) - gnus-tmp-topics) - -;;; Topic parameter jazz - -(defun gnus-topic-parameters (topic) - "Return the parameters for TOPIC." - (let ((top (gnus-topic-find-topology topic))) - (when top - (nth 3 (cadr top))))) - -(defun gnus-topic-set-parameters (topic parameters) - "Set the topic parameters of TOPIC to PARAMETERS." - (let ((top (gnus-topic-find-topology topic))) - (unless top - (error "No such topic: %s" topic)) - ;; We may have to extend if there is no parameters here - ;; to begin with. - (unless (nthcdr 2 (cadr top)) - (nconc (cadr top) (list nil))) - (unless (nthcdr 3 (cadr top)) - (nconc (cadr top) (list nil))) - (setcar (nthcdr 3 (cadr top)) parameters) - (gnus-dribble-enter - (format "(gnus-topic-set-parameters %S '%S)" topic parameters)))) - -(defun gnus-group-topic-parameters (group) - "Compute the group parameters for GROUP taking into account inheritance from topics." - (let ((params-list (list (gnus-group-get-parameter group))) - topics params param out) - (save-excursion - (gnus-group-goto-group group) - (setq topics (gnus-current-topics)) - (while topics - (push (gnus-topic-parameters (pop topics)) params-list)) - ;; We probably have lots of nil elements here, so - ;; we remove them. Probably faster than doing this "properly". - (setq params-list (delq nil params-list)) - ;; Now we have all the parameters, so we go through them - ;; and do inheritance in the obvious way. - (while (setq params (pop params-list)) - (while (setq param (pop params)) - (when (atom param) - (setq param (cons param t))) - ;; Override any old versions of this param. - (setq out (delq (assq (car param) out) out)) - (push param out))) - ;; Return the resulting parameter list. - out))) - -;;; General utility functions - -(defun gnus-topic-enter-dribble () - (gnus-dribble-enter - (format "(setq gnus-topic-topology '%S)" gnus-topic-topology))) - -;;; Generating group buffers - -(defun gnus-group-prepare-topics (level &optional all lowest regexp list-topic topic-level) - "List all newsgroups with unread articles of level LEVEL or lower, and -use the `gnus-group-topics' to sort the groups. -If ALL is non-nil, list groups that have no unread articles. -If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." - (set-buffer gnus-group-buffer) - (let ((buffer-read-only nil) - (lowest (or lowest 1))) - - (when (or (not gnus-topic-alist) - (not gnus-topology-checked-p)) - (gnus-topic-check-topology)) - - (unless list-topic - (erase-buffer)) - - ;; List dead groups? - (when (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)) - (gnus-group-prepare-flat-list-dead - (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) - gnus-level-zombie ?Z - regexp)) - - (when (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)) - (gnus-group-prepare-flat-list-dead - (setq gnus-killed-list (sort gnus-killed-list 'string<)) - gnus-level-killed ?K - regexp)) - - ;; Use topics. - (prog1 - (when (< lowest gnus-level-zombie) - (if list-topic - (let ((top (gnus-topic-find-topology list-topic))) - (gnus-topic-prepare-topic (cdr top) (car top) - (or topic-level level) all)) - (gnus-topic-prepare-topic gnus-topic-topology 0 - (or topic-level level) all))) - - (gnus-group-set-mode-line) - (setq gnus-group-list-mode (cons level all)) - (run-hooks 'gnus-group-prepare-hook)))) - -(defun gnus-topic-prepare-topic (topicl level &optional list-level all silent) - "Insert TOPIC into the group buffer. -If SILENT, don't insert anything. Return the number of unread -articles in the topic and its subtopics." - (let* ((type (pop topicl)) - (entries (gnus-topic-find-groups (car type) list-level all)) - (visiblep (and (eq (nth 1 type) 'visible) (not silent))) - (gnus-group-indentation - (make-string (* gnus-topic-indent-level level) ? )) - (beg (progn (beginning-of-line) (point))) - (topicl (reverse topicl)) - (all-entries entries) - (point-max (point-max)) - (unread 0) - (topic (car type)) - info entry end active tick) - ;; Insert any sub-topics. - (while topicl - (incf unread - (gnus-topic-prepare-topic - (pop topicl) (1+ level) list-level all - (not visiblep)))) - (setq end (point)) - (goto-char beg) - ;; Insert all the groups that belong in this topic. - (while (setq entry (pop entries)) - (when visiblep - (if (stringp entry) - ;; Dead groups. - (gnus-group-insert-group-line - entry (if (member entry gnus-zombie-list) 8 9) - nil (- (1+ (cdr (setq active (gnus-active entry)))) - (car active)) - nil) - ;; Living groups. - (when (setq info (nth 2 entry)) - (gnus-group-insert-group-line - (gnus-info-group info) - (gnus-info-level info) (gnus-info-marks info) - (car entry) (gnus-info-method info))))) - (when (and (listp entry) - (numberp (car entry))) - (incf unread (car entry))) - (when (listp entry) - (setq tick t))) - (goto-char beg) - ;; Insert the topic line. - (when (and (not silent) - (or gnus-topic-display-empty-topics ;We want empty topics - (not (zerop unread)) ;Non-empty - tick ;Ticked articles - (/= point-max (point-max)))) ;Unactivated groups - (gnus-extent-start-open (point)) - (gnus-topic-insert-topic-line - (car type) visiblep - (not (eq (nth 2 type) 'hidden)) - level all-entries unread)) - (goto-char end) - unread)) - -(defun gnus-topic-remove-topic (&optional insert total-remove hide in-level) - "Remove the current topic." - (let ((topic (gnus-group-topic-name)) - (level (gnus-group-topic-level)) - (beg (progn (beginning-of-line) (point))) - buffer-read-only) - (when topic - (while (and (zerop (forward-line 1)) - (> (or (gnus-group-topic-level) (1+ level)) level))) - (delete-region beg (point)) - ;; Do the change in this rather odd manner because it has been - ;; reported that some topics share parts of some lists, for some - ;; reason. I have been unable to determine why this is the - ;; case, but this hack seems to take care of things. - (let ((data (cadr (gnus-topic-find-topology topic)))) - (setcdr data - (list (if insert 'visible 'invisible) - (if hide 'hide nil) - (cadddr data)))) - (if total-remove - (setq gnus-topic-alist - (delq (assoc topic gnus-topic-alist) gnus-topic-alist)) - (gnus-topic-insert-topic topic in-level))))) - -(defun gnus-topic-insert-topic (topic &optional level) - "Insert TOPIC." - (gnus-group-prepare-topics - (car gnus-group-list-mode) (cdr gnus-group-list-mode) - nil nil topic level)) - -(defun gnus-topic-fold (&optional insert) - "Remove/insert the current topic." - (let ((topic (gnus-group-topic-name))) - (when topic - (save-excursion - (if (not (gnus-group-active-topic-p)) - (gnus-topic-remove-topic - (or insert (not (gnus-topic-visible-p)))) - (let ((gnus-topic-topology gnus-topic-active-topology) - (gnus-topic-alist gnus-topic-active-alist) - (gnus-group-list-mode (cons 5 t))) - (gnus-topic-remove-topic - (or insert (not (gnus-topic-visible-p))) nil nil 9) - (gnus-topic-enter-dribble))))))) - -(defun gnus-topic-insert-topic-line (name visiblep shownp level entries - &optional unread) - (let* ((visible (if visiblep "" "...")) - (indentation (make-string (* gnus-topic-indent-level level) ? )) - (total-number-of-articles unread) - (number-of-groups (length entries)) - (active-topic (eq gnus-topic-alist gnus-topic-active-alist))) - (beginning-of-line) - ;; Insert the text. - (gnus-add-text-properties - (point) - (prog1 (1+ (point)) - (eval gnus-topic-line-format-spec) - (gnus-topic-remove-excess-properties)1) - (list 'gnus-topic (intern name) - 'gnus-topic-level level - 'gnus-topic-unread unread - 'gnus-active active-topic - 'gnus-topic-visible visiblep)))) - -(defun gnus-topic-update-topics-containing-group (group) - "Update all topics that have GROUP as a member." - (when (and (eq major-mode 'gnus-group-mode) - gnus-topic-mode) - (save-excursion - (let ((alist gnus-topic-alist)) - ;; This is probably not entirely correct. If a topic - ;; isn't shown, then it's not updated. But the updating - ;; should be performed in any case, since the topic's - ;; parent should be updated. Pfft. - (while alist - (when (and (member group (cdar alist)) - (gnus-topic-goto-topic (caar alist))) - (gnus-topic-update-topic-line (caar alist))) - (pop alist)))))) - -(defun gnus-topic-update-topic () - "Update all parent topics to the current group." - (when (and (eq major-mode 'gnus-group-mode) - gnus-topic-mode) - (let ((group (gnus-group-group-name)) - (m (point-marker)) - (buffer-read-only nil)) - (when (and group - (gnus-get-info group) - (gnus-topic-goto-topic (gnus-current-topic))) - (gnus-topic-update-topic-line (gnus-group-topic-name)) - (goto-char m) - (set-marker m nil) - (gnus-group-position-point))))) - -(defun gnus-topic-goto-missing-group (group) - "Place point where GROUP is supposed to be inserted." - (let* ((topic (gnus-group-topic group)) - (groups (cdr (assoc topic gnus-topic-alist))) - (g (cdr (member group groups))) - (unfound t)) - ;; Try to jump to a visible group. - (while (and g (not (gnus-group-goto-group (car g) t))) - (pop g)) - ;; It wasn't visible, so we try to see where to insert it. - (when (not g) - (setq g (cdr (member group (reverse groups)))) - (while (and g unfound) - (when (gnus-group-goto-group (pop g) t) - (forward-line 1) - (setq unfound nil))) - (when (and unfound - topic - (not (gnus-topic-goto-missing-topic topic))) - (gnus-topic-insert-topic-line - topic t t (car (gnus-topic-find-topology topic)) nil 0))))) - -(defun gnus-topic-goto-missing-topic (topic) - (if (gnus-topic-goto-topic topic) - (forward-line 1) - ;; Topic not displayed. - (let* ((top (gnus-topic-find-topology - (gnus-topic-parent-topic topic))) - (tp (reverse (cddr top)))) - (while (not (equal (caaar tp) topic)) - (setq tp (cdr tp))) - (pop tp) - (while (and tp - (not (gnus-topic-goto-topic (caaar tp)))) - (pop tp)) - (if tp - (gnus-topic-forward-topic 1) - (gnus-topic-goto-missing-topic (caadr top)))) - nil)) - -(defun gnus-topic-update-topic-line (topic-name &optional reads) - (let* ((top (gnus-topic-find-topology topic-name)) - (type (cadr top)) - (children (cddr top)) - (entries (gnus-topic-find-groups - (car type) (car gnus-group-list-mode) - (cdr gnus-group-list-mode))) - (parent (gnus-topic-parent-topic topic-name)) - (all-entries entries) - (unread 0) - old-unread entry) - (when (gnus-topic-goto-topic (car type)) - ;; Tally all the groups that belong in this topic. - (if reads - (setq unread (- (gnus-group-topic-unread) reads)) - (while children - (incf unread (gnus-topic-unread (caar (pop children))))) - (while (setq entry (pop entries)) - (when (numberp (car entry)) - (incf unread (car entry))))) - (setq old-unread (gnus-group-topic-unread)) - ;; Insert the topic line. - (gnus-topic-insert-topic-line - (car type) (gnus-topic-visible-p) - (not (eq (nth 2 type) 'hidden)) - (gnus-group-topic-level) all-entries unread) - (gnus-delete-line)) - (when parent - (forward-line -1) - (gnus-topic-update-topic-line - parent (- old-unread (gnus-group-topic-unread)))) - unread)) - -(defun gnus-topic-group-indentation () - (make-string - (* gnus-topic-indent-level - (or (save-excursion - (forward-line -1) - (gnus-topic-goto-topic (gnus-current-topic)) - (gnus-group-topic-level)) - 0)) - ? )) - -;;; Initialization - -(gnus-add-shutdown 'gnus-topic-close 'gnus) - -(defun gnus-topic-close () - (setq gnus-topic-active-topology nil - gnus-topic-active-alist nil - gnus-topic-killed-topics nil - gnus-topology-checked-p nil)) - -(defun gnus-topic-check-topology () - ;; The first time we set the topology to whatever we have - ;; gotten here, which can be rather random. - (unless gnus-topic-alist - (gnus-topic-init-alist)) - - (setq gnus-topology-checked-p t) - ;; Go through the topic alist and make sure that all topics - ;; are in the topic topology. - (let ((topics (gnus-topic-list)) - (alist gnus-topic-alist) - changed) - (while alist - (unless (member (caar alist) topics) - (nconc gnus-topic-topology - (list (list (list (caar alist) 'visible)))) - (setq changed t)) - (setq alist (cdr alist))) - (when changed - (gnus-topic-enter-dribble)) - ;; Conversely, go through the topology and make sure that all - ;; topologies have alists. - (while topics - (unless (assoc (car topics) gnus-topic-alist) - (push (list (car topics)) gnus-topic-alist)) - (pop topics))) - ;; Go through all living groups and make sure that - ;; they belong to some topic. - (let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry)) - gnus-topic-alist))) - (entry (assoc (caar gnus-topic-topology) gnus-topic-alist)) - (newsrc (cdr gnus-newsrc-alist)) - group) - (while newsrc - (unless (member (setq group (gnus-info-group (pop newsrc))) tgroups) - (setcdr entry (cons group (cdr entry)))))) - ;; Go through all topics and make sure they contain only living groups. - (let ((alist gnus-topic-alist) - topic) - (while (setq topic (pop alist)) - (while (cdr topic) - (if (gnus-gethash (cadr topic) gnus-newsrc-hashtb) - (setq topic (cdr topic)) - (setcdr topic (cddr topic))))))) - -(defun gnus-topic-init-alist () - "Initialize the topic structures." - (setq gnus-topic-topology - (cons (list "Gnus" 'visible) - (mapcar (lambda (topic) - (list (list (car topic) 'visible))) - '(("misc"))))) - (setq gnus-topic-alist - (list (cons "misc" - (mapcar (lambda (info) (gnus-info-group info)) - (cdr gnus-newsrc-alist))) - (list "Gnus"))) - (gnus-topic-enter-dribble)) - -;;; Maintenance - -(defun gnus-topic-clean-alist () - "Remove bogus groups from the topic alist." - (let ((topic-alist gnus-topic-alist) - result topic) - (unless gnus-killed-hashtb - (gnus-make-hashtable-from-killed)) - (while (setq topic (pop topic-alist)) - (let ((topic-name (pop topic)) - group filtered-topic) - (while (setq group (pop topic)) - (when (and (or (gnus-gethash group gnus-active-hashtb) - (gnus-info-method (gnus-get-info group))) - (not (gnus-gethash group gnus-killed-hashtb))) - (push group filtered-topic))) - (push (cons topic-name (nreverse filtered-topic)) result))) - (setq gnus-topic-alist (nreverse result)))) - -(defun gnus-topic-change-level (group level oldlevel) - "Run when changing levels to enter/remove groups from topics." - (save-excursion - (set-buffer gnus-group-buffer) - (when (and gnus-topic-mode - gnus-topic-alist - (not gnus-topic-inhibit-change-level)) - ;; Remove the group from the topics. - (when (and (< oldlevel gnus-level-zombie) - (>= level gnus-level-zombie)) - (let (alist) - (forward-line -1) - (when (setq alist (assoc (gnus-current-topic) gnus-topic-alist)) - (setcdr alist (gnus-delete-first group (cdr alist)))))) - ;; If the group is subscribed we enter it into the topics. - (when (and (< level gnus-level-zombie) - (>= oldlevel gnus-level-zombie)) - (let* ((prev (gnus-group-group-name)) - (gnus-topic-inhibit-change-level t) - (gnus-group-indentation - (make-string - (* gnus-topic-indent-level - (or (save-excursion - (gnus-topic-goto-topic (gnus-current-topic)) - (gnus-group-topic-level)) - 0)) - ? )) - (yanked (list group)) - alist talist end) - ;; Then we enter the yanked groups into the topics they belong - ;; to. - (when (setq alist (assoc (save-excursion - (forward-line -1) - (or - (gnus-current-topic) - (caar gnus-topic-topology))) - gnus-topic-alist)) - (setq talist alist) - (when (stringp yanked) - (setq yanked (list yanked))) - (if (not prev) - (nconc alist yanked) - (if (not (cdr alist)) - (setcdr alist (nconc yanked (cdr alist))) - (while (and (not end) (cdr alist)) - (when (equal (cadr alist) prev) - (setcdr alist (nconc yanked (cdr alist))) - (setq end t)) - (setq alist (cdr alist))) - (unless end - (nconc talist yanked)))))) - (gnus-topic-update-topic))))) - -(defun gnus-topic-goto-next-group (group props) - "Go to group or the next group after group." - (if (not group) - (if (not (memq 'gnus-topic props)) - (goto-char (point-max)) - (gnus-topic-goto-topic (symbol-name (cadr (memq 'gnus-topic props))))) - (if (gnus-group-goto-group group) - t - ;; The group is no longer visible. - (let* ((list (assoc (gnus-group-topic group) gnus-topic-alist)) - (after (cdr (member group (cdr list))))) - ;; First try to put point on a group after the current one. - (while (and after - (not (gnus-group-goto-group (car after)))) - (setq after (cdr after))) - ;; Then try to put point on a group before point. - (unless after - (setq after (cdr (member group (reverse (cdr list))))) - (while (and after - (not (gnus-group-goto-group (car after)))) - (setq after (cdr after)))) - ;; Finally, just put point on the topic. - (if (not (car list)) - (goto-char (point-min)) - (unless after - (gnus-topic-goto-topic (car list)) - (setq after nil))) - t)))) - -;;; Topic-active functions - -(defun gnus-topic-grok-active (&optional force) - "Parse all active groups and create topic structures for them." - ;; First we make sure that we have really read the active file. - (when (or force - (not gnus-topic-active-alist)) - (let (groups) - ;; Get a list of all groups available. - (mapatoms (lambda (g) (when (symbol-value g) - (push (symbol-name g) groups))) - gnus-active-hashtb) - (setq groups (sort groups 'string<)) - ;; Init the variables. - (setq gnus-topic-active-topology (list (list "" 'visible))) - (setq gnus-topic-active-alist nil) - ;; Descend the top-level hierarchy. - (gnus-topic-grok-active-1 gnus-topic-active-topology groups) - ;; Set the top-level topic names to something nice. - (setcar (car gnus-topic-active-topology) "Gnus active") - (setcar (car gnus-topic-active-alist) "Gnus active")))) - -(defun gnus-topic-grok-active-1 (topology groups) - (let* ((name (caar topology)) - (prefix (concat "^" (regexp-quote name))) - tgroups ntopology group) - (while (and groups - (string-match prefix (setq group (car groups)))) - (if (not (string-match "\\." group (match-end 0))) - ;; There are no further hierarchies here, so we just - ;; enter this group into the list belonging to this - ;; topic. - (push (pop groups) tgroups) - ;; New sub-hierarchy, so we add it to the topology. - (nconc topology (list (setq ntopology - (list (list (substring - group 0 (match-end 0)) - 'invisible))))) - ;; Descend the hierarchy. - (setq groups (gnus-topic-grok-active-1 ntopology groups)))) - ;; We remove the trailing "." from the topic name. - (setq name - (if (string-match "\\.$" name) - (substring name 0 (match-beginning 0)) - name)) - ;; Add this topic and its groups to the topic alist. - (push (cons name (nreverse tgroups)) gnus-topic-active-alist) - (setcar (car topology) name) - ;; We return the rest of the groups that didn't belong - ;; to this topic. - groups)) - -;;; Topic mode, commands and keymap. - -(defvar gnus-topic-mode-map nil) -(defvar gnus-group-topic-map nil) - -(unless gnus-topic-mode-map - (setq gnus-topic-mode-map (make-sparse-keymap)) - - ;; Override certain group mode keys. - (gnus-define-keys gnus-topic-mode-map - "=" gnus-topic-select-group - "\r" gnus-topic-select-group - " " gnus-topic-read-group - "\C-k" gnus-topic-kill-group - "\C-y" gnus-topic-yank-group - "\M-g" gnus-topic-get-new-news-this-topic - "AT" gnus-topic-list-active - "Gp" gnus-topic-edit-parameters - "#" gnus-topic-mark-topic - "\M-#" gnus-topic-unmark-topic - gnus-mouse-2 gnus-mouse-pick-topic) - - ;; Define a new submap. - (gnus-define-keys (gnus-group-topic-map "T" gnus-group-mode-map) - "#" gnus-topic-mark-topic - "\M-#" gnus-topic-unmark-topic - "n" gnus-topic-create-topic - "m" gnus-topic-move-group - "D" gnus-topic-remove-group - "c" gnus-topic-copy-group - "h" gnus-topic-hide-topic - "s" gnus-topic-show-topic - "M" gnus-topic-move-matching - "C" gnus-topic-copy-matching - "\C-i" gnus-topic-indent - [tab] gnus-topic-indent - "r" gnus-topic-rename - "\177" gnus-topic-delete - [delete] gnus-topic-delete - "h" gnus-topic-toggle-display-empty-topics) - - (gnus-define-keys (gnus-topic-sort-map "S" gnus-group-topic-map) - "s" gnus-topic-sort-groups - "a" gnus-topic-sort-groups-by-alphabet - "u" gnus-topic-sort-groups-by-unread - "l" gnus-topic-sort-groups-by-level - "v" gnus-topic-sort-groups-by-score - "r" gnus-topic-sort-groups-by-rank - "m" gnus-topic-sort-groups-by-method)) - -(defun gnus-topic-make-menu-bar () - (unless (boundp 'gnus-topic-menu) - (easy-menu-define - gnus-topic-menu gnus-topic-mode-map "" - '("Topics" - ["Toggle topics" gnus-topic-mode t] - ("Groups" - ["Copy" gnus-topic-copy-group t] - ["Move" gnus-topic-move-group t] - ["Remove" gnus-topic-remove-group t] - ["Copy matching" gnus-topic-copy-matching t] - ["Move matching" gnus-topic-move-matching t]) - ("Topics" - ["Show" gnus-topic-show-topic t] - ["Hide" gnus-topic-hide-topic t] - ["Delete" gnus-topic-delete t] - ["Rename" gnus-topic-rename t] - ["Create" gnus-topic-create-topic t] - ["Mark" gnus-topic-mark-topic t] - ["Indent" gnus-topic-indent t] - ["Toggle hide empty" gnus-topic-toggle-display-empty-topics t]) - ["List active" gnus-topic-list-active t])))) - -(defun gnus-topic-mode (&optional arg redisplay) - "Minor mode for topicsifying Gnus group buffers." - (interactive (list current-prefix-arg t)) - (when (eq major-mode 'gnus-group-mode) - (make-local-variable 'gnus-topic-mode) - (setq gnus-topic-mode - (if (null arg) (not gnus-topic-mode) - (> (prefix-numeric-value arg) 0))) - ;; Infest Gnus with topics. - (if (not gnus-topic-mode) - (setq gnus-goto-missing-group-function nil) - (when (gnus-visual-p 'topic-menu 'menu) - (gnus-topic-make-menu-bar)) - (setq gnus-topic-line-format-spec - (gnus-parse-format gnus-topic-line-format - gnus-topic-line-format-alist t)) - (gnus-add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map) - (add-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) - (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic) - (set (make-local-variable 'gnus-group-prepare-function) - 'gnus-group-prepare-topics) - (set (make-local-variable 'gnus-group-get-parameter-function) - 'gnus-group-topic-parameters) - (set (make-local-variable 'gnus-group-goto-next-group-function) - 'gnus-topic-goto-next-group) - (set (make-local-variable 'gnus-group-indentation-function) - 'gnus-topic-group-indentation) - (set (make-local-variable 'gnus-group-update-group-function) - 'gnus-topic-update-topics-containing-group) - (set (make-local-variable 'gnus-group-sort-alist-function) - 'gnus-group-sort-topic) - (setq gnus-group-change-level-function 'gnus-topic-change-level) - (setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group) - (make-local-hook 'gnus-check-bogus-groups-hook) - (add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist) - (setq gnus-topology-checked-p nil) - ;; We check the topology. - (when gnus-newsrc-alist - (gnus-topic-check-topology)) - (run-hooks 'gnus-topic-mode-hook)) - ;; Remove topic infestation. - (unless gnus-topic-mode - (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic) - (remove-hook 'gnus-group-change-level-function - 'gnus-topic-change-level) - (remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist) - (setq gnus-group-prepare-function 'gnus-group-prepare-flat) - (setq gnus-group-sort-alist-function 'gnus-group-sort-flat)) - (when redisplay - (gnus-group-list-groups)))) - -(defun gnus-topic-select-group (&optional all) - "Select this newsgroup. -No article is selected automatically. -If ALL is non-nil, already read articles become readable. -If ALL is a number, fetch this number of articles. - -If performed over a topic line, toggle folding the topic." - (interactive "P") - (if (gnus-group-topic-p) - (let ((gnus-group-list-mode - (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode))) - (gnus-topic-fold all)) - (gnus-group-select-group all))) - -(defun gnus-mouse-pick-topic (e) - "Select the group or topic under the mouse pointer." - (interactive "e") - (mouse-set-point e) - (gnus-topic-read-group nil)) - -(defun gnus-topic-read-group (&optional all no-article group) - "Read news in this newsgroup. -If the prefix argument ALL is non-nil, already read articles become -readable. IF ALL is a number, fetch this number of articles. If the -optional argument NO-ARTICLE is non-nil, no article will be -auto-selected upon group entry. If GROUP is non-nil, fetch that -group. - -If performed over a topic line, toggle folding the topic." - (interactive "P") - (if (gnus-group-topic-p) - (let ((gnus-group-list-mode - (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode))) - (gnus-topic-fold all)) - (gnus-group-read-group all no-article group))) - -(defun gnus-topic-create-topic (topic parent &optional previous full-topic) - "Create a new TOPIC under PARENT. -When used interactively, PARENT will be the topic under point." - (interactive - (list - (read-string "New topic: ") - (gnus-current-topic))) - ;; Check whether this topic already exists. - (when (gnus-topic-find-topology topic) - (error "Topic already exists")) - (unless parent - (setq parent (caar gnus-topic-topology))) - (let ((top (cdr (gnus-topic-find-topology parent))) - (full-topic (or full-topic `((,topic visible))))) - (unless top - (error "No such parent topic: %s" parent)) - (if previous - (progn - (while (and (cdr top) - (not (equal (caaadr top) previous))) - (setq top (cdr top))) - (setcdr top (cons full-topic (cdr top)))) - (nconc top (list full-topic))) - (unless (assoc topic gnus-topic-alist) - (push (list topic) gnus-topic-alist))) - (gnus-topic-enter-dribble) - (gnus-group-list-groups) - (gnus-topic-goto-topic topic)) - -(defun gnus-topic-move-group (n topic &optional copyp) - "Move the next N groups to TOPIC. -If COPYP, copy the groups instead." - (interactive - (list current-prefix-arg - (completing-read "Move to topic: " gnus-topic-alist nil t))) - (let ((groups (gnus-group-process-prefix n)) - (topicl (assoc topic gnus-topic-alist)) - (start-group (progn (forward-line 1) (gnus-group-group-name))) - (start-topic (gnus-group-topic-name)) - entry) - (mapcar - (lambda (g) - (gnus-group-remove-mark g) - (when (and - (setq entry (assoc (gnus-current-topic) gnus-topic-alist)) - (not copyp)) - (setcdr entry (gnus-delete-first g (cdr entry)))) - (nconc topicl (list g))) - groups) - (gnus-topic-enter-dribble) - (if start-group - (gnus-group-goto-group start-group) - (gnus-topic-goto-topic start-topic)) - (gnus-group-list-groups))) - -(defun gnus-topic-remove-group (&optional arg) - "Remove the current group from the topic." - (interactive "P") - (gnus-group-iterate arg - (lambda (group) - (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist)) - (buffer-read-only nil)) - (when (and topicl group) - (gnus-delete-line) - (gnus-delete-first group topicl)) - (gnus-topic-update-topic) - (gnus-group-position-point))))) - -(defun gnus-topic-copy-group (n topic) - "Copy the current group to a topic." - (interactive - (list current-prefix-arg - (completing-read "Copy to topic: " gnus-topic-alist nil t))) - (gnus-topic-move-group n topic t)) - -(defun gnus-topic-kill-group (&optional n discard) - "Kill the next N groups." - (interactive "P") - (if (gnus-group-topic-p) - (let ((topic (gnus-group-topic-name))) - (push (cons - (gnus-topic-find-topology topic) - (assoc topic gnus-topic-alist)) - gnus-topic-killed-topics) - (gnus-topic-remove-topic nil t) - (gnus-topic-find-topology topic nil nil gnus-topic-topology) - (gnus-topic-enter-dribble)) - (gnus-group-kill-group n discard) - (gnus-topic-update-topic))) - -(defun gnus-topic-yank-group (&optional arg) - "Yank the last topic." - (interactive "p") - (if gnus-topic-killed-topics - (let* ((previous - (or (gnus-group-topic-name) - (gnus-topic-next-topic (gnus-current-topic)))) - (data (pop gnus-topic-killed-topics)) - (alist (cdr data)) - (item (cdar data))) - (push alist gnus-topic-alist) - (gnus-topic-create-topic - (caar item) (gnus-topic-parent-topic previous) previous - item) - (gnus-topic-enter-dribble) - (gnus-topic-goto-topic (caar item))) - (let* ((prev (gnus-group-group-name)) - (gnus-topic-inhibit-change-level t) - (gnus-group-indentation - (make-string - (* gnus-topic-indent-level - (or (save-excursion - (gnus-topic-goto-topic (gnus-current-topic)) - (gnus-group-topic-level)) - 0)) - ? )) - yanked alist) - ;; We first yank the groups the normal way... - (setq yanked (gnus-group-yank-group arg)) - ;; Then we enter the yanked groups into the topics they belong - ;; to. - (setq alist (assoc (save-excursion - (forward-line -1) - (gnus-current-topic)) - gnus-topic-alist)) - (when (stringp yanked) - (setq yanked (list yanked))) - (if (not prev) - (nconc alist yanked) - (if (not (cdr alist)) - (setcdr alist (nconc yanked (cdr alist))) - (while (cdr alist) - (when (equal (cadr alist) prev) - (setcdr alist (nconc yanked (cdr alist))) - (setq alist nil)) - (setq alist (cdr alist)))))) - (gnus-topic-update-topic))) - -(defun gnus-topic-hide-topic () - "Hide the current topic." - (interactive) - (when (gnus-current-topic) - (gnus-topic-goto-topic (gnus-current-topic)) - (gnus-topic-remove-topic nil nil 'hidden))) - -(defun gnus-topic-show-topic () - "Show the hidden topic." - (interactive) - (when (gnus-group-topic-p) - (gnus-topic-remove-topic t nil 'shown))) - -(defun gnus-topic-mark-topic (topic &optional unmark) - "Mark all groups in the topic with the process mark." - (interactive (list (gnus-group-topic-name))) - (if (not topic) - (call-interactively 'gnus-group-mark-group) - (save-excursion - (let ((groups (gnus-topic-find-groups topic 9 t))) - (while groups - (funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark) - (gnus-info-group (nth 2 (pop groups))))))))) - -(defun gnus-topic-unmark-topic (topic &optional unmark) - "Remove the process mark from all groups in the topic." - (interactive (list (gnus-group-topic-name))) - (if (not topic) - (call-interactively 'gnus-group-unmark-group) - (gnus-topic-mark-topic topic t))) - -(defun gnus-topic-get-new-news-this-topic (&optional n) - "Check for new news in the current topic." - (interactive "P") - (if (not (gnus-group-topic-p)) - (gnus-group-get-new-news-this-group n) - (gnus-topic-mark-topic (gnus-group-topic-name)) - (gnus-group-get-new-news-this-group))) - -(defun gnus-topic-move-matching (regexp topic &optional copyp) - "Move all groups that match REGEXP to some topic." - (interactive - (let (topic) - (nreverse - (list - (setq topic (completing-read "Move to topic: " gnus-topic-alist nil t)) - (read-string (format "Move to %s (regexp): " topic)))))) - (gnus-group-mark-regexp regexp) - (gnus-topic-move-group nil topic copyp)) - -(defun gnus-topic-copy-matching (regexp topic &optional copyp) - "Copy all groups that match REGEXP to some topic." - (interactive - (let (topic) - (nreverse - (list - (setq topic (completing-read "Copy to topic: " gnus-topic-alist nil t)) - (read-string (format "Copy to %s (regexp): " topic)))))) - (gnus-topic-move-matching regexp topic t)) - -(defun gnus-topic-delete (topic) - "Delete a topic." - (interactive (list (gnus-group-topic-name))) - (unless topic - (error "No topic to be deleted")) - (let ((entry (assoc topic gnus-topic-alist)) - (buffer-read-only nil)) - (when (cdr entry) - (error "Topic not empty")) - ;; Delete if visible. - (when (gnus-topic-goto-topic topic) - (gnus-delete-line)) - ;; Remove from alist. - (setq gnus-topic-alist (delq entry gnus-topic-alist)) - ;; Remove from topology. - (gnus-topic-find-topology topic nil nil 'delete))) - -(defun gnus-topic-rename (old-name new-name) - "Rename a topic." - (interactive - (let ((topic (gnus-current-topic))) - (list topic - (read-string (format "Rename %s to: " topic))))) - (let ((top (gnus-topic-find-topology old-name)) - (entry (assoc old-name gnus-topic-alist))) - (when top - (setcar (cadr top) new-name)) - (when entry - (setcar entry new-name)) - (forward-line -1) - (gnus-dribble-touch) - (gnus-group-list-groups))) - -(defun gnus-topic-indent (&optional unindent) - "Indent a topic -- make it a sub-topic of the previous topic. -If UNINDENT, remove an indentation." - (interactive "P") - (if unindent - (gnus-topic-unindent) - (let* ((topic (gnus-current-topic)) - (parent (gnus-topic-previous-topic topic)) - (buffer-read-only nil)) - (unless parent - (error "Nothing to indent %s into" topic)) - (when topic - (gnus-topic-goto-topic topic) - (gnus-topic-kill-group) - (push (cdar gnus-topic-killed-topics) gnus-topic-alist) - (gnus-topic-create-topic - topic parent nil (cdaar gnus-topic-killed-topics)) - (pop gnus-topic-killed-topics) - (or (gnus-topic-goto-topic topic) - (gnus-topic-goto-topic parent)))))) - -(defun gnus-topic-unindent () - "Unindent a topic." - (interactive) - (let* ((topic (gnus-current-topic)) - (parent (gnus-topic-parent-topic topic)) - (grandparent (gnus-topic-parent-topic parent))) - (unless grandparent - (error "Nothing to indent %s into" topic)) - (when topic - (gnus-topic-goto-topic topic) - (gnus-topic-kill-group) - (push (cdar gnus-topic-killed-topics) gnus-topic-alist) - (gnus-topic-create-topic - topic grandparent (gnus-topic-next-topic parent) - (cdaar gnus-topic-killed-topics)) - (pop gnus-topic-killed-topics) - (gnus-topic-goto-topic topic)))) - -(defun gnus-topic-list-active (&optional force) - "List all groups that Gnus knows about in a topicsified fashion. -If FORCE, always re-read the active file." - (interactive "P") - (when force - (gnus-get-killed-groups)) - (gnus-topic-grok-active force) - (let ((gnus-topic-topology gnus-topic-active-topology) - (gnus-topic-alist gnus-topic-active-alist) - gnus-killed-list gnus-zombie-list) - (gnus-group-list-groups 9 nil 1))) - -(defun gnus-topic-toggle-display-empty-topics () - "Show/hide topics that have no unread articles." - (interactive) - (setq gnus-topic-display-empty-topics - (not gnus-topic-display-empty-topics)) - (gnus-group-list-groups) - (message "%s empty topics" - (if gnus-topic-display-empty-topics - "Showing" "Hiding"))) - -;;; Topic sorting functions - -(defun gnus-topic-edit-parameters (group) - "Edit the group parameters of GROUP. -If performed on a topic, edit the topic parameters instead." - (interactive (list (gnus-group-group-name))) - (if group - (gnus-group-edit-group-parameters group) - (if (not (gnus-group-topic-p)) - (error "Nothing to edit on the current line") - (let ((topic (gnus-group-topic-name))) - (gnus-edit-form - (gnus-topic-parameters topic) - (format "Editing the topic parameters for `%s'." - (or group topic)) - `(lambda (form) - (gnus-topic-set-parameters ,topic form))))))) - -(defun gnus-group-sort-topic (func reverse) - "Sort groups in the topics according to FUNC and REVERSE." - (let ((alist gnus-topic-alist)) - (while alist - ;; !!!Sometimes nil elements sneak into the alist, - ;; for some reason or other. - (setcar alist (delq nil (car alist))) - (setcar alist (delete "dummy.group" (car alist))) - (gnus-topic-sort-topic (pop alist) func reverse)))) - -(defun gnus-topic-sort-topic (topic func reverse) - ;; Each topic only lists the name of the group, while - ;; the sort predicates expect group infos as inputs. - ;; So we first transform the group names into infos, - ;; then sort, and then transform back into group names. - (setcdr - topic - (mapcar - (lambda (info) (gnus-info-group info)) - (sort - (mapcar - (lambda (group) (gnus-get-info group)) - (cdr topic)) - func))) - ;; Do the reversal, if necessary. - (when reverse - (setcdr topic (nreverse (cdr topic))))) - -(defun gnus-topic-sort-groups (func &optional reverse) - "Sort the current topic according to FUNC. -If REVERSE, reverse the sorting order." - (interactive (list gnus-group-sort-function current-prefix-arg)) - (let ((topic (assoc (gnus-current-topic) gnus-topic-alist))) - (gnus-topic-sort-topic - topic (gnus-make-sort-function func) reverse) - (gnus-group-list-groups))) - -(defun gnus-topic-sort-groups-by-alphabet (&optional reverse) - "Sort the current topic alphabetically by group name. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-topic-sort-groups 'gnus-group-sort-by-alphabet reverse)) - -(defun gnus-topic-sort-groups-by-unread (&optional reverse) - "Sort the current topic by number of unread articles. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-topic-sort-groups 'gnus-group-sort-by-unread reverse)) - -(defun gnus-topic-sort-groups-by-level (&optional reverse) - "Sort the current topic by group level. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-topic-sort-groups 'gnus-group-sort-by-level reverse)) - -(defun gnus-topic-sort-groups-by-score (&optional reverse) - "Sort the current topic by group score. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-topic-sort-groups 'gnus-group-sort-by-score reverse)) - -(defun gnus-topic-sort-groups-by-rank (&optional reverse) - "Sort the current topic by group rank. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-topic-sort-groups 'gnus-group-sort-by-rank reverse)) - -(defun gnus-topic-sort-groups-by-method (&optional reverse) - "Sort the current topic alphabetically by backend name. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-topic-sort-groups 'gnus-group-sort-by-method reverse)) - -(provide 'gnus-topic) - -;;; gnus-topic.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-undo.el --- a/lisp/gnus/gnus-undo.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,172 +0,0 @@ -;;; gnus-undo.el --- minor mode for undoing in Gnus -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This package allows arbitrary undoing in Gnus buffers. As all the -;; Gnus buffers aren't very text-oriented (what is in the buffers is -;; just some random representation of the actual data), normal Emacs -;; undoing doesn't work at all for Gnus. -;; -;; This package works by letting Gnus register functions for reversing -;; actions, and then calling these functions when the user pushes the -;; `undo' key. As with normal `undo', there it is possible to set -;; undo boundaries and so on. -;; -;; Internally, the undo sequence is represented by the -;; `gnus-undo-actions' list, where each element is a list of functions -;; to be called, in sequence, to undo some action. (An "action" is a -;; collection of functions.) -;; -;; For instance, a function for killing a group will call -;; `gnus-undo-register' with a function that un-kills the group. This -;; package will put that function into an action. - -;;; Code: - -(require 'gnus-util) -(require 'gnus) - -(defvar gnus-undo-mode nil - "Minor mode for undoing in Gnus buffers.") - -(defvar gnus-undo-mode-hook nil - "Hook called in all `gnus-undo-mode' buffers.") - -;;; Internal variables. - -(defvar gnus-undo-actions nil) -(defvar gnus-undo-boundary t) -(defvar gnus-undo-last nil) -(defvar gnus-undo-boundary-inhibit nil) - -;;; Minor mode definition. - -(defvar gnus-undo-mode-map nil) - -(unless gnus-undo-mode-map - (setq gnus-undo-mode-map (make-sparse-keymap)) - - (gnus-define-keys gnus-undo-mode-map - "\M-\C-_" gnus-undo - "\C-_" gnus-undo - "\C-xu" gnus-undo - ;; many people are used to type `C-/' on X terminals and get `C-_'. - [(control /)] gnus-undo)) - -(defun gnus-undo-make-menu-bar () - ;; This is disabled for the time being. - (when nil - (define-key-after (current-local-map) [menu-bar file gnus-undo] - (cons "Undo" 'gnus-undo-actions) - [menu-bar file whatever]))) - -(defun gnus-undo-mode (&optional arg) - "Minor mode for providing `undo' in Gnus buffers. - -\\{gnus-undo-mode-map}" - (interactive "P") - (set (make-local-variable 'gnus-undo-mode) - (if (null arg) (not gnus-undo-mode) - (> (prefix-numeric-value arg) 0))) - (set (make-local-variable 'gnus-undo-actions) nil) - (set (make-local-variable 'gnus-undo-boundary) t) - (when gnus-undo-mode - ;; Set up the menu. - (when (gnus-visual-p 'undo-menu 'menu) - (gnus-undo-make-menu-bar)) - (gnus-add-minor-mode 'gnus-undo-mode "" gnus-undo-mode-map) - (make-local-hook 'post-command-hook) - (add-hook 'post-command-hook 'gnus-undo-boundary nil t) - (run-hooks 'gnus-undo-mode-hook))) - -;;; Interface functions. - -(defun gnus-disable-undo (&optional buffer) - "Disable undoing in the current buffer." - (interactive) - (save-excursion - (when buffer - (set-buffer buffer)) - (gnus-undo-mode -1))) - -(defun gnus-undo-boundary () - "Set Gnus undo boundary." - (if gnus-undo-boundary-inhibit - (setq gnus-undo-boundary-inhibit nil) - (setq gnus-undo-boundary t))) - -(defun gnus-undo-force-boundary () - "Set Gnus undo boundary." - (setq gnus-undo-boundary-inhibit nil - gnus-undo-boundary t)) - -(defun gnus-undo-register (form) - "Register FORMS as something to be performed to undo a change. -FORMS may use backtick quote syntax." - (when gnus-undo-mode - (gnus-undo-register-1 - `(lambda () - ,form)))) - -(put 'gnus-undo-register 'lisp-indent-function 0) -(put 'gnus-undo-register 'edebug-form-spec '(body)) - -(defun gnus-undo-register-1 (function) - "Register FUNCTION as something to be performed to undo a change." - (when gnus-undo-mode - (cond - ;; We are on a boundary, so we create a new action. - (gnus-undo-boundary - (push (list function) gnus-undo-actions) - (setq gnus-undo-boundary nil)) - ;; Prepend the function to an old action. - (gnus-undo-actions - (setcar gnus-undo-actions (cons function (car gnus-undo-actions)))) - ;; Initialize list. - (t - (setq gnus-undo-actions (list (list function))))) - (setq gnus-undo-boundary-inhibit t))) - -(defun gnus-undo (n) - "Undo some previous changes in Gnus buffers. -Repeat this command to undo more changes. -A numeric argument serves as a repeat count." - (interactive "p") - (unless gnus-undo-mode - (error "Undoing is not enabled in this buffer")) - (message "%s" last-command) - (when (or (not (eq last-command 'gnus-undo)) - (not gnus-undo-last)) - (setq gnus-undo-last gnus-undo-actions)) - (let ((action (pop gnus-undo-last))) - (unless action - (error "Nothing further to undo")) - (setq gnus-undo-actions (delq action gnus-undo-actions)) - (setq gnus-undo-boundary t) - (while action - (funcall (pop action))))) - -(provide 'gnus-undo) - -;;; gnus-undo.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-util.el --- a/lisp/gnus/gnus-util.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,830 +0,0 @@ -;;; gnus-util.el --- utility functions for Gnus -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Nothing in this file depends on any other parts of Gnus -- all -;; functions and macros in this file are utility functions that are -;; used by Gnus and may be used by any other package without loading -;; Gnus first. - -;;; Code: - -(require 'custom) -(require 'cl) -(require 'nnheader) -(require 'timezone) -(require 'message) - -(eval-and-compile - (autoload 'nnmail-date-to-time "nnmail")) - -(defun gnus-boundp (variable) - "Return non-nil if VARIABLE is bound and non-nil." - (and (boundp variable) - (symbol-value variable))) - -(defmacro gnus-eval-in-buffer-window (buffer &rest forms) - "Pop to BUFFER, evaluate FORMS, and then return to the original window." - (let ((tempvar (make-symbol "GnusStartBufferWindow")) - (w (make-symbol "w")) - (buf (make-symbol "buf"))) - `(let* ((,tempvar (selected-window)) - (,buf ,buffer) - (,w (get-buffer-window ,buf 'visible))) - (unwind-protect - (progn - (if ,w - (progn - (select-window ,w) - (set-buffer (window-buffer ,w))) - (pop-to-buffer ,buf)) - ,@forms) - (select-window ,tempvar))))) - -(put 'gnus-eval-in-buffer-window 'lisp-indent-function 1) -(put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body)) - -(defmacro gnus-intern-safe (string hashtable) - "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." - `(let ((symbol (intern ,string ,hashtable))) - (or (boundp symbol) - (set symbol nil)) - symbol)) - -;; modified by MORIOKA Tomohiko -;; function `substring' might cut on a middle of multi-octet -;; character. -(defun gnus-truncate-string (str width) - (substring str 0 width)) - -;; Added by Geoffrey T. Dairiki . A safe way -;; to limit the length of a string. This function is necessary since -;; `(substr "abc" 0 30)' pukes with "Args out of range". -(defsubst gnus-limit-string (str width) - (if (> (length str) width) - (substring str 0 width) - str)) - -(defsubst gnus-functionp (form) - "Return non-nil if FORM is funcallable." - (or (and (symbolp form) (fboundp form)) - (and (listp form) (eq (car form) 'lambda)) - (compiled-function-p form))) - -(defsubst gnus-goto-char (point) - (and point (goto-char point))) - -(defmacro gnus-buffer-exists-p (buffer) - `(let ((buffer ,buffer)) - (when buffer - (funcall (if (stringp buffer) 'get-buffer 'buffer-name) - buffer)))) - -(defmacro gnus-kill-buffer (buffer) - `(let ((buf ,buffer)) - (when (gnus-buffer-exists-p buf) - (kill-buffer buf)))) - -(if (fboundp 'point-at-bol) - (fset 'gnus-point-at-bol 'point-at-bol) - (defun gnus-point-at-bol () - "Return point at the beginning of the line." - (let ((p (point))) - (beginning-of-line) - (prog1 - (point) - (goto-char p))))) - -(if (fboundp 'point-at-eol) - (fset 'gnus-point-at-eol 'point-at-eol) - (defun gnus-point-at-eol () - "Return point at the end of the line." - (let ((p (point))) - (end-of-line) - (prog1 - (point) - (goto-char p))))) - -(defun gnus-delete-first (elt list) - "Delete by side effect the first occurrence of ELT as a member of LIST." - (if (equal (car list) elt) - (cdr list) - (let ((total list)) - (while (and (cdr list) - (not (equal (cadr list) elt))) - (setq list (cdr list))) - (when (cdr list) - (setcdr list (cddr list))) - total))) - -;; Delete the current line (and the next N lines). -(defmacro gnus-delete-line (&optional n) - `(delete-region (progn (beginning-of-line) (point)) - (progn (forward-line ,(or n 1)) (point)))) - -(defun gnus-byte-code (func) - "Return a form that can be `eval'ed based on FUNC." - (let ((fval (symbol-function func))) - (if (compiled-function-p fval) - (let ((flist (append fval nil))) - (setcar flist 'byte-code) - flist) - (cons 'progn (cddr fval))))) - -(defun gnus-extract-address-components (from) - (let (name address) - ;; First find the address - the thing with the @ in it. This may - ;; not be accurate in mail addresses, but does the trick most of - ;; the time in news messages. - (when (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from) - (setq address (substring from (match-beginning 0) (match-end 0)))) - ;; Then we check whether the "name

" format is used. - (and address - ;; Fix by MORIOKA Tomohiko - ;; Linear white space is not required. - (string-match (concat "[ \t]*<" (regexp-quote address) ">") from) - (and (setq name (substring from 0 (match-beginning 0))) - ;; Strip any quotes from the name. - (string-match "\".*\"" name) - (setq name (substring name 1 (1- (match-end 0)))))) - ;; If not, then "address (name)" is used. - (or name - (and (string-match "(.+)" from) - (setq name (substring from (1+ (match-beginning 0)) - (1- (match-end 0))))) - (and (string-match "()" from) - (setq name address)) - ;; Fix by MORIOKA Tomohiko . - ;; XOVER might not support folded From headers. - (and (string-match "(.*" from) - (setq name (substring from (1+ (match-beginning 0)) - (match-end 0))))) - ;; Fix by Hallvard B Furuseth . - (list (or name from) (or address from)))) - -(defun gnus-fetch-field (field) - "Return the value of the header FIELD of current article." - (save-excursion - (save-restriction - (let ((case-fold-search t) - (inhibit-point-motion-hooks t)) - (nnheader-narrow-to-headers) - (message-fetch-field field))))) - -(defun gnus-goto-colon () - (beginning-of-line) - (search-forward ":" (gnus-point-at-eol) t)) - -(defun gnus-remove-text-with-property (prop) - "Delete all text in the current buffer with text property PROP." - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (while (get-text-property (point) prop) - (delete-char 1)) - (goto-char (next-single-property-change (point) prop nil (point-max)))))) - -(defun gnus-newsgroup-directory-form (newsgroup) - "Make hierarchical directory name from NEWSGROUP name." - (let ((newsgroup (gnus-newsgroup-savable-name newsgroup)) - (len (length newsgroup)) - idx) - ;; If this is a foreign group, we don't want to translate the - ;; entire name. - (if (setq idx (string-match ":" newsgroup)) - (aset newsgroup idx ?/) - (setq idx 0)) - ;; Replace all occurrences of `.' with `/'. - (while (< idx len) - (when (= (aref newsgroup idx) ?.) - (aset newsgroup idx ?/)) - (setq idx (1+ idx))) - newsgroup)) - -(defun gnus-newsgroup-savable-name (group) - ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group) - ;; with dots. - (nnheader-replace-chars-in-string group ?/ ?.)) - -(defun gnus-string> (s1 s2) - (not (or (string< s1 s2) - (string= s1 s2)))) - -;;; Time functions. - -(defun gnus-days-between (date1 date2) - ;; Return the number of days between date1 and date2. - (- (gnus-day-number date1) (gnus-day-number date2))) - -(defun gnus-day-number (date) - (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) ) - (timezone-parse-date date)))) - (timezone-absolute-from-gregorian - (nth 1 dat) (nth 2 dat) (car dat)))) - -(defun gnus-time-to-day (time) - "Convert TIME to day number." - (let ((tim (decode-time time))) - (timezone-absolute-from-gregorian - (nth 4 tim) (nth 3 tim) (nth 5 tim)))) - -(defun gnus-encode-date (date) - "Convert DATE to internal time." - (let* ((parse (timezone-parse-date date)) - (date (mapcar (lambda (d) (and d (string-to-int d))) parse)) - (time (mapcar 'string-to-int (timezone-parse-time (aref parse 3))))) - (encode-time (caddr time) (cadr time) (car time) - (caddr date) (cadr date) (car date) - (* 60 (timezone-zone-to-minute (nth 4 date)))))) - -(defun gnus-time-minus (t1 t2) - "Subtract two internal times." - (let ((borrow (< (cadr t1) (cadr t2)))) - (list (- (car t1) (car t2) (if borrow 1 0)) - (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2))))) - -(defun gnus-time-less (t1 t2) - "Say whether time T1 is less than time T2." - (or (< (car t1) (car t2)) - (and (= (car t1) (car t2)) - (< (nth 1 t1) (nth 1 t2))))) - -(defun gnus-file-newer-than (file date) - (let ((fdate (nth 5 (file-attributes file)))) - (or (> (car fdate) (car date)) - (and (= (car fdate) (car date)) - (> (nth 1 fdate) (nth 1 date)))))) - -;;; Keymap macros. - -(defmacro gnus-local-set-keys (&rest plist) - "Set the keys in PLIST in the current keymap." - `(gnus-define-keys-1 (current-local-map) ',plist)) - -(defmacro gnus-define-keys (keymap &rest plist) - "Define all keys in PLIST in KEYMAP." - `(gnus-define-keys-1 (quote ,keymap) (quote ,plist))) - -(defmacro gnus-define-keys-safe (keymap &rest plist) - "Define all keys in PLIST in KEYMAP without overwriting previous definitions." - `(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t)) - -(put 'gnus-define-keys 'lisp-indent-function 1) -(put 'gnus-define-keys-safe 'lisp-indent-function 1) -(put 'gnus-local-set-keys 'lisp-indent-function 1) - -(defmacro gnus-define-keymap (keymap &rest plist) - "Define all keys in PLIST in KEYMAP." - `(gnus-define-keys-1 ,keymap (quote ,plist))) - -(put 'gnus-define-keymap 'lisp-indent-function 1) - -(defun gnus-define-keys-1 (keymap plist &optional safe) - (when (null keymap) - (error "Can't set keys in a null keymap")) - (cond ((symbolp keymap) - (setq keymap (symbol-value keymap))) - ((keymapp keymap)) - ((listp keymap) - (set (car keymap) nil) - (define-prefix-command (car keymap)) - (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap)) - (setq keymap (symbol-value (car keymap))))) - (let (key) - (while plist - (when (symbolp (setq key (pop plist))) - (setq key (symbol-value key))) - (if (or (not safe) - (eq (lookup-key keymap key) 'undefined)) - (define-key keymap key (pop plist)) - (pop plist))))) - -(defun gnus-completing-read (default prompt &rest args) - ;; Like `completing-read', except that DEFAULT is the default argument. - (let* ((prompt (if default - (concat prompt " (default " default ") ") - (concat prompt " "))) - (answer (apply 'completing-read prompt args))) - (if (or (null answer) (zerop (length answer))) - default - answer))) - -;; Two silly functions to ensure that all `y-or-n-p' questions clear -;; the echo area. -(defun gnus-y-or-n-p (prompt) - (prog1 - (y-or-n-p prompt) - (message ""))) - -(defun gnus-yes-or-no-p (prompt) - (prog1 - (yes-or-no-p prompt) - (message ""))) - -;; I suspect there's a better way, but I haven't taken the time to do -;; it yet. -erik selberg@cs.washington.edu -(defun gnus-dd-mmm (messy-date) - "Return a string like DD-MMM from a big messy string" - (let ((datevec (ignore-errors (timezone-parse-date messy-date)))) - (if (not datevec) - "??-???" - (format "%2s-%s" - (condition-case () - ;; Make sure leading zeroes are stripped. - (number-to-string (string-to-number (aref datevec 2))) - (error "??")) - (capitalize - (or (car - (nth (1- (string-to-number (aref datevec 1))) - timezone-months-assoc)) - "???")))))) - -(defmacro gnus-date-get-time (date) - "Convert DATE string to Emacs time. -Cache the result as a text property stored in DATE." - ;; Either return the cached value... - `(let ((d ,date)) - (if (equal "" d) - '(0 0) - (or (get-text-property 0 'gnus-time d) - ;; or compute the value... - (let ((time (nnmail-date-to-time d))) - ;; and store it back in the string. - (put-text-property 0 1 'gnus-time time d) - time))))) - -(defsubst gnus-time-iso8601 (time) - "Return a string of TIME in YYMMDDTHHMMSS format." - (format-time-string "%Y%m%dT%H%M%S" time)) - -(defun gnus-date-iso8601 (header) - "Convert the date field in HEADER to YYMMDDTHHMMSS" - (condition-case () - (gnus-time-iso8601 (gnus-date-get-time (mail-header-date header))) - (error ""))) - -(defun gnus-mode-string-quote (string) - "Quote all \"%\"'s in STRING." - (save-excursion - (gnus-set-work-buffer) - (insert string) - (goto-char (point-min)) - (while (search-forward "%" nil t) - (insert "%")) - (buffer-string))) - -;; Make a hash table (default and minimum size is 256). -;; Optional argument HASHSIZE specifies the table size. -(defun gnus-make-hashtable (&optional hashsize) - (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 256) 256) 0)) - -;; Make a number that is suitable for hashing; bigger than MIN and -;; equal to some 2^x. Many machines (such as sparcs) do not have a -;; hardware modulo operation, so they implement it in software. On -;; many sparcs over 50% of the time to intern is spent in the modulo. -;; Yes, it's slower than actually computing the hash from the string! -;; So we use powers of 2 so people can optimize the modulo to a mask. -(defun gnus-create-hash-size (min) - (let ((i 1)) - (while (< i min) - (setq i (* 2 i))) - i)) - -(defcustom gnus-verbose 7 - "*Integer that says how verbose Gnus should be. -The higher the number, the more messages Gnus will flash to say what -it's doing. At zero, Gnus will be totally mute; at five, Gnus will -display most important messages; and at ten, Gnus will keep on -jabbering all the time." - :group 'gnus-start - :type 'integer) - -;; Show message if message has a lower level than `gnus-verbose'. -;; Guideline for numbers: -;; 1 - error messages, 3 - non-serious error messages, 5 - messages -;; for things that take a long time, 7 - not very important messages -;; on stuff, 9 - messages inside loops. -(defun gnus-message (level &rest args) - (if (<= level gnus-verbose) - (apply 'message args) - ;; 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-error (level &rest args) - "Beep an error if LEVEL is equal to or less than `gnus-verbose'." - (when (<= (floor level) gnus-verbose) - (apply 'message args) - (ding) - (let (duration) - (when (and (floatp level) - (not (zerop (setq duration (* 10 (- level (floor level))))))) - (sit-for duration)))) - nil) - -(defun gnus-split-references (references) - "Return a list of Message-IDs in REFERENCES." - (let ((beg 0) - ids) - (while (string-match "<[^>]+>" references beg) - (push (substring references (match-beginning 0) (setq beg (match-end 0))) - ids)) - (nreverse ids))) - -(defun gnus-parent-id (references &optional n) - "Return the last Message-ID in REFERENCES. -If N, return the Nth ancestor instead." - (when references - (let ((ids (inline (gnus-split-references references)))) - (car (last ids (or n 1)))))) - -(defsubst gnus-buffer-live-p (buffer) - "Say whether BUFFER is alive or not." - (and buffer - (get-buffer buffer) - (buffer-name (get-buffer buffer)))) - -(defun gnus-horizontal-recenter () - "Recenter the current buffer horizontally." - (if (< (current-column) (/ (window-width) 2)) - (set-window-hscroll (get-buffer-window (current-buffer) t) 0) - (let* ((orig (point)) - (end (window-end (get-buffer-window (current-buffer) t))) - (max 0)) - ;; Find the longest line currently displayed in the window. - (goto-char (window-start)) - (while (and (not (eobp)) - (< (point) end)) - (end-of-line) - (setq max (max max (current-column))) - (forward-line 1)) - (goto-char orig) - ;; Scroll horizontally to center (sort of) the point. - (if (> max (window-width)) - (set-window-hscroll - (get-buffer-window (current-buffer) t) - (min (- (current-column) (/ (window-width) 3)) - (+ 2 (- max (window-width))))) - (set-window-hscroll (get-buffer-window (current-buffer) t) 0)) - max))) - -(defun gnus-read-event-char () - "Get the next event." - (let ((event (read-event))) - ;; should be gnus-characterp, but this can't be called in XEmacs anyway - (cons (and (numberp event) event) event))) - -(defun gnus-sortable-date (date) - "Make sortable string by string-lessp from DATE. -Timezone package is used." - (condition-case () - (progn - (setq date (inline (timezone-fix-time - date nil - (aref (inline (timezone-parse-date date)) 4)))) - (inline - (timezone-make-sortable-date - (aref date 0) (aref date 1) (aref date 2) - (inline - (timezone-make-time-string - (aref date 3) (aref date 4) (aref date 5)))))) - (error ""))) - -(defun gnus-copy-file (file &optional to) - "Copy FILE to TO." - (interactive - (list (read-file-name "Copy file: " default-directory) - (read-file-name "Copy file to: " default-directory))) - (unless to - (setq to (read-file-name "Copy file to: " default-directory))) - (when (file-directory-p to) - (setq to (concat (file-name-as-directory to) - (file-name-nondirectory file)))) - (copy-file file to)) - -(defun gnus-kill-all-overlays () - "Delete all overlays in the current buffer." - (unless gnus-xemacs - (let* ((overlayss (overlay-lists)) - (buffer-read-only nil) - (overlays (delq nil (nconc (car overlayss) (cdr overlayss))))) - (while overlays - (delete-overlay (pop overlays)))))) - -(defvar gnus-work-buffer " *gnus work*") - -(defun gnus-set-work-buffer () - "Put point in the empty Gnus work buffer." - (if (get-buffer gnus-work-buffer) - (progn - (set-buffer gnus-work-buffer) - (erase-buffer)) - (set-buffer (get-buffer-create gnus-work-buffer)) - (kill-all-local-variables) - (buffer-disable-undo (current-buffer)))) - -(defmacro gnus-group-real-name (group) - "Find the real name of a foreign newsgroup." - `(let ((gname ,group)) - (if (string-match "^[^:]+:" gname) - (substring gname (match-end 0)) - gname))) - -(defun gnus-make-sort-function (funs) - "Return a composite sort condition based on the functions in FUNC." - (cond - ((not (listp funs)) funs) - ((null funs) funs) - ((cdr funs) - `(lambda (t1 t2) - ,(gnus-make-sort-function-1 (reverse funs)))) - (t - (car funs)))) - -(defun gnus-make-sort-function-1 (funs) - "Return a composite sort condition based on the functions in FUNC." - (if (cdr funs) - `(or (,(car funs) t1 t2) - (and (not (,(car funs) t2 t1)) - ,(gnus-make-sort-function-1 (cdr funs)))) - `(,(car funs) t1 t2))) - -(defun gnus-turn-off-edit-menu (type) - "Turn off edit menu in `gnus-TYPE-mode-map'." - (define-key (symbol-value (intern (format "gnus-%s-mode-map" type))) - [menu-bar edit] 'undefined)) - -(defun gnus-prin1 (form) - "Use `prin1' on FORM in the current buffer. -Bind `print-quoted' to t while printing." - (let ((print-quoted t) - print-level print-length) - (prin1 form (current-buffer)))) - -(defun gnus-prin1-to-string (form) - "The same as `prin1', but but `print-quoted' to t." - (let ((print-quoted t)) - (prin1-to-string form))) - -(defun gnus-make-directory (directory) - "Make DIRECTORY (and all its parents) if it doesn't exist." - (when (and directory - (not (file-exists-p directory))) - (make-directory directory t)) - t) - -(defun gnus-write-buffer (file) - "Write the current buffer's contents to FILE." - ;; Make sure the directory exists. - (gnus-make-directory (file-name-directory file)) - ;; Write the buffer. - (write-region (point-min) (point-max) file nil 'quietly)) - -(defmacro gnus-delete-assq (key list) - `(let ((listval (eval ,list))) - (setq ,list (delq (assq ,key listval) listval)))) - -(defmacro gnus-delete-assoc (key list) - `(let ((listval ,list)) - (setq ,list (delq (assoc ,key listval) listval)))) - -(defun gnus-delete-file (file) - "Delete FILE if it exists." - (when (file-exists-p file) - (delete-file file))) - -(defun gnus-strip-whitespace (string) - "Return STRING stripped of all whitespace." - (while (string-match "[\r\n\t ]+" string) - (setq string (replace-match "" t t string))) - string) - -(defun gnus-put-text-property-excluding-newlines (beg end prop val) - "The same as `put-text-property', but don't put this prop on any newlines in the region." - (save-match-data - (save-excursion - (save-restriction - (goto-char beg) - (while (re-search-forward "[ \t]*\n" end 'move) - (put-text-property beg (match-beginning 0) prop val) - (setq beg (point))) - (put-text-property beg (point) prop val))))) - -;;; Protected and atomic operations. dmoore@ucsd.edu 21.11.1996 -;;; The primary idea here is to try to protect internal datastructures -;;; from becoming corrupted when the user hits C-g, or if a hook or -;;; similar blows up. Often in Gnus multiple tables/lists need to be -;;; updated at the same time, or information can be lost. - -(defvar gnus-atomic-be-safe t - "If t, certain operations will be protected from interruption by C-g.") - -(defmacro gnus-atomic-progn (&rest forms) - "Evaluate FORMS atomically, which means to protect the evaluation -from being interrupted by the user. An error from the forms themselves -will return without finishing the operation. Since interrupts from -the user are disabled, it is recommended that only the most minimal -operations are performed by FORMS. If you wish to assign many -complicated values atomically, compute the results into temporary -variables and then do only the assignment atomically." - `(let ((inhibit-quit gnus-atomic-be-safe)) - ,@forms)) - -(put 'gnus-atomic-progn 'lisp-indent-function 0) - -(defmacro gnus-atomic-progn-assign (protect &rest forms) - "Evaluate FORMS, but insure that the variables listed in PROTECT -are not changed if anything in FORMS signals an error or otherwise -non-locally exits. The variables listed in PROTECT are updated atomically. -It is safe to use gnus-atomic-progn-assign with long computations. - -Note that if any of the symbols in PROTECT were unbound, they will be -set to nil on a sucessful assignment. In case of an error or other -non-local exit, it will still be unbound." - (let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol - (concat (symbol-name x) - "-tmp")) - x)) - protect)) - (sym-temp-map (mapcar (lambda (x) (list (cadr x) (car x))) - temp-sym-map)) - (temp-sym-let (mapcar (lambda (x) (list (car x) - `(and (boundp ',(cadr x)) - ,(cadr x)))) - temp-sym-map)) - (sym-temp-let sym-temp-map) - (temp-sym-assign (apply 'append temp-sym-map)) - (sym-temp-assign (apply 'append sym-temp-map)) - (result (make-symbol "result-tmp"))) - `(let (,@temp-sym-let - ,result) - (let ,sym-temp-let - (setq ,result (progn ,@forms)) - (setq ,@temp-sym-assign)) - (let ((inhibit-quit gnus-atomic-be-safe)) - (setq ,@sym-temp-assign)) - ,result))) - -(put 'gnus-atomic-progn-assign 'lisp-indent-function 1) -;(put 'gnus-atomic-progn-assign 'edebug-form-spec '(sexp body)) - -(defmacro gnus-atomic-setq (&rest pairs) - "Similar to setq, except that the real symbols are only assigned when -there are no errors. And when the real symbols are assigned, they are -done so atomically. If other variables might be changed via side-effect, -see gnus-atomic-progn-assign. It is safe to use gnus-atomic-setq -with potentially long computations." - (let ((tpairs pairs) - syms) - (while tpairs - (push (car tpairs) syms) - (setq tpairs (cddr tpairs))) - `(gnus-atomic-progn-assign ,syms - (setq ,@pairs)))) - -;(put 'gnus-atomic-setq 'edebug-form-spec '(body)) - - -;;; Functions for saving to babyl/mail files. - -(defvar rmail-default-rmail-file) -(defun gnus-output-to-rmail (filename &optional ask) - "Append the current article to an Rmail file named FILENAME." - (require 'rmail) - ;; Most of these codes are borrowed from rmailout.el. - (setq filename (expand-file-name filename)) - (setq rmail-default-rmail-file filename) - (let ((artbuf (current-buffer)) - (tmpbuf (get-buffer-create " *Gnus-output*"))) - (save-excursion - (or (get-file-buffer filename) - (file-exists-p filename) - (if (or (not ask) - (gnus-yes-or-no-p - (concat "\"" filename "\" does not exist, create it? "))) - (let ((file-buffer (create-file-buffer filename))) - (save-excursion - (set-buffer file-buffer) - (rmail-insert-rmail-file-header) - (let ((require-final-newline nil)) - (gnus-write-buffer filename))) - (kill-buffer file-buffer)) - (error "Output file does not exist"))) - (set-buffer tmpbuf) - (erase-buffer) - (insert-buffer-substring artbuf) - (gnus-convert-article-to-rmail) - ;; Decide whether to append to a file or to an Emacs buffer. - (let ((outbuf (get-file-buffer filename))) - (if (not outbuf) - (append-to-file (point-min) (point-max) filename) - ;; File has been visited, in buffer OUTBUF. - (set-buffer outbuf) - (let ((buffer-read-only nil) - (msg (and (boundp 'rmail-current-message) - (symbol-value 'rmail-current-message)))) - ;; If MSG is non-nil, buffer is in RMAIL mode. - (when msg - (widen) - (narrow-to-region (point-max) (point-max))) - (insert-buffer-substring tmpbuf) - (when msg - (goto-char (point-min)) - (widen) - (search-backward "\^_") - (narrow-to-region (point) (point-max)) - (goto-char (1+ (point-min))) - (rmail-count-new-messages t) - (rmail-show-message msg)))))) - (kill-buffer tmpbuf))) - -(defun gnus-output-to-mail (filename &optional ask) - "Append the current article to a mail file named FILENAME." - (setq filename (expand-file-name filename)) - (let ((artbuf (current-buffer)) - (tmpbuf (get-buffer-create " *Gnus-output*"))) - (save-excursion - ;; Create the file, if it doesn't exist. - (when (and (not (get-file-buffer filename)) - (not (file-exists-p filename))) - (if (or (not ask) - (gnus-y-or-n-p - (concat "\"" filename "\" does not exist, create it? "))) - (let ((file-buffer (create-file-buffer filename))) - (save-excursion - (set-buffer file-buffer) - (let ((require-final-newline nil)) - (gnus-write-buffer filename))) - (kill-buffer file-buffer)) - (error "Output file does not exist"))) - (set-buffer tmpbuf) - (erase-buffer) - (insert-buffer-substring artbuf) - (goto-char (point-min)) - (if (looking-at "From ") - (forward-line 1) - (insert "From nobody " (current-time-string) "\n")) - (let (case-fold-search) - (while (re-search-forward "^From " nil t) - (beginning-of-line) - (insert ">"))) - ;; Decide whether to append to a file or to an Emacs buffer. - (let ((outbuf (get-file-buffer filename))) - (if (not outbuf) - (let ((buffer-read-only nil)) - (save-excursion - (goto-char (point-max)) - (forward-char -2) - (unless (looking-at "\n\n") - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (insert "\n")) - (goto-char (point-max)) - (append-to-file (point-min) (point-max) filename))) - ;; File has been visited, in buffer OUTBUF. - (set-buffer outbuf) - (let ((buffer-read-only nil)) - (goto-char (point-max)) - (unless (eobp) - (insert "\n")) - (insert "\n") - (insert-buffer-substring tmpbuf))))) - (kill-buffer tmpbuf))) - -(defun gnus-convert-article-to-rmail () - "Convert article in current buffer to Rmail message format." - (let ((buffer-read-only nil)) - ;; Convert article directly into Babyl format. - (goto-char (point-min)) - (insert "\^L\n0, unseen,,\n*** EOOH ***\n") - (while (search-forward "\n\^_" nil t) ;single char - (replace-match "\n^_" t t)) ;2 chars: "^" and "_" - (goto-char (point-max)) - (insert "\^_"))) - -(provide 'gnus-util) - -;;; gnus-util.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-uu.el --- a/lisp/gnus/gnus-uu.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2038 +0,0 @@ -;;; gnus-uu.el --- extract (uu)encoded files in Gnus -;; Copyright (C) 1985,86,87,93,94,95,96,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Created: 2 Oct 1993 -;; Keyword: 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) -(require 'gnus-art) -(require 'message) -(require 'gnus-msg) - -(defgroup gnus-extract nil - "Extracting encoded files." - :prefix "gnus-uu-" - :group 'gnus) - -(defgroup gnus-extract-view nil - "Viewwing extracted files." - :group 'gnus-extract) - -(defgroup gnus-extract-archive nil - "Extracting encoded archives." - :group 'gnus-extract) - -(defgroup gnus-extract-post nil - "Extracting encoded archives." - :prefix "gnus-uu-post" - :group 'gnus-extract) - -;; Default viewing action rules - -(defcustom gnus-uu-default-view-rules - '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/\r//g") - ("\\.pas$" "cat %s | sed s/\r//g") - ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g") - ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv") - ("\\.tga$" "tgatoppm %s | xv -") - ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$" - "sox -v .5 %s -t .au -u - > /dev/audio") - ("\\.au$" "cat %s > /dev/audio") - ("\\.midi?$" "playmidi -f") - ("\\.mod$" "str32") - ("\\.ps$" "ghostview") - ("\\.dvi$" "xdvi") - ("\\.html$" "xmosaic") - ("\\.mpe?g$" "mpeg_play") - ("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim") - ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$" - "gnus-uu-archive")) - "Default actions to be taken when the user asks to view a file. -To change the behaviour, you can either edit this variable or set -`gnus-uu-user-view-rules' to something useful. - -For example: - -To make gnus-uu use 'xli' to display JPEG and GIF files, put the -following in your .emacs file: - - (setq gnus-uu-user-view-rules '((\"jpg$\\\\|gif$\" \"xli\"))) - -Both these variables are lists of lists with two string elements. The -first string is a regular expression. If the file name matches this -regular expression, the command in the second string is executed with -the file as an argument. - -If the command string contains \"%s\", the file name will be inserted -at that point in the command string. If there's no \"%s\" in the -command string, the file name will be appended to the command string -before executing. - -There are several user variables to tailor the behaviour of gnus-uu to -your needs. First we have `gnus-uu-user-view-rules', which is the -variable gnus-uu first consults when trying to decide how to view a -file. If this variable contains no matches, gnus-uu examines the -default rule variable provided in this package. If gnus-uu finds no -match here, it uses `gnus-uu-user-view-rules-end' to try to make a -match." - :group 'gnus-extract-view - :type '(repeat (group regexp (string :tag "Command")))) - -(defcustom gnus-uu-user-view-rules nil - "What actions are to be taken to view a file. -See the documentation on the `gnus-uu-default-view-rules' variable for -details." - :group 'gnus-extract-view - :type '(repeat (group regexp (string :tag "Command")))) - -(defcustom gnus-uu-user-view-rules-end - '(("" "file")) - "What actions are to be taken if no rule matched the file name. -See the documentation on the `gnus-uu-default-view-rules' variable for -details." - :group 'gnus-extract-view - :type '(repeat (group regexp (string :tag "Command")))) - -;; Default unpacking commands - -(defcustom gnus-uu-default-archive-rules - '(("\\.tar$" "tar xf") - ("\\.zip$" "unzip -o") - ("\\.ar$" "ar x") - ("\\.arj$" "unarj x") - ("\\.zoo$" "zoo -e") - ("\\.\\(lzh\\|lha\\)$" "lha x") - ("\\.Z$" "uncompress") - ("\\.gz$" "gunzip") - ("\\.arc$" "arc -x")) - "See `gnus-uu-user-archive-rules'." - :group 'gnus-extract-archive - :type '(repeat (group regexp (string :tag "Command")))) - -(defvar gnus-uu-destructive-archivers - (list "uncompress" "gunzip")) - -(defcustom gnus-uu-user-archive-rules nil - "A list that can be set to override the default archive unpacking commands. -To use, for instance, 'untar' to unpack tar files and 'zip -x' to -unpack zip files, say the following: - (setq gnus-uu-user-archive-rules - '((\"\\\\.tar$\" \"untar\") - (\"\\\\.zip$\" \"zip -x\")))" - :group 'gnus-extract-archive - :type '(repeat (group regexp (string :tag "Command")))) - -(defcustom gnus-uu-ignore-files-by-name nil - "*A regular expression saying what files should not be viewed based on name. -If, for instance, you want gnus-uu to ignore all .au and .wav files, -you could say something like - - (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\") - -Note that this variable can be used in conjunction with the -`gnus-uu-ignore-files-by-type' variable." - :group 'gnus-extract - :type '(choice (const :tag "off" nil) - (regexp :format "%v"))) - -(defcustom gnus-uu-ignore-files-by-type nil - "*A regular expression saying what files that shouldn't be viewed, based on MIME file type. -If, for instance, you want gnus-uu to ignore all audio files and all mpegs, -you could say something like - - (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\") - -Note that this variable can be used in conjunction with the -`gnus-uu-ignore-files-by-name' variable." - :group 'gnus-extract - :type '(choice (const :tag "off" nil) - (regexp :format "%v"))) - -;; Pseudo-MIME support - -(defconst gnus-uu-ext-to-mime-list - '(("\\.gif$" "image/gif") - ("\\.jpe?g$" "image/jpeg") - ("\\.tiff?$" "image/tiff") - ("\\.xwd$" "image/xwd") - ("\\.pbm$" "image/pbm") - ("\\.pgm$" "image/pgm") - ("\\.ppm$" "image/ppm") - ("\\.xbm$" "image/xbm") - ("\\.pcx$" "image/pcx") - ("\\.tga$" "image/tga") - ("\\.ps$" "image/postscript") - ("\\.fli$" "video/fli") - ("\\.wav$" "audio/wav") - ("\\.aiff$" "audio/aiff") - ("\\.hcom$" "audio/hcom") - ("\\.voc$" "audio/voc") - ("\\.smp$" "audio/smp") - ("\\.mod$" "audio/mod") - ("\\.dvi$" "image/dvi") - ("\\.mpe?g$" "video/mpeg") - ("\\.au$" "audio/basic") - ("\\.\\(te?xt\\|doc\\|c\\|h\\)$" "text/plain") - ("\\.\\(c\\|h\\)$" "text/source") - ("read.*me" "text/plain") - ("\\.html$" "text/html") - ("\\.bat$" "text/bat") - ("\\.[1-6]$" "text/man") - ("\\.flc$" "video/flc") - ("\\.rle$" "video/rle") - ("\\.pfx$" "video/pfx") - ("\\.avi$" "video/avi") - ("\\.sme$" "video/sme") - ("\\.rpza$" "video/prza") - ("\\.dl$" "video/dl") - ("\\.qt$" "video/qt") - ("\\.rsrc$" "video/rsrc") - ("\\..*$" "unknown/unknown"))) - -;; Various variables users may set - -(defcustom gnus-uu-tmp-dir "/tmp/" - "*Variable saying where gnus-uu is to do its work. -Default is \"/tmp/\"." - :group 'gnus-extract - :type 'directory) - -(defcustom gnus-uu-do-not-unpack-archives nil - "*Non-nil means that gnus-uu won't peek inside archives looking for files to display. -Default is nil." - :group 'gnus-extract-archive - :type 'boolean) - -(defcustom gnus-uu-ignore-default-view-rules nil - "*Non-nil means that gnus-uu will ignore the default viewing rules. -Only the user viewing rules will be consulted. Default is nil." - :group 'gnus-extract-view - :type 'boolean) - -(defcustom gnus-uu-grabbed-file-functions nil - "Functions run on each file after successful decoding. -They will be called with the name of the file as the argument. -Likely functions you can use in this list are `gnus-uu-grab-view' -and `gnus-uu-grab-move'." - :group 'gnus-extract - :options '(gnus-uu-grab-view gnus-uu-grab-move) - :type 'hook) - -(defcustom gnus-uu-ignore-default-archive-rules nil - "*Non-nil means that gnus-uu will ignore the default archive unpacking commands. -Only the user unpacking commands will be consulted. Default is nil." - :group 'gnus-extract-archive - :type 'boolean) - -(defcustom gnus-uu-kill-carriage-return t - "*Non-nil means that gnus-uu will strip all carriage returns from articles. -Default is t." - :group 'gnus-extract - :type 'boolean) - -(defcustom gnus-uu-view-with-metamail nil - "*Non-nil means that files will be viewed with metamail. -The gnus-uu viewing functions will be ignored and gnus-uu will try -to guess at a content-type based on file name suffixes. Default -it nil." - :group 'gnus-extract - :type 'boolean) - -(defcustom gnus-uu-unmark-articles-not-decoded nil - "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread. -Default is nil." - :group 'gnus-extract - :type 'boolean) - -(defcustom gnus-uu-correct-stripped-uucode nil - "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted. -Default is nil." - :group 'gnus-extract - :type 'boolean) - -(defcustom gnus-uu-save-in-digest nil - "*Non-nil means that gnus-uu, when asked to save without decoding, will save in digests. -If this variable is nil, gnus-uu will just save everything in a -file without any embellishments. The digesting almost conforms to RFC1153 - -no easy way to specify any meaningful volume and issue numbers were found, -so I simply dropped them." - :group 'gnus-extract - :type 'boolean) - -(defcustom gnus-uu-digest-headers - '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:" - "^Summary:" "^References:") - "List of regexps to match headers included in digested messages. -The headers will be included in the sequence they are matched." - :group 'gnus-extract - :type '(repeat regexp)) - -(defcustom gnus-uu-save-separate-articles nil - "*Non-nil means that gnus-uu will save articles in separate files." - :group 'gnus-extract - :type 'boolean) - -(defcustom gnus-uu-be-dangerous 'ask - "*Specifies what to do if unusual situations arise during decoding. -If nil, be as conservative as possible. If t, ignore things that -didn't work, and overwrite existing files. Otherwise, ask each time." - :group 'gnus-extract - :type '(choice (const :tag "conservative" nil) - (const :tag "ask" ask) - (const :tag "liberal" t))) - -;; Internal variables - -(defvar gnus-uu-saved-article-name nil) - -(defconst gnus-uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") -(defconst gnus-uu-end-string "^end[ \t]*$") - -(defconst gnus-uu-body-line "^M") -(let ((i 61)) - (while (> (setq i (1- i)) 0) - (setq gnus-uu-body-line (concat gnus-uu-body-line "[^a-z]"))) - (setq gnus-uu-body-line (concat gnus-uu-body-line ".?$"))) - -;"^M.............................................................?$" - -(defconst gnus-uu-shar-begin-string "^#! */bin/sh") - -(defvar gnus-uu-shar-file-name nil) -(defconst gnus-uu-shar-name-marker "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)") - -(defconst gnus-uu-postscript-begin-string "^%!PS-") -(defconst gnus-uu-postscript-end-string "^%%EOF$") - -(defvar gnus-uu-file-name nil) -(defconst gnus-uu-uudecode-process nil) -(defvar gnus-uu-binhex-article-name nil) - -(defvar gnus-uu-work-dir nil) - -(defconst gnus-uu-output-buffer-name " *Gnus UU Output*") - -(defvar gnus-uu-default-dir gnus-article-save-directory) -(defvar gnus-uu-digest-from-subject nil) - -;; Keymaps - -(gnus-define-keys (gnus-uu-mark-map "P" gnus-summary-mark-map) - "p" gnus-summary-mark-as-processable - "u" gnus-summary-unmark-as-processable - "U" gnus-summary-unmark-all-processable - "v" gnus-uu-mark-over - "s" gnus-uu-mark-series - "r" gnus-uu-mark-region - "R" gnus-uu-mark-by-regexp - "t" gnus-uu-mark-thread - "T" gnus-uu-unmark-thread - "a" gnus-uu-mark-all - "b" gnus-uu-mark-buffer - "S" gnus-uu-mark-sparse - "k" gnus-summary-kill-process-mark - "y" gnus-summary-yank-process-mark - "w" gnus-summary-save-process-mark - "i" gnus-uu-invert-processable) - -(gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map) - ;;"x" gnus-uu-extract-any - ;;"m" gnus-uu-extract-mime - "u" gnus-uu-decode-uu - "U" gnus-uu-decode-uu-and-save - "s" gnus-uu-decode-unshar - "S" gnus-uu-decode-unshar-and-save - "o" gnus-uu-decode-save - "O" gnus-uu-decode-save - "b" gnus-uu-decode-binhex - "B" gnus-uu-decode-binhex - "p" gnus-uu-decode-postscript - "P" gnus-uu-decode-postscript-and-save) - -(gnus-define-keys - (gnus-uu-extract-view-map "v" gnus-uu-extract-map) - "u" gnus-uu-decode-uu-view - "U" gnus-uu-decode-uu-and-save-view - "s" gnus-uu-decode-unshar-view - "S" gnus-uu-decode-unshar-and-save-view - "o" gnus-uu-decode-save-view - "O" gnus-uu-decode-save-view - "b" gnus-uu-decode-binhex-view - "B" gnus-uu-decode-binhex-view - "p" gnus-uu-decode-postscript-view - "P" gnus-uu-decode-postscript-and-save-view) - - -;; Commands. - -(defun gnus-uu-decode-uu (&optional n) - "Uudecodes the current article." - (interactive "P") - (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n)) - -(defun gnus-uu-decode-uu-and-save (n dir) - "Decodes and saves the resulting file." - (interactive - (list current-prefix-arg - (file-name-as-directory - (read-file-name "Uudecode and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t)))) - (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n dir nil nil t)) - -(defun gnus-uu-decode-unshar (&optional n) - "Unshars the current article." - (interactive "P") - (gnus-uu-decode-with-method 'gnus-uu-unshar-article n nil nil 'scan t)) - -(defun gnus-uu-decode-unshar-and-save (n dir) - "Unshars and saves the current article." - (interactive - (list current-prefix-arg - (file-name-as-directory - (read-file-name "Unshar and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t)))) - (gnus-uu-decode-with-method 'gnus-uu-unshar-article n dir nil 'scan t)) - -(defun gnus-uu-decode-save (n file) - "Saves the current article." - (interactive - (list current-prefix-arg - (read-file-name - (if gnus-uu-save-separate-articles - "Save articles is dir: " - "Save articles in file: ") - gnus-uu-default-dir - gnus-uu-default-dir))) - (setq gnus-uu-saved-article-name file) - (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t)) - -(defun gnus-uu-decode-binhex (n dir) - "Unbinhexes the current article." - (interactive - (list current-prefix-arg - (file-name-as-directory - (read-file-name "Unbinhex and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir)))) - (setq gnus-uu-binhex-article-name - (make-temp-name (concat gnus-uu-work-dir "binhex"))) - (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir)) - -(defun gnus-uu-decode-uu-view (&optional n) - "Uudecodes and views the current article." - (interactive "P") - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-uu n))) - -(defun gnus-uu-decode-uu-and-save-view (n dir) - "Decodes, views and saves the resulting file." - (interactive - (list current-prefix-arg - (read-file-name "Uudecode, view and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t))) - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-uu-and-save n dir))) - -(defun gnus-uu-decode-unshar-view (&optional n) - "Unshars and views the current article." - (interactive "P") - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-unshar n))) - -(defun gnus-uu-decode-unshar-and-save-view (n dir) - "Unshars and saves the current article." - (interactive - (list current-prefix-arg - (read-file-name "Unshar, view and save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t))) - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-unshar-and-save n dir))) - -(defun gnus-uu-decode-save-view (n file) - "Saves and views the current article." - (interactive - (list current-prefix-arg - (read-file-name (if gnus-uu-save-separate-articles - "Save articles is dir: " - "Save articles in file: ") - gnus-uu-default-dir gnus-uu-default-dir))) - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-save n file))) - -(defun gnus-uu-decode-binhex-view (n file) - "Unbinhexes and views the current article." - (interactive - (list current-prefix-arg - (read-file-name "Unbinhex, view and save in dir: " - gnus-uu-default-dir gnus-uu-default-dir))) - (setq gnus-uu-binhex-article-name - (make-temp-name (concat gnus-uu-work-dir "binhex"))) - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-binhex n file))) - - -;; Digest and forward articles - -(defun gnus-uu-digest-mail-forward (&optional n post) - "Digests and forwards all articles in this series." - (interactive "P") - (let ((gnus-uu-save-in-digest t) - (file (make-temp-name (nnheader-concat gnus-uu-tmp-dir "forward"))) - buf subject from newsgroups) - (gnus-setup-message 'forward - (setq gnus-uu-digest-from-subject nil) - (gnus-uu-decode-save n file) - (setq buf (switch-to-buffer (get-buffer-create " *gnus-uu-forward*"))) - (gnus-add-current-to-buffer-list) - (erase-buffer) - (insert-file file) - (let ((fs gnus-uu-digest-from-subject)) - (when fs - (setq from (caar fs) - subject (gnus-simplify-subject-fuzzy (cdar fs)) - fs (cdr fs)) - (while (and fs (or from subject)) - (when from - (unless (string= from (caar fs)) - (setq from nil))) - (when subject - (unless (string= (gnus-simplify-subject-fuzzy (cdar fs)) - subject) - (setq subject nil))) - (setq fs (cdr fs)))) - (unless subject - (setq subject "Digested Articles")) - (unless from - (setq from - (if (gnus-news-group-p gnus-newsgroup-name) - gnus-newsgroup-name - "Various")))) - (goto-char (point-min)) - (when (re-search-forward "^Subject: ") - (delete-region (point) (gnus-point-at-eol)) - (insert subject)) - (goto-char (point-min)) - (when (re-search-forward "^From: ") - (delete-region (point) (gnus-point-at-eol)) - (insert from)) - (message-forward post)) - (delete-file file) - (kill-buffer buf) - (setq gnus-uu-digest-from-subject nil))) - -(defun gnus-uu-digest-post-forward (&optional n) - "Digest and forward to a newsgroup." - (interactive "P") - (gnus-uu-digest-mail-forward n t)) - -;; Process marking. - -(defun gnus-uu-mark-by-regexp (regexp &optional unmark) - "Ask for a regular expression and set the process mark on all articles that match." - (interactive (list (read-from-minibuffer "Mark (regexp): "))) - (gnus-set-global-variables) - (let ((articles (gnus-uu-find-articles-matching regexp))) - (while articles - (if unmark - (gnus-summary-remove-process-mark (pop articles)) - (gnus-summary-set-process-mark (pop articles)))) - (message "")) - (gnus-summary-position-point)) - -(defun gnus-uu-unmark-by-regexp (regexp &optional unmark) - "Ask for a regular expression and remove the process mark on all articles that match." - (interactive (list (read-from-minibuffer "Mark (regexp): "))) - (gnus-uu-mark-by-regexp regexp t)) - -(defun gnus-uu-mark-series () - "Mark the current series with the process mark." - (interactive) - (gnus-set-global-variables) - (let ((articles (gnus-uu-find-articles-matching))) - (while articles - (gnus-summary-set-process-mark (car articles)) - (setq articles (cdr articles))) - (message "")) - (gnus-summary-position-point)) - -(defun gnus-uu-mark-region (beg end &optional unmark) - "Set the process mark on all articles between point and mark." - (interactive "r") - (gnus-set-global-variables) - (save-excursion - (goto-char beg) - (while (< (point) end) - (if unmark - (gnus-summary-remove-process-mark (gnus-summary-article-number)) - (gnus-summary-set-process-mark (gnus-summary-article-number))) - (forward-line 1))) - (gnus-summary-position-point)) - -(defun gnus-uu-unmark-region (beg end) - "Remove the process mark from all articles between point and mark." - (interactive "r") - (gnus-uu-mark-region beg end t)) - -(defun gnus-uu-mark-buffer () - "Set the process mark on all articles in the buffer." - (interactive) - (gnus-uu-mark-region (point-min) (point-max))) - -(defun gnus-uu-unmark-buffer () - "Remove the process mark on all articles in the buffer." - (interactive) - (gnus-uu-mark-region (point-min) (point-max) t)) - -(defun gnus-uu-mark-thread () - "Marks all articles downwards in this thread." - (interactive) - (gnus-set-global-variables) - (let ((level (gnus-summary-thread-level))) - (while (and (gnus-summary-set-process-mark (gnus-summary-article-number)) - (zerop (gnus-summary-next-subject 1)) - (> (gnus-summary-thread-level) level)))) - (gnus-summary-position-point)) - -(defun gnus-uu-unmark-thread () - "Unmarks all articles downwards in this thread." - (interactive) - (gnus-set-global-variables) - (let ((level (gnus-summary-thread-level))) - (while (and (gnus-summary-remove-process-mark - (gnus-summary-article-number)) - (zerop (gnus-summary-next-subject 1)) - (> (gnus-summary-thread-level) level)))) - (gnus-summary-position-point)) - -(defun gnus-uu-invert-processable () - "Invert the list of process-marked articles." - (let ((data gnus-newsgroup-data) - d number) - (save-excursion - (while data - (if (memq (setq number (gnus-data-number (pop data))) - gnus-newsgroup-processable) - (gnus-summary-remove-process-mark number) - (gnus-summary-set-process-mark number))))) - (gnus-summary-position-point)) - -(defun gnus-uu-mark-over (&optional score) - "Mark all articles with a score over SCORE (the prefix.)" - (interactive "P") - (let ((score (gnus-score-default score)) - (data gnus-newsgroup-data)) - (save-excursion - (while data - (when (> (or (cdr (assq (gnus-data-number (car data)) - gnus-newsgroup-scored)) - gnus-summary-default-score 0) - score) - (gnus-summary-set-process-mark (caar data))) - (setq data (cdr data)))) - (gnus-summary-position-point))) - -(defun gnus-uu-mark-sparse () - "Mark all series that have some articles marked." - (interactive) - (gnus-set-global-variables) - (let ((marked (nreverse gnus-newsgroup-processable)) - subject articles total headers) - (unless marked - (error "No articles marked with the process mark")) - (setq gnus-newsgroup-processable nil) - (save-excursion - (while marked - (and (vectorp (setq headers - (gnus-summary-article-header (car marked)))) - (setq subject (mail-header-subject headers) - articles (gnus-uu-find-articles-matching - (gnus-uu-reginize-string subject)) - total (nconc total articles))) - (while articles - (gnus-summary-set-process-mark (car articles)) - (setcdr marked (delq (car articles) (cdr marked))) - (setq articles (cdr articles))) - (setq marked (cdr marked))) - (setq gnus-newsgroup-processable (nreverse total))) - (gnus-summary-position-point))) - -(defun gnus-uu-mark-all () - "Mark all articles in \"series\" order." - (interactive) - (gnus-set-global-variables) - (setq gnus-newsgroup-processable nil) - (save-excursion - (let ((data gnus-newsgroup-data) - number) - (while data - (when (and (not (memq (setq number (gnus-data-number (car data))) - gnus-newsgroup-processable)) - (vectorp (gnus-data-header (car data)))) - (gnus-summary-goto-subject number) - (gnus-uu-mark-series)) - (setq data (cdr data))))) - (gnus-summary-position-point)) - -;; All PostScript functions written by Erik Selberg . - -(defun gnus-uu-decode-postscript (&optional n) - "Gets postscript of the current article." - (interactive "P") - (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n)) - -(defun gnus-uu-decode-postscript-view (&optional n) - "Gets and views the current article." - (interactive "P") - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-postscript n))) - -(defun gnus-uu-decode-postscript-and-save (n dir) - "Extracts postscript and saves the current article." - (interactive - (list current-prefix-arg - (file-name-as-directory - (read-file-name "Save in dir: " - gnus-uu-default-dir - gnus-uu-default-dir t)))) - (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article - n dir nil nil t)) - -(defun gnus-uu-decode-postscript-and-save-view (n dir) - "Decodes, views and saves the resulting file." - (interactive - (list current-prefix-arg - (read-file-name "Where do you want to save the file(s)? " - gnus-uu-default-dir - gnus-uu-default-dir t))) - (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic))) - (gnus-uu-decode-postscript-and-save n dir))) - - -;; Internal functions. - -(defun gnus-uu-decode-with-method (method n &optional save not-insert - scan cdir) - (gnus-uu-initialize scan) - (when save - (setq gnus-uu-default-dir save)) - ;; Create the directory we save to. - (when (and scan cdir save - (not (file-exists-p save))) - (make-directory save t)) - (let ((articles (gnus-uu-get-list-of-articles n)) - files) - (setq files (gnus-uu-grab-articles articles method t)) - (let ((gnus-current-article (car articles))) - (when scan - (setq files (gnus-uu-scan-directory gnus-uu-work-dir)))) - (when save - (gnus-uu-save-files files save)) - (when (eq gnus-uu-do-not-unpack-archives nil) - (setq files (gnus-uu-unpack-files files))) - (setq files (nreverse (gnus-uu-get-actions files))) - (or not-insert (not gnus-insert-pseudo-articles) - (gnus-summary-insert-pseudos files save)))) - -(defun gnus-uu-scan-directory (dir &optional rec) - "Return a list of all files under DIR." - (let ((files (directory-files dir t)) - out file) - (while (setq file (pop files)) - (unless (member (file-name-nondirectory file) '("." "..")) - (push (list (cons 'name file) - (cons 'article gnus-current-article)) - out) - (when (file-directory-p file) - (setq out (nconc (gnus-uu-scan-directory file t) out))))) - (if rec - out - (nreverse out)))) - -(defun gnus-uu-save-files (files dir) - "Save FILES in DIR." - (let ((len (length files)) - (reg (concat "^" (regexp-quote gnus-uu-work-dir))) - to-file file fromdir) - (while (setq file (cdr (assq 'name (pop files)))) - (when (file-exists-p file) - (string-match reg file) - (setq fromdir (substring file (match-end 0))) - (if (file-directory-p file) - (gnus-make-directory (concat dir fromdir)) - (setq to-file (concat dir fromdir)) - (when (or (not (file-exists-p to-file)) - (eq gnus-uu-be-dangerous t) - (and gnus-uu-be-dangerous - (gnus-y-or-n-p (format "%s exists; overwrite? " - to-file)))) - (copy-file file to-file t t))))) - (gnus-message 5 "Saved %d file%s" len (if (= len 1) "" "s")))) - -;; Functions for saving and possibly digesting articles without -;; any decoding. - -;; Function called by gnus-uu-grab-articles to treat each article. -(defun gnus-uu-save-article (buffer in-state) - (cond - (gnus-uu-save-separate-articles - (save-excursion - (set-buffer buffer) - (gnus-write-buffer - (concat gnus-uu-saved-article-name gnus-current-article)) - (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) - ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name - 'begin 'end)) - ((eq in-state 'last) (list 'end)) - (t (list 'middle))))) - ((not gnus-uu-save-in-digest) - (save-excursion - (set-buffer buffer) - (write-region (point-min) (point-max) gnus-uu-saved-article-name t) - (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) - ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name - 'begin 'end)) - ((eq in-state 'last) (list 'end)) - (t (list 'middle))))) - (t - (let ((header (gnus-summary-article-header))) - (push (cons (mail-header-from header) - (mail-header-subject header)) - gnus-uu-digest-from-subject)) - (let ((name (file-name-nondirectory gnus-uu-saved-article-name)) - (delim (concat "^" (make-string 30 ?-) "$")) - beg subj headers headline sorthead body end-string state) - (if (or (eq in-state 'first) - (eq in-state 'first-and-last)) - (progn - (setq state (list 'begin)) - (save-excursion (set-buffer (get-buffer-create "*gnus-uu-body*")) - (erase-buffer)) - (save-excursion - (set-buffer (get-buffer-create "*gnus-uu-pre*")) - (erase-buffer) - (insert (format - "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n" - (current-time-string) name name)))) - (when (not (eq in-state 'end)) - (setq state (list 'middle)))) - (save-excursion - (set-buffer (get-buffer "*gnus-uu-body*")) - (goto-char (setq beg (point-max))) - (save-excursion - (save-restriction - (set-buffer buffer) - (let (buffer-read-only) - (gnus-set-text-properties (point-min) (point-max) nil) - ;; These two are necessary for XEmacs 19.12 fascism. - (put-text-property (point-min) (point-max) 'invisible nil) - (put-text-property (point-min) (point-max) 'intangible nil)) - (goto-char (point-min)) - (re-search-forward "\n\n") - ;; Quote all 30-dash lines. - (save-excursion - (while (re-search-forward delim nil t) - (beginning-of-line) - (delete-char 1) - (insert " "))) - (setq body (buffer-substring (1- (point)) (point-max))) - (narrow-to-region (point-min) (point)) - (if (not (setq headers gnus-uu-digest-headers)) - (setq sorthead (buffer-substring (point-min) (point-max))) - (while headers - (setq headline (car headers)) - (setq headers (cdr headers)) - (goto-char (point-min)) - (while (re-search-forward headline nil t) - (setq sorthead - (concat sorthead - (buffer-substring - (match-beginning 0) - (or (and (re-search-forward "^[^ \t]" nil t) - (1- (point))) - (progn (forward-line 1) (point))))))))) - (widen))) - (insert sorthead) (goto-char (point-max)) - (insert body) (goto-char (point-max)) - (insert (concat "\n" (make-string 30 ?-) "\n\n")) - (goto-char beg) - (when (re-search-forward "^Subject: \\(.*\\)$" nil t) - (setq subj (buffer-substring (match-beginning 1) (match-end 1))) - (save-excursion - (set-buffer (get-buffer "*gnus-uu-pre*")) - (insert (format " %s\n" subj))))) - (when (or (eq in-state 'last) - (eq in-state 'first-and-last)) - (save-excursion - (set-buffer (get-buffer "*gnus-uu-pre*")) - (insert (format "\n\n%s\n\n" (make-string 70 ?-))) - (gnus-write-buffer gnus-uu-saved-article-name)) - (save-excursion - (set-buffer (get-buffer "*gnus-uu-body*")) - (goto-char (point-max)) - (insert - (concat (setq end-string (format "End of %s Digest" name)) - "\n")) - (insert (concat (make-string (length end-string) ?*) "\n")) - (write-region - (point-min) (point-max) gnus-uu-saved-article-name t)) - (kill-buffer (get-buffer "*gnus-uu-pre*")) - (kill-buffer (get-buffer "*gnus-uu-body*")) - (push 'end state)) - (if (memq 'begin state) - (cons gnus-uu-saved-article-name state) - state))))) - -;; Binhex treatment - not very advanced. - -(defconst gnus-uu-binhex-body-line - "^[^:]...............................................................$") -(defconst gnus-uu-binhex-begin-line - "^:...............................................................$") -(defconst gnus-uu-binhex-end-line - ":$") - -(defun gnus-uu-binhex-article (buffer in-state) - (let (state start-char) - (save-excursion - (set-buffer buffer) - (widen) - (goto-char (point-min)) - (when (not (re-search-forward gnus-uu-binhex-begin-line nil t)) - (when (not (re-search-forward gnus-uu-binhex-body-line nil t)) - (setq state (list 'wrong-type)))) - - (if (memq 'wrong-type state) - () - (beginning-of-line) - (setq start-char (point)) - (if (looking-at gnus-uu-binhex-begin-line) - (progn - (setq state (list 'begin)) - (write-region 1 1 gnus-uu-binhex-article-name)) - (setq state (list 'middle))) - (goto-char (point-max)) - (re-search-backward (concat gnus-uu-binhex-body-line "\\|" - gnus-uu-binhex-end-line) - nil t) - (when (looking-at gnus-uu-binhex-end-line) - (setq state (if (memq 'begin state) - (cons 'end state) - (list 'end)))) - (beginning-of-line) - (forward-line 1) - (when (file-exists-p gnus-uu-binhex-article-name) - (append-to-file start-char (point) gnus-uu-binhex-article-name)))) - (if (memq 'begin state) - (cons gnus-uu-binhex-article-name state) - state))) - -;; PostScript - -(defun gnus-uu-decode-postscript-article (process-buffer in-state) - (let ((state (list 'ok)) - start-char end-char file-name) - (save-excursion - (set-buffer process-buffer) - (goto-char (point-min)) - (if (not (re-search-forward gnus-uu-postscript-begin-string nil t)) - (setq state (list 'wrong-type)) - (beginning-of-line) - (setq start-char (point)) - (if (not (re-search-forward gnus-uu-postscript-end-string nil t)) - (setq state (list 'wrong-type)) - (setq end-char (point)) - (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) - (insert-buffer-substring process-buffer start-char end-char) - (setq file-name (concat gnus-uu-work-dir - (cdr gnus-article-current) ".ps")) - (write-region (point-min) (point-max) file-name) - (setq state (list file-name 'begin 'end))))) - state)) - - -;; Find actions. - -(defun gnus-uu-get-actions (files) - (let ((ofiles files) - action name) - (while files - (setq name (cdr (assq 'name (car files)))) - (and - (setq action (gnus-uu-get-action name)) - (setcar files (nconc (list (if (string= action "gnus-uu-archive") - (cons 'action "file") - (cons 'action action)) - (cons 'execute (gnus-uu-command - action name))) - (car files)))) - (setq files (cdr files))) - ofiles)) - -(defun gnus-uu-get-action (file-name) - (let (action) - (setq action - (gnus-uu-choose-action - file-name - (append - gnus-uu-user-view-rules - (if gnus-uu-ignore-default-view-rules - nil - gnus-uu-default-view-rules) - gnus-uu-user-view-rules-end))) - (when (and (not (string= (or action "") "gnus-uu-archive")) - gnus-uu-view-with-metamail) - (when (setq action - (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)) - (setq action (format "metamail -d -b -c \"%s\"" action)))) - action)) - - -;; Functions for treating subjects and collecting series. - -(defun gnus-uu-reginize-string (string) - ;; Takes a string and puts a \ in front of every special character; - ;; ignores any leading "version numbers" thingies that they use in - ;; the comp.binaries groups, and either replaces anything that looks - ;; like "2/3" with "[0-9]+/[0-9]+" or, if it can't find something - ;; like that, replaces the last two numbers with "[0-9]+". This, in - ;; my experience, should get most postings of a series. - (let ((count 2) - (vernum "v[0-9]+[a-z][0-9]+:") - beg) - (save-excursion - (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert (regexp-quote string)) - (setq beg 1) - - (setq case-fold-search nil) - (goto-char (point-min)) - (when (looking-at vernum) - (replace-match vernum t t) - (setq beg (length vernum))) - - (goto-char beg) - (if (re-search-forward "[ \t]*[0-9]+/[0-9]+" nil t) - (replace-match " [0-9]+/[0-9]+") - - (goto-char beg) - (if (re-search-forward "[0-9]+[ \t]*of[ \t]*[0-9]+" nil t) - (replace-match "[0-9]+ of [0-9]+") - - (end-of-line) - (if (re-search-backward "\\([^0-9]\\)[0-9]+\\([^0-9]+\\)[0-9]+" - nil t) - (replace-match "\\1[0-9]+\\2[0-9]+" t nil nil nil)))) - - (goto-char beg) - (while (re-search-forward "[ \t]+" nil t) - (replace-match "[ \t]*" t t)) - - (buffer-substring 1 (point-max))))) - -(defun gnus-uu-get-list-of-articles (n) - ;; If N is non-nil, the article numbers of the N next articles - ;; will be returned. - ;; If any articles have been marked as processable, they will be - ;; returned. - ;; Failing that, articles that have subjects that are part of the - ;; same "series" as the current will be returned. - (let (articles) - (cond - (n - (setq n (prefix-numeric-value n)) - (let ((backward (< n 0)) - (n (abs n))) - (save-excursion - (while (and (> n 0) - (push (gnus-summary-article-number) - articles) - (gnus-summary-search-forward nil nil backward)) - (setq n (1- n)))) - (nreverse articles))) - (gnus-newsgroup-processable - (reverse gnus-newsgroup-processable)) - (t - (gnus-uu-find-articles-matching))))) - -(defun gnus-uu-string< (l1 l2) - (string< (car l1) (car l2))) - -(defun gnus-uu-find-articles-matching - (&optional subject only-unread do-not-translate) - ;; Finds all articles that matches the regexp SUBJECT. If it is - ;; nil, the current article name will be used. If ONLY-UNREAD is - ;; non-nil, only unread articles are chosen. If DO-NOT-TRANSLATE is - ;; non-nil, article names are not equalized before sorting. - (let ((subject (or subject - (gnus-uu-reginize-string (gnus-summary-article-subject)))) - list-of-subjects) - (save-excursion - (if (not subject) - () - ;; Collect all subjects matching subject. - (let ((case-fold-search t) - (data gnus-newsgroup-data) - subj mark d) - (while data - (setq d (pop data)) - (and (not (gnus-data-pseudo-p d)) - (or (not only-unread) - (= (setq mark (gnus-data-mark d)) - gnus-unread-mark) - (= mark gnus-ticked-mark) - (= mark gnus-dormant-mark)) - (setq subj (mail-header-subject (gnus-data-header d))) - (string-match subject subj) - (push (cons subj (gnus-data-number d)) - list-of-subjects)))) - - ;; Expand numbers, sort, and return the list of article - ;; numbers. - (mapcar (lambda (sub) (cdr sub)) - (sort (gnus-uu-expand-numbers - list-of-subjects - (not do-not-translate)) - 'gnus-uu-string<)))))) - -(defun gnus-uu-expand-numbers (string-list &optional translate) - ;; Takes a list of strings and "expands" all numbers in all the - ;; strings. That is, this function makes all numbers equal length by - ;; prepending lots of zeroes before each number. This is to ease later - ;; sorting to find out what sequence the articles are supposed to be - ;; decoded in. Returns the list of expanded strings. - (let ((out-list string-list) - string) - (save-excursion - (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) - (buffer-disable-undo (current-buffer)) - (while string-list - (erase-buffer) - (insert (caar string-list)) - ;; Translate multiple spaces to one space. - (goto-char (point-min)) - (while (re-search-forward "[ \t]+" nil t) - (replace-match " ")) - ;; Translate all characters to "a". - (goto-char (point-min)) - (when translate - (while (re-search-forward "[A-Za-z]" nil t) - (replace-match "a" t t))) - ;; Expand numbers. - (goto-char (point-min)) - (while (re-search-forward "[0-9]+" nil t) - (replace-match - (format "%06d" - (string-to-int (buffer-substring - (match-beginning 0) (match-end 0)))))) - (setq string (buffer-substring 1 (point-max))) - (setcar (car string-list) string) - (setq string-list (cdr string-list)))) - out-list)) - - -;; `gnus-uu-grab-articles' is the general multi-article treatment -;; function. It takes a list of articles to be grabbed and a function -;; to apply to each article. -;; -;; The function to be called should take two parameters. The first -;; parameter is the article buffer. The function should leave the -;; result, if any, in this buffer. Most treatment functions will just -;; generate files... -;; -;; The second parameter is the state of the list of articles, and can -;; have four values: `first', `middle', `last' and `first-and-last'. -;; -;; The function should return a list. The list may contain the -;; following symbols: -;; `error' if an error occurred -;; `begin' if the beginning of an encoded file has been received -;; If the list returned contains a `begin', the first element of -;; the list *must* be a string with the file name of the decoded -;; file. -;; `end' if the end of an encoded file has been received -;; `middle' if the article was a body part of an encoded file -;; `wrong-type' if the article was not a part of an encoded file -;; `ok', which can be used everything is ok - -(defvar gnus-uu-has-been-grabbed nil) - -(defun gnus-uu-unmark-list-of-grabbed (&optional dont-unmark-last-article) - (let (art) - (if (not (and gnus-uu-has-been-grabbed - gnus-uu-unmark-articles-not-decoded)) - () - (when dont-unmark-last-article - (setq art (car gnus-uu-has-been-grabbed)) - (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed))) - (while gnus-uu-has-been-grabbed - (gnus-summary-tick-article (car gnus-uu-has-been-grabbed) t) - (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed))) - (when dont-unmark-last-article - (setq gnus-uu-has-been-grabbed (list art)))))) - -;; This function takes a list of articles and a function to apply to -;; each article grabbed. -;; -;; This function returns a list of files decoded if the grabbing and -;; the process-function has been successful and nil otherwise. -(defun gnus-uu-grab-articles (articles process-function - &optional sloppy limit no-errors) - (let ((state 'first) - has-been-begin article result-file result-files process-state - gnus-summary-display-article-function - gnus-article-display-hook gnus-article-prepare-hook - article-series files) - - (while (and articles - (not (memq 'error process-state)) - (or sloppy - (not (memq 'end process-state)))) - - (setq article (pop articles)) - (push article article-series) - - (unless articles - (if (eq state 'first) - (setq state 'first-and-last) - (setq state 'last))) - - (let ((part (gnus-uu-part-number article))) - (gnus-message 6 "Getting article %d%s..." - article (if (string= part "") "" (concat ", " part)))) - (gnus-summary-display-article article) - - ;; Push the article to the processing function. - (save-excursion - (set-buffer gnus-original-article-buffer) - (let ((buffer-read-only nil)) - (save-excursion - (set-buffer gnus-summary-buffer) - (setq process-state - (funcall process-function - gnus-original-article-buffer state))))) - - (gnus-summary-remove-process-mark article) - - ;; If this is the beginning of a decoded file, we push it - ;; on to a list. - (when (or (memq 'begin process-state) - (and (or (eq state 'first) - (eq state 'first-and-last)) - (memq 'ok process-state))) - (when has-been-begin - ;; If there is a `result-file' here, that means that the - ;; file was unsuccessfully decoded, so we delete it. - (when (and result-file - (file-exists-p result-file) - (not gnus-uu-be-dangerous) - (or (eq gnus-uu-be-dangerous t) - (gnus-y-or-n-p - (format "Delete unsuccessfully decoded file %s" - result-file)))) - (delete-file result-file))) - (when (memq 'begin process-state) - (setq result-file (car process-state))) - (setq has-been-begin t)) - - ;; Check whether we have decoded one complete file. - (when (memq 'end process-state) - (setq article-series nil) - (setq has-been-begin nil) - (if (stringp result-file) - (setq files (list result-file)) - (setq files result-file)) - (setq result-file (car files)) - (while files - (push (list (cons 'name (pop files)) - (cons 'article article)) - result-files)) - ;; Allow user-defined functions to be run on this file. - (when gnus-uu-grabbed-file-functions - (let ((funcs gnus-uu-grabbed-file-functions)) - (unless (listp funcs) - (setq funcs (list funcs))) - (while funcs - (funcall (pop funcs) result-file)))) - (setq result-file nil) - ;; Check whether we have decoded enough articles. - (and limit (= (length result-files) limit) - (setq articles nil))) - - ;; If this is the last article to be decoded, and - ;; we still haven't reached the end, then we delete - ;; the partially decoded file. - (and (or (eq state 'last) (eq state 'first-and-last)) - (not (memq 'end process-state)) - result-file - (file-exists-p result-file) - (not gnus-uu-be-dangerous) - (or (eq gnus-uu-be-dangerous t) - (gnus-y-or-n-p (format "Delete incomplete file %s? " result-file))) - (delete-file result-file)) - - ;; If this was a file of the wrong sort, then - (when (and (or (memq 'wrong-type process-state) - (memq 'error process-state)) - gnus-uu-unmark-articles-not-decoded) - (gnus-summary-tick-article article t)) - - ;; Set the new series state. - (if (and (not has-been-begin) - (not sloppy) - (or (memq 'end process-state) - (memq 'middle process-state))) - (progn - (setq process-state (list 'error)) - (gnus-message 2 "No begin part at the beginning") - (sleep-for 2)) - (setq state 'middle))) - - ;; When there are no result-files, then something must be wrong. - (if result-files - (message "") - (cond - ((not has-been-begin) - (gnus-message 2 "Wrong type file")) - ((memq 'error process-state) - (gnus-message 2 "An error occurred during decoding")) - ((not (or (memq 'ok process-state) - (memq 'end process-state))) - (gnus-message 2 "End of articles reached before end of file"))) - ;; Make unsuccessfully decoded articles unread. - (when gnus-uu-unmark-articles-not-decoded - (while article-series - (gnus-summary-tick-article (pop article-series) t)))) - - result-files)) - -(defun gnus-uu-grab-view (file) - "View FILE using the gnus-uu methods." - (let ((action (gnus-uu-get-action file))) - (gnus-execute-command - (if (string-match "%" action) - (format action file) - (concat action " " file)) - (eq gnus-view-pseudos 'not-confirm)))) - -(defun gnus-uu-grab-move (file) - "Move FILE to somewhere." - (when gnus-uu-default-dir - (let ((to-file (concat (file-name-as-directory gnus-uu-default-dir) - (file-name-nondirectory file)))) - (rename-file file to-file) - (unless (file-exists-p file) - (make-symbolic-link to-file file))))) - -(defun gnus-uu-part-number (article) - (let* ((header (gnus-summary-article-header article)) - (subject (and header (mail-header-subject header)))) - (if (and subject - (string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+" subject)) - (match-string 0 subject) - ""))) - -(defun gnus-uu-uudecode-sentinel (process event) - (delete-process (get-process process))) - -(defun gnus-uu-uustrip-article (process-buffer in-state) - ;; Uudecodes a file asynchronously. - (save-excursion - (set-buffer process-buffer) - (let ((state (list 'wrong-type)) - process-connection-type case-fold-search buffer-read-only - files start-char) - (goto-char (point-min)) - - ;; Deal with ^M at the end of the lines. - (when gnus-uu-kill-carriage-return - (save-excursion - (while (search-forward "\r" nil t) - (delete-backward-char 1)))) - - (while (or (re-search-forward gnus-uu-begin-string nil t) - (re-search-forward gnus-uu-body-line nil t)) - (setq state (list 'ok)) - ;; Ok, we are at the first uucoded line. - (beginning-of-line) - (setq start-char (point)) - - (if (not (looking-at gnus-uu-begin-string)) - (setq state (list 'middle)) - ;; This is the beginning of a uuencoded article. - ;; We replace certain characters that could make things messy. - (setq gnus-uu-file-name - (let ((nnheader-file-name-translation-alist - '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_)))) - (nnheader-translate-file-chars (match-string 1)))) - (replace-match (concat "begin 644 " gnus-uu-file-name) t t) - - ;; Remove any non gnus-uu-body-line right after start. - (forward-line 1) - (while (and (not (eobp)) - (not (looking-at gnus-uu-body-line))) - (gnus-delete-line)) - - ;; If a process is running, we kill it. - (when (and gnus-uu-uudecode-process - (memq (process-status gnus-uu-uudecode-process) - '(run stop))) - (delete-process gnus-uu-uudecode-process) - (gnus-uu-unmark-list-of-grabbed t)) - - ;; Start a new uudecoding process. - (let ((cdir default-directory)) - (unwind-protect - (progn - (cd gnus-uu-work-dir) - (setq gnus-uu-uudecode-process - (start-process - "*uudecode*" - (get-buffer-create gnus-uu-output-buffer-name) - shell-file-name shell-command-switch - (format "cd %s %s uudecode" gnus-uu-work-dir - gnus-shell-command-separator)))) - (cd cdir))) - (set-process-sentinel - gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel) - (setq state (list 'begin)) - (push (concat gnus-uu-work-dir gnus-uu-file-name) files)) - - ;; We look for the end of the thing to be decoded. - (if (re-search-forward gnus-uu-end-string nil t) - (push 'end state) - (goto-char (point-max)) - (re-search-backward gnus-uu-body-line nil t)) - - (forward-line 1) - - (when gnus-uu-uudecode-process - (when (memq (process-status gnus-uu-uudecode-process) '(run stop)) - ;; Try to correct mishandled uucode. - (when gnus-uu-correct-stripped-uucode - (gnus-uu-check-correct-stripped-uucode start-char (point))) - - ;; Send the text to the process. - (condition-case nil - (process-send-region - gnus-uu-uudecode-process start-char (point)) - (error - (progn - (delete-process gnus-uu-uudecode-process) - (gnus-message 2 "gnus-uu: Couldn't uudecode") - (setq state (list 'wrong-type))))) - - (if (memq 'end state) - (progn - ;; Send an EOF, just in case. - (ignore-errors - (process-send-eof gnus-uu-uudecode-process)) - (while (memq (process-status gnus-uu-uudecode-process) - '(open run)) - (accept-process-output gnus-uu-uudecode-process 1))) - (when (or (not gnus-uu-uudecode-process) - (not (memq (process-status gnus-uu-uudecode-process) - '(run stop)))) - (setq state (list 'wrong-type))))))) - - (if (memq 'begin state) - (cons (if (= (length files) 1) (car files) files) state) - state)))) - -;; This function is used by `gnus-uu-grab-articles' to treat -;; a shared article. -(defun gnus-uu-unshar-article (process-buffer in-state) - (let ((state (list 'ok)) - start-char) - (save-excursion - (set-buffer process-buffer) - (goto-char (point-min)) - (if (not (re-search-forward gnus-uu-shar-begin-string nil t)) - (setq state (list 'wrong-type)) - (beginning-of-line) - (setq start-char (point)) - (call-process-region - start-char (point-max) shell-file-name nil - (get-buffer-create gnus-uu-output-buffer-name) nil - shell-command-switch - (concat "cd " gnus-uu-work-dir " " - gnus-shell-command-separator " sh")))) - state)) - -;; Returns the name of what the shar file is going to unpack. -(defun gnus-uu-find-name-in-shar () - (let ((oldpoint (point)) - res) - (goto-char (point-min)) - (when (re-search-forward gnus-uu-shar-name-marker nil t) - (setq res (buffer-substring (match-beginning 1) (match-end 1)))) - (goto-char oldpoint) - res)) - -;; `gnus-uu-choose-action' chooses what action to perform given the name -;; and `gnus-uu-file-action-list'. Returns either nil if no action is -;; found, or the name of the command to run if such a rule is found. -(defun gnus-uu-choose-action (file-name file-action-list &optional no-ignore) - (let ((action-list (copy-sequence file-action-list)) - (case-fold-search t) - rule action) - (and - (unless no-ignore - (and (not - (and gnus-uu-ignore-files-by-name - (string-match gnus-uu-ignore-files-by-name file-name))) - (not - (and gnus-uu-ignore-files-by-type - (string-match gnus-uu-ignore-files-by-type - (or (gnus-uu-choose-action - file-name gnus-uu-ext-to-mime-list t) - "")))))) - (while (not (or (eq action-list ()) action)) - (setq rule (car action-list)) - (setq action-list (cdr action-list)) - (when (string-match (car rule) file-name) - (setq action (cadr rule))))) - action)) - -(defun gnus-uu-treat-archive (file-path) - ;; Unpacks an archive. Returns t if unpacking is successful. - (let ((did-unpack t) - action command dir) - (setq action (gnus-uu-choose-action - file-path (append gnus-uu-user-archive-rules - (if gnus-uu-ignore-default-archive-rules - nil - gnus-uu-default-archive-rules)))) - - (when (not action) - (error "No unpackers for the file %s" file-path)) - - (string-match "/[^/]*$" file-path) - (setq dir (substring file-path 0 (match-beginning 0))) - - (when (member action gnus-uu-destructive-archivers) - (copy-file file-path (concat file-path "~") t)) - - (setq command (format "cd %s ; %s" dir (gnus-uu-command action file-path))) - - (save-excursion - (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) - (erase-buffer)) - - (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path)) - - (if (= 0 (call-process shell-file-name nil - (get-buffer-create gnus-uu-output-buffer-name) - nil shell-command-switch command)) - (message "") - (gnus-message 2 "Error during unpacking of archive") - (setq did-unpack nil)) - - (when (member action gnus-uu-destructive-archivers) - (rename-file (concat file-path "~") file-path t)) - - did-unpack)) - -(defun gnus-uu-dir-files (dir) - (let ((dirs (directory-files dir t "[^/][^\\.][^\\.]?$")) - files file) - (while dirs - (if (file-directory-p (setq file (car dirs))) - (setq files (append files (gnus-uu-dir-files file))) - (push file files)) - (setq dirs (cdr dirs))) - files)) - -(defun gnus-uu-unpack-files (files &optional ignore) - ;; Go through FILES and look for files to unpack. - (let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir)) - (ofiles files) - file did-unpack) - (while files - (setq file (cdr (assq 'name (car files)))) - (when (and (not (member file ignore)) - (equal (gnus-uu-get-action (file-name-nondirectory file)) - "gnus-uu-archive")) - (push file did-unpack) - (unless (gnus-uu-treat-archive file) - (gnus-message 2 "Error during unpacking of %s" file)) - (let* ((newfiles (gnus-uu-ls-r gnus-uu-work-dir)) - (nfiles newfiles)) - (while nfiles - (unless (member (car nfiles) totfiles) - (push (list (cons 'name (car nfiles)) - (cons 'original file)) - ofiles)) - (setq nfiles (cdr nfiles))) - (setq totfiles newfiles))) - (setq files (cdr files))) - (if did-unpack - (gnus-uu-unpack-files ofiles (append did-unpack ignore)) - ofiles))) - -(defun gnus-uu-ls-r (dir) - (let* ((files (gnus-uu-directory-files dir t)) - (ofiles files)) - (while files - (when (file-directory-p (car files)) - (setq ofiles (delete (car files) ofiles)) - (setq ofiles (append ofiles (gnus-uu-ls-r (car files))))) - (setq files (cdr files))) - ofiles)) - -;; Various stuff - -(defun gnus-uu-directory-files (dir &optional full) - (let (files out file) - (setq files (directory-files dir full)) - (while files - (setq file (car files)) - (setq files (cdr files)) - (unless (member (file-name-nondirectory file) '("." "..")) - (push file out))) - (setq out (nreverse out)) - out)) - -(defun gnus-uu-check-correct-stripped-uucode (start end) - (save-excursion - (let (found beg length) - (if (not gnus-uu-correct-stripped-uucode) - () - (goto-char start) - - (if (re-search-forward " \\|`" end t) - (progn - (goto-char start) - (while (not (eobp)) - (progn - (when (looking-at "\n") - (replace-match "")) - (forward-line 1)))) - - (while (not (eobp)) - (if (looking-at (concat gnus-uu-begin-string "\\|" - gnus-uu-end-string)) - () - (when (not found) - (beginning-of-line) - (setq beg (point)) - (end-of-line) - (setq length (- (point) beg))) - (setq found t) - (beginning-of-line) - (setq beg (point)) - (end-of-line) - (when (not (= length (- (point) beg))) - (insert (make-string (- length (- (point) beg)) ? )))) - (forward-line 1))))))) - -(defvar gnus-uu-tmp-alist nil) - -(defun gnus-uu-initialize (&optional scan) - (let (entry) - (if (and (not scan) - (when (setq entry (assoc gnus-newsgroup-name gnus-uu-tmp-alist)) - (if (file-exists-p (cdr entry)) - (setq gnus-uu-work-dir (cdr entry)) - (setq gnus-uu-tmp-alist (delq entry gnus-uu-tmp-alist)) - nil))) - t - (setq gnus-uu-tmp-dir (file-name-as-directory - (expand-file-name gnus-uu-tmp-dir))) - (if (not (file-directory-p gnus-uu-tmp-dir)) - (error "Temp directory %s doesn't exist" gnus-uu-tmp-dir) - (when (not (file-writable-p gnus-uu-tmp-dir)) - (error "Temp directory %s can't be written to" - gnus-uu-tmp-dir))) - - (setq gnus-uu-work-dir - (make-temp-name (concat gnus-uu-tmp-dir "gnus"))) - (gnus-make-directory gnus-uu-work-dir) - (set-file-modes gnus-uu-work-dir 448) - (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir)) - (push (cons gnus-newsgroup-name gnus-uu-work-dir) - gnus-uu-tmp-alist)))) - - -;; Kills the temporary uu buffers, kills any processes, etc. -(defun gnus-uu-clean-up () - (let (buf) - (and gnus-uu-uudecode-process - (memq (process-status (or gnus-uu-uudecode-process "nevair")) - '(stop run)) - (delete-process gnus-uu-uudecode-process)) - (when (setq buf (get-buffer gnus-uu-output-buffer-name)) - (kill-buffer buf)))) - -(defun gnus-quote-arg-for-sh-or-csh (arg) - (let ((pos 0) new-pos accum) - ;; *** bug: we don't handle newline characters properly - (while (setq new-pos (string-match "[!`\"$\\& \t{}]" arg pos)) - (push (substring arg pos new-pos) accum) - (push "\\" accum) - (push (list (aref arg new-pos)) accum) - (setq pos (1+ new-pos))) - (if (= pos 0) - arg - (apply 'concat (nconc (nreverse accum) (list (substring arg pos))))))) - -;; Inputs an action and a filename and returns a full command, making sure -;; that the filename will be treated as a single argument when the shell -;; executes the command. -(defun gnus-uu-command (action file) - (let ((quoted-file (gnus-quote-arg-for-sh-or-csh file))) - (if (string-match "%s" action) - (format action quoted-file) - (concat action " " quoted-file)))) - -(defun gnus-uu-delete-work-dir (&optional dir) - "Delete recursively all files and directories under `gnus-uu-work-dir'." - (if dir - (gnus-message 7 "Deleting directory %s..." dir) - (setq dir gnus-uu-work-dir)) - (when (and dir - (file-exists-p dir)) - (let ((files (directory-files dir t nil t)) - file) - (while (setq file (pop files)) - (unless (member (file-name-nondirectory file) '("." "..")) - (if (file-directory-p file) - (gnus-uu-delete-work-dir file) - (gnus-message 9 "Deleting file %s..." file) - (delete-file file)))) - (delete-directory dir))) - (gnus-message 7 "")) - -;; Initializing - -(add-hook 'gnus-exit-group-hook 'gnus-uu-clean-up) -(add-hook 'gnus-exit-group-hook 'gnus-uu-delete-work-dir) - - - -;;; -;;; uuencoded posting -;;; - -;; Any function that is to be used as and encoding method will take two -;; parameters: PATH-NAME and FILE-NAME. (E.g. "/home/gaga/spiral.jpg" -;; and "spiral.jpg", respectively.) The function should return nil if -;; the encoding wasn't successful. -(defcustom gnus-uu-post-encode-method 'gnus-uu-post-encode-uuencode - "Function used for encoding binary files. -There are three functions supplied with gnus-uu for encoding files: -`gnus-uu-post-encode-uuencode', which does straight uuencoding; -`gnus-uu-post-encode-mime', which encodes with base64 and adds MIME -headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with -uuencode and adds MIME headers." - :group 'gnus-extract-post - :type '(radio (function-item gnus-uu-post-encode-uuencode) - (function-item gnus-uu-post-encode-mime) - (function-item gnus-uu-post-encode-mime-uuencode) - (function :tag "Other"))) - -(defcustom gnus-uu-post-include-before-composing nil - "Non-nil means that gnus-uu will ask for a file to encode before you compose the article. -If this variable is t, you can either include an encoded file with -\\[gnus-uu-post-insert-binary-in-article] or have one included for you when you post the article." - :group 'gnus-extract-post - :type 'boolean) - -(defcustom gnus-uu-post-length 990 - "Maximum length of an article. -The encoded file will be split into how many articles it takes to -post the entire file." - :group 'gnus-extract-post - :type 'integer) - -(defcustom gnus-uu-post-threaded nil - "Non-nil means that gnus-uu will post the encoded file in a thread. -This may not be smart, as no other decoder I have seen are able to -follow threads when collecting uuencoded articles. (Well, I have seen -one package that does that - gnus-uu, but somehow, I don't think that -counts...) The default is nil." - :group 'gnus-extract-post - :type 'boolean) - -(defcustom gnus-uu-post-separate-description t - "Non-nil means that the description will be posted in a separate article. -The first article will typically be numbered (0/x). If this variable -is nil, the description the user enters will be included at the -beginning of the first article, which will be numbered (1/x). Default -is t." - :group 'gnus-extract-post - :type 'boolean) - -(defvar gnus-uu-post-binary-separator "--binary follows this line--") -(defvar gnus-uu-post-message-id nil) -(defvar gnus-uu-post-inserted-file-name nil) -(defvar gnus-uu-winconf-post-news nil) - -(defun gnus-uu-post-news () - "Compose an article and post an encoded file." - (interactive) - (setq gnus-uu-post-inserted-file-name nil) - (setq gnus-uu-winconf-post-news (current-window-configuration)) - - (gnus-summary-post-news) - - (use-local-map (copy-keymap (current-local-map))) - (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done) - (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews) - (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews) - (local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article) - - (when gnus-uu-post-include-before-composing - (save-excursion (setq gnus-uu-post-inserted-file-name - (gnus-uu-post-insert-binary))))) - -(defun gnus-uu-post-insert-binary-in-article () - "Inserts an encoded file in the buffer. -The user will be asked for a file name." - (interactive) - (save-excursion - (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary)))) - -;; Encodes with uuencode and substitutes all spaces with backticks. -(defun gnus-uu-post-encode-uuencode (path file-name) - (when (gnus-uu-post-encode-file "uuencode" path file-name) - (goto-char (point-min)) - (forward-line 1) - (while (re-search-forward " " nil t) - (replace-match "`")) - t)) - -;; Encodes with uuencode and adds MIME headers. -(defun gnus-uu-post-encode-mime-uuencode (path file-name) - (when (gnus-uu-post-encode-uuencode path file-name) - (gnus-uu-post-make-mime file-name "x-uue") - t)) - -;; Encodes with base64 and adds MIME headers -(defun gnus-uu-post-encode-mime (path file-name) - (when (gnus-uu-post-encode-file "mmencode" path file-name) - (gnus-uu-post-make-mime file-name "base64") - t)) - -;; Adds MIME headers. -(defun gnus-uu-post-make-mime (file-name encoding) - (goto-char (point-min)) - (insert (format "Content-Type: %s; name=\"%s\"\n" - (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list) - file-name)) - (insert (format "Content-Transfer-Encoding: %s\n\n" encoding)) - (save-restriction - (set-buffer gnus-message-buffer) - (goto-char (point-min)) - (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line -1) - (narrow-to-region 1 (point)) - (unless (mail-fetch-field "mime-version") - (widen) - (insert "MIME-Version: 1.0\n")) - (widen))) - -;; Encodes a file PATH with COMMAND, leaving the result in the -;; current buffer. -(defun gnus-uu-post-encode-file (command path file-name) - (= 0 (call-process shell-file-name nil t nil shell-command-switch - (format "%s %s %s" command path file-name)))) - -(defun gnus-uu-post-news-inews () - "Posts the composed news article and encoded file. -If no file has been included, the user will be asked for a file." - (interactive) - - (let (file-name) - - (if gnus-uu-post-inserted-file-name - (setq file-name gnus-uu-post-inserted-file-name) - (setq file-name (gnus-uu-post-insert-binary))) - - (gnus-uu-post-encoded file-name gnus-uu-post-threaded)) - (setq gnus-uu-post-inserted-file-name nil) - (when gnus-uu-winconf-post-news - (set-window-configuration gnus-uu-winconf-post-news))) - -;; Asks for a file to encode, encodes it and inserts the result in -;; the current buffer. Returns the file name the user gave. -(defun gnus-uu-post-insert-binary () - (let ((uuencode-buffer-name "*uuencode buffer*") - file-path uubuf file-name) - - (setq file-path (read-file-name - "What file do you want to encode? ")) - (when (not (file-exists-p file-path)) - (error "%s: No such file" file-path)) - - (goto-char (point-max)) - (insert (format "\n%s\n" gnus-uu-post-binary-separator)) - - (when (string-match "^~/" file-path) - (setq file-path (concat "$HOME" (substring file-path 1)))) - (if (string-match "/[^/]*$" file-path) - (setq file-name (substring file-path (1+ (match-beginning 0)))) - (setq file-name file-path)) - - (unwind-protect - (if (save-excursion - (set-buffer (setq uubuf - (get-buffer-create uuencode-buffer-name))) - (erase-buffer) - (funcall gnus-uu-post-encode-method file-path file-name)) - (insert-buffer-substring uubuf) - (error "Encoding unsuccessful")) - (kill-buffer uubuf)) - file-name)) - -;; Posts the article and all of the encoded file. -(defun gnus-uu-post-encoded (file-name &optional threaded) - (let ((send-buffer-name "*uuencode send buffer*") - (encoded-buffer-name "*encoded buffer*") - (top-string "[ cut here %s (%s %d/%d) %s gnus-uu ]") - (separator (concat mail-header-separator "\n\n")) - uubuf length parts header i end beg - beg-line minlen buf post-buf whole-len beg-binary end-binary) - - (setq post-buf (current-buffer)) - - (goto-char (point-min)) - (when (not (re-search-forward - (if gnus-uu-post-separate-description - (concat "^" (regexp-quote gnus-uu-post-binary-separator) - "$") - (concat "^" (regexp-quote mail-header-separator) "$")) - nil t)) - (error "Internal error: No binary/header separator")) - (beginning-of-line) - (forward-line 1) - (setq beg-binary (point)) - (setq end-binary (point-max)) - - (save-excursion - (set-buffer (setq uubuf (get-buffer-create encoded-buffer-name))) - (erase-buffer) - (insert-buffer-substring post-buf beg-binary end-binary) - (goto-char (point-min)) - (setq length (count-lines 1 (point-max))) - (setq parts (/ length gnus-uu-post-length)) - (unless (< (% length gnus-uu-post-length) 4) - (incf parts))) - - (when gnus-uu-post-separate-description - (forward-line -1)) - (delete-region (point) (point-max)) - - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") nil t) - (beginning-of-line) - (setq header (buffer-substring 1 (point))) - - (goto-char (point-min)) - (when gnus-uu-post-separate-description - (when (re-search-forward "^Subject: " nil t) - (end-of-line) - (insert (format " (0/%d)" parts))) - (save-excursion - (message-send)) - (setq gnus-uu-post-message-id (message-fetch-field "message-id"))) - - (save-excursion - (setq i 1) - (setq beg 1) - (while (not (> i parts)) - (set-buffer (get-buffer-create send-buffer-name)) - (erase-buffer) - (insert header) - (when (and threaded gnus-uu-post-message-id) - (insert "References: " gnus-uu-post-message-id "\n")) - (insert separator) - (setq whole-len - (- 62 (length (format top-string "" file-name i parts "")))) - (when (> 1 (setq minlen (/ whole-len 2))) - (setq minlen 1)) - (setq - beg-line - (format top-string - (make-string minlen ?-) - file-name i parts - (make-string - (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-))) - - (goto-char (point-min)) - (when (re-search-forward "^Subject: " nil t) - (end-of-line) - (insert (format " (%d/%d)" i parts))) - - (goto-char (point-max)) - (save-excursion - (set-buffer uubuf) - (goto-char beg) - (if (= i parts) - (goto-char (point-max)) - (forward-line gnus-uu-post-length)) - (when (and (= (1+ i) parts) (< (count-lines (point) (point-max)) 4)) - (forward-line -4)) - (setq end (point))) - (insert-buffer-substring uubuf beg end) - (insert beg-line "\n") - (setq beg end) - (incf i) - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$") nil t) - (beginning-of-line) - (forward-line 2) - (when (re-search-forward - (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$") - nil t) - (replace-match "") - (forward-line 1)) - (insert beg-line) - (insert "\n") - (let (message-sent-message-via) - (save-excursion - (message-send)) - (setq gnus-uu-post-message-id - (concat (message-fetch-field "references") " " - (message-fetch-field "message-id")))))) - - (gnus-kill-buffer send-buffer-name) - (gnus-kill-buffer encoded-buffer-name) - - (when (not gnus-uu-post-separate-description) - (set-buffer-modified-p nil) - (when (fboundp 'bury-buffer) - (bury-buffer))))) - -(provide 'gnus-uu) - -;; gnus-uu.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-vm.el --- a/lisp/gnus/gnus-vm.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,107 +0,0 @@ -;;; gnus-vm.el --- vm interface for Gnus -;; Copyright (C) 1994,95,96,97 Free Software Foundation, Inc. - -;; Author: Per Persson -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Major contributors: -;; Christian Limpach -;; Some code stolen from: -;; Rick Sladkey - -;;; Code: - -(require 'sendmail) -(require 'message) -(require 'gnus) -(require 'gnus-msg) - -(eval-when-compile - (autoload 'vm-mode "vm") - (autoload 'vm-save-message "vm") - (autoload 'vm-forward-message "vm") - (autoload 'vm-reply "vm") - (autoload 'vm-mail "vm")) - -(defvar gnus-vm-inhibit-window-system nil - "Inhibit loading `win-vm' if using a window-system. -Has to be set before gnus-vm is loaded.") - -(or gnus-vm-inhibit-window-system - (condition-case nil - (when window-system - (require 'win-vm)) - (error nil))) - -(when (not (featurep 'vm)) - (load "vm")) - -(defun gnus-vm-make-folder (&optional buffer) - (let ((article (or buffer (current-buffer))) - (tmp-folder (generate-new-buffer " *tmp-folder*")) - (start (point-min)) - (end (point-max))) - (set-buffer tmp-folder) - (insert-buffer-substring article start end) - (goto-char (point-min)) - (if (looking-at "^\\(From [^ ]+ \\).*$") - (replace-match (concat "\\1" (current-time-string))) - (insert "From " gnus-newsgroup-name " " - (current-time-string) "\n")) - (while (re-search-forward "\n\nFrom " nil t) - (replace-match "\n\n>From ")) - ;; insert a newline, otherwise the last line gets lost - (goto-char (point-max)) - (insert "\n") - (vm-mode) - tmp-folder)) - -(defun gnus-summary-save-article-vm (&optional arg) - "Append the current article to a vm folder. -If N is a positive number, save the N next articles. -If N is a negative number, save the N previous articles. -If N is nil and any articles have been marked with the process mark, -save those articles instead." - (interactive "P") - (let ((gnus-default-article-saver 'gnus-summary-save-in-vm)) - (gnus-summary-save-article arg))) - -(defun gnus-summary-save-in-vm (&optional folder) - (interactive) - (setq folder - (cond ((eq folder 'default) default-name) - (folder folder) - (t (gnus-read-save-file-name - "Save %s in VM folder:" folder - gnus-mail-save-name gnus-newsgroup-name - gnus-current-headers 'gnus-newsgroup-last-mail)))) - (gnus-eval-in-buffer-window gnus-original-article-buffer - (save-excursion - (save-restriction - (widen) - (let ((vm-folder (gnus-vm-make-folder))) - (vm-save-message folder) - (kill-buffer vm-folder)))))) - -(provide 'gnus-vm) - -;;; gnus-vm.el ends here. diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-win.el --- a/lisp/gnus/gnus-win.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,550 +0,0 @@ -;;; gnus-win.el --- window configuration functions for Gnus -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'gnus) - -(defgroup gnus-windows nil - "Window configuration." - :group 'gnus) - -(defcustom gnus-use-full-window t - "*If non-nil, use the entire Emacs screen." - :group 'gnus-windows - :type 'boolean) - -(defvar gnus-window-configuration nil - "Obsolete variable. See `gnus-buffer-configuration'.") - -(defcustom gnus-window-min-width 2 - "*Minimum width of Gnus buffers." - :group 'gnus-windows - :type 'integer) - -(defcustom gnus-window-min-height 1 - "*Minimum height of Gnus buffers." - :group 'gnus-windows - :type 'integer) - -(defcustom gnus-always-force-window-configuration nil - "*If non-nil, always force the Gnus window configurations." - :group 'gnus-windows - :type 'boolean) - -(defvar gnus-buffer-configuration - '((group - (vertical 1.0 - (group 1.0 point) - (if gnus-carpal '(group-carpal 4)))) - (summary - (vertical 1.0 - (summary 1.0 point) - (if gnus-carpal '(summary-carpal 4)))) - (article - (cond - ((and gnus-use-picons - (eq gnus-picons-display-where 'picons)) - '(frame 1.0 - (vertical 1.0 - (summary 0.25 point) - (if gnus-carpal '(summary-carpal 4)) - (article 1.0)) - (vertical ((height . 5) (width . 15) - (user-position . t) - (left . -1) (top . 1)) - (picons 1.0)))) - (gnus-use-trees - '(vertical 1.0 - (summary 0.25 point) - (tree 0.25) - (article 1.0))) - (t - '(vertical 1.0 - (summary 0.25 point) - (if gnus-carpal '(summary-carpal 4)) - (article 1.0))))) - (server - (vertical 1.0 - (server 1.0 point) - (if gnus-carpal '(server-carpal 2)))) - (browse - (vertical 1.0 - (browse 1.0 point) - (if gnus-carpal '(browse-carpal 2)))) - (message - (vertical 1.0 - (message 1.0 point))) - (pick - (vertical 1.0 - (article 1.0 point))) - (info - (vertical 1.0 - (info 1.0 point))) - (summary-faq - (vertical 1.0 - (summary 0.25) - (faq 1.0 point))) - (edit-article - (vertical 1.0 - (article 1.0 point))) - (edit-form - (vertical 1.0 - (group 0.5) - (edit-form 1.0 point))) - (edit-score - (vertical 1.0 - (summary 0.25) - (edit-score 1.0 point))) - (post - (vertical 1.0 - (post 1.0 point))) - (reply - (vertical 1.0 - (article-copy 0.5) - (message 1.0 point))) - (forward - (vertical 1.0 - (message 1.0 point))) - (reply-yank - (vertical 1.0 - (message 1.0 point))) - (mail-bounce - (vertical 1.0 - (article 0.5) - (message 1.0 point))) - (draft - (vertical 1.0 - (draft 1.0 point))) - (pipe - (vertical 1.0 - (summary 0.25 point) - (if gnus-carpal '(summary-carpal 4)) - ("*Shell Command Output*" 1.0))) - (bug - (vertical 1.0 - ("*Gnus Help Bug*" 0.5) - ("*Gnus Bug*" 1.0 point))) - (score-trace - (vertical 1.0 - (summary 0.5 point) - ("*Score Trace*" 1.0))) - (score-words - (vertical 1.0 - (summary 0.5 point) - ("*Score Words*" 1.0))) - (compose-bounce - (vertical 1.0 - (article 0.5) - (message 1.0 point)))) - "Window configuration for all possible Gnus buffers. -See the Gnus manual for an explanation of the syntax used.") - -(defvar gnus-window-to-buffer - '((group . gnus-group-buffer) - (summary . gnus-summary-buffer) - (article . gnus-article-buffer) - (server . gnus-server-buffer) - (browse . "*Gnus Browse Server*") - (edit-group . gnus-group-edit-buffer) - (edit-form . gnus-edit-form-buffer) - (edit-server . gnus-server-edit-buffer) - (group-carpal . gnus-carpal-group-buffer) - (summary-carpal . gnus-carpal-summary-buffer) - (server-carpal . gnus-carpal-server-buffer) - (browse-carpal . gnus-carpal-browse-buffer) - (edit-score . gnus-score-edit-buffer) - (message . gnus-message-buffer) - (mail . gnus-message-buffer) - (post-news . gnus-message-buffer) - (faq . gnus-faq-buffer) - (picons . "*Picons*") - (tree . gnus-tree-buffer) - (info . gnus-info-buffer) - (article-copy . gnus-article-copy) - (draft . gnus-draft-buffer)) - "Mapping from short symbols to buffer names or buffer variables.") - -;;; Internal variables. - -(defvar gnus-current-window-configuration nil - "The most recently set window configuration.") - -(defvar gnus-created-frames nil) - -(defun gnus-kill-gnus-frames () - "Kill all frames Gnus has created." - (while gnus-created-frames - (when (frame-live-p (car gnus-created-frames)) - ;; We slap a condition-case around this `delete-frame' to ensure - ;; against errors if we try do delete the single frame that's left. - (ignore-errors - (delete-frame (car gnus-created-frames)))) - (pop gnus-created-frames))) - -(defun gnus-window-configuration-element (list) - (while (and list - (not (assq (car list) gnus-window-configuration))) - (pop list)) - (cadr (assq (car list) gnus-window-configuration))) - -(defun gnus-windows-old-to-new (setting) - ;; First we take care of the really, really old Gnus 3 actions. - (when (symbolp setting) - (setq setting - ;; Take care of ooold GNUS 3.x values. - (cond ((eq setting 'SelectArticle) 'article) - ((memq setting '(SelectNewsgroup SelectSubject ExpandSubject)) - 'summary) - ((memq setting '(ExitNewsgroup)) 'group) - (t setting)))) - (if (or (listp setting) - (not (and gnus-window-configuration - (memq setting '(group summary article))))) - setting - (let* ((elem - (cond - ((eq setting 'group) - (gnus-window-configuration-element - '(group newsgroups ExitNewsgroup))) - ((eq setting 'summary) - (gnus-window-configuration-element - '(summary SelectNewsgroup SelectSubject ExpandSubject))) - ((eq setting 'article) - (gnus-window-configuration-element - '(article SelectArticle))))) - (total (apply '+ elem)) - (types '(group summary article)) - (pbuf (if (eq setting 'newsgroups) 'group 'summary)) - (i 0) - perc out) - (while (< i 3) - (or (not (numberp (nth i elem))) - (zerop (nth i elem)) - (progn - (setq perc (if (= i 2) - 1.0 - (/ (float (nth i elem)) total))) - (push (if (eq pbuf (nth i types)) - (list (nth i types) perc 'point) - (list (nth i types) perc)) - out))) - (incf i)) - `(vertical 1.0 ,@(nreverse out))))) - -;;;###autoload -(defun gnus-add-configuration (conf) - "Add the window configuration CONF to `gnus-buffer-configuration'." - (setq gnus-buffer-configuration - (cons conf (delq (assq (car conf) gnus-buffer-configuration) - gnus-buffer-configuration)))) - -(defvar gnus-frame-list nil) - -(defun gnus-configure-frame (split &optional window) - "Split WINDOW according to SPLIT." - (unless window - (setq window (get-buffer-window (current-buffer)))) - (select-window window) - ;; This might be an old-stylee buffer config. - (when (vectorp split) - (setq split (append split nil))) - (when (or (consp (car split)) - (vectorp (car split))) - (push 1.0 split) - (push 'vertical split)) - ;; The SPLIT might be something that is to be evaled to - ;; return a new SPLIT. - (while (and (not (assq (car split) gnus-window-to-buffer)) - (gnus-functionp (car split))) - (setq split (eval split))) - (let* ((type (car split)) - (subs (cddr split)) - (len (if (eq type 'horizontal) (window-width) (window-height))) - (total 0) - (window-min-width (or gnus-window-min-width window-min-width)) - (window-min-height (or gnus-window-min-height window-min-height)) - s result new-win rest comp-subs size sub) - (cond - ;; Nothing to do here. - ((null split)) - ;; Don't switch buffers. - ((null type) - (and (memq 'point split) window)) - ;; This is a buffer to be selected. - ((not (memq type '(frame horizontal vertical))) - (let ((buffer (cond ((stringp type) type) - (t (cdr (assq type gnus-window-to-buffer))))) - buf) - (unless buffer - (error "Illegal buffer type: %s" type)) - (unless (setq buf (get-buffer (if (symbolp buffer) - (symbol-value buffer) buffer))) - (setq buf (get-buffer-create (if (symbolp buffer) - (symbol-value buffer) buffer)))) - (switch-to-buffer buf) - ;; We return the window if it has the `point' spec. - (and (memq 'point split) window))) - ;; This is a frame split. - ((eq type 'frame) - (unless gnus-frame-list - (setq gnus-frame-list (list (window-frame - (get-buffer-window (current-buffer)))))) - (let ((i 0) - params frame fresult) - (while (< i (length subs)) - ;; Frame parameter is gotten from the sub-split. - (setq params (cadr (elt subs i))) - ;; It should be a list. - (unless (listp params) - (setq params nil)) - ;; Create a new frame? - (unless (setq frame (elt gnus-frame-list i)) - (nconc gnus-frame-list (list (setq frame (make-frame params)))) - (push frame gnus-created-frames)) - ;; Is the old frame still alive? - (unless (frame-live-p frame) - (setcar (nthcdr i gnus-frame-list) - (setq frame (make-frame params)))) - ;; Select the frame in question and do more splits there. - (select-frame frame) - (setq fresult (or (gnus-configure-frame (elt subs i)) fresult)) - (incf i)) - ;; Select the frame that has the selected buffer. - (when fresult - (select-frame (window-frame fresult))))) - ;; This is a normal split. - (t - (when (> (length subs) 0) - ;; First we have to compute the sizes of all new windows. - (while subs - (setq sub (append (pop subs) nil)) - (while (and (not (assq (car sub) gnus-window-to-buffer)) - (gnus-functionp (car sub))) - (setq sub (eval sub))) - (when sub - (push sub comp-subs) - (setq size (cadar comp-subs)) - (cond ((equal size 1.0) - (setq rest (car comp-subs)) - (setq s 0)) - ((floatp size) - (setq s (floor (* size len)))) - ((integerp size) - (setq s size)) - (t - (error "Illegal size: %s" size))) - ;; Try to make sure that we are inside the safe limits. - (cond ((zerop s)) - ((eq type 'horizontal) - (setq s (max s window-min-width))) - ((eq type 'vertical) - (setq s (max s window-min-height)))) - (setcar (cdar comp-subs) s) - (incf total s))) - ;; Take care of the "1.0" spec. - (if rest - (setcar (cdr rest) (- len total)) - (error "No 1.0 specs in %s" split)) - ;; The we do the actual splitting in a nice recursive - ;; fashion. - (setq comp-subs (nreverse comp-subs)) - (while comp-subs - (if (null (cdr comp-subs)) - (setq new-win window) - (setq new-win - (split-window window (cadar comp-subs) - (eq type 'horizontal)))) - (setq result (or (gnus-configure-frame - (car comp-subs) window) - result)) - (select-window new-win) - (setq window new-win) - (setq comp-subs (cdr comp-subs)))) - ;; Return the proper window, if any. - (when result - (select-window result)))))) - -(defvar gnus-frame-split-p nil) - -(defun gnus-configure-windows (setting &optional force) - (setq gnus-current-window-configuration setting) - (setq force (or force gnus-always-force-window-configuration)) - (setq setting (gnus-windows-old-to-new setting)) - (let ((split (if (symbolp setting) - (cadr (assq setting gnus-buffer-configuration)) - setting)) - all-visible) - - (setq gnus-frame-split-p nil) - - (unless split - (error "No such setting: %s" setting)) - - (if (and (setq all-visible (gnus-all-windows-visible-p split)) - (not force)) - ;; All the windows mentioned are already visible, so we just - ;; put point in the assigned buffer, and do not touch the - ;; winconf. - (select-window all-visible) - - ;; Either remove all windows or just remove all Gnus windows. - (let ((frame (selected-frame))) - (unwind-protect - (if gnus-use-full-window - ;; We want to remove all other windows. - (if (not gnus-frame-split-p) - ;; This is not a `frame' split, so we ignore the - ;; other frames. - (delete-other-windows) - ;; This is a `frame' split, so we delete all windows - ;; on all frames. - (gnus-delete-windows-in-gnusey-frames)) - ;; Just remove some windows. - (gnus-remove-some-windows) - (switch-to-buffer nntp-server-buffer)) - (select-frame frame))) - - (switch-to-buffer nntp-server-buffer) - (gnus-configure-frame split (get-buffer-window (current-buffer)))))) - -(defun gnus-delete-windows-in-gnusey-frames () - "Do a `delete-other-windows' in all frames that have Gnus windows." - (let ((buffers - (mapcar - (lambda (elem) - (if (symbolp (cdr elem)) - (when (and (boundp (cdr elem)) - (symbol-value (cdr elem))) - (get-buffer (symbol-value (cdr elem)))) - (when (cdr elem) - (get-buffer (cdr elem))))) - gnus-window-to-buffer))) - (mapcar - (lambda (frame) - (unless (eq (cdr (assq 'minibuffer - (frame-parameters frame))) - 'only) - (select-frame frame) - (let (do-delete) - (walk-windows - (lambda (window) - (when (memq (window-buffer window) buffers) - (setq do-delete t)))) - (when do-delete - (delete-other-windows))))) - (frame-list)))) - -(defun gnus-all-windows-visible-p (split) - "Say whether all buffers in SPLIT are currently visible. -In particular, the value returned will be the window that -should have point." - (let ((stack (list split)) - (all-visible t) - type buffer win buf) - (while (and (setq split (pop stack)) - all-visible) - ;; Be backwards compatible. - (when (vectorp split) - (setq split (append split nil))) - (when (or (consp (car split)) - (vectorp (car split))) - (push 1.0 split) - (push 'vertical split)) - ;; The SPLIT might be something that is to be evaled to - ;; return a new SPLIT. - (while (and (not (assq (car split) gnus-window-to-buffer)) - (gnus-functionp (car split))) - (setq split (eval split))) - - (setq type (elt split 0)) - (cond - ;; Nothing here. - ((null split) t) - ;; A buffer. - ((not (memq type '(horizontal vertical frame))) - (setq buffer (cond ((stringp type) type) - (t (cdr (assq type gnus-window-to-buffer))))) - (unless buffer - (error "Illegal buffer type: %s" type)) - (when (setq buf (get-buffer (if (symbolp buffer) - (symbol-value buffer) - buffer))) - (setq win (get-buffer-window buf t))) - (if win - (when (memq 'point split) - (setq all-visible win)) - (setq all-visible nil))) - (t - (when (eq type 'frame) - (setq gnus-frame-split-p t)) - (setq stack (append (cddr split) stack))))) - (unless (eq all-visible t) - all-visible))) - -(defun gnus-window-top-edge (&optional window) - (nth 1 (window-edges window))) - -(defun gnus-remove-some-windows () - (let ((buffers gnus-window-to-buffer) - buf bufs lowest-buf lowest) - (save-excursion - ;; Remove windows on all known Gnus buffers. - (while buffers - (setq buf (cdar buffers)) - (when (symbolp buf) - (setq buf (and (boundp buf) (symbol-value buf)))) - (and buf - (get-buffer-window buf) - (progn - (push buf bufs) - (pop-to-buffer buf) - (when (or (not lowest) - (< (gnus-window-top-edge) lowest)) - (setq lowest (gnus-window-top-edge)) - (setq lowest-buf buf)))) - (setq buffers (cdr buffers))) - ;; Remove windows on *all* summary buffers. - (walk-windows - (lambda (win) - (let ((buf (window-buffer win))) - (when (string-match "^\\*Summary" (buffer-name buf)) - (push buf bufs) - (pop-to-buffer buf) - (when (or (not lowest) - (< (gnus-window-top-edge) lowest)) - (setq lowest-buf buf) - (setq lowest (gnus-window-top-edge))))))) - (when lowest-buf - (pop-to-buffer lowest-buf) - (switch-to-buffer nntp-server-buffer)) - (while bufs - (when (not (eq (car bufs) lowest-buf)) - (delete-windows-on (car bufs))) - (setq bufs (cdr bufs)))))) - -(provide 'gnus-win) - -;;; gnus-win.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus-xmas.el --- a/lisp/gnus/gnus-xmas.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,816 +0,0 @@ -;;; gnus-xmas.el --- Gnus functions for XEmacs -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'text-props) -(defvar menu-bar-mode (featurep 'menubar)) -(require 'messagexmas) - -(defgroup gnus-xmas nil - "XEmacsoid support for Gnus" - :group 'gnus) - -(defcustom gnus-xmas-glyph-directory nil - "*Directory where Gnus logos and icons are located. -If this variable is nil, Gnus will try to locate the directory -automatically." - :type '(choice (const :tag "autodetect" nil) - directory) - :group 'gnus-xmas) - -(defvar gnus-xmas-logo-color-alist - '((flame "#cc3300" "#ff2200") - (pine "#c0cc93" "#f8ffb8") - (moss "#a1cc93" "#d2ffb8") - (irish "#04cc90" "#05ff97") - (sky "#049acc" "#05deff") - (tin "#6886cc" "#82b6ff") - (velvet "#7c68cc" "#8c82ff") - (grape "#b264cc" "#cf7df") - (labia "#cc64c2" "#fd7dff") - (berry "#cc6485" "#ff7db5") - (neutral "#b4b4b4" "#878787") - (september "#bf9900" "#ffcc00")) - "Color alist used for the Gnus logo.") - -(defcustom gnus-xmas-logo-color-style 'flame - "Color styles used for the Gnus logo." - :type '(choice (const flame) (const pine) (const moss) - (const irish) (const sky) (const tin) - (const velvet) (const grape) (const labia) - (const berry) (const neutral) (const september)) - :group 'gnus-xmas) - -(defvar gnus-xmas-logo-colors - (cdr (assq gnus-xmas-logo-color-style gnus-xmas-logo-color-alist)) - "Colors used for the Gnus logo.") - -(defcustom gnus-article-x-face-command - (if (or (featurep 'xface) - (featurep 'xpm)) - 'gnus-xmas-article-display-xface - "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -") - "String or function to be executed to display an X-Face header. -If it is a string, the command will be executed in a sub-shell -asynchronously. The compressed face will be piped to this command." - :type '(choice string function)) - -;;; Internal variables. - -;; Don't warn about these undefined variables. - -(defvar gnus-group-mode-hook) -(defvar gnus-summary-mode-hook) -(defvar gnus-article-mode-hook) - -;;defined in gnus.el -(defvar gnus-active-hashtb) -(defvar gnus-article-buffer) -(defvar gnus-auto-center-summary) -(defvar gnus-buffer-list) -(defvar gnus-current-headers) -(defvar gnus-level-killed) -(defvar gnus-level-zombie) -(defvar gnus-newsgroup-bookmarks) -(defvar gnus-newsgroup-dependencies) -(defvar gnus-newsgroup-selected-overlay) -(defvar gnus-newsrc-hashtb) -(defvar gnus-read-mark) -(defvar gnus-refer-article-method) -(defvar gnus-reffed-article-number) -(defvar gnus-unread-mark) -(defvar gnus-version) -(defvar gnus-view-pseudos) -(defvar gnus-view-pseudos-separately) -(defvar gnus-visual) -(defvar gnus-zombie-list) -;;defined in gnus-msg.el -(defvar gnus-article-copy) -(defvar gnus-check-before-posting) -;;defined in gnus-vis.el -(defvar gnus-article-button-face) -(defvar gnus-article-mouse-face) -(defvar gnus-summary-selected-face) -(defvar gnus-group-reading-menu) -(defvar gnus-group-group-menu) -(defvar gnus-group-misc-menu) -(defvar gnus-summary-article-menu) -(defvar gnus-summary-thread-menu) -(defvar gnus-summary-misc-menu) -(defvar gnus-summary-post-menu) -(defvar gnus-summary-kill-menu) -(defvar gnus-article-article-menu) -(defvar gnus-article-treatment-menu) -(defvar gnus-mouse-2) -(defvar standard-display-table) -(defvar gnus-tree-minimize-window) - -(defun gnus-xmas-set-text-properties (start end props &optional buffer) - "You should NEVER use this function. It is ideologically blasphemous. -It is provided only to ease porting of broken FSF Emacs programs." - (if (stringp buffer) - nil - (map-extents (lambda (extent ignored) - (remove-text-properties - start end - (list (extent-property extent 'text-prop) nil) - buffer) - nil) - buffer start end nil nil 'text-prop) - (gnus-add-text-properties start end props buffer))) - -(defun gnus-xmas-highlight-selected-summary () - ;; Highlight selected article in summary buffer - (when gnus-summary-selected-face - (when gnus-newsgroup-selected-overlay - (delete-extent gnus-newsgroup-selected-overlay)) - (setq gnus-newsgroup-selected-overlay - (make-extent (gnus-point-at-bol) (gnus-point-at-eol))) - (set-extent-face gnus-newsgroup-selected-overlay - gnus-summary-selected-face))) - -(defcustom gnus-xmas-force-redisplay nil - "If non-nil, force a redisplay before recentering the summary buffer. -This is ugly, but it works around a bug in `window-displayed-height'." - :type 'boolean - :group 'gnus-xmas) - -(defun gnus-xmas-switch-horizontal-scrollbar-off () - (when (featurep 'scrollbar) - (set-specifier scrollbar-height (cons (current-buffer) 0)))) - -(defun gnus-xmas-summary-recenter () - "\"Center\" point in the summary window. -If `gnus-auto-center-summary' is nil, or the article buffer isn't -displayed, no centering will be performed." - ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). - ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. - ;; Force redisplay to get properly computed window height. - (when gnus-xmas-force-redisplay - (sit-for 0)) - (when gnus-auto-center-summary - (let* ((height (if (fboundp 'window-displayed-height) - (window-displayed-height) - (- (window-height) 2))) - (top (cond ((< height 4) 0) - ((< height 7) 1) - (t 2))) - (bottom (save-excursion (goto-char (point-max)) - (forward-line (- height)) - (point))) - (window (get-buffer-window (current-buffer)))) - (when (get-buffer-window gnus-article-buffer) - ;; Only do recentering when the article buffer is displayed, - ;; Set the window start to either `bottom', which is the biggest - ;; possible valid number, or the second line from the top, - ;; whichever is the least. - (set-window-start - window (min bottom (save-excursion (forward-line (- top)) (point))))) - ;; Do horizontal recentering while we're at it. - (when (and (get-buffer-window (current-buffer) t) - (not (eq gnus-auto-center-summary 'vertical))) - (let ((selected (selected-window))) - (select-window (get-buffer-window (current-buffer) t)) - (gnus-summary-position-point) - (gnus-horizontal-recenter) - (select-window selected)))))) - -(defun gnus-xmas-summary-set-display-table () - ;; Setup the display table -- like `gnus-summary-setup-display-table', - ;; but done in an XEmacsish way. - (let ((table (make-display-table)) - (i 32)) - ;; Nix out all the control chars... - (while (>= (setq i (1- i)) 0) - (aset table i [??])) - ;; ... but not newline and cr, of course. (cr is necessary for the - ;; selective display). - (aset table ?\n nil) - (aset table ?\r nil) - ;; We nix out any glyphs over 126 below ctl-arrow. - (let ((i (if (integerp ctl-arrow) ctl-arrow 160))) - (while (>= (setq i (1- i)) 127) - (unless (aref table i) - (aset table i [??])))) - ;; Can't use `set-specifier' because of a bug in 19.14 and earlier - (add-spec-to-specifier current-display-table table (current-buffer) nil))) - -(defun gnus-xmas-add-text-properties (start end props &optional object) - (add-text-properties start end props object) - (put-text-property start end 'start-closed nil object)) - -(defun gnus-xmas-put-text-property (start end prop value &optional object) - (put-text-property start end prop value object) - (put-text-property start end 'start-closed nil object)) - -(defun gnus-xmas-extent-start-open (point) - (map-extents (lambda (extent arg) - (set-extent-property extent 'start-open t)) - nil point (min (1+ (point)) (point-max)))) - -(defun gnus-xmas-article-push-button (event) - "Check text under the mouse pointer for a callback function. -If the text under the mouse pointer has a `gnus-callback' property, -call it with the value of the `gnus-data' text property." - (interactive "e") - (set-buffer (window-buffer (event-window event))) - (let* ((pos (event-closest-point event)) - (data (get-text-property pos 'gnus-data)) - (fun (get-text-property pos 'gnus-callback))) - (when fun - (funcall fun data)))) - -(defun gnus-xmas-move-overlay (extent start end &optional buffer) - (set-extent-endpoints extent start end)) - -;; Fixed by Christopher Davis . -(defun gnus-xmas-article-add-button (from to fun &optional data) - "Create a button between FROM and TO with callback FUN and data DATA." - (when 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 'mouse-face gnus-article-mouse-face)) - (list 'gnus-callback fun) - (and data (list 'gnus-data data)) - (list 'highlight t)))) - -(defun gnus-xmas-window-top-edge (&optional window) - (nth 1 (window-pixel-edges window))) - -(defun gnus-xmas-tree-minimize () - (when (and gnus-tree-minimize-window - (not (one-window-p))) - (let* ((window-min-height 2) - (height (1+ (count-lines (point-min) (point-max)))) - (min (max (1- window-min-height) height)) - (tot (if (numberp gnus-tree-minimize-window) - (min gnus-tree-minimize-window min) - min)) - (win (get-buffer-window (current-buffer))) - (wh (and win (1- (window-height win))))) - (when (and win - (not (eq tot wh))) - (let ((selected (selected-window))) - (select-window win) - (enlarge-window (- tot wh)) - (select-window selected)))))) - -;; Select the lowest window on the frame. -(defun gnus-xmas-appt-select-lowest-window () - (let* ((lowest-window (selected-window)) - (bottom-edge (car (cdr (cdr (cdr (window-pixel-edges)))))) - (last-window (previous-window)) - (window-search t)) - (while window-search - (let* ((this-window (next-window)) - (next-bottom-edge (car (cdr (cdr (cdr - (window-pixel-edges - this-window))))))) - (when (< bottom-edge next-bottom-edge) - (setq bottom-edge next-bottom-edge) - (setq lowest-window this-window)) - - (select-window this-window) - (when (eq last-window this-window) - (select-window lowest-window) - (setq window-search nil)))))) - -(defmacro gnus-xmas-menu-add (type &rest menus) - `(gnus-xmas-menu-add-1 ',type ',menus)) -(put 'gnus-xmas-menu-add 'lisp-indent-function 1) - -(defun gnus-xmas-menu-add-1 (type menus) - (when (and menu-bar-mode - (gnus-visual-p (intern (format "%s-menu" type)) 'menu)) - (while menus - (easy-menu-add (symbol-value (pop menus)))))) - -(defun gnus-xmas-group-menu-add () - (gnus-xmas-menu-add group - gnus-group-reading-menu gnus-group-group-menu gnus-group-misc-menu)) - -(defun gnus-xmas-summary-menu-add () - (gnus-xmas-menu-add summary - gnus-summary-misc-menu gnus-summary-kill-menu - gnus-summary-article-menu gnus-summary-thread-menu - gnus-summary-post-menu )) - -(defun gnus-xmas-article-menu-add () - (gnus-xmas-menu-add article - gnus-article-article-menu gnus-article-treatment-menu)) - -(defun gnus-xmas-score-menu-add () - (gnus-xmas-menu-add score - gnus-score-menu)) - -(defun gnus-xmas-pick-menu-add () - (gnus-xmas-menu-add pick - gnus-pick-menu)) - -(defun gnus-xmas-topic-menu-add () - (gnus-xmas-menu-add topic - gnus-topic-menu)) - -(defun gnus-xmas-binary-menu-add () - (gnus-xmas-menu-add binary - gnus-binary-menu)) - -(defun gnus-xmas-tree-menu-add () - (gnus-xmas-menu-add tree - gnus-tree-menu)) - -(defun gnus-xmas-server-menu-add () - (gnus-xmas-menu-add menu - gnus-server-server-menu gnus-server-connections-menu)) - -(defun gnus-xmas-browse-menu-add () - (gnus-xmas-menu-add browse - gnus-browse-menu)) - -(defun gnus-xmas-grouplens-menu-add () - (gnus-xmas-menu-add grouplens - gnus-grouplens-menu)) - -(defun gnus-xmas-read-event-char () - "Get the next event." - (let ((event (next-command-event))) - (sit-for 0) - ;; We junk all non-key events. Is this naughty? - (while (not (or (key-press-event-p event) - (button-press-event-p event))) - (dispatch-event event) - (setq event (next-command-event))) - (cons (and (key-press-event-p event) - (event-to-character event)) - event))) - -(defun gnus-xmas-group-remove-excess-properties () - (let ((end (point)) - (beg (progn (forward-line -1) (point)))) - (remove-text-properties (1+ beg) end '(gnus-group nil)) - (remove-text-properties - beg end - '(gnus-topic nil gnus-topic-level nil gnus-topic-visible nil)) - (goto-char end) - (map-extents - (lambda (e ma) - (set-extent-property e 'start-closed t)) - (current-buffer) beg end))) - -(defun gnus-xmas-topic-remove-excess-properties () - (let ((end (point)) - (beg (progn (forward-line -1) (point)))) - (remove-text-properties beg end '(gnus-group nil gnus-unread nil)) - (remove-text-properties (1+ beg) end '(gnus-topic nil)) - (goto-char end))) - -(defun gnus-xmas-seconds-since-epoch (date) - "Return a floating point number that says how many seconds have lapsed between Jan 1 12:00:00 1970 and DATE." - (let* ((tdate (mapcar (lambda (ti) (and ti (string-to-int ti))) - (timezone-parse-date date))) - (ttime (mapcar (lambda (ti) (and ti (string-to-int ti))) - (timezone-parse-time - (aref (timezone-parse-date date) 3)))) - (edate (mapcar (lambda (ti) (and ti (string-to-int ti))) - (timezone-parse-date "Jan 1 12:00:00 1970"))) - (tday (- (timezone-absolute-from-gregorian - (nth 1 tdate) (nth 2 tdate) (nth 0 tdate)) - (timezone-absolute-from-gregorian - (nth 1 edate) (nth 2 edate) (nth 0 edate))))) - (+ (nth 2 ttime) - (* (nth 1 ttime) 60) - (* (float (nth 0 ttime)) 60 60) - (* (float tday) 60 60 24)))) - -(defun gnus-xmas-define () - (setq gnus-mouse-2 [button2]) - - (unless (memq 'underline (face-list)) - (and (fboundp 'make-face) - (funcall (intern "make-face") 'underline))) - ;; Must avoid calling set-face-underline-p directly, because it - ;; is a defsubst in emacs19, and will make the .elc files non - ;; portable! - (unless (face-differs-from-default-p 'underline) - (funcall (intern "set-face-underline-p") 'underline t)) - - (cond - ((fboundp 'char-or-char-int-p) - ;; Handle both types of marks for XEmacs-20.x. - (fset 'gnus-characterp 'char-or-char-int-p)) - ;; V19 of XEmacs, probably. - (t - (fset 'gnus-characterp 'characterp))) - - (fset 'gnus-make-overlay 'make-extent) - (fset 'gnus-overlay-put 'set-extent-property) - (fset 'gnus-move-overlay 'gnus-xmas-move-overlay) - (fset 'gnus-overlay-end 'extent-end-position) - (fset 'gnus-extent-detached-p 'extent-detached-p) - (fset 'gnus-add-text-properties 'gnus-xmas-add-text-properties) - (fset 'gnus-put-text-property 'gnus-xmas-put-text-property) - - (require 'text-props) - (if (and (<= emacs-major-version 19) - (< emacs-minor-version 14)) - (fset 'gnus-set-text-properties 'gnus-xmas-set-text-properties)) - - (when (fboundp 'turn-off-scroll-in-place) - (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place)) - - (unless (boundp 'standard-display-table) - (setq standard-display-table nil)) - - (defvar gnus-mouse-face-prop 'highlight) - - (unless (fboundp 'encode-time) - (defun encode-time (sec minute hour day month year &optional zone) - (let ((seconds - (gnus-xmas-seconds-since-epoch - (timezone-make-arpa-date - year month day (timezone-make-time-string hour minute sec) - zone)))) - (list (floor (/ seconds (expt 2 16))) - (round (mod seconds (expt 2 16))))))) - - (defun gnus-byte-code (func) - "Return a form that can be `eval'ed based on FUNC." - (let ((fval (symbol-function func))) - (if (compiled-function-p fval) - (list 'funcall fval) - (cons 'progn (cdr (cdr fval)))))) - - (fset 'gnus-x-color-values - (if (fboundp 'x-color-values) - 'x-color-values - (lambda (color) - (color-instance-rgb-components - (make-color-instance color)))))) - -(defun gnus-xmas-redefine () - "Redefine lots of Gnus functions for XEmacs." - (fset 'gnus-summary-set-display-table 'gnus-xmas-summary-set-display-table) - (fset 'gnus-visual-turn-off-edit-menu 'identity) - (fset 'gnus-summary-recenter 'gnus-xmas-summary-recenter) - (fset 'gnus-extent-start-open 'gnus-xmas-extent-start-open) - (fset 'gnus-article-push-button 'gnus-xmas-article-push-button) - (fset 'gnus-article-add-button 'gnus-xmas-article-add-button) - (fset 'gnus-window-top-edge 'gnus-xmas-window-top-edge) - (fset 'gnus-read-event-char 'gnus-xmas-read-event-char) - (fset 'gnus-group-startup-message 'gnus-xmas-group-startup-message) - (fset 'gnus-tree-minimize 'gnus-xmas-tree-minimize) - (fset 'gnus-appt-select-lowest-window - 'gnus-xmas-appt-select-lowest-window) - (fset 'gnus-mail-strip-quoted-names 'gnus-xmas-mail-strip-quoted-names) - (fset 'gnus-character-to-event 'character-to-event) - (fset 'gnus-mode-line-buffer-identification - 'gnus-xmas-mode-line-buffer-identification) - (fset 'gnus-key-press-event-p 'key-press-event-p) - (fset 'gnus-region-active-p 'region-active-p) - - (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add) - (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add) - (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add) - (add-hook 'gnus-score-mode-hook 'gnus-xmas-score-menu-add) - - (add-hook 'gnus-pick-mode-hook 'gnus-xmas-pick-menu-add) - (add-hook 'gnus-topic-mode-hook 'gnus-xmas-topic-menu-add) - (add-hook 'gnus-tree-mode-hook 'gnus-xmas-tree-menu-add) - (add-hook 'gnus-binary-mode-hook 'gnus-xmas-binary-menu-add) - (add-hook 'gnus-grouplens-mode-hook 'gnus-xmas-grouplens-menu-add) - (add-hook 'gnus-server-mode-hook 'gnus-xmas-server-menu-add) - (add-hook 'gnus-browse-mode-hook 'gnus-xmas-browse-menu-add) - - (add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar) - (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar) - - (add-hook 'gnus-summary-mode-hook - 'gnus-xmas-switch-horizontal-scrollbar-off) - (add-hook 'gnus-tree-mode-hook 'gnus-xmas-switch-horizontal-scrollbar-off)) - - -;;; XEmacs logo and toolbar. - -(defun gnus-xmas-group-startup-message (&optional x y) - "Insert startup message in current buffer." - ;; Insert the message. - (setq gnus-xmas-glyph-directory (message-xmas-find-glyph-directory "gnus")) - (erase-buffer) - (cond - ((and (console-on-window-system-p) - (or (featurep 'xpm) - (featurep 'xbm))) - (let* ((logo-xpm (expand-file-name "gnus.xpm" gnus-xmas-glyph-directory)) - (logo-xbm (expand-file-name "gnus.xbm" gnus-xmas-glyph-directory)) - (glyph (make-glyph - `(,@(if (featurep 'xpm) - (list - (vector 'xpm - ':file logo-xpm - ':color-symbols - `(("thing" . ,(car gnus-xmas-logo-colors)) - ("shadow" . ,(cadr gnus-xmas-logo-colors)) - ("background" . ,(face-background 'default)))))) - ,(vector 'xbm :file logo-xbm) - ,(vector 'nothing))))) - (insert " ") - (set-extent-begin-glyph (make-extent (point) (point)) glyph) - (goto-char (point-min)) - (while (not (eobp)) - (insert (make-string (/ (max (- (window-width) (or x 35)) 0) 2) - ?\ )) - (forward-line 1))) - (goto-char (point-min)) - (let* ((pheight (+ 20 (count-lines (point-min) (point-max)))) - (wheight (window-height)) - (rest (- wheight pheight))) - (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))) - (t - (insert - (format " %s - _ ___ _ _ - _ ___ __ ___ __ _ ___ - __ _ ___ __ ___ - _ ___ _ - _ _ __ _ - ___ __ _ - __ _ - _ _ _ - _ _ _ - _ _ _ - __ ___ - _ _ _ _ - _ _ - _ _ - _ _ - _ - __ - -" - "")) - ;; And then hack it. - (gnus-indent-rigidly (point-min) (point-max) - (/ (max (- (window-width) (or x 46)) 0) 2)) - (goto-char (point-min)) - (forward-line 1) - (let* ((pheight (count-lines (point-min) (point-max))) - (wheight (window-height)) - (rest (- wheight pheight))) - (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) - ;; Paint it. - (put-text-property (point-min) (point-max) 'face 'gnus-splash-face))) - (setq modeline-buffer-identification - (list (concat gnus-version ": *Group*"))) - (set-buffer-modified-p t)) - - -;;; The toolbar. - -(defcustom gnus-use-toolbar (if (featurep 'toolbar) - 'default-toolbar - nil) - "*If nil, do not use a toolbar. -If it is non-nil, it must be a toolbar. The five legal values are -`default-toolbar', `top-toolbar', `bottom-toolbar', -`right-toolbar', and `left-toolbar'." - :type '(choice (const default-toolbar) - (const top-toolbar) (const bottom-toolbar) - (const left-toolbar) (const right-toolbar) - (const :tag "no toolbar" nil)) - :group 'gnus-xmas) - -(defvar gnus-group-toolbar - '([gnus-group-get-new-news gnus-group-get-new-news t "Get new news"] - [gnus-group-get-new-news-this-group - gnus-group-get-new-news-this-group t "Get new news in this group"] - [gnus-group-catchup-current - gnus-group-catchup-current t "Catchup group"] - [gnus-group-describe-group - gnus-group-describe-group t "Describe group"] - [gnus-group-unsubscribe gnus-group-unsubscribe t "Unsubscribe group"] - [gnus-group-subscribe gnus-group-subscribe t "Subscribe group"] - [gnus-group-kill-group gnus-group-kill-group t "Kill group"] - [gnus-group-exit gnus-group-exit t "Exit Gnus"] - ) - "The group buffer toolbar.") - -(defvar gnus-summary-toolbar - '([gnus-summary-prev-unread - gnus-summary-prev-page-or-article t "Page up"] - [gnus-summary-next-unread - gnus-summary-next-page t "Page down"] - [gnus-summary-post-news - gnus-summary-post-news t "Post an article"] - [gnus-summary-followup-with-original - gnus-summary-followup-with-original t - "Post a followup and yank the original"] - [gnus-summary-followup - gnus-summary-followup t "Post a followup"] - [gnus-summary-reply-with-original - gnus-summary-reply-with-original t "Mail a reply and yank the original"] - [gnus-summary-reply - gnus-summary-reply t "Mail a reply"] - [gnus-summary-caesar-message - gnus-summary-caesar-message t "Rot 13"] - [gnus-uu-decode-uu - gnus-uu-decode-uu t "Decode uuencoded articles"] - [gnus-summary-save-article-file - gnus-summary-save-article-file t "Save article in file"] - [gnus-summary-save-article - gnus-summary-save-article t "Save article"] - [gnus-uu-post-news - gnus-uu-post-news t "Post a uuencoded article"] - [gnus-summary-cancel-article - gnus-summary-cancel-article t "Cancel article"] - [gnus-summary-catchup - gnus-summary-catchup t "Catchup"] - [gnus-summary-catchup-and-exit - gnus-summary-catchup-and-exit t "Catchup and exit"] - [gnus-summary-exit gnus-summary-exit t "Exit this summary"] - ) - "The summary buffer toolbar.") - -(defvar gnus-summary-mail-toolbar - '( - [gnus-summary-prev-unread - gnus-summary-prev-unread-article t "Prev unread article"] - [gnus-summary-next-unread - gnus-summary-next-unread-article t "Next unread article"] - [gnus-summary-mail-reply gnus-summary-reply t "Reply"] -; [gnus-summary-mail-get gnus-mail-get t "Message get"] - [gnus-summary-mail-originate gnus-summary-post-news t "Originate"] - [gnus-summary-mail-save gnus-summary-save-article t "Save"] - [gnus-summary-mail-copy gnus-summary-copy-article t "Copy message"] -; [gnus-summary-mail-delete gnus-summary-delete-article t "Delete message"] - [gnus-summary-mail-forward gnus-summary-mail-forward t "Forward message"] -; [gnus-summary-mail-spell gnus-mail-spell t "Spell"] -; [gnus-summary-mail-help gnus-mail-help t "Message help"] - [gnus-summary-caesar-message - gnus-summary-caesar-message t "Rot 13"] - [gnus-uu-decode-uu - gnus-uu-decode-uu t "Decode uuencoded articles"] - [gnus-summary-save-article-file - gnus-summary-save-article-file t "Save article in file"] - [gnus-summary-save-article - gnus-summary-save-article t "Save article"] - [gnus-summary-catchup - gnus-summary-catchup t "Catchup"] - [gnus-summary-catchup-and-exit - gnus-summary-catchup-and-exit t "Catchup and exit"] - [gnus-summary-exit gnus-summary-exit t "Exit this summary"] - ) - "The summary buffer mail toolbar.") - -(defun gnus-xmas-setup-group-toolbar () - (and gnus-use-toolbar - (message-xmas-setup-toolbar gnus-group-toolbar nil "gnus") - (set-specifier (symbol-value gnus-use-toolbar) - (cons (current-buffer) gnus-group-toolbar)))) - -(defun gnus-xmas-setup-summary-toolbar () - (let ((bar (if (gnus-news-group-p gnus-newsgroup-name) - gnus-summary-toolbar gnus-summary-mail-toolbar))) - (and gnus-use-toolbar - (message-xmas-setup-toolbar bar nil "gnus") - (set-specifier (symbol-value gnus-use-toolbar) - (cons (current-buffer) bar))))) - -(defun gnus-xmas-mail-strip-quoted-names (address) - "Protect mail-strip-quoted-names from NIL input. -XEmacs compatibility workaround." - (if (null address) - nil - (mail-strip-quoted-names address))) - -(defun gnus-xmas-call-region (command &rest args) - (apply - 'call-process-region (point-min) (point-max) command t '(t nil) nil - args)) - -(defface gnus-x-face '((t (:foreground "black" :background "white"))) - "Face to show X face" - :group 'gnus-xmas) - -(defun gnus-xmas-article-display-xface (beg end) - "Display any XFace headers in the current article." - (save-excursion - (let ((xface-glyph - (cond ((featurep 'xface) - (make-glyph (vector 'xface :data - (concat "X-Face: " - (buffer-substring beg end))))) - ((featurep 'xpm) - (let ((cur (current-buffer))) - (save-excursion - (gnus-set-work-buffer) - (insert (format "%s" (buffer-substring beg end cur))) - (gnus-xmas-call-region "uncompface") - (goto-char (point-min)) - (insert "/* Width=48, Height=48 */\n") - (gnus-xmas-call-region "icontopbm") - (gnus-xmas-call-region "ppmtoxpm") - (make-glyph - (vector 'xpm :data (buffer-string)))))) - (t - (make-glyph [nothing]))))) - (set-glyph-face xface-glyph 'gnus-x-face) - (goto-char (point-min)) - (re-search-forward "^From:" nil t) - (set-extent-begin-glyph - (make-extent (point) (1+ (point))) xface-glyph)))) - -;;(defvar gnus-xmas-pointer-glyph -;; (progn -;; (setq gnus-xmas-glyph-directory (message-xmas-find-glyph-directory -;; "gnus")) -;; (let ((file-xpm (expand-file-name "gnus-pointer.xpm" -;; gnus-xmas-glyph-directory)) -;; (file-xbm (expand-file-name "gnus-pointer.xbm" -;; gnus-xmas-glyph-directory))) -;; (make-pointer-glyph -;; (list (vector 'xpm ':file file-xpm) -;; (vector 'xbm ':file file-xbm)))))) - -(defvar gnus-xmas-modeline-left-extent - (let ((ext (copy-extent modeline-buffer-id-left-extent))) -; (set-extent-property ext 'pointer gnus-xmas-pointer-glyph) - ext)) - -(defvar gnus-xmas-modeline-right-extent - (let ((ext (copy-extent modeline-buffer-id-right-extent))) -; (set-extent-property ext 'pointer gnus-xmas-pointer-glyph) - ext)) - -(defvar gnus-xmas-modeline-glyph - (progn - (setq gnus-xmas-glyph-directory (message-xmas-find-glyph-directory "gnus")) - (let* ((file-xpm (expand-file-name "gnus-pointer.xpm" - gnus-xmas-glyph-directory)) - (file-xbm (expand-file-name "gnus-pointer.xbm" - gnus-xmas-glyph-directory)) - (glyph (make-glyph - ;; Gag gag gag. - `( - ,@(if (featurep 'xpm) - ;; Let's try a nifty XPM - (list (vector 'xpm ':file file-xpm))) - ;; Then a not-so-nifty XBM - ,(vector 'xbm ':file file-xbm) - ;; Then the simple string - ,(vector 'string ':data "Gnus:"))))) - (set-glyph-face glyph 'modeline-buffer-id) - glyph))) - -(defun gnus-xmas-mode-line-buffer-identification (line) - (let ((line (car line)) - chop) - (cond - ;; This is some weird type of id. - ((not (stringp line)) - (list line)) - ;; This is non-standard, so we just pass it through. - ((not (string-match "^Gnus:" line)) - (list line)) - ;; We have a standard line, so we colorize and glyphize it a bit. - (t - (setq chop (match-end 0)) - (list - (if gnus-xmas-modeline-glyph - (cons gnus-xmas-modeline-left-extent gnus-xmas-modeline-glyph) - (cons gnus-xmas-modeline-left-extent (substring line 0 chop))) - (cons gnus-xmas-modeline-right-extent (substring line chop))))))) - -(defun gnus-xmas-splash () - (when (eq (device-type) 'x) - (gnus-splash))) - -(provide 'gnus-xmas) - -;;; gnus-xmas.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/gnus.el --- a/lisp/gnus/gnus.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2597 +0,0 @@ -;;; gnus.el --- a newsreader for GNU Emacs -;; Copyright (C) 1987,88,89,90,93,94,95,96,97 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(eval '(run-hooks 'gnus-load-hook)) - -(require 'custom) -(require 'gnus-load) -(require 'message) - -(defgroup gnus nil - "The coffee-brewing, all singing, all dancing, kitchen sink newsreader." - :group 'news - :group 'mail) - -(defgroup gnus-start nil - "Starting your favorite newsreader." - :group 'gnus) - -(defgroup gnus-start-server nil - "Server options at startup." - :group 'gnus-start) - -;; These belong to gnus-group.el. -(defgroup gnus-group nil - "Group buffers." - :link '(custom-manual "(gnus)The Group Buffer") - :group 'gnus) - -(defgroup gnus-group-foreign nil - "Foreign groups." - :link '(custom-manual "(gnus)Foreign Groups") - :group 'gnus-group) - -(defgroup gnus-group-new nil - "Automatic subscription of new groups." - :group 'gnus-group) - -(defgroup gnus-group-levels nil - "Group levels." - :link '(custom-manual "(gnus)Group Levels") - :group 'gnus-group) - -(defgroup gnus-group-select nil - "Selecting a Group." - :link '(custom-manual "(gnus)Selecting a Group") - :group 'gnus-group) - -(defgroup gnus-group-listing nil - "Showing slices of the group list." - :link '(custom-manual "(gnus)Listing Groups") - :group 'gnus-group) - -(defgroup gnus-group-visual nil - "Sorting the group buffer." - :link '(custom-manual "(gnus)Group Buffer Format") - :group 'gnus-group - :group 'gnus-visual) - -(defgroup gnus-group-various nil - "Various group options." - :link '(custom-manual "(gnus)Scanning New Messages") - :group 'gnus-group) - -;; These belong to gnus-sum.el. -(defgroup gnus-summary nil - "Summary buffers." - :link '(custom-manual "(gnus)The Summary Buffer") - :group 'gnus) - -(defgroup gnus-summary-exit nil - "Leaving summary buffers." - :link '(custom-manual "(gnus)Exiting the Summary Buffer") - :group 'gnus-summary) - -(defgroup gnus-summary-marks nil - "Marks used in summary buffers." - :link '(custom-manual "(gnus)Marking Articles") - :group 'gnus-summary) - -(defgroup gnus-thread nil - "Ordering articles according to replies." - :link '(custom-manual "(gnus)Threading") - :group 'gnus-summary) - -(defgroup gnus-summary-format nil - "Formatting of the summary buffer." - :link '(custom-manual "(gnus)Summary Buffer Format") - :group 'gnus-summary) - -(defgroup gnus-summary-choose nil - "Choosing Articles." - :link '(custom-manual "(gnus)Choosing Articles") - :group 'gnus-summary) - -(defgroup gnus-summary-maneuvering nil - "Summary movement commands." - :link '(custom-manual "(gnus)Summary Maneuvering") - :group 'gnus-summary) - -(defgroup gnus-summary-mail nil - "Mail group commands." - :link '(custom-manual "(gnus)Mail Group Commands") - :group 'gnus-summary) - -(defgroup gnus-summary-sort nil - "Sorting the summary buffer." - :link '(custom-manual "(gnus)Sorting") - :group 'gnus-summary) - -(defgroup gnus-summary-visual nil - "Highlighting and menus in the summary buffer." - :link '(custom-manual "(gnus)Summary Highlighting") - :group 'gnus-visual - :group 'gnus-summary) - -(defgroup gnus-summary-various nil - "Various summary buffer options." - :link '(custom-manual "(gnus)Various Summary Stuff") - :group 'gnus-summary) - -(defgroup gnus-summary-pick nil - "Pick mode in the summary buffer." - :link '(custom-manual "(gnus)Pick and Read") - :prefix "gnus-pick-" - :group 'gnus-summary) - -(defgroup gnus-summary-tree nil - "Tree display of threads in the summary buffer." - :link '(custom-manual "(gnus)Tree Display") - :prefix "gnus-tree-" - :group 'gnus-summary) - -;; Belongs to gnus-uu.el -(defgroup gnus-extract-view nil - "Viewing extracted files." - :link '(custom-manual "(gnus)Viewing Files") - :group 'gnus-extract) - -;; Belongs to gnus-score.el -(defgroup gnus-score nil - "Score and kill file handling." - :group 'gnus) - -(defgroup gnus-score-kill nil - "Kill files." - :group 'gnus-score) - -(defgroup gnus-score-adapt nil - "Adaptive score files." - :group 'gnus-score) - -(defgroup gnus-score-default nil - "Default values for score files." - :group 'gnus-score) - -(defgroup gnus-score-expire nil - "Expiring score rules." - :group 'gnus-score) - -(defgroup gnus-score-decay nil - "Decaying score rules." - :group 'gnus-score) - -(defgroup gnus-score-files nil - "Score and kill file names." - :group 'gnus-score - :group 'gnus-files) - -(defgroup gnus-score-various nil - "Various scoring and killing options." - :group 'gnus-score) - -;; Other -(defgroup gnus-visual nil - "Options controling the visual fluff." - :group 'gnus - :group 'faces) - -(defgroup gnus-files nil - "Files used by Gnus." - :group 'gnus) - -(defgroup gnus-dribble-file nil - "Auto save file." - :link '(custom-manual "(gnus)Auto Save") - :group 'gnus-files) - -(defgroup gnus-newsrc nil - "Storing Gnus state." - :group 'gnus-files) - -(defgroup gnus-server nil - "Options related to newsservers and other servers used by Gnus." - :group 'gnus) - -(defgroup gnus-message '((message custom-group)) - "Composing replies and followups in Gnus." - :group 'gnus) - -(defgroup gnus-meta nil - "Meta variables controling major portions of Gnus. -In general, modifying these variables does not take affect until Gnus -is restarted, and sometimes reloaded." - :group 'gnus) - -(defgroup gnus-various nil - "Other Gnus options." - :link '(custom-manual "(gnus)Various Various") - :group 'gnus) - -(defgroup gnus-exit nil - "Exiting gnus." - :link '(custom-manual "(gnus)Exiting Gnus") - :group 'gnus) - -(defconst gnus-version-number "5.4.63" - "Version number for this version of Gnus.") - -(defconst gnus-version (format "Gnus v%s" gnus-version-number) - "Version string for this version of Gnus.") - -(defcustom gnus-inhibit-startup-message nil - "If non-nil, the startup message will not be displayed. -This variable is used before `.gnus.el' is loaded, so it should -be set in `.emacs' instead." - :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) - -;;; Kludges to help the transition from the old `custom.el'. - -(unless (featurep 'gnus-xmas) - (defalias 'gnus-make-overlay 'make-overlay) - (defalias 'gnus-overlay-put 'overlay-put) - (defalias 'gnus-move-overlay 'move-overlay) - (defalias 'gnus-overlay-end 'overlay-end) - (defalias 'gnus-extent-detached-p 'ignore) - (defalias 'gnus-extent-start-open 'ignore) - (defalias 'gnus-set-text-properties 'set-text-properties) - (defalias 'gnus-group-remove-excess-properties 'ignore) - (defalias 'gnus-topic-remove-excess-properties 'ignore) - (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window) - (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names) - (defalias 'gnus-character-to-event 'identity) - (defalias 'gnus-add-text-properties 'add-text-properties) - (defalias 'gnus-put-text-property 'put-text-property) - (defalias 'gnus-mode-line-buffer-identification 'identity) - (defalias 'gnus-characterp 'numberp) - (defalias 'gnus-key-press-event-p 'numberp)) - -;; The XEmacs people think this is evil, so it must go. -(defun custom-face-lookup (&optional fg bg stipple bold italic underline) - "Lookup or create a face with specified attributes." - (let ((name (intern (format "custom-face-%s-%s-%s-%S-%S-%S" - (or fg "default") - (or bg "default") - (or stipple "default") - bold italic underline)))) - (if (and (custom-facep name) - (fboundp 'make-face)) - () - (copy-face 'default name) - (when (and fg - (not (string-equal fg "default"))) - (ignore-errors - (set-face-foreground name fg))) - (when (and bg - (not (string-equal bg "default"))) - (ignore-errors - (set-face-background name bg))) - (when (and stipple - (not (string-equal stipple "default")) - (not (eq stipple 'custom:asis)) - (fboundp 'set-face-stipple)) - (set-face-stipple name stipple)) - (when (and bold - (not (eq bold 'custom:asis))) - (ignore-errors - (make-face-bold name))) - (when (and italic - (not (eq italic 'custom:asis))) - (ignore-errors - (make-face-italic name))) - (when (and underline - (not (eq underline 'custom:asis))) - (ignore-errors - (set-face-underline-p name t)))) - name)) - -;; We define these group faces here to avoid the display -;; update forced when creating new faces. - -(defface gnus-group-news-1-face - '((((class color) - (background dark)) - (:foreground "PaleTurquoise" :bold t)) - (((class color) - (background light)) - (:foreground "ForestGreen" :bold t)) - (t - ())) - "Level 1 newsgroup face.") - -(defface gnus-group-news-1-empty-face - '((((class color) - (background dark)) - (:foreground "PaleTurquoise")) - (((class color) - (background light)) - (:foreground "ForestGreen")) - (t - ())) - "Level 1 empty newsgroup face.") - -(defface gnus-group-news-2-face - '((((class color) - (background dark)) - (:foreground "turquoise" :bold t)) - (((class color) - (background light)) - (:foreground "CadetBlue4" :bold t)) - (t - ())) - "Level 2 newsgroup face.") - -(defface gnus-group-news-2-empty-face - '((((class color) - (background dark)) - (:foreground "turquoise")) - (((class color) - (background light)) - (:foreground "CadetBlue4")) - (t - ())) - "Level 2 empty newsgroup face.") - -(defface gnus-group-news-3-face - '((((class color) - (background dark)) - (:bold t)) - (((class color) - (background light)) - (:bold t)) - (t - ())) - "Level 3 newsgroup face.") - -(defface gnus-group-news-3-empty-face - '((((class color) - (background dark)) - ()) - (((class color) - (background light)) - ()) - (t - ())) - "Level 3 empty newsgroup face.") - -(defface gnus-group-news-low-face - '((((class color) - (background dark)) - (:foreground "DarkTurquoise" :bold t)) - (((class color) - (background light)) - (:foreground "DarkGreen" :bold t)) - (t - ())) - "Low level newsgroup face.") - -(defface gnus-group-news-low-empty-face - '((((class color) - (background dark)) - (:foreground "DarkTurquoise")) - (((class color) - (background light)) - (:foreground "DarkGreen")) - (t - ())) - "Low level empty newsgroup face.") - -(defface gnus-group-mail-1-face - '((((class color) - (background dark)) - (:foreground "aquamarine1" :bold t)) - (((class color) - (background light)) - (:foreground "DeepPink3" :bold t)) - (t - (:bold t))) - "Level 1 mailgroup face.") - -(defface gnus-group-mail-1-empty-face - '((((class color) - (background dark)) - (:foreground "aquamarine1")) - (((class color) - (background light)) - (:foreground "DeepPink3")) - (t - (:italic t :bold t))) - "Level 1 empty mailgroup face.") - -(defface gnus-group-mail-2-face - '((((class color) - (background dark)) - (:foreground "aquamarine2" :bold t)) - (((class color) - (background light)) - (:foreground "HotPink3" :bold t)) - (t - (:bold t))) - "Level 2 mailgroup face.") - -(defface gnus-group-mail-2-empty-face - '((((class color) - (background dark)) - (:foreground "aquamarine2")) - (((class color) - (background light)) - (:foreground "HotPink3")) - (t - (:bold t))) - "Level 2 empty mailgroup face.") - -(defface gnus-group-mail-3-face - '((((class color) - (background dark)) - (:foreground "aquamarine3" :bold t)) - (((class color) - (background light)) - (:foreground "magenta4" :bold t)) - (t - (:bold t))) - "Level 3 mailgroup face.") - -(defface gnus-group-mail-3-empty-face - '((((class color) - (background dark)) - (:foreground "aquamarine3")) - (((class color) - (background light)) - (:foreground "magenta4")) - (t - ())) - "Level 3 empty mailgroup face.") - -(defface gnus-group-mail-low-face - '((((class color) - (background dark)) - (:foreground "aquamarine4" :bold t)) - (((class color) - (background light)) - (:foreground "DeepPink4" :bold t)) - (t - (:bold t))) - "Low level mailgroup face.") - -(defface gnus-group-mail-low-empty-face - '((((class color) - (background dark)) - (:foreground "aquamarine4")) - (((class color) - (background light)) - (:foreground "DeepPink4")) - (t - (:bold t))) - "Low level empty mailgroup face.") - -;; Summary mode faces. - -(defface gnus-summary-selected-face '((t - (:underline t))) - "Face used for selected articles.") - -(defface gnus-summary-cancelled-face - '((((class color)) - (:foreground "yellow" :background "black"))) - "Face used for cancelled articles.") - -(defface gnus-summary-high-ticked-face - '((((class color) - (background dark)) - (:foreground "pink" :bold t)) - (((class color) - (background light)) - (:foreground "firebrick" :bold t)) - (t - (:bold t))) - "Face used for high interest ticked articles.") - -(defface gnus-summary-low-ticked-face - '((((class color) - (background dark)) - (:foreground "pink" :italic t)) - (((class color) - (background light)) - (:foreground "firebrick" :italic t)) - (t - (:italic t))) - "Face used for low interest ticked articles.") - -(defface gnus-summary-normal-ticked-face - '((((class color) - (background dark)) - (:foreground "pink")) - (((class color) - (background light)) - (:foreground "firebrick")) - (t - ())) - "Face used for normal interest ticked articles.") - -(defface gnus-summary-high-ancient-face - '((((class color) - (background dark)) - (:foreground "SkyBlue" :bold t)) - (((class color) - (background light)) - (:foreground "RoyalBlue" :bold t)) - (t - (:bold t))) - "Face used for high interest ancient articles.") - -(defface gnus-summary-low-ancient-face - '((((class color) - (background dark)) - (:foreground "SkyBlue" :italic t)) - (((class color) - (background light)) - (:foreground "RoyalBlue" :italic t)) - (t - (:italic t))) - "Face used for low interest ancient articles.") - -(defface gnus-summary-normal-ancient-face - '((((class color) - (background dark)) - (:foreground "SkyBlue")) - (((class color) - (background light)) - (:foreground "RoyalBlue")) - (t - ())) - "Face used for normal interest ancient articles.") - -(defface gnus-summary-high-unread-face - '((t - (:bold t))) - "Face used for high interest unread articles.") - -(defface gnus-summary-low-unread-face - '((t - (:italic t))) - "Face used for low interest unread articles.") - -(defface gnus-summary-normal-unread-face - '((t - ())) - "Face used for normal interest unread articles.") - -(defface gnus-summary-high-read-face - '((((class color) - (background dark)) - (:foreground "PaleGreen" - :bold t)) - (((class color) - (background light)) - (:foreground "DarkGreen" - :bold t)) - (t - (:bold t))) - "Face used for high interest read articles.") - -(defface gnus-summary-low-read-face - '((((class color) - (background dark)) - (:foreground "PaleGreen" - :italic t)) - (((class color) - (background light)) - (:foreground "DarkGreen" - :italic t)) - (t - (:italic t))) - "Face used for low interest read articles.") - -(defface gnus-summary-normal-read-face - '((((class color) - (background dark)) - (:foreground "PaleGreen")) - (((class color) - (background light)) - (:foreground "DarkGreen")) - (t - ())) - "Face used for normal interest read articles.") - - -;;; Splash screen. - -(defvar gnus-group-buffer "*Group*") - -(eval-and-compile - (autoload 'gnus-play-jingle "gnus-audio")) - -(defface gnus-splash-face - '((((class color) - (background dark)) - (:foreground "red")) - (((class color) - (background light)) - (:foreground "red")) - (t - ())) - "Level 1 newsgroup face.") - -(defun gnus-splash () - (save-excursion - (switch-to-buffer gnus-group-buffer) - (let ((buffer-read-only nil)) - (erase-buffer) - (unless gnus-inhibit-startup-message - (gnus-group-startup-message) - (sit-for 0) - (when gnus-play-startup-jingle - (gnus-play-jingle)))))) - -(defun gnus-indent-rigidly (start end arg) - "Indent rigidly using only spaces and no tabs." - (save-excursion - (save-restriction - (narrow-to-region start end) - (let ((tab-width 8)) - (indent-rigidly start end arg) - ;; We translate tabs into spaces -- not everybody uses - ;; an 8-character tab. - (goto-char (point-min)) - (while (search-forward "\t" nil t) - (replace-match " " t t)))))) - -(defvar gnus-simple-splash nil) - -(defun gnus-group-startup-message (&optional x y) - "Insert startup message in current buffer." - ;; Insert the message. - (erase-buffer) - (insert - (format " %s - _ ___ _ _ - _ ___ __ ___ __ _ ___ - __ _ ___ __ ___ - _ ___ _ - _ _ __ _ - ___ __ _ - __ _ - _ _ _ - _ _ _ - _ _ _ - __ ___ - _ _ _ _ - _ _ - _ _ - _ _ - _ - __ - -" - "")) - ;; And then hack it. - (gnus-indent-rigidly (point-min) (point-max) - (/ (max (- (window-width) (or x 46)) 0) 2)) - (goto-char (point-min)) - (forward-line 1) - (let* ((pheight (count-lines (point-min) (point-max))) - (wheight (window-height)) - (rest (- wheight pheight))) - (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))) - ;; Fontify some. - (put-text-property (point-min) (point-max) 'face 'gnus-splash-face) - (goto-char (point-min)) - (setq mode-line-buffer-identification (concat " " gnus-version)) - (setq gnus-simple-splash t) - (set-buffer-modified-p t)) - -(eval-when (load) - (let ((command (format "%s" this-command))) - (when (and (string-match "gnus" command) - (not (string-match "gnus-other-frame" command))) - (gnus-splash)))) - -;;; Do the rest. - -(require 'custom) -(require 'gnus-util) -(require 'nnheader) - -(defcustom gnus-home-directory "~/" - "Directory variable that specifies the \"home\" directory. -All other Gnus path variables are initialized from this variable." - :group 'gnus-files - :type 'directory) - -(defcustom gnus-directory (or (getenv "SAVEDIR") - (nnheader-concat gnus-home-directory "News/")) - "Directory variable from which all other Gnus file variables are derived." - :group 'gnus-files - :type 'directory) - -(defcustom gnus-default-directory nil - "*Default directory for all Gnus buffers." - :group 'gnus-files - :type '(choice (const :tag "current" nil) - directory)) - -;; Site dependent variables. These variables should be defined in -;; paths.el. - -(defvar gnus-default-nntp-server nil - "Specify a default NNTP server. -This variable should be defined in paths.el, and should never be set -by the user. -If you want to change servers, you should use `gnus-select-method'. -See the documentation to that variable.") - -;; Don't touch this variable. -(defvar gnus-nntp-service "nntp" - "NNTP service name (\"nntp\" or 119). -This is an obsolete variable, which is scarcely used. If you use an -nntp server for your newsgroup and want to change the port number -used to 899, you would say something along these lines: - - (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))") - -(defcustom gnus-nntpserver-file "/etc/nntpserver" - "A file with only the name of the nntp server in it." - :group 'gnus-files - :group 'gnus-server - :type 'file) - -;; This function is used to check both the environment variable -;; NNTPSERVER and the /etc/nntpserver file to see whether one can find -;; an nntp server name default. -(defun gnus-getenv-nntpserver () - (or (getenv "NNTPSERVER") - (and (file-readable-p gnus-nntpserver-file) - (save-excursion - (set-buffer (get-buffer-create " *gnus nntp*")) - (buffer-disable-undo (current-buffer)) - (insert-file-contents gnus-nntpserver-file) - (let ((name (buffer-string))) - (prog1 - (if (string-match "^[ \t\n]*$" name) - nil - name) - (kill-buffer (current-buffer)))))))) - -(defcustom gnus-select-method - (ignore-errors - (nconc - (list 'nntp (or (ignore-errors - (gnus-getenv-nntpserver)) - (when (and gnus-default-nntp-server - (not (string= gnus-default-nntp-server ""))) - gnus-default-nntp-server) - "news")) - (if (or (null gnus-nntp-service) - (equal gnus-nntp-service "nntp")) - nil - (list gnus-nntp-service)))) - "Default method for selecting a newsgroup. -This variable should be a list, where the first element is how the -news is to be fetched, the second is the address. - -For instance, if you want to get your news via NNTP from -\"flab.flab.edu\", you could say: - -\(setq gnus-select-method '(nntp \"flab.flab.edu\")) - -If you want to use your local spool, say: - -\(setq gnus-select-method (list 'nnspool (system-name))) - -If you use this variable, you must set `gnus-nntp-server' to nil. - -There is a lot more to know about select methods and virtual servers - -see the manual for details." - :group 'gnus-server - :type 'gnus-select-method) - -(defcustom gnus-message-archive-method - `(nnfolder - "archive" - (nnfolder-directory ,(nnheader-concat message-directory "archive")) - (nnfolder-active-file - ,(nnheader-concat message-directory "archive/active")) - (nnfolder-get-new-mail nil) - (nnfolder-inhibit-expiry t)) - "Method used for archiving messages you've sent. -This should be a mail method. - -It's probably not a very effective to change this variable once you've -run Gnus once. After doing that, you must edit this server from the -server buffer." - :group 'gnus-server - :group 'gnus-message - :type 'gnus-select-method) - -(defcustom gnus-message-archive-group nil - "*Name of the group in which to save the messages you've written. -This can either be a string; a list of strings; or an alist -of regexps/functions/forms to be evaluated to return a string (or a list -of strings). The functions are called with the name of the current -group (or nil) as a parameter. - -If you want to save your mail in one group and the news articles you -write in another group, you could say something like: - - \(setq gnus-message-archive-group - '((if (message-news-p) - \"misc-news\" - \"misc-mail\"))) - -Normally the group names returned by this variable should be -unprefixed -- which implicitly means \"store on the archive server\". -However, you may wish to store the message on some other server. In -that case, just return a fully prefixed name of the group -- -\"nnml+private:mail.misc\", for instance." - :group 'gnus-message - :type '(choice (const :tag "none" nil) - string)) - -(defcustom gnus-secondary-servers nil - "List of NNTP servers that the user can choose between interactively. -To make Gnus query you for a server, you have to give `gnus' a -non-numeric prefix - `C-u M-x gnus', in short." - :group 'gnus-server - :type '(repeat string)) - -(defcustom gnus-nntp-server nil - "*The name of the host running the NNTP server. -This variable is semi-obsolete. Use the `gnus-select-method' -variable instead." - :group 'gnus-server - :type '(choice (const :tag "disable" nil) - string)) - -(defcustom gnus-secondary-select-methods nil - "A list of secondary methods that will be used for reading news. -This is a list where each element is a complete select method (see -`gnus-select-method'). - -If, for instance, you want to read your mail with the nnml backend, -you could set this variable: - -\(setq gnus-secondary-select-methods '((nnml \"\")))" -:group 'gnus-server -:type '(repeat gnus-select-method)) - -(defvar gnus-backup-default-subscribed-newsgroups - '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus") - "Default default new newsgroups the first time Gnus is run. -Should be set in paths.el, and shouldn't be touched by the user.") - -(defcustom gnus-local-domain nil - "Local domain name without a host name. -The DOMAINNAME environment variable is used instead if it is defined. -If the `system-name' function returns the full Internet name, there is -no need to set this variable." - :group 'gnus-message - :type '(choice (const :tag "default" nil) - string)) - -(defvar gnus-local-organization nil - "String with a description of what organization (if any) the user belongs to. -Obsolete variable; use `message-user-organization' instead.") - -;; Customization variables - -(defcustom gnus-refer-article-method nil - "Preferred method for fetching an article by Message-ID. -If you are reading news from the local spool (with nnspool), fetching -articles by Message-ID is painfully slow. By setting this method to an -nntp method, you might get acceptable results. - -The value of this variable must be a valid select method as discussed -in the documentation of `gnus-select-method'." - :group 'gnus-server - :type '(choice (const :tag "default" nil) - gnus-select-method)) - -(defcustom gnus-group-faq-directory - '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/" - "/ftp@sunsite.auc.dk:/pub/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@rtfm.mit.edu:/pub/usenet/" - "/ftp@ftp.uni-paderborn.de:/pub/FAQ/" - "/ftp@ftp.sunet.se:/pub/usenet/" - "/ftp@nctuccca.edu.tw:/USENET/FAQ/" - "/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 - sunsite.auc.dk /pub/usenet - Asia: nctuccca.edu.tw /USENET/FAQ - hwarang.postech.ac.kr /pub/usenet - ftp.hk.super.net /mirror/faqs" - :group 'gnus-group-various - :type '(choice directory - (repeat directory))) - -(defcustom gnus-use-cross-reference t - "*Non-nil means that cross referenced articles will be marked as read. -If nil, ignore cross references. If t, mark articles as read in -subscribed newsgroups. If neither t nor nil, mark as read in all -newsgroups." - :group 'gnus-server - :type '(choice (const :tag "off" nil) - (const :tag "subscribed" t) - (sexp :format "all" - :value always))) - -(defcustom gnus-process-mark ?# - "*Process mark." - :group 'gnus-group-visual - :group 'gnus-summary-marks - :type 'character) - -(defcustom gnus-asynchronous nil - "*If non-nil, Gnus will supply backends with data needed for async article fetching." - :group 'gnus-asynchronous - :type 'boolean) - -(defcustom gnus-large-newsgroup 200 - "*The number of articles which indicates a large newsgroup. -If the number of articles in a newsgroup is greater than this value, -confirmation is required for selecting the newsgroup." - :group 'gnus-group-select - :type 'integer) - -(defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix))) - "*Non-nil means that the default name of a file to save articles in is the group name. -If it's nil, the directory form of the group name is used instead. - -If this variable is a list, and the list contains the element -`not-score', long file names will not be used for score files; if it -contains the element `not-save', long file names will not be used for -saving; and if it contains the element `not-kill', long file names -will not be used for kill files. - -Note that the default for this variable varies according to what system -type you're using. On `usg-unix-v' and `xenix' this variable defaults -to nil while on all other systems it defaults to t." - :group 'gnus-start - :type 'boolean) - -(defcustom gnus-kill-files-directory gnus-directory - "*Name of the directory where kill files will be stored (default \"~/News\")." - :group 'gnus-score-files - :group 'gnus-score-kill - :type 'directory) - -(defcustom gnus-save-score nil - "*If non-nil, save group scoring info." - :group 'gnus-score-various - :group 'gnus-start - :type 'boolean) - -(defcustom gnus-use-undo t - "*If non-nil, allow undoing in Gnus group mode buffers." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-use-adaptive-scoring nil - "*If non-nil, use some adaptive scoring scheme. -If a list, then the values `word' and `line' are meaningful. The -former will perform adaption on individual words in the subject -header while `line' will perform adaption on several headers." - :group 'gnus-meta - :group 'gnus-score-adapt - :type '(set (const word) (const line))) - -(defcustom gnus-use-cache 'passive - "*If nil, Gnus will ignore the article cache. -If `passive', it will allow entering (and reading) articles -explicitly entered into the cache. If anything else, use the -cache to the full extent of the law." - :group 'gnus-meta - :group 'gnus-cache - :type '(choice (const :tag "off" nil) - (const :tag "passive" passive) - (const :tag "active" t))) - -(defcustom gnus-use-trees nil - "*If non-nil, display a thread tree buffer." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-use-grouplens nil - "*If non-nil, use GroupLens ratings." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-keep-backlog nil - "*If non-nil, Gnus will keep read articles for later re-retrieval. -If it is a number N, then Gnus will only keep the last N articles -read. If it is neither nil nor a number, Gnus will keep all read -articles. This is not a good idea." - :group 'gnus-meta - :type '(choice (const :tag "off" nil) - integer - (sexp :format "all" - :value t))) - -(defcustom gnus-use-nocem nil - "*If non-nil, Gnus will read NoCeM cancel messages." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-suppress-duplicates nil - "*If non-nil, Gnus will mark duplicate copies of the same article as read." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-use-demon nil - "If non-nil, Gnus might use some demons." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-use-scoring t - "*If non-nil, enable scoring." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-use-picons nil - "*If non-nil, display picons." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-summary-prepare-exit-hook - '(gnus-summary-expire-articles) - "A hook called when preparing to exit from the summary buffer. -It calls `gnus-summary-expire-articles' by default." - :group 'gnus-summary-exit - :type 'hook) - -(defcustom gnus-novice-user t - "*Non-nil means that you are a usenet novice. -If non-nil, verbose messages may be displayed and confirmations may be -required." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-expert-user nil - "*Non-nil means that you will never be asked for confirmation about anything. -And that means *anything*." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-interactive-catchup t - "*If non-nil, require your confirmation when catching up a group." - :group 'gnus-group-select - :type 'boolean) - -(defcustom gnus-interactive-exit t - "*If non-nil, require your confirmation when exiting Gnus." - :group 'gnus-exit - :type 'boolean) - -(defcustom gnus-extract-address-components 'gnus-extract-address-components - "*Function for extracting address components from a From header. -Two pre-defined function exist: `gnus-extract-address-components', -which is the default, quite fast, and too simplistic solution, and -`mail-extract-address-components', which works much better, but is -slower." - :group 'gnus-summary-format - :type '(radio (function-item gnus-extract-address-components) - (function-item mail-extract-address-components) - (function :tag "Other"))) - -(defcustom gnus-carpal nil - "*If non-nil, display clickable icons." - :group 'gnus-meta - :type 'boolean) - -(defcustom gnus-shell-command-separator ";" - "String used to separate to shell commands." - :group 'gnus-files - :type 'string) - -(defcustom gnus-valid-select-methods - '(("nntp" post address prompt-address physical-address) - ("nnspool" post address) - ("nnvirtual" post-mail virtual prompt-address) - ("nnmbox" mail respool address) - ("nnml" mail respool address) - ("nnmh" mail respool address) - ("nndir" post-mail prompt-address physical-address) - ("nneething" none address prompt-address physical-address) - ("nndoc" none address prompt-address) - ("nnbabyl" mail address respool) - ("nnkiboze" post virtual) - ("nnsoup" post-mail address) - ("nndraft" post-mail) - ("nnfolder" mail respool address) - ("nngateway" none address prompt-address physical-address) - ("nnweb" none)) - "An alist of valid select methods. -The first element of each list lists should be a string with the name -of the select method. The other elements may be the category of -this method (i. e., `post', `mail', `none' or whatever) or other -properties that this method has (like being respoolable). -If you implement a new select method, all you should have to change is -this variable. I think." - :group 'gnus-server - :type '(repeat (group (string :tag "Name") - (radio-button-choice (const :format "%v " post) - (const :format "%v " mail) - (const :format "%v " none) - (const post-mail)) - (checklist :inline t - (const :format "%v " address) - (const :format "%v " prompt-address) - (const :format "%v " virtual) - (const respool))))) - -(define-widget 'gnus-select-method 'list - "Widget for entering a select method." - :args `((choice :tag "Method" - ,@(mapcar (lambda (entry) - (list 'const :format "%v\n" - (intern (car entry)))) - gnus-valid-select-methods)) - (string :tag "Address") - (editable-list :inline t - (list :format "%v" - variable - (sexp :tag "Value"))))) - -(defcustom gnus-updated-mode-lines '(group article summary tree) - "List of buffers that should update their mode lines. -The list may contain the symbols `group', `article', `tree' and -`summary'. If the corresponding symbol is present, Gnus will keep -that mode line updated with information that may be pertinent. -If this variable is nil, screen refresh may be quicker." - :group 'gnus-various - :type '(set (const group) - (const article) - (const summary) - (const tree))) - -;; Added by Keinonen Kari . -(defcustom gnus-mode-non-string-length nil - "*Max length of mode-line non-string contents. -If this is nil, Gnus will take space as is needed, leaving the rest -of the modeline intact. Note that the default of nil is unlikely -to be desirable; see the manual for further details." - :group 'gnus-various - :type '(choice (const nil) - integer)) - -(defcustom gnus-auto-expirable-newsgroups nil - "*Groups in which to automatically mark read articles as expirable. -If non-nil, this should be a regexp that should match all groups in -which to perform auto-expiry. This only makes sense for mail groups." - :group 'nnmail-expire - :type '(choice (const nil) - regexp)) - -(defcustom gnus-total-expirable-newsgroups nil - "*Groups in which to perform expiry of all read articles. -Use with extreme caution. All groups that match this regexp will be -expiring - which means that all read articles will be deleted after -\(say) one week. (This only goes for mail groups and the like, of -course.)" - :group 'nnmail-expire - :type '(choice (const nil) - regexp)) - -(defcustom gnus-group-uncollapsed-levels 1 - "Number of group name elements to leave alone when making a short group name." - :group 'gnus-group-visual - :type 'integer) - -(defcustom gnus-group-use-permanent-levels nil - "*If non-nil, once you set a level, Gnus will use this level." - :group 'gnus-group-levels - :type 'boolean) - -;; Hooks. - -(defcustom gnus-load-hook nil - "A hook run while Gnus is loaded." - :group 'gnus-start - :type 'hook) - -(defcustom gnus-apply-kill-hook '(gnus-apply-kill-file) - "A hook called to apply kill files to a group. -This hook is intended to apply a kill file to the selected newsgroup. -The function `gnus-apply-kill-file' is called by default. - -Since a general kill file is too heavy to use only for a few -newsgroups, I recommend you to use a lighter hook function. For -example, if you'd like to apply a kill file to articles which contains -a string `rmgroup' in subject in newsgroup `control', you can use the -following hook: - - (setq gnus-apply-kill-hook - (list - (lambda () - (cond ((string-match \"control\" gnus-newsgroup-name) - (gnus-kill \"Subject\" \"rmgroup\") - (gnus-expunge \"X\"))))))" - :group 'gnus-score-kill - :options '(gnus-apply-kill-file) - :type 'hook) - -(defcustom gnus-group-change-level-function nil - "Function run when a group level is changed. -It is called with three parameters -- GROUP, LEVEL and OLDLEVEL." - :group 'gnus-group-level - :type 'function) - -;;; Face thingies. - -(defcustom gnus-visual - '(summary-highlight group-highlight article-highlight - mouse-face - summary-menu group-menu article-menu - tree-highlight menu highlight - browse-menu server-menu - page-marker tree-menu binary-menu pick-menu - grouplens-menu) - "Enable visual features. -If `visual' is disabled, there will be no menus and few faces. Most of -the visual customization options below will be ignored. Gnus will use -less space and be faster as a result. - -This variable can also be a list of visual elements to switch on. For -instance, to switch off all visual things except menus, you can say: - - (setq gnus-visual '(menu)) - -Valid elements include `summary-highlight', `group-highlight', -`article-highlight', `mouse-face', `summary-menu', `group-menu', -`article-menu', `tree-highlight', `menu', `highlight', `browse-menu', -`server-menu', `page-marker', `tree-menu', `binary-menu', `pick-menu', -and `grouplens-menu'." - :group 'gnus-meta - :group 'gnus-visual - :type '(set (const summary-highlight) - (const group-highlight) - (const article-highlight) - (const mouse-face) - (const summary-menu) - (const group-menu) - (const article-menu) - (const tree-highlight) - (const menu) - (const highlight) - (const browse-menu) - (const server-menu) - (const page-marker) - (const tree-menu) - (const binary-menu) - (const pick-menu) - (const grouplens-menu))) - -(defcustom gnus-mouse-face - (condition-case () - (if (gnus-visual-p 'mouse-face 'highlight) - (if (boundp 'gnus-mouse-face) - (or gnus-mouse-face 'highlight) - 'highlight) - 'default) - (error 'highlight)) - "Face used for group or summary buffer mouse highlighting. -The line beneath the mouse pointer will be highlighted with this -face." - :group 'gnus-visual - :type 'face) - -(defcustom gnus-article-display-hook - (if (and (string-match "XEmacs" emacs-version) - (featurep 'xface)) - '(gnus-article-hide-headers-if-wanted - gnus-article-hide-boring-headers - gnus-article-treat-overstrike - gnus-article-maybe-highlight - gnus-article-display-x-face) - '(gnus-article-hide-headers-if-wanted - gnus-article-hide-boring-headers - gnus-article-treat-overstrike - gnus-article-maybe-highlight)) - "Controls how the article buffer will look. - -If you leave the list empty, the article will appear exactly as it is -stored on the disk. The list entries will hide or highlight various -parts of the article, making it easier to find the information you -want." - :group 'gnus-article-highlight - :group 'gnus-visual - :type 'hook - :options '(gnus-article-add-buttons - gnus-article-add-buttons-to-head - gnus-article-emphasize - gnus-article-fill-cited-article - gnus-article-remove-cr - gnus-article-de-quoted-unreadable - gnus-summary-stop-page-breaking - ;; gnus-summary-caesar-message - ;; gnus-summary-verbose-headers - gnus-summary-toggle-mime - gnus-article-hide - gnus-article-hide-headers - gnus-article-hide-boring-headers - gnus-article-hide-signature - gnus-article-hide-citation - gnus-article-hide-pgp - gnus-article-hide-pem - gnus-article-highlight - gnus-article-highlight-headers - gnus-article-highlight-citation - gnus-article-highlight-signature - gnus-article-date-ut - gnus-article-date-local - gnus-article-date-lapsed - gnus-article-date-original - gnus-article-remove-trailing-blank-lines - gnus-article-strip-leading-blank-lines - gnus-article-strip-multiple-blank-lines - gnus-article-strip-blank-lines - gnus-article-treat-overstrike - gnus-article-display-x-face - gnus-smiley-display)) - -(defcustom gnus-article-save-directory gnus-directory - "*Name of the directory articles will be saved in (default \"~/News\")." - :group 'gnus-article-saving - :type 'directory) - - -;;; Internal variables - -(defvar gnus-group-get-parameter-function 'gnus-group-get-parameter) -(defvar gnus-original-article-buffer " *Original Article*") -(defvar gnus-newsgroup-name nil) - -(defvar gnus-current-select-method nil - "The current method for selecting a newsgroup.") - -(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) -(defvar gnus-group-history nil) - -;; Variable holding the user answers to all mail method prompts. -(defvar gnus-mail-method-history nil) - -;; Variable holding the user answers to all group prompts. -(defvar gnus-group-history nil) - -(defvar gnus-server-alist nil - "List of available servers.") - -(defvar gnus-predefined-server-alist - `(("cache" - (nnspool "cache" - (nnspool-spool-directory "~/News/cache/") - (nnspool-nov-directory "~/News/cache/") - (nnspool-active-file "~/News/cache/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) - (bookmarks . bookmark) (dormant . dormant) - (scored . score) (saved . save) - (cached . cache))) - -(defvar gnus-headers-retrieved-by nil) -(defvar gnus-article-reply nil) -(defvar gnus-override-method nil) -(defvar gnus-article-check-size nil) -(defvar gnus-opened-servers nil) - -(defvar gnus-current-kill-article nil) - -(defvar gnus-have-read-active-file nil) - -(defconst gnus-maintainer - "bugs@gnus.org (The Gnus Bugfixing Girls + Boys)" - "The mail address of the Gnus maintainers.") - -(defvar gnus-info-nodes - '((gnus-group-mode "(gnus)The Group Buffer") - (gnus-summary-mode "(gnus)The Summary Buffer") - (gnus-article-mode "(gnus)The Article Buffer") - (mime/viewer-mode "(gnus)The Article Buffer") - (gnus-server-mode "(gnus)The Server Buffer") - (gnus-browse-mode "(gnus)Browse Foreign Server") - (gnus-tree-mode "(gnus)Tree Display")) - "Alist of major modes and related Info nodes.") - -(defvar gnus-group-buffer "*Group*") -(defvar gnus-summary-buffer "*Summary*") -(defvar gnus-article-buffer "*Article*") -(defvar gnus-server-buffer "*Server*") - -(defvar gnus-buffer-list nil - "Gnus buffers that should be killed on exit.") - -(defvar gnus-slave nil - "Whether this Gnus is a slave or not.") - -(defvar gnus-batch-mode nil - "Whether this Gnus is running in batch mode or not.") - -(defvar gnus-variable-list - '(gnus-newsrc-options gnus-newsrc-options-n - gnus-newsrc-last-checked-date - gnus-newsrc-alist gnus-server-alist - gnus-killed-list gnus-zombie-list - gnus-topic-topology gnus-topic-alist - gnus-format-specs) - "Gnus variables saved in the quick startup file.") - -(defvar gnus-newsrc-alist nil - "Assoc list of read articles. -gnus-newsrc-hashtb should be kept so that both hold the same information.") - -(defvar gnus-newsrc-hashtb nil - "Hashtable of gnus-newsrc-alist.") - -(defvar gnus-killed-list nil - "List of killed newsgroups.") - -(defvar gnus-killed-hashtb nil - "Hash table equivalent of gnus-killed-list.") - -(defvar gnus-zombie-list nil - "List of almost dead newsgroups.") - -(defvar gnus-description-hashtb nil - "Descriptions of newsgroups.") - -(defvar gnus-list-of-killed-groups nil - "List of newsgroups that have recently been killed by the user.") - -(defvar gnus-active-hashtb nil - "Hashtable of active articles.") - -(defvar gnus-moderated-hashtb nil - "Hashtable of moderated newsgroups.") - -;; Save window configuration. -(defvar gnus-prev-winconf nil) - -(defvar gnus-reffed-article-number nil) - -;;; Let the byte-compiler know that we know about this variable. -(defvar rmail-default-rmail-file) - -(defvar gnus-dead-summary nil) - -;;; End of variables. - -;; Define some autoload functions Gnus might use. -(eval-and-compile - - ;; This little mapcar goes through the list below and marks the - ;; symbols in question as autoloaded functions. - (mapcar - (lambda (package) - (let ((interactive (nth 1 (memq ':interactive package)))) - (mapcar - (lambda (function) - (let (keymap) - (when (consp function) - (setq keymap (car (memq 'keymap function))) - (setq function (car function))) - (autoload function (car package) nil interactive keymap))) - (if (eq (nth 1 package) ':interactive) - (cdddr package) - (cdr package))))) - '(("metamail" metamail-buffer) - ("info" Info-goto-node) - ("hexl" hexl-hex-string-to-integer) - ("pp" pp pp-to-string pp-eval-expression) - ("ps-print" ps-print-preprint) - ("mail-extr" mail-extract-address-components) - ("message" :interactive t - message-send-and-exit message-yank-original) - ("nnmail" nnmail-split-fancy nnmail-article-group nnmail-date-to-time) - ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers) - ("timezone" timezone-make-date-arpa-standard timezone-fix-time - timezone-make-sortable-date timezone-make-time-string) - ("rmailout" rmail-output) - ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages - rmail-show-message) - ("gnus-audio" :interactive t gnus-audio-play) - ("gnus-xmas" gnus-xmas-splash) - ("gnus-soup" :interactive t - gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article - gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet) - ("nnsoup" nnsoup-pack-replies) - ("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-add-rescan gnus-demon-add-scan-timestamps - gnus-demon-add-disconnection gnus-demon-add-handler - gnus-demon-remove-handler) - ("gnus-demon" :interactive t - gnus-demon-init gnus-demon-cancel) - ("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-srvr" gnus-browse-foreign-server) - ("gnus-cite" :interactive t - gnus-article-highlight-citation gnus-article-hide-citation-maybe - gnus-article-hide-citation gnus-article-fill-cited-article - gnus-article-hide-citation-in-followups) - ("gnus-kill" gnus-kill gnus-apply-kill-file-internal - gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author - gnus-execute gnus-expunge) - ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers - gnus-cache-possibly-remove-articles gnus-cache-request-article - gnus-cache-retrieve-headers gnus-cache-possibly-alter-active - gnus-cache-enter-remove-article gnus-cached-article-p - gnus-cache-open gnus-cache-close gnus-cache-update-article) - ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article - gnus-cache-remove-article gnus-summary-insert-cached-articles) - ("gnus-score" :interactive t - gnus-summary-increase-score gnus-summary-set-score - gnus-summary-raise-thread gnus-summary-raise-same-subject - gnus-summary-raise-score gnus-summary-raise-same-subject-and-select - gnus-summary-lower-thread gnus-summary-lower-same-subject - gnus-summary-lower-score gnus-summary-lower-same-subject-and-select - gnus-summary-current-score gnus-score-default - gnus-score-flush-cache gnus-score-close - gnus-possibly-score-headers gnus-score-followup-article - gnus-score-followup-thread) - ("gnus-score" - (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers - gnus-current-score-file-nondirectory gnus-score-adaptive - gnus-score-find-trace gnus-score-file-name) - ("gnus-cus" :interactive t gnus-group-customize gnus-score-customize) - ("gnus-topic" :interactive t gnus-topic-mode) - ("gnus-topic" gnus-topic-remove-group gnus-topic-set-parameters) - ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode) - ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap)) - ("gnus-uu" :interactive t - gnus-uu-digest-mail-forward gnus-uu-digest-post-forward - gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer - gnus-uu-mark-by-regexp gnus-uu-mark-all - gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu - gnus-uu-decode-uu-and-save gnus-uu-decode-unshar - gnus-uu-decode-unshar-and-save gnus-uu-decode-save - gnus-uu-decode-binhex gnus-uu-decode-uu-view - gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view - gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view - gnus-uu-decode-binhex-view) - ("gnus-uu" gnus-uu-delete-work-dir gnus-quote-arg-for-sh-or-csh) - ("gnus-msg" (gnus-summary-send-map keymap) - gnus-article-mail gnus-copy-article-buffer gnus-extended-version) - ("gnus-msg" :interactive t - gnus-group-post-news gnus-group-mail gnus-summary-post-news - gnus-summary-followup gnus-summary-followup-with-original - gnus-summary-cancel-article gnus-summary-supersede-article - gnus-post-news gnus-summary-reply gnus-summary-reply-with-original - gnus-summary-mail-forward gnus-summary-mail-other-window - gnus-summary-resend-message gnus-summary-resend-bounced-mail - gnus-bug) - ("gnus-picon" :interactive t gnus-article-display-picons - gnus-group-display-picons gnus-picons-article-display-x-face - gnus-picons-display-x-face) - ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p - gnus-grouplens-mode) - ("smiley" :interactive t gnus-smiley-display) - ("gnus-win" gnus-configure-windows gnus-add-configuration) - ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group - gnus-list-of-unread-articles gnus-list-of-read-articles - gnus-offer-save-summaries gnus-make-thread-indent-array - gnus-summary-exit gnus-update-read-articles) - ("gnus-group" gnus-group-insert-group-line gnus-group-quit - gnus-group-list-groups gnus-group-first-unread-group - gnus-group-set-mode-line gnus-group-set-info gnus-group-save-newsrc - gnus-group-setup-buffer gnus-group-get-new-news - gnus-group-make-help-group gnus-group-update-group) - ("gnus-bcklg" gnus-backlog-request-article gnus-backlog-enter-article - gnus-backlog-remove-article) - ("gnus-art" gnus-article-read-summary-keys gnus-article-save - gnus-article-prepare gnus-article-set-window-start - gnus-article-next-page gnus-article-prev-page - gnus-request-article-this-buffer gnus-article-mode - gnus-article-setup-buffer gnus-narrow-to-page - gnus-article-delete-invisible-text gnus-hack-decode-rfc1522) - ("gnus-art" :interactive t - gnus-article-hide-headers gnus-article-hide-boring-headers - gnus-article-treat-overstrike gnus-article-word-wrap - gnus-article-remove-cr gnus-article-remove-trailing-blank-lines - gnus-article-display-x-face gnus-article-de-quoted-unreadable - gnus-article-mime-decode-quoted-printable gnus-article-hide-pgp - gnus-article-hide-pem gnus-article-hide-signature - gnus-article-strip-leading-blank-lines gnus-article-date-local - gnus-article-date-original gnus-article-date-lapsed - gnus-article-show-all-headers - gnus-article-edit-mode gnus-article-edit-article - gnus-article-edit-done gnus-decode-rfc1522 article-decode-rfc1522) - ("gnus-int" gnus-request-type) - ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1 - gnus-dribble-enter) - ("gnus-dup" gnus-dup-suppress-articles gnus-dup-unsuppress-article - gnus-dup-enter-articles) - ("gnus-range" gnus-copy-sequence) - ("gnus-eform" gnus-edit-form) - ("gnus-move" :interactive t - gnus-group-move-group-to-server gnus-change-server) - ("gnus-logic" gnus-score-advanced) - ("gnus-undo" gnus-undo-mode gnus-undo-register) - ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next - gnus-async-prefetch-article gnus-async-prefetch-remove-group - gnus-async-halt-prefetch) - ("gnus-vm" :interactive t gnus-summary-save-in-vm - gnus-summary-save-article-vm)))) - -;;; gnus-sum.el thingies - - -(defcustom gnus-summary-line-format "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n" - "*The format specification of the lines in the summary buffer. - -It works along the same lines as a normal formatting string, -with some simple extensions. - -%N Article number, left padded with spaces (string) -%S Subject (string) -%s Subject if it is at the root of a thread, and \"\" otherwise (string) -%n Name of the poster (string) -%a Extracted name of the poster (string) -%A Extracted address of the poster (string) -%F Contents of the From: header (string) -%x Contents of the Xref: header (string) -%D Date of the article (string) -%d Date of the article (string) in DD-MMM format -%M Message-id of the article (string) -%r References of the article (string) -%c Number of characters in the article (integer) -%L Number of lines in the article (integer) -%I Indentation based on thread level (a string of spaces) -%T A string with two possible values: 80 spaces if the article - is on thread level two or larger and 0 spaces on level one -%R \"A\" if this article has been replied to, \" \" otherwise (character) -%U Status of this article (character, \"R\", \"K\", \"-\" or \" \") -%[ Opening bracket (character, \"[\" or \"<\") -%] Closing bracket (character, \"]\" or \">\") -%> Spaces of length thread-level (string) -%< Spaces of length (- 20 thread-level) (string) -%i Article score (number) -%z Article zcore (character) -%t Number of articles under the current thread (number). -%e Whether the thread is empty or not (character). -%l GroupLens score (string). -%V Total thread score (number). -%P The line number (number). -%u User defined specifier. The next character in the format string should - be a letter. Gnus will call the function gnus-user-format-function-X, - where X is the letter following %u. The function will be passed the - current header as argument. The function should return a string, which - will be inserted into the summary just like information from any other - summary specifier. - -Text between %( and %) will be highlighted with `gnus-mouse-face' -when the mouse point is placed inside the area. There can only be one -such area. - -The %U (status), %R (replied) and %z (zcore) specs have to be handled -with care. For reasons of efficiency, Gnus will compute what column -these characters will end up in, and \"hard-code\" that. This means that -it is illegal to have these specs after a variable-length spec. Well, -you might not be arrested, but your summary buffer will look strange, -which is bad enough. - -The smart choice is to have these specs as for to the left as -possible. - -This restriction may disappear in later versions of Gnus." - :type 'string - :group 'gnus-summary-format) - -;;; -;;; Skeleton keymaps -;;; - -(defun gnus-suppress-keymap (keymap) - (suppress-keymap keymap) - (let ((keys `([delete] "\177" "\M-u"))) ;gnus-mouse-2 - (while keys - (define-key keymap (pop keys) 'undefined)))) - -(defvar gnus-article-mode-map - (let ((keymap (make-keymap))) - (gnus-suppress-keymap keymap) - keymap)) -(defvar gnus-summary-mode-map - (let ((keymap (make-keymap))) - (gnus-suppress-keymap keymap) - keymap)) -(defvar gnus-group-mode-map - (let ((keymap (make-keymap))) - (gnus-suppress-keymap keymap) - keymap)) - - - -;; Fix by Hallvard B Furuseth . -;; If you want the cursor to go somewhere else, set these two -;; functions in some startup hook to whatever you want. -(defalias 'gnus-summary-position-point 'gnus-goto-colon) -(defalias 'gnus-group-position-point 'gnus-goto-colon) - -;;; Various macros and substs. - -(defun gnus-header-from (header) - (mail-header-from header)) - -(defmacro gnus-gethash (string hashtable) - "Get hash value of STRING in HASHTABLE." - `(symbol-value (intern-soft ,string ,hashtable))) - -(defmacro gnus-sethash (string value hashtable) - "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." - `(set (intern ,string ,hashtable) ,value)) -(put 'gnus-sethash 'edebug-form-spec '(form form form)) - -(defmacro gnus-group-unread (group) - "Get the currently computed number of unread articles in GROUP." - `(car (gnus-gethash ,group gnus-newsrc-hashtb))) - -(defmacro gnus-group-entry (group) - "Get the newsrc entry for GROUP." - `(gnus-gethash ,group gnus-newsrc-hashtb)) - -(defmacro gnus-active (group) - "Get active info on GROUP." - `(gnus-gethash ,group gnus-active-hashtb)) - -(defmacro gnus-set-active (group active) - "Set GROUP's active info." - `(gnus-sethash ,group ,active gnus-active-hashtb)) - -(defun gnus-alive-p () - "Say whether Gnus is running or not." - (and gnus-group-buffer - (get-buffer gnus-group-buffer) - (save-excursion - (set-buffer gnus-group-buffer) - (eq major-mode 'gnus-group-mode)))) - -;; Info access macros. - -(defmacro gnus-info-group (info) - `(nth 0 ,info)) -(defmacro gnus-info-rank (info) - `(nth 1 ,info)) -(defmacro gnus-info-read (info) - `(nth 2 ,info)) -(defmacro gnus-info-marks (info) - `(nth 3 ,info)) -(defmacro gnus-info-method (info) - `(nth 4 ,info)) -(defmacro gnus-info-params (info) - `(nth 5 ,info)) - -(defmacro gnus-info-level (info) - `(let ((rank (gnus-info-rank ,info))) - (if (consp rank) - (car rank) - rank))) -(defmacro gnus-info-score (info) - `(let ((rank (gnus-info-rank ,info))) - (or (and (consp rank) (cdr rank)) 0))) - -(defmacro gnus-info-set-group (info group) - `(setcar ,info ,group)) -(defmacro gnus-info-set-rank (info rank) - `(setcar (nthcdr 1 ,info) ,rank)) -(defmacro gnus-info-set-read (info read) - `(setcar (nthcdr 2 ,info) ,read)) -(defmacro gnus-info-set-marks (info marks &optional extend) - (if extend - `(gnus-info-set-entry ,info ,marks 3) - `(setcar (nthcdr 3 ,info) ,marks))) -(defmacro gnus-info-set-method (info method &optional extend) - (if extend - `(gnus-info-set-entry ,info ,method 4) - `(setcar (nthcdr 4 ,info) ,method))) -(defmacro gnus-info-set-params (info params &optional extend) - (if extend - `(gnus-info-set-entry ,info ,params 5) - `(setcar (nthcdr 5 ,info) ,params))) - -(defun gnus-info-set-entry (info entry number) - ;; Extend the info until we have enough elements. - (while (<= (length info) number) - (nconc info (list nil))) - ;; Set the entry. - (setcar (nthcdr number info) entry)) - -(defmacro gnus-info-set-level (info level) - `(let ((rank (cdr ,info))) - (if (consp (car rank)) - (setcar (car rank) ,level) - (setcar rank ,level)))) -(defmacro gnus-info-set-score (info score) - `(let ((rank (cdr ,info))) - (if (consp (car rank)) - (setcdr (car rank) ,score) - (setcar rank (cons (car rank) ,score))))) - -(defmacro gnus-get-info (group) - `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb))) - -;; Byte-compiler warning. -(defvar gnus-visual) -;; Find out whether the gnus-visual TYPE is wanted. -(defun gnus-visual-p (&optional type class) - (and gnus-visual ; Has to be non-nil, at least. - (if (not type) ; We don't care about type. - gnus-visual - (if (listp gnus-visual) ; It's a list, so we check it. - (or (memq type gnus-visual) - (memq class gnus-visual)) - t)))) - -;;; Load the compatability functions. - -(require 'gnus-ems) - - -;;; -;;; Shutdown -;;; - -(defvar gnus-shutdown-alist nil) - -(defun gnus-add-shutdown (function &rest symbols) - "Run FUNCTION whenever one of SYMBOLS is shut down." - (push (cons function symbols) gnus-shutdown-alist)) - -(defun gnus-shutdown (symbol) - "Shut down everything that waits for SYMBOL." - (let ((alist gnus-shutdown-alist) - entry) - (while (setq entry (pop alist)) - (when (memq symbol (cdr entry)) - (funcall (car entry)))))) - - -;;; -;;; Gnus Utility Functions -;;; - -(defmacro gnus-string-or (&rest strings) - "Return the first element of STRINGS that is a non-blank string. -STRINGS will be evaluated in normal `or' order." - `(gnus-string-or-1 ',strings)) - -(defun gnus-string-or-1 (strings) - (let (string) - (while strings - (setq string (eval (pop strings))) - (if (string-match "^[ \t]*$" string) - (setq string nil) - (setq strings nil))) - string)) - -;; Add the current buffer to the list of buffers to be killed on exit. -(defun gnus-add-current-to-buffer-list () - (or (memq (current-buffer) gnus-buffer-list) - (push (current-buffer) gnus-buffer-list))) - -(defun gnus-version (&optional arg) - "Version number of this version of Gnus. -If ARG, insert string at point." - (interactive "P") - (let ((methods gnus-valid-select-methods) - (mess gnus-version) - meth) - ;; Go through all the legal select methods and add their version - ;; numbers to the total version string. Only the backends that are - ;; currently in use will have their message numbers taken into - ;; consideration. - (while methods - (setq meth (intern (concat (caar methods) "-version"))) - (and (boundp meth) - (stringp (symbol-value meth)) - (setq mess (concat mess "; " (symbol-value meth)))) - (setq methods (cdr methods))) - (if arg - (insert (message mess)) - (message mess)))) - -(defun gnus-continuum-version (version) - "Return VERSION as a floating point number." - (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version) - (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version)) - (let* ((alpha (and (match-beginning 1) (match-string 1 version))) - (number (match-string 2 version)) - major minor least) - (string-match "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number) - (setq major (string-to-number (match-string 1 number))) - (setq minor (string-to-number (match-string 2 number))) - (setq least (if (match-beginning 3) - (string-to-number (match-string 3 number)) - 0)) - (string-to-number - (if (zerop major) - (format "%s00%02d%02d" - (cond - ((member alpha '("(ding)" "d")) "4.99") - ((member alpha '("September" "s")) "5.01") - ((member alpha '("Red" "r")) "5.03")) - minor least) - (format "%d.%02d%02d" major minor least)))))) - -(defun gnus-info-find-node () - "Find Info documentation of Gnus." - (interactive) - ;; Enlarge info window if needed. - (let (gnus-info-buffer) - (Info-goto-node (cadr (assq major-mode gnus-info-nodes))) - (setq gnus-info-buffer (current-buffer)) - (gnus-configure-windows 'info))) - -;;; More various functions. - -(defun gnus-group-read-only-p (&optional group) - "Check whether GROUP supports editing or not. -If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note -that that variable is buffer-local to the summary buffers." - (let ((group (or group gnus-newsgroup-name))) - (not (gnus-check-backend-function 'request-replace-article group)))) - -(defun gnus-group-total-expirable-p (group) - "Check whether GROUP is total-expirable or not." - (let ((params (gnus-group-find-parameter group)) - val) - (cond - ((memq 'total-expire params) - t) - ((setq val (assq 'total-expire params)) ; (auto-expire . t) - (cdr val)) - (gnus-total-expirable-newsgroups ; Check var. - (string-match gnus-total-expirable-newsgroups group))))) - -(defun gnus-group-auto-expirable-p (group) - "Check whether GROUP is auto-expirable or not." - (let ((params (gnus-group-find-parameter group)) - val) - (cond - ((memq 'auto-expire params) - t) - ((setq val (assq 'auto-expire params)) ; (auto-expire . t) - (cdr val)) - (gnus-auto-expirable-newsgroups ; Check var. - (string-match gnus-auto-expirable-newsgroups group))))) - -(defun gnus-virtual-group-p (group) - "Say whether GROUP is virtual or not." - (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group))) - gnus-valid-select-methods))) - -(defun gnus-news-group-p (group &optional article) - "Return non-nil if GROUP (and ARTICLE) come from a news server." - (or (gnus-member-of-valid 'post group) ; Ordinary news group. - (and (gnus-member-of-valid 'post-mail group) ; Combined group. - (eq (gnus-request-type group article) 'news)))) - -;; Returns a list of writable groups. -(defun gnus-writable-groups () - (let ((alist gnus-newsrc-alist) - groups group) - (while (setq group (car (pop alist))) - (unless (gnus-group-read-only-p group) - (push group groups))) - (nreverse groups))) - -;; Check whether to use long file names. -(defun gnus-use-long-file-name (symbol) - ;; The variable has to be set... - (and gnus-use-long-file-name - ;; If it isn't a list, then we return t. - (or (not (listp gnus-use-long-file-name)) - ;; If it is a list, and the list contains `symbol', we - ;; return nil. - (not (memq symbol gnus-use-long-file-name))))) - -;; Generate a unique new group name. -(defun gnus-generate-new-group-name (leaf) - (let ((name leaf) - (num 0)) - (while (gnus-gethash name gnus-newsrc-hashtb) - (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">"))) - name)) - -(defun gnus-ephemeral-group-p (group) - "Say whether GROUP is ephemeral or not." - (gnus-group-get-parameter group 'quit-config)) - -(defun gnus-group-quit-config (group) - "Return the quit-config of GROUP." - (gnus-group-get-parameter group 'quit-config)) - -(defun gnus-kill-ephemeral-group (group) - "Remove ephemeral GROUP from relevant structures." - (gnus-sethash group nil gnus-newsrc-hashtb)) - -(defun gnus-simplify-mode-line () - "Make mode lines a bit simpler." - (setq mode-line-modified (cdr gnus-mode-line-modified)) - (when (listp mode-line-format) - (make-local-variable 'mode-line-format) - (setq mode-line-format (copy-sequence mode-line-format)) - (when (equal (nth 3 mode-line-format) " ") - (setcar (nthcdr 3 mode-line-format) " ")))) - -;;; Servers and groups. - -(defsubst gnus-server-add-address (method) - (let ((method-name (symbol-name (car method)))) - (if (and (memq 'address (assoc method-name gnus-valid-select-methods)) - (not (assq (intern (concat method-name "-address")) method)) - (memq 'physical-address (assq (car method) - gnus-valid-select-methods))) - (append method (list (list (intern (concat method-name "-address")) - (nth 1 method)))) - method))) - -(defsubst gnus-server-get-method (group method) - ;; Input either a server name, and extended server name, or a - ;; select method, and return a select method. - (cond ((stringp method) - (gnus-server-to-method method)) - ((equal method gnus-select-method) - gnus-select-method) - ((and (stringp (car method)) group) - (gnus-server-extend-method group method)) - ((and method (not group) - (equal (cadr method) "")) - method) - (t - (gnus-server-add-address method)))) - -(defun gnus-server-to-method (server) - "Map virtual server names to select methods." - (or - ;; Is this a method, perhaps? - (and server (listp server) server) - ;; Perhaps this is the native server? - (and (equal server "native") gnus-select-method) - ;; It should be in the server alist. - (cdr (assoc server gnus-server-alist)) - ;; It could be in the predefined server alist. - (cdr (assoc server gnus-predefined-server-alist)) - ;; If not, we look through all the opened server - ;; to see whether we can find it there. - (let ((opened gnus-opened-servers)) - (while (and opened - (not (equal server (format "%s:%s" (caaar opened) - (cadaar opened))))) - (pop opened)) - (caar opened)))) - -(defmacro gnus-method-equal (ss1 ss2) - "Say whether two servers are equal." - `(let ((s1 ,ss1) - (s2 ,ss2)) - (or (equal s1 s2) - (and (= (length s1) (length s2)) - (progn - (while (and s1 (member (car s1) s2)) - (setq s1 (cdr s1))) - (null s1)))))) - -(defun gnus-server-equal (m1 m2) - "Say whether two methods are equal." - (let ((m1 (cond ((null m1) gnus-select-method) - ((stringp m1) (gnus-server-to-method m1)) - (t m1))) - (m2 (cond ((null m2) gnus-select-method) - ((stringp m2) (gnus-server-to-method m2)) - (t m2)))) - (gnus-method-equal m1 m2))) - -(defun gnus-servers-using-backend (backend) - "Return a list of known servers using BACKEND." - (let ((opened gnus-opened-servers) - out) - (while opened - (when (eq backend (caaar opened)) - (push (caar opened) out)) - (pop opened)) - out)) - -(defun gnus-archive-server-wanted-p () - "Say whether the user wants to use the archive server." - (cond - ((or (not gnus-message-archive-method) - (not gnus-message-archive-group)) - nil) - ((and gnus-message-archive-method gnus-message-archive-group) - t) - (t - (let ((active (cadr (assq 'nnfolder-active-file - gnus-message-archive-method)))) - (and active - (file-exists-p active)))))) - -(defun gnus-group-prefixed-name (group method) - "Return the whole name from GROUP and METHOD." - (and (stringp method) (setq method (gnus-server-to-method method))) - (if (not method) - group - (concat (format "%s" (car method)) - (when (and - (or (assoc (format "%s" (car method)) - (gnus-methods-using 'address)) - (gnus-server-equal method gnus-message-archive-method)) - (nth 1 method) - (not (string= (nth 1 method) ""))) - (concat "+" (nth 1 method))) - ":" group))) - -(defun gnus-group-real-prefix (group) - "Return the prefix of the current group name." - (if (string-match "^[^:]+:" group) - (substring group 0 (match-end 0)) - "")) - -(defun gnus-group-method (group) - "Return the server or method used for selecting GROUP. -You should probably use `gnus-find-method-for-group' instead." - (let ((prefix (gnus-group-real-prefix group))) - (if (equal prefix "") - gnus-select-method - (let ((servers gnus-opened-servers) - (server "") - backend possible found) - (if (string-match "^[^\\+]+\\+" prefix) - (setq backend (intern (substring prefix 0 (1- (match-end 0)))) - server (substring prefix (match-end 0) (1- (length prefix)))) - (setq backend (intern (substring prefix 0 (1- (length prefix)))))) - (while servers - (when (eq (caaar servers) backend) - (setq possible (caar servers)) - (when (equal (cadaar servers) server) - (setq found (caar servers)))) - (pop servers)) - (or (car (rassoc found gnus-server-alist)) - found - (car (rassoc possible gnus-server-alist)) - possible - (list backend server)))))) - -(defsubst gnus-secondary-method-p (method) - "Return whether METHOD is a secondary select method." - (let ((methods gnus-secondary-select-methods) - (gmethod (gnus-server-get-method nil method))) - (while (and methods - (not (equal (gnus-server-get-method nil (car methods)) - gmethod))) - (setq methods (cdr methods))) - methods)) - -(defun gnus-group-foreign-p (group) - "Say whether a group is foreign or not." - (and (not (gnus-group-native-p group)) - (not (gnus-group-secondary-p group)))) - -(defun gnus-group-native-p (group) - "Say whether the group is native or not." - (not (string-match ":" group))) - -(defun gnus-group-secondary-p (group) - "Say whether the group is secondary or not." - (gnus-secondary-method-p (gnus-find-method-for-group group))) - -(defun gnus-group-find-parameter (group &optional symbol) - "Return the group parameters for GROUP. -If SYMBOL, return the value of that symbol in the group parameters." - (save-excursion - (set-buffer gnus-group-buffer) - (let ((parameters (funcall gnus-group-get-parameter-function group))) - (if symbol - (gnus-group-parameter-value parameters symbol) - parameters)))) - -(defun gnus-group-get-parameter (group &optional symbol) - "Return the group parameters for GROUP. -If SYMBOL, return the value of that symbol in the group parameters." - (let ((params (gnus-info-params (gnus-get-info group)))) - (if symbol - (gnus-group-parameter-value params symbol) - params))) - -(defun gnus-group-parameter-value (params symbol) - "Return the value of SYMBOL in group PARAMS." - (or (car (memq symbol params)) ; It's either a simple symbol - (cdr (assq symbol params)))) ; or a cons. - -(defun gnus-group-add-parameter (group param) - "Add parameter PARAM to GROUP." - (let ((info (gnus-get-info group))) - (when info - (gnus-group-remove-parameter group (if (consp param) (car param) param)) - ;; Cons the new param to the old one and update. - (gnus-group-set-info (cons param (gnus-info-params info)) - group 'params)))) - -(defun gnus-group-set-parameter (group name value) - "Set parameter NAME to VALUE in GROUP." - (let ((info (gnus-get-info group))) - (when info - (gnus-group-remove-parameter group name) - (let ((old-params (gnus-info-params info)) - (new-params (list (cons name value)))) - (while old-params - (when (or (not (listp (car old-params))) - (not (eq (caar old-params) name))) - (setq new-params (append new-params (list (car old-params))))) - (setq old-params (cdr old-params))) - (gnus-group-set-info new-params group 'params))))) - -(defun gnus-group-remove-parameter (group name) - "Remove parameter NAME from GROUP." - (let ((info (gnus-get-info group))) - (when info - (let ((params (gnus-info-params info))) - (when params - (setq params (delq name params)) - (while (assq name params) - (setq params (delq (assq name params) params))) - (gnus-info-set-params info params)))))) - -(defun gnus-group-add-score (group &optional score) - "Add SCORE to the GROUP score. -If SCORE is nil, add 1 to the score of GROUP." - (let ((info (gnus-get-info group))) - (when info - (gnus-info-set-score info (+ (gnus-info-score info) (or score 1)))))) - -;; Function written by Stainless Steel Rat -(defun gnus-short-group-name (group &optional levels) - "Collapse GROUP name LEVELS. -Select methods are stripped and any remote host name is stripped down to -just the host name." - (let* ((name "") (foreign "") (depth -1) (skip 1) - (levels (or levels - (progn - (while (string-match "\\." group skip) - (setq skip (match-end 0) - depth (+ depth 1))) - depth)))) - ;; separate foreign select method from group name and collapse. - ;; if method contains a server, collapse to non-domain server name, - ;; otherwise collapse to select method - (when (string-match ":" group) - (cond ((string-match "+" group) - (let* ((plus (string-match "+" group)) - (colon (string-match ":" group (or plus 0))) - (dot (string-match "\\." group))) - (setq foreign (concat - (substring group (+ 1 plus) - (cond ((null dot) colon) - ((< colon dot) colon) - ((< dot colon) dot))) - ":") - group (substring group (+ 1 colon))))) - (t - (let* ((colon (string-match ":" group))) - (setq foreign (concat (substring group 0 (+ 1 colon))) - group (substring group (+ 1 colon))))))) - ;; collapse group name leaving LEVELS uncollapsed elements - (while group - (if (and (string-match "\\." group) (> levels 0)) - (setq name (concat name (substring group 0 1)) - group (substring group (match-end 0)) - levels (- levels 1) - name (concat name ".")) - (setq name (concat foreign name group) - group nil))) - name)) - -(defun gnus-narrow-to-body () - "Narrow to the body of an article." - (narrow-to-region - (progn - (goto-char (point-min)) - (or (search-forward "\n\n" nil t) - (point-max))) - (point-max))) - - -;;; -;;; Kill file handling. -;;; - -(defun gnus-apply-kill-file () - "Apply a kill file to the current newsgroup. -Returns the number of articles marked as read." - (if (or (file-exists-p (gnus-newsgroup-kill-file nil)) - (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))) - (gnus-apply-kill-file-internal) - 0)) - -(defun gnus-kill-save-kill-buffer () - (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))) - (when (get-file-buffer file) - (save-excursion - (set-buffer (get-file-buffer file)) - (when (buffer-modified-p) - (save-buffer)) - (kill-buffer (current-buffer)))))) - -(defcustom gnus-kill-file-name "KILL" - "Suffix of the kill files." - :group 'gnus-score-kill - :group 'gnus-score-files - :type 'string) - -(defun gnus-newsgroup-kill-file (newsgroup) - "Return the name of a kill file name for NEWSGROUP. -If NEWSGROUP is nil, return the global kill file name instead." - (cond - ;; The global KILL file is placed at top of the directory. - ((or (null newsgroup) - (string-equal newsgroup "")) - (expand-file-name gnus-kill-file-name - gnus-kill-files-directory)) - ;; Append ".KILL" to newsgroup name. - ((gnus-use-long-file-name 'not-kill) - (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup) - "." gnus-kill-file-name) - gnus-kill-files-directory)) - ;; Place "KILL" under the hierarchical directory. - (t - (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) - "/" gnus-kill-file-name) - gnus-kill-files-directory)))) - -;;; Server things. - -(defun gnus-member-of-valid (symbol group) - "Find out if GROUP has SYMBOL as part of its \"valid\" spec." - (memq symbol (assoc - (symbol-name (car (gnus-find-method-for-group group))) - gnus-valid-select-methods))) - -(defun gnus-method-option-p (method option) - "Return non-nil if select METHOD has OPTION as a parameter." - (when (stringp method) - (setq method (gnus-server-to-method method))) - (memq option (assoc (format "%s" (car method)) - gnus-valid-select-methods))) - -(defun gnus-similar-server-opened (method) - (let ((opened gnus-opened-servers)) - (while (and method opened) - (when (and (equal (cadr method) (cadaar opened)) - (not (equal method (caar opened)))) - (setq method nil)) - (pop opened)) - (not method))) - -(defun gnus-server-extend-method (group method) - ;; This function "extends" a virtual server. If the server is - ;; "hello", and the select method is ("hello" (my-var "something")) - ;; in the group "alt.alt", this will result in a new virtual server - ;; called "hello+alt.alt". - (if (or (not (inline (gnus-similar-server-opened method))) - (not (cddr method))) - method - `(,(car method) ,(concat (cadr method) "+" group) - (,(intern (format "%s-address" (car method))) ,(cadr method)) - ,@(cddr method)))) - -(defun gnus-server-status (method) - "Return the status of METHOD." - (nth 1 (assoc method gnus-opened-servers))) - -(defun gnus-group-name-to-method (group) - "Guess a select method based on GROUP." - (if (string-match ":" group) - (let ((server (substring group 0 (match-beginning 0)))) - (if (string-match "\\+" server) - (list (intern (substring server 0 (match-beginning 0))) - (substring server (match-end 0))) - (list (intern server) ""))) - gnus-select-method)) - -(defun gnus-find-method-for-group (group &optional info) - "Find the select method that GROUP uses." - (or gnus-override-method - (and (not group) - gnus-select-method) - (let ((info (or info (gnus-get-info group))) - method) - (if (or (not info) - (not (setq method (gnus-info-method info))) - (equal method "native")) - gnus-select-method - (setq method - (cond ((stringp method) - (inline (gnus-server-to-method method))) - ((stringp (cadr method)) - (inline (gnus-server-extend-method group method))) - (t - method))) - (cond ((equal (cadr method) "") - method) - ((null (cadr method)) - (list (car method) "")) - (t - (gnus-server-add-address method))))))) - -(defsubst gnus-check-backend-function (func group) - "Check whether GROUP supports function FUNC. -GROUP can either be a string (a group name) or a select method." - (ignore-errors - (let ((method (if (stringp group) - (car (gnus-find-method-for-group group)) - group))) - (unless (featurep method) - (require method)) - (fboundp (intern (format "%s-%s" method func)))))) - -(defun gnus-methods-using (feature) - "Find all methods that have FEATURE." - (let ((valids gnus-valid-select-methods) - outs) - (while valids - (when (memq feature (car valids)) - (push (car valids) outs)) - (setq valids (cdr valids))) - outs)) - -(defun gnus-read-group (prompt &optional default) - "Prompt the user for a group name. -Disallow illegal group names." - (let ((prefix "") - group) - (while (not group) - (when (string-match - "[: `'\"/]\\|^$" - (setq group (read-string (concat prefix prompt) - (cons (or default "") 0) - 'gnus-group-history))) - (setq prefix (format "Illegal group name: \"%s\". " group) - group nil))) - group)) - -(defun gnus-read-method (prompt) - "Prompt the user for a method. -Allow completion over sensible values." - (let ((method - (completing-read - prompt (append gnus-valid-select-methods gnus-predefined-server-alist - gnus-server-alist) - nil t nil 'gnus-method-history))) - (cond - ((equal method "") - (setq method gnus-select-method)) - ((assoc method gnus-valid-select-methods) - (list (intern method) - (if (memq 'prompt-address - (assoc method gnus-valid-select-methods)) - (read-string "Address: ") - ""))) - ((assoc method gnus-server-alist) - method) - (t - (list (intern method) ""))))) - -;;; User-level commands. - -;;;###autoload -(defun gnus-slave-no-server (&optional arg) - "Read network news as a slave, without connecting to local server" - (interactive "P") - (gnus-no-server arg t)) - -;;;###autoload -(defun gnus-no-server (&optional arg slave) - "Read network news. -If ARG is a positive number, Gnus will use that as the -startup level. If ARG is nil, Gnus will be started at level 2. -If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use. -As opposed to `gnus', this command will not connect to the local server." - (interactive "P") - (gnus-no-server-1 arg slave)) - -;;;###autoload -(defun gnus-slave (&optional arg) - "Read news as a slave." - (interactive "P") - (gnus arg nil 'slave)) - -;;;###autoload -(defun gnus-other-frame (&optional arg) - "Pop up a frame to read news." - (interactive "P") - (let ((window (get-buffer-window gnus-group-buffer))) - (cond (window - (select-frame (window-frame window))) - ((= (length (frame-list)) 1) - (select-frame (make-frame))) - (t - (other-frame 1)))) - (gnus arg)) - -;;;###autoload -(defun gnus (&optional arg dont-connect slave) - "Read network news. -If ARG is non-nil and a positive number, Gnus will use that as the -startup level. If ARG is non-nil and not a positive number, Gnus will -prompt the user for the name of an NNTP server to use." - (interactive "P") - (gnus-1 arg dont-connect slave)) - -;; Allow redefinition of Gnus functions. - -(gnus-ems-redefine) - -(provide 'gnus) - -;;; gnus.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/lpath.el --- a/lisp/gnus/lpath.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,55 +0,0 @@ -;; Shut up. - -(defvar byte-compile-default-warnings) - -(defun maybe-fbind (args) - (while args - (or (fboundp (car args)) - (fset (car args) 'ignore)) - (setq args (cdr args)))) - -(defun maybe-bind (args) - (mapcar (lambda (var) (unless (boundp var) (set var nil))) args)) - -(if (string-match "XEmacs" emacs-version) - (progn - (defvar track-mouse nil) - (maybe-fbind '(posn-point - event-start x-popup-menu - facemenu-get-face window-at coordinates-in-window-p - compute-motion x-defined-colors easy-menu-create-keymaps - read-event internal-find-face internal-next-face-id - make-face-internal set-frame-face-alist frame-face-alist - facemenu-add-new-face make-face-x-resource-internal - set-font-size set-font-family posn-window - run-with-idle-timer mouse-minibuffer-check window-edges - event-click-count track-mouse read-event mouse-movement-p - event-end mouse-scroll-subr overlay-lists delete-overlay - set-face-stipple mail-abbrevs-setup char-int - make-char-table set-char-table-range font-create-object - x-color-values widget-make-intangible error-message-string - w3-form-encode-xwfu - )) - (maybe-bind '(global-face-data - mark-active transient-mark-mode mouse-selection-click-count - mouse-selection-click-count-buffer buffer-display-table - font-lock-defaults user-full-name user-login-name - gnus-newsgroup-name gnus-article-x-face-too-ugly))) - (defvar browse-url-browser-function nil) - (maybe-fbind '(color-instance-rgb-components - make-color-instance color-instance-name specifier-instance - device-type device-class get-popup-menu-response event-object - x-defined-colors read-color add-submenu set-font-family - font-create-object set-font-size frame-device find-face - set-extent-property make-extent characterp display-error - set-face-doc-string frame-property face-doc-string - button-press-event-p next-command-event - widget-make-intangible glyphp make-glyph set-glyph-image - set-glyph-property event-glyph glyph-property event-point - device-on-window-system-p make-gui-button Info-goto-node - pp-to-string color-name))) - -(setq load-path (cons "." load-path)) -(require 'custom) - -(provide 'lpath) diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/mailheader.el --- a/lisp/gnus/mailheader.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,182 +0,0 @@ -;;; mail-header.el --- Mail header parsing, merging, formatting - -;; Copyright (C) 1996 by Free Software Foundation, Inc. - -;; Author: Erik Naggum -;; Keywords: tools, mail, 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This package provides an abstraction to RFC822-style messages, used in -;; mail news, and some other systems. The simple syntactic rules for such -;; headers, such as quoting and line folding, are routinely reimplemented -;; in many individual packages. This package removes the need for this -;; redundancy by representing message headers as association lists, -;; offering functions to extract the set of headers from a message, to -;; parse individual headers, to merge sets of headers, and to format a set -;; of headers. - -;; The car of each element in the message-header alist is a symbol whose -;; print name is the name of the header, in all lower-case. The cdr of an -;; element depends on the operation. After extracting headers from a -;; message, it is a string, the value of the header. An extracted set of -;; headers may be parsed further, which may turn it into a list, whose car -;; is the original value and whose subsequent elements depend on the -;; header. For formatting, it is evaluated to obtain the strings to be -;; inserted. For merging, one set of headers consists of strings, while -;; the other set will be evaluated with the symbols in the first set of -;; headers bound to their respective values. - -;;; Code: - -(require 'cl) - -;; Make the byte-compiler shut up. -(defvar headers) - -(defun mail-header-extract () - "Extract headers from current buffer after point. -Returns a header alist, where each element is a cons cell (name . value), -where NAME is a symbol, and VALUE is the string value of the header having -that name." - (let ((message-headers ()) (top (point)) - start end) - (while (and (setq start (point)) - (> (skip-chars-forward "^\0- :") 0) - (= (following-char) ?:) - (setq end (point)) - (progn (forward-char) - (> (skip-chars-forward " \t") 0))) - (let ((header (intern (downcase (buffer-substring start end)))) - (value (list (buffer-substring - (point) (progn (end-of-line) (point)))))) - (while (progn (forward-char) (> (skip-chars-forward " \t") 0)) - (push (buffer-substring (point) (progn (end-of-line) (point))) - value)) - (push (if (cdr value) - (cons header (mapconcat #'identity (nreverse value) " ")) - (cons header (car value))) - message-headers))) - (goto-char top) - (nreverse message-headers))) - -(defun mail-header-extract-no-properties () - "Extract headers from current buffer after point, without properties. -Returns a header alist, where each element is a cons cell (name . value), -where NAME is a symbol, and VALUE is the string value of the header having -that name." - (mapcar - (lambda (elt) - (set-text-properties 0 (length (cdr elt)) nil (cdr elt)) - elt) - (mail-header-extract))) - -(defun mail-header-parse (parsing-rules headers) - "Apply PARSING-RULES to HEADERS. -PARSING-RULES is an alist whose keys are header names (symbols) and whose -value is a parsing function. The function takes one argument, a string, -and return a list of values, which will destructively replace the value -associated with the key in HEADERS, after being prepended with the original -value." - (dolist (rule parsing-rules) - (let ((header (assq (car rule) headers))) - (when header - (if (consp (cdr header)) - (setf (cddr header) (funcall (cdr rule) (cadr header))) - (setf (cdr header) - (cons (cdr header) (funcall (cdr rule) (cdr header)))))))) - headers) - -(defsubst mail-header (header &optional header-alist) - "Return the value associated with header HEADER in HEADER-ALIST. -If the value is a string, it is the original value of the header. If the -value is a list, its first element is the original value of the header, -with any subsequent elements being the result of parsing the value. -If HEADER-ALIST is nil, the dynamically bound variable `headers' is used." - (cdr (assq header (or header-alist headers)))) - -(defun mail-header-set (header value &optional header-alist) - "Set the value associated with header HEADER to VALUE in HEADER-ALIST. -HEADER-ALIST defaults to the dynamically bound variable `headers' if nil. -See `mail-header' for the semantics of VALUE." - (let* ((alist (or header-alist headers)) - (entry (assq header alist))) - (if entry - (setf (cdr entry) value) - (nconc alist (list (cons header value))))) - value) - -(defsetf mail-header (header &optional header-alist) (value) - `(mail-header-set ,header ,value ,header-alist)) - -(defun mail-header-merge (merge-rules headers) - "Return a new header alist with MERGE-RULES applied to HEADERS. -MERGE-RULES is an alist whose keys are header names (symbols) and whose -values are forms to evaluate, the results of which are the new headers. It -should be a string or a list of string. The first element may be nil to -denote that the formatting functions must use the remaining elements, or -skip the header altogether if there are no other elements. - The macro `mail-header' can be used to access headers in HEADERS." - (mapcar - (lambda (rule) - (cons (car rule) (eval (cdr rule)))) - merge-rules)) - -(defvar mail-header-format-function - (lambda (header value) - "Function to format headers without a specified formatting function." - (insert (capitalize (symbol-name header)) - ": " - (if (consp value) (car value) value) - "\n"))) - -(defun mail-header-format (format-rules headers) - "Use FORMAT-RULES to format HEADERS and insert into current buffer. -FORMAT-RULES is an alist whose keys are header names (symbols), and whose -values are functions that format the header, the results of which are -inserted, unless it is nil. The function takes two arguments, the header -symbol, and the value of that header. If the function itself is nil, the -default action is to insert the value of the header, unless it is nil. -The headers are inserted in the order of the FORMAT-RULES. -A key of t represents any otherwise unmentioned headers. -A key of nil has as its value a list of defaulted headers to ignore." - (let ((ignore (append (cdr (assq nil format-rules)) - (mapcar #'car format-rules)))) - (dolist (rule format-rules) - (let* ((header (car rule)) - (value (mail-header header))) - (cond ((null header) 'ignore) - ((eq header t) - (dolist (defaulted headers) - (unless (memq (car defaulted) ignore) - (let* ((header (car defaulted)) - (value (cdr defaulted))) - (if (cdr rule) - (funcall (cdr rule) header value) - (funcall mail-header-format-function header value)))))) - (value - (if (cdr rule) - (funcall (cdr rule) header value) - (funcall mail-header-format-function header value)))))) - (insert "\n"))) - -(provide 'mailheader) - -;;; mail-header.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/message.el --- a/lisp/gnus/message.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,3686 +0,0 @@ -;;; message.el --- composing mail and news messages -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: mail, 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This mode provides mail-sending facilities from within Emacs. It -;; consists mainly of large chunks of code from the sendmail.el, -;; gnus-msg.el and rnewspost.el files. - -;;; Code: - -(require 'cl) -(require 'mailheader) -(require 'rmail) -(require 'nnheader) -(require 'timezone) -(require 'easymenu) -(require 'custom) -(if (string-match "XEmacs\\|Lucid" emacs-version) - (require 'mail-abbrevs) - (require 'mailabbrev)) - -(defgroup message '((user-mail-address custom-variable) - (user-full-name custom-variable)) - "Mail and news message composing." - :link '(custom-manual "(message)Top") - :group 'mail - :group 'news) - -(put 'user-mail-address 'custom-type 'string) -(put 'user-full-name 'custom-type 'string) - -(defgroup message-various nil - "Various Message Variables" - :link '(custom-manual "(message)Various Message Variables") - :group 'message) - -(defgroup message-buffers nil - "Message Buffers" - :link '(custom-manual "(message)Message Buffers") - :group 'message) - -(defgroup message-sending nil - "Message Sending" - :link '(custom-manual "(message)Sending Variables") - :group 'message) - -(defgroup message-interface nil - "Message Interface" - :link '(custom-manual "(message)Interface") - :group 'message) - -(defgroup message-forwarding nil - "Message Forwarding" - :link '(custom-manual "(message)Forwarding") - :group 'message-interface) - -(defgroup message-insertion nil - "Message Insertion" - :link '(custom-manual "(message)Insertion") - :group 'message) - -(defgroup message-headers nil - "Message Headers" - :link '(custom-manual "(message)Message Headers") - :group 'message) - -(defgroup message-news nil - "Composing News Messages" - :group 'message) - -(defgroup message-mail nil - "Composing Mail Messages" - :group 'message) - -(defgroup message-faces nil - "Faces used for message composing." - :group 'message - :group 'faces) - -(defcustom message-directory "~/Mail/" - "*Directory from which all other mail file variables are derived." - :group 'message-various - :type 'directory) - -(defcustom message-max-buffers 10 - "*How many buffers to keep before starting to kill them off." - :group 'message-buffers - :type 'integer) - -(defcustom message-send-rename-function nil - "Function called to rename the buffer after sending it." - :group 'message-buffers - :type 'function) - -(defcustom message-fcc-handler-function 'message-output - "*A function called to save outgoing articles. -This function will be called with the name of the file to store the -article in. The default function is `message-output' which saves in Unix -mailbox format." - :type '(radio (function-item message-output) - (function :tag "Other")) - :group 'message-sending) - -(defcustom message-courtesy-message - "The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n" - "*This is inserted at the start of a mailed copy of a posted message. -If the string contains the format spec \"%s\", the Newsgroups -the article has been posted to will be inserted there. -If this variable is nil, no such courtesy message will be added." - :group 'message-sending - :type 'string) - -(defcustom message-ignored-bounced-headers "^\\(Received\\|Return-Path\\):" - "*Regexp that matches headers to be removed in resent bounced mail." - :group 'message-interface - :type 'regexp) - -;;;###autoload -(defcustom message-from-style 'default - "*Specifies how \"From\" headers look. - -If `nil', they contain just the return address like: - king@grassland.com -If `parens', they look like: - king@grassland.com (Elvis Parsley) -If `angles', they look like: - Elvis Parsley - -Otherwise, most addresses look like `angles', but they look like -`parens' if `angles' would need quoting and `parens' would not." - :type '(choice (const :tag "simple" nil) - (const parens) - (const angles) - (const default)) - :group 'message-headers) - -(defcustom message-syntax-checks nil - ;; Guess this one shouldn't be easy to customize... - "Controls what syntax checks should not be performed on outgoing posts. -To disable checking of long signatures, for instance, add - `(signature . disabled)' to this list. - -Don't touch this variable unless you really know what you're doing. - -Checks include subject-cmsg multiple-headers sendsys message-id from -long-lines control-chars size new-text redirected-followup signature -approved sender empty empty-headers message-id from subject -shorten-followup-to existing-newsgroups." - :group 'message-news) - -(defcustom message-required-news-headers - '(From Newsgroups Subject Date Message-ID - (optional . Organization) Lines - (optional . X-Newsreader)) - "Headers to be generated or prompted for when posting an article. -RFC977 and RFC1036 require From, Date, Newsgroups, Subject, -Message-ID. Organization, Lines, In-Reply-To, Expires, and -X-Newsreader are optional. If don't you want message to insert some -header, remove it from this list." - :group 'message-news - :group 'message-headers - :type '(repeat sexp)) - -(defcustom message-required-mail-headers - '(From Subject Date (optional . In-Reply-To) Message-ID Lines - (optional . X-Mailer)) - "Headers to be generated or prompted for when mailing a message. -RFC822 required that From, Date, To, Subject and Message-ID be -included. Organization, Lines and X-Mailer are optional." - :group 'message-mail - :group 'message-headers - :type '(repeat sexp)) - -(defcustom message-deletable-headers '(Message-ID Date Lines) - "Headers to be deleted if they already exist and were generated by message previously." - :group 'message-headers - :type 'sexp) - -(defcustom message-ignored-news-headers - "^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:\\|^Resent-Fcc:" - "*Regexp of headers to be removed unconditionally before posting." - :group 'message-news - :group 'message-headers - :type 'regexp) - -(defcustom message-ignored-mail-headers "^Gcc:\\|^Fcc:\\|^Resent-Fcc:" - "*Regexp of headers to be removed unconditionally before mailing." - :group 'message-mail - :group 'message-headers - :type 'regexp) - -(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|Return-Path:\\|^Supersedes:" - "*Header lines matching this regexp will be deleted before posting. -It's best to delete old Path and Date headers before posting to avoid -any confusion." - :group 'message-interface - :type 'regexp) - -;;;###autoload -(defcustom message-signature-separator "^-- *$" - "Regexp matching the signature separator." - :type 'regexp - :group 'message-various) - -(defcustom message-elide-elipsis "\n[...]\n\n" - "*The string which is inserted for elided text.") - -(defcustom message-interactive nil - "Non-nil means when sending a message wait for and display errors. -nil means let mailer mail back a message to report errors." - :group 'message-sending - :group 'message-mail - :type 'boolean) - -(defcustom message-generate-new-buffers t - "*Non-nil means that a new message buffer will be created whenever `mail-setup' is called. -If this is a function, call that function with three parameters: The type, -the to address and the group name. (Any of these may be nil.) The function -should return the new buffer name." - :group 'message-buffers - :type '(choice (const :tag "off" nil) - (const :tag "on" t) - (function fun))) - -(defcustom message-kill-buffer-on-exit nil - "*Non-nil means that the message buffer will be killed after sending a message." - :group 'message-buffers - :type 'boolean) - -(defvar gnus-local-organization) -(defcustom message-user-organization - (or (and (boundp 'gnus-local-organization) - (stringp gnus-local-organization) - gnus-local-organization) - (getenv "ORGANIZATION") - t) - "*String to be used as an Organization header. -If t, use `message-user-organization-file'." - :group 'message-headers - :type '(choice string - (const :tag "consult file" t))) - -;;;###autoload -(defcustom message-user-organization-file "/usr/lib/news/organization" - "*Local news organization file." - :type 'file - :group 'message-headers) - -(defcustom message-autosave-directory "~/" - ; (concat (file-name-as-directory message-directory) "drafts/") - "*Directory where message autosaves buffers. -If nil, message won't autosave." - :group 'message-buffers - :type 'directory) - -(defcustom message-forward-start-separator - "------- Start of forwarded message -------\n" - "*Delimiter inserted before forwarded messages." - :group 'message-forwarding - :type 'string) - -(defcustom message-forward-end-separator - "------- End of forwarded message -------\n" - "*Delimiter inserted after forwarded messages." - :group 'message-forwarding - :type 'string) - -(defcustom message-signature-before-forwarded-message t - "*If non-nil, put the signature before any included forwarded message." - :group 'message-forwarding - :type 'boolean) - -(defcustom message-included-forward-headers - "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:" - "*Regexp matching headers to be included in forwarded messages." - :group 'message-forwarding - :type 'regexp) - -(defcustom message-ignored-resent-headers "^Return-receipt" - "*All headers that match this regexp will be deleted when resending a message." - :group 'message-interface - :type 'regexp) - -(defcustom message-ignored-cited-headers "." - "*Delete these headers from the messages you yank." - :group 'message-insertion - :type 'regexp) - -(defcustom message-cancel-message "I am canceling my own article." - "Message to be inserted in the cancel message." - :group 'message-interface - :type 'string) - -;; Useful to set in site-init.el -;;;###autoload -(defcustom message-send-mail-function 'message-send-mail-with-sendmail - "Function to call to send the current buffer as mail. -The headers should be delimited by a line whose contents match the -variable `mail-header-separator'. - -Legal values include `message-send-mail-with-sendmail' (the default), -`message-send-mail-with-mh' and `message-send-mail-with-qmail'." - :type '(radio (function-item message-send-mail-with-sendmail) - (function-item message-send-mail-with-mh) - (function-item message-send-mail-with-qmail) - (function :tag "Other")) - :group 'message-sending - :group 'message-mail) - -(defcustom message-send-news-function 'message-send-news - "Function to call to send the current buffer as news. -The headers should be delimited by a line whose contents match the -variable `mail-header-separator'." - :group 'message-sending - :group 'message-news - :type 'function) - -(defcustom message-reply-to-function nil - "Function that should return a list of headers. -This function should pick out addresses from the To, Cc, and From headers -and respond with new To and Cc headers." - :group 'message-interface - :type 'function) - -(defcustom message-wide-reply-to-function nil - "Function that should return a list of headers. -This function should pick out addresses from the To, Cc, and From headers -and respond with new To and Cc headers." - :group 'message-interface - :type 'function) - -(defcustom message-followup-to-function nil - "Function that should return a list of headers. -This function should pick out addresses from the To, Cc, and From headers -and respond with new To and Cc headers." - :group 'message-interface - :type 'function) - -(defcustom message-use-followup-to 'ask - "*Specifies what to do with Followup-To header. -If nil, always ignore the header. If it is t, use its value, but -query before using the \"poster\" value. If it is the symbol `ask', -always query the user whether to use the value. If it is the symbol -`use', always use the value." - :group 'message-interface - :type '(choice (const :tag "ignore" nil) - (const use) - (const ask))) - -;; stuff relating to broken sendmail in MMDF -(defcustom message-sendmail-f-is-evil nil - "*Non-nil means that \"-f username\" should not be added to the sendmail -command line, because it is even more evil than leaving it out." - :group 'message-sending - :type 'boolean) - -;; qmail-related stuff -(defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject" - "Location of the qmail-inject program." - :group 'message-sending - :type 'file) - -(defcustom message-qmail-inject-args nil - "Arguments passed to qmail-inject programs. -This should be a list of strings, one string for each argument. - -For e.g., if you wish to set the envelope sender address so that bounces -go to the right place or to deal with listserv's usage of that address, you -might set this variable to '(\"-f\" \"you@some.where\")." - :group 'message-sending - :type '(repeat string)) - -(defvar gnus-post-method) -(defvar gnus-select-method) -(defcustom message-post-method - (cond ((and (boundp 'gnus-post-method) - gnus-post-method) - gnus-post-method) - ((boundp 'gnus-select-method) - gnus-select-method) - (t '(nnspool ""))) - "Method used to post news." - :group 'message-news - :group 'message-sending - ;; This should be the `gnus-select-method' widget, but that might - ;; create a dependence to `gnus.el'. - :type 'sexp) - -(defcustom message-generate-headers-first nil - "*If non-nil, generate all possible headers before composing." - :group 'message-headers - :type 'boolean) - -(defcustom message-setup-hook nil - "Normal hook, run each time a new outgoing message is initialized. -The function `message-setup' runs this hook." - :group 'message-various - :type 'hook) - -(defcustom message-signature-setup-hook nil - "Normal hook, run each time a new outgoing message is initialized. -It is run after the headers have been inserted and before -the signature is inserted." - :group 'message-various - :type 'hook) - -(defcustom message-mode-hook nil - "Hook run in message mode buffers." - :group 'message-various - :type 'hook) - -(defcustom message-header-hook nil - "Hook run in a message mode buffer narrowed to the headers." - :group 'message-various - :type 'hook) - -(defcustom message-header-setup-hook nil - "Hook called narrowed to the headers when setting up a message -buffer." - :group 'message-various - :type 'hook) - -;;;###autoload -(defcustom message-citation-line-function 'message-insert-citation-line - "*Function called to insert the \"Whomever writes:\" line." - :type 'function - :group 'message-insertion) - -;;;###autoload -(defcustom message-yank-prefix "> " - "*Prefix inserted on the lines of yanked messages. -nil means use indentation." - :type 'string - :group 'message-insertion) - -(defcustom message-indentation-spaces 3 - "*Number of spaces to insert at the beginning of each cited line. -Used by `message-yank-original' via `message-yank-cite'." - :group 'message-insertion - :type 'integer) - -;;;###autoload -(defcustom message-cite-function - (if (and (boundp 'mail-citation-hook) - mail-citation-hook) - mail-citation-hook - 'message-cite-original) - "*Function for citing an original message." - :type '(radio (function-item message-cite-original) - (function-item sc-cite-original) - (function :tag "Other")) - :group 'message-insertion) - -;;;###autoload -(defcustom message-indent-citation-function 'message-indent-citation - "*Function for modifying a citation just inserted in the mail buffer. -This can also be a list of functions. Each function can find the -citation between (point) and (mark t). And each function should leave -point and mark around the citation text as modified." - :type 'function - :group 'message-insertion) - -(defvar message-abbrevs-loaded nil) - -;;;###autoload -(defcustom message-signature t - "*String to be inserted at the end of the message buffer. -If t, the `message-signature-file' file will be inserted instead. -If a function, the result from the function will be used instead. -If a form, the result from the form will be used instead." - :type 'sexp - :group 'message-insertion) - -;;;###autoload -(defcustom message-signature-file "~/.signature" - "*File containing the text inserted at end of message buffer." - :type 'file - :group 'message-insertion) - -(defcustom message-distribution-function nil - "*Function called to return a Distribution header." - :group 'message-news - :group 'message-headers - :type 'function) - -(defcustom message-expires 14 - "Number of days before your article expires." - :group 'message-news - :group 'message-headers - :link '(custom-manual "(message)News Headers") - :type 'integer) - -(defcustom message-user-path nil - "If nil, use the NNTP server name in the Path header. -If stringp, use this; if non-nil, use no host name (user name only)." - :group 'message-news - :group 'message-headers - :link '(custom-manual "(message)News Headers") - :type '(choice (const :tag "nntp" nil) - (string :tag "name") - (sexp :tag "none" :format "%t" t))) - -(defvar message-reply-buffer nil) -(defvar message-reply-headers nil) -(defvar message-newsreader nil) -(defvar message-mailer nil) -(defvar message-sent-message-via nil) -(defvar message-checksum nil) -(defvar message-send-actions nil - "A list of actions to be performed upon successful sending of a message.") -(defvar message-exit-actions nil - "A list of actions to be performed upon exiting after sending a message.") -(defvar message-kill-actions nil - "A list of actions to be performed before killing a message buffer.") -(defvar message-postpone-actions nil - "A list of actions to be performed after postponing a message.") - -(defcustom message-default-headers "" - "*A string containing header lines to be inserted in outgoing messages. -It is inserted before you edit the message, so you can edit or delete -these lines." - :group 'message-headers - :type 'string) - -(defcustom message-default-mail-headers "" - "*A string of header lines to be inserted in outgoing mails." - :group 'message-headers - :group 'message-mail - :type 'string) - -(defcustom message-default-news-headers "" - "*A string of header lines to be inserted in outgoing news -articles." - :group 'message-headers - :group 'message-news - :type 'string) - -;; Note: could use /usr/ucb/mail instead of sendmail; -;; options -t, and -v if not interactive. -(defcustom message-mailer-swallows-blank-line - (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" - system-configuration) - (file-readable-p "/etc/sendmail.cf") - (let ((buffer (get-buffer-create " *temp*"))) - (unwind-protect - (save-excursion - (set-buffer buffer) - (insert-file-contents "/etc/sendmail.cf") - (goto-char (point-min)) - (let ((case-fold-search nil)) - (re-search-forward "^OR\\>" nil t))) - (kill-buffer buffer)))) - ;; According to RFC822, "The field-name must be composed of printable - ;; ASCII characters (i. e., characters that have decimal values between - ;; 33 and 126, except colon)", i. e., any chars except ctl chars, - ;; space, or colon. - '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:")) - "Set this non-nil if the system's mailer runs the header and body together. -\(This problem exists on Sunos 4 when sendmail is run in remote mode.) -The value should be an expression to test whether the problem will -actually occur." - :group 'message-sending - :type 'sexp) - -(ignore-errors - (define-mail-user-agent 'message-user-agent - 'message-mail 'message-send-and-exit - 'message-kill-buffer 'message-send-hook)) - -(defvar message-mh-deletable-headers '(Message-ID Date Lines Sender) - "If non-nil, delete the deletable headers before feeding to mh.") - -(defvar message-send-method-alist - '((news message-news-p message-send-via-news) - (mail message-mail-p message-send-via-mail)) - "Alist of ways to send outgoing messages. -Each element has the form - - \(TYPE PREDICATE FUNCTION) - -where TYPE is a symbol that names the method; PREDICATE is a function -called without any parameters to determine whether the message is -a message of type TYPE; and FUNCTION is a function to be called if -PREDICATE returns non-nil. FUNCTION is called with one parameter -- -the prefix.") - -(defvar message-mail-alias-type 'abbrev - "*What alias expansion type to use in Message buffers. -The default is `abbrev', which uses mailabbrev. nil switches -mail aliases off.") - -;;; Internal variables. -;;; Well, not really internal. - -(defvar message-mode-syntax-table - (let ((table (copy-syntax-table text-mode-syntax-table))) - (modify-syntax-entry ?% ". " table) - table) - "Syntax table used while in Message mode.") - -(defvar message-mode-abbrev-table text-mode-abbrev-table - "Abbrev table used in Message mode buffers. -Defaults to `text-mode-abbrev-table'.") -(defgroup message-headers nil - "Message headers." - :link '(custom-manual "(message)Variables") - :group 'message) - -(defface message-header-to-face - '((((class color) - (background dark)) - (:foreground "green2" :bold t)) - (((class color) - (background light)) - (:foreground "MidnightBlue" :bold t)) - (t - (:bold t :italic t))) - "Face used for displaying From headers." - :group 'message-faces) - -(defface message-header-cc-face - '((((class color) - (background dark)) - (:foreground "green4" :bold t)) - (((class color) - (background light)) - (:foreground "MidnightBlue")) - (t - (:bold t))) - "Face used for displaying Cc headers." - :group 'message-faces) - -(defface message-header-subject-face - '((((class color) - (background dark)) - (:foreground "green3")) - (((class color) - (background light)) - (:foreground "navy blue" :bold t)) - (t - (:bold t))) - "Face used for displaying subject headers." - :group 'message-faces) - -(defface message-header-newsgroups-face - '((((class color) - (background dark)) - (:foreground "yellow" :bold t :italic t)) - (((class color) - (background light)) - (:foreground "blue4" :bold t :italic t)) - (t - (:bold t :italic t))) - "Face used for displaying newsgroups headers." - :group 'message-faces) - -(defface message-header-other-face - '((((class color) - (background dark)) - (:foreground "red4")) - (((class color) - (background light)) - (:foreground "steel blue")) - (t - (:bold t :italic t))) - "Face used for displaying newsgroups headers." - :group 'message-faces) - -(defface message-header-name-face - '((((class color) - (background dark)) - (:foreground "DarkGreen")) - (((class color) - (background light)) - (:foreground "cornflower blue")) - (t - (:bold t))) - "Face used for displaying header names." - :group 'message-faces) - -(defface message-header-xheader-face - '((((class color) - (background dark)) - (:foreground "blue")) - (((class color) - (background light)) - (:foreground "blue")) - (t - (:bold t))) - "Face used for displaying X-Header headers." - :group 'message-faces) - -(defface message-separator-face - '((((class color) - (background dark)) - (:foreground "blue4")) - (((class color) - (background light)) - (:foreground "brown")) - (t - (:bold t))) - "Face used for displaying the separator." - :group 'message-faces) - -(defface message-cited-text-face - '((((class color) - (background dark)) - (:foreground "red")) - (((class color) - (background light)) - (:foreground "red")) - (t - (:bold t))) - "Face used for displaying cited text names." - :group 'message-faces) - -(defvar message-font-lock-keywords - (let* ((cite-prefix "A-Za-z") - (cite-suffix (concat cite-prefix "0-9_.@-")) - (content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)")) - `((,(concat "^\\([Tt]o:\\)" content) - (1 'message-header-name-face) - (2 'message-header-to-face nil t)) - (,(concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content) - (1 'message-header-name-face) - (2 'message-header-cc-face nil t)) - (,(concat "^\\([Ss]ubject:\\)" content) - (1 'message-header-name-face) - (2 'message-header-subject-face nil t)) - (,(concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content) - (1 'message-header-name-face) - (2 'message-header-newsgroups-face nil t)) - (,(concat "^\\([A-Z][^: \n\t]+:\\)" content) - (1 'message-header-name-face) - (2 'message-header-other-face nil t)) - (,(concat "^\\(X-[A-Za-z0-9-]+\\|In-Reply-To\\):" content) - (1 'message-header-name-face) - (2 'message-header-name-face)) - (,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$") - 1 'message-separator-face) - (,(concat "^[ \t]*" - "\\([" cite-prefix "]+[" cite-suffix "]*\\)?" - "[>|}].*") - (0 'message-cited-text-face)))) - "Additional expressions to highlight in Message mode.") - -(defvar message-face-alist - '((bold . bold-region) - (underline . underline-region) - (default . (lambda (b e) - (unbold-region b e) - (ununderline-region b e)))) - "Alist of mail and news faces for facemenu. -The cdr of ech entry is a function for applying the face to a region.") - -(defcustom message-send-hook nil - "Hook run before sending messages." - :group 'message-various - :options '(ispell-message) - :type 'hook) - -(defcustom message-send-mail-hook nil - "Hook run before sending mail messages." - :group 'message-various - :type 'hook) - -(defcustom message-send-news-hook nil - "Hook run before sending news messages." - :group 'message-various - :type 'hook) - -(defcustom message-sent-hook nil - "Hook run after sending messages." - :group 'message-various - :type 'hook) - -;;; Internal variables. - -(defvar message-buffer-list nil) -(defvar message-this-is-news nil) -(defvar message-this-is-mail nil) - -;; Byte-compiler warning -(defvar gnus-active-hashtb) -(defvar gnus-read-active-file) - -;;; Regexp matching the delimiter of messages in UNIX mail format -;;; (UNIX From lines), minus the initial ^. -(defvar message-unix-mail-delimiter - (let ((time-zone-regexp - (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?" - "\\|[-+]?[0-9][0-9][0-9][0-9]" - "\\|" - "\\) *"))) - (concat - "From " - - ;; Username, perhaps with a quoted section that can contain spaces. - "\\(" - "[^ \n]*" - "\\(\\|\".*\"[^ \n]*\\)" - "\\|<[^<>\n]+>" - "\\) ?" - - ;; The time the message was sent. - "\\([^ \n]*\\) *" ; day of the week - "\\([^ ]*\\) *" ; month - "\\([0-9]*\\) *" ; day of month - "\\([0-9:]*\\) *" ; time of day - - ;; Perhaps a time zone, specified by an abbreviation, or by a - ;; numeric offset. - time-zone-regexp - - ;; The year. - " [0-9][0-9]\\([0-9]*\\) *" - - ;; On some systems the time zone can appear after the year, too. - time-zone-regexp - - ;; Old uucp cruft. - "\\(remote from .*\\)?" - - "\n"))) - -(defvar message-unsent-separator - (concat "^ *---+ +Unsent message follows +---+ *$\\|" - "^ *---+ +Returned message +---+ *$\\|" - "^Start of returned message$\\|" - "^ *---+ +Original message +---+ *$\\|" - "^ *--+ +begin message +--+ *$\\|" - "^ *---+ +Original message follows +---+ *$\\|" - "^|? *---+ +Message text follows: +---+ *|?$") - "A regexp that matches the separator before the text of a failed message.") - -(defvar message-header-format-alist - `((Newsgroups) - (To . message-fill-address) - (Cc . message-fill-address) - (Subject) - (In-Reply-To) - (Fcc) - (Bcc) - (Date) - (Organization) - (Distribution) - (Lines) - (Expires) - (Message-ID) - (References) - (X-Mailer) - (X-Newsreader)) - "Alist used for formatting headers.") - -(eval-and-compile - (autoload 'message-setup-toolbar "messagexmas") - (autoload 'mh-send-letter "mh-comp") - (autoload 'gnus-point-at-eol "gnus-util") - (autoload 'gnus-point-at-bol "gnus-util") - (autoload 'gnus-output-to-mail "gnus-util") - (autoload 'gnus-output-to-rmail "gnus-util") - (autoload 'mail-abbrev-in-expansion-header-p "mailabbrev")) - - - -;;; -;;; Utility functions. -;;; - -(defmacro message-y-or-n-p (question show &rest text) - "Ask QUESTION, displaying the rest of the arguments in a temp. buffer if SHOW" - `(message-talkative-question 'y-or-n-p ,question ,show ,@text)) - -;; Delete the current line (and the next N lines.); -(defmacro message-delete-line (&optional n) - `(delete-region (progn (beginning-of-line) (point)) - (progn (forward-line ,(or n 1)) (point)))) - -(defun message-tokenize-header (header &optional separator) - "Split HEADER into a list of header elements. -\",\" is used as the separator." - (if (not header) - nil - (let ((regexp (format "[%s]+" (or separator ","))) - (beg 1) - (first t) - quoted elems paren) - (save-excursion - (message-set-work-buffer) - (insert header) - (goto-char (point-min)) - (while (not (eobp)) - (if first - (setq first nil) - (forward-char 1)) - (cond ((and (> (point) beg) - (or (eobp) - (and (looking-at regexp) - (not quoted) - (not paren)))) - (push (buffer-substring beg (point)) elems) - (setq beg (match-end 0))) - ((= (following-char) ?\") - (setq quoted (not quoted))) - ((and (= (following-char) ?\() - (not quoted)) - (setq paren t)) - ((and (= (following-char) ?\)) - (not quoted)) - (setq paren nil)))) - (nreverse elems))))) - -(defun message-mail-file-mbox-p (file) - "Say whether FILE looks like a Unix mbox file." - (when (and (file-exists-p file) - (file-readable-p file) - (file-regular-p file)) - (nnheader-temp-write nil - (nnheader-insert-file-contents file) - (goto-char (point-min)) - (looking-at message-unix-mail-delimiter)))) - -(defun message-fetch-field (header &optional not-all) - "The same as `mail-fetch-field', only remove all newlines." - (let ((value (mail-fetch-field header nil (not not-all)))) - (when value - (nnheader-replace-chars-in-string value ?\n ? )))) - -(defun message-add-header (&rest headers) - "Add the HEADERS to the message header, skipping those already present." - (while headers - (let (hclean) - (unless (string-match "^\\([^:]+\\):[ \t]*[^ \t]" (car headers)) - (error "Invalid header `%s'" (car headers))) - (setq hclean (match-string 1 (car headers))) - (save-restriction - (message-narrow-to-headers) - (unless (re-search-forward (concat "^" (regexp-quote hclean) ":") nil t) - (insert (car headers) ?\n)))) - (setq headers (cdr headers)))) - -(defun message-fetch-reply-field (header) - "Fetch FIELD from the message we're replying to." - (when (and message-reply-buffer - (buffer-name message-reply-buffer)) - (save-excursion - (set-buffer message-reply-buffer) - (message-fetch-field header)))) - -(defun message-set-work-buffer () - (if (get-buffer " *message work*") - (progn - (set-buffer " *message work*") - (erase-buffer)) - (set-buffer (get-buffer-create " *message work*")) - (kill-all-local-variables) - (buffer-disable-undo (current-buffer)))) - -(defun message-functionp (form) - "Return non-nil if FORM is funcallable." - (or (and (symbolp form) (fboundp form)) - (and (listp form) (eq (car form) 'lambda)) - (compiled-function-p form))) - -(defun message-strip-subject-re (subject) - "Remove \"Re:\" from subject lines." - (if (string-match "^[Rr][Ee]: *" subject) - (substring subject (match-end 0)) - subject)) - -(defun message-remove-header (header &optional is-regexp first reverse) - "Remove HEADER in the narrowed buffer. -If REGEXP, HEADER is a regular expression. -If FIRST, only remove the first instance of the header. -Return the number of headers removed." - (goto-char (point-min)) - (let ((regexp (if is-regexp header (concat "^" header ":"))) - (number 0) - (case-fold-search t) - last) - (while (and (not (eobp)) - (not last)) - (if (if reverse - (not (looking-at regexp)) - (looking-at regexp)) - (progn - (incf number) - (when first - (setq last t)) - (delete-region - (point) - ;; There might be a continuation header, so we have to search - ;; until we find a new non-continuation line. - (progn - (forward-line 1) - (if (re-search-forward "^[^ \t]" nil t) - (goto-char (match-beginning 0)) - (point-max))))) - (forward-line 1) - (if (re-search-forward "^[^ \t]" nil t) - (goto-char (match-beginning 0)) - (point-max)))) - number)) - -(defun message-narrow-to-headers () - "Narrow the buffer to the head of the message." - (widen) - (narrow-to-region - (goto-char (point-min)) - (if (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n") nil t) - (match-beginning 0) - (point-max))) - (goto-char (point-min))) - -(defun message-narrow-to-head () - "Narrow the buffer to the head of the message." - (widen) - (narrow-to-region - (goto-char (point-min)) - (if (search-forward "\n\n" nil 1) - (1- (point)) - (point-max))) - (goto-char (point-min))) - -(defun message-news-p () - "Say whether the current buffer contains a news message." - (or message-this-is-news - (save-excursion - (save-restriction - (message-narrow-to-headers) - (message-fetch-field "newsgroups"))))) - -(defun message-mail-p () - "Say whether the current buffer contains a mail message." - (or message-this-is-mail - (save-excursion - (save-restriction - (message-narrow-to-headers) - (or (message-fetch-field "to") - (message-fetch-field "cc") - (message-fetch-field "bcc")))))) - -(defun message-next-header () - "Go to the beginning of the next header." - (beginning-of-line) - (or (eobp) (forward-char 1)) - (not (if (re-search-forward "^[^ \t]" nil t) - (beginning-of-line) - (goto-char (point-max))))) - -(defun message-sort-headers-1 () - "Sort the buffer as headers using `message-rank' text props." - (goto-char (point-min)) - (sort-subr - nil 'message-next-header - (lambda () - (message-next-header) - (unless (bobp) - (forward-char -1))) - (lambda () - (or (get-text-property (point) 'message-rank) - 10000)))) - -(defun message-sort-headers () - "Sort the headers of the current message according to `message-header-format-alist'." - (interactive) - (save-excursion - (save-restriction - (let ((max (1+ (length message-header-format-alist))) - rank) - (message-narrow-to-headers) - (while (re-search-forward "^[^ \n]+:" nil t) - (put-text-property - (match-beginning 0) (1+ (match-beginning 0)) - 'message-rank - (if (setq rank (length (memq (assq (intern (buffer-substring - (match-beginning 0) - (1- (match-end 0)))) - message-header-format-alist) - message-header-format-alist))) - (- max rank) - (1+ max))))) - (message-sort-headers-1)))) - - - -;;; -;;; Message mode -;;; - -;;; Set up keymap. - -(defvar message-mode-map nil) - -(unless message-mode-map - (setq message-mode-map (copy-keymap text-mode-map)) - (define-key message-mode-map "\C-c?" 'describe-mode) - - (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to) - (define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc) - (define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc) - (define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc) - (define-key message-mode-map "\C-c\C-f\C-s" 'message-goto-subject) - (define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to) - (define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups) - (define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution) - (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to) - (define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords) - (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary) - (define-key message-mode-map "\C-c\C-b" 'message-goto-body) - (define-key message-mode-map "\C-c\C-i" 'message-goto-signature) - - (define-key message-mode-map "\C-c\C-t" 'message-insert-to) - (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups) - - (define-key message-mode-map "\C-c\C-y" 'message-yank-original) - (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message) - (define-key message-mode-map "\C-c\C-w" 'message-insert-signature) - (define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body) - (define-key message-mode-map "\C-c\C-o" 'message-sort-headers) - (define-key message-mode-map "\C-c\M-r" 'message-rename-buffer) - - (define-key message-mode-map "\C-c\C-c" 'message-send-and-exit) - (define-key message-mode-map "\C-c\C-s" 'message-send) - (define-key message-mode-map "\C-c\C-k" 'message-kill-buffer) - (define-key message-mode-map "\C-c\C-d" 'message-dont-send) - - (define-key message-mode-map "\C-c\C-e" 'message-elide-region) - - (define-key message-mode-map "\t" 'message-tab)) - -(easy-menu-define - message-mode-menu message-mode-map "Message Menu." - '("Message" - ["Sort Headers" message-sort-headers t] - ["Yank Original" message-yank-original t] - ["Fill Yanked Message" message-fill-yanked-message t] - ["Insert Signature" message-insert-signature t] - ["Caesar (rot13) Message" message-caesar-buffer-body t] - ["Caesar (rot13) Region" message-caesar-region (mark t)] - ["Elide Region" message-elide-region (mark t)] - ["Rename buffer" message-rename-buffer t] - ["Spellcheck" ispell-message t] - "----" - ["Send Message" message-send-and-exit t] - ["Abort Message" message-dont-send t])) - -(easy-menu-define - message-mode-field-menu message-mode-map "" - '("Field" - ["Fetch To" message-insert-to t] - ["Fetch Newsgroups" message-insert-newsgroups t] - "----" - ["To" message-goto-to t] - ["Subject" message-goto-subject t] - ["Cc" message-goto-cc t] - ["Reply-To" message-goto-reply-to t] - ["Summary" message-goto-summary t] - ["Keywords" message-goto-keywords t] - ["Newsgroups" message-goto-newsgroups t] - ["Followup-To" message-goto-followup-to t] - ["Distribution" message-goto-distribution t] - ["Body" message-goto-body t] - ["Signature" message-goto-signature t])) - -(defvar facemenu-add-face-function) -(defvar facemenu-remove-face-function) - -;;;###autoload -(defun message-mode () - "Major mode for editing mail and news to be sent. -Like Text Mode but with these additional commands: -C-c C-s message-send (send the message) C-c C-c message-send-and-exit -C-c C-f move to a header field (and create it if there isn't): - C-c C-f C-t move to To C-c C-f C-s move to Subject - C-c C-f C-c move to Cc C-c C-f C-b move to Bcc - C-c C-f C-w move to Fcc C-c C-f C-r move to Reply-To - C-c C-f C-u move to Summary C-c C-f C-n move to Newsgroups - C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution - C-c C-f C-f move to Followup-To -C-c C-t message-insert-to (add a To header to a news followup) -C-c C-n message-insert-newsgroups (add a Newsgroup header to a news reply) -C-c C-b message-goto-body (move to beginning of message text). -C-c C-i message-goto-signature (move to the beginning of the signature). -C-c C-w message-insert-signature (insert `message-signature-file' file). -C-c C-y message-yank-original (insert current message, if any). -C-c C-q message-fill-yanked-message (fill what was yanked). -C-c C-e message-elide-region (elide the text between point and mark). -C-c C-r message-caesar-buffer-body (rot13 the message body)." - (interactive) - (kill-all-local-variables) - (make-local-variable 'message-reply-buffer) - (setq message-reply-buffer nil) - (make-local-variable 'message-send-actions) - (make-local-variable 'message-exit-actions) - (make-local-variable 'message-kill-actions) - (make-local-variable 'message-postpone-actions) - (set-syntax-table message-mode-syntax-table) - (use-local-map message-mode-map) - (setq local-abbrev-table message-mode-abbrev-table) - (setq major-mode 'message-mode) - (setq mode-name "Message") - (setq buffer-offer-save t) - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(message-font-lock-keywords t)) - (make-local-variable 'facemenu-add-face-function) - (make-local-variable 'facemenu-remove-face-function) - (setq facemenu-add-face-function - (lambda (face end) - (let ((face-fun (cdr (assq face message-face-alist)))) - (if face-fun - (funcall face-fun (point) end) - (error "Face %s not configured for %s mode" face mode-name))) - "") - facemenu-remove-face-function t) - (make-local-variable 'paragraph-separate) - (make-local-variable 'paragraph-start) - (setq paragraph-start (concat (regexp-quote mail-header-separator) - "$\\|[ \t]*[-_][-_][-_]+$\\|" - "-- $\\|" - paragraph-start)) - (setq paragraph-separate (concat (regexp-quote mail-header-separator) - "$\\|[ \t]*[-_][-_][-_]+$\\|" - "-- $\\|" - paragraph-separate)) - (make-local-variable 'message-reply-headers) - (setq message-reply-headers nil) - (make-local-variable 'message-newsreader) - (make-local-variable 'message-mailer) - (make-local-variable 'message-post-method) - (make-local-variable 'message-sent-message-via) - (setq message-sent-message-via nil) - (make-local-variable 'message-checksum) - (setq message-checksum nil) - ;;(when (fboundp 'mail-hist-define-keys) - ;; (mail-hist-define-keys)) - (when (string-match "XEmacs\\|Lucid" emacs-version) - (message-setup-toolbar)) - (easy-menu-add message-mode-menu message-mode-map) - (easy-menu-add message-mode-field-menu message-mode-map) - ;; Allow mail alias things. - (when (eq message-mail-alias-type 'abbrev) - (if (fboundp 'mail-abbrevs-setup) - (mail-abbrevs-setup) - (funcall (intern "mail-aliases-setup")))) - (run-hooks 'text-mode-hook 'message-mode-hook)) - - - -;;; -;;; Message mode commands -;;; - -;;; Movement commands - -(defun message-goto-to () - "Move point to the To header." - (interactive) - (message-position-on-field "To")) - -(defun message-goto-subject () - "Move point to the Subject header." - (interactive) - (message-position-on-field "Subject")) - -(defun message-goto-cc () - "Move point to the Cc header." - (interactive) - (message-position-on-field "Cc" "To")) - -(defun message-goto-bcc () - "Move point to the Bcc header." - (interactive) - (message-position-on-field "Bcc" "Cc" "To")) - -(defun message-goto-fcc () - "Move point to the Fcc header." - (interactive) - (message-position-on-field "Fcc" "To" "Newsgroups")) - -(defun message-goto-reply-to () - "Move point to the Reply-To header." - (interactive) - (message-position-on-field "Reply-To" "Subject")) - -(defun message-goto-newsgroups () - "Move point to the Newsgroups header." - (interactive) - (message-position-on-field "Newsgroups")) - -(defun message-goto-distribution () - "Move point to the Distribution header." - (interactive) - (message-position-on-field "Distribution")) - -(defun message-goto-followup-to () - "Move point to the Followup-To header." - (interactive) - (message-position-on-field "Followup-To" "Newsgroups")) - -(defun message-goto-keywords () - "Move point to the Keywords header." - (interactive) - (message-position-on-field "Keywords" "Subject")) - -(defun message-goto-summary () - "Move point to the Summary header." - (interactive) - (message-position-on-field "Summary" "Subject")) - -(defun message-goto-body () - "Move point to the beginning of the message body." - (interactive) - (if (looking-at "[ \t]*\n") (expand-abbrev)) - (goto-char (point-min)) - (search-forward (concat "\n" mail-header-separator "\n") nil t)) - -(defun message-goto-signature () - "Move point to the beginning of the message signature." - (interactive) - (goto-char (point-min)) - (if (re-search-forward message-signature-separator nil t) - (forward-line 1) - (goto-char (point-max)))) - - - -(defun message-insert-to (&optional force) - "Insert a To header that points to the author of the article being replied to. -If the original author requested not to be sent mail, the function signals -an error. -With the prefix argument FORCE, insert the header anyway." - (interactive "P") - (let ((co (message-fetch-reply-field "mail-copies-to"))) - (when (and (null force) - co - (equal (downcase co) "never")) - (error "The user has requested not to have copies sent via mail"))) - (when (and (message-position-on-field "To") - (mail-fetch-field "to") - (not (string-match "\\` *\\'" (mail-fetch-field "to")))) - (insert ", ")) - (insert (or (message-fetch-reply-field "reply-to") - (message-fetch-reply-field "from") ""))) - -(defun message-insert-newsgroups () - "Insert the Newsgroups header from the article being replied to." - (interactive) - (when (and (message-position-on-field "Newsgroups") - (mail-fetch-field "newsgroups") - (not (string-match "\\` *\\'" (mail-fetch-field "newsgroups")))) - (insert ",")) - (insert (or (message-fetch-reply-field "newsgroups") ""))) - - - -;;; Various commands - -(defun message-insert-signature (&optional force) - "Insert a signature. See documentation for the `message-signature' variable." - (interactive (list 0)) - (let* ((signature - (cond - ((and (null message-signature) - (eq force 0)) - (save-excursion - (goto-char (point-max)) - (not (re-search-backward - message-signature-separator nil t)))) - ((and (null message-signature) - force) - t) - ((message-functionp message-signature) - (funcall message-signature)) - ((listp message-signature) - (eval message-signature)) - (t message-signature))) - (signature - (cond ((stringp signature) - signature) - ((and (eq t signature) - message-signature-file - (file-exists-p message-signature-file)) - signature)))) - (when signature - (goto-char (point-max)) - ;; Insert the signature. - (unless (bolp) - (insert "\n")) - (insert "\n-- \n") - (if (eq signature t) - (insert-file-contents message-signature-file) - (insert signature)) - (goto-char (point-max)) - (or (bolp) (insert "\n"))))) - -(defun message-elide-region (b e) - "Elide the text between point and mark. An ellipsis (from -message-elide-elipsis) will be inserted where the text was killed." - (interactive "r") - (kill-region b e) - (unless (bolp) - (insert "\n")) - (insert message-elide-elipsis)) - -(defvar message-caesar-translation-table nil) - -(defun message-caesar-region (b e &optional n) - "Caesar rotation of region by N, default 13, for decrypting netnews." - (interactive - (list - (min (point) (or (mark t) (point))) - (max (point) (or (mark t) (point))) - (when current-prefix-arg - (prefix-numeric-value current-prefix-arg)))) - - (setq n (if (numberp n) (mod n 26) 13)) ;canonize N - (unless (or (zerop n) ; no action needed for a rot of 0 - (= b e)) ; no region to rotate - ;; We build the table, if necessary. - (when (or (not message-caesar-translation-table) - (/= (aref message-caesar-translation-table ?a) (+ ?a n))) - (setq message-caesar-translation-table - (message-make-caesar-translation-table n))) - ;; Then we translate the region. Do it this way to retain - ;; text properties. - (while (< b e) - (subst-char-in-region - b (1+ b) (char-after b) - (aref message-caesar-translation-table (char-after b))) - (incf b)))) - -(defun message-make-caesar-translation-table (n) - "Create a rot table with offset N." - (let ((i -1) - (table (make-string 256 0))) - (while (< (incf i) 256) - (aset table i i)) - (concat - (substring table 0 ?A) - (substring table (+ ?A n) (+ ?A n (- 26 n))) - (substring table ?A (+ ?A n)) - (substring table (+ ?A 26) ?a) - (substring table (+ ?a n) (+ ?a n (- 26 n))) - (substring table ?a (+ ?a n)) - (substring table (+ ?a 26) 255)))) - -(defun message-caesar-buffer-body (&optional rotnum) - "Caesar rotates all letters in the current buffer by 13 places. -Used to encode/decode possibly offensive messages (commonly in net.jokes). -With prefix arg, specifies the number of places to rotate each letter forward. -Mail and USENET news headers are not rotated." - (interactive (if current-prefix-arg - (list (prefix-numeric-value current-prefix-arg)) - (list nil))) - (save-excursion - (save-restriction - (when (message-goto-body) - (narrow-to-region (point) (point-max))) - (message-caesar-region (point-min) (point-max) rotnum)))) - -(defun message-pipe-buffer-body (program) - "Pipe the message body in the current buffer through PROGRAM." - (save-excursion - (save-restriction - (when (message-goto-body) - (narrow-to-region (point) (point-max))) - (let ((body (buffer-substring (point-min) (point-max)))) - (unless (equal 0 (call-process-region - (point-min) (point-max) program t t)) - (insert body) - (message "%s failed." program)))))) - -(defun message-rename-buffer (&optional enter-string) - "Rename the *message* buffer to \"*message* RECIPIENT\". -If the function is run with a prefix, it will ask for a new buffer -name, rather than giving an automatic name." - (interactive "Pbuffer name: ") - (save-excursion - (save-restriction - (goto-char (point-min)) - (narrow-to-region (point) - (search-forward mail-header-separator nil 'end)) - (let* ((mail-to (or - (if (message-news-p) (message-fetch-field "Newsgroups") - (message-fetch-field "To")) - "")) - (mail-trimmed-to - (if (string-match "," mail-to) - (concat (substring mail-to 0 (match-beginning 0)) ", ...") - mail-to)) - (name-default (concat "*message* " mail-trimmed-to)) - (name (if enter-string - (read-string "New buffer name: " name-default) - name-default)) - (default-directory - (file-name-as-directory message-autosave-directory))) - (rename-buffer name t))))) - -(defun message-fill-yanked-message (&optional justifyp) - "Fill the paragraphs of a message yanked into this one. -Numeric argument means justify as well." - (interactive "P") - (save-excursion - (goto-char (point-min)) - (search-forward (concat "\n" mail-header-separator "\n") nil t) - (let ((fill-prefix message-yank-prefix)) - (fill-individual-paragraphs (point) (point-max) justifyp t)))) - -(defun message-indent-citation () - "Modify text just inserted from a message to be cited. -The inserted text should be the region. -When this function returns, the region is again around the modified text. - -Normally, indent each nonblank line `message-indentation-spaces' spaces. -However, if `message-yank-prefix' is non-nil, insert that prefix on each line." - (let ((start (point))) - ;; Remove unwanted headers. - (when message-ignored-cited-headers - (let (all-removed) - (save-restriction - (narrow-to-region - (goto-char start) - (if (search-forward "\n\n" nil t) - (1- (point)) - (point))) - (message-remove-header message-ignored-cited-headers t) - (when (= (point-min) (point-max)) - (setq all-removed t)) - (goto-char (point-max))) - (if all-removed - (goto-char start) - (forward-line 1)))) - ;; Delete blank lines at the start of the buffer. - (while (and (point-min) - (eolp) - (not (eobp))) - (message-delete-line)) - ;; Delete blank lines at the end of the buffer. - (goto-char (point-max)) - (unless (eolp) - (insert "\n")) - (while (and (zerop (forward-line -1)) - (looking-at "$")) - (message-delete-line)) - ;; Do the indentation. - (if (null message-yank-prefix) - (indent-rigidly start (mark t) message-indentation-spaces) - (save-excursion - (goto-char start) - (while (< (point) (mark t)) - (insert message-yank-prefix) - (forward-line 1)))) - (goto-char start))) - -(defun message-yank-original (&optional arg) - "Insert the message being replied to, if any. -Puts point before the text and mark after. -Normally indents each nonblank line ARG spaces (default 3). However, -if `message-yank-prefix' is non-nil, insert that prefix on each line. - -This function uses `message-cite-function' to do the actual citing. - -Just \\[universal-argument] as argument means don't indent, insert no -prefix, and don't delete any headers." - (interactive "P") - (let ((modified (buffer-modified-p))) - (when (and message-reply-buffer - message-cite-function) - (delete-windows-on message-reply-buffer t) - (insert-buffer message-reply-buffer) - (funcall message-cite-function) - (message-exchange-point-and-mark) - (unless (bolp) - (insert ?\n)) - (unless modified - (setq message-checksum (cons (message-checksum) (buffer-size))))))) - -(defun message-cite-original () - "Cite function in the standard Message manner." - (let ((start (point)) - (functions - (when message-indent-citation-function - (if (listp message-indent-citation-function) - message-indent-citation-function - (list message-indent-citation-function))))) - (goto-char start) - (while functions - (funcall (pop functions))) - (when message-citation-line-function - (unless (bolp) - (insert "\n")) - (funcall message-citation-line-function)))) - -(defun message-insert-citation-line () - "Function that inserts a simple citation line." - (when message-reply-headers - (insert (mail-header-from message-reply-headers) " writes:\n\n"))) - -(defun message-position-on-field (header &rest afters) - (let ((case-fold-search t)) - (save-restriction - (narrow-to-region - (goto-char (point-min)) - (progn - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (match-beginning 0))) - (goto-char (point-min)) - (if (re-search-forward (concat "^" (regexp-quote header) ":") nil t) - (progn - (re-search-forward "^[^ \t]" nil 'move) - (beginning-of-line) - (skip-chars-backward "\n") - t) - (while (and afters - (not (re-search-forward - (concat "^" (regexp-quote (car afters)) ":") - nil t))) - (pop afters)) - (when afters - (re-search-forward "^[^ \t]" nil 'move) - (beginning-of-line)) - (insert header ": \n") - (forward-char -1) - nil)))) - -(defun message-remove-signature () - "Remove the signature from the text between point and mark. -The text will also be indented the normal way." - (save-excursion - (let ((start (point)) - mark) - (if (not (re-search-forward message-signature-separator (mark t) t)) - ;; No signature here, so we just indent the cited text. - (message-indent-citation) - ;; Find the last non-empty line. - (forward-line -1) - (while (looking-at "[ \t]*$") - (forward-line -1)) - (forward-line 1) - (setq mark (set-marker (make-marker) (point))) - (goto-char start) - (message-indent-citation) - ;; Enable undoing the deletion. - (undo-boundary) - (delete-region mark (mark t)) - (set-marker mark nil))))) - - - -;;; -;;; Sending messages -;;; - -(defun message-send-and-exit (&optional arg) - "Send message like `message-send', then, if no errors, exit from mail buffer." - (interactive "P") - (let ((buf (current-buffer)) - (actions message-exit-actions)) - (when (and (message-send arg) - (buffer-name buf)) - (if message-kill-buffer-on-exit - (kill-buffer buf) - (bury-buffer buf) - (when (eq buf (current-buffer)) - (message-bury buf))) - (message-do-actions actions)))) - -(defun message-dont-send () - "Don't send the message you have been editing." - (interactive) - (let ((actions message-postpone-actions)) - (message-bury (current-buffer)) - (message-do-actions actions))) - -(defun message-kill-buffer () - "Kill the current buffer." - (interactive) - (when (or (not (buffer-modified-p)) - (yes-or-no-p "Message modified; kill anyway? ")) - (let ((actions message-kill-actions)) - (kill-buffer (current-buffer)) - (message-do-actions actions)))) - -(defun message-bury (buffer) - "Bury this mail buffer." - (let ((newbuf (other-buffer buffer))) - (bury-buffer buffer) - (if (and (fboundp 'frame-parameters) - (cdr (assq 'dedicated (frame-parameters))) - (not (null (delq (selected-frame) (visible-frame-list))))) - (delete-frame (selected-frame)) - (switch-to-buffer newbuf)))) - -(defun message-send (&optional arg) - "Send the message in the current buffer. -If `message-interactive' is non-nil, wait for success indication -or error messages, and inform user. -Otherwise any failure is reported in a message back to -the user from the mailer." - (interactive "P") - (when (if buffer-file-name - (y-or-n-p (format "Send buffer contents as %s message? " - (if (message-mail-p) - (if (message-news-p) "mail and news" "mail") - "news"))) - (or (buffer-modified-p) - (y-or-n-p "No changes in the buffer; really send? "))) - ;; Make it possible to undo the coming changes. - (undo-boundary) - (let ((inhibit-read-only t)) - (put-text-property (point-min) (point-max) 'read-only nil)) - (message-fix-before-sending) - (run-hooks 'message-send-hook) - (message "Sending...") - (let ((alist message-send-method-alist) - (success t) - elem sent) - (while (and success - (setq elem (pop alist))) - (when (and (or (not (funcall (cadr elem))) - (and (or (not (memq (car elem) - message-sent-message-via)) - (y-or-n-p - (format - "Already sent message via %s; resend? " - (car elem)))) - (setq success (funcall (caddr elem) arg))))) - (setq sent t))) - (when (and success sent) - (message-do-fcc) - ;;(when (fboundp 'mail-hist-put-headers-into-history) - ;; (mail-hist-put-headers-into-history)) - (run-hooks 'message-sent-hook) - (message "Sending...done") - ;; If buffer has no file, mark it as unmodified and delete autosave. - (unless buffer-file-name - (set-buffer-modified-p nil) - (delete-auto-save-file-if-necessary t)) - ;; Delete other mail buffers and stuff. - (message-do-send-housekeeping) - (message-do-actions message-send-actions) - ;; Return success. - t)))) - -(defun message-send-via-mail (arg) - "Send the current message via mail." - (message-send-mail arg)) - -(defun message-send-via-news (arg) - "Send the current message via news." - (funcall message-send-news-function arg)) - -(defun message-fix-before-sending () - "Do various things to make the message nice before sending it." - ;; Make sure there's a newline at the end of the message. - (goto-char (point-max)) - (unless (bolp) - (insert "\n"))) - -(defun message-add-action (action &rest types) - "Add ACTION to be performed when doing an exit of type TYPES." - (let (var) - (while types - (set (setq var (intern (format "message-%s-actions" (pop types)))) - (nconc (symbol-value var) (list action)))))) - -(defun message-do-actions (actions) - "Perform all actions in ACTIONS." - ;; Now perform actions on successful sending. - (while actions - (ignore-errors - (cond - ;; A simple function. - ((message-functionp (car actions)) - (funcall (car actions))) - ;; Something to be evaled. - (t - (eval (car actions))))) - (pop actions))) - -(defun message-send-mail (&optional arg) - (require 'mail-utils) - (let ((tembuf (message-generate-new-buffer-clone-locals " message temp")) - (case-fold-search nil) - (news (message-news-p)) - (mailbuf (current-buffer))) - (save-restriction - (message-narrow-to-headers) - ;; Insert some headers. - (let ((message-deletable-headers - (if news nil message-deletable-headers))) - (message-generate-headers message-required-mail-headers)) - ;; Let the user do all of the above. - (run-hooks 'message-header-hook)) - (unwind-protect - (save-excursion - (set-buffer tembuf) - (erase-buffer) - ;; Avoid copying text props. - (insert (format - "%s" (save-excursion - (set-buffer mailbuf) - (buffer-string)))) - ;; Remove some headers. - (save-restriction - (message-narrow-to-headers) - ;; Remove some headers. - (message-remove-header message-ignored-mail-headers t)) - (goto-char (point-max)) - ;; require one newline at the end. - (or (= (preceding-char) ?\n) - (insert ?\n)) - (when (and news - (or (message-fetch-field "cc") - (message-fetch-field "to"))) - (message-insert-courtesy-copy)) - (funcall message-send-mail-function)) - (kill-buffer tembuf)) - (set-buffer mailbuf) - (push 'mail message-sent-message-via))) - -(defun message-send-mail-with-sendmail () - "Send off the prepared buffer with sendmail." - (let ((errbuf (if message-interactive - (generate-new-buffer " sendmail errors") - 0)) - resend-to-addresses delimline) - (let ((case-fold-search t)) - (save-restriction - (message-narrow-to-headers) - (setq resend-to-addresses (message-fetch-field "resent-to"))) - ;; Change header-delimiter to be what sendmail expects. - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (replace-match "\n") - (backward-char 1) - (setq delimline (point-marker)) - (run-hooks 'message-send-mail-hook) - ;; Insert an extra newline if we need it to work around - ;; Sun's bug that swallows newlines. - (goto-char (1+ delimline)) - (when (eval message-mailer-swallows-blank-line) - (newline)) - (when message-interactive - (save-excursion - (set-buffer errbuf) - (erase-buffer)))) - (let ((default-directory "/")) - (apply 'call-process-region - (append (list (point-min) (point-max) - (if (boundp 'sendmail-program) - sendmail-program - "/usr/lib/sendmail") - nil errbuf nil "-oi") - ;; Always specify who from, - ;; since some systems have broken sendmails. - ;; But some systems are more broken with -f, so - ;; we'll let users override this. - (if (null message-sendmail-f-is-evil) - (list "-f" (user-login-name))) - ;; These mean "report errors by mail" - ;; and "deliver in background". - (if (null message-interactive) '("-oem" "-odb")) - ;; Get the addresses from the message - ;; unless this is a resend. - ;; We must not do that for a resend - ;; because we would find the original addresses. - ;; For a resend, include the specific addresses. - (if resend-to-addresses - (list resend-to-addresses) - '("-t"))))) - (when message-interactive - (save-excursion - (set-buffer errbuf) - (goto-char (point-min)) - (while (re-search-forward "\n\n* *" nil t) - (replace-match "; ")) - (if (not (zerop (buffer-size))) - (error "Sending...failed to %s" - (buffer-substring (point-min) (point-max))))) - (when (bufferp errbuf) - (kill-buffer errbuf))))) - -(defun message-send-mail-with-qmail () - "Pass the prepared message buffer to qmail-inject. -Refer to the documentation for the variable `message-send-mail-function' -to find out how to use this." - ;; replace the header delimiter with a blank line - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (replace-match "\n") - (run-hooks 'message-send-mail-hook) - ;; send the message - (case - (apply - 'call-process-region 1 (point-max) message-qmail-inject-program - nil nil nil - ;; qmail-inject's default behaviour is to look for addresses on the - ;; command line; if there're none, it scans the headers. - ;; yes, it does The Right Thing w.r.t. Resent-To and it's kin. - ;; - ;; in general, ALL of qmail-inject's defaults are perfect for simply - ;; reading a formatted (i. e., at least a To: or Resent-To header) - ;; message from stdin. - ;; - ;; qmail also has the advantage of not having been raped by - ;; various vendors, so we don't have to allow for that, either -- - ;; compare this with message-send-mail-with-sendmail and weep - ;; for sendmail's lost innocence. - ;; - ;; all this is way cool coz it lets us keep the arguments entirely - ;; free for -inject-arguments -- a big win for the user and for us - ;; since we don't have to play that double-guessing game and the user - ;; gets full control (no gestapo'ish -f's, for instance). --sj - message-qmail-inject-args) - ;; qmail-inject doesn't say anything on it's stdout/stderr, - ;; we have to look at the retval instead - (0 nil) - (1 (error "qmail-inject reported permanent failure")) - (111 (error "qmail-inject reported transient failure")) - ;; should never happen - (t (error "qmail-inject reported unknown failure")))) - -(defun message-send-mail-with-mh () - "Send the prepared message buffer with mh." - (let ((mh-previous-window-config nil) - (name (make-temp-name - (concat (file-name-as-directory - (expand-file-name message-autosave-directory)) - "msg.")))) - (setq buffer-file-name name) - ;; MH wants to generate these headers itself. - (when message-mh-deletable-headers - (let ((headers message-mh-deletable-headers)) - (while headers - (goto-char (point-min)) - (and (re-search-forward - (concat "^" (symbol-name (car headers)) ": *") nil t) - (message-delete-line)) - (pop headers)))) - (run-hooks 'message-send-mail-hook) - ;; Pass it on to mh. - (mh-send-letter))) - -(defun message-send-news (&optional arg) - (let ((tembuf (message-generate-new-buffer-clone-locals " *message temp*")) - (case-fold-search nil) - (method (if (message-functionp message-post-method) - (funcall message-post-method arg) - message-post-method)) - (messbuf (current-buffer)) - (message-syntax-checks - (if arg - (cons '(existing-newsgroups . disabled) - message-syntax-checks) - message-syntax-checks)) - result) - (save-restriction - (message-narrow-to-headers) - ;; Insert some headers. - (message-generate-headers message-required-news-headers) - ;; Let the user do all of the above. - (run-hooks 'message-header-hook)) - (message-cleanup-headers) - (if (not (message-check-news-syntax)) - (progn - ;;(message "Posting not performed") - nil) - (unwind-protect - (save-excursion - (set-buffer tembuf) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - ;; Avoid copying text props. - (insert (format - "%s" (save-excursion - (set-buffer messbuf) - (buffer-string)))) - ;; Remove some headers. - (save-restriction - (message-narrow-to-headers) - ;; Remove some headers. - (message-remove-header message-ignored-news-headers t)) - (goto-char (point-max)) - ;; require one newline at the end. - (or (= (preceding-char) ?\n) - (insert ?\n)) - (let ((case-fold-search t)) - ;; Remove the delimiter. - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (replace-match "\n") - (backward-char 1)) - (run-hooks 'message-send-news-hook) - (require (car method)) - (funcall (intern (format "%s-open-server" (car method))) - (cadr method) (cddr method)) - (setq result - (funcall (intern (format "%s-request-post" (car method))) - (cadr method)))) - (kill-buffer tembuf)) - (set-buffer messbuf) - (if result - (push 'news message-sent-message-via) - (message "Couldn't send message via news: %s" - (nnheader-get-report (car method))) - nil)))) - -;;; -;;; Header generation & syntax checking. -;;; - -(defmacro message-check (type &rest forms) - "Eval FORMS if TYPE is to be checked." - `(or (message-check-element ,type) - (save-excursion - ,@forms))) - -(put 'message-check 'lisp-indent-function 1) -(put 'message-check 'edebug-form-spec '(form body)) - -(defun message-check-element (type) - "Returns non-nil if this type is not to be checked." - (if (eq message-syntax-checks 'dont-check-for-anything-just-trust-me) - t - (let ((able (assq type message-syntax-checks))) - (and (consp able) - (eq (cdr able) 'disabled))))) - -(defun message-check-news-syntax () - "Check the syntax of the message." - (save-excursion - (save-restriction - (widen) - (and - ;; We narrow to the headers and check them first. - (save-excursion - (save-restriction - (message-narrow-to-headers) - (message-check-news-header-syntax))) - ;; Check the body. - (message-check-news-body-syntax))))) - -(defun message-check-news-header-syntax () - (and - ;; Check the Subject header. - (message-check 'subject - (let* ((case-fold-search t) - (subject (message-fetch-field "subject"))) - (or - (and subject - (not (string-match "\\`[ \t]*\\'" subject))) - (ignore - (message - "The subject field is empty or missing. Posting is denied."))))) - ;; Check for commands in Subject. - (message-check 'subject-cmsg - (if (string-match "^cmsg " (message-fetch-field "subject")) - (y-or-n-p - "The control code \"cmsg\" is in the subject. Really post? ") - t)) - ;; Check for multiple identical headers. - (message-check 'multiple-headers - (let (found) - (while (and (not found) - (re-search-forward "^[^ \t:]+: " nil t)) - (save-excursion - (or (re-search-forward - (concat "^" - (regexp-quote - (setq found - (buffer-substring - (match-beginning 0) (- (match-end 0) 2)))) - ":") - nil t) - (setq found nil)))) - (if found - (y-or-n-p (format "Multiple %s headers. Really post? " found)) - t))) - ;; Check for Version and Sendsys. - (message-check 'sendsys - (if (re-search-forward "^Sendsys:\\|^Version:" nil t) - (y-or-n-p - (format "The article contains a %s command. Really post? " - (buffer-substring (match-beginning 0) - (1- (match-end 0))))) - t)) - ;; See whether we can shorten Followup-To. - (message-check 'shorten-followup-to - (let ((newsgroups (message-fetch-field "newsgroups")) - (followup-to (message-fetch-field "followup-to")) - to) - (when (and newsgroups - (string-match "," newsgroups) - (not followup-to) - (not - (zerop - (length - (setq to (completing-read - "Followups to: (default all groups) " - (mapcar (lambda (g) (list g)) - (cons "poster" - (message-tokenize-header - newsgroups))))))))) - (goto-char (point-min)) - (insert "Followup-To: " to "\n")) - t)) - ;; Check "Shoot me". - (message-check 'shoot - (if (re-search-forward - "Message-ID.*.i-did-not-set--mail-host-address--so-shoot-me" nil t) - (y-or-n-p "You appear to have a misconfigured system. Really post? ") - t)) - ;; Check for Approved. - (message-check 'approved - (if (re-search-forward "^Approved:" nil t) - (y-or-n-p "The article contains an Approved header. Really post? ") - t)) - ;; Check the Message-ID header. - (message-check 'message-id - (let* ((case-fold-search t) - (message-id (message-fetch-field "message-id" t))) - (or (not message-id) - (and (string-match "@" message-id) - (string-match "@[^\\.]*\\." message-id)) - (y-or-n-p - (format "The Message-ID looks strange: \"%s\". Really post? " - message-id))))) - ;; Check the Newsgroups & Followup-To headers. - (message-check 'existing-newsgroups - (let* ((case-fold-search t) - (newsgroups (message-fetch-field "newsgroups")) - (followup-to (message-fetch-field "followup-to")) - (groups (message-tokenize-header - (if followup-to - (concat newsgroups "," followup-to) - newsgroups))) - (hashtb (and (boundp 'gnus-active-hashtb) - gnus-active-hashtb)) - errors) - (if (or (not hashtb) - (not (boundp 'gnus-read-active-file)) - (not gnus-read-active-file) - (eq gnus-read-active-file 'some)) - t - (while groups - (when (and (not (boundp (intern (car groups) hashtb))) - (not (equal (car groups) "poster"))) - (push (car groups) errors)) - (pop groups)) - (if (not errors) - t - (y-or-n-p - (format - "Really post to %s unknown group%s: %s " - (if (= (length errors) 1) "this" "these") - (if (= (length errors) 1) "" "s") - (mapconcat 'identity errors ", "))))))) - ;; Check the Newsgroups & Followup-To headers for syntax errors. - (message-check 'valid-newsgroups - (let ((case-fold-search t) - (headers '("Newsgroups" "Followup-To")) - header error) - (while (and headers (not error)) - (when (setq header (mail-fetch-field (car headers))) - (if (or - (not - (string-match - "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-+_&.a-zA-Z0-9]+\\)*\\'" - header)) - (memq - nil (mapcar - (lambda (g) - (not (string-match "\\.\\'\\|\\.\\." g))) - (message-tokenize-header header ",")))) - (setq error t))) - (unless error - (pop headers))) - (if (not error) - t - (y-or-n-p - (format "The %s header looks odd: \"%s\". Really post? " - (car headers) header))))) - (message-check 'repeated-newsgroups - (let ((case-fold-search t) - (headers '("Newsgroups" "Followup-To")) - header error groups group) - (while (and headers - (not error)) - (when (setq header (mail-fetch-field (pop headers))) - (setq groups (message-tokenize-header header ",")) - (while (setq group (pop groups)) - (when (member group groups) - (setq error group - groups nil))))) - (if (not error) - t - (y-or-n-p - (format "Group %s is repeated in headers. Really post? " error))))) - ;; Check the From header. - (message-check 'from - (let* ((case-fold-search t) - (from (message-fetch-field "from")) - (ad (nth 1 (mail-extract-address-components from)))) - (cond - ((not from) - (message "There is no From line. Posting is denied.") - nil) - ((or (not (string-match "@[^\\.]*\\." ad)) ;larsi@ifi - (string-match "\\.\\." ad) ;larsi@ifi..uio - (string-match "@\\." ad) ;larsi@.ifi.uio - (string-match "\\.$" ad) ;larsi@ifi.uio. - (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio - (string-match "(.*).*(.*)" from)) ;(lars) (lars) - (message - "Denied posting -- the From looks strange: \"%s\"." from) - nil) - (t t)))))) - -(defun message-check-news-body-syntax () - (and - ;; Check for long lines. - (message-check 'long-lines - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (while (and - (progn - (end-of-line) - (< (current-column) 80)) - (zerop (forward-line 1)))) - (or (bolp) - (eobp) - (y-or-n-p - "You have lines longer than 79 characters. Really post? "))) - ;; Check whether the article is empty. - (message-check 'empty - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line 1) - (let ((b (point))) - (goto-char (point-max)) - (re-search-backward message-signature-separator nil t) - (beginning-of-line) - (or (re-search-backward "[^ \n\t]" b t) - (y-or-n-p "Empty article. Really post? ")))) - ;; Check for control characters. - (message-check 'control-chars - (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t) - (y-or-n-p - "The article contains control characters. Really post? ") - t)) - ;; Check excessive size. - (message-check 'size - (if (> (buffer-size) 60000) - (y-or-n-p - (format "The article is %d octets long. Really post? " - (buffer-size))) - t)) - ;; Check whether any new text has been added. - (message-check 'new-text - (or - (not message-checksum) - (not (and (eq (message-checksum) (car message-checksum)) - (eq (buffer-size) (cdr message-checksum)))) - (y-or-n-p - "It looks like no new text has been added. Really post? "))) - ;; Check the length of the signature. - (message-check 'signature - (goto-char (point-max)) - (if (or (not (re-search-backward message-signature-separator nil t)) - (search-forward message-forward-end-separator nil t)) - t - (if (> (count-lines (point) (point-max)) 5) - (y-or-n-p - (format - "Your .sig is %d lines; it should be max 4. Really post? " - (1- (count-lines (point) (point-max))))) - t))))) - -(defun message-checksum () - "Return a \"checksum\" for the current buffer." - (let ((sum 0)) - (save-excursion - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (while (not (eobp)) - (when (not (looking-at "[ \t\n]")) - (setq sum (logxor (ash sum 1) (if (natnump sum) 0 1) - (following-char)))) - (forward-char 1))) - sum)) - -(defun message-do-fcc () - "Process Fcc headers in the current buffer." - (let ((case-fold-search t) - (buf (current-buffer)) - list file) - (save-excursion - (set-buffer (get-buffer-create " *message temp*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert-buffer-substring buf) - (save-restriction - (message-narrow-to-headers) - (while (setq file (message-fetch-field "fcc")) - (push file list) - (message-remove-header "fcc" nil t))) - (goto-char (point-min)) - (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) - (replace-match "" t t) - ;; Process FCC operations. - (while list - (setq file (pop list)) - (if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file) - ;; Pipe the article to the program in question. - (call-process-region (point-min) (point-max) shell-file-name - nil nil nil shell-command-switch - (match-string 1 file)) - ;; Save the article. - (setq file (expand-file-name file)) - (unless (file-exists-p (file-name-directory file)) - (make-directory (file-name-directory file) t)) - (if (and message-fcc-handler-function - (not (eq message-fcc-handler-function 'rmail-output))) - (funcall message-fcc-handler-function file) - (if (and (file-readable-p file) (mail-file-babyl-p file)) - (rmail-output file 1 nil t) - (let ((mail-use-rfc822 t)) - (rmail-output file 1 t t)))))) - - (kill-buffer (current-buffer))))) - -(defun message-output (filename) - "Append this article to Unix/babyl mail file.." - (if (and (file-readable-p filename) - (mail-file-babyl-p filename)) - (gnus-output-to-rmail filename t) - (gnus-output-to-mail filename t))) - -(defun message-cleanup-headers () - "Do various automatic cleanups of the headers." - ;; Remove empty lines in the header. - (save-restriction - (message-narrow-to-headers) - (while (re-search-forward "^[ \t]*\n" nil t) - (replace-match "" t t))) - - ;; Correct Newsgroups and Followup-To headers: change sequence of - ;; spaces to comma and eliminate spaces around commas. Eliminate - ;; embedded line breaks. - (goto-char (point-min)) - (while (re-search-forward "^\\(Newsgroups\\|Followup-To\\): +" nil t) - (save-restriction - (narrow-to-region - (point) - (if (re-search-forward "^[^ \t]" nil t) - (match-beginning 0) - (forward-line 1) - (point))) - (goto-char (point-min)) - (while (re-search-forward "\n[ \t]+" nil t) - (replace-match " " t t)) ;No line breaks (too confusing) - (goto-char (point-min)) - (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t) - (replace-match "," t t)) - (goto-char (point-min)) - ;; Remove trailing commas. - (when (re-search-forward ",+$" nil t) - (replace-match "" t t))))) - -(defun message-make-date () - "Make a valid data header." - (let ((now (current-time))) - (timezone-make-date-arpa-standard - (current-time-string now) (current-time-zone now)))) - -(defun message-make-message-id () - "Make a unique Message-ID." - (concat "<" (message-unique-id) - (let ((psubject (save-excursion (message-fetch-field "subject")))) - (if (and message-reply-headers - (mail-header-references message-reply-headers) - (mail-header-subject message-reply-headers) - psubject - (mail-header-subject message-reply-headers) - (not (string= - (message-strip-subject-re - (mail-header-subject message-reply-headers)) - (message-strip-subject-re psubject)))) - "_-_" "")) - "@" (message-make-fqdn) ">")) - -(defvar message-unique-id-char nil) - -;; If you ever change this function, make sure the new version -;; cannot generate IDs that the old version could. -;; You might for example insert a "." somewhere (not next to another dot -;; or string boundary), or modify the "fsf" string. -(defun message-unique-id () - ;; Don't use microseconds from (current-time), they may be unsupported. - ;; Instead we use this randomly inited counter. - (setq message-unique-id-char - (% (1+ (or message-unique-id-char (logand (random t) (1- (lsh 1 20))))) - ;; (current-time) returns 16-bit ints, - ;; and 2^16*25 just fits into 4 digits i base 36. - (* 25 25))) - (let ((tm (current-time))) - (concat - (if (memq system-type '(ms-dos emx vax-vms)) - (let ((user (downcase (user-login-name)))) - (while (string-match "[^a-z0-9_]" user) - (aset user (match-beginning 0) ?_)) - user) - (message-number-base36 (user-uid) -1)) - (message-number-base36 (+ (car tm) - (lsh (% message-unique-id-char 25) 16)) 4) - (message-number-base36 (+ (nth 1 tm) - (lsh (/ message-unique-id-char 25) 16)) 4) - ;; Append the newsreader name, because while the generated - ;; ID is unique to this newsreader, other newsreaders might - ;; otherwise generate the same ID via another algorithm. - ".fsf"))) - -(defun message-number-base36 (num len) - (if (if (< len 0) - (<= num 0) - (= len 0)) - "" - (concat (message-number-base36 (/ num 36) (1- len)) - (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210" - (% num 36)))))) - -(defun message-make-organization () - "Make an Organization header." - (let* ((organization - (or (getenv "ORGANIZATION") - (when message-user-organization - (if (message-functionp message-user-organization) - (funcall message-user-organization) - message-user-organization))))) - (save-excursion - (message-set-work-buffer) - (cond ((stringp organization) - (insert organization)) - ((and (eq t organization) - message-user-organization-file - (file-exists-p message-user-organization-file)) - (insert-file-contents message-user-organization-file))) - (goto-char (point-min)) - (while (re-search-forward "[\t\n]+" nil t) - (replace-match "" t t)) - (unless (zerop (buffer-size)) - (buffer-string))))) - -(defun message-make-lines () - "Count the number of lines and return numeric string." - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "$")) - (forward-line 1) - (int-to-string (count-lines (point) (point-max)))))) - -(defun message-make-in-reply-to () - "Return the In-Reply-To header for this message." - (when message-reply-headers - (let ((from (mail-header-from message-reply-headers)) - (date (mail-header-date message-reply-headers))) - (when from - (let ((stop-pos - (string-match " *at \\| *@ \\| *(\\| *<" from))) - (concat (if stop-pos (substring from 0 stop-pos) from) - "'s message of \"" - (if (or (not date) (string= date "")) - "(unknown date)" date) - "\"")))))) - -(defun message-make-distribution () - "Make a Distribution header." - (let ((orig-distribution (message-fetch-reply-field "distribution"))) - (cond ((message-functionp message-distribution-function) - (funcall message-distribution-function)) - (t orig-distribution)))) - -(defun message-make-expires () - "Return an Expires header based on `message-expires'." - (let ((current (current-time)) - (future (* 1.0 message-expires 60 60 24))) - ;; Add the future to current. - (setcar current (+ (car current) (round (/ future (expt 2 16))))) - (setcar (cdr current) (+ (nth 1 current) (% (round future) (expt 2 16)))) - ;; Return the date in the future in UT. - (timezone-make-date-arpa-standard - (current-time-string current) (current-time-zone current) '(0 "UT")))) - -(defun message-make-path () - "Return uucp path." - (let ((login-name (user-login-name))) - (cond ((null message-user-path) - (concat (system-name) "!" login-name)) - ((stringp message-user-path) - ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com. - (concat message-user-path "!" login-name)) - (t login-name)))) - -(defun message-make-from () - "Make a From header." - (let* ((style message-from-style) - (login (message-make-address)) - (fullname - (or (and (boundp 'user-full-name) - user-full-name) - (user-full-name)))) - (when (string= fullname "&") - (setq fullname (user-login-name))) - (save-excursion - (message-set-work-buffer) - (cond - ((or (null style) - (equal fullname "")) - (insert login)) - ((or (eq style 'angles) - (and (not (eq style 'parens)) - ;; Use angles if no quoting is needed, or if parens would - ;; need quoting too. - (or (not (string-match "[^- !#-'*+/-9=?A-Z^-~]" fullname)) - (let ((tmp (concat fullname nil))) - (while (string-match "([^()]*)" tmp) - (aset tmp (match-beginning 0) ?-) - (aset tmp (1- (match-end 0)) ?-)) - (string-match "[\\()]" tmp))))) - (insert fullname) - (goto-char (point-min)) - ;; Look for a character that cannot appear unquoted - ;; according to RFC 822. - (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1) - ;; Quote fullname, escaping specials. - (goto-char (point-min)) - (insert "\"") - (while (re-search-forward "[\"\\]" nil 1) - (replace-match "\\\\\\&" t)) - (insert "\"")) - (insert " <" login ">")) - (t ; 'parens or default - (insert login " (") - (let ((fullname-start (point))) - (insert fullname) - (goto-char fullname-start) - ;; RFC 822 says \ and nonmatching parentheses - ;; must be escaped in comments. - ;; Escape every instance of ()\ ... - (while (re-search-forward "[()\\]" nil 1) - (replace-match "\\\\\\&" t)) - ;; ... then undo escaping of matching parentheses, - ;; including matching nested parentheses. - (goto-char fullname-start) - (while (re-search-forward - "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)" - nil 1) - (replace-match "\\1(\\3)" t) - (goto-char fullname-start))) - (insert ")"))) - (buffer-string)))) - -(defun message-make-sender () - "Return the \"real\" user address. -This function tries to ignore all user modifications, and -give as trustworthy answer as possible." - (concat (user-login-name) "@" (system-name))) - -(defun message-make-address () - "Make the address of the user." - (or (message-user-mail-address) - (concat (user-login-name) "@" (message-make-domain)))) - -(defun message-user-mail-address () - "Return the pertinent part of `user-mail-address'." - (when user-mail-address - (if (string-match " " user-mail-address) - (nth 1 (mail-extract-address-components user-mail-address)) - user-mail-address))) - -(defun message-make-fqdn () - "Return user's fully qualified domain name." - (let ((system-name (system-name)) - (user-mail (message-user-mail-address))) - (cond - ((string-match "[^.]\\.[^.]" system-name) - ;; `system-name' returned the right result. - system-name) - ;; Try `mail-host-address'. - ((and (boundp 'mail-host-address) - (stringp mail-host-address) - (string-match "\\." mail-host-address)) - mail-host-address) - ;; We try `user-mail-address' as a backup. - ((and (string-match "\\." user-mail) - (string-match "@\\(.*\\)\\'" user-mail)) - (match-string 1 user-mail)) - ;; Default to this bogus thing. - (t - (concat system-name ".i-did-not-set--mail-host-address--so-shoot-me"))))) - -(defun message-make-host-name () - "Return the name of the host." - (let ((fqdn (message-make-fqdn))) - (string-match "^[^.]+\\." fqdn) - (substring fqdn 0 (1- (match-end 0))))) - -(defun message-make-domain () - "Return the domain name." - (or mail-host-address - (message-make-fqdn))) - -(defun message-generate-headers (headers) - "Prepare article HEADERS. -Headers already prepared in the buffer are not modified." - (save-restriction - (message-narrow-to-headers) - (let* ((Date (message-make-date)) - (Message-ID (message-make-message-id)) - (Organization (message-make-organization)) - (From (message-make-from)) - (Path (message-make-path)) - (Subject nil) - (Newsgroups nil) - (In-Reply-To (message-make-in-reply-to)) - (To nil) - (Distribution (message-make-distribution)) - (Lines (message-make-lines)) - (X-Newsreader message-newsreader) - (X-Mailer (and (not (message-fetch-field "X-Newsreader")) - message-mailer)) - (Expires (message-make-expires)) - (case-fold-search t) - header value elem) - ;; First we remove any old generated headers. - (let ((headers message-deletable-headers)) - (while headers - (goto-char (point-min)) - (and (re-search-forward - (concat "^" (symbol-name (car headers)) ": *") nil t) - (get-text-property (1+ (match-beginning 0)) 'message-deletable) - (message-delete-line)) - (pop headers))) - ;; Go through all the required headers and see if they are in the - ;; articles already. If they are not, or are empty, they are - ;; inserted automatically - except for Subject, Newsgroups and - ;; Distribution. - (while headers - (goto-char (point-min)) - (setq elem (pop headers)) - (if (consp elem) - (if (eq (car elem) 'optional) - (setq header (cdr elem)) - (setq header (car elem))) - (setq header elem)) - (when (or (not (re-search-forward - (concat "^" (downcase (symbol-name header)) ":") - nil t)) - (progn - ;; The header was found. We insert a space after the - ;; colon, if there is none. - (if (/= (following-char) ? ) (insert " ") (forward-char 1)) - ;; Find out whether the header is empty... - (looking-at "[ \t]*$"))) - ;; So we find out what value we should insert. - (setq value - (cond - ((and (consp elem) (eq (car elem) 'optional)) - ;; This is an optional header. If the cdr of this - ;; is something that is nil, then we do not insert - ;; this header. - (setq header (cdr elem)) - (or (and (fboundp (cdr elem)) (funcall (cdr elem))) - (and (boundp (cdr elem)) (symbol-value (cdr elem))))) - ((consp elem) - ;; The element is a cons. Either the cdr is a - ;; string to be inserted verbatim, or it is a - ;; function, and we insert the value returned from - ;; this function. - (or (and (stringp (cdr elem)) (cdr elem)) - (and (fboundp (cdr elem)) (funcall (cdr elem))))) - ((and (boundp header) (symbol-value header)) - ;; The element is a symbol. We insert the value - ;; of this symbol, if any. - (symbol-value header)) - (t - ;; We couldn't generate a value for this header, - ;; so we just ask the user. - (read-from-minibuffer - (format "Empty header for %s; enter value: " header))))) - ;; Finally insert the header. - (when (and value - (not (equal value ""))) - (save-excursion - (if (bolp) - (progn - ;; This header didn't exist, so we insert it. - (goto-char (point-max)) - (insert (symbol-name header) ": " value "\n") - (forward-line -1)) - ;; The value of this header was empty, so we clear - ;; totally and insert the new value. - (delete-region (point) (gnus-point-at-eol)) - (insert value)) - ;; Add the deletable property to the headers that require it. - (and (memq header message-deletable-headers) - (progn (beginning-of-line) (looking-at "[^:]+: ")) - (add-text-properties - (point) (match-end 0) - '(message-deletable t face italic) (current-buffer))))))) - ;; Insert new Sender if the From is strange. - (let ((from (message-fetch-field "from")) - (sender (message-fetch-field "sender")) - (secure-sender (message-make-sender))) - (when (and from - (not (message-check-element 'sender)) - (not (string= - (downcase - (cadr (mail-extract-address-components from))) - (downcase secure-sender))) - (or (null sender) - (not - (string= - (downcase - (cadr (mail-extract-address-components sender))) - (downcase secure-sender))))) - (goto-char (point-min)) - ;; Rename any old Sender headers to Original-Sender. - (when (re-search-forward "^\\(Original-\\)*Sender:" nil t) - (beginning-of-line) - (insert "Original-") - (beginning-of-line)) - (when (or (message-news-p) - (string-match "^[^@]@.+\\..+" secure-sender)) - (insert "Sender: " secure-sender "\n"))))))) - -(defun message-insert-courtesy-copy () - "Insert a courtesy message in mail copies of combined messages." - (let (newsgroups) - (save-excursion - (save-restriction - (message-narrow-to-headers) - (when (setq newsgroups (message-fetch-field "newsgroups")) - (goto-char (point-max)) - (insert "Posted-To: " newsgroups "\n"))) - (forward-line 1) - (when message-courtesy-message - (cond - ((string-match "%s" message-courtesy-message) - (insert (format message-courtesy-message newsgroups))) - (t - (insert message-courtesy-message))))))) - -;;; -;;; Setting up a message buffer -;;; - -(defun message-fill-address (header value) - (save-restriction - (narrow-to-region (point) (point)) - (insert (capitalize (symbol-name header)) - ": " - (if (consp value) (car value) value) - "\n") - (narrow-to-region (point-min) (1- (point-max))) - (let (quoted last) - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward "^,\"" (point-max)) - (if (or (= (following-char) ?,) - (eobp)) - (when (not quoted) - (if (and (> (current-column) 78) - last) - (progn - (save-excursion - (goto-char last) - (insert "\n\t")) - (setq last (1+ (point)))) - (setq last (1+ (point))))) - (setq quoted (not quoted))) - (unless (eobp) - (forward-char 1)))) - (goto-char (point-max)) - (widen) - (forward-line 1))) - -(defun message-fill-header (header value) - (let ((begin (point)) - (fill-column 78) - (fill-prefix "\t")) - (insert (capitalize (symbol-name header)) - ": " - (if (consp value) (car value) value) - "\n") - (save-restriction - (narrow-to-region begin (point)) - (fill-region-as-paragraph begin (point)) - ;; Tapdance around looong Message-IDs. - (forward-line -1) - (when (looking-at "[ \t]*$") - (message-delete-line)) - (goto-char begin) - (re-search-forward ":" nil t) - (when (looking-at "\n[ \t]+") - (replace-match " " t t)) - (goto-char (point-max))))) - -(defun message-position-point () - "Move point to where the user probably wants to find it." - (message-narrow-to-headers) - (cond - ((re-search-forward "^[^:]+:[ \t]*$" nil t) - (search-backward ":" ) - (widen) - (forward-char 1) - (if (= (following-char) ? ) - (forward-char 1) - (insert " "))) - (t - (goto-char (point-max)) - (widen) - (forward-line 1) - (unless (looking-at "$") - (forward-line 2))) - (sit-for 0))) - -(defun message-buffer-name (type &optional to group) - "Return a new (unique) buffer name based on TYPE and TO." - (cond - ;; Check whether `message-generate-new-buffers' is a function, - ;; and if so, call it. - ((message-functionp message-generate-new-buffers) - (funcall message-generate-new-buffers type to group)) - ;; Generate a new buffer name The Message Way. - (message-generate-new-buffers - (generate-new-buffer-name - (concat "*" type - (if to - (concat " to " - (or (car (mail-extract-address-components to)) - to) "") - "") - (if (and group (not (string= group ""))) (concat " on " group) "") - "*"))) - ;; Use standard name. - (t - (format "*%s message*" type)))) - -(defun message-pop-to-buffer (name) - "Pop to buffer NAME, and warn if it already exists and is modified." - (let ((buffer (get-buffer name))) - (if (and buffer - (buffer-name buffer)) - (progn - (set-buffer (pop-to-buffer buffer)) - (when (and (buffer-modified-p) - (not (y-or-n-p - "Message already being composed; erase? "))) - (error "Message being composed"))) - (set-buffer (pop-to-buffer name)))) - (erase-buffer) - (message-mode)) - -(defun message-do-send-housekeeping () - "Kill old message buffers." - ;; We might have sent this buffer already. Delete it from the - ;; list of buffers. - (setq message-buffer-list (delq (current-buffer) message-buffer-list)) - (while (and message-max-buffers - message-buffer-list - (>= (length message-buffer-list) message-max-buffers)) - ;; Kill the oldest buffer -- unless it has been changed. - (let ((buffer (pop message-buffer-list))) - (when (and (buffer-name buffer) - (not (buffer-modified-p buffer))) - (kill-buffer buffer)))) - ;; Rename the buffer. - (if message-send-rename-function - (funcall message-send-rename-function) - (when (string-match "\\`\\*" (buffer-name)) - (rename-buffer - (concat "*sent " (substring (buffer-name) (match-end 0))) t))) - ;; Push the current buffer onto the list. - (when message-max-buffers - (setq message-buffer-list - (nconc message-buffer-list (list (current-buffer)))))) - -(defvar mc-modes-alist) -(defun message-setup (headers &optional replybuffer actions) - (when (and (boundp 'mc-modes-alist) - (not (assq 'message-mode mc-modes-alist))) - (push '(message-mode (encrypt . mc-encrypt-message) - (sign . mc-sign-message)) - mc-modes-alist)) - (when actions - (setq message-send-actions actions)) - (setq message-reply-buffer replybuffer) - (goto-char (point-min)) - ;; Insert all the headers. - (mail-header-format - (let ((h headers) - (alist message-header-format-alist)) - (while h - (unless (assq (caar h) message-header-format-alist) - (push (list (caar h)) alist)) - (pop h)) - alist) - headers) - (delete-region (point) (progn (forward-line -1) (point))) - (when message-default-headers - (insert message-default-headers)) - (put-text-property - (point) - (progn - (insert mail-header-separator "\n") - (1- (point))) - 'read-only nil) - (forward-line -1) - (when (message-news-p) - (when message-default-news-headers - (insert message-default-news-headers)) - (when message-generate-headers-first - (message-generate-headers - (delq 'Lines - (delq 'Subject - (copy-sequence message-required-news-headers)))))) - (when (message-mail-p) - (when message-default-mail-headers - (insert message-default-mail-headers)) - (when message-generate-headers-first - (message-generate-headers - (delq 'Lines - (delq 'Subject - (copy-sequence message-required-mail-headers)))))) - (run-hooks 'message-signature-setup-hook) - (message-insert-signature) - (message-set-auto-save-file-name) - (save-restriction - (message-narrow-to-headers) - (run-hooks 'message-header-setup-hook)) - (set-buffer-modified-p nil) - (setq buffer-undo-list nil) - (run-hooks 'message-setup-hook) - (message-position-point) - (undo-boundary)) - -(defun message-set-auto-save-file-name () - "Associate the message buffer with a file in the drafts directory." - (when message-autosave-directory - (unless (file-exists-p message-autosave-directory) - (make-directory message-autosave-directory t)) - (let ((name (make-temp-name - (expand-file-name - (concat (file-name-as-directory message-autosave-directory) - "msg." - (nnheader-replace-chars-in-string - (nnheader-replace-chars-in-string - (buffer-name) ?* ?.) - ?/ ?-)))))) - (setq buffer-auto-save-file-name - (save-excursion - (prog1 - (progn - (set-buffer (get-buffer-create " *draft tmp*")) - (setq buffer-file-name name) - (make-auto-save-file-name)) - (kill-buffer (current-buffer))))) - (clear-visited-file-modtime)))) - - - -;;; -;;; Commands for interfacing with message -;;; - -;;;###autoload -(defun message-mail (&optional to subject - other-headers continue switch-function - yank-action send-actions) - "Start editing a mail message to be sent." - (interactive) - (let ((message-this-is-mail t)) - (message-pop-to-buffer (message-buffer-name "mail" to)) - (message-setup - (nconc - `((To . ,(or to "")) (Subject . ,(or subject ""))) - (when other-headers other-headers))))) - -;;;###autoload -(defun message-news (&optional newsgroups subject) - "Start editing a news article to be sent." - (interactive) - (let ((message-this-is-news t)) - (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)) - (message-setup `((Newsgroups . ,(or newsgroups "")) - (Subject . ,(or subject "")))))) - -;;;###autoload -(defun message-reply (&optional to-address wide ignore-reply-to) - "Start editing a reply to the article in the current buffer." - (interactive) - (let ((cur (current-buffer)) - from subject date reply-to to cc - references message-id follow-to - (inhibit-point-motion-hooks t) - mct never-mct gnus-warning) - (save-restriction - (message-narrow-to-head) - ;; Allow customizations to have their say. - (if (not wide) - ;; This is a regular reply. - (if (message-functionp message-reply-to-function) - (setq follow-to (funcall message-reply-to-function))) - ;; This is a followup. - (if (message-functionp message-wide-reply-to-function) - (save-excursion - (setq follow-to - (funcall message-wide-reply-to-function))))) - ;; Find all relevant headers we need. - (setq from (message-fetch-field "from") - date (message-fetch-field "date") - subject (or (message-fetch-field "subject") "none") - to (message-fetch-field "to") - cc (message-fetch-field "cc") - mct (message-fetch-field "mail-copies-to") - reply-to (unless ignore-reply-to (message-fetch-field "reply-to")) - references (message-fetch-field "references") - message-id (message-fetch-field "message-id" t)) - ;; Remove any (buggy) Re:'s that are present and make a - ;; proper one. - (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject) - (setq subject (substring subject (match-end 0)))) - (setq subject (concat "Re: " subject)) - - (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) - (string-match "<[^>]+>" gnus-warning)) - (setq message-id (match-string 0 gnus-warning))) - - ;; Handle special values of Mail-Copies-To. - (when mct - (cond ((equal (downcase mct) "never") - (setq never-mct t) - (setq mct nil)) - ((equal (downcase mct) "always") - (setq mct (or reply-to from))))) - - (unless follow-to - (if (or (not wide) - to-address) - (setq follow-to (list (cons 'To (or to-address reply-to from)))) - (let (ccalist) - (save-excursion - (message-set-work-buffer) - (unless never-mct - (insert (or reply-to from ""))) - (insert (if to (concat (if (bolp) "" ", ") to "") "")) - (insert (if mct (concat (if (bolp) "" ", ") mct) "")) - (insert (if cc (concat (if (bolp) "" ", ") cc) "")) - (goto-char (point-min)) - (while (re-search-forward "[ \t]+" nil t) - (replace-match " " t t)) - ;; Remove addresses that match `rmail-dont-reply-to-names'. - (insert (prog1 (rmail-dont-reply-to (buffer-string)) - (erase-buffer))) - (goto-char (point-min)) - ;; Perhaps Mail-Copies-To: never removed the only address? - (when (eobp) - (insert (or reply-to from ""))) - (setq ccalist - (mapcar - (lambda (addr) - (cons (mail-strip-quoted-names addr) addr)) - (message-tokenize-header (buffer-string)))) - (let ((s ccalist)) - (while s - (setq ccalist (delq (assoc (car (pop s)) s) ccalist))))) - (setq follow-to (list (cons 'To (cdr (pop ccalist))))) - (when ccalist - (let ((ccs (cons 'Cc (mapconcat - (lambda (addr) (cdr addr)) ccalist ", ")))) - (when (string-match "^ +" (cdr ccs)) - (setcdr ccs (substring (cdr ccs) (match-end 0)))) - (push ccs follow-to)))))) - (widen)) - - (message-pop-to-buffer (message-buffer-name - (if wide "wide reply" "reply") from - (if wide to-address nil))) - - (setq message-reply-headers - (vector 0 subject from date message-id references 0 0 "")) - - (message-setup - `((Subject . ,subject) - ,@follow-to - ,@(if (or references message-id) - `((References . ,(concat (or references "") (and references " ") - (or message-id "")))) - nil)) - cur))) - -;;;###autoload -(defun message-wide-reply (&optional to-address ignore-reply-to) - "Make a \"wide\" reply to the message in the current buffer." - (interactive) - (message-reply to-address t ignore-reply-to)) - -;;;###autoload -(defun message-followup (&optional to-newsgroups) - "Follow up to the message in the current buffer. -If TO-NEWSGROUPS, use that as the new Newsgroups line." - (interactive) - (let ((cur (current-buffer)) - from subject date reply-to mct - references message-id follow-to - (inhibit-point-motion-hooks t) - (message-this-is-news t) - followup-to distribution newsgroups gnus-warning posted-to) - (save-restriction - (narrow-to-region - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (1- (point)) - (point-max))) - (when (message-functionp message-followup-to-function) - (setq follow-to - (funcall message-followup-to-function))) - (setq from (message-fetch-field "from") - date (message-fetch-field "date") - subject (or (message-fetch-field "subject") "none") - references (message-fetch-field "references") - message-id (message-fetch-field "message-id" t) - followup-to (message-fetch-field "followup-to") - newsgroups (message-fetch-field "newsgroups") - posted-to (message-fetch-field "posted-to") - reply-to (message-fetch-field "reply-to") - distribution (message-fetch-field "distribution") - mct (message-fetch-field "mail-copies-to")) - (when (and (setq gnus-warning (message-fetch-field "gnus-warning")) - (string-match "<[^>]+>" gnus-warning)) - (setq message-id (match-string 0 gnus-warning))) - ;; Remove bogus distribution. - (when (and (stringp distribution) - (let ((case-fold-search t)) - (string-match "world" distribution))) - (setq distribution nil)) - ;; Remove any (buggy) Re:'s that are present and make a - ;; proper one. - (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject) - (setq subject (substring subject (match-end 0)))) - (setq subject (concat "Re: " subject)) - (widen)) - - (message-pop-to-buffer (message-buffer-name "followup" from newsgroups)) - - (message-setup - `((Subject . ,subject) - ,@(cond - (to-newsgroups - (list (cons 'Newsgroups to-newsgroups))) - (follow-to follow-to) - ((and followup-to message-use-followup-to) - (list - (cond - ((equal (downcase followup-to) "poster") - (if (or (eq message-use-followup-to 'use) - (message-y-or-n-p "Obey Followup-To: poster? " t "\ -You should normally obey the Followup-To: header. - -`Followup-To: poster' sends your response via e-mail instead of news. - -A typical situation where `Followup-To: poster' is used is when the poster -does not read the newsgroup, so he wouldn't see any replies sent to it.")) - (progn - (setq message-this-is-news nil) - (cons 'To (or reply-to from ""))) - (cons 'Newsgroups newsgroups))) - (t - (if (or (equal followup-to newsgroups) - (not (eq message-use-followup-to 'ask)) - (message-y-or-n-p - (concat "Obey Followup-To: " followup-to "? ") t "\ -You should normally obey the Followup-To: header. - - `Followup-To: " followup-to "' -directs your response to " (if (string-match "," followup-to) - "the specified newsgroups" - "that newsgroup only") ". - -If a message is posted to several newsgroups, Followup-To is often -used to direct the following discussion to one newsgroup only, -because discussions that are spread over several newsgroup tend to -be fragmented and very difficult to follow. - -Also, some source/announcement newsgroups are not indented for discussion; -responses here are directed to other newsgroups.")) - (cons 'Newsgroups followup-to) - (cons 'Newsgroups newsgroups)))))) - (posted-to - `((Newsgroups . ,posted-to))) - (t - `((Newsgroups . ,newsgroups)))) - ,@(and distribution (list (cons 'Distribution distribution))) - ,@(if (or references message-id) - `((References . ,(concat (or references "") (and references " ") - (or message-id ""))))) - ,@(when (and mct - (not (equal (downcase mct) "never"))) - (list (cons 'Cc (if (equal (downcase mct) "always") - (or reply-to from "") - mct))))) - - cur) - - (setq message-reply-headers - (vector 0 subject from date message-id references 0 0 "")))) - - -;;;###autoload -(defun message-cancel-news () - "Cancel an article you posted." - (interactive) - (unless (message-news-p) - (error "This is not a news article; canceling is impossible")) - (when (yes-or-no-p "Do you really want to cancel this article? ") - (let (from newsgroups message-id distribution buf) - (save-excursion - ;; Get header info. from original article. - (save-restriction - (message-narrow-to-head) - (setq from (message-fetch-field "from") - newsgroups (message-fetch-field "newsgroups") - message-id (message-fetch-field "message-id" t) - distribution (message-fetch-field "distribution"))) - ;; Make sure that this article was written by the user. - (unless (string-equal - (downcase (cadr (mail-extract-address-components from))) - (downcase (message-make-address))) - (error "This article is not yours")) - ;; Make control message. - (setq buf (set-buffer (get-buffer-create " *message cancel*"))) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert "Newsgroups: " newsgroups "\n" - "From: " (message-make-from) "\n" - "Subject: cmsg cancel " message-id "\n" - "Control: cancel " message-id "\n" - (if distribution - (concat "Distribution: " distribution "\n") - "") - mail-header-separator "\n" - message-cancel-message) - (message "Canceling your article...") - (if (let ((message-syntax-checks - 'dont-check-for-anything-just-trust-me)) - (funcall message-send-news-function)) - (message "Canceling your article...done")) - (kill-buffer buf))))) - -;;;###autoload -(defun message-supersede () - "Start composing a message to supersede the current message. -This is done simply by taking the old article and adding a Supersedes -header line with the old Message-ID." - (interactive) - (let ((cur (current-buffer))) - ;; Check whether the user owns the article that is to be superseded. - (unless (string-equal - (downcase (cadr (mail-extract-address-components - (message-fetch-field "from")))) - (downcase (message-make-address))) - (error "This article is not yours")) - ;; Get a normal message buffer. - (message-pop-to-buffer (message-buffer-name "supersede")) - (insert-buffer-substring cur) - (message-narrow-to-head) - ;; Remove unwanted headers. - (when message-ignored-supersedes-headers - (message-remove-header message-ignored-supersedes-headers t)) - (goto-char (point-min)) - (if (not (re-search-forward "^Message-ID: " nil t)) - (error "No Message-ID in this article") - (replace-match "Supersedes: " t t)) - (goto-char (point-max)) - (insert mail-header-separator) - (widen) - (forward-line 1))) - -;;;###autoload -(defun message-recover () - "Reread contents of current buffer from its last auto-save file." - (interactive) - (let ((file-name (make-auto-save-file-name))) - (cond ((save-window-excursion - (if (not (eq system-type 'vax-vms)) - (with-output-to-temp-buffer "*Directory*" - (buffer-disable-undo standard-output) - (let ((default-directory "/")) - (call-process - "ls" nil standard-output nil "-l" file-name)))) - (yes-or-no-p (format "Recover auto save file %s? " file-name))) - (let ((buffer-read-only nil)) - (erase-buffer) - (insert-file-contents file-name nil))) - (t (error "message-recover cancelled"))))) - -;;; Forwarding messages. - -(defun message-make-forward-subject () - "Return a Subject header suitable for the message in the current buffer." - (save-excursion - (save-restriction - (current-buffer) - (message-narrow-to-head) - (concat "[" (or (message-fetch-field - (if (message-news-p) "newsgroups" "from")) - "(nowhere)") - "] " (or (message-fetch-field "Subject") ""))))) - -;;;###autoload -(defun message-forward (&optional news) - "Forward the current message via mail. -Optional NEWS will use news to forward instead of mail." - (interactive "P") - (let ((cur (current-buffer)) - (subject (message-make-forward-subject)) - art-beg) - (if news (message-news nil subject) (message-mail nil subject)) - ;; Put point where we want it before inserting the forwarded - ;; message. - (if message-signature-before-forwarded-message - (goto-char (point-max)) - (message-goto-body)) - ;; Make sure we're at the start of the line. - (unless (eolp) - (insert "\n")) - ;; Narrow to the area we are to insert. - (narrow-to-region (point) (point)) - ;; Insert the separators and the forwarded buffer. - (insert message-forward-start-separator) - (setq art-beg (point)) - (insert-buffer-substring cur) - (goto-char (point-max)) - (insert message-forward-end-separator) - (set-text-properties (point-min) (point-max) nil) - ;; Remove all unwanted headers. - (goto-char art-beg) - (narrow-to-region (point) (if (search-forward "\n\n" nil t) - (1- (point)) - (point))) - (goto-char (point-min)) - (message-remove-header message-included-forward-headers t nil t) - (widen) - (message-position-point))) - -;;;###autoload -(defun message-resend (address) - "Resend the current article to ADDRESS." - (interactive "sResend message to: ") - (message "Resending message to %s..." address) - (save-excursion - (let ((cur (current-buffer)) - beg) - ;; We first set up a normal mail buffer. - (set-buffer (get-buffer-create " *message resend*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (message-setup `((To . ,address))) - ;; Insert our usual headers. - (message-generate-headers '(From Date To)) - (message-narrow-to-headers) - ;; Rename them all to "Resent-*". - (while (re-search-forward "^[A-Za-z]" nil t) - (forward-char -1) - (insert "Resent-")) - (widen) - (forward-line) - (delete-region (point) (point-max)) - (setq beg (point)) - ;; Insert the message to be resent. - (insert-buffer-substring cur) - (goto-char (point-min)) - (search-forward "\n\n") - (forward-char -1) - (save-restriction - (narrow-to-region beg (point)) - (message-remove-header message-ignored-resent-headers t) - (goto-char (point-max))) - (insert mail-header-separator) - ;; Rename all old ("Also-")Resent headers. - (while (re-search-backward "^\\(Also-\\)?Resent-" beg t) - (beginning-of-line) - (insert "Also-")) - ;; Quote any "From " lines at the beginning. - (goto-char beg) - (when (looking-at "From ") - (replace-match "X-From-Line: ")) - ;; Send it. - (message-send-mail) - (kill-buffer (current-buffer))) - (message "Resending message to %s...done" address))) - -;;;###autoload -(defun message-bounce () - "Re-mail the current message. -This only makes sense if the current message is a bounce message than -contains some mail you have written which has been bounced back to -you." - (interactive) - (let ((cur (current-buffer)) - boundary) - (message-pop-to-buffer (message-buffer-name "bounce")) - (insert-buffer-substring cur) - (undo-boundary) - (message-narrow-to-head) - (if (and (message-fetch-field "Mime-Version") - (setq boundary (message-fetch-field "Content-Type"))) - (if (string-match "boundary=\"\\([^\"]+\\)\"" boundary) - (setq boundary (concat (match-string 1 boundary) " *\n" - "Content-Type: message/rfc822")) - (setq boundary nil))) - (widen) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (or (and boundary - (re-search-forward boundary nil t) - (forward-line 2)) - (and (re-search-forward message-unsent-separator nil t) - (forward-line 1)) - (re-search-forward "^Return-Path:.*\n" nil t)) - ;; We remove everything before the bounced mail. - (delete-region - (point-min) - (if (re-search-forward "^[^ \n\t]+:" nil t) - (match-beginning 0) - (point))) - (save-restriction - (message-narrow-to-head) - (message-remove-header message-ignored-bounced-headers t) - (goto-char (point-max)) - (insert mail-header-separator)) - (message-position-point))) - -;;; -;;; Interactive entry points for new message buffers. -;;; - -;;;###autoload -(defun message-mail-other-window (&optional to subject) - "Like `message-mail' command, but display mail buffer in another window." - (interactive) - (let ((pop-up-windows t) - (special-display-buffer-names nil) - (special-display-regexps nil) - (same-window-buffer-names nil) - (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "mail" to))) - (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))) - -;;;###autoload -(defun message-mail-other-frame (&optional to subject) - "Like `message-mail' command, but display mail buffer in another frame." - (interactive) - (let ((pop-up-frames t) - (special-display-buffer-names nil) - (special-display-regexps nil) - (same-window-buffer-names nil) - (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "mail" to))) - (message-setup `((To . ,(or to "")) (Subject . ,(or subject ""))))) - -;;;###autoload -(defun message-news-other-window (&optional newsgroups subject) - "Start editing a news article to be sent." - (interactive) - (let ((pop-up-windows t) - (special-display-buffer-names nil) - (special-display-regexps nil) - (same-window-buffer-names nil) - (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))) - (message-setup `((Newsgroups . ,(or newsgroups "")) - (Subject . ,(or subject ""))))) - -;;;###autoload -(defun message-news-other-frame (&optional newsgroups subject) - "Start editing a news article to be sent." - (interactive) - (let ((pop-up-frames t) - (special-display-buffer-names nil) - (special-display-regexps nil) - (same-window-buffer-names nil) - (same-window-regexps nil)) - (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))) - (message-setup `((Newsgroups . ,(or newsgroups "")) - (Subject . ,(or subject ""))))) - -;;; underline.el - -;; This code should be moved to underline.el (from which it is stolen). - -;;;###autoload -(defun bold-region (start end) - "Bold all nonblank characters in the region. -Works by overstriking characters. -Called from program, takes two arguments START and END -which specify the range to operate on." - (interactive "r") - (save-excursion - (let ((end1 (make-marker))) - (move-marker end1 (max start end)) - (goto-char (min start end)) - (while (< (point) end1) - (or (looking-at "[_\^@- ]") - (insert (following-char) "\b")) - (forward-char 1))))) - -;;;###autoload -(defun unbold-region (start end) - "Remove all boldness (overstruck characters) in the region. -Called from program, takes two arguments START and END -which specify the range to operate on." - (interactive "r") - (save-excursion - (let ((end1 (make-marker))) - (move-marker end1 (max start end)) - (goto-char (min start end)) - (while (re-search-forward "\b" end1 t) - (if (eq (following-char) (char-after (- (point) 2))) - (delete-char -2)))))) - -(defalias 'message-exchange-point-and-mark 'exchange-point-and-mark) - -;; Support for toolbar -(when (string-match "XEmacs\\|Lucid" emacs-version) - (require 'messagexmas)) - -;;; Group name completion. - -(defvar message-newgroups-header-regexp - "^\\(Newsgroups\\|Followup-To\\|Posted-To\\|Gcc\\):" - "Regexp that match headers that lists groups.") - -(defun message-tab () - "Expand group names in Newsgroups and Followup-To headers. -Do a `tab-to-tab-stop' if not in those headers." - (interactive) - (if (let ((mail-abbrev-mode-regexp message-newgroups-header-regexp)) - (mail-abbrev-in-expansion-header-p)) - (message-expand-group) - (tab-to-tab-stop))) - -(defvar gnus-active-hashtb) -(defun message-expand-group () - (let* ((b (save-excursion - (save-restriction - (narrow-to-region - (save-excursion - (beginning-of-line) - (skip-chars-forward "^:") - (1+ (point))) - (point)) - (skip-chars-backward "^, \t\n") (point)))) - (completion-ignore-case t) - (string (buffer-substring b (point))) - (hashtb (and (boundp 'gnus-active-hashtb) gnus-active-hashtb)) - (completions (all-completions string hashtb)) - (cur (current-buffer)) - comp) - (delete-region b (point)) - (cond - ((= (length completions) 1) - (if (string= (car completions) string) - (progn - (insert string) - (message "Only matching group")) - (insert (car completions)))) - ((and (setq comp (try-completion string hashtb)) - (not (string= comp string))) - (insert comp)) - (t - (insert string) - (if (not comp) - (message "No matching groups") - (save-selected-window - (pop-to-buffer "*Completions*") - (buffer-disable-undo (current-buffer)) - (let ((buffer-read-only nil)) - (erase-buffer) - (let ((standard-output (current-buffer))) - (display-completion-list (sort completions 'string<))) - (goto-char (point-min)) - (delete-region (point) (progn (forward-line 3) (point)))))))))) - -;;; Help stuff. - -(defun message-talkative-question (ask question show &rest text) - "Call FUNCTION with argument QUESTION, displaying the rest of the arguments in a temporary buffer if SHOW. -The following arguments may contain lists of values." - (if (and show - (setq text (message-flatten-list text))) - (save-window-excursion - (save-excursion - (with-output-to-temp-buffer " *MESSAGE information message*" - (set-buffer " *MESSAGE information message*") - (mapcar 'princ text) - (goto-char (point-min)))) - (funcall ask question)) - (funcall ask question))) - -(defun message-flatten-list (list) - "Return a new, flat list that contains all elements of LIST. - -\(message-flatten-list '(1 (2 3 (4 5 (6))) 7)) -=> (1 2 3 4 5 6 7)" - (cond ((consp list) - (apply 'append (mapcar 'message-flatten-list list))) - (list - (list list)))) - -(defun message-generate-new-buffer-clone-locals (name &optional varstr) - "Create and return a buffer with a name based on NAME using generate-new-buffer. -Then clone the local variables and values from the old buffer to the -new one, cloning only the locals having a substring matching the -regexp varstr." - (let ((oldbuf (current-buffer))) - (save-excursion - (set-buffer (generate-new-buffer name)) - (message-clone-locals oldbuf) - (current-buffer)))) - -(defun message-clone-locals (buffer) - "Clone the local variables from BUFFER to the current buffer." - (let ((locals (save-excursion - (set-buffer buffer) - (buffer-local-variables))) - (regexp "^gnus\\|^nn\\|^message")) - (mapcar - (lambda (local) - (when (and (car local) - (string-match regexp (symbol-name (car local)))) - (ignore-errors - (set (make-local-variable (car local)) - (cdr local))))) - locals))) - -(run-hooks 'message-load-hook) - -(provide 'message) - -;;; message.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/messagexmas.el --- a/lisp/gnus/messagexmas.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,125 +0,0 @@ -;;; messagexmas.el --- XEmacs extensions to message -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: mail, 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) - -(defvar message-xmas-dont-activate-region t - "If t, don't activate region after yanking.") - -(defvar message-xmas-glyph-directory nil - "*Directory where Message logos and icons are located. -If this variable is nil, Message will try to locate the directory -automatically.") - -(defvar message-use-toolbar (if (featurep 'toolbar) - 'default-toolbar - nil) - "*If nil, do not use a toolbar. -If it is non-nil, it must be a toolbar. The five legal values are -`default-toolbar', `top-toolbar', `bottom-toolbar', -`right-toolbar', and `left-toolbar'.") - -(defvar message-toolbar - '([message-spell ispell-message t "Spell"] - [message-help (Info-goto-node "(Message)Top") t "Message help"]) - "The message buffer toolbar.") - -(defun message-xmas-find-glyph-directory (&optional package) - (setq package (or package "message")) - (let ((dir (symbol-value - (intern-soft (concat package "-xmas-glyph-directory"))))) - (if (and (stringp dir) (file-directory-p dir)) - dir - (nnheader-find-etc-directory package)))) - -(defun message-xmas-setup-toolbar (bar &optional force package) - (let ((dir (message-xmas-find-glyph-directory package)) - (xpm (if (featurep 'xpm) "xpm" "xbm")) - icon up down disabled name) - (unless package - (setq message-xmas-glyph-directory dir)) - (when dir - (while bar - (setq icon (aref (car bar) 0) - name (symbol-name icon) - bar (cdr bar)) - (when (or force - (not (boundp icon))) - (setq up (concat dir name "-up." xpm)) - (setq down (concat dir name "-down." xpm)) - (setq disabled (concat dir name "-disabled." xpm)) - (if (not (file-exists-p up)) - (setq bar nil - dir nil) - (set icon (toolbar-make-button-list - up (and (file-exists-p down) down) - (and (file-exists-p disabled) disabled))))))) - dir)) - -(defun message-setup-toolbar () - (and message-use-toolbar - (message-xmas-setup-toolbar message-toolbar) - (set-specifier (symbol-value message-use-toolbar) - (cons (current-buffer) message-toolbar)))) - -(defun message-xmas-exchange-point-and-mark () - "Exchange point and mark, but allow for XEmacs' optional argument." - (exchange-point-and-mark message-xmas-dont-activate-region)) - -(fset 'message-exchange-point-and-mark 'message-xmas-exchange-point-and-mark) - -(defun message-xmas-maybe-fontify () - (when (and (featurep 'font-lock) - font-lock-auto-fontify) - (turn-on-font-lock))) - -(defun message-xmas-make-caesar-translation-table (n) - "Create a rot table with offset N." - (let ((i -1) - (table (make-string 256 0)) - (a (char-int ?a)) - (A (char-int ?A))) - (while (< (incf i) 256) - (aset table i i)) - (concat - (substring table 0 A) - (substring table (+ A n) (+ A n (- 26 n))) - (substring table A (+ A n)) - (substring table (+ A 26) a) - (substring table (+ a n) (+ a n (- 26 n))) - (substring table a (+ a n)) - (substring table (+ a 26) 255)))) - -(when (>= emacs-major-version 20) - (fset 'message-make-caesar-translation-table - 'message-xmas-make-caesar-translation-table)) - -(add-hook 'message-mode-hook 'message-xmas-maybe-fontify) - -(provide 'messagexmas) - -;;; messagexmas.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/messcompat.el --- a/lisp/gnus/messcompat.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,86 +0,0 @@ -;;; messcompat.el --- making message mode compatible with mail mode -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: mail, 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; This file tries to provide backward compatability with sendmail.el -;; for Message mode. It should be used by simply adding -;; -;; (require 'messcompat) -;; -;; to the .emacs file. Loading it after Message mode has been -;; loaded will have no effect. - -;;; Code: - -(require 'sendmail) - -(defvar message-from-style mail-from-style - "*Specifies how \"From\" headers look. - -If `nil', they contain just the return address like: - king@grassland.com -If `parens', they look like: - king@grassland.com (Elvis Parsley) -If `angles', they look like: - Elvis Parsley - -Otherwise, most addresses look like `angles', but they look like -`parens' if `angles' would need quoting and `parens' would not.") - -(defvar message-interactive mail-interactive - "Non-nil means when sending a message wait for and display errors. -nil means let mailer mail back a message to report errors.") - -(defvar message-setup-hook mail-setup-hook - "Normal hook, run each time a new outgoing message is initialized. -The function `message-setup' runs this hook.") - -(defvar message-mode-hook mail-mode-hook - "Hook run in message mode buffers.") - -(defvar message-indentation-spaces mail-indentation-spaces - "*Number of spaces to insert at the beginning of each cited line. -Used by `message-yank-original' via `message-yank-cite'.") - -(defvar message-signature mail-signature - "*String to be inserted at the end of the message buffer. -If t, the `message-signature-file' file will be inserted instead. -If a function, the result from the function will be used instead. -If a form, the result from the form will be used instead.") - -;;;###autoload -(defvar message-signature-file mail-signature-file - "*File containing the text inserted at end of message. buffer.") - -(defvar message-default-headers mail-default-headers - "*A string containing header lines to be inserted in outgoing messages. -It is inserted before you edit the message, so you can edit or delete -these lines.") - -(defvar message-send-hook mail-send-hook - "Hook run before sending messages.") - -(provide 'messcompat) - -;;; messcompat.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/nnbabyl.el --- a/lisp/gnus/nnbabyl.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,650 +0,0 @@ -;;; nnbabyl.el --- rmail mbox access for Gnus -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; For an overview of what the interface functions do, please see the -;; Gnus sources. - -;;; Code: - -(require 'nnheader) -(require 'rmail) -(require 'nnmail) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nnbabyl) - -(defvoo nnbabyl-mbox-file (expand-file-name "~/RMAIL") - "The name of the rmail box file in the users home directory.") - -(defvoo nnbabyl-active-file (expand-file-name "~/.rmail-active") - "The name of the active file for the rmail box.") - -(defvoo nnbabyl-get-new-mail t - "If non-nil, nnbabyl will check the incoming mail file and split the mail.") - -(defvoo nnbabyl-prepare-save-mail-hook nil - "Hook run narrowed to an article before saving.") - - - -(defvar nnbabyl-mail-delimiter "\^_") - -(defconst nnbabyl-version "nnbabyl 1.0" - "nnbabyl version.") - -(defvoo nnbabyl-mbox-buffer nil) -(defvoo nnbabyl-current-group nil) -(defvoo nnbabyl-status-string "") -(defvoo nnbabyl-group-alist nil) -(defvoo nnbabyl-active-timestamp nil) - -(defvoo nnbabyl-previous-buffer-mode nil) - -(eval-and-compile - (autoload 'gnus-set-text-properties "gnus-ems")) - - - -;;; Interface functions - -(nnoo-define-basics nnbabyl) - -(deffoo nnbabyl-retrieve-headers (articles &optional group server fetch-old) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let ((number (length articles)) - (count 0) - (delim (concat "^" nnbabyl-mail-delimiter)) - article art-string start stop) - (nnbabyl-possibly-change-newsgroup group server) - (while (setq article (pop articles)) - (setq art-string (nnbabyl-article-string article)) - (set-buffer nnbabyl-mbox-buffer) - (end-of-line) - (when (or (search-forward art-string nil t) - (search-backward art-string nil t)) - (unless (re-search-backward delim nil t) - (goto-char (point-min))) - (while (and (not (looking-at ".+:")) - (zerop (forward-line 1)))) - (setq start (point)) - (search-forward "\n\n" nil t) - (setq stop (1- (point))) - (set-buffer nntp-server-buffer) - (insert "221 ") - (princ article (current-buffer)) - (insert " Article retrieved.\n") - (insert-buffer-substring nnbabyl-mbox-buffer start stop) - (goto-char (point-max)) - (insert ".\n")) - (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup) - (zerop (% (incf count) 20)) - (nnheader-message 5 "nnbabyl: Receiving headers... %d%%" - (/ (* count 100) number)))) - - (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup) - (nnheader-message 5 "nnbabyl: Receiving headers...done")) - - (set-buffer nntp-server-buffer) - (nnheader-fold-continuation-lines) - 'headers))) - -(deffoo nnbabyl-open-server (server &optional defs) - (nnoo-change-server 'nnbabyl server defs) - (nnbabyl-create-mbox) - (cond - ((not (file-exists-p nnbabyl-mbox-file)) - (nnbabyl-close-server) - (nnheader-report 'nnbabyl "No such file: %s" nnbabyl-mbox-file)) - ((file-directory-p nnbabyl-mbox-file) - (nnbabyl-close-server) - (nnheader-report 'nnbabyl "Not a regular file: %s" nnbabyl-mbox-file)) - (t - (nnheader-report 'nnbabyl "Opened server %s using mbox %s" server - nnbabyl-mbox-file) - t))) - -(deffoo nnbabyl-close-server (&optional server) - ;; Restore buffer mode. - (when (and (nnbabyl-server-opened) - nnbabyl-previous-buffer-mode) - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (narrow-to-region - (caar nnbabyl-previous-buffer-mode) - (cdar nnbabyl-previous-buffer-mode)) - (funcall (cdr nnbabyl-previous-buffer-mode)))) - (nnoo-close-server 'nnbabyl server) - (setq nnbabyl-mbox-buffer nil) - t) - -(deffoo nnbabyl-server-opened (&optional server) - (and (nnoo-current-server-p 'nnbabyl server) - nnbabyl-mbox-buffer - (buffer-name nnbabyl-mbox-buffer) - nntp-server-buffer - (buffer-name nntp-server-buffer))) - -(deffoo nnbabyl-request-article (article &optional newsgroup server buffer) - (nnbabyl-possibly-change-newsgroup newsgroup server) - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - (when (search-forward (nnbabyl-article-string article) nil t) - (let (start stop summary-line) - (unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) - (goto-char (point-min)) - (end-of-line)) - (while (and (not (looking-at ".+:")) - (zerop (forward-line 1)))) - (setq start (point)) - (or (when (re-search-forward - (concat "^" nnbabyl-mail-delimiter) nil t) - (beginning-of-line) - t) - (goto-char (point-max))) - (setq stop (point)) - (let ((nntp-server-buffer (or buffer nntp-server-buffer))) - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-buffer-substring nnbabyl-mbox-buffer start stop) - (goto-char (point-min)) - ;; If there is an EOOH header, then we have to remove some - ;; duplicated headers. - (setq summary-line (looking-at "Summary-line:")) - (when (search-forward "\n*** EOOH ***" nil t) - (if summary-line - ;; The headers to be deleted are located before the - ;; EOOH line... - (delete-region (point-min) (progn (forward-line 1) - (point))) - ;; ...or after. - (delete-region (progn (beginning-of-line) (point)) - (or (search-forward "\n\n" nil t) - (point))))) - (if (numberp article) - (cons nnbabyl-current-group article) - (nnbabyl-article-group-number))))))) - -(deffoo nnbabyl-request-group (group &optional server dont-check) - (let ((active (cadr (assoc group nnbabyl-group-alist)))) - (save-excursion - (cond - ((or (null active) - (null (nnbabyl-possibly-change-newsgroup group server))) - (nnheader-report 'nnbabyl "No such group: %s" group)) - (dont-check - (nnheader-report 'nnbabyl "Selected group %s" group) - (nnheader-insert "")) - (t - (nnheader-report 'nnbabyl "Selected group %s" group) - (nnheader-insert "211 %d %d %d %s\n" - (1+ (- (cdr active) (car active))) - (car active) (cdr active) group)))))) - -(deffoo nnbabyl-request-scan (&optional group server) - (nnbabyl-possibly-change-newsgroup group server) - (nnbabyl-read-mbox) - (nnmail-get-new-mail - 'nnbabyl - (lambda () - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (save-buffer))) - (file-name-directory nnbabyl-mbox-file) - group - (lambda () - (save-excursion - (let ((in-buf (current-buffer))) - (goto-char (point-min)) - (while (search-forward "\n\^_\n" nil t) - (delete-char -1)) - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-max)) - (search-backward "\n\^_" nil t) - (goto-char (match-end 0)) - (insert-buffer-substring in-buf))) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))) - -(deffoo nnbabyl-close-group (group &optional server) - t) - -(deffoo nnbabyl-request-create-group (group &optional server args) - (nnmail-activate 'nnbabyl) - (unless (assoc group nnbabyl-group-alist) - (push (list group (cons 1 0)) - nnbabyl-group-alist) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) - t) - -(deffoo nnbabyl-request-list (&optional server) - (save-excursion - (nnmail-find-file nnbabyl-active-file) - (setq nnbabyl-group-alist (nnmail-get-active)) - t)) - -(deffoo nnbabyl-request-newgroups (date &optional server) - (nnbabyl-request-list server)) - -(deffoo nnbabyl-request-list-newsgroups (&optional server) - (nnheader-report 'nnbabyl "nnbabyl: LIST NEWSGROUPS is not implemented.")) - -(deffoo nnbabyl-request-expire-articles - (articles newsgroup &optional server force) - (nnbabyl-possibly-change-newsgroup newsgroup server) - (let* ((is-old t) - rest) - (nnmail-activate 'nnbabyl) - - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (gnus-set-text-properties (point-min) (point-max) nil) - (while (and articles is-old) - (goto-char (point-min)) - (when (search-forward (nnbabyl-article-string (car articles)) nil t) - (if (setq is-old - (nnmail-expired-article-p - newsgroup - (buffer-substring - (point) (progn (end-of-line) (point))) force)) - (progn - (nnheader-message 5 "Deleting article %d in %s..." - (car articles) newsgroup) - (nnbabyl-delete-mail)) - (push (car articles) rest))) - (setq articles (cdr articles))) - (save-buffer) - ;; Find the lowest active article in this group. - (let ((active (nth 1 (assoc newsgroup nnbabyl-group-alist)))) - (goto-char (point-min)) - (while (and (not (search-forward - (nnbabyl-article-string (car active)) nil t)) - (<= (car active) (cdr active))) - (setcar active (1+ (car active))) - (goto-char (point-min)))) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) - (nconc rest articles)))) - -(deffoo nnbabyl-request-move-article - (article group server accept-form &optional last) - (let ((buf (get-buffer-create " *nnbabyl move*")) - result) - (and - (nnbabyl-request-article article group server) - (save-excursion - (set-buffer buf) - (insert-buffer-substring nntp-server-buffer) - (goto-char (point-min)) - (while (re-search-forward - "^X-Gnus-Newsgroup:" - (save-excursion (search-forward "\n\n" nil t) (point)) t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) - (setq result (eval accept-form)) - (kill-buffer (current-buffer)) - result) - (save-excursion - (nnbabyl-possibly-change-newsgroup group server) - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - (if (search-forward (nnbabyl-article-string article) nil t) - (nnbabyl-delete-mail)) - (and last (save-buffer)))) - result)) - -(deffoo nnbabyl-request-accept-article (group &optional server last) - (nnbabyl-possibly-change-newsgroup group server) - (nnmail-check-syntax) - (let ((buf (current-buffer)) - result beg) - (and - (nnmail-activate 'nnbabyl) - (save-excursion - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (forward-line -1) - (save-excursion - (while (re-search-backward "^X-Gnus-Newsgroup: " beg t) - (delete-region (point) (progn (forward-line 1) (point))))) - (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id"))) - (setq result - (if (stringp group) - (list (cons group (nnbabyl-active-number group))) - (nnmail-article-group 'nnbabyl-active-number))) - (if (and (null result) - (yes-or-no-p "Moved to `junk' group; delete article? ")) - (setq result 'junk) - (setq result (car (nnbabyl-save-mail result)))) - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-max)) - (search-backward "\n\^_") - (goto-char (match-end 0)) - (insert-buffer-substring buf) - (when last - (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id"))) - (save-buffer) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)) - result)))) - -(deffoo nnbabyl-request-replace-article (article group buffer) - (nnbabyl-possibly-change-newsgroup group) - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - (if (not (search-forward (nnbabyl-article-string article) nil t)) - nil - (nnbabyl-delete-mail t t) - (insert-buffer-substring buffer) - (save-buffer) - t))) - -(deffoo nnbabyl-request-delete-group (group &optional force server) - (nnbabyl-possibly-change-newsgroup group server) - ;; Delete all articles in GROUP. - (if (not force) - () ; Don't delete the articles. - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - ;; Delete all articles in this group. - (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":")) - found) - (while (search-forward ident nil t) - (setq found t) - (nnbabyl-delete-mail)) - (when found - (save-buffer))))) - ;; Remove the group from all structures. - (setq nnbabyl-group-alist - (delq (assoc group nnbabyl-group-alist) nnbabyl-group-alist) - nnbabyl-current-group nil) - ;; Save the active file. - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) - t) - -(deffoo nnbabyl-request-rename-group (group new-name &optional server) - (nnbabyl-possibly-change-newsgroup group server) - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":")) - (new-ident (concat "\nX-Gnus-Newsgroup: " new-name ":")) - found) - (while (search-forward ident nil t) - (replace-match new-ident t t) - (setq found t)) - (when found - (save-buffer)))) - (let ((entry (assoc group nnbabyl-group-alist))) - (and entry (setcar entry new-name)) - (setq nnbabyl-current-group nil) - ;; Save the new group alist. - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) - t)) - - -;;; Internal functions. - -;; If FORCE, delete article no matter how many X-Gnus-Newsgroup -;; headers there are. If LEAVE-DELIM, don't delete the Unix mbox -;; delimiter line. -(defun nnbabyl-delete-mail (&optional force leave-delim) - ;; Delete the current X-Gnus-Newsgroup line. - (unless force - (delete-region - (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) - ;; Beginning of the article. - (save-excursion - (save-restriction - (widen) - (narrow-to-region - (save-excursion - (unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t) - (goto-char (point-min)) - (end-of-line)) - (if leave-delim (progn (forward-line 1) (point)) - (match-beginning 0))) - (progn - (forward-line 1) - (or (and (re-search-forward (concat "^" nnbabyl-mail-delimiter) - nil t) - (match-beginning 0)) - (point-max)))) - (goto-char (point-min)) - ;; Only delete the article if no other groups owns it as well. - (when (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t))) - (delete-region (point-min) (point-max)))))) - -(defun nnbabyl-possibly-change-newsgroup (newsgroup &optional server) - (when (and server - (not (nnbabyl-server-opened server))) - (nnbabyl-open-server server)) - (when (or (not nnbabyl-mbox-buffer) - (not (buffer-name nnbabyl-mbox-buffer))) - (save-excursion (nnbabyl-read-mbox))) - (unless nnbabyl-group-alist - (nnmail-activate 'nnbabyl)) - (if newsgroup - (if (assoc newsgroup nnbabyl-group-alist) - (setq nnbabyl-current-group newsgroup) - (nnheader-report 'nnbabyl "No such group in file")) - t)) - -(defun nnbabyl-article-string (article) - (if (numberp article) - (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":" - (int-to-string article) " ") - (concat "\nMessage-ID: " article))) - -(defun nnbabyl-article-group-number () - (save-excursion - (goto-char (point-min)) - (when (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) " - nil t) - (cons (buffer-substring (match-beginning 1) (match-end 1)) - (string-to-int - (buffer-substring (match-beginning 2) (match-end 2))))))) - -(defun nnbabyl-insert-lines () - "Insert how many lines and chars there are in the body of the mail." - (let (lines chars) - (save-excursion - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - ;; There may be an EOOH line here... - (when (looking-at "\\*\\*\\* EOOH \\*\\*\\*") - (search-forward "\n\n" nil t)) - (setq chars (- (point-max) (point)) - lines (max (- (count-lines (point) (point-max)) 1) 0)) - ;; Move back to the end of the headers. - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (forward-char -1) - (save-excursion - (when (re-search-backward "^Lines: " nil t) - (delete-region (point) (progn (forward-line 1) (point))))) - (insert (format "Lines: %d\n" lines)) - chars)))) - -(defun nnbabyl-save-mail (group-art) - ;; Called narrowed to an article. - (nnbabyl-insert-lines) - (nnmail-insert-xref group-art) - (nnbabyl-insert-newsgroup-line group-art) - (run-hooks 'nnbabyl-prepare-save-mail-hook) - group-art) - -(defun nnbabyl-insert-newsgroup-line (group-art) - (save-excursion - (goto-char (point-min)) - (while (looking-at "From ") - (replace-match "Mail-from: From " t t) - (forward-line 1)) - ;; If there is a C-l at the beginning of the narrowed region, this - ;; isn't really a "save", but rather a "scan". - (goto-char (point-min)) - (unless (looking-at "\^L") - (save-excursion - (insert "\^L\n0, unseen,,\n*** EOOH ***\n") - (goto-char (point-max)) - (insert "\^_\n"))) - (when (search-forward "\n\n" nil t) - (forward-char -1) - (while group-art - (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" - (caar group-art) (cdar group-art) - (current-time-string))) - (setq group-art (cdr group-art)))) - t)) - -(defun nnbabyl-active-number (group) - ;; Find the next article number in GROUP. - (let ((active (cadr (assoc group nnbabyl-group-alist)))) - (if active - (setcdr active (1+ (cdr active))) - ;; This group is new, so we create a new entry for it. - ;; This might be a bit naughty... creating groups on the drop of - ;; a hat, but I don't know... - (push (list group (setq active (cons 1 1))) - nnbabyl-group-alist)) - (cdr active))) - -(defun nnbabyl-create-mbox () - (unless (file-exists-p nnbabyl-mbox-file) - ;; Create a new, empty RMAIL mbox file. - (save-excursion - (set-buffer (setq nnbabyl-mbox-buffer - (create-file-buffer nnbabyl-mbox-file))) - (setq buffer-file-name nnbabyl-mbox-file) - (insert "BABYL OPTIONS:\n\n\^_") - (nnmail-write-region - (point-min) (point-max) nnbabyl-mbox-file t 'nomesg)))) - -(defun nnbabyl-read-mbox () - (nnmail-activate 'nnbabyl) - (nnbabyl-create-mbox) - - (unless (and nnbabyl-mbox-buffer - (buffer-name nnbabyl-mbox-buffer) - (save-excursion - (set-buffer nnbabyl-mbox-buffer) - (= (buffer-size) (nnheader-file-size nnbabyl-mbox-file)))) - ;; This buffer has changed since we read it last. Possibly. - (save-excursion - (let ((delim (concat "^" nnbabyl-mail-delimiter)) - (alist nnbabyl-group-alist) - start end number) - (set-buffer (setq nnbabyl-mbox-buffer - (nnheader-find-file-noselect - nnbabyl-mbox-file nil 'raw))) - ;; Save previous buffer mode. - (setq nnbabyl-previous-buffer-mode - (cons (cons (point-min) (point-max)) - major-mode)) - - (buffer-disable-undo (current-buffer)) - (widen) - (setq buffer-read-only nil) - (fundamental-mode) - - ;; Go through the group alist and compare against - ;; the rmail file. - (while alist - (goto-char (point-max)) - (when (and (re-search-backward - (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) " - (caar alist)) - nil t) - (> (setq number - (string-to-number - (buffer-substring - (match-beginning 1) (match-end 1)))) - (cdadar alist))) - (setcdr (cadar alist) number)) - (setq alist (cdr alist))) - - ;; We go through the mbox and make sure that each and - ;; every mail belongs to some group or other. - (goto-char (point-min)) - (if (looking-at "\^L") - (setq start (point)) - (re-search-forward delim nil t) - (setq start (match-end 0))) - (while (re-search-forward delim nil t) - (setq end (match-end 0)) - (unless (search-backward "\nX-Gnus-Newsgroup: " start t) - (goto-char end) - (save-excursion - (save-restriction - (narrow-to-region (goto-char start) end) - (nnbabyl-save-mail - (nnmail-article-group 'nnbabyl-active-number)) - (setq end (point-max))))) - (goto-char (setq start end))) - (when (buffer-modified-p (current-buffer)) - (save-buffer)) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))))) - -(defun nnbabyl-remove-incoming-delims () - (goto-char (point-min)) - (while (search-forward "\^_" nil t) - (replace-match "?" t t))) - -(defun nnbabyl-check-mbox () - "Go through the nnbabyl mbox and make sure that no article numbers are reused." - (interactive) - (let ((idents (make-vector 1000 0)) - id) - (save-excursion - (when (or (not nnbabyl-mbox-buffer) - (not (buffer-name nnbabyl-mbox-buffer))) - (nnbabyl-read-mbox)) - (set-buffer nnbabyl-mbox-buffer) - (goto-char (point-min)) - (while (re-search-forward "^X-Gnus-Newsgroup: \\([^ ]+\\) " nil t) - (if (intern-soft (setq id (match-string 1)) idents) - (progn - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point))) - (nnheader-message 7 "Moving %s..." id) - (nnbabyl-save-mail - (nnmail-article-group 'nnbabyl-active-number))) - (intern id idents))) - (when (buffer-modified-p (current-buffer)) - (save-buffer)) - (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file) - (message "")))) - -(provide 'nnbabyl) - -;;; nnbabyl.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/nndb.el --- a/lisp/gnus/nndb.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,332 +0,0 @@ -;;; nndb.el --- nndb access for Gnus -;; Copyright (C) 1997 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Kai Grossjohann -;; Joe Hildebrand -;; David Blacka -;; Keywords: news - -;; This file is NOT part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; This was based upon Kai Grossjohan's shamessly snarfed code and -;;; further modified by Joe Hildebrand. It has been updated for Red -;;; Gnus. - -;; TODO: -;; -;; * Fix bug where server connection can be lost and impossible to regain -;; This hasn't happened to me in a while; think it was fixed in Rgnus -;; -;; * make it handle different nndb servers seemlessly -;; -;; * Optimize expire if FORCE -;; -;; * Optimize move (only expire once) -;; -;; * Deal with add/deletion of groups -;; -;; * make the backend TOUCH an article when marked as expireable (will -;; make article expire 'expiry' days after that moment). - -;;- -;; Register nndb with known select methods. - -(gnus-declare-backend "nndb" 'mail 'respool 'address 'prompt-address) - -;;; Code: - -(require 'nnmail) -(require 'nnheader) -(require 'nntp) -(eval-when-compile (require 'cl)) - -(eval-and-compile - (unless (fboundp 'open-network-stream) - (require 'tcp))) - -(eval-when-compile (require 'cl)) - -(eval-and-compile - (autoload 'news-setup "rnewspost") - (autoload 'news-reply-mode "rnewspost") - (autoload 'cancel-timer "timer") - (autoload 'telnet "telnet" nil t) - (autoload 'telnet-send-input "telnet" nil t) - (autoload 'timezone-parse-date "timezone")) - -;; Declare nndb as derived from nntp - -(nnoo-declare nndb nntp) - -;; Variables specific to nndb - -;;- currently not used but just in case... -(defvoo nndb-deliver-program "nndel" - "*The program used to put a message in an NNDB group.") - -(defvoo nndb-server-side-expiry nil - "If t, expiry calculation will occur on the server side") - -(defvoo nndb-set-expire-date-on-mark nil - "If t, the expiry date for a given article will be set to the time -it was marked as expireable; otherwise the date will be the time the -article was posted to nndb") - -;; Variables copied from nntp - -(defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file) - "Like nntp-server-opened-hook." - nntp-server-opened-hook) - -(defvoo nndb-address "localhost" - "*The name of the NNDB server." - nntp-address) - -(defvoo nndb-port-number 9000 - "*Port number to connect to." - nntp-port-number) - -;; change to 'news if you are actually using nndb for news -(defvoo nndb-article-type 'mail) - -(defvoo nndb-status-string nil "" nntp-status-string) - - - -(defconst nndb-version "nndb 0.7" - "Version numbers of this version of NNDB.") - - -;;; Interface functions. - -(nnoo-define-basics nndb) - -;;------------------------------------------------------------------ - -;; this function turns the lisp list into a string list. There is -;; probably a more efficient way to do this. -(defun nndb-build-article-string (articles) - (let (art-string art) - (while articles - (setq art (pop articles)) - (setq art-string (concat art-string art " "))) - art-string)) - -(defun nndb-build-expire-rest-list (total expire) - (let (art rest) - (while total - (setq art (pop total)) - (if (memq art expire) - () - (push art rest))) - rest)) - - -;; -(deffoo nndb-request-type (group &optional article) - nndb-article-type) - -;; nndb-request-update-info does not exist and is not needed - -;; nndb-request-update-mark does not exist; it should be used to TOUCH -;; articles as they are marked exipirable -(defun nndb-touch-article (group article) - (nntp-send-command nil "X-TOUCH" article)) - -(deffoo nndb-request-update-mark - (group article mark) - "Sets the expiry date for ARTICLE in GROUP to now, if the mark is 'E'" - (if (and nndb-set-expire-date-on-mark (string-equal mark "E")) - (nndb-touch-article group article)) - mark) - -;; nndb-request-create-group -- currently this isn't necessary; nndb -;; creates groups on demand. - -;; todo -- use some other time than the creation time of the article -;; best is time since article has been marked as expirable - -(defun nndb-request-expire-articles-local - (articles &optional group server force) - "Let gnus do the date check and issue the delete commands." - (let (msg art delete-list (num-delete 0) rest) - (nntp-possibly-change-group group server) - (while articles - (setq art (pop articles)) - (nntp-send-command "^\\([23]\\|^423\\).*\n" "X-DATE" art) - (setq msg (nndb-status-message)) - (if (string-match "^423" msg) - () - (or (string-match "'\\(.+\\)'" msg) - (error "Not a valid response for X-DATE command: %s" - msg)) - (if (nnmail-expired-article-p - group - (gnus-encode-date - (substring msg (match-beginning 1) (match-end 1))) - force) - (progn - (setq delete-list (concat delete-list " " (int-to-string art))) - (setq num-delete (1+ num-delete))) - (push art rest)))) - (if (> (length delete-list) 0) - (progn - (nnheader-message 5 "Deleting %s article(s) from %s" - (int-to-string num-delete) group) - (nntp-send-command "^[23].*\n" "X-DELETE" delete-list)) - ) - - (message "") - (nconc rest articles))) - -(defun nndb-get-remote-expire-response () - (let (list) - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (if (looking-at "^[34]") - ;; x-expire returned error--presume no articles were expirable) - (setq list nil) - ;; otherwise, pull all of the following numbers into the list - (re-search-forward "follows\r?\n?" nil t) - (while (re-search-forward "^[0-9]+$" nil t) - (push (string-to-int (match-string 0)) list))) - list)) - -(defun nndb-request-expire-articles-remote - (articles &optional group server force) - "Let the nndb backend expire articles" - (let (days art-string delete-list (num-delete 0)) - (nntp-possibly-change-group group server) - - ;; first calculate the wait period in days - (setq days (or (and nnmail-expiry-wait-function - (funcall nnmail-expiry-wait-function group)) - nnmail-expiry-wait)) - ;; now handle the special cases - (cond (force - (setq days 0)) - ((eq days 'never) - ;; This isn't an expirable group. - (setq days -1)) - ((eq days 'immediate) - (setq days 0))) - - - ;; build article string - (setq art-string (concat days " " (nndb-build-article-string articles))) - (nntp-send-command "^\.\r?\n\\|^[345].*\n" "X-EXPIRE" art-string) - - (setq delete-list (nndb-get-remote-expire-response)) - (setq num-delete (length delete-list)) - (if (> num-delete 0) - (nnheader-message 5 "Deleting %s article(s) from %s" - (int-to-string num-delete) group)) - - (nndb-build-expire-rest-list articles delete-list))) - -(deffoo nndb-request-expire-articles - (articles &optional group server force) - "Expires ARTICLES from GROUP on SERVER. -If FORCE, delete regardless of exiration date, otherwise use normal -expiry mechanism." - (if nndb-server-side-expiry - (nndb-request-expire-articles-remote articles group server force) - (nndb-request-expire-articles-local articles group server force))) - -(deffoo nndb-request-move-article - (article group server accept-form &optional last) - "Move ARTICLE (a number) from GROUP on SERVER. -Evals ACCEPT-FORM in current buffer, where the article is. -Optional LAST is ignored." - ;; we guess that the second arg in accept-form is the new group, - ;; which it will be for nndb, which is all that matters anyway - (let ((new-group (nth 1 accept-form)) result) - (nntp-possibly-change-group group server) - - ;; use the move command for nndb-to-nndb moves - (if (string-match "^nndb" new-group) - (let ((new-group-name (gnus-group-real-name new-group))) - (nntp-send-command "^[23].*\n" "X-MOVE" article new-group-name) - (cons new-group article)) - ;; else move normally - (let ((artbuf (get-buffer-create " *nndb move*"))) - (and - (nndb-request-article article group server artbuf) - (save-excursion - (set-buffer artbuf) - (insert-buffer-substring nntp-server-buffer) - (setq result (eval accept-form)) - (kill-buffer (current-buffer)) - result) - (nndb-request-expire-articles (list article) - group - server - t)) - result) - ))) - -(deffoo nndb-request-accept-article (group server &optional last) - "The article in the current buffer is put into GROUP." - (nntp-possibly-change-group group server) - (let (art msg) - (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group) - (nnheader-insert "") - (nntp-send-buffer "^[23].*\n")) - - (set-buffer nntp-server-buffer) - (setq msg (buffer-string (point-min) (point-max))) - (or (string-match "^\\([0-9]+\\)" msg) - (error "nndb: %s" msg)) - (setq art (substring msg (match-beginning 1) (match-end 1))) - (message "nndb: accepted %s" art) - (list art))) - -(deffoo nndb-request-replace-article (article group buffer) - "ARTICLE is the number of the article in GROUP to be replaced -with the contents of the BUFFER." - (set-buffer buffer) - (when (nntp-send-command "^[23].*\r?\n" "X-REPLACE" (int-to-string article)) - (nnheader-insert "") - (nntp-send-buffer "^[23.*\n") - (list (int-to-string article)))) - -; nndb-request-delete-group does not exist -; todo -- maybe later - -; nndb-request-rename-group does not exist -; todo -- maybe later - -;; -- standard compatability functions - -(deffoo nndb-status-message (&optional server) - "Return server status as a string." - (set-buffer nntp-server-buffer) - (buffer-string (point-min) (point-max))) - -;; Import stuff from nntp - -(nnoo-import nndb - (nntp)) - -(provide 'nndb) - - - diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/nndir.el --- a/lisp/gnus/nndir.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,99 +0,0 @@ -;;; nndir.el --- single directory newsgroup access for Gnus -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'nnmh) -(require 'nnml) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nndir - nnml nnmh) - -(defvoo nndir-directory nil - "Where nndir will look for groups." - nnml-current-directory nnmh-current-directory) - -(defvoo nndir-nov-is-evil nil - "*Non-nil means that nndir will never retrieve NOV headers." - nnml-nov-is-evil) - - - -(defvoo nndir-current-group "" nil nnml-current-group nnmh-current-group) -(defvoo nndir-top-directory nil nil nnml-directory nnmh-directory) -(defvoo nndir-get-new-mail nil nil nnml-get-new-mail nnmh-get-new-mail) - -(defvoo nndir-status-string "" nil nnmh-status-string) -(defconst nndir-version "nndir 1.0") - - - -;;; Interface functions. - -(nnoo-define-basics nndir) - -(deffoo nndir-open-server (server &optional defs) - (setq nndir-directory - (or (cadr (assq 'nndir-directory defs)) - server)) - (unless (assq 'nndir-directory defs) - (push `(nndir-directory ,server) defs)) - (push `(nndir-current-group - ,(file-name-nondirectory (directory-file-name nndir-directory))) - defs) - (push `(nndir-top-directory - ,(file-name-directory (directory-file-name nndir-directory))) - defs) - (nnoo-change-server 'nndir server defs) - (let (err) - (cond - ((not (condition-case arg - (file-exists-p nndir-directory) - (ftp-error (setq err (format "%s" arg))))) - (nndir-close-server) - (nnheader-report - 'nndir (or err "No such file or directory: %s" nndir-directory))) - ((not (file-directory-p (file-truename nndir-directory))) - (nndir-close-server) - (nnheader-report 'nndir "Not a directory: %s" nndir-directory)) - (t - (nnheader-report 'nndir "Opened server %s using directory %s" - server nndir-directory) - t)))) - -(nnoo-map-functions nndir - (nnml-retrieve-headers 0 nndir-current-group 0 0) - (nnmh-request-article 0 nndir-current-group 0 0) - (nnmh-request-group nndir-current-group 0 0) - (nnml-close-group nndir-current-group 0) - (nnmh-request-list (nnoo-current-server 'nndir) nndir-directory) - (nnmh-request-newsgroups (nnoo-current-server 'nndir) nndir-directory)) - -(provide 'nndir) - -;;; nndir.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/nndoc.el --- a/lisp/gnus/nndoc.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,628 +0,0 @@ -;;; nndoc.el --- single file access for Gnus -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'message) -(require 'nnmail) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nndoc) - -(defvoo nndoc-article-type 'guess - "*Type of the file. -One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward', -`rfc934', `rfc822-forward', `mime-digest', `standard-digest', -`slack-digest', `clari-briefs' or `guess'.") - -(defvoo nndoc-post-type 'mail - "*Whether the nndoc group is `mail' or `post'.") - -(defvar nndoc-type-alist - `((mmdf - (article-begin . "^\^A\^A\^A\^A\n") - (body-end . "^\^A\^A\^A\^A\n")) - (news - (article-begin . "^Path:")) - (rnews - (article-begin . "^#! *rnews +\\([0-9]+\\) *\n") - (body-end-function . nndoc-rnews-body-end)) - (mbox - (article-begin-function . nndoc-mbox-article-begin) - (body-end-function . nndoc-mbox-body-end)) - (babyl - (article-begin . "\^_\^L *\n") - (body-end . "\^_") - (body-begin-function . nndoc-babyl-body-begin) - (head-begin-function . nndoc-babyl-head-begin)) - (forward - (article-begin . "^-+ Start of forwarded message -+\n+") - (body-end . "^-+ End of forwarded message -+$") - (prepare-body-function . nndoc-unquote-dashes)) - (rfc934 - (article-begin . "^--.*\n+") - (body-end . "^--.*$") - (prepare-body-function . nndoc-unquote-dashes)) - (clari-briefs - (article-begin . "^ \\*") - (body-end . "^\t------*[ \t]^*\n^ \\*") - (body-begin . "^\t") - (head-end . "^\t") - (generate-head-function . nndoc-generate-clari-briefs-head) - (article-transform-function . nndoc-transform-clari-briefs)) - (mime-digest - (article-begin . "") - (head-end . "^ ?$") - (body-end . "") - (file-end . "") - (subtype digest guess)) - (standard-digest - (first-article . ,(concat "^" (make-string 70 ?-) "\n\n+")) - (article-begin . ,(concat "^\n" (make-string 30 ?-) "\n\n+")) - (prepare-body-function . nndoc-unquote-dashes) - (body-end-function . nndoc-digest-body-end) - (head-end . "^ ?$") - (body-begin . "^ ?\n") - (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$") - (subtype digest guess)) - (slack-digest - (article-begin . "^------------------------------*[\n \t]+") - (head-end . "^ ?$") - (body-end-function . nndoc-digest-body-end) - (body-begin . "^ ?$") - (file-end . "^End of") - (prepare-body-function . nndoc-unquote-dashes) - (subtype digest guess)) - (lanl-gov-announce - (article-begin . "^\\\\\\\\\n") - (head-begin . "^Paper.*:") - (head-end . "\\(^\\\\\\\\.*\n\\|-----------------\\)") - (body-begin . "") - (body-end . "-------------------------------------------------") - (file-end . "^Title: Recent Seminal") - (generate-head-function . nndoc-generate-lanl-gov-head) - (article-transform-function . nndoc-transform-lanl-gov-announce) - (subtype preprints guess)) - (rfc822-forward - (article-begin . "^\n") - (body-end-function . nndoc-rfc822-forward-body-end-function)) - (guess - (guess . t) - (subtype nil)) - (digest - (guess . t) - (subtype nil)) - (preprints - (guess . t) - (subtype nil)))) - - - -(defvoo nndoc-file-begin nil) -(defvoo nndoc-first-article nil) -(defvoo nndoc-article-end nil) -(defvoo nndoc-article-begin nil) -(defvoo nndoc-head-begin nil) -(defvoo nndoc-head-end nil) -(defvoo nndoc-file-end nil) -(defvoo nndoc-body-begin nil) -(defvoo nndoc-body-end-function nil) -(defvoo nndoc-body-begin-function nil) -(defvoo nndoc-head-begin-function nil) -(defvoo nndoc-body-end nil) -(defvoo nndoc-dissection-alist nil) -(defvoo nndoc-prepare-body-function nil) -(defvoo nndoc-generate-head-function nil) -(defvoo nndoc-article-transform-function nil) -(defvoo nndoc-article-begin-function nil) - -(defvoo nndoc-status-string "") -(defvoo nndoc-group-alist nil) -(defvoo nndoc-current-buffer nil - "Current nndoc news buffer.") -(defvoo nndoc-address nil) - -(defconst nndoc-version "nndoc 1.0" - "nndoc version.") - - - -;;; Interface functions - -(nnoo-define-basics nndoc) - -(deffoo nndoc-retrieve-headers (articles &optional newsgroup server fetch-old) - (when (nndoc-possibly-change-buffer newsgroup server) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let (article entry) - (if (stringp (car articles)) - 'headers - (while articles - (when (setq entry (cdr (assq (setq article (pop articles)) - nndoc-dissection-alist))) - (insert (format "221 %d Article retrieved.\n" article)) - (if nndoc-generate-head-function - (funcall nndoc-generate-head-function article) - (insert-buffer-substring - nndoc-current-buffer (car entry) (nth 1 entry))) - (goto-char (point-max)) - (unless (= (char-after (1- (point))) ?\n) - (insert "\n")) - (insert (format "Lines: %d\n" (nth 4 entry))) - (insert ".\n"))) - - (nnheader-fold-continuation-lines) - 'headers))))) - -(deffoo nndoc-request-article (article &optional newsgroup server buffer) - (nndoc-possibly-change-buffer newsgroup server) - (save-excursion - (let ((buffer (or buffer nntp-server-buffer)) - (entry (cdr (assq article nndoc-dissection-alist))) - beg) - (set-buffer buffer) - (erase-buffer) - (when entry - (if (stringp article) - nil - (insert-buffer-substring - nndoc-current-buffer (car entry) (nth 1 entry)) - (insert "\n") - (setq beg (point)) - (insert-buffer-substring - nndoc-current-buffer (nth 2 entry) (nth 3 entry)) - (goto-char beg) - (when nndoc-prepare-body-function - (funcall nndoc-prepare-body-function)) - (when nndoc-article-transform-function - (funcall nndoc-article-transform-function article)) - t))))) - -(deffoo nndoc-request-group (group &optional server dont-check) - "Select news GROUP." - (let (number) - (cond - ((not (nndoc-possibly-change-buffer group server)) - (nnheader-report 'nndoc "No such file or buffer: %s" - nndoc-address)) - (dont-check - (nnheader-report 'nndoc "Selected group %s" group) - t) - ((zerop (setq number (length nndoc-dissection-alist))) - (nndoc-close-group group) - (nnheader-report 'nndoc "No articles in group %s" group)) - (t - (nnheader-insert "211 %d %d %d %s\n" number 1 number group))))) - -(deffoo nndoc-request-type (group &optional article) - (cond ((not article) 'unknown) - (nndoc-post-type nndoc-post-type) - (t 'unknown))) - -(deffoo nndoc-close-group (group &optional server) - (nndoc-possibly-change-buffer group server) - (and nndoc-current-buffer - (buffer-name nndoc-current-buffer) - (kill-buffer nndoc-current-buffer)) - (setq nndoc-group-alist (delq (assoc group nndoc-group-alist) - nndoc-group-alist)) - (setq nndoc-current-buffer nil) - (nnoo-close-server 'nndoc server) - (setq nndoc-dissection-alist nil) - t) - -(deffoo nndoc-request-list (&optional server) - nil) - -(deffoo nndoc-request-newgroups (date &optional server) - nil) - -(deffoo nndoc-request-list-newsgroups (&optional server) - nil) - - -;;; Internal functions. - -(defun nndoc-possibly-change-buffer (group source) - (let (buf) - (cond - ;; The current buffer is this group's buffer. - ((and nndoc-current-buffer - (buffer-name nndoc-current-buffer) - (eq nndoc-current-buffer - (setq buf (cdr (assoc group nndoc-group-alist)))))) - ;; We change buffers by taking an old from the group alist. - ;; `source' is either a string (a file name) or a buffer object. - (buf - (setq nndoc-current-buffer buf)) - ;; It's a totally new group. - ((or (and (bufferp nndoc-address) - (buffer-name nndoc-address)) - (and (stringp nndoc-address) - (file-exists-p nndoc-address) - (not (file-directory-p nndoc-address)))) - (push (cons group (setq nndoc-current-buffer - (get-buffer-create - (concat " *nndoc " group "*")))) - nndoc-group-alist) - (setq nndoc-dissection-alist nil) - (save-excursion - (set-buffer nndoc-current-buffer) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (if (stringp nndoc-address) - (nnheader-insert-file-contents nndoc-address) - (insert-buffer-substring nndoc-address))))) - ;; Initialize the nndoc structures according to this new document. - (when (and nndoc-current-buffer - (not nndoc-dissection-alist)) - (save-excursion - (set-buffer nndoc-current-buffer) - (nndoc-set-delims) - (nndoc-dissect-buffer))) - (unless nndoc-current-buffer - (nndoc-close-server)) - ;; Return whether we managed to select a file. - nndoc-current-buffer)) - -;;; -;;; Deciding what document type we have -;;; - -(defun nndoc-set-delims () - "Set the nndoc delimiter variables according to the type of the document." - (let ((vars '(nndoc-file-begin - nndoc-first-article - nndoc-article-end nndoc-head-begin nndoc-head-end - nndoc-file-end nndoc-article-begin - nndoc-body-begin nndoc-body-end-function nndoc-body-end - nndoc-prepare-body-function nndoc-article-transform-function - nndoc-generate-head-function nndoc-body-begin-function - nndoc-head-begin-function))) - (while vars - (set (pop vars) nil))) - (let (defs) - ;; Guess away until we find the real file type. - (while (assq 'guess (setq defs (cdr (assq nndoc-article-type - nndoc-type-alist)))) - (setq nndoc-article-type (nndoc-guess-type nndoc-article-type))) - ;; Set the nndoc variables. - (while defs - (set (intern (format "nndoc-%s" (caar defs))) - (cdr (pop defs)))))) - -(defun nndoc-guess-type (subtype) - (let ((alist nndoc-type-alist) - results result entry) - (while (and (not result) - (setq entry (pop alist))) - (when (memq subtype (or (cdr (assq 'subtype entry)) '(guess))) - (goto-char (point-min)) - (when (numberp (setq result (funcall (intern - (format "nndoc-%s-type-p" - (car entry)))))) - (push (cons result entry) results) - (setq result nil)))) - (unless (or result results) - (error "Document is not of any recognized type")) - (if result - (car entry) - (cadar (sort results (lambda (r1 r2) (< (car r1) (car r2)))))))) - -;;; -;;; Built-in type predicates and functions -;;; - -(defun nndoc-mbox-type-p () - (when (looking-at message-unix-mail-delimiter) - t)) - -(defun nndoc-mbox-article-begin () - (when (re-search-forward (concat "^" message-unix-mail-delimiter) nil t) - (goto-char (match-beginning 0)))) - -(defun nndoc-mbox-body-end () - (let ((beg (point)) - len end) - (when - (save-excursion - (and (re-search-backward - (concat "^" message-unix-mail-delimiter) nil t) - (setq end (point)) - (search-forward "\n\n" beg t) - (re-search-backward - "^Content-Length:[ \t]*\\([0-9]+\\) *$" end t) - (setq len (string-to-int (match-string 1))) - (search-forward "\n\n" beg t) - (unless (= (setq len (+ (point) len)) (point-max)) - (and (< len (point-max)) - (goto-char len) - (looking-at message-unix-mail-delimiter))))) - (goto-char len)))) - -(defun nndoc-mmdf-type-p () - (when (looking-at "\^A\^A\^A\^A$") - t)) - -(defun nndoc-news-type-p () - (when (looking-at "^Path:.*\n") - t)) - -(defun nndoc-rnews-type-p () - (when (looking-at "#! *rnews") - t)) - -(defun nndoc-rnews-body-end () - (and (re-search-backward nndoc-article-begin nil t) - (forward-line 1) - (goto-char (+ (point) (string-to-int (match-string 1)))))) - -(defun nndoc-babyl-type-p () - (when (re-search-forward "\^_\^L *\n" nil t) - t)) - -(defun nndoc-babyl-body-begin () - (re-search-forward "^\n" nil t) - (when (looking-at "\*\*\* EOOH \*\*\*") - (let ((next (or (save-excursion - (re-search-forward nndoc-article-begin nil t)) - (point-max)))) - (unless (re-search-forward "^\n" next t) - (goto-char next) - (forward-line -1) - (insert "\n") - (forward-line -1))))) - -(defun nndoc-babyl-head-begin () - (when (re-search-forward "^[0-9].*\n" nil t) - (when (looking-at "\*\*\* EOOH \*\*\*") - (forward-line 1)) - t)) - -(defun nndoc-forward-type-p () - (when (and (re-search-forward "^-+ Start of forwarded message -+\n+" nil t) - (not (re-search-forward "^Subject:.*digest" nil t)) - (not (re-search-backward "^From:" nil t 2)) - (not (re-search-forward "^From:" nil t 2))) - t)) - -(defun nndoc-rfc934-type-p () - (when (and (re-search-forward "^-+ Start of forwarded.*\n+" nil t) - (not (re-search-forward "^Subject:.*digest" nil t)) - (not (re-search-backward "^From:" nil t 2)) - (not (re-search-forward "^From:" nil t 2))) - t)) - -(defun nndoc-rfc822-forward-type-p () - (save-restriction - (message-narrow-to-head) - (when (re-search-forward "^Content-Type: *message/rfc822" nil t) - t))) - -(defun nndoc-rfc822-forward-body-end-function () - (goto-char (point-max))) - -(defun nndoc-clari-briefs-type-p () - (when (let ((case-fold-search nil)) - (re-search-forward "^\t[^a-z]+ ([^a-z]+) --" nil t)) - t)) - -(defun nndoc-transform-clari-briefs (article) - (goto-char (point-min)) - (when (looking-at " *\\*\\(.*\\)\n") - (replace-match "" t t)) - (nndoc-generate-clari-briefs-head article)) - -(defun nndoc-generate-clari-briefs-head (article) - (let ((entry (cdr (assq article nndoc-dissection-alist))) - subject from) - (save-excursion - (set-buffer nndoc-current-buffer) - (save-restriction - (narrow-to-region (car entry) (nth 3 entry)) - (goto-char (point-min)) - (when (looking-at " *\\*\\(.*\\)$") - (setq subject (match-string 1)) - (when (string-match "[ \t]+$" subject) - (setq subject (substring subject 0 (match-beginning 0))))) - (when - (let ((case-fold-search nil)) - (re-search-forward - "^\t\\([^a-z]+\\(,[^(]+\\)? ([^a-z]+)\\) --" nil t)) - (setq from (match-string 1))))) - (insert "From: " "clari@clari.net (" (or from "unknown") ")" - "\nSubject: " (or subject "(no subject)") "\n"))) - -(defun nndoc-mime-digest-type-p () - (let ((case-fold-search t) - boundary-id b-delimiter entry) - (when (and - (re-search-forward - (concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]" - "boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"") - nil t) - (match-beginning 1)) - (setq boundary-id (match-string 1) - b-delimiter (concat "\n--" boundary-id "[\n \t]+")) - (setq entry (assq 'mime-digest nndoc-type-alist)) - (setcdr entry - (list - (cons 'head-end "^ ?$") - (cons 'body-begin "^ ?\n") - (cons 'article-begin b-delimiter) - (cons 'body-end-function 'nndoc-digest-body-end) - (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$")))) - t))) - -(defun nndoc-standard-digest-type-p () - (when (and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t) - (re-search-forward - (concat "\n\n" (make-string 30 ?-) "\n\n") nil t)) - t)) - -(defun nndoc-digest-body-end () - (and (re-search-forward nndoc-article-begin nil t) - (goto-char (match-beginning 0)))) - -(defun nndoc-slack-digest-type-p () - 0) - -(defun nndoc-lanl-gov-announce-type-p () - (when (let ((case-fold-search nil)) - (re-search-forward "^\\\\\\\\\nPaper: [a-z-]+/[0-9]+" nil t)) - t)) - -(defun nndoc-transform-lanl-gov-announce (article) - (goto-char (point-max)) - (when (re-search-backward "^\\\\\\\\ +(\\([^ ]*\\) , *\\([^ ]*\\))" nil t) - (replace-match "\n\nGet it at \\1 (\\2)" t nil)) - ;; (when (re-search-backward "^\\\\\\\\$" nil t) - ;; (replace-match "" t t)) - ) - -(defun nndoc-generate-lanl-gov-head (article) - (let ((entry (cdr (assq article nndoc-dissection-alist))) - (e-mail "no address given") - subject from) - (save-excursion - (set-buffer nndoc-current-buffer) - (save-restriction - (narrow-to-region (car entry) (nth 1 entry)) - (goto-char (point-min)) - (when (looking-at "^Paper.*: \\([a-z-]+/[0-9]+\\)") - (setq subject (concat " (" (match-string 1) ")")) - (when (re-search-forward "^From: \\([^ ]+\\)" nil t) - (setq e-mail (match-string 1))) - (when (re-search-forward "^Title: \\([^\f]*\\)\nAuthors?: \\(.*\\)" - nil t) - (setq subject (concat (match-string 1) subject)) - (setq from (concat (match-string 2) " <" e-mail ">")))) - )) - (while (and from (string-match "(\[^)\]*)" from)) - (setq from (replace-match "" t t from))) - (insert "From: " (or from "unknown") - "\nSubject: " (or subject "(no subject)") "\n"))) - - - -;;; -;;; Functions for dissecting the documents -;;; - -(defun nndoc-search (regexp) - (prog1 - (re-search-forward regexp nil t) - (beginning-of-line))) - -(defun nndoc-dissect-buffer () - "Go through the document and partition it into heads/bodies/articles." - (let ((i 0) - (first t) - head-begin head-end body-begin body-end) - (setq nndoc-dissection-alist nil) - (save-excursion - (set-buffer nndoc-current-buffer) - (goto-char (point-min)) - ;; Find the beginning of the file. - (when nndoc-file-begin - (nndoc-search nndoc-file-begin)) - ;; Go through the file. - (while (if (and first nndoc-first-article) - (nndoc-search nndoc-first-article) - (nndoc-article-begin)) - (setq first nil) - (cond (nndoc-head-begin-function - (funcall nndoc-head-begin-function)) - (nndoc-head-begin - (nndoc-search nndoc-head-begin))) - (if (or (>= (point) (point-max)) - (and nndoc-file-end - (looking-at nndoc-file-end))) - (goto-char (point-max)) - (setq head-begin (point)) - (nndoc-search (or nndoc-head-end "^$")) - (setq head-end (point)) - (if nndoc-body-begin-function - (funcall nndoc-body-begin-function) - (nndoc-search (or nndoc-body-begin "^\n"))) - (setq body-begin (point)) - (or (and nndoc-body-end-function - (funcall nndoc-body-end-function)) - (and nndoc-body-end - (nndoc-search nndoc-body-end)) - (nndoc-article-begin) - (progn - (goto-char (point-max)) - (when nndoc-file-end - (and (re-search-backward nndoc-file-end nil t) - (beginning-of-line))))) - (setq body-end (point)) - (push (list (incf i) head-begin head-end body-begin body-end - (count-lines body-begin body-end)) - nndoc-dissection-alist)))))) - -(defun nndoc-article-begin () - (if nndoc-article-begin-function - (funcall nndoc-article-begin-function) - (ignore-errors - (nndoc-search nndoc-article-begin)))) - -(defun nndoc-unquote-dashes () - "Unquote quoted non-separators in digests." - (while (re-search-forward "^- -"nil t) - (replace-match "-" t t))) - -;;;###autoload -(defun nndoc-add-type (definition &optional position) - "Add document DEFINITION to the list of nndoc document definitions. -If POSITION is nil or `last', the definition will be added -as the last checked definition, if t or `first', add as the -first definition, and if any other symbol, add after that -symbol in the alist." - ;; First remove any old instances. - (setq nndoc-type-alist - (delq (assq (car definition) nndoc-type-alist) - nndoc-type-alist)) - ;; Then enter the new definition in the proper place. - (cond - ((or (null position) (eq position 'last)) - (setq nndoc-type-alist (nconc nndoc-type-alist (list definition)))) - ((or (eq position t) (eq position 'first)) - (push definition nndoc-type-alist)) - (t - (let ((list (memq (assq position nndoc-type-alist) - nndoc-type-alist))) - (unless list - (error "No such position: %s" position)) - (setcdr list (cons definition (cdr list))))))) - -(provide 'nndoc) - -;;; nndoc.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/nndraft.el --- a/lisp/gnus/nndraft.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,248 +0,0 @@ -;;; nndraft.el --- draft article access for Gnus -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'nnmh) -(require 'nnoo) -(eval-and-compile (require 'cl)) - -(nnoo-declare nndraft) - -(eval-and-compile - (autoload 'mail-send-and-exit "sendmail")) - -(defvoo nndraft-directory nil - "Where nndraft will store its directory.") - - - -(defconst nndraft-version "nndraft 1.0") -(defvoo nndraft-status-string "") - - - -;;; Interface functions. - -(nnoo-define-basics nndraft) - -(deffoo nndraft-retrieve-headers (articles &optional group server fetch-old) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let* ((buf (get-buffer-create " *draft headers*")) - article) - (set-buffer buf) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - ;; We don't support fetching by Message-ID. - (if (stringp (car articles)) - 'headers - (while articles - (set-buffer buf) - (when (nndraft-request-article - (setq article (pop articles)) group server (current-buffer)) - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (forward-line -1) - (goto-char (point-max))) - (delete-region (point) (point-max)) - (set-buffer nntp-server-buffer) - (goto-char (point-max)) - (insert (format "221 %d Article retrieved.\n" article)) - (insert-buffer-substring buf) - (insert ".\n"))) - - (nnheader-fold-continuation-lines) - 'headers)))) - -(deffoo nndraft-open-server (server &optional defs) - (nnoo-change-server 'nndraft server defs) - (unless (assq 'nndraft-directory defs) - (setq nndraft-directory server)) - (cond - ((not (file-exists-p nndraft-directory)) - (nndraft-close-server) - (nnheader-report 'nndraft "No such file or directory: %s" - nndraft-directory)) - ((not (file-directory-p (file-truename nndraft-directory))) - (nndraft-close-server) - (nnheader-report 'nndraft "Not a directory: %s" nndraft-directory)) - (t - (nnheader-report 'nndraft "Opened server %s using directory %s" - server nndraft-directory) - t))) - -(deffoo nndraft-request-article (id &optional group server buffer) - (when (numberp id) - ;; We get the newest file of the auto-saved file and the - ;; "real" file. - (let* ((file (nndraft-article-filename id)) - (auto (nndraft-auto-save-file-name file)) - (newest (if (file-newer-than-file-p file auto) file auto)) - (nntp-server-buffer (or buffer nntp-server-buffer))) - (when (and (file-exists-p newest) - (nnmail-find-file newest)) - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - ;; If there's a mail header separator in this file, - ;; we remove it. - (when (re-search-forward - (concat "^" mail-header-separator "$") nil t) - (replace-match "" t t))) - t)))) - -(deffoo nndraft-request-restore-buffer (article &optional group server) - "Request a new buffer that is restored to the state of ARTICLE." - (let ((file (nndraft-article-filename article ".state")) - nndraft-point nndraft-mode nndraft-buffer-name) - (when (file-exists-p file) - (load file t t t) - (when nndraft-buffer-name - (set-buffer (get-buffer-create - (generate-new-buffer-name nndraft-buffer-name))) - (nndraft-request-article article group server (current-buffer)) - (funcall nndraft-mode) - (let ((gnus-verbose-backends nil)) - (nndraft-request-expire-articles (list article) group server t)) - (goto-char nndraft-point)) - nndraft-buffer-name))) - -(deffoo nndraft-request-update-info (group info &optional server) - (setcar (cddr info) nil) - (when (nth 3 info) - (setcar (nthcdr 3 info) nil)) - t) - -(deffoo nndraft-request-associate-buffer (group) - "Associate the current buffer with some article in the draft group." - (let* ((gnus-verbose-backends nil) - (article (cdr (nndraft-request-accept-article - group (nnoo-current-server 'nndraft) t 'noinsert))) - (file (nndraft-article-filename article))) - (setq buffer-file-name file) - (setq buffer-auto-save-file-name (make-auto-save-file-name)) - (clear-visited-file-modtime) - article)) - -(deffoo nndraft-request-group (group &optional server dont-check) - (prog1 - (nndraft-execute-nnmh-command - `(nnmh-request-group group "" ,dont-check)) - (nnheader-report 'nndraft nnmh-status-string))) - -(deffoo nndraft-request-list (&optional server dir) - (nndraft-execute-nnmh-command - `(nnmh-request-list nil ,dir))) - -(deffoo nndraft-request-newgroups (date &optional server) - (nndraft-execute-nnmh-command - `(nnmh-request-newgroups ,date ,server))) - -(deffoo nndraft-request-expire-articles - (articles group &optional server force) - (let ((res (nndraft-execute-nnmh-command - `(nnmh-request-expire-articles - ',articles group ,server ,force))) - article) - ;; Delete all the "state" files of articles that have been expired. - (while articles - (unless (memq (setq article (pop articles)) res) - (let ((file (nndraft-article-filename article ".state")) - (auto (nndraft-auto-save-file-name - (nndraft-article-filename article)))) - (when (file-exists-p file) - (funcall nnmail-delete-file-function file)) - (when (file-exists-p auto) - (funcall nnmail-delete-file-function auto))))) - res)) - -(deffoo nndraft-request-accept-article (group &optional server last noinsert) - (let* ((point (point)) - (mode major-mode) - (name (buffer-name)) - (gnus-verbose-backends nil) - (gart (nndraft-execute-nnmh-command - `(nnmh-request-accept-article group ,server ,last noinsert))) - (state - (nndraft-article-filename (cdr gart) ".state"))) - ;; Write the "state" file. - (save-excursion - (nnheader-set-temp-buffer " *draft state*") - (insert (format "%S\n" `(setq nndraft-mode (quote ,mode) - nndraft-point ,point - nndraft-buffer-name ,name))) - (write-region (point-min) (point-max) state nil 'silent) - (kill-buffer (current-buffer))) - gart)) - -(deffoo nndraft-close-group (group &optional server) - t) - -(deffoo nndraft-request-create-group (group &optional server args) - (if (file-exists-p nndraft-directory) - (if (file-directory-p nndraft-directory) - t - nil) - (condition-case () - (progn - (gnus-make-directory nndraft-directory) - t) - (file-error nil)))) - - -;;; Low-Level Interface - -(defun nndraft-execute-nnmh-command (command) - (let ((dir (expand-file-name nndraft-directory))) - (when (string-match "/$" dir) - (setq dir (substring dir 0 (match-beginning 0)))) - (string-match "/[^/]+$" dir) - (let ((group (substring dir (1+ (match-beginning 0)))) - (nnmh-directory (substring dir 0 (1+ (match-beginning 0)))) - (nnmail-keep-last-article nil) - (nnmh-get-new-mail nil)) - (eval command)))) - -(defun nndraft-article-filename (article &rest args) - (apply 'concat - (file-name-as-directory nndraft-directory) - (int-to-string article) - args)) - -(defun nndraft-auto-save-file-name (file) - (save-excursion - (prog1 - (progn - (set-buffer (get-buffer-create " *draft tmp*")) - (setq buffer-file-name file) - (make-auto-save-file-name)) - (kill-buffer (current-buffer))))) - -(provide 'nndraft) - -;;; nndraft.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/nneething.el --- a/lisp/gnus/nneething.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,350 +0,0 @@ -;;; nneething.el --- random file access for Gnus -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'nnmail) -(require 'nnoo) -(require 'gnus-util) -(require 'cl) - -(nnoo-declare nneething) - -(defvoo nneething-map-file-directory "~/.nneething/" - "Where nneething stores the map files.") - -(defvoo nneething-map-file ".nneething" - "Name of the map files.") - -(defvoo nneething-exclude-files nil - "Regexp saying what files to exclude from the group. -If this variable is nil, no files will be excluded.") - - - -;;; Internal variables. - -(defconst nneething-version "nneething 1.0" - "nneething version.") - -(defvoo nneething-current-directory nil - "Current news group directory.") - -(defvoo nneething-status-string "") - -(defvoo nneething-message-id-number 0) -(defvoo nneething-work-buffer " *nneething work*") - -(defvoo nneething-group nil) -(defvoo nneething-map nil) -(defvoo nneething-read-only nil) -(defvoo nneething-active nil) - - - -;;; Interface functions. - -(nnoo-define-basics nneething) - -(deffoo nneething-retrieve-headers (articles &optional group server fetch-old) - (nneething-possibly-change-directory group) - - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let* ((number (length articles)) - (count 0) - (large (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup))) - article file) - - (if (stringp (car articles)) - 'headers - - (while (setq article (pop articles)) - (setq file (nneething-file-name article)) - - (when (and (file-exists-p file) - (or (file-directory-p file) - (not (zerop (nnheader-file-size file))))) - (insert (format "221 %d Article retrieved.\n" article)) - (nneething-insert-head file) - (insert ".\n")) - - (incf count) - - (and large - (zerop (% count 20)) - (message "nneething: Receiving headers... %d%%" - (/ (* count 100) number)))) - - (when large - (message "nneething: Receiving headers...done")) - - (nnheader-fold-continuation-lines) - 'headers)))) - -(deffoo nneething-request-article (id &optional group server buffer) - (nneething-possibly-change-directory group) - (let ((file (unless (stringp id) - (nneething-file-name id))) - (nntp-server-buffer (or buffer nntp-server-buffer))) - (and (stringp file) ; We did not request by Message-ID. - (file-exists-p file) ; The file exists. - (not (file-directory-p file)) ; It's not a dir. - (save-excursion - (nnmail-find-file file) ; Insert the file in the nntp buf. - (unless (nnheader-article-p) ; Either it's a real article... - (goto-char (point-min)) - (nneething-make-head file (current-buffer)) ; ... or we fake some headers. - (insert "\n")) - t)))) - -(deffoo nneething-request-group (group &optional server dont-check) - (nneething-possibly-change-directory group server) - (unless dont-check - (nneething-create-mapping) - (if (> (car nneething-active) (cdr nneething-active)) - (nnheader-insert "211 0 1 0 %s\n" group) - (nnheader-insert - "211 %d %d %d %s\n" - (- (1+ (cdr nneething-active)) (car nneething-active)) - (car nneething-active) (cdr nneething-active) - group))) - t) - -(deffoo nneething-request-list (&optional server dir) - (nnheader-report 'nneething "LIST is not implemented.")) - -(deffoo nneething-request-newgroups (date &optional server) - (nnheader-report 'nneething "NEWSGROUPS is not implemented.")) - -(deffoo nneething-request-type (group &optional article) - 'unknown) - -(deffoo nneething-close-group (group &optional server) - (setq nneething-current-directory nil) - t) - -(deffoo nneething-open-server (server &optional defs) - (nnheader-init-server-buffer) - (if (nneething-server-opened server) - t - (unless (assq 'nneething-directory defs) - (setq defs (append defs (list (list 'nneething-directory server))))) - (nnoo-change-server 'nneething server defs))) - - -;;; Internal functions. - -(defun nneething-possibly-change-directory (group &optional server) - (when (and server - (not (nneething-server-opened server))) - (nneething-open-server server)) - (when (and group - (not (equal nneething-group group))) - (setq nneething-group group) - (setq nneething-map nil) - (setq nneething-active (cons 1 0)) - (nneething-create-mapping))) - -(defun nneething-map-file () - ;; We make sure that the .nneething directory exists. - (gnus-make-directory nneething-map-file-directory) - ;; We store it in a special directory under the user's home dir. - (concat (file-name-as-directory nneething-map-file-directory) - nneething-group nneething-map-file)) - -(defun nneething-create-mapping () - ;; Read nneething-active and nneething-map. - (when (file-exists-p nneething-directory) - (let ((map-file (nneething-map-file)) - (files (directory-files nneething-directory)) - touched map-files) - (when (file-exists-p map-file) - (ignore-errors - (load map-file nil t t))) - (unless nneething-active - (setq nneething-active (cons 1 0))) - ;; Old nneething had a different map format. - (when (and (cdar nneething-map) - (atom (cdar nneething-map))) - (setq nneething-map - (mapcar (lambda (n) - (list (cdr n) (car n) - (nth 5 (file-attributes - (nneething-file-name (car n)))))) - nneething-map))) - ;; Remove files matching the exclusion regexp. - (when nneething-exclude-files - (let ((f files) - prev) - (while f - (if (string-match nneething-exclude-files (car f)) - (if prev (setcdr prev (cdr f)) - (setq files (cdr files))) - (setq prev f)) - (setq f (cdr f))))) - ;; Remove deleted files from the map. - (let ((map nneething-map) - prev) - (while map - (if (and (member (cadar map) files) - ;; We also remove files that have changed mod times. - (equal (nth 5 (file-attributes - (nneething-file-name (cadar map)))) - (caddar map))) - (progn - (push (cadar map) map-files) - (setq prev map)) - (setq touched t) - (if prev - (setcdr prev (cdr map)) - (setq nneething-map (cdr nneething-map)))) - (setq map (cdr map)))) - ;; Find all new files and enter them into the map. - (while files - (unless (member (car files) map-files) - ;; This file is not in the map, so we enter it. - (setq touched t) - (setcdr nneething-active (1+ (cdr nneething-active))) - (push (list (cdr nneething-active) (car files) - (nth 5 (file-attributes - (nneething-file-name (car files))))) - nneething-map)) - (setq files (cdr files))) - (when (and touched - (not nneething-read-only)) - (nnheader-temp-write map-file - (insert "(setq nneething-map '") - (gnus-prin1 nneething-map) - (insert ")\n(setq nneething-active '") - (gnus-prin1 nneething-active) - (insert ")\n")))))) - -(defun nneething-insert-head (file) - "Insert the head of FILE." - (when (nneething-get-head file) - (insert-buffer-substring nneething-work-buffer) - (goto-char (point-max)))) - -(defun nneething-make-head (file &optional buffer) - "Create a head by looking at the file attributes of FILE." - (let ((atts (file-attributes file))) - (insert - "Subject: " (file-name-nondirectory file) "\n" - "Message-ID: \n" - (if (equal '(0 0) (nth 5 atts)) "" - (concat "Date: " (current-time-string (nth 5 atts)) "\n")) - (or (when buffer - (save-excursion - (set-buffer buffer) - (when (re-search-forward "<[a-zA-Z0-9_]@[-a-zA-Z0-9_]>" 1000 t) - (concat "From: " (match-string 0) "\n")))) - (nneething-from-line (nth 2 atts) file)) - (if (> (string-to-int (int-to-string (nth 7 atts))) 0) - (concat "Chars: " (int-to-string (nth 7 atts)) "\n") - "") - (if buffer - (save-excursion - (set-buffer buffer) - (concat "Lines: " (int-to-string - (count-lines (point-min) (point-max))) - "\n")) - "") - ))) - -(defun nneething-from-line (uid &optional file) - "Return a From header based of UID." - (let* ((login (condition-case nil - (user-login-name uid) - (error - (cond ((= uid (user-uid)) (user-login-name)) - ((zerop uid) "root") - (t (int-to-string uid)))))) - (name (condition-case nil - (user-full-name uid) - (error - (cond ((= uid (user-uid)) (user-full-name)) - ((zerop uid) "Ms. Root"))))) - (host (if (string-match "\\`/[^/@]*@\\([^:/]+\\):" file) - (prog1 - (substring file - (match-beginning 1) - (match-end 1)) - (when (string-match "/\\(users\\|home\\)/\\([^/]+\\)/" file) - (setq login (substring file - (match-beginning 2) - (match-end 2)) - name nil))) - (system-name)))) - (concat "From: " login "@" host - (if name (concat " (" name ")") "") "\n"))) - -(defun nneething-get-head (file) - "Either find the head in FILE or make a head for FILE." - (save-excursion - (set-buffer (get-buffer-create nneething-work-buffer)) - (setq case-fold-search nil) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (cond - ((not (file-exists-p file)) - ;; The file do not exist. - nil) - ((or (file-directory-p file) - (file-symlink-p file)) - ;; It's a dir, so we fudge a head. - (nneething-make-head file) t) - (t - ;; We examine the file. - (nnheader-insert-head file) - (if (nnheader-article-p) - (delete-region - (progn - (goto-char (point-min)) - (or (and (search-forward "\n\n" nil t) - (1- (point))) - (point-max))) - (point-max)) - (goto-char (point-min)) - (nneething-make-head file (current-buffer)) - (delete-region (point) (point-max))) - t)))) - -(defun nneething-file-name (article) - "Return the file name of ARTICLE." - (concat (file-name-as-directory nneething-directory) - (if (numberp article) - (cadr (assq article nneething-map)) - article))) - -(provide 'nneething) - -;;; nneething.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/nnfolder.el --- a/lisp/gnus/nnfolder.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,771 +0,0 @@ -;;; nnfolder.el --- mail folder access for Gnus -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Scott Byer -;; Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; Keywords: mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'message) -(require 'nnmail) -(require 'nnoo) -(require 'cl) -(require 'gnus-util) - -(nnoo-declare nnfolder) - -(defvoo nnfolder-directory (expand-file-name message-directory) - "The name of the nnfolder directory.") - -(defvoo nnfolder-active-file - (nnheader-concat nnfolder-directory "active") - "The name of the active file.") - -;; I renamed this variable to something more in keeping with the general GNU -;; style. -SLB - -(defvoo nnfolder-ignore-active-file nil - "If non-nil, causes nnfolder to do some extra work in order to determine -the true active ranges of an mbox file. Note that the active file is still -saved, but it's values are not used. This costs some extra time when -scanning an mbox when opening it.") - -(defvoo nnfolder-distrust-mbox nil - "If non-nil, causes nnfolder to not trust the user with respect to -inserting unaccounted for mail in the middle of an mbox file. This can greatly -slow down scans, which now must scan the entire file for unmarked messages. -When nil, scans occur forward from the last marked message, a huge -time saver for large mailboxes.") - -(defvoo nnfolder-newsgroups-file - (concat (file-name-as-directory nnfolder-directory) "newsgroups") - "Mail newsgroups description file.") - -(defvoo nnfolder-get-new-mail t - "If non-nil, nnfolder will check the incoming mail file and split the mail.") - -(defvoo nnfolder-prepare-save-mail-hook nil - "Hook run narrowed to an article before saving.") - -(defvoo nnfolder-save-buffer-hook nil - "Hook run before saving the nnfolder mbox buffer.") - -(defvoo nnfolder-inhibit-expiry nil - "If non-nil, inhibit expiry.") - - - -(defconst nnfolder-version "nnfolder 1.0" - "nnfolder version.") - -(defconst nnfolder-article-marker "X-Gnus-Article-Number: " - "String used to demarcate what the article number for a message is.") - -(defvoo nnfolder-current-group nil) -(defvoo nnfolder-current-buffer nil) -(defvoo nnfolder-status-string "") -(defvoo nnfolder-group-alist nil) -(defvoo nnfolder-buffer-alist nil) -(defvoo nnfolder-scantime-alist nil) -(defvoo nnfolder-active-timestamp nil) - - - -;;; Interface functions - -(nnoo-define-basics nnfolder) - -(deffoo nnfolder-retrieve-headers (articles &optional group server fetch-old) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let (article art-string start stop) - (nnfolder-possibly-change-group group server) - (when nnfolder-current-buffer - (set-buffer nnfolder-current-buffer) - (goto-char (point-min)) - (if (stringp (car articles)) - 'headers - (while articles - (setq article (car articles)) - (setq art-string (nnfolder-article-string article)) - (set-buffer nnfolder-current-buffer) - (when (or (search-forward art-string nil t) - ;; Don't search the whole file twice! Also, articles - ;; probably have some locality by number, so searching - ;; backwards will be faster. Especially if we're at the - ;; beginning of the buffer :-). -SLB - (search-backward art-string nil t)) - (nnmail-search-unix-mail-delim-backward) - (setq start (point)) - (search-forward "\n\n" nil t) - (setq stop (1- (point))) - (set-buffer nntp-server-buffer) - (insert (format "221 %d Article retrieved.\n" article)) - (insert-buffer-substring nnfolder-current-buffer start stop) - (goto-char (point-max)) - (insert ".\n")) - (setq articles (cdr articles))) - - (set-buffer nntp-server-buffer) - (nnheader-fold-continuation-lines) - 'headers))))) - -(deffoo nnfolder-open-server (server &optional defs) - (nnoo-change-server 'nnfolder server defs) - (nnmail-activate 'nnfolder t) - (gnus-make-directory nnfolder-directory) - (cond - ((not (file-exists-p nnfolder-directory)) - (nnfolder-close-server) - (nnheader-report 'nnfolder "Couldn't create directory: %s" - nnfolder-directory)) - ((not (file-directory-p (file-truename nnfolder-directory))) - (nnfolder-close-server) - (nnheader-report 'nnfolder "Not a directory: %s" nnfolder-directory)) - (t - (nnmail-activate 'nnfolder) - (nnheader-report 'nnfolder "Opened server %s using directory %s" - server nnfolder-directory) - t))) - -(deffoo nnfolder-request-close () - (let ((alist nnfolder-buffer-alist)) - (while alist - (nnfolder-close-group (caar alist) nil t) - (setq alist (cdr alist)))) - (nnoo-close-server 'nnfolder) - (setq nnfolder-buffer-alist nil - nnfolder-group-alist nil)) - -(deffoo nnfolder-request-article (article &optional group server buffer) - (nnfolder-possibly-change-group group server) - (save-excursion - (set-buffer nnfolder-current-buffer) - (goto-char (point-min)) - (when (search-forward (nnfolder-article-string article) nil t) - (let (start stop) - (nnmail-search-unix-mail-delim-backward) - (setq start (point)) - (forward-line 1) - (unless (and (nnmail-search-unix-mail-delim) - (forward-line -1)) - (goto-char (point-max))) - (setq stop (point)) - (let ((nntp-server-buffer (or buffer nntp-server-buffer))) - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-buffer-substring nnfolder-current-buffer start stop) - (goto-char (point-min)) - (while (looking-at "From ") - (delete-char 5) - (insert "X-From-Line: ") - (forward-line 1)) - (if (numberp article) - (cons nnfolder-current-group article) - (goto-char (point-min)) - (search-forward (concat "\n" nnfolder-article-marker)) - (cons nnfolder-current-group - (string-to-int - (buffer-substring - (point) (progn (end-of-line) (point))))))))))) - -(deffoo nnfolder-request-group (group &optional server dont-check) - (nnfolder-possibly-change-group group server t) - (save-excursion - (if (not (assoc group nnfolder-group-alist)) - (nnheader-report 'nnfolder "No such group: %s" group) - (if dont-check - (progn - (nnheader-report 'nnfolder "Selected group %s" group) - t) - (let* ((active (assoc group nnfolder-group-alist)) - (group (car active)) - (range (cadr active))) - (cond - ((null active) - (nnheader-report 'nnfolder "No such group: %s" group)) - ((null nnfolder-current-group) - (nnheader-report 'nnfolder "Empty group: %s" group)) - (t - (nnheader-report 'nnfolder "Selected group %s" group) - (nnheader-insert "211 %d %d %d %s\n" - (1+ (- (cdr range) (car range))) - (car range) (cdr range) group)))))))) - -(deffoo nnfolder-request-scan (&optional group server) - (nnfolder-possibly-change-group nil server) - (when nnfolder-get-new-mail - (nnfolder-possibly-change-group group server) - (nnmail-get-new-mail - 'nnfolder - (lambda () - (let ((bufs nnfolder-buffer-alist)) - (save-excursion - (while bufs - (if (not (gnus-buffer-live-p (nth 1 (car bufs)))) - (setq nnfolder-buffer-alist - (delq (car bufs) nnfolder-buffer-alist)) - (set-buffer (nth 1 (car bufs))) - (nnfolder-save-buffer) - (kill-buffer (current-buffer))) - (setq bufs (cdr bufs)))))) - nnfolder-directory - group))) - -;; Don't close the buffer if we're not shutting down the server. This way, -;; we can keep the buffer in the group buffer cache, and not have to grovel -;; over the buffer again unless we add new mail to it or modify it in some -;; way. - -(deffoo nnfolder-close-group (group &optional server force) - ;; Make sure we _had_ the group open. - (when (or (assoc group nnfolder-buffer-alist) - (equal group nnfolder-current-group)) - (let ((inf (assoc group nnfolder-buffer-alist))) - (when inf - (when (and nnfolder-current-group - nnfolder-current-buffer) - (push (list nnfolder-current-group nnfolder-current-buffer) - nnfolder-buffer-alist)) - (setq nnfolder-buffer-alist - (delq inf nnfolder-buffer-alist)) - (setq nnfolder-current-buffer (cadr inf) - nnfolder-current-group (car inf)))) - (when (and nnfolder-current-buffer - (buffer-name nnfolder-current-buffer)) - (save-excursion - (set-buffer nnfolder-current-buffer) - ;; If the buffer was modified, write the file out now. - (nnfolder-save-buffer) - ;; If we're shutting the server down, we need to kill the - ;; buffer and remove it from the open buffer list. Or, of - ;; course, if we're trying to minimize our space impact. - (kill-buffer (current-buffer)) - (setq nnfolder-buffer-alist (delq (assoc group nnfolder-buffer-alist) - nnfolder-buffer-alist))))) - (setq nnfolder-current-group nil - nnfolder-current-buffer nil) - t) - -(deffoo nnfolder-request-create-group (group &optional server args) - (nnfolder-possibly-change-group nil server) - (nnmail-activate 'nnfolder) - (when group - (unless (assoc group nnfolder-group-alist) - (push (list group (cons 1 0)) nnfolder-group-alist) - (nnmail-save-active nnfolder-group-alist nnfolder-active-file) - (nnfolder-read-folder group))) - t) - -(deffoo nnfolder-request-list (&optional server) - (nnfolder-possibly-change-group nil server) - (save-excursion - (nnmail-find-file nnfolder-active-file) - (setq nnfolder-group-alist (nnmail-get-active)) - t)) - -(deffoo nnfolder-request-newgroups (date &optional server) - (nnfolder-possibly-change-group nil server) - (nnfolder-request-list server)) - -(deffoo nnfolder-request-list-newsgroups (&optional server) - (nnfolder-possibly-change-group nil server) - (save-excursion - (nnmail-find-file nnfolder-newsgroups-file))) - -(deffoo nnfolder-request-expire-articles - (articles newsgroup &optional server force) - (nnfolder-possibly-change-group newsgroup server) - (let* ((is-old t) - rest) - (nnmail-activate 'nnfolder) - - (save-excursion - (set-buffer nnfolder-current-buffer) - (while (and articles is-old) - (goto-char (point-min)) - (when (search-forward (nnfolder-article-string (car articles)) nil t) - (if (setq is-old - (nnmail-expired-article-p - newsgroup - (buffer-substring - (point) (progn (end-of-line) (point))) - force nnfolder-inhibit-expiry)) - (progn - (nnheader-message 5 "Deleting article %d..." - (car articles) newsgroup) - (nnfolder-delete-mail)) - (push (car articles) rest))) - (setq articles (cdr articles))) - (unless nnfolder-inhibit-expiry - (nnheader-message 5 "Deleting articles...done")) - (nnfolder-save-buffer) - (nnfolder-adjust-min-active newsgroup) - (nnmail-save-active nnfolder-group-alist nnfolder-active-file) - (nconc rest articles)))) - -(deffoo nnfolder-request-move-article - (article group server accept-form &optional last) - (let ((buf (get-buffer-create " *nnfolder move*")) - result) - (and - (nnfolder-request-article article group server) - (save-excursion - (set-buffer buf) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert-buffer-substring nntp-server-buffer) - (goto-char (point-min)) - (while (re-search-forward - (concat "^" nnfolder-article-marker) - (save-excursion (search-forward "\n\n" nil t) (point)) t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) - (setq result (eval accept-form)) - (kill-buffer buf) - result) - (save-excursion - (nnfolder-possibly-change-group group server) - (set-buffer nnfolder-current-buffer) - (goto-char (point-min)) - (when (search-forward (nnfolder-article-string article) nil t) - (nnfolder-delete-mail)) - (when last - (nnfolder-save-buffer) - (nnfolder-adjust-min-active group) - (nnmail-save-active nnfolder-group-alist nnfolder-active-file)))) - result)) - -(deffoo nnfolder-request-accept-article (group &optional server last) - (nnfolder-possibly-change-group group server) - (nnmail-check-syntax) - (let ((buf (current-buffer)) - result art-group) - (goto-char (point-min)) - (when (looking-at "X-From-Line: ") - (replace-match "From ")) - (and - (nnfolder-request-list) - (save-excursion - (set-buffer buf) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (forward-line -1) - (while (re-search-backward (concat "^" nnfolder-article-marker) nil t) - (delete-region (point) (progn (forward-line 1) (point)))) - (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id"))) - (setq result (if (stringp group) - (list (cons group (nnfolder-active-number group))) - (setq art-group - (nnmail-article-group 'nnfolder-active-number)))) - (if (and (null result) - (yes-or-no-p "Moved to `junk' group; delete article? ")) - (setq result 'junk) - (setq result - (car (nnfolder-save-mail result))))) - (when last - (save-excursion - (nnfolder-possibly-change-folder (or (caar art-group) group)) - (nnfolder-save-buffer) - (when nnmail-cache-accepted-message-ids - (nnmail-cache-close))))) - (nnmail-save-active nnfolder-group-alist nnfolder-active-file) - (unless result - (nnheader-report 'nnfolder "Couldn't store article")) - result)) - -(deffoo nnfolder-request-replace-article (article group buffer) - (nnfolder-possibly-change-group group) - (save-excursion - (set-buffer nnfolder-current-buffer) - (goto-char (point-min)) - (if (not (search-forward (nnfolder-article-string article) nil t)) - nil - (nnfolder-delete-mail t t) - (insert-buffer-substring buffer) - (nnfolder-save-buffer) - t))) - -(deffoo nnfolder-request-delete-group (group &optional force server) - (nnfolder-close-group group server t) - ;; Delete all articles in GROUP. - (if (not force) - () ; Don't delete the articles. - ;; Delete the file that holds the group. - (ignore-errors - (delete-file (nnfolder-group-pathname group)))) - ;; Remove the group from all structures. - (setq nnfolder-group-alist - (delq (assoc group nnfolder-group-alist) nnfolder-group-alist) - nnfolder-current-group nil - nnfolder-current-buffer nil) - ;; Save the active file. - (nnmail-save-active nnfolder-group-alist nnfolder-active-file) - t) - -(deffoo nnfolder-request-rename-group (group new-name &optional server) - (nnfolder-possibly-change-group group server) - (save-excursion - (set-buffer nnfolder-current-buffer) - (and (file-writable-p buffer-file-name) - (ignore-errors - (rename-file - buffer-file-name - (nnfolder-group-pathname new-name)) - t) - ;; That went ok, so we change the internal structures. - (let ((entry (assoc group nnfolder-group-alist))) - (and entry (setcar entry new-name)) - (setq nnfolder-current-buffer nil - nnfolder-current-group nil) - ;; Save the new group alist. - (nnmail-save-active nnfolder-group-alist nnfolder-active-file) - ;; We kill the buffer instead of renaming it and stuff. - (kill-buffer (current-buffer)) - t)))) - - -;;; Internal functions. - -(defun nnfolder-adjust-min-active (group) - ;; Find the lowest active article in this group. - (let* ((active (cadr (assoc group nnfolder-group-alist))) - (marker (concat "\n" nnfolder-article-marker)) - (number "[0-9]+") - (activemin (cdr active))) - (save-excursion - (set-buffer nnfolder-current-buffer) - (goto-char (point-min)) - (while (and (search-forward marker nil t) - (re-search-forward number nil t)) - (setq activemin (min activemin - (string-to-number (buffer-substring - (match-beginning 0) - (match-end 0)))))) - (setcar active activemin)))) - -(defun nnfolder-article-string (article) - (if (numberp article) - (concat "\n" nnfolder-article-marker (int-to-string article) " ") - (concat "\nMessage-ID: " article))) - -(defun nnfolder-delete-mail (&optional force leave-delim) - "Delete the message that point is in." - (save-excursion - (delete-region - (save-excursion - (nnmail-search-unix-mail-delim-backward) - (if leave-delim (progn (forward-line 1) (point)) - (point))) - (progn - (forward-line 1) - (if (nnmail-search-unix-mail-delim) - (if (and (not (bobp)) leave-delim) - (progn (forward-line -2) (point)) - (point)) - (point-max)))))) - -(defun nnfolder-possibly-change-group (group &optional server dont-check) - ;; Change servers. - (when (and server - (not (nnfolder-server-opened server))) - (nnfolder-open-server server)) - (unless (gnus-buffer-live-p nnfolder-current-buffer) - (setq nnfolder-current-buffer nil - nnfolder-current-group nil)) - ;; Change group. - (when (and group - (not (equal group nnfolder-current-group))) - (nnmail-activate 'nnfolder) - (when (and (not (assoc group nnfolder-group-alist)) - (not (file-exists-p - (nnfolder-group-pathname group)))) - ;; The group doesn't exist, so we create a new entry for it. - (push (list group (cons 1 0)) nnfolder-group-alist) - (nnmail-save-active nnfolder-group-alist nnfolder-active-file)) - - (if dont-check - (setq nnfolder-current-group group - nnfolder-current-buffer nil) - (let (inf file) - ;; If we have to change groups, see if we don't already have the - ;; folder in memory. If we do, verify the modtime and destroy - ;; the folder if needed so we can rescan it. - (setq nnfolder-current-buffer - (nth 1 (assoc group nnfolder-buffer-alist))) - - ;; If the buffer is not live, make sure it isn't in the alist. If it - ;; is live, verify that nobody else has touched the file since last - ;; time. - (when (and nnfolder-current-buffer - (not (gnus-buffer-live-p nnfolder-current-buffer))) - (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist) - nnfolder-current-buffer nil)) - - (setq nnfolder-current-group group) - - (when (or (not nnfolder-current-buffer) - (not (verify-visited-file-modtime nnfolder-current-buffer))) - (save-excursion - (setq file (nnfolder-group-pathname group)) - ;; See whether we need to create the new file. - (unless (file-exists-p file) - (gnus-make-directory (file-name-directory file)) - (nnmail-write-region 1 1 file t 'nomesg)) - (when (setq nnfolder-current-buffer (nnfolder-read-folder group)) - (set-buffer nnfolder-current-buffer) - (push (list group nnfolder-current-buffer) - nnfolder-buffer-alist)))))))) - -(defun nnfolder-save-mail (group-art-list) - "Called narrowed to an article." - (let* (save-list group-art) - (goto-char (point-min)) - ;; The From line may have been quoted by movemail. - (when (looking-at (concat ">" message-unix-mail-delimiter)) - (delete-char 1)) - ;; This might come from somewhere else. - (unless (looking-at message-unix-mail-delimiter) - (insert "From nobody " (current-time-string) "\n") - (goto-char (point-min))) - ;; Quote all "From " lines in the article. - (forward-line 1) - (let (case-fold-search) - (while (re-search-forward "^From " nil t) - (beginning-of-line) - (insert "> "))) - (setq save-list group-art-list) - (nnmail-insert-lines) - (nnmail-insert-xref group-art-list) - (run-hooks 'nnmail-prepare-save-mail-hook) - (run-hooks 'nnfolder-prepare-save-mail-hook) - - ;; Insert the mail into each of the destination groups. - (while (setq group-art (pop group-art-list)) - ;; Kill any previous newsgroup markers. - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (forward-line -1) - (while (search-backward (concat "\n" nnfolder-article-marker) nil t) - (delete-region (1+ (point)) (progn (forward-line 2) (point)))) - - ;; Insert the new newsgroup marker. - (nnfolder-insert-newsgroup-line group-art) - - (save-excursion - (let ((beg (point-min)) - (end (point-max)) - (obuf (current-buffer))) - (nnfolder-possibly-change-folder (car group-art)) - (let ((buffer-read-only nil)) - (goto-char (point-max)) - (unless (eolp) - (insert "\n")) - (unless (bobp) - (insert "\n")) - (insert-buffer-substring obuf beg end))))) - - ;; Did we save it anywhere? - save-list)) - -(defun nnfolder-insert-newsgroup-line (group-art) - (save-excursion - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (forward-char -1) - (insert (format (concat nnfolder-article-marker "%d %s\n") - (cdr group-art) (current-time-string)))))) - -(defun nnfolder-active-number (group) - ;; Find the next article number in GROUP. - (let ((active (cadr (assoc group nnfolder-group-alist)))) - (if active - (setcdr active (1+ (cdr active))) - ;; This group is new, so we create a new entry for it. - ;; This might be a bit naughty... creating groups on the drop of - ;; a hat, but I don't know... - (push (list group (setq active (cons 1 1))) - nnfolder-group-alist)) - (cdr active))) - -(defun nnfolder-possibly-change-folder (group) - (let ((inf (assoc group nnfolder-buffer-alist))) - (if (and inf - (gnus-buffer-live-p (cadr inf))) - (set-buffer (cadr inf)) - (when inf - (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist))) - (when nnfolder-group-alist - (nnmail-save-active nnfolder-group-alist nnfolder-active-file)) - (push (list group (nnfolder-read-folder group)) - nnfolder-buffer-alist)))) - -;; This method has a problem if you've accidentally let the active list get -;; out of sync with the files. This could happen, say, if you've -;; accidentally gotten new mail with something other than Gnus (but why -;; would _that_ ever happen? :-). In that case, we will be in the middle of -;; processing the file, ready to add new X-Gnus article number markers, and -;; we'll run across a message with no ID yet - the active list _may_not_ be -;; ready for us yet. - -;; To handle this, I'm modifying this routine to maintain the maximum ID seen -;; so far, and when we hit a message with no ID, we will _manually_ scan the -;; rest of the message looking for any more, possibly higher IDs. We'll -;; assume the maximum that we find is the highest active. Note that this -;; shouldn't cost us much extra time at all, but will be a lot less -;; vulnerable to glitches between the mbox and the active file. - -(defun nnfolder-read-folder (group) - (let* ((file (nnfolder-group-pathname group)) - (buffer (set-buffer (nnheader-find-file-noselect file)))) - (if (equal (cadr (assoc group nnfolder-scantime-alist)) - (nth 5 (file-attributes file))) - ;; This looks up-to-date, so we don't do any scanning. - buffer - ;; Parse the damn thing. - (save-excursion - (nnmail-activate 'nnfolder) - ;; Read in the file. - (let ((delim (concat "^" message-unix-mail-delimiter)) - (marker (concat "\n" nnfolder-article-marker)) - (number "[0-9]+") - (active (or (cadr (assoc group nnfolder-group-alist)) - (cons 1 0))) - (scantime (assoc group nnfolder-scantime-alist)) - (minid (lsh -1 -1)) - maxid start end newscantime - buffer-read-only) - (buffer-disable-undo (current-buffer)) - (setq maxid (cdr active)) - (goto-char (point-min)) - - ;; Anytime the active number is 1 or 0, it is suspect. In that - ;; case, search the file manually to find the active number. Or, - ;; of course, if we're being paranoid. (This would also be the - ;; place to build other lists from the header markers, such as - ;; expunge lists, etc., if we ever desired to abandon the active - ;; file entirely for mboxes.) - (when (or nnfolder-ignore-active-file - (< maxid 2)) - (while (and (search-forward marker nil t) - (re-search-forward number nil t)) - (let ((newnum (string-to-number (match-string 0)))) - (setq maxid (max maxid newnum)) - (setq minid (min minid newnum)))) - (setcar active (max 1 (min minid maxid))) - (setcdr active (max maxid (cdr active))) - (goto-char (point-min))) - - ;; As long as we trust that the user will only insert unmarked mail - ;; at the end, go to the end and search backwards for the last - ;; marker. Find the start of that message, and begin to search for - ;; unmarked messages from there. - (when (not (or nnfolder-distrust-mbox - (< maxid 2))) - (goto-char (point-max)) - (unless (re-search-backward marker nil t) - (goto-char (point-min))) - (when (nnmail-search-unix-mail-delim) - (goto-char (point-min)))) - - ;; Keep track of the active number on our own, and insert it back - ;; into the active list when we're done. Also, prime the pump to - ;; cut down on the number of searches we do. - (unless (nnmail-search-unix-mail-delim) - (goto-char (point-max))) - (setq end (point-marker)) - (while (not (= end (point-max))) - (setq start (marker-position end)) - (goto-char end) - ;; There may be more than one "From " line, so we skip past - ;; them. - (while (looking-at delim) - (forward-line 1)) - (set-marker end (if (nnmail-search-unix-mail-delim) - (point) - (point-max))) - (goto-char start) - (when (not (search-forward marker end t)) - (narrow-to-region start end) - (nnmail-insert-lines) - (nnfolder-insert-newsgroup-line - (cons nil (nnfolder-active-number nnfolder-current-group))) - (widen))) - - (set-marker end nil) - ;; Make absolutely sure that the active list reflects reality! - (nnmail-save-active nnfolder-group-alist nnfolder-active-file) - ;; Set the scantime for this group. - (setq newscantime (visited-file-modtime)) - (if scantime - (setcdr scantime (list newscantime)) - (push (list nnfolder-current-group newscantime) - nnfolder-scantime-alist)) - (current-buffer)))))) - -;;;###autoload -(defun nnfolder-generate-active-file () - "Look for mbox folders in the nnfolder directory and make them into groups." - (interactive) - (nnmail-activate 'nnfolder) - (let ((files (directory-files nnfolder-directory)) - file) - (while (setq file (pop files)) - (when (and (not (backup-file-name-p file)) - (message-mail-file-mbox-p - (nnheader-concat nnfolder-directory file))) - (let ((oldgroup (assoc file nnfolder-group-alist))) - (if oldgroup - (nnheader-message 5 "Refreshing group %s..." file) - (nnheader-message 5 "Adding group %s..." file)) - (setq nnfolder-group-alist (remove oldgroup nnfolder-group-alist)) - (push (list file (cons 1 0)) nnfolder-group-alist) - (nnfolder-possibly-change-folder file) - (nnfolder-possibly-change-group file) - (nnfolder-close-group file)))) - (message ""))) - -(defun nnfolder-group-pathname (group) - "Make pathname for GROUP." - (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory)))) - ;; If this file exists, we use it directly. - (if (or nnmail-use-long-file-names - (file-exists-p (concat dir group))) - (concat dir group) - ;; If not, we translate dots into slashes. - (concat dir (nnheader-replace-chars-in-string group ?. ?/))))) - -(defun nnfolder-save-buffer () - "Save the buffer." - (when (buffer-modified-p) - (run-hooks 'nnfolder-save-buffer-hook) - (gnus-make-directory (file-name-directory (buffer-file-name))) - (save-buffer))) - -(provide 'nnfolder) - -;;; nnfolder.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/nngateway.el --- a/lisp/gnus/nngateway.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,82 +0,0 @@ -;;; nngateway.el --- posting news via mail gateways -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnoo) -(require 'message) - -(nnoo-declare nngateway) - -(defvoo nngateway-address nil - "Address of the mail-to-news gateway.") - -(defvoo nngateway-header-transformation 'nngateway-simple-header-transformation - "Function to be called to rewrite the news headers into mail headers. -It is called narrowed to the headers to be transformed with one -parameter -- the gateway address.") - -;;; Interface functions - -(nnoo-define-basics nngateway) - -(deffoo nngateway-open-server (server &optional defs) - (if (nngateway-server-opened server) - t - (unless (assq 'nngateway-address defs) - (setq defs (append defs (list (list 'nngateway-address server))))) - (nnoo-change-server 'nngateway server defs))) - -(deffoo nngateway-request-post (&optional server) - (when (or (nngateway-server-opened server) - (nngateway-open-server server)) - ;; Rewrite the header. - (let ((buf (current-buffer))) - (nnheader-temp-write nil - (insert-buffer-substring buf) - (message-narrow-to-head) - (funcall nngateway-header-transformation nngateway-address) - (goto-char (point-max)) - (insert mail-header-separator "\n") - (widen) - (let (message-required-mail-headers) - (funcall message-send-mail-function)))))) - -;;; Internal functions - -(defun nngateway-simple-header-transformation (gateway) - "Transform the headers to use GATEWAY." - (let ((newsgroups (mail-fetch-field "newsgroups"))) - (message-remove-header "to") - (message-remove-header "cc") - (goto-char (point-min)) - (insert "To: " (nnheader-replace-chars-in-string newsgroups ?. ?-) - "@" gateway "\n"))) - -(nnoo-define-skeleton nngateway) - -(provide 'nngateway) - -;;; nngateway.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/nnheader.el --- a/lisp/gnus/nnheader.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,820 +0,0 @@ -;;; nnheader.el --- header access macros for Gnus and its backends -;; Copyright (C) 1987,88,89,90,93,94,95,96,97 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; These macros may look very much like the ones in GNUS 4.1. They -;; are, in a way, but you should note that the indices they use have -;; been changed from the internal GNUS format to the NOV format. The -;; makes it possible to read headers from XOVER much faster. -;; -;; The format of a header is now: -;; [number subject from date id references chars lines xref] -;; -;; (That last entry is defined as "misc" in the NOV format, but Gnus -;; uses it for xrefs.) - -;;; Code: - -(require 'mail-utils) - -(defvar nnheader-max-head-length 4096 - "*Max length of the head of articles.") - -(defvar nnheader-head-chop-length 2048 - "*Length of each read operation when trying to fetch HEAD headers.") - -(defvar nnheader-file-name-translation-alist nil - "*Alist that says how to translate characters in file names. -For instance, if \":\" is illegal as a file character in file names -on your system, you could say something like: - -\(setq nnheader-file-name-translation-alist '((?: . ?_)))") - -(eval-and-compile - (autoload 'nnmail-message-id "nnmail") - (autoload 'mail-position-on-field "sendmail") - (autoload 'message-remove-header "message") - (autoload 'cancel-function-timers "timers") - (autoload 'gnus-point-at-eol "gnus-util")) - -;;; Header access macros. - -(defmacro mail-header-number (header) - "Return article number in HEADER." - `(aref ,header 0)) - -(defmacro mail-header-set-number (header number) - "Set article number of HEADER to NUMBER." - `(aset ,header 0 ,number)) - -(defmacro mail-header-subject (header) - "Return subject string in HEADER." - `(aref ,header 1)) - -(defmacro mail-header-set-subject (header subject) - "Set article subject of HEADER to SUBJECT." - `(aset ,header 1 ,subject)) - -(defmacro mail-header-from (header) - "Return author string in HEADER." - `(aref ,header 2)) - -(defmacro mail-header-set-from (header from) - "Set article author of HEADER to FROM." - `(aset ,header 2 ,from)) - -(defmacro mail-header-date (header) - "Return date in HEADER." - `(aref ,header 3)) - -(defmacro mail-header-set-date (header date) - "Set article date of HEADER to DATE." - `(aset ,header 3 ,date)) - -(defalias 'mail-header-message-id 'mail-header-id) -(defmacro mail-header-id (header) - "Return Id in HEADER." - `(aref ,header 4)) - -(defalias 'mail-header-set-message-id 'mail-header-set-id) -(defmacro mail-header-set-id (header id) - "Set article Id of HEADER to ID." - `(aset ,header 4 ,id)) - -(defmacro mail-header-references (header) - "Return references in HEADER." - `(aref ,header 5)) - -(defmacro mail-header-set-references (header ref) - "Set article references of HEADER to REF." - `(aset ,header 5 ,ref)) - -(defmacro mail-header-chars (header) - "Return number of chars of article in HEADER." - `(aref ,header 6)) - -(defmacro mail-header-set-chars (header chars) - "Set number of chars in article of HEADER to CHARS." - `(aset ,header 6 ,chars)) - -(defmacro mail-header-lines (header) - "Return lines in HEADER." - `(aref ,header 7)) - -(defmacro mail-header-set-lines (header lines) - "Set article lines of HEADER to LINES." - `(aset ,header 7 ,lines)) - -(defmacro mail-header-xref (header) - "Return xref string in HEADER." - `(aref ,header 8)) - -(defmacro mail-header-set-xref (header xref) - "Set article xref of HEADER to xref." - `(aset ,header 8 ,xref)) - -(defun make-mail-header (&optional init) - "Create a new mail header structure initialized with INIT." - (make-vector 9 init)) - -(defun make-full-mail-header (&optional number subject from date id - references chars lines xref) - "Create a new mail header structure initialized with the parameters given." - (vector number subject from date id references chars lines xref)) - -;; fake message-ids: generation and detection - -(defvar nnheader-fake-message-id 1) - -(defsubst nnheader-generate-fake-message-id () - (concat "fake+none+" (int-to-string (incf nnheader-fake-message-id)))) - -(defsubst nnheader-fake-message-id-p (id) - (save-match-data ; regular message-id's are <.*> - (string-match "\\`fake\\+none\\+[0-9]+\\'" id))) - -;; Parsing headers and NOV lines. - -(defsubst nnheader-header-value () - (buffer-substring (match-end 0) (gnus-point-at-eol))) - -(defun nnheader-parse-head (&optional naked) - (let ((case-fold-search t) - (cur (current-buffer)) - (buffer-read-only nil) - in-reply-to lines p) - (goto-char (point-min)) - (when naked - (insert "\n")) - ;; Search to the beginning of the next header. Error messages - ;; do not begin with 2 or 3. - (prog1 - (when (or naked (re-search-forward "^[23][0-9]+ " nil t)) - ;; This implementation of this function, with nine - ;; search-forwards instead of the one re-search-forward and - ;; a case (which basically was the old function) is actually - ;; about twice as fast, even though it looks messier. You - ;; can't have everything, I guess. Speed and elegance - ;; don't always go hand in hand. - (vector - ;; Number. - (if naked - (progn - (setq p (point-min)) - 0) - (prog1 - (read cur) - (end-of-line) - (setq p (point)) - (narrow-to-region (point) - (or (and (search-forward "\n.\n" nil t) - (- (point) 2)) - (point))))) - ;; Subject. - (progn - (goto-char p) - (if (search-forward "\nsubject: " nil t) - (nnheader-header-value) "(none)")) - ;; From. - (progn - (goto-char p) - (if (search-forward "\nfrom: " nil t) - (nnheader-header-value) "(nobody)")) - ;; Date. - (progn - (goto-char p) - (if (search-forward "\ndate: " nil t) - (nnheader-header-value) "")) - ;; Message-ID. - (progn - (goto-char p) - (if (search-forward "\nmessage-id:" nil t) - (buffer-substring - (1- (or (search-forward "<" nil t) (point))) - (or (search-forward ">" nil t) (point))) - ;; If there was no message-id, we just fake one to make - ;; subsequent routines simpler. - (nnheader-generate-fake-message-id))) - ;; References. - (progn - (goto-char p) - (if (search-forward "\nreferences: " nil t) - (nnheader-header-value) - ;; Get the references from the in-reply-to header if there - ;; were no references and the in-reply-to header looks - ;; promising. - (if (and (search-forward "\nin-reply-to: " nil t) - (setq in-reply-to (nnheader-header-value)) - (string-match "<[^>]+>" in-reply-to)) - (substring in-reply-to (match-beginning 0) - (match-end 0)) - ""))) - ;; Chars. - 0 - ;; Lines. - (progn - (goto-char p) - (if (search-forward "\nlines: " nil t) - (if (numberp (setq lines (read cur))) - lines 0) - 0)) - ;; Xref. - (progn - (goto-char p) - (and (search-forward "\nxref: " nil t) - (nnheader-header-value))))) - (when naked - (goto-char (point-min)) - (delete-char 1))))) - -(defmacro nnheader-nov-skip-field () - '(search-forward "\t" eol 'move)) - -(defmacro nnheader-nov-field () - '(buffer-substring (point) (if (nnheader-nov-skip-field) (1- (point)) eol))) - -(defmacro nnheader-nov-read-integer () - '(prog1 - (if (= (following-char) ?\t) - 0 - (let ((num (ignore-errors (read (current-buffer))))) - (if (numberp num) num 0))) - (or (eobp) (forward-char 1)))) - -;; (defvar nnheader-none-counter 0) - -(defun nnheader-parse-nov () - (let ((eol (gnus-point-at-eol))) - (vector - (nnheader-nov-read-integer) ; number - (nnheader-nov-field) ; subject - (nnheader-nov-field) ; from - (nnheader-nov-field) ; date - (or (nnheader-nov-field) - (nnheader-generate-fake-message-id)) ; id - (nnheader-nov-field) ; refs - (nnheader-nov-read-integer) ; chars - (nnheader-nov-read-integer) ; lines - (if (= (following-char) ?\n) - nil - (nnheader-nov-field)) ; misc - ))) - -(defun nnheader-insert-nov (header) - (princ (mail-header-number header) (current-buffer)) - (insert - "\t" - (or (mail-header-subject header) "(none)") "\t" - (or (mail-header-from header) "(nobody)") "\t" - (or (mail-header-date header) "") "\t" - (or (mail-header-id header) - (nnmail-message-id)) - "\t" - (or (mail-header-references header) "") "\t") - (princ (or (mail-header-chars header) 0) (current-buffer)) - (insert "\t") - (princ (or (mail-header-lines header) 0) (current-buffer)) - (insert "\t") - (when (mail-header-xref header) - (insert "Xref: " (mail-header-xref header) "\t")) - (insert "\n")) - -(defun nnheader-insert-article-line (article) - (goto-char (point-min)) - (insert "220 ") - (princ article (current-buffer)) - (insert " Article retrieved.\n") - (search-forward "\n\n" nil 'move) - (delete-region (point) (point-max)) - (forward-char -1) - (insert ".")) - -(defun nnheader-nov-delete-outside-range (beg end) - "Delete all NOV lines that lie outside the BEG to END range." - ;; First we find the first wanted line. - (nnheader-find-nov-line beg) - (delete-region (point-min) (point)) - ;; Then we find the last wanted line. - (when (nnheader-find-nov-line end) - (forward-line 1)) - (delete-region (point) (point-max))) - -(defun nnheader-find-nov-line (article) - "Put point at the NOV line that start with ARTICLE. -If ARTICLE doesn't exist, put point where that line -would have been. The function will return non-nil if -the line could be found." - ;; This function basically does a binary search. - (let ((max (point-max)) - (min (goto-char (point-min))) - (cur (current-buffer)) - (prev (point-min)) - num found) - (while (not found) - (goto-char (/ (+ max min) 2)) - (beginning-of-line) - (if (or (= (point) prev) - (eobp)) - (setq found t) - (setq prev (point)) - (cond ((> (setq num (read cur)) article) - (setq max (point))) - ((< num article) - (setq min (point))) - (t - (setq found 'yes))))) - ;; We may be at the first line. - (when (and (not num) - (not (eobp))) - (setq num (read cur))) - ;; Now we may have found the article we're looking for, or we - ;; may be somewhere near it. - (when (and (not (eq found 'yes)) - (not (eq num article))) - (setq found (point)) - (while (and (< (point) max) - (or (not (numberp num)) - (< num article))) - (forward-line 1) - (setq found (point)) - (or (eobp) - (= (setq num (read cur)) article))) - (unless (eq num article) - (goto-char found))) - (beginning-of-line) - (eq num article))) - -;; Various cruft the backends and Gnus need to communicate. - -(defvar nntp-server-buffer nil) -(defvar gnus-verbose-backends 7 - "*A number that says how talkative the Gnus backends should be.") -(defvar gnus-nov-is-evil nil - "If non-nil, Gnus backends will never output headers in the NOV format.") -(defvar news-reply-yank-from nil) -(defvar news-reply-yank-message-id nil) - -(defvar nnheader-callback-function nil) - -(defun nnheader-init-server-buffer () - "Initialize the Gnus-backend communication buffer." - (save-excursion - (unless (gnus-buffer-live-p nntp-server-buffer) - (setq nntp-server-buffer (get-buffer-create " *nntpd*"))) - (set-buffer nntp-server-buffer) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (kill-all-local-variables) - (setq case-fold-search t) ;Should ignore case. - t)) - -;;; Various functions the backends use. - -(defun nnheader-file-error (file) - "Return a string that says what is wrong with FILE." - (format - (cond - ((not (file-exists-p file)) - "%s does not exist") - ((file-directory-p file) - "%s is a directory") - ((not (file-readable-p file)) - "%s is not readable")) - file)) - -(defun nnheader-insert-head (file) - "Insert the head of the article." - (when (file-exists-p file) - (if (eq nnheader-max-head-length t) - ;; Just read the entire file. - (nnheader-insert-file-contents file) - ;; Read 1K blocks until we find a separator. - (let ((beg 0) - format-alist) - (while (and (eq nnheader-head-chop-length - (nth 1 (nnheader-insert-file-contents - file nil beg - (incf beg nnheader-head-chop-length)))) - (prog1 (not (search-forward "\n\n" nil t)) - (goto-char (point-max))) - (or (null nnheader-max-head-length) - (< beg nnheader-max-head-length)))))) - t)) - -(defun nnheader-article-p () - "Say whether the current buffer looks like an article." - (goto-char (point-min)) - (if (not (search-forward "\n\n" nil t)) - nil - (narrow-to-region (point-min) (1- (point))) - (goto-char (point-min)) - (while (looking-at "[A-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n") - (goto-char (match-end 0))) - (prog1 - (eobp) - (widen)))) - -(defun nnheader-insert-references (references message-id) - "Insert a References header based on REFERENCES and MESSAGE-ID." - (if (and (not references) (not message-id)) - () ; This is illegal, but not all articles have Message-IDs. - (mail-position-on-field "References") - (let ((begin (save-excursion (beginning-of-line) (point))) - (fill-column 78) - (fill-prefix "\t")) - (when references - (insert references)) - (when (and references message-id) - (insert " ")) - (when message-id - (insert message-id)) - ;; Fold long References lines to conform to RFC1036 (sort of). - ;; The region must end with a newline to fill the region - ;; without inserting extra newline. - (fill-region-as-paragraph begin (1+ (point)))))) - -(defun nnheader-replace-header (header new-value) - "Remove HEADER and insert the NEW-VALUE." - (save-excursion - (save-restriction - (nnheader-narrow-to-headers) - (prog1 - (message-remove-header header) - (goto-char (point-max)) - (insert header ": " new-value "\n"))))) - -(defun nnheader-narrow-to-headers () - "Narrow to the head of an article." - (widen) - (narrow-to-region - (goto-char (point-min)) - (if (search-forward "\n\n" nil t) - (1- (point)) - (point-max))) - (goto-char (point-min))) - -(defun nnheader-set-temp-buffer (name &optional noerase) - "Set-buffer to an empty (possibly new) buffer called NAME with undo disabled." - (set-buffer (get-buffer-create name)) - (buffer-disable-undo (current-buffer)) - (unless noerase - (erase-buffer)) - (current-buffer)) - -(defmacro nnheader-temp-write (file &rest forms) - "Create a new buffer, evaluate FORMS there, and write the buffer to FILE. -Return the value of FORMS. -If FILE is nil, just evaluate FORMS and don't save anything. -If FILE is t, return the buffer contents as a string." - (let ((temp-file (make-symbol "temp-file")) - (temp-buffer (make-symbol "temp-buffer")) - (temp-results (make-symbol "temp-results"))) - `(save-excursion - (let* ((,temp-file ,file) - (default-major-mode 'fundamental-mode) - (,temp-buffer - (set-buffer - (get-buffer-create - (generate-new-buffer-name " *nnheader temp*")))) - ,temp-results) - (unwind-protect - (progn - (setq ,temp-results (progn ,@forms)) - (cond - ;; Don't save anything. - ((null ,temp-file) - ,temp-results) - ;; Return the buffer contents. - ((eq ,temp-file t) - (set-buffer ,temp-buffer) - (buffer-string)) - ;; Save a file. - (t - (set-buffer ,temp-buffer) - ;; Make sure the directory where this file is - ;; to be saved exists. - (when (not (file-directory-p - (file-name-directory ,temp-file))) - (make-directory (file-name-directory ,temp-file) t)) - ;; Save the file. - (write-region (point-min) (point-max) - ,temp-file nil 'nomesg) - ,temp-results))) - ;; Kill the buffer. - (when (buffer-name ,temp-buffer) - (kill-buffer ,temp-buffer))))))) - -(put 'nnheader-temp-write 'lisp-indent-function 1) -(put 'nnheader-temp-write 'edebug-form-spec '(form body)) - -(defvar jka-compr-compression-info-list) -(defvar nnheader-numerical-files - (if (boundp 'jka-compr-compression-info-list) - (concat "\\([0-9]+\\)\\(" - (mapconcat (lambda (i) (aref i 0)) - jka-compr-compression-info-list "\\|") - "\\)?") - "[0-9]+$") - "Regexp that match numerical files.") - -(defvar nnheader-numerical-short-files (concat "^" nnheader-numerical-files) - "Regexp that matches numerical file names.") - -(defvar nnheader-numerical-full-files (concat "/" nnheader-numerical-files) - "Regexp that matches numerical full file paths.") - -(defsubst nnheader-file-to-number (file) - "Take a file name and return the article number." - (if (not (boundp 'jka-compr-compression-info-list)) - (string-to-int file) - (string-match nnheader-numerical-short-files file) - (string-to-int (match-string 0 file)))) - -(defun nnheader-directory-files-safe (&rest args) - ;; It has been reported numerous times that `directory-files' - ;; fails with an alarming frequency on NFS mounted file systems. - ;; This function executes that function twice and returns - ;; the longest result. - (let ((first (apply 'directory-files args)) - (second (apply 'directory-files args))) - (if (> (length first) (length second)) - first - second))) - -(defun nnheader-directory-articles (dir) - "Return a list of all article files in a directory." - (mapcar 'nnheader-file-to-number - (nnheader-directory-files-safe - dir nil nnheader-numerical-short-files t))) - -(defun nnheader-article-to-file-alist (dir) - "Return an alist of article/file pairs in DIR." - (mapcar (lambda (file) (cons (nnheader-file-to-number file) file)) - (nnheader-directory-files-safe - dir nil nnheader-numerical-short-files t))) - -(defun nnheader-fold-continuation-lines () - "Fold continuation lines in the current buffer." - (nnheader-replace-regexp "\\(\r?\n[ \t]+\\)+" " ")) - -(defun nnheader-translate-file-chars (file) - (if (null nnheader-file-name-translation-alist) - ;; No translation is necessary. - file - ;; We translate -- but only the file name. We leave the directory - ;; alone. - (let* ((i 0) - trans leaf path len) - (if (string-match "/[^/]+\\'" file) - ;; This is needed on NT's and stuff. - (setq leaf (substring file (1+ (match-beginning 0))) - path (substring file 0 (1+ (match-beginning 0)))) - ;; Fall back on this. - (setq leaf (file-name-nondirectory file) - path (file-name-directory file))) - (setq len (length leaf)) - (while (< i len) - (when (setq trans (cdr (assq (aref leaf i) - nnheader-file-name-translation-alist))) - (aset leaf i trans)) - (incf i)) - (concat path leaf)))) - -(defun nnheader-report (backend &rest args) - "Report an error from the BACKEND. -The first string in ARGS can be a format string." - (set (intern (format "%s-status-string" backend)) - (if (< (length args) 2) - (car args) - (apply 'format args))) - nil) - -(defun nnheader-get-report (backend) - "Get the most recent report from BACKEND." - (condition-case () - (message "%s" (symbol-value (intern (format "%s-status-string" - backend)))) - (error (message "")))) - -(defun nnheader-insert (format &rest args) - "Clear the communication buffer and insert FORMAT and ARGS into the buffer. -If FORMAT isn't a format string, it and all ARGS will be inserted -without formatting." - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (if (string-match "%" format) - (insert (apply 'format format args)) - (apply 'insert format args)) - t)) - -(defun nnheader-replace-chars-in-string (string from to) - "Replace characters in STRING from FROM to TO." - (let ((string (substring string 0)) ;Copy string. - (len (length string)) - (idx 0)) - ;; Replace all occurrences of FROM with TO. - (while (< idx len) - (when (= (aref string idx) from) - (aset string idx to)) - (setq idx (1+ idx))) - string)) - -(defun nnheader-file-to-group (file &optional top) - "Return a group name based on FILE and TOP." - (nnheader-replace-chars-in-string - (if (not top) - file - (condition-case () - (substring (expand-file-name file) - (length - (expand-file-name - (file-name-as-directory top)))) - (error ""))) - ?/ ?.)) - -(defun nnheader-message (level &rest args) - "Message if the Gnus backends are talkative." - (if (or (not (numberp gnus-verbose-backends)) - (<= level gnus-verbose-backends)) - (apply 'message args) - (apply 'format args))) - -(defun nnheader-be-verbose (level) - "Return whether the backends should be verbose on LEVEL." - (or (not (numberp gnus-verbose-backends)) - (<= level gnus-verbose-backends))) - -(defun nnheader-group-pathname (group dir &optional file) - "Make pathname for GROUP." - (concat - (let ((dir (file-name-as-directory (expand-file-name dir)))) - ;; If this directory exists, we use it directly. - (if (file-directory-p (concat dir group)) - (concat dir group "/") - ;; If not, we translate dots into slashes. - (concat dir (nnheader-replace-chars-in-string group ?. ?/) "/"))) - (cond ((null file) "") - ((numberp file) (int-to-string file)) - (t file)))) - -(defun nnheader-functionp (form) - "Return non-nil if FORM is funcallable." - (or (and (symbolp form) (fboundp form)) - (and (listp form) (eq (car form) 'lambda)))) - -(defun nnheader-concat (dir &rest files) - "Concat DIR as directory to FILE." - (apply 'concat (file-name-as-directory dir) files)) - -(defun nnheader-ms-strip-cr () - "Strip ^M from the end of all lines." - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "\r$" nil t) - (delete-backward-char 1)))) - -(defun nnheader-file-size (file) - "Return the file size of FILE or 0." - (or (nth 7 (file-attributes file)) 0)) - -(defun nnheader-find-etc-directory (package &optional file) - "Go through the path and find the \".../etc/PACKAGE\" directory. -If FILE, find the \".../etc/PACKAGE\" file instead." - (let ((path load-path) - dir result) - ;; We try to find the dir by looking at the load path, - ;; stripping away the last component and adding "etc/". - (while path - (if (and (car path) - (file-exists-p - (setq dir (concat - (file-name-directory - (directory-file-name (car path))) - "etc/" package - (if file "" "/")))) - (or file (file-directory-p dir))) - (setq result dir - path nil) - (setq path (cdr path)))) - result)) - -(defvar ange-ftp-path-format) -(defvar efs-path-regexp) -(defun nnheader-re-read-dir (path) - "Re-read directory PATH if PATH is on a remote system." - (if (and (fboundp 'efs-re-read-dir) (boundp 'efs-path-regexp)) - (when (string-match efs-path-regexp path) - (efs-re-read-dir path)) - (when (and (fboundp 'ange-ftp-re-read-dir) (boundp 'ange-ftp-path-format)) - (when (string-match (car ange-ftp-path-format) path) - (ange-ftp-re-read-dir path))))) - -(defun nnheader-insert-file-contents (filename &optional visit beg end replace) - "Like `insert-file-contents', q.v., but only reads in the file. -A buffer may be modified in several ways after reading into the buffer due -to advanced Emacs features, such as file-name-handlers, format decoding, -find-file-hooks, etc. - This function ensures that none of these modifications will take place." - (let ((format-alist nil) - (auto-mode-alist (nnheader-auto-mode-alist)) - (default-major-mode 'fundamental-mode) - (after-insert-file-functions nil)) - (insert-file-contents filename visit beg end replace))) - -(defun nnheader-find-file-noselect (&rest args) - (let ((format-alist nil) - (auto-mode-alist (nnheader-auto-mode-alist)) - (default-major-mode 'fundamental-mode) - (enable-local-variables nil) - (after-insert-file-functions nil)) - (apply 'find-file-noselect args))) - -(defun nnheader-auto-mode-alist () - "Return an `auto-mode-alist' with only the .gz (etc) thingies." - (let ((alist auto-mode-alist) - out) - (while alist - (when (listp (cdar alist)) - (push (car alist) out)) - (pop alist)) - (nreverse out))) - -(defun nnheader-directory-regular-files (dir) - "Return a list of all regular files in DIR." - (let ((files (directory-files dir t)) - out) - (while files - (when (file-regular-p (car files)) - (push (car files) out)) - (pop files)) - (nreverse out))) - -(defmacro nnheader-skeleton-replace (from &optional to regexp) - `(let ((new (generate-new-buffer " *nnheader replace*")) - (cur (current-buffer)) - (start (point-min))) - (set-buffer new) - (buffer-disable-undo (current-buffer)) - (set-buffer cur) - (goto-char (point-min)) - (while (,(if regexp 're-search-forward 'search-forward) - ,from nil t) - (insert-buffer-substring - cur start (prog1 (match-beginning 0) (set-buffer new))) - (goto-char (point-max)) - ,(when to `(insert ,to)) - (set-buffer cur) - (setq start (point))) - (insert-buffer-substring - cur start (prog1 (point-max) (set-buffer new))) - (copy-to-buffer cur (point-min) (point-max)) - (kill-buffer (current-buffer)) - (set-buffer cur))) - -(defun nnheader-replace-string (from to) - "Do a fast replacement of FROM to TO from point to point-max." - (nnheader-skeleton-replace from to)) - -(defun nnheader-replace-regexp (from to) - "Do a fast regexp replacement of FROM to TO from point to point-max." - (nnheader-skeleton-replace from to t)) - -(defun nnheader-strip-cr () - "Strip all \r's from the current buffer." - (nnheader-skeleton-replace "\r")) - -(fset 'nnheader-run-at-time 'run-at-time) -(fset 'nnheader-cancel-timer 'cancel-timer) -(fset 'nnheader-cancel-function-timers 'cancel-function-timers) - -(when (string-match "XEmacs\\|Lucid" emacs-version) - (require 'nnheaderxm)) - -(run-hooks 'nnheader-load-hook) - -(provide 'nnheader) - -;;; nnheader.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/nnheaderxm.el --- a/lisp/gnus/nnheaderxm.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,41 +0,0 @@ -;;; nnheaderxm.el --- making Gnus backends work under XEmacs -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(defun nnheader-xmas-run-at-time (time repeat function &rest args) - (start-itimer - "nnheader-run-at-time" - `(lambda () - (,function ,@args)) - time repeat)) - -(fset 'nnheader-run-at-time 'nnheader-xmas-run-at-time) -(fset 'nnheader-cancel-timer 'delete-itimer) -(fset 'nnheader-cancel-function-timers 'ignore) - -(provide 'nnheaderxm) - -;;; nnheaderxm.el ends here. diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/nnkiboze.el --- a/lisp/gnus/nnkiboze.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,349 +0,0 @@ -;;; nnkiboze.el --- select virtual news access for Gnus -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; The other access methods (nntp, nnspool, etc) are general news -;; access methods. This module relies on Gnus and can't be used -;; separately. - -;;; Code: - -(require 'nntp) -(require 'nnheader) -(require 'gnus) -(require 'gnus-score) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nnkiboze) -(defvoo nnkiboze-directory (nnheader-concat gnus-directory "kiboze/") - "nnkiboze will put its files in this directory.") - -(defvoo nnkiboze-level 9 - "The maximum level to be searched for articles.") - -(defvoo nnkiboze-remove-read-articles t - "If non-nil, nnkiboze will remove read articles from the kiboze group.") - -(defvoo nnkiboze-ephemeral nil - "If non-nil, don't store any data anywhere.") - -(defvoo nnkiboze-scores nil - "Score rules for generating the nnkiboze group.") - -(defvoo nnkiboze-regexp nil - "Regexp for matching component groups.") - - - -(defconst nnkiboze-version "nnkiboze 1.0") - -(defvoo nnkiboze-current-group nil) -(defvoo nnkiboze-status-string "") - -(defvoo nnkiboze-headers nil) - - - -;;; Interface functions. - -(nnoo-define-basics nnkiboze) - -(deffoo nnkiboze-retrieve-headers (articles &optional group server fetch-old) - (nnkiboze-possibly-change-group group) - (unless gnus-nov-is-evil - (if (stringp (car articles)) - 'headers - (let ((nov (nnkiboze-nov-file-name))) - (when (file-exists-p nov) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (nnheader-insert-file-contents nov) - (nnheader-nov-delete-outside-range - (car articles) (car (last articles))) - 'nov)))))) - -(deffoo nnkiboze-request-article (article &optional newsgroup server buffer) - (nnkiboze-possibly-change-group newsgroup) - (if (not (numberp article)) - ;; This is a real kludge. It might not work at times, but it - ;; does no harm I think. The only alternative is to offer no - ;; article fetching by message-id at all. - (nntp-request-article article newsgroup gnus-nntp-server buffer) - (let* ((header (gnus-summary-article-header article)) - (xref (mail-header-xref header))) - (unless xref - (error "nnkiboze: No xref")) - (unless (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref) - (error "nnkiboze: Malformed xref")) - (gnus-request-article (string-to-int (match-string 2 xref)) - (match-string 1 xref) - buffer)))) - -(deffoo nnkiboze-request-scan (&optional group server) - (nnkiboze-generate-group (concat "nnkiboze:" group))) - -(deffoo nnkiboze-request-group (group &optional server dont-check) - "Make GROUP the current newsgroup." - (nnkiboze-possibly-change-group group) - (if dont-check - t - (let ((nov-file (nnkiboze-nov-file-name)) - beg end total) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (if (not (file-exists-p nov-file)) - (nnheader-report 'nnkiboze "Can't select group %s" group) - (nnheader-insert-file-contents nov-file) - (if (zerop (buffer-size)) - (nnheader-insert "211 0 0 0 %s\n" group) - (goto-char (point-min)) - (when (looking-at "[0-9]+") - (setq beg (read (current-buffer)))) - (goto-char (point-max)) - (when (re-search-backward "^[0-9]" nil t) - (setq end (read (current-buffer)))) - (setq total (count-lines (point-min) (point-max))) - (nnheader-insert "211 %d %d %d %s\n" total beg end group))))))) - -(deffoo nnkiboze-close-group (group &optional server) - (nnkiboze-possibly-change-group group) - ;; Remove NOV lines of articles that are marked as read. - (when (and (file-exists-p (nnkiboze-nov-file-name)) - nnkiboze-remove-read-articles) - (nnheader-temp-write (nnkiboze-nov-file-name) - (let ((cur (current-buffer))) - (nnheader-insert-file-contents (nnkiboze-nov-file-name)) - (goto-char (point-min)) - (while (not (eobp)) - (if (not (gnus-article-read-p (read cur))) - (forward-line 1) - (gnus-delete-line)))))) - (setq nnkiboze-current-group nil)) - -(deffoo nnkiboze-open-server (server &optional defs) - (unless (assq 'nnkiboze-regexp defs) - (push `(nnkiboze-regexp ,server) - defs)) - (nnoo-change-server 'nnkiboze server defs)) - -(deffoo nnkiboze-request-delete-group (group &optional force server) - (nnkiboze-possibly-change-group group) - (when force - (let ((files (list (nnkiboze-nov-file-name) - (concat nnkiboze-directory group ".newsrc") - (nnkiboze-score-file group)))) - (while files - (and (file-exists-p (car files)) - (file-writable-p (car files)) - (delete-file (car files))) - (setq files (cdr files))))) - (setq nnkiboze-current-group nil)) - -(nnoo-define-skeleton nnkiboze) - - -;;; Internal functions. - -(defun nnkiboze-possibly-change-group (group) - (setq nnkiboze-current-group group)) - -(defun nnkiboze-prefixed-name (group) - (gnus-group-prefixed-name group '(nnkiboze ""))) - -;;;###autoload -(defun nnkiboze-generate-groups () - "Usage: emacs -batch -l nnkiboze -f nnkiboze-generate-groups -Finds out what articles are to be part of the nnkiboze groups." - (interactive) - (let ((nnmail-spool-file nil) - (gnus-use-dribble-file nil) - (gnus-read-active-file t) - (gnus-expert-user t)) - (gnus)) - (let* ((gnus-newsrc-alist (gnus-copy-sequence gnus-newsrc-alist)) - (newsrc (cdr gnus-newsrc-alist)) - gnus-newsrc-hashtb info) - (gnus-make-hashtable-from-newsrc-alist) - ;; We have copied all the newsrc alist info over to local copies - ;; so that we can mess all we want with these lists. - (while (setq info (pop newsrc)) - (when (string-match "nnkiboze" (gnus-info-group info)) - ;; For each kiboze group, we call this function to generate - ;; it. - (nnkiboze-generate-group (gnus-info-group info)))))) - -(defun nnkiboze-score-file (group) - (list (expand-file-name - (concat (file-name-as-directory gnus-kill-files-directory) - (nnheader-translate-file-chars - (concat (nnkiboze-prefixed-name nnkiboze-current-group) - "." gnus-score-file-suffix)))))) - -(defun nnkiboze-generate-group (group) - (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) - (newsrc-file (concat nnkiboze-directory group ".newsrc")) - (nov-file (concat nnkiboze-directory group ".nov")) - method nnkiboze-newsrc gname newsrc active - ginfo lowest glevel orig-info nov-buffer - ;; Bind various things to nil to make group entry faster. - (gnus-expert-user t) - (gnus-large-newsgroup nil) - (gnus-score-find-score-files-function 'nnkiboze-score-file) - (gnus-verbose (min gnus-verbose 3)) - gnus-select-group-hook gnus-summary-prepare-hook - gnus-thread-sort-functions gnus-show-threads - gnus-visual gnus-suppress-duplicates) - (unless info - (error "No such group: %s" group)) - ;; Load the kiboze newsrc file for this group. - (when (file-exists-p newsrc-file) - (load newsrc-file)) - (nnheader-temp-write nov-file - (when (file-exists-p nov-file) - (insert-file-contents nov-file)) - (setq nov-buffer (current-buffer)) - ;; Go through the active hashtb and add new all groups that match the - ;; kiboze regexp. - (mapatoms - (lambda (group) - (and (string-match nnkiboze-regexp - (setq gname (symbol-name group))) ; Match - (not (assoc gname nnkiboze-newsrc)) ; It isn't registered - (numberp (car (symbol-value group))) ; It is active - (or (> nnkiboze-level 7) - (and (setq glevel (nth 1 (nth 2 (gnus-gethash - gname gnus-newsrc-hashtb)))) - (>= nnkiboze-level glevel))) - (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes - (push (cons gname (1- (car (symbol-value group)))) - nnkiboze-newsrc))) - gnus-active-hashtb) - ;; `newsrc' is set to the list of groups that possibly are - ;; component groups to this kiboze group. This list has elements - ;; on the form `(GROUP . NUMBER)', where NUMBER is the highest - ;; number that has been kibozed in GROUP in this kiboze group. - (setq newsrc nnkiboze-newsrc) - (while newsrc - (if (not (setq active (gnus-gethash - (caar newsrc) gnus-active-hashtb))) - ;; This group isn't active after all, so we remove it from - ;; the list of component groups. - (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc)) - (setq lowest (cdar newsrc)) - ;; Ok, we have a valid component group, so we jump to it. - (switch-to-buffer gnus-group-buffer) - (gnus-group-jump-to-group (caar newsrc)) - (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc)) - (setq ginfo (gnus-get-info (gnus-group-group-name)) - orig-info (gnus-copy-sequence ginfo)) - (unwind-protect - (progn - ;; We set all list of article marks to nil. Since we operate - ;; on copies of the real lists, we can destroy anything we - ;; want here. - (when (nth 3 ginfo) - (setcar (nthcdr 3 ginfo) nil)) - ;; We set the list of read articles to be what we expect for - ;; this kiboze group -- either nil or `(1 . LOWEST)'. - (when ginfo - (setcar (nthcdr 2 ginfo) - (and (not (= lowest 1)) (cons 1 lowest)))) - (when (and (or (not ginfo) - (> (length (gnus-list-of-unread-articles - (car ginfo))) - 0)) - (progn - (gnus-group-select-group nil) - (eq major-mode 'gnus-summary-mode))) - ;; We are now in the group where we want to be. - (setq method (gnus-find-method-for-group - gnus-newsgroup-name)) - (when (eq method gnus-select-method) - (setq method nil)) - ;; We go through the list of scored articles. - (while gnus-newsgroup-scored - (when (> (caar gnus-newsgroup-scored) lowest) - ;; If it has a good score, then we enter this article - ;; into the kiboze group. - (nnkiboze-enter-nov - nov-buffer - (gnus-summary-article-header - (caar gnus-newsgroup-scored)) - gnus-newsgroup-name)) - (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored))) - ;; That's it. We exit this group. - (gnus-summary-exit-no-update))) - ;; Restore the proper info. - (when ginfo - (setcdr ginfo (cdr orig-info))))) - (setcdr (car newsrc) (car active)) - (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc)) - (setq newsrc (cdr newsrc)))) - ;; We save the kiboze newsrc for this group. - (nnheader-temp-write newsrc-file - (insert "(setq nnkiboze-newsrc '") - (gnus-prin1 nnkiboze-newsrc) - (insert ")\n")) - t)) - -(defun nnkiboze-enter-nov (buffer header group) - (save-excursion - (set-buffer buffer) - (goto-char (point-max)) - (let ((xref (mail-header-xref header)) - (prefix (gnus-group-real-prefix group)) - (oheader (copy-sequence header)) - (first t) - article) - (if (zerop (forward-line -1)) - (progn - (setq article (1+ (read (current-buffer)))) - (forward-line 1)) - (setq article 1)) - (mail-header-set-number oheader article) - (nnheader-insert-nov oheader) - (search-backward "\t" nil t 2) - (if (re-search-forward " [^ ]+:[0-9]+" nil t) - (goto-char (match-beginning 0)) - (forward-char 1)) - ;; The first Xref has to be the group this article - ;; really came for - this is the article nnkiboze - ;; will request when it is asked for the article. - (insert group ":" - (int-to-string (mail-header-number header)) " ") - (while (re-search-forward " [^ ]+:[0-9]+" nil t) - (goto-char (1+ (match-beginning 0))) - (insert prefix))))) - -(defun nnkiboze-nov-file-name () - (concat (file-name-as-directory nnkiboze-directory) - (nnheader-translate-file-chars - (concat (nnkiboze-prefixed-name nnkiboze-current-group) ".nov")))) - -(provide 'nnkiboze) - -;;; nnkiboze.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/nnmail.el --- a/lisp/gnus/nnmail.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1721 +0,0 @@ -;;; nnmail.el --- mail support functions for the Gnus mail backends -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'timezone) -(require 'message) -(require 'cl) -(require 'custom) - -(eval-and-compile - (autoload 'gnus-error "gnus-util")) - -(defgroup nnmail nil - "Reading mail with Gnus." - :group 'gnus) - -(defgroup nnmail-retrieve nil - "Retrieving new mail." - :group 'nnmail) - -(defgroup nnmail-prepare nil - "Preparing (or mangling) new mail after retrival." - :group 'nnmail) - -(defgroup nnmail-duplicate nil - "Handling of duplicate mail messages." - :group 'nnmail) - -(defgroup nnmail-split nil - "Organizing the incomming mail in folders." - :group 'nnmail) - -(defgroup nnmail-files nil - "Mail files." - :group 'gnus-files - :group 'nnmail) - -(defgroup nnmail-expire nil - "Expiring old mail." - :group 'nnmail) - -(defgroup nnmail-procmail nil - "Interfacing with procmail and other mail agents." - :group 'nnmail) - -(defgroup nnmail-various nil - "Various mail options." - :group 'nnmail) - -(defcustom nnmail-split-methods - '(("mail.misc" "")) - "Incoming mail will be split according to this variable. - -If you'd like, for instance, one mail group for mail from the -\"4ad-l\" mailing list, one group for junk mail and one for everything -else, you could do something like this: - - (setq nnmail-split-methods - '((\"mail.4ad\" \"From:.*4ad\") - (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\") - (\"mail.misc\" \"\"))) - -As you can see, this variable is a list of lists, where the first -element in each \"rule\" is the name of the group (which, by the way, -does not have to be called anything beginning with \"mail\", -\"yonka.zow\" is a fine, fine name), and the second is a regexp that -nnmail will try to match on the header to find a fit. - -The second element can also be a function. In that case, it will be -called narrowed to the headers with the first element of the rule as -the argument. It should return a non-nil value if it thinks that the -mail belongs in that group. - -The last element should always have \"\" as the regexp. - -This variable can also have a function as its value." - :group 'nnmail-split - :type '(choice (repeat :tag "Alist" (group (string :tag "Name") regexp)) - (function-item nnmail-split-fancy) - (function :tag "Other"))) - -;; Suggested by Erik Selberg . -(defcustom nnmail-crosspost t - "If non-nil, do crossposting if several split methods match the mail. -If nil, the first match found will be used." - :group 'nnmail-split - :type 'boolean) - -;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit). -(defcustom nnmail-keep-last-article nil - "If non-nil, nnmail will never delete/move a group's last article. -It can be marked expirable, so it will be deleted when it is no longer last. - -You may need to set this variable if other programs are putting -new mail into folder numbers that Gnus has marked as expired." - :group 'nnmail-procmail - :group 'nnmail-various - :type 'boolean) - -(defcustom nnmail-use-long-file-names nil - "If non-nil the mail backends will use long file and directory names. -If nil, groups like \"mail.misc\" will end up in directories like -\"mail/misc/\"." - :group 'nnmail-files - :type 'boolean) - -(defcustom nnmail-default-file-modes 384 - "Set the mode bits of all new mail files to this integer." - :group 'nnmail-files - :type 'integer) - -(defcustom nnmail-expiry-wait 7 - "*Expirable articles that are older than this will be expired. -This variable can either be a number (which will be interpreted as a -number of days) -- this doesn't have to be an integer. This variable -can also be `immediate' and `never'." - :group 'nnmail-expire - :type '(choice (const immediate) - (integer :tag "days") - (const never))) - -(defcustom nnmail-expiry-wait-function nil - "Variable that holds function to specify how old articles should be before they are expired. - The function will be called with the name of the group that the -expiry is to be performed in, and it should return an integer that -says how many days an article can be stored before it is considered -\"old\". It can also return the values `never' and `immediate'. - -Eg.: - -\(setq nnmail-expiry-wait-function - (lambda (newsgroup) - (cond ((string-match \"private\" newsgroup) 31) - ((string-match \"junk\" newsgroup) 1) - ((string-match \"important\" newsgroup) 'never) - (t 7))))" - :group 'nnmail-expire - :type '(choice (const :tag "nnmail-expiry-wait" nil) - (function :format "%v" nnmail-))) - -(defcustom nnmail-cache-accepted-message-ids nil - "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache." - :group 'nnmail - :type 'boolean) - -(defcustom nnmail-spool-file - (or (getenv "MAIL") - (concat "/usr/spool/mail/" (user-login-name))) - "Where the mail backends will look for incoming mail. -This variable is \"/usr/spool/mail/$user\" by default. -If this variable is nil, no mail backends will read incoming mail. -If this variable is a list, all files mentioned in this list will be -used as incoming mailboxes. -If this variable is a directory (i. e., it's name ends with a \"/\"), -treat all files in that directory as incoming spool files." - :group 'nnmail-files - :type 'file) - -(defcustom nnmail-crash-box "~/.gnus-crash-box" - "File where Gnus will store mail while processing it." - :group 'nnmail-files - :type 'file) - -(defcustom nnmail-use-procmail nil - "*If non-nil, the mail backends will look in `nnmail-procmail-directory' for spool files. -The file(s) in `nnmail-spool-file' will also be read." - :group 'nnmail-procmail - :type 'boolean) - -(defcustom nnmail-procmail-directory "~/incoming/" - "*When using procmail (and the like), incoming mail is put in this directory. -The Gnus mail backends will read the mail from this directory." - :group 'nnmail-procmail - :type 'directory) - -(defcustom nnmail-procmail-suffix "\\.spool" - "*Suffix of files created by procmail (and the like). -This variable might be a suffix-regexp to match the suffixes of -several files - eg. \".spool[0-9]*\"." - :group 'nnmail-procmail - :type 'regexp) - -(defcustom nnmail-resplit-incoming nil - "*If non-nil, re-split incoming procmail sorted mail." - :group 'nnmail-procmail - :type 'boolean) - -(defcustom nnmail-delete-file-function 'delete-file - "Function called to delete files in some mail backends." - :group 'nnmail-files - :type 'function) - -(defcustom nnmail-crosspost-link-function - (if (string-match "windows-nt\\|emx" (format "%s" system-type)) - 'copy-file - 'add-name-to-file) - "Function called to create a copy of a file. -This is `add-name-to-file' by default, which means that crossposts -will use hard links. If your file system doesn't allow hard -links, you could set this variable to `copy-file' instead." - :group 'nnmail-files - :type '(radio (function-item add-name-to-file) - (function-item copy-file) - (function :tag "Other"))) - -(defcustom nnmail-movemail-program "movemail" - "*A command to be executed to move mail from the inbox. -The default is \"movemail\". - -This can also be a function. In that case, the function will be -called with two parameters -- the name of the INBOX file, and the file -to be moved to." - :group 'nnmail-files - :group 'nnmail-retrieve - :type 'string) - -(defcustom nnmail-pop-password-required nil - "*Non-nil if a password is required when reading mail using POP." - :group 'nnmail-retrieve - :type 'boolean) - -(defcustom nnmail-read-incoming-hook - (if (eq system-type 'windows-nt) - '(nnheader-ms-strip-cr) - nil) - "Hook that will be run after the incoming mail has been transferred. -The incoming mail is moved from `nnmail-spool-file' (which normally is -something like \"/usr/spool/mail/$user\") to the user's home -directory. This hook is called after the incoming mail box has been -emptied, and can be used to call any mail box programs you have -running (\"xwatch\", etc.) - -Eg. - -\(add-hook 'nnmail-read-incoming-hook - (lambda () - (start-process \"mailsend\" nil - \"/local/bin/mailsend\" \"read\" \"mbox\"))) - -If you have xwatch running, this will alert it that mail has been -read. - -If you use `display-time', you could use something like this: - -\(add-hook 'nnmail-read-incoming-hook - (lambda () - ;; Update the displayed time, since that will clear out - ;; the flag that says you have mail. - (when (eq (process-status \"display-time\") 'run) - (display-time-filter display-time-process \"\"))))" - :group 'nnmail-prepare - :type 'hook) - -;; Suggested by Erik Selberg . -(defcustom nnmail-prepare-incoming-hook nil - "Hook called before treating incoming mail. -The hook is run in a buffer with all the new, incoming mail." - :group 'nnmail-prepare - :type 'hook) - -(defcustom nnmail-prepare-incoming-header-hook nil - "Hook called narrowed to the headers of each message. -This can be used to remove excessive spaces (and stuff like -that) from the headers before splitting and saving the messages." - :group 'nnmail-prepare - :type 'hook) - -(defcustom nnmail-prepare-incoming-message-hook nil - "Hook called narrowed to each message." - :group 'nnmail-prepare - :type 'hook) - -(defcustom nnmail-list-identifiers nil - "Regexp that matches list identifiers to be removed. -This can also be a list of regexps." - :group 'nnmail-prepare - :type '(choice (const :tag "none" nil) - regexp - (repeat regexp))) - -(defcustom nnmail-pre-get-new-mail-hook nil - "Hook called just before starting to handle new incoming mail." - :group 'nnmail-retrieve - :type 'hook) - -(defcustom nnmail-post-get-new-mail-hook nil - "Hook called just after finishing handling new incoming mail." - :group 'nnmail-retrieve - :type 'hook) - -(defcustom nnmail-split-hook nil - "Hook called before deciding where to split an article. -The functions in this hook are free to modify the buffer -contents in any way they choose -- the buffer contents are -discarded after running the split process." - :group 'nnmail-split - :type 'hook) - -;; Suggested by Mejia Pablo J . -(defcustom nnmail-tmp-directory nil - "*If non-nil, use this directory for temporary storage. -Used when reading incoming mail." - :group 'nnmail-files - :group 'nnmail-retrieve - :type '(choice (const :tag "default" nil) - (directory :format "%v"))) - -(defcustom nnmail-large-newsgroup 50 - "*The number of the articles which indicates a large newsgroup. -If the number of the articles is greater than the value, verbose -messages will be shown to indicate the current status." - :group 'nnmail-various - :type 'integer) - -(defcustom nnmail-split-fancy "mail.misc" - "Incoming mail can be split according to this fancy variable. -To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'. - -The format is this variable is SPLIT, where SPLIT can be one of -the following: - -GROUP: Mail will be stored in GROUP (a string). - -\(FIELD VALUE SPLIT): If the message field FIELD (a regexp) contains - VALUE (a regexp), store the messages as specified by SPLIT. - -\(| SPLIT...): Process each SPLIT expression until one of them matches. - A SPLIT expression is said to match if it will cause the mail - message to be stored in one or more groups. - -\(& SPLIT...): Process each SPLIT expression. - -\(: FUNCTION optional args): Call FUNCTION with the optional args, in - the buffer containing the message headers. The return value FUNCTION - should be a split, which is then recursively processed. - -FIELD must match a complete field name. VALUE must match a complete -word according to the `nnmail-split-fancy-syntax-table' syntax table. -You can use \".*\" in the regexps to match partial field names or words. - -FIELD and VALUE can also be lisp symbols, in that case they are expanded -as specified in `nnmail-split-abbrev-alist'. - -GROUP can contain \\& and \\N which will substitute from matching -\\(\\) patterns in the previous VALUE. - -Example: - -\(setq nnmail-split-methods 'nnmail-split-fancy - nnmail-split-fancy - ;; Messages from the mailer daemon are not crossposted to any of - ;; the ordinary groups. Warnings are put in a separate group - ;; from real errors. - '(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\") - \"mail.misc\")) - ;; Non-error messages are crossposted to all relevant - ;; groups, but we don't crosspost between the group for the - ;; (ding) list and the group for other (ding) related mail. - (& (| (any \"ding@ifi\\\\.uio\\\\.no\" \"ding.list\") - (\"subject\" \"ding\" \"ding.misc\")) - ;; Other mailing lists... - (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\") - (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\") - ;; People... - (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\")) - ;; Unmatched mail goes to the catch all group. - \"misc.misc\"))" - :group 'nnmail-split - ;; Sigh! - :type 'sexp) - -(defcustom nnmail-split-abbrev-alist - '((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc") - (mail . "mailer-daemon\\|postmaster\\|uucp") - (to . "to\\|cc\\|apparently-to\\|resent-to\\|resent-cc") - (from . "from\\|sender\\|resent-from") - (nato . "to\\|cc\\|resent-to\\|resent-cc") - (naany . "from\\|to\\|cc\\|sender\\|resent-from\\|resent-to\\|resent-cc")) - "Alist of abbreviations allowed in `nnmail-split-fancy'." - :group 'nnmail-split - :type '(repeat (cons :format "%v" symbol regexp))) - -(defcustom nnmail-delete-incoming t - "*If non-nil, the mail backends will delete incoming files after -splitting." - :group 'nnmail-retrieve - :type 'boolean) - -(defcustom nnmail-message-id-cache-length 1000 - "*The approximate number of Message-IDs nnmail will keep in its cache. -If this variable is nil, no checking on duplicate messages will be -performed." - :group 'nnmail-duplicate - :type '(choice (const :tag "disable" nil) - (integer :format "%v"))) - -(defcustom nnmail-message-id-cache-file "~/.nnmail-cache" - "*The file name of the nnmail Message-ID cache." - :group 'nnmail-duplicate - :group 'nnmail-files - :type 'file) - -(defcustom nnmail-treat-duplicates 'warn - "*If non-nil, nnmail keep a cache of Message-IDs to discover mail duplicates. -Three values are legal: nil, which means that nnmail is not to keep a -Message-ID cache; `warn', which means that nnmail should insert extra -headers to warn the user about the duplication (this is the default); -and `delete', which means that nnmail will delete duplicated mails. - -This variable can also be a function. It will be called from a buffer -narrowed to the article in question with the Message-ID as a -parameter. It should return nil, `warn' or `delete'." - :group 'nnmail-duplicate - :type '(choice (const :tag "off" nil) - (const warn) - (const delete))) - -;;; Internal variables. - -(defvar nnmail-split-history nil - "List of group/article elements that say where the previous split put messages.") - -(defvar nnmail-pop-password nil - "*Password to use when reading mail from a POP server, if required.") - -(defvar nnmail-split-fancy-syntax-table nil - "Syntax table used by `nnmail-split-fancy'.") -(unless (syntax-table-p nnmail-split-fancy-syntax-table) - (setq nnmail-split-fancy-syntax-table - (copy-syntax-table (standard-syntax-table))) - ;; support the %-hack - (modify-syntax-entry ?\% "." nnmail-split-fancy-syntax-table)) - -(defvar nnmail-prepare-save-mail-hook nil - "Hook called before saving mail.") - -(defvar nnmail-moved-inboxes nil - "List of inboxes that have been moved.") - -(defvar nnmail-internal-password nil) - - - -(defconst nnmail-version "nnmail 1.0" - "nnmail version.") - - - -(defun nnmail-request-post (&optional server) - (mail-send-and-exit nil)) - -(defun nnmail-find-file (file) - "Insert FILE in server buffer safely." - (set-buffer nntp-server-buffer) - (erase-buffer) - (let ((format-alist nil) - (after-insert-file-functions nil)) - (condition-case () - (progn (insert-file-contents file) t) - (file-error nil)))) - -(defun nnmail-group-pathname (group dir &optional file) - "Make pathname for GROUP." - (concat - (let ((dir (file-name-as-directory (expand-file-name dir)))) - ;; If this directory exists, we use it directly. - (if (or nnmail-use-long-file-names - (file-directory-p (concat dir group))) - (concat dir group "/") - ;; If not, we translate dots into slashes. - (concat dir (nnheader-replace-chars-in-string group ?. ?/) "/"))) - (or file ""))) - -(defun nnmail-date-to-time (date) - "Convert DATE into time." - (condition-case () - (let* ((d1 (timezone-parse-date date)) - (t1 (timezone-parse-time (aref d1 3)))) - (apply 'encode-time - (mapcar (lambda (el) - (and el (string-to-number el))) - (list - (aref t1 2) (aref t1 1) (aref t1 0) - (aref d1 2) (aref d1 1) (aref d1 0) - (number-to-string - (* 60 (timezone-zone-to-minute (aref d1 4)))))))) - ;; If we get an error, then we just return a 0 time. - (error (list 0 0)))) - -(defun nnmail-time-less (t1 t2) - "Say whether time T1 is less than time T2." - (or (< (car t1) (car t2)) - (and (= (car t1) (car t2)) - (< (nth 1 t1) (nth 1 t2))))) - -(defun nnmail-days-to-time (days) - "Convert DAYS into time." - (let* ((seconds (* 1.0 days 60 60 24)) - (rest (expt 2 16)) - (ms (condition-case nil (round (/ seconds rest)) - (range-error (expt 2 16))))) - (list ms (condition-case nil (round (- seconds (* ms rest))) - (range-error (expt 2 16)))))) - -(defun nnmail-time-since (time) - "Return the time since TIME, which is either an internal time or a date." - (when (stringp time) - ;; Convert date strings to internal time. - (setq time (nnmail-date-to-time time))) - (let* ((current (current-time)) - (rest (when (< (nth 1 current) (nth 1 time)) - (expt 2 16)))) - (list (- (+ (car current) (if rest -1 0)) (car time)) - (- (+ (or rest 0) (nth 1 current)) (nth 1 time))))) - -;; Function rewritten from rmail.el. -(defun nnmail-move-inbox (inbox) - "Move INBOX to `nnmail-crash-box'." - (if (not (file-writable-p nnmail-crash-box)) - (gnus-error 1 "Can't write to crash box %s. Not moving mail" - nnmail-crash-box) - ;; If the crash box exists and is empty, we delete it. - (when (and (file-exists-p nnmail-crash-box) - (zerop (nnheader-file-size (file-truename nnmail-crash-box)))) - (delete-file nnmail-crash-box)) - (let ((tofile (file-truename (expand-file-name nnmail-crash-box))) - (popmail (string-match "^po:" inbox)) - movemail errors result) - (unless popmail - (setq inbox (file-truename (expand-file-name inbox))) - (setq movemail t) - ;; On some systems, /usr/spool/mail/foo is a directory - ;; and the actual inbox is /usr/spool/mail/foo/foo. - (when (file-directory-p inbox) - (setq inbox (expand-file-name (user-login-name) inbox)))) - (if (member inbox nnmail-moved-inboxes) - ;; We don't try to move an already moved inbox. - nil - (if popmail - (progn - (when (and nnmail-pop-password - (not nnmail-internal-password)) - (setq nnmail-internal-password nnmail-pop-password)) - (when (and nnmail-pop-password-required - (not nnmail-internal-password)) - (setq nnmail-internal-password - (nnmail-read-passwd - (format "Password for %s: " - (substring inbox (+ popmail 3)))))) - (message "Getting mail from the post office...")) - (when (or (and (file-exists-p tofile) - (/= 0 (nnheader-file-size tofile))) - (and (file-exists-p inbox) - (/= 0 (nnheader-file-size inbox)))) - (message "Getting mail from %s..." inbox))) - ;; Set TOFILE if have not already done so, and - ;; rename or copy the file INBOX to TOFILE if and as appropriate. - (cond - ((file-exists-p tofile) - ;; The crash box exists already. - t) - ((and (not popmail) - (not (file-exists-p inbox))) - ;; There is no inbox. - (setq tofile nil)) - (t - ;; If getting from mail spool directory, use movemail to move - ;; rather than just renaming, so as to interlock with the - ;; mailer. - (unwind-protect - (save-excursion - (setq errors (generate-new-buffer " *nnmail loss*")) - (buffer-disable-undo errors) - (let ((default-directory "/")) - (if (nnheader-functionp nnmail-movemail-program) - (condition-case err - (progn - (funcall nnmail-movemail-program inbox tofile) - (setq result 0)) - (error - (save-excursion - (set-buffer errors) - (insert (prin1-to-string err)) - (setq result 255)))) - (setq result - (apply - 'call-process - (append - (list - (expand-file-name - nnmail-movemail-program exec-directory) - nil errors nil inbox tofile) - (when nnmail-internal-password - (list nnmail-internal-password))))))) - (if (and (not (buffer-modified-p errors)) - (zerop result)) - ;; No output => movemail won - (progn - (unless popmail - (when (file-exists-p tofile) - (set-file-modes tofile nnmail-default-file-modes))) - (push inbox nnmail-moved-inboxes)) - (set-buffer errors) - ;; There may be a warning about older revisions. We - ;; ignore those. - (goto-char (point-min)) - (if (search-forward "older revision" nil t) - (progn - (unless popmail - (when (file-exists-p tofile) - (set-file-modes tofile nnmail-default-file-modes))) - (push inbox nnmail-moved-inboxes)) - ;; Probably a real error. - (subst-char-in-region (point-min) (point-max) ?\n ?\ ) - (goto-char (point-max)) - (skip-chars-backward " \t") - (delete-region (point) (point-max)) - (goto-char (point-min)) - (when (looking-at "movemail: ") - (delete-region (point-min) (match-end 0))) - (unless (yes-or-no-p - (format "movemail: %s (%d return). Continue? " - (buffer-string) result)) - (error "%s" (buffer-string))) - (setq tofile nil))))))) - (message "Getting mail from %s...done" inbox) - (and errors - (buffer-name errors) - (kill-buffer errors)) - tofile)))) - -(defun nnmail-get-active () - "Returns an assoc of group names and active ranges. -nn*-request-list should have been called before calling this function." - (let (group-assoc) - ;; Go through all groups from the active list. - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (while (re-search-forward - "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t) - ;; We create an alist with `(GROUP (LOW . HIGH))' elements. - (push (list (match-string 1) - (cons (string-to-int (match-string 3)) - (string-to-int (match-string 2)))) - group-assoc))) - group-assoc)) - -(defun nnmail-save-active (group-assoc file-name) - "Save GROUP-ASSOC in ACTIVE-FILE." - (when file-name - (nnheader-temp-write file-name - (nnmail-generate-active group-assoc)))) - -(defun nnmail-generate-active (alist) - "Generate an active file from group-alist ALIST." - (erase-buffer) - (let (group) - (while (setq group (pop alist)) - (insert (format "%s %d %d y\n" (car group) (cdadr group) - (caadr group)))))) - -(defun nnmail-get-split-group (file group) - "Find out whether this FILE is to be split into GROUP only. -If GROUP is non-nil and we are using procmail, return the group name -only when the file is the correct procmail file. When GROUP is nil, -return nil if FILE is a spool file or the procmail group for which it -is a spool. If not using procmail, return GROUP." - (if (or (eq nnmail-spool-file 'procmail) - nnmail-use-procmail) - (if (string-match (concat "^" (expand-file-name - (file-name-as-directory - nnmail-procmail-directory)) - "\\([^/]*\\)" nnmail-procmail-suffix "$") - (expand-file-name file)) - (let ((procmail-group (substring (expand-file-name file) - (match-beginning 1) - (match-end 1)))) - (if group - (if (string-equal group procmail-group) - group - nil) - procmail-group)) - nil) - group)) - -(defun nnmail-process-babyl-mail-format (func artnum-func) - (let ((case-fold-search t) - start message-id content-length do-search end) - (goto-char (point-min)) - (while (not (eobp)) - (re-search-forward - " \n0, *unseen,+\n\\(\\*\\*\\* EOOH \\*\\*\\*\n\\)?" nil t) - (goto-char (match-end 0)) - (delete-region (match-beginning 0) (match-end 0)) - (narrow-to-region - (setq start (point)) - (progn - ;; Skip all the headers in case there are more "From "s... - (or (search-forward "\n\n" nil t) - (search-forward-regexp "^[^:]*\\( .*\\|\\)$" nil t) - (search-forward " ")) - (point))) - ;; Unquote the ">From " line, if any. - (goto-char (point-min)) - (when (looking-at ">From ") - (replace-match "X-From-Line: ") ) - (run-hooks 'nnmail-prepare-incoming-header-hook) - (goto-char (point-max)) - ;; Find the Message-ID header. - (save-excursion - (if (re-search-backward - "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]*>\\)" nil t) - (setq message-id (buffer-substring (match-beginning 1) - (match-end 1))) - ;; There is no Message-ID here, so we create one. - (save-excursion - (when (re-search-backward "^Message-ID[ \t]*:" nil t) - (beginning-of-line) - (insert "Original-"))) - (forward-line -1) - (insert "Message-ID: " (setq message-id (nnmail-message-id)) - "\n"))) - ;; Look for a Content-Length header. - (if (not (save-excursion - (and (re-search-backward - "^Content-Length:[ \t]*\\([0-9]+\\)" start t) - (setq content-length (string-to-int - (buffer-substring - (match-beginning 1) - (match-end 1)))) - ;; We destroy the header, since none of - ;; the backends ever use it, and we do not - ;; want to confuse other mailers by having - ;; a (possibly) faulty header. - (progn (insert "X-") t)))) - (setq do-search t) - (widen) - (if (or (= (+ (point) content-length) (point-max)) - (save-excursion - (goto-char (+ (point) content-length)) - (looking-at ""))) - (progn - (goto-char (+ (point) content-length)) - (setq do-search nil)) - (setq do-search t))) - (widen) - ;; Go to the beginning of the next article - or to the end - ;; of the buffer. - (when do-search - (if (re-search-forward "^" nil t) - (goto-char (match-beginning 0)) - (goto-char (1- (point-max))))) - (delete-char 1) ; delete ^_ - (save-excursion - (save-restriction - (narrow-to-region start (point)) - (goto-char (point-min)) - (nnmail-check-duplication message-id func artnum-func) - (setq end (point-max)))) - (goto-char end)))) - -(defsubst nnmail-search-unix-mail-delim () - "Put point at the beginning of the next Unix mbox message." - ;; Algorithm used to find the the next article in the - ;; brain-dead Unix mbox format: - ;; - ;; 1) Search for "^From ". - ;; 2) If we find it, then see whether the previous - ;; line is blank and the next line looks like a header. - ;; Then it's possible that this is a mail delim, and we use it. - (let ((case-fold-search nil) - found) - (while (not found) - (if (not (re-search-forward "^From " nil t)) - (setq found 'no) - (save-excursion - (beginning-of-line) - (when (and (or (bobp) - (save-excursion - (forward-line -1) - (= (following-char) ?\n))) - (save-excursion - (forward-line 1) - (while (looking-at ">From \\|From ") - (forward-line 1)) - (looking-at "[^ \n\t:]+[ \n\t]*:"))) - (setq found 'yes))))) - (beginning-of-line) - (eq found 'yes))) - -(defun nnmail-search-unix-mail-delim-backward () - "Put point at the beginning of the current Unix mbox message." - ;; Algorithm used to find the the next article in the - ;; brain-dead Unix mbox format: - ;; - ;; 1) Search for "^From ". - ;; 2) If we find it, then see whether the previous - ;; line is blank and the next line looks like a header. - ;; Then it's possible that this is a mail delim, and we use it. - (let ((case-fold-search nil) - found) - (while (not found) - (if (not (re-search-backward "^From " nil t)) - (setq found 'no) - (save-excursion - (beginning-of-line) - (when (and (or (bobp) - (save-excursion - (forward-line -1) - (= (following-char) ?\n))) - (save-excursion - (forward-line 1) - (while (looking-at ">From \\|From ") - (forward-line 1)) - (looking-at "[^ \n\t:]+[ \n\t]*:"))) - (setq found 'yes))))) - (beginning-of-line) - (eq found 'yes))) - -(defun nnmail-process-unix-mail-format (func artnum-func) - (let ((case-fold-search t) - start message-id content-length end skip head-end) - (goto-char (point-min)) - (if (not (and (re-search-forward "^From " nil t) - (goto-char (match-beginning 0)))) - ;; Possibly wrong format? - (error "Error, unknown mail format! (Possibly corrupted.)") - ;; Carry on until the bitter end. - (while (not (eobp)) - (setq start (point) - end nil) - ;; Find the end of the head. - (narrow-to-region - start - (if (search-forward "\n\n" nil t) - (1- (point)) - ;; This will never happen, but just to be on the safe side -- - ;; if there is no head-body delimiter, we search a bit manually. - (while (and (looking-at "From \\|[^ \t]+:") - (not (eobp))) - (forward-line 1)) - (point))) - ;; Find the Message-ID header. - (goto-char (point-min)) - (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t) - (setq message-id (match-string 1)) - (save-excursion - (when (re-search-forward "^Message-ID[ \t]*:" nil t) - (beginning-of-line) - (insert "Original-"))) - ;; There is no Message-ID here, so we create one. - (forward-line 1) - (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n")) - ;; Look for a Content-Length header. - (goto-char (point-min)) - (if (not (re-search-forward - "^Content-Length:[ \t]*\\([0-9]+\\)" nil t)) - (setq content-length nil) - (setq content-length (string-to-int (match-string 1))) - ;; We destroy the header, since none of the backends ever - ;; use it, and we do not want to confuse other mailers by - ;; having a (possibly) faulty header. - (beginning-of-line) - (insert "X-")) - (run-hooks 'nnmail-prepare-incoming-header-hook) - ;; Find the end of this article. - (goto-char (point-max)) - (widen) - (setq head-end (point)) - ;; We try the Content-Length value. The idea: skip over the header - ;; separator, then check what happens content-length bytes into the - ;; message body. This should be either the end ot the buffer, the - ;; message separator or a blank line followed by the separator. - ;; The blank line should probably be deleted. If neither of the - ;; three is met, the content-length header is probably invalid. - (when content-length - (forward-line 1) - (setq skip (+ (point) content-length)) - (goto-char skip) - (cond ((or (= skip (point-max)) - (= (1+ skip) (point-max))) - (setq end (point-max))) - ((looking-at "From ") - (setq end skip)) - ((looking-at "[ \t]*\n\\(From \\)") - (setq end (match-beginning 1))) - (t (setq end nil)))) - (if end - (goto-char end) - ;; No Content-Length, so we find the beginning of the next - ;; article or the end of the buffer. - (goto-char head-end) - (or (nnmail-search-unix-mail-delim) - (goto-char (point-max)))) - ;; Allow the backend to save the article. - (save-excursion - (save-restriction - (narrow-to-region start (point)) - (goto-char (point-min)) - (nnmail-check-duplication message-id func artnum-func) - (setq end (point-max)))) - (goto-char end))))) - -(defun nnmail-process-mmdf-mail-format (func artnum-func) - (let ((delim "^\^A\^A\^A\^A$") - (case-fold-search t) - start message-id end) - (goto-char (point-min)) - (if (not (and (re-search-forward delim nil t) - (forward-line 1))) - ;; Possibly wrong format? - (error "Error, unknown mail format! (Possibly corrupted.)") - ;; Carry on until the bitter end. - (while (not (eobp)) - (setq start (point)) - ;; Find the end of the head. - (narrow-to-region - start - (if (search-forward "\n\n" nil t) - (1- (point)) - ;; This will never happen, but just to be on the safe side -- - ;; if there is no head-body delimiter, we search a bit manually. - (while (and (looking-at "From \\|[^ \t]+:") - (not (eobp))) - (forward-line 1)) - (point))) - ;; Find the Message-ID header. - (goto-char (point-min)) - (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t) - (setq message-id (match-string 1)) - ;; There is no Message-ID here, so we create one. - (save-excursion - (when (re-search-backward "^Message-ID[ \t]*:" nil t) - (beginning-of-line) - (insert "Original-"))) - (forward-line 1) - (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n")) - (run-hooks 'nnmail-prepare-incoming-header-hook) - ;; Find the end of this article. - (goto-char (point-max)) - (widen) - (if (re-search-forward delim nil t) - (beginning-of-line) - (goto-char (point-max))) - ;; Allow the backend to save the article. - (save-excursion - (save-restriction - (narrow-to-region start (point)) - (goto-char (point-min)) - (nnmail-check-duplication message-id func artnum-func) - (setq end (point-max)))) - (goto-char end) - (forward-line 2))))) - -(defun nnmail-split-incoming (incoming func &optional exit-func - group artnum-func) - "Go through the entire INCOMING file and pick out each individual mail. -FUNC will be called with the buffer narrowed to each mail." - (let (;; If this is a group-specific split, we bind the split - ;; methods to just this group. - (nnmail-split-methods (if (and group - (or (eq nnmail-spool-file 'procmail) - nnmail-use-procmail) - (not nnmail-resplit-incoming)) - (list (list group "")) - nnmail-split-methods))) - (save-excursion - ;; Insert the incoming file. - (set-buffer (get-buffer-create " *nnmail incoming*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (nnheader-insert-file-contents incoming) - (unless (zerop (buffer-size)) - (goto-char (point-min)) - (save-excursion (run-hooks 'nnmail-prepare-incoming-hook)) - ;; Handle both babyl, MMDF and unix mail formats, since movemail will - ;; use the former when fetching from a mailbox, the latter when - ;; fetching from a file. - (cond ((or (looking-at "\^L") - (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)) - (t - (nnmail-process-unix-mail-format func artnum-func)))) - (when exit-func - (funcall exit-func)) - (kill-buffer (current-buffer))))) - -;; Mail crossposts suggested by Brian Edmonds . -(defun nnmail-article-group (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 nnmail-split-methods) - (obuf (current-buffer)) - (beg (point-min)) - end group-art method) - (if (and (sequencep methods) (= (length methods) 1)) - ;; If there is only just one group to put everything in, we - ;; just return a list with just this one method in. - (setq group-art - (list (cons (caar methods) (funcall func (caar methods))))) - ;; We do actual comparison. - (save-excursion - ;; Find headers. - (goto-char beg) - (setq end (if (search-forward "\n\n" nil t) (point) (point-max))) - (set-buffer nntp-server-buffer) - (erase-buffer) - ;; Copy the headers into the work buffer. - (insert-buffer-substring obuf beg end) - ;; Fold continuation lines. - (goto-char (point-min)) - (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) - (replace-match " " t t)) - ;; Allow washing. - (run-hooks 'nnmail-split-hook) - (if (and (symbolp nnmail-split-methods) - (fboundp nnmail-split-methods)) - (let ((split - (condition-case nil - ;; `nnmail-split-methods' is a function, so we - ;; just call this function here and use the - ;; result. - (or (funcall nnmail-split-methods) - '("bogus")) - (error - (message - "Error in `nnmail-split-methods'; using `bogus' mail group") - (sit-for 1) - '("bogus"))))) - ;; 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 split - (setq group-art - (mapcar - (lambda (group) (cons group (funcall func group))) - split)))) - ;; Go through the split methods to find a match. - (while (and methods (or nnmail-crosspost (not group-art))) - (goto-char (point-max)) - (setq method (pop methods)) - (if (or methods - (not (equal "" (nth 1 method)))) - (when (and - (ignore-errors - (if (stringp (nth 1 method)) - (re-search-backward (cadr method) nil t) - ;; Function to say whether this is a match. - (funcall (nth 1 method) (car method)))) - ;; Don't enter the article into the same - ;; group twice. - (not (assoc (car method) group-art))) - (push (cons (car method) (funcall func (car method))) - group-art)) - ;; This is the final group, which is used as a - ;; catch-all. - (unless group-art - (setq group-art - (list (cons (car method) - (funcall func (car method))))))))) - ;; See whether the split methods returned `junk'. - (if (equal group-art '(junk)) - nil - ;; 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 group-art))) - (setq group-art (delq elem group-art))) - (nreverse group-art))))))) - -(defun nnmail-insert-lines () - "Insert how many lines there are in the body of the mail. -Return the number of characters in the body." - (let (lines chars) - (save-excursion - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (setq chars (- (point-max) (point))) - (setq lines (count-lines (point) (point-max))) - (forward-char -1) - (save-excursion - (when (re-search-backward "^Lines: " nil t) - (delete-region (point) (progn (forward-line 1) (point))))) - (beginning-of-line) - (insert (format "Lines: %d\n" (max lines 0))) - chars)))) - -(defun nnmail-insert-xref (group-alist) - "Insert an Xref line based on the (group . article) alist." - (save-excursion - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (forward-char -1) - (when (re-search-backward "^Xref: " nil t) - (delete-region (match-beginning 0) - (progn (forward-line 1) (point)))) - (insert (format "Xref: %s" (system-name))) - (while group-alist - (insert (format " %s:%d" (caar group-alist) (cdar group-alist))) - (setq group-alist (cdr group-alist))) - (insert "\n")))) - -;;; Message washing functions - -(defun nnmail-remove-leading-whitespace () - "Remove excessive whitespace from all headers." - (goto-char (point-min)) - (while (re-search-forward "^\\([^ :]+: \\) +" nil t) - (replace-match "\\1" t))) - -(defun nnmail-remove-list-identifiers () - "Remove list identifiers from Subject headers." - (let ((regexp (if (stringp nnmail-list-identifiers) nnmail-list-identifiers - (mapconcat 'identity nnmail-list-identifiers "\\|")))) - (when regexp - (goto-char (point-min)) - (when (re-search-forward - (concat "^Subject: +\\(Re: +\\)?\\(" regexp "\\) *") - nil t) - (delete-region (match-beginning 2) (match-end 0)))))) - -(defun nnmail-remove-tabs () - "Translate TAB characters into SPACE characters." - (subst-char-in-region (point-min) (point-max) ?\t ? t)) - -;;; Utility functions - -;; Written by byer@mv.us.adobe.com (Scott Byer). -(defun nnmail-make-complex-temp-name (prefix) - (let ((newname (make-temp-name prefix)) - (newprefix prefix)) - (while (file-exists-p newname) - (setq newprefix (concat newprefix "x")) - (setq newname (make-temp-name newprefix))) - newname)) - -;; Written by Per Abrahamsen . - -(defun nnmail-split-fancy () - "Fancy splitting method. -See the documentation for the variable `nnmail-split-fancy' for documentation." - (let ((syntab (syntax-table))) - (unwind-protect - (progn - (set-syntax-table nnmail-split-fancy-syntax-table) - (nnmail-split-it nnmail-split-fancy)) - (set-syntax-table syntab)))) - -(defvar nnmail-split-cache nil) -;; Alist of split expressions their equivalent regexps. - -(defun nnmail-split-it (split) - ;; Return a list of groups matching SPLIT. - (cond - ;; nil split - ((null split) - nil) - - ;; A group name. Do the \& and \N subs into the string. - ((stringp split) - (list (nnmail-expand-newtext split))) - - ;; Junk the message. - ((eq split 'junk) - (list 'junk)) - - ;; Builtin & operation. - ((eq (car split) '&) - (apply 'nconc (mapcar 'nnmail-split-it (cdr split)))) - - ;; Builtin | operation. - ((eq (car split) '|) - (let (done) - (while (and (not done) (cdr split)) - (setq split (cdr split) - done (nnmail-split-it (car split)))) - done)) - - ;; Builtin : operation. - ((eq (car split) ':) - (nnmail-split-it (eval (cdr split)))) - - ;; Check the cache for the regexp for this split. - ;; FIX FIX FIX could avoid calling assq twice here - ((assq split nnmail-split-cache) - (goto-char (point-max)) - ;; FIX FIX FIX problem with re-search-backward is that if you have - ;; a split: (from "foo-\\(bar\\|baz\\)@gnus.org "mail.foo.\\1") - ;; and someone mails a message with 'To: foo-bar@gnus.org' and - ;; 'CC: foo-baz@gnus.org', we'll pick 'mail.foo.baz' as the group - ;; if the cc line is a later header, even though the other choice - ;; is probably better. Also, this routine won't do a crosspost - ;; when there are two different matches. - ;; I guess you could just make this more determined, and it could - ;; look for still more matches prior to this one, and recurse - ;; on each of the multiple matches hit. Of course, then you'd - ;; want to make sure that nnmail-article-group or nnmail-split-fancy - ;; removed duplicates, since there might be more of those. - ;; I guess we could also remove duplicates in the & split case, since - ;; that's the only thing that can introduce them. - (when (re-search-backward (cdr (assq split nnmail-split-cache)) nil t) - ;; Someone might want to do a \N sub on this match, so get the - ;; correct match positions. - (goto-char (match-end 0)) - (let ((value (nth 1 split))) - (re-search-backward (if (symbolp value) - (cdr (assq value nnmail-split-abbrev-alist)) - value) - (match-end 1))) - (nnmail-split-it (nth 2 split)))) - - ;; Not in cache, compute a regexp for the field/value pair. - (t - (let* ((field (nth 0 split)) - (value (nth 1 split)) - (regexp (concat "^\\(\\(" - (if (symbolp field) - (cdr (assq field nnmail-split-abbrev-alist)) - field) - "\\):.*\\)\\<\\(" - (if (symbolp value) - (cdr (assq value nnmail-split-abbrev-alist)) - value) - "\\)\\>"))) - (push (cons split regexp) nnmail-split-cache) - ;; Now that it's in the cache, just call nnmail-split-it again - ;; on the same split, which will find it immediately in the cache. - (nnmail-split-it split))))) - -(defun nnmail-expand-newtext (newtext) - (let ((len (length newtext)) - (pos 0) - c expanded beg N did-expand) - (while (< pos len) - (setq beg pos) - (while (and (< pos len) - (not (= (aref newtext pos) ?\\))) - (setq pos (1+ pos))) - (unless (= beg pos) - (push (substring newtext beg pos) expanded)) - (when (< pos len) - ;; we hit a \, expand it. - (setq did-expand t) - (setq pos (1+ pos)) - (setq c (aref newtext pos)) - (if (not (or (= c ?\&) - (and (>= c ?1) - (<= c ?9)))) - ;; \ followed by some character we don't expand - (push (char-to-string c) expanded) - ;; \& or \N - (if (= c ?\&) - (setq N 0) - (setq N (- c ?0))) - (when (match-beginning N) - (push (buffer-substring (match-beginning N) (match-end N)) - expanded)))) - (setq pos (1+ pos))) - (if did-expand - (apply 'concat (nreverse expanded)) - newtext))) - -;; Get a list of spool files to read. -(defun nnmail-get-spool-files (&optional group) - (if (null nnmail-spool-file) - ;; No spool file whatsoever. - nil - (let* ((procmails - ;; If procmail is used to get incoming mail, the files - ;; are stored in this directory. - (and (file-exists-p nnmail-procmail-directory) - (or (eq nnmail-spool-file 'procmail) - nnmail-use-procmail) - (directory-files - nnmail-procmail-directory - t (concat (if group (concat "^" group) "") - nnmail-procmail-suffix "$")))) - (p procmails) - (crash (when (and (file-exists-p nnmail-crash-box) - (> (nnheader-file-size - (file-truename nnmail-crash-box)) - 0)) - (list nnmail-crash-box)))) - ;; Remove any directories that inadvertently match the procmail - ;; suffix, which might happen if the suffix is "". - (while p - (when (file-directory-p (car p)) - (setq procmails (delete (car p) procmails))) - (setq p (cdr p))) - ;; Return the list of spools. - (append - crash - (cond ((and group - (or (eq nnmail-spool-file 'procmail) - nnmail-use-procmail) - procmails) - procmails) - ((and group - (eq nnmail-spool-file 'procmail)) - nil) - ((listp nnmail-spool-file) - (nconc - (apply - 'nconc - (mapcar - (lambda (file) - (if (and (not (string-match "^po:" file)) - (file-directory-p file)) - (nnheader-directory-regular-files file) - (list file))) - nnmail-spool-file)) - procmails)) - ((stringp nnmail-spool-file) - (if (and (not (string-match "^po:" nnmail-spool-file)) - (file-directory-p nnmail-spool-file)) - (nconc - (nnheader-directory-regular-files nnmail-spool-file) - procmails) - (cons nnmail-spool-file procmails))) - ((eq nnmail-spool-file 'pop) - (cons (format "po:%s" (user-login-name)) procmails)) - (t - procmails)))))) - -;; Activate a backend only if it isn't already activated. -;; If FORCE, re-read the active file even if the backend is -;; already activated. -(defun nnmail-activate (backend &optional force) - (let (file timestamp file-time) - (if (or (not (symbol-value (intern (format "%s-group-alist" backend)))) - force - (and (setq file (ignore-errors - (symbol-value (intern (format "%s-active-file" - backend))))) - (setq file-time (nth 5 (file-attributes file))) - (or (not - (setq timestamp - (condition-case () - (symbol-value (intern - (format "%s-active-timestamp" - backend))) - (error 'none)))) - (not (consp timestamp)) - (equal timestamp '(0 0)) - (> (nth 0 file-time) (nth 0 timestamp)) - (and (= (nth 0 file-time) (nth 0 timestamp)) - (> (nth 1 file-time) (nth 1 timestamp)))))) - (save-excursion - (or (eq timestamp 'none) - (set (intern (format "%s-active-timestamp" backend)) - file-time)) - (funcall (intern (format "%s-request-list" backend))))) - t)) - -(defun nnmail-message-id () - (concat "<" (message-unique-id) "@totally-fudged-out-message-id>")) - -;;; -;;; nnmail duplicate handling -;;; - -(defvar nnmail-cache-buffer nil) - -(defun nnmail-cache-open () - (if (or (not nnmail-treat-duplicates) - (and nnmail-cache-buffer - (buffer-name nnmail-cache-buffer))) - () ; The buffer is open. - (save-excursion - (set-buffer - (setq nnmail-cache-buffer - (get-buffer-create " *nnmail message-id cache*"))) - (buffer-disable-undo (current-buffer)) - (when (file-exists-p nnmail-message-id-cache-file) - (nnheader-insert-file-contents nnmail-message-id-cache-file)) - (set-buffer-modified-p nil) - (current-buffer)))) - -(defun nnmail-cache-close () - (when (and nnmail-cache-buffer - nnmail-treat-duplicates - (buffer-name nnmail-cache-buffer) - (buffer-modified-p nnmail-cache-buffer)) - (save-excursion - (set-buffer nnmail-cache-buffer) - ;; Weed out the excess number of Message-IDs. - (goto-char (point-max)) - (when (search-backward "\n" nil t nnmail-message-id-cache-length) - (progn - (beginning-of-line) - (delete-region (point-min) (point)))) - ;; Save the buffer. - (or (file-exists-p (file-name-directory nnmail-message-id-cache-file)) - (make-directory (file-name-directory nnmail-message-id-cache-file) - t)) - (nnmail-write-region (point-min) (point-max) - nnmail-message-id-cache-file nil 'silent) - (set-buffer-modified-p nil) - (setq nnmail-cache-buffer nil) - (kill-buffer (current-buffer))))) - -(defun nnmail-cache-insert (id) - (when nnmail-treat-duplicates - (unless (gnus-buffer-live-p nnmail-cache-buffer) - (nnmail-cache-open)) - (save-excursion - (set-buffer nnmail-cache-buffer) - (goto-char (point-max)) - (insert id "\n")))) - -(defun nnmail-cache-id-exists-p (id) - (when nnmail-treat-duplicates - (save-excursion - (set-buffer nnmail-cache-buffer) - (goto-char (point-max)) - (search-backward id nil t)))) - -(defun nnmail-fetch-field (header) - (save-excursion - (save-restriction - (message-narrow-to-head) - (message-fetch-field header)))) - -(defun nnmail-check-duplication (message-id func artnum-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)) - (case-fold-search t) - (action (when duplication - (cond - ((memq nnmail-treat-duplicates '(warn delete)) - nnmail-treat-duplicates) - ((nnheader-functionp nnmail-treat-duplicates) - (funcall nnmail-treat-duplicates message-id)) - (t - nnmail-treat-duplicates)))) - group-art) - ;; Let the backend save the article (or not). - (cond - ((not duplication) - (nnmail-cache-insert message-id) - (funcall func (setq group-art - (nreverse (nnmail-article-group artnum-func))))) - ((eq action 'delete) - (setq group-art nil)) - ((eq action 'warn) - ;; We insert a warning. - (let ((case-fold-search t)) - (goto-char (point-min)) - (re-search-forward "^message-id[ \t]*:" nil t) - (beginning-of-line) - (insert - "Gnus-Warning: This is a duplicate of message " message-id "\n") - (funcall func (setq group-art - (nreverse (nnmail-article-group artnum-func)))))) - (t - (funcall func (setq group-art - (nreverse (nnmail-article-group artnum-func)))))) - ;; Add the group-art list to the history list. - (if group-art - (push group-art nnmail-split-history) - (delete-region (point-min) (point-max))))) - -;;; Get new mail. - -(defun nnmail-get-value (&rest args) - (let ((sym (intern (apply 'format args)))) - (when (boundp sym) - (symbol-value sym)))) - -(defun nnmail-get-new-mail (method exit-func temp - &optional group spool-func) - "Read new incoming mail." - ;; Nix out the previous split history. - (unless group - (setq nnmail-split-history nil)) - (let* ((spools (nnmail-get-spool-files group)) - (group-in group) - incoming incomings spool) - (when (and (nnmail-get-value "%s-get-new-mail" method) - nnmail-spool-file) - ;; We first activate all the groups. - (nnmail-activate method) - ;; Allow the user to hook. - (run-hooks 'nnmail-pre-get-new-mail-hook) - ;; Open the message-id cache. - (nnmail-cache-open) - ;; The we go through all the existing spool files and split the - ;; mail from each. - (while spools - (setq spool (pop spools)) - ;; We read each spool file if either the spool is a POP-mail - ;; spool, or the file exists. We can't check for the - ;; existence of POPped mail. - (when (or (string-match "^po:" spool) - (and (file-exists-p (file-truename spool)) - (> (nnheader-file-size (file-truename spool)) 0))) - (nnheader-message 3 "%s: Reading incoming mail..." method) - (when (and (nnmail-move-inbox spool) - (file-exists-p nnmail-crash-box)) - ;; There is new mail. We first find out if all this mail - ;; is supposed to go to some specific group. - (setq group (nnmail-get-split-group spool group-in)) - ;; We split the mail - (nnmail-split-incoming - nnmail-crash-box (intern (format "%s-save-mail" method)) - spool-func group (intern (format "%s-active-number" method))) - ;; Check whether the inbox is to be moved to the special tmp dir. - (setq incoming - (nnmail-make-complex-temp-name - (expand-file-name - (if nnmail-tmp-directory - (concat - (file-name-as-directory nnmail-tmp-directory) - (file-name-nondirectory - (concat (file-name-as-directory temp) "Incoming"))) - (concat (file-name-as-directory temp) "Incoming"))))) - (rename-file nnmail-crash-box incoming t) - (push incoming incomings)))) - ;; If we did indeed read any incoming spools, we save all info. - (when incomings - (nnmail-save-active - (nnmail-get-value "%s-group-alist" method) - (nnmail-get-value "%s-active-file" method)) - (when exit-func - (funcall exit-func)) - (run-hooks 'nnmail-read-incoming-hook) - (nnheader-message 3 "%s: Reading incoming mail...done" method)) - ;; Close the message-id cache. - (nnmail-cache-close) - ;; Allow the user to hook. - (run-hooks 'nnmail-post-get-new-mail-hook) - ;; Delete all the temporary files. - (while incomings - (setq incoming (pop incomings)) - (and nnmail-delete-incoming - (file-exists-p incoming) - (file-writable-p incoming) - (delete-file incoming)))))) - -(defun nnmail-expired-article-p (group time force &optional inhibit) - "Say whether an article that is TIME old in GROUP should be expired." - (if force - t - (let ((days (or (and nnmail-expiry-wait-function - (funcall nnmail-expiry-wait-function group)) - nnmail-expiry-wait))) - (cond ((or (eq days 'never) - (and (not force) - inhibit)) - ;; This isn't an expirable group. - nil) - ((eq days 'immediate) - ;; We expire all articles on sight. - t) - ((equal time '(0 0)) - ;; This is an ange-ftp group, and we don't have any dates. - nil) - ((numberp days) - (setq days (nnmail-days-to-time days)) - ;; Compare the time with the current time. - (nnmail-time-less days (nnmail-time-since time))))))) - -(defvar nnmail-read-passwd nil) -(defun nnmail-read-passwd (prompt &rest args) - "Read a password using PROMPT. -If ARGS, PROMPT is used as an argument to `format'." - (let ((prompt - (if args - (apply 'format prompt args) - prompt))) - (unless nnmail-read-passwd - (if (load "passwd" t) - (setq nnmail-read-passwd 'read-passwd) - (unless (fboundp 'ange-ftp-read-passwd) - (autoload 'ange-ftp-read-passwd "ange-ftp")) - (setq nnmail-read-passwd 'ange-ftp-read-passwd))) - (funcall nnmail-read-passwd prompt))) - -(defun nnmail-check-syntax () - "Check (and modify) the syntax of the message in the current buffer." - (save-restriction - (message-narrow-to-head) - (let ((case-fold-search t)) - (unless (re-search-forward "^Message-ID[ \t]*:" nil t) - (insert "Message-ID: " (nnmail-message-id) "\n"))))) - -(defun nnmail-write-region (start end filename &optional append visit lockname) - "Do a `write-region', and then set the file modes." - (write-region start end filename append visit lockname) - (set-file-modes filename nnmail-default-file-modes)) - -;;; -;;; Status functions -;;; - -(defun nnmail-replace-status (name value) - "Make status NAME and VALUE part of the current status line." - (save-restriction - (message-narrow-to-head) - (let ((status (nnmail-decode-status))) - (setq status (delq (member name status) status)) - (when value - (push (cons name value) status)) - (message-remove-header "status") - (goto-char (point-max)) - (insert "Status: " (nnmail-encode-status status) "\n")))) - -(defun nnmail-decode-status () - "Return a status-value alist from STATUS." - (goto-char (point-min)) - (when (re-search-forward "^Status: " nil t) - (let (name value status) - (save-restriction - ;; Narrow to the status. - (narrow-to-region - (point) - (if (re-search-forward "^[^ \t]" nil t) - (1- (point)) - (point-max))) - ;; Go through all elements and add them to the list. - (goto-char (point-min)) - (while (re-search-forward "[^ \t=]+" nil t) - (setq name (match-string 0)) - (if (not (= (following-char) ?=)) - ;; Implied "yes". - (setq value "yes") - (forward-char 1) - (if (not (= (following-char) ?\")) - (if (not (looking-at "[^ \t]")) - ;; Implied "no". - (setq value "no") - ;; Unquoted value. - (setq value (match-string 0)) - (goto-char (match-end 0))) - ;; Quoted value. - (setq value (read (current-buffer))))) - (push (cons name value) status))) - status))) - -(defun nnmail-encode-status (status) - "Return a status string from STATUS." - (mapconcat - (lambda (elem) - (concat - (car elem) "=" - (if (string-match "[ \t]" (cdr elem)) - (prin1-to-string (cdr elem)) - (cdr elem)))) - status " ")) - -(defun nnmail-split-history () - "Generate an overview of where the last mail split put articles." - (interactive) - (unless nnmail-split-history - (error "No current split history")) - (with-output-to-temp-buffer "*nnmail split history*" - (let ((history nnmail-split-history) - elem) - (while (setq elem (pop history)) - (princ (mapconcat (lambda (ga) - (concat (car ga) ":" (int-to-string (cdr ga)))) - elem - ", ")) - (princ "\n"))))) - -(defun nnmail-new-mail-p (group) - "Say whether GROUP has new mail." - (let ((his nnmail-split-history) - found) - (while his - (when (assoc group (pop his)) - (setq found t - his nil))) - found)) - -(eval-and-compile - (autoload 'pop3-movemail "pop3")) - -(defun nnmail-pop3-movemail (inbox crashbox) - "Function to move mail from INBOX on a pop3 server to file CRASHBOX." - (let ((pop3-maildrop - (substring inbox (match-end (string-match "^po:" inbox))))) - (pop3-movemail crashbox))) - -(run-hooks 'nnmail-load-hook) - -(provide 'nnmail) - -;;; nnmail.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/nnmbox.el --- a/lisp/gnus/nnmbox.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,552 +0,0 @@ -;;; nnmbox.el --- mail mbox access for Gnus -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; For an overview of what the interface functions do, please see the -;; Gnus sources. - -;;; Code: - -(require 'nnheader) -(require 'message) -(require 'nnmail) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nnmbox) - -(defvoo nnmbox-mbox-file (expand-file-name "~/mbox") - "The name of the mail box file in the user's home directory.") - -(defvoo nnmbox-active-file (expand-file-name "~/.mbox-active") - "The name of the active file for the mail box.") - -(defvoo nnmbox-get-new-mail t - "If non-nil, nnmbox will check the incoming mail file and split the mail.") - -(defvoo nnmbox-prepare-save-mail-hook nil - "Hook run narrowed to an article before saving.") - - - -(defconst nnmbox-version "nnmbox 1.0" - "nnmbox version.") - -(defvoo nnmbox-current-group nil - "Current nnmbox news group directory.") - -(defconst nnmbox-mbox-buffer nil) - -(defvoo nnmbox-status-string "") - -(defvoo nnmbox-group-alist nil) -(defvoo nnmbox-active-timestamp nil) - - - -;;; Interface functions - -(nnoo-define-basics nnmbox) - -(deffoo nnmbox-retrieve-headers (sequence &optional newsgroup server fetch-old) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let ((number (length sequence)) - (count 0) - article art-string start stop) - (nnmbox-possibly-change-newsgroup newsgroup server) - (while sequence - (setq article (car sequence)) - (setq art-string (nnmbox-article-string article)) - (set-buffer nnmbox-mbox-buffer) - (when (or (search-forward art-string nil t) - (progn (goto-char (point-min)) - (search-forward art-string nil t))) - (setq start - (save-excursion - (re-search-backward - (concat "^" message-unix-mail-delimiter) nil t) - (point))) - (search-forward "\n\n" nil t) - (setq stop (1- (point))) - (set-buffer nntp-server-buffer) - (insert (format "221 %d Article retrieved.\n" article)) - (insert-buffer-substring nnmbox-mbox-buffer start stop) - (goto-char (point-max)) - (insert ".\n")) - (setq sequence (cdr sequence)) - (setq count (1+ count)) - (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup) - (zerop (% count 20)) - (nnheader-message 5 "nnmbox: Receiving headers... %d%%" - (/ (* count 100) number)))) - - (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup) - (nnheader-message 5 "nnmbox: Receiving headers...done")) - - (set-buffer nntp-server-buffer) - (nnheader-fold-continuation-lines) - 'headers))) - -(deffoo nnmbox-open-server (server &optional defs) - (nnoo-change-server 'nnmbox server defs) - (nnmbox-create-mbox) - (cond - ((not (file-exists-p nnmbox-mbox-file)) - (nnmbox-close-server) - (nnheader-report 'nnmbox "No such file: %s" nnmbox-mbox-file)) - ((file-directory-p nnmbox-mbox-file) - (nnmbox-close-server) - (nnheader-report 'nnmbox "Not a regular file: %s" nnmbox-mbox-file)) - (t - (nnheader-report 'nnmbox "Opened server %s using mbox %s" server - nnmbox-mbox-file) - t))) - -(deffoo nnmbox-close-server (&optional server) - (when (and nnmbox-mbox-buffer - (buffer-name nnmbox-mbox-buffer)) - (kill-buffer nnmbox-mbox-buffer)) - (nnoo-close-server 'nnmbox server) - t) - -(deffoo nnmbox-server-opened (&optional server) - (and (nnoo-current-server-p 'nnmbox server) - nnmbox-mbox-buffer - (buffer-name nnmbox-mbox-buffer) - nntp-server-buffer - (buffer-name nntp-server-buffer))) - -(deffoo nnmbox-request-article (article &optional newsgroup server buffer) - (nnmbox-possibly-change-newsgroup newsgroup server) - (save-excursion - (set-buffer nnmbox-mbox-buffer) - (goto-char (point-min)) - (when (search-forward (nnmbox-article-string article) nil t) - (let (start stop) - (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) - (setq start (point)) - (forward-line 1) - (or (and (re-search-forward - (concat "^" message-unix-mail-delimiter) nil t) - (forward-line -1)) - (goto-char (point-max))) - (setq stop (point)) - (let ((nntp-server-buffer (or buffer nntp-server-buffer))) - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-buffer-substring nnmbox-mbox-buffer start stop) - (goto-char (point-min)) - (while (looking-at "From ") - (delete-char 5) - (insert "X-From-Line: ") - (forward-line 1)) - (if (numberp article) - (cons nnmbox-current-group article) - (nnmbox-article-group-number))))))) - -(deffoo nnmbox-request-group (group &optional server dont-check) - (let ((active (cadr (assoc group nnmbox-group-alist)))) - (cond - ((or (null active) - (null (nnmbox-possibly-change-newsgroup group server))) - (nnheader-report 'nnmbox "No such group: %s" group)) - (dont-check - (nnheader-report 'nnmbox "Selected group %s" group) - (nnheader-insert "")) - (t - (nnheader-report 'nnmbox "Selected group %s" group) - (nnheader-insert "211 %d %d %d %s\n" - (1+ (- (cdr active) (car active))) - (car active) (cdr active) group))))) - -(deffoo nnmbox-request-scan (&optional group server) - (nnmbox-possibly-change-newsgroup group server) - (nnmbox-read-mbox) - (nnmail-get-new-mail - 'nnmbox - (lambda () - (save-excursion - (set-buffer nnmbox-mbox-buffer) - (save-buffer))) - (file-name-directory nnmbox-mbox-file) - group - (lambda () - (save-excursion - (let ((in-buf (current-buffer))) - (set-buffer nnmbox-mbox-buffer) - (goto-char (point-max)) - (insert-buffer-substring in-buf))) - (nnmail-save-active nnmbox-group-alist nnmbox-active-file)))) - -(deffoo nnmbox-close-group (group &optional server) - t) - -(deffoo nnmbox-request-list (&optional server) - (save-excursion - (nnmail-find-file nnmbox-active-file) - (setq nnmbox-group-alist (nnmail-get-active)) - t)) - -(deffoo nnmbox-request-newgroups (date &optional server) - (nnmbox-request-list server)) - -(deffoo nnmbox-request-list-newsgroups (&optional server) - (nnheader-report 'nnmbox "LIST NEWSGROUPS is not implemented.")) - -(deffoo nnmbox-request-expire-articles - (articles newsgroup &optional server force) - (nnmbox-possibly-change-newsgroup newsgroup server) - (let* ((is-old t) - rest) - (nnmail-activate 'nnmbox) - - (save-excursion - (set-buffer nnmbox-mbox-buffer) - (while (and articles is-old) - (goto-char (point-min)) - (when (search-forward (nnmbox-article-string (car articles)) nil t) - (if (setq is-old - (nnmail-expired-article-p - newsgroup - (buffer-substring - (point) (progn (end-of-line) (point))) force)) - (progn - (nnheader-message 5 "Deleting article %d in %s..." - (car articles) newsgroup) - (nnmbox-delete-mail)) - (push (car articles) rest))) - (setq articles (cdr articles))) - (save-buffer) - ;; Find the lowest active article in this group. - (let ((active (nth 1 (assoc newsgroup nnmbox-group-alist)))) - (goto-char (point-min)) - (while (and (not (search-forward - (nnmbox-article-string (car active)) nil t)) - (<= (car active) (cdr active))) - (setcar active (1+ (car active))) - (goto-char (point-min)))) - (nnmail-save-active nnmbox-group-alist nnmbox-active-file) - (nconc rest articles)))) - -(deffoo nnmbox-request-move-article - (article group server accept-form &optional last) - (let ((buf (get-buffer-create " *nnmbox move*")) - result) - (and - (nnmbox-request-article article group server) - (save-excursion - (set-buffer buf) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (insert-buffer-substring nntp-server-buffer) - (goto-char (point-min)) - (while (re-search-forward - "^X-Gnus-Newsgroup:" - (save-excursion (search-forward "\n\n" nil t) (point)) t) - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) - (setq result (eval accept-form)) - (kill-buffer buf) - result) - (save-excursion - (nnmbox-possibly-change-newsgroup group server) - (set-buffer nnmbox-mbox-buffer) - (goto-char (point-min)) - (when (search-forward (nnmbox-article-string article) nil t) - (nnmbox-delete-mail)) - (and last (save-buffer)))) - result)) - -(deffoo nnmbox-request-accept-article (group &optional server last) - (nnmbox-possibly-change-newsgroup group server) - (nnmail-check-syntax) - (let ((buf (current-buffer)) - result) - (goto-char (point-min)) - ;; The From line may have been quoted by movemail. - (when (looking-at (concat ">" message-unix-mail-delimiter)) - (delete-char 1)) - (if (looking-at "X-From-Line: ") - (replace-match "From ") - (insert "From nobody " (current-time-string) "\n")) - (and - (nnmail-activate 'nnmbox) - (progn - (set-buffer buf) - (goto-char (point-min)) - (search-forward "\n\n" nil t) - (forward-line -1) - (while (re-search-backward "^X-Gnus-Newsgroup: " nil t) - (delete-region (point) (progn (forward-line 1) (point)))) - (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id"))) - (setq result (if (stringp group) - (list (cons group (nnmbox-active-number group))) - (nnmail-article-group 'nnmbox-active-number))) - (if (and (null result) - (yes-or-no-p "Moved to `junk' group; delete article? ")) - (setq result 'junk) - (setq result (car (nnmbox-save-mail result))))) - (save-excursion - (set-buffer nnmbox-mbox-buffer) - (goto-char (point-max)) - (insert-buffer-substring buf) - (when last - (when nnmail-cache-accepted-message-ids - (nnmail-cache-close)) - (nnmail-save-active nnmbox-group-alist nnmbox-active-file) - (save-buffer)))) - result)) - -(deffoo nnmbox-request-replace-article (article group buffer) - (nnmbox-possibly-change-newsgroup group) - (save-excursion - (set-buffer nnmbox-mbox-buffer) - (goto-char (point-min)) - (if (not (search-forward (nnmbox-article-string article) nil t)) - nil - (nnmbox-delete-mail t t) - (insert-buffer-substring buffer) - (save-buffer) - t))) - -(deffoo nnmbox-request-delete-group (group &optional force server) - (nnmbox-possibly-change-newsgroup group server) - ;; Delete all articles in GROUP. - (if (not force) - () ; Don't delete the articles. - (save-excursion - (set-buffer nnmbox-mbox-buffer) - (goto-char (point-min)) - ;; Delete all articles in this group. - (let ((ident (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":")) - found) - (while (search-forward ident nil t) - (setq found t) - (nnmbox-delete-mail)) - (when found - (save-buffer))))) - ;; Remove the group from all structures. - (setq nnmbox-group-alist - (delq (assoc group nnmbox-group-alist) nnmbox-group-alist) - nnmbox-current-group nil) - ;; Save the active file. - (nnmail-save-active nnmbox-group-alist nnmbox-active-file) - t) - -(deffoo nnmbox-request-rename-group (group new-name &optional server) - (nnmbox-possibly-change-newsgroup group server) - (save-excursion - (set-buffer nnmbox-mbox-buffer) - (goto-char (point-min)) - (let ((ident (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":")) - (new-ident (concat "\nX-Gnus-Newsgroup: " new-name ":")) - found) - (while (search-forward ident nil t) - (replace-match new-ident t t) - (setq found t)) - (when found - (save-buffer)))) - (let ((entry (assoc group nnmbox-group-alist))) - (when entry - (setcar entry new-name)) - (setq nnmbox-current-group nil) - ;; Save the new group alist. - (nnmail-save-active nnmbox-group-alist nnmbox-active-file) - t)) - - -;;; Internal functions. - -;; If FORCE, delete article no matter how many X-Gnus-Newsgroup -;; headers there are. If LEAVE-DELIM, don't delete the Unix mbox -;; delimiter line. -(defun nnmbox-delete-mail (&optional force leave-delim) - ;; Delete the current X-Gnus-Newsgroup line. - (or force - (delete-region - (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point)))) - ;; Beginning of the article. - (save-excursion - (save-restriction - (narrow-to-region - (save-excursion - (re-search-backward (concat "^" message-unix-mail-delimiter) nil t) - (if leave-delim (progn (forward-line 1) (point)) - (match-beginning 0))) - (progn - (forward-line 1) - (or (and (re-search-forward (concat "^" message-unix-mail-delimiter) - nil t) - (if (and (not (bobp)) leave-delim) - (progn (forward-line -2) (point)) - (match-beginning 0))) - (point-max)))) - (goto-char (point-min)) - ;; Only delete the article if no other groups owns it as well. - (when (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t))) - (delete-region (point-min) (point-max)))))) - -(defun nnmbox-possibly-change-newsgroup (newsgroup &optional server) - (when (and server - (not (nnmbox-server-opened server))) - (nnmbox-open-server server)) - (when (or (not nnmbox-mbox-buffer) - (not (buffer-name nnmbox-mbox-buffer))) - (save-excursion - (set-buffer (setq nnmbox-mbox-buffer - (nnheader-find-file-noselect - nnmbox-mbox-file nil 'raw))) - (buffer-disable-undo (current-buffer)))) - (when (not nnmbox-group-alist) - (nnmail-activate 'nnmbox)) - (if newsgroup - (when (assoc newsgroup nnmbox-group-alist) - (setq nnmbox-current-group newsgroup)) - t)) - -(defun nnmbox-article-string (article) - (if (numberp article) - (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":" - (int-to-string article) " ") - (concat "\nMessage-ID: " article))) - -(defun nnmbox-article-group-number () - (save-excursion - (goto-char (point-min)) - (when (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) " - nil t) - (cons (buffer-substring (match-beginning 1) (match-end 1)) - (string-to-int - (buffer-substring (match-beginning 2) (match-end 2))))))) - -(defun nnmbox-save-mail (group-art) - "Called narrowed to an article." - (let ((delim (concat "^" message-unix-mail-delimiter))) - (goto-char (point-min)) - ;; This might come from somewhere else. - (unless (looking-at delim) - (insert "From nobody " (current-time-string) "\n") - (goto-char (point-min))) - ;; Quote all "From " lines in the article. - (forward-line 1) - (while (re-search-forward delim nil t) - (beginning-of-line) - (insert "> ")) - (nnmail-insert-lines) - (nnmail-insert-xref group-art) - (nnmbox-insert-newsgroup-line group-art) - (run-hooks 'nnmail-prepare-save-mail-hook) - (run-hooks 'nnmbox-prepare-save-mail-hook) - group-art)) - -(defun nnmbox-insert-newsgroup-line (group-art) - (save-excursion - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (forward-char -1) - (while group-art - (insert (format "X-Gnus-Newsgroup: %s:%d %s\n" - (caar group-art) (cdar group-art) - (current-time-string))) - (setq group-art (cdr group-art)))) - t)) - -(defun nnmbox-active-number (group) - ;; Find the next article number in GROUP. - (let ((active (cadr (assoc group nnmbox-group-alist)))) - (if active - (setcdr active (1+ (cdr active))) - ;; This group is new, so we create a new entry for it. - ;; This might be a bit naughty... creating groups on the drop of - ;; a hat, but I don't know... - (push (list group (setq active (cons 1 1))) - nnmbox-group-alist)) - (cdr active))) - -(defun nnmbox-create-mbox () - (when (not (file-exists-p nnmbox-mbox-file)) - (nnmail-write-region 1 1 nnmbox-mbox-file t 'nomesg))) - -(defun nnmbox-read-mbox () - (nnmail-activate 'nnmbox) - (nnmbox-create-mbox) - (if (and nnmbox-mbox-buffer - (buffer-name nnmbox-mbox-buffer) - (save-excursion - (set-buffer nnmbox-mbox-buffer) - (= (buffer-size) (nnheader-file-size nnmbox-mbox-file)))) - () - (save-excursion - (let ((delim (concat "^" message-unix-mail-delimiter)) - (alist nnmbox-group-alist) - start end number) - (set-buffer (setq nnmbox-mbox-buffer - (nnheader-find-file-noselect - nnmbox-mbox-file nil 'raw))) - (buffer-disable-undo (current-buffer)) - - ;; Go through the group alist and compare against - ;; the mbox file. - (while alist - (goto-char (point-max)) - (when (and (re-search-backward - (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) " - (caar alist)) nil t) - (>= (setq number - (string-to-number - (buffer-substring - (match-beginning 1) (match-end 1)))) - (cdadar alist))) - (setcdr (cadar alist) (1+ number))) - (setq alist (cdr alist))) - - (goto-char (point-min)) - (while (re-search-forward delim nil t) - (setq start (match-beginning 0)) - (when (not (search-forward "\nX-Gnus-Newsgroup: " - (save-excursion - (setq end - (or - (and - (re-search-forward delim nil t) - (match-beginning 0)) - (point-max)))) - t)) - (save-excursion - (save-restriction - (narrow-to-region start end) - (nnmbox-save-mail - (nnmail-article-group 'nnmbox-active-number))))) - (goto-char end)))))) - -(provide 'nnmbox) - -;;; nnmbox.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/nnmh.el --- a/lisp/gnus/nnmh.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,547 +0,0 @@ -;;; nnmh.el --- mhspool access for Gnus -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Based on nnspool.el by Masanobu UMEDA . -;; For an overview of what the interface functions do, please see the -;; Gnus sources. - -;;; Code: - -(require 'nnheader) -(require 'nnmail) -(require 'gnus-start) -(require 'nnoo) -(require 'cl) - -(nnoo-declare nnmh) - -(defvoo nnmh-directory message-directory - "*Mail spool directory.") - -(defvoo nnmh-get-new-mail t - "*If non-nil, nnmh will check the incoming mail file and split the mail.") - -(defvoo nnmh-prepare-save-mail-hook nil - "*Hook run narrowed to an article before saving.") - -(defvoo nnmh-be-safe nil - "*If non-nil, nnmh will check all articles to make sure whether they are new or not.") - - - -(defconst nnmh-version "nnmh 1.0" - "nnmh version.") - -(defvoo nnmh-current-directory nil - "Current news group directory.") - -(defvoo nnmh-status-string "") -(defvoo nnmh-group-alist nil) - - - -;;; Interface functions. - -(nnoo-define-basics nnmh) - -(deffoo nnmh-retrieve-headers (articles &optional newsgroup server fetch-old) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let* ((file nil) - (number (length articles)) - (large (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup))) - (count 0) - beg article) - (nnmh-possibly-change-directory newsgroup server) - ;; We don't support fetching by Message-ID. - (if (stringp (car articles)) - 'headers - (while articles - (when (and (file-exists-p - (setq file (concat (file-name-as-directory - nnmh-current-directory) - (int-to-string - (setq article (pop articles)))))) - (not (file-directory-p file))) - (insert (format "221 %d Article retrieved.\n" article)) - (setq beg (point)) - (nnheader-insert-head file) - (goto-char beg) - (if (search-forward "\n\n" nil t) - (forward-char -1) - (goto-char (point-max)) - (insert "\n\n")) - (insert ".\n") - (delete-region (point) (point-max))) - (setq count (1+ count)) - - (and large - (zerop (% count 20)) - (message "nnmh: Receiving headers... %d%%" - (/ (* count 100) number)))) - - (when large - (message "nnmh: Receiving headers...done")) - - (nnheader-fold-continuation-lines) - 'headers)))) - -(deffoo nnmh-open-server (server &optional defs) - (nnoo-change-server 'nnmh server defs) - (when (not (file-exists-p nnmh-directory)) - (condition-case () - (make-directory nnmh-directory t) - (error t))) - (cond - ((not (file-exists-p nnmh-directory)) - (nnmh-close-server) - (nnheader-report 'nnmh "Couldn't create directory: %s" nnmh-directory)) - ((not (file-directory-p (file-truename nnmh-directory))) - (nnmh-close-server) - (nnheader-report 'nnmh "Not a directory: %s" nnmh-directory)) - (t - (nnheader-report 'nnmh "Opened server %s using directory %s" - server nnmh-directory) - t))) - -(deffoo nnmh-request-article (id &optional newsgroup server buffer) - (nnmh-possibly-change-directory newsgroup server) - (let ((file (if (stringp id) - nil - (concat nnmh-current-directory (int-to-string id)))) - (nntp-server-buffer (or buffer nntp-server-buffer))) - (and (stringp file) - (file-exists-p file) - (not (file-directory-p file)) - (save-excursion (nnmail-find-file file)) - (string-to-int (file-name-nondirectory file))))) - -(deffoo nnmh-request-group (group &optional server dont-check) - (let ((pathname (nnmail-group-pathname group nnmh-directory)) - dir) - (cond - ((not (file-directory-p pathname)) - (nnheader-report - 'nnmh "Can't select group (no such directory): %s" group)) - (t - (setq nnmh-current-directory pathname) - (and nnmh-get-new-mail - nnmh-be-safe - (nnmh-update-gnus-unreads group)) - (cond - (dont-check - (nnheader-report 'nnmh "Selected group %s" group) - t) - (t - ;; Re-scan the directory if it's on a foreign system. - (nnheader-re-read-dir pathname) - (setq dir - (sort - (mapcar (lambda (name) (string-to-int name)) - (directory-files pathname nil "^[0-9]+$" t)) - '<)) - (cond - (dir - (nnheader-report 'nnmh "Selected group %s" group) - (nnheader-insert - "211 %d %d %d %s\n" (length dir) (car dir) - (progn (while (cdr dir) (setq dir (cdr dir))) (car dir)) - group)) - (t - (nnheader-report 'nnmh "Empty group %s" group) - (nnheader-insert (format "211 0 1 0 %s\n" group)))))))))) - -(deffoo nnmh-request-scan (&optional group server) - (nnmail-get-new-mail 'nnmh nil nnmh-directory group)) - -(deffoo nnmh-request-list (&optional server dir) - (nnheader-insert "") - (let ((nnmh-toplev - (file-truename (or dir (file-name-as-directory nnmh-directory))))) - (nnmh-request-list-1 nnmh-toplev)) - (setq nnmh-group-alist (nnmail-get-active)) - t) - -(defvar nnmh-toplev) -(defun nnmh-request-list-1 (dir) - (setq dir (expand-file-name dir)) - ;; Recurse down all directories. - (let ((dirs (and (file-readable-p dir) - (> (nth 1 (file-attributes (file-chase-links dir))) 2) - (directory-files dir t nil t))) - dir) - ;; Recurse down directories. - (while (setq dir (pop dirs)) - (when (and (not (member (file-name-nondirectory dir) '("." ".."))) - (file-directory-p dir) - (file-readable-p dir)) - (nnmh-request-list-1 dir)))) - ;; For each directory, generate an active file line. - (unless (string= (expand-file-name nnmh-toplev) dir) - (let ((files (mapcar - (lambda (name) (string-to-int name)) - (directory-files dir nil "^[0-9]+$" t)))) - (when files - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-max)) - (insert - (format - "%s %d %d y\n" - (progn - (string-match - (regexp-quote - (file-truename (file-name-as-directory - (expand-file-name nnmh-toplev)))) - dir) - (nnheader-replace-chars-in-string - (substring dir (match-end 0)) ?/ ?.)) - (apply 'max files) - (apply 'min files))))))) - t) - -(deffoo nnmh-request-newgroups (date &optional server) - (nnmh-request-list server)) - -(deffoo nnmh-request-expire-articles (articles newsgroup - &optional server force) - (nnmh-possibly-change-directory newsgroup server) - (let* ((active-articles - (mapcar - (function - (lambda (name) - (string-to-int name))) - (directory-files nnmh-current-directory nil "^[0-9]+$" t))) - (is-old t) - article rest mod-time) - (nnmail-activate 'nnmh) - - (while (and articles is-old) - (setq article (concat nnmh-current-directory - (int-to-string (car articles)))) - (when (setq mod-time (nth 5 (file-attributes article))) - (if (and (nnmh-deletable-article-p newsgroup (car articles)) - (setq is-old - (nnmail-expired-article-p newsgroup mod-time force))) - (progn - (nnheader-message 5 "Deleting article %s in %s..." - article newsgroup) - (condition-case () - (funcall nnmail-delete-file-function article) - (file-error - (nnheader-message 1 "Couldn't delete article %s in %s" - article newsgroup) - (push (car articles) rest)))) - (push (car articles) rest))) - (setq articles (cdr articles))) - (message "") - (nconc rest articles))) - -(deffoo nnmh-close-group (group &optional server) - t) - -(deffoo nnmh-request-move-article - (article group server accept-form &optional last) - (let ((buf (get-buffer-create " *nnmh move*")) - result) - (and - (nnmh-deletable-article-p group article) - (nnmh-request-article article group server) - (save-excursion - (set-buffer buf) - (erase-buffer) - (insert-buffer-substring nntp-server-buffer) - (setq result (eval accept-form)) - (kill-buffer (current-buffer)) - result) - (progn - (nnmh-possibly-change-directory group server) - (condition-case () - (funcall nnmail-delete-file-function - (concat nnmh-current-directory (int-to-string article))) - (file-error nil)))) - result)) - -(deffoo nnmh-request-accept-article (group &optional server last noinsert) - (nnmh-possibly-change-directory group server) - (nnmail-check-syntax) - (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id"))) - (prog1 - (if (stringp group) - (and - (nnmail-activate 'nnmh) - (car (nnmh-save-mail - (list (cons group (nnmh-active-number group))) - noinsert))) - (and - (nnmail-activate 'nnmh) - (let ((res (nnmail-article-group 'nnmh-active-number))) - (if (and (null res) - (yes-or-no-p "Moved to `junk' group; delete article? ")) - 'junk - (car (nnmh-save-mail res noinsert)))))) - (when (and last nnmail-cache-accepted-message-ids) - (nnmail-cache-close)))) - -(deffoo nnmh-request-replace-article (article group buffer) - (nnmh-possibly-change-directory group) - (save-excursion - (set-buffer buffer) - (nnmh-possibly-create-directory group) - (ignore-errors - (nnmail-write-region - (point-min) (point-max) - (concat nnmh-current-directory (int-to-string article)) - nil (if (nnheader-be-verbose 5) nil 'nomesg)) - t))) - -(deffoo nnmh-request-create-group (group &optional server args) - (nnmail-activate 'nnmh) - (unless (assoc group nnmh-group-alist) - (let (active) - (push (list group (setq active (cons 1 0))) - nnmh-group-alist) - (nnmh-possibly-create-directory group) - (nnmh-possibly-change-directory group server) - (let ((articles (mapcar - (lambda (file) - (string-to-int file)) - (directory-files - nnmh-current-directory nil "^[0-9]+$")))) - (when articles - (setcar active (apply 'min articles)) - (setcdr active (apply 'max articles)))))) - t) - -(deffoo nnmh-request-delete-group (group &optional force server) - (nnmh-possibly-change-directory group server) - ;; Delete all articles in GROUP. - (if (not force) - () ; Don't delete the articles. - (let ((articles (directory-files nnmh-current-directory t "^[0-9]+$"))) - (while articles - (when (file-writable-p (car articles)) - (nnheader-message 5 "Deleting article %s in %s..." - (car articles) group) - (funcall nnmail-delete-file-function (car articles))) - (setq articles (cdr articles)))) - ;; Try to delete the directory itself. - (ignore-errors - (delete-directory nnmh-current-directory))) - ;; Remove the group from all structures. - (setq nnmh-group-alist - (delq (assoc group nnmh-group-alist) nnmh-group-alist) - nnmh-current-directory nil) - t) - -(deffoo nnmh-request-rename-group (group new-name &optional server) - (nnmh-possibly-change-directory group server) - (let ((new-dir (nnmail-group-pathname new-name nnmh-directory)) - (old-dir (nnmail-group-pathname group nnmh-directory))) - (when (ignore-errors - (make-directory new-dir t) - t) - ;; We move the articles file by file instead of renaming - ;; the directory -- there may be subgroups in this group. - ;; One might be more clever, I guess. - (let ((files (nnheader-article-to-file-alist old-dir))) - (while files - (rename-file - (concat old-dir (cdar files)) - (concat new-dir (cdar files))) - (pop files))) - (when (<= (length (directory-files old-dir)) 2) - (ignore-errors - (delete-directory old-dir))) - ;; That went ok, so we change the internal structures. - (let ((entry (assoc group nnmh-group-alist))) - (when entry - (setcar entry new-name)) - (setq nnmh-current-directory nil) - t)))) - -(nnoo-define-skeleton nnmh) - - -;;; Internal functions. - -(defun nnmh-possibly-change-directory (newsgroup &optional server) - (when (and server - (not (nnmh-server-opened server))) - (nnmh-open-server server)) - (when newsgroup - (let ((pathname (nnmail-group-pathname newsgroup nnmh-directory))) - (if (file-directory-p pathname) - (setq nnmh-current-directory pathname) - (error "No such newsgroup: %s" newsgroup))))) - -(defun nnmh-possibly-create-directory (group) - (let (dir dirs) - (setq dir (nnmail-group-pathname group nnmh-directory)) - (while (not (file-directory-p dir)) - (push dir dirs) - (setq dir (file-name-directory (directory-file-name dir)))) - (while dirs - (when (make-directory (directory-file-name (car dirs))) - (error "Could not create directory %s" (car dirs))) - (nnheader-message 5 "Creating mail directory %s" (car dirs)) - (setq dirs (cdr dirs))))) - -(defun nnmh-save-mail (group-art &optional noinsert) - "Called narrowed to an article." - (unless noinsert - (nnmail-insert-lines) - (nnmail-insert-xref group-art)) - (run-hooks 'nnmail-prepare-save-mail-hook) - (run-hooks 'nnmh-prepare-save-mail-hook) - (goto-char (point-min)) - (while (looking-at "From ") - (replace-match "X-From-Line: ") - (forward-line 1)) - ;; We save the article in all the newsgroups it belongs in. - (let ((ga group-art) - first) - (while ga - (nnmh-possibly-create-directory (caar ga)) - (let ((file (concat (nnmail-group-pathname - (caar ga) nnmh-directory) - (int-to-string (cdar ga))))) - (if first - ;; It was already saved, so we just make a hard link. - (funcall nnmail-crosspost-link-function first file t) - ;; Save the article. - (nnmail-write-region (point-min) (point-max) file nil nil) - (setq first file))) - (setq ga (cdr ga)))) - group-art) - -(defun nnmh-active-number (group) - "Compute the next article number in GROUP." - (let ((active (cadr (assoc group nnmh-group-alist))) - (dir (nnmail-group-pathname group nnmh-directory))) - (unless active - ;; The group wasn't known to nnmh, so we just create an active - ;; entry for it. - (setq active (cons 1 0)) - (push (list group active) nnmh-group-alist) - (unless (file-exists-p dir) - (make-directory dir)) - ;; Find the highest number in the group. - (let ((files (sort - (mapcar - (lambda (f) - (string-to-int f)) - (directory-files dir nil "^[0-9]+$")) - '>))) - (when files - (setcdr active (car files))))) - (setcdr active (1+ (cdr active))) - (while (file-exists-p - (concat (nnmail-group-pathname group nnmh-directory) - (int-to-string (cdr active)))) - (setcdr active (1+ (cdr active)))) - (cdr active))) - -(defun nnmh-update-gnus-unreads (group) - ;; Go through the .nnmh-articles file and compare with the actual - ;; articles in this folder. The articles that are "new" will be - ;; marked as unread by Gnus. - (let* ((dir nnmh-current-directory) - (files (sort (mapcar (function (lambda (name) (string-to-int name))) - (directory-files nnmh-current-directory - nil "^[0-9]+$" t)) - '<)) - (nnmh-file (concat dir ".nnmh-articles")) - new articles) - ;; Load the .nnmh-articles file. - (when (file-exists-p nnmh-file) - (setq articles - (let (nnmh-newsgroup-articles) - (ignore-errors (load nnmh-file nil t t)) - nnmh-newsgroup-articles))) - ;; Add all new articles to the `new' list. - (let ((art files)) - (while art - (unless (assq (car art) articles) - (push (car art) new)) - (setq art (cdr art)))) - ;; Remove all deleted articles. - (let ((art articles)) - (while art - (unless (memq (caar art) files) - (setq articles (delq (car art) articles))) - (setq art (cdr art)))) - ;; Check whether the articles really are the ones that Gnus thinks - ;; they are by looking at the time-stamps. - (let ((arts articles) - art) - (while (setq art (pop arts)) - (when (not (equal - (nth 5 (file-attributes - (concat dir (int-to-string (car art))))) - (cdr art))) - (setq articles (delq art articles)) - (push (car art) new)))) - ;; Go through all the new articles and add them, and their - ;; time-stamps, to the list. - (setq articles - (nconc articles - (mapcar - (lambda (art) - (cons art - (nth 5 (file-attributes - (concat dir (int-to-string art)))))) - new))) - ;; Make Gnus mark all new articles as unread. - (when new - (gnus-make-articles-unread - (gnus-group-prefixed-name group (list 'nnmh "")) - (setq new (sort new '<)))) - ;; Sort the article list with highest numbers first. - (setq articles (sort articles (lambda (art1 art2) - (> (car art1) (car art2))))) - ;; Finally write this list back to the .nnmh-articles file. - (nnheader-temp-write nnmh-file - (insert ";; Gnus article active file for " group "\n\n") - (insert "(setq nnmh-newsgroup-articles '") - (gnus-prin1 articles) - (insert ")\n")))) - -(defun nnmh-deletable-article-p (group article) - "Say whether ARTICLE in GROUP can be deleted." - (let ((path (concat nnmh-current-directory (int-to-string article)))) - ;; Writable. - (and (file-writable-p path) - ;; We can never delete the last article in the group. - (not (eq (cdr (nth 1 (assoc group nnmh-group-alist))) - article))))) - -(provide 'nnmh) - -;;; nnmh.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/nnml.el --- a/lisp/gnus/nnml.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,800 +0,0 @@ -;;; nnml.el --- mail spool access for Gnus -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Based on nnspool.el by Masanobu UMEDA . -;; For an overview of what the interface functions do, please see the -;; Gnus sources. - -;;; Code: - -(require 'nnheader) -(require 'nnmail) -(require 'nnoo) -(require 'cl) - -(nnoo-declare nnml) - -(defvoo nnml-directory message-directory - "Mail spool directory.") - -(defvoo nnml-active-file - (concat (file-name-as-directory nnml-directory) "active") - "Mail active file.") - -(defvoo nnml-newsgroups-file - (concat (file-name-as-directory nnml-directory) "newsgroups") - "Mail newsgroups description file.") - -(defvoo nnml-get-new-mail t - "If non-nil, nnml will check the incoming mail file and split the mail.") - -(defvoo nnml-nov-is-evil nil - "If non-nil, Gnus will never generate and use nov databases for mail groups. -Using nov databases will speed up header fetching considerably. -This variable shouldn't be flipped much. If you have, for some reason, -set this to t, and want to set it to nil again, you should always run -the `nnml-generate-nov-databases' command. The function will go -through all nnml directories and generate nov databases for them -all. This may very well take some time.") - -(defvoo nnml-prepare-save-mail-hook nil - "Hook run narrowed to an article before saving.") - -(defvoo nnml-inhibit-expiry nil - "If non-nil, inhibit expiry.") - - - - -(defconst nnml-version "nnml 1.0" - "nnml version.") - -(defvoo nnml-nov-file-name ".overview") - -(defvoo nnml-current-directory nil) -(defvoo nnml-current-group nil) -(defvoo nnml-status-string "") -(defvoo nnml-nov-buffer-alist nil) -(defvoo nnml-group-alist nil) -(defvoo nnml-active-timestamp nil) -(defvoo nnml-article-file-alist nil) - -(defvoo nnml-generate-active-function 'nnml-generate-active-info) - - - -;;; Interface functions. - -(nnoo-define-basics nnml) - -(deffoo nnml-retrieve-headers (sequence &optional group server fetch-old) - (when (nnml-possibly-change-directory group server) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let ((file nil) - (number (length sequence)) - (count 0) - beg article) - (if (stringp (car sequence)) - 'headers - (if (nnml-retrieve-headers-with-nov sequence fetch-old) - 'nov - (while sequence - (setq article (car sequence)) - (setq file (nnml-article-to-file article)) - (when (and file - (file-exists-p file) - (not (file-directory-p file))) - (insert (format "221 %d Article retrieved.\n" article)) - (setq beg (point)) - (nnheader-insert-head file) - (goto-char beg) - (if (search-forward "\n\n" nil t) - (forward-char -1) - (goto-char (point-max)) - (insert "\n\n")) - (insert ".\n") - (delete-region (point) (point-max))) - (setq sequence (cdr sequence)) - (setq count (1+ count)) - (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup) - (zerop (% count 20)) - (nnheader-message 6 "nnml: Receiving headers... %d%%" - (/ (* count 100) number)))) - - (and (numberp nnmail-large-newsgroup) - (> number nnmail-large-newsgroup) - (nnheader-message 6 "nnml: Receiving headers...done")) - - (nnheader-fold-continuation-lines) - 'headers)))))) - -(deffoo nnml-open-server (server &optional defs) - (nnoo-change-server 'nnml server defs) - (when (not (file-exists-p nnml-directory)) - (condition-case () - (make-directory nnml-directory t) - (error))) - (cond - ((not (file-exists-p nnml-directory)) - (nnml-close-server) - (nnheader-report 'nnml "Couldn't create directory: %s" nnml-directory)) - ((not (file-directory-p (file-truename nnml-directory))) - (nnml-close-server) - (nnheader-report 'nnml "Not a directory: %s" nnml-directory)) - (t - (nnheader-report 'nnml "Opened server %s using directory %s" - server nnml-directory) - t))) - -(defun nnml-request-regenerate (server) - (nnml-possibly-change-directory nil server) - (nnml-generate-nov-databases) - t) - -(deffoo nnml-request-article (id &optional group server buffer) - (nnml-possibly-change-directory group server) - (let* ((nntp-server-buffer (or buffer nntp-server-buffer)) - path gpath group-num) - (if (stringp id) - (when (and (setq group-num (nnml-find-group-number id)) - (cdr - (assq (cdr group-num) - (nnheader-article-to-file-alist - (setq gpath - (nnmail-group-pathname - (car group-num) - nnml-directory)))))) - (setq path (concat gpath (int-to-string (cdr group-num))))) - (setq path (nnml-article-to-file id))) - (cond - ((not path) - (nnheader-report 'nnml "No such article: %s" id)) - ((not (file-exists-p path)) - (nnheader-report 'nnml "No such file: %s" path)) - ((file-directory-p path) - (nnheader-report 'nnml "File is a directory: %s" path)) - ((not (save-excursion (nnmail-find-file path))) - (nnheader-report 'nnml "Couldn't read file: %s" path)) - (t - (nnheader-report 'nnml "Article %s retrieved" id) - ;; We return the article number. - (cons (if group-num (car group-num) group) - (string-to-int (file-name-nondirectory path))))))) - -(deffoo nnml-request-group (group &optional server dont-check) - (cond - ((not (nnml-possibly-change-directory group server)) - (nnheader-report 'nnml "Invalid group (no such directory)")) - ((not (file-exists-p nnml-current-directory)) - (nnheader-report 'nnml "Directory %s does not exist" - nnml-current-directory)) - ((not (file-directory-p nnml-current-directory)) - (nnheader-report 'nnml "%s is not a directory" nnml-current-directory)) - (dont-check - (nnheader-report 'nnml "Group %s selected" group) - t) - (t - (nnheader-re-read-dir nnml-current-directory) - (nnmail-activate 'nnml) - (let ((active (nth 1 (assoc group nnml-group-alist)))) - (if (not active) - (nnheader-report 'nnml "No such group: %s" group) - (nnheader-report 'nnml "Selected group %s" group) - (nnheader-insert "211 %d %d %d %s\n" - (max (1+ (- (cdr active) (car active))) 0) - (car active) (cdr active) group)))))) - -(deffoo nnml-request-scan (&optional group server) - (setq nnml-article-file-alist nil) - (nnml-possibly-change-directory group server) - (nnmail-get-new-mail 'nnml 'nnml-save-nov nnml-directory group)) - -(deffoo nnml-close-group (group &optional server) - (setq nnml-article-file-alist nil) - t) - -(deffoo nnml-request-create-group (group &optional server args) - (nnmail-activate 'nnml) - (unless (assoc group nnml-group-alist) - (let (active) - (push (list group (setq active (cons 1 0))) - nnml-group-alist) - (nnml-possibly-create-directory group) - (nnml-possibly-change-directory group server) - (let ((articles (nnheader-directory-articles nnml-current-directory))) - (when articles - (setcar active (apply 'min articles)) - (setcdr active (apply 'max articles)))) - (nnmail-save-active nnml-group-alist nnml-active-file))) - t) - -(deffoo nnml-request-list (&optional server) - (save-excursion - (nnmail-find-file nnml-active-file) - (setq nnml-group-alist (nnmail-get-active)) - t)) - -(deffoo nnml-request-newgroups (date &optional server) - (nnml-request-list server)) - -(deffoo nnml-request-list-newsgroups (&optional server) - (save-excursion - (nnmail-find-file nnml-newsgroups-file))) - -(deffoo nnml-request-expire-articles (articles group - &optional server force) - (nnml-possibly-change-directory group server) - (let* ((active-articles - (nnheader-directory-articles nnml-current-directory)) - (is-old t) - article rest mod-time number) - (nnmail-activate 'nnml) - - (while (and articles is-old) - (when (setq article (nnml-article-to-file (setq number (pop articles)))) - (when (setq mod-time (nth 5 (file-attributes article))) - (if (and (nnml-deletable-article-p group number) - (setq is-old - (nnmail-expired-article-p group mod-time force - nnml-inhibit-expiry))) - (progn - (nnheader-message 5 "Deleting article %s in %s" - article group) - (condition-case () - (funcall nnmail-delete-file-function article) - (file-error - (push number rest))) - (setq active-articles (delq number active-articles)) - (nnml-nov-delete-article group number)) - (push number rest))))) - (let ((active (nth 1 (assoc group nnml-group-alist)))) - (when active - (setcar active (or (and active-articles - (apply 'min active-articles)) - (1+ (cdr active))))) - (nnmail-save-active nnml-group-alist nnml-active-file)) - (nnml-save-nov) - (nconc rest articles))) - -(deffoo nnml-request-move-article - (article group server accept-form &optional last) - (let ((buf (get-buffer-create " *nnml move*")) - result) - (nnml-possibly-change-directory group server) - (nnml-update-file-alist) - (and - (nnml-deletable-article-p group article) - (nnml-request-article article group server) - (save-excursion - (set-buffer buf) - (insert-buffer-substring nntp-server-buffer) - (setq result (eval accept-form)) - (kill-buffer (current-buffer)) - result) - (progn - (nnml-possibly-change-directory group server) - (condition-case () - (funcall nnmail-delete-file-function - (nnml-article-to-file article)) - (file-error nil)) - (nnml-nov-delete-article group article) - (when last - (nnml-save-nov) - (nnmail-save-active nnml-group-alist nnml-active-file)))) - result)) - -(deffoo nnml-request-accept-article (group &optional server last) - (nnml-possibly-change-directory group server) - (nnmail-check-syntax) - (let (result) - (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id"))) - (if (stringp group) - (and - (nnmail-activate 'nnml) - (setq result (car (nnml-save-mail - (list (cons group (nnml-active-number group)))))) - (progn - (nnmail-save-active nnml-group-alist nnml-active-file) - (and last (nnml-save-nov)))) - (and - (nnmail-activate 'nnml) - (if (and (not (setq result (nnmail-article-group 'nnml-active-number))) - (yes-or-no-p "Moved to `junk' group; delete article? ")) - (setq result 'junk) - (setq result (car (nnml-save-mail result)))) - (when last - (nnmail-save-active nnml-group-alist nnml-active-file) - (when nnmail-cache-accepted-message-ids - (nnmail-cache-close)) - (nnml-save-nov)))) - result)) - -(deffoo nnml-request-replace-article (article group buffer) - (nnml-possibly-change-directory group) - (save-excursion - (set-buffer buffer) - (nnml-possibly-create-directory group) - (let ((chars (nnmail-insert-lines)) - (art (concat (int-to-string article) "\t")) - headers) - (when (condition-case () - (progn - (nnmail-write-region - (point-min) (point-max) - (or (nnml-article-to-file article) - (concat nnml-current-directory - (int-to-string article))) - nil (if (nnheader-be-verbose 5) nil 'nomesg)) - t) - (error nil)) - (setq headers (nnml-parse-head chars article)) - ;; Replace the NOV line in the NOV file. - (save-excursion - (set-buffer (nnml-open-nov group)) - (goto-char (point-min)) - (if (or (looking-at art) - (search-forward (concat "\n" art) nil t)) - ;; Delete the old NOV line. - (delete-region (progn (beginning-of-line) (point)) - (progn (forward-line 1) (point))) - ;; The line isn't here, so we have to find out where - ;; we should insert it. (This situation should never - ;; occur, but one likes to make sure...) - (while (and (looking-at "[0-9]+\t") - (< (string-to-int - (buffer-substring - (match-beginning 0) (match-end 0))) - article) - (zerop (forward-line 1))))) - (beginning-of-line) - (nnheader-insert-nov headers) - (nnml-save-nov) - t))))) - -(deffoo nnml-request-delete-group (group &optional force server) - (nnml-possibly-change-directory group server) - (when force - ;; Delete all articles in GROUP. - (let ((articles - (directory-files - nnml-current-directory t - (concat nnheader-numerical-short-files - "\\|" (regexp-quote nnml-nov-file-name) "$"))) - article) - (while articles - (setq article (pop articles)) - (when (file-writable-p article) - (nnheader-message 5 "Deleting article %s in %s..." article group) - (funcall nnmail-delete-file-function article)))) - ;; Try to delete the directory itself. - (condition-case () - (delete-directory nnml-current-directory) - (error nil))) - ;; Remove the group from all structures. - (setq nnml-group-alist - (delq (assoc group nnml-group-alist) nnml-group-alist) - nnml-current-group nil - nnml-current-directory nil) - ;; Save the active file. - (nnmail-save-active nnml-group-alist nnml-active-file) - t) - -(deffoo nnml-request-rename-group (group new-name &optional server) - (nnml-possibly-change-directory group server) - (let ((new-dir (nnmail-group-pathname new-name nnml-directory)) - (old-dir (nnmail-group-pathname group nnml-directory))) - (when (condition-case () - (progn - (make-directory new-dir t) - t) - (error nil)) - ;; We move the articles file by file instead of renaming - ;; the directory -- there may be subgroups in this group. - ;; One might be more clever, I guess. - (let ((files (nnheader-article-to-file-alist old-dir))) - (while files - (rename-file - (concat old-dir (cdar files)) - (concat new-dir (cdar files))) - (pop files))) - ;; Move .overview file. - (let ((overview (concat old-dir nnml-nov-file-name))) - (when (file-exists-p overview) - (rename-file overview (concat new-dir nnml-nov-file-name)))) - (when (<= (length (directory-files old-dir)) 2) - (condition-case () - (delete-directory old-dir) - (error nil))) - ;; That went ok, so we change the internal structures. - (let ((entry (assoc group nnml-group-alist))) - (when entry - (setcar entry new-name)) - (setq nnml-current-directory nil - nnml-current-group nil) - ;; Save the new group alist. - (nnmail-save-active nnml-group-alist nnml-active-file) - t)))) - -(deffoo nnml-set-status (article name value &optional group server) - (nnml-possibly-change-directory group server) - (let ((file (nnml-article-to-file article))) - (cond - ((not (file-exists-p file)) - (nnheader-report 'nnml "File %s does not exist" file)) - (t - (nnheader-temp-write file - (nnheader-insert-file-contents file) - (nnmail-replace-status name value)) - t)))) - - -;;; Internal functions. - -(defun nnml-article-to-file (article) - (nnml-update-file-alist) - (let (file) - (if (setq file (cdr (assq article nnml-article-file-alist))) - (concat nnml-current-directory file) - ;; Just to make sure nothing went wrong when reading over NFS -- - ;; check once more. - (when (file-exists-p - (setq file (concat nnml-current-directory "/" - (number-to-string article)))) - (nnml-update-file-alist t) - file)))) - -(defun nnml-deletable-article-p (group article) - "Say whether ARTICLE in GROUP can be deleted." - (let (path) - (when (setq path (nnml-article-to-file article)) - (when (file-writable-p path) - (or (not nnmail-keep-last-article) - (not (eq (cdr (nth 1 (assoc group nnml-group-alist))) - article))))))) - -;; Find an article number in the current group given the Message-ID. -(defun nnml-find-group-number (id) - (save-excursion - (set-buffer (get-buffer-create " *nnml id*")) - (buffer-disable-undo (current-buffer)) - (let ((alist nnml-group-alist) - number) - ;; We want to look through all .overview files, but we want to - ;; start with the one in the current directory. It seems most - ;; likely that the article we are looking for is in that group. - (if (setq number (nnml-find-id nnml-current-group id)) - (cons nnml-current-group number) - ;; It wasn't there, so we look through the other groups as well. - (while (and (not number) - alist) - (or (string= (caar alist) nnml-current-group) - (setq number (nnml-find-id (caar alist) id))) - (or number - (setq alist (cdr alist)))) - (and number - (cons (caar alist) number)))))) - -(defun nnml-find-id (group id) - (erase-buffer) - (let ((nov (concat (nnmail-group-pathname group nnml-directory) - nnml-nov-file-name)) - number found) - (when (file-exists-p nov) - (nnheader-insert-file-contents nov) - (while (and (not found) - (search-forward id nil t)) ; We find the ID. - ;; And the id is in the fourth field. - (if (not (and (search-backward "\t" nil t 4) - (not (search-backward"\t" (gnus-point-at-bol) t)))) - (forward-line 1) - (beginning-of-line) - (setq found t) - ;; We return the article number. - (setq number - (condition-case () - (read (current-buffer)) - (error nil))))) - number))) - -(defun nnml-retrieve-headers-with-nov (articles &optional fetch-old) - (if (or gnus-nov-is-evil nnml-nov-is-evil) - nil - (let ((nov (concat nnml-current-directory nnml-nov-file-name))) - (when (file-exists-p nov) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (nnheader-insert-file-contents nov) - (if (and fetch-old - (not (numberp fetch-old))) - t ; Don't remove anything. - (nnheader-nov-delete-outside-range - (if fetch-old (max 1 (- (car articles) fetch-old)) - (car articles)) - (car (last articles))) - t)))))) - -(defun nnml-possibly-change-directory (group &optional server) - (when (and server - (not (nnml-server-opened server))) - (nnml-open-server server)) - (if (not group) - t - (let ((pathname (nnmail-group-pathname group nnml-directory))) - (when (not (equal pathname nnml-current-directory)) - (setq nnml-current-directory pathname - nnml-current-group group - nnml-article-file-alist nil)) - (file-exists-p nnml-current-directory)))) - -(defun nnml-possibly-create-directory (group) - (let (dir dirs) - (setq dir (nnmail-group-pathname group nnml-directory)) - (while (not (file-directory-p dir)) - (push dir dirs) - (setq dir (file-name-directory (directory-file-name dir)))) - (while dirs - (make-directory (directory-file-name (car dirs))) - (nnheader-message 5 "Creating mail directory %s" (car dirs)) - (setq dirs (cdr dirs))))) - -(defun nnml-save-mail (group-art) - "Called narrowed to an article." - (let (chars headers) - (setq chars (nnmail-insert-lines)) - (nnmail-insert-xref group-art) - (run-hooks 'nnmail-prepare-save-mail-hook) - (run-hooks 'nnml-prepare-save-mail-hook) - (goto-char (point-min)) - (while (looking-at "From ") - (replace-match "X-From-Line: ") - (forward-line 1)) - ;; We save the article in all the groups it belongs in. - (let ((ga group-art) - first) - (while ga - (nnml-possibly-create-directory (caar ga)) - (let ((file (concat (nnmail-group-pathname - (caar ga) nnml-directory) - (int-to-string (cdar ga))))) - (if first - ;; It was already saved, so we just make a hard link. - (funcall nnmail-crosspost-link-function first file t) - ;; Save the article. - (nnmail-write-region (point-min) (point-max) file nil - (if (nnheader-be-verbose 5) nil 'nomesg)) - (setq first file))) - (setq ga (cdr ga)))) - ;; Generate a nov line for this article. We generate the nov - ;; line after saving, because nov generation destroys the - ;; header. - (setq headers (nnml-parse-head chars)) - ;; Output the nov line to all nov databases that should have it. - (let ((ga group-art)) - (while ga - (nnml-add-nov (caar ga) (cdar ga) headers) - (setq ga (cdr ga)))) - group-art)) - -(defun nnml-active-number (group) - "Compute the next article number in GROUP." - (let ((active (cadr (assoc group nnml-group-alist)))) - ;; The group wasn't known to nnml, so we just create an active - ;; entry for it. - (unless active - ;; Perhaps the active file was corrupt? See whether - ;; there are any articles in this group. - (nnml-possibly-create-directory group) - (nnml-possibly-change-directory group) - (unless nnml-article-file-alist - (setq nnml-article-file-alist - (sort - (nnheader-article-to-file-alist nnml-current-directory) - (lambda (a1 a2) (< (car a1) (car a2)))))) - (setq active - (if nnml-article-file-alist - (cons (caar nnml-article-file-alist) - (caar (last nnml-article-file-alist))) - (cons 1 0))) - (push (list group active) nnml-group-alist)) - (setcdr active (1+ (cdr active))) - (while (file-exists-p - (concat (nnmail-group-pathname group nnml-directory) - (int-to-string (cdr active)))) - (setcdr active (1+ (cdr active)))) - (cdr active))) - -(defun nnml-add-nov (group article headers) - "Add a nov line for the GROUP base." - (save-excursion - (set-buffer (nnml-open-nov group)) - (goto-char (point-max)) - (mail-header-set-number headers article) - (nnheader-insert-nov headers))) - -(defsubst nnml-header-value () - (buffer-substring (match-end 0) (progn (end-of-line) (point)))) - -(defun nnml-parse-head (chars &optional number) - "Parse the head of the current buffer." - (save-excursion - (save-restriction - (goto-char (point-min)) - (narrow-to-region - (point) - (1- (or (search-forward "\n\n" nil t) (point-max)))) - ;; Fold continuation lines. - (goto-char (point-min)) - (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) - (replace-match " " t t)) - ;; Remove any tabs; they are too confusing. - (subst-char-in-region (point-min) (point-max) ?\t ? ) - (let ((headers (nnheader-parse-head t))) - (mail-header-set-chars headers chars) - (mail-header-set-number headers number) - headers)))) - -(defun nnml-open-nov (group) - (or (cdr (assoc group nnml-nov-buffer-alist)) - (let ((buffer (nnheader-find-file-noselect - (concat (nnmail-group-pathname group nnml-directory) - nnml-nov-file-name)))) - (save-excursion - (set-buffer buffer) - (buffer-disable-undo (current-buffer))) - (push (cons group buffer) nnml-nov-buffer-alist) - buffer))) - -(defun nnml-save-nov () - (save-excursion - (while nnml-nov-buffer-alist - (when (buffer-name (cdar nnml-nov-buffer-alist)) - (set-buffer (cdar nnml-nov-buffer-alist)) - (when (buffer-modified-p) - (nnmail-write-region 1 (point-max) (buffer-file-name) nil 'nomesg)) - (set-buffer-modified-p nil) - (kill-buffer (current-buffer))) - (setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist))))) - -;;;###autoload -(defun nnml-generate-nov-databases () - "Generate NOV databases in all nnml directories." - (interactive) - ;; Read the active file to make sure we don't re-use articles - ;; numbers in empty groups. - (nnmail-activate 'nnml) - (nnml-open-server (or (nnoo-current-server 'nnml) "")) - (setq nnml-directory (expand-file-name nnml-directory)) - ;; Recurse down the directories. - (nnml-generate-nov-databases-1 nnml-directory nil t) - ;; Save the active file. - (nnmail-save-active nnml-group-alist nnml-active-file)) - -(defun nnml-generate-nov-databases-1 (dir &optional seen no-active) - "Regenerate the NOV database in DIR." - (interactive "DRegenerate NOV in: ") - (setq dir (file-name-as-directory dir)) - ;; Only scan this sub-tree if we haven't been here yet. - (unless (member (file-truename dir) seen) - (push (file-truename dir) seen) - ;; We descend recursively - (let ((dirs (directory-files dir t nil t)) - dir) - (while (setq dir (pop dirs)) - (when (and (not (member (file-name-nondirectory dir) '("." ".."))) - (file-directory-p dir)) - (nnml-generate-nov-databases-1 dir seen)))) - ;; Do this directory. - (let ((files (sort (nnheader-article-to-file-alist dir) - (lambda (a b) (< (car a) (car b)))))) - (when files - (funcall nnml-generate-active-function dir) - ;; Generate the nov file. - (nnml-generate-nov-file dir files) - (unless no-active - (nnmail-save-active nnml-group-alist nnml-active-file)))))) - -(defvar files) -(defun nnml-generate-active-info (dir) - ;; Update the active info for this group. - (let ((group (nnheader-file-to-group - (directory-file-name dir) nnml-directory))) - (setq nnml-group-alist - (delq (assoc group nnml-group-alist) nnml-group-alist)) - (push (list group - (cons (caar files) - (let ((f files)) - (while (cdr f) (setq f (cdr f))) - (caar f)))) - nnml-group-alist))) - -(defun nnml-generate-nov-file (dir files) - (let* ((dir (file-name-as-directory dir)) - (nov (concat dir nnml-nov-file-name)) - (nov-buffer (get-buffer-create " *nov*")) - chars file headers) - (save-excursion - ;; Init the nov buffer. - (set-buffer nov-buffer) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (set-buffer nntp-server-buffer) - ;; Delete the old NOV file. - (when (file-exists-p nov) - (funcall nnmail-delete-file-function nov)) - (while files - (unless (file-directory-p (setq file (concat dir (cdar files)))) - (erase-buffer) - (nnheader-insert-file-contents file) - (narrow-to-region - (goto-char (point-min)) - (progn - (search-forward "\n\n" nil t) - (setq chars (- (point-max) (point))) - (max 1 (1- (point))))) - (unless (zerop (buffer-size)) - (goto-char (point-min)) - (setq headers (nnml-parse-head chars (caar files))) - (save-excursion - (set-buffer nov-buffer) - (goto-char (point-max)) - (nnheader-insert-nov headers))) - (widen)) - (setq files (cdr files))) - (save-excursion - (set-buffer nov-buffer) - (nnmail-write-region 1 (point-max) nov nil 'nomesg) - (kill-buffer (current-buffer)))))) - -(defun nnml-nov-delete-article (group article) - (save-excursion - (set-buffer (nnml-open-nov group)) - (when (nnheader-find-nov-line article) - (delete-region (point) (progn (forward-line 1) (point))) - (when (bobp) - (let ((active (cadr (assoc group nnml-group-alist))) - num) - (when active - (if (eobp) - (setf (car active) (1+ (cdr active))) - (when (and (setq num (ignore-errors (read (current-buffer)))) - (numberp num)) - (setf (car active) num))))))) - t)) - -(defun nnml-update-file-alist (&optional force) - (when (or (not nnml-article-file-alist) - force) - (setq nnml-article-file-alist - (nnheader-article-to-file-alist nnml-current-directory)))) - -(provide 'nnml) - -;;; nnml.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/nnoo.el --- a/lisp/gnus/nnoo.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,279 +0,0 @@ -;;; nnoo.el --- OO Gnus Backends -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'cl) - -(defvar nnoo-definition-alist nil) -(defvar nnoo-state-alist nil) - -(defmacro defvoo (var init &optional doc &rest map) - "The same as `defvar', only takes list of variables to MAP to." - `(prog1 - ,(if doc - `(defvar ,var ,init ,doc) - `(defvar ,var ,init)) - (nnoo-define ',var ',map))) -(put 'defvoo 'lisp-indent-function 2) -(put 'defvoo 'edebug-form-spec '(var init &optional doc &rest map)) - -(defmacro deffoo (func args &rest forms) - "The same as `defun', only register FUNC." - `(prog1 - (defun ,func ,args ,@forms) - (nnoo-register-function ',func))) -(put 'deffoo 'lisp-indent-function 2) -(put 'deffoo 'edebug-form-spec '(&define name lambda-list def-body)) - -(defun nnoo-register-function (func) - (let ((funcs (nthcdr 3 (assoc (nnoo-backend func) - nnoo-definition-alist)))) - (unless funcs - (error "%s belongs to a backend that hasn't been declared" func)) - (setcar funcs (cons func (car funcs))))) - -(defmacro nnoo-declare (backend &rest parents) - `(eval-and-compile - (push (list ',backend - (mapcar (lambda (p) (list p)) ',parents) - nil nil) - nnoo-definition-alist) - (push (list ',backend "*internal-non-initialized-backend*") - nnoo-state-alist))) -(put 'nnoo-declare 'lisp-indent-function 1) - -(defun nnoo-parents (backend) - (nth 1 (assoc backend nnoo-definition-alist))) - -(defun nnoo-variables (backend) - (nth 2 (assoc backend nnoo-definition-alist))) - -(defun nnoo-functions (backend) - (nth 3 (assoc backend nnoo-definition-alist))) - -(defmacro nnoo-import (backend &rest imports) - `(nnoo-import-1 ',backend ',imports)) -(put 'nnoo-import 'lisp-indent-function 1) - -(defun nnoo-import-1 (backend imports) - (let ((call-function - (if (symbolp (car imports)) (pop imports) 'nnoo-parent-function)) - imp functions function) - (while (setq imp (pop imports)) - (setq functions - (or (cdr imp) - (nnoo-functions (car imp)))) - (while functions - (unless (fboundp (setq function - (nnoo-symbol backend (nnoo-rest-symbol - (car functions))))) - (eval `(deffoo ,function (&rest args) - (,call-function ',backend ',(car functions) args)))) - (pop functions))))) - -(defun nnoo-parent-function (backend function args) - (let* ((pbackend (nnoo-backend function))) - (nnoo-change-server pbackend (nnoo-current-server backend) - (cdr (assq pbackend (nnoo-parents backend)))) - (apply function args))) - -(defun nnoo-execute (backend function &rest args) - "Execute FUNCTION on behalf of BACKEND." - (let* ((pbackend (nnoo-backend function))) - (nnoo-change-server pbackend (nnoo-current-server backend) - (cdr (assq pbackend (nnoo-parents backend)))) - (apply function args))) - -(defmacro nnoo-map-functions (backend &rest maps) - `(nnoo-map-functions-1 ',backend ',maps)) -(put 'nnoo-map-functions 'lisp-indent-function 1) - -(defun nnoo-map-functions-1 (backend maps) - (let (m margs i) - (while (setq m (pop maps)) - (setq i 0 - margs nil) - (while (< i (length (cdr m))) - (if (numberp (nth i (cdr m))) - (push `(nth ,i args) margs) - (push (nth i (cdr m)) margs)) - (incf i)) - (eval `(deffoo ,(nnoo-symbol backend (nnoo-rest-symbol (car m))) - (&rest args) - (nnoo-parent-function ',backend ',(car m) - ,(cons 'list (nreverse margs)))))))) - -(defun nnoo-backend (symbol) - (string-match "^[^-]+-" (symbol-name symbol)) - (intern (substring (symbol-name symbol) 0 (1- (match-end 0))))) - -(defun nnoo-rest-symbol (symbol) - (string-match "^[^-]+-" (symbol-name symbol)) - (intern (substring (symbol-name symbol) (match-end 0)))) - -(defun nnoo-symbol (backend symbol) - (intern (format "%s-%s" backend symbol))) - -(defun nnoo-define (var map) - (let* ((backend (nnoo-backend var)) - (def (assq backend nnoo-definition-alist)) - (parents (nth 1 def))) - (unless def - (error "%s belongs to a backend that hasn't been declared" var)) - (setcar (nthcdr 2 def) - (delq (assq var (nth 2 def)) (nth 2 def))) - (setcar (nthcdr 2 def) - (cons (cons var (symbol-value var)) - (nth 2 def))) - (while map - (nconc (assq (nnoo-backend (car map)) parents) - (list (list (pop map) var)))))) - -(defun nnoo-change-server (backend server defs) - (let* ((bstate (cdr (assq backend nnoo-state-alist))) - (current (car bstate)) - (parents (nnoo-parents backend)) - (bvariables (nnoo-variables backend)) - state def) - (unless bstate - (push (setq bstate (list backend nil)) - nnoo-state-alist) - (pop bstate)) - (if (equal server current) - t - (nnoo-push-server backend current) - (setq state (or (cdr (assoc server (cddr bstate))) - (nnoo-variables backend))) - (while state - (set (caar state) (cdar state)) - (pop state)) - (setcar bstate server) - (unless (cdr (assoc server (cddr bstate))) - (while (setq def (pop defs)) - (unless (assq (car def) bvariables) - (nconc bvariables - (list (cons (car def) (and (boundp (car def)) - (symbol-value (car def))))))) - (set (car def) (cadr def)))) - (while parents - (nnoo-change-server - (caar parents) server - (mapcar (lambda (def) (list (car def) (symbol-value (cadr def)))) - (cdar parents))) - (pop parents)))) - t) - -(defun nnoo-push-server (backend current) - (let ((bstate (assq backend nnoo-state-alist)) - (defs (nnoo-variables backend))) - ;; Remove the old definition. - (setcdr (cdr bstate) (delq (assoc current (cddr bstate)) (cddr bstate))) - ;; If this is the first time we push the server (i. e., this is - ;; the nil server), then we update the default values of - ;; all the variables to reflect the current values. - (when (equal current "*internal-non-initialized-backend*") - (let ((defaults (nnoo-variables backend)) - def) - (while (setq def (pop defaults)) - (setcdr def (symbol-value (car def)))))) - (let (state) - (while defs - (push (cons (caar defs) (symbol-value (caar defs))) - state) - (pop defs)) - (nconc bstate (list (cons current state)))))) - -(defsubst nnoo-current-server-p (backend server) - (equal (nnoo-current-server backend) server)) - -(defun nnoo-current-server (backend) - (nth 1 (assq backend nnoo-state-alist))) - -(defun nnoo-close-server (backend &optional server) - (unless server - (setq server (nnoo-current-server backend))) - (when server - (let* ((bstate (cdr (assq backend nnoo-state-alist))) - (defs (assoc server (cdr bstate)))) - (when bstate - (setcar bstate nil) - (setcdr bstate (delq defs (cdr bstate))) - (pop defs) - (while defs - (set (car (pop defs)) nil))))) - t) - -(defun nnoo-close (backend) - (setq nnoo-state-alist - (delq (assq backend nnoo-state-alist) - nnoo-state-alist)) - t) - -(defun nnoo-status-message (backend server) - (nnheader-get-report backend)) - -(defun nnoo-server-opened (backend server) - (and (nnoo-current-server-p backend server) - nntp-server-buffer - (buffer-name nntp-server-buffer))) - -(defmacro nnoo-define-basics (backend) - "Define `close-server', `server-opened' and `status-message'." - `(eval-and-compile - (nnoo-define-basics-1 ',backend))) - -(defun nnoo-define-basics-1 (backend) - (let ((functions '(close-server server-opened status-message))) - (while functions - (eval `(deffoo ,(nnoo-symbol backend (car functions)) - (&optional server) - (,(nnoo-symbol 'nnoo (pop functions)) ',backend server))))) - (eval `(deffoo ,(nnoo-symbol backend 'open-server) - (server &optional defs) - (nnoo-change-server ',backend server defs)))) - -(defmacro nnoo-define-skeleton (backend) - "Define all required backend functions for BACKEND. -All functions will return nil and report an error." - `(eval-and-compile - (nnoo-define-skeleton-1 ',backend))) - -(defun nnoo-define-skeleton-1 (backend) - (let ((functions '(retrieve-headers - request-close request-article - request-group close-group - request-list request-post request-list-newsgroups)) - function fun) - (while (setq function (pop functions)) - (when (not (fboundp (setq fun (nnoo-symbol backend function)))) - (eval `(deffoo ,fun - (&rest args) - (nnheader-report ',backend ,(format "%s-%s not implemented" - backend function)))))))) -(provide 'nnoo) - -;;; nnoo.el ends here. diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/nnsoup.el --- a/lisp/gnus/nnsoup.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,804 +0,0 @@ -;;; nnsoup.el --- SOUP access for Gnus -;; Copyright (C) 1995,96,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'nnmail) -(require 'gnus-soup) -(require 'gnus-msg) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nnsoup) - -(defvoo nnsoup-directory "~/SOUP/" - "*SOUP packet directory.") - -(defvoo nnsoup-tmp-directory "/tmp/" - "*Where nnsoup will store temporary files.") - -(defvoo nnsoup-replies-directory (concat nnsoup-directory "replies/") - "*Directory where outgoing packets will be composed.") - -(defvoo nnsoup-replies-format-type ?n - "*Format of the replies packages.") - -(defvoo nnsoup-replies-index-type ?n - "*Index type of the replies packages.") - -(defvoo nnsoup-active-file (concat nnsoup-directory "active") - "Active file.") - -(defvoo nnsoup-packer "tar cf - %s | gzip > $HOME/Soupin%d.tgz" - "Format string command for packing a SOUP packet. -The SOUP files will be inserted where the %s is in the string. -This string MUST contain both %s and %d. The file number will be -inserted where %d appears.") - -(defvoo nnsoup-unpacker "gunzip -c %s | tar xvf -" - "*Format string command for unpacking a SOUP packet. -The SOUP packet file name will be inserted at the %s.") - -(defvoo nnsoup-packet-directory "~/" - "*Where nnsoup will look for incoming packets.") - -(defvoo nnsoup-packet-regexp "Soupout" - "*Regular expression matching SOUP packets in `nnsoup-packet-directory'.") - - - -(defconst nnsoup-version "nnsoup 0.0" - "nnsoup version.") - -(defvoo nnsoup-status-string "") -(defvoo nnsoup-group-alist nil) -(defvoo nnsoup-current-prefix 0) -(defvoo nnsoup-replies-list nil) -(defvoo nnsoup-buffers nil) -(defvoo nnsoup-current-group nil) -(defvoo nnsoup-group-alist-touched nil) -(defvoo nnsoup-article-alist nil) - - - -;;; Interface functions. - -(nnoo-define-basics nnsoup) - -(deffoo nnsoup-retrieve-headers (sequence &optional group server fetch-old) - (nnsoup-possibly-change-group group) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let ((areas (cddr (assoc nnsoup-current-group nnsoup-group-alist))) - (articles sequence) - (use-nov t) - useful-areas this-area-seq msg-buf) - (if (stringp (car sequence)) - ;; We don't support fetching by Message-ID. - 'headers - ;; We go through all the areas and find which files the - ;; articles in SEQUENCE come from. - (while (and areas sequence) - ;; Peel off areas that are below sequence. - (while (and areas (< (cdaar areas) (car sequence))) - (setq areas (cdr areas))) - (when areas - ;; This is a useful area. - (push (car areas) useful-areas) - (setq this-area-seq nil) - ;; We take note whether this MSG has a corresponding IDX - ;; for later use. - (when (or (= (gnus-soup-encoding-index - (gnus-soup-area-encoding (nth 1 (car areas)))) ?n) - (not (file-exists-p - (nnsoup-file - (gnus-soup-area-prefix (nth 1 (car areas))))))) - (setq use-nov nil)) - ;; We assign the portion of `sequence' that is relevant to - ;; this MSG packet to this packet. - (while (and sequence (<= (car sequence) (cdaar areas))) - (push (car sequence) this-area-seq) - (setq sequence (cdr sequence))) - (setcar useful-areas (cons (nreverse this-area-seq) - (car useful-areas))))) - - ;; We now have a list of article numbers and corresponding - ;; areas. - (setq useful-areas (nreverse useful-areas)) - - ;; Two different approaches depending on whether all the MSG - ;; files have corresponding IDX files. If they all do, we - ;; simply return the relevant IDX files and let Gnus sort out - ;; what lines are relevant. If some of the IDX files are - ;; missing, we must return HEADs for all the articles. - (if use-nov - ;; We have IDX files for all areas. - (progn - (while useful-areas - (goto-char (point-max)) - (let ((b (point)) - (number (car (nth 1 (car useful-areas)))) - (index-buffer (nnsoup-index-buffer - (gnus-soup-area-prefix - (nth 2 (car useful-areas)))))) - (when index-buffer - (insert-buffer-substring index-buffer) - (goto-char b) - ;; We have to remove the index number entires and - ;; insert article numbers instead. - (while (looking-at "[0-9]+") - (replace-match (int-to-string number) t t) - (incf number) - (forward-line 1)))) - (setq useful-areas (cdr useful-areas))) - 'nov) - ;; We insert HEADs. - (while useful-areas - (setq articles (caar useful-areas) - useful-areas (cdr useful-areas)) - (while articles - (when (setq msg-buf - (nnsoup-narrow-to-article - (car articles) (cdar useful-areas) 'head)) - (goto-char (point-max)) - (insert (format "221 %d Article retrieved.\n" (car articles))) - (insert-buffer-substring msg-buf) - (goto-char (point-max)) - (insert ".\n")) - (setq articles (cdr articles)))) - - (nnheader-fold-continuation-lines) - 'headers))))) - -(deffoo nnsoup-open-server (server &optional defs) - (nnoo-change-server 'nnsoup server defs) - (when (not (file-exists-p nnsoup-directory)) - (condition-case () - (make-directory nnsoup-directory t) - (error t))) - (cond - ((not (file-exists-p nnsoup-directory)) - (nnsoup-close-server) - (nnheader-report 'nnsoup "Couldn't create directory: %s" nnsoup-directory)) - ((not (file-directory-p (file-truename nnsoup-directory))) - (nnsoup-close-server) - (nnheader-report 'nnsoup "Not a directory: %s" nnsoup-directory)) - (t - (nnsoup-read-active-file) - (nnheader-report 'nnsoup "Opened server %s using directory %s" - server nnsoup-directory) - t))) - -(deffoo nnsoup-request-close () - (nnsoup-write-active-file) - (nnsoup-write-replies) - (gnus-soup-save-areas) - ;; Kill all nnsoup buffers. - (let (buffer) - (while nnsoup-buffers - (setq buffer (cdr (pop nnsoup-buffers))) - (and buffer - (buffer-name buffer) - (kill-buffer buffer)))) - (setq nnsoup-group-alist nil - nnsoup-group-alist-touched nil - nnsoup-current-group nil - nnsoup-replies-list nil) - (nnoo-close-server 'nnoo) - t) - -(deffoo nnsoup-request-article (id &optional newsgroup server buffer) - (nnsoup-possibly-change-group newsgroup) - (let (buf) - (save-excursion - (set-buffer (or buffer nntp-server-buffer)) - (erase-buffer) - (when (and (not (stringp id)) - (setq buf (nnsoup-narrow-to-article id))) - (insert-buffer-substring buf) - t)))) - -(deffoo nnsoup-request-group (group &optional server dont-check) - (nnsoup-possibly-change-group group) - (if dont-check - t - (let ((active (cadr (assoc group nnsoup-group-alist)))) - (if (not active) - (nnheader-report 'nnsoup "No such group: %s" group) - (nnheader-insert - "211 %d %d %d %s\n" - (max (1+ (- (cdr active) (car active))) 0) - (car active) (cdr active) group))))) - -(deffoo nnsoup-request-type (group &optional article) - (nnsoup-possibly-change-group group) - ;; Try to guess the type based on the first articl ein the group. - (when (not article) - (setq article - (cdaar (cddr (assoc group nnsoup-group-alist))))) - (if (not article) - 'unknown - (let ((kind (gnus-soup-encoding-kind - (gnus-soup-area-encoding - (nth 1 (nnsoup-article-to-area - article nnsoup-current-group)))))) - (cond ((= kind ?m) 'mail) - ((= kind ?n) 'news) - (t 'unknown))))) - -(deffoo nnsoup-close-group (group &optional server) - ;; Kill all nnsoup buffers. - (let ((buffers nnsoup-buffers) - elem) - (while buffers - (when (equal (car (setq elem (pop buffers))) group) - (setq nnsoup-buffers (delq elem nnsoup-buffers)) - (and (cdr elem) (buffer-name (cdr elem)) - (kill-buffer (cdr elem)))))) - t) - -(deffoo nnsoup-request-list (&optional server) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (unless nnsoup-group-alist - (nnsoup-read-active-file)) - (let ((alist nnsoup-group-alist) - (standard-output (current-buffer)) - entry) - (while (setq entry (pop alist)) - (insert (car entry) " ") - (princ (cdadr entry)) - (insert " ") - (princ (caadr entry)) - (insert " y\n")) - t))) - -(deffoo nnsoup-request-scan (group &optional server) - (nnsoup-unpack-packets)) - -(deffoo nnsoup-request-newgroups (date &optional server) - (nnsoup-request-list)) - -(deffoo nnsoup-request-list-newsgroups (&optional server) - nil) - -(deffoo nnsoup-request-post (&optional server) - (nnsoup-store-reply "news") - t) - -(deffoo nnsoup-request-mail (&optional server) - (nnsoup-store-reply "mail") - t) - -(deffoo nnsoup-request-expire-articles (articles group &optional server force) - (nnsoup-possibly-change-group group) - (let* ((total-infolist (assoc group nnsoup-group-alist)) - (active (cadr total-infolist)) - (infolist (cddr total-infolist)) - info range-list mod-time prefix) - (while infolist - (setq info (pop infolist) - range-list (gnus-uncompress-range (car info)) - prefix (gnus-soup-area-prefix (nth 1 info))) - (when ;; All the articles in this file are marked for expiry. - (and (or (setq mod-time (nth 5 (file-attributes - (nnsoup-file prefix)))) - (setq mod-time (nth 5 (file-attributes - (nnsoup-file prefix t))))) - (gnus-sublist-p articles range-list) - ;; This file is old enough. - (nnmail-expired-article-p group mod-time force)) - ;; Ok, we delete this file. - (when (ignore-errors - (nnheader-message - 5 "Deleting %s in group %s..." (nnsoup-file prefix) - group) - (when (file-exists-p (nnsoup-file prefix)) - (delete-file (nnsoup-file prefix))) - (nnheader-message - 5 "Deleting %s in group %s..." (nnsoup-file prefix t) - group) - (when (file-exists-p (nnsoup-file prefix t)) - (delete-file (nnsoup-file prefix t))) - t) - (setcdr (cdr total-infolist) (delq info (cddr total-infolist))) - (setq articles (gnus-sorted-complement articles range-list)))) - (when (not mod-time) - (setcdr (cdr total-infolist) (delq info (cddr total-infolist))))) - (if (cddr total-infolist) - (setcar active (caaadr (cdr total-infolist))) - (setcar active (1+ (cdr active)))) - (nnsoup-write-active-file t) - ;; Return the articles that weren't expired. - articles)) - - -;;; Internal functions - -(defun nnsoup-possibly-change-group (group &optional force) - (when (and group - (not (equal nnsoup-current-group group))) - (setq nnsoup-article-alist nil) - (setq nnsoup-current-group group)) - t) - -(defun nnsoup-read-active-file () - (setq nnsoup-group-alist nil) - (when (file-exists-p nnsoup-active-file) - (ignore-errors - (load nnsoup-active-file t t t)) - ;; Be backwards compatible. - (when (and nnsoup-group-alist - (not (atom (caadar nnsoup-group-alist)))) - (let ((alist nnsoup-group-alist) - entry e min max) - (while (setq e (cdr (setq entry (pop alist)))) - (setq min (caaar e)) - (while (cdr e) - (setq e (cdr e))) - (setq max (cdaar e)) - (setcdr entry (cons (cons min max) (cdr entry))))) - (setq nnsoup-group-alist-touched t)) - nnsoup-group-alist)) - -(defun nnsoup-write-active-file (&optional force) - (when (and nnsoup-group-alist - (or force - nnsoup-group-alist-touched)) - (setq nnsoup-group-alist-touched nil) - (nnheader-temp-write nnsoup-active-file - (gnus-prin1 `(setq nnsoup-group-alist ',nnsoup-group-alist)) - (insert "\n") - (gnus-prin1 `(setq nnsoup-current-prefix ,nnsoup-current-prefix)) - (insert "\n")))) - -(defun nnsoup-next-prefix () - "Return the next free prefix." - (let (prefix) - (while (or (file-exists-p - (nnsoup-file (setq prefix (int-to-string - nnsoup-current-prefix)))) - (file-exists-p (nnsoup-file prefix t))) - (incf nnsoup-current-prefix)) - (incf nnsoup-current-prefix) - prefix)) - -(defun nnsoup-file-name (dir file) - "Return the full path of FILE (in any case) in DIR." - (let* ((case-fold-search t) - (files (directory-files dir t)) - (regexp (concat (regexp-quote file) "$"))) - (car (delq nil - (mapcar - (lambda (file) - (if (string-match regexp file) - file - nil)) - files))))) - -(defun nnsoup-read-areas () - (let ((areas-file (nnsoup-file-name nnsoup-tmp-directory "areas"))) - (when areas-file - (save-excursion - (set-buffer nntp-server-buffer) - (let ((areas (gnus-soup-parse-areas areas-file)) - entry number area lnum cur-prefix file) - ;; Go through all areas in the new AREAS file. - (while (setq area (pop areas)) - ;; Change the name to the permanent name and move the files. - (setq cur-prefix (nnsoup-next-prefix)) - (message "Incorporating file %s..." cur-prefix) - (when (file-exists-p - (setq file (concat nnsoup-tmp-directory - (gnus-soup-area-prefix area) ".IDX"))) - (rename-file file (nnsoup-file cur-prefix))) - (when (file-exists-p - (setq file (concat nnsoup-tmp-directory - (gnus-soup-area-prefix area) ".MSG"))) - (rename-file file (nnsoup-file cur-prefix t)) - (gnus-soup-set-area-prefix area cur-prefix) - ;; Find the number of new articles in this area. - (setq number (nnsoup-number-of-articles area)) - (if (not (setq entry (assoc (gnus-soup-area-name area) - nnsoup-group-alist))) - ;; If this is a new area (group), we just add this info to - ;; the group alist. - (push (list (gnus-soup-area-name area) - (cons 1 number) - (list (cons 1 number) area)) - nnsoup-group-alist) - ;; There are already articles in this group, so we add this - ;; info to the end of the entry. - (nconc entry (list (list (cons (1+ (setq lnum (cdadr entry))) - (+ lnum number)) - area))) - (setcdr (cadr entry) (+ lnum number)))))) - (nnsoup-write-active-file t) - (delete-file areas-file))))) - -(defun nnsoup-number-of-articles (area) - (save-excursion - (cond - ;; If the number is in the area info, we just return it. - ((gnus-soup-area-number area) - (gnus-soup-area-number area)) - ;; If there is an index file, we just count the lines. - ((/= (gnus-soup-encoding-index (gnus-soup-area-encoding area)) ?n) - (set-buffer (nnsoup-index-buffer (gnus-soup-area-prefix area))) - (count-lines (point-min) (point-max))) - ;; We do it the hard way - re-searching through the message - ;; buffer. - (t - (set-buffer (nnsoup-message-buffer (gnus-soup-area-prefix area))) - (unless (assoc (gnus-soup-area-prefix area) nnsoup-article-alist) - (nnsoup-dissect-buffer area)) - (length (cdr (assoc (gnus-soup-area-prefix area) - nnsoup-article-alist))))))) - -(defun nnsoup-dissect-buffer (area) - (let ((mbox-delim (concat "^" message-unix-mail-delimiter)) - (format (gnus-soup-encoding-format (gnus-soup-area-encoding area))) - (i 0) - alist len) - (goto-char (point-min)) - (cond - ;; rnews batch format - ((= format ?n) - (while (looking-at "^#! *rnews \\(+[0-9]+\\) *$") - (forward-line 1) - (push (list - (incf i) (point) - (progn - (forward-char (string-to-number (match-string 1))) - (point))) - alist))) - ;; Unix mbox format - ((= format ?m) - (while (looking-at mbox-delim) - (forward-line 1) - (push (list - (incf i) (point) - (progn - (if (re-search-forward mbox-delim nil t) - (beginning-of-line) - (goto-char (point-max))) - (point))) - alist))) - ;; MMDF format - ((= format ?M) - (while (looking-at "\^A\^A\^A\^A\n") - (forward-line 1) - (push (list - (incf i) (point) - (progn - (if (search-forward "\n\^A\^A\^A\^A\n" nil t) - (beginning-of-line) - (goto-char (point-max))) - (point))) - alist))) - ;; Binary format - ((or (= format ?B) (= format ?b)) - (while (not (eobp)) - (setq len (+ (* (char-after (point)) (expt 2.0 24)) - (* (char-after (+ (point) 1)) (expt 2 16)) - (* (char-after (+ (point) 2)) (expt 2 8)) - (char-after (+ (point) 3)))) - (push (list - (incf i) (+ (point) 4) - (progn - (forward-char (floor (+ len 4))) - (point))) - alist))) - (t - (error "Unknown format: %c" format))) - (push (cons (gnus-soup-area-prefix area) alist) nnsoup-article-alist))) - -(defun nnsoup-index-buffer (prefix &optional message) - (let* ((file (concat prefix (if message ".MSG" ".IDX"))) - (buffer-name (concat " *nnsoup " file "*"))) - (or (get-buffer buffer-name) ; File already loaded. - (when (file-exists-p (concat nnsoup-directory file)) - (save-excursion ; Load the file. - (set-buffer (get-buffer-create buffer-name)) - (buffer-disable-undo (current-buffer)) - (push (cons nnsoup-current-group (current-buffer)) nnsoup-buffers) - (nnheader-insert-file-contents (concat nnsoup-directory file)) - (current-buffer)))))) - -(defun nnsoup-file (prefix &optional message) - (expand-file-name - (concat nnsoup-directory prefix (if message ".MSG" ".IDX")))) - -(defun nnsoup-message-buffer (prefix) - (nnsoup-index-buffer prefix 'msg)) - -(defun nnsoup-unpack-packets () - "Unpack all packets in `nnsoup-packet-directory'." - (let ((packets (directory-files - nnsoup-packet-directory t nnsoup-packet-regexp)) - packet) - (while (setq packet (pop packets)) - (message "nnsoup: unpacking %s..." packet) - (if (not (gnus-soup-unpack-packet - nnsoup-tmp-directory nnsoup-unpacker packet)) - (message "Couldn't unpack %s" packet) - (delete-file packet) - (nnsoup-read-areas) - (message "Unpacking...done"))))) - -(defun nnsoup-narrow-to-article (article &optional area head) - (let* ((area (or area (nnsoup-article-to-area article nnsoup-current-group))) - (prefix (and area (gnus-soup-area-prefix (nth 1 area)))) - (msg-buf (and prefix (nnsoup-index-buffer prefix 'msg))) - beg end) - (when area - (save-excursion - (cond - ;; There is no MSG file. - ((null msg-buf) - nil) - ;; We use the index file to find out where the article - ;; begins and ends. - ((and (= (gnus-soup-encoding-index - (gnus-soup-area-encoding (nth 1 area))) - ?c) - (file-exists-p (nnsoup-file prefix))) - (set-buffer (nnsoup-index-buffer prefix)) - (widen) - (goto-char (point-min)) - (forward-line (- article (caar area))) - (setq beg (read (current-buffer))) - (forward-line 1) - (if (looking-at "[0-9]+") - (progn - (setq end (read (current-buffer))) - (set-buffer msg-buf) - (widen) - (let ((format (gnus-soup-encoding-format - (gnus-soup-area-encoding (nth 1 area))))) - (goto-char end) - (when (or (= format ?n) (= format ?m)) - (setq end (progn (forward-line -1) (point)))))) - (set-buffer msg-buf)) - (widen) - (narrow-to-region beg (or end (point-max)))) - (t - (set-buffer msg-buf) - (widen) - (unless (assoc (gnus-soup-area-prefix (nth 1 area)) - nnsoup-article-alist) - (nnsoup-dissect-buffer (nth 1 area))) - (let ((entry (assq article (cdr (assoc (gnus-soup-area-prefix - (nth 1 area)) - nnsoup-article-alist))))) - (when entry - (narrow-to-region (cadr entry) (caddr entry)))))) - (goto-char (point-min)) - (if (not head) - () - (narrow-to-region - (point-min) - (if (search-forward "\n\n" nil t) - (1- (point)) - (point-max)))) - msg-buf)))) - -;;;###autoload -(defun nnsoup-pack-replies () - "Make an outbound package of SOUP replies." - (interactive) - (unless (file-exists-p nnsoup-replies-directory) - (message "No such directory: %s" nnsoup-replies-directory)) - ;; Write all data buffers. - (gnus-soup-save-areas) - ;; Write the active file. - (nnsoup-write-active-file) - ;; Write the REPLIES file. - (nnsoup-write-replies) - ;; Check whether there is anything here. - (when (null (directory-files nnsoup-replies-directory nil "\\.MSG$")) - (error "No files to pack")) - ;; Pack all these files into a SOUP packet. - (gnus-soup-pack nnsoup-replies-directory nnsoup-packer)) - -(defun nnsoup-write-replies () - "Write the REPLIES file." - (when nnsoup-replies-list - (gnus-soup-write-replies nnsoup-replies-directory nnsoup-replies-list) - (setq nnsoup-replies-list nil))) - -(defun nnsoup-article-to-area (article group) - "Return the area that ARTICLE in GROUP is located in." - (let ((areas (cddr (assoc group nnsoup-group-alist)))) - (while (and areas (< (cdaar areas) article)) - (setq areas (cdr areas))) - (and areas (car areas)))) - -(defvar nnsoup-old-functions - (list message-send-mail-function message-send-news-function)) - -;;;###autoload -(defun nnsoup-set-variables () - "Use the SOUP methods for posting news and mailing mail." - (interactive) - (setq message-send-news-function 'nnsoup-request-post) - (setq message-send-mail-function 'nnsoup-request-mail)) - -;;;###autoload -(defun nnsoup-revert-variables () - "Revert posting and mailing methods to the standard Emacs methods." - (interactive) - (setq message-send-mail-function (car nnsoup-old-functions)) - (setq message-send-news-function (cadr nnsoup-old-functions))) - -(defun nnsoup-store-reply (kind) - ;; Mostly stolen from `message.el'. - (require 'mail-utils) - (let ((tembuf (generate-new-buffer " message temp")) - (case-fold-search nil) - delimline - (mailbuf (current-buffer))) - (unwind-protect - (save-excursion - (save-restriction - (message-narrow-to-headers) - (if (equal kind "mail") - (message-generate-headers message-required-mail-headers) - (message-generate-headers message-required-news-headers))) - (set-buffer tembuf) - (erase-buffer) - (insert-buffer-substring mailbuf) - ;; Remove some headers. - (save-restriction - (message-narrow-to-headers) - ;; Remove some headers. - (message-remove-header message-ignored-mail-headers t)) - (goto-char (point-max)) - ;; require one newline at the end. - (or (= (preceding-char) ?\n) - (insert ?\n)) - (let ((case-fold-search t)) - ;; Change header-delimiter to be what sendmail expects. - (goto-char (point-min)) - (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n")) - (replace-match "\n") - (backward-char 1) - (setq delimline (point-marker)) - ;; Insert an extra newline if we need it to work around - ;; Sun's bug that swallows newlines. - (goto-char (1+ delimline)) - (when (eval message-mailer-swallows-blank-line) - (newline)) - (let ((msg-buf - (gnus-soup-store - nnsoup-replies-directory - (nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type - nnsoup-replies-index-type)) - (num 0)) - (when (and msg-buf (bufferp msg-buf)) - (save-excursion - (set-buffer msg-buf) - (goto-char (point-min)) - (while (re-search-forward "^#! *rnews" nil t) - (incf num))) - (message "Stored %d messages" num))) - (nnsoup-write-replies) - (kill-buffer tembuf)))))) - -(defun nnsoup-kind-to-prefix (kind) - (unless nnsoup-replies-list - (setq nnsoup-replies-list - (gnus-soup-parse-replies - (concat nnsoup-replies-directory "REPLIES")))) - (let ((replies nnsoup-replies-list)) - (while (and replies - (not (string= kind (gnus-soup-reply-kind (car replies))))) - (setq replies (cdr replies))) - (if replies - (gnus-soup-reply-prefix (car replies)) - (push (vector (gnus-soup-unique-prefix nnsoup-replies-directory) - kind - (format "%c%c%c" - nnsoup-replies-format-type - nnsoup-replies-index-type - (if (string= kind "news") - ?n ?m))) - nnsoup-replies-list) - (gnus-soup-reply-prefix (car nnsoup-replies-list))))) - -(defun nnsoup-make-active () - "(Re-)create the SOUP active file." - (interactive) - (let ((files (sort (directory-files nnsoup-directory t "IDX$") - (lambda (f1 f2) - (< (progn (string-match "/\\([0-9]+\\)\\." f1) - (string-to-int (match-string 1 f1))) - (progn (string-match "/\\([0-9]+\\)\\." f2) - (string-to-int (match-string 1 f2))))))) - active group lines ident elem min) - (set-buffer (get-buffer-create " *nnsoup work*")) - (buffer-disable-undo (current-buffer)) - (while files - (message "Doing %s..." (car files)) - (erase-buffer) - (nnheader-insert-file-contents (car files)) - (goto-char (point-min)) - (if (not (re-search-forward "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t *\\(Xref: \\)? *[^ ]* \\([^ ]+\\):[0-9]" nil t)) - (setq group "unknown") - (setq group (match-string 2))) - (setq lines (count-lines (point-min) (point-max))) - (setq ident (progn (string-match - "/\\([0-9]+\\)\\." (car files)) - (substring - (car files) (match-beginning 1) - (match-end 1)))) - (if (not (setq elem (assoc group active))) - (push (list group (cons 1 lines) - (list (cons 1 lines) - (vector ident group "ncm" "" lines))) - active) - (nconc elem - (list - (list (cons (1+ (setq min (cdadr elem))) - (+ min lines)) - (vector ident group "ncm" "" lines)))) - (setcdr (cadr elem) (+ min lines))) - (setq files (cdr files))) - (message "") - (setq nnsoup-group-alist active) - (nnsoup-write-active-file t))) - -(defun nnsoup-delete-unreferenced-message-files () - "Delete any *.MSG and *.IDX files that aren't known by nnsoup." - (interactive) - (let* ((known (apply 'nconc (mapcar - (lambda (ga) - (mapcar - (lambda (area) - (gnus-soup-area-prefix (cadr area))) - (cddr ga))) - nnsoup-group-alist))) - (regexp "\\.MSG$\\|\\.IDX$") - (files (directory-files nnsoup-directory nil regexp)) - non-files file) - ;; Find all files that aren't known by nnsoup. - (while (setq file (pop files)) - (string-match regexp file) - (unless (member (substring file 0 (match-beginning 0)) known) - (push file non-files))) - ;; Sort and delete the files. - (setq non-files (sort non-files 'string<)) - (map-y-or-n-p "Delete file %s? " - (lambda (file) (delete-file (concat nnsoup-directory file))) - non-files))) - -(provide 'nnsoup) - -;;; nnsoup.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/nnspool.el --- a/lisp/gnus/nnspool.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,463 +0,0 @@ -;;; nnspool.el --- spool access for GNU Emacs -;; Copyright (C) 1988,89,90,93,94,95,96,97 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA -;; Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'nntp) -(require 'timezone) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nnspool) - -(defvoo nnspool-inews-program news-inews-program - "Program to post news. -This is most commonly `inews' or `injnews'.") - -(defvoo nnspool-inews-switches '("-h" "-S") - "Switches for nnspool-request-post to pass to `inews' for posting news. -If you are using Cnews, you probably should set this variable to nil.") - -(defvoo nnspool-spool-directory (file-name-as-directory news-path) - "Local news spool directory.") - -(defvoo nnspool-nov-directory (concat nnspool-spool-directory "over.view/") - "Local news nov directory.") - -(defvoo nnspool-lib-dir "/usr/lib/news/" - "Where the local news library files are stored.") - -(defvoo nnspool-active-file (concat nnspool-lib-dir "active") - "Local news active file.") - -(defvoo nnspool-newsgroups-file (concat nnspool-lib-dir "newsgroups") - "Local news newsgroups file.") - -(defvoo nnspool-distributions-file (concat nnspool-lib-dir "distribs.pat") - "Local news distributions file.") - -(defvoo nnspool-history-file (concat nnspool-lib-dir "history") - "Local news history file.") - -(defvoo nnspool-active-times-file (concat nnspool-lib-dir "active.times") - "Local news active date file.") - -(defvoo nnspool-large-newsgroup 50 - "The number of the articles which indicates a large newsgroup. -If the number of the articles is greater than the value, verbose -messages will be shown to indicate the current status.") - -(defvoo nnspool-nov-is-evil nil - "Non-nil means that nnspool will never return NOV lines instead of headers.") - -(defconst nnspool-sift-nov-with-sed nil - "If non-nil, use sed to get the relevant portion from the overview file. -If nil, nnspool will load the entire file into a buffer and process it -there.") - -(defvoo nnspool-rejected-article-hook nil - "*A hook that will be run when an article has been rejected by the server.") - - - -(defconst nnspool-version "nnspool 2.0" - "Version numbers of this version of NNSPOOL.") - -(defvoo nnspool-current-directory nil - "Current news group directory.") - -(defvoo nnspool-current-group nil) -(defvoo nnspool-status-string "") - - -;;; Interface functions. - -(nnoo-define-basics nnspool) - -(deffoo nnspool-retrieve-headers (articles &optional group server fetch-old) - "Retrieve the headers of ARTICLES." - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (when (nnspool-possibly-change-directory group) - (let* ((number (length articles)) - (count 0) - (default-directory nnspool-current-directory) - (do-message (and (numberp nnspool-large-newsgroup) - (> number nnspool-large-newsgroup))) - file beg article ag) - (if (and (numberp (car articles)) - (nnspool-retrieve-headers-with-nov articles fetch-old)) - ;; We successfully retrieved the NOV headers. - 'nov - ;; No NOV headers here, so we do it the hard way. - (while (setq article (pop articles)) - (if (stringp article) - ;; This is a Message-ID. - (setq ag (nnspool-find-id article) - file (and ag (nnspool-article-pathname - (car ag) (cdr ag))) - article (cdr ag)) - ;; This is an article in the current group. - (setq file (int-to-string article))) - ;; Insert the head of the article. - (when (and file - (file-exists-p file)) - (insert "221 ") - (princ article (current-buffer)) - (insert " Article retrieved.\n") - (setq beg (point)) - (inline (nnheader-insert-head file)) - (goto-char beg) - (search-forward "\n\n" nil t) - (forward-char -1) - (insert ".\n") - (delete-region (point) (point-max))) - - (and do-message - (zerop (% (incf count) 20)) - (message "nnspool: Receiving headers... %d%%" - (/ (* count 100) number)))) - - (when do-message - (message "nnspool: Receiving headers...done")) - - ;; Fold continuation lines. - (nnheader-fold-continuation-lines) - 'headers))))) - -(deffoo nnspool-open-server (server &optional defs) - (nnoo-change-server 'nnspool server defs) - (cond - ((not (file-exists-p nnspool-spool-directory)) - (nnspool-close-server) - (nnheader-report 'nnspool "Spool directory doesn't exist: %s" - nnspool-spool-directory)) - ((not (file-directory-p - (directory-file-name - (file-truename nnspool-spool-directory)))) - (nnspool-close-server) - (nnheader-report 'nnspool "Not a directory: %s" nnspool-spool-directory)) - ((not (file-exists-p nnspool-active-file)) - (nnheader-report 'nnspool "The active file doesn't exist: %s" - nnspool-active-file)) - (t - (nnheader-report 'nnspool "Opened server %s using directory %s" - server nnspool-spool-directory) - t))) - -(deffoo nnspool-request-article (id &optional group server buffer) - "Select article by message ID (or number)." - (nnspool-possibly-change-directory group) - (let ((nntp-server-buffer (or buffer nntp-server-buffer)) - file ag) - (if (stringp id) - ;; This is a Message-ID. - (when (setq ag (nnspool-find-id id)) - (setq file (nnspool-article-pathname (car ag) (cdr ag)))) - (setq file (nnspool-article-pathname nnspool-current-group id))) - (and file - (file-exists-p file) - (not (file-directory-p file)) - (save-excursion (nnspool-find-file file)) - ;; We return the article number and group name. - (if (numberp id) - (cons nnspool-current-group id) - ag)))) - -(deffoo nnspool-request-body (id &optional group server) - "Select article body by message ID (or number)." - (nnspool-possibly-change-directory group) - (let ((res (nnspool-request-article id))) - (when res - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (delete-region (point-min) (point))) - res)))) - -(deffoo nnspool-request-head (id &optional group server) - "Select article head by message ID (or number)." - (nnspool-possibly-change-directory group) - (let ((res (nnspool-request-article id))) - (when res - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (when (search-forward "\n\n" nil t) - (delete-region (1- (point)) (point-max))) - (nnheader-fold-continuation-lines))) - res)) - -(deffoo nnspool-request-group (group &optional server dont-check) - "Select news GROUP." - (let ((pathname (nnspool-article-pathname group)) - dir) - (if (not (file-directory-p pathname)) - (nnheader-report - 'nnspool "Invalid group name (no such directory): %s" group) - (setq nnspool-current-directory pathname) - (nnheader-report 'nnspool "Selected group %s" group) - (if dont-check - (progn - (nnheader-report 'nnspool "Selected group %s" group) - t) - ;; Yes, completely empty spool directories *are* possible. - ;; Fix by Sudish Joseph - (when (setq dir (directory-files pathname nil "^[0-9]+$" t)) - (setq dir - (sort (mapcar (lambda (name) (string-to-int name)) dir) '<))) - (if dir - (nnheader-insert - "211 %d %d %d %s\n" (length dir) (car dir) - (progn (while (cdr dir) (setq dir (cdr dir))) (car dir)) - group) - (nnheader-report 'nnspool "Empty group %s" group) - (nnheader-insert "211 0 0 0 %s\n" group)))))) - -(deffoo nnspool-request-type (group &optional article) - 'news) - -(deffoo nnspool-close-group (group &optional server) - t) - -(deffoo nnspool-request-list (&optional server) - "List active newsgroups." - (save-excursion - (or (nnspool-find-file nnspool-active-file) - (nnheader-report 'nnspool (nnheader-file-error nnspool-active-file))))) - -(deffoo nnspool-request-list-newsgroups (&optional server) - "List newsgroups (defined in NNTP2)." - (save-excursion - (or (nnspool-find-file nnspool-newsgroups-file) - (nnheader-report 'nnspool (nnheader-file-error - nnspool-newsgroups-file))))) - -(deffoo nnspool-request-list-distributions (&optional server) - "List distributions (defined in NNTP2)." - (save-excursion - (or (nnspool-find-file nnspool-distributions-file) - (nnheader-report 'nnspool (nnheader-file-error - nnspool-distributions-file))))) - -;; Suggested by Hallvard B Furuseth . -(deffoo nnspool-request-newgroups (date &optional server) - "List groups created after DATE." - (if (nnspool-find-file nnspool-active-times-file) - (save-excursion - ;; Find the last valid line. - (goto-char (point-max)) - (while (and (not (looking-at - "\\([^ ]+\\) +\\([0-9]+\\)[0-9][0-9][0-9] ")) - (zerop (forward-line -1)))) - (let ((seconds (nnspool-seconds-since-epoch date)) - groups) - ;; Go through lines and add the latest groups to a list. - (while (and (looking-at "\\([^ ]+\\) +[0-9]+ ") - (progn - ;; We insert a .0 to make the list reader - ;; interpret the number as a float. It is far - ;; too big to be stored in a lisp integer. - (goto-char (1- (match-end 0))) - (insert ".0") - (> (progn - (goto-char (match-end 1)) - (read (current-buffer))) - seconds)) - (push (buffer-substring - (match-beginning 1) (match-end 1)) - groups) - (zerop (forward-line -1)))) - (erase-buffer) - (while groups - (insert (car groups) " 0 0 y\n") - (setq groups (cdr groups)))) - t) - nil)) - -(deffoo nnspool-request-post (&optional server) - "Post a new news in current buffer." - (save-excursion - (let* ((process-connection-type nil) ; t bugs out on Solaris - (inews-buffer (generate-new-buffer " *nnspool post*")) - (proc - (condition-case err - (apply 'start-process "*nnspool inews*" inews-buffer - nnspool-inews-program nnspool-inews-switches) - (error - (nnheader-report 'nnspool "inews error: %S" err))))) - (if (not proc) - ;; The inews program failed. - () - (nnheader-report 'nnspool "") - (set-process-sentinel proc 'nnspool-inews-sentinel) - (process-send-region proc (point-min) (point-max)) - ;; We slap a condition-case around this, because the process may - ;; have exited already... - (ignore-errors - (process-send-eof proc)) - t)))) - - - -;;; Internal functions. - -(defun nnspool-inews-sentinel (proc status) - (save-excursion - (set-buffer (process-buffer proc)) - (goto-char (point-min)) - (if (or (zerop (buffer-size)) - (search-forward "spooled" nil t)) - (kill-buffer (current-buffer)) - ;; Make status message by folding lines. - (while (re-search-forward "[ \t\n]+" nil t) - (replace-match " " t t)) - (nnheader-report 'nnspool "%s" (buffer-string)) - (message "nnspool: %s" nnspool-status-string) - (ding) - (run-hooks 'nnspool-rejected-article-hook)))) - -(defun nnspool-retrieve-headers-with-nov (articles &optional fetch-old) - (if (or gnus-nov-is-evil nnspool-nov-is-evil) - nil - (let ((nov (nnheader-group-pathname - nnspool-current-group nnspool-nov-directory ".overview")) - (arts articles) - last) - (if (not (file-exists-p nov)) - () - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (if nnspool-sift-nov-with-sed - (nnspool-sift-nov-with-sed articles nov) - (nnheader-insert-file-contents nov) - (if (and fetch-old - (not (numberp fetch-old))) - t ; We want all the headers. - (ignore-errors - ;; Delete unwanted NOV lines. - (nnheader-nov-delete-outside-range - (if fetch-old (max 1 (- (car articles) fetch-old)) - (car articles)) - (car (last articles))) - ;; If the buffer is empty, this wasn't very successful. - (unless (zerop (buffer-size)) - ;; We check what the last article number was. - ;; The NOV file may be out of sync with the articles - ;; in the group. - (forward-line -1) - (setq last (read (current-buffer))) - (if (= last (car articles)) - ;; Yup, it's all there. - t - ;; Perhaps not. We try to find the missing articles. - (while (and arts - (<= last (car arts))) - (pop arts)) - ;; The articles in `arts' are missing from the buffer. - (while arts - (nnspool-insert-nov-head (pop arts))) - t)))))))))) - -(defun nnspool-insert-nov-head (article) - "Read the head of ARTICLE, convert to NOV headers, and insert." - (save-excursion - (let ((cur (current-buffer)) - buf) - (setq buf (nnheader-set-temp-buffer " *nnspool head*")) - (when (nnheader-insert-head - (nnspool-article-pathname nnspool-current-group article)) - (nnheader-insert-article-line article) - (let ((headers (nnheader-parse-head))) - (set-buffer cur) - (goto-char (point-max)) - (nnheader-insert-nov headers))) - (kill-buffer buf)))) - -(defun nnspool-sift-nov-with-sed (articles file) - (let ((first (car articles)) - (last (progn (while (cdr articles) (setq articles (cdr articles))) - (car articles)))) - (call-process "awk" nil t nil - (format "BEGIN {firstmsg=%d; lastmsg=%d;}\n $1 >= firstmsg && $1 <= lastmsg {print;}" - (1- first) (1+ last)) - file))) - -;; Fixed by fdc@cliwe.ping.de (Frank D. Cringle). -;; Find out what group an article identified by a Message-ID is in. -(defun nnspool-find-id (id) - (save-excursion - (set-buffer (get-buffer-create " *nnspool work*")) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (ignore-errors - (call-process "grep" nil t nil (regexp-quote id) nnspool-history-file)) - (goto-char (point-min)) - (prog1 - (when (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ /\t\n]+\\)/\\([0-9]+\\)[ \t\n]") - (cons (match-string 1) (string-to-int (match-string 2)))) - (kill-buffer (current-buffer))))) - -(defun nnspool-find-file (file) - "Insert FILE in server buffer safely." - (set-buffer nntp-server-buffer) - (erase-buffer) - (condition-case () - (progn (nnheader-insert-file-contents file) t) - (file-error nil))) - -(defun nnspool-possibly-change-directory (group) - (if (not group) - t - (let ((pathname (nnspool-article-pathname group))) - (if (file-directory-p pathname) - (setq nnspool-current-directory pathname - nnspool-current-group group) - (nnheader-report 'nnspool "No such newsgroup: %s" group))))) - -(defun nnspool-article-pathname (group &optional article) - "Find the path for GROUP." - (nnheader-group-pathname group nnspool-spool-directory article)) - -(defun nnspool-seconds-since-epoch (date) - (let* ((tdate (mapcar (lambda (ti) (and ti (string-to-int ti))) - (timezone-parse-date date))) - (ttime (mapcar (lambda (ti) (and ti (string-to-int ti))) - (timezone-parse-time - (aref (timezone-parse-date date) 3)))) - (unix (encode-time (nth 2 ttime) (nth 1 ttime) (nth 0 ttime) - (nth 2 tdate) (nth 1 tdate) (nth 0 tdate) - (nth 4 tdate)))) - (+ (* (car unix) 65536.0) - (cadr unix)))) - -(provide 'nnspool) - -;;; nnspool.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/nntp.el --- a/lisp/gnus/nntp.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1148 +0,0 @@ -;;; nntp.el --- nntp access for Gnus -;;; Copyright (C) 1987,88,89,90,92,93,94,95,96,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'nnoo) -(require 'gnus-util) - -(nnoo-declare nntp) - -(eval-and-compile - (unless (fboundp 'open-network-stream) - (require 'tcp))) - -(eval-when-compile (require 'cl)) - -(defvoo nntp-address nil - "Address of the physical nntp server.") - -(defvoo nntp-port-number "nntp" - "Port number on the physical nntp server.") - -(defvoo nntp-server-opened-hook '(nntp-send-mode-reader) - "*Hook used for sending commands to the server at startup. -The default value is `nntp-send-mode-reader', which makes an innd -server spawn an nnrpd server. Another useful function to put in this -hook might be `nntp-send-authinfo', which will prompt for a password -to allow posting from the server. Note that this is only necessary to -do on servers that use strict access control.") - -(defvoo nntp-authinfo-function 'nntp-send-authinfo - "Function used to send AUTHINFO to the server.") - -(defvoo nntp-server-action-alist - '(("nntpd 1\\.5\\.11t" - (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader)) - ("NNRP server Netscape" - (setq nntp-server-list-active-group nil))) - "Alist of regexps to match on server types and actions to be taken. -For instance, if you want Gnus to beep every time you connect -to innd, you could say something like: - -\(setq nntp-server-action-alist - '((\"innd\" (ding)))) - -You probably don't want to do that, though.") - -(defvoo nntp-open-connection-function 'nntp-open-network-stream - "*Function used for connecting to a remote system. -It will be called with the buffer to output in. - -Two pre-made functions are `nntp-open-network-stream', which is the -default, and simply connects to some port or other on the remote -system (see nntp-port-number). The other are `nntp-open-rlogin', -which does an rlogin on the remote system, and then does a telnet to -the NNTP server available there (see nntp-rlogin-parameters) and -`nntp-open-telnet' which telnets to a remote system, logs in and does -the same.") - -(defvoo nntp-rlogin-parameters '("telnet" "-8" "${NNTPSERVER:=news}" "nntp") - "*Parameters to `nntp-open-login'. -That function may be used as `nntp-open-connection-function'. In that -case, this list will be used as the parameter list given to rsh.") - -(defvoo nntp-rlogin-user-name nil - "*User name on remote system when using the rlogin connect method.") - -(defvoo nntp-telnet-parameters '("exec" "telnet" "-8" "${NNTPSERVER:=news}" "nntp") - "*Parameters to `nntp-open-telnet'. -That function may be used as `nntp-open-connection-function'. In that -case, this list will be executed as a command after logging in -via telnet.") - -(defvoo nntp-telnet-user-name nil - "User name to log in via telnet with.") - -(defvoo nntp-telnet-passwd nil - "Password to use to log in via telnet with.") - -(defvoo nntp-telnet-command "telnet" - "Command used to start telnet.") - -(defvoo nntp-telnet-switches '("-8") - "Switches given to the telnet command.") - -(defvoo nntp-end-of-line "\r\n" - "String to use on the end of lines when talking to the NNTP server. -This is \"\\r\\n\" by default, but should be \"\\n\" when -using rlogin or telnet to communicate with the server.") - -(defvoo nntp-large-newsgroup 50 - "*The number of the articles which indicates a large newsgroup. -If the number of the articles is greater than the value, verbose -messages will be shown to indicate the current status.") - -(defvoo nntp-maximum-request 400 - "*The maximum number of the requests sent to the NNTP server at one time. -If Emacs hangs up while retrieving headers, set the variable to a -lower value.") - -(defvoo nntp-nov-is-evil nil - "*If non-nil, nntp will never attempt to use XOVER when talking to the server.") - -(defvoo nntp-xover-commands '("XOVER" "XOVERVIEW") - "*List of strings that are used as commands to fetch NOV lines from a server. -The strings are tried in turn until a positive response is gotten. If -none of the commands are successful, nntp will just grab headers one -by one.") - -(defvoo nntp-nov-gap 20 - "*Maximum allowed gap between two articles. -If the gap between two consecutive articles is bigger than this -variable, split the XOVER request into two requests.") - -(defvoo nntp-connection-timeout nil - "*Number of seconds to wait before an nntp connection times out. -If this variable is nil, which is the default, no timers are set.") - -(defvoo nntp-prepare-server-hook nil - "*Hook run before a server is opened. -If can be used to set up a server remotely, for instance. Say you -have an account at the machine \"other.machine\". This machine has -access to an NNTP server that you can't access locally. You could -then use this hook to rsh to the remote machine and start a proxy NNTP -server there that you can connect to. See also `nntp-open-connection-function'") - -(defvoo nntp-warn-about-losing-connection t - "*If non-nil, beep when a server closes connection.") - - - -;;; Internal variables. - -(defvar nntp-have-messaged nil) - -(defvar nntp-process-wait-for nil) -(defvar nntp-process-to-buffer nil) -(defvar nntp-process-callback nil) -(defvar nntp-process-decode nil) -(defvar nntp-process-start-point nil) -(defvar nntp-inside-change-function nil) - -(defvar nntp-connection-list nil) - -(defvoo nntp-server-type nil) -(defvoo nntp-connection-alist nil) -(defvoo nntp-status-string "") -(defconst nntp-version "nntp 5.0") -(defvoo nntp-inhibit-erase nil) -(defvoo nntp-inhibit-output nil) - -(defvoo nntp-server-xover 'try) -(defvoo nntp-server-list-active-group 'try) - -(eval-and-compile - (autoload 'nnmail-read-passwd "nnmail")) - - - -;;; Internal functions. - -(defsubst nntp-send-string (process string) - "Send STRING to PROCESS." - (process-send-string process (concat string nntp-end-of-line))) - -(defsubst nntp-wait-for (process wait-for buffer &optional decode discard) - "Wait for WAIT-FOR to arrive from PROCESS." - (save-excursion - (set-buffer (process-buffer process)) - (goto-char (point-min)) - (while (or (not (memq (char-after (point)) '(?2 ?3 ?4 ?5))) - (looking-at "480")) - (when (looking-at "480") - (erase-buffer) - (funcall nntp-authinfo-function)) - (nntp-accept-process-output process) - (goto-char (point-min))) - (prog1 - (if (looking-at "[45]") - (progn - (nntp-snarf-error-message) - nil) - (goto-char (point-max)) - (let ((limit (point-min))) - (while (not (re-search-backward wait-for limit t)) - ;; We assume that whatever we wait for is less than 1000 - ;; characters long. - (setq limit (max (- (point-max) 1000) (point-min))) - (nntp-accept-process-output process) - (goto-char (point-max)))) - (nntp-decode-text (not decode)) - (unless discard - (save-excursion - (set-buffer buffer) - (goto-char (point-max)) - (insert-buffer-substring (process-buffer process)) - ;; Nix out "nntp reading...." message. - (when nntp-have-messaged - (setq nntp-have-messaged nil) - (message "")) - t))) - (unless discard - (erase-buffer))))) - -(defsubst nntp-find-connection (buffer) - "Find the connection delivering to BUFFER." - (let ((alist nntp-connection-alist) - (buffer (if (stringp buffer) (get-buffer buffer) buffer)) - process entry) - (while (setq entry (pop alist)) - (when (eq buffer (cadr entry)) - (setq process (car entry) - alist nil))) - (when process - (if (memq (process-status process) '(open run)) - process - (when (buffer-name (process-buffer process)) - (kill-buffer (process-buffer process))) - (setq nntp-connection-alist (delq entry nntp-connection-alist)) - nil)))) - -(defsubst nntp-find-connection-entry (buffer) - "Return the entry for the connection to BUFFER." - (assq (nntp-find-connection buffer) nntp-connection-alist)) - -(defun nntp-find-connection-buffer (buffer) - "Return the process connection buffer tied to BUFFER." - (let ((process (nntp-find-connection buffer))) - (when process - (process-buffer process)))) - -(defsubst nntp-retrieve-data (command address port buffer - &optional wait-for callback decode) - "Use COMMAND to retrieve data into BUFFER from PORT on ADDRESS." - (let ((process (or (nntp-find-connection buffer) - (nntp-open-connection buffer)))) - (if (not process) - (nnheader-report 'nntp "Couldn't open connection to %s" address) - (unless (or nntp-inhibit-erase nnheader-callback-function) - (save-excursion - (set-buffer (process-buffer process)) - (erase-buffer))) - (when command - (nntp-send-string process command)) - (cond - ((eq callback 'ignore) - t) - ((and callback wait-for) - (save-excursion - (set-buffer (process-buffer process)) - (unless nntp-inside-change-function - (erase-buffer)) - (setq nntp-process-decode decode - nntp-process-to-buffer buffer - nntp-process-wait-for wait-for - nntp-process-callback callback - nntp-process-start-point (point-max) - after-change-functions - (list 'nntp-after-change-function-callback))) - t) - (wait-for - (nntp-wait-for process wait-for buffer decode)) - (t t))))) - -(defsubst nntp-send-command (wait-for &rest strings) - "Send STRINGS to server and wait until WAIT-FOR returns." - (when (and (not nnheader-callback-function) - (not nntp-inhibit-output)) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer))) - (nntp-retrieve-data - (mapconcat 'identity strings " ") - nntp-address nntp-port-number nntp-server-buffer - wait-for nnheader-callback-function)) - -(defun nntp-send-command-nodelete (wait-for &rest strings) - "Send STRINGS to server and wait until WAIT-FOR returns." - (nntp-retrieve-data - (mapconcat 'identity strings " ") - nntp-address nntp-port-number nntp-server-buffer - wait-for nnheader-callback-function)) - -(defun nntp-send-command-and-decode (wait-for &rest strings) - "Send STRINGS to server and wait until WAIT-FOR returns." - (when (and (not nnheader-callback-function) - (not nntp-inhibit-output)) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer))) - (nntp-retrieve-data - (mapconcat 'identity strings " ") - nntp-address nntp-port-number nntp-server-buffer - wait-for nnheader-callback-function t)) - -(defun nntp-send-buffer (wait-for) - "Send the current buffer to server and wait until WAIT-FOR returns." - (when (and (not nnheader-callback-function) - (not nntp-inhibit-output)) - (save-excursion - (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) - (erase-buffer))) - (nntp-encode-text) - (process-send-region (nntp-find-connection nntp-server-buffer) - (point-min) (point-max)) - (nntp-retrieve-data - nil nntp-address nntp-port-number nntp-server-buffer - wait-for nnheader-callback-function)) - - - -;;; Interface functions. - -(nnoo-define-basics nntp) - -(deffoo nntp-retrieve-headers (articles &optional group server fetch-old) - "Retrieve the headers of ARTICLES." - (nntp-possibly-change-group group server) - (save-excursion - (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) - (erase-buffer) - (if (and (not gnus-nov-is-evil) - (not nntp-nov-is-evil) - (nntp-retrieve-headers-with-xover articles fetch-old)) - ;; We successfully retrieved the headers via XOVER. - 'nov - ;; XOVER didn't work, so we do it the hard, slow and inefficient - ;; way. - (let ((number (length articles)) - (count 0) - (received 0) - (last-point (point-min)) - (buf (nntp-find-connection-buffer nntp-server-buffer)) - (nntp-inhibit-erase t)) - ;; Send HEAD command. - (while articles - (nntp-send-command - nil - "HEAD" (if (numberp (car articles)) - (int-to-string (car articles)) - ;; `articles' is either a list of article numbers - ;; or a list of article IDs. - (car articles))) - (setq articles (cdr articles) - count (1+ count)) - ;; Every 400 header requests we have to read the stream in - ;; order to avoid deadlocks. - (when (or (null articles) ;All requests have been sent. - (zerop (% count nntp-maximum-request))) - (nntp-accept-response) - (while (progn - (progn - (set-buffer buf) - (goto-char last-point)) - ;; Count replies. - (while (re-search-forward "^[0-9]" nil t) - (incf received)) - (setq last-point (point)) - (< received count)) - ;; If number of headers is greater than 100, give - ;; informative messages. - (and (numberp nntp-large-newsgroup) - (> number nntp-large-newsgroup) - (zerop (% received 20)) - (nnheader-message 6 "NNTP: Receiving headers... %d%%" - (/ (* received 100) number))) - (nntp-accept-response)))) - ;; Wait for text of last command. - (goto-char (point-max)) - (re-search-backward "^[0-9]" nil t) - (when (looking-at "^[23]") - (while (progn - (goto-char (point-max)) - (forward-line -1) - (not (looking-at "^\\.\r?\n"))) - (nntp-accept-response))) - (and (numberp nntp-large-newsgroup) - (> number nntp-large-newsgroup) - (nnheader-message 6 "NNTP: Receiving headers...done")) - - ;; Now all of replies are received. Fold continuation lines. - (nnheader-fold-continuation-lines) - ;; Remove all "\r"'s. - (nnheader-strip-cr) - (copy-to-buffer nntp-server-buffer (point-min) (point-max)) - 'headers)))) - -(deffoo nntp-retrieve-groups (groups &optional server) - "Retrieve group info on GROUPS." - (nntp-possibly-change-group nil server) - (save-excursion - (set-buffer (nntp-find-connection-buffer nntp-server-buffer)) - ;; The first time this is run, this variable is `try'. So we - ;; try. - (when (eq nntp-server-list-active-group 'try) - (nntp-try-list-active (car groups))) - (erase-buffer) - (let ((count 0) - (received 0) - (last-point (point-min)) - (nntp-inhibit-erase t) - (command (if nntp-server-list-active-group "LIST ACTIVE" "GROUP"))) - (while groups - ;; Send the command to the server. - (nntp-send-command nil command (pop groups)) - (incf count) - ;; Every 400 requests we have to read the stream in - ;; order to avoid deadlocks. - (when (or (null groups) ;All requests have been sent. - (zerop (% count nntp-maximum-request))) - (nntp-accept-response) - (while (progn - (goto-char last-point) - ;; Count replies. - (while (re-search-forward "^[0-9]" nil t) - (incf received)) - (setq last-point (point)) - (< received count)) - (nntp-accept-response)))) - - ;; Wait for the reply from the final command. - (goto-char (point-max)) - (re-search-backward "^[0-9]" nil t) - (when (looking-at "^[23]") - (while (progn - (goto-char (point-max)) - (if (not nntp-server-list-active-group) - (not (re-search-backward "\r?\n" (- (point) 3) t)) - (not (re-search-backward "^\\.\r?\n" (- (point) 4) t)))) - (nntp-accept-response))) - - ;; Now all replies are received. We remove CRs. - (goto-char (point-min)) - (while (search-forward "\r" nil t) - (replace-match "" t t)) - - (if (not nntp-server-list-active-group) - (progn - (copy-to-buffer nntp-server-buffer (point-min) (point-max)) - 'group) - ;; We have read active entries, so we just delete the - ;; superfluous gunk. - (goto-char (point-min)) - (while (re-search-forward "^[.2-5]" nil t) - (delete-region (match-beginning 0) - (progn (forward-line 1) (point)))) - (copy-to-buffer nntp-server-buffer (point-min) (point-max)) - 'active)))) - -(deffoo nntp-retrieve-articles (articles &optional group server) - (nntp-possibly-change-group group server) - (save-excursion - (let ((number (length articles)) - (count 0) - (received 0) - (last-point (point-min)) - (buf (nntp-find-connection-buffer nntp-server-buffer)) - (nntp-inhibit-erase t) - (map (apply 'vector articles)) - (point 1) - article alist) - (set-buffer buf) - (erase-buffer) - ;; Send HEAD command. - (while (setq article (pop articles)) - (nntp-send-command - nil - "ARTICLE" (if (numberp article) - (int-to-string article) - ;; `articles' is either a list of article numbers - ;; or a list of article IDs. - article)) - (incf count) - ;; Every 400 requests we have to read the stream in - ;; order to avoid deadlocks. - (when (or (null articles) ;All requests have been sent. - (zerop (% count nntp-maximum-request))) - (nntp-accept-response) - (while (progn - (progn - (set-buffer buf) - (goto-char last-point)) - ;; Count replies. - (while (nntp-next-result-arrived-p) - (aset map received (cons (aref map received) (point))) - (incf received)) - (setq last-point (point)) - (< received count)) - ;; If number of headers is greater than 100, give - ;; informative messages. - (and (numberp nntp-large-newsgroup) - (> number nntp-large-newsgroup) - (zerop (% received 20)) - (nnheader-message 6 "NNTP: Receiving articles... %d%%" - (/ (* received 100) number))) - (nntp-accept-response)))) - (and (numberp nntp-large-newsgroup) - (> number nntp-large-newsgroup) - (nnheader-message 6 "NNTP: Receiving headers...done")) - - ;; Now we have all the responses. We go through the results, - ;; washes it and copies it over to the server buffer. - (set-buffer nntp-server-buffer) - (erase-buffer) - (mapcar - (lambda (entry) - (narrow-to-region - (setq point (goto-char (point-max))) - (progn - (insert-buffer-substring buf last-point (cdr entry)) - (point-max))) - (nntp-decode-text) - (widen) - (cons (car entry) point)) - map)))) - -(defun nntp-next-result-arrived-p () - (let ((point (point))) - (cond - ((looking-at "2") - (if (re-search-forward "\n.\r?\n" nil t) - t - (goto-char point) - nil)) - ((looking-at "[34]") - (forward-line 1) - t) - (t - nil)))) - -(defun nntp-try-list-active (group) - (nntp-list-active-group group) - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (cond ((or (eobp) - (looking-at "5[0-9]+")) - (setq nntp-server-list-active-group nil)) - (t - (setq nntp-server-list-active-group t))))) - -(deffoo nntp-list-active-group (group &optional server) - "Return the active info on GROUP (which can be a regexp." - (nntp-possibly-change-group nil server) - (nntp-send-command "^.*\r?\n" "LIST ACTIVE" group)) - -(deffoo nntp-request-article (article &optional group server buffer command) - (nntp-possibly-change-group group server) - (when (nntp-send-command-and-decode - "\r?\n\\.\r?\n" "ARTICLE" - (if (numberp article) (int-to-string article) article)) - (if (and buffer - (not (equal buffer nntp-server-buffer))) - (save-excursion - (set-buffer nntp-server-buffer) - (copy-to-buffer buffer (point-min) (point-max)) - (nntp-find-group-and-number)) - (nntp-find-group-and-number)))) - -(deffoo nntp-request-head (article &optional group server) - (nntp-possibly-change-group group server) - (when (nntp-send-command - "\r?\n\\.\r?\n" "HEAD" - (if (numberp article) (int-to-string article) article)) - (prog1 - (nntp-find-group-and-number) - (nntp-decode-text)))) - -(deffoo nntp-request-body (article &optional group server) - (nntp-possibly-change-group group server) - (nntp-send-command-and-decode - "\r?\n\\.\r?\n" "BODY" - (if (numberp article) (int-to-string article) article))) - -(deffoo nntp-request-group (group &optional server dont-check) - (nntp-possibly-change-group nil server) - (when (nntp-send-command "^2.*\n" "GROUP" group) - (let ((entry (nntp-find-connection-entry nntp-server-buffer))) - (setcar (cddr entry) group)))) - -(deffoo nntp-close-group (group &optional server) - t) - -(deffoo nntp-server-opened (&optional server) - "Say whether a connection to SERVER has been opened." - (and (nnoo-current-server-p 'nntp server) - nntp-server-buffer - (gnus-buffer-live-p nntp-server-buffer) - (nntp-find-connection nntp-server-buffer))) - -(deffoo nntp-open-server (server &optional defs connectionless) - (nnheader-init-server-buffer) - (if (nntp-server-opened server) - t - (when (or (stringp (car defs)) - (numberp (car defs))) - (setq defs (cons (list 'nntp-port-number (car defs)) (cdr defs)))) - (unless (assq 'nntp-address defs) - (setq defs (append defs (list (list 'nntp-address server))))) - (nnoo-change-server 'nntp server defs) - (unless connectionless - (or (nntp-find-connection nntp-server-buffer) - (nntp-open-connection nntp-server-buffer))))) - -(deffoo nntp-close-server (&optional server) - (nntp-possibly-change-group nil server t) - (let (process) - (while (setq process (car (pop nntp-connection-alist))) - (when (memq (process-status process) '(open run)) - (set-process-sentinel process nil) - (nntp-send-string process "QUIT")) - (when (buffer-name (process-buffer process)) - (kill-buffer (process-buffer process)))) - (nnoo-close-server 'nntp))) - -(deffoo nntp-request-close () - (let (process) - (while (setq process (pop nntp-connection-list)) - (when (memq (process-status process) '(open run)) - (set-process-sentinel process nil) - (ignore-errors - (nntp-send-string process "QUIT"))) - (when (buffer-name (process-buffer process)) - (kill-buffer (process-buffer process)))))) - -(deffoo nntp-request-list (&optional server) - (nntp-possibly-change-group nil server) - (nntp-send-command-and-decode "\r?\n\\.\r?\n" "LIST")) - -(deffoo nntp-request-list-newsgroups (&optional server) - (nntp-possibly-change-group nil server) - (nntp-send-command "\r?\n\\.\r?\n" "LIST NEWSGROUPS")) - -(deffoo nntp-request-newgroups (date &optional server) - (nntp-possibly-change-group nil server) - (save-excursion - (set-buffer nntp-server-buffer) - (let* ((date (timezone-parse-date date)) - (time-string - (format "%s%02d%02d %s%s%s" - (substring (aref date 0) 2) (string-to-int (aref date 1)) - (string-to-int (aref date 2)) (substring (aref date 3) 0 2) - (substring - (aref date 3) 3 5) (substring (aref date 3) 6 8)))) - (prog1 - (nntp-send-command "^\\.\r?\n" "NEWGROUPS" time-string) - (nntp-decode-text))))) - -(deffoo nntp-request-post (&optional server) - (nntp-possibly-change-group nil server) - (when (nntp-send-command "^[23].*\r?\n" "POST") - (nntp-send-buffer "^[23].*\n"))) - -(deffoo nntp-request-type (group article) - 'news) - -(deffoo nntp-asynchronous-p () - t) - -;;; Hooky functions. - -(defun nntp-send-mode-reader () - "Send the MODE READER command to the nntp server. -This function is supposed to be called from `nntp-server-opened-hook'. -It will make innd servers spawn an nnrpd process to allow actual article -reading." - (nntp-send-command "^.*\r?\n" "MODE READER")) - -(defun nntp-send-nosy-authinfo () - "Send the AUTHINFO to the nntp server. -This function is supposed to be called from `nntp-server-opened-hook'. -It will prompt for a password." - (nntp-send-command - "^.*\r?\n" "AUTHINFO USER" - (read-string (format "NNTP (%s) user name: " nntp-address))) - (nntp-send-command - "^.*\r?\n" "AUTHINFO PASS" - (nnmail-read-passwd "NNTP (%s) password: " nntp-address))) - -(defun nntp-send-authinfo () - "Send the AUTHINFO to the nntp server. -This function is supposed to be called from `nntp-server-opened-hook'. -It will prompt for a password." - (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name)) - (nntp-send-command - "^.*\r?\n" "AUTHINFO PASS" - (nnmail-read-passwd (format "NNTP (%s) password: " nntp-address)))) - -(defun nntp-send-authinfo-from-file () - "Send the AUTHINFO to the nntp server. -This function is supposed to be called from `nntp-server-opened-hook'." - (when (file-exists-p "~/.nntp-authinfo") - (nnheader-temp-write nil - (insert-file-contents "~/.nntp-authinfo") - (goto-char (point-min)) - (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name)) - (nntp-send-command - "^.*\r?\n" "AUTHINFO PASS" - (buffer-substring (point) (progn (end-of-line) (point))))))) - -;;; Internal functions. - -(defun nntp-make-process-buffer (buffer) - "Create a new, fresh buffer usable for nntp process connections." - (save-excursion - (set-buffer - (generate-new-buffer - (format " *server %s %s %s*" - nntp-address nntp-port-number - (buffer-name (get-buffer buffer))))) - (buffer-disable-undo (current-buffer)) - (set (make-local-variable 'after-change-functions) nil) - (set (make-local-variable 'nntp-process-wait-for) nil) - (set (make-local-variable 'nntp-process-callback) nil) - (set (make-local-variable 'nntp-process-to-buffer) nil) - (set (make-local-variable 'nntp-process-start-point) nil) - (set (make-local-variable 'nntp-process-decode) nil) - (current-buffer))) - -(defun nntp-open-connection (buffer) - "Open a connection to PORT on ADDRESS delivering output to BUFFER." - (run-hooks 'nntp-prepare-server-hook) - (let* ((pbuffer (nntp-make-process-buffer buffer)) - (process - (condition-case () - (funcall nntp-open-connection-function pbuffer) - (error nil) - (quit nil)))) - (when process - (process-kill-without-query process) - (nntp-wait-for process "^.*\n" buffer nil t) - (if (memq (process-status process) '(open run)) - (prog1 - (caar (push (list process buffer nil) nntp-connection-alist)) - (push process nntp-connection-list) - (save-excursion - (set-buffer pbuffer) - (nntp-read-server-type) - (erase-buffer) - (set-buffer nntp-server-buffer) - (let ((nnheader-callback-function nil)) - (run-hooks 'nntp-server-opened-hook)))) - (when (buffer-name (process-buffer process)) - (kill-buffer (process-buffer process))) - nil)))) - -(defun nntp-open-network-stream (buffer) - (open-network-stream "nntpd" buffer nntp-address nntp-port-number)) - -(defun nntp-read-server-type () - "Find out what the name of the server we have connected to is." - ;; Wait for the status string to arrive. - (setq nntp-server-type (buffer-string)) - (let ((alist nntp-server-action-alist) - (case-fold-search t) - entry) - ;; Run server-specific commands. - (while alist - (setq entry (pop alist)) - (when (string-match (car entry) nntp-server-type) - (if (and (listp (cadr entry)) - (not (eq 'lambda (caadr entry)))) - (eval (cadr entry)) - (funcall (cadr entry))))))) - -(defun nntp-after-change-function-callback (beg end len) - (when nntp-process-callback - (save-match-data - (if (and (= beg (point-min)) - (memq (char-after beg) '(?4 ?5))) - ;; Report back error messages. - (save-excursion - (goto-char beg) - (if (looking-at "480") - (funcall nntp-authinfo-function) - (nntp-snarf-error-message) - (funcall nntp-process-callback nil))) - (goto-char end) - (when (and (> (point) nntp-process-start-point) - (re-search-backward nntp-process-wait-for - nntp-process-start-point t)) - (when (buffer-name (get-buffer nntp-process-to-buffer)) - (let ((cur (current-buffer)) - (start nntp-process-start-point)) - (save-excursion - (set-buffer (get-buffer nntp-process-to-buffer)) - (goto-char (point-max)) - (let ((b (point))) - (insert-buffer-substring cur start) - (narrow-to-region b (point-max)) - (nntp-decode-text) - (widen))))) - (goto-char end) - (let ((callback nntp-process-callback) - (nntp-inside-change-function t)) - (setq nntp-process-callback nil) - (save-excursion - (funcall callback (buffer-name - (get-buffer nntp-process-to-buffer)))))))))) - -(defun nntp-snarf-error-message () - "Save the error message in the current buffer." - (let ((message (buffer-string))) - (while (string-match "[\r\n]+" message) - (setq message (replace-match " " t t message))) - (nnheader-report 'nntp message) - message)) - -(defun nntp-accept-process-output (process) - "Wait for output from PROCESS and message some dots." - (save-excursion - (set-buffer (or (nntp-find-connection-buffer nntp-server-buffer) - nntp-server-buffer)) - (let ((len (/ (point-max) 1024)) - message-log-max) - (unless (< len 10) - (setq nntp-have-messaged t) - (nnheader-message 7 "nntp read: %dk" len))) - (accept-process-output process 1))) - -(defun nntp-accept-response () - "Wait for output from the process that outputs to BUFFER." - (nntp-accept-process-output (nntp-find-connection nntp-server-buffer))) - -(defun nntp-possibly-change-group (group server &optional connectionless) - (let ((nnheader-callback-function nil)) - (when server - (or (nntp-server-opened server) - (nntp-open-server server nil connectionless))) - - (unless connectionless - (or (nntp-find-connection nntp-server-buffer) - (nntp-open-connection nntp-server-buffer)))) - - (when group - (let ((entry (nntp-find-connection-entry nntp-server-buffer))) - (when (not (equal group (caddr entry))) - (save-excursion - (set-buffer (process-buffer (car entry))) - (erase-buffer) - (nntp-send-string (car entry) (concat "GROUP " group)) - (nntp-wait-for-string "^2.*\n") - (setcar (cddr entry) group) - (erase-buffer)))))) - -(defun nntp-decode-text (&optional cr-only) - "Decode the text in the current buffer." - (goto-char (point-min)) - (while (search-forward "\r" nil t) - (delete-char -1)) - (unless cr-only - ;; Remove trailing ".\n" end-of-transfer marker. - (goto-char (point-max)) - (forward-line -1) - (when (looking-at ".\n") - (delete-char 2)) - ;; Delete status line. - (goto-char (point-min)) - (delete-region (point) (progn (forward-line 1) (point))) - ;; Remove "." -> ".." encoding. - (while (search-forward "\n.." nil t) - (delete-char -1)))) - -(defun nntp-encode-text () - "Encode the text in the current buffer." - (save-excursion - ;; Replace "." at beginning of line with "..". - (goto-char (point-min)) - (while (re-search-forward "^\\." nil t) - (insert ".")) - (goto-char (point-max)) - ;; Insert newline at the end of the buffer. - (unless (bolp) - (insert "\n")) - ;; Insert `.' at end of buffer (end of text mark). - (goto-char (point-max)) - (insert "." nntp-end-of-line))) - -(defun nntp-retrieve-headers-with-xover (articles &optional fetch-old) - (set-buffer nntp-server-buffer) - (erase-buffer) - (cond - - ;; This server does not talk NOV. - ((not nntp-server-xover) - nil) - - ;; We don't care about gaps. - ((or (not nntp-nov-gap) - fetch-old) - (nntp-send-xover-command - (if fetch-old - (if (numberp fetch-old) - (max 1 (- (car articles) fetch-old)) - 1) - (car articles)) - (car (last articles)) 'wait) - - (goto-char (point-min)) - (when (looking-at "[1-5][0-9][0-9] ") - (delete-region (point) (progn (forward-line 1) (point)))) - (while (search-forward "\r" nil t) - (replace-match "" t t)) - (goto-char (point-max)) - (forward-line -1) - (when (looking-at "\\.") - (delete-region (point) (progn (forward-line 1) (point))))) - - ;; We do it the hard way. For each gap, an XOVER command is sent - ;; to the server. We do not wait for a reply from the server, we - ;; just send them off as fast as we can. That means that we have - ;; to count the number of responses we get back to find out when we - ;; have gotten all we asked for. - ((numberp nntp-nov-gap) - (let ((count 0) - (received 0) - (last-point (point-min)) - (buf nntp-server-buffer) - ;;(process-buffer (nntp-find-connection (current-buffer)))) - first) - ;; We have to check `nntp-server-xover'. If it gets set to nil, - ;; that means that the server does not understand XOVER, but we - ;; won't know that until we try. - (while (and nntp-server-xover articles) - (setq first (car articles)) - ;; Search forward until we find a gap, or until we run out of - ;; articles. - (while (and (cdr articles) - (< (- (nth 1 articles) (car articles)) nntp-nov-gap)) - (setq articles (cdr articles))) - - (when (nntp-send-xover-command first (car articles)) - (setq articles (cdr articles) - count (1+ count)) - - ;; Every 400 requests we have to read the stream in - ;; order to avoid deadlocks. - (when (or (null articles) ;All requests have been sent. - (zerop (% count nntp-maximum-request))) - (accept-process-output) - ;; On some Emacs versions the preceding function has - ;; a tendency to change the buffer. Perhaps. It's - ;; quite difficult to reproduce, because it only - ;; seems to happen once in a blue moon. - (set-buffer buf) - (while (progn - (goto-char last-point) - ;; Count replies. - (while (re-search-forward "^[0-9][0-9][0-9] " nil t) - (setq received (1+ received))) - (setq last-point (point)) - (< received count)) - (accept-process-output) - (set-buffer buf))))) - - (when nntp-server-xover - ;; Wait for the reply from the final command. - (goto-char (point-max)) - (re-search-backward "^[0-9][0-9][0-9] " nil t) - (when (looking-at "^[23]") - (while (progn - (goto-char (point-max)) - (forward-line -1) - (not (looking-at "^\\.\r?\n"))) - (nntp-accept-response))) - - ;; We remove any "." lines and status lines. - (goto-char (point-min)) - (while (search-forward "\r" nil t) - (delete-char -1)) - (goto-char (point-min)) - (delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] ") - ;;(copy-to-buffer nntp-server-buffer (point-min) (point-max)) - t)))) - - nntp-server-xover) - -(defun nntp-send-xover-command (beg end &optional wait-for-reply) - "Send the XOVER command to the server." - (let ((range (format "%d-%d" beg end)) - (nntp-inhibit-erase t)) - (if (stringp nntp-server-xover) - ;; If `nntp-server-xover' is a string, then we just send this - ;; command. - (if wait-for-reply - (nntp-send-command-nodelete - "\r?\n\\.\r?\n" nntp-server-xover range) - ;; We do not wait for the reply. - (nntp-send-command-nodelete "\r?\n\\.\r?\n" nntp-server-xover range)) - (let ((commands nntp-xover-commands)) - ;; `nntp-xover-commands' is a list of possible XOVER commands. - ;; We try them all until we get at positive response. - (while (and commands (eq nntp-server-xover 'try)) - (nntp-send-command-nodelete "\r?\n\\.\r?\n" (car commands) range) - (save-excursion - (set-buffer nntp-server-buffer) - (goto-char (point-min)) - (and (looking-at "[23]") ; No error message. - ;; We also have to look at the lines. Some buggy - ;; servers give back simple lines with just the - ;; article number. How... helpful. - (progn - (forward-line 1) - (looking-at "[0-9]+\t...")) ; More text after number. - (setq nntp-server-xover (car commands)))) - (setq commands (cdr commands))) - ;; If none of the commands worked, we disable XOVER. - (when (eq nntp-server-xover 'try) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (setq nntp-server-xover nil))) - nntp-server-xover)))) - -;;; Alternative connection methods. - -(defun nntp-wait-for-string (regexp) - "Wait until string arrives in the buffer." - (let ((buf (current-buffer))) - (goto-char (point-min)) - (while (not (re-search-forward regexp nil t)) - (accept-process-output (nntp-find-connection nntp-server-buffer)) - (set-buffer buf) - (goto-char (point-min))))) - -(defun nntp-open-telnet (buffer) - (save-excursion - (set-buffer buffer) - (erase-buffer) - (let ((proc (apply - 'start-process - "nntpd" buffer nntp-telnet-command nntp-telnet-switches)) - (case-fold-search t)) - (when (memq (process-status proc) '(open run)) - (process-send-string proc "set escape \^X\n") - (process-send-string proc (concat "open " nntp-address "\n")) - (nntp-wait-for-string "^\r*.?login:") - (process-send-string - proc (concat - (or nntp-telnet-user-name - (setq nntp-telnet-user-name (read-string "login: "))) - "\n")) - (nntp-wait-for-string "^\r*.?password:") - (process-send-string - proc (concat - (or nntp-telnet-passwd - (setq nntp-telnet-passwd - (nnmail-read-passwd "Password: "))) - "\n")) - (erase-buffer) - (nntp-wait-for-string "bash\\|\$ *\r?$\\|> *\r?") - (process-send-string - proc (concat (mapconcat 'identity nntp-telnet-parameters " ") "\n")) - (nntp-wait-for-string "^\r*200") - (beginning-of-line) - (delete-region (point-min) (point)) - (process-send-string proc "\^]") - (nntp-wait-for-string "^telnet") - (process-send-string proc "mode character\n") - (accept-process-output proc 1) - (sit-for 1) - (goto-char (point-min)) - (forward-line 1) - (delete-region (point) (point-max))) - proc))) - -(defun nntp-open-rlogin (buffer) - "Open a connection to SERVER using rsh." - (let ((proc (if nntp-rlogin-user-name - (start-process - "nntpd" buffer "rsh" - nntp-address "-l" nntp-rlogin-user-name - (mapconcat 'identity - nntp-rlogin-parameters " ")) - (start-process - "nntpd" buffer "rsh" nntp-address - (mapconcat 'identity - nntp-rlogin-parameters " "))))) - (set-buffer buffer) - (nntp-wait-for-string "^\r*200") - (beginning-of-line) - (delete-region (point-min) (point)) - proc)) - -(defun nntp-find-group-and-number () - (save-excursion - (save-restriction - (set-buffer nntp-server-buffer) - (narrow-to-region (goto-char (point-min)) - (or (search-forward "\n\n" nil t) (point-max))) - (goto-char (point-min)) - ;; We first find the number by looking at the status line. - (let ((number (and (looking-at "2[0-9][0-9] +\\([0-9]+\\) ") - (string-to-int - (buffer-substring (match-beginning 1) - (match-end 1))))) - group newsgroups xref) - (and number (zerop number) (setq number nil)) - ;; Then we find the group name. - (setq group - (cond - ;; If there is only one group in the Newsgroups header, - ;; then it seems quite likely that this article comes - ;; from that group, I'd say. - ((and (setq newsgroups (mail-fetch-field "newsgroups")) - (not (string-match "," newsgroups))) - newsgroups) - ;; If there is more than one group in the Newsgroups - ;; header, then the Xref header should be filled out. - ;; We hazard a guess that the group that has this - ;; article number in the Xref header is the one we are - ;; looking for. This might very well be wrong if this - ;; article happens to have the same number in several - ;; groups, but that's life. - ((and (setq xref (mail-fetch-field "xref")) - number - (string-match (format "\\([^ :]+\\):%d" number) xref)) - (substring xref (match-beginning 1) (match-end 1))) - (t ""))) - (when (string-match "\r" group) - (setq group (substring group 0 (match-beginning 0)))) - (cons group number))))) - -(provide 'nntp) - -;;; nntp.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/nnvirtual.el --- a/lisp/gnus/nnvirtual.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,766 +0,0 @@ -;;; nnvirtual.el --- virtual newsgroups access for Gnus -;; Copyright (C) 1994,95,96,97 Free Software Foundation, Inc. - -;; Author: David Moore -;; Lars Magne Ingebrigtsen -;; Masanobu UMEDA -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; The other access methods (nntp, nnspool, etc) are general news -;; access methods. This module relies on Gnus and can not be used -;; separately. - -;;; Code: - -(require 'nntp) -(require 'nnheader) -(require 'gnus) -(require 'nnoo) -(require 'gnus-util) -(require 'gnus-start) -(require 'gnus-sum) -(eval-when-compile (require 'cl)) - -(nnoo-declare nnvirtual) - -(defvoo nnvirtual-always-rescan nil - "*If non-nil, always scan groups for unread articles when entering a group. -If this variable is nil (which is the default) and you read articles -in a component group after the virtual group has been activated, the -read articles from the component group will show up when you enter the -virtual group.") - -(defvoo nnvirtual-component-regexp nil - "*Regexp to match component groups.") - -(defvoo nnvirtual-component-groups nil - "Component group in this nnvirtual group.") - - - -(defconst nnvirtual-version "nnvirtual 1.1") - -(defvoo nnvirtual-current-group nil) - -(defvoo nnvirtual-mapping-table nil - "Table of rules on how to map between component group and article number -to virtual article number.") - -(defvoo nnvirtual-mapping-offsets nil - "Table indexed by component group to an offset to be applied to article numbers in that group.") - -(defvoo nnvirtual-mapping-len 0 - "Number of articles in this virtual group.") - -(defvoo nnvirtual-mapping-reads nil - "Compressed sequence of read articles on the virtual group as computed from the unread status of individual component groups.") - -(defvoo nnvirtual-mapping-marks nil - "Compressed marks alist for the virtual group as computed from the marks of individual component groups.") - -(defvoo nnvirtual-info-installed nil - "T if we have already installed the group info for this group, and shouldn't blast over it again.") - -(defvoo nnvirtual-status-string "") - -(eval-and-compile - (autoload 'gnus-cache-articles-in-group "gnus-cache")) - - - -;;; Interface functions. - -(nnoo-define-basics nnvirtual) - - -(deffoo nnvirtual-retrieve-headers (articles &optional newsgroup - server fetch-old) - (when (nnvirtual-possibly-change-server server) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (if (stringp (car articles)) - 'headers - (let ((vbuf (nnheader-set-temp-buffer - (get-buffer-create " *virtual headers*"))) - (carticles (nnvirtual-partition-sequence articles)) - (system-name (system-name)) - cgroup carticle article result prefix) - (while carticles - (setq cgroup (caar carticles)) - (setq articles (cdar carticles)) - (pop carticles) - (when (and articles - (gnus-check-server - (gnus-find-method-for-group cgroup) t) - (gnus-request-group cgroup t) - (setq prefix (gnus-group-real-prefix cgroup)) - ;; FIX FIX FIX we want to check the cache! - ;; This is probably evil if people have set - ;; gnus-use-cache to nil themselves, but I - ;; have no way of finding the true value of it. - (let ((gnus-use-cache t)) - (setq result (gnus-retrieve-headers - articles cgroup nil)))) - (set-buffer nntp-server-buffer) - ;; If we got HEAD headers, we convert them into NOV - ;; headers. This is slow, inefficient and, come to think - ;; of it, downright evil. So sue me. I couldn't be - ;; bothered to write a header parse routine that could - ;; parse a mixed HEAD/NOV buffer. - (when (eq result 'headers) - (nnvirtual-convert-headers)) - (goto-char (point-min)) - (while (not (eobp)) - (delete-region (point) - (progn - (setq carticle (read nntp-server-buffer)) - (point))) - - ;; We remove this article from the articles list, if - ;; anything is left in the articles list after going through - ;; the entire buffer, then those articles have been - ;; expired or canceled, so we appropriately update the - ;; component group below. They should be coming up - ;; generally in order, so this shouldn't be slow. - (setq articles (delq carticle articles)) - - (setq article (nnvirtual-reverse-map-article cgroup carticle)) - (if (null article) - ;; This line has no reverse mapping, that means it - ;; was an extra article reference returned by nntp. - (progn - (beginning-of-line) - (delete-region (point) (progn (forward-line 1) (point)))) - ;; Otherwise insert the virtual article number, - ;; and clean up the xrefs. - (princ article nntp-server-buffer) - (nnvirtual-update-xref-header cgroup carticle - prefix system-name) - (forward-line 1)) - ) - - (set-buffer vbuf) - (goto-char (point-max)) - (insert-buffer-substring nntp-server-buffer)) - ;; Anything left in articles is expired or canceled. - ;; Could be smart and not tell it about articles already known? - (when articles - (gnus-group-make-articles-read cgroup articles)) - ) - - ;; The headers are ready for reading, so they are inserted into - ;; the nntp-server-buffer, which is where Gnus expects to find - ;; them. - (prog1 - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (insert-buffer-substring vbuf) - ;; FIX FIX FIX, we should be able to sort faster than - ;; this if needed, since each cgroup is sorted, we just - ;; need to merge - (sort-numeric-fields 1 (point-min) (point-max)) - 'nov) - (kill-buffer vbuf))))))) - - -(defvoo nnvirtual-last-accessed-component-group nil) - -(deffoo nnvirtual-request-article (article &optional group server buffer) - (when (nnvirtual-possibly-change-server server) - (if (stringp article) - ;; This is a fetch by Message-ID. - (cond - ((not nnvirtual-last-accessed-component-group) - (nnheader-report - 'nnvirtual "Don't know what server to request from")) - (t - (save-excursion - (when buffer - (set-buffer buffer)) - (let ((method (gnus-find-method-for-group - nnvirtual-last-accessed-component-group))) - (funcall (gnus-get-function method 'request-article) - article nil (nth 1 method) buffer))))) - ;; This is a fetch by number. - (let* ((amap (nnvirtual-map-article article)) - (cgroup (car amap))) - (cond - ((not amap) - (nnheader-report 'nnvirtual "No such article: %s" article)) - ((not (gnus-check-group cgroup)) - (nnheader-report - 'nnvirtual "Can't open server where %s exists" cgroup)) - ((not (gnus-request-group cgroup t)) - (nnheader-report 'nnvirtual "Can't open component group %s" cgroup)) - (t - (setq nnvirtual-last-accessed-component-group cgroup) - (if buffer - (save-excursion - (set-buffer buffer) - (gnus-request-article-this-buffer (cdr amap) cgroup)) - (gnus-request-article (cdr amap) cgroup)))))))) - - -(deffoo nnvirtual-open-server (server &optional defs) - (unless (assq 'nnvirtual-component-regexp defs) - (push `(nnvirtual-component-regexp ,server) - defs)) - (nnoo-change-server 'nnvirtual server defs) - (if nnvirtual-component-groups - t - (setq nnvirtual-mapping-table nil - nnvirtual-mapping-offsets nil - nnvirtual-mapping-len 0 - nnvirtual-mapping-reads nil - nnvirtual-mapping-marks nil - nnvirtual-info-installed nil) - (when nnvirtual-component-regexp - ;; Go through the newsrc alist and find all component groups. - (let ((newsrc (cdr gnus-newsrc-alist)) - group) - (while (setq group (car (pop newsrc))) - (when (string-match nnvirtual-component-regexp group) ; Match - ;; Add this group to the list of component groups. - (setq nnvirtual-component-groups - (cons group (delete group nnvirtual-component-groups))))))) - (if (not nnvirtual-component-groups) - (nnheader-report 'nnvirtual "No component groups: %s" server) - t))) - - -(deffoo nnvirtual-request-group (group &optional server dont-check) - (nnvirtual-possibly-change-server server) - (setq nnvirtual-component-groups - (delete (nnvirtual-current-group) nnvirtual-component-groups)) - (cond - ((null nnvirtual-component-groups) - (setq nnvirtual-current-group nil) - (nnheader-report 'nnvirtual "No component groups in %s" group)) - (t - (when (or (not dont-check) - nnvirtual-always-rescan) - (nnvirtual-create-mapping)) - (setq nnvirtual-current-group group) - (nnheader-insert "211 %d 1 %d %s\n" - nnvirtual-mapping-len nnvirtual-mapping-len group)))) - - -(deffoo nnvirtual-request-type (group &optional article) - (if (not article) - 'unknown - (let ((mart (nnvirtual-map-article article))) - (when mart - (gnus-request-type (car mart) (cdr mart)))))) - -(deffoo nnvirtual-request-update-mark (group article mark) - (let* ((nart (nnvirtual-map-article article)) - (cgroup (car nart)) - ;; The component group might be a virtual group. - (nmark (gnus-request-update-mark cgroup (cdr nart) mark))) - (when (and nart - (= mark nmark) - (gnus-group-auto-expirable-p cgroup)) - (setq mark gnus-expirable-mark))) - mark) - - -(deffoo nnvirtual-close-group (group &optional server) - (when (and (nnvirtual-possibly-change-server server) - (not (gnus-ephemeral-group-p (nnvirtual-current-group)))) - (nnvirtual-update-read-and-marked t t)) - t) - - -(deffoo nnvirtual-request-list (&optional server) - (nnheader-report 'nnvirtual "LIST is not implemented.")) - - -(deffoo nnvirtual-request-newgroups (date &optional server) - (nnheader-report 'nnvirtual "NEWGROUPS is not supported.")) - - -(deffoo nnvirtual-request-list-newsgroups (&optional server) - (nnheader-report 'nnvirtual "LIST NEWSGROUPS is not implemented.")) - - -(deffoo nnvirtual-request-update-info (group info &optional server) - (when (and (nnvirtual-possibly-change-server server) - (not nnvirtual-info-installed)) - ;; Install the precomputed lists atomically, so the virtual group - ;; is not left in a half-way state in case of C-g. - (gnus-atomic-progn - (setcar (cddr info) nnvirtual-mapping-reads) - (if (nthcdr 3 info) - (setcar (nthcdr 3 info) nnvirtual-mapping-marks) - (when nnvirtual-mapping-marks - (setcdr (nthcdr 2 info) (list nnvirtual-mapping-marks)))) - (setq nnvirtual-info-installed t)) - t)) - - -(deffoo nnvirtual-catchup-group (group &optional server all) - (when (and (nnvirtual-possibly-change-server server) - (not (gnus-ephemeral-group-p (nnvirtual-current-group)))) - ;; copy over existing marks first, in case they set anything - (nnvirtual-update-read-and-marked nil nil) - ;; do a catchup on all component groups - (let ((gnus-group-marked (copy-sequence nnvirtual-component-groups)) - (gnus-expert-user t)) - ;; Make sure all groups are activated. - (mapcar - (lambda (g) - (when (not (numberp (car (gnus-gethash g gnus-newsrc-hashtb)))) - (gnus-activate-group g))) - nnvirtual-component-groups) - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-group-catchup-current nil all))))) - - -(deffoo nnvirtual-find-group-art (group article) - "Return the real group and article for virtual GROUP and ARTICLE." - (nnvirtual-map-article article)) - - -;;; Internal functions. - -(defun nnvirtual-convert-headers () - "Convert HEAD headers into NOV headers." - (save-excursion - (set-buffer nntp-server-buffer) - (let* ((dependencies (make-vector 100 0)) - (headers (gnus-get-newsgroup-headers dependencies)) - header) - (erase-buffer) - (while (setq header (pop headers)) - (nnheader-insert-nov header))))) - - -(defun nnvirtual-update-xref-header (group article prefix system-name) - "Edit current NOV header in current buffer to have an xref to the component group, and also server prefix any existing xref lines." - ;; Move to beginning of Xref field, creating a slot if needed. - (beginning-of-line) - (looking-at - "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t") - (goto-char (match-end 0)) - (unless (search-forward "\t" (gnus-point-at-eol) 'move) - (insert "\t")) - - ;; Remove any spaces at the beginning of the Xref field. - (while (= (char-after (1- (point))) ? ) - (forward-char -1) - (delete-char 1)) - - (insert "Xref: " system-name " " group ":") - (princ article (current-buffer)) - - ;; If there were existing xref lines, clean them up to have the correct - ;; component server prefix. - (let ((xref-end (save-excursion - (search-forward "\t" (gnus-point-at-eol) 'move) - (point))) - (len (length prefix))) - (unless (= (point) xref-end) - (insert " ") - (when (not (string= "" prefix)) - (while (re-search-forward "[^ ]+:[0-9]+" xref-end t) - (save-excursion - (goto-char (match-beginning 0)) - (insert prefix)) - (setq xref-end (+ xref-end len))) - ))) - - ;; Ensure a trailing \t. - (end-of-line) - (or (= (char-after (1- (point))) ?\t) - (insert ?\t))) - - -(defun nnvirtual-possibly-change-server (server) - (or (not server) - (nnoo-current-server-p 'nnvirtual server) - (nnvirtual-open-server server))) - - -(defun nnvirtual-update-read-and-marked (read-p update-p) - "Copy marks from the virtual group to the component groups. -If READ-P is not nil, update the (un)read status of the components. -If UPDATE-P is not nil, call gnus-group-update-group on the components." - (when nnvirtual-current-group - (let ((unreads (and read-p - (nnvirtual-partition-sequence - (gnus-list-of-unread-articles - (nnvirtual-current-group))))) - (type-marks (mapcar (lambda (ml) - (cons (car ml) - (nnvirtual-partition-sequence (cdr ml)))) - (gnus-info-marks (gnus-get-info - (nnvirtual-current-group))))) - mark type groups carticles info entry) - - ;; Ok, atomically move all of the (un)read info, clear any old - ;; marks, and move all of the current marks. This way if someone - ;; hits C-g, you won't leave the component groups in a half-way state. - (gnus-atomic-progn - ;; move (un)read - (let ((gnus-newsgroup-active nil)) ;workaround guns-update-read-articles - (while (setq entry (pop unreads)) - (gnus-update-read-articles (car entry) (cdr entry)))) - - ;; clear all existing marks on the component groups - (setq groups nnvirtual-component-groups) - (while groups - (when (and (setq info (gnus-get-info (pop groups))) - (gnus-info-marks info)) - (gnus-info-set-marks info nil))) - - ;; Ok, currently type-marks is an assq list with keys of a mark type, - ;; with data of an assq list with keys of component group names - ;; and the articles which correspond to that key/group pair. - (while (setq mark (pop type-marks)) - (setq type (car mark)) - (setq groups (cdr mark)) - (while (setq carticles (pop groups)) - (gnus-add-marked-articles (car carticles) type (cdr carticles) - nil t)))) - - ;; possibly update the display, it is really slow - (when update-p - (setq groups nnvirtual-component-groups) - (while groups - (gnus-group-update-group (pop groups) t)))))) - - -(defun nnvirtual-current-group () - "Return the prefixed name of the current nnvirtual group." - (concat "nnvirtual:" nnvirtual-current-group)) - - - -;;; This is currently O(kn^2) to merge n lists of length k. -;;; You could do it in O(knlogn), but we have a small n, and the -;;; overhead of the other approach is probably greater. -(defun nnvirtual-merge-sorted-lists (&rest lists) - "Merge many sorted lists of numbers." - (if (null (cdr lists)) - (car lists) - (apply 'nnvirtual-merge-sorted-lists - (merge 'list (car lists) (cadr lists) '<) - (cddr lists)))) - - - -;;; We map between virtual articles and real articles in a manner -;;; which keeps the size of the virtual active list the same as -;;; the sum of the component active lists. -;;; To achieve fair mixing of the groups, the last article in -;;; each of N component groups will be in the the last N articles -;;; in the virtual group. - -;;; If you have 3 components A, B and C, with articles 1-8, 1-5, and 6-7 -;;; resprectively, then the virtual article numbers look like: -;;; -;;; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 -;;; A1 A2 A3 A4 B1 A5 B2 A6 B3 A7 B4 C6 A8 B5 C7 - -;;; To compute these mappings we generate a couple tables and then -;;; do some fast operations on them. Tables for the example above: -;;; -;;; Offsets - [(A 0) (B -3) (C -1)] -;;; -;;; a b c d e -;;; Mapping - ([ 3 0 1 3 0 ] -;;; [ 6 3 2 9 3 ] -;;; [ 8 6 3 15 9 ]) -;;; -;;; (note column 'e' is different in real algorithm, which is slightly -;;; different than described here, but this gives you the methodology.) -;;; -;;; The basic idea is this, when going from component->virtual, apply -;;; the appropriate offset to the article number. Then search the first -;;; column of the table for a row where 'a' is less than or equal to the -;;; modified number. You can see that only group A can therefore go to -;;; the first row, groups A and B to the second, and all to the last. -;;; The third column of the table is telling us the number of groups -;;; which might be able to reach that row (it might increase by more than -;;; 1 if several groups have the same size). -;;; Then column 'b' provides an additional offset you apply when you have -;;; found the correct row. You then multiply by 'c' and add on the groups -;;; _position_ in the offset table. The basic idea here is that on -;;; any given row we are going to map back and forth using X'=X*c+Y and -;;; X=(X'/c), Y=(X' mod c). Then once you've done this transformation, -;;; you apply a final offset from column 'e' to give the virtual article. -;;; -;;; Going the other direction, you instead search on column 'd' instead -;;; of 'a', and apply everything in reverse order. - -;;; Convert component -> virtual: -;;; set num = num - Offset(group) -;;; find first row in Mapping where num <= 'a' -;;; num = (num-'b')*c + Position(group) + 'e' - -;;; Convert virtual -> component: -;;; find first row in Mapping where num <= 'd' -;;; num = num - 'e' -;;; group_pos = num mod 'c' -;;; num = (num / 'c') + 'b' + Offset(group_pos) - -;;; Easy no? :) -;;; -;;; Well actually, you need to keep column e offset smaller by the 'c' -;;; column for that line, and always add 1 more when going from -;;; component -> virtual. Otherwise you run into a problem with -;;; unique reverse mapping. - -(defun nnvirtual-map-article (article) - "Return a cons of the component group and article corresponding to the given virtual ARTICLE." - (let ((table nnvirtual-mapping-table) - entry group-pos) - (while (and table - (> article (aref (car table) 3))) - (setq table (cdr table))) - (when (and table - (> article 0)) - (setq entry (car table)) - (setq article (- article (aref entry 4) 1)) - (setq group-pos (mod article (aref entry 2))) - (cons (car (aref nnvirtual-mapping-offsets group-pos)) - (+ (/ article (aref entry 2)) - (aref entry 1) - (cdr (aref nnvirtual-mapping-offsets group-pos))) - )) - )) - - - -(defun nnvirtual-reverse-map-article (group article) - "Return the virtual article number corresponding to the given component GROUP and ARTICLE." - (let ((table nnvirtual-mapping-table) - (group-pos 0) - entry) - (while (not (string= group (car (aref nnvirtual-mapping-offsets - group-pos)))) - (setq group-pos (1+ group-pos))) - (setq article (- article (cdr (aref nnvirtual-mapping-offsets - group-pos)))) - (while (and table - (> article (aref (car table) 0))) - (setq table (cdr table))) - (setq entry (car table)) - (when (and entry - (> article 0) - (< group-pos (aref entry 2))) ; article not out of range below - (+ (aref entry 4) - group-pos - (* (- article (aref entry 1)) - (aref entry 2)) - 1)) - )) - - -(defsubst nnvirtual-reverse-map-sequence (group articles) - "Return list of virtual article numbers for all ARTICLES in GROUP. -The ARTICLES should be sorted, and can be a compressed sequence. -If any of the article numbers has no corresponding virtual article, -then it is left out of the result." - (when (numberp (cdr-safe articles)) - (setq articles (list articles))) - (let (result a i j new-a) - (while (setq a (pop articles)) - (if (atom a) - (setq i a - j a) - (setq i (car a) - j (cdr a))) - (while (<= i j) - ;; If this is slow, you can optimize by moving article checking - ;; into here. You don't have to recompute the group-pos, - ;; nor scan the table every time. - (when (setq new-a (nnvirtual-reverse-map-article group i)) - (push new-a result)) - (setq i (1+ i)))) - (nreverse result))) - - -(defun nnvirtual-partition-sequence (articles) - "Return an association list of component article numbers. -These are indexed by elements of nnvirtual-component-groups, based on -the sequence ARTICLES of virtual article numbers. ARTICLES should be -sorted, and can be a compressed sequence. If any of the article -numbers has no corresponding component article, then it is left out of -the result." - (when (numberp (cdr-safe articles)) - (setq articles (list articles))) - (let ((carticles (mapcar (lambda (g) (list g)) - nnvirtual-component-groups)) - a i j article entry) - (while (setq a (pop articles)) - (if (atom a) - (setq i a - j a) - (setq i (car a) - j (cdr a))) - (while (<= i j) - (when (setq article (nnvirtual-map-article i)) - (setq entry (assoc (car article) carticles)) - (setcdr entry (cons (cdr article) (cdr entry)))) - (setq i (1+ i)))) - (mapc (lambda (x) (setcdr x (nreverse (cdr x)))) - carticles) - carticles)) - - -(defun nnvirtual-create-mapping () - "Build the tables necessary to map between component (group, article) to virtual article. -Generate the set of read messages and marks for the virtual group -based on the marks on the component groups." - (let ((cnt 0) - (tot 0) - (M 0) - (i 0) - actives all-unreads all-marks - active min max size unreads marks - next-M next-tot - reads beg) - ;; Ok, we loop over all component groups and collect a lot of - ;; information: - ;; Into actives we place (g size max), where size is max-min+1. - ;; Into all-unreads we put (g unreads). - ;; Into all-marks we put (g marks). - ;; We also increment cnt and tot here, and compute M (max of sizes). - (mapc (lambda (g) - (setq active (gnus-activate-group g) - min (car active) - max (cdr active)) - (when (and active (>= max min) (not (zerop max))) - ;; store active information - (push (list g (- max min -1) max) actives) - ;; collect unread/mark info for later - (setq unreads (gnus-list-of-unread-articles g)) - (setq marks (gnus-info-marks (gnus-get-info g))) - (when gnus-use-cache - (push (cons 'cache - (gnus-cache-articles-in-group g)) - marks)) - (push (cons g unreads) all-unreads) - (push (cons g marks) all-marks) - ;; count groups, total #articles, and max size - (setq size (- max min -1)) - (setq cnt (1+ cnt) - tot (+ tot size) - M (max M size)))) - nnvirtual-component-groups) - - ;; Number of articles in the virtual group. - (setq nnvirtual-mapping-len tot) - - - ;; We want the actives list sorted by size, to build the tables. - (setq actives (sort actives (lambda (g1 g2) (< (nth 1 g1) (nth 1 g2))))) - - ;; Build the offset table. Largest sized groups are at the front. - (setq nnvirtual-mapping-offsets - (vconcat - (nreverse - (mapcar (lambda (entry) - (cons (nth 0 entry) - (- (nth 2 entry) M))) - actives)))) - - ;; Build the mapping table. - (setq nnvirtual-mapping-table nil) - (setq actives (mapcar (lambda (entry) (nth 1 entry)) actives)) - (while actives - (setq size (car actives)) - (setq next-M (- M size)) - (setq next-tot (- tot (* cnt size))) - ;; make current row in table - (push (vector M next-M cnt tot (- next-tot cnt)) - nnvirtual-mapping-table) - ;; update M and tot - (setq M next-M) - (setq tot next-tot) - ;; subtract the current size from all entries. - (setq actives (mapcar (lambda (x) (- x size)) actives)) - ;; remove anything that went to 0. - (while (and actives - (= (car actives) 0)) - (pop actives) - (setq cnt (- cnt 1)))) - - - ;; Now that the mapping tables are generated, we can convert - ;; and combine the separate component unreads and marks lists - ;; into single lists of virtual article numbers. - (setq unreads (apply 'nnvirtual-merge-sorted-lists - (mapcar (lambda (x) - (nnvirtual-reverse-map-sequence - (car x) (cdr x))) - all-unreads))) - (setq marks (mapcar - (lambda (type) - (cons (cdr type) - (gnus-compress-sequence - (apply - 'nnvirtual-merge-sorted-lists - (mapcar (lambda (x) - (nnvirtual-reverse-map-sequence - (car x) - (cdr (assq (cdr type) (cdr x))))) - all-marks))))) - gnus-article-mark-lists)) - - ;; Remove any empty marks lists, and store. - (setq nnvirtual-mapping-marks (delete-if-not 'cdr marks)) - - ;; We need to convert the unreads to reads. We compress the - ;; sequence as we go, otherwise it could be huge. - (while (and (<= (incf i) nnvirtual-mapping-len) - unreads) - (if (= i (car unreads)) - (setq unreads (cdr unreads)) - ;; try to get a range. - (setq beg i) - (while (and (<= (incf i) nnvirtual-mapping-len) - (not (= i (car unreads))))) - (setq i (- i 1)) - (if (= i beg) - (push i reads) - (push (cons beg i) reads)) - )) - (when (<= i nnvirtual-mapping-len) - (if (= i nnvirtual-mapping-len) - (push i reads) - (push (cons i nnvirtual-mapping-len) reads))) - - ;; Store the reads list for later use. - (setq nnvirtual-mapping-reads (nreverse reads)) - - ;; Throw flag to show we changed the info. - (setq nnvirtual-info-installed nil) - )) - -(provide 'nnvirtual) - -;;; nnvirtual.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/nnweb.el --- a/lisp/gnus/nnweb.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,691 +0,0 @@ -;;; nnweb.el --- retrieving articles via web search engines -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; 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 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Note: You need to have `url' and `w3' installed for this -;; backend to work. - -;;; Code: - -(require 'nnoo) -(require 'message) -(require 'gnus-util) -(require 'gnus) -(require 'w3) -(require 'url) -(require 'nnmail) -(ignore-errors - (require 'w3-forms)) - -(nnoo-declare nnweb) - -(defvoo nnweb-directory (nnheader-concat gnus-directory "nnweb/") - "Where nnweb will save its files.") - -(defvoo nnweb-type 'dejanews - "What search engine type is being used.") - -(defvar nnweb-type-definition - '((dejanews - (article . nnweb-dejanews-wash-article) - (map . nnweb-dejanews-create-mapping) - (search . nnweb-dejanews-search) - (address . "http://xp9.dejanews.com/dnquery.xp") - (identifier . nnweb-dejanews-identity)) - (reference - (article . nnweb-reference-wash-article) - (map . nnweb-reference-create-mapping) - (search . nnweb-reference-search) - (address . "http://www.reference.com/cgi-bin/pn/go") - (identifier . identity)) - (altavista - (article . nnweb-altavista-wash-article) - (map . nnweb-altavista-create-mapping) - (search . nnweb-altavista-search) - (address . "http://www.altavista.digital.com/cgi-bin/query") - (id . "/cgi-bin/news?id@%s") - (identifier . identity))) - "Type-definition alist.") - -(defvoo nnweb-search nil - "Search string to feed to DejaNews.") - -(defvoo nnweb-max-hits 100 - "Maximum number of hits to display.") - -(defvoo nnweb-ephemeral-p nil - "Whether this nnweb server is ephemeral.") - -;;; Internal variables - -(defvoo nnweb-articles nil) -(defvoo nnweb-buffer nil) -(defvoo nnweb-group-alist nil) -(defvoo nnweb-group nil) -(defvoo nnweb-hashtb nil) - -;;; Interface functions - -(nnoo-define-basics nnweb) - -(deffoo nnweb-retrieve-headers (articles &optional group server fetch-old) - (nnweb-possibly-change-server group server) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let (article header) - (while (setq article (pop articles)) - (when (setq header (cadr (assq article nnweb-articles))) - (nnheader-insert-nov header))) - 'nov))) - -(deffoo nnweb-request-scan (&optional group server) - (nnweb-possibly-change-server group server) - (setq nnweb-hashtb (gnus-make-hashtable 4095)) - (funcall (nnweb-definition 'map)) - (unless nnweb-ephemeral-p - (nnweb-write-active) - (nnweb-write-overview group))) - -(deffoo nnweb-request-group (group &optional server dont-check) - (nnweb-possibly-change-server nil server) - (when (and group - (not (equal group nnweb-group)) - (not nnweb-ephemeral-p)) - (let ((info (assoc group nnweb-group-alist))) - (setq nnweb-group group) - (setq nnweb-type (nth 2 info)) - (setq nnweb-search (nth 3 info)) - (unless dont-check - (nnweb-read-overview group)))) - (cond - ((not nnweb-articles) - (nnheader-report 'nnweb "No matching articles")) - (t - (let ((active (if nnweb-ephemeral-p - (cons (caar nnweb-articles) - (caar (last nnweb-articles))) - (cadr (assoc group nnweb-group-alist))))) - (nnheader-report 'nnweb "Opened group %s" group) - (nnheader-insert - "211 %d %d %d %s\n" (length nnweb-articles) - (car active) (cdr active) group))))) - -(deffoo nnweb-close-group (group &optional server) - (nnweb-possibly-change-server group server) - (when (gnus-buffer-live-p nnweb-buffer) - (save-excursion - (set-buffer nnweb-buffer) - (set-buffer-modified-p nil) - (kill-buffer nnweb-buffer))) - t) - -(deffoo nnweb-request-article (article &optional group server buffer) - (nnweb-possibly-change-server group server) - (save-excursion - (set-buffer (or buffer nntp-server-buffer)) - (let* ((header (cadr (assq article nnweb-articles))) - (url (and header (mail-header-xref header)))) - (when (or (and url - (nnweb-fetch-url url)) - (and (stringp article) - (nnweb-definition 'id t) - (let ((fetch (nnweb-definition 'id)) - art) - (when (string-match "^<\\(.*\\)>$" article) - (setq art (match-string 1 article))) - (and fetch - art - (nnweb-fetch-url - (format fetch article)))))) - (unless nnheader-callback-function - (funcall (nnweb-definition 'article)) - (nnweb-decode-entities)) - (nnheader-report 'nnweb "Fetched article %s" article) - t)))) - -(deffoo nnweb-close-server (&optional server) - (when (and (nnweb-server-opened server) - (gnus-buffer-live-p nnweb-buffer)) - (save-excursion - (set-buffer nnweb-buffer) - (set-buffer-modified-p nil) - (kill-buffer nnweb-buffer))) - (nnoo-close-server 'nnweb server)) - -(deffoo nnweb-request-list (&optional server) - (nnweb-possibly-change-server nil server) - (save-excursion - (set-buffer nntp-server-buffer) - (nnmail-generate-active nnweb-group-alist) - t)) - -(deffoo nnweb-request-update-info (group info &optional server) - (nnweb-possibly-change-server group server) - ;;(setcar (cddr info) nil) - ) - -(deffoo nnweb-asynchronous-p () - t) - -(deffoo nnweb-request-create-group (group &optional server args) - (nnweb-possibly-change-server nil server) - (nnweb-request-delete-group group) - (push `(,group ,(cons 1 0) ,@args) nnweb-group-alist) - (nnweb-write-active) - t) - -(deffoo nnweb-request-delete-group (group &optional force server) - (nnweb-possibly-change-server group server) - (gnus-delete-assoc group nnweb-group-alist) - (gnus-delete-file (nnweb-overview-file group)) - t) - -(nnoo-define-skeleton nnweb) - -;;; Internal functions - -(defun nnweb-read-overview (group) - "Read the overview of GROUP and build the map." - (when (file-exists-p (nnweb-overview-file group)) - (nnheader-temp-write nil - (nnheader-insert-file-contents (nnweb-overview-file group)) - (goto-char (point-min)) - (let (header) - (while (not (eobp)) - (setq header (nnheader-parse-nov)) - (forward-line 1) - (push (list (mail-header-number header) - header (mail-header-xref header)) - nnweb-articles) - (nnweb-set-hashtb header (car nnweb-articles))))))) - -(defun nnweb-write-overview (group) - "Write the overview file for GROUP." - (nnheader-temp-write (nnweb-overview-file group) - (let ((articles nnweb-articles)) - (while articles - (nnheader-insert-nov (cadr (pop articles))))))) - -(defun nnweb-set-hashtb (header data) - (gnus-sethash (nnweb-identifier (mail-header-xref header)) - data nnweb-hashtb)) - -(defun nnweb-get-hashtb (url) - (gnus-gethash (nnweb-identifier url) nnweb-hashtb)) - -(defun nnweb-identifier (ident) - (funcall (nnweb-definition 'identifier) ident)) - -(defun nnweb-overview-file (group) - "Return the name of the overview file of GROUP." - (nnheader-concat nnweb-directory group ".overview")) - -(defun nnweb-write-active () - "Save the active file." - (nnheader-temp-write (nnheader-concat nnweb-directory "active") - (prin1 `(setq nnweb-group-alist ',nnweb-group-alist) (current-buffer)))) - -(defun nnweb-read-active () - "Read the active file." - (load (nnheader-concat nnweb-directory "active") t t t)) - -(defun nnweb-definition (type &optional noerror) - "Return the definition of TYPE." - (let ((def (cdr (assq type (assq nnweb-type nnweb-type-definition))))) - (when (and (not def) - (not noerror)) - (error "Undefined definition %s" type)) - def)) - -(defun nnweb-possibly-change-server (&optional group server) - (nnweb-init server) - (when server - (unless (nnweb-server-opened server) - (nnweb-open-server server))) - (unless nnweb-group-alist - (nnweb-read-active)) - (when group - (when (and (not nnweb-ephemeral-p) - (not (equal group nnweb-group))) - (nnweb-request-group group nil t)))) - -(defun nnweb-init (server) - "Initialize buffers and such." - (unless (gnus-buffer-live-p nnweb-buffer) - (setq nnweb-buffer - (save-excursion - (nnheader-set-temp-buffer - (format " *nnweb %s %s %s*" nnweb-type nnweb-search server)))))) - -(defun nnweb-fetch-url (url) - (save-excursion - (if (not nnheader-callback-function) - (let ((buf (current-buffer))) - (save-excursion - (set-buffer nnweb-buffer) - (erase-buffer) - (url-insert-file-contents url) - (copy-to-buffer buf (point-min) (point-max)) - t)) - (nnweb-url-retrieve-asynch - url 'nnweb-callback (current-buffer) nnheader-callback-function) - t))) - -(defun nnweb-callback (buffer callback) - (when (gnus-buffer-live-p url-working-buffer) - (save-excursion - (set-buffer url-working-buffer) - (funcall (nnweb-definition 'article)) - (nnweb-decode-entities) - (set-buffer buffer) - (goto-char (point-max)) - (insert-buffer-substring url-working-buffer)) - (funcall callback t) - (gnus-kill-buffer url-working-buffer))) - -(defun nnweb-url-retrieve-asynch (url callback &rest data) - (let ((url-request-method "GET") - (old-asynch url-be-asynchronous) - (url-request-data nil) - (url-request-extra-headers nil) - (url-working-buffer (generate-new-buffer-name " *nnweb*"))) - (setq-default url-be-asynchronous t) - (save-excursion - (set-buffer (get-buffer-create url-working-buffer)) - (setq url-current-callback-data data - url-be-asynchronous t - url-current-callback-func callback) - (url-retrieve url)) - (setq-default url-be-asynchronous old-asynch))) - -(defun nnweb-encode-www-form-urlencoded (pairs) - "Return PAIRS encoded for forms." - (mapconcat - (function - (lambda (data) - (concat (w3-form-encode-xwfu (car data)) "=" - (w3-form-encode-xwfu (cdr data))))) - pairs "&")) - -(defun nnweb-fetch-form (url pairs) - (let ((url-request-data (nnweb-encode-www-form-urlencoded pairs)) - (url-request-method "POST") - (url-request-extra-headers - '(("Content-type" . "application/x-www-form-urlencoded")))) - (url-insert-file-contents url) - (setq buffer-file-name nil)) - t) - -(defun nnweb-decode-entities () - (goto-char (point-min)) - (while (re-search-forward "&\\([a-z]+\\);" nil t) - (replace-match (char-to-string (or (cdr (assq (intern (match-string 1)) - w3-html-entities)) - ?#)) - t t))) - -(defun nnweb-remove-markup () - (goto-char (point-min)) - (while (search-forward "" nil t) - (point-max)))) - (goto-char (point-min)) - (while (re-search-forward "<[^>]+>" nil t) - (replace-match "" t t))) - -;;; -;;; DejaNews functions. -;;; - -(defun nnweb-dejanews-create-mapping () - "Perform the search and create an number-to-url alist." - (save-excursion - (set-buffer nnweb-buffer) - (erase-buffer) - (when (funcall (nnweb-definition 'search) nnweb-search) - (let ((i 0) - (more t) - (case-fold-search t) - (active (or (cadr (assoc nnweb-group nnweb-group-alist)) - (cons 1 0))) - Subject Score Date Newsgroup Author - map url) - (while more - ;; Go through all the article hits on this page. - (goto-char (point-min)) - (nnweb-decode-entities) - (goto-char (point-min)) - (while (re-search-forward "^ +[0-9]+\\." nil t) - (narrow-to-region - (point) - (cond ((re-search-forward "^ +[0-9]+\\." nil t) - (match-beginning 0)) - ((search-forward "\n\n" nil t) - (point)) - (t - (point-max)))) - (goto-char (point-min)) - (when (looking-at ".*HREF=\"\\([^\"]+\\)\"") - (setq url (match-string 1))) - (nnweb-remove-markup) - (goto-char (point-min)) - (while (search-forward "\t" nil t) - (replace-match " ")) - (goto-char (point-min)) - (while (re-search-forward "^ +\\([^:]+\\): +\\(.*\\)$" nil t) - (set (intern (match-string 1)) (match-string 2))) - (widen) - (when (string-match "#[0-9]+/[0-9]+ *$" Subject) - (setq Subject (substring Subject 0 (match-beginning 0)))) - (incf i) - (unless (nnweb-get-hashtb url) - (push - (list - (incf (cdr active)) - (make-full-mail-header - (cdr active) (concat "(" Newsgroup ") " Subject) Author Date - (concat "<" (nnweb-identifier url) "@dejanews>") - nil 0 (string-to-int Score) url)) - map) - (nnweb-set-hashtb (cadar map) (car map)))) - ;; See whether there is a "Get next 20 hits" button here. - (if (or (not (re-search-forward - "HREF=\"\\([^\"]+\\)\">Get next" nil t)) - (>= i nnweb-max-hits)) - (setq more nil) - ;; Yup -- fetch it. - (setq more (match-string 1)) - (erase-buffer) - (url-insert-file-contents more))) - ;; Return the articles in the right order. - (setq nnweb-articles - (sort (nconc nnweb-articles map) - (lambda (s1 s2) (< (car s1) (car s2))))))))) - -(defun nnweb-dejanews-wash-article () - (let ((case-fold-search t)) - (goto-char (point-min)) - (re-search-forward "
" nil t)
-    (delete-region (point-min) (point))
-    (re-search-forward "
" nil t) - (delete-region (point) (point-max)) - (nnweb-remove-markup) - (goto-char (point-min)) - (while (and (looking-at " *$") - (not (eobp))) - (gnus-delete-line)) - (while (looking-at "\\(^[^ ]+:\\) *") - (replace-match "\\1 " t) - (forward-line 1)) - (when (re-search-forward "\n\n+" nil t) - (replace-match "\n" t t)) - (goto-char (point-min)) - (when (search-forward "[More Headers]" nil t) - (replace-match "" t t)))) - -(defun nnweb-dejanews-search (search) - (nnweb-fetch-form - (nnweb-definition 'address) - `(("query" . ,search) - ("defaultOp" . "AND") - ("svcclass" . "dncurrent") - ("maxhits" . "100") - ("format" . "verbose") - ("threaded" . "0") - ("showsort" . "score") - ("agesign" . "1") - ("ageweight" . "1"))) - t) - -(defun nnweb-dejanews-identity (url) - "Return an unique identifier based on URL." - (if (string-match "recnum=\\([0-9]+\\)" url) - (match-string 1 url) - url)) - -;;; -;;; InReference -;;; - -(defun nnweb-reference-create-mapping () - "Perform the search and create an number-to-url alist." - (save-excursion - (set-buffer nnweb-buffer) - (erase-buffer) - (when (funcall (nnweb-definition 'search) nnweb-search) - (let ((i 0) - (more t) - (case-fold-search t) - (active (or (cadr (assoc nnweb-group nnweb-group-alist)) - (cons 1 0))) - Subject Score Date Newsgroups From Message-ID - map url) - (while more - ;; Go through all the article hits on this page. - (goto-char (point-min)) - (search-forward "
" nil t) - (delete-region (point-min) (point)) - ;(nnweb-decode-entities) - (goto-char (point-min)) - (while (re-search-forward "^ +[0-9]+\\." nil t) - (narrow-to-region - (point) - (if (re-search-forward "^$" nil t) - (match-beginning 0) - (point-max))) - (goto-char (point-min)) - (when (looking-at ".*href=\"\\([^\"]+\\)\"") - (setq url (match-string 1))) - (nnweb-remove-markup) - (goto-char (point-min)) - (while (search-forward "\t" nil t) - (replace-match " ")) - (goto-char (point-min)) - (while (re-search-forward "^\\([^:]+\\): \\(.*\\)$" nil t) - (set (intern (match-string 1)) (match-string 2))) - (widen) - (search-forward "" nil t) - (incf i) - (unless (nnweb-get-hashtb url) - (push - (list - (incf (cdr active)) - (make-full-mail-header - (cdr active) (concat "(" Newsgroups ") " Subject) From Date - Message-ID - nil 0 (string-to-int Score) url)) - map) - (nnweb-set-hashtb (cadar map) (car map)))) - (setq more nil)) - ;; Return the articles in the right order. - (setq nnweb-articles - (sort (nconc nnweb-articles map) - (lambda (s1 s2) (< (car s1) (car s2))))))))) - -(defun nnweb-reference-wash-article () - (let ((case-fold-search t)) - (goto-char (point-min)) - (re-search-forward "^
" nil t) - (delete-region (point-min) (point)) - (search-forward "
" nil t)
-    (forward-line -1)
-    (let ((body (point-marker)))
-      (search-forward "
" nil t) - (delete-region (point) (point-max)) - (nnweb-remove-markup) - (goto-char (point-min)) - (while (looking-at " *$") - (gnus-delete-line)) - (narrow-to-region (point-min) body) - (while (and (re-search-forward "^$" nil t) - (not (eobp))) - (gnus-delete-line)) - (goto-char (point-min)) - (while (looking-at "\\(^[^ ]+:\\) *") - (replace-match "\\1 " t) - (forward-line 1)) - (goto-char (point-min)) - (when (re-search-forward "^References:" nil t) - (narrow-to-region - (point) (if (re-search-forward "^$\\|^[^:]+:" nil t) - (match-beginning 0) - (point-max))) - (goto-char (point-min)) - (while (not (eobp)) - (unless (looking-at "References") - (insert "\t") - (forward-line 1))) - (goto-char (point-min)) - (while (search-forward "," nil t) - (replace-match " " t t))) - (widen) - (set-marker body nil)))) - -(defun nnweb-reference-search (search) - (url-insert-file-contents - (concat - (nnweb-definition 'address) - "?" - (nnweb-encode-www-form-urlencoded - `(("search" . "advanced") - ("querytext" . ,search) - ("subj" . "") - ("name" . "") - ("login" . "") - ("host" . "") - ("organization" . "") - ("groups" . "") - ("keywords" . "") - ("choice" . "Search") - ("startmonth" . "Jul") - ("startday" . "25") - ("startyear" . "1996") - ("endmonth" . "Aug") - ("endday" . "24") - ("endyear" . "1996") - ("mode" . "Quick") - ("verbosity" . "Verbose") - ("ranking" . "Relevance") - ("first" . "1") - ("last" . "25") - ("score" . "50"))))) - (setq buffer-file-name nil) - t) - -;;; -;;; Alta Vista -;;; - -(defun nnweb-altavista-create-mapping () - "Perform the search and create an number-to-url alist." - (save-excursion - (set-buffer nnweb-buffer) - (erase-buffer) - (let ((part 0)) - (when (funcall (nnweb-definition 'search) nnweb-search part) - (let ((i 0) - (more t) - (case-fold-search t) - (active (or (cadr (assoc nnweb-group nnweb-group-alist)) - (cons 1 0))) - subject date from id group - map url) - (while more - ;; Go through all the article hits on this page. - (goto-char (point-min)) - (search-forward "
" nil t) - (delete-region (point-min) (match-beginning 0)) - (goto-char (point-min)) - (while (search-forward "
" nil t) - (replace-match "\n")) - (nnweb-decode-entities) - (goto-char (point-min)) - (while (re-search-forward ".*href=\"\\([^\"]+\\)\">\\([^>]*\\)
\\([^-]+\\)- \\([^<]+\\)<.*href=\"news:\\([^\"]+\\)\">.*\">\\(.+\\)

" - nil t) - (setq url (match-string 1) - subject (match-string 2) - date (match-string 3) - group (match-string 4) - id (concat "<" (match-string 5) ">") - from (match-string 6)) - (incf i) - (unless (nnweb-get-hashtb url) - (push - (list - (incf (cdr active)) - (make-full-mail-header - (cdr active) (concat "(" group ") " subject) from date - id nil 0 0 url)) - map) - (nnweb-set-hashtb (cadar map) (car map)))) - ;; See if we want more. - (when (or (not nnweb-articles) - (>= i nnweb-max-hits) - (not (funcall (nnweb-definition 'search) - nnweb-search (incf part)))) - (setq more nil))) - ;; Return the articles in the right order. - (setq nnweb-articles - (sort (nconc nnweb-articles map) - (lambda (s1 s2) (< (car s1) (car s2)))))))))) - -(defun nnweb-altavista-wash-article () - (goto-char (point-min)) - (let ((case-fold-search t)) - (when (re-search-forward "^" nil t) - (delete-region (point-min) (match-beginning 0))) - (goto-char (point-min)) - (while (looking-at "\\([^ ]+\\) + +\\(.*\\)$") - (replace-match "\\1: \\2" t) - (forward-line 1)) - (when (re-search-backward "^References:" nil t) - (narrow-to-region (point) (progn (forward-line 1) (point))) - (goto-char (point-min)) - (while (re-search-forward "[0-9]+" nil t) - (replace-match "<\\1> " t))) - (widen) - (nnweb-remove-markup))) - -(defun nnweb-altavista-search (search &optional part) - (url-insert-file-contents - (concat - (nnweb-definition 'address) - "?" - (nnweb-encode-www-form-urlencoded - `(("pg" . "aq") - ("what" . "news") - ,@(when part `(("stq" . ,(int-to-string (* part 30))))) - ("fmt" . "d") - ("q" . ,search) - ("r" . "") - ("d0" . "") - ("d1" . ""))))) - (setq buffer-file-name nil) - t) - -(provide 'nnweb) - -;;; nnweb.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/parse-time.el --- a/lisp/gnus/parse-time.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,199 +0,0 @@ -;;; parse-time.el --- Parsing time strings - -;; Copyright (C) 1996 by Free Software Foundation, Inc. - -;; Author: Erik Naggum -;; Keywords: util - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; With the introduction of the `encode-time', `decode-time', and -;; `format-time-string' functions, dealing with time became simpler in -;; Emacs. However, parsing time strings is still largely a matter of -;; heuristics and no common interface has been designed. - -;; `parse-time-string' parses a time in a string and returns a list of 9 -;; values, just like `decode-time', where unspecified elements in the -;; string are returned as nil. `encode-time' may be applied on these -;; valuse to obtain an internal time value. - -;;; Code: - -(require 'cl) ;and ah ain't kiddin' 'bout it - -(put 'parse-time-syntax 'char-table-extra-slots 0) - -(defvar parse-time-syntax (make-char-table 'parse-time-syntax)) -(defvar parse-time-digits (make-char-table 'parse-time-syntax)) - -;; Byte-compiler warnings -(defvar elt) -(defvar val) - -(unless (aref parse-time-digits ?0) - (loop for i from ?0 to ?9 - do (set-char-table-range parse-time-digits i (- i ?0)))) - -(unless (aref parse-time-syntax ?0) - (loop for i from ?0 to ?9 - do (set-char-table-range parse-time-syntax i ?0)) - (loop for i from ?A to ?Z - do (set-char-table-range parse-time-syntax i ?A)) - (loop for i from ?a to ?z - do (set-char-table-range parse-time-syntax i ?a)) - (set-char-table-range parse-time-syntax ?+ 1) - (set-char-table-range parse-time-syntax ?- -1) - (set-char-table-range parse-time-syntax ?: ?d) - ) - -(defsubst digit-char-p (char) - (aref parse-time-digits char)) - -(defsubst parse-time-string-chars (char) - (aref parse-time-syntax char)) - -(put 'parse-error 'error-conditions '(parse-error error)) -(put 'parse-error 'error-message "Parsing error") - -(defsubst parse-integer (string &optional start end) - "[CL] Parse and return the integer in STRING, or nil if none." - (let ((integer 0) - (digit 0) - (index (or start 0)) - (end (or end (length string)))) - (when (< index end) - (let ((sign (aref string index))) - (if (or (eq sign ?+) (eq sign ?-)) - (setq sign (parse-time-string-chars sign) - index (1+ index)) - (setq sign 1)) - (while (and (< index end) - (setq digit (digit-char-p (aref string index)))) - (setq integer (+ (* integer 10) digit) - index (1+ index))) - (if (/= index end) - (signal 'parse-error `("not an integer" ,(substring string (or start 0) end))) - (* sign integer)))))) - -(defun parse-time-tokenize (string) - "Tokenize STRING into substrings." - (let ((start nil) - (end (length string)) - (all-digits nil) - (list ()) - (index 0) - (c nil)) - (while (< index end) - (while (and (< index end) ;skip invalid characters - (not (setq c (parse-time-string-chars (aref string index))))) - (incf index)) - (setq start index all-digits (eq c ?0)) - (while (and (< (incf index) end) ;scan valid characters - (setq c (parse-time-string-chars (aref string index)))) - (setq all-digits (and all-digits (eq c ?0)))) - (if (<= index end) - (push (if all-digits (parse-integer string start index) - (substring string start index)) - list))) - (nreverse list))) - -(defvar parse-time-months '(("Jan" . 1) ("Feb" . 2) ("Mar" . 3) - ("Apr" . 4) ("May" . 5) ("Jun" . 6) - ("Jul" . 7) ("Aug" . 8) ("Sep" . 9) - ("Oct" . 10) ("Nov" . 11) ("Dec" . 12))) -(defvar parse-time-weekdays '(("Sun" . 0) ("Mon" . 1) ("Tue" . 2) - ("Wed" . 3) ("Thu" . 4) ("Fri" . 5) ("Sat" . 6))) -(defvar parse-time-zoneinfo `(("Z" 0) ("UT" 0) ("GMT" 0) - ("PST" ,(* -8 3600)) ("PDT" ,(* -7 3600) t) - ("MST" ,(* -7 3600)) ("MDT" ,(* -6 3600) t) - ("CST" ,(* -6 3600)) ("CDT" ,(* -5 3600) t) - ("EST" ,(* -5 3600)) ("EDT" ,(* -4 3600) t)) - "(zoneinfo seconds-off daylight-savings-time-p)") - -(defvar parse-time-rules - `(((6) parse-time-weekdays) - ((3) (1 31)) - ((4) parse-time-months) - ((5) (1970 2038)) - ((2 1 0) - ,#'(lambda () (and (stringp elt) - (= (length elt) 8) - (= (aref elt 2) ?:) - (= (aref elt 5) ?:))) - [0 2] [3 5] [6 8]) - ((8 7) parse-time-zoneinfo - ,#'(lambda () (car val)) - ,#'(lambda () (cadr val))) - ((8) - ,#'(lambda () - (and (stringp elt) - (= 5 (length elt)) - (or (= (aref elt 0) ?+) (= (aref elt 0) ?-)))) - ,#'(lambda () (* 60 (+ (parse-integer elt 3 5) - (* 60 (parse-integer elt 1 3))) - (if (= (aref elt 0) ?-) -1 1)))) - ((5 4 3) - ,#'(lambda () (and (stringp elt) (= (length elt) 10) (= (aref elt 4) ?-) (= (aref elt 7) ?-))) - [0 4] [5 7] [8 10]) - ((2 1) - ,#'(lambda () (and (stringp elt) (= (length elt) 5) (= (aref elt 2) ?:))) - [0 2] [3 5]) - ((5) (70 99) ,#'(lambda () (+ 1900 elt)))) - "(slots predicate extractor...)") - -(defun parse-time-string (string) - "Parse the time-string STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ). -The values are identical to those of `decode-time', but any values that are -unknown are returned as nil." - (let ((time (list nil nil nil nil nil nil nil nil nil nil)) - (temp (parse-time-tokenize string))) - (while temp - (let ((elt (pop temp)) - (rules parse-time-rules) - (exit nil)) - (while (and (not (null rules)) (not exit)) - (let* ((rule (pop rules)) - (slots (pop rule)) - (predicate (pop rule)) - (val)) - (if (and (not (nth (car slots) time)) ;not already set - (setq val (cond ((and (consp predicate) - (not (eq (car predicate) 'lambda))) - (and (numberp elt) - (<= (car predicate) elt) - (<= elt (cadr predicate)) - elt)) - ((symbolp predicate) - (cdr (assoc elt (symbol-value predicate)))) - ((funcall predicate))))) - (progn - (setq exit t) - (while slots - (let ((new-val (and rule - (let ((this (pop rule))) - (if (vectorp this) - (parse-integer elt (aref this 0) (aref this 1)) - (funcall this)))))) - (rplaca (nthcdr (pop slots) time) (or new-val val)))))))))) - time)) - -(provide 'parse-time) - -;;; parse-time.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/pop3.el --- a/lisp/gnus/pop3.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,443 +0,0 @@ -;;; pop3.el --- Post Office Protocol (RFC 1460) interface - -;; Copyright (C) 1996, Free Software Foundation, Inc. - -;; Author: Richard L. Pieri -;; Keywords: mail, pop3 -;; Version: 1.3e - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; Most of the standard Post Office Protocol version 3 (RFC 1460) commands -;; are implemented. The LIST command has not been implemented due to lack -;; of actual usefulness. -;; The optional POP3 command TOP has not been implemented. - -;; This program was inspired by Kyle E. Jones's vm-pop program. - -;;; Code: - -(require 'mail-utils) -(provide 'pop3) - -(defconst pop3-version "1.3c") - -(defvar pop3-maildrop (or user-login-name (getenv "LOGNAME") (getenv "USER") nil) - "*POP3 maildrop.") -(defvar pop3-mailhost (or (getenv "MAILHOST") nil) - "*POP3 mailhost.") -(defvar pop3-port 110 - "*POP3 port.") - -(defvar pop3-password-required t - "*Non-nil if a password is required when connecting to POP server.") -(defvar pop3-password nil - "*Password to use when connecting to POP server.") - -(defvar pop3-authentication-scheme 'pass - "*POP3 authentication scheme. -Defaults to 'pass, for the standard USER/PASS authentication. Other valid -values are 'apop.") - -(defvar pop3-timestamp nil - "Timestamp returned when initially connected to the POP server. -Used for APOP authentication.") - -(defvar pop3-read-point nil) -(defvar pop3-debug nil) - -(defun pop3-movemail (&optional crashbox) - "Transfer contents of a maildrop to the specified CRASHBOX." - (or crashbox (setq crashbox (expand-file-name "~/.crashbox"))) - (let* ((process (pop3-open-server pop3-mailhost pop3-port)) - (crashbuf (get-buffer-create " *pop3-retr*")) - (n 1) - message-count) - ;; for debugging only - (if pop3-debug (switch-to-buffer (process-buffer process))) - (cond ((equal 'apop pop3-authentication-scheme) - (pop3-apop process pop3-maildrop)) - ((equal 'pass pop3-authentication-scheme) - (pop3-user process pop3-maildrop) - (pop3-pass process)) - (t (error "Invalid POP3 authentication scheme"))) - (setq message-count (car (pop3-stat process))) - (while (<= n message-count) - (message (format "Retrieving message %d of %d from %s..." - n message-count pop3-mailhost)) - (pop3-retr process n crashbuf) - (save-excursion - (set-buffer crashbuf) - (append-to-file (point-min) (point-max) crashbox) - (set-buffer (process-buffer process)) - (while (> (buffer-size) 5000) - (goto-char (point-min)) - (forward-line 50) - (delete-region (point-min) (point)))) - (pop3-dele process n) - (setq n (+ 1 n)) - (if pop3-debug (sit-for 1) (sit-for 0.1)) - ) - (pop3-quit process) - (kill-buffer crashbuf) - ) - ) - -(defun pop3-open-server (mailhost port) - "Open TCP connection to MAILHOST. -Returns the process associated with the connection." - (let ((process-buffer - (get-buffer-create (format "trace of POP session to %s" mailhost))) - (process)) - (save-excursion - (set-buffer process-buffer) - (erase-buffer)) - (setq process - (open-network-stream "POP" process-buffer mailhost port)) - (setq pop3-read-point (point-min)) - (let ((response (pop3-read-response process t))) - (setq pop3-timestamp - (substring response (or (string-match "<" response) 0) - (+ 1 (or (string-match ">" response) -1))))) - process - )) - -;; Support functions - -(defun pop3-process-filter (process output) - (save-excursion - (set-buffer (process-buffer process)) - (goto-char (point-max)) - (insert output))) - -(defun pop3-send-command (process command) - (set-buffer (process-buffer process)) - (goto-char (point-max)) -;; (if (= (aref command 0) ?P) -;; (insert "PASS \r\n") -;; (insert command "\r\n")) - (setq pop3-read-point (point)) - (goto-char (point-max)) - (process-send-string process command) - (process-send-string process "\r\n") - ) - -(defun pop3-read-response (process &optional return) - "Read the response from the server. -Return the response string if optional second argument is non-nil." - (let ((case-fold-search nil) - match-end) - (save-excursion - (set-buffer (process-buffer process)) - (goto-char pop3-read-point) - (while (not (search-forward "\r\n" nil t)) - (accept-process-output process 3) - (goto-char pop3-read-point)) - (setq match-end (point)) - (goto-char pop3-read-point) - (if (looking-at "-ERR") - (error (buffer-substring (point) (- match-end 2))) - (if (not (looking-at "+OK")) - (progn (setq pop3-read-point match-end) nil) - (setq pop3-read-point match-end) - (if return - (buffer-substring (point) match-end) - t) - ))))) - -(defun pop3-string-to-list (string &optional regexp) - "Chop up a string into a list." - (let ((list) - (regexp (or regexp " ")) - (string (if (string-match "\r" string) - (substring string 0 (match-beginning 0)) - string))) - (store-match-data nil) - (while string - (if (string-match regexp string) - (setq list (cons (substring string 0 (- (match-end 0) 1)) list) - string (substring string (match-end 0))) - (setq list (cons string list) - string nil))) - (nreverse list))) - -(defvar pop3-read-passwd nil) -(defun pop3-read-passwd (prompt) - (if (not pop3-read-passwd) - (if (load "passwd" t) - (setq pop3-read-passwd 'read-passwd) - (autoload 'ange-ftp-read-passwd "ange-ftp") - (setq pop3-read-passwd 'ange-ftp-read-passwd))) - (funcall pop3-read-passwd prompt)) - -(defun pop3-clean-region (start end) - (setq end (set-marker (make-marker) end)) - (save-excursion - (goto-char start) - (while (and (< (point) end) (search-forward "\r\n" end t)) - (replace-match "\n" t t)) - (goto-char start) - (while (and (< (point) end) (re-search-forward "^\\." end t)) - (replace-match "" t t) - (forward-char))) - (set-marker end nil)) - -(defun pop3-munge-message-separator (start end) - "Check to see if a message separator exists. If not, generate one." - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (if (not (or (looking-at "From .?") ; Unix mail - (looking-at "\001\001\001\001\n") ; MMDF - (looking-at "BABYL OPTIONS:") ; Babyl - )) - (let ((from (mail-strip-quoted-names (mail-fetch-field "From"))) - (date (pop3-string-to-list (mail-fetch-field "Date"))) - (From_)) - ;; sample date formats I have seen - ;; Date: Tue, 9 Jul 1996 09:04:21 -0400 (EDT) - ;; Date: 08 Jul 1996 23:22:24 -0400 - ;; should be - ;; Tue Jul 9 09:04:21 1996 - (setq date - (cond ((string-match "[A-Z]" (nth 0 date)) - (format "%s %s %s %s %s" - (nth 0 date) (nth 2 date) (nth 1 date) - (nth 4 date) (nth 3 date))) - (t - ;; this really needs to be better but I don't feel - ;; like writing a date to day converter. - (format "Sun %s %s %s %s" - (nth 1 date) (nth 0 date) - (nth 3 date) (nth 2 date))) - )) - (setq From_ (format "\nFrom %s %s\n" from date)) - (while (string-match "," From_) - (setq From_ (concat (substring From_ 0 (match-beginning 0)) - (substring From_ (match-end 0))))) - (goto-char (point-min)) - (insert From_)))))) - -;; The Command Set - -;; AUTHORIZATION STATE - -(defun pop3-user (process user) - "Send USER information to POP3 server." - (pop3-send-command process (format "USER %s" user)) - (let ((response (pop3-read-response process t))) - (if (not (and response (string-match "+OK" response))) - (error (format "USER %s not valid." user))))) - -(defun pop3-pass (process) - "Send authentication information to the server." - (let ((pass pop3-password)) - (if (and pop3-password-required (not pass)) - (setq pass - (pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) - (if pass - (progn - (pop3-send-command process (format "PASS %s" pass)) - (let ((response (pop3-read-response process t))) - (if (not (and response (string-match "+OK" response))) - (pop3-quit process))))) - )) - -(defun pop3-apop (process user) - "Send alternate authentication information to the server." - (if (not (fboundp 'md5)) (autoload 'md5 "md5")) - (let ((pass pop3-password)) - (if (and pop3-password-required (not pass)) - (setq pass - (pop3-read-passwd (format "Password for %s: " pop3-maildrop)))) - (if pass - (let ((hash (md5 (concat pop3-timestamp pass)))) - (pop3-send-command process (format "APOP %s %s" user hash)) - (let ((response (pop3-read-response process t))) - (if (not (and response (string-match "+OK" response))) - (pop3-quit process))))) - )) - -;; TRANSACTION STATE - -(defun pop3-stat (process) - "Return the number of messages in the maildrop and the maildrop's size." - (pop3-send-command process "STAT") - (let ((response (pop3-read-response process t))) - (list (string-to-int (nth 1 (pop3-string-to-list response))) - (string-to-int (nth 2 (pop3-string-to-list response)))) - )) - -(defun pop3-list (process &optional msg) - "Scan listing of available messages. -This function currently does nothing.") - -(defun pop3-retr (process msg crashbuf) - "Retrieve message-id MSG to buffer CRASHBUF." - (pop3-send-command process (format "RETR %s" msg)) - (pop3-read-response process) - (let ((start pop3-read-point) end) - (save-excursion - (set-buffer (process-buffer process)) - (while (not (re-search-forward "^\\.\r\n" nil t)) - (accept-process-output process 3) - ;; bill@att.com ... to save wear and tear on the heap - (if (> (buffer-size) 20000) (sleep-for 1)) - (if (> (buffer-size) 50000) (sleep-for 1)) - (if (> (buffer-size) 100000) (sleep-for 1)) - (if (> (buffer-size) 200000) (sleep-for 1)) - (if (> (buffer-size) 500000) (sleep-for 1)) - ;; bill@att.com - (goto-char start)) - (setq pop3-read-point (point-marker)) -;; this code does not seem to work for some POP servers... -;; and I cannot figure out why not. -; (goto-char (match-beginning 0)) -; (backward-char 2) -; (if (not (looking-at "\r\n")) -; (insert "\r\n")) -; (re-search-forward "\\.\r\n") - (goto-char (match-beginning 0)) - (setq end (point-marker)) - (pop3-clean-region start end) - (pop3-munge-message-separator start end) - (save-excursion - (set-buffer crashbuf) - (erase-buffer)) - (copy-to-buffer crashbuf start end) - (delete-region start end) - ))) - -(defun pop3-dele (process msg) - "Mark message-id MSG as deleted." - (pop3-send-command process (format "DELE %s" msg)) - (pop3-read-response process)) - -(defun pop3-noop (process msg) - "No-operation." - (pop3-send-command process "NOOP") - (pop3-read-response process)) - -(defun pop3-last (process) - "Return highest accessed message-id number for the session." - (pop3-send-command process "LAST") - (let ((response (pop3-read-response process t))) - (string-to-int (nth 1 (pop3-string-to-list response))) - )) - -(defun pop3-rset (process) - "Remove all delete marks from current maildrop." - (pop3-send-command process "RSET") - (pop3-read-response process)) - -;; UPDATE - -(defun pop3-quit (process) - "Close connection to POP3 server. -Tell server to remove all messages marked as deleted, unlock the maildrop, -and close the connection." - (pop3-send-command process "QUIT") - (pop3-read-response process t) - (if process - (save-excursion - (set-buffer (process-buffer process)) - (goto-char (point-max)) - (delete-process process)))) - -;; Summary of POP3 (Post Office Protocol version 3) commands and responses - -;;; AUTHORIZATION STATE - -;; Initial TCP connection -;; Arguments: none -;; Restrictions: none -;; Possible responses: -;; +OK [POP3 server ready] - -;; USER name -;; Arguments: a server specific user-id (required) -;; Restrictions: authorization state [after unsuccessful USER or PASS -;; Possible responses: -;; +OK [valid user-id] -;; -ERR [invalid user-id] - -;; PASS string -;; Arguments: a server/user-id specific password (required) -;; Restrictions: authorization state, after successful USER -;; Possible responses: -;; +OK [maildrop locked and ready] -;; -ERR [invalid password] -;; -ERR [unable to lock maildrop] - -;;; TRANSACTION STATE - -;; STAT -;; Arguments: none -;; Restrictions: transaction state -;; Possible responses: -;; +OK nn mm [# of messages, size of maildrop] - -;; LIST [msg] -;; Arguments: a message-id (optional) -;; Restrictions: transaction state; msg must not be deleted -;; Possible responses: -;; +OK [scan listing follows] -;; -ERR [no such message] - -;; RETR msg -;; Arguments: a message-id (required) -;; Restrictions: transaction state; msg must not be deleted -;; Possible responses: -;; +OK [message contents follow] -;; -ERR [no such message] - -;; DELE msg -;; Arguments: a message-id (required) -;; Restrictions: transaction state; msg must not be deleted -;; Possible responses: -;; +OK [message deleted] -;; -ERR [no such message] - -;; NOOP -;; Arguments: none -;; Restrictions: transaction state -;; Possible responses: -;; +OK - -;; LAST -;; Arguments: none -;; Restrictions: transaction state -;; Possible responses: -;; +OK nn [highest numbered message accessed] - -;; RSET -;; Arguments: none -;; Restrictions: transaction state -;; Possible responses: -;; +OK [all delete marks removed] - -;;; UPDATE STATE - -;; QUIT -;; Arguments: none -;; Restrictions: none -;; Possible responses: -;; +OK [TCP connection closed] diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/score-mode.el --- a/lisp/gnus/score-mode.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,109 +0,0 @@ -;;; score-mode.el --- mode for editing Gnus score files -;; Copyright (C) 1996 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news, mail - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;;; Code: - -(require 'easymenu) -(require 'timezone) -(eval-when-compile (require 'cl)) - -(defvar gnus-score-mode-hook nil - "*Hook run in score mode buffers.") - -(defvar gnus-score-menu-hook nil - "*Hook run after creating the score mode menu.") - -(defvar gnus-score-edit-exit-function nil - "Function run on exit from the score buffer.") - -(defvar gnus-score-mode-map nil) -(unless gnus-score-mode-map - (setq gnus-score-mode-map (copy-keymap emacs-lisp-mode-map)) - (define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-exit) - (define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date) - (define-key gnus-score-mode-map "\C-c\C-p" 'gnus-score-pretty-print)) - -;;;###autoload -(defun gnus-score-mode () - "Mode for editing Gnus score files. -This mode is an extended emacs-lisp mode. - -\\{gnus-score-mode-map}" - (interactive) - (kill-all-local-variables) - (use-local-map gnus-score-mode-map) - (gnus-score-make-menu-bar) - (set-syntax-table emacs-lisp-mode-syntax-table) - (setq major-mode 'gnus-score-mode) - (setq mode-name "Score") - (lisp-mode-variables nil) - (make-local-variable 'gnus-score-edit-exit-function) - (run-hooks 'emacs-lisp-mode-hook 'gnus-score-mode-hook)) - -(defun gnus-score-make-menu-bar () - (unless (boundp 'gnus-score-menu) - (easy-menu-define - gnus-score-menu gnus-score-mode-map "" - '("Score" - ["Exit" gnus-score-edit-exit t] - ["Insert date" gnus-score-edit-insert-date t] - ["Format" gnus-score-pretty-print t])) - (run-hooks 'gnus-score-menu-hook))) - -(defun gnus-score-edit-insert-date () - "Insert date in numerical format." - (interactive) - (princ (gnus-score-day-number (current-time)) (current-buffer))) - -(defun gnus-score-pretty-print () - "Format the current score file." - (interactive) - (goto-char (point-min)) - (let ((form (read (current-buffer)))) - (erase-buffer) - (pp form (current-buffer))) - (goto-char (point-min))) - -(defun gnus-score-edit-exit () - "Stop editing the score file." - (interactive) - (unless (file-exists-p (file-name-directory (buffer-file-name))) - (make-directory (file-name-directory (buffer-file-name)) t)) - (save-buffer) - (bury-buffer (current-buffer)) - (let ((buf (current-buffer))) - (when gnus-score-edit-exit-function - (funcall gnus-score-edit-exit-function)) - (when (eq buf (current-buffer)) - (switch-to-buffer (other-buffer (current-buffer)))))) - -(defun gnus-score-day-number (time) - (let ((dat (decode-time time))) - (timezone-absolute-from-gregorian - (nth 4 dat) (nth 3 dat) (nth 5 dat)))) - -(provide 'score-mode) - -;;; score-mode.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/gnus/smiley.el --- a/lisp/gnus/smiley.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,272 +0,0 @@ -;;; smiley.el --- displaying smiley faces -;; Copyright (C) 1996,97 Free Software Foundation, Inc. - -;; Author: Wes Hardaker -;; Keywords: fun - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Commentary: - -;; -;; comments go here. -;; - -;;; Test smileys: :-] :-o :-) ;-) :-\ :-| :-d :-P 8-| :-( - -;; To use: -;; (require 'smiley) -;; (add-hook 'gnus-article-display-hook 'gnus-smiley-display t) - -;; The smilies were drawn by Joe Reiss . - -(require 'annotations) -(require 'messagexmas) -(require 'cl) -(require 'custom) - -(defgroup smiley nil - "Turn :-)'s into real images (XEmacs)." - :group 'gnus-visual) - -(defcustom smiley-data-directory (message-xmas-find-glyph-directory "smilies") - "Location of the smiley faces files." - :type 'directory - :group 'smiley) - -;; Notice the subtle differences in the regular expressions in the -;; two alists below. - -(defcustom smiley-deformed-regexp-alist - '(("\\(\\^_?\\^;;;\\)\\W" 1 "WideFaceAse3.xbm") - ("\\(\\^_?\\^;;\\)\\W" 1 "WideFaceAse2.xbm") - ("\\(\\^_?\\^;\\)\\W" 1 "WideFaceAse1.xbm") - ("\\(\\^_?\\^\\)\\W" 1 "WideFaceSmile.xbm") - ("\\(\\;_;\\)\\W" 1 "WideFaceWeep.xbm") - ("\\(\\T_T\\)\\W" 1 "WideFaceWeep.xbm") - ("\\(:-*[<«]+\\)\\W" 1 "FaceAngry.xpm") - ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm") - ("\\(:-*D\\)\\W" 1 "FaceGrinning.xpm") - ("\\(:-*[)>}»]+\\)\\W" 1 "FaceHappy.xpm") - ("\\(:-*[/\\\"]\\)[^/]\\W" 1 "FaceIronic.xpm") - ("\\([8|]-*[|Oo%]\\)\\W" 1 "FaceKOed.xpm") - ("\\([:|]-*#+\\)\\W" 1 "FaceNyah.xpm") - ("\\(:-*[({]+\\)\\W" 1 "FaceSad.xpm") - ("\\(:-*[Oo\*]\\)\\W" 1 "FaceStartled.xpm") - ("\\(:-*|\\)\\W" 1 "FaceStraight.xpm") - ("\\(:-*p\\)\\W" 1 "FaceTalking.xpm") - ("\\(:-*d\\)\\W" 1 "FaceTasty.xpm") - ("\\(;-*[>)}»]+\\)\\W" 1 "FaceWinking.xpm") - ("\\(:-*[Vvµ]\\)\\W" 1 "FaceWry.xpm") - ("\\([:|]-*P\\)\\W" 1 "FaceYukky.xpm")) - "Normal and deformed faces for smilies." - :type '(repeat (list regexp - (integer :tag "Match") - (string :tag "Image"))) - :group 'smiley) - -(defcustom smiley-nosey-regexp-alist - '(("\\(:-+[<«]+\\)\\W" 1 "FaceAngry.xpm") - ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm") - ("\\(:-+D\\)\\W" 1 "FaceGrinning.xpm") - ("\\(:-+[}»]+\\)\\W" 1 "FaceHappy.xpm") - ("\\(:-*)+\\)\\W" 1 "FaceHappy.xpm") - ("\\(:-+[/\\\"]+\\)\\W" 1 "FaceIronic.xpm") - ("\\([8|]-+[|Oo%]\\)\\W" 1 "FaceKOed.xpm") - ("\\([:|]-+#+\\)\\W" 1 "FaceNyah.xpm") - ("\\(:-+[({]+\\)\\W" 1 "FaceSad.xpm") - ("\\(:-+[Oo\*]\\)\\W" 1 "FaceStartled.xpm") - ("\\(:-+|\\)\\W" 1 "FaceStraight.xpm") - ("\\(:-+p\\)\\W" 1 "FaceTalking.xpm") - ("\\(:-+d\\)\\W" 1 "FaceTasty.xpm") - ("\\(;-+[>)}»]+\\)\\W" 1 "FaceWinking.xpm") - ("\\(:-+[Vvµ]\\)\\W" 1 "FaceWry.xpm") - ("\\(][:8B]-[)>]\\)\\W" 1 "FaceDevilish.xpm") - ("\\([:|]-+P\\)\\W" 1 "FaceYukky.xpm")) - "Smileys with noses. These get less false matches." - :type '(repeat (list regexp - (integer :tag "Match") - (string :tag "Image"))) - :group 'smiley) - -(defcustom smiley-regexp-alist smiley-deformed-regexp-alist - "A list of regexps to map smilies to real images. -Defaults to the contents of `smiley-deformed-regexp-alist'. -An alternative is `smiley-nosey-regexp-alist' that matches less -aggressively. -If this is a symbol, take its value." - :type '(radio (variable-item smiley-deformed-regexp-alist) - (variable-item smiley-nosey-regexp-alist) - symbol - (repeat (list regexp - (integer :tag "Match") - (string :tag "Image")))) - :group 'smiley) - -(defcustom smiley-flesh-color "yellow" - "Flesh color." - :type 'string - :group 'smiley) - -(defcustom smiley-features-color "black" - "Features color." - :type 'string - :group 'smiley) - -(defcustom smiley-tongue-color "red" - "Tongue color." - :type 'string - :group 'smiley) - -(defcustom smiley-circle-color "black" - "Circle color." - :type 'string - :group 'smiley) - -(defcustom smiley-mouse-face 'highlight - "Face used for mouse highlighting in the smiley buffer. - -Smiley buttons will be displayed in this face when the cursor is -above them." - :type 'face - :group 'smiley) - - -(defvar smiley-glyph-cache nil) -(defvar smiley-running-xemacs (string-match "XEmacs" emacs-version)) - -(defvar smiley-map (make-sparse-keymap "smiley-keys") - "Keymap to toggle smiley states.") - -(define-key smiley-map [(button2)] 'smiley-toggle-extent) - -(defun smiley-create-glyph (smiley pixmap) - (and - smiley-running-xemacs - (or - (cdr-safe (assoc pixmap smiley-glyph-cache)) - (let* ((xpm-color-symbols - (and (featurep 'xpm) - (append `(("flesh" ,smiley-flesh-color) - ("features" ,smiley-features-color) - ("tongue" ,smiley-tongue-color)) - xpm-color-symbols))) - (glyph (make-glyph - (list - (cons 'x (expand-file-name pixmap smiley-data-directory)) - (cons 'tty smiley))))) - (setq smiley-glyph-cache (cons (cons pixmap glyph) smiley-glyph-cache)) - (set-glyph-face glyph 'default) - glyph)))) - -;;;###autoload -(defun smiley-region (beg end) - "Smilify the region between point and mark." - (interactive "r") - (smiley-buffer (current-buffer) beg end)) - -(defun smiley-toggle-extent (event) - "Toggle smiley at given point" - (interactive "e") - (let* ((ant (event-glyph-extent event)) - (pt (event-closest-point event)) - ext) - (if (annotationp ant) - (when (extentp (setq ext (extent-property ant 'smiley-extent))) - (set-extent-property ext 'invisible nil) - (hide-annotation ant)) - (when pt - (while (setq ext (extent-at pt (event-buffer event) nil ext 'at)) - (when (annotationp (setq ant - (extent-property ext 'smiley-annotation))) - (reveal-annotation ant) - (set-extent-property ext 'invisible t))))))) - -;;;###autoload -(defun smiley-buffer (&optional buffer st nd) - (interactive) - (when (featurep 'x) - (save-excursion - (when buffer - (set-buffer buffer)) - (let ((buffer-read-only nil) - (alist (if (symbolp smiley-regexp-alist) - (symbol-value smiley-regexp-alist) - smiley-regexp-alist)) - entry regexp beg group file) - (goto-char (or st (point-min))) - (setq beg (point)) - ;; loop through alist - (while (setq entry (pop alist)) - (setq regexp (car entry) - group (cadr entry) - file (caddr entry)) - (goto-char beg) - (while (re-search-forward regexp nd t) - (let* ((start (match-beginning group)) - (end (match-end group)) - (glyph (smiley-create-glyph (buffer-substring start end) - file))) - (when glyph - (mapcar 'delete-annotation (annotations-at end)) - (let ((ext (make-extent start end)) - (ant (make-annotation glyph end 'text))) - ;; set text extent params - (set-extent-property ext 'end-open t) - (set-extent-property ext 'start-open t) - (set-extent-property ext 'invisible t) - (set-extent-property ext 'keymap smiley-map) - (set-extent-property ext 'mouse-face smiley-mouse-face) - (set-extent-property ext 'intangible t) - ;; set annotation params - (set-extent-property ant 'mouse-face smiley-mouse-face) - (set-extent-property ant 'keymap smiley-map) - ;; remember each other - (set-extent-property ant 'smiley-extent ext) - (set-extent-property ext 'smiley-annotation ant)) - (when (smiley-end-paren-p start end) - (make-annotation ")" end 'text)) - (goto-char end))))))))) - -(defun smiley-end-paren-p (start end) - "Try to guess whether the current smiley is an end-paren smiley." - (save-excursion - (goto-char start) - (when (and (re-search-backward "[()]" nil t) - (= (following-char) ?\() - (goto-char end) - (or (not (re-search-forward "[()]" nil t)) - (= (char-after (1- (point))) ?\())) - t))) - -(defvar gnus-article-buffer) -;;;###autoload -(defun gnus-smiley-display () - "Display \"smileys\" as small graphical icons." - (interactive) - (save-excursion - (set-buffer gnus-article-buffer) - (goto-char (point-min)) - ;; We skip the headers. - (unless (search-forward "\n\n" nil t) - (goto-char (point-max))) - (smiley-buffer (current-buffer) (point)))) - -(provide 'smiley) - -;;; smiley.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/hm--html-menus/ANNOUNCEMENT --- a/lisp/hm--html-menus/ANNOUNCEMENT Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/hm--html-menus/ANNOUNCEMENT Mon Aug 13 09:51:16 2007 +0200 @@ -1,9 +1,9 @@ Hello, -I've written a new version (5.7) of my html package for the XEmacs +I've written a new version (5.8) of my html package for the XEmacs and the GNU Emacs 19. The name of the package is: - hm--html-menus-5.7.tar.gz + hm--html-menus-5.8.tar.gz With this package it is very easy to write html pages for the World Wide Web (WWW). Eg: In most cases the user gets help to construct a specific @@ -11,37 +11,33 @@ It is also possible to insert links and images by just clicking on its source and destination (drag and drop feature). -The biggest new features compared with release 5.0 are: -- commands to insert all elements, which are used by HTML 3.2. -- a better drag and drop interface to insert links with the mouse -- help feature for the drag and drop commands -- there's now also a default drag and drop table for other modes -- a better interface for inserting template files -- indentation -- better font lock stuff -- a site specific configuration file - (look at the variable hm--html-site-config-file) -- a better syntax table from Bob Weiner -- a lot of bug fixes -- a Texinfo ducomentation -- automatic update of the created, changed and title date is more - flexible -- a visible modified line could be inserted and updated automaticly +The biggest new features compared with release 5.7 are: +- use of the customize package for customization +- the header of the main files should no be 'package finder' compatible +- in the XEmacs a drag and drop mouse pointer will be used + during drag and drop +- the minor mode (hm--html-minor-mode) could now be used in many + other major modes +- better popup menu support for the hm--html-minor-mode in the + Emacs 19 +- the emacs start up options -u, -q, -no-site-file are now + respected +- some bug fixes Read the NEWS file to see news in detail... -You should find hm--html-menus-5.7.tar.gz on the following ftp server: +You should find hm--html-menus-5.8.tar.gz on the following ftp server: sunsite.unc.edu in /pub/Linux/apps/editors/emacs/ ftp.tnt.uni-hannover.de in /pub/editors/xemacs/contrib It may take some time, before the package is copied by the ftp admins from the incoming directories to the above listed directories. -There is also a html documentation about the package. You can find it on: +There is a html documentation about the package. You can find it on: http://www.tnt.uni-hannover.de/~muenkel/software/own/hm--html-menus/overview.html This package provides also a minor mode (hm--html-minor-mode), which -can be used together with another html major mode, like the psgml-html -mode in the XEmacs 19.15. +can be used together with other html major modes, like the psgml-html +mode or other major edit modes, like the perl-mode. The package provides functions to insert the following stuff in html-pages: 1. Anchors: @@ -104,10 +100,10 @@ - preview html documents with the xmosaic - preview html documents with the w3 package for the XEmacs and emacs -You can insert links and images by clicking with Meta Button1 on its -source and then on its destination. For this drag and drop interface -the following destinations and links are supported: -- the inclusion of an GIF- or JPEG- image by clicking on its name +You can insert links and images by clicking with Meta Control Button1 +on its source and then on its destination. For this drag and drop +interface the following destinations and links are supported: - the +inclusion of an GIF- or JPEG- image by clicking on its name in a dired buffer - a file or relative link to any other file by clicking on its name in a dired buffer diff -r 6866abce6aaf -r 6075d714658b lisp/hm--html-menus/NEWS --- a/lisp/hm--html-menus/NEWS Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/hm--html-menus/NEWS Mon Aug 13 09:51:16 2007 +0200 @@ -1,8 +1,48 @@ +20.07.97 + -- BUILDED the version 5.8 of the package -- +19.07.97 + The minor mode (hm--html-minor-mode) in the Emacs 19 has now + an entry to get the major mode menu - propably not the best + solution, but better than nothing. + Updated the Texinfo documentation. +17.07.97 + Added dummy definitions for defgroup and defcustom for the + Emacs 19. + The variable `site-run-file' is now used, if `site-start-file' + doesn't exists (for Emacs 19 compatibility). + Fixed a bug in the minor mode popup menu, which occured + in the XEmacs together with the html-mode of the psgml + package. +15.07.97 + The minor mode (hm--html-minor-mode) could now be used in many + other (non html) major modes in the XEmacs, like the java-mode + or the perl-mode. In these modes, in the XEmacs it adds it's + own popup menu at the beginning of the major mode menu. +06.07.97 + Changed the file header of hm--html-mode.el, + internal-drag-and-drop.el and tmpl-minor-mode.el. + They should now be compliant with standards. + The mouse pointer in the XEmacs changes now it's shape, + during the drag and drop. +01.07.97 + The package uses now the customisation stuff. + Applied a patch from Dave Love , which fixed + some font-lock bugs. + Fixed a bug in `hm--html-insert-modified-line'. Thanks to + David M. Cook , who reported this bug. + The package respects now the emacs flags -q, -u and + -no-site-file. -u is only respected, if the user config + file isn't given neither by the environment variable nor by the + lisp variable. +31.05.97 + Added the functions `define-obsolete-variable-alias' and + `define-obsolete-variable-alias' for the Emacs 19 to the file + adapt.el. This fixed a load bug in the Emacs 19. 24.05.97 Added `hm--html-automatic-create-title-date' and changed the variable `hm--html-automatic-new-date' to `hm--html-automatic-update-title-date'. `hm--html-automatic-new-date' - is no an obsolete variable and will be deleted in the future. + is now an obsolete variable and will be deleted in the future. Applied a patch from Luca Pisati , which fixed a bug in `hm--html-indent-region'. Fixed a bug in the `hm--html-minor-region-mode-map'. Thanks to @@ -12,6 +52,7 @@ Changed `hm--html-indent-line' so that the indentation leaves the point now at the old text position, if it was behind the indentation column. + -- BUILDED the version 5.7 of the package -- 23.05.97 Changed the special character entities &circumflex to &circ, thanks to Guylaine Prat , for the bug report. diff -r 6866abce6aaf -r 6075d714658b lisp/hm--html-menus/README --- a/lisp/hm--html-menus/README Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/hm--html-menus/README Mon Aug 13 09:51:16 2007 +0200 @@ -1,4 +1,4 @@ -This README file describes the emacs lisp package hm--html-menus-5.7. +This README file describes the emacs lisp package hm--html-menus-5.8. The package provides functions and various popup and pulldown menus for a html mode called hm--html-mode, a mode for writing html pages. @@ -90,6 +90,8 @@ command-description.html.tmpl : Templatefile for the use with the tmpl-minor-mode; frame.html.tmpl : Templatefile, provides a simple frame; +drop : xbm file with the drag and drop mouse pointer +dropmsk : xbm file with mask for the d&d mouse pointer doc/hm--html-mode.texinfo : Package documentation in the Texinfo format; doc/umlaute.texinfo : Texinfo include file for german vowel mutation (deutsche Umlaute); @@ -109,7 +111,16 @@ 1. Put all the *.el files in one of your xemacs (or emacs) lisp load directories (i.e. lisp/packages). -2. Put the following in your .emacs (or default.el or site-init.el): +2. For XEmacs only: Put the files drop and dropmask in the + directory specified by the lisp variable `idd-data-directory'. + By default this directory is /lib/xemacs-/etc/idd. + (eg: if you've installed the Xemacs 19.15 in /usr/local, it is + /usr/local/xemacs/lib/xemacs-19.15/etc/idd). + If you'd like to put the files in another directory, then you must + set the variable `idd-data-directory' to this directory (eg: + (setq idd-data-directory "/usr/local/data") + +3. Put the following in your .emacs (or default.el or site-init.el): (autoload 'hm--html-mode "hm--html-mode" "HTML major mode." t) (autoload 'hm--html-minor-mode "hm--html-mode" "HTML minor mode." t) @@ -163,17 +174,17 @@ line (works only in XEmacs version >= 19.15 and != 20.0) (add-hook 'html-mode-hook 'hm--html-minor-mode) -3. Set (if you want) the environment variable HTML_CONFIG_FILE +4. Set (if you want) the environment variable HTML_CONFIG_FILE to the html system configuration file i.e.: setenv HTML_CONFIG_FILE /usr/xemacs/lisp/hm--html-configuration.el -4. Set (if you want) the environment variable HTML_USER_CONFIG_FILE to +5. Set (if you want) the environment variable HTML_USER_CONFIG_FILE to the html user configuration file i.e.: setenv HTML_USER_CONFIG_FILE ~/.hm--html-configuration.el And put the file .hm--html-configuration.el in your Home directory. An example for this user specific file is given below. -5. Check the files hm--html-configuration.el and +6. Check the files hm--html-configuration.el and .hm--html-configuration.el whether all variables are set suitable for you and your site or not. You can make changes in both of these files and you can also create a site specific configuration file, called @@ -200,18 +211,18 @@ html-view-mosaic-command w3-default-homepage -6. If you want to use templatefiles, you should put these files +7. If you want to use templatefiles, you should put these files in the directory to which `hm--html-template-dir' points. You can use the file command-description.html.tmpl as an example. -7. If you don't want to use the feature of adding html comments +8. If you don't want to use the feature of adding html comments about the creation date and author and with a change log, then you should set the following three variables to nil: hm--html-automatic-changed-comment hm--html-automatic-created-comment -8. If you don't want to set a date in the title line, than you should +9. If you don't want to set a date in the title line, than you should set the following to nil: hm--html-automatic-new-date @@ -258,13 +269,9 @@ Look at first at the configuration files, if you have problems with this package! +You should also look at the Texinfo documentation of this package. -Sorry, I know that the documentation of this package isn't so good as -it should be, but at the moment I've not the time to make a better -one. - -There is also a (small) html documentation about the package. You can -find it on: +There is a html documentation about the package. You can find it on: http://www.tnt.uni-hannover.de/~muenkel/software/own/hm--html-menus/overview.html diff -r 6866abce6aaf -r 6075d714658b lisp/hm--html-menus/adapt.el --- a/lisp/hm--html-menus/adapt.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/hm--html-menus/adapt.el Mon Aug 13 09:51:16 2007 +0200 @@ -1,4 +1,4 @@ -;;; $Id: adapt.el,v 1.4 1997/05/29 23:49:41 steve Exp $ +;;; $Id: adapt.el,v 1.5 1997/07/26 22:09:44 steve Exp $ ;;; ;;; Copyright (C) 1993 - 1997 Heiko Muenkel ;;; email: muenkel@tnt.uni-hannover.de @@ -452,6 +452,37 @@ (if (not (fboundp 'read-directory-name)) (defalias 'read-directory-name 'read-file-name)) + (if (not (fboundp 'define-obsolete-function-alias)) + (defsubst define-obsolete-function-alias (oldfun newfun) + "Define OLDFUN as an obsolete alias for function NEWFUN. +This makes calling OLDFUN equivalent to calling NEWFUN and marks OLDFUN +as obsolete." + (define-function oldfun newfun) + (make-obsolete oldfun newfun))) + + (if (not (fboundp 'define-obsolete-variable-alias)) + (defsubst define-obsolete-variable-alias (oldvar newvar) + "Define OLDVAR as an obsolete alias for varction NEWVAR. +This makes referencing or setting OLDVAR equivalent to referencing or +setting NEWVAR and marks OLDVAR as obsolete. + +It is not full implemented in the Emacs 19, because of the lack of +the function defvaralias.y" + ;;(defvaralias oldvar newvar) <- doesn't exist in the Emacs 19.34 + (make-obsolete-variable oldvar newvar))) + + (if (not (fboundp 'defgroup)) + (defmacro defgroup (symbol members doc &rest args) + "Dummy definition. Used, if the custom package isn't installed. +The dummy definition makes nothing, it returns only nil." + nil)) + + (if (not (fboundp 'defcustom)) + (defmacro defcustom (symbol value doc &rest args) + "Simulates the defcustom definition from the custom package. +It calles a `defvar' with the arguments SYMBOL, VALUE and DOC." + `(defvar ,symbol ,value ,doc))) + )) diff -r 6866abce6aaf -r 6075d714658b lisp/hm--html-menus/custom-load.el --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/hm--html-menus/custom-load.el Mon Aug 13 09:51:16 2007 +0200 @@ -0,0 +1,12 @@ +(custom-put 'tmpl-minor 'custom-loads '("tmpl-minor-mode")) +(custom-put 'idd-drag-and-drop 'custom-loads '("internal-drag-and-drop")) +(custom-put 'hm--html-indentation 'custom-loads '("hm--html-configuration")) +(custom-put 'hm--html-hooks 'custom-loads '("hm--html-configuration")) +(custom-put 'hm--html-display 'custom-loads '("hm--html-configuration")) +(custom-put 'hm--html-keys 'custom-loads '("hm--html-configuration")) +(custom-put 'hm--html-templates 'custom-loads '("hm--html-configuration")) +(custom-put 'hm--html-links 'custom-loads '("hm--html-configuration")) +(custom-put 'hm--html-menus 'custom-loads '("hm--html-configuration")) +(custom-put 'hm--html-document-information 'custom-loads '("hm--html-configuration")) +(custom-put 'hm--html-files 'custom-loads '("hm--html-configuration")) +(custom-put 'hm--html 'custom-loads '("hm--html-configuration")) diff -r 6866abce6aaf -r 6075d714658b lisp/hm--html-menus/hm--html-configuration.el --- a/lisp/hm--html-menus/hm--html-configuration.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/hm--html-menus/hm--html-configuration.el Mon Aug 13 09:51:16 2007 +0200 @@ -1,6 +1,6 @@ ;;; hm--html-configuration.el - Configurationfile for the html-mode ;;; -;;; $Id: hm--html-configuration.el,v 1.6 1997/05/29 23:49:42 steve Exp $ +;;; $Id: hm--html-configuration.el,v 1.7 1997/07/26 22:09:45 steve Exp $ ;;; ;;; Copyright (C) 1993 - 1997 Heiko Muenkel ;;; email: muenkel@tnt.uni-hannover.de @@ -41,255 +41,384 @@ ;(require 'adapt) +(defgroup hm--html nil + "A package for writing HTML pages. +It provides a major mode and a minor mode. The minor mode can be +used together with the psgml html-mode." + :group 'hypermedia) + +(defgroup hm--html-files nil + "hm--html configuration files." + :group 'hm--html) + +(defgroup hm--html-document-information nil + "Variables relating to the insertation of document information. +This contains the user name of the document author, his signature, +the creation and change dates, the HTML doctype and the meta element." + :group 'hm--html) + +(defgroup hm--html-menus nil + "Variables relating to the pulldown and popup menus." + :group 'hm--html) + +(defgroup hm--html-links nil + "Variables relating to the insertation of links." + :group 'hm--html) + +(defgroup hm--html-templates nil + "Variables relating to inserting HTML templates." + :group 'hm--html) + +(defgroup hm--html-keys nil + "Variables relating to the key and mouse bindings and drag and drop." + :group 'hm--html) + +(defgroup hm--html-display nil + "Variables relating to the display of the HTML sources and the previewing." + :group 'hm--html) + +(defgroup hm--html-hooks nil + "Hooks relating to the hm--html modes." + :group 'hm--html) + +(defgroup hm--html-indentation nil + "Variables relating to the indentation in the `hm--html-mode'." + :group 'hm--html) ;;; The User config file (an proposal of Manoj Srivastava) -(defvar hm--html-user-config-file nil +(defcustom hm--html-user-config-file nil "*The location of the users config file. This variable will only be used, if no environment variable \"HTML_USER_CONFIG_FILE\" is set. -Example value: \"~/.hm--html-configuration.el\".") +Example value: \"~/.hm--html-configuration.el\". + +If this is set to nil and no \"HTML_USER_CONFIG_FILE\" is set, +then the file ~/.hm--html-configuration.el will be used. In this case +also the variable `init-file-user' will be respected." + :group 'hm--html-files + :type '(choice (const :tag "~/.hm--html-configuration.el" :value nil) + file)) ;;; The site specific config file -(defvar hm--html-site-config-file nil +(defcustom hm--html-site-config-file nil "*The location of a site specific config file. This variable will only be used, if no environment variable -\"HTML_SITE_CONFIG_FILE\" is set.") +\"HTML_SITE_CONFIG_FILE\" is set." + :group 'hm--html-files + :type '(choice (const :tag "No Site Specific Configuration" :value nil) + file)) ;;; Chose the initial popup menu -(defvar hm--html-expert nil +(defcustom hm--html-expert nil "*t : Use the HTML expert popup menu, nil : Use the HTML novice (simple) menu. NOTE: In the Emacs 19 you should set this variable only before - loading the mode.") + loading the mode." + :group 'hm--html-menus + :type '(choice (const :tag "Use Expert Popup Menu" :value t) + (const :tag "Use Novice Popup Menu" :value nil))) ;;; Your Signature -(defvar hm--html-signature-file nil +(defcustom hm--html-signature-file nil "*Your Signature file. -For example: \"http://www.tnt.uni-hannover.de:80/data/info/www/tnt/info/tnt/whois/muenkel.html\".") +For example: \"http://www.tnt.uni-hannover.de:80/data/info/www/tnt/info/tnt/whois/muenkel.html\"." + :group 'hm--html-document-information + :type '(choice (const :tag "No Signature file" :value nil) + string)) -(defvar hm--html-username nil - "*Your Name for the signature. For example: \"Heiko Münkel\".") +(defcustom hm--html-username nil + "*Your Name for the signature. For example: \"Heiko Münkel\"." + :group 'hm--html-document-information + :type '(choice (const :tag "Use Value Of `(user-full-name)'" :value nil) + string)) ;;; HTML Doctype -(defvar hm--html-html-doctype-version "-//W3C//DTD HTML 3.2 Final//EN" - "The HTML version. This is used in the doctype element.") +(defcustom hm--html-html-doctype-version "-//W3C//DTD HTML 3.2 Final//EN" + "*The HTML version. This is used in the doctype element." + :group 'hm--html-document-information + :type 'string) ;;; Your favorite server (eg: the name of the host of your own http server) ;;; This is used in some other variables -(defvar hm--html-favorite-http-server-host-name "www.tnt.uni-hannover.de" - "*The name of your favorite http server host. It must be specified !") +(defcustom hm--html-favorite-http-server-host-name "www.tnt.uni-hannover.de" + "*The name of your favorite http server host. It must be specified !" + :group 'hm--html-links + :type 'string) ;;; For links to Info Gateways -(defvar hm--html-info-hostname:port-alist '(("www.tnt.uni-hannover.de:8005")) - "*Alist with hostnames and ports for the Info gateway.") - -(defvar hm--html-info-hostname:port-default "www.tnt.uni-hannover.de:8005" - "*Default hostname with port for the Info gateway.") +(defcustom hm--html-info-hostname:port-alist + '(("www.tnt.uni-hannover.de:8005")) + "*Alist with hostnames and ports for the Info gateway." + :group 'hm--html-links + :type '(repeat string)) -(defvar hm--html-info-path-alist '((1 . "/appl/lemacs/Global/emacs/info") - (2 . "/appl/emacs/info") - (3 . "/appl/gnu/Global/info") - (4 . "/appl/emacs-19/Global/info") - (5 . "/")) - "*Alist with directories for the Info gateway.") +(defcustom hm--html-info-hostname:port-default "www.tnt.uni-hannover.de:8005" + "*Default hostname with port for the Info gateway." + :group 'hm--html-links + :type 'string) + +(defcustom hm--html-info-path-alist '((1 . "/appl/lemacs/Global/emacs/info") + (2 . "/appl/emacs/info") + (3 . "/appl/gnu/Global/info") + (4 . "/appl/emacs-19/Global/info") + (5 . "/")) + "*Alist with directories for the Info gateway." + :group 'hm--html-links + :type '(repeat cons)) ;;; For links to WAIS Gateways -(defvar hm--html-wais-hostname:port-alist '(("www.tnt.uni-hannover.de:8001") - ("info.cern.ch:8001")) - "*Alist with hostnames and ports for the WAIS gateway.") +(defcustom hm--html-wais-hostname:port-alist '(("www.tnt.uni-hannover.de:8001") + ("info.cern.ch:8001")) + "*Alist with hostnames and ports for the WAIS gateway." + :group 'hm--html-links + :type '(repeat string)) -(defvar hm--html-wais-hostname:port-default "www.tnt.uni-hannover.de:8001" - "*Default hostname with port for the WAIS gateway.") +(defcustom hm--html-wais-hostname:port-default "www.tnt.uni-hannover.de:8001" + "*Default hostname with port for the WAIS gateway." + :group 'hm--html-links + :type 'string) -(defvar hm--html-wais-servername:port-alist +(defcustom hm--html-wais-servername:port-alist '(("wais.tnt.uni-hannover.de:210") ("daedalus.tnt.uni-hannover.de:21408") ("ikarus.tnt.uni-hannover.de:21401")) - "*Alist with servernames and ports for the WAIS gateway.") + "*Alist with servernames and ports for the WAIS gateway." + :group 'hm--html-links + :type '(repeat string)) -(defvar hm--html-wais-servername:port-default "www.tnt.uni-hannover.de:210" - "*Default servername with port for the WAIS gateway.") +(defcustom hm--html-wais-servername:port-default "www.tnt.uni-hannover.de:210" + "*Default servername with port for the WAIS gateway." + :group 'hm--html-links + :type 'string) -(defvar hm--html-wais-path-alist nil - "*Alist with directories for the wais gateway.") +(defcustom hm--html-wais-path-alist nil + "*Alist with directories for the wais gateway." + :group 'hm--html-links + :type '(repeat string)) ;;; For links to HTML servers -(defvar hm--html-html-hostname:port-alist '(("www.tnt.uni-hannover.de:80") - ("vxcrna.cern.ch:80") - ("www.ncsa.uiuc.edu:80")) - "*Alist with hostnames and ports for the HTML server.") +(defcustom hm--html-html-hostname:port-alist '(("www.tnt.uni-hannover.de:80") + ("vxcrna.cern.ch:80") + ("www.ncsa.uiuc.edu:80")) + "*Alist with hostnames and ports for the HTML server." + :group 'hm--html-links + :type '(repeat string)) -(defvar hm--html-html-hostname:port-default "www.tnt.uni-hannover.de:80" - "*Default hostname with port for the HTML server.") +(defcustom hm--html-html-hostname:port-default "www.tnt.uni-hannover.de:80" + "*Default hostname with port for the HTML server." + :group 'hm--html-links + :type 'string) -(defvar hm--html-html-path-alist '((1 . "/data/info/www/tnt/") - (2 . "/data/info/www/") - (3 . "/data/info/") - (4 . "/data/") - (5 . "/appl/") - (6 . "/project/") - (7 . "~/") - (8 . "/")) - "*Alist with directories for the HTML server.") +(defcustom hm--html-html-path-alist '((1 . "/data/info/www/tnt/") + (2 . "/data/info/www/") + (3 . "/data/info/") + (4 . "/data/") + (5 . "/appl/") + (6 . "/project/") + (7 . "~/") + (8 . "/")) + "*Alist with directories for the HTML server." + :group 'hm--html-links + :type '(repeat cons)) ;;; For links to file gateways -(defvar hm--html-file-path-alist '((1 . "/data/info/www/tnt/") - (2 . "/data/info/www/") - (3 . "/data/info/") - (4 . "/data/") - (5 . "/appl/") - (6 . "/project/") - (7 . "~/") - (8 . "/")) - "*Alist with directories for the file gateway.") +(defcustom hm--html-file-path-alist '((1 . "/data/info/www/tnt/") + (2 . "/data/info/www/") + (3 . "/data/info/") + (4 . "/data/") + (5 . "/appl/") + (6 . "/project/") + (7 . "~/") + (8 . "/")) + "*Alist with directories for the file gateway." + :group 'hm--html-links + :type '(repeat cons)) ;;; For links to ftp servers -(defvar hm--html-ftp-hostname:port-alist '(("ftp.tnt.uni-hannover.de") - ("ftp.rrzn.uni-hannover.de") - ("wega.informatik.uni-hannover.de") - ("rusmv1.rus.uni-stuttgart.de") - ("export.lcs.mit.edu") - ) - "*Alist with hostnames and ports for the ftp server.") +(defcustom hm--html-ftp-hostname:port-alist + '(("ftp.tnt.uni-hannover.de") + ("ftp.rrzn.uni-hannover.de") + ("wega.informatik.uni-hannover.de") + ("rusmv1.rus.uni-stuttgart.de") + ("export.lcs.mit.edu") + ) + "*Alist with hostnames and ports for the ftp server." + :group 'hm--html-links + :type '(repeat string)) -(defvar hm--html-ftp-hostname:port-default "ftp.rrzn.uni-hannover.de" - "*Default hostname with port for the ftp server.") +(defcustom hm--html-ftp-hostname:port-default "ftp.rrzn.uni-hannover.de" + "*Default hostname with port for the ftp server." + :group 'hm--html-links + :type 'string) -(defvar hm--html-ftp-path-alist '((1 . "/pub") - (2 . "/pub/gnu") - (3 . "/pub/linux") - (4 . "/pub/unix") - (5 . "/incoming") - (6 . "/")) - "*Alist with directories for the ftp server.") +(defcustom hm--html-ftp-path-alist '((1 . "/pub") + (2 . "/pub/gnu") + (3 . "/pub/linux") + (4 . "/pub/unix") + (5 . "/incoming") + (6 . "/")) + "*Alist with directories for the ftp server." + :group 'hm--html-links + :type '(repeat cons)) ;;; For links to gopher servers -(defvar hm--html-gopher-hostname:port-alist +(defcustom hm--html-gopher-hostname:port-alist '(("newsserver.rrzn.uni-hannover.de:70") ("solaris.rz.tu-clausthal.de:70") ("veronica.scs.unr.edu:70") ("pinus.slu.se:70") ("sunic.sunet.se:70") ) - "*Alist with hostnames and ports for the gopher server.") + "*Alist with hostnames and ports for the gopher server." + :group 'hm--html-links + :type '(repeat string)) -(defvar hm--html-gopher-hostname:port-default +(defcustom hm--html-gopher-hostname:port-default "newsserver.rrzn.uni-hannover.de:70" - "*Default hostname with port for the gopher server.") + "*Default hostname with port for the gopher server." + :group 'hm--html-links + :type 'string) -(defvar hm--html-gopher-doctype-alist '(("/1") +(defcustom hm--html-gopher-doctype-alist '(("/1") ("/11") ("/00")) - "*Alist with doctype strings for the gopher server.") + "*Alist with doctype strings for the gopher server." + :group 'hm--html-links + :type '(repeat string)) -(defvar hm--html-gopher-doctype-default "/1" - "*Default doctype string for the gopher server.") +(defcustom hm--html-gopher-doctype-default "/1" + "*Default doctype string for the gopher server." + :group 'hm--html-links + :type 'string) -(defvar hm--html-gopher-anchor-alist +(defcustom hm--html-gopher-anchor-alist '(("veronica") ("Wide%20Area%20Information%20Services%20databases") ("Subject%20Tree")) - "*Alist with directories for the gopher server.") + "*Alist with directories for the gopher server." + :group 'hm--html-links + :type '(repeat string)) ;;; For the links to the Program Gateway -(defvar hm--html-proggate-hostname:port-alist +(defcustom hm--html-proggate-hostname:port-alist '(("www.tnt.uni-hannover.de:8007") ) - "*Alist with hostnames and ports for the proggate server.") + "*Alist with hostnames and ports for the proggate server." + :group 'hm--html-links + :type '(repeat string)) -(defvar hm--html-proggate-hostname:port-default "www.tnt.uni-hannover.de:8007" - "*Default hostname with port for the proggate server.") +(defcustom hm--html-proggate-hostname:port-default + "www.tnt.uni-hannover.de:8007" + "*Default hostname with port for the proggate server." + :group 'hm--html-links + :type '(repeat string)) -(defvar hm--html-proggate-allowed-file "/appl/www/bin/proggate.allowed" - "*The filename (with path) of the proggate allowed file.") +(defcustom hm--html-proggate-allowed-file "/appl/www/bin/proggate.allowed" + "*The filename (with path) of the proggate allowed file." + :group 'hm--html-links + :type 'file) ;;; For links to the Local Program Gatewy -(defvar hm--html-local-proggate-path-alist '((1 . "/bin/") - (2 . "/usr/bin/") - (3 . "/usr/local/bin/") - (4 . "/appl/util/bin/") - (5 . "/appl/gnu/Global/bin/") - (6 . "/") - (7 . "/appl/") - (8 . "~/appl/Global/bin/") - (9 . "~/")) - "*Alist with directories for the local program gateway.") +(defcustom hm--html-local-proggate-path-alist '((1 . "/bin/") + (2 . "/usr/bin/") + (3 . "/usr/local/bin/") + (4 . "/appl/util/bin/") + (5 . "/appl/gnu/Global/bin/") + (6 . "/") + (7 . "/appl/") + (8 . "~/appl/Global/bin/") + (9 . "~/")) + "*Alist with directories for the local program gateway." + :group 'hm--html-links + :type '(repeat cons)) ;;; For links to the mail gateway -(defvar hm--html-mail-hostname:port-alist '(("www.tnt.uni-hannover.de:8003") - ) - "*Alist with hostnames and ports for the mail gateway.") +(defcustom hm--html-mail-hostname:port-alist '(("www.tnt.uni-hannover.de:8003") + ) + "*Alist with hostnames and ports for the mail gateway." + :group 'hm--html-links + :type '(repeat string)) -(defvar hm--html-mail-hostname:port-default "www.tnt.uni-hannover.de:8003" - "*Default hostname with port for the mail gateway.") +(defcustom hm--html-mail-hostname:port-default "www.tnt.uni-hannover.de:8003" + "*Default hostname with port for the mail gateway." + :group 'hm--html-links + :type 'string) -(defvar hm--html-mail-path-alist '((1 . "~/data/docs/mail") - (2 . "~/data/docs/news") - (3 . "~/docs/mail") - (4 . "~/docs/news") - (5 . "~/mail") - (6 . "~/news") - (7 . "~/") - (8 . "/data/info/mail") - (9 . "/data/info/news") - (10 . "/")) - "*Alist with directories for the mail gateway.") +(defcustom hm--html-mail-path-alist '((1 . "~/data/docs/mail") + (2 . "~/data/docs/news") + (3 . "~/docs/mail") + (4 . "~/docs/news") + (5 . "~/mail") + (6 . "~/news") + (7 . "~/") + (8 . "/data/info/mail") + (9 . "/data/info/news") + (10 . "/")) + "*Alist with directories for the mail gateway." + :group 'hm--html-links + :type '(repeat string)) ;;; For mailto links -(defvar hm--html-mailto-alist '(("muenkel@tnt.uni-hannover.de")) +(defcustom hm--html-mailto-alist '(("muenkel@tnt.uni-hannover.de")) "*Alist with mail adresses for the mailto alist. The value of `user-mail-address' will also be added by the package to -this alist.") +this alist." + :group 'hm--html-links + :type '(repeat string)) ;;; For the server side include directive ;;; not sure, if these directives works on any server -(defvar hm--html-server-side-include-command-alist '(("/bin/date") - ("/usr/bin/finger") - ("/bin/df")) +(defcustom hm--html-server-side-include-command-alist '(("/bin/date") + ("/usr/bin/finger") + ("/bin/df")) "*Alist with commands for the server side include directive. -These commands needs no parameter.") +These commands needs no parameter." + :group 'hm--html-links + :type '(repeat string)) -(defvar hm--html-server-side-include-command-with-parameter-alist +(defcustom hm--html-server-side-include-command-with-parameter-alist '(("/usr/bin/man") ("/usr/bin/finger") ("/usr/bin/ls") ("/bin/cat")) "*Alist with commands for the server side include directive. -These commands needs parameters.") +These commands needs parameters." + :group 'hm--html-links + :type '(repeat string)) ;;; Alist with URL'S for FORMS and IMAGE tags -(defvar hm--html-url-alist +(defcustom hm--html-url-alist (list '("http://hoohoo.ncsa.uiuc.edu/htbin-post/post-query" POST) @@ -302,27 +431,37 @@ 'IMAGE)) "*Alist with URL's for FORMS and IMAGE tags. The cdr of each list contains symbols, which specifys the use of the -URL.") +URL." + :group 'hm--html-links + :type '(repeat cons)) ;;; For the marking of examples in the help buffer -(defvar hm--html-help-foreground "red" - "The foreground color to highlight examples.") +(defcustom hm--html-help-foreground "red" + "The foreground color to highlight examples." + :group 'hm--html-links + :type 'string) -(defvar hm--html-help-background nil - "The background color to highlight examples.") +(defcustom hm--html-help-background nil + "The background color to highlight examples." + :group 'hm--html-links + :type 'string) -(defvar hm--html-help-font (face-font 'bold) - "The font to highlight examples.") +(defcustom hm--html-help-font (face-font 'bold) + "The font to highlight examples." + :group 'hm--html-links + :type 'string) ;;; For the Templates -(defvar hm--html-template-dir "/data/info/www/tnt/guide/templates" +(defcustom hm--html-template-dir "/data/info/www/tnt/guide/templates" "*A directory with templatefiles. It is now also possible to use it as a list of directories. -Look at the variable `tmpl-template-dir-list' for further descriptions.") +Look at the variable `tmpl-template-dir-list' for further descriptions." + :group 'hm--html-templates + :type 'directory) (if (listp hm--html-template-dir) (unless (file-exists-p (car hm--html-template-dir)) @@ -337,21 +476,27 @@ (setq hm--html-template-dir (concat data-directory "../lisp/hm--html-menus/")))) -(defvar hm--html-frame-template-file (concat data-directory +(defcustom hm--html-frame-template-file (concat data-directory "../lisp/hm--html-menus/" "frame.html.tmpl") - "File, which is used as template for a html frame.") + "File, which is used as template for a html frame." + :group 'hm--html-templates + :type 'file) -(defvar hm--html-automatic-expand-templates t +(defcustom hm--html-automatic-expand-templates t "*Automatic expansion of templates. This feature needs the file tmpl-minor-mode.el from Heiko Muenkel (muenkel@tnt.uni-hannover.de), -which is distributed with the package hm--html-menus.") +which is distributed with the package hm--html-menus." + :group 'hm--html-templates + :type 'boolean) -(defvar hm--html-template-filter-regexp ".*\\.html\\.tmpl$" - "*Regexp for filtering out non template files in a directory.") +(defcustom hm--html-template-filter-regexp ".*\\.html\\.tmpl$" + "*Regexp for filtering out non template files in a directory." + :group 'hm--html-templates + :type 'string) ;;; for deleting the automounter path-prefix -(defvar hm--html-delete-wrong-path-prefix '("/tmp_mnt" "/phys/[^/]+") +(defcustom hm--html-delete-wrong-path-prefix '("/tmp_mnt" "/phys/[^/]+") "If non nil, it specifies path-prefixes, which should be deleted in pathes. The Sun automounter adds a temporary prefix to the automounted directories (At our site the prefix is /tmp_mnt). But you can't select such a path, if @@ -360,86 +505,137 @@ you can set this variable to the prefix (eg. \"/tmp_mnt\"). After that, the prefix should be stripped from the pathes during the creation of the links. ATTENTION: This variable is used as regular expression ! -It can be set to a string or to a list of strings.") +It can be set to a string or to a list of strings." + :group 'hm--html-links + :type '(repeat string)) ;;; For insertation of created and changed comments and automatic ;;; date update in the title line and a visible modification date -(defvar hm--html-automatic-create-title-date t +(defcustom hm--html-automatic-create-title-date t "*t => A date string will be inserted in the title line. This will be updated each time before file saving, if -`hm--html-automatic-update-title-date' is also set to t.") +`hm--html-automatic-update-title-date' is also set to t." + :group 'hm--html-document-information + :type 'boolean) -(defvar hm--html-automatic-update-title-date t +(defcustom hm--html-automatic-update-title-date t "*t => The date in the title line will be updated before filesaving. -nil => No automatic update of the date.") +nil => No automatic update of the date." + :group 'hm--html-document-information + :type 'boolean) (define-obsolete-variable-alias 'hm--html-automatic-new-date 'hm--html-automatic-update-title-date) -(defvar hm--html-automatic-changed-comment t +(defcustom hm--html-automatic-changed-comment t "*t => A \"changed comment\" line will be added before filesaving. -nil => No automatic insertation of a \"changed comment\" line.") +nil => No automatic insertation of a \"changed comment\" line." + :group 'hm--html-document-information + :type 'boolean) -(defvar hm--html-changed-comment-prefix "Changed by: " - "*The prefix text of the \"changed comment\" lines.") +(defcustom hm--html-changed-comment-prefix "Changed by: " + "*The prefix text of the \"changed comment\" lines." + :group 'hm--html-document-information + :type 'string) -(defvar hm--html-created-comment-prefix "Created by: " - "*The prefix text of the \"created comment\" lines.") +(defcustom hm--html-created-comment-prefix "Created by: " + "*The prefix text of the \"created comment\" lines." + :group 'hm--html-document-information + :type 'string) -(defvar hm--html-comment-infix nil +(defcustom hm--html-comment-infix nil "*The infix (second part) of the \"changed/created comment\" lines. By default, if this variable is nil, the username is used. Then the infix looks like \"Heiko Münkel, \". Set it to an empty string, if you don't want to have your name -in the comments.") +in the comments." + :group 'hm--html-document-information + :type '(choice (const :tag "Use The Username" :value nil) + string)) -(defvar hm--html-automatic-created-comment t +(defcustom hm--html-automatic-created-comment t "*t => A \"created comment\" line will be added. -nil => No automatic insertation of a \"created comment\" line.") +nil => No automatic insertation of a \"created comment\" line." + :group 'hm--html-document-information + :type 'boolean) -(defvar hm--html-automatic-create-modified-line nil +(defcustom hm--html-automatic-create-modified-line nil "*t => Inserts a visible \"modified\" line with the current date. -Visible means, that it is not a HTML comment.") +Visible means, that it is not a HTML comment." + :group 'hm--html-document-information + :type 'boolean) -(defvar hm--html-automatic-update-modified-line nil +(defcustom hm--html-automatic-update-modified-line nil "*t => Updates a visible \"modified\" line with the current date. -Visible means, that it is not a HTML comment.") +Visible means, that it is not a HTML comment." + :group 'hm--html-document-information + :type 'boolean) -(defvar hm--html-modified-prefix "Modified: " - "*Prefix of the last modified entry.") +(defcustom hm--html-modified-prefix "Modified: " + "*Prefix of the last modified entry." + :group 'hm--html-document-information + :type 'string) -(defvar hm--html-modified-start-tag "" +(defcustom hm--html-modified-start-tag "" "*Start tag of the modified line. If you change this, you'll need to change also -`hm--html-modified-end-tag'.") +`hm--html-modified-end-tag'." + :group 'hm--html-document-information + :type '(choice (const :tag "Emphasized" :value "") + (const :tag "Strong" :value "") + (const :tag "No Tags" :value "") + (const :tag "Bold" :value "") + (const :tag "Italic" :value "") + (const :tag "Typewriter" :value "") + (const :tag "Small" :value "") + (const :tag "Big" :value "") + (const :tag "Underline" :value "") + string)) -(defvar hm--html-modified-end-tag "" +(defcustom hm--html-modified-end-tag "" "*End tag of the modified line. If you change this, you'll need to change also -`hm--html-modified-start-tag'.") +`hm--html-modified-start-tag'." + :group 'hm--html-document-information + :type '(choice (const :tag "Emphasized" :value "") + (const :tag "Strong" :value "") + (const :tag "No Tags" :value "") + (const :tag "Bold" :value "") + (const :tag "Italic" :value "") + (const :tag "Typewriter" :value "") + (const :tag "Small" :value "") + (const :tag "Big" :value "") + (const :tag "Underline" :value "") + string)) -(defvar hm--html-modified-insert-before "" +(defcustom hm--html-modified-insert-before "" "Insert modified line before this string. -The search will be done from the end to the beginning.") +The search will be done from the end to the beginning." + :group 'hm--html-document-information + :type 'string) ;;; Keybindings: -(defvar hm--html-bind-latin-1-char-entities t +(defcustom hm--html-bind-latin-1-char-entities t "Set this to nil, if you don't want to use the ISO Latin 1 character entities. This is only useful, if `hm--html-use-old-keymap' is set to nil. It is only -used during loading the html package the first time.") +used during loading the html package the first time." + :group 'hm--html-keys + :type 'boolean) ;;; The drag and drop interface -(defvar hm--html-idd-create-relative-links t +(defcustom hm--html-idd-create-relative-links t "If t, then the hm--html-idd-* functions are creating relative links. Otherwise absolute links are used. The idd functions are used for -drag and drop.") +drag and drop." + :group 'hm--html-keys + :type 'boolean) -(defvar hm--html-idd-actions +(defcustom hm--html-idd-actions '((nil (((idd-if-major-mode-p . dired-mode) (idd-if-dired-file-on-line-p . ".*\\.\\(gif\\)\\|\\(jpg\\)")) hm--html-idd-add-include-image-from-dired-line) @@ -457,107 +653,161 @@ (((idd-if-local-file-p . t)) hm--html-idd-add-file-link-to-buffer))) "The action list for the destination mode `hm--html-mode'. -Look at the description of the variable idd-actions.") +Look at the description of the variable idd-actions." + :group 'hm--html-keys + :type 'list) ;;; The font lock keywords -(defconst hm--html-font-lock-keywords-1 +(defcustom hm--html-font-lock-keywords-1 (list '("" . font-lock-comment-face) '("<[^>]*>" . font-lock-keyword-face) - '("<[^>=]*href[ \t\n]*=[ \t\n]*\"\\([^\"]*\\)\"" 1 font-lock-string-face t) - '("<[^>=]src[ \t\n]*=[ \t\n]*\"\\([^\"]*\\)\"" 1 font-lock-string-face t)) - "Subdued level highlighting for hm--html-mode.") +; '("<[^>=]*href[ \t\n]*=[ \t\n]*\"\\([^\"]*\\)\"" 1 font-lock-string-face t) +; '("<[^>=]src[ \t\n]*=[ \t\n]*\"\\([^\"]*\\)\"" 1 font-lock-string-face t) + '("<[^>=]*\\(href\\|src\\)[ \t\n]*=[ \t\n]*\"\\([^\"]*\\)\"" + 2 font-lock-string-face t)) + "Subdued level highlighting for hm--html-mode." + :group 'hm--html-display + :type '(repeat cons)) -(defconst hm--html-font-lock-keywords-2 +(defcustom hm--html-font-lock-keywords-2 (append hm--html-font-lock-keywords-1 (list - '(">\\([^<]*\\)" 1 font-lock-reference-face) - '("\\([^<]*\\)" 1 bold) - '("\\([^<]*\\)" 1 italic) + '(">\\([^<]+\\)" 1 font-lock-reference-face) + '("\\([^<]+\\)" 1 bold) + '("\\([^<]+\\)" 1 italic) )) - "Gaudy level highlighting for hm--html-mode.") + "Gaudy level highlighting for hm--html-mode." + :group 'hm--html-display + :type '(repeat cons)) -(defvar hm--html-font-lock-keywords hm--html-font-lock-keywords-1 - "Default expressions to highlight in the hm--html-mode.") +(defcustom hm--html-font-lock-keywords hm--html-font-lock-keywords-1 + "Default expressions to highlight in the hm--html-mode." + :group 'hm--html-display + :type '(repeat cons)) ;;; The Prefix- Key for the keytables -(defvar hm--html-minor-mode-prefix-key "\C-z" - "The prefix key for the keytables in the `hm--html-minor-mode'.") +(defcustom hm--html-minor-mode-prefix-key "\C-z" + "The prefix key for the keytables in the `hm--html-minor-mode'." + :group 'hm--html-keys + :type 'string) -(defvar hm--html-mode-prefix-key "\C-c" - "The prefix key for the hm--html keys in the `hm--html-mode'.") +(defcustom hm--html-mode-prefix-key "\C-c" + "The prefix key for the hm--html keys in the `hm--html-mode'." + :group 'hm--html-keys + :type 'string) ;;; The pulldown menu names -(defvar hm--html-minor-mode-pulldown-menu-name "HM-HTML" - "The name of the pulldown menu in the minor html mode.") +(defcustom hm--html-minor-mode-pulldown-menu-name "HM-HTML" + "The name of the pulldown menu in the minor html mode." + :group 'hm--html-menus + :type 'string + ) -(defvar hm--html-mode-pulldown-menu-name "HTML" - "The name of the pulldown menu in the major html mode.") +(defcustom hm--html-mode-pulldown-menu-name "HTML" + "The name of the pulldown menu in the major html mode." + :group 'hm--html-menus + :type 'string) ;;; The hook variables -(defvar hm--html-load-hook nil - "*Hook variable to execute functions after loading the package.") +(defcustom hm--html-load-hook nil + "*Hook variable to execute functions after loading the package." + :group 'hm--html-hooks + :type 'hook) -(defvar hm--html-mode-hook nil - "*This hook will be called each time, when the hm--html-mode is invoked.") +(defcustom hm--html-mode-hook nil + "*This hook will be called each time, when the hm--html-mode is invoked." + :group 'hm--html-hooks + :type 'hook) ;;; For the file html-view.el ;;; There are also some other variables in hmtl-view.el ;;; Look at that file, if you've trouble with the functions ;;; to preview the html document with the Mosaic -(defvar html-view-mosaic-command "/sol/www/bin/mosaic" - "The command that runs Mosaic on your system.") +(defcustom html-view-mosaic-command "/sol/www/bin/mosaic" + "The command that runs Mosaic on your system." + :group 'hm--html-display + :type '(choice (const :tag "mosaic" :value "mosaic") + (const :value "/usr/local/bin/mosaic") + file)) -(defvar html-sigusr1-signal-value 16 +(defcustom html-sigusr1-signal-value 16 "Value for the SIGUSR1 signal on your system. See, usually, /usr/include/sys/signal.h. SunOS 4.1.x : (setq html-sigusr1-signal-value 30) SunOS 5.x : (setq html-sigusr1-signal-value 16) - Linux : (setq html-sigusr1-signal-value 10))") + Linux : (setq html-sigusr1-signal-value 10))" + :group 'hm--html-display + :type '(choice (const :tag "On SunOS 4.1.x" :value 30) + (const :tag "On SunOS 5.x" :value 16) + (const :tag "On Linux" :value 10) + integer)) ;;; Meta information -(defvar hm--html-meta-name-alist '(("Expires") ("Keys") ("Author")) - "*Alist with possible names for the name or http-equiv attribute of meta.") +(defcustom hm--html-meta-name-alist '(("Expires") ("Keys") ("Author")) + "*Alist with possible names for the name or http-equiv attribute of meta." + :group 'hm--html-document-information + :type '(repeat (list (choice (const "Expires") + (const "Keys") + (const "Author") + string)))) ;;; indentation -(defvar hm--html-disable-indentation nil +(defcustom hm--html-disable-indentation nil "*Set this to t, if you want to disable the indentation in the hm--html-mode. And may be send me (muenkel@tnt.uni-hannover.de) a note, why you've -done this.") +done this." + :group 'hm--html-indentation + :type 'boolean) -(defvar hm--html-inter-tag-indent 2 - "*The indentation after a start tag.") +(defcustom hm--html-inter-tag-indent 2 + "*The indentation after a start tag." + :group 'hm--html-indentation + :type 'integer) -(defvar hm--html-comment-indent 5 - "*The indentation of a comment.") +(defcustom hm--html-comment-indent 5 + "*The indentation of a comment." + :group 'hm--html-indentation + :type 'integer) -(defvar hm--html-intra-tag-indent 2 - "*The indentation after the start of a tag.") +(defcustom hm--html-intra-tag-indent 2 + "*The indentation after the start of a tag." + :group 'hm--html-indentation + :type 'integer) -(defvar hm--html-tag-name-alist - '(("!--" (:hm--html-one-element-tag t)) - ("!doctype" (:hm--html-one-element-tag t)) +(defcustom hm--html-tag-name-alist + '(("!--" (:hm--html-one-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) + ("!doctype" (:hm--html-one-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) ("isindex" (:hm--html-one-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (prompt))) ("base" (:hm--html-one-element-tag t) - (:hm--html-required-attributes (href))) + (:hm--html-required-attributes (href)) + (:hm--html-optional-attributes nil)) ("meta" (:hm--html-one-element-tag t) (:hm--html-required-attributes (content)) (:hm--html-optional-attributes (http-equiv name))) ("link" (:hm--html-one-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (href rel rev title))) ("hr" (:hm--html-one-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (align noshade size width))) ("input" (:hm--html-one-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (type name value checked size maxlength src align))) ("img" (:hm--html-one-element-tag t) @@ -568,103 +818,184 @@ (:hm--html-required-attributes (name)) (:hm--html-optional-attributes (value))) ("br" (:hm--html-one-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (clear))) ("basefont" (:hm--html-one-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes size)) ("area" (:hm--html-one-element-tag t) (:hm--html-required-attributes (alt)) (:hm--html-optional-attributes (shape coords href nohref))) ("option" (:hm--html-one-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (selected value))) - ("html" (:hm--html-two-element-tag t)) - ("head" (:hm--html-two-element-tag t)) + ("html" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) + ("head" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) ("body" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (bgcolor text link vlink alink background)) ) ("h1" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (align))) ("h2" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (align))) ("h3" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (align))) ("h4" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (align))) ("h5" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (align))) ("h6" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (align))) - ("address" (:hm--html-two-element-tag t)) + ("address" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) ("p" (:hm--html-one-or-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (align))) ("ul" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (type compact))) ("ol" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (type start compact))) ("dl" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (compact))) ("li" (:hm--html-one-or-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (type (value "ol")))) - ("dt" (:hm--html-one-or-two-element-tag t)) - ("dd" (:hm--html-one-or-two-element-tag t)) + ("dt" (:hm--html-one-or-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) + ("dd" (:hm--html-one-or-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) ("dir" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (compact))) ("menu" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (compact))) ("pre" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (width))) ("div" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (align))) - ("center" (:hm--html-two-element-tag t)) - ("blockquote" (:hm--html-two-element-tag t)) + ("center" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) + ("blockquote" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) ("form" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (action method enctype))) ("select" (:hm--html-two-element-tag t) (:hm--html-required-attributes (name)) (:hm--html-optional-attributes (size multiple))) ("textarea" (:hm--html-two-element-tag t) - (:hm--html-required-attributes (name rows cols))) + (:hm--html-required-attributes (name rows cols)) + (:hm--html-optional-attributes nil)) ("table" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (align width border cellspacing cellpading))) ("caption" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (align))) ("tr" (:hm--html-one-or-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (align valign))) ("th" (:hm--html-one-or-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (nowrap rowspan colspan align valign width height))) ("td" (:hm--html-one-or-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (nowrap rowspan colspan align valign width height))) - ("tt" (:hm--html-two-element-tag t)) - ("i" (:hm--html-two-element-tag t)) - ("b" (:hm--html-two-element-tag t)) - ("u" (:hm--html-two-element-tag t)) - ("strike" (:hm--html-two-element-tag t)) - ("big" (:hm--html-two-element-tag t)) - ("small" (:hm--html-two-element-tag t)) - ("sub" (:hm--html-two-element-tag t)) - ("sup" (:hm--html-two-element-tag t)) - ("em" (:hm--html-two-element-tag t)) - ("strong" (:hm--html-two-element-tag t)) - ("dfn" (:hm--html-two-element-tag t)) - ("code" (:hm--html-two-element-tag t)) - ("samp" (:hm--html-two-element-tag t)) - ("kbd" (:hm--html-two-element-tag t)) - ("var" (:hm--html-two-element-tag t)) - ("cite" (:hm--html-two-element-tag t)) + ("tt" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) + ("i" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) + ("b" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) + ("u" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) + ("strike" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) + ("big" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) + ("small" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) + ("sub" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) + ("sup" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) + ("em" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) + ("strong" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) + ("dfn" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) + ("code" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) + ("samp" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) + ("kbd" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) + ("var" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) + ("cite" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) ("a" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (name href rel rev title))) ("applet" (:hm--html-two-element-tag t) (:hm--html-required-attributes (code width height)) (:hm--html-optional-attributes (codebase alt name align hspace vspace))) ("font" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) (:hm--html-optional-attributes (size color))) ("map" (:hm--html-two-element-tag t) - (:hm--html-required-attributes (name))) - ("style" (:hm--html-two-element-tag t)) - ("script" (:hm--html-two-element-tag t)) + (:hm--html-required-attributes (name)) + (:hm--html-optional-attributes nil)) + ("style" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) + ("script" (:hm--html-two-element-tag t) + (:hm--html-required-attributes nil) + (:hm--html-optional-attributes nil)) ) "An alist with tag names known by the `hm--html-mode'. CURRENTLY THIS LIST MIGHT NOT CONTAIN ALL TAGS!!!!. @@ -674,7 +1005,34 @@ In the future it should also be used to get possible parameters of the tag. -Use lower case characters in this list!!!!") +Use lower case characters in this list!!!!" + :group 'hm--html-indentation + :type 'list) +; :type '(repeat lisp)) +; :type '(repeat (list string +; (list (const +; :tag "Element with one tag" +; :value (:hm--html-one-element-tag t)) +; (const +; :tag "Element with two tags" +; :value (:hm--html-two-element-tag t)) +; (const +; :tag "Element with one or two tags" +; :value (:hm--html-one-or-two-element-tag t)) +; ) +; (list :format "%t%v" +; :tag "" +; (const :format "" +; :value :hm--html-required-attributes) +; (repeat :tag "Repeat Required Attributes" +; symbol)) +; (list :format "%t%v" +; :tag "" +; (const :format "" +; :value :hm--html-optional-attributes) +; (repeat :tag "Repeat Optional Attributes" +; symbol)) +; ))) ;;; Announce the feature hm--html-configuration diff -r 6866abce6aaf -r 6075d714658b lisp/hm--html-menus/hm--html-menu.el --- a/lisp/hm--html-menus/hm--html-menu.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/hm--html-menus/hm--html-menu.el Mon Aug 13 09:51:16 2007 +0200 @@ -1,6 +1,6 @@ ;;; hm--html-menu --- A menu for the hm--html-mode. ;;; -;;; $Id: hm--html-menu.el,v 1.7 1997/05/29 23:49:42 steve Exp $ +;;; $Id: hm--html-menu.el,v 1.8 1997/07/26 22:09:45 steve Exp $ ;;; ;;; Copyright (C) 1993 - 1997 Heiko Muenkel ;;; email: muenkel@tnt.uni-hannover.de @@ -751,6 +751,8 @@ ((eq (event-object event) 'menu-no-selection-hook) nil) ((commandp (event-object event)) ; for the + (set-mark hm--html-mark) ; + (goto-char hm--html-point) ; (call-interactively (event-object event)) ; hm--html-menu (signal 'quit nil)) ; items (t @@ -765,7 +767,35 @@ (message "please make a choice from the menu.")))) value)) ) -; Fuer den Emacs 19 fehlt hier noch etwas !!! + + ;; For the Emacs 19 + (defun hm--html-add-major-menu-to-minor-menus () + "Adds an entry to get the general major menu in the minor mode menus. +This function is only used in the Emacs 19." + (define-key hm--html-menu-noregion-novice-map + [mouse-major-mode-menu] + '("Major Mode Menu" . mouse-major-mode-menu)) + (define-key hm--html-menu-noregion-expert-map + [mouse-major-mode-menu] + '("Major Mode Menu" . mouse-major-mode-menu)) + (define-key hm--html-menu-region-novice-map + [mouse-major-mode-menu] + '("Major Mode Menu" . mouse-major-mode-menu)) + (define-key hm--html-menu-region-expert-map + [mouse-major-mode-menu] + '("Major Mode Menu" . mouse-major-mode-menu))) + + (defun hm--html-remove-major-menu-from-minor-menus () + "Removes the entry to get the general major menu in the minor mode menus. +This function is only used in the Emacs 19." + (define-key hm--html-menu-noregion-novice-map + [mouse-major-mode-menu] 'undefined) + (define-key hm--html-menu-noregion-expert-map + [mouse-major-mode-menu] 'undefined) + (define-key hm--html-menu-region-novice-map + [mouse-major-mode-menu] 'undefined) + (define-key hm--html-menu-region-expert-map + [mouse-major-mode-menu] 'undefined)) ) (if (adapt-xemacsp) @@ -774,30 +804,52 @@ (defun hm--html-popup-minor-html-menu (event) "Pops the HTML- menu up, if no region is active." (interactive "@e") - (if hm--html-use-psgml - (let ((hm--html-popup-menu (if hm--html-expert - hm--html-menu-noregion-expert - hm--html-menu-noregion-novice))) - (sgml-tags-menu event)) - (if hm--html-expert - (popup-menu hm--html-menu-noregion-expert) - (popup-menu hm--html-menu-noregion-novice)) - )) + (if (eq major-mode 'html-mode) + (if hm--html-use-psgml + (let ((hm--html-popup-menu (if hm--html-expert + hm--html-menu-noregion-expert + hm--html-menu-noregion-novice)) + (hm--html-point (point)) + (hm--html-mark (mark))) + (sgml-tags-menu event)) + (if hm--html-expert + (popup-menu hm--html-menu-noregion-expert) + (popup-menu hm--html-menu-noregion-novice)) + ) + (popup-menu (append ;mode-popup-menu + ;'("===") + (if hm--html-expert + hm--html-menu-noregion-expert + hm--html-menu-noregion-novice) + (list "===" + (car mode-popup-menu) + "===") + (cdr mode-popup-menu) + )))) + (defun hm--html-popup-minor-html-menu-region (event) "Pops the HTML- menu up, if a region is active." (interactive "@e") - (if hm--html-use-psgml - (let ((hm--html-popup-menu (if hm--html-expert - hm--html-menu-region-expert - hm--html-menu-region-novice))) - (sgml-tags-menu event)) - (if hm--html-expert - (popup-menu hm--html-menu-region-expert) - (popup-menu hm--html-menu-region-novice)) - )) - + (if (eq major-mode 'html-mode) + (if hm--html-use-psgml + (let ((hm--html-popup-menu (if hm--html-expert + hm--html-menu-region-expert + hm--html-menu-region-novice)) + (hm--html-point (point)) + (hm--html-mark (mark))) + (sgml-tags-menu event)) + (if hm--html-expert + (popup-menu hm--html-menu-region-expert) + (popup-menu hm--html-menu-region-novice)) + ) + (popup-menu (append mode-popup-menu + '("---") + (if hm--html-expert + hm--html-menu-noregion-expert + hm--html-menu-noregion-novice))))) + )) diff -r 6866abce6aaf -r 6075d714658b lisp/hm--html-menus/hm--html-mode.el --- a/lisp/hm--html-menus/hm--html-mode.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/hm--html-menus/hm--html-mode.el Mon Aug 13 09:51:16 2007 +0200 @@ -1,71 +1,77 @@ ;;; hm--html-mode --- Major mode for editing HTML documents for the WWW -;;; -;;; Keywords: hypermedia languages help docs wp -;;; -;;; $Id: hm--html-mode.el,v 1.6 1997/05/29 23:49:43 steve Exp $ -;;; -;;; Copyright (C) 1996, 1997 Heiko Muenkel -;;; email: muenkel@tnt.uni-hannover.de -;;; -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software -;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -;;; + +;; Copyright (C) 1996, 1997 Heiko Muenkel + +;; Author: Heiko Muenkel +;; Keywords: hypermedia languages help docs wp + +;; $Id: hm--html-mode.el,v 1.7 1997/07/26 22:09:45 steve Exp $ + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your +;; option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; See the file COPYING. if not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA + +;;; Synched up with: Not part of Emacs. + ;;; Commentary: -;;; Description: -;;; -;;; This file defines the hm--html-mode, a mode for editing html -;;; files. It is the main file of the package hm--html-menus. -;;; Previous releases had used the file html-mode.el from Marc -;;; Andreessen. In that times the mode was called html-mode. I've -;;; changed the name of the mode to distinquish it from other -;;; html modes. But feel free to set a -;;; (defalias 'hm--html-mode 'html-mode) -;;; to get back the old name of the mode. -;;; -;;; In the earlier releases of the package the main file was -;;; hm--html-menu.el. This has been changed to hm--html-mode.el. -;;; -;;; Installation: -;;; -;;; Put this file and all the other files of the package -;;; in one of your load path directories and the -;;; following lines in your .emacs: -;;; -;;; (autoload 'hm--html-mode "hm--html-mode" "HTML major mode." t) -;;; -;;; (or (assoc "\\.html$" auto-mode-alist) -;;; (setq auto-mode-alist (cons '("\\.html$" . hm--html-mode) -;;; auto-mode-alist))) -;;; If there is already another html-mode (like psgml in the XEmacs -;;; 19.14, then you must put the following instead of the last form -;;; in your .emacs: -;;; (setq auto-mode-alist (cons '("\\.html$" . hm--html-mode) -;;; auto-mode-alist)) -;;; -;;; But you can also use the hm--html-minor-mode as an addition to -;;; the psgml html modes. For that you've to put the following line in -;;; your .emacs: -;;; (add-hook 'html-mode-hook 'hm--html-minor-mode) -;;; -;;; Note: This works only in an XEmacs version greater than 19.14 and -;;; also not in the XEmacs 20.0. -;;; -;;; Look at the file hm--html-configuration for further installation -;;; points. -;;; -;;; + +;; Description: + +;; This file defines the hm--html-mode, a mode for editing html +;; files. It is the main file of the package hm--html-menus. +;; Previous releases had used the file html-mode.el from Marc +;; Andreessen. In that times the mode was called html-mode. I've +;; changed the name of the mode to distinquish it from other +;; html modes. But feel free to set a +;; (defalias 'hm--html-mode 'html-mode) +;; to get back the old name of the mode. + +;; In the earlier releases of the package the main file was +;; hm--html-menu.el. This has been changed to hm--html-mode.el. + + +;; Installation: + +;; Put this file and all the other files of the package +;; in one of your load path directories and the +;; following lines in your .emacs: +;; (autoload 'hm--html-mode "hm--html-mode" "HTML major mode." t) + +;; (or (assoc "\\.html$" auto-mode-alist) +;; (setq auto-mode-alist (cons '("\\.html$" . hm--html-mode) +;; auto-mode-alist))) +;; If there is already another html-mode (like psgml in the XEmacs +;; 19.14, then you must put the following instead of the last form +;; in your .emacs: +;; (setq auto-mode-alist (cons '("\\.html$" . hm--html-mode) +;; auto-mode-alist)) + +;; But you can also use the hm--html-minor-mode as an addition to +;; the psgml html modes. For that you've to put the following line in +;; your .emacs: +;; (add-hook 'html-mode-hook 'hm--html-minor-mode) + +;; Note: This works only in an XEmacs version greater than 19.14 and +;; also not in the XEmacs 20.0. + +;; Look at the file hm--html-configuration for further installation +;; points. + +;;; Code: (require 'font-lock) (require 'cl) @@ -99,7 +105,7 @@ (defconst hm--html-menus-package-name "hm--html-menus") -(defconst hm--html-menus-package-version "5.7") +(defconst hm--html-menus-package-version "5.8") ;;; Generate the help buffer faces @@ -160,14 +166,22 @@ (hm--install-html-menu hm--html-mode-pulldown-menu-name) (make-variable-buffer-local 'write-file-hooks) (add-hook 'write-file-hooks 'hm--html-maybe-new-date-and-changed-comment) - (put major-mode 'font-lock-defaults '((hm--html-font-lock-keywords - hm--html-font-lock-keywords-1 - hm--html-font-lock-keywords-2) - t - t - nil - nil - )) + (if (adapt-xemacsp) + (put major-mode 'font-lock-defaults '((hm--html-font-lock-keywords + hm--html-font-lock-keywords-1 + hm--html-font-lock-keywords-2) + t + t + nil + nil)) + (make-local-variable 'font-lock-defaults) + (setq font-lock-defaults '((hm--html-font-lock-keywords + hm--html-font-lock-keywords-1 + hm--html-font-lock-keywords-2) + t + t + nil + nil))) (run-hooks 'hm--html-mode-hook)) ;;;; Minor Modes @@ -240,10 +254,15 @@ (if (null arg) (not hm--html-minor-mode) (> (prefix-numeric-value arg) 0))) (if hm--html-minor-mode - (hm--install-html-menu hm--html-minor-mode-pulldown-menu-name) - (if (and current-menubar (assoc hm--html-minor-mode-pulldown-menu-name - current-menubar)) - (delete-menu-item (list hm--html-minor-mode-pulldown-menu-name)))) + (progn + (hm--install-html-menu hm--html-minor-mode-pulldown-menu-name) + (when (adapt-emacs19p) + (hm--html-add-major-menu-to-minor-menus))) + (when (and current-menubar (assoc hm--html-minor-mode-pulldown-menu-name + current-menubar)) + (delete-menu-item (list hm--html-minor-mode-pulldown-menu-name))) + (when (adapt-emacs19p) + (hm--html-remove-major-menu-from-minor-menus))) ) @@ -324,3 +343,6 @@ ;;; Announce the feature hm--html-configuration (provide 'hm--html-mode) + + +;;; hm--html-mode.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/hm--html-menus/hm--html.el --- a/lisp/hm--html-menus/hm--html.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/hm--html-menus/hm--html.el Mon Aug 13 09:51:16 2007 +0200 @@ -1,4 +1,4 @@ -;;; $Id: hm--html.el,v 1.8 1997/06/06 00:57:04 steve Exp $ +;;; $Id: hm--html.el,v 1.9 1997/07/26 22:09:45 steve Exp $ ;;; ;;; Copyright (C) 1993 - 1997 Heiko Muenkel ;;; email: muenkel@tnt.uni-hannover.de @@ -2943,7 +2943,7 @@ (newline) (indent-according-to-mode) (forward-line -1) - (unless (= (util-return-end-of-line) (point)) + (unless (= (hm--html-return-end-of-line) (point)) (end-of-line) (newline)) (newline) @@ -4054,8 +4054,6 @@ (hm--html-greater-than) (setq hm--just-insert-greater-than nil)) (insert ?>) - ;; Next line added by Bob Weiner, Altrasoft, 11/21/96. - #+infodock (if id-html-auto-indent (indent-according-to-mode)) (setq hm--just-insert-greater-than t))) @@ -4238,14 +4236,18 @@ HTML_CONFIG_FILE; normaly hm--html-configuration.el(c)) is loaded. At second a site config file is loaded, if the environment variable HTML_SITE_CONFIG_FILE or the lisp variable `hm--html-site-config-file' -is set to such a file. +is set to such a file and if the emacs wasn't started with the +flag -no-site-file. At least the user config file (determined by the environment variable HTML_USER_CONFIG_FILE; normaly the file ~/.hm--html-configuration.el(c)). If no HTML_CONFIG_FILE exists, then the file hm--html-configuration.el(c) is searched in one of the lisp load path directories. If no HTML_USER_CONFIG_FILE exists, then the variable `hm--html-user-config-file' is checked. If this variable is nil or the file -also doesn't exist, then the file ~/.hm--html-configuration.el(c) is used." +also doesn't exist, then the file ~/.hm--html-configuration.el(c) is used. +In this case it is possible to use another home directory by using the -u +flag for the emacs start. In all cases, the loading of the user configuration +file can be avoided by using the -q flag." (interactive) ;; at first the system config file (if (and (stringp (getenv "HTML_CONFIG_FILE")) @@ -4256,34 +4258,51 @@ (load-library "hm--html-configuration")) ;; at second the site config file - (if (and (stringp (getenv "HTML_SITE_CONFIG_FILE")) - (file-exists-p - (expand-file-name - (getenv "HTML_SITE_CONFIG_FILE")))) - (load-file (expand-file-name (getenv "HTML_SITE_CONFIG_FILE"))) - (when (and (boundp 'hm--html-site-config-file) - (stringp hm--html-site-config-file) - (file-exists-p (expand-file-name hm--html-site-config-file))) - (load-file (expand-file-name hm--html-site-config-file)))) + (when (or (and (boundp 'site-start-file) ;XEmacs + site-start-file) + (and (boundp 'site-run-file) ; Emacs 19 + site-run-file)) + (if (and (stringp (getenv "HTML_SITE_CONFIG_FILE")) + (file-exists-p + (expand-file-name + (getenv "HTML_SITE_CONFIG_FILE")))) + (load-file (expand-file-name (getenv "HTML_SITE_CONFIG_FILE"))) + (when (and (boundp 'hm--html-site-config-file) + (stringp hm--html-site-config-file) + (file-exists-p (expand-file-name hm--html-site-config-file))) + (load-file (expand-file-name hm--html-site-config-file))))) - ;; and now the user config file - (cond ((and (stringp (getenv "HTML_USER_CONFIG_FILE")) - (file-exists-p - (expand-file-name - (getenv "HTML_USER_CONFIG_FILE")))) - (load-file (expand-file-name (getenv "HTML_USER_CONFIG_FILE")))) - ((and (boundp 'hm--html-user-config-file) - (stringp hm--html-user-config-file) - (file-exists-p (expand-file-name hm--html-user-config-file))) - (load-file (expand-file-name hm--html-user-config-file))) - ((file-exists-p (expand-file-name "~/.hm--html-configuration.elc")) - (load-file (expand-file-name "~/.hm--html-configuration.elc"))) - ((file-exists-p (expand-file-name "~/.hm--html-configuration.el")) - (load-file (expand-file-name "~/.hm--html-configuration.el"))) - (t - (message (concat "WARNING: No HTML User Config File ! " - "Look at hm--html-load-config-files !"))) - ) + ;; and now the user config file + (when init-file-user ; may be something should be done for reloading + (cond ((and (stringp (getenv "HTML_USER_CONFIG_FILE")) + (file-exists-p + (expand-file-name + (getenv "HTML_USER_CONFIG_FILE")))) + (load-file (expand-file-name (getenv "HTML_USER_CONFIG_FILE")))) + ((and (boundp 'hm--html-user-config-file) + (stringp hm--html-user-config-file) + (file-exists-p (expand-file-name hm--html-user-config-file))) + (load-file (expand-file-name hm--html-user-config-file))) + ((file-exists-p (expand-file-name + (concat "~" + init-file-user + "/.hm--html-configuration.elc"))) + (load-file (expand-file-name + (concat "~" + init-file-user + "~/.hm--html-configuration.elc")))) + ((file-exists-p (expand-file-name + (concat "~" + init-file-user + "~/.hm--html-configuration.el"))) + (load-file (expand-file-name + (concat "~" + init-file-user + "~/.hm--html-configuration.el")))) + (t + (message (concat "WARNING: No HTML User Config File ! " + "Look at hm--html-load-config-files !"))) + )) ) diff -r 6866abce6aaf -r 6075d714658b lisp/hm--html-menus/internal-drag-and-drop.el --- a/lisp/hm--html-menus/internal-drag-and-drop.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/hm--html-menus/internal-drag-and-drop.el Mon Aug 13 09:51:16 2007 +0200 @@ -1,89 +1,111 @@ -;;; $Id: internal-drag-and-drop.el,v 1.4 1997/05/29 23:49:44 steve Exp $ -;;; -;;; Copyright (C) 1996, 1997 Heiko Muenkel -;;; email: muenkel@tnt.uni-hannover.de -;;; -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 1, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software -;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -;;; -;;; -;;; Description: -;;; -;;; This package provides functions to define and call internal -;;; drag and drop actions in the emacs. One could start such an -;;; action by clicking with the mouse in the source buffer and -;;; then in the destination buffer. The action could depend on -;;; the points where you've clicked with the mouse, on the state -;;; of the region, the point, the mark and any other properties -;;; of the source and the destination buffers. The actions are -;;; defined by the variable `idd-actions', which is a buffer local -;;; variable. The following is an example for the hm--html-mode: -;;; (defvar hm--html-idd-actions -;;; '((nil (((idd-if-major-mode-p . dired-mode) -;;; (idd-if-dired-file-on-line-p -;;; . ".*\\.\\(gif\\)\\|\\(jpq\\)")) -;;; hm--html-idd-add-include-image-from-dired-line) -;;; (((idd-if-major-mode-p . dired-mode) -;;; (idd-if-dired-no-file-on-line-p . nil)) -;;; hm--html-idd-add-file-link-to-file-on-dired-line) -;;; (((idd-if-major-mode-p . dired-mode) -;;; (idd-if-dired-no-file-on-line-p . t)) -;;; hm--html-idd-add-file-link-to-directory-of-buffer) -;;; (((idd-if-major-mode-p . w3-mode) -;;; (idd-if-url-at-point-p . t)) -;;; hm--html-idd-add-html-link-from-w3-buffer-point) -;;; (((idd-if-major-mode-p . w3-mode)) -;;; hm--html-idd-add-html-link-to-w3-buffer) -;;; (((idd-if-local-file-p . t)) -;;; hm--html-idd-add-file-link-to-buffer))) -;;; Look at the variable `idd-actions' for further descriptions. -;;; -;;; -;;; -;;; Installation: -;;; -;;; Put this file in one of your load path directories. -;;; -;;; Put the following in your .emacs: -;;; (autoload 'idd-mouse-drag-and-drop "internal-drag-and-drop" -;;; "Performs a drag and drop action. -;;; At first you must click on the source and -;;; after that on the destination." -;;; t) -;;; -;;; Define actions in the variable `idd-actions'. -;;; -;;; The variable `idd-global-mouse-keys' defines the mouse keys, -;;; which are bound to the drag and drop command. -;;; -;;; The variable `idd-global-help-mouse-keys' defines the mouse keys, -;;; which are bound to the drag and drop help command. -;;; -;;; The variable `idd-drag-and-drop-mouse-binding-type' determines -;;; if you've to hold a mouse button down during moving the mouse -;;; from the source to the destination or not. -;;; -;;; Emacs 19 users should read carefully the whole comments of -;;; `idd-drag-and-drop-mouse-binding-type', `idd-global-mouse-keys' -;;; and `idd-global-help-mouse-keys', if they would like to change -;;; any of these variables or the mouse bindings! -;;; +;;; internal-drag-and-drop.el --- Internal drag and drop interface + +;; Copyright (C) 1996, 1997 Heiko Muenkel + +;; Author: Heiko Muenkel +;; Keywords: mouse + +;; $Id: internal-drag-and-drop.el,v 1.5 1997/07/26 22:09:46 steve Exp $ + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your +;; option) any later version. + +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; See the file COPYING. if not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not part of Emacs. + +;;; Commentary: + +;; Description: + +;; This package provides functions to define and call internal +;; drag and drop actions in the emacs. One could start such an +;; action by clicking with the mouse in the source buffer and +;; then in the destination buffer. The action could depend on +;; the points where you've clicked with the mouse, on the state +;; of the region, the point, the mark and any other properties +;; of the source and the destination buffers. The actions are +;; defined by the variable `idd-actions', which is a buffer local +;; variable. The following is an example for the hm--html-mode: +;; (defvar hm--html-idd-actions +;; '((nil (((idd-if-major-mode-p . dired-mode) +;; (idd-if-dired-file-on-line-p +;; . ".*\\.\\(gif\\)\\|\\(jpq\\)")) +;; hm--html-idd-add-include-image-from-dired-line) +;; (((idd-if-major-mode-p . dired-mode) +;; (idd-if-dired-no-file-on-line-p . nil)) +;; hm--html-idd-add-file-link-to-file-on-dired-line) +;; (((idd-if-major-mode-p . dired-mode) +;; (idd-if-dired-no-file-on-line-p . t)) +;; hm--html-idd-add-file-link-to-directory-of-buffer) +;; (((idd-if-major-mode-p . w3-mode) +;; (idd-if-url-at-point-p . t)) +;; hm--html-idd-add-html-link-from-w3-buffer-point) +;; (((idd-if-major-mode-p . w3-mode)) +;; hm--html-idd-add-html-link-to-w3-buffer) +;; (((idd-if-local-file-p . t)) +;; hm--html-idd-add-file-link-to-buffer))) +;; Look at the variable `idd-actions' for further descriptions. + + +;; Installation: + +;; Put this file in one of your load path directories. + +;; Put the following in your .emacs: +;; (autoload 'idd-mouse-drag-and-drop "internal-drag-and-drop" +;; "Performs a drag and drop action. +;; At first you must click on the source and +;; after that on the destination." +;; t) + +;; Define actions in the variable `idd-actions'. + +;; The variable `idd-global-mouse-keys' defines the mouse keys, +;; which are bound to the drag and drop command. + +;; The variable `idd-global-help-mouse-keys' defines the mouse keys, +;; which are bound to the drag and drop help command. + +;; The variable `idd-drag-and-drop-mouse-binding-type' determines +;; if you've to hold a mouse button down during moving the mouse +;; from the source to the destination or not. + +;; Emacs 19 users should read carefully the whole comments of +;; `idd-drag-and-drop-mouse-binding-type', `idd-global-mouse-keys' +;; and `idd-global-help-mouse-keys', if they would like to change +;; any of these variables or the mouse bindings! + +;;; Code: (require 'adapt) (require 'cl) -(defvar idd-drag-and-drop-mouse-binding-type 'click +(defgroup idd-drag-and-drop nil + "This package provides functions to define and call internal +drag and drop actions in the emacs. One could start such an +action by clicking with the mouse in the source buffer and +then in the destination buffer. The action could depend on +the points where you've clicked with the mouse, on the state +of the region, the point, the mark and any other properties +of the source and the destination buffers. The actions are +defined by the variable `idd-actions', which is a buffer local +variable." + :group 'mouse) + +(defcustom idd-drag-and-drop-mouse-binding-type 'click "*The type of the drag and drop mouse binding. The value maybe `click' or `press-button-during-move'. A value of `click' means, that you've to click over the source, leave @@ -100,7 +122,12 @@ Note: In the Emacs 19 you'll have to change also the keybindings of the drag and drop commands, if you change this variable. Look at the variables `idd-global-mouse-keys' and `idd-global-help-mouse-keys' for -this.") +this." + :group 'idd-drag-and-drop + :type '(choice (const :tag "Click on source and destination" + :value click) + (const :tag "Press button during mouse move" + :value press-button-during-move))) (defvar idd-global-mouse-keys (if (adapt-emacs19p) (if (eq idd-drag-and-drop-mouse-binding-type @@ -148,25 +175,25 @@ before loading the package internal-drag-and-drop, the mouse will be bind in the right way.") -(defvar idd-actions '((((idd-if-region-active-p . nil)) - (((idd-if-region-active-p . t)) - idd-action-copy-region)) - - (((idd-if-region-active-p . t)) - (((idd-if-region-active-p . t)) - idd-action-copy-replace-region)) - - (((idd-if-region-active-p . nil) - (idd-if-modifiers-p . nil)) - (((idd-if-region-active-p . t)) - idd-action-move-region)) - - (((idd-if-region-active-p . t) - (idd-if-modifiers-p . nil)) - (((idd-if-region-active-p . t)) - idd-action-move-replace-region)) - ) - "The list with actions, depending on the source and the destination. +(defcustom idd-actions '((((idd-if-region-active-p . nil)) + (((idd-if-region-active-p . t)) + idd-action-copy-region)) + + (((idd-if-region-active-p . t)) + (((idd-if-region-active-p . t)) + idd-action-copy-replace-region)) + + (((idd-if-region-active-p . nil) + (idd-if-modifiers-p . nil)) + (((idd-if-region-active-p . t)) + idd-action-move-region)) + + (((idd-if-region-active-p . t) + (idd-if-modifiers-p . nil)) + (((idd-if-region-active-p . t)) + idd-action-move-replace-region)) + ) + "*The list with actions, depending on the source and the destination. The list looks like: '(( ( ) ( ) @@ -214,13 +241,59 @@ ist a function, which has two arguments, the first specifies the source and the second the destination. Look at the function definition of `idd-action-copy-region' and `idd-action-copy-replace-region'. They are -examples for such actions.") +examples for such actions." + :group 'idd-drag-and-drop + :type 'list) (make-variable-buffer-local 'idd-actions) -(defvar idd-help-instead-of-action nil +(defcustom idd-help-instead-of-action nil "*If this variable is t, then a help buffer is displayed. -No action will be performed if this variable is t.") +No action will be performed if this variable is t. + +Note: You can also use the help mouse key instead of setting +this to t." + :group 'idd-drag-and-drop + :type 'boolean) + +(defcustom idd-mouse-pointer-image "drop" + "*The name of the image used as mouse pointer during drag and drop. +The image must be in the directory `idd-data-directory'. +Run the command `idd-make-drag-and-drop-pointer-glyph' after changing +this variable." + :group 'idd-drag-and-drop + :type 'file) + +(defcustom idd-data-directory (file-name-as-directory + (expand-file-name "idd" data-directory)) + "Data directory for the file `idd-mouse-pointer-image'. +Run the command `idd-make-drag-and-drop-pointer-glyph' after changing +this variable." + :group 'idd-drag-and-drop + :type 'directory) + +(defcustom idd-overwrite-mouse-pointers + (if (adapt-xemacsp) + '(text-pointer-glyph + nontext-pointer-glyph + selection-pointer-glyph) + nil) + "*A list with pointer glyph variables, which should be overwritten +by the idd-drag-and-drop-pointer-glyph. If it is nil, the pointer +wont be changed. Currently it must be nil in the Emacs." + :group 'idd-drag-and-drop + :type '(repeat lisp)) + +(defvar idd-drag-and-drop-pointer-glyph nil +; (if idd-overwrite-mouse-pointers +; (make-pointer-glyph +; (vector 'autodetect :data idd-mouse-pointer-image)) +; nil) + "The shape of the mouse-pointer when internal drag and drop is active.") + +(defvar idd-original-pointer-image-instances nil + "Internal variable. Alist with the saved images instances of the pointers. +This list is used to restore the old mouse pointers.") (defvar idd-help-start-action-keymap nil "Keymap used in an extent in the help buffer to start the action.") @@ -242,6 +315,49 @@ 'source-or-destination '(cdr specification)))) +(defun idd-get-old-pointer-image-instances (mouse-pointers) + "Returns an alist with the pointer variables and there image instances." + (cond ((not mouse-pointers) nil) + (t (cons (cons (car mouse-pointers) + (glyph-image-instance (eval (car mouse-pointers)))) + (idd-get-old-pointer-image-instances (cdr mouse-pointers)))))) + +(defun idd-set-drag-and-drop-pointer-glyphs-1 (mouse-pointers + drag-and-drop-pointer-glyph) + "Internal function." + (cond ((not mouse-pointers)) + (t (set-glyph-image (eval (car mouse-pointers)) + (glyph-image-instance drag-and-drop-pointer-glyph)) + (idd-set-drag-and-drop-pointer-glyphs-1 (cdr mouse-pointers) + drag-and-drop-pointer-glyph) + ))) + +(defun idd-set-drag-and-drop-pointer-glyphs () + "Set the shape of some pointers to the drag and drop shape. +Only the pointers in the list `idd-overwrite-mouse-pointers' are +used." + (unless (or idd-original-pointer-image-instances + (not idd-overwrite-mouse-pointers)) + (setq idd-original-pointer-image-instances + (idd-get-old-pointer-image-instances idd-overwrite-mouse-pointers)) + (idd-set-drag-and-drop-pointer-glyphs-1 idd-overwrite-mouse-pointers + idd-drag-and-drop-pointer-glyph))) + +(defun idd-restore-original-pointer-glyphs-1 (pointer-alist) + "Internal function." + (cond ((not pointer-alist)) + (t (set-glyph-image (eval (car (car pointer-alist))) + (cdr (car pointer-alist))) + (idd-restore-original-pointer-glyphs-1 (cdr pointer-alist))))) + +(defun idd-restore-original-pointer-glyphs () + "Restores the original pointer shapes." + (interactive) + (when idd-overwrite-mouse-pointers + (idd-restore-original-pointer-glyphs-1 + idd-original-pointer-image-instances) + (setq idd-original-pointer-image-instances nil))) + (defun idd-compare-specifications-1 (source-or-destination specifications value) @@ -678,6 +794,7 @@ `idd-mouse-drag-and-drop-click' is, that you can't select a destination region." (interactive "@e") + (idd-set-drag-and-drop-pointer-glyphs) (let ((drag-and-drop-message "Drag&Drop: Leave the button over the destination!") (source (idd-get-source-or-destination-alist source-event)) @@ -702,7 +819,8 @@ (idd-call-action (idd-get-action source destination idd-actions) source destination))) - (t (message "Wrong event! Exit drag and drop.") nil)))) + (t (message "Wrong event! Exit drag and drop.") nil))) + (idd-restore-original-pointer-glyphs)) (defun idd-mouse-drag-and-drop-click (source-event) "Performs a drag and drop action. @@ -710,6 +828,7 @@ This must be bind to a mouse button. The SOURCE-EVENT must be a button-press-event." (interactive "@e") + (idd-set-drag-and-drop-pointer-glyphs) (let ((drag-and-drop-message "Drag&Drop: Click on the destination!") (source (idd-get-source-or-destination-alist source-event)) (destination nil) @@ -756,7 +875,8 @@ ;; (setq idd-last-source source) ;; (setq idd-last-destination destination) - )) + ) + (idd-restore-original-pointer-glyphs)) (defun idd-help-start-action (event) "Used to start the action from the help buffer." @@ -769,6 +889,34 @@ idd-help-destination) (delete-extent idd-help-start-extent)) +(if (adapt-xemacsp) + (progn + + (defun idd-make-drag-and-drop-pointer-glyph () + "Creates the drag and drop pointer glyph. +You've to rerun this, if you change either the variable +`idd-data-directory' or `idd-mouse-pointer-image'." + (interactive) + (let ((mouse-pointer-image (if (and idd-data-directory + idd-mouse-pointer-image) + (expand-file-name + (file-name-nondirectory + idd-mouse-pointer-image) + idd-data-directory) + idd-mouse-pointer-image))) + (if (and mouse-pointer-image + (file-exists-p mouse-pointer-image)) + (setq idd-drag-and-drop-pointer-glyph + (make-pointer-glyph + (vector 'autodetect :data mouse-pointer-image))) + (setq idd-drag-and-drop-pointer-glyph (make-pointer-glyph)) + (message + "Warning: Can't find drag and drop mouse pointer image!")))) + + (idd-make-drag-and-drop-pointer-glyph) + + )) + ;; keymap for help buffer extents (if (not idd-help-start-action-keymap) (progn @@ -790,3 +938,5 @@ (provide 'internal-drag-and-drop) + +;;; internal-drag-and-drop ends here diff -r 6866abce6aaf -r 6075d714658b lisp/hm--html-menus/tmpl-minor-mode.el --- a/lisp/hm--html-menus/tmpl-minor-mode.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/hm--html-menus/tmpl-minor-mode.el Mon Aug 13 09:51:16 2007 +0200 @@ -1,65 +1,75 @@ ;;; tmpl-minor-mode.el --- Template Minor Mode -;;; -;;; $Id: tmpl-minor-mode.el,v 1.5 1997/05/29 23:49:44 steve Exp $ -;;; -;;; Copyright (C) 1993 - 1997 Heiko Muenkel -;;; email: muenkel@tnt.uni-hannover.de -;;; -;;; Keywords: data tools -;;; -;;; This program is free software; you can redistribute it and/or modify -;;; it under the terms of the GNU General Public License as published by -;;; the Free Software Foundation; either version 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; You should have received a copy of the GNU General Public License -;;; along with this program; if not, write to the Free Software -;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. -;;; -;;; + +;; Copyright (C) 1993 - 1997 Heiko Muenkel + +;; Author: Heiko Muenkel +;; Keywords: data tools + +;; $Id: tmpl-minor-mode.el,v 1.6 1997/07/26 22:09:46 steve Exp $ + +;; This file is part of XEmacs. + +;; XEmacs is free software; you can redistribute it and/or modify it +;; under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your +;; option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; See the file COPYING. if not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA + +;;; Synched up with: Not part of Emacs. + ;;; Commentary: -;;; -;;; This file contains functions to expand templates. -;;; Look at the file templates-syntax.doc for the syntax of the -;;; templates. -;;; There are the following 2 interactive functions to expand -;;; templates: -;;; tmpl-expand-templates-in-region -;;; tmpl-expand-templates-in-buffer -;;; The following two interactive functions are to escape the -;;; unescaped special template signs: -;;; tmpl-escape-tmpl-sign-in-region -;;; tmpl-escape-tmpl-sign-in-buffer -;;; The following function ask for a name of a template file, inserts -;;; the template file and expands the templates: -;;; tmpl-insert-template-file -;;; If you want to use keystrokes to call the above functions, you must -;;; switch the minor mode tmpl-mode on with `tmpl-minor-mode'. After -;;; that, the following keys are defined: -;;; `C-c x' = tmpl-expand-templates-in-region -;;; `C-c C-x' = tmpl-expand-templates-in-buffer -;;; `C-c ESC' = tmpl-escape-tmpl-sign-in-region -;;; `C-c C-ESC' = tmpl-escape-tmpl-sign-in-buffer -;;; Type again `M-x tmpl-minor-mode' to switch the template minor mode off. -;;; -;;; This file needs also the file adapt.el ! -;;; -;;; Installation: -;;; -;;; Put this file in one of your lisp directories and the following -;;; lisp command in your .emacs: -;;; (load-library "templates") -;;; + +;; Description: +;; This file contains functions to expand templates. +;; Look at the file templates-syntax.doc for the syntax of the +;; templates. +;; There are the following 2 interactive functions to expand +;; templates: +;; tmpl-expand-templates-in-region +;; tmpl-expand-templates-in-buffer +;; The following two interactive functions are to escape the +;; unescaped special template signs: +;; tmpl-escape-tmpl-sign-in-region +;; tmpl-escape-tmpl-sign-in-buffer +;; The following function ask for a name of a template file, inserts +;; the template file and expands the templates: +;; tmpl-insert-template-file +;; If you want to use keystrokes to call the above functions, you must +;; switch the minor mode tmpl-mode on with `tmpl-minor-mode'. After +;; that, the following keys are defined: +;; `C-c x' = tmpl-expand-templates-in-region +;; `C-c C-x' = tmpl-expand-templates-in-buffer +;; `C-c ESC' = tmpl-escape-tmpl-sign-in-region +;; `C-c C-ESC' = tmpl-escape-tmpl-sign-in-buffer +;; Type again `M-x tmpl-minor-mode' to switch the template minor mode off. + +;; This file needs also the file adapt.el ! + + +;; Installation: + +;; Put this file in one of your lisp directories and the following +;; lisp command in your .emacs: +;; (load-library "templates") + +;;; Code: (require 'adapt) +(defgroup tmpl-minor nil + "A package for inserting and expanding templates." + :group 'data) -(defvar tmpl-template-dir-list nil +(defcustom tmpl-template-dir-list nil "*A list of directories with the template files. If it is nil, then the default-directory will be used. If more than one directory is given, then the @@ -68,22 +78,30 @@ This variable is used in the commands for inserting templates. Look at `tmpl-insert-template-file-from-fixed-dirs' and at `tmpl-insert-template-file'. The command `tmpl-insert-template-file' -uses only the car of the list (if it is a list).") +uses only the car of the list (if it is a list)." + :group 'tmpl-minor + :type '(choice (const :tag "default-directory" :value nil) + (repeat directory))) -(defvar tmpl-automatic-expand t +(defcustom tmpl-automatic-expand t "*An inserted template will be automaticly expanded, if this is t. This variable is used in the commands for inserting templates. Look at `tmpl-insert-template-file-from-fixed-dirs' and -at `tmpl-insert-template-file'.") +at `tmpl-insert-template-file'." + :group 'tmpl-minor + :type 'boolean) -(defvar tmpl-filter-regexp ".*\\.tmpl$" + +(defcustom tmpl-filter-regexp ".*\\.tmpl$" "*Regexp for filtering out non template files in a directory. It is used in `tmpl-insert-template-file-from-fixed-dirs' to allow only the selecting of files, which are matching the regexp. If it is nil, then the Filter \".*\\.tmpl$\" is used. Set it to \".*\" if you want to disable the filter function or -use the command `tmpl-insert-template-file'.") +use the command `tmpl-insert-template-file'." + :group 'tmpl-minor + :type 'string) (defvar tmpl-history-variable-name 'tmpl-history-variable "The name of the history variable. @@ -95,8 +113,10 @@ (defvar tmpl-history-variable nil "The history variable. See also `tmpl-history-variable-name'.") -(defvar tmpl-sign "\000" "Sign which marks a template expression.") - +(defcustom tmpl-sign "\000" + "Sign which marks a template expression." + :group 'tmpl-minor + :type 'string) (defvar tmpl-name-lisp "LISP" "Name of the lisp templates.") @@ -138,22 +158,6 @@ (1+ (count-lines 1 (point)))))) -;(defun mapcar* (f &rest args) -; "Apply FUNCTION to successive cars of all ARGS, until one ends. -;Return the list of results." -; (if (not (memq 'nil args)) ; If no list is exhausted, -; (cons (apply f (mapcar 'car args)) ; Apply function to CARs. -; (apply 'mapcar* f ; Recurse for rest of elements. -; (mapcar 'cdr args))))) -; -;(defmacro tmpl-error (&rest args) -; "Widen the buffer and signal an error. -;Making error message by passing all args to `error', -;which passes all args to format." -; (widen) -; (error args)) - - (defun tmpl-search-next-template-sign (&optional dont-unescape) "Search the next template sign after the current point. It returns t, if a template is found and nil otherwise. @@ -241,25 +245,6 @@ TEMPLATE-ATTRIBUTE-LIST is the attribute list of the template." (end-of-line) (template-delete-template begin-of-template template-attribute-list)) -; (tmpl-save-excursion -; (if (or (not (assoc tmpl-attribute-dont-delete template-attribute-list)) -; (not (car (cdr (assoc tmpl-attribute-dont-delete -; template-attribute-list))))) -; (if (and (assoc tmpl-attribute-delete-line template-attribute-list) -; (car (cdr (assoc tmpl-attribute-delete-line -; template-attribute-list)))) -; ;; Delete the whole line -; (let ((end-of-region (progn (end-of-line) (point))) -; (start-of-region begin-of-template)) ; ausgetauscht -; (delete-region start-of-region end-of-region) -; (delete-char 1)) -; ;; Delete only the comment -; (let ((end-of-region (progn -; (end-of-line) -; (point))) -; (start-of-region (progn (goto-char begin-of-template) -; (point)))) -; (delete-region start-of-region end-of-region)))))) (defun tmpl-get-template-argument () @@ -517,7 +502,6 @@ "Directory with Templatefiles: " (car directories)))))) (unless (or (not history-variable) -; (string= answer (car internal-history))) (string= file (car (eval history-variable)))) (set history-variable (cons file (eval history-variable)))) file)) @@ -593,18 +577,6 @@ (tmpl-expand-templates-in-buffer)) file) -;(defun tmpl-insert-template-file (&optional template-dir automatic-expand) -; "Insert a template file and expand it, if AUTOMATIC-EXPAND is t. -;The TEMPLATE-DIR is the directory with the template files." -; (interactive) -; (insert-file -; (expand-file-name -; (read-file-name "Templatefile: " -; template-dir -; nil -; t))) -; (if automatic-expand -; (tmpl-expand-templates-in-buffer))) ;;; General utilities, which are useful in a template file (defun tmpl-util-indent-region (begin end) @@ -699,3 +671,5 @@ (provide 'tmpl-minor-mode) + +;;; tmpl-minor-mode ends here diff -r 6866abce6aaf -r 6075d714658b lisp/leim/quail.el --- a/lisp/leim/quail.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/leim/quail.el Mon Aug 13 09:51:16 2007 +0200 @@ -1481,7 +1481,7 @@ (defun quail-completion-list-translations (map key indent) (let ((translations (quail-get-translation (car map) key (length key)))) - (if (integerp translations) + (if (characterp translations) (insert "(1/1) 1." translations "\n") ;; We need only vector part. (setq translations (cdr translations)) diff -r 6866abce6aaf -r 6075d714658b lisp/mel/ChangeLog --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/mel/ChangeLog Mon Aug 13 09:51:16 2007 +0200 @@ -0,0 +1,530 @@ +1997-07-25 MORIOKA Tomohiko + + * MEL: Version 6.10.1 was released. + +1997-07-14 MORIOKA Tomohiko + + * mel-u.el (uuencode-external-decode-region): Use + `inhibit-read-only' instead of `(setq buffer-read-only nil)'. + +1997-07-09 Steven L Baur + + * mel-u.el (uuencode-external-decode-region): Force + buffer-read-only nil because it gets changed magically to t during + the call to `insert-file-contents'. + + +1997-07-14 MORIOKA Tomohiko + + * MEL: Version 6.10 was released. + +1997-07-14 MORIOKA Tomohiko + + * mel.el: Add autoload comments for command `mime-encode-region', + `mime-decode-region' and `mime-insert-encoded-file'. + +1997-07-13 MORIOKA Tomohiko + + * mel-q.el (quoted-printable-internal-encoding-limit): Change + initial value; 0 for XEmacs/mule; 1000 if mmencode is found; + otherwise nil; Don't use `quoted-printable-internal-encode-region' + for XEmacs/mule. + + * mel-q.el: Use `start' instead of `beg' for argument. + + * mel-q.el (quoted-printable-internal-encode-region): New + implementation. + + * mel-q.el (quoted-printable-quote-char): Change to `defsubst'; + use `aref'. + + * mel-q.el: Abolish unused function `byte-to-hex-string'. + +1997-07-01 Steven L Baur + + * mel/mel-q.el (q-encoding-encode-string): Fix Ebola-ified + comparison. (cf. [xemacs-beta:10342][tm-en:1367]) + + +1997-05-15 MORIOKA Tomohiko + + * MEL: Version 6.9.1 was released. + +Thu May 15 05:43:48 1997 MORIOKA Tomohiko + + * README.en (make install): Add LISPDIR. + +Tue May 13 14:59:52 1997 MORIOKA Tomohiko + + * Makefile (LISPDIR): New variable. + + * MEL-MK (config-mel): set LISPDIR. + + * MEL-CFG: Setting for load-path is modified. + + +1997-04-30 MORIOKA Tomohiko + + * MEL: Version 6.9 was released. + +Wed Apr 30 17:29:02 1997 MORIOKA Tomohiko + + * README.en (q-encoding-encode-string, q-encoding-decode-string): + Modify documentation. + +Wed Apr 30 17:24:32 1997 MORIOKA Tomohiko + + * mel.el, mel-q.el (q-encoding-encode-string, + q-encoding-decode-string): Add DOC-string. + +Wed Apr 30 17:14:46 1997 MORIOKA Tomohiko + + * mel.el (base64-insert-encoded-file, + quoted-printable-insert-encoded-file): Modify DOC-string. + + * mel-q.el (quoted-printable-insert-encoded-file): Add DOC-string. + +Wed Apr 30 17:09:57 1997 MORIOKA Tomohiko + + * mel-q.el (quoted-printable-encode-region, + quoted-printable-decode-region): Add DOC-string. + + * mel.el: Add autoload for `quoted-printable-encode-string' and + `quoted-printable-decode-string'. + + * mel-q.el (quoted-printable-encode-string, + quoted-printable-decode-string): Add DOC-string. + +Wed Apr 30 13:23:00 1997 MORIOKA Tomohiko + + * mel.el (base64-insert-encoded-file): DOC-string was modified. + + * mel-b.el (base64-insert-encoded-file): Add DOC-string. + +Wed Apr 30 13:15:12 1997 MORIOKA Tomohiko + + * mel-b.el (base64-encode-region, base64-decode-region): Add + DOC-string. + +Wed Apr 30 13:01:16 1997 MORIOKA Tomohiko + + * mel.el (base64-encode-string, base64-decode-string): Add + DOC-string. + + * mel-b.el (base64-encode-string, base64-decode-string): Add + DOC-string. + + * mel.el: autoload for `q-encoding-encode-string-for-text', + `q-encoding-encode-string-for-comment' and + `q-encoding-encode-string-for-phrase' were abolished. + +Tue Apr 29 11:47:35 1997 MORIOKA Tomohiko + + * README.en: New file. + + +1997-03-14 MORIOKA Tomohiko + + * MEL: Version 6.3 was released. + +Fri Mar 14 07:40:13 1997 MORIOKA Tomohiko + + * MEL-MK (config-mel): New function; load "MEL-CFG". + + * MEL-CFG: New file. + +Wed Mar 12 06:31:16 1997 MORIOKA Tomohiko + + * MEL-MK: mk-mel was renamed to MEL-MK. + +Mon Mar 10 15:15:09 1997 MORIOKA Tomohiko + + * mel-u.el: Variable `mime/tmp-dir' was abolished. + + Require mel. + + (uuencode-external-decoder): Use variable `mime-temp-directory' + instead of `mime/tmp-dir'. + + (uuencode-external-decode-region): Use variable + `mime-temp-directory' instead of `mime/tmp-dir'. + + * mel.el (mime-temp-directory): New variable. + + * mel-u.el (uuencode-external-decode-region): Use + `as-binary-input-file'. + + +1997-03-10 MORIOKA Tomohiko + + * MEL: Version 6.2.3 was released. + + * mel-g.el (gzip64-external-encoder, gzip64-external-decoder): Use + `exec-installed-p' instead of `file-installed-p' to search + mmencode. + + +1997-03-03 MORIOKA Tomohiko + + * MEL: Version 6.2.2 was released. + + * mel-g.el (gzip64-external-encoder, gzip64-external-decoder): + Search mmencode from `exec-path'. (cf. [xemacs-beta:3730]) + + +Wed Jan 1 11:01:44 1997 MORIOKA Tomohiko + + * MEL: Version 6.2.1 was released. + +Wed Dec 28 13:57:22 1996 Martin Buchholz + + * mk-mel: Use variable `default-directory' instead of `(getenv + "PWD")'. (cf. [tm-en:1084]) + + * Makefile: A makefile command like `cd some-dir; do-something' is + generally better written as: `cd some-dir && do-something' since + if the cd fails (usually because of a coding or file-system error) + the do-something is not executed in the wrong + directory. (cf. [tm-en:1084]) + + +Wed Dec 25 06:30:59 1996 MORIOKA Tomohiko + + * MEL: Version 6.2 was released. + + * mel.el (mime-encoding-method-alist, mime-decoding-method-alist, + mime-file-encoding-method-alist): Add DOC-string. + +Wed Dec 25 01:08:47 1996 Steven L Baur + + * mel.el: to decode `x-uuencode'. (cf. [tm-en:1062]) + + +Thu Oct 31 16:05:41 1996 MORIOKA Tomohiko + + * MEL: Version 6.0.1 was released. + +Mon Oct 28 12:53:09 1996 MORIOKA Tomohiko + + * mel-q.el (quoted-printable-insert-encoded-file): New constant. + (q-encoding-encode-string): New implementation; Function + `q-encoding-encode-string-for-text', + `q-encoding-encode-string-for-comment' and + `q-encoding-encode-string-for-phrase' were abolished. + + +Mon Sep 23 16:53:19 1996 MORIOKA Tomohiko + + * MEL: Version 6.0 was released. + + * mel.el (mime-file-encoding-method-alist): Use function + `insert-binary-file-contents-literally'. + + +Fri Aug 23 07:31:32 1996 MORIOKA Tomohiko + + * MEL: Version 5.6.1 was released. + +Thu Aug 22 14:49:14 1996 MORIOKA Tomohiko + + * MEL-ELS: Variable `mel-el-files' and `mel-elc-files' were + abolished. + +Thu Aug 22 14:47:45 1996 MORIOKA Tomohiko + + * mk-mel: Variable `el-file-mode' was abolished. + Function `install-el', `install-el-files', `install-elc' and + `install-elc-files' were abolished. + (install-mel): Use function `install-elisp-modules'. + +Mon Aug 19 16:55:27 1996 MORIOKA Tomohiko + + * mk-mel (compile-mel): Use function `compile-elisp-modules'. + +Mon Aug 19 16:53:14 1996 MORIOKA Tomohiko + + * MEL-ELS (mel-modules): changed to list of symbols. + + * mk-mel: mel-els was renamed to MEL-ELS. + + +Thu Jun 27 22:28:57 1996 MORIOKA Tomohiko + + * MEL: Version 5.6 was released. + +Wed Jun 26 16:25:13 1996 MORIOKA Tomohiko + + * mel-g.el (gzip64-external-encode-region): regularize line break + code (for OS/2). + +Wed Jun 26 16:23:39 1996 MORIOKA Tomohiko + + * mel-g.el (gzip64-external-encode-region): Use macro + `as-binary-process'. + (gzip64-external-decode-region): Use macro `as-binary-process'. + +Wed Jun 26 16:21:11 1996 MORIOKA Tomohiko + + * mel-u.el (uuencode-external-encode-region): regularize line + break code (for OS/2). + +Wed Jun 26 16:18:39 1996 MORIOKA Tomohiko + + * mel-u.el (uuencode-external-encode-region): Use macro + `as-binary-process'. + (uuencode-external-decode-region): Use macro `as-binary-process'. + +Wed Jun 26 16:13:39 1996 MORIOKA Tomohiko + + * mel-q.el (quoted-printable-external-encode-region): Use macro + `as-binary-process'. + (quoted-printable-external-decode-region): Use macro + `as-binary-process'. + + * mel-b.el (base64-external-encode-region): Use macro + `as-binary-process'. + (base64-external-decode-region): Use macro `as-binary-process'. + +Wed Jun 12 05:30:23 1996 MORIOKA Tomohiko + + * MEL: Version 5.5 was released. + +Mon Jun 10 05:06:27 1996 MORIOKA Tomohiko + + * mel-q.el (q-encoding-printable-char-p): New function. + + (q-encoding-encoded-length): Use function + `q-encoding-printable-char-p'. + + +Sun Jun 9 04:10:08 1996 MORIOKA Tomohiko + + * MEL: Version 5.4 was released. + +Fri Jun 7 14:06:59 1996 MORIOKA Tomohiko + + * mel-g.el (gzip64-external-encode-region): fixed. + (gzip64-external-decode-region): fixed. + +Fri Jun 7 14:04:09 1996 MORIOKA Tomohiko + + * mel-q.el (quoted-printable-external-encode-region): fixed. + (quoted-printable-external-decode-region): fixed. + +Fri Jun 7 12:12:47 1996 MORIOKA Tomohiko + + * mel-u.el (uuencode-external-encode-region): fixed. + (uuencode-external-decode-region): fixed. + +Thu Jun 6 08:46:55 1996 MORIOKA Tomohiko + + * mel.el (mime-file-encoding-method-alist): New variable. + (mime-insert-encoded-file): New function. + + * mel-g.el (gzip64-external-encode-region): fixed + `default-process-coding-system'. + + (gzip64-external-decode-region): fixed + `default-process-coding-system'. + +Thu Jun 6 07:51:30 1996 MORIOKA Tomohiko + + * mel-u.el (uuencode-external-encode-region): fixed + `default-process-coding-system'. + + (uuencode-external-decode-region): fixed + `default-process-coding-system'. + +Thu Jun 6 07:48:44 1996 MORIOKA Tomohiko + + * mel-q.el (quoted-printable-external-encode-region): fixed + `default-process-coding-system'. + + (quoted-printable-external-decode-region): fixed + `default-process-coding-system'. + +Thu Jun 6 07:09:23 1996 MORIOKA Tomohiko + + * mel-b.el (base64-external-encode-region): fixed + `default-process-coding-system'. + + (base64-external-decode-region): fixed + `default-process-coding-system'. + + +Mon Jun 3 14:43:47 1996 MORIOKA Tomohiko + + * MEL: Version 5.2 was released. + +Wed May 29 12:54:45 1996 MORIOKA Tomohiko + + * mel-g.el: Don't use function `define-program-coding-system' and + `define-program-kanji-code'. + (gzip64-external-encode-region): set for process code. + (gzip64-external-decode-region): set for process code. + +Wed May 29 12:49:41 1996 MORIOKA Tomohiko + + * mel-u.el: Don't use function `define-program-coding-system' and + `define-program-kanji-code'. + (uuencode-external-encode-region): set for process code. + (uuencode-external-decode-region): set for process code. + +Wed May 29 12:40:12 1996 MORIOKA Tomohiko + + * mel-q.el: Don't use function `define-program-coding-system' and + `define-program-kanji-code'. + (quoted-printable-external-encode-region): set for process code. + (quoted-printable-external-decode-region): set for process code. + +Wed May 29 10:54:01 1996 MORIOKA Tomohiko + + * mel-b.el: Don't use function `define-program-coding-system' and + `define-program-kanji-code'. + (base64-external-encode-region): set for process code. + (base64-external-decode-region): set for process code. + +Wed May 29 08:10:15 1996 MORIOKA Tomohiko + + * mel-g.el (gzip64-insert-encoded-file): New function. + +Wed May 29 08:00:01 1996 MORIOKA Tomohiko + + * mel-g.el: Shuhei KOBAYASHI's address was changed. + + * mel-u.el (uuencode-insert-encoded-file): New function. + +Wed May 29 07:30:48 1996 MORIOKA Tomohiko + + * mel-q.el (quoted-printable-insert-encoded-file): New function. + + * mel-b.el (base64-insert-encoded-file): New function. + + +Tue May 28 03:31:13 1996 MORIOKA Tomohiko + + * MEL: Version 5.0 was released. + + * mel.el: Function `mime/encode-region' and `mime/decode-region' + were abolished. + + +Thu May 23 01:32:04 1996 MORIOKA Tomohiko + + * MEL: Version 4.7.1 was released. + +Wed May 22 02:20:35 1996 MORIOKA Tomohiko + + * mel.el (mime-encode-region): New function; Order of arguments + was changed. + (mime-decode-region): New function; Order of arguments was + changed. + (mime/encode-region): New implementation. + (mime/decode-region): New implementation. + + +Wed May 15 21:19:12 1996 MORIOKA Tomohiko + + * MEL: Version 4.7 was released. + + * mel-b.el (base64-internal-decode-region): fixed about last line + which does not have line break. + + +Tue May 14 02:43:41 1996 MORIOKA Tomohiko + + * MEL: Version 4.6 was released. + +Sun May 12 17:43:04 1996 MORIOKA Tomohiko + + * mel-b.el (base64-decode-1): New spec; Argument was changed; + Return string instead of list of characters. + (base64-decode-string): modified for new spec of function + `base64-decode-1'. + (base64-internal-decode-region): fixed. + +Sun May 12 17:05:17 1996 MORIOKA Tomohiko + + * mel-b.el (base64-encode-1): New spec; Argument was changed; + Return string instead of list of characters. + (base64-encode-string): modified for new spec of function + `base64-encode-1'. + (base64-internal-decode-region): fixed. + +Sun May 12 16:17:11 1996 MORIOKA Tomohiko + + * mel-b.el: Function `base64-encode-chars' was abolished. + (base64-encode-1): New spec; use function `base64-num-to-char. + (base64-encode-string): Use function `base64-encode-1' instead of + `base64-encode-chars'. + +Sun May 12 15:50:26 1996 MORIOKA Tomohiko + + * mel-b.el: Function `base64-decode-chars' was abolished. + (base64-decode-1): New spec; use function `base64-char-to-num'. + (base64-decode-string): Use function `base64-decode-1' instead of + `base64-decode-chars'. + + +Sat May 11 08:12:23 1996 MORIOKA Tomohiko + + * MEL: Version 4.2 was released. + + * mel-b.el (base64-encode-1): don't use function `base64-mask'. + Function `base64-mask' was abolished. + +Sat May 11 07:52:05 1996 MORIOKA Tomohiko + + * mel-b.el (base64-decode-1): don't use function `base64-mask'. + +Sat May 11 06:35:20 1996 MORIOKA Tomohiko + + * mel-b.el (base64-internal-decode-region): New implementation. + + +Wed Mar 13 16:40:46 1996 MORIOKA Tomohiko + + * MEL: Version 3.5 was released. + +Mon Mar 11 14:29:31 1996 MORIOKA Tomohiko + + * mel-q.el (byte-to-hex-string): New function. + +Tue Mar 12 11:19:02 1996 Shuhei KOBAYASHI + + * mel-els (mel-modules): "mel-g" was added. (cf.[tm-ja:1661]) + + * mel.el: gzip64 support was added. (cf.[tm-ja:1661]) + + * mel-g.el: New file. + gzip64 encoder/decoder. `gzip64' is an experimental encoding. + (cf.[tm-ja:1661]) + + +Mon Mar 4 09:13:20 1996 Morioka Tomohiko + + * MEL: Version 3.3.1 was released. + + * mel-els: New module + + * mk-mel: use mel-els file. + +Thu Jan 18 10:26:38 1996 Morioka Tomohiko + + * Makefile: Yoshiyuki Yamagami 's patch + was applied to specify `-no-site-file' option. (cf. [tm-ja:1474]) + +Thu Jan 18 01:55:25 1996 Yoshiyuki Yamagami + + * Makefile: specify `-no-site-file' option (cf. [tm-ja:1474]) + + +Wed Jan 9 19:09:44 1996 Morioka Tomohiko + + * MEL: version 3.3 was released. + +Tue Jan 9 18:25:22 1996 Morioka Tomohiko + + * mel-u.el (uuencode-external-decode-region): + don't display uuencode output. + (cf. [tm-en:253]) diff -r 6866abce6aaf -r 6075d714658b lisp/mel/mel-q.el --- a/lisp/mel/mel-q.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/mel/mel-q.el Mon Aug 13 09:51:16 2007 +0200 @@ -4,7 +4,7 @@ ;; Author: MORIOKA Tomohiko ;; Created: 1995/6/25 -;; Version: $Id: mel-q.el,v 1.4 1997/07/07 00:52:59 steve Exp $ +;; Version: $Id: mel-q.el,v 1.5 1997/07/26 22:09:47 steve Exp $ ;; Keywords: MIME, Quoted-Printable, Q-encoding ;; This file is part of MEL (MIME Encoding Library). @@ -29,82 +29,133 @@ (require 'emu) -;;; @ constants +;;; @ Quoted-Printable encoder ;;; (defconst quoted-printable-hex-chars "0123456789ABCDEF") -(defconst quoted-printable-octet-regexp - (concat "=[" quoted-printable-hex-chars - "][" quoted-printable-hex-chars "]")) + +(defsubst quoted-printable-quote-char (character) + (concat + "=" + (char-to-string (aref quoted-printable-hex-chars (ash character -4))) + (char-to-string (aref quoted-printable-hex-chars (logand character 15))) + )) - -;;; @ variables -;;; +(defun quoted-printable-internal-encode-region (start end) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char start) + (let ((col 0) + enable-multibyte-characters) + (while (< (point)(point-max)) + (cond ((>= col 75) + (insert "=\n") + (setq col 0) + ) + ((looking-at "^From ") + (replace-match "=46rom ") + (backward-char 1) + (setq col (+ col 6)) + ) + ((looking-at "[ \t]\n") + (forward-char 1) + (insert "=\n") + (forward-char 1) + (setq col 0) + ) + (t + (let ((chr (char-after (point)))) + (cond ((= chr ?\n) + (forward-char 1) + (setq col 0) + ) + ((or (= chr ?\t) + (and (<= 32 chr)(/= chr ?=)(< chr 127)) + ) + (forward-char 1) + (setq col (1+ col)) + ) + ((>= col 73) + (insert "=\n") + (setq col 0) + ) + (t + (delete-char 1) + (insert (quoted-printable-quote-char chr)) + (setq col (+ col 3)) + )) + ))) + ))))) (defvar quoted-printable-external-encoder '("mmencode" "-q") "*list of quoted-printable encoder program name and its arguments.") -(defvar quoted-printable-external-decoder '("mmencode" "-q" "-u") - "*list of quoted-printable decoder program name and its arguments.") +(defun quoted-printable-external-encode-region (start end) + (save-excursion + (save-restriction + (narrow-to-region start end) + (as-binary-process + (apply (function call-process-region) + start end (car quoted-printable-external-encoder) + t t nil (cdr quoted-printable-external-encoder)) + ) + ;; for OS/2 + ;; regularize line break code + (goto-char (point-min)) + (while (re-search-forward "\r$" nil t) + (replace-match "") + ) + ))) -(defvar quoted-printable-internal-encoding-limit 10000 +(defvar quoted-printable-internal-encoding-limit + (if (and (featurep 'xemacs)(featurep 'mule)) + 0 + (require 'file-detect) + (if (exec-installed-p "mmencode") + 1000 + (message "Don't found external encoder for Quoted-Printable!") + nil)) "*limit size to use internal quoted-printable encoder. If size of input to encode is larger than this limit, external encoder is called.") -(defvar quoted-printable-internal-decoding-limit nil - "*limit size to use internal quoted-printable decoder. -If size of input to decode is larger than this limit, -external decoder is called.") - - -;;; @ Quoted-Printable (Q-encode) encoder/decoder -;;; - -(defun byte-to-hex-string (num) - (concat (char-to-string (elt quoted-printable-hex-chars (ash num -4))) - (char-to-string (elt quoted-printable-hex-chars (logand num 15))) - )) - -(defun quoted-printable-quote-char (chr) - (concat "=" - (char-to-string (elt quoted-printable-hex-chars (ash chr -4))) - (char-to-string (elt quoted-printable-hex-chars (logand chr 15))) - )) - - -;;; @@ Quoted-Printable encoder/decoder for string -;;; +(defun quoted-printable-encode-region (start end) + "Encode current region by quoted-printable. +START and END are buffer positions. +This function calls internal quoted-printable encoder if size of +region is smaller than `quoted-printable-internal-encoding-limit', +otherwise it calls external quoted-printable encoder specified by +`quoted-printable-external-encoder'. In this case, you must install +the program (maybe mmencode included in metamail or XEmacs package)." + (interactive "r") + (if (and quoted-printable-internal-encoding-limit + (> (- end start) quoted-printable-internal-encoding-limit)) + (quoted-printable-external-encode-region start end) + (quoted-printable-internal-encode-region start end) + )) (defun quoted-printable-encode-string (string) "Encode STRING to quoted-printable, and return the result." - (let ((i 0)) - (mapconcat (function - (lambda (chr) - (cond ((eq chr ?\n) - (setq i 0) - "\n") - ((or (< chr 32) (< 126 chr) (eq chr ?=)) - (if (>= i 73) - (progn - (setq i 3) - (concat "=\n" (quoted-printable-quote-char chr)) - ) - (progn - (setq i (+ i 3)) - (quoted-printable-quote-char chr) - ))) - (t (if (>= i 75) - (progn - (setq i 1) - (concat "=\n" (char-to-string chr)) - ) - (progn - (setq i (1+ i)) - (char-to-string chr) - ))) - ))) - string ""))) + (with-temp-buffer + (insert string) + (quoted-printable-encode-region (point-min)(point-max)) + (buffer-string) + )) + +(defun quoted-printable-insert-encoded-file (filename) + "Encode contents of file FILENAME to quoted-printable, and insert the result. +It calls external quoted-printable encoder specified by +`quoted-printable-external-encoder'. So you must install the program +\(maybe mmencode included in metamail or XEmacs package)." + (interactive (list (read-file-name "Insert encoded file: "))) + (apply (function call-process) (car quoted-printable-external-encoder) + filename t nil (cdr quoted-printable-external-encoder)) + ) + + +;;; @ Quoted-Printable decoder +;;; (defun quoted-printable-decode-string (string) "Decode STRING which is encoded in quoted-printable, and return the result." @@ -134,27 +185,14 @@ ))) string ""))) +(defconst quoted-printable-octet-regexp + (concat "=[" quoted-printable-hex-chars + "][" quoted-printable-hex-chars "]")) -;;; @@ Quoted-Printable encoder/decoder for region -;;; - -(defun quoted-printable-internal-encode-region (beg end) +(defun quoted-printable-internal-decode-region (start end) (save-excursion (save-restriction - (narrow-to-region beg end) - (let ((str (buffer-substring beg end))) - (delete-region beg end) - (insert (quoted-printable-encode-string str)) - ) - (or (bolp) - (insert "=\n") - ) - ))) - -(defun quoted-printable-internal-decode-region (beg end) - (save-excursion - (save-restriction - (narrow-to-region beg end) + (narrow-to-region start end) (goto-char (point-min)) (while (re-search-forward "=\n" nil t) (replace-match "") @@ -170,47 +208,23 @@ )) ))) -(defun quoted-printable-external-encode-region (beg end) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (as-binary-process - (apply (function call-process-region) - beg end (car quoted-printable-external-encoder) - t t nil (cdr quoted-printable-external-encoder)) - ) - ;; for OS/2 - ;; regularize line break code - (goto-char (point-min)) - (while (re-search-forward "\r$" nil t) - (replace-match "") - ) - ))) +(defvar quoted-printable-external-decoder '("mmencode" "-q" "-u") + "*list of quoted-printable decoder program name and its arguments.") -(defun quoted-printable-external-decode-region (beg end) +(defun quoted-printable-external-decode-region (start end) (save-excursion (as-binary-process (apply (function call-process-region) - beg end (car quoted-printable-external-decoder) + start end (car quoted-printable-external-decoder) t t nil (cdr quoted-printable-external-decoder)) ))) -(defun quoted-printable-encode-region (beg end) - "Encode current region by quoted-printable. -START and END are buffer positions. -This function calls internal quoted-printable encoder if size of -region is smaller than `quoted-printable-internal-encoding-limit', -otherwise it calls external quoted-printable encoder specified by -`quoted-printable-external-encoder'. In this case, you must install -the program (maybe mmencode included in metamail or XEmacs package)." - (interactive "r") - (if (and quoted-printable-internal-encoding-limit - (> (- end beg) quoted-printable-internal-encoding-limit)) - (quoted-printable-external-encode-region beg end) - (quoted-printable-internal-encode-region beg end) - )) +(defvar quoted-printable-internal-decoding-limit nil + "*limit size to use internal quoted-printable decoder. +If size of input to decode is larger than this limit, +external decoder is called.") -(defun quoted-printable-decode-region (beg end) +(defun quoted-printable-decode-region (start end) "Decode current region by quoted-printable. START and END are buffer positions. This function calls internal quoted-printable decoder if size of @@ -220,25 +234,11 @@ the program (maybe mmencode included in metamail or XEmacs package)." (interactive "r") (if (and quoted-printable-internal-decoding-limit - (> (- end beg) quoted-printable-internal-decoding-limit)) - (quoted-printable-external-decode-region beg end) - (quoted-printable-internal-decode-region beg end) + (> (- end start) quoted-printable-internal-decoding-limit)) + (quoted-printable-external-decode-region start end) + (quoted-printable-internal-decode-region start end) )) - -;;; @@ Quoted-Printable encoder/decoder for file -;;; - -(defun quoted-printable-insert-encoded-file (filename) - "Encode contents of file FILENAME to quoted-printable, and insert the result. -It calls external quoted-printable encoder specified by -`quoted-printable-external-encoder'. So you must install the program -(maybe mmencode included in metamail or XEmacs package)." - (interactive (list (read-file-name "Insert encoded file: "))) - (apply (function call-process) (car quoted-printable-external-encoder) - filename t nil (cdr quoted-printable-external-encoder)) - ) - ;;; @ Q-encoding encode/decode string ;;; diff -r 6866abce6aaf -r 6075d714658b lisp/mel/mel-u.el --- a/lisp/mel/mel-u.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/mel/mel-u.el Mon Aug 13 09:51:16 2007 +0200 @@ -4,7 +4,7 @@ ;; Author: MORIOKA Tomohiko ;; Created: 1995/10/25 -;; Version: $Id: mel-u.el,v 1.4 1997/07/13 22:41:32 steve Exp $ +;; Version: $Id: mel-u.el,v 1.5 1997/07/26 22:09:47 steve Exp $ ;; Keywords: uuencode ;; This file is part of MEL (MIME Encoding Library). @@ -87,8 +87,11 @@ ;; The previous line causes the buffer to be made read-only, I ;; do not pretend to understand the control flow leading to this ;; but suspect it has something to do with image-mode. -slb - (setq buffer-read-only nil) - (delete-file filename) + ;; Use `inhibit-read-only' to avoid to force + ;; buffer-read-only nil. - tomo. + (let ((inhibit-read-only t)) + (delete-file filename) + ) )) ))) diff -r 6866abce6aaf -r 6075d714658b lisp/mel/mel.el --- a/lisp/mel/mel.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/mel/mel.el Mon Aug 13 09:51:16 2007 +0200 @@ -5,7 +5,7 @@ ;; Author: MORIOKA Tomohiko ;; modified by Shuhei KOBAYASHI ;; Created: 1995/6/25 -;; Version: $Id: mel.el,v 1.4 1997/06/06 00:57:15 steve Exp $ +;; Version: $Id: mel.el,v 1.5 1997/07/26 22:09:47 steve Exp $ ;; Keywords: MIME, Base64, Quoted-Printable, uuencode, gzip64 ;; This file is part of MEL (MIME Encoding Library). @@ -85,6 +85,7 @@ FUNCTION is region decoder.") +;;;###autoload (defun mime-encode-region (start end encoding) "Encode region START to END of current buffer using ENCODING." (interactive @@ -98,6 +99,7 @@ (funcall f start end) ))) +;;;###autoload (defun mime-decode-region (start end encoding) "Decode region START to END of current buffer using ENCODING." (interactive @@ -138,6 +140,7 @@ STRING is content-transfer-encoding. FUNCTION is function to insert encoded file.") +;;;###autoload (defun mime-insert-encoded-file (filename encoding) "Insert file FILENAME encoded by ENCODING format." (interactive diff -r 6866abce6aaf -r 6075d714658b lisp/mh-e/custom-load.el --- a/lisp/mh-e/custom-load.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/mh-e/custom-load.el Mon Aug 13 09:51:16 2007 +0200 @@ -1,4 +1,4 @@ -(custom-put 'mh-compose 'custom-loads '("mh-comp")) +(custom-put 'mh-buffer 'custom-loads '("mh-utils")) +(custom-put 'mh-hook 'custom-loads '("mh-e")) (custom-put 'mh 'custom-loads '("mh-comp" "mh-e" "mh-utils")) -(custom-put 'mh-hook 'custom-loads '("mh-e")) -(custom-put 'mh-buffer 'custom-loads '("mh-utils")) +(custom-put 'mh-compose 'custom-loads '("mh-comp")) diff -r 6866abce6aaf -r 6075d714658b lisp/modes/auto-autoloads.el --- a/lisp/modes/auto-autoloads.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/modes/auto-autoloads.el Mon Aug 13 09:51:16 2007 +0200 @@ -567,53 +567,10 @@ ;;;*** -;;;### (autoloads (imenu imenu-add-to-menubar) "imenu" "modes/imenu.el") - -(defvar imenu-generic-expression nil "\ -The regex pattern to use for creating a buffer index. - -If non-nil this pattern is passed to `imenu-create-index-with-pattern' -to create a buffer index. - -It is an alist with elements that look like this: (MENU-TITLE -REGEXP INDEX). - -MENU-TITLE is a string used as the title for the submenu or nil if the -entries are not nested. - -REGEXP is a regexp that should match a construct in the buffer that is -to be displayed in the menu; i.e., function or variable definitions, -etc. It contains a substring which is the name to appear in the -menu. See the info section on Regexps for more information. - -INDEX points to the substring in REGEXP that contains the name (of the -function, variable or type) that is to appear in the menu. - -For emacs-lisp-mode for example PATTERN would look like: - -'((nil \"^\\\\s-*(def\\\\(un\\\\|subst\\\\|macro\\\\|advice\\\\)\\\\s-+\\\\([-A-Za-z0-9+]+\\\\)\" 2) - (\"*Vars*\" \"^\\\\s-*(def\\\\(var\\\\|const\\\\)\\\\s-+\\\\([-A-Za-z0-9+]+\\\\)\" 2) - (\"*Types*\" \"^\\\\s-*(def\\\\(type\\\\|struct\\\\|class\\\\|ine-condition\\\\)\\\\s-+\\\\([-A-Za-z0-9+]+\\\\)\" 2)) - -The variable is buffer-local.") - -(make-variable-buffer-local 'imenu-generic-expression) - -(autoload 'imenu-add-to-menubar "imenu" "\ -Adds an `imenu' entry to the menu bar for the current buffer. -NAME is a string used to name the menu bar item. -See the command `imenu' for more information." t nil) - -(autoload 'imenu "imenu" "\ -Jump to a place in the buffer chosen using a buffer menu or mouse menu. -See `imenu-choose-buffer-index' for more information." t nil) - -;;;*** - ;;;### (autoloads (ksh-mode) "ksh-mode" "modes/ksh-mode.el") (autoload 'ksh-mode "ksh-mode" "\ -ksh-mode $Revision: 1.5 $ - Major mode for editing (Bourne, Korn or Bourne again) +ksh-mode $Revision: 1.6 $ - Major mode for editing (Bourne, Korn or Bourne again) shell scripts. Special key bindings and commands: \\{ksh-mode-map} @@ -979,8 +936,8 @@ pascal-case-indent (default 2) Indentation for case statements. pascal-auto-newline (default nil) - Non-nil means automatically newline after semicolons and the punctuation mark - after an end. + Non-nil means automatically newline after semicolons and the punctuation + mark after an end. pascal-tab-always-indent (default t) Non-nil means TAB in Pascal mode should always reindent the current line, regardless of where in the line point is when the TAB command is used. @@ -1602,7 +1559,7 @@ ;;;*** -;;;### (autoloads (strokes-mode strokes-list-strokes strokes-load-user-strokes strokes-help strokes-describe-stroke strokes-do-complex-stroke strokes-do-stroke strokes-read-complex-stroke strokes-read-stroke strokes-global-set-stroke) "strokes" "modes/strokes.el") +;;;### (autoloads (strokes-mode strokes-list-strokes strokes-edit-strokes strokes-load-user-strokes strokes-help strokes-describe-stroke strokes-do-complex-stroke strokes-do-stroke strokes-read-complex-stroke strokes-read-stroke strokes-global-set-stroke) "strokes" "modes/strokes.el") (defvar strokes-mode nil "\ Non-nil when `strokes' is globally enabled") @@ -1653,9 +1610,21 @@ (defalias 'load-user-strokes 'strokes-load-user-strokes) +(autoload 'strokes-edit-strokes "strokes" "\ +Edit strokes in a pop-up buffer containing strokes and their definitions. +If STROKES-MAP is not given, `strokes-global-map' will be used instead. + +Editing commands: + +\\{edit-faces-mode-map}" t nil) + +(defalias 'edit-strokes 'strokes-edit-strokes) + (autoload 'strokes-list-strokes "strokes" "\ -Pop up a buffer containing a listing of all strokes defined in STROKE-MAP. -If STROKE-MAP is not given, `strokes-global-map' will be used instead." t nil) +Pop up a buffer containing an alphabetical listing of strokes in STROKES-MAP. +With CHRONOLOGICAL prefix arg (\\[universal-argument]) list strokes +chronologically by command name. +If STROKES-MAP is not given, `strokes-global-map' will be used instead." t nil) (defalias 'list-strokes 'strokes-list-strokes) @@ -1970,7 +1939,7 @@ (autoload 'vhdl-mode "vhdl-mode" "\ Major mode for editing VHDL code. -vhdl-mode $Revision: 1.5 $ +vhdl-mode $Revision: 1.6 $ To submit a problem report, enter `\\[vhdl-submit-bug-report]' from a vhdl-mode buffer. This automatically sets up a mail buffer with version information already added. You just need to add a description of the diff -r 6866abce6aaf -r 6075d714658b lisp/modes/custom-load.el --- a/lisp/modes/custom-load.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/modes/custom-load.el Mon Aug 13 09:51:16 2007 +0200 @@ -1,31 +1,31 @@ -(custom-put 'asm 'custom-loads '("asm-mode")) -(custom-put 'auto-show 'custom-loads '("auto-show")) -(custom-put 'lisp-indent 'custom-loads '("cl-indent")) -(custom-put 'c-macro 'custom-loads '("cmacexp")) -(custom-put 'enriched 'custom-loads '("enriched")) -(custom-put 'executable 'custom-loads '("executable")) -(custom-put 'f90 'custom-loads '("f90")) -(custom-put 'f90-indent 'custom-loads '("f90")) -(custom-put 'fortran 'custom-loads '("f90" "fortran")) -(custom-put 'fortran-indent 'custom-loads '("fortran")) -(custom-put 'fortran-comment 'custom-loads '("fortran")) -(custom-put 'icon 'custom-loads '("icon")) -(custom-put 'mail-abbrevs 'custom-loads '("mail-abbrevs")) -(custom-put 'makefile-mode 'custom-loads '("make-mode")) -(custom-put 'outl-mouse 'custom-loads '("outl-mouse")) +(custom-put 'xrdb 'custom-loads '("xrdb-mode")) +(custom-put 'winmgr 'custom-loads '("winmgr-mode")) +(custom-put 'whitespace 'custom-loads '("whitespace-mode")) +(custom-put 'vrml 'custom-loads '("vrml-mode")) +(custom-put 'verilog 'custom-loads '("verilog-mode")) +(custom-put 'texinfo 'custom-loads '("texinfo")) +(custom-put 'tcl 'custom-loads '("tcl")) +(custom-put 'strokes 'custom-loads '("strokes")) +(custom-put 'sh-script 'custom-loads '("sh-script")) +(custom-put 'sh 'custom-loads '("sh-script")) +(custom-put 'resize-minibuffer 'custom-loads '("rsz-minibuf")) +(custom-put 'rexx 'custom-loads '("rexx-mode")) +(custom-put 'reftex-label-support 'custom-loads '("reftex")) +(custom-put 'reftex 'custom-loads '("reftex")) +(custom-put 'prolog 'custom-loads '("prolog")) (custom-put 'pascal 'custom-loads '("pascal")) -(custom-put 'prolog 'custom-loads '("prolog")) -(custom-put 'reftex 'custom-loads '("reftex")) -(custom-put 'reftex-label-support 'custom-loads '("reftex")) -(custom-put 'rexx 'custom-loads '("rexx-mode")) -(custom-put 'resize-minibuffer 'custom-loads '("rsz-minibuf")) -(custom-put 'sh 'custom-loads '("sh-script")) -(custom-put 'sh-script 'custom-loads '("sh-script")) -(custom-put 'strokes 'custom-loads '("strokes")) -(custom-put 'tcl 'custom-loads '("tcl")) -(custom-put 'texinfo 'custom-loads '("texinfo")) -(custom-put 'verilog 'custom-loads '("verilog-mode")) -(custom-put 'vrml 'custom-loads '("vrml-mode")) -(custom-put 'whitespace 'custom-loads '("whitespace-mode")) -(custom-put 'winmgr 'custom-loads '("winmgr-mode")) -(custom-put 'xrdb 'custom-loads '("xrdb-mode")) +(custom-put 'outl-mouse 'custom-loads '("outl-mouse")) +(custom-put 'makefile-mode 'custom-loads '("make-mode")) +(custom-put 'mail-abbrevs 'custom-loads '("mail-abbrevs")) +(custom-put 'icon 'custom-loads '("icon")) +(custom-put 'fortran-comment 'custom-loads '("fortran")) +(custom-put 'fortran-indent 'custom-loads '("fortran")) +(custom-put 'fortran 'custom-loads '("f90" "fortran")) +(custom-put 'f90-indent 'custom-loads '("f90")) +(custom-put 'f90 'custom-loads '("f90")) +(custom-put 'executable 'custom-loads '("executable")) +(custom-put 'enriched 'custom-loads '("enriched")) +(custom-put 'c-macro 'custom-loads '("cmacexp")) +(custom-put 'lisp-indent 'custom-loads '("cl-indent")) +(custom-put 'auto-show 'custom-loads '("auto-show")) +(custom-put 'asm 'custom-loads '("asm-mode")) diff -r 6866abce6aaf -r 6075d714658b lisp/modes/imenu.el --- a/lisp/modes/imenu.el Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,870 +0,0 @@ -;;; imenu.el --- Framework for mode-specific buffer indexes. - -;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc. - -;; Author: Ake Stenhoff -;; Lars Lindberg -;; Created: 8 Feb 1994 -;; Keywords: tools - -;; This file is part of XEmacs. - -;; XEmacs is free software; you can redistribute it and/or modify it -;; under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; XEmacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with XEmacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. - -;;; Synched up with: FSF 19.34. - -;;; Commentary: - -;; Purpose of this package: -;; To present a framework for mode-specific buffer indexes. -;; A buffer index is an alist of names and buffer positions. -;; For instance all functions in a C-file and their positions. -;; -;; How it works: - -;; A mode-specific function is called to generate the index. It is -;; then presented to the user, who can choose from this index. -;; -;; The package comes with a set of example functions for how to -;; utilize this package. - -;; There are *examples* for index gathering functions/regular -;; expressions for C/C++ and Lisp/Emacs Lisp but it is easy to -;; customize for other modes. A function for jumping to the chosen -;; index position is also supplied. - -;;; Thanks goes to -;; [simon] - Simon Leinen simon@lia.di.epfl.ch -;; [dean] - Dean Andrews ada@unison.com -;; [alon] - Alon Albert al@mercury.co.il -;; [greg] - Greg Thompson gregt@porsche.visix.COM -;; [wolfgang] - Wolfgang Bangerth zcg51122@rpool1.rus.uni-stuttgart.de -;; [kai] - Kai Grossjohann grossjoh@linus.informatik.uni-dortmund.de -;; [david] - David M. Smith dsmith@stats.adelaide.edu.au -;; [christian] - Christian Egli Christian.Egli@hcsd.hac.com -;; [karl] - Karl Fogel kfogel@floss.life.uiuc.edu - -;;; Code - -(eval-when-compile (require 'cl)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Customizable variables -;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defvar imenu-auto-rescan nil - "*Non-nil means Imenu should always rescan the buffers.") - -(defvar imenu-auto-rescan-maxout 60000 - "* auto-rescan is disabled in buffers larger than this. -This variable is buffer-local.") - -(defvar imenu-always-use-completion-buffer-p nil - "*Set this to non-nil for displaying the index in a completion buffer. - -Non-nil means always display the index in a completion buffer. -Nil means display the index as a mouse menu when the mouse was -used to invoke `imenu'. -`never' means never automatically display a listing of any kind.") - -(defvar imenu-sort-function nil - "*The function to use for sorting the index mouse-menu. - -Affects only the mouse index menu. - -Set this to nil if you don't want any sorting (faster). -The items in the menu are then presented in the order they were found -in the buffer. - -Set it to `imenu--sort-by-name' if you want alphabetic sorting. - -The function should take two arguments and return T if the first -element should come before the second. The arguments are cons cells; -\(NAME . POSITION). Look at `imenu--sort-by-name' for an example.") - -(defvar imenu-max-items 25 - "*Maximum number of elements in an mouse menu for Imenu.") - -(defvar imenu-scanning-message "Scanning buffer for index (%3d%%)" - "*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 -index use `imenu-progress-message'.") - -(defvar imenu-space-replacement "^" - "*The replacement string for spaces in index names. -Used when presenting the index in a completion-buffer to make the -names work as tokens.") - -(defvar imenu-level-separator ":" - "*The separator between index names of different levels. -Used for making mouse-menu titles and for flattening nested indexes -with name concatenation.") - -;;;###autoload -(defvar imenu-generic-expression nil - "The regex pattern to use for creating a buffer index. - -If non-nil this pattern is passed to `imenu-create-index-with-pattern' -to create a buffer index. - -It is an alist with elements that look like this: (MENU-TITLE -REGEXP INDEX). - -MENU-TITLE is a string used as the title for the submenu or nil if the -entries are not nested. - -REGEXP is a regexp that should match a construct in the buffer that is -to be displayed in the menu; i.e., function or variable definitions, -etc. It contains a substring which is the name to appear in the -menu. See the info section on Regexps for more information. - -INDEX points to the substring in REGEXP that contains the name (of the -function, variable or type) that is to appear in the menu. - -For emacs-lisp-mode for example PATTERN would look like: - -'((nil \"^\\\\s-*(def\\\\(un\\\\|subst\\\\|macro\\\\|advice\\\\)\\\\s-+\\\\([-A-Za-z0-9+]+\\\\)\" 2) - (\"*Vars*\" \"^\\\\s-*(def\\\\(var\\\\|const\\\\)\\\\s-+\\\\([-A-Za-z0-9+]+\\\\)\" 2) - (\"*Types*\" \"^\\\\s-*(def\\\\(type\\\\|struct\\\\|class\\\\|ine-condition\\\\)\\\\s-+\\\\([-A-Za-z0-9+]+\\\\)\" 2)) - -The variable is buffer-local.") - -;;;###autoload -(make-variable-buffer-local 'imenu-generic-expression) - -;;;; Hooks - -(defvar imenu-create-index-function 'imenu-default-create-index-function - "The function to use for creating a buffer index. - -It should be a function that takes no arguments and returns an index -of the current buffer as an alist. The elements in the alist look -like: (INDEX-NAME . INDEX-POSITION). You may also nest index list like -\(INDEX-NAME . INDEX-ALIST). - -This function is called within a `save-excursion'. - -The variable is buffer-local.") -(make-variable-buffer-local 'imenu-create-index-function) - -(defvar imenu-prev-index-position-function 'beginning-of-defun - "Function for finding the next index position. - -If `imenu-create-index-function' is set to -`imenu-default-create-index-function', then you must set this variable -to a function that will find the next index, looking backwards in the -file. - -The function should leave point at the place to be connected to the -index and it should return nil when it doesn't find another index.") -(make-variable-buffer-local 'imenu-prev-index-position-function) - -(defvar imenu-extract-index-name-function nil - "Function for extracting the index name. - -This function is called after the function pointed out by -`imenu-prev-index-position-function'.") -(make-variable-buffer-local 'imenu-extract-index-name-function) - -;;; -;;; Macro to display a progress message. -;;; RELPOS is the relative position to display. -;;; If RELPOS is nil, then the relative position in the buffer -;;; is calculated. -;;; PREVPOS is the variable in which we store the last position displayed. -(defmacro imenu-progress-message (prevpos &optional relpos reverse) - (` (and - imenu-scanning-message - (let ((pos (, (if relpos - relpos - (` (imenu--relative-position (, reverse))))))) - (if (, (if relpos t - (` (> pos (+ 5 (, prevpos)))))) - (progn - (message imenu-scanning-message pos) - (setq (, prevpos) pos))))))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;;; -;;;; Some examples of functions utilizing the framework of this -;;;; package. -;;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; Return the current/previous sexp and the location of the sexp (its -;; beginning) without moving the point. -(defun imenu-example--name-and-position () - (save-excursion - (forward-sexp -1) - (let ((beg (point)) - (end (progn (forward-sexp) (point))) - (marker (make-marker))) - (set-marker marker beg) - (cons (buffer-substring beg end) - marker)))) - -;;; -;;; Lisp -;;; - -(defun imenu-example--lisp-extract-index-name () - ;; Example of a candidate for `imenu-extract-index-name-function'. - ;; This will generate a flat index of definitions in a lisp file. - (save-match-data - (and (looking-at "(def") - (condition-case nil - (progn - (down-list 1) - (forward-sexp 2) - (let ((beg (point)) - (end (progn (forward-sexp -1) (point)))) - (buffer-substring beg end))) - (error nil))))) - -(defun imenu-example--create-lisp-index () - ;; Example of a candidate for `imenu-create-index-function'. - ;; It will generate a nested index of definitions. - (let ((index-alist '()) - (index-var-alist '()) - (index-type-alist '()) - (index-unknown-alist '()) - prev-pos) - (goto-char (point-max)) - (imenu-progress-message prev-pos 0) - ;; Search for the function - (while (beginning-of-defun) - (imenu-progress-message prev-pos nil t) - (save-match-data - (and (looking-at "(def") - (save-excursion - (down-list 1) - (cond - ((looking-at "def\\(var\\|const\\)") - (forward-sexp 2) - (push (imenu-example--name-and-position) - index-var-alist)) - ((looking-at "def\\(un\\|subst\\|macro\\|advice\\)") - (forward-sexp 2) - (push (imenu-example--name-and-position) - index-alist)) - ((looking-at "def\\(type\\|struct\\|class\\|ine-condition\\)") - (forward-sexp 2) - (if (= (char-after (1- (point))) ?\)) - (progn - (forward-sexp -1) - (down-list 1) - (forward-sexp 1))) - (push (imenu-example--name-and-position) - index-type-alist)) - (t - (forward-sexp 2) - (push (imenu-example--name-and-position) - index-unknown-alist))))))) - (imenu-progress-message prev-pos 100) - (and index-var-alist - (push (cons "Variables" index-var-alist) - index-alist)) - (and index-type-alist - (push (cons "Types" index-type-alist) - index-alist)) - (and index-unknown-alist - (push (cons "Syntax-unknown" index-unknown-alist) - index-alist)) - index-alist)) - -;; Regular expression to find C functions -(defvar imenu-example--function-name-regexp-c - (concat - "^[a-zA-Z0-9]+[ \t]?" ; type specs; there can be no - "\\([a-zA-Z0-9_*]+[ \t]+\\)?" ; more than 3 tokens, right? - "\\([a-zA-Z0-9_*]+[ \t]+\\)?" - "\\([*&]+[ \t]*\\)?" ; pointer - "\\([a-zA-Z0-9_*]+\\)[ \t]*(" ; name - )) - -(defun imenu-example--create-c-index (&optional regexp) - (let ((index-alist '()) - prev-pos char) - (goto-char (point-min)) - (imenu-progress-message prev-pos 0) - ;; Search for the function - (save-match-data - (while (re-search-forward - (or regexp imenu-example--function-name-regexp-c) - nil t) - (imenu-progress-message prev-pos) - (backward-up-list 1) - (save-excursion - (goto-char (scan-sexps (point) 1)) - (setq char (following-char))) - ;; Skip this function name if it is a prototype declaration. - (if (not (eq char ?\;)) - (push (imenu-example--name-and-position) index-alist)))) - (imenu-progress-message prev-pos 100) - (nreverse index-alist))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Internal variables -;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; The item to use in the index for rescanning the buffer. -(defconst imenu--rescan-item '("*Rescan*" . -99)) - -;; The latest buffer index. -;; Buffer local. -(defvar imenu--index-alist nil) -(make-variable-buffer-local 'imenu--index-alist) - -;; The latest buffer index used to update the menu bar menu. -(defvar imenu--last-menubar-index-alist nil) -(make-variable-buffer-local 'imenu--last-menubar-index-alist) - -;; History list for 'jump-to-function-in-buffer'. -;; Making this buffer local caused it not to work! -(defvar imenu--history-list nil) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Internal support functions -;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;;; -;;; Sort function -;;; Sorts the items depending on their index name. -;;; An item look like (NAME . POSITION). -;;; -(defun imenu--sort-by-name (item1 item2) - (string-lessp (car item1) (car item2))) - -(defun imenu--relative-position (&optional reverse) - ;; Support function to calculate relative position in buffer - ;; Beginning of buffer is 0 and end of buffer is 100 - ;; If REVERSE is non-nil then the beginning is 100 and the end is 0. - (let ((pos (point)) - (total (buffer-size))) - (and reverse (setq pos (- total pos))) - (if (> total 50000) - ;; Avoid overflow from multiplying by 100! - (/ (1- pos) (max (/ total 100) 1)) - (/ (* 100 (1- pos)) (max total 1))))) - -;; Split LIST into sublists of max length N. -;; Example (imenu--split '(1 2 3 4 5 6 7 8) 3)-> '((1 2 3) (4 5 6) (7 8)) -(defun imenu--split (list n) - (let ((remain list) - (result '()) - (sublist '()) - (i 0)) - (while remain - (push (pop remain) sublist) - (incf i) - (and (= i n) - ;; We have finished a sublist - (progn (push (nreverse sublist) result) - (setq i 0) - (setq sublist '())))) - ;; There might be a sublist (if the length of LIST mod n is != 0) - ;; that has to be added to the result list. - (and sublist - (push (nreverse sublist) result)) - (nreverse result))) - -;;; Split the alist MENULIST into a nested alist, if it is long enough. -;;; In any case, add TITLE to the front of the alist. -(defun imenu--split-menu (menulist title) - (if (> (length menulist) imenu-max-items) - (let ((count 0)) - (cons title - (mapcar - (function - (lambda (menu) - (cons (format "(%s-%d)" title (setq count (1+ count))) - menu))) - (imenu--split menulist imenu-max-items)))) - (cons title menulist))) - -;;; Split up each long alist that are nested within ALIST -;;; into nested alists. -(defun imenu--split-submenus (alist) - (mapcar (function (lambda (elt) - (if (and (consp elt) - (stringp (car elt)) - (listp (cdr elt))) - (imenu--split-menu (cdr elt) (car elt)) - elt))) - alist)) - -;;; -;;; Find all items in this buffer that should be in the index. -;;; Returns an alist on the form -;;; ((NAME . POSITION) (NAME . POSITION) ...) -;;; - -(defun imenu--make-index-alist (&optional noerror) - ;; Create a list for this buffer only when needed. - (or (and imenu--index-alist - (or (not imenu-auto-rescan) - (and imenu-auto-rescan - (> (buffer-size) imenu-auto-rescan-maxout)))) - ;; Get the index - (setq imenu--index-alist - (save-excursion - (funcall imenu-create-index-function)))) - (or imenu--index-alist noerror - (error "No items suitable for an index found in this buffer")) - (or imenu--index-alist - (setq imenu--index-alist (list nil))) - ;; Add a rescan option to the index. - (cons imenu--rescan-item imenu--index-alist)) -;;; -;;; Find all markers in alist and makes -;;; them point nowhere. -;;; -(defun imenu--cleanup (&optional alist) - ;; Sets the markers in imenu--index-alist - ;; point nowhere. - ;; if alist is provided use that list. - (or alist - (setq alist imenu--index-alist)) - (and alist - (mapcar - (function - (lambda (item) - (cond - ((markerp (cdr item)) - (set-marker (cdr item) nil)) - ((consp (cdr item)) - (imenu--cleanup (cdr item)))))) - alist) - t)) - -(defun imenu--create-keymap-2 (alist counter &optional commands) - (let ((map nil)) - (mapcar - (function - (lambda (item) - (cond - ((listp (cdr item)) - (append (list (setq counter (1+ counter)) - (car item) 'keymap (car item)) - (imenu--create-keymap-2 (cdr item) (+ counter 10) commands))) - (t - (let ((end (if commands `(lambda () (interactive) - (imenu--menubar-select ',item)) - (cons '(nil) t)))) - (cons (car item) - (cons (car item) end)))) - ))) - alist))) - -;; If COMMANDS is non-nil, make a real keymap -;; with a real command used as the definition. -;; If it is nil, make something suitable for x-popup-menu. -(defun imenu--create-keymap-1 (title alist &optional commands) - (append (list 'keymap title) (imenu--create-keymap-2 alist 0 commands))) - - -(defun imenu--in-alist (str alist) - "Check whether the string STR is contained in multi-level ALIST." - (let (elt head tail res) - (setq res nil) - (while alist - (setq elt (car alist) - tail (cdr elt) - alist (cdr alist) - head (car elt)) - (if (string= str head) - (setq alist nil res elt) - (if (and (listp tail) - (setq res (imenu--in-alist str tail))) - (setq alist nil)))) - res)) - -(defun imenu-default-create-index-function () - "*Wrapper for index searching functions. - -Moves point to end of buffer and then repeatedly calls -`imenu-prev-index-position-function' and `imenu-extract-index-name-function'. -Their results are gathered into an index alist." - ;; These should really be done by setting imenu-create-index-function - ;; in these major modes. But save that change for later. - (cond ((and (fboundp imenu-prev-index-position-function) - (fboundp imenu-extract-index-name-function)) - (let ((index-alist '()) - prev-pos name) - (goto-char (point-max)) - (imenu-progress-message prev-pos 0 t) - ;; Search for the function - (while (funcall imenu-prev-index-position-function) - (imenu-progress-message prev-pos nil t) - (save-excursion - (setq name (funcall imenu-extract-index-name-function))) - (and (stringp name) - (push (cons name (point)) index-alist))) - (imenu-progress-message prev-pos 100 t) - index-alist)) - ;; Use generic expression if possible. - ((and imenu-generic-expression) - (imenu--generic-function imenu-generic-expression)) - (t - (error "The mode \"%s\" does not take full advantage of imenu.el yet." - mode-name)))) - -(defun imenu--replace-spaces (name replacement) - ;; Replace all spaces in NAME with REPLACEMENT. - ;; That second argument should be a string. - (mapconcat - (function - (lambda (ch) - (if (char-equal ch ?\ ) - replacement - (char-to-string ch)))) - name - "")) - -(defun imenu--flatten-index-alist (index-alist &optional concat-names prefix) - ;; Takes a nested INDEX-ALIST and returns a flat index alist. - ;; If optional CONCAT-NAMES is non-nil, then a nested index has its - ;; name and a space concatenated to the names of the children. - ;; Third argument PREFIX is for internal use only. - (mapcan - (function - (lambda (item) - (let* ((name (car item)) - (pos (cdr item)) - (new-prefix (and concat-names - (if prefix - (concat prefix imenu-level-separator name) - name)))) - (cond - ((or (markerp pos) (numberp pos)) - (list (cons new-prefix pos))) - (t - (imenu--flatten-index-alist pos new-prefix)))))) - index-alist)) - -;;; -;;; Generic index gathering function. -;;; - -(defun imenu--generic-function (patterns) -;; Built on some ideas that Erik Naggum once posted -;; to comp.emacs - "Return an index of the current buffer as an alist. - -PATTERN is an alist with elements that look like this: (MENU-TITLE -REGEXP INDEX). - -MENU-TITLE is a string used as the title for the submenu or nil if the -entries are not nested. - -REGEXP is a regexp that should match a construct in the buffer that is -to be displayed in the menu; i.e., function or variable definitions, -etc. It contains a substring which is the name to appear in the -menu. See the info section on Regexps for more information. - -INDEX points to the substring in REGEXP that contains the name (of the -function, variable or type) that is to appear in the menu. - -For emacs-lisp-mode for example PATTERN would look like: - -'((nil \"^\\\\s-*(def\\\\(un\\\\|subst\\\\|macro\\\\|advice\\\\)\\\\s-+\\\\([-A-Za-z0-9]+\\\\)\" 2) - (\"*Vars*\" \"^\\\\s-*(def\\\\(var\\\\|const\\\\)\\\\s-+\\\\([-A-Za-z0-9]+\\\\)\" 2) - (\"*Types*\" \"^\\\\s-*(def\\\\(type\\\\|struct\\\\|class\\\\|ine-condition\\\\)\\\\s-+\\\\([-A-Za-z0-9]+\\\\)\" 2))' - -Returns an index of the current buffer as an alist. The elements in -the alist look like: (INDEX-NAME . INDEX-POSITION). They may also be -nested index lists like (INDEX-NAME . INDEX-ALIST) depending on -pattern. - -\(imenu--generic-function PATTERN\)." - - (let ((index-alist (list 'dummy)) - (found nil) - (global-regexp - (concat "\\(" - (mapconcat - (function (lambda (pattern) (identity (cadr pattern)))) - patterns "\\)\\|\\(") - "\\)")) - prev-pos) - - (goto-char (point-max)) - (imenu-progress-message prev-pos 0 t) - (save-match-data - (while (re-search-backward global-regexp nil t) - (imenu-progress-message prev-pos nil t) - (setq found nil) - (save-excursion - (goto-char (match-beginning 0)) - (mapcar - (function - (lambda (pat) - (let ((menu-title (car pat)) - (regexp (cadr pat)) - (index (caddr pat))) - (if (and (not found) ; Only allow one entry; - (looking-at regexp)) - (let ((beg (match-beginning index)) - (end (match-end index))) - (setq found t) - (push - (cons (buffer-substring-no-properties beg end) beg) - (cdr - (or (assoc menu-title index-alist) - (car (push - (cons menu-title '()) - index-alist)))))))))) - patterns)))) - (imenu-progress-message prev-pos 100 t) - (let ((main-element (assq nil index-alist))) - (nconc (delq main-element (delq 'dummy index-alist)) main-element)))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; The main functions for this package! -;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defun imenu--completion-buffer (index-alist &optional prompt) - "Let the user select from INDEX-ALIST in a completion buffer with PROMPT. - -Returns t for rescan and otherwise a position number." - ;; Create a list for this buffer only when needed. - (let (name choice - (prepared-index-alist - (mapcar - (function - (lambda (item) - (cons (imenu--replace-spaces (car item) imenu-space-replacement) - (cdr item)))) - index-alist))) - (if (eq imenu-always-use-completion-buffer-p 'never) - (setq name (completing-read (or prompt "Index item: ") - prepared-index-alist - nil t nil 'imenu--history-list)) - (save-window-excursion - ;; Display the completion buffer - (with-output-to-temp-buffer "*Completions*" - (display-completion-list - (all-completions "" prepared-index-alist ))) - (let ((minibuffer-setup-hook - (function (lambda () - (let ((buffer (current-buffer))) - (save-excursion - (set-buffer "*Completions*") - (setq completion-reference-buffer buffer))))))) - ;; Make a completion question - (setq name (completing-read (or prompt "Index item: ") - prepared-index-alist - nil t nil 'imenu--history-list))))) - (cond ((not (stringp name)) - nil) - ((string= name (car imenu--rescan-item)) - t) - (t - (setq choice (assoc name prepared-index-alist)) - (if (listp (cdr choice)) - (imenu--completion-buffer (cdr choice) prompt) - choice))))) - -(defun imenu--mouse-menu (index-alist event &optional title) - "Let the user select from a buffer index from a mouse menu. - -INDEX-ALIST is the buffer index and EVENT is a mouse event. - -Returns t for rescan and otherwise a position number." - (setq index-alist (imenu--split-submenus index-alist)) - (let* ((menu (imenu--split-menu - (if imenu-sort-function - (sort - (let ((res nil) - (oldlist index-alist)) - ;; Copy list method from the cl package `copy-list' - (while (consp oldlist) (push (pop oldlist) res)) - (prog1 (nreverse res) (setcdr res oldlist))) - imenu-sort-function) - index-alist) - (or title (buffer-name)))) - position) - (setq menu (imenu--create-keymap-1 (car menu) - (if (< 1 (length (cdr menu))) - (cdr menu) - (cdr (cadr menu))))) - (setq position (x-popup-menu event menu)) - (cond ((and (listp position) - (numberp (car position)) - (stringp (nth (1- (length position)) position))) - (setq position (nth (1- (length position)) position))) - ((and (stringp (car position)) - (null (cdr position))) - (setq position (car position)))) - (cond ((eq position nil) - position) - ((listp position) - (imenu--mouse-menu position event - (if title - (concat title imenu-level-separator - (car (rassq position index-alist))) - (car (rassq position index-alist))))) - ((stringp position) - (or (string= position (car imenu--rescan-item)) - (imenu--in-alist position index-alist))) - ((or (= position (cdr imenu--rescan-item)) - (and (stringp position) - (string= position (car imenu--rescan-item)))) - t) - (t - (rassq position index-alist))))) - -(defun imenu-choose-buffer-index (&optional prompt alist) - "Let the user select from a buffer index and return the chosen index. - -If the user originally activated this function with the mouse, a mouse -menu is used. Otherwise a completion buffer is used and the user is -prompted with PROMPT. - -If you call this function with index alist ALIST, then it lets the user -select from ALIST. - -With no index alist ALIST, it calls `imenu--make-index-alist' to -create the index alist. - -If `imenu-always-use-completion-buffer-p' is non-nil, then the -completion buffer is always used, no matter if the mouse was used or -not. - -The returned value is on the form (INDEX-NAME . INDEX-POSITION)." - (let (index-alist - (mouse-triggered (listp last-nonmenu-event)) - (result t) ) - ;; If selected by mouse, see to that the window where the mouse is - ;; really is selected. - (and mouse-triggered - (not (equal last-nonmenu-event '(menu-bar))) - (let ((window (posn-window (event-start last-nonmenu-event)))) - (or (framep window) (null window) (select-window window)))) - ;; Create a list for this buffer only when needed. - (while (eq result t) - (setq index-alist (if alist alist (imenu--make-index-alist))) - (setq result - (if (and mouse-triggered - (not imenu-always-use-completion-buffer-p)) - (imenu--mouse-menu index-alist last-nonmenu-event) - (imenu--completion-buffer index-alist prompt))) - (and (eq result t) - (imenu--cleanup) - (setq imenu--index-alist nil))) - result)) - -;;;###autoload -(defun imenu-add-to-menubar (name) - "Adds an `imenu' entry to the menu bar for the current buffer. -NAME is a string used to name the menu bar item. -See the command `imenu' for more information." - (interactive "sImenu menu item name: ") - (let ((newmap (make-sparse-keymap)) - (menu-bar (lookup-key (current-local-map) [menu-bar]))) - (when menu-bar - (define-key newmap [menu-bar] - (append (make-sparse-keymap) menu-bar)) - (define-key newmap [menu-bar index] - (cons name (nconc (make-sparse-keymap "Imenu") - (make-sparse-keymap)))) - (use-local-map (append newmap (current-local-map))))) - (add-hook 'menu-bar-update-hook 'imenu-update-menubar)) - -(defvar imenu-buffer-menubar nil) - -(defun imenu-update-menubar () - (and (current-local-map) - (keymapp (lookup-key (current-local-map) [menu-bar index])) - (let ((index-alist (imenu--make-index-alist t))) - ;; Don't bother updating if the index-alist has not changed - ;; since the last time we did it. - (or (equal index-alist imenu--last-menubar-index-alist) - (let (menu menu1 old) - (setq imenu--last-menubar-index-alist index-alist) - (setq index-alist (imenu--split-submenus index-alist)) - (setq menu (imenu--split-menu - (if imenu-sort-function - (sort - (let ((res nil) - (oldlist index-alist)) - ;; Copy list method from the cl package `copy-list' - (while (consp oldlist) (push (pop oldlist) res)) - (prog1 (nreverse res) (setcdr res oldlist))) - imenu-sort-function) - index-alist) - (buffer-name))) - (setq menu1 (imenu--create-keymap-1 (car menu) - (if (< 1 (length (cdr menu))) - (cdr menu) - (cdr (car (cdr menu)))) - t)) - (setq old (lookup-key (current-local-map) [menu-bar index])) - (setcdr old (cdr menu1))))))) - -(defun imenu--menubar-select (item) - "Use Imenu to select the function or variable named in this menu item." - (if (equal item '("*Rescan*" . -99)) - (progn - (imenu--cleanup) - (setq imenu--index-alist nil) - (imenu-update-menubar)) - (imenu item))) - -;;;###autoload -(defun imenu (index-item) - "Jump to a place in the buffer chosen using a buffer menu or mouse menu. -See `imenu-choose-buffer-index' for more information." - (interactive - (list (save-restriction - (widen) - (imenu-choose-buffer-index)))) - ;; Convert a string to an alist element. - (if (stringp index-item) - (setq index-item (assoc index-item (imenu--make-index-alist)))) - (and index-item - (progn - (push-mark) - (cond - ((markerp (cdr index-item)) - (if (or ( > (marker-position (cdr index-item)) (point-min)) - ( < (marker-position (cdr index-item)) (point-max))) - ;; widen if outside narrowing - (widen)) - (goto-char (marker-position (cdr index-item)))) - (t - (if (or ( > (cdr index-item) (point-min)) - ( < (cdr index-item) (point-max))) - ;; widen if outside narrowing - (widen)) - (goto-char (cdr index-item))))))) - -(provide 'imenu) - -;;; imenu.el ends here - diff -r 6866abce6aaf -r 6075d714658b lisp/modes/pascal.el --- a/lisp/modes/pascal.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/modes/pascal.el Mon Aug 13 09:51:16 2007 +0200 @@ -1,9 +1,9 @@ -;;; pascal.el - Major mode for editing pascal source in emacs. +;;; pascal.el --- major mode for editing pascal source in Emacs -;;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. +;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc. -;;; Author: Espen Skoglund (espensk@stud.cs.uit.no) -;;; Keywords: languages +;; Author: Espen Skoglund (espensk@stud.cs.uit.no) +;; Keywords: languages ;; This file is part of XEmacs. @@ -22,47 +22,47 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;;; Synched up with: FSF 19.30. +;;; Synched up with: FSF 19.34 ;;; Commentary: -;;; USAGE -;;; ===== +;; USAGE +;; ===== -;;; Emacs should enter Pascal mode when you find a Pascal source file. -;;; When you have entered Pascal mode, you may get more info by pressing -;;; C-h m. You may also get online help describing various functions by: -;;; C-h f +;; Emacs should enter Pascal mode when you find a Pascal source file. +;; When you have entered Pascal mode, you may get more info by pressing +;; C-h m. You may also get online help describing various functions by: +;; C-h f -;;; If you want to customize Pascal mode to fit you better, you may add -;;; these lines (the values of the variables presented here are the defaults): -;;; -;;; ;; User customization for Pascal mode -;;; (setq pascal-indent-level 3 -;;; pascal-case-indent 2 -;;; pascal-auto-newline nil -;;; pascal-tab-always-indent t -;;; pascal-auto-endcomments t -;;; pascal-auto-lineup '(all) -;;; pascal-toggle-completions nil -;;; pascal-type-keywords '("array" "file" "packed" "char" -;;; "integer" "real" "string" "record") -;;; pascal-start-keywords '("begin" "end" "function" "procedure" -;;; "repeat" "until" "while" "read" "readln" -;;; "reset" "rewrite" "write" "writeln") -;;; pascal-separator-keywords '("downto" "else" "mod" "div" "then")) +;; If you want to customize Pascal mode to fit you better, you may add +;; these lines (the values of the variables presented here are the defaults): +;; +;; ;; User customization for Pascal mode +;; (setq pascal-indent-level 3 +;; pascal-case-indent 2 +;; pascal-auto-newline nil +;; pascal-tab-always-indent t +;; pascal-auto-endcomments t +;; pascal-auto-lineup '(all) +;; pascal-toggle-completions nil +;; pascal-type-keywords '("array" "file" "packed" "char" +;; "integer" "real" "string" "record") +;; pascal-start-keywords '("begin" "end" "function" "procedure" +;; "repeat" "until" "while" "read" "readln" +;; "reset" "rewrite" "write" "writeln") +;; pascal-separator-keywords '("downto" "else" "mod" "div" "then")) -;;; KNOWN BUGS / BUGREPORTS -;;; ======================= -;;; As far as I know, there are no bugs in the current version of this -;;; package. This may not be true however, since I never use this mode -;;; myself and therefore would never notice them anyway. If you do -;;; find any bugs, you may submit them to: espensk@stud.cs.uit.no -;;; as well as to bug-gnu-emacs@prep.ai.mit.edu. +;; KNOWN BUGS / BUGREPORTS +;; ======================= +;; As far as I know, there are no bugs in the current version of this +;; package. This may not be true however, since I never use this mode +;; myself and therefore would never notice them anyway. If you do +;; find any bugs, you may submit them to: espensk@stud.cs.uit.no +;; as well as to bug-gnu-emacs@prep.ai.mit.edu. ;;; Code: -(defconst pascal-mode-version "2.4" +(defconst pascal-mode-version "2.5" "Version of `pascal.el'.") (defgroup pascal nil @@ -158,19 +158,17 @@ (modify-syntax-entry ?_ "_" pascal-mode-syntax-table) (modify-syntax-entry ?\' "\"" pascal-mode-syntax-table)) -(defconst pascal-font-lock-keywords (purecopy +(defvar pascal-font-lock-keywords (list '("^[ \t]*\\(function\\|pro\\(cedure\\|gram\\)\\)\\>[ \t]*\\(\\sw+\\)?" - 1 font-lock-keyword-face) - '("^[ \t]*\\(function\\|pro\\(cedure\\|gram\\)\\)\\>[ \t]*\\(\\sw+\\)?" - 3 font-lock-function-name-face t) + (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t)) ; ("type" "const" "real" "integer" "char" "boolean" "var" ; "record" "array" "file") (cons (concat "\\<\\(array\\|boolean\\|c\\(har\\|onst\\)\\|file\\|" "integer\\|re\\(al\\|cord\\)\\|type\\|var\\)\\>") 'font-lock-type-face) - '("\\<\\(label\\|external\\|forward\\)\\>" . font-lock-function-name-face) - '("\\<\\([0-9]+\\)[ \t]*:" 1 font-lock-function-name-face) + '("\\<\\(label\\|external\\|forward\\)\\>" . font-lock-reference-face) + '("\\<\\([0-9]+\\)[ \t]*:" 1 font-lock-reference-face) ; ("of" "to" "for" "if" "then" "else" "case" "while" ; "do" "until" "and" "or" "not" "in" "with" "repeat" "begin" "end") (concat "\\<\\(" @@ -178,11 +176,8 @@ "not\\|o[fr]\\|repeat\\|t\\(hen\\|o\\)\\|until\\|w\\(hile\\|ith\\)" "\\)\\>") '("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?" - 1 font-lock-keyword-face) - '("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?" - 2 font-lock-keyword-face t))) + (1 font-lock-keyword-face) (2 font-lock-reference-face nil t))) "Additional expressions to highlight in Pascal mode.") -(put 'pascal-mode 'font-lock-defaults '(pascal-font-lock-keywords nil t)) (defcustom pascal-indent-level 3 "*Indentation of Pascal statements with respect to containing block." @@ -195,8 +190,8 @@ :group 'pascal) (defcustom pascal-auto-newline nil - "*Non-nil means automatically newline after semicolons and the punctuation mark -after an end." + "*Non-nil means automatically newline after semicolons and the punctuation +mark after an end." :type 'boolean :group 'pascal) @@ -226,10 +221,9 @@ :group 'pascal) (defcustom pascal-toggle-completions nil - "*Non-nil means that \\\\[pascal-complete-label] should \ -not display a completion buffer when -the label couldn't be completed, but instead toggle the possible completions -with repeated \\[pascal-complete-label]'s." + "*Non-nil means that \\\\[pascal-complete-word] should try all pRepeated use of \\[pascal-complete-word] will show you all of them. +Normally, when there is more than one possible completion, +it displays a list of all possible completions." :type 'boolean :group 'pascal) @@ -329,8 +323,8 @@ pascal-case-indent (default 2) Indentation for case statements. pascal-auto-newline (default nil) - Non-nil means automatically newline after semicolons and the punctuation mark - after an end. + Non-nil means automatically newline after semicolons and the punctuation + mark after an end. pascal-tab-always-indent (default t) Non-nil means TAB in Pascal mode should always reindent the current line, regardless of where in the line point is when the TAB command is used. @@ -355,18 +349,22 @@ (make-local-variable 'indent-line-function) (setq indent-line-function 'pascal-indent-line) (setq comment-indent-function 'pascal-indent-comment) - (make-local-variable 'comment-start) - (setq comment-start "{") (make-local-variable 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments nil) (make-local-variable 'case-fold-search) (setq case-fold-search t) + (make-local-variable 'comment-start) + (setq comment-start "{") (make-local-variable 'comment-start-skip) (setq comment-start-skip "(\\*+ *\\|{ *") (make-local-variable 'comment-end) (setq comment-end "}") -; (make-local-variable 'imenu-generic-expression) -; (setq imenu-generic-expression pascal-imenu-generic-expression) + ;; Font lock support + ;;(make-local-variable 'font-lock-defaults) + ;;(setq font-lock-defaults '(pascal-font-lock-keywords nil t)) + ;; Imenu support + ;; (make-local-variable 'imenu-generic-expression) + ;; (setq imenu-generic-expression pascal-imenu-generic-expression) (run-hooks 'pascal-mode-hook)) @@ -441,7 +439,7 @@ (pascal-indent-command)))) (defun electric-pascal-hash () - "Insert `#', and indent to coulmn 0 if this is a CPP directive." + "Insert `#', and indent to column 0 if this is a CPP directive." (interactive) (insert last-command-char) (if (save-excursion (beginning-of-line) (looking-at "^[ \t]*#")) @@ -938,12 +936,12 @@ (beg (point)) oldpos (ind 0)) ;; Get right indent - (while (< (point) (marker-position end)) + (while (< (point) end) (if (re-search-forward "^[ \t]*[^ \t,:]+[ \t]*\\(,[ \t]*[^ \t,:]+[ \t]*\\)*:" (marker-position end) 'move) (forward-char -1)) - (if (< (point) (marker-position end)) + (if (< (point) end) (progn (delete-horizontal-space) (if (> (current-column) ind) @@ -952,7 +950,7 @@ (goto-char beg) (setq oldpos (marker-position end)) ;; Indent all case statements - (while (< (point) (marker-position end)) + (while (< (point) end) (if (re-search-forward "^[ \t]*[^][ \t,\\.:]+[ \t]*\\(,[ \t]*[^ \t,:]+[ \t]*\\)*:" (marker-position end) 'move) @@ -1008,10 +1006,14 @@ pos)))) ind) + (if (= (point-max) edpos) + (save-excursion + (goto-char (point-max)) + (insert "\n"))) (goto-char stpos) ;; Indent lines in record block (if arg - (while (<= (point) (marker-position edpos)) + (while (<= (point) edpos) (beginning-of-line) (delete-horizontal-space) (if (looking-at "end\\>") @@ -1022,7 +1024,7 @@ ;; Do lineup (setq ind (pascal-get-lineup-indent stpos edpos lineup)) (goto-char stpos) - (while (<= (point) (marker-position edpos)) + (while (<= (point) edpos) (if (search-forward lineup (pascal-get-end-of-line) 'move) (forward-char -1)) (delete-horizontal-space) @@ -1039,19 +1041,17 @@ ;; If arg - move point (if arg (forward-line -1) - (goto-char (marker-position pos))))) + (goto-char pos)))) ; "Return the indent level that will line up several lines within the region ;from b to e nicely. The lineup string is str." (defun pascal-get-lineup-indent (b e str) (save-excursion (let ((ind 0) - (reg (concat str "\\|\\(\\\\)")) - nest) + (reg (concat str "\\|\\(\\\\)"))) (goto-char b) ;; Get rightmost position (while (< (point) e) - (setq nest 1) (if (re-search-forward reg (min e (pascal-get-end-of-line 2)) 'move) (progn ;; Skip record blocks @@ -1126,7 +1126,7 @@ (defun pascal-get-completion-decl () ;; Macro for searching through current declaration (var, type or const) - ;; for matches of `str' and adding the occurence tp `all' + ;; for matches of `str' and adding the occurrence tp `all' (let ((end (save-excursion (pascal-declaration-end) (point))) match) @@ -1176,7 +1176,7 @@ (save-excursion (if (> start (prog1 (save-excursion (pascal-end-of-defun) (point)))) - () ; Declarations not reacable + () ; Declarations not reachable (if (search-forward "(" (pascal-get-end-of-line) t) ;; Check parameterlist (pascal-get-completion-decl)) @@ -1215,7 +1215,7 @@ (save-excursion (let ((pascal-all nil)) ;; Set buffer to use for searching labels. This should be set - ;; within functins which use pascal-completions + ;; within functions which use pascal-completions (set-buffer pascal-buffer-to-use) ;; Determine what should be completed @@ -1260,7 +1260,7 @@ (let* ((elm (cdr pascal-all)) (match (car pascal-all)) (min (length match)) - exact tmp) + tmp) (if (string= match pascal-str) ;; Return t if first match was an exact match (setq match t) @@ -1325,7 +1325,7 @@ (insert "" pascal-last-word-shown) (insert "" pascal-str) (message "(No match)"))) - ;; The other form of completion does not necessarly do that. + ;; The other form of completion does not necessarily do that. ;; Insert match if found, or the original string if no match (if (or (null match) (equal match 't)) @@ -1401,7 +1401,7 @@ match) ;; Set buffer to use for searching labels. This should be set - ;; within functins which use pascal-completions + ;; within functions which use pascal-completions (set-buffer pascal-buffer-to-use) (let ((pascal-str pascal-str)) diff -r 6866abce6aaf -r 6075d714658b lisp/modes/strokes.el --- a/lisp/modes/strokes.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/modes/strokes.el Mon Aug 13 09:51:16 2007 +0200 @@ -1,10 +1,11 @@ -;;; strokes.el Sat May 24 14:18:08 1997 +;;; strokes.el -- Control XEmacs through mouse strokes -- +;; Mon Jun 2 12:40:41 EDT 1997 ;; Copyright (C) 1997 Free Software Foundation, Inc. ;; Author: David Bakhash ;; Maintainer: David Bakhash -;; Version: 2.3-beta +;; Version: 2.3 ;; Created: 12 April 1997 ;; Keywords: lisp, mouse, extensions @@ -158,11 +159,23 @@ ;; which "remove the pencil from the paper" so to speak, so one character ;; can have multiple strokes. +;; You can read more about strokes at: + +;; http://www.mit.edu/people/cadet/strokes-help.html + +;; If you're interested in using strokes for writing English into XEmacs +;; using strokes, then you'll want to read about it on the web page above +;; or just download from http://www.mit.edu/people/cadet/strokes-abc.el, +;; which is nothing but a file with some helper commands for inserting +;; alphanumerics and punctuation. + ;; Great thanks to Rob Ristroph for his generosity in letting me use his ;; PC to develop this, Jason Johnson for his help in algorithms, Euna ;; Kim for her help in Korean, and massive thanks to the helpful guys ;; on the help instance on athena (zeno, jered, amu, gsstark, ghudson, etc) ;; Special thanks to Steve Baur and Hrvoje Niksic for all their help. +;; And even more thanks to Dave Gillespie for all the elisp help--he +;; is responsible for helping me use the cl macros at (near) max speed. ;; Tasks: (what I'm getting ready for future version)... ;; 2) use 'strokes-read-complex-stroke for korean, etc. @@ -253,10 +266,12 @@ (autoload 'reporter-submit-bug-report "reporter") (autoload 'mail-position-on-field "sendmail") +(eval-when-compile + (mapc 'require '(xpm-mode pp annotations reporter advice))) ;;; Constants... -(defconst strokes-version "2.3-beta") +(defconst strokes-version "2.3") (defconst strokes-bug-address "cadet@mit.edu") @@ -265,6 +280,23 @@ Complex strokes are those which contain two or more simple strokes. This will be useful for when XEmacs understands Chinese.") +(defconst strokes-xpm-header "/* XPM */ +static char * stroke_xpm[] = { +/* width height ncolors cpp [x_hot y_hot] */ +\"33 33 9 1 26 23\", +/* colors */ +\" c #D9D9D9D9D9D9\", +\"* s iconColor1 m black c black\", +\"R c #FFFF00000000\", +\"O c #FFFF80000000\", +\"Y c #FFFFFFFF0000\", +\"G c #0000FFFF0000\", +\"B c #00000000FFFF\", +\"P c #FFFF0000FFFF\", +\". c #45458B8B0000\", +/* pixels */\n" + "The header to all xpm buffers created by strokes") + ;;; user variables... (defgroup strokes nil @@ -365,6 +397,17 @@ (defvar strokes-load-hook nil "Function or functions to be called when `strokes' is loaded.") +(defvar edit-strokes-menu + '("Edit-Strokes" + ["Add stroke..." strokes-global-set-stroke t] + ["Delete stroke..." strokes-edit-delete-stroke t] + ["Change stroke" strokes-smaller t] + ["Change definition" strokes-larger t] + ["[Re]List Strokes chronologically" strokes-list-strokes t] + ["[Re]List Strokes alphabetically" strokes-list-strokes t] + ["Quit" strokes-edit-quit t] + )) + ;;; Macros... (defsubst strokes-click-p (stroke) @@ -482,6 +525,7 @@ (strokes-fix-button2-command 'dired-o-w-mouse-toggle) (strokes-fix-button2-command 'isearch-yank-x-selection) (strokes-fix-button2-command 'occur-mode-mouse-goto) +(strokes-fix-button2-command 'cvs-mouse-find-file) ;;; I can fix the customize widget button click, but then ;;; people will get confused when they try to customize @@ -637,10 +681,10 @@ "Returns a list with no consecutive redundant entries." ;; defun a grande vitesse grace a Dave G. (loop for element on entries - if (not (equal (car element) (cadr element))) + if (not (equal (car element) (cadr element))) collect (car element))) ;; (loop for element on entries -;; nconc (if (not (equal (car el) (cadr el))) +;; nconc (if (not (equal (car el) (cadr el))) ;; (list (car el))))) ;; yet another (orig) way of doing it... ;; (if entries @@ -663,6 +707,7 @@ POSITIONS is a list of positions and stroke-lifts. Optional GRID-RESOLUTION may be used in place of STROKES-GRID-RESOLUTION. The grid is a square whose dimesion is [0,GRID-RESOLUTION)." + (or grid-resolution (setq grid-resolution strokes-grid-resolution)) (let ((stroke-extent (strokes-get-stroke-extent positions))) (mapcar (function (lambda (pos) @@ -855,15 +900,16 @@ (when point (goto-char point) (subst-char-in-region point (1+ point) ?\ strokes-character)) - (setq pix-locs (cons (cons (event-x-pixel event) - (event-y-pixel event)) - pix-locs)))) + (push (cons (event-x-pixel event) + (event-y-pixel event)) + pix-locs))) (setq event (next-event event)))) ;; protected ;; clean up strokes buffer and then bury it. - (subst-char-in-region (point-min) (point-max) strokes-character ?\ ) - (goto-char (point-min)) - (bury-buffer))) + (when (equal (buffer-name) strokes-buffer-name) + (subst-char-in-region (point-min) (point-max) strokes-character ?\ ) + (goto-char (point-min)) + (bury-buffer)))) ;; Otherwise, don't use strokes buffer and read stroke silently (if prompt (progn @@ -874,9 +920,9 @@ (setq event (next-event)) (while (not (button-release-event-p event)) (if (mouse-event-p event) - (setq pix-locs (cons (cons (event-x-pixel event) - (event-y-pixel event)) - pix-locs))) + (push (cons (event-x-pixel event) + (event-y-pixel event)) + pix-locs)) (setq event (next-event event)))) (setq grid-locs (strokes-renormalize-to-grid (nreverse pix-locs))) (strokes-fill-stroke (strokes-eliminate-consecutive-redundancies grid-locs))))) @@ -901,6 +947,7 @@ (setq event (next-event event)))) (unwind-protect (progn + (setq event (next-event event prompt)) (while (not (and (button-press-event-p event) (eq (event-button event) 3))) (while (not (button-release-event-p event)) @@ -909,11 +956,11 @@ (when point (goto-char point) (subst-char-in-region point (1+ point) ?\ strokes-character)) - (setq pix-locs (cons (cons (event-x-pixel event) - (event-y-pixel event)) - pix-locs)))) + (push (cons (event-x-pixel event) + (event-y-pixel event)) + pix-locs))) (setq event (next-event event prompt))) - (setq pix-locs (cons strokes-lift pix-locs)) + (push strokes-lift pix-locs) (while (not (button-press-event-p event)) (dispatch-event event) (setq event (next-event event prompt)))) @@ -922,9 +969,10 @@ (strokes-fill-stroke (strokes-eliminate-consecutive-redundancies grid-locs))) ;; protected - (subst-char-in-region (point-min) (point-max) strokes-character ?\ ) - (goto-char (point-min)) - (bury-buffer)))))) + (when (equal (buffer-name) strokes-buffer-name) + (subst-char-in-region (point-min) (point-max) strokes-character ?\ ) + (goto-char (point-min)) + (bury-buffer))))))) (defun strokes-execute-stroke (stroke) "Given STROKE, execute the command which corresponds to it. @@ -1078,10 +1126,14 @@ > M-x list-strokes -Your strokes will be displayed in from most recent down, and the -beginning of each simple stroke will be marked by a color dot. Since -you may have several simple strokes in a complex stroke, the dot -colors are arranged in the rainbow color sequence, `ROYGBIV'. +Your strokes will be displayed in alphabetical order (based on command +names) and the beginning of each simple stroke will be marked by a +color dot. Since you may have several simple strokes in a complex +stroke, the dot colors are arranged in the rainbow color sequence, +`ROYGBIV'. If you want a listing of your strokes from most recent +down, then use a prefix argument: + +> C-u M-x list-strokes Your strokes are stored as you enter them. They get saved in a file called ~/.strokes, along with other strokes configuration variables. @@ -1158,10 +1210,9 @@ (defsubst strokes-fill-current-buffer-with-whitespace () "Erase the contents of the current buffer and fill it with whitespace" (erase-buffer) - (loop for i from 1 to (frame-height) do - (progn - (insert-char ?\ (1- (frame-width))) - (newline))) + (loop repeat (frame-height) do + (insert-char ?\ (1- (frame-width))) + (newline)) (goto-char (point-min))) (defun strokes-update-window-configuration () @@ -1268,48 +1319,43 @@ (if arg (> (prefix-numeric-value arg) 0) (not strokes-use-strokes-buffer)))) -(defun strokes-xpm-for-stroke (stroke &optional bufname) - "Create an xpm pixmap for the given stroke in buffer `*strokes-xpm*'. +(defun strokes-xpm-for-stroke (&optional stroke bufname b/w-only) + "Create an xpm pixmap for the given STROKE in buffer `*strokes-xpm*'. +If STROKE is not supplied, then `strokes-last-stroke' will be used. Optional BUFNAME to name something else. The pixmap will contain time information via rainbow dot colors -where each individual strokes begins." +where each individual strokes begins. +Optional B/W-ONLY non-nil will create a mono pixmap, not intended +for trying to figure out the order of strokes, but rather for reading +the stroke as a character in some language." + (interactive) (save-excursion (let ((buf (get-buffer-create (or bufname "*strokes-xpm*"))) (stroke (strokes-eliminate-consecutive-redundancies (strokes-fill-stroke - (strokes-renormalize-to-grid stroke 31)))) + (strokes-renormalize-to-grid (or stroke + strokes-last-stroke) + 31)))) (lift-flag t) - (rainbow-chars (list ?R ?O ?Y ?G ?B ?P)) ; ROYGBIV w/o indigo - (header (format "/* XPM */ -static char * stroke_xpm[] = { -/* width height ncolors cpp [x_hot y_hot] */ -\"33 33 9 1 26 23\", -/* colors */ -\" c #FFFFFFFFFFFF\", -\"* s iconColor1 m black c black\", -\"R c #FFFF00000000\", -\"O c #FFFF80000000\", -\"Y c #FFFFFFFF0000\", -\"G c #0000FFFF0000\", -\"B c #00000000FFFF\", -\"P c #FFFF0000FFFF\", -\". c #45458B8B0000\", -/* pixels */"))) + (rainbow-chars (list ?R ?O ?Y ?G ?B ?P))) ; ROYGBIV w/o indigo (set-buffer buf) (erase-buffer) - (insert header) + (insert strokes-xpm-header) (loop repeat 33 do - (newline) (insert-char ?\") (insert-char ?\ 33) (insert "\",") - finally (insert "}\n")) + (newline) + finally + (forward-line -1) + (end-of-line) + (insert "}\n")) (loop for point in stroke for x = (car-safe point) for y = (cdr-safe point) do (cond ((consp point) ;; draw a point, and possibly a starting-point - (if lift-flag + (if (and lift-flag (not b/w-only)) ;; mark starting point with the appropriate color (let ((char (or (car rainbow-chars) ?\.))) (loop for i from 0 to 2 do @@ -1326,27 +1372,149 @@ (subst-char-in-region (point) (1+ (point)) ?\ ?\*))) ((strokes-lift-p point) ;; a lift--tell the loop to X out the next point... - (setq lift-flag t))))))) + (setq lift-flag t)))) + (when (interactive-p) + (require 'xpm-mode) + (pop-to-buffer "*strokes-xpm*") + ;; (xpm-mode 1) + (xpm-show-image) + (goto-char (point-min)))))) + +;;; Strokes Edit stuff... + +(defun strokes-edit-quit () + (interactive) + (or (one-window-p t 0) + (delete-window)) + (kill-buffer "*Strokes List*")) + +(define-derived-mode edit-strokes-mode list-mode + "Edit-Strokes" + "Major mode for `edit-strokes' and `list-strokes' buffers. + +Editing commands: + +\\{edit-strokes-mode-map}" + (setq truncate-lines nil + auto-show-mode nil ; don't want problems here either + mode-popup-menu edit-strokes-menu) ; what about extent-specific stuff? + (and (featurep 'menubar) + current-menubar + (set (make-local-variable 'current-menubar) + (copy-sequence current-menubar)) + (add-submenu nil edit-strokes-menu))) + +(let ((map edit-strokes-mode-map)) + (define-key map "<" 'beginning-of-buffer) + (define-key map ">" 'end-of-buffer) + ;; (define-key map "c" 'strokes-copy-other-face) + ;; (define-key map "C" 'strokes-copy-this-face) + ;; (define-key map "s" 'strokes-smaller) + ;; (define-key map "l" 'strokes-larger) + ;; (define-key map "b" 'strokes-bold) + ;; (define-key map "i" 'strokes-italic) + (define-key map "e" 'strokes-list-edit) + ;; (define-key map "f" 'strokes-font) + ;; (define-key map "u" 'strokes-underline) + ;; (define-key map "t" 'strokes-truefont) + ;; (define-key map "F" 'strokes-foreground) + ;; (define-key map "B" 'strokes-background) + ;; (define-key map "D" 'strokes-doc-string) + (define-key map "a" 'strokes-global-set-stroke) + (define-key map "d" 'strokes-list-delete-stroke) + ;; (define-key map "n" 'strokes-list-next) + ;; (define-key map "p" 'strokes-list-prev) + ;; (define-key map " " 'strokes-list-next) + ;; (define-key map "\C-?" 'strokes-list-prev) + (define-key map "g" 'strokes-list-strokes) ; refresh display + (define-key map "q" 'strokes-edit-quit) + (define-key map [(control c) (control c)] 'bury-buffer)) ;;;###autoload -(defun strokes-list-strokes (&optional stroke-map) - "Pop up a buffer containing a listing of all strokes defined in STROKE-MAP. -If STROKE-MAP is not given, `strokes-global-map' will be used instead." - (interactive) +(defun strokes-edit-strokes (&optional chronological strokes-map) + ;; ### DEAL WITH THE 2nd ARGUMENT ISSUE! ### + "Edit strokes in a pop-up buffer containing strokes and their definitions. +If STROKES-MAP is not given, `strokes-global-map' will be used instead. + +Editing commands: + +\\{edit-faces-mode-map}" + (interactive "P") + (pop-to-buffer (get-buffer-create "*Strokes List*")) + (reset-buffer (current-buffer)) ; handy function from minibuf.el + (setq strokes-map (or strokes-map + strokes-global-map + (progn + (strokes-load-user-strokes) + strokes-global-map))) + (or chronological + (setq strokes-map (sort (copy-sequence strokes-map) + 'strokes-alphabetic-lessp))) + ;; (push-window-configuration) + (insert + "Command Stroke\n" + "------- ------") + (loop for def in strokes-map + for i from 0 to (1- (length strokes-map)) do + (let ((stroke (car def)) + (command-name (symbol-name (cdr def)))) + (strokes-xpm-for-stroke stroke " *strokes-xpm*") + (newline 2) + (insert-char ?\ 45) + (beginning-of-line) + (insert command-name) + (beginning-of-line) + (forward-char 45) + (set (intern (format "strokes-list-annotation-%d" i)) + (make-annotation (make-glyph + (list + (vector 'xpm + :data (buffer-substring + (point-min " *strokes-xpm*") + (point-max " *strokes-xpm*") + " *strokes-xpm*")) + [string :data "[Stroke]"])) + (point) 'text)) + (set-annotation-data (symbol-value (intern (format "strokes-list-annotation-%d" i))) + def)) + finally do (kill-region (1+ (point)) (point-max))) + (edit-strokes-mode) + (goto-char (point-min))) + +;;;###autoload +(defalias 'edit-strokes 'strokes-edit-strokes) + +;;;###autoload +(defun strokes-list-strokes (&optional chronological strokes-map) + "Pop up a buffer containing an alphabetical listing of strokes in STROKES-MAP. +With CHRONOLOGICAL prefix arg \(\\[universal-argument]\) list strokes +chronologically by command name. +If STROKES-MAP is not given, `strokes-global-map' will be used instead." + (interactive "P") + (setq strokes-map (or strokes-map + strokes-global-map + (progn + (strokes-load-user-strokes) + strokes-global-map))) + (if (not chronological) + ;; then alphabetize the strokes based on command names... + (setq strokes-map (sort (copy-sequence strokes-map) + 'strokes-alphabetic-lessp))) (push-window-configuration) (set-buffer (get-buffer-create "*Strokes List*")) (setq buffer-read-only nil) (erase-buffer) (insert "Command Stroke\n" - "------- ------\n\n") - (loop for def in (or stroke-map strokes-global-map) do + "------- ------") + (loop for def in strokes-map do (let ((stroke (car def)) - (command (cdr def))) + (command-name (symbol-name (cdr def)))) (strokes-xpm-for-stroke stroke " *strokes-xpm*") - (insert-char ?\ 60) + (newline 2) + (insert-char ?\ 45) (beginning-of-line) - (insert (symbol-name command)) + (insert command-name) (beginning-of-line) (forward-char 45) (make-annotation (make-glyph @@ -1357,15 +1525,22 @@ (point-max " *strokes-xpm*") " *strokes-xpm*")) [string :data "[Image]"])) - (point) 'text) - (newline 2))) + (point) 'text)) + finally do (kill-region (1+ (point)) (point-max))) (view-buffer "*Strokes List*" t) (goto-char (point-min)) -;; (define-key -;; (current-local-map (get-buffer "*Strokes List*")) -;; [(q)] -;; 'pop-window-configuration)) - ) + (define-key view-minor-mode-map [(q)] (lambda () + (interactive) + (view-quit) + (pop-window-configuration) + ;; (bury-buffer "*Strokes List*") + (define-key view-minor-mode-map [(q)] 'view-quit)))) + +(defun strokes-alphabetic-lessp (stroke1 stroke2) + "T iff command name for STROKE1 is less than STROKE2's in lexicographic order." + (let ((command-name-1 (symbol-name (cdr stroke1))) + (command-name-2 (symbol-name (cdr stroke2)))) + (string-lessp command-name-1 command-name-2))) ;;;###autoload (defalias 'list-strokes 'strokes-list-strokes) @@ -1418,7 +1593,325 @@ (add-minor-mode 'strokes-mode strokes-modeline-string nil nil 'strokes-mode) +(unless (find-face 'strokes-char-face) + (copy-face 'default 'strokes-char-face) + (set-face-background 'strokes-char-face "lightgray")) + +(defconst strokes-char-value-hashtable (make-hashtable 62) ; + ; (make-char-table + ; 'syntax) + ; in 20.* + ;; ### This will become a char-table for XEmacs-20 !!! ### + "The table which stores values for the character keys.") +(puthash ?0 0 strokes-char-value-hashtable) ; (put-char-table ?0 0 + ; strokes-value-chartable) + ; in 20.* +(puthash ?1 1 strokes-char-value-hashtable) +(puthash ?2 2 strokes-char-value-hashtable) +(puthash ?3 3 strokes-char-value-hashtable) +(puthash ?4 4 strokes-char-value-hashtable) +(puthash ?5 5 strokes-char-value-hashtable) +(puthash ?6 6 strokes-char-value-hashtable) +(puthash ?7 7 strokes-char-value-hashtable) +(puthash ?8 8 strokes-char-value-hashtable) +(puthash ?9 9 strokes-char-value-hashtable) +(puthash ?a 10 strokes-char-value-hashtable) +(puthash ?b 11 strokes-char-value-hashtable) +(puthash ?c 12 strokes-char-value-hashtable) +(puthash ?d 13 strokes-char-value-hashtable) +(puthash ?e 14 strokes-char-value-hashtable) +(puthash ?f 15 strokes-char-value-hashtable) +(puthash ?g 16 strokes-char-value-hashtable) +(puthash ?h 17 strokes-char-value-hashtable) +(puthash ?i 18 strokes-char-value-hashtable) +(puthash ?j 19 strokes-char-value-hashtable) +(puthash ?k 20 strokes-char-value-hashtable) +(puthash ?l 21 strokes-char-value-hashtable) +(puthash ?m 22 strokes-char-value-hashtable) +(puthash ?n 23 strokes-char-value-hashtable) +(puthash ?o 24 strokes-char-value-hashtable) +(puthash ?p 25 strokes-char-value-hashtable) +(puthash ?q 26 strokes-char-value-hashtable) +(puthash ?r 27 strokes-char-value-hashtable) +(puthash ?s 28 strokes-char-value-hashtable) +(puthash ?t 29 strokes-char-value-hashtable) +(puthash ?u 30 strokes-char-value-hashtable) +(puthash ?v 31 strokes-char-value-hashtable) +(puthash ?w 32 strokes-char-value-hashtable) +(puthash ?x 33 strokes-char-value-hashtable) +(puthash ?y 34 strokes-char-value-hashtable) +(puthash ?z 35 strokes-char-value-hashtable) +(puthash ?A 36 strokes-char-value-hashtable) +(puthash ?B 37 strokes-char-value-hashtable) +(puthash ?C 38 strokes-char-value-hashtable) +(puthash ?D 39 strokes-char-value-hashtable) +(puthash ?E 40 strokes-char-value-hashtable) +(puthash ?F 41 strokes-char-value-hashtable) +(puthash ?G 42 strokes-char-value-hashtable) +(puthash ?H 43 strokes-char-value-hashtable) +(puthash ?I 44 strokes-char-value-hashtable) +(puthash ?J 45 strokes-char-value-hashtable) +(puthash ?K 46 strokes-char-value-hashtable) +(puthash ?L 47 strokes-char-value-hashtable) +(puthash ?M 48 strokes-char-value-hashtable) +(puthash ?N 49 strokes-char-value-hashtable) +(puthash ?O 50 strokes-char-value-hashtable) +(puthash ?P 51 strokes-char-value-hashtable) +(puthash ?Q 52 strokes-char-value-hashtable) +(puthash ?R 53 strokes-char-value-hashtable) +(puthash ?S 54 strokes-char-value-hashtable) +(puthash ?T 55 strokes-char-value-hashtable) +(puthash ?U 56 strokes-char-value-hashtable) +(puthash ?V 57 strokes-char-value-hashtable) +(puthash ?W 58 strokes-char-value-hashtable) +(puthash ?X 59 strokes-char-value-hashtable) +(puthash ?Y 60 strokes-char-value-hashtable) +(puthash ?Z 61 strokes-char-value-hashtable) + +(defconst strokes-base64-chars + ;; I can easily have made this a vector of single-character strings, + ;; like (vector "0" "1" "2" ...), and then the program would run + ;; faster since it wouldn't then have to call `char-to-string' when it + ;; did the `concat'. I left them as chars here because I want + ;; *them* to change `concat' so that it accepts chars and deals with + ;; them properly. i.e. the form: (concat "abc" ?T "xyz") should + ;; return "abcTxyz" NOT "abc84xyz" (XEmacs 19.*) and NOT an error + ;; (XEmacs 20.*). + ;; (vector "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" + ;; "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" + ;; "p" "q" "r" "s" "t" "u" "v" "w" "x" "y" "z" "A" "B" "C" "D" + ;; "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O" "P" "Q" "R" "S" + ;; "T" "U" "V" "W" "X" "Y" "Z") + (vector ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 + ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z + ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z) + "Character vector for fast lookup of base-64 encoding of numbers in [0,61].") + +(defsubst strokes-xpm-char-on-p (char) + ;; ### CAUTION: `char-equal' may need to change to `char=' ### + "Non-nil if CHAR represents an `on' bit in the xpm." + (char-equal char ?*)) + +(defsubst strokes-xpm-char-bit-p (char) + "Non-nil if CHAR represents an `on' or `off' bit in the xpm." + ;; ### CAUTION: `char-equal' may need to change to `char=' ### + (or (char-equal char ?\ ) + (char-equal char ?*))) + +;;(defsubst strokes-xor (a b) ### Should I make this an inline function? ### +;; "T iff one and only one of A and B is non-nil; otherwise, returns nil. +;;NOTE: Don't use this as a numeric xor since it treats all non-nil +;; values as t including `0' (zero)." +;; (eq (null a) (not (null b)))) + +(defsubst strokes-xpm-encode-length-as-string (length) + "Given some LENGTH in [0,62) do a fast lookup of it's encoding." + (char-to-string (aref strokes-base64-chars length))) + +(defsubst strokes-xpm-decode-char (character) + "Given a CHARACTER, do a fast lookup to find its corresponding integer value." + ;; ### NOTE: for XEmacs-20.* this will need to be changed to deal w/ + ;; char-tables !!! ### + (gethash character strokes-char-value-hashtable)) ; (get-char-table + ; character + ; strokes-value-chartable) + +(defun strokes-xpm-to-compressed-string (&optional xpm-buffer) + "Convert the xpm in XPM-BUFFER into a compressed string representing the stroke. +XPM-BUFFER is an optional argument, and defaults to `*strokes-xpm*'." + (save-excursion + (set-buffer (setq xpm-buffer (or xpm-buffer "*strokes-xpm*"))) + (goto-char (point-min)) + (search-forward "/* pixels */") ; skip past header junk + (forward-char 2) + ;; a note for below: + ;; the `current-char' is the char being counted -- NOT the char at (point) + ;; which happens to be called `char-at-point' + (let ((compressed-string "+/") ; initialize the output + (count 0) ; keep a current count of + ; `current-char' + (last-char-was-on-p t) ; last entered stream + ; represented `on' bits + (current-char-is-on-p nil) ; current stream represents `on' bits + (char-at-point (char-after))) ; read the first char + (while (not (char-equal char-at-point ?})) ; a `}' denotes the + ; end of the pixmap + (cond ((zerop count) ; must restart counting + ;; check to see if the `char-at-point' is an actual pixmap bit + (when (strokes-xpm-char-bit-p char-at-point) + (setq count 1 + current-char-is-on-p (strokes-xpm-char-on-p char-at-point))) + (forward-char 1)) + ((= count 61) ; maximum single char's + ; encoding length + (setq compressed-string (concat compressed-string + ;; add a zero-length + ;; encoding when + ;; necessary + (when (eq last-char-was-on-p + current-char-is-on-p) + ;; "0" + (strokes-xpm-encode-length-as-string 0)) + (strokes-xpm-encode-length-as-string 61)) + last-char-was-on-p current-char-is-on-p + count 0)) ; note that we just set + ; count=0 and *don't* advance + ; (point) + ((strokes-xpm-char-bit-p char-at-point) ; an actual xpm bit + (if (eq current-char-is-on-p + (strokes-xpm-char-on-p char-at-point)) + ;; yet another of the same bit-type, so we continue + ;; counting... + (progn + (incf count) + (forward-char 1)) + ;; otherwise, it's the opposite bit-type, so we do a + ;; write and then restart count ### NOTE (for myself + ;; to be aware of) ### I really should advance + ;; (point) in this case instead of letting another + ;; iteration go through and letting the case: count=0 + ;; take care of this stuff for me. That's why + ;; there's no (forward-char 1) below. + (setq compressed-string (concat compressed-string + ;; add a zero-length + ;; encoding when + ;; necessary + (when (eq last-char-was-on-p + current-char-is-on-p) + ;; "0" + (strokes-xpm-encode-length-as-string 0)) + (strokes-xpm-encode-length-as-string count)) + count 0 + last-char-was-on-p current-char-is-on-p))) + (t ; ELSE it's some other useless + ; char, like `"' or `,' + (forward-char 1))) + (setq char-at-point (char-after))) + (concat compressed-string + (when (> count 0) + (concat (when (eq last-char-was-on-p + current-char-is-on-p) + ;; "0" + (strokes-xpm-encode-length-as-string 0)) + (strokes-xpm-encode-length-as-string count))) + "/")))) + +(defun strokes-strokify-buffer (&optional buffer) + "Decode stroke strings in BUFFER and display their corresponding glyphs. +BUFFER defaults to the current buffer." + (interactive) + ;; (interactive "*bStrokify buffer: ") + (save-excursion + (set-buffer (or buffer (setq buffer (current-buffer)))) + (if (interactive-p) + (message "Strokifying %s..." buffer)) + (goto-char (point-min)) + (let (ext string) + ;; The comment below is what i'd have to do if I wanted to deal with + ;; random newlines in the midst of the compressed strings. + ;; If I do this, I'll also have to change `strokes-xpm-to-compress-string' + ;; to deal with the newline, and possibly other whitespace stuff. YUCK! + ;; (while (re-search-forward "\\+/\\(\\w\\| + ;;\\)+/" nil t nil (get-buffer buffer)) + (while (re-search-forward "\\+/\\w+/" nil t nil (get-buffer buffer)) + (setq string (buffer-substring (+ 2 (match-beginning 0)) + (1- (match-end 0)))) + (strokes-xpm-for-compressed-string string " *strokes-xpm*") + (replace-match " ") + (setq ext (make-extent (1- (point)) (point))) + (set-extent-property ext 'type 'stroke-glyph) + (set-extent-property ext 'start-open t) + (set-extent-property ext 'end-open t) + (set-extent-property ext 'detachable t) + (set-extent-property ext 'duplicable t) + (set-extent-property ext 'data string) + (set-extent-face ext 'strokes-char-face) + (set-extent-end-glyph ext (make-glyph + (list + (vector 'xpm + :data (buffer-substring + (point-min " *strokes-xpm*") + (point-max " *strokes-xpm*") + " *strokes-xpm*")) + [string :data "[Stroke]"]))))) + (if (interactive-p) + (message "Strokifying %s...done" buffer)))) + +(defun strokes-unstrokify-buffer (&optional buffer) + "Convert the glyphs in BUFFER to thier base-64 ASCII representations. +BUFFER defaults to the current buffer" + ;; ### NOTE !!! ### (for me) + ;; For later on, you can/should make the inserted strings atomic + ;; extents, so that the users have a clue that they shouldn't be + ;; editing inside them. Plus, if you make them extents, you can + ;; very easily just hide the glyphs, so if you unstrokify, and the + ;; restrokify, then those that already are glyphed don't need to be + ;; re-calculated, etc. It's just nicer that way. The only things + ;; to worry about is cleanup (i.e. do the glyphs get gc'd when the + ;; buffer is killed? + ;; (interactive "*bUnstrokify buffer: ") + (interactive) + (save-excursion + (set-buffer (setq buffer (or buffer (current-buffer)))) + ;; (map-extents + ;; (lambda (ext buf) + ;; (when (eq (extent-property ext 'type) 'stroke-glyph) + ;; (goto-char (extent-start-position ext)) + ;; (delete-char 1) ; ### What the hell do I do here? ### + ;; (insert "+/" (extent-property ext 'data) "/") + ;; (delete-extent ext)))))) + (let (start) + (map-extents + (lambda (ext buf) + (when (eq (extent-property ext 'type) 'stroke-glyph) + (setq start (goto-char (extent-start-position ext))) +;; (insert "+/" (extent-property ext 'data) "/") + (insert-string "+/") + (insert-string (extent-property ext 'data)) + (insert-string "/") + (delete-char 1) + (set-extent-endpoints ext start (point)) + (set-extent-property ext 'type 'stroke-string) + (set-extent-property ext 'atomic t) +;; (set-extent-property ext 'read-only t) + (set-extent-face ext 'strokes-char-face) + (set-extent-property ext 'stroke-glyph (extent-end-glyph ext)) + (set-extent-end-glyph ext nil))))))) + +(defun strokes-xpm-for-compressed-string (compressed-string &optional bufname) + "Convert the stroke represented by COMPRESSED-STRING into an xpm. +Store xpm in buffer BUFNAME if supplied \(default is `*strokes-xpm*'\)" + (save-excursion + (or bufname (setq bufname "*strokes-xpm*")) + (erase-buffer (set-buffer (get-buffer-create bufname))) + (insert compressed-string) + (goto-char (point-min)) + (let ((current-char-is-on-p nil)) + (while (not (eobp)) + (insert-char + (if current-char-is-on-p + ?* + ?\ ) + (strokes-xpm-decode-char (char-after))) + (delete-char 1) + (setq current-char-is-on-p (not current-char-is-on-p))) + (goto-char (point-min)) + (loop repeat 33 do + (insert-char ?\") + (forward-char 33) + (insert "\",\n")) + (goto-char (point-min)) + (insert strokes-xpm-header)))) + +(defun strokes-compose-complex-stroke () + (interactive "*") + (let ((strokes-grid-resolution 33)) + (strokes-read-complex-stroke) + (strokes-xpm-for-stroke nil nil t) + (insert (strokes-xpm-to-compressed-string)) + (strokes-strokify-buffer))) + (provide 'strokes) (run-hooks 'strokes-load-hook) -;;; strokes.el ends here +;;; strokes.el ends here \ No newline at end of file diff -r 6866abce6aaf -r 6075d714658b lisp/modes/verilog-mode.el --- a/lisp/modes/verilog-mode.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/modes/verilog-mode.el Mon Aug 13 09:51:16 2007 +0200 @@ -1,6 +1,6 @@ ;;; verilog-mode.el --- major mode for editing verilog source in Emacs ;; -;; $Header: /afs/informatik.uni-tuebingen.de/local/web/xemacs/xemacs-cvs/XEmacs/xemacs/lisp/modes/Attic/verilog-mode.el,v 1.6 1997/06/14 20:31:18 steve Exp $ +;; $Header: /afs/informatik.uni-tuebingen.de/local/web/xemacs/xemacs-cvs/XEmacs/xemacs/lisp/modes/Attic/verilog-mode.el,v 1.7 1997/07/26 22:09:50 steve Exp $ ;; Copyright (C) 1996 Free Software Foundation, Inc. @@ -70,7 +70,7 @@ (provide 'verilog-mode) ;; This variable will always hold the version number of the mode -(defconst verilog-mode-version "$$Revision: 1.6 $$" +(defconst verilog-mode-version "$$Revision: 1.7 $$" "Version of this verilog mode.") ;; @@ -2973,7 +2973,7 @@ (save-excursion (let ((verilog-all nil)) ;; Set buffer to use for searching labels. This should be set - ;; within functins which use verilog-completions + ;; within functions which use verilog-completions (set-buffer verilog-buffer-to-use) ;; Determine what should be completed @@ -3157,7 +3157,7 @@ match) ;; Set buffer to use for searching labels. This should be set - ;; within functins which use verilog-completions + ;; within functions which use verilog-completions (set-buffer verilog-buffer-to-use) (let ((verilog-str verilog-str)) diff -r 6866abce6aaf -r 6075d714658b lisp/modes/view-process-system-specific.el --- a/lisp/modes/view-process-system-specific.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/modes/view-process-system-specific.el Mon Aug 13 09:51:16 2007 +0200 @@ -7,7 +7,7 @@ ;; This file is part of XEmacs. -;;; $Id: view-process-system-specific.el,v 1.2 1997/06/26 02:31:06 steve Exp $ +;;; $Id: view-process-system-specific.el,v 1.3 1997/07/26 22:09:50 steve Exp $ ;; XEmacs is free software; you can redistribute it and/or modify it ;; under the terms of the GNU General Public License as published by @@ -44,7 +44,7 @@ (defvar View-process-specific-system-list '(("linux" nil "bsd" - nil + View-process-field-name-descriptions-linux View-process-kill-signals-linux) ("sunos" "4" "bsd" View-process-field-name-descriptions-sunos4 @@ -149,18 +149,19 @@ '(("SIGHUP" "1") ("SIGINT" "2") ("SIGQUIT" "3") ("SIGILL" "4") ("SIGTRAP" "5") ("SIGIOT" "6") ("SIGBUS" "7") ("SIGFPE" "8") ("SIGKILL" "9") ("SIGUSR1" "10") ("SIGSEGV" "11") ("SIGUSR2" "12") - ("SIGPIPE" "13") ("SIGALRM" "14") ("SIGTERM" "15") ("SIGCHLD" "17") - ("SIGCONT" "18") ("SIGSTOP" "19") ("SIGTSTP" "20") ("SIGTTIN" "21") - ("SIGTTOU" "22") ("SIGIO" "23") ("SIGXCPU" "24") ("SIGXFSZ" "25") - ("SIGVTALRM" "26") ("SIGPROF" "27") ("SIGWINCH" "28") ("SIGPWR" "30") + ("SIGPIPE" "13") ("SIGALRM" "14") ("SIGTERM" "15") ("SIGSTKFLT" "16") + ("SIGCHLD" "17") ("SIGCONT" "18") ("SIGSTOP" "19") ("SIGTSTP" "20") + ("SIGTTIN" "21") ("SIGTTOU" "22") ("SIGURG" "23") ("SIGXCPU" "24") + ("SIGXFSZ" "25") ("SIGVTALRM" "26") ("SIGPROF" "27") ("SIGWINCH" "28") + ("SIGIO" "29") ("SIGPWR" "30") ("1" "1") ("2" "2") ("3" "3") ("4" "4") ("5" "5") ("6" "6") ("7" "7") ("8" "8") ("9" "9") ("10" "10") ("11" "11") ("12" "12") ("13" "13") - ("14" "14") ("15" "15") ("17" "17") ("18" "18") ("19" "19") + ("14" "14") ("15" "15") ("16" "16") ("17" "17") ("18" "18") ("19" "19") ("20" "20") ("21" "21") ("22" "22") ("23" "23") ("24" "24") - ("25" "25") ("26" "26") ("27" "27") ("28" "28") ("30" "30")) + ("25" "25") ("26" "26") ("27" "27") ("28" "28") ("29" "29") ("30" "30")) "An alist with the possible signals for the kill command for linux. It may be that you've other signals on your system. Try to test -it with \"kill -l\" in a shell.") +it with \"kill -l\" in a shell, or better, see ") ;; all Linux signals ;(defvar View-process-kill-signals @@ -230,6 +231,70 @@ ) "Help list with the descriptions of ps fields for BSD systems.") +(defvar View-process-field-name-descriptions-linux + '( + ("USER" "Effective user id.") ("UID" "Effective user id.") + ("RUSER" "Real user id.") ("RUID" "Real user id.") + ("SUSER" "Saved user id.") ("SUID" "Saved user id.") + ("FSUSER" "Filesystem user id.") ("FSUID" "Filesystem user id.") + ("GROUP" "Effective group id.") ("GID" "Effective group id.") + ("RGROUP" "Real group id.") ("RGID" "Real group id.") + ("SGROUP" "Saved group id.") ("SGID" "Saved group id.") + ("FSGROUP" "Filesystem group id.") ("FSGID" "Filesystem group id.") + ("PID" "Process id.") ("PPID" "Parent process id.") + ("PGID" "Process group id.") ("TPGID" "Terminal process group id, (-1 if none).") + ("SID" "Session id.") + ("NI" "Nice.") ("PRI" "Priority.") + ("TIME" "CPU time, both user and system, in seconds.") + ("CTIME" "Cumulative CPU time, both user and system, in seconds.") + ("ELAPSED" "Time between process start and now, in seconds.") + ("UTIME" "User time, in seconds.") ("CUTIME" "Cumulative user time, in seconds.") + ("STIME" "System time, in seconds.") ("CSTIME" "Cumulative system time, in seconds.") + ("%CPU" "Percent cpu.") + ("TT" "Controlling tty, or ? if none.") + ("COMMAND" "The command name of the process.") + ("VSZ" "Virtual size.") ("RSS" "Resident set size.") + ("%MEM" "Percentage of real memory, derived from RSS.") + ("STAT" ("State: " + ("R" "'R'=runnable. ") + ("S" "'S'=sleeping. ") + ("D" "'D'=un-interruptible wait (eg disk or NFS I/O). ") + ("T" "'T'=stopped or traced. ") + ("Z" "'Z'=zombie (terminated). ") + ("W" "'W'=no resident pages. ") + ("SW" "'S'=sleeping. 'W'=no resident pages. ") + ("SW<" "'S'=sleeping. 'W'=no resident pages. '<'=Nice < 0 (super priveledged task) ") + ("N" "'N'=Nice > 0 (lower priority) ") + ("<" "'<'=Nice < 0 (super priveledged task) ") + (">" "'>'=exceeded soft limit. "))) + ("START" "Starting time.") ("FLAGS" "Process flags .") + ("MINFL" "Minor page faults.") ("MAJFL" "Major page faults.") + ("TMOUT" "Timeout.") ("ALARM" "Alarm.") + ("S_CODE" "Address of start of code segment.") + ("E_CODE" "Address of end of code segment.") + ("STACKP" "Address of the process's stack bottom.") + ("ESP" "Stack pointer.") ("EIP" "Stack pointer.") + ("WCHAN" "Wait channel in which process is sleeping. ") + ("BLOCKED" "Blocked signals mask.") + ("IGNORED" "Ignored signals mask.") + ("CATCHED" "Catched signals mask.") + ("SIGNAL" "Pending signals mask.") + ("ENVIRONMENT" "Process environment.") + ("LCK" "Pages locked in i/o, kb.") + ("DATA" "Data size.") ("STACK" "Stack size.") + ("EXE" "Executable size.") ("LIB" "Library size.") + ("SIZE" "The virtual size of the process.") + ("RES" "The resident size of the process.") + ("SHRD" "The size of all shared pages, (lib, code, data).") + ("TRS" "Text resident size.") + ("DRS" "Data resident size.") + ("DT" "Dirty pages.") + ("LRS" "Library resident size. (a.out).") + ("SWAP" "Non-resident size of the process.") + ) + "Help list with the descriptions of ps fields for Linux systems. +See: `manual-entry' ps_fields(7), ps(1), and top(1) for more information.") + (defvar View-process-field-name-descriptions-system-v '( ("C" "Processor utilization for scheduling. ") diff -r 6866abce6aaf -r 6075d714658b lisp/modes/whitespace-mode.el --- a/lisp/modes/whitespace-mode.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/modes/whitespace-mode.el Mon Aug 13 09:51:16 2007 +0200 @@ -26,7 +26,7 @@ ;;; Commentary: -;; $Id: whitespace-mode.el,v 1.3 1997/04/19 23:21:05 steve Exp $ +;; $Id: whitespace-mode.el,v 1.4 1997/07/26 22:09:50 steve Exp $ ;; Description: ;; ;; This is a minor mode, which highlights whitespaces (blanks and @@ -561,31 +561,20 @@ (if (and (adapt-xemacsp) whitespace-install-toolbar-icon - (featurep 'toolbar) + (featurep 'toolbar) (eq (device-type (selected-device)) 'x)) - (add-spec-list-to-specifier - default-toolbar - '((global - (nil - [toolbar-file-icon find-file t "Open a file" ] - [toolbar-folder-icon dired t "View directory"] - [toolbar-disk-icon save-buffer t "Save buffer" ] - [toolbar-printer-icon print-buffer t "Print buffer" ] - [toolbar-cut-icon x-kill-primary-selection t "Kill region"] - [toolbar-copy-icon x-copy-primary-selection t "Copy region"] - [toolbar-paste-icon - x-yank-clipboard-selection t "Paste from clipboard"] - [toolbar-undo-icon undo t "Undo edit" ] - [toolbar-replace-icon query-replace t "Replace text" ] - [toolbar-wspace-icon - whitespace-toolbar-function t "Toggle whitespace mode"] - nil - [toolbar-compile-icon toolbar-compile t "Compile" ] - [toolbar-debug-icon toolbar-debug t "Debug" ] - [toolbar-spell-icon toolbar-ispell t "Spellcheck" ] - [toolbar-mail-icon toolbar-mail t "Mail" ] - [toolbar-news-icon toolbar-news t "News" ] - [toolbar-info-icon toolbar-info t "Information" ] - ))))) + (let ((tb (mapcar #'(lambda (e) + (elt e 1)) (specifier-instance default-toolbar)))) + (and (not (member 'whitespace-toolbar-function tb)) + (toolbar-add-item + [toolbar-wspace-icon whitespace-toolbar-function + t "Toggle whitespace mode"] + (let ((n (or + (position 'toolbar-replace tb) + (position 'toolbar-undo tb) + (position 'toolbar-paste tb) + (position 'toolbar-copy tb) + (position 'toolbar-cut tb)))) + (if n (1+ n) (length tb))))))) ;;; whitespace-mode.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/mule/mule-misc.el --- a/lisp/mule/mule-misc.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/mule/mule-misc.el Mon Aug 13 09:51:16 2007 +0200 @@ -216,8 +216,8 @@ (list (intern (completing-read "Language environment: " obarray 'language-environment-p 'require-match)))) - (when (not (string= (charset-registry 'ascii) "ISO8859-1")) - (set-charset-registry 'ascii "ISO8859-1")) + (when (not (string= (charset-registry 'ascii) "iso8859-1")) + (set-charset-registry 'ascii "iso8859-1")) (let ((func (get env 'set-lang-environ))) (if (not (null func)) (funcall func))) diff -r 6866abce6aaf -r 6075d714658b lisp/packages/auto-autoloads.el --- a/lisp/packages/auto-autoloads.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/packages/auto-autoloads.el Mon Aug 13 09:51:16 2007 +0200 @@ -2167,7 +2167,7 @@ ;;;*** -;;;### (autoloads (vc-update-change-log vc-rename-file vc-cancel-version vc-revert-buffer vc-print-log vc-retrieve-snapshot vc-create-snapshot vc-directory vc-insert-headers vc-version-other-window vc-diff vc-checkout vc-register vc-next-action vc-find-binary) "vc" "packages/vc.el") +;;;### (autoloads (vc-update-change-log vc-rename-file vc-cancel-version vc-revert-buffer vc-print-log vc-retrieve-snapshot vc-create-snapshot vc-directory vc-insert-headers vc-version-other-window vc-version-diff vc-diff vc-checkout vc-register vc-next-action vc-find-binary) "vc" "packages/vc.el") (defvar vc-before-checkin-hook nil "\ *Normal hook (list of functions) run before a file gets checked in. @@ -2231,6 +2231,11 @@ With a prefix argument, it reads the file name to use and two version designators specifying which versions to compare." t nil) +(autoload 'vc-version-diff "vc" "\ +For FILE, report diffs between two stored versions REL1 and REL2 of it. +If FILE is a directory, generate diffs between versions for all registered +files in or below it." t nil) + (autoload 'vc-version-other-window "vc" "\ Visit version REV of the current buffer in another window. If the current buffer is named `F', the version is named `F.~REV~'. diff -r 6866abce6aaf -r 6075d714658b lisp/packages/custom-load.el --- a/lisp/packages/custom-load.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/packages/custom-load.el Mon Aug 13 09:51:16 2007 +0200 @@ -1,46 +1,46 @@ -(custom-put 'copyright 'custom-loads '("upd-copyr")) -(custom-put 'time-stamp 'custom-loads '("time-stamp")) -(custom-put 'texinfo-tex 'custom-loads '("texnfo-tex")) -(custom-put 'supercite-hooks 'custom-loads '("supercite")) -(custom-put 'supercite-cite 'custom-loads '("supercite")) -(custom-put 'supercite-attr 'custom-loads '("supercite")) -(custom-put 'supercite-frames 'custom-loads '("supercite")) -(custom-put 'supercite 'custom-loads '("supercite")) -(custom-put 'save-place 'custom-loads '("saveplace")) -(custom-put 'recent-files-menu 'custom-loads '("recent-files")) -(custom-put 'recent-files 'custom-loads '("recent-files")) -(custom-put 'remote-compile 'custom-loads '("rcompile")) -(custom-put 'ps-print-face 'custom-loads '("ps-print")) -(custom-put 'ps-print-color 'custom-loads '("ps-print")) -(custom-put 'ps-print-font 'custom-loads '("ps-print")) -(custom-put 'ps-print-header 'custom-loads '("ps-print")) -(custom-put 'ps-print-vertical 'custom-loads '("ps-print")) -(custom-put 'ps-print-horizontal 'custom-loads '("ps-print")) -(custom-put 'ps-print 'custom-loads '("ps-print")) -(custom-put 'pages 'custom-loads '("page-ext")) -(custom-put 'metamail 'custom-loads '("metamail")) -(custom-put 'man 'custom-loads '("man")) +(custom-put 'igrep 'custom-loads '("igrep")) +(custom-put 'change-log 'custom-loads '("add-log")) +(custom-put 'auto-save 'custom-loads '("auto-save")) +(custom-put 'avoid 'custom-loads '("avoid")) +(custom-put 'balloon-help 'custom-loads '("balloon-help")) +(custom-put 'compilation 'custom-loads '("compile")) +(custom-put 'completion 'custom-loads '("completion")) +(custom-put 'dabbrev 'custom-loads '("dabbrev")) +(custom-put 'desktop 'custom-loads '("desktop")) +(custom-put 'diff 'custom-loads '("diff")) +(custom-put 'etags 'custom-loads '("etags")) +(custom-put 'fast-lock 'custom-loads '("fast-lock")) +(custom-put 'feedmail 'custom-loads '("feedmail")) +(custom-put 'filladapt 'custom-loads '("filladapt")) +(custom-put 'fume 'custom-loads '("func-menu")) +(custom-put 'generic-sc 'custom-loads '("generic-sc")) +(custom-put 'gnuserv 'custom-loads '("gnuserv")) +(custom-put 'gopher 'custom-loads '("gopher")) +(custom-put 'hyper-apropos 'custom-loads '("hyper-apropos")) +(custom-put 'hyper-apropos-faces 'custom-loads '("hyper-apropos")) +(custom-put 'info 'custom-loads '("info")) +(custom-put 'ispell 'custom-loads '("ispell")) +(custom-put 'lpr 'custom-loads '("lpr")) (custom-put 'makeinfo 'custom-loads '("makeinfo")) -(custom-put 'lpr 'custom-loads '("lpr")) -(custom-put 'ispell 'custom-loads '("ispell")) -(custom-put 'info 'custom-loads '("info")) -(custom-put 'hyper-apropos-faces 'custom-loads '("hyper-apropos")) -(custom-put 'hyper-apropos 'custom-loads '("hyper-apropos")) -(custom-put 'gopher 'custom-loads '("gopher")) -(custom-put 'gnuserv 'custom-loads '("gnuserv")) -(custom-put 'generic-sc 'custom-loads '("generic-sc")) -(custom-put 'fume 'custom-loads '("func-menu")) -(custom-put 'filladapt 'custom-loads '("filladapt")) -(custom-put 'feedmail 'custom-loads '("feedmail")) -(custom-put 'fast-lock 'custom-loads '("fast-lock")) -(custom-put 'etags 'custom-loads '("etags")) -(custom-put 'diff 'custom-loads '("diff")) -(custom-put 'desktop 'custom-loads '("desktop")) -(custom-put 'dabbrev 'custom-loads '("dabbrev")) -(custom-put 'completion 'custom-loads '("completion")) -(custom-put 'compilation 'custom-loads '("compile")) -(custom-put 'balloon-help 'custom-loads '("balloon-help")) -(custom-put 'avoid 'custom-loads '("avoid")) -(custom-put 'auto-save 'custom-loads '("auto-save")) -(custom-put 'change-log 'custom-loads '("add-log")) -(custom-put 'igrep 'custom-loads '("igrep")) +(custom-put 'man 'custom-loads '("man")) +(custom-put 'metamail 'custom-loads '("metamail")) +(custom-put 'pages 'custom-loads '("page-ext")) +(custom-put 'ps-print 'custom-loads '("ps-print")) +(custom-put 'ps-print-horizontal 'custom-loads '("ps-print")) +(custom-put 'ps-print-vertical 'custom-loads '("ps-print")) +(custom-put 'ps-print-header 'custom-loads '("ps-print")) +(custom-put 'ps-print-font 'custom-loads '("ps-print")) +(custom-put 'ps-print-color 'custom-loads '("ps-print")) +(custom-put 'ps-print-face 'custom-loads '("ps-print")) +(custom-put 'remote-compile 'custom-loads '("rcompile")) +(custom-put 'recent-files 'custom-loads '("recent-files")) +(custom-put 'recent-files-menu 'custom-loads '("recent-files")) +(custom-put 'save-place 'custom-loads '("saveplace")) +(custom-put 'supercite 'custom-loads '("supercite")) +(custom-put 'supercite-frames 'custom-loads '("supercite")) +(custom-put 'supercite-attr 'custom-loads '("supercite")) +(custom-put 'supercite-cite 'custom-loads '("supercite")) +(custom-put 'supercite-hooks 'custom-loads '("supercite")) +(custom-put 'texinfo-tex 'custom-loads '("texnfo-tex")) +(custom-put 'time-stamp 'custom-loads '("time-stamp")) +(custom-put 'copyright 'custom-loads '("upd-copyr")) diff -r 6866abce6aaf -r 6075d714658b lisp/packages/info.el --- a/lisp/packages/info.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/packages/info.el Mon Aug 13 09:51:16 2007 +0200 @@ -1899,7 +1899,9 @@ (bury-buffer (current-buffer)) (if (and (featurep 'toolbar) (eq toolbar-info-frame (selected-frame))) - (delete-frame toolbar-info-frame) + (condition-case () + (delete-frame toolbar-info-frame) + (error (bury-buffer))) (switch-to-buffer (other-buffer (current-buffer)))))) (defun Info-undefined () @@ -2343,7 +2345,8 @@ ;; (not (string-match "\\" Info-current-node)) ;; (< (- (point-max) (point)) 10000) ) - (while (re-search-forward "^\\* \\([^:\t\n]*\\):" nil t) + (while (re-search-forward + "^\\* \\([^\t\n]*\\):?:[ \t\n]" nil t) (Info-highlight-region (match-beginning 1) (match-end 1) 'info-node ;lucid ))) diff -r 6866abce6aaf -r 6075d714658b lisp/packages/vc-hooks.el --- a/lisp/packages/vc-hooks.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/packages/vc-hooks.el Mon Aug 13 09:51:16 2007 +0200 @@ -4,6 +4,7 @@ ;; Author: Eric S. Raymond ;; Maintainer: Andre Spiegel +;; Maintainer: (ClearCase) Rod Whitby ;; XEmacs conversion: Steve Baur ;; This file is part of GNU Emacs. @@ -30,6 +31,15 @@ ;; so that vc.el itself is loaded only when you use a VC command. ;; See the commentary of vc.el. +;; Rudimentary ClearCase support by Rod Whitby . +;; I (Rod Whitby) intend to maintain the rudimentary functionality that is +;; currently in this file. At some time in the future (don't hold your +;; breath), I intend to merge the functionality of the cc-vc package +;; (separately available from /rtfm.mit.edu:/pub/cc-vc/) into this file. +;; I am not the maintainer of cc-vc, nor am I the maintainer of the +;; non-ClearCase parts of this file. +;; + ;;; Code: ;; Customization Variables (the rest is in vc.el) diff -r 6866abce6aaf -r 6075d714658b lisp/packages/vc.el --- a/lisp/packages/vc.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/packages/vc.el Mon Aug 13 09:51:16 2007 +0200 @@ -4,6 +4,7 @@ ;; Author: Eric S. Raymond ;; Maintainer: Andre Spiegel +;; Maintainer: (ClearCase) Rod Whitby ;; XEmacs conversion: Steve Baur ;; This file is part of GNU Emacs. @@ -66,7 +67,14 @@ ;; ;; Developer's notes on some concurrency issues are included at the end of ;; the file. - +;; +;; Rudimentary ClearCase support by Rod Whitby . +;; I (Rod Whitby) intend to maintain the rudimentary functionality that is +;; currently in this file. At some time in the future (don't hold your +;; breath), I intend to merge the functionality of the cc-vc package +;; (separately available from /rtfm.mit.edu:/pub/cc-vc/) into this file. +;; I am not the maintainer of cc-vc, nor am I the maintainer of the +;; non-ClearCase parts of this file. ;;; Code: (require 'vc-hooks) @@ -1164,6 +1172,7 @@ (shrink-window-if-larger-than-buffer))) (not unchanged)))) +;;;###autoload (defun vc-version-diff (file rel1 rel2) "For FILE, report diffs between two stored versions REL1 and REL2 of it. If FILE is a directory, generate diffs between versions for all registered diff -r 6866abce6aaf -r 6075d714658b lisp/prim/about.el --- a/lisp/prim/about.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/prim/about.el Mon Aug 13 09:51:16 2007 +0200 @@ -61,7 +61,7 @@ (cthomp "Chuck Thompson" "cthomp@xemacs.org") (dmoore "David Moore" "dmoore@ucsd.edu") (hniksic "Hrvoje Niksic" "hniksic@srce.hr") - (jareth "Jareth Hein" "jhod@po.iijnet.or.jp") + (jareth "Jareth Hein" "jhod@camelot-soft.com") (jens "Jens Lautenbacher" "jens@lemcbed.lem.uni-karlsruhe.de") (jwz "Jamie Zawinski" "jwz@netscape.com") (kazz "IENAGA Kazuyuki" "ienaga@jsys.co.jp") @@ -1159,7 +1159,7 @@ (print-short "Michael Meissner" "meissner@osf.org") (print-short "David M. Meyer" "meyer@ns.uoregon.edu") (print-short "Brad Miller" "bmiller@cs.umn.edu") - (print-short "Jeff Miller" "jmiller@bay1.bayserve.net") + (print-short "Jeff Miller" "jmiller@smart.net") (print-short "John Morey" "jmorey@crl.com") (print-short "Rob Mori" "rob.mori@sun.com") (print-short "Heiko Muenkel" "muenkel@tnt.uni-hannover.de") diff -r 6866abce6aaf -r 6075d714658b lisp/prim/custom-load.el --- a/lisp/prim/custom-load.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/prim/custom-load.el Mon Aug 13 09:51:16 2007 +0200 @@ -1,12 +1,12 @@ -(custom-put 'sound 'custom-loads '("sound")) -(custom-put 'paren-matching 'custom-loads '()) -(custom-put 'fill-comments 'custom-loads '("simple")) -(custom-put 'killing 'custom-loads '("simple")) -(custom-put 'editing-basics 'custom-loads '("simple" "files" "lisp" "cmdloop")) +(custom-put 'backup 'custom-loads '("files")) +(custom-put 'find-file 'custom-loads '("files")) +(custom-put 'frames 'custom-loads '("frame" "window-xemacs" "gui")) +(custom-put 'help-appearance 'custom-loads '("help")) +(custom-put 'isearch 'custom-loads '("isearch-mode")) +(custom-put 'minibuffer 'custom-loads '("minibuf")) (custom-put 'modeline 'custom-loads '("modeline")) -(custom-put 'minibuffer 'custom-loads '("minibuf")) -(custom-put 'isearch 'custom-loads '("isearch-mode")) -(custom-put 'help-appearance 'custom-loads '("help")) -(custom-put 'frames 'custom-loads '("frame" "window-xemacs" "gui")) -(custom-put 'find-file 'custom-loads '("files")) -(custom-put 'backup 'custom-loads '("files")) +(custom-put 'editing-basics 'custom-loads '("simple" "files" "lisp" "cmdloop")) +(custom-put 'killing 'custom-loads '("simple")) +(custom-put 'fill-comments 'custom-loads '("simple")) +(custom-put 'paren-matching 'custom-loads '()) +(custom-put 'sound 'custom-loads '("sound")) diff -r 6866abce6aaf -r 6075d714658b lisp/prim/dumped-lisp.el --- a/lisp/prim/dumped-lisp.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/prim/dumped-lisp.el Mon Aug 13 09:51:16 2007 +0200 @@ -1,6 +1,7 @@ (setq dumped-lisp-packages '("backquote" ; needed for defsubst etc. "bytecomp-runtime" ; define defsubst + "packages" ; Bootstrap run-time lisp environment "subr" ; load the most basic Lisp functions "replace" ; match-string used in version.el. "version.el" ; Ignore compiled-by-mistake version.elc diff -r 6866abce6aaf -r 6075d714658b lisp/prim/faces.el --- a/lisp/prim/faces.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/prim/faces.el Mon Aug 13 09:51:16 2007 +0200 @@ -1029,6 +1029,7 @@ (defun invert-face (face &optional locale) "Swap the foreground and background colors of the face." + (interactive (list (read-face-name "Invert face: "))) (if (valid-specifier-domain-p locale) (let ((foreface (face-foreground-instance face locale))) (set-face-foreground face (face-background-instance face locale) diff -r 6866abce6aaf -r 6075d714658b lisp/prim/help.el --- a/lisp/prim/help.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/prim/help.el Mon Aug 13 09:51:16 2007 +0200 @@ -1174,51 +1174,52 @@ nil) ;; Synched with Emacs 19.35 -(defun locate-library (library &optional nosuffix path interactive-call) - "Show the precise file name of Emacs library LIBRARY. -This command searches the directories in `load-path' like `M-x load-library' -to find the file that `M-x load-library RET LIBRARY RET' would load. -Optional second arg NOSUFFIX non-nil means don't add suffixes `.elc' or `.el' -to the specified name LIBRARY. +;; Moved to packages.el +;(defun locate-library (library &optional nosuffix path interactive-call) +; "Show the precise file name of Emacs library LIBRARY. +;This command searches the directories in `load-path' like `M-x load-library' +;to find the file that `M-x load-library RET LIBRARY RET' would load. +;Optional second arg NOSUFFIX non-nil means don't add suffixes `.elc' or `.el' +;to the specified name LIBRARY. -If the optional third arg PATH is specified, that list of directories -is used instead of `load-path'." - (interactive (list (read-string "Locate library: ") - nil nil - t)) - (let (result) - (catch 'answer - (mapcar - (lambda (dir) - (mapcar - (lambda (suf) - (let ((try (expand-file-name (concat library suf) dir))) - (and (file-readable-p try) - (null (file-directory-p try)) - (progn - (setq result try) - (throw 'answer try))))) - (if nosuffix - '("") - (let ((basic '(".elc" ".el" "")) - (compressed '(".Z" ".gz" ""))) - ;; If autocompression mode is on, - ;; consider all combinations of library suffixes - ;; and compression suffixes. - (if (rassq 'jka-compr-handler file-name-handler-alist) - (apply 'nconc - (mapcar (lambda (compelt) - (mapcar (lambda (baselt) - (concat baselt compelt)) - basic)) - compressed)) - basic))))) - (or path load-path))) - (and interactive-call - (if result - (message "Library is file %s" result) - (message "No library %s in search path" library))) - result)) +;If the optional third arg PATH is specified, that list of directories +;is used instead of `load-path'." +; (interactive (list (read-string "Locate library: ") +; nil nil +; t)) +; (let (result) +; (catch 'answer +; (mapcar +; (lambda (dir) +; (mapcar +; (lambda (suf) +; (let ((try (expand-file-name (concat library suf) dir))) +; (and (file-readable-p try) +; (null (file-directory-p try)) +; (progn +; (setq result try) +; (throw 'answer try))))) +; (if nosuffix +; '("") +; (let ((basic '(".elc" ".el" "")) +; (compressed '(".Z" ".gz" ""))) +; ;; If autocompression mode is on, +; ;; consider all combinations of library suffixes +; ;; and compression suffixes. +; (if (rassq 'jka-compr-handler file-name-handler-alist) +; (apply 'nconc +; (mapcar (lambda (compelt) +; (mapcar (lambda (baselt) +; (concat baselt compelt)) +; basic)) +; compressed)) +; basic))))) +; (or path load-path))) +; (and interactive-call +; (if result +; (message "Library is file %s" result) +; (message "No library %s in search path" library))) +; result)) ;; Functions ported from C into Lisp in XEmacs diff -r 6866abce6aaf -r 6075d714658b lisp/prim/make-docfile.el --- a/lisp/prim/make-docfile.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/prim/make-docfile.el Mon Aug 13 09:51:16 2007 +0200 @@ -156,13 +156,28 @@ (setq exec-path (list (concat default-directory "../lib-src"))) ;; (locate-file-clear-hashing nil) - (apply 'call-process-internal - ;; (concat default-directory "../lib-src/make-docfile") - "make-docfile" - nil - t - nil - (append options processed)) + (if (eq system-type 'berkeley-unix) + ;; Suboptimal, but we have a unresolved bug somewhere in the + ;; low-level process code + (call-process-internal + "/bin/csh" + nil + t + nil + "-fc" + (mapconcat + 'identity + (append + (list (concat default-directory "../lib-src/make-docfile")) + options processed) + " ")) + (apply 'call-process-internal + ;; (concat default-directory "../lib-src/make-docfile") + "make-docfile" + nil + t + nil + (append options processed))) (princ "Spawning make-docfile ...done\n") ;; (write-region-internal (point-min) (point-max) "/tmp/DOC") diff -r 6866abce6aaf -r 6075d714658b lisp/prim/minibuf.el --- a/lisp/prim/minibuf.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/prim/minibuf.el Mon Aug 13 09:51:16 2007 +0200 @@ -48,6 +48,13 @@ :type 'boolean :group 'minibuffer) +(defcustom minibuffer-history-uniquify t + "*Non-nil means when adding an item to a minibuffer history, remove +previous occurances of the same item from the history list first, +rather than just consing the new element onto the front of the list." + :type 'boolean + :group 'minibuffer) + (defvar minibuffer-completion-table nil "Alist or obarray used for completion in the minibuffer. This becomes the ALIST argument to `try-completion' and `all-completions'. @@ -481,8 +488,9 @@ (< (length val) minibuffer-history-minimum-string-length)) (set minibuffer-history-variable - (cons histval - (remove histval list)))))) + (if minibuffer-history-uniquify + (cons histval (remove histval list)) + (cons histval list)))))) (if err (signal (car err) (cdr err))) val)))) ;; stupid display code requires this for some reason @@ -2062,7 +2070,7 @@ You should *bind* this, not set it. This is useful if you're doing something mousy but which wasn't actually invoked using the mouse." :type 'boolean - :group 'minubuffer) + :group 'minibuffer) ;; We include this here rather than dialog.el so it is defined ;; even when dialog boxes are not present. diff -r 6866abce6aaf -r 6075d714658b lisp/prim/packages.el --- a/lisp/prim/packages.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/prim/packages.el Mon Aug 13 09:51:16 2007 +0200 @@ -54,9 +54,29 @@ "Lisp packages that should not be byte compiled.") ;; Copied from subr.el -(if (null (fboundp 'lambda)) - (defmacro lambda (&rest cdr) - (list 'function (cons 'lambda cdr)))) +(defmacro lambda (&rest cdr) + "Return a lambda expression. +A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is +self-quoting; the result of evaluating the lambda expression is the +expression itself. The lambda expression may then be treated as a +function, i.e., stored as the function value of a symbol, passed to +funcall or mapcar, etc. + +ARGS should take the same form as an argument list for a `defun'. +DOCSTRING is an optional documentation string. + If present, it should describe how to call the function. + But documentation strings are usually not useful in nameless functions. +INTERACTIVE should be a call to the function `interactive', which see. +It may also be omitted. +BODY should be a list of lisp expressions." + ;; Note that this definition should not use backquotes; subr.el should not + ;; depend on backquote.el. + ;; #### - I don't see why. So long as backquote.el doesn't use anything + ;; from subr.el, there's no problem with using backquotes here. --Stig + ;;(list 'function (cons 'lambda cdr))) + ;; -slb, This has to run in a naked temacs. Enough is enough. + ;; `(function (lambda ,@cdr))) + (list 'function (cons 'lambda cdr))) ;; Copied from help.el, could possibly move it to here permanently. ;; This is taken directly from Emacs 19.34.94. @@ -130,6 +150,68 @@ (setq files (cdr files))) autolist)) +;; The following function is called from temacs +(defun packages-find-packages-1 (package path-only) + "Search the supplied directory for associated directories. +The top level is assumed to look like: +info/ Contain texinfo files for lisp installed in this hierarchy +etc/ Contain data files for lisp installled in this hiearchy +lisp/ Contain directories which either have straight lisp code + or are self-contained packages of their own." + ;; Info files + (if (and (null path-only) (file-directory-p (concat package "/info"))) + (setq Info-default-directory-list + (cons (concat package "/info/") Info-default-directory-list))) + ;; Data files + (if (and (null path-only) (file-directory-p (concat package "/etc"))) + (setq data-directory-list + (cons (concat package "/etc/") data-directory-list))) + ;; Lisp files + (if (file-directory-p (concat package "/lisp")) + (progn + (setq load-path (cons (concat package "/lisp/") load-path)) + (let ((dirs (directory-files (concat package "/lisp/") + t "^[^-.]" nil 'dirs-only)) + dir) + (while dirs + (setq dir (car dirs)) + (setq load-path (cons dir load-path)) + (packages-find-packages-1 dir path-only) + (setq dirs (cdr dirs))))))) + +;; The following function is called from temacs +(defun packages-find-packages (pkg-path path-only) + "Search the supplied path for additional info/etc/lisp directories. +Lisp directories if configured prior to build time will have equivalent +status as bundled packages." + (let ((path pkg-path) + dir) + (while path + (setq dir (car path)) + (prin1 (concat "Find: " (expand-file-name dir) "\n")) + (packages-find-packages-1 (expand-file-name dir) path-only) + (setq path (cdr path))))) + +;; Data-directory is really a list now. Provide something to search it for +;; directories. + +(defun locate-data-directory (name &optional data-dir-list) + "Locate a directory in a search path." + (unless data-dir-list + (setq data-dir-list data-directory-list)) + (let (dir found found-dir (dirs data-dir-list)) + (while (and (null found-dir) dirs) + (setq dir (car dirs)) + (setq found (concat dir name "/")) + (setq found-dir (file-directory-p found)) + (setq dirs (cdr dirs))) + found)) + +;; If we are being loaded as part of being dumped, bootstrap the rest of the +;; load-path for loaddefs. +(if (fboundp 'load-gc) + (packages-find-packages package-path t)) + (provide 'packages) ;;; packages.el ends here diff -r 6866abce6aaf -r 6075d714658b lisp/prim/startup.el --- a/lisp/prim/startup.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/prim/startup.el Mon Aug 13 09:51:16 2007 +0200 @@ -469,6 +469,15 @@ (nreverse new-args))) +(defconst initial-scratch-message "\ +;; If you want to create a file, don't type the text in this buffer. +;; This buffer is for notes you don't want to save, and for Lisp evaluation. +;; If you want to create a file, first visit that file with C-x C-f, +;; then enter the text in that file's own buffer. + +" + "Initial message displayed in *scratch* buffer at startup.") + (defun command-line () (let ((command-line-args-left (cdr command-line-args))) @@ -512,12 +521,12 @@ ;;; Load init files. (load-init-file) - ;; If *scratch* exists and init file didn't change its mode, initialize it. - (when (get-buffer "*scratch*") - (save-excursion - (set-buffer "*scratch*") - (when (eq major-mode 'fundamental-mode) - (funcall initial-major-mode)))) + (with-current-buffer (get-buffer "*scratch*") + (erase-buffer) + ;; (insert initial-scratch-message) + (set-buffer-modified-p nil) + (when (eq major-mode 'fundamental-mode) + (funcall initial-major-mode))) ;; Load library for our terminal type. ;; User init file can set term-file-prefix to nil to prevent this. @@ -675,11 +684,11 @@ (sit-for 0) (setq unread-command-event (next-command-event))) (when timeout (disable-timeout timeout)) - (save-excursion + (with-current-buffer (get-buffer "*scratch*") + (erase-buffer) + (insert initial-scratch-message) ;; In case the XEmacs server has already selected ;; another buffer, erase the one our message is in. - (set-buffer (get-buffer "*scratch*")) - (erase-buffer) (set-buffer-modified-p nil))))) ;; Command-line-options exist @@ -1001,6 +1010,7 @@ (concat "lib/xemacs-" version))) (defun find-emacs-root-internal-1 (path lisp-p) + (prin1 (format "f-e-r-i-1: %s\n" path)) (let ((dir (file-name-directory path))) (or ;; @@ -1089,12 +1099,13 @@ ;; XEmacs can run (kind of) if the lisp directory is omitted, which ;; some people might want to do for space reasons. (or (find-emacs-root-internal-1 path t) - (find-emacs-root-internal-1 path nil) + ;; (find-emacs-root-internal-1 path nil) ;; If we don't succeed we are going to crash and burn for sure. ;; Try some paths relative to prefix-directory if it isn't nil. ;; This is definitely necessary in cases such as when we're used ;; as a login shell since we can't determine the invocation ;; directory in that case. + (find-emacs-root-internal-1 (format "%s/bin/%s" prefix-directory invocation-name) t) (find-emacs-root-internal-1 @@ -1103,6 +1114,12 @@ (format "%s/lib/%s" prefix-directory invocation-name) t) (find-emacs-root-internal-1 (format "%s/lib/%s" prefix-directory invocation-name) nil) + + ;; We're desperate -- try the prefix-directory correctly. + (find-emacs-root-internal-1 + (format "%s/%s/foo" prefix-directory (startup-make-version-dir)) t) + (find-emacs-root-internal-1 + (format "%s/%s/foo" prefix-directory (startup-make-version-dir)) nil) )) (defun set-default-load-path () @@ -1227,7 +1244,7 @@ (list lisp) ) )) - + ;; 1997/03/06 by Jeff Miller ;; initialize 'site-directory'. This is the site-lisp dir used by ;; XEmacs @@ -1253,8 +1270,6 @@ (not (string= data-directory etc)))) (setq data-directory (file-name-as-directory etc))) - - ;; If `configure' specified an info dir, use it. (or (boundp 'Info-default-directory-list) (setq Info-default-directory-list nil)) @@ -1284,7 +1299,10 @@ (expand-file-name "!!!SuperLock!!!" lock-directory))))) - (set-default-load-path-warning))) + (set-default-load-path-warning) + (when (and data-directory Info-default-directory-list) + (setq data-directory-list (list data-directory)) + (packages-find-packages package-path nil)))) (defun set-default-load-path-warning () diff -r 6866abce6aaf -r 6075d714658b lisp/prim/subr.el --- a/lisp/prim/subr.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/prim/subr.el Mon Aug 13 09:51:16 2007 +0200 @@ -35,27 +35,28 @@ ;;;; Lisp language features. -(defmacro lambda (&rest cdr) - "Return a lambda expression. -A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is -self-quoting; the result of evaluating the lambda expression is the -expression itself. The lambda expression may then be treated as a -function, i.e., stored as the function value of a symbol, passed to -funcall or mapcar, etc. +;; Moved to packages.el +;(defmacro lambda (&rest cdr) +; "Return a lambda expression. +;A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is +;self-quoting; the result of evaluating the lambda expression is the +;expression itself. The lambda expression may then be treated as a +;function, i.e., stored as the function value of a symbol, passed to +;funcall or mapcar, etc. -ARGS should take the same form as an argument list for a `defun'. -DOCSTRING is an optional documentation string. - If present, it should describe how to call the function. - But documentation strings are usually not useful in nameless functions. -INTERACTIVE should be a call to the function `interactive', which see. -It may also be omitted. -BODY should be a list of lisp expressions." - ;; Note that this definition should not use backquotes; subr.el should not - ;; depend on backquote.el. - ;; #### - I don't see why. So long as backquote.el doesn't use anything - ;; from subr.el, there's no problem with using backquotes here. --Stig - ;;(list 'function (cons 'lambda cdr))) - `(function (lambda ,@cdr))) +;ARGS should take the same form as an argument list for a `defun'. +;DOCSTRING is an optional documentation string. +; If present, it should describe how to call the function. +; But documentation strings are usually not useful in nameless functions. +;INTERACTIVE should be a call to the function `interactive', which see. +;It may also be omitted. +;BODY should be a list of lisp expressions." +; ;; Note that this definition should not use backquotes; subr.el should not +; ;; depend on backquote.el. +; ;; #### - I don't see why. So long as backquote.el doesn't use anything +; ;; from subr.el, there's no problem with using backquotes here. --Stig +; ;;(list 'function (cons 'lambda cdr))) +; `(function (lambda ,@cdr))) (defmacro defun-when-void (&rest args) "Define a function, just like `defun', unless it's already defined. diff -r 6866abce6aaf -r 6075d714658b lisp/psgml/custom-load.el --- a/lisp/psgml/custom-load.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/psgml/custom-load.el Mon Aug 13 09:51:16 2007 +0200 @@ -1,7 +1,7 @@ -(custom-put 'html 'custom-loads '("psgml-html")) -(custom-put 'psgml-html 'custom-loads '("psgml-html")) -(custom-put 'sgml 'custom-loads '("psgml-html" "psgml")) +(custom-put 'tempo 'custom-loads '("tempo")) +(custom-put 'psgml-dtd 'custom-loads '("psgml")) +(custom-put 'psgml-insert 'custom-loads '("psgml")) (custom-put 'psgml 'custom-loads '("psgml-html" "psgml")) -(custom-put 'psgml-insert 'custom-loads '("psgml")) -(custom-put 'psgml-dtd 'custom-loads '("psgml")) -(custom-put 'tempo 'custom-loads '("tempo")) +(custom-put 'sgml 'custom-loads '("psgml-html" "psgml")) +(custom-put 'psgml-html 'custom-loads '("psgml-html")) +(custom-put 'html 'custom-loads '("psgml-html")) diff -r 6866abce6aaf -r 6075d714658b lisp/utils/auto-autoloads.el --- a/lisp/utils/auto-autoloads.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/utils/auto-autoloads.el Mon Aug 13 09:51:16 2007 +0200 @@ -942,6 +942,29 @@ ;;;*** +;;;### (autoloads (smtpmail-send-it) "smtpmail" "utils/smtpmail.el") + +(autoload 'smtpmail-send-it "smtpmail" nil nil nil) + +;;;*** + +;;;### (autoloads (speedbar-get-focus speedbar-frame-mode) "speedbar" "utils/speedbar.el") + +(defalias 'speedbar 'speedbar-frame-mode) + +(autoload 'speedbar-frame-mode "speedbar" "\ +Enable or disable speedbar. Positive ARG means turn on, negative turn off. +nil means toggle. Once the speedbar frame is activated, a buffer in +`speedbar-mode' will be displayed. Currently, only one speedbar is +supported at a time." t nil) + +(autoload 'speedbar-get-focus "speedbar" "\ +Change frame focus to or from the speedbar frame. +If the selected frame is not speedbar, then speedbar frame is +selected. If the speedbar frame is active, then select the attached frame." t nil) + +;;;*** + ;;;### (autoloads nil "timezone" "utils/timezone.el") (define-error 'invalid-date "Invalid date string") diff -r 6866abce6aaf -r 6075d714658b lisp/utils/custom-load.el --- a/lisp/utils/custom-load.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/utils/custom-load.el Mon Aug 13 09:51:16 2007 +0200 @@ -1,14 +1,14 @@ -(custom-put 'highlight-headers-faces 'custom-loads '("highlight-headers")) -(custom-put 'crontab 'custom-loads '("crontab")) -(custom-put 'browse-url 'custom-loads '("browse-url")) -(custom-put 'detached-minibuf 'custom-loads '("detached-minibuf")) -(custom-put 'edmacro 'custom-loads '("edmacro")) -(custom-put 'eldoc 'custom-loads '("eldoc")) +(custom-put 'uniquify 'custom-loads '("uniquify")) +(custom-put 'smtpmail 'custom-loads '("smtpmail")) +(custom-put 'savehist 'custom-loads '("savehist")) +(custom-put 'ph 'custom-loads '("ph")) +(custom-put 'passwd 'custom-loads '("passwd")) +(custom-put 'message-headers 'custom-loads '()) +(custom-put 'highlight-headers 'custom-loads '("highlight-headers")) (custom-put 'elp 'custom-loads '("elp")) -(custom-put 'highlight-headers 'custom-loads '("highlight-headers")) -(custom-put 'message-headers 'custom-loads '()) -(custom-put 'passwd 'custom-loads '("passwd")) -(custom-put 'ph 'custom-loads '("ph")) -(custom-put 'savehist 'custom-loads '("savehist")) -(custom-put 'smtpmail 'custom-loads '("smtpmail")) -(custom-put 'uniquify 'custom-loads '("uniquify")) +(custom-put 'eldoc 'custom-loads '("eldoc")) +(custom-put 'edmacro 'custom-loads '("edmacro")) +(custom-put 'detached-minibuf 'custom-loads '("detached-minibuf")) +(custom-put 'browse-url 'custom-loads '("browse-url")) +(custom-put 'crontab 'custom-loads '("crontab")) +(custom-put 'highlight-headers-faces 'custom-loads '("highlight-headers")) diff -r 6866abce6aaf -r 6075d714658b lisp/utils/elp.el --- a/lisp/utils/elp.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/utils/elp.el Mon Aug 13 09:51:16 2007 +0200 @@ -39,7 +39,7 @@ ;; elp-reset-all. ;; ;; You can also instrument all functions in a package, provided that -;; the package follows the GNU coding standard of a common textural +;; the package follows the GNU coding standard of a common textual ;; prefix. Use M-x elp-instrument-package for this. ;; ;; If you want to sort the results, set elp-sort-by-function to some diff -r 6866abce6aaf -r 6075d714658b lisp/utils/smtpmail.el --- a/lisp/utils/smtpmail.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/utils/smtpmail.el Mon Aug 13 09:51:16 2007 +0200 @@ -87,6 +87,7 @@ ;;; ;;; +;;;###autoload (defun smtpmail-send-it () (require 'mail-utils) (let ((errbuf (if mail-interactive diff -r 6866abce6aaf -r 6075d714658b lisp/utils/speedbar.el --- a/lisp/utils/speedbar.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/utils/speedbar.el Mon Aug 13 09:51:16 2007 +0200 @@ -5,7 +5,7 @@ ;; Author: Eric M. Ludlam ;; Version: 0.5 ;; Keywords: file, tags, tools -;; X-RCS: $Id: speedbar.el,v 1.2 1997/06/29 23:13:33 steve Exp $ +;; X-RCS: $Id: speedbar.el,v 1.3 1997/07/26 22:09:58 steve Exp $ ;; ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -672,8 +672,9 @@ ;;; Mode definitions/ user commands ;; -;;###autoload +;;;###autoload (defalias 'speedbar 'speedbar-frame-mode) +;;;###autoload (defun speedbar-frame-mode (&optional arg) "Enable or disable speedbar. Positive ARG means turn on, negative turn off. nil means toggle. Once the speedbar frame is activated, a buffer in @@ -722,7 +723,8 @@ (let ((params (cons (cons 'height (frame-height)) speedbar-frame-parameters))) (setq speedbar-frame - (if (< emacs-major-version 20) ;a bug is fixed in v20 & later + (if (or speedbar-xemacsp + (< emacs-major-version 20)) ;a bug is fixed in v20 & later (make-frame params) (let ((x-pointer-shape x-pointer-top-left-arrow) (x-sensitive-text-pointer-shape x-pointer-hand2)) @@ -761,7 +763,9 @@ (defun speedbar-frame-width () "Return the width of the speedbar frame in characters. nil if it doesn't exist." - (and speedbar-frame (cdr (assoc 'width (frame-parameters speedbar-frame))))) + (and speedbar-frame + (frame-live-p speedbar-frame) + (cdr (assoc 'width (frame-parameters speedbar-frame))))) (defun speedbar-mode () "Major mode for managing a display of directories and tags. @@ -887,7 +891,8 @@ ;; The trailer speedbar-easymenu-definition-trailer))) (easy-menu-define speedbar-menu-map speedbar-key-map "Speedbar menu" md) - (if speedbar-xemacsp (set-buffer-menubar (list km))))) + ;; (if speedbar-xemacsp (set-buffer-menubar (list km))) +)) ;;; User Input stuff @@ -910,6 +915,7 @@ ;;(message "X: Pixel %d Char Pixels %d On char %d" xp cpw oc) )) +;;;###autoload (defun speedbar-get-focus () "Change frame focus to or from the speedbar frame. If the selected frame is not speedbar, then speedbar frame is diff -r 6866abce6aaf -r 6075d714658b lisp/viper/viper.el --- a/lisp/viper/viper.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/viper/viper.el Mon Aug 13 09:51:16 2007 +0200 @@ -310,11 +310,15 @@ (if noninteractive (eval-when-compile (let ((load-path (cons (expand-file-name ".") load-path))) + (or (featurep 'viper-init) + (load "viper-init.el" nil nil 'nosuffix)) (or (featurep 'viper-cmd) (load "viper-cmd.el" nil nil 'nosuffix)) ))) ;; end pacifier +(require 'viper-init) + ;; better be defined before Viper custom group. (defvar vip-custom-file-name (vip-convert-standard-file-name "~/.viper") "Viper customisation file. diff -r 6866abce6aaf -r 6075d714658b lisp/w3/custom-load.el --- a/lisp/w3/custom-load.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/w3/custom-load.el Mon Aug 13 09:51:16 2007 +0200 @@ -1,19 +1,19 @@ -(custom-put 'ssl 'custom-loads '("ssl")) -(custom-put 'url-gateway 'custom-loads '("url-gw")) -(custom-put 'url 'custom-loads '("url-gw" "url-irc" "url-vars" "url" "url-news")) -(custom-put 'url-file 'custom-loads '("url-cache" "url-vars")) -(custom-put 'url-cache 'custom-loads '("url-cache" "url-vars")) -(custom-put 'url-history 'custom-loads '("url-vars")) -(custom-put 'url-cookie 'custom-loads '("url-cookie" "url-vars")) -(custom-put 'url-mime 'custom-loads '("url-vars")) -(custom-put 'url-hairy 'custom-loads '("url-vars")) +(custom-put 'url-news 'custom-loads '("url-news")) +(custom-put 'w3-scripting 'custom-loads '("w3-script")) +(custom-put 'w3-hooks 'custom-loads '("w3-cus")) +(custom-put 'w3-display 'custom-loads '("w3-cus")) +(custom-put 'w3-parsing 'custom-loads '("w3-cus")) +(custom-put 'w3-menus 'custom-loads '("w3-cus" "w3-menu")) +(custom-put 'w3-printing 'custom-loads '("w3-cus")) +(custom-put 'w3-images 'custom-loads '("w3-cus")) +(custom-put 'w3-files 'custom-loads '("w3-cus")) (custom-put 'w3 'custom-loads '("w3-cus" "w3-script")) -(custom-put 'w3-files 'custom-loads '("w3-cus")) -(custom-put 'w3-images 'custom-loads '("w3-cus")) -(custom-put 'w3-printing 'custom-loads '("w3-cus")) -(custom-put 'w3-menus 'custom-loads '("w3-cus" "w3-menu")) -(custom-put 'w3-parsing 'custom-loads '("w3-cus")) -(custom-put 'w3-display 'custom-loads '("w3-cus")) -(custom-put 'w3-hooks 'custom-loads '("w3-cus")) -(custom-put 'w3-scripting 'custom-loads '("w3-script")) -(custom-put 'url-news 'custom-loads '("url-news")) +(custom-put 'url-hairy 'custom-loads '("url-vars")) +(custom-put 'url-mime 'custom-loads '("url-vars")) +(custom-put 'url-cookie 'custom-loads '("url-cookie" "url-vars")) +(custom-put 'url-history 'custom-loads '("url-vars")) +(custom-put 'url-cache 'custom-loads '("url-cache" "url-vars")) +(custom-put 'url-file 'custom-loads '("url-cache" "url-vars")) +(custom-put 'url 'custom-loads '("url-gw" "url-irc" "url-vars" "url" "url-news")) +(custom-put 'url-gateway 'custom-loads '("url-gw")) +(custom-put 'ssl 'custom-loads '("ssl")) diff -r 6866abce6aaf -r 6075d714658b lisp/x11/x-toolbar.el --- a/lisp/x11/x-toolbar.el Mon Aug 13 09:50:16 2007 +0200 +++ b/lisp/x11/x-toolbar.el Mon Aug 13 09:51:16 2007 +0200 @@ -94,7 +94,8 @@ (defcustom toolbar-paste-function 'x-yank-clipboard-selection "*Function to call when the paste icon is selected." - :type '(radio (function-item x-yank-primary-selection) + :type '(radio (function-item x-yank-clipboard-selection) + (function-item x-yank-primary-selection) (function :tag "Other")) :group 'toolbar) diff -r 6866abce6aaf -r 6075d714658b lwlib/config.h.in --- a/lwlib/config.h.in Mon Aug 13 09:50:16 2007 +0200 +++ b/lwlib/config.h.in Mon Aug 13 09:51:16 2007 +0200 @@ -91,6 +91,7 @@ #undef NEED_MOTIF #undef NEED_ATHENA +#undef USE_XFONTSET #if defined (LWLIB_MENUBARS_LUCID) || defined (LWLIB_SCROLLBARS_LUCID) #define NEED_LUCID diff -r 6866abce6aaf -r 6075d714658b lwlib/lwlib-utils.h --- a/lwlib/lwlib-utils.h Mon Aug 13 09:50:16 2007 +0200 +++ b/lwlib/lwlib-utils.h Mon Aug 13 09:51:16 2007 +0200 @@ -17,4 +17,7 @@ void XtSafelyDestroyWidget (Widget); +#ifdef USE_DEBUG_MALLOC +#include +#endif #endif /* _LWLIB_UTILS_H_ */ diff -r 6866abce6aaf -r 6075d714658b lwlib/xlwmenu.c --- a/lwlib/xlwmenu.c Mon Aug 13 09:50:16 2007 +0200 +++ b/lwlib/xlwmenu.c Mon Aug 13 09:51:16 2007 +0200 @@ -47,6 +47,10 @@ #endif #include "xlwmenuP.h" +#ifdef USE_DEBUG_MALLOC +#include +#endif + /* simple, naieve integer maximum */ #ifndef max #define max(a,b) ((a)>(b)?(a):(b)) diff -r 6866abce6aaf -r 6075d714658b lwlib/xlwscrollbar.c --- a/lwlib/xlwscrollbar.c Mon Aug 13 09:50:16 2007 +0200 +++ b/lwlib/xlwscrollbar.c Mon Aug 13 09:51:16 2007 +0200 @@ -82,6 +82,10 @@ #include "xlwscrollbarP.h" #include "xlwscrollbar.h" +#ifdef USE_DEBUG_MALLOC +#include +#endif + #define DBUG(x) #define MINL(x,y) ((((unsigned long) (x)) < ((unsigned long) (y))) \ diff -r 6866abce6aaf -r 6075d714658b man/ChangeLog --- a/man/ChangeLog Mon Aug 13 09:50:16 2007 +0200 +++ b/man/ChangeLog Mon Aug 13 09:51:16 2007 +0200 @@ -1,3 +1,22 @@ +1997-07-25 Barry A. Warsaw + + * cc-mode.texi: Describe support for idl-mode + + * cc-mode.texi: + Document c-initialization-hook. Also rewrite the "Getting Connected" + section on byte compiling the source. + +1997-07-21 Karl M. Hegbloom + + * lispref/streams.texi: "Output Streams", change `last-output' + result list from integers to characters. + + * lispref/minibuf.texi: "Object from Minibuffer", correction. + + * lispref/minibuf.texi: "Minibuffer History", add + `Info-minibuffer-history', `Manual-page-minibuffer-history', and + short paragraph refering to `M-x apropos'. + 1997-07-17 Steven L Baur * Makefile: makeinfo-1.68 is verified to work. diff -r 6866abce6aaf -r 6075d714658b man/Makefile --- a/man/Makefile Mon Aug 13 09:50:16 2007 +0200 +++ b/man/Makefile Mon Aug 13 09:51:16 2007 +0200 @@ -33,14 +33,14 @@ .SUFFIXES: .info .texi .dvi # Subdirectories to make recursively. -SUBDIR = xemacs lispref new-users-guide internals tm auctex gnats +SUBDIR = xemacs lispref new-users-guide internals tm gnats ../info/%.info : %.texi -$(MAKEINFO) -o $@ $< -srcs = cc-mode cl custom ediff efs external-widget forms gnus \ +srcs = cc-mode cl custom ediff efs external-widget forms \ hm--html-mode \ - hyperbole ilisp info ispell mailcrypt message mh-e oo-browser \ + hyperbole ilisp info ispell mailcrypt mh-e oo-browser \ pcl-cvs ph psgml psgml-api rmail standards supercite term \ termcap texinfo vhdl-mode viper vm w3 widget xemacs-faq diff -r 6866abce6aaf -r 6075d714658b man/auctex/Makefile --- a/man/auctex/Makefile Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,80 +0,0 @@ - -infodir=../../info -TEX=tex - -info: $(infodir)/auctex.info - -$(infodir)/auctex.info: auc-tex.texi install.texi intro.texi changes.texi - makeinfo auc-tex.texi -o $(infodir)/auctex.info - -all: auc-tex.dvi tex-ref.dvi math-ref.dvi auctex - -dist: auctex INSTALLATION README CHANGES auc-tex_toc.html auc-tex.ps - -auc-tex_toc.html: auc-tex.texi - texi2html -split_node auc-tex.texi - -math-ref.dvi: math-ref.tex - $(TEX) math-ref - @echo "**********************************************************" - @echo "** doc/math-ref.dvi may now be printed (1 page)" - @echo "**********************************************************" - -tex-ref.dvi: tex-ref.tex - $(TEX) tex-ref - @echo "**********************************************************" - @echo "** doc/tex-ref.dvi may now be printed (1 page)" - @echo "**********************************************************" - -auc-tex.dvi: auc-tex.texi - -$(TEX) "\nonstopmode\input auc-tex.texi" - -texindex auc-tex.ky - -texindex auc-tex.fn - -texindex auc-tex.vr - -texindex auc-tex.cp - -$(TEX) "\nonstopmode\input auc-tex.texi" - @echo "**********************************************************" - @echo "** If this gave trouble, maybe you need to install" - @echo "** a newer version of texinfo?" - @echo "** doc/auc-tex.dvi may now be printed (70+ pages)" - @echo "**********************************************************" - -auc-tex.ps: auc-tex.dvi - dvips auc-tex.dvi > auc-tex.ps - -auctex: auc-tex.texi install.texi intro.texi changes.texi - -makeinfo auc-tex.texi - @echo "**********************************************************" - @echo "** If this gave trouble, maybe you need to install" - @echo "** a newer version of texinfo?" - @echo "**********************************************************" - -INSTALLATION: install.texi - -makeinfo --no-headers install.texi --output INSTALLATION - -README: intro.texi - -makeinfo --no-headers intro.texi --output README - -CHANGES: changes.texi - -makeinfo --no-headers changes.texi --output CHANGES - -HISTORY: history.texi - -makeinfo --no-headers history.texi --output HISTORY - -install: auctex - cp auctex auctex-* $(infodir) - @echo "**********************************************************" - @echo "** The \`auctex' info files are now installed." - @echo "** Edit \`$(infodir)/dir'" - @echo "** to add an entry for file \`auctex'" - @echo "**********************************************************" - -clean: allways - rm -f *.dvi *.ps *.aux *.cp *.fn *.info *.ky *.log *~ \#*\# *.tp *.vr *.pg *.toc *.tp *.bak *.cps *.kys *.tps *.fns *.vrs *.pgs auctex auctex-? *.html INSTALLATION README CHANGES - - -allways: - -mostlyclean: clean - -distclean: clean diff -r 6866abce6aaf -r 6075d714658b man/auctex/auc-tex.texi --- a/man/auctex/auc-tex.texi Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2702 +0,0 @@ -\input texinfo -@setfilename auctex -@settitle AUC TeX -@c footnotestyle separate -@c paragraphindent 2 -@comment %**end of header -@iftex -@tolerance 10000 -@end iftex - -@c $Id: auc-tex.texi,v 1.1 1997/02/20 02:05:18 steve Exp $ - -@finalout -@titlepage -@title AUC @TeX{} -@subtitle A much enhanced La@TeX{} mode for GNU Emacs. -@subtitle Version 9.7 - -@author by Kresten Krab Thorup -@author updated for 6.1 to 9.7 by Per Abrahamsen -@page -@vskip 0pt plus 1filll -Copyright @copyright{} 1992 Kresten Krab Thorup @* -Copyright @copyright{} 1993, 1994,1995 Per Abrahamsen - -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. - -@ignore -Permission is granted to process this file through TeX and print the -results, provided the printed document carries copying permission -notice identical to this one except for the removal of this paragraph -(this paragraph not being relevant to the printed manual). -@end ignore - -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided also that the -section entitled ``Copying'' is included exactly as in the original, and -provided that the entire resulting derived work is distributed under the -terms of a permission notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions, -except that this permission notice may be stated in a translation -approved by the Free Software Foundation. -@end titlepage -@page - -@ifinfo -@node top, Copying, (dir), (dir) -@top AUC @TeX{} - -AUC @TeX{} is an integrated environment for editing La@TeX{} and -@TeX{} files.@refill - -This file documents AUC @TeX{} version 9.7. - -Although AUC @TeX{} contains a large number of features, there are no -reasons to despair. You can continue to write @TeX{} and La@TeX{} -documents the way you are used to, and only start using the multiple -features in small steps. AUC @TeX{} is not monolithic, each feature -described in this manual is useful by itself, but together they provide -an environment where you will make very few LaTeX errors, and makes it -easy to find the errors that may slip through anyway. - -If you want to make AUC TeX aware of style files and multi-file -documents right away, insert the following in your @file{.emacs} file. -@lisp -(setq TeX-auto-save t) -(setq TeX-parse-self t) -(setq-default TeX-master nil) -@end lisp - -NOTE: This documentation is preliminary. It should however cover most -important points. Corrections or perhaps rewrites of sections -are VERY WELCOME.@refill - -Kresten Krab Thorup (6.0) @* -Per Abrahamsen (later updates) - -There is a mailing list for discussion about AUC @TeX{} and announcement -of alpha releases, write to @samp{auc-tex-request@@sunsite.auc.dk} to join -it. Send contributions to @samp{auc-tex@@sunsite.auc.dk}. - -Bug reports, suggestions for new features, and pleas for help should go -to either @samp{auc-tex_mgr@@iesd.auc.dk} (the AUC @TeX{} managers), or -to @samp{auc-tex@@sunsite.auc.dk} (the mailing list) if they might have -general interest. Please use the command @kbd{M-x -TeX-submit-bug-report} to report bugs if possible.@refill - -@end ifinfo - -@menu -* Copying:: Copying -* Introduction:: Why AUC @TeX{} is good for you. -* Frequently Used Commands:: Inserting Frequently Used Commands -* Advanced Features:: Advanced Editing Features -* Formatting:: Formatting and Printing -* Multifile:: Multifile Documents -* Parsing Files:: Automatic Parsing of @TeX{} files. -* I18n:: Internationalization -* Automatic:: Automatic Customization -* Style Files:: Writing Your own Style Support -* Installation:: How to install AUC @TeX{} -* History:: The History of AUC @TeX{} -* Projects:: Wishlist -* Credit:: Credit -* Key Index:: Key Index -* Function Index:: Function Index -* Variable Index:: Variable Index -* Concept Index:: Concept Index - -@end menu - -@node Copying, Introduction, top, top -@unnumbered Copying -@cindex Copying -@cindex Copyright -@cindex GPL -@cindex General Public License -@cindex License -@cindex Free -@cindex Free software -@cindex Distribution -@cindex Right -@cindex Warranty - -(This text stolen from the @TeX{}info 2.16 distribution). - -The programs currently being distributed that relate to AUC @TeX{} -include lisp files for GNU Emacs. These programs are @dfn{free}; this -means that everyone is free to use them and free to redistribute them on -a free basis. The AUC @TeX{} related programs are not in the public -domain; they are copyrighted and there are restrictions on their -distribution, but these restrictions are designed to permit everything -that a good cooperating citizen would want to do. What is not allowed -is to try to prevent others from further sharing any version of these -programs that they might get from you.@refill - - Specifically, we want to make sure that you have the right to give -away copies of the programs that relate to AUC @TeX{}, that you receive -source code or else can get it if you want it, that you can change these -programs or use pieces of them in new free programs, and that you know -you can do these things.@refill - - To make sure that everyone has such rights, we have to forbid you to -deprive anyone else of these rights. For example, if you distribute -copies of the AUC @TeX{} related programs, you must give the recipients all -the rights that you have. You must make sure that they, too, receive or -can get the source code. And you must tell them their rights.@refill - - Also, for our own protection, we must make certain that everyone finds -out that there is no warranty for the programs that relate to AUC @TeX{}. -If these programs are modified by someone else and passed on, we want -their recipients to know that what they have is not what we distributed, -so that any problems introduced by others will not reflect on our -reputation.@refill - - The precise conditions of the licenses for the programs currently -being distributed that relate to AUC @TeX{} are found in the General -Public Licenses that accompany them.@refill - -@node Introduction, Frequently Used Commands, Copying, top -@include intro.texi - -@node Frequently Used Commands, Advanced Features, Introduction, top -@chapter Inserting Frequently Used Commands - -The most commonly used commands/macros of AUC @TeX{} are those which -simply insert templates for often used @TeX{} and/or La@TeX{} -constructs, like font changes, handling of environments, etc. -These features are very simple, and easy to learn, and help you -avoiding stupid mistakes like mismatched braces, or -@samp{\begin@{@}}-@samp{\end@{@}} pairs.@refill - -@menu -* Quotes:: Inserting double quotes -* Font Specifiers:: Inserting Font Specifiers -* Sectioning:: Inserting chapters, sections, etc. -* Environments:: Inserting Environment Templates -@end menu - -@node Quotes, Font Specifiers, Frequently Used Commands, Frequently Used Commands -@section Insertion of Quotes, Dollars, and Braces - -@cindex Quotes -@cindex Double quotes -@cindex Braces -@cindex Brackets -@cindex Dollars -@cindex Math mode delimiters -@cindex Matching dollar signs -@cindex Display math mode - -In @TeX{} literal double quotes @samp{"like this"} are seldom used, -instead two single quotes are used @samp{``like this''}. To help you -insert these efficiently, AUC @TeX{} allows you to continue to press -@kbd{"} to insert two single quotes. To get a literal double quote, -press @kbd{"} twice. - -@deffn Command TeX-insert-quote @var{count} -@kindex " -(@kbd{"}) Insert the appropriate quote marks for TeX. - -Inserts the value of @code{TeX-open-quote} (normally @samp{``}) or -@code{TeX-close-quote} (normally @samp{''}) depending on the context. -With prefix argument, always inserts @samp{"} characters.@refill -@end deffn - -@defopt TeX-open-quote -String inserted by typing @kbd{"} to open a quotation. -@end defopt - -@defopt TeX-close-quote -String inserted by typing @kbd{"} to open a quotation. -@end defopt - -If you include the style file @file{german} @code{TeX-open-quote} and -@code{TeX-close-quote} will both be set to @samp{"}. - -In AUC @TeX{}, dollar signs should match like they do in @TeX{}. This -has been partially implemented, we assume dollar signs always match -within a paragraph. The first @samp{$} you insert in a paragraph will -do nothing special. The second @samp{$} will match the first. This -will be indicated by moving the cursor temporarily over the first dollar -sign. If you enter a dollar sign that matches a double dollar sign -@samp{$$} AUC @TeX{} will automatically insert two dollar signs. If you -enter a second dollar sign that matches a single dollar sign, the single -dollar sign will automatically be converted to a double dollar sign. - -@deffn Command TeX-insert-dollar @var{arg} -@kindex $ -(@kbd{$}) Insert dollar sign. - -Show matching dollar sign if this dollar sign end the @TeX{} math mode. -Ensure double dollar signs match up correctly by inserting extra -dollar signs when needed. - -With optional @var{arg}, insert that many dollar signs. -@end deffn - -To avoid unbalanced braces, it is useful to insert them pairwise. You -can do this by typing @kbd{C-c @{}. - -@deffn Command TeX-insert-braces -@kindex C-c @{ -(@kbd{C-c @{}) Make a pair of braces and position the cursor -to type inside of them. -@end deffn - -@node Font Specifiers, Sectioning, Quotes, Frequently Used Commands -@section Inserting Font Specifiers - -@cindex Fonts -@cindex Font macros -@cindex Changing font -@cindex Specifying a font - -Perhaps the most used keyboard commands of AUC @TeX{} are the short-cuts -available for easy insertion of font changing macros. They all put the -font change inside a @TeX{} group, a practice that help preventing -subtle errors. The most significant advantage of using these command -instead of typing it in yourself, is that the braces will always match -correctly. - -If you give an argument (that is, type @kbd{C-u}) to the font command, -the innermost font will be replaced, i.e. the font in the @TeX{} group -around point will be changed. The following table shows the available -commands, with @code{@point{}} indicating the position where the text -will be inserted.@refill - -@table @kbd -@item C-c C-f C-r -@kindex C-c C-f C-r -@cindex @code{\textrm} -Insert roman @r{@{\textrm @point{}@}} text. - -@item C-c C-f C-b -@kindex C-c C-f C-b -@cindex @code{\textbf} -Insert @b{bold face} @samp{@{\textbf @point{}@}} text. - -@item C-c C-f C-i -@kindex C-c C-f C-i -@cindex @code{\textit} -Insert @i{italics} @samp{@{\textit @point{}\/@}} text. - -@item C-c C-f C-e -@kindex C-c C-f C-e -@cindex @code{\emph} -Insert @i{emphasized} @samp{@{\emph @point{}\/@}} text. - -@item C-c C-f C-s -@kindex C-c C-f C-s -@cindex @code{\textsl} -Insert @i{slanted} @samp{@{\textsl @point{}\/@}} text. - -@item C-c C-f C-t -@kindex C-c C-f C-t -@cindex @code{\texttt} -Insert @t{typewriter} @samp{@{\texttt @point{}@}} text. - -@item C-c C-f C-c -@kindex C-c C-f C-c -@cindex @code{\textsc} -Insert @sc{small caps} @samp{@{\textsc @point{}@}} text. - -@item C-c C-f C-d -@kindex C-c C-f C-c -@cindex Deleting fonts -Delete the innermost font specification containing point. - -@end table - -@deffn Command TeX-font @var{arg} -@kindex C-c C-f -(@kbd{C-c C-f}) Insert template for font change command. - -If @var{replace} is not nil, replace current font. @var{what} -determines the font to use, as specified by @code{TeX-font-list}. -@end deffn - -@defopt TeX-font-list -List of fonts used by TeX-font. - -Each entry is a list with three elements. The first element is the -key to activate the font. The second element is the string to insert -before point, and the third element is the string to insert after -point. An optional fourth element means always replace if not nil. -@end defopt - -@node Sectioning, Environments, Font Specifiers, Frequently Used Commands -@section Inserting chapters, sections, etc. -@cindex Sectioning -@cindex Sections -@cindex Chapters -@cindex @code{\chapter} -@cindex @code{\section} -@cindex @code{\subsection} -@cindex @code{\label} - -Insertion of sectioning macros, that is @samp{\chapter}, -@samp{\section}, @samp{\subsection}, etc. and accompanying -@samp{\label}'s may be eased by using @kbd{C-c C-s}. This command is -highly customizable, the following describes the default behavior. - -When invoking you will be asked for a section macro to insert. An -appropriate default is automatically selected by AUC @TeX{}, that is -either: at the top of the document; the top level sectioning for that -document style, and any other place: The same as the last occurring -sectioning command. - -Next, you will be asked for the actual name of that section, and -last you will be asked for a label to be associated with that section. -The label will be prefixed by the value specified in -@code{LaTeX-section-hook}. - -@deffn Command LaTeX-section @var{arg} -@kindex C-c C-s -(@kbd{C-c C-s}) Insert a sectioning command. - -Determine the type of section to be inserted, by the argument -@var{arg}.@refill - -@itemize @bullet -@item -If @var{arg} is nil or missing, use the current level. -@item -If @var{arg} is a list (selected by C-u), go downward one level. -@item -If @var{arg} is negative, go up that many levels. -@item -If @var{arg} is positive or zero, use absolute level: -@itemize + -@item -0 : part -@item -1 : chapter -@item -2 : section -@item -3 : subsection -@item -4 : subsubsection -@item -5 : paragraph -@item -6 : subparagraph -@end itemize -@end itemize - -The following variables can be set to customize the function. - -@vtable @code -@item LaTeX-section-hook -Hooks to be run when inserting a section. -@item LaTeX-section-label -Prefix to all section references. -@end vtable - -@end deffn - -The precise behavior of @code{LaTeX-section} is defined by the contents -of @code{LaTeX-section-hook}. - -@defopt LaTeX-section-hook -List of hooks to run when a new section is inserted. - -The following variables are set before the hooks are run - -@table @var -@item level -Numeric section level, default set by prefix arg to @code{LaTeX-section}. -@item name -Name of the sectioning command, derived from @var{level}. -@item title -The title of the section, default to an empty string. -@item toc -Entry for the table of contents list, default nil. -@item done-mark -Position of point afterwards, default nil meaning after the inserted -text. -@end table - -A number of hooks are already defined. Most likely, you will be able to -get the desired functionality by choosing from these hooks. - -@ftable @code -@item LaTeX-section-heading -Query the user about the name of the sectioning command. Modifies -@var{level} and @var{name}. -@item LaTeX-section-title -Query the user about the title of the section. Modifies @var{title}. -@item LaTeX-section-toc -Query the user for the toc entry. Modifies @var{toc}. -@item LaTeX-section-section -Insert La@TeX{} section command according to @var{name}, @var{title}, -and @var{toc}. If @var{toc} is nil, no toc entry is inserted. If -@var{toc} or @var{title} are empty strings, @var{done-mark} will be -placed at the point they should be inserted. -@item LaTeX-section-label -Insert a label after the section command. Controlled by the variable -@code{LaTeX-section-label}. -@end ftable - -To get a full featured @code{LaTeX-section} command, insert - -@lisp -(setq LaTeX-section-hook - '(LaTeX-section-heading - LaTeX-section-title - LaTeX-section-toc - LaTeX-section-section - LaTeX-section-label)) -@end lisp - -in your @file{.emacs} file. -@end defopt - -The behavior of @code{LaTeX-section-label} is determined by the -variable @code{LaTeX-section-label}.@refill - -@defopt LaTeX-section-label -Default prefix when asking for a label. - -If it is a string, it is used unchanged for all kinds of sections. -If it is nil, no label is inserted. -If it is a list, the list is searched for a member whose car is equal -to the name of the sectioning command being inserted. The cdr is then -used as the prefix. If the name is not found, or if the cdr is nil, -no label is inserted. - -@cindex Prefix for labels -@cindex Label prefix -@cindex Labels -By default, chapters have a prefix of @samp{cha:} while sections and -subsections have a prefix of @samp{sec:}. Labels are not automatically -inserted for other types of sections. -@end defopt - -@node Environments, , Sectioning, Frequently Used Commands -@section Inserting Environment Templates -@cindex Environments -@cindex @samp{\begin} -@cindex @samp{\end} - -A large apparatus is available that supports insertions of environments, -that is @samp{\begin@{@}} --- @samp{\end@{@}} pairs. - -AUC @TeX{} is aware of most of the actual environments available in a -specific document. This is achieved by examining your -@samp{\documentstyle} command, and consulting a precompiled list of -environments available in a large number of styles. - -You insert an environment with @kbd{C-c C-e}, and select an environment -type. Depending on the environment, AUC @TeX{} may ask more questions -about the optional parts of the selected environment type. With -@kbd{C-u C-c C-e} you will change the current environment. - -@deffn Command LaTeX-environment @var{arg} -@kindex C-c C-e -(@kbd{C-c C-e}) AUC @TeX{} will prompt you for an environment -to insert. At this prompt, you may press @key{TAB} or @key{SPC} to -complete a partially written name, and/or to get a list of available -environments. After selection of a specific environment AUC @TeX{} may -prompt you for further specifications. - -If the optional argument @var{arg} is not-nil (i.e. you have given a -prefix argument), the current environment is modified and no new -environment is inserted. -@end deffn - -As a default selection, AUC @TeX{} will suggest the environment last -inserted or, as the first choice the value of the variable -@code{LaTeX-default-environment}. - -@defopt LaTeX-default-environment -Default environment to insert when invoking @samp{LaTeX-environment} -first time. -@end defopt - -If the document is empty, or the cursor is placed at the top of the -document, AUC @TeX{} will default to insert a `document' environment. - -Most of these are described further in the following sections, and you -may easily specify more, as described in `Customizing environments'. - -@menu -* Floats:: Floats -* Itemize-like:: Itemize-like -* Tabular-like:: Tabular-like -* Customizing environments:: Customizing environments -@end menu - -You can close the current environment with @kbd{C-c ]}, but we suggest -that you use @kbd{C-c C-e} to insert complete environments instead. - -@deffn Command LaTeX-close-environment -@kindex C-c ] -(@kbd{C-c ]}) Insert an @samp{\end} that matches the current environment. -@end deffn - -@node Floats, Itemize-like, Environments, Environments -@subsection Floats -@cindex Floats -@cindex Figures -@cindex Figure environment -@cindex Tables -@cindex Table environment - -Figures and tables (i.e., floats) may also be inserted using AUC @TeX{}. -After choosing either `figure' or `table' in the environment list -described above, you will be prompted for a number of additional things. - -@table @var -@item float-to -This field is the option of float environments that controls how they are -placed in the final document. In La@TeX{} this is a sequence of the -letters @samp{htbp} as described in the La@TeX{} manual. The value will -default to the value of @code{LaTeX-float}. -@vindex LaTeX-float - -@item caption -This is the caption of the float. - -@item label -The label of this float. The label will have a default prefix, which is -controlled by the variables @code{LaTeX-figure-label} and -@code{LaTeX-table-label}. -@vindex LaTeX-figure-label -@vindex LaTeX-table-label -@cindex Prefix for labels -@cindex Label prefix -@cindex Labels -@end table - -Moreover, in the case of a `figure' environment, you will be asked if -you want to insert a `center' environment inside the figure. - -@defopt LaTeX-float -Default placement for floats. -@end defopt - -@defopt LaTeX-figure-label -Prefix to use for figure labels. -@end defopt - -@defopt LaTeX-table-label -Prefix to use for table labels. -@end defopt - -@node Itemize-like, Tabular-like, Floats, Environments -@subsection Itemize-like -@cindex Itemize -@cindex Enumerates -@cindex Descriptions -@cindex Items -@cindex \item - -In an itemize-like environment, nodes (i.e., @samp{\item}s) may be -inserted using @kbd{C-c @key{LFD}}. - -@deffn Command LaTeX-insert-item -@kindex C-c @key{LFD} -(@kbd{C-c @key{LFD}}) Close the current item, move to the next line and -insert an appropriate @samp{\item} for the current environment. That is, -`itemize' and `enumerate' will have @samp{\item } inserted, while -`description' will have @samp{\item[]} inserted. -@end deffn - -@node Tabular-like, Customizing environments, Itemize-like, Environments -@subsection Tabular-like - -When inserting Tabular-like environments, that is, `tabular' `array' -etc., you will be prompted for a template for that environment. - -@node Customizing environments, , Tabular-like, Environments -@subsection Customizing environments - -@xref{Adding Environments}, for how to customize the list of known -environments. - -@node Advanced Features, Formatting, Frequently Used Commands, top -@chapter Advanced Editing Features -@cindex Advanced features - -The previous chapter described how to write the main body of the text -easily and with a minimum of errors. In this chapter we will describe -some features for entering more specialized sorts of text, and for -indenting and navigating through the document. - -@menu -* Mathematics:: Entering Mathematics -* Completion:: Completion -* Commenting:: Commenting -* Marking and formatting:: Marking, Formatting and Indenting -* Outline:: Hiding text -@end menu - -@node Mathematics, Completion, Advanced Features, Advanced Features -@section Entering Mathematics -@cindex Mathematics -@cindex Symbols -@cindex Abbreviations - -@TeX{} is written by a mathematician, and has always contained good -support for formatting mathematical text. AUC @TeX{} supports this -tradition, by offering a special minor mode for entering text with many -mathematic symbols. You can enter this mode by typing @kbd{C-c -~}.@refill - -@deffn Command LaTeX-math-mode -@kindex C-c ~ -(@kbd{C-c ~}) Toggle LaTeX-math-mode. This is a minor mode rebinding -the key @code{LaTeX-math-abbrev-prefix} to allow easy typing of -mathematical symbols. @kbd{`} will read a character from the keyboard, -and insert the symbol as specified in @code{LaTeX-math-list}. If given a -prefix argument, the symbol will be surrounded by dollar signs.@refill -@end deffn - -You can use another prefix key (instead of @kbd{`}) by setting the -variable LaTeX-math-abbrev-prefix. - -@defopt LaTeX-math-abbrev-prefix -A string containing the prefix of @code{LaTeX-math-mode} commands; -This value defaults to @kbd{`}. @refill -@end defopt - -The variable @code{LaTeX-math-list} holds the actual mapping. - -@defopt LaTeX-math-list -A list containing key command mappings to use in @code{LaTeX-math-mode}. -The car of each element is the key and the cdr is the macro name. -@end defopt - -The AUC @TeX{} distributions includes a reference card for -@code{LaTeX-math-mode} with a list of all math mode commands. - -@node Completion, Commenting, Mathematics, Advanced Features -@section Completion -@cindex Completion -@cindex Expansion -@cindex Macro expansion -@cindex Macro completion -@cindex Macro arguments -@cindex Arguments to @TeX{} macros - -Emacs lisp programmers probably know the @code{lisp-complete-symbol} -command, usually bound to @kbd{M-@key{TAB}}. Users of the wonderful -ispell mode know and love the @code{ispell-complete-word} command from -that package. Similarly, AUC @TeX{} has a @code{TeX-complete-symbol} -command, usually bound to @kbd{M-@key{TAB}}. Using -@code{LaTeX-complete-symbol} makes it easier to type and remember the -names of long La@TeX{} macros. - -In order to use @code{TeX-complete-symbol}, you should write a backslash -and the start of the macro. Typing @kbd{M-@key{TAB}} will now -complete as much of the macro, as it unambiguously can. For example, if -you type `@samp{\renewc}' and then `@kbd{M-@key{TAB}}, it will expand -to `@samp{\renewcommand}'. - -@deffn Command TeX-complete-symbol -@kindex M-@key{TAB} -(@kbd{M-@key{TAB}}) Complete @TeX{} symbol before point. -@end deffn - -A more direct way to insert a macro is with @code{TeX-insert-macro}, -bound to @kbd{C-c C-m}. It has the advantage over completion that it -knows about the argument of most standard La@TeX{} macros, and will -prompt for them. It also knows about the type of the arguments, so it -will for example give completion for the argument to @samp{\include}. -Some examples are listed below. - -@deffn Command TeX-insert-macro -@kindex C-c C-m -(@kbd{C-c C-m}) Prompt (with completion) for the name of a @TeX{} macro, -and if AUC @TeX{} knows the macro, prompt for each argument. -@end deffn - -As a default selection, AUC @TeX{} will suggest the macro last inserted -or, as the first choice the value of the variable -@code{TeX-default-macro}. - -@defopt TeX-default-macro -Default macro to insert when invoking @code{TeX-insert-macro} first time. -@end defopt - -A faster alternative is to bind the function @code{TeX-electric-macro} -to @samp{\}. This can be done by setting the variable @code{TeX-electric-escape} - -@defopt TeX-electric-escape -If this is non-nil when AUC @TeX{} is loaded, the @TeX{} escape -character @samp{\} will be bound to @code{TeX-electric-macro} -@end defopt - -The difference between @code{TeX-insert-macro} and -@code{TeX-electric-macro} is that space will complete and exit from the -minibuffer in @code{TeX-electric-macro}. Use @key{TAB} if you merely -want to complete. - -@deffn Command TeX-electric-macro -Prompt (with completion) for the name of a @TeX{} macro, -and if AUC @TeX{} knows the macro, prompt for each argument. -Space will complete and exit. -@end deffn - -By default AUC @TeX{} will put an empty set braces @samp{@{@}} after a -macro with no arguments to stop it from eating the next whitespace. -This can be stopped by entering @code{LaTeX-math-mode}, -@pxref{Mathematics}, or by setting @code{TeX-insert-braces} to nil - -@defopt TeX-insert-braces -If non-nil, append a empty pair of braces after inserting a macro. -@end defopt - -Completions work because AUC @TeX{} can analyze @TeX{} files, and store -symbols in emacs lisp files for later retrieval. @xref{Automatic}, for -more information. - -@cindex \cite, completion of -@cindex Bib@TeX{}, completion -@cindex cite, completion of -@cindex bibliography, completion -@cindex citations, completion of -@cindex \label, completion -@cindex \ref, completion -@cindex labels, completion of -AUC @TeX{} will also make completion for many macro arguments, for -example existing labels when you enter a @samp{\ref} macro with -@code{TeX-insert-macro} or @code{TeX-electric-macro}, and Bib@TeX{} -entries when you enter a @samp{\cite} macro. For this kind of -completion to work, parsing must be enabled as described in -@pxref{Parsing Files}. For @samp{\cite} you must also make sure that -the Bib@TeX{} files have been saved at least once after you enabled -automatic parsing on save, and that the basename of the Bib@TeX{} file -does not conflict with the basename of one of @TeX{} files. - -@node Commenting, Marking and formatting, Completion, Advanced Features -@section Commenting - -It is often necessary to comment out temporarily a region of @TeX{} or -La@TeX{} code. This can be done with the commands @kbd{C-c ;} and -@kbd{C-c %}. @kbd{C-c ;} will comment out all lines in the current -region, while @kbd{C-c %} will comment out the current paragraph. To -uncomment, simply type @kbd{C-u - C-c ;} to uncomment all lines in the -region, or @kbd{C-u - C-c %} uncomment all comment lines around point. - -By default, these commands will insert or remove a single @samp{%}. To -insert more than one, give an argument. @kbd{C-u 5 C-c %} will add five -@samp{%} to each line, while @kbd{C-u - 5 C-c %} will remove up to 5 -@samp{%} from each line. - -@deffn Command TeX-comment-region @var{count} -@kindex C-c ; -(@kbd{C-c ;}) Add or remove @samp{%} from the beginning of each line in -the current region, as specified by @var{count}. -@end deffn - -@deffn Command TeX-comment-paragraph @var{count} -@kindex C-c % -(@kbd{C-c %}) Add or remove @samp{%} from the beginning of each line in -the current paragraph, as specified by @var{count}. When removing -@samp{%}'s the paragraph is considered to consist of all preceding and -succeeding lines starting with a @samp{%}, until the first non-comment -line. -@end deffn - -@node Marking and formatting, Outline, Commenting, Advanced Features -@section Marking, Formatting and Indenting -@cindex Formatting -@cindex Filling -@cindex Indenting -@cindex Reformatting -@cindex Reindenting - -AUC @TeX{} contains very advanced handling of indentation and -reformatting of the La@TeX{} source. If you have already tried AUC -@TeX{} with @code{auto-fill-mode} enabled, you may have noted that the -source is automatically indented and formatted as you write it. More -over, AUC @TeX{} is able to format sections of text on demand. - -It is important to realize, that AUC @TeX{} comes with `formatting' in -two fashions. Either letting @TeX{} format the file, or letting AUC -@TeX{} make the ASCII document look better. - -Indentation is done by La@TeX{} environments and by @TeX{} groups, that -is the body of an environment is indented by the value of -@code{LaTeX-indent-level} (default 2). Also, items of an `itemize-like' -environment are indented by the value of @code{LaTeX-item-indent}, -default @minus{}2. This indentation makes it easier to see the -structure of the document, and to catch errors such as a missing close -brace. Thus, the indentation is done for precisely the same reasons -that you would indent ordinary computer programs. -@vindex LaTeX-indent-level -@vindex LaTeX-item-indent - -The following is a short sample of an itemize environment indented by -AUC @TeX{}. If more environment are nested, they are indented -`accumulated' just like most programming languages usually are seen -indented in nested constructs. - -@example -\begin@{itemize@} -\item Insertion of templates for logical-structural compositions such as - environments and sections. -\item Hot-keys for easy access to certain often used constructs, e.g., - font changes, accented letters, and mathematical symbols. -\item Running application programs (such as \TeX), and then parsing - the output so that errors in the document may be located - easily. -\item Support for multi-file documents. -\item Online help for \AllTeX\ error messages. -\item Outlining\Dash i.e., manipulating the document as a composition - of nested/sequential logical constructs. -\item Instant formatting and indentation of the \ascii-document in - order to make it easier to read. -\item `Completion' (and thereby spell-checking) of partially written - control sequences. -\end@{itemize@} -@end example - -You can format and indent single lines, paragraphs, environments, or -sections. - -@table @kbd -@item @key{TAB} -@kindex @key{TAB} -@findex LaTeX-indent-line -@code{LaTeX-indent-line} will indent the current line. - -@item @key{LFD} -@kindex @key{LFD} -@code{reindent-then-newline-and-indent} indents the current line, and -then inserts a new line (much like @key{RET}) and move the cursor to an -appropriate position by the left margin. - -@item M-q -@kindex M-q -Alias for @kbd{C-c C-q C-p} - -@item C-c C-q C-p -@kindex C-c C-q C-p -@findex LaTeX-fill-paragraph -@code{LaTeX-fill-paragraph} will reformat or `fill' the current -paragraph. - -@item C-c C-q C-e -@kindex C-c C-q C-e -@findex LaTeX-fill-environment -@code{LaTeX-fill-environment} will reformat or `fill' the current -environment. This may e.g. be the `document' environment, in which case -the entire document will be formatted. - -@item C-c C-q C-s -@kindex C-c C-q C-s -@findex LaTeX-fill-section -@code{LaTeX-fill-section} will reformat or `fill' the current -logical sectional unit. - -@item M-g -@kindex M-g -Alias for @kbd{C-c C-q C-r} - -@item C-c C-q C-r -@kindex C-c C-q C-r -@findex LaTeX-fill-region -@code{LaTeX-fill-region} will format or `fill' the current region. -@end table - -@strong{Warning:} The formatting cannot handle tabular-like -environments. Those will be completely messed-up if you try to format -them. - -@defopt LaTeX-indent-level -Number of spaces to add to the indentation for each @samp{\begin} not -matched by a @samp{\end}.@refill -@end defopt - -@defopt LaTeX-item-indent -Number of spaces to add to the indentation for @samp{\item}'s in list -environments.@refill -@end defopt - -@defopt TeX-brace-indent-level -Number of spaces to add to the indentation for each @samp{@{} not -matched by a @samp{@}}.@refill -@end defopt - -@node Outline, , Marking and formatting, Advanced Features -@section Outlining the Document -@cindex Outlining -@cindex Headers -@cindex Sections -@cindex Overview -@cindex Folding - -GNU Emacs earlier than version 19.19 does not have a useful outline -mode. If you want to use outlines with old versions of emacs, please -get the file @file{outln-18.el} from -@file{sunsite.auc.dk:/packages/auctex/outln-18.el}. It is a port of the -Emacs 19.19 outline mode to Emacs 18 and Lucid Emacs.@refill - -AUC @TeX{} supports the standard outline minor mode using La@TeX{} -sectioning commands as header lines. @xref{Outline Mode, , Outline -Mode, emacs, GNU Emacs Manual}. By default -@code{outline-minor-mode} will use the prefix key @kbd{C-c} which is -also used by AUC @TeX{}, so it is suggested that you choose another -prefix key by inserting - -@lisp - (setq outline-minor-mode-prefix "\C-c\C-o") ; Or whatever... -@end lisp - -in your @file{.emacs} file. - -You can add your own headings by setting the variable -@code{TeX-outline-extra}. - -@defvar TeX-outline-extra -List of extra @TeX{} outline levels. - -Each element is a list with two entries. The first entry is the regular -expression matching a header, and the second is the level of the header. -A @samp{^} is automatically prepended to the regular expressions in the -list, so they must match text at the beginning of the line. - -See @code{LaTeX-section-list} for existing header levels. -@end defvar - -The following example add @samp{\item} and @samp{\bibliography} headers, -with @samp{\bibliography} at the same outline level as @samp{\section}, -and @samp{\item} being below @samp{\subparagraph}. - -@example -(setq TeX-outline-extra - '(("[ \t]*\\\\\\(bib\\)?item\\b" 7) - ("\\\\bibliography\\b" 2))) -@end example - -You may want to check out the unbundled @file{out-xtra} package for even -better outline support. It is available from your favorite emacs lisp -archive. - -@node Formatting, Multifile, Advanced Features, top -@chapter Formatting and Printing - -The most powerful features of AUC @TeX{} may be those allowing you to -run (La)@TeX{} and other external commands like Bib@TeX{} and -@code{makeindex} from within Emacs, viewing and printing the results, -and moreover allowing you to @emph{debug} your documents. - -@menu -* Commands:: Invoking external commands. -* Debugging:: Debugging @TeX{} and La@TeX{} output. -* Checking:: Checking the document. -* Control:: Controlling the processes. -@end menu - -@node Commands, Debugging, Formatting, Formatting -@section Executing Commands -@cindex Formatting -@cindex Running La@TeX{} -@cindex Running @TeX{} -@cindex La@TeX{} -@cindex @TeX{} -@cindex Running commands -@cindex Default command -@cindex Header -@cindex Trailer -@cindex Setting the header -@cindex Setting the trailer -@cindex Region -@cindex Region file -@cindex Setting the default command -@cindex Commands -@cindex External Commands -@cindex Indexing -@cindex Making an index -@cindex Running @code{makeindex} -@cindex @code{makeindex} -@cindex Bib@TeX{} -@cindex Bibliography -@cindex Literature -@cindex Running Bib@TeX{} -@cindex Making a bibliography -@cindex Printing -@cindex Writing to a printer -@cindex Viewing -@cindex Previewing -@cindex Starting a previewer - -Formatting the document with @TeX{} or La@TeX{}, viewing with a -previewer, printing the document, running Bib@TeX{}, making an index, or -checking the document with @code{lacheck} or @code{chktex} all require -running an external command. - -There are two ways to run an external command, you can either run it on -all of the current documents with @code{TeX-command-master}, or on the -current region with @code{TeX-command-region}.@refill - -@deffn Command TeX-command-master -@kindex C-c C-c -(@kbd{C-c C-c}) Query the user for a command, and run it on the master -file associated with the current buffer. The name of the master file is -controlled by the variable @code{TeX-master}. The available commands are -controlled by the variable @code{TeX-command-list}.@refill -@vindex TeX-master -@vindex TeX-command-list -@end deffn - -@xref{Installation} for a discussion about @code{TeX-command-list} and -@ref{Multifile} for a discussion about @code{TeX-master}. - -@deffn Command TeX-command-region -@kindex C-c C-r -(@kbd{C-c C-r}) Query the user for a command, and run it on the ``region -file''. Some commands (typically those invoking @TeX{} or La@TeX{}) -will write the current region into the region file, after extracting the -header and tailer from the master file. If mark is not active, use the -old region. The name of the region file is controlled by the variable -@code{TeX-region}. The name of the master file is controlled by the -variable @code{TeX-master}. The header is all text up to the line -matching the regular expression @code{TeX-header-end}. The trailer is -all text from the line matching the regular expression -@code{TeX-trailer-start}. The available commands are controlled by the -variable @code{TeX-command-list}.@refill -@vindex TeX-region -@vindex TeX-header-end -@vindex TeX-trailer-start -@vindex TeX-master -@vindex TeX-command-list -@end deffn - -AUC @TeX{} will allow one process for each document, plus one process -for the region file to be active at the same time. Thus, if you are -editing @var{n} different documents, you can have @var{n} plus one -processes running at the same time. If the last process you started was -on the region, the commands described in @ref{Debugging} and -@ref{Control} will work on that process, otherwise they will work on the -process associated with the current document. - -@defopt TeX-region -The name of the file for temporarily storing the text when formatting -the current region. -@end defopt - -@defopt TeX-header-end -A regular expression matching the end of the header. By default, this -is @samp{\begin@{document@}} in La@TeX{} mode and @samp{%**end of -header} in @TeX{} mode.@refill -@end defopt - -@defopt TeX-trailer-start -A regular expression matching the start of the trailer. By default, -this is @samp{\end@{document@}} in La@TeX{} mode and @samp{\bye} in -@TeX{} mode.@refill -@end defopt - -AUC @TeX{} will try to guess what command you want to invoke, but by -default it will assume that you want to run @TeX{} in @TeX{} mode and -La@TeX{} in La@TeX{} mode. You can overwrite this by setting the -variable @code{TeX-command-default}. - -@defopt TeX-command-default -The default command to run in this buffer. Must be an entry in -@code{TeX-command-list}. -@end defopt - -If you want to overwrite the values of @code{TeX-header-end}, -@code{TeX-trailer-start}, or @code{TeX-command-default}, you can do that -for all files by setting them in either @code{TeX-mode-hook}, -@code{plain-TeX-mode-hook}, or @code{LaTeX-mode-hook}. To overwrite -them for a single file, define them as file variables (@pxref{File -Variables,,,emacs,The Emacs Editor}). You do this by putting special -formatted text near the end of the file. -@cindex Variables -@cindex File Variables -@cindex Local Variables - -@example -% Local Variables: -% TeX-header-end: "% End-Of-Header" -% TeX-trailer-start: "% Start-Of-Trailer" -% TeX-command-default: "SliTeX" -% End: -@end example - -AUC @TeX{} will try to save any buffers related to the document, and -check if the document needs to be reformatted. If the variable -@code{TeX-save-query} is non-nil, AUC @TeX{} will query before saving -each file. By default AUC @TeX{} will check emacs buffers associated -with files in the current directory, in one of the -@code{TeX-macro-private} directories, and in the @code{TeX-macro-global} -directories. You can change this by setting the variable -@code{TeX-check-path}.@refill - -@defopt TeX-check-path -Directory path to search for dependencies. - -If nil, just check the current file. -Used when checking if any files have changed. -@end defopt - -@node Debugging, Checking, Commands, Formatting -@section Catching the errors -@cindex Debugging -@cindex Errors -@cindex Parsing errors -@cindex Parsing TeX output -@cindex Next error -@cindex Parsing LaTeX errors -@cindex Overfull boxes -@cindex Bad boxes -@cindex Wonderful boxes - -Once you've formatted your document you may `debug' it, i.e. browse -through the errors (La)@TeX{} reported. - -@deffn Command TeX-next-error -@kindex C-c ` -(@kbd{C-c `}) Go to the next error reported by @TeX{}. The view will -be split in two, with the cursor placed as close as possible to the -error in the top view. In the bottom view, the error message will be -displayed along with some explanatory text. -@end deffn - -Normally AUC @TeX{} will only report real errors, but you may as well -ask it to report `bad boxes' as well. - -@deffn Command TeX-toggle-debug-bad-boxes -@kindex C-c C-w -(@kbd{C-c C-w}) Toggle whether AUC @TeX{} should stop at bad boxes -(i.e. over/under full boxes) as well as at normal errors. -@end deffn - -As default, AUC @TeX{} will display that special @samp{*help*} buffer -containing the error reported by @TeX{} along with the documentation. -There is however an `expert' option, which allows you to display the -real @TeX{} output. - -@defopt TeX-display-help -When non-nil AUC @TeX{} will automatically display a help text whenever -an error is encountered using @code{TeX-next-error} (@kbd{C-c `}). -@end defopt - -@node Checking, Control, Debugging, Formatting -@section Checking for problems -@cindex Checking -@cindex @code{lacheck} -@cindex @code{chktex} -@cindex Finding errors -@cindex Running @code{lacheck} -@cindex Running @code{chktex} -@cindex Style -@cindex Problems - -Running @TeX{} or La@TeX{} will only find regular errors in the -document, not examples of bad style. Furthermore, description of the -errors may often be confusing. The utility @code{lacheck} can be used -to find style errors, such as forgetting to escape the space after an -abbreviation or using @samp{...} instead of @samp{\ldots} and many other -problems like that. You start @code{lacheck} with @kbd{C-c C-c C h e c -k @key{RET}}. The result will be a list of errors in the -@samp{*compilation*} buffer. You can go through the errors with -@kbd{C-x `} (@code{next-error}, @pxref{Compilation,,,emacs,The Emacs -Editor}), which will move point to the location of the next -error.@refill - -Another newer program which can be used to find errors is @code{chktex}. -It is much more configurable than @code{lacheck}, but doesn't find all -the problems @code{lacheck} does, at least in its default configuration. -You must install the programs before using them, and for @code{chktex} -you must also modify @code{TeX-command-list}. You can get -@code{lacheck} from @file{} -or alternatively @code{chktex} from -@file{}. Search for -`chktex' in @file{tex.el} to see how to switch between them.@refill They -are - -@node Control, , Checking, Formatting -@section Controlling the output -@cindex Controlling the output -@cindex Output -@cindex Redisplay output -@cindex Processes -@cindex Killing a process -@cindex Finding the master file -@cindex Master file -@cindex Stopping a process -@cindex Current file -@cindex Finding the current file - -A number of commands are available for controlling the output of an -application running under AUC @TeX{} - -@deffn Command TeX-kill-job -@kindex C-c C-k -(@kbd{C-c C-k}) Kill currently running external application. -This may be either of @TeX{}, La@TeX{}, previewer Bib@TeX{} etc. -@end deffn - -@deffn Command TeX-recenter-output-buffer -@kindex C-c C-l -(@kbd{C-c C-l}) Recenter the output buffer so that the bottom line is -visible. -@end deffn - -@deffn Command TeX-home-buffer -@kindex C-c ^ -(@kbd{C-c ^}) Go to the `master' file in the document associated with -the current buffer, or if already there, to the file where the current -process was started. -@end deffn - -@node Multifile, Parsing Files, Formatting, top -@chapter Multifile Documents -@cindex Multifile Documents -@cindex Documents -@cindex Documents with multiple files -@cindex Multiple Files -@cindex Many Files -@cindex Including -@cindex \include -@cindex Inputing -@cindex \input -@cindex Master file - -You may wish spread a document over many files (as you are likely to do if -there are multiple authors, or if you have not yet discovered the power -of the outline commands (@pxref{Outline})). This can be done by having a -``master'' file in which you include the various files with the @TeX{} -macro @samp{\input} or the La@TeX{} macro @samp{\include}. These -files may also include other files themselves. However, to format the -document you must run the commands on the top level master file.@refill - -When you, for example, ask AUC @TeX{} to run a command on the master file, -it has no way of knowing the name of the master file. By default, -it will assume that the current file is the master file. If you insert -the following in your @file{.emacs} file AUC @TeX{} will use a more -advanced algorithm. - -@lisp -(setq-default TeX-master nil) ; Query for master file. -@end lisp - -If AUC @TeX{} finds the line indicating the end of the header in a -master file (@code{TeX-header-end}), it can figure out for itself that -this is a master file. Otherwise, it will ask for the name of the -master file associated with the buffer. To avoid asking you again, AUC -@TeX{} will automatically insert the name of the master file as a file -variable (@pxref{File Variables,,,emacs,The Emacs Editor}). You can -also insert the file variable yourself, by putting the following text at -the end of your files.@refill -@findex TeX-header-end - -@example -% Local Variables: -% TeX-master: "master" -% End: -@end example - -You should always set this variable to the name of the top level document. If -you always use the same name for your top level documents, you can set -@code{TeX-master} in your @file{.emacs} file. - -@lisp -(setq-default TeX-master "master") ; All master files called "master". -@end lisp - -@defopt TeX-master -The master file associated with the current buffer. If the file being -edited is actually included from another file, then you can tell AUC @TeX{} -the name of the master file by setting this variable. If there are -multiple levels of nesting, specify the top level file.@refill - -If this variable is @code{nil}, AUC @TeX{} will query you for the -name.@refill - -If the variable is @code{t}, then AUC @TeX{} will assume the file is a master -file itself.@refill - -If the variable is @code{shared}, then AUC @TeX{} will query for the name, -but will not change the file.@refill - -It is suggested that you use the File Variables (@pxref{File -Variables,,,emacs,The Emacs Editor}) to set this variable permanently -for each file.@refill -@end defopt - -@defopt TeX-one-master -Regular expression matching ordinary TeX files. - -You should set this variable to match the name of all files, for which -it is a good idea to append a @code{TeX-master} file variable entry -automatically. When AUC @TeX{} adds the name of the master file as a -file variable, it does not need to ask next time you edit the file. - -If you dislike AUC @TeX{} automatically modifying your files, you can -set this variable to @samp{""}. By default, AUC @TeX{} will modify -any file with an extension of @samp{.tex}.@refill -@end defopt - -AUC @TeX{} keeps track of macros, environments, labels, and style -files that are used in a given document. For this to work with -multifile documents, AUC @TeX{} has to have a place to put the -information about the files in the document. This is done by having an -@file{auto} subdirectory placed in the directory where your document is -located. Each time you save a file, AUC @TeX{} will write information -about the file into the @file{auto} directory. When you load a file, -AUC @TeX{} will read the information in the @file{auto} directory -about the file you loaded @emph{and the master file specified by -@code{TeX-master}}. Since the master file (perhaps indirectly) includes -all other files in the document, AUC @TeX{} will get information from -all files in the document. This means that you will get from each file, -for example, completion for all labels defined anywhere in the document. - -AUC TeX will create the @file{auto} directory automatically if -@code{TeX-auto-save} is non-nil. Without it, the files in the document -will not know anything about each other, except for the name of the -master file. @xref{Automatic Local}. - -@deffn Command TeX-save-document -@kindex C-c C-d -(@kbd{C-c C-d}) Save all buffers known to belong to the current document. -@end deffn - -@defopt TeX-save-query -If non-nil, then query the user before saving each file with -@code{TeX-save-document}. -@end defopt - - -@node Parsing Files, I18n, Multifile, top -@chapter Automatic Parsing of @TeX{} files. -@cindex Parsing @TeX{} -@cindex Automatic Parsing -@cindex Tabs -@cindex Tabify -@cindex Untabify - -AUC @TeX{} depends heavily on being able to extract information from the -buffers by parsing them. Since parsing the buffer can be somewhat slow, -the parsing is initially disabled. You are encouraged to enable them by -adding the following lines to your @file{.emacs} file. - -@lisp -(setq TeX-parse-self t) ; Enable parse on load. -(setq TeX-auto-save t) ; Enable parse on save. -@end lisp - -The later command will make AUC @TeX{} store the parsed information in -an @file{auto} subdirectory in the directory each time the @TeX{} files -are stored, @pxref{Automatic Local}. If AUC @TeX{} finds the pre-parsed -information when loading a file, it will not need to reparse the buffer. -The information in the @file{auto} directory is also useful for -multifile documents @pxref{Multifile}, since it allows each file to -access the parsed information from all the other files in the document. -This is done by first reading the information from the master file, and -then recursively the information from each file stored in the master -file.@refill - -The variables can also be done on a per file basis, by changing the file -local variables. - -@example -% Local Variables: -% TeX-parse-self: t -% TeX-auto-save: t -% End: -@end example - -Even when you have disabled the automatic parsing, you can force the -generation of style information by pressing @kbd{C-c C-n}. This is -often the best choice, as you will be able to decide when it is -necessary to reparse the file. - -@defopt TeX-parse-self -Parse file after loading it if no style hook is found for it. -@end defopt - -@defopt TeX-auto-save -Automatically save style information when saving the buffer. -@end defopt - -@deffn Command TeX-normal-mode @var{arg} -@kindex C-c C-n -(@kbd{C-c C-n}) Remove all information about this buffer, and apply the -style hooks again. Save buffer first including style information. With -optional argument, also reload the style hooks. -@end deffn - -When AUC TeX saves your buffer, it will by default convert all tabs in -your buffer into spaces. To disable this behaviour, insert the -following in your @file{.emacs} file. - -@lisp -(setq TeX-auto-untabify nil) -@end lisp - -@defopt TeX-auto-untabify -Automatically remove all tabs from a file before saving it. -@end defopt - -Instead of disabling the parsing entirely, you can also speed it -significantly up by limiting the information it will search for (and -store) when parsing the buffer. You can do this by setting the default -values for the buffer local variables @code{TeX-auto-regexp-list} and -@code{TeX-auto-parse-length} in your @file{.emacs} file. - -@lisp -;; Only parse \documentstyle information. -(setq-default TeX-auto-regexp-list 'LaTeX-auto-minimal-regexp-list) -;; The documentstyle command is usually near the beginning. -(setq-default TeX-auto-parse-length 2000) -@end lisp - -This example will speed the parsing up significantly, but AUC @TeX{} -will no longer be able to provide completion for labels, macros, -environments, or bibitems specified in the document, nor will it know -what files belong to the document. - -These variables can also be specified on a per file basis, by changing -the file local variables. - -@example -% Local Variables: -% TeX-auto-regexp-list: TeX-auto-full-regexp-list -% TeX-auto-parse-length: 999999 -% End: -@end example - -@defopt TeX-auto-regexp-list -List of regular expressions used for parsing the current file. -@end defopt - -@defopt TeX-auto-parse-length -Maximal length of TeX file that will be parsed. -@end defopt - -The pre-specified lists of regexps are defined below. You can use these -before loading AUC @TeX{} by quoting them, as in the example above. - -@defvr Constant TeX-auto-empty-regexp-list -Parse nothing -@end defvr - -@defvr Constant LaTeX-auto-minimal-regexp-list -Only parse documentstyle. -@end defvr - -@defvr Constant LaTeX-auto-label-regexp-list -Only parse La@TeX{} labels. -@end defvr - -@defvr Constant LaTeX-auto-regexp-list -Parse common La@TeX{} commands. -@end defvr - -@defvr Constant plain-TeX-auto-regexp-list -Parse common plain @TeX{} commands. -@end defvr - -@defvr Constant TeX-auto-full-regexp-list -Parse all @TeX{} and La@TeX{} commands that AUC @TeX{} can use. -@end defvr - -@node I18n, Automatic, Parsing Files, top -@chapter Internationalization -@cindex Internationalization -@cindex Character set -@cindex National letters - -There are several problems associated with editing non-English @TeX{} -with GNU Emacs. Modern versions of GNU Emacs and @TeX{} are usable for -European (Latin, Cyrillic, Greek) based languages, but special versions -of TeX and Emacs are needed for Korean, Japanese, and Chinese. - -@menu -* European:: Using AUC @TeX{} for European languages. -* Japanese:: Japanese @TeX{} -@end menu - -@node European, Japanese, I18n, I18n -@section Using AUC @TeX{} for European languages. -@cindex Europe -@cindex European Characters -@cindex ISO 8859 Latin 1 -@cindex Latin 1 -@cindex ISO 8859 Latin 2 -@cindex Latin 2 -@cindex ANSI -@cindex Denmark -@cindex Danish -@cindex Holland -@cindex Dutch -@cindex Germany -@cindex Poland - -First you will need a way to write non-ASCII characters. You can either -use macros, or teach @TeX{} about the ISO character sets. I prefer the -later, it has the advantage that the usual the standard emacs word -movement and case change commands will work. - - -With LaTeX2e, just add @samp{\usepackage[latin1]@{inputenc@}}. With older -LaTeX versions, try: - -@table @file -@item isolatin1.sty -Support for ISO 8859 Latin 1. Available by ftp from the host -@t{ftp.uni-stuttgart.de} as -@file{/pub/tex/macros/latex/contrib/misc/isolatin1.sty}. - -@item latin2.sty -Support for ISO 8859 Latin 2. Available by ftp from the host -@t{ftp.uni-stuttgart.de} as -@file{/pub/tex/macros/latex/contrib/latin2.sty}. -@end table - -To be able to display non-ASCII characters you will need an appropriate -font and a version of GNU Emacs capable of displaying 8-bit characters. -I believe all emacs versions except plain Emacs 18 are capable of this. -For GNU Emacs 19, @pxref{European Display,,,emacs, The GNU Emacs -Editor}. Other relevant packages are: - -@table @file -@item remap -Supports lots of different 7-bit and 8-bit character sets for GNU Emacs -19. Mostly useful if you have seldomly used character sets, or need to -use different character set for keyboard, buffer, and display. An -overkill if you just need ISO 8859 Latin 1. Currently in alpha test, -but available by ftp from the host @t{ftp.iesd.auc.dk} in -@file{/packages/auctex/}. - -To get dead keys for @TeX{}, install remap and insert the following in -your @file{.emacs} or @file{site-start.el} file. - -@lisp -(require 'remap) - -(defvar all-dead-keys "~'`^" - "Dead keys used by remap") - -(remap-define-map "Dead Key" - (apply 'append (mapcar 'remap-dead-map all-dead-keys))) - -(remap-define-map "TeX Dead Key" - (remap-map "Dead Key" (remap-add "Ascii" "~TeX"))) - -(setq remap-setup-alist - '(("7-bit" "Raw" "L1" "US" "Ctrl" "~TeX") - ("8-bit" "Raw" "L1" "L1" "Ctrl" "Raw") - ("Dead/7" "Dead Key" "L1" "US" "Ctrl" "~TeX") - ("Dead/8" "Dead Key" "L1" "L1" "Ctrl" "Raw") - ("TeX" "TeX Dead Key" "L1" "US" "Ctrl" "Raw"))) -@end lisp - -You can now enable TeX dead keys with -@example -@kbd{M-x remap-setup-choose RET TeX RET} -@end example -@end table - -A compromise is to use use an European character set when editing the -file, and convert to @TeX{} macros when reading and writing the files. - -@table @file -@item iso-tex.el -@cindex @file{iso-tex.el} -This file automatically converts between ISO 8859 Latin 1 encoding and -La@TeX{} encodings of West European characters. It is available by ftp -from @t{aida.intellektik.informatik.th-darmstadt.de} in the directory -@file{/pub/gene/Emacs}. -@item iso-cvt.el -@cindex @file{iso-cvt.el} -Much like @file{iso-tex.el} but is bundled with Emacs 19.23 and later. - -@item x-compose.el -@cindex @file{x-compose.el} -Similar package bundled with new versions of XEmacs. - -@end table - -AUC @TeX{} supports style files for several languages. Each style file -may modify some AUC @TeX{} to better support the language, and will run -a language specific hook that will allow you to for example change -ispell dictionary, or run code to change the keyboard remapping. The -following will for example choose a Danish dictionary for documents -including the @file{dk.sty} file. This requires parsing to be enabled, -@pxref{Parsing Files}. - -@lisp -(add-hook 'TeX-language-dk-hook - (function (lambda () (ispell-change-dictionary "danish")))) -@end lisp - -The following style files are recognized. -@table @file -@item dk -Runs style hook @code{TeX-language-dk-hook}. - -@item dutch -Runs style hook @code{TeX-language-nl-hook}. - -@item german -Runs style hook @code{TeX-language-de-hook}. -Gives @samp{"} word syntax and makes the @key{"} key insert a literal -@samp{"}. - -@item plfonts -@itemx plhb -Runs style hook @code{TeX-language-pl-hook}. -Gives @samp{"} word syntax and makes the @key{"} key insert a literal -@samp{"}. Pressing @key{"} twice will insert @samp{"<} or @samp{">} -depending on context. -@end table - -@node Japanese, , European, I18n -@section Japanese @TeX{} -@cindex Japan -@cindex Japanese -@cindex Nippon -@cindex NEMACS -@cindex MULE -@cindex j@TeX{} -@cindex jLa@TeX{} - -To write Japanese text with AUC @TeX{} you need to have versions of -@TeX{} and Emacs that support Japanese. There exist at least two -variants of @TeX{} for Japanese text, and AUC @TeX{} can be used with -both, as well as with the two Japanese-aware Emacses, NEMACS and MULE. - -To use the Japanese TeX variants, simply enter @code{japanese-tex-mode}, -@code{japanese-latex-mode}, or @code{japanese-slitex-mode}, and -everything should work. If not, send mail to Shinji Kobayashi -(@samp{}, who kindly donated the code for -supporting Japanese in AUC @TeX{}. None of the primary AUC @TeX{} -maintainers understand Japanese, so they can not help you. - -@node Automatic, Style Files, I18n, top -@chapter Automatic Customization -@cindex Automatic Customization -@cindex Extracting @TeX{} symbols -@cindex Automatic -@cindex @file{auto} directories. -@cindex Parsing @TeX{} -@cindex @TeX{} parsing -@cindex Generating symbols - -Since AUC @TeX{} is so highly customizable, it makes sense that it is able -to customize itself. The automatic customization consists of scanning -@TeX{} files and extracting symbols, environments, and things like that. - -The automatic customization is done on three different levels. The -global level is the level shared by all users at your site, and consists -of scanning the standard @TeX{} style files, and any extra styles added -locally for all users on the site. The private level deals with those -style files you have written for your own use, and use in different -documents. You may have a @file{~/lib/TeX/} directory where you store -useful style files for your own use. The local level is for a specific -directory, and deals with writing customization for the files for your -normal @TeX{} documents. - -If compared with the environment variable @code{TEXINPUTS}, the -global level corresponds to the directories built into @TeX{}. The -private level corresponds to the directories you add yourself, except for -@file{.}, which is the local level. - -@menu -* Automatic Global:: Automatic Customization for the Site -* Automatic Private:: Automatic Customization for a User -* Automatic Local:: Automatic Customization for a Directory -@end menu - -By default AUC @TeX{} will search for customization files in all the -global, private, and local style directories, but you can also set the -path directly. This is useful if you for example want to add another -person's style hooks to your path. Please note that all matching files -found in @code{TeX-style-path} are loaded, and all hooks defined in the -files will be executed. - -@defopt TeX-style-path -List of directories to search for AUC @TeX{} style files. -Each must end with a slash. -@end defopt - -By default, when AUC @TeX{} searches a directory for files, it will -recursively search through subdirectories. - -@defopt TeX-file-recurse -If not nil, search @TeX{} directories recursively. -@end defopt - -By default, AUC @TeX{} will ignore files name @file{.}, @file{..}, -@file{SCCS}, @file{RCS}, and @file{CVS}. - -@defopt TeX-ignore-file -Regular expression matching file names to ignore. - -These files or directories will not be considered when searching for -@TeX{} files in a directory. -@end defopt - -@node Automatic Global, Automatic Private, Automatic, Automatic -@section Automatic Customization for the Site -@cindex Global style hook directory -@cindex Global macro directory -@cindex Site macro directory -@cindex Global @TeX{} macro directory -@cindex Site @TeX{} macro directory -@cindex Global directories -@cindex Site information - -Assuming that the automatic customization at the global level was done -when AUC @TeX{} was installed, your choice is now: will you use it? If -you use it, you will benefit by having access to all the symbols and -environments available for completion purposes. The drawback is slower -load time when you edit a new file and perhaps too many confusing -symbols when you try to do a completion. - -You can disable the automatic generated global style hooks by setting -the variable @code{TeX-auto-global} to nil. - -@defopt TeX-macro-global -Directories containing the site's @TeX{} style files. -@end defopt - -@defopt TeX-style-global -Directory containing hand generated @TeX{} information. -Must end with a slash. - -These correspond to @TeX{} macros shared by all users of a site. -@end defopt - -@defopt TeX-auto-global -Directory containing automatically generated information. - -For storing automatic extracted information about the @TeX{} macros -shared by all users of a site. -@end defopt - -@node Automatic Private, Automatic Local, Automatic Global, Automatic -@section Automatic Customization for a User -@cindex Private style hook directory -@cindex Private macro directory -@cindex Personal macro directory -@cindex Private @TeX{} macro directory -@cindex Personal @TeX{} macro directory -@cindex Private directories -@cindex Personal information - -You should specify where you store your private @TeX{} macros, so AUC -@TeX{} can extract their information. The extracted information will go -to the directories listed in @code{TeX-auto-private} - -Use @kbd{M-x TeX-auto-generate} to extract the information. - -@defopt TeX-macro-private -Directories where you store your personal @TeX{} macros. -Each must end with a slash. - -This defaults to the directories listed in the @samp{TEXINPUTS} and -@samp{BIBINPUTS} environment variables. -@end defopt - -@defopt TeX-auto-private -List of directories containing automatically generated information. -Must end with a slash. - -These correspond to the personal @TeX{} macros. -@end defopt - -@deffn Command TeX-auto-generate @var{TEX} @var{AUTO} -(@kbd{M-x TeX-auto-generate}) Generate style hook for @var{TEX} and -store it in @var{AUTO}. If @var{TEX} is a directory, generate style -hooks for all files in the directory.@refill -@end deffn - -@defopt TeX-style-private -List of directories containing hand generated information. -Must end with a slash. - -These correspond to the personal @TeX{} macros. -@end defopt - -@node Automatic Local, , Automatic Private, Automatic -@section Automatic Customization for a Directory -@cindex Local style hooks -@cindex Updating style hooks -@cindex Automatic updating style hooks -@cindex Local style hooks -@cindex Local style directory - -AUC @TeX{} can update the style information about a file each time you -save it, and it will do this if the directory @code{TeX-auto-local} -exist. @code{TeX-auto-local} is by default set to @samp{"auto/"}, so -simply creating an @file{auto} directory will enable automatic saving of -style information. - -The advantage of doing this is that macros, labels, etc. defined in any -file in a multifile document will be known in all the files in the -document. The disadvantage is that saving will be slower. To disable, -set @code{TeX-auto-local} to nil. - -@defopt TeX-style-local -Directory containing hand generated @TeX{} information. -Must end with a slash. - -These correspond to @TeX{} macros found in the current directory. -@end defopt - -@defopt TeX-auto-local -Directory containing automatically generated @TeX{} information. -Must end with a slash. - -These correspond to @TeX{} macros found in the current directory. -@end defopt - -@node Style Files, Installation, Automatic, top -@chapter Writing Your own Style Support -@cindex Style files -@cindex Style hooks -@cindex @file{style} - -@xref{Automatic} for a discussion about automatically generated global, -private, and local style files. The hand generated style files are -equivalent, except that they by default are found in @file{style} -directories instead of @file{auto} directories. - -@menu -* Simple Style:: A Simple Style File -* Adding Macros:: Adding Support for Macros -* Adding Environments:: Adding Support for Environments -* Adding Other:: Adding Other Information -* Hacking the Parser:: Automatic Extraction of New Things -@end menu - -If you write some useful support for a public @TeX{} style file, please -send it to us. - -@node Simple Style, Adding Macros, Style Files, Style Files -@section A Simple Style File -@cindex @file{book.el} -@cindex Sample style file -@cindex Style file -@cindex Example of a style file. -@cindex Style hook -@cindex Adding a style hook - -Here is a simple example of a style file. - -@lisp -;;; book.el - Special code for book style. - -(TeX-add-style-hook "book" - (function (lambda () (setq LaTeX-largest-level - (LaTeX-section-level ("chapter")))))) - -@end lisp - -This file specifies that the largest kind of section in a LaTeX document -using the book document style is chapter. The interesting thing to -notice is that the style file defines an (anonymous) function, and adds it -to the list of loaded style hooks by calling @code{TeX-add-style-hook}. - -The first time the user indirectly tries to access some style specific -information, such as the largest sectioning command available, the style -hooks for all files directly or indirectly read by the current document -is executed. The actual files will only be evaluated once, but the -hooks will be called for each buffer using the style file. - -@defun TeX-add-style-hook @var{style} @var{hook} -Add @var{hook} to the list of functions to run when we use the @TeX{} -file @var{style}. -@end defun - -@node Adding Macros, Adding Environments, Simple Style, Style Files -@section Adding Support for Macros -@cindex Adding macros -@cindex Macros, adding -@cindex Defining macros in style hooks - -The most common thing to define in a style hook is new symbols (@TeX{} -macros). Most likely along with a description of the arguments to the -function, since the symbol itself can be defined automatically. - -Here are a few examples from @file{latex.el}. - -@lisp -(TeX-add-style-hook "latex" - (function - (lambda () - (TeX-add-symbols - '("arabic" TeX-arg-counter) - '("label" TeX-arg-define-label) - '("ref" TeX-arg-label) - '("newcommand" TeX-arg-define-macro [ "Number of arguments" ] t) - '("newtheorem" TeX-arg-define-environment - [ TeX-arg-environment "Numbered like" ] - t [ TeX-arg-counter "Within counter" ]))))) -@end lisp - -@defun TeX-add-symbols @var{symbol} @dots{} -Add each @var{symbol} to the list of known symbols. -@end defun - -Each argument to @code{TeX-add-symbols} is a list describing one symbol. -The head of the list is the name of the symbol, the remaining elements -describe each argument. - -If there are no additional elements, the symbol will be inserted with -point inside braces. Otherwise, each argument of this function should -match an argument of the @TeX{} macro. What is done depends on the argument -type. - -If a macro is defined multiple times, AUC @TeX{} will chose the one with -the longest definition (i.e. the one with the most arguments). - -Thus, to overwrite -@example - '("tref" 1) ; one argument -@end example -you can specify -@example - '("tref" TeX-arg-label ignore) ; two arguments -@end example - -@code{ignore} is a function that does not do anything, so when you -insert a @samp{tref} you will be prompted for a label and no more. - -@table @code -@item string -Use the string as a prompt to prompt for the argument. - -@item number -Insert that many braces, leave point inside the first. - -@item nil -Insert empty braces. - -@item t -Insert empty braces, leave point between the braces. - -@item other symbols -Call the symbol as a function. You can define your -own hook, or use one of the predefined argument hooks. - -@item list -If the car is a string, insert it as a prompt and the next -element as initial input. Otherwise, call the car of the list with -the remaining elements as arguments. - -@item vector -Optional argument. If it has more than one element, parse it -as a list, otherwise parse the only element as above. Use square -brackets instead of curly braces, and is not inserted on empty user -input. -@end table - -A lot of argument hooks have already been defined. The first argument to -all hooks is a flag indicating if it is an optional argument. It is up -to the hook to determine what to do with the remaining arguments, if -any. Typically the next argument is used to overwrite the default -prompt. - -@ftable @code -@item TeX-arg-conditional -Implements if EXPR THEN ELSE. If EXPR evaluates to true, parse THEN as an -argument list, else parse ELSE as an argument list. - -@item TeX-arg-literal -Insert its arguments into the buffer. Used for specifying extra syntax -for a macro. - -@item TeX-arg-free -Parse its arguments but use no braces when they are inserted. - -@item TeX-arg-eval -Evaluate arguments and insert the result in the buffer. - -@item TeX-arg-file -Prompt for a tex or sty filename, and use it without the extension. Run -the file hooks defined for it. - -@item TeX-arg-label -Prompt for a label completing with known labels. - -@item TeX-arg-macro -Prompt for a @TeX{} macro with completion. - -@item TeX-arg-environment -Prompt for a La@TeX{} environment with completion. - -@item TeX-arg-cite -Prompt for a Bib@TeX{} citation. - -@item TeX-arg-counter -Prompt for a La@TeX{} counter. - -@item TeX-arg-savebox -Prompt for a La@TeX{} savebox. - -@item TeX-arg-file -Prompt for a filename in the current directory, and use it without the -extension. - -@item TeX-arg-input-file -Prompt for a filename in the current directory, and use it without the -extension. Run the style hooks for the file. - -@item TeX-arg-define-label -Prompt for a label completing with known labels. Add label to list of -defined labels. - -@item TeX-arg-define-macro -Prompt for a @TeX{} macro with completion. Add macro to list of defined -macros. - -@item TeX-arg-define-environment -Prompt for a La@TeX{} environment with completion. Add environment to -list of defined environments. - -@item TeX-arg-define-cite -Prompt for a Bib@TeX{} citation. - -@item TeX-arg-define-counter -Prompt for a La@TeX{} counter. - -@item TeX-arg-define-savebox -Prompt for a La@TeX{} savebox. - -@item TeX-arg-corner -Prompt for a La@TeX{} side or corner position with completion. - -@item TeX-arg-lr -Prompt for a La@TeX{} side with completion. - -@item TeX-arg-tb -Prompt for a La@TeX{} side with completion. - -@item TeX-arg-pagestyle -Prompt for a La@TeX{} pagestyle with completion. - -@item TeX-arg-verb -Prompt for delimiter and text. - -@item TeX-arg-pair -Insert a pair of numbers, use arguments for prompt. The numbers are -surrounded by parentheses and separated with a comma. - -@item TeX-arg-size -Insert width and height as a pair. No arguments. - -@item TeX-arg-coordinate -Insert x and y coordinates as a pair. No arguments. -@end ftable - -If you add new hooks, you can assume that point is placed directly after -the previous argument, or after the macro name if this is the first -argument. Please leave point located after the argument you are -inserting. If you want point to be located somewhere else after all -hooks have been processed, set the value of @code{exit-mark}. It will -point nowhere, until the argument hook sets it.@refill - -@node Adding Environments, Adding Other, Adding Macros, Style Files -@section Adding Support for Environments -@cindex Adding environments -@cindex Environments, adding -@cindex Defining environments in style hooks - -Adding support for environments is very much like adding support for -@TeX{} macros, except that each environment normally only takes one -argument, an environment hook. The example is again a short version of -@file{latex.el}. - -@lisp -(TeX-add-style-hook "latex" - (function - (lambda () - (LaTeX-add-environments - '("document" LaTeX-env-document) - '("enumerate" LaTeX-env-item) - '("itemize" LaTeX-env-item) - '("list" LaTeX-env-list))))) -@end lisp - -@findex LaTeX-env-item -The only hook that is generally useful is @code{LaTeX-env-item}, which is -used for environments that contain items. It is completely up to the -environment hook to insert the environment, but the function -@code{LaTeX-insert-environment} may be of some help. The hook will be -called with the name of the environment as its first argument, and extra -arguments can be provided by adding them to a list after the hook. - -For simple environments with arguments, for example defined with -@samp{\newenvironment}, you can make AUC @TeX{} prompt for the arguments -by giving the prompt strings in the call to -@code{LaTeX-add-environments}. For example, if you have defined a -@code{loop} environment with the three arguments @var{from}, @var{to}, -and @var{step}, you can add support for them in a style file. - -@example -%% loop.sty - -\newenvironment@{loop@}[3]@{...@}@{...@} -@end example - -@lisp -;; loop.el - -(TeX-add-style-hook "loop" - (function - (lambda () - (LaTeX-add-environments - '("loop" "From" "To" "Step"))))) -@end lisp - -If an environment is defined multiple times, AUC @TeX{} will chose the -one with the longest definition. Thus, if you have an enumerate style -file, and want it to replace the standard La@TeX{} enumerate hook above, -you could define an @file{enumerate.el} file as follows, and place it in -the appropriate style directory. - -@lisp -(TeX-add-style-hook "latex" - (function - (lambda () - (LaTeX-add-environments - '("enumerate" LaTeX-env-enumerate foo))))) - -(defun LaTeX-env-enumerate (environment &optional ignore) ...) -@end lisp - -The symbol @code{foo} will be passed to @code{LaTeX-env-enumerate} as -the second argument, but since we only added it to overwrite the -definition in @file{latex.el} it is just ignored. - -@defun LaTeX-add-environments @var{env} @dots{} -Add each @var{env} to list of loaded environments. -@end defun - -@defun LaTeX-insert-environment @var{env} [ @var{extra} ] -Insert environment of type @var{env}, with optional argument @var{extra}. -@end defun - -@node Adding Other, Hacking the Parser, Adding Environments, Style Files -@section Adding Other Information -@cindex Adding bibliographies -@cindex Bibliographies, adding -@cindex Defining bibliographies in style hooks -@cindex Adding labels -@cindex Labels, adding -@cindex Defining labels in style hooks -@cindex Adding other information -@cindex Other information, adding -@cindex Defining other information in style hooks - -You can also specify bibliographical databases and labels in the style -file. This is probably of little use, since this information will -usually be automatically generated from the @TeX{} file anyway. - -@defun LaTeX-add-bibliographies @var{bibliography} @dots{} -Add each @var{bibliography} to list of loaded bibliographies. -@end defun - -@defun LaTeX-add-labels @var{label} @dots{} -Add each @var{label} to the list of known labels. -@end defun - -@node Hacking the Parser, , Adding Other, Style Files -@section Automatic Extraction of New Things -@cindex Parsing new macros -@cindex @file{macro.tex} -@cindex @file{macro.el} -@cindex Changing the parser - -The automatic @TeX{} information extractor works by searching for -regular expressions in the @TeX{} files, and storing the matched -information. You can add support for new constructs to the parser, -something that is needed when you add new commands to define symbols. - -For example, in the file @file{macro.tex} I define the following macro. - -@example -\newcommand@{\newmacro@}[5]@{% -\def#1@{#3\index@{#4@@#5~cite@{#4@}@}\nocite@{#4@}@}% -\def#2@{#5\index@{#4@@#5~cite@{#4@}@}\nocite@{#4@}@}% -@} -@end example - -AUC @TeX{} will automatically figure out that @samp{newmacro} is a macro -that takes five arguments. However, it is not smart enough to -automatically see that each time we use the macro, two new macros are -defined. We can specify this information in a style hook file. - -@lisp -;;; macro.el - Special code for my own macro file. - -;;; Code: - -(defvar TeX-newmacro-regexp - '("\\\\newmacro@{\\\\\\([a-zA-Z]+\\)@}@{\\\\\\([a-zA-Z]+\\)@}" - (1 2) TeX-auto-multi) - "Matches \newmacro definitions.") - -(defvar TeX-auto-multi nil - "Temporary for parsing \\newmacro definitions.") - -(defun TeX-macro-cleanup () - ;; Move symbols from `TeX-auto-multi' to `TeX-auto-symbol'. - (mapcar (function (lambda (list) - (mapcar (function (lambda (symbol) - (setq TeX-auto-symbol - (cons symbol TeX-auto-symbol)))) - list))) - TeX-auto-multi)) - -(defun TeX-macro-prepare () - ;; Clear `Tex-auto-multi' before use. - (setq TeX-auto-multi nil)) - -(add-hook 'TeX-auto-prepare-hook 'TeX-macro-prepare) -(add-hook 'TeX-auto-cleanup-hook 'TeX-macro-cleanup) - -(TeX-add-style-hook "macro" - (function - (lambda () - (TeX-auto-add-regexp TeX-newmacro-regexp) - (TeX-add-symbols '("newmacro" - TeX-arg-macro - (TeX-arg-macro "Capitalized macro: \\") - t - "BibTeX entry: " - nil))))) - -;;; macro.el ends here -@end lisp - -When this file is first loaded, it adds a new entry to -@code{TeX-newmacro-regexp}, and defines a function to be called before -the parsing starts, and one to be called after the parsing is done. It -also declares a variable to contain the data collected during parsing. -Finally, it adds a style hook which describes the @samp{newmacro} macro, -as we have seen it before. - -So the general strategy is: Add a new entry to @code{TeX-newmacro-regexp}. -Declare a variable to contain intermediate data during parsing. Add hook -to be called before and after parsing. In this case, the hook before -parsing just initializes the variable, and the hook after parsing -collects the data from the variable, and adds them to the list of symbols -found. - -@defvar TeX-auto-regexp-list -List of regular expressions matching @TeX{} macro definitions. - -The list has the following format ((REGEXP MATCH TABLE) @dots{}), that -is, each entry is a list with three elements. - -REGEXP. Regular expression matching the macro we want to parse. - -MATCH. A number or list of numbers, each representing one -parenthesized subexpression matched by REGEXP. - -TABLE. The symbol table to store the data. This can be a function, in -which case the function is called with the argument MATCH. Use -@code{TeX-match-buffer} to get match data. If it is not a function, it -is presumed to be the name of a variable containing a list of match -data. The matched data (a string if MATCH is a number, a list of -strings if MATCH is a list of numbers) is put in front of the table. -@end defvar - -@defvar TeX-auto-prepare-hook nil -List of functions to be called before parsing a @TeX{} file. -@end defvar - -@defvar TeX-auto-cleanup-hook nil -List of functions to be called after parsing a @TeX{} file. -@end defvar - -@node Installation, History, Style Files, top -@include install.texi - -@node History, Projects, Installation, top -@comment node-name, next, previous, up -@appendix The History of AUC @TeX{} - -See the file @file{history.texi} for older changes. - -@include changes.texi - -@node Projects, Credit, History, top -@comment node-name, next, previous, up -@appendix Wishlist - -This is a list of projects for AUC @TeX{}. Bug reports and requests we -can not fix or honor right away will be added to this list. If you have -some time for emacs lisp hacking, you are encouraged to try to provide a -solution to one of the following problems. It might be a good idea to -mail me first, though. - -@itemize @bullet -@item - -Filling messes up comments, but only at the end of the file. Reported -by uergen Reiss . -@item -@kbd{C-c C-q C-e} doesn't work properly on nested itemize environments. -Reported by "Robert B. Love" . - -@item -One suggestion for AUC-TeX: I think that the font command C-c C-f C-r, -which produces \textrm@{@} in a LaTeX file, should instead produce -either \textrm@{@} or \mathrm@{@}, depending on whether one is in math -mode or not. --- John Palmieri - -@item -A way to add and overwrite math mode entries in style files, and to -decide where they should be. Suggested by Remo Badii . - -@item -Create template for (first) line of tabular environment. - -@item -I think prompting for the master is the intended behaviour. It -corresponds to a `shared' value for TeX-master. - -There should probably be a `none' value which wouldn't query for the -master, but instead disable all features that relies on TeX-master. - -This default value for TeX-master could then be controled with mapping -based on the extension. - -@item -@kbd{C-c '} should alway stay in the current window, also when it find a -new file. - -@item -@code{LaTeX-fill-environment} does not indent the closing @samp{\end}. - -@item -Rewrite @file{ltx-help.el} and put it in @file{latex.el}. Fix also: -@example -From: Denby Wong - - 1) change documentation regarding where to get the - latest version (at CTAN at pip.shsu.edu for me) - under info/latex2e-help-texinfo/ - - 2) change or provide choice over which version to - use. There are three references to the info - node "(latex)" in the file which should be - "(latex2e)" for the new file. - -From: Piet van Oostrum - -One of the annoying things of latex-help is that if you ask for \LARGE, you -get \large if you have case-fold-search=t. This is really info's problem as -it doesn't reset it for a search of the node, but it would be easy to stick -a (let (case-fold-search) in latex-help. -@end example - -@item -It should be possible to insert a default preamble containing -e.g. @code{usepackage} declarations, perhaps depending on the document -class. - -@item -Multiple argument completion for @samp{\bibliography}. In general, I -ought to make @kbd{,} special for these kind of completions. - -@item -Do not overwrite emacs warnings about existing auto-save files when -loading a new file. - -@item -Suggest @samp{makindex} when appropriate. - -@item -Maybe the regexp for matching a TeX symbol during parsing should be -@samp{"\\\\\\([a-zA-Z]+\\|.\\)"} --- -@samp{} Peter Thiemann. - -@item -AUC TeX should be able to parse La@TeX{}2e @file{.cls} files. Here are -the regexps by @samp{} Peter -Thiemann. - -@example - ("\\\\DeclareRobustCommand@{?\\\\\\([a-zA-Z]+\\)@}?\\[\\([0-9]+\\)\\]\ -\\[\\([^\]\\\\\n\r]+\\)\\]" - (1 2 3) LaTeX-auto-optional) - ("\\\\DeclareRobustCommand@{?\\\\\\([a-zA-Z]+\\)@}?\\[\\([0-9]+\\)\\]" - (1 2) LaTeX-auto-arguments) - ("\\\\DeclareRobustCommand@{?\\\\\\([a-zA-Z]+\\)@}?" 1 TeX-auto-symbol) - ("\\\\DeclareFixedFont@{?\\\\\\([a-zA-Z]+\\)@}?" - 1 TeX-auto-symbol) - ("\\\\Declare\\(Text\\|Old\\)FontCommand@{?\\\\\\([a-zA-Z]+\\)@}?" - 2 TeX-auto-symbol) - ("\\\\DeclareMath\\(Symbol\\|Delimiter\\|Accent\\|Radical\\)@{?\\\\\\([a-zA-Z]+\\)@}?" - 2 TeX-auto-symbol) - ;;; it is also valid to declare just a single symbol, e.g. <, - ;;; with \DeclareMathSymbol but it is not necessary to register that here - ("\\\\DeclareText\\(Command\\|Symbol\\|Accent\\|Composite\\)@{?\\\\\\([a-zA-Z]+\\)@}?" - 2 TeX-auto-symbol) -@end example - -@item -Use index files (when available) to speed up @kbd{C-c C-m include -@key{RET}}. - -@item -Option not to calculate very slow completions like for -@kbd{C-c C-m include @key{RET}}.@refill - -@item -AUC @TeX{} should not parse verbatim environments. - -@item -Font menu should be created from @code{TeX-font-list}. - -@item -Installation procedure written purely in emacs lisp. - -@item -Format La@TeX{} comment blocks. - -@item -Included PostScript files should also be counted as part of the -document. - -@item -The argument to @samp{\verb} may be broken when filling if it contains a -space. This should be fixed or documented. Suggested by several -people. - -@item -The parser should catch warnings about undefined crossreferences. -Suggested by Richard Hirsch @samp{i3080501@@ws.rz.tu-bs.de}. - -@item -A nice hierarchical by-topic organization of all officially documented -LaTeX macros, available from the menu bar. - -@item -Make @samp{`} check for math context in @code{LaTeX-math-mode}. and -simply self insert if not in a math context. - -@item -Make @code{TeX-insert-dollar} more robust. Currently it can be fooled -by @samp{\mbox}'es and escaped double dollar for example. - -@item -La@TeX{} formatting should skip @code{verbatim} environments. - -@item -@code{TeX-command-default} should be set from the master file, if not -set locally. Suggested by Peter Whaite @samp{}. - -@item -Make AUC @TeX{} work with @samp{crypt++}. Suggested by Chris Moore -@samp{}. - -@item -Fix bug with @code{TeX-show-environment} from hidden document -environment. - -@item -Function to check if you are in math mode (between two dollar signs). -Suggested by Jan Erik Odegard @samp{} - -@item -The @samp{Spell} command should apply to all files in a document. Maybe -it could try to restrict to files that have been modified since last -spell check? Suggested by Ravinder Bhumbla @samp{}. - -@item -Make @key{.} check for abbreviations and sentences ending with capital -letters. - -@item -Use Emacs 19 minibuffer history to choose between previewers, and other -stuff. Suggested by John Interrante -@samp{}. - -@item -Make features. - -A new command @code{TeX-update} (@kbd{C-c C-u}) could be used to create -an up-to-date dvi file by repeatedly running Bib@TeX{}, MakeIndex and -(La)@TeX{}, until an error occurs or we are done. - -An alternative is to have an @samp{Update} command that ensures the -@samp{dvi} file is up to date. This could be called before printing and -previewing. - -@item -Documentation of variables that can be set in a style hook. - -We need a list of what can safely be done in an ordinary style hook. -You can not set a variable that AUC TeX depends on, unless AUC TeX knows -that it has to run the style hooks first. - -Here is the start of such a list. -@table @code - -@item LaTeX-add-environments - -@item TeX-add-symbols - -@item LaTeX-add-labels - -@item LaTeX-add-bibliographies - -@item LaTeX-largest-level - -@end table - -@item -Correct indentation for tabular, tabbing, table, math, and array -environments. - -@item -Optional special indentation after an @samp{\item}. - -@example -\begin@{itemize@} -\item blabalaskdfjlas lajf adf - lkfjl af jasl lkf jlsdf jlf -\item f lk jldjf lajflkas flf af -\end@{itemize@} -@end example - -@item -Completion for counters and sboxes. - -@item -Outline should be (better) supported in @TeX{} mode. - -At least, support headers, trailers, as well as TeX-outline-extra. - -@item -@code{TeX-header-start} and @code{TeX-trailer-end}. - -We might want these, just for fun (and outlines) - -@item -Plain @TeX{} and La@TeX{} specific header and trailer expressions. - -We should have a way to globally specify the default value of the header -and trailer regexps. - -@item -Add support for original @code{TeX-mode} keybindings. - -A third initialization file (@file{tex-mode.el}) containing an emulator -of the standard @code{TeX-mode} would help convince some people to -change to AUC @TeX{}.@refill - -@item -Make @code{TeX-next-error} parse ahead and store the results in a list, -using markers to remember buffer positions in order to be more robust -with regard to line numbers and changed files. This is what -@code{next-error} does. (Or did, until Emacs 19). - -@item -When @code{LaTeX-environment} is given an argument, change the current -environment. Be smart about @samp{\item[]} versus @samp{\item } and -labels like @samp{fig:} versus @samp{tab:}. - -@item -Check out if lightning completion from Ultra @TeX{} is anything for us. - -@item -Finish the @TeX{}info mode. For one thing, many @TeX{}info mode -commands do not accept braces around their arguments. - -@item -BibTeX mode. - -@item -Support for AMSLaTeX style files. - -@item -Hook up the letter environment with `bbdb.el'. - -@item -Make the letter environment hook produce `documentstyle' too. - -@end itemize - -@node Credit, Key Index, Projects, top -@comment node-name, next, previous, up -@appendix Credit - -A big smile and thanks should go to all the folks who cheered me up, -during the long hours of programming@dots{} sorry folks, but I can't help -including the list below, of comments I've got@dots{} - -Kresten Krab Thorup - -@table @samp -@item -I'd like to say that I'm very much enjoying using auc-tex. Thanks for -the great package! -@item -I really enjoy working with auc-tex. -@item -Thanks for your great package. It's indispensable now! Thanks! -@item -Thanks for your time and for what appears to be a great and useful -package. Thanks again -@item -Thanks for providing auc-tex. -@item -I really enjoy using the new emacs TeX-mode you wrote. I think you did -a great job. -@item -I am having fun with auc-tex already. -@item -Thanks for your work on auc-tex, especially the math-minor mode. -@item -I like your auc-tex elisp package for writing LaTeX files - I am -especially impressed by the help with error correction. -@item -Thanks so much! -@item -I >really< like the macro, particularly the hooks for previewing and the -error parsing! -@item -All in all I am pleased with your package. Thanks a lot. -@end table - -@node Key Index, Function Index, Credit, top -@comment node-name, next, previous, up -@unnumbered Key Index - -@printindex ky - -@node Function Index, Variable Index, Key Index, top -@comment node-name, next, previous, up -@unnumbered Function Index - -@printindex fn - -@node Variable Index, Concept Index, Function Index, top -@comment node-name, next, previous, up -@unnumbered Variable Index - -@printindex vr - -@node Concept Index, , Variable Index, top -@comment node-name, next, previous, up -@unnumbered Concept Index - -@printindex cp - -@summarycontents -@contents -@bye - - diff -r 6866abce6aaf -r 6075d714658b man/auctex/changes.texi --- a/man/auctex/changes.texi Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,9 +0,0 @@ -@section News in 9.7 - -@itemize @bullet -@item -Added minimal support for @code{sentence-end-double-space}. - -@end itemize - - diff -r 6866abce6aaf -r 6075d714658b man/auctex/history.texi --- a/man/auctex/history.texi Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1682 +0,0 @@ -@section News in 9.6 - -@itemize @bullet -@item -NT installation instructions added. - -@item -@file{func-doc.el} unbundled, as @file{word-help.el} will be added to -the standard Emacs distribution. See @url{http://www.ifi.uio.no/~jensthi/}. - -@item -@samp{$} is now of the syntax class `matched pair', suggested by Mats -Bengtsson @samp{}. - -@item -Now use @kbd{,} to enter multiple arguments to a @samp{\cite} or -@samp{\bibliography} command instead of @kbd{@key{ret}}. - -@item -Installation procedure is changed, read the @file{INSTALLATION} file. - -@item -LaCheck is unbundled. You can get @code{lacheck} from -@file{} or alternatively -@code{chktex} from -@file{}. Search for -`chktex' in @file{tex.el} to see how to switch between them.@refill - -@item -Insert @code{(require 'font-latex)} to get better font lock support. - -@item -Bug fixes. - -@item -Better handling of subdirectories, suggested by Frederic Devernay - and many others. -@end itemize - -@section News in 9.5 - -@itemize @bullet -@item Use the @file{func-doc.el} package to get context senstive help. -This is not autoloaded, you must load it explicitly with: - -@lisp -(require 'func-doc) -@end lisp - -@item -Bug fixes. - -@end itemize - -@section News in 9.4 - -@itemize @bullet -@item There is now a menu in @code{LaTeX-math-minor-mode}. - -@item -Bug fixes. -@end itemize - -@section News in 9.3 - -@itemize @bullet -@item -Bug fixes. -@end itemize - -@section News in 9.2 - -@itemize @bullet -@item -Bug fixes. - -@item -New file @file{bib-cite.el} contributed by Peter S. Galbraith -@samp{}. This file is not installed -or enabled by default and is not part of the basic AUC @TeX{} -package. If you have problems, questions, or suggestions, please direct -them to Peter. - -@item -New file @file{hilit-LaTeX.el} contributed by Peter S. Galbraith -@samp{}. This file is not installed -or enabled by default and is not part of the basic AUC @TeX{} -package. If you have problems, questions, or suggestions, please direct -them to Peter. - -@item -AUC @TeX{} is now less likely to suggest running Bib@TeX{} when it is -not needed. - -@item -Press @kbd{M-x LaTeX-209-to-2e @key{ret}} to make a stab at converting a -La@TeX{} 2.09 header to La@TeX{}2e. - -@item -@kbd{C-c C-m input @key{ret}} should be faster now on second try. - -@item -New variable @code{LaTeX-left-right-indent-level} controls the -indentation added by @samp{\left}. - -@item -@samp{\begin}, @samp{\end}, @samp{\left}, and @samp{\right} no longer -need to be at the beginning of the line to take effect. - -@item -You can now delete and replace La@TeX{}2e style fonts. - -@item -Moved external commands to new menu. - -@item -@kbd{C-c C-m cite @key{ret}} will prompt for multiple keys. - -@item -Better handling of @samp{"} with @file{german.sty}. - -@item -New variable @code{LaTeX-paragraph-commands} lists La@TeX{} commands -that shouldn't be formatted as part of a paragraph. - -@item -Older news moved to @file{HISTORY}. It is not @TeX{}info able, but you -can get a plaintext version with @samp{make HISTORY}. - -@item -See the new @file{ChangeLog} file for a more detailed list of changes. -The history section will now only contain user level changes. If you -send me a patch, please also provide a ChangeLog entry. -@end itemize - -@node Version 9.1, Version 9.0, Version 9.2, History -@section News in 9.1 - -Coordinater: Per Abrahamsen, 1994. - -Alpha testers (in order of appearance): -Bernt Guldbrandtsen @samp{}, -Kevin Scott @samp{}, -Lawrence R. Dodd @samp{}, -Michelangelo Grigni @samp{}, -David Aspinall @samp{}, -Frederic Devernay @samp{}, -Robert Estes @samp{}, -Peter Whaite @samp{}, -Karl Eichwalder @samp{}, -John Interrante @samp{}, -James A. Robinson @samp{}, -Tim Carlson @samp{}, -Michelangelo Grigni @samp{}, -Manoj Srivastava @samp{}, -Richard Stanton @samp{}, -Kobayashi Shinji @samp{}, -and probably more.@refill - -@itemize @bullet -@item -La@TeX{}2e is now default. Set @code{LaTeX-version} to @samp{"2"} to -disable this. - -@item -Better handling of @samp{*TeX background*} buffer. Suggested by John -Interrante @samp{}. - -@item -Parser did not recognise the use of @samp{\def} to create La@TeX{} -environments. Reported by Frederic Devernay -@samp{}. - -@item -Minor cleanup in some error messages. - -@item -Fixed bug in @code{TeX-comment-paragraph} when called with a negative -argument. Reported by Markus Kramer @samp{}. - -@item -Don't move point in master file when running a command on the region in -an included file. Thanks to Karl Wilhelm Langenberger -@samp{} for the patch. - -@item -@code{LaTeX-math-mode} no longer works on Emacs 18 or older Lucid -versions. This change allowed me to unbundle @file{min-map.el}. - -@item -Made @kbd{C-c C-e} more robust, especially when applied on an empty -active region. Reported by Andrew Senior @samp{}. - -@item -@kbd{C-c C-m section RET} and @kbd{M-@key{tab}} should work now in -@TeX{}info mode. @kbd{C-c C-b} and @kbd{C-c C-r} removed, since they -did not work. Reported by Karl Eichwalder -@samp{}. - -@item -Made @kbd{M-q} skip block comments. Sugested by Peter Whaite -@samp{}. - -@item -Code cleanup: Renamed @samp{-format-} functions to @samp{-fill-}. - -@item -Made @kbd{,} and @kbd{.} remove any preceding italic correction. - -@item -Changes in math mode: @samp{setminus} moved to @key{\}, @samp{not} moved -to @key{/}, and @samp{wedge}, @samp{vee}, and @samp{neg} installed on -@key{&}, @kbd{|}, and @kbd{!} to make writing logic easier for C -programmers. - -@item -Renamed @file{auc-tex.el} to @file{auc-old.el} to make it less likely -that new users load it by mistake. - -@item -Changed name of @file{easymenu.el} to @file{auc-menu.el} to avoid -conflict with RMS's version. Updated it to handle the Lucid -@code{:keys} keyword argument. Defines a popup menu for both FSF and -Lucid emacs, although it is only installed in Lucid Emacs. Added David -Aspinall's @samp{} patch to handle an empty -menu bar under Lucid Emacs. The interface is still a superset of -@file{easymenu.el}. This version should no longer prevent the sharing -of byte compiled files between FSF and Lucid emacs. - -@item -Marking a section or environment now highlight it in Lucid Emacs. It -already worked in GNU Emacs. Thanks to Andreas Ernst -@samp{ernst_a@@maths.uwa.edu.au}. - -@item -Font support for La@TeX{}2e. Many people suggested this. -Automatically activated for all documents defined with -@samp{\documentclass}. - -@item -Outline support for La@TeX{}2e fixed by Robert Estes -@samp{}. - -@item -@samp{bibliography} macro now works. Thanks to Frederic Devernay -@samp{}. - -@item -Fixes to @file{psfig} support by Thomas Graichen -@samp{}. - -@item -Fixed position of @samp{\label} in environments. Reported by Richard -Stanton @samp{}. - -@item -Made the name of the AUC @TeX{} menu mode specific. - -@item -More reliable guesses with @kbd{C-c C-r}. Thanks to Lawrence R. Dodd -@samp{}. - -@item -Insert newline before inserting local variable section. Thanks to -Rajeev Gore' @samp{}. - -@item -Fixes to Japanese version. Thanks to Kobayashi Shinji -@samp{}. - -@item -Fixed bug in @samp{put} and @samp{multiput} macros. Thanks to Kobayashi -Shinji @samp{} and Masayuki Kuwada -. - -@item -Display number of pages after end of La@TeX{} compilation. Thanks to -Lawrence R. Dodd @samp{}. - -@item -Only update section and environment menus when the lists have changed. - -@item -New variables @code{LaTeX-header-end} and @code{LaTeX-trailer-start}. - -@item -Some Emacs 18 compatibility changes. Thanks to Fran E. Burstall -@samp{}. - -@item -Use nonrecursive function to determine the current environment. This -should solve problems with exceeding lisp max depth. Contributed by -David Aspinall @samp{}. - -@item -Fixed documentation for @kbd{` ~} in @file{math-ref.tex}. Thanks to -Morten Welinder @samp{}. - -@item -Made @code{LaTeX-math-mode} work better with FSF Emacs 19 in the case -where you press something undefined, in particular function keys. -Requested by several. - -@item -Inserting an itemize environment around the active region now insert the -first item inside the environment. Thanks to Berwin A. Turlach -@samp{} for reporting this. - -@item -Fixed bug in right button menu under Lucid. Reported by Frederic -Devernay @samp{}. -@end itemize - -@node Version 9.0, Version 8.0, Version 9.1, History -@section News in 9.0 - -Coordinator: Per Abrahamsen, 1994. - -Alpha testers (in order of appearance): -Volker Dobler @samp{}, -Piet van Oostrum @samp{}, -Frederic Devernay @samp{}, -Robert Estes @samp{}, -Berwin Turlach @samp{}, -Tim Carlson @samp{}, -Peter Thiemann @samp{}, -Kevin Scott @samp{}, -Lawrence R. Dodd @samp{}, -Johan Van Biesen @samp{}, -Marc Gemis @samp{}, -Michelangelo Grigni @samp{}, -Kevin Scott @samp{}, -Peter Paris @samp{}, -Peter Barth @samp{}, -Andy Piper @samp{}, -Richard Stanton @samp{}, -Christoph Wedler @samp{}, -Graham Gough @samp{}, -and probably more.@refill - -@itemize @bullet -@item -Fixed problem with @file{filladapt} defeating La@TeX{} mode's own -indentation algorithm. Thanks to Piet van Oostrum -@samp{}. - -@item -Made environments and sections selectable from the menu bar. - -@item -Support Emacs comment conventions. Comments starting with a single -@samp{%} are indented at @code{comment-column}. Comments starting with -@samp{%%%} are indented at column 0. Comments starting with -@samp{%%} are indented like ordinary text. You can set the variables -@code{LaTeX-right-comment-regexp} and @code{LaTeX-left-comment-regexp} -to nil to disable this. See also @code{LaTeX-ignore-comment-regexp}. -Rewrote it from Christoph Wedler @samp{} from -original code. - -@item -@key{tab} and @key{lfd} will not indent code in @samp{verbatim} -environment if you set @code{LaTeX-indent-environment-check} to non-nil. -This was also first implemented by Christoph Wedler -@samp{}. - -@item -You can now get get custom indentation for various environments. See -@code{LaTeX-indent-environment-list}. - -@item -@kbd{C-c C-m left @key{ret}} new automatically inserts a matching -@samp{\right}. See variables @code{TeX-left-right-braces}, -@code{TeX-braces-default-association}, and -@code{TeX-braces-user-association}. This feature was suggested by Jesse -@samp{} and implemented by Berwin Turlach -@samp{}. - -@item -Don't automatically display the compilation buffer unless -@code{TeX-show-compilation} in non-nil. Suggested by Stefan Schoef -@samp{Stefan.Schoef@@arbi.informatik.uni-oldenburg.de}. - -@item -Bundled @file{ltx-help.el}. Press @kbd{C-h C-l} to get the -documentation for a LaTeX command. - -@item -Fixed indentation of @samp{\left} and @samp{\right}. Thanks to -Christoph Wedler @samp{}. - -@item -Installation procedure changed. @file{tex-site.el} is now intended to -survive AUC @TeX{} upgraded. The distribution version only contains -autoloads (eliminating the need for @file{tex-load.el} , the -customization variables are moved to @file{tex.el}. You should copy -those variables you need to customize from @file{tex.el} to -@file{tex-site.el}. - -@item -Made it possible to use absolute paths when including bibliographies or -style files. - -@item -Fixed problem with parsing errors after running La@TeX{} on the region -from the menu. Thanks to Peter Barth @samp{} for -finding this one. - -@item -The file @file{doc/ref-card.texi} has been renamed to -@file{doc/tex-ref.texi} to avoid confusion with the reference card for -GNU Emacs. Suggested by Michelangelo Grigni @samp{}. - -@item -The @file{README}, @file{CHANGES} and @file{INSTALLATION} files are now -generated from chapters of this manual, to ensure they stay in sync. - -@item -@kbd{M-@key{tab}} will now complete some macro arguments in addition to -macro names. In particular, if you press @kbd{M-@key{tab}} after -@samp{\cite@{} or @samp{\ref@{} you will get completion for bibitems and -labels, respectively. - -@item -Merged a number of files. The major files are now @file{tex.el} for -plain @TeX{} and common support, @file{tex-buf.el} for running external -commands, and @file{latex.el} for La@TeX{} support. - -@item -Unbundled @file{outln-18.el}. Users of Emacs 18 or Lucid Emacs 19.9 or -earlier must get @file{outln-18.el} and install it as @file{outline.el} -if they want the outline commands to work. - -@item -No longer bind @kbd{C-c @key{tab}} to @code{TeX-complete-symbol}. Use -@kbd{M-@key{tab}} instead. - -@item -Cleaned up the parser and parameterizedd it. Now you can add now types -of information to be maintained by the parser simply by calling -@code{TeX-auto-add-type}. You still need to install the regexps with -@code{TeX-auto-add-regexp}. - -@item -Disable the automatic insertion of empty braces after macros with no -arguments in @code{LaTeX-math-mode}. Added a variable -@code{TeX-insert-braces} to disable it everywhere. - -@item -Now complete with existing labels when asking for a label in a La@TeX{} -environment. Suggested by Berwin Turlach -@samp{}. - -@item -The variables @code{TeX-private-macro}, @code{TeX-private-auto}, and -@code{TeX-private-style} are now initialized from the @samp{TEXINPUTS} -and @samp{BIBINPUTS} environment variables. - -@item -@kbd{C-c C-f} and @kbd{C-c C-e} will now put the template around the -region if the region is active. - -@item -Fixed @kbd{C-u C-c C-e} to handle environments ending with a star -(@samp{*}). Reported by Berwin Turlach -@samp{}. - -@item -Don't use @code{with-output-to-temp-buffer} for compilation buffer. -Fixed by Frederic Devernay @samp{}. - -@item -New function @code{TeX-command-buffer} (@kbd{C-c C-b}) to run a command -on the (visible part of) the current buffer. Requested by several -people. - -@item -Bundled the latest @file{reporter.el}, added -@code{TeX-submit-bug-report} to menus. - -@item -@code{TeX-insert-braces} now takes an argument like -@code{insert-parentheses}. Thanks to Lawrence R. Dodd -@samp{}. - -@item -Fixed bug in @samp{\put} and @samp{\multiput} macros. Thanks to Kevin -Scott @samp{}. - -@item -Deleted @code{ams-latex-mode}, @code{slitex-mode}, and -@code{foiltex-mode}. Instead, use @code{LaTeX-command-style} to -determine the name of the external command to use. - -@item -Deleted @code{latex2e-mode}. Instead set the @code{LaTeX-version} -variable. This may be done automatically if you use -@samp{\documentclass} in the future. - -@item -Fixed Lucid Emacs menu for @TeX{}info mode. Thanks to Frederic Devernay -@samp{}, - -@item -Added support for @file{harvard.sty} by Berwin Turlach -@samp{}. - -@item -Filling will not let display math equations @samp{\[ ... \]} be on a -line by themselves. Reported by Matthew Morley -@samp{}. - -@item -Made @code{words-include-escapes} default to nil. - -@item -Made @code{TeX-expand-list} expansions case sensitive. Thanks to Havard -Rue @samp{}. - -@item -Fixed error in calculating indentation for lines starting with a brace. -Thanks to Piet van Oostrum @samp{}. - -@item -Fixed bug in the @samp{addcontentsline}, @samp{newtheorem}, and -@samp{pagenumbering} macros reported by Berwin Turlach -@samp{}. - -@item -Doc fixes by Lawrence R. Dodd @samp{}. - -@item -Indentation no longer fooled by @samp{\\@{}, Thanks to Peter Thiemann -@samp{}. - -@item -Bind @kbd{M-C-e} and @kbd{M-c-a} to @code{LaTeX-find-matching-end} and -@code{LaTeX-find-matching-begin}. Suggested by Lawrence R. Dodd -@samp{}. - -@item -Added variable @code{TeX-quote-after-quote} which causes -@code{TeX-insert-quote} to insert literal @samp{"} except when after -another @samp{"}, in which case it will expand to @code{TeX-open-quote} -or @code{TeX-close-quote}. This code was contributed by Piotr Filip -Sawicki @samp{}. - -@item -Added support for Polish style files @file{plfonts.sty} and -@file{plhb.sty}, contributed by Piotr Filip -Sawicki @samp{}. - -@item -Added section with suggestions for how to handle European -character sets. - -@item -Created workaround for bug in the regexp handler in some Emacs 18 -versions and older versions of Lucid Emacs. The workaround -means you cannot use space in the documentstyle command in Emacs and -Lucid Emacs earlier than version 19.9. - -@item -@file{powerkey.el} is removed since the functionality is integrated in -GNU Emacs - -@item -@kbd{C-u "} now inserts four literal @samp{"}, not just one. To insert -a single @samp{"} either press @key{"} twice or use @kbd{C-q "}. - -@item -Allow non-string value for @code{outline-minor-map-prefix}. Reported by -David Smith @samp{}. - -@item -Make the use of @code{write-file-hooks} more safe, and use -@code{local-write-file-hooks} when possible. Suggested by David Smith -@samp{}. - -@item -Don't indent @samp{\begin@{verbatim@}} and @samp{\end@{verbatim@}}, -since any space before @samp{\end@{verbatim@}} is significant. Thanks to -Peter Thiemann @samp{} for the -patch. - -@item -Show available fonts when you try to insert an non-existing font. -Suggested by David Smith @samp{}. - -@item -The @code{member} function in @file{tex-18.el} does not depend on -@code{TeX-member} now. Thanks to Piet van Oostrum -@samp{}. - -@item -Do not overwrite any global binding of @kbd{M-@kbd{ret}}. Suggested by -Jens Petersen @samp{}. - -@item -Major modes for writing text are supposed to rebind @kbd{M-@kbd{tab}} to -@code{ispell-complete-word}. Reported by Jens Petersen -@samp{}. - -@item -Fixed problems with @TeX{}info menus. Thanks to David Smith -@samp{} for reporting this. - -@item -Code cleanup. Removed the @file{format} directory, as it did not make -it easier to add new @TeX{} modes, quite the contrary. - -@item -Fixed name conflict in @file{auc-tex.el}, reported by Rik Faith -@samp{}. - -@item -Fixed some spelling errors. Thanks to Lawrence R. Dodd -@samp{}. - -@item -Fixed bug prohibiting non-standard file extensions. Now recognize -@file{.ltx} by default. Suggested by Lawrence R. Dodd -@samp{}. - -@item -Name of the AUC @TeX{} info files changes once again to be usable under -DOS. This time simply to @file{auctex}. - -@item -Documented @code{TeX-outline-extra}. - -@item -Could not select command on region from the menu before loading -@file{tex-buf}. Reported by Uwe Bonnes -@samp{}. - -@item -Make the hilit19 interface more robust. Thanks to William Dean Norris -II @samp{}. - -@item -More OS/2 Makefile fixes by Bodo Huckestein -@samp{}. - -@item -Reimplemented comment support on top of @code{comment-region}, giving -slightly different semantics. -@end itemize - - -@node Version 8.0, Version 7.3, Version 9.0, History -@comment node-name, next, previous, up -@section News in 8.0 - -Coordinator: Per Abrahamsen, 1993. - -Alpha testers (in order of appearance): Marc Gemis -@samp{}, Shinji Kobayashi -@samp{}, Philippe Defert -@samp{}, Richard Stanton -@samp{}, Norbert Kiesel -@samp{}, Roberto Cecchini -@samp{}, Hanno Wirth @samp{}, -Tim Carlson @samp{}, John Daschbach -@samp{}, Bob Fields -@samp{}, Peter Whaite -@samp{}, Volker Dobler -@samp{}, Phil Austin -@samp{}, Martin Maechler -@samp{}, Havard Rue -@samp{}, Tim Geisler -@samp{}, Tim Carlson -@samp{}, Sridhar Anandakrishnan -@samp{}, Peter Thiemann -@samp{}, Pedro Quaresma -@samp{}, Christian Lynbech -@samp{}, Kevin Scott -@samp{}, Bodo Huckestein -@samp{}, Cengiz Alaettinoglu -@samp{}, Jakob Schiotz -@samp{}, and probably more.@refill - -@itemize @bullet -@item -New variable @code{LaTeX-letter-sender-address} contains default address -for use with the letter style. Set it to the address of your -organization in @file{tex-site.el}. Thanks to Sridhar Anandakrishnan -@samp{}. - -@item -Makefile now works under OS/2 with GNU Make. Thanks to Bodo Huckestein -@samp{bodo@@eu10.mpi-hd.mpg.de}. - -@item -Made it possible to install global auto files without having Bib@TeX{} -mode installed. Thanks to Christian Lynbech -@samp{}. - -@item -Minor documentation fixes. Thanks to Martin Maechler -@samp{}. - -@item -Added support for @samp{eqref} for the @samp{amsart} style. Thanks to -Peter Whaite @samp{}. - -@item -Use @samp{-c} as the default shell command option under @samp{emx}. -Eberhard Mattes @samp{} says -it is better than @samp{/c}. - -@item -Made powerkey in the menus work better under OS/2. Thanks to Eberhard -Mattes @samp{}. - -@item -Made the reference cards print correctly on US letter format paper. -Thanks to Magnus Nordborg @samp{}. - -@item -@code{LaTeX-dead-mode} removed. Read the file `ISO-TEX' for alternative -solutions. - -@item -All minor modes unbundled. You can find them from ftp at -@samp{ftp.iesd.auc.dk} in the directory @file{/pub/emacs-lisp}. Removed -information about minor modes from this document. - -@item -New hooks for changing ispell directory, see @file{tex-site.el} for -details. - -@item -La@TeX{}2e mode now supported. Insert - -@lisp - (setq TeX-default-mode 'latex2e-mode) -@end lisp - -in your @file{.emacs} file to get documentclass instead of documentstyle -per default. The parser recognizes documentclass, usepackage, and -newcommand with a default argument. There are also templates for all of -them. - -@item -Added Jakob Schiotz's @samp{} help file for -installing AUC @TeX{} on OEMACS. It will probably also be of interest -for DEMACS users. - -@item -Minor changes to be more friendly for OEMACS, thanks to Jakob Schiotz -@samp{}. - -@item -The control key bindings in @code{LaTeX-math-mode} now works, thanks to -Frederic Devernay @samp{}. - -@item -La@TeX{} outlines no longer matches @samp{\partial} or other commands -with a sectioning command as prefix. Thanks to Jakob Schiotz -@samp{}. - -@item -@code{LaTeX-fill-paragraph} now handles the case where the previous line -both contain an @samp{\item} and an unmatched open brace. Thanks to -Piet van Oostrum @samp{}. - -@item -Use abbreviated file name for @TeX{} output buffers in Emacs 19. Thanks -to Jens Gustedt @samp{}. - -@item -Added lowercase alias for @code{LaTeX-math-mode} for use with Emacs file -mode commands. Thanks to Olaf Burkart -@samp{}. - -@item -Added code to reuse old region in @code{TeX-command-region} if mark is -not active. Thanks to Cengiz Alaettinoglu @samp{}. - -@item -Now get keyboard accelerators on all menus rather than only AUC @TeX{} -menus, thanks to the @file{powerkey.el} file by Lars Lindberg -@samp{}. - -@item -Added @code{TeX-electric-macro} for faster completion of @TeX{} macros. -@xref{Completion}. - -@item -Comparing printer names are now case incentive. Thanks to Richard -Stanton @samp{}. - -@item -Default shell fixed for OS/2. Thanks to Richard Stanton -@samp{}. - -@item -Added functions to hide (@code{LaTeX-hide-environment}) and show -(@code{LaTeX-show-environment}) the current environment. - -@item -@kbd{C-u C-c C-e} will now modify the current environment instead of -inserting a new environment. This is like the optional argument to the -font commands. - -@item -Added nabla to LaTeX Math Mode. Suggested by Bill Reynolds -@samp{}. - -@item -Added commands for running @TeX{} and La@TeX{} interactively. Thanks to -David Carlisle @samp{}. - -@item -The external commands will now insert there output @emph{before} point -in the output buffers. This allows you to follow the progress by -putting point at the end of the file. Suggested by Jak Kirman -@samp{}. - -@item -When invoking an external command from a menu, the document will be -automatically saved. - -@item -There are now a printer menu for emacs 19. - -@item -Redesigned dependency checking. Now only checks dependencies for files -loaded in the current emacs session. This is much faster, but will not -catch files that are edited outside this emacs session, or files edited -in killed buffers. @strong{@code{TeX-check-path} must at least contain -@file{.} for saving to work}. If you have set @samp{TeX-check-path} -in your @file{.emacs} file, remove it. The default value is fast enough -now. - -@item -New variable @code{TeX-save-query} control if AUC @TeX{} will query you -for each modified buffer when you save the document. Set it to nil to -get rid of these questions. Setting this variable also affect the -automatic saving of the document that happens each time you start an -external command. - -@item -New command @code{TeX-save-document} will save all files in the current -document, i.e. the document associated with the current buffer. - -@item -Cleaned up all minor modes, also made them use @file{min-map.el} or -@file{min-mode.el} instead of @file{min-bind.el}. - -@item -Cleaned up release management. - -@item -AUC TeX will not longer be confused when you rewrite a file under a new -name. - -@item -Lots of code cleanup, involving reformatting the source and renaming all -@samp{-hook} variables and functions to conform with the Emacs 19 -guidelines. - -@item -Can now parse Japanese characters in labels and macros when you use -Japanese @TeX{}. Thanks to Shinji Kobayashi -@samp{}. - -@item -Made it safe to quit when AUC @TeX{} asks for the name of the master -file. It will simply assume the file itself is the master, and continue -without inserting any file local variables. - -@item -Support for @code{epsf} and @code{psfig} style files. Thanks to Marc -Gemis @samp{}. - -@item -Support for La@TeX{}info. Thanks to Marc Gemis -@samp{}. - -@item -Only examine the first 10000 bytes to find out what @TeX{} mode to use. - -@item -Added @code{TeX-submit-bug-report} command to submit bug reports. It -uses the @file{reporter.el} distributed with SuperCite, so it may not be -available in some Emacs 18 installations. - -@item -Speeded up parsing significantly by using a simpler regexp. - -@item -Added variable @code{TeX-auto-untabify}. Set it to nil to prevent -untabifying the buffer when it is saved. Several people wanted this. - -@item -Changed defaults to @emph{not} do any automatic parsing, nor prompt for -a master file. @xref{Parsing Files}, @ref{Multifile}, for information -about how ot correct this. In short, insert the following in your -@file{.emacs} file. - -@lisp -(setq TeX-auto-save t) -(setq TeX-parse-self t) -(setq-default TeX-master nil) -@end lisp - -@item -Some grammatical fixes to the @file{PROBLEMS} file. Thanks to Lawrence -R. Dodd @samp{}. - -@item -No longer install a separate @code{outline-minor-mode} by default, as -the FSF Emacs 19.19 @code{outline-minor-mode} is adequate. The included -file @file{outln-18.el} emulates the FSF Emacs 19.19 mode under Emacs 18. - -The FSF Emacs 19.19 @code{outline-minor-mode} use the @kbd{C-c} prefix -instead of @kbd{C-c C-o} by default, and does not bind as many keys as -the @code{outline-minor-mode} distributed with earlier versions of AUC -@TeX{} did. You can get the keybindings back together with other -goodies by inserting -@example -(require 'out-xtra) -@end example -in your @file{.emacs} file. @file{out-xtra.el} will probably be -unbundled from AUC @TeX{} in the future. - -@item -Some fixes to AmS-@TeX{} mode by Ulf Juergens -@samp{}. - -@item -Make @samp{plain-TeX-mode-menu} work in Lucid Emacs. Thanks to Anthony -Rossini @samp{rossini@@hsph.harvard.edu} for reporting this. - -@item -First cut on a @TeX{}info mode. - -@item -More strict about parsing @samp{\bibitem}'s and Bib@TeX{} entries. - -@item -Made it easier to write style files for environments that takes -arguments and documented it. Suggested by Martin -Wunderli @samp{}. - -@item -Parse optional argument to @samp{\newenvironment}. Suggested by Martin -Wunderli @samp{}. - -@item -Fixed @samp{parbox} macro. Thanks to Shinji Kobayashi -@samp{}. - -@item -Made the parser work better in outline minor mode. Thanks to Salvador -Pinto Abreu @samp{}. - -@item -Also save style information with @code{TeX-normal-mode} when buffer not -modified. - -@item -Use @code{$(MAKE)} instead of @samp{make} to invoke @code{make} from the -@file{Makefile}. Thanks to John Interrante -@samp{}. - -@item -Make last value default for @code{TeX-insert-macro}. Suggested by Matt -Fairtlough @samp{}. - -@item -Renamed info file to @samp{auc-info} in order to fill DOS file limits. -Please remember to update your @file{dir} file to reflect this change. - -@item -Delete auto file instead of saving an empty file. -@end itemize - -@node Version 7.3, Version 7.2, Version 8.0, History -@comment node-name, next, previous, up -@section News in 7.3 - -Coordinator: Per Abrahamsen, 1993. - -@itemize @bullet -@item -More robust installation, especially for Lucid Emacs (I hope). Many -people reported problems with this. - -@item -Make `easymenu' work when byte-compiled. Many people reported this -bug. - -@item -Minimally updated the @file{README} file from version 6.0 (sigh). -Thanks to Boris Goldowsky @samp{} for reporting -this. - -@item -Added @samp{@@finalout} to manual. Reported by Henrik Drabol -@samp{}. - -@item -Fixed @kbd{M-q} to work after an @samp{\end@{@dots{}@}}. It will not -work at the end of the buffer, but there are usually the local variables -so it should (hopefully) not matter. Thanks to Shinji Kobayashi -@samp{} again. - -@item -New variables @code{TeX-open-quote} and @code{TeX-close-quote} determine -what is inserted by @code{TeX-insert-quote}. The @file{german} style -file now use those variables instead of changing the keymap. - -@item -Changes to the default settings in @file{tex-site.el}, in particular a -@samp{Queue} command is added to display the print queue. Thanks to -John Interrante @samp{} for code, and -other members of the @samp{auc-tex@@iesd.auc.dk} mailing list for -ideas. - -@item -Make sure all outline mode commands are bound in -@code{outline-minor-mode}. - -@item -Added autoload for @code{TeX-command}. Thanks to Hanno Wirth -@samp{} for reporting this. - -@item -Added support for AmS@TeX{} and AmSLa@TeX{}. Currently they are -identical to @TeX{} and La@TeX{} except for another default command. - -@item -Added Vor@TeX{} style matching of dollar sign. The style is guaranteed -to be Vor@TeX{}, since I lifted the code directly from Vor@TeX{}. -Thanks to Pehong Chen @samp{} for writing the -Vor@TeX{} code. Thanks to Jak Kirman @samp{} for -pointing out this nice Vor@TeX{} feature. - -@item -Added information about AUC @TeX{} mail addresses to the manual. Thanks -to Dave Smith @samp{}. - -@item -Added menu to for plain @TeX{}. Suggested by Tim Carlson -@samp{}. - -@item -Made the menus depend on @code{TeX-command-list}. - -@item -Made it possible to specify @code{TeX-auto-regexp-list} in the local -variable section of each file. - -@item -Added variable @code{TeX-auto-parse-length} to specify maximal length of -text that will be parsed. - -@item -Added automatic parsing of Bib@TeX{} files and @samp{bibitem} entries in -order to get completion in @samp{cite}. This was inspired by an add on -made by Sridhar Anandakrishnan @samp{}. - -@item -Added variable @code{TeX-byte-compile} to disable automatic byte -compilation of style files when loaded. This is needed when using -different Emacs versions. - -@item -Added variable @code{TeX-translate-location-hook} to translate file and -line information before showing an error, as requested by Thorbjoern -Ravn Andersen @samp{}. - -@item -Added variable @code{TeX-auto-save} to allow disabling the automatic -saving of style information, either per file in the file local -variables, or globally by using @code{setq-default}. Use -@code{TeX-normal-mode} to force style information to be saved. - -@item -Try to create @file{auto} directory if it does not exists. - -@item -Added chapter describing how to tune the @TeX{} parsing. - -@item -Allow (but do not encourage) a string value for -@code{LaTeX-default-options}. - -@item -Give @samp{"} word syntax when german.sty is loaded. Suggested by Tim -Geisler @samp{}. - -@item -Many corrections to the grammar in the manual. Thanks to Manfred -Weichel @samp{}. - -@item -Bind @code{TeX-home-buffer} to @kbd{C-c ^} instead of @kbd{C-c C-h} -which are reserved in Emacs 19. Suggested by Chris Moore -@samp{}. -@end itemize - -@node Version 7.2, Version 7.1, Version 7.3, History -@comment node-name, next, previous, up -@section News in 7.2 - -Coordinator: Per Abrahamsen, 1993. - -@itemize @bullet -@item -@code{LaTeX-dead-mode} works again. Thanks to Patrick O'Callaghan -@samp{} for fixing it. - -@item -Minor fixes to the documentation. Thanks to Shinji Kobayashi -@samp{}. - -@item -Add @samp{Compiling} to the mode line of all buffers, while there is a -AUC @TeX{} compilation process running. This is similar to the behavior -of @code{compile} in Emacs 19. - -@item -@code{TeX-normal-mode} will now save the buffer first to make sure it -gets reparsed. - -@item -Labels with underscores are now recognized. Thanks to Wolfgang Franzki -@samp{} - -@item -Fix to `ghostview' printer specification. Thanks to Masayuki Kuwada -@samp{}. - -@item -Recognize @samp{abstract}, @samp{center}, @samp{titlepage}, -@samp{verse}, and @samp{theindex} environments. Thanks to Masayuki Kuwada -@samp{}. - -@item -Fix to @samp{newsavebox} macro. Thanks to Shinji Kobayashi -@samp{} for reporting this. - -@item -Menu support for GNU Emacs 19 and Lucid Emacs. Thanks to Alastair Burt -@samp{} for the initial Lucid Emacs version. - -@item -@kbd{C-c C-f C-d} now deletes the current font. The current font is -defined to be the innermost @TeX{} group starting with a @TeX{} macro -that is terminated by a space. - -@item -Giving @kbd{C-c C-f} a prefix argument will replace the current font, -i.e. @kbd{C-u C-c C-f C-b} will change the current font to bold. - -The old functionality (putting the font around the region) has been -removed. To make the region bold, type @kbd{C-w C-c C-f C-b C-y} -instead. - -@item -Chapter recognized as largest heading in the report style. Thanks to -Shinji Kobayashi @samp{} for reporting -this. - -@item -More support for Japanese style files. Thanks to Shinji Kobayashi -@samp{}. - -@item -No longer put @samp{Outline} in the mode line whenever -@code{selective-display} is set. Thanks to Lawrence R. Dodd -@samp{} for reporting this. - -@item -Support for inserting calligraphic letters in @code{TeX-math-mode} with -@kbd{` c @key{letter}}. Thanks to Olaf Burkart -@samp{}. - -@item -@code{set-docstring} in @file{tex-math.el} should work better now. -Thanks to Alastair Burt @samp{} and Olaf Burkart -@samp{}. - -@item -Support for dviout preview on PC-9801. Thanks to Shinji Kobayashi -@samp{}. - -@item -Inserting environment in empty buffer should work now. Thanks to -Alastair Burt @samp{}. - -@item -Default float for figures changed from @samp{tbp} to @samp{htbp}. - -@item -@code{LaTeX-format-environment} may work now. Thanks to Shinji -Kobayashi @samp{}. - -@item -Better @code{LaTeX-close-environment}. Thanks to Thorbjoern Hansen -@samp{}. - -@item -Some support for Ispell 4.0. - -@item -Bib@TeX{} in Emacs 19 need @code{tex-insert-quote}, make it autoload -from AUC @TeX{} instead of the standard @code{tex-mode}. - -@item -@code{TeX-auto-generate} failed when repeated. Thanks to Peter Whaite -@samp{} for reporting this. -@end itemize - -@node Version 7.1, Version 7.0, Version 7.2, History -@comment node-name, next, previous, up -@section News in 7.1 - -Coordinator: Per Abrahamsen, 1993. - -@itemize @bullet -@item -Allow multiple @samp{%p} in print commands. - -Suggested by Cliff Krumvieda @samp{}. - -@item -Improved backward compatibility in @file{auc-tex.el}. Thanks to Ralf -Handl @samp{}. - -@item -New style hook for @file{german.sty}. - -Disable smart quotes. Press @kbd{C-c C-n} to make it take effect. - -@item -Allow files to have other extensions than ``tex''. - -But no longer allow files to have multiple dots. Sigh. - -@item -Will no longer parse the buffer if it can use the saved state. - -@item -New variable @code{TeX-parse-self}. - -Set it to nil if you never want to parse the buffer when you load it. - -@item -Only offer to save files that belongs to the document. - -When you format the document with @kbd{C-c C-c}, AUC @TeX{} will no -longer offer to save your @file{RMAIL}, @file{.newsrc}, or other files -that does not belong to the document. Suggested by Jim Hetrick -@samp{}. - -@item -Foil@TeX{} support. - -Thanks to Sven Mattisson @samp{} - -@item -Smarter about when you need to reformat. - -Thanks to Chris Callsen @samp{}. - -@item -Japanese @TeX{} - -Now supports Japanese @TeX{}. Thanks to Shinji Kobayashi -@samp{}. - -@item -Works again under OS/2 and other case insensitive file systems. - -@item -DEMACS support. - -Thanks to Shinji Kobayashi @samp{}. - -@item -Better @code{LaTeX-close-environment}. - -Thanks to Piet van Oostrum @samp{}. - -@item -Ispell support. - -Thanks to Piet van Oostrum @samp{}. - -@item -Support for Russian letters. - -Thanks to Justin R. Smith @samp{}. - -@item -Sli@TeX{} fixes. - -Many people. - -@item -Fixes for spelling errors. - -Many people. - -@end itemize - -@node Version 7.0, Version 6.1, Version 7.1, History -@comment node-name, next, previous, up -@section Version 7.0 - -Coordinator: Per Abrahamsen, 1993. - -Alpha testers (in order of appearance): Piet van Oostrum -@samp{}, Sven Mattisson @samp{}, Tim -Geisler @samp{}, Fran E. -Burstall @samp{}, Alastair Burt -@samp{}, Sridhar Anandakrishnan -@samp{}, Kjell Gustafsson -@samp{}, Uffe Kjaerulff -@samp{}, Kurt Swanson @samp{Kurt.Swanson@@dna.lth.se}, -Mark Utting @samp{}, Per Norman Oma -@samp{perno@@itk.unit.no}, Naji Mouawad -@samp{}, Bo Nygaard Bai -@samp{}, and probably more. - -@itemize @bullet -@item -New keymap. - -The keymap has been changed in order to make it more intuitive to new -users, and because the old bindings did not work well with the new -buffer manipulation commands in tex-buf.el. To use the new bindings, -load @file{tex-init.el} instead of @file{auc-tex.el}. - -The file @file{auc-tex.el} is still available and implements the old -keybindings on top of the new code. - -Print out the reference card (@file{doc/tex-ref.tex}) to see the new -bindings. - -@item -Completely redesigned the buffer handling. - -No part of the interface or the customization variables remain the same, -unless you use the compatibility functions in @file{auc-tex.el}. In -that case the interactive commands remain similar in spirit, but the -customization interface is still changed. - -The file @file{tex-buf.el} has been completely rewritten, and there are -major cleanup in @file{tex-dbg.el}, however the basic functionality -remains the same in this file. The code for both @file{tex-buf.el} and -@file{tex-dbg.el} should be much simpler now and easier to extent. - -@file{auc-tex.el} and @file{tex-site.el} was updated to support the new -interface. I actually believe the moral equivalent to @code{TeX-region} -to work now @t{:-)}, at least I understand the code now. - -The two major functions are now @code{TeX-command-master} and -@code{TeX-command-region}. Each function will prompt you for the -command to execute. AUC @TeX{} will make an educated guess on what -command you want to run, and make that the default. The available -commands are defined in the variable @code{TeX-command-list}. - -@code{TeX-command-master} will run the specified command on the buffers -master file. You can have one command running for each master file. -@code{TeX-command-region} will run the specified command on the current -region, getting the header on trailer from the master file. - -You can have exactly one region command running, independent on how many -master file commands that are running. Commands that operate on the -active process (like @code{TeX-next-error}) will chose the process -associated with buffers master file, unless the last region process is -more recent than all master file processes. - -AUC @TeX{} now insist on knowing the master file for a buffer. If you -do not specify it in the file variable section, and it is not obviously -a master file itself, it will ask you. It will also add the master file -name to the file variables, unless you disable this feature by setting -@code{TeX-add-local} to nil. Furthermore, it will convert @samp{%% -Master:} lines to file variables, unless you disable it by setting -@code{TeX-convert-master} to nil. -@vindex TeX-convert-master - -Functionality removed (for now, it might appear again latter) include -all other functions to start a command (e.g. @code{LaTeX-BibTeX}), and -alternative ways to specify headers and trailers. The only place to get -the header and trailer is from the master file (I can easily change -that, if anyone have such needs). - -@item -Style specific code isolated. - -You can now add style specific information to AUC TeX by writing a -style file somewhere in TeX-style-path. - -The main code is now organized around this principle. - -@item -Automatically generate style files. - -AUC @TeX{} can now automatically extract information from a @TeX{} file, -and will do this when you save a buffer. - -@item -Sli@TeX{} mode. - -Just like La@TeX{} mode, except that the default command to format run -on the buffer is @samp{slitex}. - -@item -@code{LaTeX-section} completely general. - -Rewrote @file{ltx-sec.el}. - -@itemize @minus -@item -Sectioning level, toc, and title queries can be individually turned off. -@item -Label query can be turned on or off for selected sectioning levels. -@item -Label prefix can be different for different sectioning levels. -@item -If the title (or toc) is empty, point will be positioned there. -@item -Users can add new hooks -@end itemize - -@item -@code{TeX-insert-macro} much smarter. - -It will now prompt for the symbol with completions, and for many symbols -it will also prompt for each argument. There are also completion on -some of the arguments. - -@item -Fixed center in figure environment. - -Thanks to Thomas Koenig @samp{}. - -@item -Changed @code{\M-} to @code{\e} in all keybindings in order to better -support 8-bit input on some GNU Emacs. Thanks to Peter Dalgaard -@samp{}. - -Please, implementors of 8-bit input extensions to GNU Emacs. -@code{\M-x} does @emph{not} means @dfn{@kbd{x} with the 8-bit set}. It -means @dfn{pressing @kbd{x} while holding down the @key{meta} key}. -Some systems (such as X11) are able to tell the different. Thus, even -if you implement 256 byte keymaps, @code{\M-x} should still expand -@code{meta-prefix-char} followed by an @kbd{x} in the keymap. This -allows you to distinguish pressing @kbd{x} while holding down the -@key{meta} key from entering a literal 8-bit character. - -@item -Made the outline commands aware of the document style. - -That is, if the document style is @samp{article}, @samp{\section} will -be one level below the @samp{\documentstyle}, while if the style is -@samp{book}, @samp{\section} will be three levels below -@samp{\documentstyle}. This will make @code{show-children} work better -at the top level. - -@item -The makefiles are closer to GNU coding standard. - -They now understand `prefix' and some other macros. - -@item -Added hooks to be run after list of environments or list of completion -names are updated, and also added a hook to be called after each file -has been loaded. Thanks to Piet van Oostrum @samp{}. - -@item -Added @samp{*} to lot of @code{(interactive)} declarations. - -@item -The outline commands are now always accessible from La@TeX{} mode. - -@item -Generalized the keyboard remapping and double modes. - -These are found in the file @file{min-key.el}. - -@item -Smart Comments. - -Not really, but there are now two comment functions which use their -arguments to determine what to do, instead of four functions ignoring -their arguments. - -@item -Add outline headers. - -It is now possible to add extra outline headers, by setting the variable -@code{TeX-outline-extra}. - -@item -Smart quotes even smarter. - -If you press @kbd{"} twice, it will insert an real double quote instead -of two (or four) single quotes. This is consistent with how remapping -in @file{min-key.el} is done. - -@item -Automatically untabify buffer when you save it. - -Hands up, everyone who have produced a `last revision' paper containing -an unreadable list of data in the back, because @TeX{} does not -understands tabs. - -@item -Call show-all when you change major mode. - -Thanks to Inge Frick's @samp{} @file{kill-fix.el} -enhancement, outline minor mode can now guarantee that all text is shown -when you leave the minor mode, even if you leave the minor mode by -changing the major mode. - -@item -Updated documentation for 7.0. - -Also added key, variable, function, and concept indexes, as well as this -history section and a new chapter on multifile documents -(@pxref{Multifile}).@refill - -@end itemize - -@node Version 6.1, Version 6.0, Version 7.0, History -@comment node-name, next, previous, up -@section Version 6.1 - -Coordinator: Per Abrahamsen, 1992. - -@itemize @bullet -@item -@code{TeX-region} might work now (heard that before?). - -Many people reported this one. Especially thanks to Fran Burstall -@samp{} and Bill Schworm -@samp{}.@refill - -@item -The specification format for the @TeX{} command is more general. - -See the documentation for @code{LaTeX-command} and -@code{plain-TeX-command}. - -@item -The specification format for the preview commands is more general. - -See their respective documentation. - -@item -The specification format for the print command is more general. - -See the documentation for @code{TeX-print-command}. - -@item -@code{TeX-args} is marked as obsolete. - -@item -The @samp{"Emergency stop ..."} error. - -Some users of old @TeX{} installations got might might be fixed now. -Thanks to Philip Sterne @samp{}. - -@item -It is now possible to change the preview command. - -@dots{} without loading TeX-site first. Thanks to Tim Bradshaw -@samp{}. - -@item -New variable TeX-smart-quotes. - -Allow @file{german.sty} users (and others) to disable the mapping of -double quote (@kbd{"} to @samp{``} or @samp{''}). Thanks to Daniel -Hernandez @samp{}. - -@item -Many minor corrections to the documentation. - -Thanks to Mainhard E. Mayer @samp{}. - -@item -Make test for @code{HOSTTYPE} case insensitive. - -Thanks to Gisli Ottarsson @samp{}. - -@item -@code{TeX-force-default-mode} - -Set to avoid AUC @TeX{}'s attempts to infer the mode of the file by -itself. - -@end itemize - -@node Version 6.0, Ancient History, Version 6.1, History -@comment node-name, next, previous, up -@section Version 6.0 - -Coordinator: Kresten Krab Thorup, 1992. - -Preliminary documentation is available in the directory @file{doc}. It -isn't very well written, but I believe it covers most interesting points. -Comments, suggestions, or even rewrites of sections are VERY -WELCOME@dots{} - -LaCheck has been incorporated in the package. The source code for it is -available in the directory @file{lacheck} along with the documentation -for it. Lacheck may also be used from the command line. It is bound to -@kbd{C-c $}. - -Some minor changes in: - -@table @code -@item TeX-region -Should work better with @samp{Master:} option. - -@item LaTeX-environment -Numerous new hooks added by Masayuki Kuwada. - -@item TeX-command-on-region -Removed. @kbd{C-c C-o} used for @code{outline-minor-mode} instead. - -@end table - -And some additional minor fixes... - -@node Ancient History, , Version 6.0, History -@comment node-name, next, previous, up -@section Ancient History - -The origin of AUC @TeX{} is @file{tex-mode.el} from Emacs 16. Lars -Peter Fischer @samp{} wrote the first functions to -insert font macros and Danish characters back in 1986. Per Abrahamsen -@samp{} wrote the functions to insert environments -and sections, to indent the text, and the outline minor mode in 1987. -Kresten Krab Thorup @samp{} wrote the buffer handling -and debugging functions, the macro completion, and much more, including -much improved indentation and text formatting functions. He also made -the first public release in 1991, and was the main author and -coordinator of every release up to and including 6.0. - -Thanks should also go to all the people who have been a great help -developing the AUC @TeX{} system. Especially all the people on the -@samp{auc-tex} mailing list, who have been very helpful commenting and -pointing out weak points and errors. - -Some of the contributors are listed below. Others are mentioned in the -lisp files or in the History section. - -@table @samp -@item -Denys Duchier -@item -George Ferguson -@item -Martin Simons -@item -Michael Smith -@item -Per Hagen -@item -Ralf Handl -@item -Sven Mattisson -@item -Masayuki Kuwada -@item -Terrence Brannon -@item -Leonard Roseman -@end table - -Special thanks to Leslie Lamport for supplying the source for the LaTeX -error messages in the @file{tex-dbg.el} file. - diff -r 6866abce6aaf -r 6075d714658b man/auctex/install.texi --- a/man/auctex/install.texi Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,144 +0,0 @@ -@chapter Installation of AUC @TeX{} -@cindex Installation -@cindex Make -@cindex @file{Makefile} -@cindex @file{.emacs} -@cindex Site initialization -@cindex Initialization -@cindex @file{tex-site.el} -@cindex Personal customization -@cindex Site customization -@cindex Customization -@cindex Customization, personal -@cindex Customization, site - -@section Compiling - -The following describes how to install AUC @TeX{} under Unix. You may -also be able to do use these instructions under some other operating -systems, if you have already installed the proper GNU tools, such as -@file{make}. - -To install AUC @TeX{} for an entire site (which may just be your own -personal Linux box), issue the following two commands as root: - -@example -make -make lispdir=/usr/local/share/emacs/site-lisp install -@end example - -except that instead of @t{/usr/local/...} you should use the location of -your sites emacs installation. AUC @TeX{} will then be installed in a -subdirectory named @file{auctex} of the @file{site-lisp} directory, and -the file @file{tex-site.el} will be stored directly in the -@file{site-lisp}. You can now tell your users to enable AUC @TeX{} by -adding - -@example -(require 'tex-site) -@end example - -to their @file{.emacs} file. - -If you use xemacs instead, or if your emacs binary is named something -else than @file{emacs}, specify this by using the commands - -@example -make EMACS=xemacs -make lispdir=/usr/local/share/emacs/site-lisp install -@end example - -to install. - -If you want to install AUC @TeX{} in your personal account, you should -chose a directory for all your emacs add-ons, for example an -@file{elisp} subdirectory in your home directory. You can then install -AUC @TeX{} with the commands - -@example -make -make lispdir=$HOME/elisp install -@end example - -You will then need to add the following lines to your @file{.emacs} -file: - -@example -(setq load-path (cons "~/elisp" load-path)) -(require 'tex-site) -@end example - -@section Customizing - -Next, you should edit the file @file{tex-site.el} to fit your local -site. You do this by looking at the customization section in the -beginning of @file{tex.el} and copy the definitions that are wrong for -your site to @file{tex-site.el}. Do @emph{not} edit @file{tex.el} -directly, or you will have to do all the work over again when you -upgrade AUC @TeX{}. AUC @TeX{} will not overwrite your old -@file{tex-site.el} file next time you install, so you will be able to -keep all your customizations. - -There are two variables with a special significance. - -@defopt TeX-lisp-directory -The directory where you want to install the AUC @TeX{} lisp files. -@end defopt - -This variable is set automatically by the @code{make install} command. -If you don't issue a @code{make install}, for example if you don't want -to install AUC @TeX{} in a different place, you will have to set this -variable manually to the location of the compiled files. - -@defopt TeX-macro-global -Directories containing the site's @TeX{} style files. -@end defopt - -Normally, AUC @TeX{} will only allow you to complete a short list of -build-in macros and environments and on the macros you define yourself. -If you issue the @kbd{M-x TeX-auto-generate-global} command after -loading AUC @TeX{}, you will be able to complete on all macros available -in the standard style files used by your document. To do this, you must -set this variable to a list of directories where the standard style -files are located. The directories will be searched recursively, so -there is no reason to list subsirectories explicitly. - -You probably also need to change @code{TeX-command-list} to make sure -that the commands used for starting @TeX{}, printing, etc. work on your -system. Copy the definition from @file{tex.el} to @file{tex-site.el} -and edit the command names appropriately. -@vindex TeX-command-list - -Finally, copy and edit @code{TeX-printer-list} to contain the printers -available at your site. -@vindex TeX-printer-list - -To extract information from your sites @TeX{} macros, type @kbd{M-x -TeX-auto-generate-global} in your emacs. This will only work if you -have set @code{TeX-macro-global} correctly in @file{tex-site.el}. - -@section Contributed files - -There are several files that are not part of AUC @TeX{} proper, but -included in the distribution in case they are useful. - -@table @file -@item hilit-LaTeX.el -Better highlighting for the obsolete @file{hilit19} package. - -@item font-latex.el -Better highlighting for the @sc{font-lock} package. - -@item bib-cite.el -Better support for bibliographies and much more. - -@item tex-jp.el -Support for Japanese. - -@item func-doc.el -Support for context sensitive online help for various languages. - -@end table - -Read the comments in the start of each file for more information about -how to install, what they do, and who wrote and maintains them. diff -r 6866abce6aaf -r 6075d714658b man/auctex/intro.texi --- a/man/auctex/intro.texi Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,174 +0,0 @@ -@chapter Introduction to AUC TeX - -This section of the AUC @TeX{} manual gives a brief overview of what AUC -@TeX{} is, and the section is also available as a @file{README} file. -It is @strong{not} an attempt to document AUC @TeX{}. Real -documentation for AUC @TeX{} is available in the rest of the manual, -which you can find in the @file{doc} directory. - -Read the @file{INSTALLATION} file for information about how to install -AUC @TeX{}. It is identical to the Installation chapter in the AUC -@TeX{} manual. - -If you are upgrading from the previous version of AUC @TeX{}, the -latest changes can be found in the @file{CHANGES} file. If you are -upgrading from an older version, read the History chapter in the AUC -@TeX{} manual. - -AUC @TeX{} is a comprehensive customizable integrated environment for -writing input files for La@TeX{} using GNU Emacs. - -AUC @TeX{} lets you run @TeX{}/La@TeX{} and other La@TeX{}-related -tools, such as a output filters or post processor from inside Emacs. -Especially `running La@TeX{}' is interesting, as AUC @TeX{} lets you -browse through the errors @TeX{} reported, while it moves the cursor -directly to the reported error, and displays some documentation for that -particular error. This will even work when the document is spread over -several files. - -AUC @TeX{} automatically indents your `La@TeX{}-source', not only as you -write it --- you can also let it indent and format an entire document. -It has a special outline feature, which can greatly help you `getting an -overview' of a document. - -Apart from these special features, AUC @TeX{} provides an large range of -handy Emacs macros, which in several different ways can help you write -your La@TeX{} documents fast and painless. - -All features of AUC @TeX{} are documented using the GNU Emacs online -documentation system. That is, documentation for any command is just -a key click away! - -AUC @TeX{} is written entirely in Emacs-Lisp, and hence you can easily -add new features for your own needs. It was not made as part of any -particular employment or project (apart from the AUC @TeX{} project -itself). AUC @TeX{} is distributed under the `GNU Emacs General Public -License' and may therefore almost freely be copied and redistributed. - -The next sections are a short introduction to some `actual' features. -For further information, refer to the build-in online documentation of -AUC @TeX{}. - -@section Indentation and formatting - -AUC @TeX{} may automatically indent your document as you write it. By -pressing @key{lfd} instead of @key{ret} at the end of a line, the -current line is indented by two spaces according to the current -environment level, and the cursor is moved down one line. By pressing -@key{tab}, the current line is indented, and the cursor stays where it -is. The well-known Emacs feature @code{format-paragraph} (@kbd{M-q}) is -reimplemented especially for AUC @TeX{} to follow the indentation. A -special command @code{LaTeX-fill-buffer} lets you indent an entire -document like the well-known C utility indent (this time, only according -to the La@TeX{} structure @t{:-)}. - -@section Completion - -By studying your @samp{\documentstyle} command (in the top of your -document), and consulting a precompiled list of (La)@TeX{} symbols from -a large number of @TeX{} and La@TeX{} files, AUC @TeX{} is aware of the -La@TeX{} commands you should able to use in this particular document. -This `knowledge' of AUC @TeX{} is used for two purposes. - -@enumerate -@item -To make you able to `complete' partly written La@TeX{} commands. You may -e.g. write @kbd{\renew} and press @kbd{M-@key{tab}} -(@code{TeX-complete-symbol}), and then AUC @TeX{} will complete the word -@samp{\renewcommand} for you. In case of ambiguity it will display a -list of possible completions. -@item -To aid you inserting environments, that is \begin - \end pairs. This is -done by pressing C-c C-e (La@TeX{}-environment), and you will be -prompted for which `environment' to insert. -@end enumerate - -@section Editing your document - -A number of more or less intelligent keyboard macros have been defined -to aid you editing your document. The most important are listed here -below. - -@table @code -@item LaTeX-environment -(@kbd{C-c C-e}) Insert a @samp{\begin@{@}} --- @samp{\end@{@}} pair as -described above. -@item LaTeX-section -(@kbd{C-c C-s}) Insert one of @samp{\chapter}, @samp{\section}, etc. -@item TeX-font -(@kbd{C-c C-f C-r}, @kbd{C-c C-f C-i}, @kbd{C-c C-f C-b}) Insert one of -@samp{@{\textrm @}}), @samp{@{\textit \/@}} @samp{@{\textbf @}} etc. -@end table - -A number of additional functions are available. But it would be far too -much to write about here. Refer to the rest of the AUC @TeX{} -documentation for further information. - -@section Running La@TeX{} - -When invoking on of the commands @code{TeX-command-master} (@kbd{C-c -C-c}) or @code{TeX-command-region} (@kbd{C-c C-r}) La@TeX{} is run on -either the entire current document or a given region of it. The Emacs -view is split in two, and the output of @TeX{} is printed in the second -half of the screen, as you may simultaneously continue editing your -document. In case @TeX{} found any errors when processing your input -you can call the function @code{TeX-next-error} (@kbd{C-c `}) which will -move the cursor to the first given error, and display a short -explanatory text along with the message @TeX{} gave. This procedure may -be repeated until all errors have been displayed. By pressing @kbd{C-c -C-w} (@code{TeX-toggle-debug-boxes}) you can toggle whether the browser -also should notify over-full/under-full boxes or not. - -Once you've successfully formatted your document, you may preview or -print it by invoking @code{TeX-command-master} again. - -@section Outlines - -Along with AUC @TeX{} comes support for outline mode for Emacs, which -lets you browse the sectioning structure of your document, while you -will still be able to use the full power of the rest of the AUC @TeX{} -functionality. - -@section Availability - -The most recent version is always available by ftp at - -@flushright -@samp{ftp://ftp.iesd.auc.dk/pub/emacs-lisp/auctex.tar.gz} -@end flushright - -In case you don't have access anonymous ftp, you can get it by email -requests to @samp{}. - -WWW users may want to check out the AUC @TeX{} page at - -@flushright -@samp{http://www.iesd.auc.dk/~amanda/auctex/} -@end flushright - -@section Contacts - -There has been established a mailing list for help, bug reports, feature -requests and general discussion about AUC @TeX{}. You're very welcome -to join. Traffic average at an article by day, but they come in bursts. -If you are only interested in information on updates, you could refer to -the newsgroups @samp{comp.text.tex} and @samp{gnu.emacs.sources}. - -If you want to contact the AUC @TeX{} mailing list, send mail to -@samp{} in order to join. Articles should -be send to @samp{}. - -To contact the current maintainers of auc-@TeX{} directly, email -@samp{}. - -@example - AUC @TeX{} development - c/o Kresten Krab Thorup - - Mathematics and Computer Science - University of Aalborg - DK 9000 Aalborg - Denmark -@end example - - diff -r 6866abce6aaf -r 6075d714658b man/auctex/math-ref.tex --- a/man/auctex/math-ref.tex Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,289 +0,0 @@ -% -*- plain-tex -*- -% $Id: math-ref.tex,v 1.1 1997/02/20 02:05:18 steve Exp $ -% Reference Card for LaTeX Math Minor Mode -%**start of header -\newcount\columnsperpage - -% This file can be printed with 1, 2, or 3 columns per page (see below). -% Specify how many you want here. Nothing else needs to be changed. - -\columnsperpage=2 - -% This file is intended to be processed by plain TeX (TeX82). -% compile-command: "tex auc-tex-ref.tex" - -% Original author of Auc-TeX Reference Card: -% -% Terrence Brannon, PO Box 5027, Bethlehem, PA 18015 , USA -% internet: tb06@pl118f.cc.lehigh.edu (215) 758-1720 (215) 758-2104 -% -% Kresten Krab Thorup updated the reference card to 6.* -% Per Abrahamsen updated the reference card to 7.* -% -% Thanks to Stephen Gildea -% Paul Rubin, Bob Chassell, Len Tower, and Richard Mlynarik -% for creating the GNU Emacs Reference Card from which this was mutated - -\def\versionnumber{5.2} -\def\year{1993} -\def\version{February \year\ v\versionnumber} - -\def\shortcopyrightnotice{\vskip 1ex plus 2 fill - \centerline{\small \copyright\ \year\ Free Software Foundation, Inc. - Permissions on back. v\versionnumber}} - -\def\copyrightnotice{ -\vskip 1ex plus 2 fill\begingroup\small -\centerline{Copyright \copyright\ 1987 Free Software Foundation, Inc.} -\centerline{Copyright \copyright\ 1992 Kresten Krab Thorup} -\centerline{Copyright \copyright\ \year\ Per Abrahamsen} - -Permission is granted to make and distribute copies of -this card provided the copyright notice and this permission notice -are preserved on all copies. - -\endgroup} - -% make \bye not \outer so that the \def\bye in the \else clause below -% can be scanned without complaint. -\def\bye{\par\vfill\supereject\end} - -\newdimen\intercolumnskip -\newbox\columna -\newbox\columnb - -\def\ncolumns{\the\columnsperpage} - -\message{[\ncolumns\space - column\if 1\ncolumns\else s\fi\space per page]} - -\def\scaledmag#1{ scaled \magstep #1} - -% This multi-way format was designed by Stephen Gildea -% October 1986. -\if 1\ncolumns - \hsize 4in - \vsize 10in - \voffset -.7in - \font\titlefont=\fontname\tenbf \scaledmag3 - \font\headingfont=\fontname\tenbf \scaledmag2 - \font\smallfont=\fontname\sevenrm - \font\smallsy=\fontname\sevensy - - \footline{\hss\folio} - \def\makefootline{\baselineskip10pt\hsize6.5in\line{\the\footline}} -\else - \hsize 3.2in - \vsize 7.95in -% \hoffset -.75in -% \voffset -.745in - \font\titlefont=cmbx10 \scaledmag2 - \font\headingfont=cmbx10 \scaledmag1 - \font\smallfont=cmr6 - \font\smallsy=cmsy6 - \font\eightrm=cmr8 - \font\eightbf=cmbx8 - \font\eightit=cmti8 - \font\eighttt=cmtt8 - \font\eightsy=cmsy8 - \textfont0=\eightrm - \textfont2=\eightsy - \def\rm{\eightrm} - \def\bf{\eightbf} - \def\it{\eightit} - \def\tt{\eighttt} - \normalbaselineskip=.8\normalbaselineskip - \normallineskip=.8\normallineskip - \normallineskiplimit=.8\normallineskiplimit - \normalbaselines\rm %make definitions take effect - - \if 2\ncolumns - \let\maxcolumn=b - \footline{\hss\rm\folio\hss} - \def\makefootline{\vskip 2in \hsize=6.86in\line{\the\footline}} - \else \if 3\ncolumns - \let\maxcolumn=c - \nopagenumbers - \else - \errhelp{You must set \columnsperpage equal to 1, 2, or 3.} - \errmessage{Illegal number of columns per page} - \fi\fi - - \intercolumnskip=.46in - \def\abc{a} - \output={% - % This next line is useful when designing the layout. - %\immediate\write16{Column \folio\abc\space starts with \firstmark} - \if \maxcolumn\abc \multicolumnformat \global\def\abc{a} - \else\if a\abc - \global\setbox\columna\columnbox \global\def\abc{b} - %% in case we never use \columnb (two-column mode) - \global\setbox\columnb\hbox to -\intercolumnskip{} - \else - \global\setbox\columnb\columnbox \global\def\abc{c}\fi\fi} - \def\multicolumnformat{\shipout\vbox{\makeheadline - \hbox{\box\columna\hskip\intercolumnskip - \box\columnb\hskip\intercolumnskip\columnbox} - \makefootline}\advancepageno} - \def\columnbox{\leftline{\pagebody}} - - \def\bye{\par\vfill\supereject - \if a\abc \else\null\vfill\eject\fi - \if a\abc \else\null\vfill\eject\fi - \end} -\fi - -% we won't be using math mode much, so redefine some of the characters -% we might want to talk about -\catcode`\^=12 -\catcode`\_=12 - -\chardef\\=`\\ -\chardef\{=`\{ -\chardef\}=`\} - -\hyphenation{mini-buf-fer} - -\parindent 0pt -\parskip 1ex plus .5ex minus .5ex - -\def\small{\smallfont\textfont2=\smallsy\baselineskip=.8\baselineskip} - -\outer\def\newcolumn{\vfill\eject} - -\outer\def\title#1{{\titlefont\centerline{#1}}\vskip 1ex plus .5ex} - -\outer\def\section#1{\par\filbreak - \vskip 3ex plus 2ex minus 2ex {\headingfont #1}\mark{#1}% - \vskip 2ex plus 1ex minus 1.5ex} - -\newdimen\keyindent - -\def\beginindentedkeys{\keyindent=1em} -\def\endindentedkeys{\keyindent=0em} -\endindentedkeys - -\def\paralign{\vskip\parskip\halign} - -\def\<#1>{$\langle${\rm #1}$\rangle$} - -\def\kbd#1{{\tt#1}\null} %\null so not an abbrev even if period follows - -\def\beginexample{\par\leavevmode\begingroup - \obeylines\obeyspaces\parskip0pt\tt} -{\obeyspaces\global\let =\ } -\def\endexample{\endgroup} - -\def\key#1#2{\leavevmode\hbox to \hsize{\vtop - {\hsize=.75\hsize\rightskip=1em - \hskip\keyindent\relax#1}\kbd{#2}\hfil}} - -\newbox\metaxbox -\setbox\metaxbox\hbox{\kbd{M-x }} -\newdimen\metaxwidth -\metaxwidth=\wd\metaxbox - -\def\metax#1#2{\leavevmode\hbox to \hsize{\hbox to .75\hsize - {\hskip\keyindent\relax#1\hfil}% - \hskip -\metaxwidth minus 1fil - \kbd{#2}\hfil}} - -\def\threecol#1#2#3{\hskip\keyindent\relax#1\hfil&\kbd{#2}\quad - &\kbd{#3}\quad\cr} - -%**end of header - - -\title{Math Mode Reference Card} - -\section{Variables} - -All math mode commands are under the prefix key specified by -LaTeX-math-abbrev-prefix, default is "`". - -You can define your own math mode commands by setting the variable -LaTeX-math-list before loading LaTeX-math-mode. - -\section{Greek Letters} - -\def\disp#1{\hbox to 6ex{$#1$\hfill}} -\key{\disp{\alpha} (alpha)}{a} -\key{\disp{\beta} (beta)}{b} -\key{\disp{\delta} (delta)}{d} -\key{\disp{\epsilon} (epsilon)}{e} -\key{\disp{\phi} (phi)}{f} -\key{\disp{\gamma} (gamma)}{g} -\key{\disp{\eta} (eta)}{h} -\key{\disp{\kappa} (kappa)}{k} -\key{\disp{\lambda} (lambda)}{l} -\key{\disp{\mu} (mu)}{m} -\key{\disp{\nabla} (nabla)}{N} -\key{\disp{\nu} (nu)}{n} -\key{\disp{\omega} (omega)}{o} -\key{\disp{\pi} (pi)}{p} -\key{\disp{\theta} (theta)}{q} -\key{\disp{\rho} (rho)}{r} -\key{\disp{\sigma} (sigma)}{s} -\key{\disp{\tau} (tau)}{t} -\key{\disp{\upsilon} (upsilon)}{u} -\key{\disp{\chi} (chi)}{x} -\key{\disp{\psi} (psi)}{y} -\key{\disp{\zeta} (zeta)}{z} -\key{\disp{\Delta} (Delta)}{D} -\key{\disp{\Phi} (Phi)}{F} -\key{\disp{\Gamma} (Gamma)}{G} -\key{\disp{\Theta} (Theta)}{Q} -\key{\disp{\Lambda} (Lambda)}{L} -\key{\disp{\Psi} (Psi)}{Y} -\key{\disp{\Pi} (Pi)}{P} -\key{\disp{\Sigma} (Sigma)}{S} -\key{\disp{\Upsilon} (Upsilon)}{U} -\key{\disp{\Omega} (Omega)}{O} - -\section{Symbols} - -\key{\disp{\rightarrow} (rightarrow)}{C-f} -\key{\disp{\leftarrow} (leftarrow)}{C-b} -\key{\disp{\uparrow} (uparrow)}{C-p} -\key{\disp{\downarrow} (downarrow)}{C-n} -\key{\disp{\leq} (leq)}{<} -\key{\disp{\geq} (geq)}{>} -\key{\disp{\tilde{ }} (tilde)}{$\tilde{ }$} -\key{\disp{\infty} (infty)}{I} -\key{\disp{\forall} (forall)}{A} -\key{\disp{\exists} (exists)}{E} -\key{\disp{\not } (not)}{!} -\key{\disp{\in} (in)}{i} -\key{\disp{\times} (times)}{*} -\key{\disp{\cdot} (cdot)}{.} -\key{\disp{\subset} (subset)}{\{} -\key{\disp{\supset} (supset)}{\}} -\key{\disp{\subseteq} (subseteq)}{[} -\key{\disp{\supseteq} (supseteq)}{]} -\key{\disp{\backslash} (backslash)}{\\} -\key{\disp{\setminus} (setminus)}{/} -\key{\disp{\cup} (cup)}{+} -\key{\disp{\cap} (cap)}{-} -\key{\disp{\langle} (langle)}{(} -\key{\disp{\rangle} (rangle)}{)} -\key{\disp{\exp} (exp)}{C-e} -\key{\disp{\sin} (sin)}{C-s} -\key{\disp{\cos} (cos)}{C-c} -\key{\disp{\sup} (sup)}{C-^} -\key{\disp{\inf} (inf)}{C-_} -\key{\disp{\det} (det)}{C-d} -\key{\disp{\lim} (lim)}{C-l} -\key{\disp{\tan} (tan)}{C-t} -\key{\disp{\hat{ }} (hat)}{^} -\key{\disp{\vee} (vee)}{v} - -\section{Miscellaneous} - -\key{cal letters}{c {\rm LETTER}} - -\copyrightnotice - -\bye - -% End: - diff -r 6866abce6aaf -r 6075d714658b man/auctex/tex-ref.tex --- a/man/auctex/tex-ref.tex Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,295 +0,0 @@ -+% -*- plain-tex -*- -% $Id: tex-ref.tex,v 1.1 1997/02/20 02:05:18 steve Exp $ -% Reference Card for Auc TeX version 7 -%**start of header -\newcount\columnsperpage - -% This file can be printed with 1, 2, or 3 columns per page (see below). -% Specify how many you want here. Nothing else needs to be changed. - -\columnsperpage=2 - -% This file is intended to be processed by plain TeX (TeX82). -% compile-command: "tex ref-card.tex" -% -% Original author of Auc-TeX Reference Card: -% -% Terrence Brannon, PO Box 5027, Bethlehem, PA 18015 , USA -% internet: tb06@pl118f.cc.lehigh.edu (215) 758-1720 (215) 758-2104 -% -% Kresten Krab Thorup updated the reference card to 6. -% Per Abrahamsen updated the reference card to 7, 8, and 9. -% -% Thanks to Stephen Gildea -% Paul Rubin, Bob Chassell, Len Tower, and Richard Mlynarik -% for creating the GNU Emacs Reference Card from which this was mutated - -\def\versionnumber{9} -\def\year{1993} -\def\version{February \year\ v\versionnumber} - -\def\shortcopyrightnotice{\vskip 1ex plus 2 fill - \centerline{\small \copyright\ \year\ Free Software Foundation, Inc. - Permissions on back. v\versionnumber}} - -\def\copyrightnotice{ -\vskip 1ex plus 2 fill\begingroup\small -\centerline{Copyright \copyright\ 1987 Free Software Foundation, Inc.} -\centerline{Copyright \copyright\ 1992 Kresten Krab Thorup} -\centerline{Copyright \copyright\ \year\ Per Abrahamsen} -\centerline{for AUC \TeX\ version \versionnumber} - -Permission is granted to make and distribute copies of -this card provided the copyright notice and this permission notice -are preserved on all copies. - - -\endgroup} - -% make \bye not \outer so that the \def\bye in the \else clause below -% can be scanned without complaint. -\def\bye{\par\vfill\supereject\end} - -\newdimen\intercolumnskip -\newbox\columna -\newbox\columnb - -\def\ncolumns{\the\columnsperpage} - -\message{[\ncolumns\space - column\if 1\ncolumns\else s\fi\space per page]} - -\def\scaledmag#1{ scaled \magstep #1} - -% This multi-way format was designed by Stephen Gildea -% October 1986. -\if 1\ncolumns - \hsize 4in - \vsize 10in - \voffset -.7in - \font\titlefont=\fontname\tenbf \scaledmag3 - \font\headingfont=\fontname\tenbf \scaledmag2 - \font\smallfont=\fontname\sevenrm - \font\smallsy=\fontname\sevensy - - \footline{\hss\folio} - \def\makefootline{\baselineskip10pt\hsize6.5in\line{\the\footline}} -\else - \hsize 3.2in - \vsize 7.95in -% \hoffset -.75in -% \voffset -.745in - \font\titlefont=cmbx10 \scaledmag2 - \font\headingfont=cmbx10 \scaledmag1 - \font\smallfont=cmr6 - \font\smallsy=cmsy6 - \font\eightrm=cmr8 - \font\eightbf=cmbx8 - \font\eightit=cmti8 - \font\eighttt=cmtt8 - \font\eightsy=cmsy8 - \textfont0=\eightrm - \textfont2=\eightsy - \def\rm{\eightrm} - \def\bf{\eightbf} - \def\it{\eightit} - \def\tt{\eighttt} - \normalbaselineskip=.8\normalbaselineskip - \normallineskip=.8\normallineskip - \normallineskiplimit=.8\normallineskiplimit - \normalbaselines\rm %make definitions take effect - - \if 2\ncolumns - \let\maxcolumn=b - \footline{\hss\rm\folio\hss} - \def\makefootline{\vskip 2in \hsize=6.86in\line{\the\footline}} - \else \if 3\ncolumns - \let\maxcolumn=c - \nopagenumbers - \else - \errhelp{You must set \columnsperpage equal to 1, 2, or 3.} - \errmessage{Illegal number of columns per page} - \fi\fi - - \intercolumnskip=.46in - \def\abc{a} - \output={% - % This next line is useful when designing the layout. - %\immediate\write16{Column \folio\abc\space starts with \firstmark} - \if \maxcolumn\abc \multicolumnformat \global\def\abc{a} - \else\if a\abc - \global\setbox\columna\columnbox \global\def\abc{b} - %% in case we never use \columnb (two-column mode) - \global\setbox\columnb\hbox to -\intercolumnskip{} - \else - \global\setbox\columnb\columnbox \global\def\abc{c}\fi\fi} - \def\multicolumnformat{\shipout\vbox{\makeheadline - \hbox{\box\columna\hskip\intercolumnskip - \box\columnb\hskip\intercolumnskip\columnbox} - \makefootline}\advancepageno} - \def\columnbox{\leftline{\pagebody}} - - \def\bye{\par\vfill\supereject - \if a\abc \else\null\vfill\eject\fi - \if a\abc \else\null\vfill\eject\fi - \end} -\fi - -% we won't be using math mode much, so redefine some of the characters -% we might want to talk about -\catcode`\^=12 -\catcode`\_=12 - -\chardef\\=`\\ -\chardef\{=`\{ -\chardef\}=`\} - -\hyphenation{mini-buf-fer} - -\parindent 0pt -\parskip 1ex plus .5ex minus .5ex - -\def\small{\smallfont\textfont2=\smallsy\baselineskip=.8\baselineskip} - -\outer\def\newcolumn{\vfill\eject} - -\outer\def\title#1{{\titlefont\centerline{#1}}\vskip 1ex plus .5ex} - -\outer\def\section#1{\par\filbreak - \vskip 3ex plus 2ex minus 2ex {\headingfont #1}\mark{#1}% - \vskip 2ex plus 1ex minus 1.5ex} - -\newdimen\keyindent - -\def\beginindentedkeys{\keyindent=1em} -\def\endindentedkeys{\keyindent=0em} -\endindentedkeys - -\def\paralign{\vskip\parskip\halign} - -\def\<#1>{$\langle${\rm #1}$\rangle$} - -\def\kbd#1{{\tt#1}\null} %\null so not an abbrev even if period follows - -\def\beginexample{\par\leavevmode\begingroup - \obeylines\obeyspaces\parskip0pt\tt} -{\obeyspaces\global\let =\ } -\def\endexample{\endgroup} - -\def\key#1#2{\leavevmode\hbox to \hsize{\vtop - {\hsize=.75\hsize\rightskip=1em - \hskip\keyindent\relax#1}\kbd{#2}\hfil}} - -\newbox\metaxbox -\setbox\metaxbox\hbox{\kbd{M-x }} -\newdimen\metaxwidth -\metaxwidth=\wd\metaxbox - -\def\metax#1#2{\leavevmode\hbox to \hsize{\hbox to .75\hsize - {\hskip\keyindent\relax#1\hfil}% - \hskip -\metaxwidth minus 1fil - \kbd{#2}\hfil}} - -\def\threecol#1#2#3{\hskip\keyindent\relax#1\hfil&\kbd{#2}\quad - &\kbd{#3}\quad\cr} - -%**end of header - - -\title{AUC \TeX\ Reference Card} - -\centerline{(for version \versionnumber)} - -\section{Conventions Used} - -\key{Carriage Return}{RET} -\key{Tabular}{TAB} -\key{Linefeed}{LFD} - -Mode variables: You want to change the variables found in the file -`{\tt tex-site.el}' in the AUC-\TeX\ distribution for your site. The -other variables should be set by the individual user. - -Entering LaTeX mode calls the value of text-mode-hook, then the value -of TeX-mode-hook, and then the value of LaTeX-mode-hook. - -\section{Shell Interaction} - -\key{Save Document}{C-c C-d} -\key{Run a command on the master file}{C-c C-c} -\key{Run a command on the buffer}{C-c C-b} -\key{Run a command on the region}{C-c C-r} -\key{Kill job}{C-c C-k} -\key{Recenter output buffer}{C-c C-l} -\key{Next error in \TeX/LaTeX session}{C-c `} -\key{Toggle debug of wonderful boxes}{C-c C-w} -\key{Switch to master file or active buffer}{C-c ^} - -Commands you can run on the master file (with C-c C-c) or the region -(with C-c C-r) include the following. - -\key{\TeX}{TeX} -\overfullrule=0pt %The next line is too wide. -\key{Run \TeX{} Interactively}{TeX Interactive} -\key{LaTeX}{LaTeX} -\key{Run LaTeX Interactively}{LaTeX Interactive} -\key{SliTeX}{SliTeX} -\key{A previewer}{View} -\key{Printing the DVI file}{Print} -\key{Bib\TeX}{BibTeX} -\key{MakeIndex}{Index} -\key{LaCheck}{Check} -\key{(PostScript) File}{File} -\key{Ispell}{Spell} - -\section{Command Insertion} - -\key{Insert Section}{C-c C-s} -\key{Insert LaTeX environment}{C-c C-e} -\key{Insert item}{C-c LFD} -\key{Close LaTeX environment}{C-c ]} -\key{Insert \TeX\ macro \kbd{\\\{\}} }{C-c C-m} -\key{Insert double brace}{C-c \{} -\key{Complete \TeX\ macro}{M-TAB} -\key{Smart ``quote''}{"} -\key{Smart ``dollar''}{\$} - -\section{Font Selection} - -\key{Insert {\bf bold} text}{C-c C-f C-b} -\key{Insert {\it italics\/} text}{C-c C-f C-i} -\key{Insert {\rm roman} text}{C-c C-f C-r} -\key{Insert {\it emphasized} text}{C-c C-f C-e} -\key{Insert {\tt typewriter} text}{C-c C-f C-t} -\key{Insert {\sl slanted\/} text}{C-c C-f C-s} -\key{Delete font}{C-c C-f C-d} -\key{Change font}{C-u C-c C-f } - -\section{Source Formatting} - -\key{Indent current line}{TAB} -\key{Indent next line}{LFD} - -\key{Format a paragraph}{M-q} -\key{Format a region}{C-c C-q C-r} -\key{Format a section}{C-c C-q C-s} -\key{Format an environment}{C-c C-q C-e} - -\key{Mark an environment}{C-c .} -\key{Mark a section}{C-c *} - -\key{Comment region}{C-c ;} -\key{Comment paragraph}{C-c \%} -\key{Uncomment region}{C-u - C-c ;} -\key{Uncomment paragraph}{C-u - C-c \%} - -\section{Miscellaneous} - -\key{Math Mode}{C-c \~{}} -\key{Reset AUC TeX}{C-c C-n} - -\copyrightnotice - -\bye - -% End: diff -r 6866abce6aaf -r 6075d714658b man/cc-mode.texi --- a/man/cc-mode.texi Mon Aug 13 09:50:16 2007 +0200 +++ b/man/cc-mode.texi Mon Aug 13 09:51:16 2007 +0200 @@ -46,9 +46,9 @@ @comment The title is printed in a large font. @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -@center @titlefont{CC Mode 5.13} +@center @titlefont{CC Mode 5.14} @sp 2 -@center @subtitlefont{A GNU Emacs mode for editing C, C++, Objective-C, and Java code} +@center @subtitlefont{A GNU Emacs mode for editing C and C-like languages} @sp 2 @center Barry A. Warsaw @@ -111,8 +111,8 @@ @cindex BOCM Welcome to @ccmode{}. This is a GNU Emacs mode for editing files -containing C, C++, Objective-C, and Java code. This incarnation of the -mode is descendant from @file{c-mode.el} (also called "Boring Old C +containing C, C++, Objective-C, Java, and IDL code. This incarnation of +the mode is descendant from @file{c-mode.el} (also called "Boring Old C Mode" or BOCM @code{:-)}, and @file{c++-mode.el} version 2, which I have been maintaining since 1992. @ccmode{} represents a significant milestone in the mode's life. It has been fully merged back with Emacs @@ -121,11 +121,12 @@ @ccmode{} supports the editing of K&R and ANSI C, @dfn{ARM} @footnote{``The Annotated C++ Reference Manual'', by Ellis and -Stroustrup.} C++, Objective-C, and Java files. In this way, you can +Stroustrup.} C++, Objective-C, Java and IDL@footnote{CORBA's Interface +Definition Language} files. In this way, you can easily set up consistent coding styles for use in editing all C, C++, -Objective-C, and Java programs. @ccmode{} does @emph{not} handle +Objective-C, Java and IDL programs. @ccmode{} does @emph{not} handle font-locking (a.k.a. syntax coloring, keyword highlighting) or anything -of that nature, for any of the 4 modes. Those are handled by other +of that nature, for any of these modes. Font-locking is handled by other Emacs packages. This manual will describe the following: @@ -142,26 +143,32 @@ @end itemize -Note that the name of this package is ``@ccmode{}''. The main file for -@ccmode{} is @file{cc-mode.el}, but other files are included in the -@ccmode{} distribution. There is no top level @code{cc-mode} entry -point. All of the variables, commands, and functions in @ccmode{} are -prefixed with @code{c-@var{}}, and @code{c-mode}, -@code{c++-mode}, @code{objc-mode}, and @code{java-mode} entry points are -provided. This file is intended to be a replacement for -@file{c-mode.el} and @file{c++-mode.el}. +@findex c-mode +@findex c++-mode +@findex objc-mode +@findex java-mode +@findex idl-mode +Note that the name of this package is ``@ccmode{}'', but there is no top +level @code{cc-mode} entry point. All of the variables, commands, and +functions in @ccmode{} are prefixed with @code{c-@var{}}, and +@code{c-mode}, @code{c++-mode}, @code{objc-mode}, @code{java-mode}, and +@code{idl-mode} entry points are provided. This file is intended to be +a replacement for @file{c-mode.el} and @file{c++-mode.el}. @cindex @file{cc-compat.el} file -This distribution also contains a file called @file{cc-compat.el} which -should ease your transition from BOCM to @ccmode{}. It currently -comes unguaranteed and unsupported, but this may change for future -versions. If you have a BOCM configuration you are really happy with, -and want to postpone learning how to configure @ccmode{}, take a -look at that file. It maps BOCM configuration variables to -@ccmode{}'s new indentation model. +This distribution also contains a file +called @file{cc-compat.el} which should ease your transition from BOCM +to @ccmode{}. If you have a BOCM configuration you are really happy +with, and want to postpone learning how to configure @ccmode{}, take a +look at that file. It maps BOCM configuration variables to @ccmode{}'s +new indentation model. It is not actively supported so for the long +run, you should learn how to customize @ccmode{} to support your coding +style. A special word of thanks goes to Krishna Padmasola for his work in -converting the original @file{README} file to Texinfo format. +converting the original @file{README} file to Texinfo format. I'd also +like to thank all the @ccmode{} victims who help enormously during the +early beta stages of @ccmode{}'s development. @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -193,16 +200,15 @@ The first thing you will want to do is put the @ccmode{} source files in a subdirectory somewhere on your @code{load-path} so Emacs can find it. -The distribution tarball unpacks into its own subdirectory tagged with -the version number of the release. E.g. @ccmode{} release 5.00 will -unpack into the @file{cc-mode-5.00} directory. Assuming you unpacked -the distribution in your home directory, you should add the following to -your @file{.emacs} file in order to pick up the latest version of -@ccmode{} over the one distributed with your Emacs: +The distribution tarball unpacks into its own subdirectory, +e.g. @file{cc-mode/}. Assuming you unpacked the distribution in your +home directory, you should add the following to your @file{.emacs} file +in order to pick up the latest version of @ccmode{} over the one +distributed with your Emacs: @example -(setq load-path (cons "~/cc-mode-5.00" load-path)) +(setq load-path (cons "~/cc-mode" load-path)) @end example @@ -215,38 +221,29 @@ Emacs, and none of the warnings have any effect on operation. Let me say this again: @strong{You really can ignore all byte-compiler warnings!} -To byte-compile the source files, be sure you have access to the -@code{make(1)} program. In a shell, execute the following commands -(again, assuming you unpacked @ccmode{} version 5.00 in your home -directory@footnote{Of course, the version numbers will probably be -different.}): +To byte-compile the source files, first @code{cd} to the directory you +unpacked the tarball into. Then run the following command at your shell +prompt: @example -% cd ~/cc-mode-5.00 -% make +% $EMACS -batch -no-site-file -q -l cc-make.el cc-*.el @end example -By default, the @file{Makefile} assumes you are using XEmacs. If you -are using Emacs, execute this instead: - -@example - -% make EMACS=emacs - -@end example +@noindent +where $EMACS is either @code{emacs} or @code{xemacs} depending on the +version you use. Next time you start up Emacs you should be using the latest @ccmode{}. You can test this by visiting a C file and hitting @kbd{M-x c-version RET}; you should see this message in the echo area: @example -Using CC Mode version 5.00 +Using CC Mode version 5.XX @end example - @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @node New Indentation Engine, Minor Modes, Getting Connected, Top @comment node-name, next, previous, up @@ -289,11 +286,11 @@ @cindex relative buffer position The first thing @ccmode{} does when indenting a line of code, is to analyze the line, determining the @dfn{syntactic component list} of the -construct on that line. A @dfn{syntactic component} consists of a pair +construct on that line. A syntactic component consists of a pair of information (in lisp parlance, a @emph{cons cell}), where the first part is a @dfn{syntactic symbol}, and the second part is a @dfn{relative buffer position}. Syntactic symbols describe elements of C code -@footnote{or C++, Objective-C, or Java code. In general, for the rest +@footnote{or C++, Objective-C, Java or IDL code. In general, for the rest of this manual I'll use the term ``C code'' to refer to all the C-like dialects, unless otherwise noted.}, e.g. @code{statement}, @code{substatement}, @code{class-open}, @code{class-close}, etc. @@ -328,7 +325,7 @@ We can use the command @kbd{C-c C-s} (@code{c-show-syntactic-information}) to simply report what the syntactic analysis is for the current line. Running this command on -line 4 this example, we'd see in the echo area@footnote{With a universal +line 4 of this example, we'd see in the echo area@footnote{With a universal argument (i.e. @kbd{C-u C-c C-s}) the analysis is inserted into the buffer as a comment on the current line.}: @@ -548,9 +545,10 @@ The state of the minor modes is always reflected in the minor mode list on the modeline of the @ccmode{} buffer. When auto-newline mode is enabled, you will see @samp{C/a} on the mode line @footnote{Remember -that the @samp{C} could be replaced with @samp{C++}, @samp{ObjC}, or -@samp{Java}.}. When hungry delete mode is enabled you would see -@samp{C/h} and when both modes are enabled, you'd see @samp{C/ah}. +that the @samp{C} could be replaced with @samp{C++}, @samp{ObjC}, +@samp{Java} or @samp{IDL}.}. When hungry delete mode is enabled you +would see @samp{C/h} and when both modes are enabled, you'd see +@samp{C/ah}. @kindex C-c C-a @kindex C-c C-d @@ -634,12 +632,12 @@ @findex enable-//-in-c-mode (c-) Some characters are electric in some languages, and not in others. For example, the second slash (@kbd{/}) of a C++ style line comment is -electric in @code{c++-mode}, @code{objc-mode}, and @code{java-mode}, but -not in @code{c-mode}@footnote{Ordinarily, @samp{//} does not introduce a -comment in @code{c-mode}. However, if you call the function -@code{c-enable-//-in-c-mode}, @code{c-mode} will recognize C++ style -line comments. Note however that this is a global change which will -affect all your @code{c-mode} buffers.}. +electric in @code{c++-mode}, @code{objc-mode}, @code{java-mode}, and +@code{idl-mode}, but not in @code{c-mode}@footnote{Ordinarily, @samp{//} +does not introduce a comment in @code{c-mode}. However, if you call the +function @code{c-enable-//-in-c-mode}, @code{c-mode} will recognize C++ +style line comments. Note however that this is a global change which +will affect all your @code{c-mode} buffers.}. @menu @@ -777,7 +775,7 @@ @code{c-hanging-colons-alist}. The syntactic symbols appropriate for this assocation list are: @code{case-label}, @code{label}, @code{access-label}, @code{member-init-intro}, and @code{inher-intro}. -Note however, that for @code{c-hanging-colons-alist} @var{ACTION}s as +Note however that for @code{c-hanging-colons-alist}, @var{ACTION}s as functions are not supported. See also @ref{Custom Brace and Colon Hanging} for details. @@ -880,7 +878,7 @@ functionality provided by the @code{c-hanging-*-alist} variables, and similarly, clean-ups are only enabled when auto-newline minor mode is enabled. Clean-ups are used however to adjust code ``after-the-fact'', -i.e. to eliminate some whitespace that isn't inserted by electric +i.e. to eliminate some whitespace that is inserted by electric commands, or whitespace that contains intervening constructs. @cindex literal @@ -1085,7 +1083,7 @@ Similarly, hitting the @kbd{DEL} key runs the command @code{c-electric-delete}. Some versions of Emacs@footnote{As of this -writing, 20-Jun-1997, only XEmacs 20 supports this.} support separation +writing, 20-Jun-1997, only XEmacs 20.3 supports this.} support separation of the @kbd{Backspace} and @kbd{DEL} keys, so that @kbd{DEL} will delete in the forward direction when @code{delete-key-deletes-forward} is non-@code{nil}. If your Emacs supports this, and @@ -1152,8 +1150,7 @@ Some provision has been made to at least inform you as to the progress of the re-indentation. The variable @code{c-progress-interval} controls how often a progress message is displayed. Set this variable to -@code{nil} to inhibit progress messages. Note that this feature only -works with Emacs 19 and beyond. +@code{nil} to inhibit progress messages. Also, except as noted below, re-indentation is always driven by the same mechanisms that control on-the-fly indentation of code. @xref{New @@ -1200,7 +1197,7 @@ @findex indent-defun (c-) Another very convenient keystroke is @kbd{C-c C-q} (@code{c-indent-defun}) when re-indents the entire top-level function or -class definition that encompases point. It leaves point at the +class definition that encompasses point. It leaves point at the same position within the buffer. @kindex M-C-\ @@ -1298,14 +1295,14 @@ letter of each word is capitalized, and not separated by underscores. E.g. @samp{SymbolsWithMixedCaseAndNoUnderlines}. -This command moves point forward to end of a C++ nomenclature -section or word. With prefix argument @var{n}, move @var{n} times. +This command moves point forward to next capitalized word. With prefix +argument @var{n}, move @var{n} times. @item M-x c-backward-into-nomenclature @findex c-backward-into-nomenclature @findex backward-into-nomenclature (c-) -Move point backward to beginning of a C++ nomenclature -section or word. With prefix argument @var{n}, move @var{n} times. If +Move point backward to beginning of the next capitalized +word. With prefix argument @var{n}, move @var{n} times. If @var{n} is negative, move forward. @kindex C-c : @@ -1323,12 +1320,15 @@ @vindex c-hanging-comment-ender-p @vindex hanging-comment-starter-p (c-) @vindex hanging-comment-ender-p (c-) + The command is used to fill a block style (C) or line style (C++) comment, in much the same way that text in the various text modes can be -filled. You should never attempt to fill non-comment code sections; -you'll end up with garbage! Two variables control how C style block -comments are filled, specifically how the comment start and end -delimiters are handled. +filled@footnote{You should not use specialized filling packages such as +@code{filladapt} with CC Mode. They don't work as well for filling as +@code{c-fill-paragraph}}. You should never attempt to fill non-comment +code sections; you'll end up with garbage! Two variables control how C +style block comments are filled, specifically how the comment start and +end delimiters are handled. The variable @code{c-hanging-comment-starter-p} controls whether comment start delimiters which appear on a line by themselves, end up on a line @@ -1337,7 +1337,9 @@ separate line if it is not already on a separate line.}. Otherwise, text on the next line will be put on the same line as the comment starter. This is called @dfn{hanging} because the following text hangs -on the line with the comment starter. +on the line with the comment starter@footnote{This variable is @code{t} +by default, except in @code{java-mode}. Hanging comment starters mess +up Javadoc style comments.} The variable @code{c-hanging-comment-ender-p} controls the analogous behavior for the block comment end delimiter. When the value is @@ -1369,7 +1371,7 @@ to add for every syntactic symbol. You can use the command @kbd{C-c C-o} (@code{c-set-offset}) as the way to set offsets, both interactively and from your mode hook. Also, you can set up @emph{styles} of -indentation just like in BOCM. Most likely, you'll +indentatio. Most likely, you'll find one of the pre-defined styles will suit your needs, but if not, this section will describe how to set up basic editing configurations. @xref{Styles} for an explanation of how to set up named styles. @@ -1582,23 +1584,26 @@ @vindex c++-mode-hook @vindex objc-mode-hook @vindex java-mode-hook +@vindex idl-mode-hook +@vindex c-initialization-hook +@vindex initialization-hook (c-) @cindex hooks To make your changes permanent, you need to add some lisp code to your @file{.emacs} file, but first you need to decide whether your styles should be global in every buffer, or local to each specific buffer. -If you edit primarily one style of C (or C++, Objective-C, Java) code, -you may want to make the @ccmode{} style variables have global values so -that every buffer will share the style settings. This will allow you to -set the @ccmode{} variables at the top level of your @file{.emacs} -file. This is the default way @ccmode{} works. +If you edit primarily one style of code, you may want to make the +@ccmode{} style variables have global values so that every buffer will +share the style settings. This will allow you to set the @ccmode{} +variables at the top level of your @file{.emacs} file, and is the +way @ccmode{} works by default. @vindex c-mode-common-hook @vindex mode-common-hook (c-) @vindex c-style-variables-are-local-p @vindex style-variables-are-local-p (c-) -If you edit many different styles of C (or C++, Objective-C, Java) at -the same time, you probably want to make the @ccmode{} style variables +If you edit many different styles of code at +the same time, you might want to make the @ccmode{} style variables have buffer local values. If you do this, then you will need to set any @ccmode{} style variables in a hook function (e.g. off of @code{c-mode-common-hook} instead of at the top level of your @@ -1609,7 +1614,8 @@ @ccmode{} provides several hooks that you can use to customize the mode according to your coding style. Each language mode has its own hook, adhering to standard Emacs major mode -conventions. There is also one general hook: +conventions. There is also one general hook and one package +initialization hook: @itemize @bullet @@ -1622,12 +1628,17 @@ @item @code{java-mode-hook} --- for Java buffers only @item +@code{idl-mode-hook} --- for IDL buffers only +@item @code{c-mode-common-hook} --- common across all languages +@item +@code{c-initialization-hook} --- hook run only once per Emacs session, +when @ccmode{} is initialized. @end itemize The language hooks get run as the last thing when you enter that -language-specific mode. The @code{c-mode-common-hook} is run by all +language mode. The @code{c-mode-common-hook} is run by all supported modes @emph{before} the language specific hook, and thus can contain customizations that are common across all languages. Most of the examples in this section will assume you are using the common @@ -1635,8 +1646,8 @@ variables is slightly different than for the other modes. @code{java-mode} sets the style (see @ref{Styles}) of the buffer to @samp{java} @emph{before} running the @code{c-mode-common-hook} or -@code{java-mode-hook}. You need to be aware of this so any style -settings in @code{c-mode-common-hook} doesn't clobber your Java style.}. +@code{java-mode-hook}. You need to be aware of this so that style +settings in @code{c-mode-common-hook} don't clobber your Java style.}. Here's a simplified example of what you can add to your @file{.emacs} file to make the changes described in the previous section @@ -1647,7 +1658,7 @@ @group (defun my-c-mode-common-hook () - ;; my customizations for all of c-mode, c++-mode, objc-mode, java-mode + ;; my customizations for all of c-mode and related modes (c-set-offset 'substatement-open 0) ;; other customizations can go here ) @@ -1672,7 +1683,7 @@ and consistent styles. For example, their organization might impose a ``blessed'' style that all its programmers must conform to. Similarly, people who work on GNU software will have to use the GNU coding style on -C code. Some shops are more lenient, allowing some variety of coding +C code. Some shops are more lenient, allowing a variety of coding styles, and as programmers come and go, there could be a number of styles in use. For this reason, @ccmode{} makes it convenient for you to set up logical groupings of customizations called @dfn{styles}, @@ -1834,6 +1845,9 @@ non-@code{nil}, automatically applies the new style to the current buffer. +@comment TBD: The next paragraph is bogus. I really need to better +@comment document adding styles, including setting up inherited styles. + The sample @file{.emacs} file provides a concrete example of how a new style can be added and automatically set. @xref{Sample .emacs File}. @@ -1846,12 +1860,16 @@ @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @cindex local variables + The Emacs manual describes how you can customize certain variables on a per-file basis by including a @dfn{Local Variable} block at the end of -the file. So far, you've only seen a functional interface to -@ccmode{}, which is highly inconvenient for use in a Local Variable -block. @ccmode{} provides two variables that make it easier for -you to customize your style on a per-file basis. +the file. So far, you've only seen a functional interface to @ccmode{} +customization, which is highly inconvenient for use in a Local Variable +block. @ccmode{} provides two variables that make it easier for you to +customize your style on a per-file basis@footnote{Note that file styles +don't work with Emacs versions before XEmacs 19.12 and Emacs 19.29. +File styles work via the standard Emacs hook variable +@code{hack-local-variables-hook}.}. @vindex c-file-style @vindex file-style (c-) @@ -1872,11 +1890,7 @@ @code{c-set-offset}. Note that file style settings (i.e. @code{c-file-style}) are applied -before file offset settings (i.e. @code{c-file-offsets})@footnote{File -styles have only been supported since XEmacs 19.12 and Emacs 19.29. -They work via the standard Emacs hook variable -@code{hack-local-variables-hook}. Older Emacsen lack this hook, so file -styles can't be used with them.}. +before file offset settings (i.e. @code{c-file-offsets}). @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -1958,11 +1972,11 @@ syntactic symbol. Here, @code{stream-op} has an offset of @code{+}, and with a @code{c-basic-offset} of 2, you can see that lines 4 through 6 are simply indented two spaces to the right of line 3. But perhaps we'd -like @ccmode{} to be a little more intelligent so that it lines up +like @ccmode{} to be a little more intelligent so that it aligns all the @samp{<<} symbols in lines 3 through 6. To do this, we have to write a custom indentation function which finds the column of first -stream operator on the first line of the statement. Here is the lisp -code (from the @file{cc-mode.el} source file) that implements this: +stream operator on the first line of the statement. Here is sample +lisp code implementing this: @example @group @@ -1987,7 +2001,7 @@ operator is on, and the column of the buffer relative position passed in the function's argument. Remember that @ccmode{} automatically adds in the column of the component's relative buffer position and we -don't want that value added into the final total twice. +don't the column offset added in twice. @cindex stream-op syntactic symbol @findex c-lineup-streamop @@ -2072,15 +2086,17 @@ @findex lineup-comment (c-) @vindex c-comment-only-line-offset @vindex comment-only-line-offset (c-) -@code{c-lineup-comment} --- implements the old comment line up behavior -specified by the variable @code{c-comment-only-line-offset}. +@code{c-lineup-comment} --- lines up comment only lines according to +the variable @code{c-comment-only-line-offset}. @item @findex c-lineup-runin-statements @findex lineup-runin-statements (c-) @code{c-lineup-runin-statements} --- lines up @code{statement}s for coding standards which place the first statement in a block on the same line as -the block opening brace. +the block opening brace@footnote{Run-in style doesn't really work too +well. You might need to write your own custom indentation functions to +better support this style.}. @item @findex c-lineup-math @@ -2126,8 +2142,8 @@ Remember that @var{ACTION}'s are typically a list containing some combination of the symbols @code{before} and @code{after} (see @ref{Hanging Braces}). However, an @var{ACTION} can also be a function -symbol which gets called when a brace matching that syntactic symbol is -typed. +which gets called when a brace matching that syntactic symbol is +entered. @cindex customizing brace hanging These @var{ACTION} functions are called with two arguments: the @@ -2254,7 +2270,7 @@ (defun my-semicolon-criteria () (save-excursion - (if (and (= last-command-char ?\;) + (if (and (eq last-command-char ?\;) (zerop (forward-line 1)) (not (looking-at "^[ \t]*$"))) 'stop @@ -2495,7 +2511,7 @@ the brace that opens a top-level function definition. Line 9 is a @code{defun-close} since it contains the brace that closes the top-level function definition. Line 4 is a @code{defun-block-intro}, i.e. it is -the first line of a brace-block, which happens to be enclosed in a +the first line of a brace-block, enclosed in a top-level function definition. @cindex statement syntactic symbol @@ -2593,7 +2609,7 @@ @cindex in-class inline methods @cindex inline-open syntactic symbol @cindex inline-close syntactic symbol -But the line 11's analysis is a bit more complicated: +Line 11's analysis is a bit more complicated: @example @group @@ -2608,8 +2624,8 @@ definition. This is distinct from, but related to, the C++ notion of an inline function in that its definition occurs inside an enclosing class definition, which in C++ implies that the function should be inlined. -For example, if the definition of the @code{Bass} constructor appeared -outside the class definition, line 11 would be given the +If though, the definition of the @code{Bass} constructor appeared +outside the class definition, the construct would be given the @code{defun-open} syntax, even if the keyword @code{inline} appeared before the method name, as in: @example @@ -2998,7 +3014,7 @@ position higher up in the buffer from which to begin a forward scan. The farther this position is from the current insertion point, the slower the mode gets. Some coding styles can even force @ccmode{} -to scan from the beginning of the buffer! +to scan from the beginning of the buffer for every line of code! @findex beginning-of-defun @findex defun-prompt-regexp @@ -3030,7 +3046,7 @@ You will probably notice pathological behavior from @ccmode{} when working in files containing large amounts of cpp macros. This is -because @ccmode{} cannot quickly skip backwards over these lines. +because Emacs cannot be made to quickly skip backwards over these lines. @vindex c-recognize-knr-p @vindex recognize-knr-p (c-) @@ -3140,8 +3156,8 @@ @strong{Q.} @emph{How do I make strings, comments, keywords, and other constructs appear in different colors, or in bold face, etc.?} -@strong{A.} ``Syntax Colorization'' is an Emacs 19 feature, controlled -by @code{font-lock-mode}. It is not part of @ccmode{}. +@strong{A.} ``Syntax Colorization'' is a standard Emacs feature, +controlled by @code{font-lock-mode}. It is not part of @ccmode{}. @end quotation @@ -3154,10 +3170,12 @@ @cindex Getting the latest CC Mode release @comment !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -@ccmode{} is now distributed with Emacs 19, XEmacs 19, and XEmacs 20, so -you would typically just use the version that comes with your Emacs. -These may be slightly out of date due to release schedule skew, so you -should always check the canonical site for the latest version. +@ccmode{} is now standard with later versions Emacs 19 and XEmacs 19. +It is also the standard for XEmacs 20, and will be the standard for +Emacs 20 (unreleased as of this writing). You would typically just use +the version that comes with your X/Emacs. These may be slightly out of +date due to release schedule skew, so you should always check the +canonical site for the latest version. @example @group @@ -3251,9 +3269,9 @@ ;; we like auto-newline and hungry-delete (c-toggle-auto-hungry-state 1) ;; keybindings for all supported languages. We can put these in - ;; c-mode-map because c++-mode-map, objc-mode-map, and java-mode-map - ;; inherit from it. - (define-key c-mode-map "\C-m" 'newline-and-indent) + ;; c-mode-base-map because c-mode-map, c++-mode-map, objc-mode-map, + ;; java-mode-map, and idl-mode-map inherit from it. + (define-key c-mode-base-map "\C-m" 'newline-and-indent) ) (add-hook 'c-mode-common-hook 'my-c-mode-common-hook) @@ -3313,23 +3331,19 @@ Bug reports are now sent to the following email addresses: @code{cc-mode-help@@python.org} and @code{bug-gnu-emacs@@prep.ai.mit.edu}; the latter is mirrored on the -Usenet newsgroup @code{gnu.emacs.bug}. You can send other questions, -suggestions, and kudos to @code{cc-mode-help@@python.org}, or +Usenet newsgroup @code{gnu.emacs.bug}. You can send other questions and +suggestions (kudos? @code{;-)} to @code{cc-mode-help@@python.org}, or @code{help-gnu-emacs@@prep.ai.mit.edu} which is mirrored on newsgroup @code{gnu.emacs.help}. -There are two mailing lists for @ccmode{}. One is a general discussion -list and the other is an announce-only list. You do not need to -subscribe to either list, but if you want to, only subscribe to one of -these. Announcements of new releases get sent to both lists. To join -the general discussion list, send a message with the word -@emph{subscribe} in the body of the message to -@code{cc-mode-victims-request@@python.org}. To join just the -announce-only list, send a message with the word @emph{subscribe} in the -body of the message to @code{cc-mode-announce-request@@python.org}. -Both mailing lists are managed by Majordomo, and if you are successfully -subscribed, you will receive an email message with more information on -using the list. +If you want to get announcements of new CC Mode releases, send the +word @emph{subscribe} in the body of a message to +@code{cc-mode-announce-request@@python.org}. Announcements will also be +posted to the Usenet newsgroups @code{gnu.emacs.sources}, +@code{comp.emacs}, @code{comp.emacs.xemacs}, and possibly some of the +language oriented newsgroups. Note that the +@code{cc-mode-victims@@python.org} mailing list was recently +decommissioned. @c !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @node Concept Index, Command Index, Mailing Lists and Submitting Bug Reports, Top diff -r 6866abce6aaf -r 6075d714658b man/gnus-faq.texi --- a/man/gnus-faq.texi Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,659 +0,0 @@ -\input texinfo -@c -*-texinfo-*- -@c Copyright (C) 1995 Free Software Foundation, Inc. -@setfilename gnus-faq.info - -@node Frequently Asked Questions -@section Frequently Asked Questions - -This is the Gnus Frequently Asked Questions list. -If you have a Web browser, the official hypertext version is at -@file{http://www.ccs.neu.edu/software/gnus/}, and has -probably been updated since you got this manual. - -@menu -* Installation FAQ:: Installation of Gnus. -* Customization FAQ:: Customizing Gnus. -* Reading News FAQ:: News Reading Questions. -* Reading Mail FAQ:: Mail Reading Questions. -@end menu - - -@node Installation FAQ -@subsection Installation - -@itemize @bullet -@item -Q1.1 What is the latest version of Gnus? - -The latest (and greatest) version is 5.0.10. You might also run -across something called @emph{September Gnus}. September Gnus -is the alpha version of the next major release of Gnus. It is currently -not stable enough to run unless you are prepared to debug lisp. - -@item -Q1.2 Where do I get Gnus? - -Any of the following locations: - -@itemize @minus -@item -@file{ftp://ftp.ifi.uio.no/pub/emacs/gnus/gnus.tar.gz} - -@item -@file{ftp://ftp.pilgrim.umass.edu/pub/misc/ding/} - -@item -@file{gopher://gopher.pilgrim.umass.edu/11/pub/misc/ding/} - -@item -@file{ftp://aphrodite.nectar.cs.cmu.edu/pub/ding-gnus/} - -@item -@file{ftp://ftp.solace.mh.se:/pub/gnu/elisp/} - -@end itemize - -@item -Q1.3 Which version of Emacs do I need? - -At least GNU Emacs 19.28, or XEmacs 19.12 is recommended. GNU Emacs -19.25 has been reported to work under certain circumstances, but it -doesn't @emph{officially} work on it. 19.27 has also been reported to -work. Gnus has been reported to work under OS/2 as well as Unix. - - -@item -Q1.4 Where is timezone.el? - -Upgrade to XEmacs 19.13. In earlier versions of XEmacs this file was -placed with Gnus 4.1.3, but that has been corrected. - - -@item -Q1.5 When I run Gnus on XEmacs 19.13 I get weird error messages. - -You're running an old version of Gnus. Upgrade to at least version -5.0.4. - - -@item -Q1.6 How do I unsubscribe from the Mailing List? - -Send an e-mail message to @file{ding-request@@ifi.uio.no} with the magic word -@emph{unsubscribe} somewhere in it, and you will be removed. - -If you are reading the digest version of the list, send an e-mail message -to @* -@file{ding-rn-digests-d-request@@moe.shore.net} -with @emph{unsubscribe} as the subject and you will be removed. - - -@item -Q1.7 How do I run Gnus on both Emacs and XEmacs? - -The basic answer is to byte-compile under XEmacs, and then you can -run under either Emacsen. There is, however, a potential version -problem with easymenu.el with Gnu Emacs prior to 19.29. - -Per Abrahamsen writes :@* -The internal easymenu.el interface changed between 19.28 and 19.29 in -order to make it possible to create byte compiled files that can be -shared between Gnu Emacs and XEmacs. The change is upward -compatible, but not downward compatible. -This gives the following compatibility table: - -@example -Compiled with: | Can be used with: -----------------+-------------------------------------- -19.28 | 19.28 19.29 -19.29 | 19.29 XEmacs -XEmacs | 19.29 XEmacs -@end example - -If you have Gnu Emacs 19.28 or earlier, or XEmacs 19.12 or earlier, get -a recent version of auc-menu.el from -@file{ftp://ftp.iesd.auc.dk/pub/emacs-lisp/auc-menu.el}, and install it -under the name easymenu.el somewhere early in your load path. - - -@item -Q1.8 What resources are available? - -There is the newsgroup Gnu.emacs.gnus. Discussion of Gnus 5.x is now -taking place there. There is also a mailing list, send mail to -@file{ding-request@@ifi.uio.no} with the magic word @emph{subscribe} -somewhere in it. - -@emph{NOTE:} the traffic on this list is heavy so you may not want to be -on it (unless you use Gnus as your mailer reader, that is). The mailing -list is mainly for developers and testers. - -Gnus has a home World Wide Web page at@* -@file{http://www.ifi.uio.no/~larsi/ding.html}. - -Gnus has a write up in the X Windows Applications FAQ at@* -@file{http://www.ee.ryerson.ca:8080/~elf/xapps/Q-III.html}. - -The Gnus manual is also available on the World Wide Web. The canonical -source is in Norway at@* -@file{http://www.ifi.uio.no/~larsi/ding-manual/gnus_toc.html}. - -There are three mirrors in the United States: -@enumerate -@item -@file{http://www.miranova.com/gnus-man/} - -@item -@file{http://www.pilgrim.umass.edu/pub/misc/ding/manual/gnus_toc.html} - -@item -@file{http://www.rtd.com/~woo/gnus/} - -@end enumerate - -PostScript copies of the Gnus Reference card are available from@* -@file{ftp://ftp.cs.ualberta.ca/pub/oolog/gnus/}. They are mirrored at@* -@file{ftp://ftp.pilgrim.umass.edu/pub/misc/ding/refcard/} in the -United States. And@* -@file{ftp://marvin.fkphy.uni-duesseldorf.de/pub/gnus/} -in Germany. - -An online version of the Gnus FAQ is available at@* -@file{http://www.miranova.com/~steve/gnus-faq.html}. Off-line formats -are also available:@* -ASCII: @file{ftp://ftp.miranova.com/pub/gnus/gnus-faq}@* -PostScript: @file{ftp://ftp.miranova.com/pub/gnus/gnus-faq.ps}. - - -@item -Q1.9 Gnus hangs on connecting to NNTP server - -I am running XEmacs on SunOS and Gnus prints a message about Connecting -to NNTP server and then just hangs. - -Ben Wing writes :@* -I wonder if you're hitting the infamous @emph{libresolv} problem. -The basic problem is that under SunOS you can compile either -with DNS or NIS name lookup libraries but not both. Try -substituting the IP address and see if that works; if so, you -need to download the sources and recompile. - - -@item -Q1.10 Mailcrypt 3.4 doesn't work - -This problem is verified to still exist in Gnus 5.0.9 and Mailcrypt 3.4. -The answer comes from Peter Arius -. - -I found out that mailcrypt uses -@code{gnus-eval-in-buffer-window}, which is a macro. -It seems as if you have -compiled mailcrypt with plain old GNUS in load path, and the XEmacs byte -compiler has inserted that macro definition into -@file{mc-toplev.elc}. -The solution is to recompile @file{mc-toplev.el} with Gnus 5 in -load-path, and it works fine. - -Steve Baur adds :@* -The problem also manifests itself if neither GNUS 4 nor Gnus 5 is in the -load-path. - - -@item -Q1.11 What other packages work with Gnus? - -@itemize @minus -@item -Mailcrypt. - -Mailcrypt is an Emacs interface to PGP. It works, it installs -without hassle, and integrates very easily. Mailcrypt can be -obtained from@* -@file{ftp://cag.lcs.mit.edu/pub/patl/mailcrypt-3.4.tar.gz}. - -@item -Tools for Mime. - -Tools for Mime is an Emacs MUA interface to MIME. Installation is -a two-step process unlike most other packages, so you should -be prepared to move the byte-compiled code somewhere. There -are currently two versions of this package available. It can -be obtained from@* -@file{ftp://ftp.jaist.ac.jp/pub/GNU/elisp/}. -Be sure to apply the supplied patch. It works with Gnus through -version 5.0.9. In order for all dependencies to work correctly -the load sequence is as follows: -@lisp - (load "tm-setup") - (load "gnus") - (load "mime-compose") -@end lisp - -@emph{NOTE:} Loading the package disables citation highlighting by -default. To get the old behavior back, use the @kbd{M-t} command. - -@end itemize - -@end itemize - - -@node Customization FAQ -@subsection Customization - -@itemize @bullet -@item -Q2.1 Custom Edit does not work under XEmacs - -The custom package has not been ported to XEmacs. - - -@item -Q2.2 How do I quote messages? - -I see lots of messages with quoted material in them. I am wondering -how to have Gnus do it for me. - -This is Gnus, so there are a number of ways of doing this. You can use -the built-in commands to do this. There are the @kbd{F} and @kbd{R} -keys from the summary buffer which automatically include the article -being responded to. These commands are also selectable as @i{Followup -and Yank} and @i{Reply and Yank} in the Post menu. - -@kbd{C-c C-y} grabs the previous message and prefixes each line with -@code{ail-indentation-spaces} spaces or @code{mail-yank-prefix} if that is -non-nil, unless you have set your own @code{mail-citation-hook}, which will -be called to do the job. - -You might also consider the Supercite package, which allows for pretty -arbitrarily complex quoting styles. Some people love it, some people -hate it. - - -@item -Q2.3 How can I keep my nnvirtual:* groups sorted? - -How can I most efficiently arrange matters so as to keep my nnvirtual:* -(etc) groups at the top of my group selection buffer, whilst keeping -everything sorted in alphabetical order. - -If you don't subscribe often to new groups then the easiest way is to -first sort the groups and then manually kill and yank the virtuals -wherever you want them. - - -@item -Q2.4 Any good suggestions on stuff for an all.SCORE file? - -Here is a collection of suggestions from the Gnus mailing list. - -@enumerate -@item -From ``Dave Disser'' @* -I like blasting anything without lowercase letters. Weeds out most of -the make $$ fast, as well as the lame titles like ``IBM'' and ``HP-UX'' -with no further description. -@lisp - (("Subject" - ("^\\(Re: \\)?[^a-z]*$" -200 nil R))) -@end lisp - -@item -From ``Peter Arius'' @* -The most vital entries in my (still young) all.SCORE: -@lisp -(("xref" - ("alt.fan.oj-simpson" -1000 nil s)) - ("subject" - ("\\<\\(make\\|fast\\|big\\)\\s-*\\(money\\|cash\\|bucks?\\)\\>" -1000 nil r) - ("$$$$" -1000 nil s))) -@end lisp - -@item -From ``Per Abrahamsen'' @* -@lisp -(("subject" - ;; CAPS OF THE WORLD, UNITE - ("^..[^a-z]+$" -1 nil R) - ;; $$$ Make Money $$$ (Try work) - ("$" -1 nil s) - ;; I'm important! And I have exclamation marks to prove it! - ("!" -1 nil s))) -@end lisp - -@item -From ``heddy boubaker'' @* -I would like to contribute with mine. -@lisp -( - (read-only t) - ("subject" - ;; ALL CAPS SUBJECTS - ("^\\([Rr][Ee]: +\\)?[^a-z]+$" -1 nil R) - ;; $$$ Make Money $$$ - ("$$" -10 nil s) - ;; Empty subjects are worthless! - ("^ *\\([(<]none[>)]\\|(no subject\\( given\\)?)\\)? *$" -10 nil r) - ;; Sometimes interesting announces occur! - ("ANN?OU?NC\\(E\\|ING\\)" +10 nil r) - ;; Some people think they're on mailing lists - ("\\(un\\)?sub?scribe" -100 nil r) - ;; Stop Micro$oft NOW!! - ("\\(m\\(icro\\)?[s$]\\(oft\\|lot\\)?-?\\)?wind?\\(ows\\|aube\\|oze\\)?[- ]*\\('?95\\|NT\\|3[.]1\\|32\\)" -1001 nil r) - ;; I've nothing to buy - ("\\(for\\|4\\)[- ]*sale" -100 nil r) - ;; SELF-DISCIPLINED people - ("\\[[^a-z0-9 \t\n][^a-z0-9 \t\n]\\]" +100 nil r) - ) - ("from" - ;; To keep track of posters from my site - (".dgac.fr" +1000 nil s)) - ("followup" - ;; Keep track of answers to my posts - ("boubaker" +1000 nil s)) - ("lines" - ;; Some people have really nothing to say!! - (1 -10 nil <=)) - (mark -100) - (expunge -1000) - ) -@end lisp - -@item -From ``Christopher Jones'' @* -The sample @file{all.SCORE} files from Per and boubaker could be -augmented with: -@lisp - (("subject" - ;; No junk mail please! - ("please ignore" -500 nil s) - ("test" -500 nil e)) - ) -@end lisp - -@item -From ``Brian Edmonds'' @* -Augment any of the above with a fast method of scoring down -excessively cross posted articles. -@lisp - ("xref" - ;; the more cross posting, the exponentially worse the article - ("^xref: \\S-+ \\S-+ \\S-+ \\S-+" -1 nil r) - ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -2 nil r) - ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -4 nil r) - ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -8 nil r) - ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -16 nil r) - ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -32 nil r) - ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -64 nil r) - ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -128 nil r) - ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -256 nil r) - ("^xref: \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+" -512 nil r)) -@end lisp - -@end enumerate - - -@item -Q2.5 What do I use to yank-through when replying? - -You should probably reply and followup with @kbd{R} and @kbd{F}, instead -of @kbd{r} and @kbd{f}, which solves your problem. But you could try -something like: - -@example -(defconst mail-yank-ignored-headers - "^.*:" - "Delete these headers from old message when it's inserted in a reply.") -@end example - - -@item -Q2.6 I don't like the default WWW browser - -Now when choosing an URL Gnus starts up a W3 buffer, I would like it -to always use Netscape (I don't browse in text-mode ;-). - -@enumerate -@item -Activate `Customize...' from the `Help' menu. - -@item -Scroll down to the `WWW Browser' field. - -@item -Click `mouse-2' on `WWW Browser'. - -@item -Select `Netscape' from the pop up menu. - -@item -Press `C-c C-c' - -@end enumerate - -If you are using XEmacs then to specify Netscape do -@lisp - (setq gnus-button-url 'gnus-netscape-open-url) -@end lisp - - -@item -Q2.7 What, if any, relation is between ``ask-server'' and ``(setq -gnus-read-active-file 'some)''? - -In order for Gnus to show you the complete list of newsgroups, it will -either have to either store the list locally, or ask the server to -transmit the list. You enable the first with - -@lisp - (setq gnus-save-killed-list t) -@end lisp - -and the second with - -@lisp - (setq gnus-read-active-file t) -@end lisp - -If both are disabled, Gnus will not know what newsgroups exists. There -is no option to get the list by casting a spell. - - -@item -Q2.8 Moving between groups is slow. - -Per Abrahamsen writes:@* - -Do you call @code{define-key} or something like that in one of the -summary mode hooks? This would force Emacs to recalculate the keyboard -shortcuts. Removing the call should speed up @kbd{M-x gnus-summary-mode -RET} by a couple of orders of magnitude. You can use - -@lisp -(define-key gnus-summary-mode-map KEY COMMAND) -@end lisp - -in your @file{.gnus} instead. - -@end itemize - - -@node Reading News FAQ -@subsection Reading News - -@itemize @bullet -@item -Q3.1 How do I convert my kill files to score files? - -A kill-to-score translator was written by Ethan Bradford -. It is available from@* -@file{http://baugi.ifi.uio.no/~larsi/ding-various/gnus-kill-to-score.el}. - - -@item -Q3.2 My news server has a lot of groups, and killing groups is painfully -slow. - -Don't do that then. The best way to get rid of groups that should be -dead is to edit your newsrc directly. This problem will be addressed -in the near future. - - -@item -Q3.3 How do I use an NNTP server with authentication? - -Put the following into your .gnus: -@lisp - (add-hook 'nntp-server-opened-hook 'nntp-send-authinfo) -@end lisp - - -@item -Q3.4 Not reading the first article. - -How do I avoid reading the first article when a group is selected? - -@enumerate -@item -Use @kbd{RET} to select the group instead of @kbd{SPC}. - -@item -@code{(setq gnus-auto-select first nil)} - -@item -Luis Fernandes writes:@* -This is what I use...customize as necessary... - -@lisp -;;; Don't auto-select first article if reading sources, or archives or -;;; jobs postings, etc. and just display the summary buffer -(add-hook 'gnus-select-group-hook - (function - (lambda () - (cond ((string-match "sources" gnus-newsgroup-name) - (setq gnus-auto-select-first nil)) - ((string-match "jobs" gnus-newsgroup-name) - (setq gnus-auto-select-first nil)) - ((string-match "comp\\.archives" gnus-newsgroup-name) - (setq gnus-auto-select-first nil)) - ((string-match "reviews" gnus-newsgroup-name) - (setq gnus-auto-select-first nil)) - ((string-match "announce" gnus-newsgroup-name) - (setq gnus-auto-select-first nil)) - ((string-match "binaries" gnus-newsgroup-name) - (setq gnus-auto-select-first nil)) - (t - (setq gnus-auto-select-first t)))))) -@end lisp - -@item -Per Abrahamsen writes:@* -Another possibility is to create an @file{all.binaries.all.SCORE} file -like this: - -@lisp -((local - (gnus-auto-select-first nil))) -@end lisp - -and insert -@lisp - (setq gnus-auto-select-first t) -@end lisp - -in your @file{.gnus}. - -@end enumerate - -@item -Q3.5 Why aren't BBDB known posters marked in the summary buffer? - -Brian Edmonds writes:@* -Due to changes in Gnus 5.0, @file{bbdb-gnus.el} no longer marks known -posters in the summary buffer. An updated version, @file{gnus-bbdb.el} -is available at the locations listed below. This package also supports -autofiling of incoming mail to folders specified in the BBDB. Extensive -instructions are included as comments in the file. - -Send mail to @file{majordomo@@edmonds.home.cs.ubc.ca} with the following -line in the body of the message: @emph{get misc gnus-bbdb.el}. - -Or get it from the World Wide Web:@* -@file{http://www.cs.ubc.ca/spider/edmonds/gnus-bbdb.el}. - -@end itemize - - -@node Reading Mail FAQ -@subsection Reading Mail - -@itemize @bullet -@item -Q4.1 What does the message ``Buffer has changed on disk'' mean in a mail -group? - -Your filter program should not deliver mail directly to your folders, -instead it should put the mail into spool files. Gnus will then move -the mail safely from the spool files into the folders. This will -eliminate the problem. Look it up in the manual, in the section -entitled ``Mail & Procmail''. - - -@item -Q4.2 How do you make articles un-expirable? - -I am using nnml to read news and have used -@code{gnus-auto-expirable-newsgroups} to automagically expire articles -in some groups (Gnus being one of them). Sometimes there are -interesting articles in these groups that I want to keep. Is there any -way of explicitly marking an article as un-expirable - that is mark it -as read but not expirable? - -Use @kbd{u}, @kbd{!}, @kbd{d} or @kbd{M-u} in the summary buffer. You -just remove the @kbd{E} mark by setting some other mark. It's not -necessary to tick the articles. - - -@item -Q4.3 How do I delete bogus nnml: groups? - -My problem is that I have various mail (nnml) groups generated while -experimenting with Gnus. How do I remove them now? Setting the level to -9 does not help. Also @code{gnus-group-check-bogus-groups} does not -recognize them. - -Removing mail groups is tricky at the moment. (It's on the to-do list, -though.) You basically have to kill the groups in Gnus, shut down Gnus, -edit the active file to exclude these groups, and probably remove the -nnml directories that contained these groups as well. Then start Gnus -back up again. - - -@item -Q4.4 What happened to my new mail groups? - -I got new mail, but I have -never seen the groups they should have been placed in. - -They are probably there, but as zombies. Press @kbd{A z} to list -zombie groups, and then subscribe to the groups you want with @kbd{u}. -This is all documented quite nicely in the user's manual. - - -@item -Q4.5 Not scoring mail groups - -How do you @emph{totally} turn off scoring in mail groups? - -Use an nnbabyl:all.SCORE (or nnmh, or nnml, or whatever) file containing: - -@example -((adapt ignore) - (local (gnus-use-scoring nil)) - (exclude-files "all.SCORE")) -@end example - -@end itemize - - diff -r 6866abce6aaf -r 6075d714658b man/gnus.texi --- a/man/gnus.texi Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,16866 +0,0 @@ -\input texinfo @c -*-texinfo-*- - -@setfilename gnus -@settitle Gnus 5.4.63 Manual -@synindex fn cp -@synindex vr cp -@synindex pg cp -@iftex -@finalout -@end iftex -@setchapternewpage odd - -@iftex -@iflatex -\documentclass[twoside,a4paper,openright,11pt]{book} -\usepackage[latin1]{inputenc} -\usepackage{pagestyle} -\usepackage{epsfig} -\usepackage{bembo} - -\makeindex -\begin{document} - -\newcommand{\gnuschaptername}{} -\newcommand{\gnussectionname}{} - -\newcommand{\gnusbackslash}{/} - -\newcommand{\gnusxref}[1]{See ``#1'' on page \pageref{#1}} -\newcommand{\gnuspxref}[1]{see ``#1'' on page \pageref{#1}} - -\newcommand{\gnuskindex}[1]{\index{#1}} -\newcommand{\gnusindex}[1]{\index{#1}} - -\newcommand{\gnustt}[1]{{\fontfamily{pfu}\fontsize{10pt}{10}\selectfont #1}} -\newcommand{\gnuscode}[1]{\gnustt{#1}} -\newcommand{\gnussamp}[1]{``{\fontencoding{OT1}\fontfamily{pcr}\fontsize{10pt}{10}\selectfont #1}''} -\newcommand{\gnuslisp}[1]{\gnustt{#1}} -\newcommand{\gnuskbd}[1]{`\gnustt{#1}'} -\newcommand{\gnusfile}[1]{`\gnustt{#1}'} -\newcommand{\gnusdfn}[1]{\textit{#1}} -\newcommand{\gnusi}[1]{\textit{#1}} -\newcommand{\gnusstrong}[1]{\textbf{#1}} -\newcommand{\gnusemph}[1]{\textit{#1}} -\newcommand{\gnusvar}[1]{{\fontsize{10pt}{10}\selectfont\textsl{\textsf{#1}}}} -\newcommand{\gnussc}[1]{\textsc{#1}} -\newcommand{\gnustitle}[1]{{\huge\textbf{#1}}} -\newcommand{\gnusauthor}[1]{{\large\textbf{#1}}} - -\newcommand{\gnusbullet}{{${\bullet}$}} -\newcommand{\gnusdollar}{\$} -\newcommand{\gnusampersand}{\&} -\newcommand{\gnuspercent}{\%} -\newcommand{\gnushash}{\#} -\newcommand{\gnushat}{\symbol{"5E}} -\newcommand{\gnusunderline}{\symbol{"5F}} -\newcommand{\gnusnot}{$\neg$} -\newcommand{\gnustilde}{\symbol{"7E}} -\newcommand{\gnusless}{{$<$}} -\newcommand{\gnusgreater}{{$>$}} - -\newcommand{\gnushead}{\raisebox{-1cm}{\epsfig{figure=gnus-head.eps,height=1cm}}} -\newcommand{\gnusinteresting}{ -\marginpar[\mbox{}\hfill\gnushead]{\gnushead} -} - -\newcommand{\gnuscleardoublepage}{\ifodd\count0\mbox{}\clearpage\thispagestyle{empty}\mbox{}\clearpage\else\clearpage\fi} - -\newcommand{\gnuspagechapter}[1]{ -{\mbox{}} -} - -\newdimen{\gnusdimen} -\gnusdimen 0pt - -\newcommand{\gnuschapter}[2]{ -\gnuscleardoublepage -\ifdim \gnusdimen = 0pt\setcounter{page}{1}\pagestyle{gnus}\pagenumbering{arabic} \gnusdimen 1pt\fi -\chapter{#2} -\renewcommand{\gnussectionname}{} -\renewcommand{\gnuschaptername}{#2} -\thispagestyle{empty} -\hspace*{-2cm} -\begin{picture}(500,500)(0,0) -\put(480,350){\makebox(0,0)[tr]{#1}} -\put(40,300){\makebox(500,50)[bl]{{\Huge\bf{#2}}}} -\end{picture} -\clearpage -} - -\newcommand{\gnusfigure}[3]{ -\begin{figure} -\mbox{}\ifodd\count0\hspace*{-0.8cm}\else\hspace*{-3cm}\fi\begin{picture}(440,#2) -#3 -\end{picture} -\caption{#1} -\end{figure} -} - -\newcommand{\gnusicon}[1]{ -\marginpar[\mbox{}\hfill\raisebox{-1.5cm}{\epsfig{figure=tmp/#1-up.ps,height=1.5cm}}]{\raisebox{-1cm}{\epsfig{figure=tmp/#1-up.ps,height=1cm}}} -} - -\newcommand{\gnuspicon}[1]{ -\marginpar[\mbox{}\hfill\epsfig{figure=#1,height=1.5cm}]{\epsfig{figure=#1,height=1.5cm}} -} - -\newcommand{\gnusxface}[1]{ -\marginpar[\mbox{}\hfill\epsfig{figure=#1,height=1cm}]{\epsfig{figure=#1,height=1cm}} -} - - -\newcommand{\gnusitemx}[1]{\mbox{}\vspace*{-\itemsep}\vspace*{-\parsep}\item#1} - -\newcommand{\gnussection}[1]{ -\renewcommand{\gnussectionname}{#1} -\section{#1} -} - -\newenvironment{codelist}% -{\begin{list}{}{ -} -}{\end{list}} - -\newenvironment{kbdlist}% -{\begin{list}{}{ -\labelwidth=0cm -} -}{\end{list}} - -\newenvironment{dfnlist}% -{\begin{list}{}{ -} -}{\end{list}} - -\newenvironment{stronglist}% -{\begin{list}{}{ -} -}{\end{list}} - -\newenvironment{samplist}% -{\begin{list}{}{ -} -}{\end{list}} - -\newenvironment{varlist}% -{\begin{list}{}{ -} -}{\end{list}} - -\newenvironment{emphlist}% -{\begin{list}{}{ -} -}{\end{list}} - -\newlength\gnusheadtextwidth -\setlength{\gnusheadtextwidth}{\headtextwidth} -\addtolength{\gnusheadtextwidth}{1cm} - -\newpagestyle{gnuspreamble}% -{ -{ -\ifodd\count0 -{ -\hspace*{-0.23cm}\underline{\makebox[\gnusheadtextwidth]{\mbox{}}\textbf{\hfill\roman{page}}} -} -\else -{ -\hspace*{-3.25cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\roman{page}\hfill\mbox{}}} -} -} -\fi -} -} -{ -\ifodd\count0 -\mbox{} \hfill -\raisebox{-0.5cm}{\epsfig{figure=gnus-big-logo.eps,height=1cm}} -\else -\raisebox{-0.5cm}{\epsfig{figure=gnus-big-logo.eps,height=1cm}} -\hfill \mbox{} -\fi -} - -\newpagestyle{gnusindex}% -{ -{ -\ifodd\count0 -{ -\hspace*{-0.23cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\gnuschaptername\hfill\arabic{page}}}} -} -\else -{ -\hspace*{-3.25cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\arabic{page}\hfill\gnuschaptername}}} -} -\fi -} -} -{ -\ifodd\count0 -\mbox{} \hfill -\raisebox{-0.5cm}{\epsfig{figure=gnus-big-logo.eps,height=1cm}} -\else -\raisebox{-0.5cm}{\epsfig{figure=gnus-big-logo.eps,height=1cm}} -\hfill \mbox{} -\fi -} - -\newpagestyle{gnus}% -{ -{ -\ifodd\count0 -{ -\makebox[12cm]{\hspace*{3.1cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\arabic{chapter}.\arabic{section}} \textbf{\gnussectionname\hfill\arabic{page}}}}} -} -\else -{ -\makebox[12cm]{\hspace*{-2.95cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\arabic{page}\hfill\gnuschaptername}}}} -} -\fi -} -} -{ -\ifodd\count0 -\mbox{} \hfill -\raisebox{-0.5cm}{\epsfig{figure=gnus-big-logo.eps,height=1cm}} -\else -\raisebox{-0.5cm}{\epsfig{figure=gnus-big-logo.eps,height=1cm}} -\hfill \mbox{} -\fi -} - -\pagenumbering{roman} -\pagestyle{gnuspreamble} - -@end iflatex -@end iftex - -@iftex -@iflatex -\begin{titlepage} -{ - -%\addtolength{\oddsidemargin}{-5cm} -%\addtolength{\evensidemargin}{-5cm} -\parindent=0cm -\addtolength{\textheight}{2cm} - -\gnustitle{\gnustitlename}\\ -\rule{15cm}{1mm}\\ -\vfill -\hspace*{0cm}\epsfig{figure=gnus-big-logo.eps,height=15cm} -\vfill -\rule{15cm}{1mm}\\ -\gnusauthor{by Lars Magne Ingebrigtsen} -\newpage -} - -\mbox{} -\vfill - -\thispagestyle{empty} - -Copyright \copyright{} 1995,96 Free Software Foundation, Inc. - -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. - -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the -entire resulting derived work is distributed under the terms of a -permission notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions. - -\newpage -\end{titlepage} -@end iflatex -@end iftex - -@ifinfo - -This file documents Gnus, the GNU Emacs newsreader. - -Copyright (C) 1995,96 Free Software Foundation, Inc. - -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. - -@ignore -Permission is granted to process this file through Tex and print the -results, provided the printed document carries copying permission -notice identical to this one except for the removal of this paragraph -(this paragraph not being relevant to the printed manual). - -@end ignore -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided also that the -entire resulting derived work is distributed under the terms of a -permission notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions. -@end ifinfo - -@tex - -@titlepage -@title Gnus 5.4.63 Manual - -@author by Lars Magne Ingebrigtsen -@page - -@vskip 0pt plus 1filll -Copyright @copyright{} 1995,96,97 Free Software Foundation, Inc. - -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. - -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the -entire resulting derived work is distributed under the terms of a -permission notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions. - -@end titlepage -@page - -@end tex - - -@node Top -@top The Gnus Newsreader - -@ifinfo - -You can read news (and mail) from within Emacs by using Gnus. The news -can be gotten by any nefarious means you can think of---@sc{nntp}, local -spool or your mbox file. All at the same time, if you want to push your -luck. - -This manual corresponds to Gnus 5.4.63. - -@end ifinfo - -@iftex - -@iflatex -\tableofcontents -\gnuscleardoublepage -@end iflatex - -Gnus is the advanced, self-documenting, customizable, extensible -unreal-time newsreader for GNU Emacs. - -Oops. That sounds oddly familiar, so let's start over again to avoid -being accused of plagiarism: - -Gnus is a message-reading laboratory. It will let you look at just -about anything as if it were a newsgroup. You can read mail with it, -you can browse directories with it, you can @code{ftp} with it---you can -even read news with it! - -Gnus tries to empower people who read news the same way Emacs empowers -people who edit text. Gnus sets no limits to what the user should be -allowed to do. Users are encouraged to extend Gnus to make it behave -like they want it to behave. A program should not control people; -people should be empowered to do what they want by using (or abusing) -the program. - -@end iftex - - -@menu -* Starting Up:: Finding news can be a pain. -* The Group Buffer:: Selecting, subscribing and killing groups. -* The Summary Buffer:: Reading, saving and posting articles. -* The Article Buffer:: Displaying and handling articles. -* Composing Messages:: Information on sending mail and news. -* Select Methods:: Gnus reads all messages from various select methods. -* Scoring:: Assigning values to articles. -* Various:: General purpose settings. -* The End:: Farewell and goodbye. -* Appendices:: Terminology, Emacs intro, FAQ, History, Internals. -* Index:: Variable, function and concept index. -* Key Index:: Key Index. -@end menu - -@node Starting Up -@chapter Starting Gnus -@cindex starting up - -@kindex M-x gnus -@findex gnus -If your system administrator has set things up properly, starting Gnus -and reading news is extremely easy---you just type @kbd{M-x gnus} in -your Emacs. - -@findex gnus-other-frame -@kindex M-x gnus-other-frame -If you want to start Gnus in a different frame, you can use the command -@kbd{M-x gnus-other-frame} instead. - -If things do not go smoothly at startup, you have to twiddle some -variables. - -@menu -* Finding the News:: Choosing a method for getting news. -* The First Time:: What does Gnus do the first time you start it? -* The Server is Down:: How can I read my mail then? -* Slave Gnusae:: You can have more than one Gnus active at a time. -* Fetching a Group:: Starting Gnus just to read a group. -* New Groups:: What is Gnus supposed to do with new groups? -* Startup Files:: Those pesky startup files---@file{.newsrc}. -* Auto Save:: Recovering from a crash. -* The Active File:: Reading the active file over a slow line Takes Time. -* Changing Servers:: You may want to move from one server to another. -* Startup Variables:: Other variables you might change. -@end menu - - -@node Finding the News -@section Finding the News -@cindex finding news - -@vindex gnus-select-method -@c @head -The @code{gnus-select-method} variable says where Gnus should look for -news. This variable should be a list where the first element says -@dfn{how} and the second element says @dfn{where}. This method is your -native method. All groups not fetched with this method are -foreign groups. - -For instance, if the @samp{news.somewhere.edu} @sc{nntp} server is where -you want to get your daily dosage of news from, you'd say: - -@lisp -(setq gnus-select-method '(nntp "news.somewhere.edu")) -@end lisp - -If you want to read directly from the local spool, say: - -@lisp -(setq gnus-select-method '(nnspool "")) -@end lisp - -If you can use a local spool, you probably should, as it will almost -certainly be much faster. - -@vindex gnus-nntpserver-file -@cindex NNTPSERVER -@cindex @sc{nntp} server -If this variable is not set, Gnus will take a look at the -@code{NNTPSERVER} environment variable. If that variable isn't set, -Gnus will see whether @code{gnus-nntpserver-file} -(@file{/etc/nntpserver} by default) has any opinions on the matter. If -that fails as well, Gnus will try to use the machine running Emacs as an @sc{nntp} server. That's a long shot, though. - -@vindex gnus-nntp-server -If @code{gnus-nntp-server} is set, this variable will override -@code{gnus-select-method}. You should therefore set -@code{gnus-nntp-server} to @code{nil}, which is what it is by default. - -@vindex gnus-secondary-servers -You can also make Gnus prompt you interactively for the name of an -@sc{nntp} server. If you give a non-numerical prefix to @code{gnus} -(i.e., @kbd{C-u M-x gnus}), Gnus will let you choose between the servers -in the @code{gnus-secondary-servers} list (if any). You can also just -type in the name of any server you feel like visiting. - -@findex gnus-group-browse-foreign-server -@kindex B (Group) -However, if you use one @sc{nntp} server regularly and are just -interested in a couple of groups from a different server, you would be -better served by using the @kbd{B} command in the group buffer. It will -let you have a look at what groups are available, and you can subscribe -to any of the groups you want to. This also makes @file{.newsrc} -maintenance much tidier. @xref{Foreign Groups}. - -@vindex gnus-secondary-select-methods -@c @head -A slightly different approach to foreign groups is to set the -@code{gnus-secondary-select-methods} variable. The select methods -listed in this variable are in many ways just as native as the -@code{gnus-select-method} server. They will also be queried for active -files during startup (if that's required), and new newsgroups that -appear on these servers will be subscribed (or not) just as native -groups are. - -For instance, if you use the @code{nnmbox} backend to read your mail, you -would typically set this variable to - -@lisp -(setq gnus-secondary-select-methods '((nnmbox ""))) -@end lisp - - -@node The First Time -@section The First Time -@cindex first time usage - -If no startup files exist, Gnus will try to determine what groups should -be subscribed by default. - -@vindex gnus-default-subscribed-newsgroups -If the variable @code{gnus-default-subscribed-newsgroups} is set, Gnus -will subscribe you to just those groups in that list, leaving the rest -killed. Your system administrator should have set this variable to -something useful. - -Since she hasn't, Gnus will just subscribe you to a few arbitrarily -picked groups (i.e., @samp{*.newusers}). (@dfn{Arbitrary} is defined -here as @dfn{whatever Lars thinks you should read}.) - -You'll also be subscribed to the Gnus documentation group, which should -help you with most common problems. - -If @code{gnus-default-subscribed-newsgroups} is @code{t}, Gnus will just -use the normal functions for handling new groups, and not do anything -special. - - -@node The Server is Down -@section The Server is Down -@cindex server errors - -If the default server is down, Gnus will understandably have some -problems starting. However, if you have some mail groups in addition to -the news groups, you may want to start Gnus anyway. - -Gnus, being the trusting sort of program, will ask whether to proceed -without a native select method if that server can't be contacted. This -will happen whether the server doesn't actually exist (i.e., you have -given the wrong address) or the server has just momentarily taken ill -for some reason or other. If you decide to continue and have no foreign -groups, you'll find it difficult to actually do anything in the group -buffer. But, hey, that's your problem. Blllrph! - -@findex gnus-no-server -@kindex M-x gnus-no-server -@c @head -If you know that the server is definitely down, or you just want to read -your mail without bothering with the server at all, you can use the -@code{gnus-no-server} command to start Gnus. That might come in handy -if you're in a hurry as well. This command will not attempt to contact -your primary server---instead, it will just activate all groups on level -1 and 2. (You should preferably keep no native groups on those two -levels.) - - -@node Slave Gnusae -@section Slave Gnusae -@cindex slave - -You might want to run more than one Emacs with more than one Gnus at the -same time. If you are using different @file{.newsrc} files (e.g., if you -are using the two different Gnusae to read from two different servers), -that is no problem whatsoever. You just do it. - -The problem appears when you want to run two Gnusae that use the same -@code{.newsrc} file. - -To work around that problem some, we here at the Think-Tank at the Gnus -Towers have come up with a new concept: @dfn{Masters} and -@dfn{slaves}. (We have applied for a patent on this concept, and have -taken out a copyright on those words. If you wish to use those words in -conjunction with each other, you have to send $1 per usage instance to -me. Usage of the patent (@dfn{Master/Slave Relationships In Computer -Applications}) will be much more expensive, of course.) - -Anyways, you start one Gnus up the normal way with @kbd{M-x gnus} (or -however you do it). Each subsequent slave Gnusae should be started with -@kbd{M-x gnus-slave}. These slaves won't save normal @file{.newsrc} -files, but instead save @dfn{slave files} that contain information only -on what groups have been read in the slave session. When a master Gnus -starts, it will read (and delete) these slave files, incorporating all -information from them. (The slave files will be read in the sequence -they were created, so the latest changes will have precedence.) - -Information from the slave files has, of course, precedence over the -information in the normal (i.e., master) @code{.newsrc} file. - - -@node Fetching a Group -@section Fetching a Group -@cindex fetching a group - -@findex gnus-fetch-group -It is sometimes convenient to be able to just say ``I want to read this -group and I don't care whether Gnus has been started or not''. This is -perhaps more useful for people who write code than for users, but the -command @code{gnus-fetch-group} provides this functionality in any case. -It takes the group name as a parameter. - - -@node New Groups -@section New Groups -@cindex new groups -@cindex subscription - -@vindex gnus-check-new-newsgroups -If you are satisfied that you really never want to see any new groups, -you can set @code{gnus-check-new-newsgroups} to @code{nil}. This will -also save you some time at startup. Even if this variable is -@code{nil}, you can always subscribe to the new groups just by pressing -@kbd{U} in the group buffer (@pxref{Group Maintenance}). This variable -is @code{ask-server} by default. If you set this variable to -@code{always}, then Gnus will query the backends for new groups even -when you do the @kbd{g} command (@pxref{Scanning New Messages}). - -@menu -* Checking New Groups:: Determining what groups are new. -* Subscription Methods:: What Gnus should do with new groups. -* Filtering New Groups:: Making Gnus ignore certain new groups. -@end menu - - -@node Checking New Groups -@subsection Checking New Groups - -Gnus normally determines whether a group is new or not by comparing the -list of groups from the active file(s) with the lists of subscribed and -dead groups. This isn't a particularly fast method. If -@code{gnus-check-new-newsgroups} is @code{ask-server}, Gnus will ask the -server for new groups since the last time. This is both faster and -cheaper. This also means that you can get rid of the list of killed -groups altogether, so you may set @code{gnus-save-killed-list} to -@code{nil}, which will save time both at startup, at exit, and all over. -Saves disk space, too. Why isn't this the default, then? -Unfortunately, not all servers support this command. - -I bet I know what you're thinking now: How do I find out whether my -server supports @code{ask-server}? No? Good, because I don't have a -fail-safe answer. I would suggest just setting this variable to -@code{ask-server} and see whether any new groups appear within the next -few days. If any do, then it works. If none do, then it doesn't -work. I could write a function to make Gnus guess whether the server -supports @code{ask-server}, but it would just be a guess. So I won't. -You could @code{telnet} to the server and say @code{HELP} and see -whether it lists @samp{NEWGROUPS} among the commands it understands. If -it does, then it might work. (But there are servers that lists -@samp{NEWGROUPS} without supporting the function properly.) - -This variable can also be a list of select methods. If so, Gnus will -issue an @code{ask-server} command to each of the select methods, and -subscribe them (or not) using the normal methods. This might be handy -if you are monitoring a few servers for new groups. A side effect is -that startup will take much longer, so you can meditate while waiting. -Use the mantra ``dingnusdingnusdingnus'' to achieve permanent bliss. - - -@node Subscription Methods -@subsection Subscription Methods - -@vindex gnus-subscribe-newsgroup-method -What Gnus does when it encounters a new group is determined by the -@code{gnus-subscribe-newsgroup-method} variable. - -This variable should contain a function. This function will be called -with the name of the new group as the only parameter. - -Some handy pre-fab functions are: - -@table @code - -@item gnus-subscribe-zombies -@vindex gnus-subscribe-zombies -Make all new groups zombies. This is the default. You can browse the -zombies later (with @kbd{A z}) and either kill them all off properly -(with @kbd{S z}), or subscribe to them (with @kbd{u}). - -@item gnus-subscribe-randomly -@vindex gnus-subscribe-randomly -Subscribe all new groups randomly. - -@item gnus-subscribe-alphabetically -@vindex gnus-subscribe-alphabetically -Subscribe all new groups alphabetically. - -@item gnus-subscribe-hierarchically -@vindex gnus-subscribe-hierarchically -Subscribe all new groups hierarchically. The difference between this -function and @code{gnus-subscribe-alphabetically} is slight. -@code{gnus-subscribe-alphabetically} will subscribe new groups in a strictly -alphabetical fashion, while this function will enter groups into it's -hierarchy. So if you want to have the @samp{rec} hierarchy before the -@samp{comp} hierarchy, this function will not mess that configuration -up. Or something like that. - -@item gnus-subscribe-interactively -@vindex gnus-subscribe-interactively -Subscribe new groups interactively. This means that Gnus will ask -you about @strong{all} new groups. - -@item gnus-subscribe-killed -@vindex gnus-subscribe-killed -Kill all new groups. - -@end table - -@vindex gnus-subscribe-hierarchical-interactive -A closely related variable is -@code{gnus-subscribe-hierarchical-interactive}. (That's quite a -mouthful.) If this variable is non-@code{nil}, Gnus will ask you in a -hierarchical fashion whether to subscribe to new groups or not. Gnus -will ask you for each sub-hierarchy whether you want to descend the -hierarchy or not. - -One common mistake is to set the variable a few paragraphs above -(@code{gnus-subscribe-newsgroup-method}) to -@code{gnus-subscribe-hierarchical-interactive}. This is an error. This -will not work. This is ga-ga. So don't do it. - - -@node Filtering New Groups -@subsection Filtering New Groups - -A nice and portable way to control which new newsgroups should be -subscribed (or ignored) is to put an @dfn{options} line at the start of -the @file{.newsrc} file. Here's an example: - -@example -options -n !alt.all !rec.all sci.all -@end example - -@vindex gnus-subscribe-options-newsgroup-method -This line obviously belongs to a serious-minded intellectual scientific -person (or she may just be plain old boring), because it says that all -groups that have names beginning with @samp{alt} and @samp{rec} should -be ignored, and all groups with names beginning with @samp{sci} should -be subscribed. Gnus will not use the normal subscription method for -subscribing these groups. -@code{gnus-subscribe-options-newsgroup-method} is used instead. This -variable defaults to @code{gnus-subscribe-alphabetically}. - -@vindex gnus-options-not-subscribe -@vindex gnus-options-subscribe -If you don't want to mess with your @file{.newsrc} file, you can just -set the two variables @code{gnus-options-subscribe} and -@code{gnus-options-not-subscribe}. These two variables do exactly the -same as the @file{.newsrc} @samp{options -n} trick. Both are regexps, -and if the new group matches the former, it will be unconditionally -subscribed, and if it matches the latter, it will be ignored. - -@vindex gnus-auto-subscribed-groups -Yet another variable that meddles here is -@code{gnus-auto-subscribed-groups}. It works exactly like -@code{gnus-options-subscribe}, and is therefore really superfluous, but I -thought it would be nice to have two of these. This variable is more -meant for setting some ground rules, while the other variable is used -more for user fiddling. By default this variable makes all new groups -that come from mail backends (@code{nnml}, @code{nnbabyl}, -@code{nnfolder}, @code{nnmbox}, and @code{nnmh}) subscribed. If you -don't like that, just set this variable to @code{nil}. - -New groups that match this regexp are subscribed using -@code{gnus-subscribe-options-newsgroup-method}. - - -@node Changing Servers -@section Changing Servers -@cindex changing servers - -Sometimes it is necessary to move from one @sc{nntp} server to another. -This happens very rarely, but perhaps you change jobs, or one server is -very flaky and you want to use another. - -Changing the server is pretty easy, right? You just change -@code{gnus-select-method} to point to the new server? - -@emph{Wrong!} - -Article numbers are not (in any way) kept synchronized between different -@sc{nntp} servers, and the only way Gnus keeps track of what articles -you have read is by keeping track of article numbers. So when you -change @code{gnus-select-method}, your @file{.newsrc} file becomes -worthless. - -Gnus provides a few functions to attempt to translate a @file{.newsrc} -file from one server to another. They all have one thing in -common---they take a looong time to run. You don't want to use these -functions more than absolutely necessary. - -@kindex M-x gnus-change-server -@findex gnus-change-server -If you have access to both servers, Gnus can request the headers for all -the articles you have read and compare @code{Message-ID}s and map the -article numbers of the read articles and article marks. The @kbd{M-x -gnus-change-server} command will do this for all your native groups. It -will prompt for the method you want to move to. - -@kindex M-x gnus-group-move-group-to-server -@findex gnus-group-move-group-to-server -You can also move individual groups with the @kbd{M-x -gnus-group-move-group-to-server} command. This is useful if you want to -move a (foreign) group from one server to another. - -@kindex M-x gnus-group-clear-data-on-native-groups -@findex gnus-group-clear-data-on-native-groups -If you don't have access to both the old and new server, all your marks -and read ranges have become worthless. You can use the @kbd{M-x -gnus-group-clear-data-on-native-groups} command to clear out all data -that you have on your native groups. Use with caution. - - -@node Startup Files -@section Startup Files -@cindex startup files -@cindex .newsrc -@cindex .newsrc.el -@cindex .newsrc.eld - -Now, you all know about the @file{.newsrc} file. All subscription -information is traditionally stored in this file. - -Things got a bit more complicated with @sc{gnus}. In addition to -keeping the @file{.newsrc} file updated, it also used a file called -@file{.newsrc.el} for storing all the information that didn't fit into -the @file{.newsrc} file. (Actually, it also duplicated everything in -the @file{.newsrc} file.) @sc{gnus} would read whichever one of these -files was the most recently saved, which enabled people to swap between -@sc{gnus} and other newsreaders. - -That was kinda silly, so Gnus went one better: In addition to the -@file{.newsrc} and @file{.newsrc.el} files, Gnus also has a file called -@file{.newsrc.eld}. It will read whichever of these files that are most -recent, but it will never write a @file{.newsrc.el} file. - -@vindex gnus-save-newsrc-file -You can turn off writing the @file{.newsrc} file by setting -@code{gnus-save-newsrc-file} to @code{nil}, which means you can delete -the file and save some space, as well as making exit from Gnus faster. -However, this will make it impossible to use other newsreaders than -Gnus. But hey, who would want to, right? - -@vindex gnus-save-killed-list -If @code{gnus-save-killed-list} (default @code{t}) is @code{nil}, Gnus -will not save the list of killed groups to the startup file. This will -save both time (when starting and quitting) and space (on disk). It -will also mean that Gnus has no record of what groups are new or old, -so the automatic new groups subscription methods become meaningless. -You should always set @code{gnus-check-new-newsgroups} to @code{nil} or -@code{ask-server} if you set this variable to @code{nil} (@pxref{New -Groups}). This variable can also be a regular expression. If that's -the case, remove all groups that do not match this regexp before -saving. This can be useful in certain obscure situations that involve -several servers where not all servers support @code{ask-server}. - -@vindex gnus-startup-file -The @code{gnus-startup-file} variable says where the startup files are. -The default value is @file{~/.newsrc}, with the Gnus (El Dingo) startup -file being whatever that one is, with a @samp{.eld} appended. - -@vindex gnus-save-newsrc-hook -@vindex gnus-save-quick-newsrc-hook -@vindex gnus-save-standard-newsrc-hook -@code{gnus-save-newsrc-hook} is called before saving any of the newsrc -files, while @code{gnus-save-quick-newsrc-hook} is called just before -saving the @file{.newsrc.eld} file, and -@code{gnus-save-standard-newsrc-hook} is called just before saving the -@file{.newsrc} file. The latter two are commonly used to turn version -control on or off. Version control is on by default when saving the -startup files. If you want to turn backup creation off, say something like: - -@lisp -(defun turn-off-backup () - (set (make-local-variable 'backup-inhibited) t)) - -(add-hook 'gnus-save-quick-newsrc-hook 'turn-off-backup) -(add-hook 'gnus-save-standard-newsrc-hook 'turn-off-backup) -@end lisp - -@vindex gnus-init-file -When Gnus starts, it will read the @code{gnus-site-init-file} -(@file{.../site-lisp/gnus} by default) and @code{gnus-init-file} -(@file{~/.gnus} by default) files. These are normal Emacs Lisp files -and can be used to avoid cluttering your @file{~/.emacs} and -@file{site-init} files with Gnus stuff. Gnus will also check for files -with the same names as these, but with @file{.elc} and @file{.el} -suffixes. In other words, if you have set @code{gnus-init-file} to -@file{~/.gnus}, it will look for @file{~/.gnus.elc}, @file{~/.gnus.el}, -and finally @file{~/.gnus} (in this order). - - - -@node Auto Save -@section Auto Save -@cindex dribble file -@cindex auto-save - -Whenever you do something that changes the Gnus data (reading articles, -catching up, killing/subscribing groups), the change is added to a -special @dfn{dribble buffer}. This buffer is auto-saved the normal -Emacs way. If your Emacs should crash before you have saved the -@file{.newsrc} files, all changes you have made can be recovered from -this file. - -If Gnus detects this file at startup, it will ask the user whether to -read it. The auto save file is deleted whenever the real startup file is -saved. - -@vindex gnus-use-dribble-file -If @code{gnus-use-dribble-file} is @code{nil}, Gnus won't create and -maintain a dribble buffer. The default is @code{t}. - -@vindex gnus-dribble-directory -Gnus will put the dribble file(s) in @code{gnus-dribble-directory}. If -this variable is @code{nil}, which it is by default, Gnus will dribble -into the directory where the @file{.newsrc} file is located. (This is -normally the user's home directory.) The dribble file will get the same -file permissions as the @code{.newsrc} file. - - -@node The Active File -@section The Active File -@cindex active file -@cindex ignored groups - -When Gnus starts, or indeed whenever it tries to determine whether new -articles have arrived, it reads the active file. This is a very large -file that lists all the active groups and articles on the server. - -@vindex gnus-ignored-newsgroups -Before examining the active file, Gnus deletes all lines that match the -regexp @code{gnus-ignored-newsgroups}. This is done primarily to reject -any groups with bogus names, but you can use this variable to make Gnus -ignore hierarchies you aren't ever interested in. However, this is not -recommended. In fact, it's highly discouraged. Instead, @pxref{New -Groups} for an overview of other variables that can be used instead. - -@c This variable is -@c @code{nil} by default, and will slow down active file handling somewhat -@c if you set it to anything else. - -@vindex gnus-read-active-file -@c @head -The active file can be rather Huge, so if you have a slow network, you -can set @code{gnus-read-active-file} to @code{nil} to prevent Gnus from -reading the active file. This variable is @code{some} by default. - -Gnus will try to make do by getting information just on the groups that -you actually subscribe to. - -Note that if you subscribe to lots and lots of groups, setting this -variable to @code{nil} will probably make Gnus slower, not faster. At -present, having this variable @code{nil} will slow Gnus down -considerably, unless you read news over a 2400 baud modem. - -This variable can also have the value @code{some}. Gnus will then -attempt to read active info only on the subscribed groups. On some -servers this is quite fast (on sparkling, brand new INN servers that -support the @code{LIST ACTIVE group} command), on others this isn't fast -at all. In any case, @code{some} should be faster than @code{nil}, and -is certainly faster than @code{t} over slow lines. - -If this variable is @code{nil}, Gnus will ask for group info in total -lock-step, which isn't very fast. If it is @code{some} and you use an -@sc{nntp} server, Gnus will pump out commands as fast as it can, and -read all the replies in one swoop. This will normally result in better -performance, but if the server does not support the aforementioned -@code{LIST ACTIVE group} command, this isn't very nice to the server. - -In any case, if you use @code{some} or @code{nil}, you should definitely -kill all groups that you aren't interested in to speed things up. - -Note that this variable also affects active file retrieval from -secondary select methods. - - -@node Startup Variables -@section Startup Variables - -@table @code - -@item gnus-load-hook -@vindex gnus-load-hook -A hook run while Gnus is being loaded. Note that this hook will -normally be run just once in each Emacs session, no matter how many -times you start Gnus. - -@item gnus-startup-hook -@vindex gnus-startup-hook -A hook run after starting up Gnus successfully. - -@item gnus-started-hook -@vindex gnus-started-hook -A hook run as the very last thing after starting up Gnus -successfully. - -@item gnus-check-bogus-newsgroups -@vindex gnus-check-bogus-newsgroups -If non-@code{nil}, Gnus will check for and delete all bogus groups at -startup. A @dfn{bogus group} is a group that you have in your -@file{.newsrc} file, but doesn't exist on the news server. Checking for -bogus groups can take quite a while, so to save time and resources it's -best to leave this option off, and do the checking for bogus groups once -in a while from the group buffer instead (@pxref{Group Maintenance}). - -@item gnus-inhibit-startup-message -@vindex gnus-inhibit-startup-message -If non-@code{nil}, the startup message won't be displayed. That way, -your boss might not notice as easily that you are reading news instead -of doing your job. Note that this variable is used before -@file{.gnus.el} is loaded, so it should be set in @code{.emacs} instead. - -@item gnus-no-groups-message -@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}. - -@end table - - -@node The Group Buffer -@chapter The Group Buffer -@cindex group buffer - -The @dfn{group buffer} lists all (or parts) of the available groups. It -is the first buffer shown when Gnus starts, and will never be killed as -long as Gnus is active. - -@iftex -@iflatex -\gnusfigure{The Group Buffer}{320}{ -\put(75,50){\epsfig{figure=tmp/group.ps,height=9cm}} -\put(120,37){\makebox(0,0)[t]{Buffer name}} -\put(120,38){\vector(1,2){10}} -\put(40,60){\makebox(0,0)[r]{Mode line}} -\put(40,58){\vector(1,0){30}} -\put(200,28){\makebox(0,0)[t]{Native select method}} -\put(200,26){\vector(-1,2){15}} -} -@end iflatex -@end iftex - -@menu -* Group Buffer Format:: Information listed and how you can change it. -* Group Maneuvering:: Commands for moving in the group buffer. -* Selecting a Group:: Actually reading news. -* Group Data:: Changing the info for a group. -* Subscription Commands:: Unsubscribing, killing, subscribing. -* Group Levels:: Levels? What are those, then? -* Group Score:: A mechanism for finding out what groups you like. -* Marking Groups:: You can mark groups for later processing. -* Foreign Groups:: Creating and editing groups. -* Group Parameters:: Each group may have different parameters set. -* Listing Groups:: Gnus can list various subsets of the groups. -* Sorting Groups:: Re-arrange the group order. -* Group Maintenance:: Maintaining a tidy @file{.newsrc} file. -* Browse Foreign Server:: You can browse a server. See what it has to offer. -* Exiting Gnus:: Stop reading news and get some work done. -* Group Topics:: A folding group mode divided into topics. -* Misc Group Stuff:: Other stuff that you can to do. -@end menu - - -@node Group Buffer Format -@section Group Buffer Format - -@menu -* Group Line Specification:: Deciding how the group buffer is to look. -* Group Modeline Specification:: The group buffer modeline. -* Group Highlighting:: Having nice colors in the group buffer. -@end menu - - -@node Group Line Specification -@subsection Group Line Specification -@cindex group buffer format - -The default format of the group buffer is nice and dull, but you can -make it as exciting and ugly as you feel like. - -Here's a couple of example group lines: - -@example - 25: news.announce.newusers - * 0: alt.fan.andrea-dworkin -@end example - -Quite simple, huh? - -You can see that there are 25 unread articles in -@samp{news.announce.newusers}. There are no unread articles, but some -ticked articles, in @samp{alt.fan.andrea-dworkin} (see that little -asterisk at the beginning of the line?). - -@vindex gnus-group-line-format -You can change that format to whatever you want by fiddling with the -@code{gnus-group-line-format} variable. This variable works along the -lines of a @code{format} specification, which is pretty much the same as -a @code{printf} specifications, for those of you who use (feh!) C. -@xref{Formatting Variables}. - -@samp{%M%S%5y: %(%g%)\n} is the value that produced those lines above. - -There should always be a colon on the line; the cursor always moves to -the colon after performing an operation. Nothing else is required---not -even the group name. All displayed text is just window dressing, and is -never examined by Gnus. Gnus stores all real information it needs using -text properties. - -(Note that if you make a really strange, wonderful, spreadsheet-like -layout, everybody will believe you are hard at work with the accounting -instead of wasting time reading news.) - -Here's a list of all available format characters: - -@table @samp - -@item M -An asterisk if the group only has marked articles. - -@item S -Whether the group is subscribed. - -@item L -Level of subscribedness. - -@item N -Number of unread articles. - -@item I -Number of dormant articles. - -@item T -Number of ticked articles. - -@item R -Number of read articles. - -@item t -Estimated total number of articles. (This is really @var{max-number} -minus @var{min-number} plus 1.) - -@item y -Number of unread, unticked, non-dormant articles. - -@item i -Number of ticked and dormant articles. - -@item g -Full group name. - -@item G -Group name. - -@item D -Newsgroup description. - -@item o -@samp{m} if moderated. - -@item O -@samp{(m)} if moderated. - -@item s -Select method. - -@item n -Select from where. - -@item z -A string that looks like @samp{<%s:%n>} if a foreign select method is -used. - -@item P -Indentation based on the level of the topic (@pxref{Group Topics}). - -@item c -@vindex gnus-group-uncollapsed-levels -Short (collapsed) group name. The @code{gnus-group-uncollapsed-levels} -variable says how many levels to leave at the end of the group name. -The default is 1---this will mean that group names like -@samp{gnu.emacs.gnus} will be shortened to @samp{g.emacs.gnus}. - -@item m -@vindex gnus-new-mail-mark -@cindex % -@samp{%} (@code{gnus-new-mail-mark}) if there has arrived new mail to -the group lately. - -@item d -A string that says when you last read the group (@pxref{Group -Timestamp}). - -@item u -User defined specifier. The next character in the format string should -be a letter. Gnus will call the function -@code{gnus-user-format-function-}@samp{X}, where @samp{X} is the letter -following @samp{%u}. The function will be passed a single dummy -parameter as argument. The function should return a string, which will -be inserted into the buffer just like information from any other -specifier. -@end table - -@cindex * -All the ``number-of'' specs will be filled with an asterisk (@samp{*}) -if no info is available---for instance, if it is a non-activated foreign -group, or a bogus native group. - - -@node Group Modeline Specification -@subsection Group Modeline Specification -@cindex group modeline - -@vindex gnus-group-mode-line-format -The mode line can be changed by setting -@code{gnus-group-mode-line-format} (@pxref{Formatting Variables}). It -doesn't understand that many format specifiers: - -@table @samp -@item S -The native news server. -@item M -The native select method. -@end table - - -@node Group Highlighting -@subsection Group Highlighting -@cindex highlighting -@cindex group highlighting - -@vindex gnus-group-highlight -Highlighting in the group buffer is controlled by the -@code{gnus-group-highlight} variable. This is an alist with elements -that look like @var{(form . face)}. If @var{form} evaluates to -something non-@code{nil}, the @var{face} will be used on the line. - -Here's an example value for this variable that might look nice if the -background is dark: - -@lisp -(setq gnus-group-highlight - `(((> unread 200) . - ,(custom-face-lookup "Red" nil nil t nil nil)) - ((and (< level 3) (zerop unread)) . - ,(custom-face-lookup "SeaGreen" nil nil t nil nil)) - ((< level 3) . - ,(custom-face-lookup "SpringGreen" nil nil t nil nil)) - ((zerop unread) . - ,(custom-face-lookup "SteelBlue" nil nil t nil nil)) - (t . - ,(custom-face-lookup "SkyBlue" nil nil t nil nil)))) -@end lisp - -Variables that are dynamically bound when the forms are evaluated -include: - -@table @code -@item group -The group name. -@item unread -The number of unread articles in the group. -@item method -The select method. -@item mailp -Whether the group is a mail group. -@item level -The level of the group. -@item score -The score of the group. -@item ticked -The number of ticked articles in the group. -@item total -The total number of articles in the group. Or rather, MAX-NUMBER minus -MIN-NUMBER plus one. -@item topic -When using the topic minor mode, this variable is bound to the current -topic being inserted. -@end table - -When the forms are @code{eval}ed, point is at the beginning of the line -of the group in question, so you can use many of the normal Gnus -functions for snarfing info on the group. - -@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. - - -@node Group Maneuvering -@section Group Maneuvering -@cindex group movement - -All movement commands understand the numeric prefix and will behave as -expected, hopefully. - -@table @kbd - -@item n -@kindex n (Group) -@findex gnus-group-next-unread-group -Go to the next group that has unread articles -(@code{gnus-group-next-unread-group}). - -@item p -@itemx DEL -@kindex DEL (Group) -@kindex p (Group) -@findex gnus-group-prev-unread-group -Go to the previous group that has unread articles -(@code{gnus-group-prev-unread-group}). - -@item N -@kindex N (Group) -@findex gnus-group-next-group -Go to the next group (@code{gnus-group-next-group}). - -@item P -@kindex P (Group) -@findex gnus-group-prev-group -Go to the previous group (@code{gnus-group-prev-group}). - -@item M-p -@kindex M-p (Group) -@findex gnus-group-next-unread-group-same-level -Go to the next unread group on the same (or lower) level -(@code{gnus-group-next-unread-group-same-level}). - -@item M-n -@kindex M-n (Group) -@findex gnus-group-prev-unread-group-same-level -Go to the previous unread group on the same (or lower) level -(@code{gnus-group-prev-unread-group-same-level}). -@end table - -Three commands for jumping to groups: - -@table @kbd - -@item j -@kindex j (Group) -@findex gnus-group-jump-to-group -Jump to a group (and make it visible if it isn't already) -(@code{gnus-group-jump-to-group}). Killed groups can be jumped to, just -like living groups. - -@item , -@kindex , (Group) -@findex gnus-group-best-unread-group -Jump to the unread group with the lowest level -(@code{gnus-group-best-unread-group}). - -@item . -@kindex . (Group) -@findex gnus-group-first-unread-group -Jump to the first group with unread articles -(@code{gnus-group-first-unread-group}). -@end table - -@vindex gnus-group-goto-unread -If @code{gnus-group-goto-unread} is @code{nil}, all the movement -commands will move to the next group, not the next unread group. Even -the commands that say they move to the next unread group. The default -is @code{t}. - - -@node Selecting a Group -@section Selecting a Group -@cindex group selection - -@table @kbd - -@item SPACE -@kindex SPACE (Group) -@findex gnus-group-read-group -Select the current group, switch to the summary buffer and display the -first unread article (@code{gnus-group-read-group}). If there are no -unread articles in the group, or if you give a non-numerical prefix to -this command, Gnus will offer to fetch all the old articles in this -group from the server. If you give a numerical prefix @var{N}, @var{N} -determines the number of articles Gnus will fetch. If @var{N} is -positive, Gnus fetches the @var{N} newest articles, if @var{N} is -negative, Gnus fetches the @var{abs(N)} oldest articles. - -@item RET -@kindex RET (Group) -@findex gnus-group-select-group -Select the current group and switch to the summary buffer -(@code{gnus-group-select-group}). Takes the same arguments as -@code{gnus-group-read-group}---the only difference is that this command -does not display the first unread article automatically upon group -entry. - -@item M-RET -@kindex M-RET (Group) -@findex gnus-group-quick-select-group -This does the same as the command above, but tries to do it with the -minimum amount of fuzz (@code{gnus-group-quick-select-group}). No -scoring/killing will be performed, there will be no highlights and no -expunging. This might be useful if you're in a real hurry and have to -enter some humongous group. If you give a 0 prefix to this command -(i.e., @kbd{0 M-RET}), Gnus won't even generate the summary buffer. -This might be useful if you want to toggle threading before entering the -group. - -@item M-SPACE -@kindex M-SPACE (Group) -@findex gnus-group-visible-select-group -This is yet one more command that does the same as the @kbd{RET} -command, but this one does it without expunging and hiding dormants -(@code{gnus-group-visible-select-group}). - -@item M-C-RET -@kindex M-C-RET (Group) -@findex gnus-group-select-group-ephemerally -Finally, this command selects the current group ephemerally without -doing any processing of its contents -(@code{gnus-group-select-group-ephemerally}). Even threading has been -turned off. Everything you do in the group after selecting it in this -manner will have no permanent effects. - -@end table - -@vindex gnus-large-newsgroup -The @code{gnus-large-newsgroup} variable says what Gnus should consider -to be a big group. This is 200 by default. If the group has more -(unread and/or ticked) articles than this, Gnus will query the user -before entering the group. The user can then specify how many articles -should be fetched from the server. If the user specifies a negative -number (@code{-n}), the @code{n} oldest articles will be fetched. If it -is positive, the @code{n} articles that have arrived most recently will -be fetched. - -@vindex gnus-select-group-hook -@vindex gnus-auto-select-first -@code{gnus-auto-select-first} control whether any articles are selected -automatically when entering a group with the @kbd{SPACE} command. - -@table @code - -@item nil -Don't select any articles when entering the group. Just display the -full summary buffer. - -@item t -Select the first unread article when entering the group. - -@item best -Select the most high-scored article in the group when entering the -group. -@end table - -If you want to prevent automatic selection in some group (say, in a -binary group with Huge articles) you can set this variable to @code{nil} -in @code{gnus-select-group-hook}, which is called when a group is -selected. - - -@node Subscription Commands -@section Subscription Commands -@cindex subscription - -@table @kbd - -@item S t -@itemx u -@kindex S t (Group) -@kindex u (Group) -@findex gnus-group-unsubscribe-current-group -@c @icon{gnus-group-unsubscribe} -Toggle subscription to the current group -(@code{gnus-group-unsubscribe-current-group}). - -@item S s -@itemx U -@kindex S s (Group) -@kindex U (Group) -@findex gnus-group-unsubscribe-group -Prompt for a group to subscribe, and then subscribe it. If it was -subscribed already, unsubscribe it instead -(@code{gnus-group-unsubscribe-group}). - -@item S k -@itemx C-k -@kindex S k (Group) -@kindex C-k (Group) -@findex gnus-group-kill-group -@c @icon{gnus-group-kill-group} -Kill the current group (@code{gnus-group-kill-group}). - -@item S y -@itemx C-y -@kindex S y (Group) -@kindex C-y (Group) -@findex gnus-group-yank-group -Yank the last killed group (@code{gnus-group-yank-group}). - -@item C-x C-t -@kindex C-x C-t (Group) -@findex gnus-group-transpose-groups -Transpose two groups (@code{gnus-group-transpose-groups}). This isn't -really a subscription command, but you can use it instead of a -kill-and-yank sequence sometimes. - -@item S w -@itemx C-w -@kindex S w (Group) -@kindex C-w (Group) -@findex gnus-group-kill-region -Kill all groups in the region (@code{gnus-group-kill-region}). - -@item S z -@kindex S z (Group) -@findex gnus-group-kill-all-zombies -Kill all zombie groups (@code{gnus-group-kill-all-zombies}). - -@item S C-k -@kindex S C-k (Group) -@findex gnus-group-kill-level -Kill all groups on a certain level (@code{gnus-group-kill-level}). -These groups can't be yanked back after killing, so this command should -be used with some caution. The only time where this command comes in -really handy is when you have a @file{.newsrc} with lots of unsubscribed -groups that you want to get rid off. @kbd{S C-k} on level 7 will -kill off all unsubscribed groups that do not have message numbers in the -@file{.newsrc} file. - -@end table - -Also @pxref{Group Levels}. - - -@node Group Data -@section Group Data - -@table @kbd - -@item c -@kindex c (Group) -@findex gnus-group-catchup-current -@vindex gnus-group-catchup-group-hook -@c @icon{gnus-group-catchup-current} -Mark all unticked articles in this group as read -(@code{gnus-group-catchup-current}). -@code{gnus-group-catchup-group-hook} is called when catching up a group from -the group buffer. - -@item C -@kindex C (Group) -@findex gnus-group-catchup-current-all -Mark all articles in this group, even the ticked ones, as read -(@code{gnus-group-catchup-current-all}). - -@item M-c -@kindex M-c (Group) -@findex gnus-group-clear-data -Clear the data from the current group---nix out marks and the list of -read articles (@code{gnus-group-clear-data}). - -@item M-x gnus-group-clear-data-on-native-groups -@kindex M-x gnus-group-clear-data-on-native-groups -@findex gnus-group-clear-data-on-native-groups -If you have switched from one @sc{nntp} server to another, all your marks -and read ranges have become worthless. You can use this command to -clear out all data that you have on your native groups. Use with -caution. - -@end table - - -@node Group Levels -@section Group Levels -@cindex group level -@cindex level - -All groups have a level of @dfn{subscribedness}. For instance, if a -group is on level 2, it is more subscribed than a group on level 5. You -can ask Gnus to just list groups on a given level or lower -(@pxref{Listing Groups}), or to just check for new articles in groups on -a given level or lower (@pxref{Scanning New Messages}). - -Remember: The higher the level of the group, the less important it is. - -@table @kbd - -@item S l -@kindex S l (Group) -@findex gnus-group-set-current-level -Set the level of the current group. If a numeric prefix is given, the -next @var{n} groups will have their levels set. The user will be -prompted for a level. -@end table - -@vindex gnus-level-killed -@vindex gnus-level-zombie -@vindex gnus-level-unsubscribed -@vindex gnus-level-subscribed -Gnus considers groups from levels 1 to -@code{gnus-level-subscribed} (inclusive) (default 5) to be subscribed, -@code{gnus-level-subscribed} (exclusive) and -@code{gnus-level-unsubscribed} (inclusive) (default 7) to be -unsubscribed, @code{gnus-level-zombie} to be zombies (walking dead) -(default 8) and @code{gnus-level-killed} to be killed (completely dead) -(default 9). Gnus treats subscribed and unsubscribed groups exactly the -same, but zombie and killed groups have no information on what articles -you have read, etc, stored. This distinction between dead and living -groups isn't done because it is nice or clever, it is done purely for -reasons of efficiency. - -It is recommended that you keep all your mail groups (if any) on quite -low levels (e.g. 1 or 2). - -If you want to play with the level variables, you should show some care. -Set them once, and don't touch them ever again. Better yet, don't touch -them at all unless you know exactly what you're doing. - -@vindex gnus-level-default-unsubscribed -@vindex gnus-level-default-subscribed -Two closely related variables are @code{gnus-level-default-subscribed} -(default 3) and @code{gnus-level-default-unsubscribed} (default 6), -which are the levels that new groups will be put on if they are -(un)subscribed. These two variables should, of course, be inside the -relevant legal ranges. - -@vindex gnus-keep-same-level -If @code{gnus-keep-same-level} is non-@code{nil}, some movement commands -will only move to groups of the same level (or lower). In -particular, going from the last article in one group to the next group -will go to the next group of the same level (or lower). This might be -handy if you want to read the most important groups before you read the -rest. - -@vindex gnus-group-default-list-level -All groups with a level less than or equal to -@code{gnus-group-default-list-level} will be listed in the group buffer -by default. - -@vindex gnus-group-list-inactive-groups -If @code{gnus-group-list-inactive-groups} is non-@code{nil}, non-active -groups will be listed along with the unread groups. This variable is -@code{t} by default. If it is @code{nil}, inactive groups won't be -listed. - -@vindex gnus-group-use-permanent-levels -If @code{gnus-group-use-permanent-levels} is non-@code{nil}, once you -give a level prefix to @kbd{g} or @kbd{l}, all subsequent commands will -use this level as the ``work'' level. - -@vindex gnus-activate-level -Gnus will normally just activate groups on level -@code{gnus-activate-level} or less. If you don't want to activate -unsubscribed groups, for instance, you might set this variable to -5. The default is 6. - - -@node Group Score -@section Group Score -@cindex group score - -You would normally keep important groups on high levels, but that scheme -is somewhat restrictive. Don't you wish you could have Gnus sort the -group buffer according to how often you read groups, perhaps? Within -reason? - -This is what @dfn{group score} is for. You can assign a score to each -group. You can then sort the group buffer based on this score. -Alternatively, you can sort on score and then level. (Taken together, -the level and the score is called the @dfn{rank} of the group. A group -that is on level 4 and has a score of 1 has a higher rank than a group -on level 5 that has a score of 300. (The level is the most significant -part and the score is the least significant part.)) - -@findex gnus-summary-bubble-group -If you want groups you read often to get higher scores than groups you -read seldom you can add the @code{gnus-summary-bubble-group} function to -the @code{gnus-summary-exit-hook} hook. This will result (after -sorting) in a bubbling sort of action. If you want to see that in -action after each summary exit, you can add -@code{gnus-group-sort-groups-by-rank} or -@code{gnus-group-sort-groups-by-score} to the same hook, but that will -slow things down somewhat. - - -@node Marking Groups -@section Marking Groups -@cindex marking groups - -If you want to perform some command on several groups, and they appear -subsequently in the group buffer, you would normally just give a -numerical prefix to the command. Most group commands will then do your -bidding on those groups. - -However, if the groups are not in sequential order, you can still -perform a command on several groups. You simply mark the groups first -with the process mark and then execute the command. - -@table @kbd - -@item # -@kindex # (Group) -@itemx M m -@kindex M m (Group) -@findex gnus-group-mark-group -Set the mark on the current group (@code{gnus-group-mark-group}). - -@item M-# -@kindex M-# (Group) -@itemx M u -@kindex M u (Group) -@findex gnus-group-unmark-group -Remove the mark from the current group -(@code{gnus-group-unmark-group}). - -@item M U -@kindex M U (Group) -@findex gnus-group-unmark-all-groups -Remove the mark from all groups (@code{gnus-group-unmark-all-groups}). - -@item M w -@kindex M w (Group) -@findex gnus-group-mark-region -Mark all groups between point and mark (@code{gnus-group-mark-region}). - -@item M b -@kindex M b (Group) -@findex gnus-group-mark-buffer -Mark all groups in the buffer (@code{gnus-group-mark-buffer}). - -@item M r -@kindex M r (Group) -@findex gnus-group-mark-regexp -Mark all groups that match some regular expression -(@code{gnus-group-mark-regexp}). -@end table - -Also @pxref{Process/Prefix}. - -@findex gnus-group-universal-argument -If you want to execute some command on all groups that have been marked -with the process mark, you can use the @kbd{M-&} -(@code{gnus-group-universal-argument}) command. It will prompt you for -the command to be executed. - - -@node Foreign Groups -@section Foreign Groups -@cindex foreign groups - -Below are some group mode commands for making and editing general foreign -groups, as well as commands to ease the creation of a few -special-purpose groups. All these commands insert the newly created -groups under point---@code{gnus-subscribe-newsgroup-method} is not -consulted. - -@table @kbd - -@item G m -@kindex G m (Group) -@findex gnus-group-make-group -@cindex making groups -Make a new group (@code{gnus-group-make-group}). Gnus will prompt you -for a name, a method and possibly an @dfn{address}. For an easier way -to subscribe to @sc{nntp} groups, @pxref{Browse Foreign Server}. - -@item G r -@kindex G r (Group) -@findex gnus-group-rename-group -@cindex renaming groups -Rename the current group to something else -(@code{gnus-group-rename-group}). This is legal only on some -groups---mail groups mostly. This command might very well be quite slow -on some backends. - -@item G c -@kindex G c (Group) -@cindex customizing -@findex gnus-group-customize -Customize the group parameters (@code{gnus-group-customize}). - -@item G e -@kindex G e (Group) -@findex gnus-group-edit-group-method -@cindex renaming groups -Enter a buffer where you can edit the select method of the current -group (@code{gnus-group-edit-group-method}). - -@item G p -@kindex G p (Group) -@findex gnus-group-edit-group-parameters -Enter a buffer where you can edit the group parameters -(@code{gnus-group-edit-group-parameters}). - -@item G E -@kindex G E (Group) -@findex gnus-group-edit-group -Enter a buffer where you can edit the group info -(@code{gnus-group-edit-group}). - -@item G d -@kindex G d (Group) -@findex gnus-group-make-directory-group -@cindex nndir -Make a directory group (@pxref{Directory Groups}). You will be prompted -for a directory name (@code{gnus-group-make-directory-group}). - -@item G h -@kindex G h (Group) -@cindex help group -@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 k -@kindex G k (Group) -@findex gnus-group-make-kiboze-group -@cindex nnkiboze -Make a kiboze group. You will be prompted for a name, for a regexp to -match groups to be ``included'' in the kiboze group, and a series of -strings to match on headers (@code{gnus-group-make-kiboze-group}). -@xref{Kibozed Groups}. - -@item G D -@kindex G D (Group) -@findex gnus-group-enter-directory -@cindex nneething -Read an arbitrary directory as if it were a newsgroup with the -@code{nneething} backend (@code{gnus-group-enter-directory}). -@xref{Anything Groups}. - -@item G f -@kindex G f (Group) -@findex gnus-group-make-doc-group -@cindex ClariNet Briefs -@cindex nndoc -Make a group based on some file or other -(@code{gnus-group-make-doc-group}). If you give a prefix to this -command, you will be prompted for a file name and a file type. -Currently supported types are @code{babyl}, @code{mbox}, @code{digest}, -@code{mmdf}, @code{news}, @code{rnews}, @code{clari-briefs}, -@code{rfc934}, @code{rfc822-forward}, and @code{forward}. If you run -this command without a prefix, Gnus will guess at the file type. -@xref{Document Groups}. - -@item G w -@kindex G w (Group) -@findex gnus-group-make-web-group -@cindex DejaNews -@cindex Alta Vista -@cindex InReference -@cindex nnweb -Make an ephemeral group based on a web search -(@code{gnus-group-make-web-group}). If you give a prefix to this -command, make a solid group instead. You will be prompted for the -search engine type and the search string. Legal search engine types -include @code{dejanews}, @code{altavista} and @code{reference}. -@xref{Web Searches}. - -@item G DEL -@kindex G DEL (Group) -@findex gnus-group-delete-group -This function will delete the current group -(@code{gnus-group-delete-group}). If given a prefix, this function will -actually delete all the articles in the group, and forcibly remove the -group itself from the face of the Earth. Use a prefix only if you are -absolutely sure of what you are doing. - -@item G V -@kindex G V (Group) -@findex gnus-group-make-empty-virtual -Make a new, fresh, empty @code{nnvirtual} group -(@code{gnus-group-make-empty-virtual}). @xref{Virtual Groups}. - -@item G v -@kindex G v (Group) -@findex gnus-group-add-to-virtual -Add the current group to an @code{nnvirtual} group -(@code{gnus-group-add-to-virtual}). Uses the process/prefix convention. -@end table - -@xref{Select Methods} for more information on the various select -methods. - -@vindex gnus-activate-foreign-newsgroups -If @code{gnus-activate-foreign-newsgroups} is a positive number, -Gnus will check all foreign groups with this level or lower at startup. -This might take quite a while, especially if you subscribe to lots of -groups from different @sc{nntp} servers. - - -@node Group Parameters -@section Group Parameters -@cindex group parameters - -The group parameters store information local to a particular group: - -@table @code -@item to-address -@cindex to-address -If the group parameter list contains an element that looks like -@code{(to-address . "some@@where.com")}, that address will be used by -the backend when doing followups and posts. This is primarily useful in -mail groups that represent closed mailing lists---mailing lists where -it's expected that everybody that writes to the mailing list is -subscribed to it. Since using this parameter ensures that the mail only -goes to the mailing list itself, it means that members won't receive two -copies of your followups. - -Using @code{to-address} will actually work whether the group is foreign -or not. Let's say there's a group on the server that is called -@samp{fa.4ad-l}. This is a real newsgroup, but the server has gotten -the articles from a mail-to-news gateway. Posting directly to this -group is therefore impossible---you have to send mail to the mailing -list address instead. - -@item to-list -@cindex to-list -If the group parameter list has an element that looks like -@code{(to-list . "some@@where.com")}, that address will be used when -doing a @kbd{a} in that group. It is totally ignored when doing a -followup---except that if it is present in a news group, you'll get mail -group semantics when doing @kbd{f}. - -If you do an @kbd{a} command in a mail group and you don't have a -@code{to-list} group parameter, one will be added automatically upon -sending the message. - -@item visible -@cindex visible -If the group parameter list has the element @code{(visible . t)}, -that group will always be visible in the Group buffer, regardless -of whether it has any unread articles. - -@item broken-reply-to -@cindex broken-reply-to -Elements like @code{(broken-reply-to . t)} signals that @code{Reply-To} -headers in this group are to be ignored. This can be useful if you're -reading a mailing list group where the listserv has inserted -@code{Reply-To} headers that point back to the listserv itself. This is -broken behavior. So there! - -@item to-group -@cindex to-group -Elements like @code{(to-group . "some.group.name")} means that all -posts in that group will be sent to @code{some.group.name}. - -@item newsgroup -@cindex newsgroup -If this symbol is present in the group parameter list, Gnus will treat -all responses as if they were responses to news articles. This can be -useful if you have a mail group that's really a mirror of a news group. - -@item gcc-self -@cindex gcc-self -If this symbol is present in the group parameter list and set to -@code{t}, newly composed messages will be @code{Gcc}'d to the current -group. If it is present and set to @code{none}, no @code{Gcc:} header -will be generated, if it is present and a string, this string will be -inserted literally as a @code{gcc} header (this symbol takes precedence over -any default @code{Gcc} rules as described later). - -@item auto-expire -@cindex auto-expire -If the group parameter has an element that looks like @code{(auto-expire -. t)}, all articles read will be marked as expirable. For an -alternative approach, @pxref{Expiring Mail}. - -@item total-expire -@cindex total-expire -If the group parameter has an element that looks like -@code{(total-expire . t)}, all read articles will be put through the -expiry process, even if they are not marked as expirable. Use with -caution. Unread, ticked and dormant articles are not eligible for -expiry. - -@item expiry-wait -@cindex expiry-wait -@vindex nnmail-expiry-wait-function -If the group parameter has an element that looks like @code{(expiry-wait -. 10)}, this value will override any @code{nnmail-expiry-wait} and -@code{nnmail-expiry-wait-function} when expiring expirable messages. -The value can either be a number of days (not necessarily an integer) or -the symbols @code{never} or @code{immediate}. - -@item score-file -@cindex score file group parameter -Elements that look like @code{(score-file . "file")} will make -@file{file} into the current score file for the group in question. This -means that all score commands you issue will end up in that file. - -@item adapt-file -@cindex adapt file group parameter -Elements that look like @code{(adapt-file . "file")} will make -@file{file} into the current adaptive score file for the group in -question. All adaptive score entries will be put into this file. - -@item admin-address -When unsubscribing from a mailing list you should never send the -unsubscription notice to the mailing list itself. Instead, you'd send -messages to the administrative address. This parameter allows you to -put the admin address somewhere convenient. - -@item display -Elements that look like @code{(display . MODE)} say which articles to -display on entering the group. Legal values are: - -@table @code -@item all -Display all articles, both read and unread. - -@item default -Display the default visible articles, which normally includes unread and -ticked articles. -@end table - -@item comment -Elements that look like @code{(comment . "This is a comment")} -are arbitrary comments on the group. They are currently ignored by -Gnus, but provide a place for you to store information on particular -groups. - -@item @var{(variable form)} -You can use the group parameters to set variables local to the group you -are entering. If you want to turn threading off in @samp{news.answers}, -you could put @code{(gnus-show-threads nil)} in the group parameters of -that group. @code{gnus-show-threads} will be made into a local variable -in the summary buffer you enter, and the form @code{nil} will be -@code{eval}ed there. - -This can also be used as a group-specific hook function, if you'd like. -If you want to hear a beep when you enter a group, you could put -something like @code{(dummy-variable (ding))} in the parameters of that -group. @code{dummy-variable} will be set to the result of the -@code{(ding)} form, but who cares? - -@end table - -Use the @kbd{G p} command to edit group parameters of a group. - -@pxref{Topic Parameters}. - -Here's an example group parameter list: - -@example -((to-address . "ding@@gnus.org") - (auto-expiry . t)) -@end example - - -@node Listing Groups -@section Listing Groups -@cindex group listing - -These commands all list various slices of the groups available. - -@table @kbd - -@item l -@itemx A s -@kindex A s (Group) -@kindex l (Group) -@findex gnus-group-list-groups -List all groups that have unread articles -(@code{gnus-group-list-groups}). If the numeric prefix is used, this -command will list only groups of level ARG and lower. By default, it -only lists groups of level five (i. e., -@code{gnus-group-default-list-level}) or lower (i.e., just subscribed -groups). - -@item L -@itemx A u -@kindex A u (Group) -@kindex L (Group) -@findex gnus-group-list-all-groups -List all groups, whether they have unread articles or not -(@code{gnus-group-list-all-groups}). If the numeric prefix is used, -this command will list only groups of level ARG and lower. By default, -it lists groups of level seven or lower (i.e., just subscribed and -unsubscribed groups). - -@item A l -@kindex A l (Group) -@findex gnus-group-list-level -List all unread groups on a specific level -(@code{gnus-group-list-level}). If given a prefix, also list the groups -with no unread articles. - -@item A k -@kindex A k (Group) -@findex gnus-group-list-killed -List all killed groups (@code{gnus-group-list-killed}). If given a -prefix argument, really list all groups that are available, but aren't -currently (un)subscribed. This could entail reading the active file -from the server. - -@item A z -@kindex A z (Group) -@findex gnus-group-list-zombies -List all zombie groups (@code{gnus-group-list-zombies}). - -@item A m -@kindex A m (Group) -@findex gnus-group-list-matching -List all unread, subscribed groups with names that match a regexp -(@code{gnus-group-list-matching}). - -@item A M -@kindex A M (Group) -@findex gnus-group-list-all-matching -List groups that match a regexp (@code{gnus-group-list-all-matching}). - -@item A A -@kindex A A (Group) -@findex gnus-group-list-active -List absolutely all groups in the active file(s) of the -server(s) you are connected to (@code{gnus-group-list-active}). This -might very well take quite a while. It might actually be a better idea -to do a @kbd{A M} to list all matching, and just give @samp{.} as the -thing to match on. Also note that this command may list groups that -don't exist (yet)---these will be listed as if they were killed groups. -Take the output with some grains of salt. - -@item A a -@kindex A a (Group) -@findex gnus-group-apropos -List all groups that have names that match a regexp -(@code{gnus-group-apropos}). - -@item A d -@kindex A d (Group) -@findex gnus-group-description-apropos -List all groups that have names or descriptions that match a regexp -(@code{gnus-group-description-apropos}). - -@end table - -@vindex gnus-permanently-visible-groups -@cindex visible group parameter -Groups that match the @code{gnus-permanently-visible-groups} regexp will -always be shown, whether they have unread articles or not. You can also -add the @code{visible} element to the group parameters in question to -get the same effect. - -@vindex gnus-list-groups-with-ticked-articles -Groups that have just ticked articles in it are normally listed in the -group buffer. If @code{gnus-list-groups-with-ticked-articles} is -@code{nil}, these groups will be treated just like totally empty -groups. It is @code{t} by default. - - -@node Sorting Groups -@section Sorting Groups -@cindex sorting groups - -@kindex C-c C-s (Group) -@findex gnus-group-sort-groups -@vindex gnus-group-sort-function -The @kbd{C-c C-s} (@code{gnus-group-sort-groups}) command sorts the -group buffer according to the function(s) given by the -@code{gnus-group-sort-function} variable. Available sorting functions -include: - -@table @code - -@item gnus-group-sort-by-alphabet -@findex gnus-group-sort-by-alphabet -Sort the group names alphabetically. This is the default. - -@item gnus-group-sort-by-real-name -@findex gnus-group-sort-by-real-name -Sort the group alphabetically on the real (unprefixed) group names. - -@item gnus-group-sort-by-level -@findex gnus-group-sort-by-level -Sort by group level. - -@item gnus-group-sort-by-score -@findex gnus-group-sort-by-score -Sort by group score. - -@item gnus-group-sort-by-rank -@findex gnus-group-sort-by-rank -Sort by group score and then the group level. The level and the score -are, when taken together, the group's @dfn{rank}. - -@item gnus-group-sort-by-unread -@findex gnus-group-sort-by-unread -Sort by number of unread articles. - -@item gnus-group-sort-by-method -@findex gnus-group-sort-by-method -Sort alphabetically on the select method. - - -@end table - -@code{gnus-group-sort-function} can also be a list of sorting -functions. In that case, the most significant sort key function must be -the last one. - - -There are also a number of commands for sorting directly according to -some sorting criteria: - -@table @kbd -@item G S a -@kindex G S a (Group) -@findex gnus-group-sort-groups-by-alphabet -Sort the group buffer alphabetically by group name -(@code{gnus-group-sort-groups-by-alphabet}). - -@item G S u -@kindex G S u (Group) -@findex gnus-group-sort-groups-by-unread -Sort the group buffer by the number of unread articles -(@code{gnus-group-sort-groups-by-unread}). - -@item G S l -@kindex G S l (Group) -@findex gnus-group-sort-groups-by-level -Sort the group buffer by group level -(@code{gnus-group-sort-groups-by-level}). - -@item G S v -@kindex G S v (Group) -@findex gnus-group-sort-groups-by-score -Sort the group buffer by group score -(@code{gnus-group-sort-groups-by-score}). - -@item G S r -@kindex G S r (Group) -@findex gnus-group-sort-groups-by-rank -Sort the group buffer by group rank -(@code{gnus-group-sort-groups-by-rank}). - -@item G S m -@kindex G S m (Group) -@findex gnus-group-sort-groups-by-method -Sort the group buffer alphabetically by backend name -(@code{gnus-group-sort-groups-by-method}). - -@end table - -When given a prefix, all these commands will sort in reverse order. - -You can also sort a subset of the groups: - -@table @kbd -@item G P a -@kindex G P a (Group) -@findex gnus-group-sort-selected-groups-by-alphabet -Sort the process/prefixed groups in the group buffer alphabetically by -group name (@code{gnus-group-sort-selected-groups-by-alphabet}). - -@item G P u -@kindex G P u (Group) -@findex gnus-group-sort-selected-groups-by-unread -Sort the process/prefixed groups in the group buffer by the number of -unread articles (@code{gnus-group-sort-selected-groups-by-unread}). - -@item G P l -@kindex G P l (Group) -@findex gnus-group-sort-selected-groups-by-level -Sort the process/prefixed groups in the group buffer by group level -(@code{gnus-group-sort-selected-groups-by-level}). - -@item G P v -@kindex G P v (Group) -@findex gnus-group-sort-selected-groups-by-score -Sort the process/prefixed groups in the group buffer by group score -(@code{gnus-group-sort-selected-groups-by-score}). - -@item G P r -@kindex G P r (Group) -@findex gnus-group-sort-selected-groups-by-rank -Sort the process/prefixed groups in the group buffer by group rank -(@code{gnus-group-sort-selected-groups-by-rank}). - -@item G P m -@kindex G P m (Group) -@findex gnus-group-sort-selected-groups-by-method -Sort the process/prefixed groups in the group buffer alphabetically by -backend name (@code{gnus-group-sort-selected-groups-by-method}). - -@end table - - - -@node Group Maintenance -@section Group Maintenance -@cindex bogus groups - -@table @kbd -@item b -@kindex b (Group) -@findex gnus-group-check-bogus-groups -Find bogus groups and delete them -(@code{gnus-group-check-bogus-groups}). - -@item F -@kindex F (Group) -@findex gnus-group-find-new-groups -Find new groups and process them (@code{gnus-group-find-new-groups}). -If given a prefix, use the @code{ask-server} method to query the server -for new groups. - -@item C-c C-x -@kindex C-c C-x (Group) -@findex gnus-group-expire-articles -Run all expirable articles in the current group through the expiry -process (if any) (@code{gnus-group-expire-articles}). - -@item C-c M-C-x -@kindex C-c M-C-x (Group) -@findex gnus-group-expire-all-groups -Run all articles in all groups through the expiry process -(@code{gnus-group-expire-all-groups}). - -@end table - - -@node Browse Foreign Server -@section Browse Foreign Server -@cindex foreign servers -@cindex browsing servers - -@table @kbd -@item B -@kindex B (Group) -@findex gnus-group-browse-foreign-server -You will be queried for a select method and a server name. Gnus will -then attempt to contact this server and let you browse the groups there -(@code{gnus-group-browse-foreign-server}). -@end table - -@findex gnus-browse-mode -A new buffer with a list of available groups will appear. This buffer -will use the @code{gnus-browse-mode}. This buffer looks a bit (well, -a lot) like a normal group buffer. - -Here's a list of keystrokes available in the browse mode: - -@table @kbd -@item n -@kindex n (Browse) -@findex gnus-group-next-group -Go to the next group (@code{gnus-group-next-group}). - -@item p -@kindex p (Browse) -@findex gnus-group-prev-group -Go to the previous group (@code{gnus-group-prev-group}). - -@item SPACE -@kindex SPACE (Browse) -@findex gnus-browse-read-group -Enter the current group and display the first article -(@code{gnus-browse-read-group}). - -@item RET -@kindex RET (Browse) -@findex gnus-browse-select-group -Enter the current group (@code{gnus-browse-select-group}). - -@item u -@kindex u (Browse) -@findex gnus-browse-unsubscribe-current-group -Unsubscribe to the current group, or, as will be the case here, -subscribe to it (@code{gnus-browse-unsubscribe-current-group}). - -@item l -@itemx q -@kindex q (Browse) -@kindex l (Browse) -@findex gnus-browse-exit -Exit browse mode (@code{gnus-browse-exit}). - -@item ? -@kindex ? (Browse) -@findex gnus-browse-describe-briefly -Describe browse mode briefly (well, there's not much to describe, is -there) (@code{gnus-browse-describe-briefly}). -@end table - - -@node Exiting Gnus -@section Exiting Gnus -@cindex exiting Gnus - -Yes, Gnus is ex(c)iting. - -@table @kbd -@item z -@kindex z (Group) -@findex gnus-group-suspend -Suspend Gnus (@code{gnus-group-suspend}). This doesn't really exit Gnus, -but it kills all buffers except the Group buffer. I'm not sure why this -is a gain, but then who am I to judge? - -@item q -@kindex q (Group) -@findex gnus-group-exit -@c @icon{gnus-group-exit} -Quit Gnus (@code{gnus-group-exit}). - -@item Q -@kindex Q (Group) -@findex gnus-group-quit -Quit Gnus without saving the @file{.newsrc} files (@code{gnus-group-quit}). -The dribble file will be saved, though (@pxref{Auto Save}). -@end table - -@vindex gnus-exit-gnus-hook -@vindex gnus-suspend-gnus-hook -@code{gnus-suspend-gnus-hook} is called when you suspend Gnus and -@code{gnus-exit-gnus-hook} is called when you quit Gnus, while -@code{gnus-after-exiting-gnus-hook} is called as the final item when -exiting Gnus. - -@findex gnus-unload -@cindex unloading -If you wish to completely unload Gnus and all its adherents, you can use -the @code{gnus-unload} command. This command is also very handy when -trying to customize meta-variables. - -Note: - -@quotation -Miss Lisa Cannifax, while sitting in English class, felt her feet go -numbly heavy and herself fall into a hazy trance as the boy sitting -behind her drew repeated lines with his pencil across the back of her -plastic chair. -@end quotation - - -@node Group Topics -@section Group Topics -@cindex topics - -If you read lots and lots of groups, it might be convenient to group -them hierarchically according to topics. You put your Emacs groups over -here, your sex groups over there, and the rest (what, two groups or so?) -you put in some misc section that you never bother with anyway. You can -even group the Emacs sex groups as a sub-topic to either the Emacs -groups or the sex groups---or both! Go wild! - -@iftex -@iflatex -\gnusfigure{Group Topics}{400}{ -\put(75,50){\epsfig{figure=tmp/group-topic.ps,height=9cm}} -} -@end iflatex -@end iftex - -Here's an example: - -@example -Gnus - Emacs -- I wuw it! - 3: comp.emacs - 2: alt.religion.emacs - Naughty Emacs - 452: alt.sex.emacs - 0: comp.talk.emacs.recovery - Misc - 8: comp.binaries.fractals - 13: comp.sources.unix -@end example - -@findex gnus-topic-mode -@kindex t (Group) -To get this @emph{fab} functionality you simply turn on (ooh!) the -@code{gnus-topic} minor mode---type @kbd{t} in the group buffer. (This -is a toggling command.) - -Go ahead, just try it. I'll still be here when you get back. La de -dum... Nice tune, that... la la la... What, you're back? Yes, and now -press @kbd{l}. There. All your groups are now listed under -@samp{misc}. Doesn't that make you feel all warm and fuzzy? Hot and -bothered? - -If you want this permanently enabled, you should add that minor mode to -the hook for the group mode: - -@lisp -(add-hook 'gnus-group-mode-hook 'gnus-topic-mode) -@end lisp - -@menu -* Topic Variables:: How to customize the topics the Lisp Way. -* Topic Commands:: Interactive E-Z commands. -* Topic Sorting:: Sorting each topic individually. -* Topic Topology:: A map of the world. -* Topic Parameters:: Parameters that apply to all groups in a topic. -@end menu - - -@node Topic Variables -@subsection Topic Variables -@cindex topic variables - -Now, if you select a topic, it will fold/unfold that topic, which is -really neat, I think. - -@vindex gnus-topic-line-format -The topic lines themselves are created according to the -@code{gnus-topic-line-format} variable (@pxref{Formatting Variables}). -Legal elements are: - -@table @samp -@item i -Indentation. -@item n -Topic name. -@item v -Visibility. -@item l -Level. -@item g -Number of groups in the topic. -@item a -Number of unread articles in the topic. -@item A -Number of unread articles in the topic and all its subtopics. -@end table - -@vindex gnus-topic-indent-level -Each sub-topic (and the groups in the sub-topics) will be indented with -@code{gnus-topic-indent-level} times the topic level number of spaces. -The default is 2. - -@vindex gnus-topic-mode-hook -@code{gnus-topic-mode-hook} is called in topic minor mode buffers. - -@vindex gnus-topic-display-empty-topics -The @code{gnus-topic-display-empty-topics} says whether to display even -topics that have no unread articles in them. The default is @code{t}. - - -@node Topic Commands -@subsection Topic Commands -@cindex topic commands - -When the topic minor mode is turned on, a new @kbd{T} submap will be -available. In addition, a few of the standard keys change their -definitions slightly. - -@table @kbd - -@item T n -@kindex T n (Topic) -@findex gnus-topic-create-topic -Prompt for a new topic name and create it -(@code{gnus-topic-create-topic}). - -@item T m -@kindex T m (Topic) -@findex gnus-topic-move-group -Move the current group to some other topic -(@code{gnus-topic-move-group}). This command uses the process/prefix -convention (@pxref{Process/Prefix}). - -@item T c -@kindex T c (Topic) -@findex gnus-topic-copy-group -Copy the current group to some other topic -(@code{gnus-topic-copy-group}). This command uses the process/prefix -convention (@pxref{Process/Prefix}). - -@item T D -@kindex T D (Topic) -@findex gnus-topic-remove-group -Remove a group from the current topic (@code{gnus-topic-remove-group}). -This command uses the process/prefix convention -(@pxref{Process/Prefix}). - -@item T M -@kindex T M (Topic) -@findex gnus-topic-move-matching -Move all groups that match some regular expression to a topic -(@code{gnus-topic-move-matching}). - -@item T C -@kindex T C (Topic) -@findex gnus-topic-copy-matching -Copy all groups that match some regular expression to a topic -(@code{gnus-topic-copy-matching}). - -@item T h -@kindex T h (Topic) -@findex gnus-topic-toggle-display-empty-topics -Toggle hiding empty topics -(@code{gnus-topic-toggle-display-empty-topics}). - -@item T # -@kindex T # (Topic) -@findex gnus-topic-mark-topic -Mark all groups in the current topic with the process mark -(@code{gnus-topic-mark-topic}). - -@item T M-# -@kindex T M-# (Topic) -@findex gnus-topic-unmark-topic -Remove the process mark from all groups in the current topic -(@code{gnus-topic-unmark-topic}). - -@item RET -@kindex RET (Topic) -@findex gnus-topic-select-group -@itemx SPACE -Either select a group or fold a topic (@code{gnus-topic-select-group}). -When you perform this command on a group, you'll enter the group, as -usual. When done on a topic line, the topic will be folded (if it was -visible) or unfolded (if it was folded already). So it's basically a -toggling command on topics. In addition, if you give a numerical -prefix, group on that level (and lower) will be displayed. - -@item T TAB -@kindex T TAB (Topic) -@findex gnus-topic-indent -``Indent'' the current topic so that it becomes a sub-topic of the -previous topic (@code{gnus-topic-indent}). If given a prefix, -``un-indent'' the topic instead. - -@item C-k -@kindex C-k (Topic) -@findex gnus-topic-kill-group -Kill a group or topic (@code{gnus-topic-kill-group}). All groups in the -topic will be removed along with the topic. - -@item C-y -@kindex C-y (Topic) -@findex gnus-topic-yank-group -Yank the previously killed group or topic -(@code{gnus-topic-yank-group}). Note that all topics will be yanked -before all groups. - -@item T r -@kindex T r (Topic) -@findex gnus-topic-rename -Rename a topic (@code{gnus-topic-rename}). - -@item T DEL -@kindex T DEL (Topic) -@findex gnus-topic-delete -Delete an empty topic (@code{gnus-topic-delete}). - -@item A T -@kindex A T (Topic) -@findex gnus-topic-list-active -List all groups that Gnus knows about in a topics-ified way -(@code{gnus-topic-list-active}). - -@item G p -@kindex G p (Topic) -@findex gnus-topic-edit-parameters -@cindex group parameters -@cindex topic parameters -@cindex parameters -Edit the topic parameters (@code{gnus-topic-edit-parameters}). -@xref{Topic Parameters}. - -@end table - - -@node Topic Sorting -@subsection Topic Sorting -@cindex topic sorting - -You can sort the groups in each topic individually with the following -commands: - - -@table @kbd -@item T S a -@kindex T S a (Topic) -@findex gnus-topic-sort-groups-by-alphabet -Sort the current topic alphabetically by group name -(@code{gnus-topic-sort-groups-by-alphabet}). - -@item T S u -@kindex T S u (Topic) -@findex gnus-topic-sort-groups-by-unread -Sort the current topic by the number of unread articles -(@code{gnus-topic-sort-groups-by-unread}). - -@item T S l -@kindex T S l (Topic) -@findex gnus-topic-sort-groups-by-level -Sort the current topic by group level -(@code{gnus-topic-sort-groups-by-level}). - -@item T S v -@kindex T S v (Topic) -@findex gnus-topic-sort-groups-by-score -Sort the current topic by group score -(@code{gnus-topic-sort-groups-by-score}). - -@item T S r -@kindex T S r (Topic) -@findex gnus-topic-sort-groups-by-rank -Sort the current topic by group rank -(@code{gnus-topic-sort-groups-by-rank}). - -@item T S m -@kindex T S m (Topic) -@findex gnus-topic-sort-groups-by-method -Sort the current topic alphabetically by backend name -(@code{gnus-topic-sort-groups-by-method}). - -@end table - -@xref{Sorting Groups} for more information about group sorting. - - -@node Topic Topology -@subsection Topic Topology -@cindex topic topology -@cindex topology - -So, let's have a look at an example group buffer: - -@example -Gnus - Emacs -- I wuw it! - 3: comp.emacs - 2: alt.religion.emacs - Naughty Emacs - 452: alt.sex.emacs - 0: comp.talk.emacs.recovery - Misc - 8: comp.binaries.fractals - 13: comp.sources.unix -@end example - -So, here we have one top-level topic (@samp{Gnus}), two topics under -that, and one sub-topic under one of the sub-topics. (There is always -just one (1) top-level topic). This topology can be expressed as -follows: - -@lisp -(("Gnus" visible) - (("Emacs -- I wuw it!" visible) - (("Naughty Emacs" visible))) - (("Misc" visible))) -@end lisp - -@vindex gnus-topic-topology -This is in fact how the variable @code{gnus-topic-topology} would look -for the display above. That variable is saved in the @file{.newsrc.eld} -file, and shouldn't be messed with manually---unless you really want -to. Since this variable is read from the @file{.newsrc.eld} file, -setting it in any other startup files will have no effect. - -This topology shows what topics are sub-topics of what topics (right), -and which topics are visible. Two settings are currently -allowed---@code{visible} and @code{invisible}. - - -@node Topic Parameters -@subsection Topic Parameters -@cindex topic parameters - -All groups in a topic will inherit group parameters from the parent (and -ancestor) topic parameters. All legal group parameters are legal topic -parameters (@pxref{Group Parameters}). - -Group parameters (of course) override topic parameters, and topic -parameters in sub-topics override topic parameters in super-topics. You -know. Normal inheritance rules. (@dfn{Rules} is here a noun, not a -verb, although you may feel free to disagree with me here.) - -@example -Gnus - Emacs - 3: comp.emacs - 2: alt.religion.emacs - 452: alt.sex.emacs - Relief - 452: alt.sex.emacs - 0: comp.talk.emacs.recovery - Misc - 8: comp.binaries.fractals - 13: comp.sources.unix - 452: alt.sex.emacs -@end example - -The @samp{Emacs} topic has the topic parameter @code{(score-file -. "emacs.SCORE")}; the @samp{Relief} topic has the topic parameter -@code{(score-file . "relief.SCORE")}; and the @samp{Misc} topic has the -topic parameter @code{(score-file . "emacs.SCORE")}. In addition, -@samp{alt.religion.emacs} has the group parameter @code{(score-file -. "religion.SCORE")}. - -Now, when you enter @samp{alt.sex.emacs} in the @samp{Relief} topic, you -will get the @file{relief.SCORE} home score file. If you enter the same -group in the @samp{Emacs} topic, you'll get the @file{emacs.SCORE} home -score file. If you enter the group @samp{alt.religion.emacs}, you'll -get the @file{religion.SCORE} home score file. - -This seems rather simple and self-evident, doesn't it? Well, yes. But -there are some problems, especially with the @code{total-expiry} -parameter. Say you have a mail group in two topics; one with -@code{total-expiry} and one without. What happens when you do @kbd{M-x -gnus-expire-all-expirable-groups}? Gnus has no way of telling which one -of these topics you mean to expire articles from, so anything may -happen. In fact, I hereby declare that it is @dfn{undefined} what -happens. You just have to be careful if you do stuff like that. - - -@node Misc Group Stuff -@section Misc Group Stuff - -@menu -* Scanning New Messages:: Asking Gnus to see whether new messages have arrived. -* Group Information:: Information and help on groups and Gnus. -* Group Timestamp:: Making Gnus keep track of when you last read a group. -* File Commands:: Reading and writing the Gnus files. -@end menu - -@table @kbd - -@item ^ -@kindex ^ (Group) -@findex gnus-group-enter-server-mode -Enter the server buffer (@code{gnus-group-enter-server-mode}). -@xref{The Server Buffer}. - -@item a -@kindex a (Group) -@findex gnus-group-post-news -Post an article to a group (@code{gnus-group-post-news}). The current -group name will be used as the default. - -@item m -@kindex m (Group) -@findex gnus-group-mail -Mail a message somewhere (@code{gnus-group-mail}). - -@end table - -Variables for the group buffer: - -@table @code - -@item gnus-group-mode-hook -@vindex gnus-group-mode-hook -is called after the group buffer has been -created. - -@item gnus-group-prepare-hook -@vindex gnus-group-prepare-hook -is called after the group buffer is -generated. It may be used to modify the buffer in some strange, -unnatural way. - -@item gnus-permanently-visible-groups -@vindex gnus-permanently-visible-groups -Groups matching this regexp will always be listed in the group buffer, -whether they are empty or not. - -@end table - - -@node Scanning New Messages -@subsection Scanning New Messages -@cindex new messages -@cindex scanning new news - -@table @kbd - -@item g -@kindex g (Group) -@findex gnus-group-get-new-news -@c @icon{gnus-group-get-new-news} -Check the server(s) for new articles. If the numerical prefix is used, -this command will check only groups of level @var{arg} and lower -(@code{gnus-group-get-new-news}). If given a non-numerical prefix, this -command will force a total re-reading of the active file(s) from the -backend(s). - -@item M-g -@kindex M-g (Group) -@findex gnus-group-get-new-news-this-group -@vindex gnus-goto-next-group-when-activating -@c @icon{gnus-group-get-new-news-this-group} -Check whether new articles have arrived in the current group -(@code{gnus-group-get-new-news-this-group}). -@code{gnus-goto-next-group-when-activating} says whether this command is -to move point to the next group or not. It is @code{t} by default. - -@findex gnus-activate-all-groups -@cindex activating groups -@item C-c M-g -@kindex C-c M-g (Group) -Activate absolutely all groups (@code{gnus-activate-all-groups}). - -@item R -@kindex R (Group) -@cindex restarting -@findex gnus-group-restart -Restart Gnus (@code{gnus-group-restart}). This saves the @file{.newsrc} -file(s), closes the connection to all servers, clears up all run-time -Gnus variables, and then starts Gnus all over again. - -@end table - -@vindex gnus-get-new-news-hook -@code{gnus-get-new-news-hook} is run just before checking for new news. - -@vindex gnus-after-getting-new-news-hook -@code{gnus-after-getting-new-news-hook} is run after checking for new -news. - - -@node Group Information -@subsection Group Information -@cindex group information -@cindex information on groups - -@table @kbd - - -@item H f -@kindex H f (Group) -@findex gnus-group-fetch-faq -@vindex gnus-group-faq-directory -@cindex FAQ -@cindex ange-ftp -Try to fetch the FAQ for the current group -(@code{gnus-group-fetch-faq}). Gnus will try to get the 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 be used -for fetching the file. - -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 d -@itemx C-c C-d -@c @icon{gnus-group-describe-group} -@kindex H d (Group) -@kindex C-c C-d (Group) -@cindex describing groups -@cindex group description -@findex gnus-group-describe-group -Describe the current group (@code{gnus-group-describe-group}). If given -a prefix, force Gnus to re-read the description from the server. - -@item M-d -@kindex M-d (Group) -@findex gnus-group-describe-all-groups -Describe all groups (@code{gnus-group-describe-all-groups}). If given a -prefix, force Gnus to re-read the description file from the server. - -@item H v -@itemx V -@kindex V (Group) -@kindex H v (Group) -@cindex version -@findex gnus-version -Display current Gnus version numbers (@code{gnus-version}). - -@item ? -@kindex ? (Group) -@findex gnus-group-describe-briefly -Give a very short help message (@code{gnus-group-describe-briefly}). - -@item C-c C-i -@kindex C-c C-i (Group) -@cindex info -@cindex manual -@findex gnus-info-find-node -Go to the Gnus info node (@code{gnus-info-find-node}). -@end table - - -@node Group Timestamp -@subsection Group Timestamp -@cindex timestamps -@cindex group timestamps - -It can be convenient to let Gnus keep track of when you last read a -group. To set the ball rolling, you should add -@code{gnus-group-set-timestamp} to @code{gnus-select-group-hook}: - -@lisp -(add-hook 'gnus-select-group-hook 'gnus-group-set-timestamp) -@end lisp - -After doing this, each time you enter a group, it'll be recorded. - -This information can be displayed in various ways---the easiest is to -use the @samp{%d} spec in the group line format: - -@lisp -(setq gnus-group-line-format - "%M\%S\%p\%P\%5y: %(%-40,40g%) %d\n") -@end lisp - -This will result in lines looking like: - -@example -* 0: mail.ding 19961002T012943 - 0: custom 19961002T012713 -@end example - -As you can see, the date is displayed in compact ISO 8601 format. This -may be a bit too much, so to just display the date, you could say -something like: - -@lisp -(setq gnus-group-line-format - "%M\%S\%p\%P\%5y: %(%-40,40g%) %6,6~(cut 2)d\n") -@end lisp - - -@node File Commands -@subsection File Commands -@cindex file commands - -@table @kbd - -@item r -@kindex r (Group) -@findex gnus-group-read-init-file -@vindex gnus-init-file -@cindex reading init file -Re-read the init file (@code{gnus-init-file}, which defaults to -@file{~/.gnus}) (@code{gnus-group-read-init-file}). - -@item s -@kindex s (Group) -@findex gnus-group-save-newsrc -@cindex saving .newsrc -Save the @file{.newsrc.eld} file (and @file{.newsrc} if wanted) -(@code{gnus-group-save-newsrc}). If given a prefix, force saving the -file(s) whether Gnus thinks it is necessary or not. - -@c @item Z -@c @kindex Z (Group) -@c @findex gnus-group-clear-dribble -@c Clear the dribble buffer (@code{gnus-group-clear-dribble}). - -@end table - - -@node The Summary Buffer -@chapter The Summary Buffer -@cindex summary buffer - -A line for each article is displayed in the summary buffer. You can -move around, read articles, post articles and reply to articles. - -The most common way to a summary buffer is to select a group from the -group buffer (@pxref{Selecting a Group}). - -You can have as many summary buffers open as you wish. - -@menu -* Summary Buffer Format:: Deciding how the summary buffer is to look. -* Summary Maneuvering:: Moving around the summary buffer. -* Choosing Articles:: Reading articles. -* Paging the Article:: Scrolling the current article. -* Reply Followup and Post:: Posting articles. -* Canceling and Superseding:: ``Whoops, I shouldn't have called him that.'' -* Marking Articles:: Marking articles as read, expirable, etc. -* Limiting:: You can limit the summary buffer. -* Threading:: How threads are made. -* Sorting:: How articles and threads are sorted. -* Asynchronous Fetching:: Gnus might be able to pre-fetch articles. -* Article Caching:: You may store articles in a cache. -* Persistent Articles:: Making articles expiry-resistant. -* Article Backlog:: Having already read articles hang around. -* Saving Articles:: Ways of customizing article saving. -* Decoding Articles:: Gnus can treat series of (uu)encoded articles. -* Article Treatment:: The article buffer can be mangled at will. -* Article Commands:: Doing various things with the article buffer. -* Summary Sorting:: Sorting the summary buffer in various ways. -* Finding the Parent:: No child support? Get the parent. -* Alternative Approaches:: Reading using non-default summaries. -* Tree Display:: A more visual display of threads. -* Mail Group Commands:: Some commands can only be used in mail groups. -* Various Summary Stuff:: What didn't fit anywhere else. -* Exiting the Summary Buffer:: Returning to the Group buffer. -* Crosspost Handling:: How crossposted articles are dealt with. -* Duplicate Suppression:: An alternative when crosspost handling fails. -@end menu - - -@node Summary Buffer Format -@section Summary Buffer Format -@cindex summary buffer format - -@iftex -@iflatex -\gnusfigure{The Summary Buffer}{180}{ -\put(0,0){\epsfig{figure=tmp/summary.ps,width=7.5cm}} -\put(445,0){\makebox(0,0)[br]{\epsfig{figure=tmp/summary-article.ps,width=7.5cm}}} -} -@end iflatex -@end iftex - -@menu -* Summary Buffer Lines:: You can specify how summary lines should look. -* Summary Buffer Mode Line:: You can say how the mode line should look. -* Summary Highlighting:: Making the summary buffer all pretty and nice. -@end menu - -@findex mail-extract-address-components -@findex gnus-extract-address-components -@vindex gnus-extract-address-components -Gnus will use the value of the @code{gnus-extract-address-components} -variable as a function for getting the name and address parts of a -@code{From} header. Two pre-defined functions exist: -@code{gnus-extract-address-components}, which is the default, quite -fast, and too simplistic solution; and -@code{mail-extract-address-components}, which works very nicely, but is -slower. The default function will return the wrong answer in 5% of the -cases. If this is unacceptable to you, use the other function instead. - -@vindex gnus-summary-same-subject -@code{gnus-summary-same-subject} is a string indicating that the current -article has the same subject as the previous. This string will be used -with those specs that require it. The default is @samp{}. - - -@node Summary Buffer Lines -@subsection Summary Buffer Lines - -@vindex gnus-summary-line-format -You can change the format of the lines in the summary buffer by changing -the @code{gnus-summary-line-format} variable. It works along the same -lines as a normal @code{format} string, with some extensions -(@pxref{Formatting Variables}). - -The default string is @samp{%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n}. - -The following format specification characters are understood: - -@table @samp -@item N -Article number. -@item S -Subject string. -@item s -Subject if the article is the root or the previous article had a -different subject, @code{gnus-summary-same-subject} otherwise. -(@code{gnus-summary-same-subject} defaults to @samp{}.) -@item F -Full @code{From} header. -@item n -The name (from the @code{From} header). -@item a -The name (from the @code{From} header). This differs from the @code{n} -spec in that it uses the function designated by the -@code{gnus-extract-address-components} variable, which is slower, but -may be more thorough. -@item A -The address (from the @code{From} header). This works the same way as -the @code{a} spec. -@item L -Number of lines in the article. -@item c -Number of characters in the article. -@item I -Indentation based on thread level (@pxref{Customizing Threading}). -@item T -Nothing if the article is a root and lots of spaces if it isn't (it -pushes everything after it off the screen). -@item [ -Opening bracket, which is normally @samp{[}, but can also be @samp{<} -for adopted articles (@pxref{Customizing Threading}). -@item ] -Closing bracket, which is normally @samp{]}, but can also be @samp{>} -for adopted articles. -@item > -One space for each thread level. -@item < -Twenty minus thread level spaces. -@item U -Unread. -@item R -Replied. -@item i -Score as a number. -@item z -@vindex gnus-summary-zcore-fuzz -Zcore, @samp{+} if above the default level and @samp{-} if below the -default level. If the difference between -@code{gnus-summary-default-level} and the score is less than -@code{gnus-summary-zcore-fuzz}, this spec will not be used. -@item V -Total thread score. -@item x -@code{Xref}. -@item D -@code{Date}. -@item d -The @code{Date} in @code{DD-MMM} format. -@item o -The @code{Date} in @var{YYYYMMDD}@code{T}@var{HHMMSS} format. -@item M -@code{Message-ID}. -@item r -@code{References}. -@item t -Number of articles in the current sub-thread. Using this spec will slow -down summary buffer generation somewhat. -@item e -An @samp{=} (@code{gnus-not-empty-thread-mark}) will be displayed if the -article has any children. -@item P -The line number. -@item u -User defined specifier. The next character in the format string should -be a letter. Gnus will call the function -@code{gnus-user-format-function-}@samp{X}, where @samp{X} is the letter -following @samp{%u}. The function will be passed the current header as -argument. The function should return a string, which will be inserted -into the summary just like information from any other summary specifier. -@end table - -The @samp{%U} (status), @samp{%R} (replied) and @samp{%z} (zcore) specs -have to be handled with care. For reasons of efficiency, Gnus will -compute what column these characters will end up in, and ``hard-code'' -that. This means that it is illegal to have these specs after a -variable-length spec. Well, you might not be arrested, but your summary -buffer will look strange, which is bad enough. - -The smart choice is to have these specs as far to the left as possible. -(Isn't that the case with everything, though? But I digress.) - -This restriction may disappear in later versions of Gnus. - - -@node Summary Buffer Mode Line -@subsection Summary Buffer Mode Line - -@vindex gnus-summary-mode-line-format -You can also change the format of the summary mode bar. Set -@code{gnus-summary-mode-line-format} to whatever you like. The default -is @samp{Gnus: %%b [%A] %Z}. - -Here are the elements you can play with: - -@table @samp -@item G -Group name. -@item p -Unprefixed group name. -@item A -Current article number. -@item V -Gnus version. -@item U -Number of unread articles in this group. -@item e -Number of unselected articles in this group. -@item Z -A string with the number of unread and unselected articles represented -either as @samp{<%U(+%e) more>} if there are both unread and unselected -articles, and just as @samp{<%U more>} if there are just unread articles -and no unselected ones. -@item g -Shortish group name. For instance, @samp{rec.arts.anime} will be -shortened to @samp{r.a.anime}. -@item S -Subject of the current article. -@item u -User-defined spec. -@item s -Name of the current score file. -@item d -Number of dormant articles. -@item t -Number of ticked articles. -@item r -Number of articles that have been marked as read in this session. -@item E -Number of articles expunged by the score files. -@end table - - -@node Summary Highlighting -@subsection Summary Highlighting - -@table @code - -@item gnus-visual-mark-article-hook -@vindex gnus-visual-mark-article-hook -This hook is run after selecting an article. It is meant to be used for -highlighting the article in some way. It is not run if -@code{gnus-visual} is @code{nil}. - -@item gnus-summary-update-hook -@vindex gnus-summary-update-hook -This hook is called when a summary line is changed. It is not run if -@code{gnus-visual} is @code{nil}. - -@item gnus-summary-selected-face -@vindex gnus-summary-selected-face -This is the face (or @dfn{font} as some people call it) used to -highlight the current article in the summary buffer. - -@item gnus-summary-highlight -@vindex gnus-summary-highlight -Summary lines are highlighted according to this variable, which is a -list where the elements are of the format @var{(FORM . FACE)}. If you -would, for instance, like ticked articles to be italic and high-scored -articles to be bold, you could set this variable to something like -@lisp -(((eq mark gnus-ticked-mark) . italic) - ((> score default) . bold)) -@end lisp -As you may have guessed, if @var{FORM} returns a non-@code{nil} value, -@var{FACE} will be applied to the line. -@end table - - -@node Summary Maneuvering -@section Summary Maneuvering -@cindex summary movement - -All the straight movement commands understand the numeric prefix and -behave pretty much as you'd expect. - -None of these commands select articles. - -@table @kbd -@item G M-n -@itemx M-n -@kindex M-n (Summary) -@kindex G M-n (Summary) -@findex gnus-summary-next-unread-subject -Go to the next summary line of an unread article -(@code{gnus-summary-next-unread-subject}). - -@item G M-p -@itemx M-p -@kindex M-p (Summary) -@kindex G M-p (Summary) -@findex gnus-summary-prev-unread-subject -Go to the previous summary line of an unread article -(@code{gnus-summary-prev-unread-subject}). - -@item G j -@itemx j -@kindex j (Summary) -@kindex G j (Summary) -@findex gnus-summary-goto-article -Ask for an article number and then go to that article -(@code{gnus-summary-goto-article}). - -@item G g -@kindex G g (Summary) -@findex gnus-summary-goto-subject -Ask for an article number and then go to the summary line of that article -without displaying the article (@code{gnus-summary-goto-subject}). -@end table - -If Gnus asks you to press a key to confirm going to the next group, you -can use the @kbd{C-n} and @kbd{C-p} keys to move around the group -buffer, searching for the next group to read without actually returning -to the group buffer. - -Variables related to summary movement: - -@table @code - -@vindex gnus-auto-select-next -@item gnus-auto-select-next -If you issue one of the movement commands (like @kbd{n}) and there are -no more unread articles after the current one, Gnus will offer to go to -the next group. If this variable is @code{t} and the next group is -empty, Gnus will exit summary mode and return to the group buffer. If -this variable is neither @code{t} nor @code{nil}, Gnus will select the -next group, no matter whether it has any unread articles or not. As a -special case, if this variable is @code{quietly}, Gnus will select the -next group without asking for confirmation. If this variable is -@code{almost-quietly}, the same will happen only if you are located on -the last article in the group. Finally, if this variable is -@code{slightly-quietly}, the @kbd{Z n} command will go to the next group -without confirmation. Also @pxref{Group Levels}. - -@item gnus-auto-select-same -@vindex gnus-auto-select-same -If non-@code{nil}, all the movement commands will try to go to the next -article with the same subject as the current. (@dfn{Same} here might -mean @dfn{roughly equal}. See @code{gnus-summary-gather-subject-limit} -for details (@pxref{Customizing Threading}).) This variable is not -particularly useful if you use a threaded display. - -@item gnus-summary-check-current -@vindex gnus-summary-check-current -If non-@code{nil}, all the ``unread'' movement commands will not proceed -to the next (or previous) article if the current article is unread. -Instead, they will choose the current article. - -@item gnus-auto-center-summary -@vindex gnus-auto-center-summary -If non-@code{nil}, Gnus will keep the point in the summary buffer -centered at all times. This makes things quite tidy, but if you have a -slow network connection, or simply do not like this un-Emacsism, you can -set this variable to @code{nil} to get the normal Emacs scrolling -action. This will also inhibit horizontal re-centering of the summary -buffer, which might make it more inconvenient to read extremely long -threads. - -@end table - - -@node Choosing Articles -@section Choosing Articles -@cindex selecting articles - -@menu -* Choosing Commands:: Commands for choosing articles. -* Choosing Variables:: Variables that influence these commands. -@end menu - - -@node Choosing Commands -@subsection Choosing Commands - -None of the following movement commands understand the numeric prefix, -and they all select and display an article. - -@table @kbd -@item SPACE -@kindex SPACE (Summary) -@findex gnus-summary-next-page -Select the current article, or, if that one's read already, the next -unread article (@code{gnus-summary-next-page}). - -@item G n -@itemx n -@kindex n (Summary) -@kindex G n (Summary) -@findex gnus-summary-next-unread-article -@c @icon{gnus-summary-next-unread} -Go to next unread article (@code{gnus-summary-next-unread-article}). - -@item G p -@itemx p -@kindex p (Summary) -@findex gnus-summary-prev-unread-article -@c @icon{gnus-summary-prev-unread} -Go to previous unread article (@code{gnus-summary-prev-unread-article}). - -@item G N -@itemx N -@kindex N (Summary) -@kindex G N (Summary) -@findex gnus-summary-next-article -Go to the next article (@code{gnus-summary-next-article}). - -@item G P -@itemx P -@kindex P (Summary) -@kindex G P (Summary) -@findex gnus-summary-prev-article -Go to the previous article (@code{gnus-summary-prev-article}). - -@item G C-n -@kindex G C-n (Summary) -@findex gnus-summary-next-same-subject -Go to the next article with the same subject -(@code{gnus-summary-next-same-subject}). - -@item G C-p -@kindex G C-p (Summary) -@findex gnus-summary-prev-same-subject -Go to the previous article with the same subject -(@code{gnus-summary-prev-same-subject}). - -@item G f -@itemx . -@kindex G f (Summary) -@kindex . (Summary) -@findex gnus-summary-first-unread-article -Go to the first unread article -(@code{gnus-summary-first-unread-article}). - -@item G b -@itemx , -@kindex G b (Summary) -@kindex , (Summary) -@findex gnus-summary-best-unread-article -Go to the article with the highest score -(@code{gnus-summary-best-unread-article}). - -@item G l -@itemx l -@kindex l (Summary) -@kindex G l (Summary) -@findex gnus-summary-goto-last-article -Go to the previous article read (@code{gnus-summary-goto-last-article}). - -@item G p -@kindex G p (Summary) -@findex gnus-summary-pop-article -Pop an article off the summary history and go to this article -(@code{gnus-summary-pop-article}). This command differs from the -command above in that you can pop as many previous articles off the -history as you like. -@end table - - -@node Choosing Variables -@subsection Choosing Variables - -Some variables relevant for moving and selecting articles: - -@table @code -@item gnus-auto-extend-newsgroup -@vindex gnus-auto-extend-newsgroup -All the movement commands will try to go to the previous (or next) -article, even if that article isn't displayed in the Summary buffer if -this variable is non-@code{nil}. Gnus will then fetch the article from -the server and display it in the article buffer. - -@item gnus-select-article-hook -@vindex gnus-select-article-hook -This hook is called whenever an article is selected. By default it -exposes any threads hidden under the selected article. - -@item gnus-mark-article-hook -@vindex gnus-mark-article-hook -@findex gnus-summary-mark-unread-as-read -@findex gnus-summary-mark-read-and-unread-as-read -@findex gnus-unread-mark -This hook is called whenever an article is selected. It is intended to -be used for marking articles as read. The default value is -@code{gnus-summary-mark-read-and-unread-as-read}, and will change the -mark of almost any article you read to @code{gnus-unread-mark}. The -only articles not affected by this function are ticked, dormant, and -expirable articles. If you'd instead like to just have unread articles -marked as read, you can use @code{gnus-summary-mark-unread-as-read} -instead. It will leave marks like @code{gnus-low-score-mark}, -@code{gnus-del-mark} (and so on) alone. - -@end table - - -@node Paging the Article -@section Scrolling the Article -@cindex article scrolling - -@table @kbd - -@item SPACE -@kindex SPACE (Summary) -@findex gnus-summary-next-page -Pressing @kbd{SPACE} will scroll the current article forward one page, -or, if you have come to the end of the current article, will choose the -next article (@code{gnus-summary-next-page}). - -@item DEL -@kindex DEL (Summary) -@findex gnus-summary-prev-page -Scroll the current article back one page (@code{gnus-summary-prev-page}). - -@item RET -@kindex RET (Summary) -@findex gnus-summary-scroll-up -Scroll the current article one line forward -(@code{gnus-summary-scroll-up}). - -@item A g -@itemx g -@kindex A g (Summary) -@kindex g (Summary) -@findex gnus-summary-show-article -(Re)fetch the current article (@code{gnus-summary-show-article}). If -given a prefix, fetch the current article, but don't run any of the -article treatment functions. This will give you a ``raw'' article, just -the way it came from the server. - -@item A < -@itemx < -@kindex < (Summary) -@kindex A < (Summary) -@findex gnus-summary-beginning-of-article -Scroll to the beginning of the article -(@code{gnus-summary-beginning-of-article}). - -@item A > -@itemx > -@kindex > (Summary) -@kindex A > (Summary) -@findex gnus-summary-end-of-article -Scroll to the end of the article (@code{gnus-summary-end-of-article}). - -@item A s -@itemx s -@kindex A s (Summary) -@kindex s (Summary) -@findex gnus-summary-isearch-article -Perform an isearch in the article buffer -(@code{gnus-summary-isearch-article}). - -@end table - - -@node Reply Followup and Post -@section Reply, Followup and Post - -@menu -* Summary Mail Commands:: Sending mail. -* Summary Post Commands:: Sending news. -@end menu - - -@node Summary Mail Commands -@subsection Summary Mail Commands -@cindex mail -@cindex composing mail - -Commands for composing a mail message: - -@table @kbd - -@item S r -@itemx r -@kindex S r (Summary) -@kindex r (Summary) -@findex gnus-summary-reply -@c @icon{gnus-summary-mail-reply} -@c @icon{gnus-summary-reply} -Mail a reply to the author of the current article -(@code{gnus-summary-reply}). - -@item S R -@itemx R -@kindex R (Summary) -@kindex S R (Summary) -@findex gnus-summary-reply-with-original -@c @icon{gnus-summary-reply-with-original} -Mail a reply to the author of the current article and include the -original message (@code{gnus-summary-reply-with-original}). This -command uses the process/prefix convention. - -@item S w -@kindex S w (Summary) -@findex gnus-summary-wide-reply -Mail a wide reply to the author of the current article -(@code{gnus-summary-wide-reply}). A @dfn{wide reply} is a reply that -goes out to all people listed in the @code{To}, @code{From} (or -@code{Reply-to}) and @code{Cc} headers. - -@item S W -@kindex S W (Summary) -@findex gnus-summary-wide-reply-with-original -Mail a wide reply to the current article and include the original -message (@code{gnus-summary-reply-with-original}). This command uses -the process/prefix convention. - -@item S o m -@kindex S o m (Summary) -@findex gnus-summary-mail-forward -@c @icon{gnus-summary-mail-forward} -Forward the current article to some other person -(@code{gnus-summary-mail-forward}). If given a prefix, include the full -headers of the forwarded article. - -@item S m -@itemx m -@kindex m (Summary) -@kindex S m (Summary) -@findex gnus-summary-mail-other-window -@c @icon{gnus-summary-mail-originate} -Send a mail to some other person -(@code{gnus-summary-mail-other-window}). - -@item S D b -@kindex S D b (Summary) -@findex gnus-summary-resend-bounced-mail -@cindex bouncing mail -If you have sent a mail, but the mail was bounced back to you for some -reason (wrong address, transient failure), you can use this command to -resend that bounced mail (@code{gnus-summary-resend-bounced-mail}). You -will be popped into a mail buffer where you can edit the headers before -sending the mail off again. If you give a prefix to this command, and -the bounced mail is a reply to some other mail, Gnus will try to fetch -that mail and display it for easy perusal of its headers. This might -very well fail, though. - -@item S D r -@kindex S D r (Summary) -@findex gnus-summary-resend-message -Not to be confused with the previous command, -@code{gnus-summary-resend-message} will prompt you for an address to -send the current message off to, and then send it to that place. The -headers of the message won't be altered---but lots of headers that say -@code{Resent-To}, @code{Resent-From} and so on will be added. This -means that you actually send a mail to someone that has a @code{To} -header that (probably) points to yourself. This will confuse people. -So, natcherly you'll only do that if you're really eVIl. - -This command is mainly used if you have several accounts and want to -ship a mail to a different account of yours. (If you're both -@code{root} and @code{postmaster} and get a mail for @code{postmaster} -to the @code{root} account, you may want to resend it to -@code{postmaster}. Ordnung muß sein! - -This command understands the process/prefix convention -(@pxref{Process/Prefix}). - -@item S O m -@kindex S O m (Summary) -@findex gnus-uu-digest-mail-forward -Digest the current series and forward the result using mail -(@code{gnus-uu-digest-mail-forward}). This command uses the -process/prefix convention (@pxref{Process/Prefix}). - -@item S M-c -@kindex S M-c (Summary) -@findex gnus-summary-mail-crosspost-complaint -@cindex crossposting -@cindex excessive crossposting -Send a complaint about excessive crossposting to the author of the -current article (@code{gnus-summary-mail-crosspost-complaint}). - -@findex gnus-crosspost-complaint -This command is provided as a way to fight back agains the current -crossposting pandemic that's sweeping Usenet. It will compose a reply -using the @code{gnus-crosspost-complaint} variable as a preamble. This -command understands the process/prefix convention -(@pxref{Process/Prefix}) and will prompt you before sending each mail. - -@end table - - -@node Summary Post Commands -@subsection Summary Post Commands -@cindex post -@cindex composing news - -Commands for posting a news article: - -@table @kbd -@item S p -@itemx a -@kindex a (Summary) -@kindex S p (Summary) -@findex gnus-summary-post-news -@c @icon{gnus-summary-post-news} -Post an article to the current group -(@code{gnus-summary-post-news}). - -@item S f -@itemx f -@kindex f (Summary) -@kindex S f (Summary) -@findex gnus-summary-followup -@c @icon{gnus-summary-followup} -Post a followup to the current article (@code{gnus-summary-followup}). - -@item S F -@itemx F -@kindex S F (Summary) -@kindex F (Summary) -@c @icon{gnus-summary-followup-with-original} -@findex gnus-summary-followup-with-original -Post a followup to the current article and include the original message -(@code{gnus-summary-followup-with-original}). This command uses the -process/prefix convention. - -@item S n -@kindex S n (Summary) -@findex gnus-summary-followup-to-mail -Post a followup to the current article via news, even if you got the -message through mail (@code{gnus-summary-followup-to-mail}). - -@item S n -@kindex S n (Summary) -@findex gnus-summary-followup-to-mail -Post a followup to the current article via news, even if you got the -message through mail and include the original message -(@code{gnus-summary-followup-to-mail-with-original}). This command uses -the process/prefix convention. - -@item S o p -@kindex S o p (Summary) -@findex gnus-summary-post-forward -Forward the current article to a newsgroup -(@code{gnus-summary-post-forward}). If given a prefix, include the full -headers of the forwarded article. - -@item S O p -@kindex S O p (Summary) -@findex gnus-uu-digest-post-forward -@cindex digests -@cindex making digests -Digest the current series and forward the result to a newsgroup -(@code{gnus-uu-digest-mail-forward}). This command uses the -process/prefix convention. - -@item S u -@kindex S u (Summary) -@findex gnus-uu-post-news -@c @icon{gnus-uu-post-news} -Uuencode a file, split it into parts, and post it as a series -(@code{gnus-uu-post-news}). (@pxref{Uuencoding and Posting}). -@end table - - -@node Canceling and Superseding -@section Canceling Articles -@cindex canceling articles -@cindex superseding articles - -Have you ever written something, and then decided that you really, -really, really wish you hadn't posted that? - -Well, you can't cancel mail, but you can cancel posts. - -@findex gnus-summary-cancel-article -@kindex C (Summary) -@c @icon{gnus-summary-cancel-article} -Find the article you wish to cancel (you can only cancel your own -articles, so don't try any funny stuff). Then press @kbd{C} or @kbd{S -c} (@code{gnus-summary-cancel-article}). Your article will be -canceled---machines all over the world will be deleting your article. - -Be aware, however, that not all sites honor cancels, so your article may -live on here and there, while most sites will delete the article in -question. - -If you discover that you have made some mistakes and want to do some -corrections, you can post a @dfn{superseding} article that will replace -your original article. - -@findex gnus-summary-supersede-article -@kindex S (Summary) -Go to the original article and press @kbd{S s} -(@code{gnus-summary-supersede-article}). You will be put in a buffer -where you can edit the article all you want before sending it off the -usual way. - -The same goes for superseding as for canceling, only more so: Some -sites do not honor superseding. On those sites, it will appear that you -have posted almost the same article twice. - -If you have just posted the article, and change your mind right away, -there is a trick you can use to cancel/supersede the article without -waiting for the article to appear on your site first. You simply return -to the post buffer (which is called @code{*sent ...*}). There you will -find the article you just posted, with all the headers intact. Change -the @code{Message-ID} header to a @code{Cancel} or @code{Supersedes} -header by substituting one of those words for the word -@code{Message-ID}. Then just press @kbd{C-c C-c} to send the article as -you would do normally. The previous article will be -canceled/superseded. - -Just remember, kids: There is no 'c' in 'supersede'. - - -@node Marking Articles -@section Marking Articles -@cindex article marking -@cindex article ticking -@cindex marks - -There are several marks you can set on an article. - -You have marks that decide the @dfn{readedness} (whoo, neato-keano -neologism ohoy!) of the article. Alphabetic marks generally mean -@dfn{read}, while non-alphabetic characters generally mean @dfn{unread}. - -In addition, you also have marks that do not affect readedness. - -@menu -* Unread Articles:: Marks for unread articles. -* Read Articles:: Marks for read articles. -* Other Marks:: Marks that do not affect readedness. -@end menu - -@ifinfo -There's a plethora of commands for manipulating these marks: -@end ifinfo - -@menu -* Setting Marks:: How to set and remove marks. -* Setting Process Marks:: How to mark articles for later processing. -@end menu - - -@node Unread Articles -@subsection Unread Articles - -The following marks mark articles as (kinda) unread, in one form or -other. - -@table @samp -@item ! -@vindex gnus-ticked-mark -Marked as ticked (@code{gnus-ticked-mark}). - -@dfn{Ticked articles} are articles that will remain visible always. If -you see an article that you find interesting, or you want to put off -reading it, or replying to it, until sometime later, you'd typically -tick it. However, articles can be expired, so if you want to keep an -article forever, you'll have to make it persistent (@pxref{Persistent -Articles}). - -@item ? -@vindex gnus-dormant-mark -Marked as dormant (@code{gnus-dormant-mark}). - -@dfn{Dormant articles} will only appear in the summary buffer if there -are followups to it. - -@item SPACE -@vindex gnus-unread-mark -Markes as unread (@code{gnus-unread-mark}). - -@dfn{Unread articles} are articles that haven't been read at all yet. -@end table - - -@node Read Articles -@subsection Read Articles -@cindex expirable mark - -All the following marks mark articles as read. - -@table @samp - -@item r -@vindex gnus-del-mark -These are articles that the user has marked as read with the @kbd{d} -command manually, more or less (@code{gnus-del-mark}). - -@item R -@vindex gnus-read-mark -Articles that have actually been read (@code{gnus-read-mark}). - -@item O -@vindex gnus-ancient-mark -Articles that were marked as read in previous sessions and are now -@dfn{old} (@code{gnus-ancient-mark}). - -@item K -@vindex gnus-killed-mark -Marked as killed (@code{gnus-killed-mark}). - -@item X -@vindex gnus-kill-file-mark -Marked as killed by kill files (@code{gnus-kill-file-mark}). - -@item Y -@vindex gnus-low-score-mark -Marked as read by having too low a score (@code{gnus-low-score-mark}). - -@item C -@vindex gnus-catchup-mark -Marked as read by a catchup (@code{gnus-catchup-mark}). - -@item G -@vindex gnus-canceled-mark -Canceled article (@code{gnus-canceled-mark}) - -@item F -@vindex gnus-souped-mark -@sc{SOUP}ed article (@code{gnus-souped-mark}). @xref{SOUP}. - -@item Q -@vindex gnus-sparse-mark -Sparsely reffed article (@code{gnus-sparse-mark}). @xref{Customizing -Threading}. - -@item M -@vindex gnus-duplicate-mark -Article marked as read by duplicate suppression -(@code{gnus-duplicated-mark}). @xref{Duplicate Suppression}. - -@end table - -All these marks just mean that the article is marked as read, really. -They are interpreted differently when doing adaptive scoring, though. - -One more special mark, though: - -@table @samp -@item E -@vindex gnus-expirable-mark -Marked as expirable (@code{gnus-expirable-mark}). - -Marking articles as @dfn{expirable} (or have them marked as such -automatically) doesn't make much sense in normal groups---a user doesn't -control expiring of news articles, but in mail groups, for instance, -articles marked as @dfn{expirable} can be deleted by Gnus at -any time. -@end table - - -@node Other Marks -@subsection Other Marks -@cindex process mark -@cindex bookmarks - -There are some marks that have nothing to do with whether the article is -read or not. - -@itemize @bullet - -@item -You can set a bookmark in the current article. Say you are reading a -long thesis on cats' urinary tracts, and have to go home for dinner -before you've finished reading the thesis. You can then set a bookmark -in the article, and Gnus will jump to this bookmark the next time it -encounters the article. @xref{Setting Marks} - -@item -@vindex gnus-replied-mark -All articles that you have replied to or made a followup to (i.e., have -answered) will be marked with an @samp{A} in the second column -(@code{gnus-replied-mark}). - -@item -@vindex gnus-cached-mark -Articles stored in the article cache will be marked with an -@samp{*} in the second column (@code{gnus-cached-mark}). - -@item -@vindex gnus-saved-mark -Articles ``saved'' (in some manner or other; not necessarily -religiously) are marked with an @samp{S} in the second column -(@code{gnus-saved-mark}). - -@item -@vindex gnus-not-empty-thread-mark -@vindex gnus-empty-thread-mark -If the @samp{%e} spec is used, the presence of threads or not will be -marked with @code{gnus-not-empty-thread-mark} and -@code{gnus-empty-thread-mark} in the third column, respectively. - -@item -@vindex gnus-process-mark -Finally we have the @dfn{process mark} (@code{gnus-process-mark}). A -variety of commands react to the presence of the process mark. For -instance, @kbd{X u} (@code{gnus-uu-decode-uu}) will uudecode and view -all articles that have been marked with the process mark. Articles -marked with the process mark have a @samp{#} in the second column. - -@end itemize - -You might have noticed that most of these ``non-readedness'' marks -appear in the second column by default. So if you have a cached, saved, -replied article that you have process-marked, what will that look like? - -Nothing much. The precedence rules go as follows: process -> cache -> -replied -> saved. So if the article is in the cache and is replied, -you'll only see the cache mark and not the replied mark. - - -@node Setting Marks -@subsection Setting Marks -@cindex setting marks - -All the marking commands understand the numeric prefix. - -@table @kbd -@item M t -@itemx ! -@kindex ! (Summary) -@kindex M t (Summary) -@findex gnus-summary-tick-article-forward -Tick the current article (@code{gnus-summary-tick-article-forward}). - -@item M ? -@itemx ? -@kindex ? (Summary) -@kindex M ? (Summary) -@findex gnus-summary-mark-as-dormant -Mark the current article as dormant -(@code{gnus-summary-mark-as-dormant}). - -@item M d -@itemx d -@kindex M d (Summary) -@kindex d (Summary) -@findex gnus-summary-mark-as-read-forward -Mark the current article as read -(@code{gnus-summary-mark-as-read-forward}). - -@item D -@kindex D (Summary) -@findex gnus-summary-mark-as-read-backward -Mark the current article as read and move point to the previous line -(@code{gnus-summary-mark-as-read-backward}). - -@item M k -@itemx k -@kindex k (Summary) -@kindex M k (Summary) -@findex gnus-summary-kill-same-subject-and-select -Mark all articles that have the same subject as the current one as read, -and then select the next unread article -(@code{gnus-summary-kill-same-subject-and-select}). - -@item M K -@itemx C-k -@kindex M K (Summary) -@kindex C-k (Summary) -@findex gnus-summary-kill-same-subject -Mark all articles that have the same subject as the current one as read -(@code{gnus-summary-kill-same-subject}). - -@item M C -@kindex M C (Summary) -@findex gnus-summary-catchup -@c @icon{gnus-summary-catchup} -Mark all unread articles as read (@code{gnus-summary-catchup}). - -@item M C-c -@kindex M C-c (Summary) -@findex gnus-summary-catchup-all -Mark all articles in the group as read---even the ticked and dormant -articles (@code{gnus-summary-catchup-all}). - -@item M H -@kindex M H (Summary) -@findex gnus-summary-catchup-to-here -Catchup the current group to point -(@code{gnus-summary-catchup-to-here}). - -@item C-w -@kindex C-w (Summary) -@findex gnus-summary-mark-region-as-read -Mark all articles between point and mark as read -(@code{gnus-summary-mark-region-as-read}). - -@item M V k -@kindex M V k (Summary) -@findex gnus-summary-kill-below -Kill all articles with scores below the default score (or below the -numeric prefix) (@code{gnus-summary-kill-below}). - -@item M c -@itemx M-u -@kindex M c (Summary) -@kindex M-u (Summary) -@findex gnus-summary-clear-mark-forward -Clear all readedness-marks from the current article -(@code{gnus-summary-clear-mark-forward}). - -@item M e -@itemx E -@kindex M e (Summary) -@kindex E (Summary) -@findex gnus-summary-mark-as-expirable -Mark the current article as expirable -(@code{gnus-summary-mark-as-expirable}). - -@item M b -@kindex M b (Summary) -@findex gnus-summary-set-bookmark -Set a bookmark in the current article -(@code{gnus-summary-set-bookmark}). - -@item M B -@kindex M B (Summary) -@findex gnus-summary-remove-bookmark -Remove the bookmark from the current article -(@code{gnus-summary-remove-bookmark}). - -@item M V c -@kindex M V c (Summary) -@findex gnus-summary-clear-above -Clear all marks from articles with scores over the default score (or -over the numeric prefix) (@code{gnus-summary-clear-above}). - -@item M V u -@kindex M V u (Summary) -@findex gnus-summary-tick-above -Tick all articles with scores over the default score (or over the -numeric prefix) (@code{gnus-summary-tick-above}). - -@item M V m -@kindex M V m (Summary) -@findex gnus-summary-mark-above -Prompt for a mark, and mark all articles with scores over the default -score (or over the numeric prefix) with this mark -(@code{gnus-summary-clear-above}). -@end table - -@vindex gnus-summary-goto-unread -The @code{gnus-summary-goto-unread} variable controls what action should -be taken after setting a mark. If non-@code{nil}, point will move to -the next/previous unread article. If @code{nil}, point will just move -one line up or down. As a special case, if this variable is -@code{never}, all the marking commands as well as other commands (like -@kbd{SPACE}) will move to the next article, whether it is unread or not. -The default is @code{t}. - - -@node Setting Process Marks -@subsection Setting Process Marks -@cindex setting process marks - -@table @kbd - -@item M P p -@itemx # -@kindex # (Summary) -@kindex M P p (Summary) -@findex gnus-summary-mark-as-processable -Mark the current article with the process mark -(@code{gnus-summary-mark-as-processable}). -@findex gnus-summary-unmark-as-processable - -@item M P u -@itemx M-# -@kindex M P u (Summary) -@kindex M-# (Summary) -Remove the process mark, if any, from the current article -(@code{gnus-summary-unmark-as-processable}). - -@item M P U -@kindex M P U (Summary) -@findex gnus-summary-unmark-all-processable -Remove the process mark from all articles -(@code{gnus-summary-unmark-all-processable}). - -@item M P i -@kindex M P i (Summary) -@findex gnus-uu-invert-processable -Invert the list of process marked articles -(@code{gnus-uu-invert-processable}). - -@item M P R -@kindex M P R (Summary) -@findex gnus-uu-mark-by-regexp -Mark articles by a regular expression (@code{gnus-uu-mark-by-regexp}). - -@item M P r -@kindex M P r (Summary) -@findex gnus-uu-mark-region -Mark articles in region (@code{gnus-uu-mark-region}). - -@item M P t -@kindex M P t (Summary) -@findex gnus-uu-mark-thread -Mark all articles in the current (sub)thread -(@code{gnus-uu-mark-thread}). - -@item M P T -@kindex M P T (Summary) -@findex gnus-uu-unmark-thread -Unmark all articles in the current (sub)thread -(@code{gnus-uu-unmark-thread}). - -@item M P v -@kindex M P v (Summary) -@findex gnus-uu-mark-over -Mark all articles that have a score above the prefix argument -(@code{gnus-uu-mark-over}). - -@item M P s -@kindex M P s (Summary) -@findex gnus-uu-mark-series -Mark all articles in the current series (@code{gnus-uu-mark-series}). - -@item M P S -@kindex M P S (Summary) -@findex gnus-uu-mark-sparse -Mark all series that have already had some articles marked -(@code{gnus-uu-mark-sparse}). - -@item M P a -@kindex M P a (Summary) -@findex gnus-uu-mark-all -Mark all articles in series order (@code{gnus-uu-mark-series}). - -@item M P b -@kindex M P b (Summary) -@findex gnus-uu-mark-buffer -Mark all articles in the buffer in the order they appear -(@code{gnus-uu-mark-buffer}). - -@item M P k -@kindex M P k (Summary) -@findex gnus-summary-kill-process-mark -Push the current process mark set onto the stack and unmark all articles -(@code{gnus-summary-kill-process-mark}). - -@item M P y -@kindex M P y (Summary) -@findex gnus-summary-yank-process-mark -Pop the previous process mark set from the stack and restore it -(@code{gnus-summary-yank-process-mark}). - -@item M P w -@kindex M P w (Summary) -@findex gnus-summary-save-process-mark -Push the current process mark set onto the stack -(@code{gnus-summary-save-process-mark}). - -@end table - - -@node Limiting -@section Limiting -@cindex limiting - -It can be convenient to limit the summary buffer to just show some -subset of the articles currently in the group. The effect most limit -commands have is to remove a few (or many) articles from the summary -buffer. - -@table @kbd - -@item / / -@itemx / s -@kindex / / (Summary) -@findex gnus-summary-limit-to-subject -Limit the summary buffer to articles that match some subject -(@code{gnus-summary-limit-to-subject}). - -@item / a -@kindex / a (Summary) -@findex gnus-summary-limit-to-author -Limit the summary buffer to articles that match some author -(@code{gnus-summary-limit-to-author}). - -@item / u -@itemx x -@kindex / u (Summary) -@kindex x (Summary) -@findex gnus-summary-limit-to-unread -Limit the summary buffer to articles not marked as read -(@code{gnus-summary-limit-to-unread}). If given a prefix, limit the -buffer to articles strictly unread. This means that ticked and -dormant articles will also be excluded. - -@item / m -@kindex / m (Summary) -@findex gnus-summary-limit-to-marks -Ask for a mark and then limit to all articles that have not been marked -with that mark (@code{gnus-summary-limit-to-marks}). - -@item / t -@kindex / t (Summary) -@findex gnus-summary-limit-to-age -Ask for a number and then limit the summary buffer to articles older than (or equal to) that number of days -(@code{gnus-summary-limit-to-marks}). If given a prefix, limit to -articles younger than that number of days. - -@item / n -@kindex / n (Summary) -@findex gnus-summary-limit-to-articles -Limit the summary buffer to the current article -(@code{gnus-summary-limit-to-articles}). Uses the process/prefix -convention (@pxref{Process/Prefix}). - -@item / w -@kindex / w (Summary) -@findex gnus-summary-pop-limit -Pop the previous limit off the stack and restore it -(@code{gnus-summary-pop-limit}). If given a prefix, pop all limits off -the stack. - -@item / v -@kindex / v (Summary) -@findex gnus-summary-limit-to-score -Limit the summary buffer to articles that have a score at or above some -score (@code{gnus-summary-limit-to-score}). - -@item / E -@itemx M S -@kindex M S (Summary) -@kindex / E (Summary) -@findex gnus-summary-limit-include-expunged -Display all expunged articles -(@code{gnus-summary-limit-include-expunged}). - -@item / D -@kindex / D (Summary) -@findex gnus-summary-limit-include-dormant -Display all dormant articles (@code{gnus-summary-limit-include-dormant}). - -@item / d -@kindex / d (Summary) -@findex gnus-summary-limit-exclude-dormant -Hide all dormant articles (@code{gnus-summary-limit-exclude-dormant}). - -@item / c -@kindex / c (Summary) -@findex gnus-summary-limit-exclude-childless-dormant -Hide all dormant articles that have no children -(@code{gnus-summary-limit-exclude-childless-dormant}). - -@item / C -@kindex / C (Summary) -@findex gnus-summary-limit-mark-excluded-as-read -Mark all excluded unread articles as read -(@code{gnus-summary-limit-mark-excluded-as-read}). If given a prefix, -also mark excluded ticked and dormant articles as read. - -@end table - - -@node Threading -@section Threading -@cindex threading -@cindex article threading - -Gnus threads articles by default. @dfn{To thread} is to put responses -to articles directly after the articles they respond to---in a -hierarchical fashion. - -@menu -* Customizing Threading:: Variables you can change to affect the threading. -* Thread Commands:: Thread based commands in the summary buffer. -@end menu - - -@node Customizing Threading -@subsection Customizing Threading -@cindex customizing threading -@cindex < -@cindex > - -@table @code - -@item gnus-show-threads -@vindex gnus-show-threads -If this variable is @code{nil}, no threading will be done, and all of -the rest of the variables here will have no effect. Turning threading -off will speed group selection up a bit, but it is sure to make reading -slower and more awkward. - -@item gnus-fetch-old-headers -@vindex gnus-fetch-old-headers -If non-@code{nil}, Gnus will attempt to build old threads by fetching -more old headers---headers to articles marked as read. If you -would like to display as few summary lines as possible, but still -connect as many loose threads as possible, you should set this variable -to @code{some} or a number. If you set it to a number, no more than -that number of extra old headers will be fetched. In either case, -fetching old headers only works if the backend you are using carries -overview files---this would normally be @code{nntp}, @code{nnspool} and -@code{nnml}. Also remember that if the root of the thread has been -expired by the server, there's not much Gnus can do about that. - -@item gnus-build-sparse-threads -@vindex gnus-build-sparse-threads -Fetching old headers can be slow. A low-rent similar effect can be -gotten by setting this variable to @code{some}. Gnus will then look at -the complete @code{References} headers of all articles and try to string -together articles that belong in the same thread. This will leave -@dfn{gaps} in the threading display where Gnus guesses that an article -is missing from the thread. (These gaps appear like normal summary -lines. If you select a gap, Gnus will try to fetch the article in -question.) If this variable is @code{t}, Gnus will display all these -``gaps'' without regard for whether they are useful for completing the -thread or not. Finally, if this variable is @code{more}, Gnus won't cut -off sparse leaf nodes that don't lead anywhere. This variable is -@code{nil} by default. - -@item gnus-summary-gather-subject-limit -@vindex gnus-summary-gather-subject-limit -Loose threads are gathered by comparing subjects of articles. If this -variable is @code{nil}, Gnus requires an exact match between the -subjects of the loose threads before gathering them into one big -super-thread. This might be too strict a requirement, what with the -presence of stupid newsreaders that chop off long subject lines. If -you think so, set this variable to, say, 20 to require that only the -first 20 characters of the subjects have to match. If you set this -variable to a really low number, you'll find that Gnus will gather -everything in sight into one thread, which isn't very helpful. - -@cindex fuzzy article gathering -If you set this variable to the special value @code{fuzzy}, Gnus will -use a fuzzy string comparison algorithm on the subjects (@pxref{Fuzzy -Matching}). - -@item gnus-simplify-subject-fuzzy-regexp -@vindex gnus-simplify-subject-fuzzy-regexp -This can either be a regular expression or list of regular expressions -that match strings that will be removed from subjects if fuzzy subject -simplification is used. - -@item gnus-simplify-ignored-prefixes -@vindex gnus-simplify-ignored-prefixes -If you set @code{gnus-summary-gather-subject-limit} to something as low -as 10, you might consider setting this variable to something sensible: - -@c Written by Michael Ernst -@lisp -(setq gnus-simplify-ignored-prefixes - (concat - "\\`\\[?\\(" - (mapconcat - 'identity - '("looking" - "wanted" "followup" "summary\\( of\\)?" - "help" "query" "problem" "question" - "answer" "reference" "announce" - "How can I" "How to" "Comparison of" - ;; ... - ) - "\\|") - "\\)\\s *\\(" - (mapconcat 'identity - '("for" "for reference" "with" "about") - "\\|") - "\\)?\\]?:?[ \t]*")) -@end lisp - -All words that match this regexp will be removed before comparing two -subjects. - -@item gnus-summary-gather-exclude-subject -@vindex gnus-summary-gather-exclude-subject -Since loose thread gathering is done on subjects only, that might lead -to many false hits, especially with certain common subjects like -@samp{} and @samp{(none)}. To make the situation slightly better, -you can use the regexp @code{gnus-summary-gather-exclude-subject} to say -what subjects should be excluded from the gathering process.@* -The default is @samp{^ *$\\|^(none)$}. - -@item gnus-summary-thread-gathering-function -@vindex gnus-summary-thread-gathering-function -Gnus gathers threads by looking at @code{Subject} headers. This means -that totally unrelated articles may end up in the same ``thread'', which -is confusing. An alternate approach is to look at all the -@code{Message-ID}s in all the @code{References} headers to find matches. -This will ensure that no gathered threads ever include unrelated -articles, but it also means that people who have posted with broken -newsreaders won't be gathered properly. The choice is yours---plague or -cholera: - -@table @code -@item gnus-gather-threads-by-subject -@findex gnus-gather-threads-by-subject -This function is the default gathering function and looks at -@code{Subject}s exclusively. - -@item gnus-gather-threads-by-references -@findex gnus-gather-threads-by-references -This function looks at @code{References} headers exclusively. -@end table - -If you want to test gathering by @code{References}, you could say -something like: - -@lisp -(setq gnus-summary-thread-gathering-function - 'gnus-gather-threads-by-references) -@end lisp - -@item gnus-summary-make-false-root -@vindex gnus-summary-make-false-root -If non-@code{nil}, Gnus will gather all loose subtrees into one big tree -and create a dummy root at the top. (Wait a minute. Root at the top? -Yup.) Loose subtrees occur when the real root has expired, or you've -read or killed the root in a previous session. - -When there is no real root of a thread, Gnus will have to fudge -something. This variable says what fudging method Gnus should use. -There are four possible values: - -@iftex -@iflatex -\gnusfigure{The Summary Buffer}{390}{ -\put(0,0){\epsfig{figure=tmp/summary-adopt.ps,width=7.5cm}} -\put(445,0){\makebox(0,0)[br]{\epsfig{figure=tmp/summary-empty.ps,width=7.5cm}}} -\put(0,400){\makebox(0,0)[tl]{\epsfig{figure=tmp/summary-none.ps,width=7.5cm}}} -\put(445,400){\makebox(0,0)[tr]{\epsfig{figure=tmp/summary-dummy.ps,width=7.5cm}}} -} -@end iflatex -@end iftex - -@cindex adopting articles - -@table @code - -@item adopt -Gnus will make the first of the orphaned articles the parent. This -parent will adopt all the other articles. The adopted articles will be -marked as such by pointy brackets (@samp{<>}) instead of the standard -square brackets (@samp{[]}). This is the default method. - -@item dummy -@vindex gnus-summary-dummy-line-format -Gnus will create a dummy summary line that will pretend to be the -parent. This dummy line does not correspond to any real article, so -selecting it will just select the first real article after the dummy -article. @code{gnus-summary-dummy-line-format} is used to specify the -format of the dummy roots. It accepts only one format spec: @samp{S}, -which is the subject of the article. @xref{Formatting Variables}. - -@item empty -Gnus won't actually make any article the parent, but simply leave the -subject field of all orphans except the first empty. (Actually, it will -use @code{gnus-summary-same-subject} as the subject (@pxref{Summary -Buffer Format}).) - -@item none -Don't make any article parent at all. Just gather the threads and -display them after one another. - -@item nil -Don't gather loose threads. -@end table - -@item gnus-thread-hide-subtree -@vindex gnus-thread-hide-subtree -If non-@code{nil}, all threads will be hidden when the summary buffer is -generated. - -@item gnus-thread-expunge-below -@vindex gnus-thread-expunge-below -All threads that have a total score (as defined by -@code{gnus-thread-score-function}) less than this number will be -expunged. This variable is @code{nil} by default, which means that no -threads are expunged. - -@item gnus-thread-hide-killed -@vindex gnus-thread-hide-killed -if you kill a thread and this variable is non-@code{nil}, the subtree -will be hidden. - -@item gnus-thread-ignore-subject -@vindex gnus-thread-ignore-subject -Sometimes somebody changes the subject in the middle of a thread. If -this variable is non-@code{nil}, the subject change is ignored. If it -is @code{nil}, which is the default, a change in the subject will result -in a new thread. - -@item gnus-thread-indent-level -@vindex gnus-thread-indent-level -This is a number that says how much each sub-thread should be indented. -The default is 4. - -@item gnus-parse-headers-hook -@vindex gnus-parse-headers-hook -Hook run before parsing any headers. The default value is -@code{(gnus-decode-rfc1522)}, which means that QPized headers will be -slightly decoded in a hackish way. This is likely to change in the -future when Gnus becomes @sc{MIME}ified. - -@end table - - -@node Thread Commands -@subsection Thread Commands -@cindex thread commands - -@table @kbd - -@item T k -@itemx M-C-k -@kindex T k (Summary) -@kindex M-C-k (Summary) -@findex gnus-summary-kill-thread -Mark all articles in the current (sub-)thread as read -(@code{gnus-summary-kill-thread}). If the prefix argument is positive, -remove all marks instead. If the prefix argument is negative, tick -articles instead. - -@item T l -@itemx M-C-l -@kindex T l (Summary) -@kindex M-C-l (Summary) -@findex gnus-summary-lower-thread -Lower the score of the current (sub-)thread -(@code{gnus-summary-lower-thread}). - -@item T i -@kindex T i (Summary) -@findex gnus-summary-raise-thread -Increase the score of the current (sub-)thread -(@code{gnus-summary-raise-thread}). - -@item T # -@kindex T # (Summary) -@findex gnus-uu-mark-thread -Set the process mark on the current (sub-)thread -(@code{gnus-uu-mark-thread}). - -@item T M-# -@kindex T M-# (Summary) -@findex gnus-uu-unmark-thread -Remove the process mark from the current (sub-)thread -(@code{gnus-uu-unmark-thread}). - -@item T T -@kindex T T (Summary) -@findex gnus-summary-toggle-threads -Toggle threading (@code{gnus-summary-toggle-threads}). - -@item T s -@kindex T s (Summary) -@findex gnus-summary-show-thread -Expose the (sub-)thread hidden under the current article, if any -(@code{gnus-summary-show-thread}). - -@item T h -@kindex T h (Summary) -@findex gnus-summary-hide-thread -Hide the current (sub-)thread (@code{gnus-summary-hide-thread}). - -@item T S -@kindex T S (Summary) -@findex gnus-summary-show-all-threads -Expose all hidden threads (@code{gnus-summary-show-all-threads}). - -@item T H -@kindex T H (Summary) -@findex gnus-summary-hide-all-threads -Hide all threads (@code{gnus-summary-hide-all-threads}). - -@item T t -@kindex T t (Summary) -@findex gnus-summary-rethread-current -Re-thread the current article's thread -(@code{gnus-summary-rethread-current}). This works even when the -summary buffer is otherwise unthreaded. - -@item T ^ -@kindex T ^ (Summary) -@findex gnus-summary-reparent-thread -Make the current article the child of the marked (or previous) article -(@code{gnus-summary-reparent-thread}). - -@end table - -The following commands are thread movement commands. They all -understand the numeric prefix. - -@table @kbd - -@item T n -@kindex T n (Summary) -@findex gnus-summary-next-thread -Go to the next thread (@code{gnus-summary-next-thread}). - -@item T p -@kindex T p (Summary) -@findex gnus-summary-prev-thread -Go to the previous thread (@code{gnus-summary-prev-thread}). - -@item T d -@kindex T d (Summary) -@findex gnus-summary-down-thread -Descend the thread (@code{gnus-summary-down-thread}). - -@item T u -@kindex T u (Summary) -@findex gnus-summary-up-thread -Ascend the thread (@code{gnus-summary-up-thread}). - -@item T o -@kindex T o (Summary) -@findex gnus-summary-top-thread -Go to the top of the thread (@code{gnus-summary-top-thread}). -@end table - -@vindex gnus-thread-operation-ignore-subject -If you ignore subject while threading, you'll naturally end up with -threads that have several different subjects in them. If you then issue -a command like `T k' (@code{gnus-summary-kill-thread}) you might not -wish to kill the entire thread, but just those parts of the thread that -have the same subject as the current article. If you like this idea, -you can fiddle with @code{gnus-thread-operation-ignore-subject}. If it -is non-@code{nil} (which it is by default), subjects will be ignored -when doing thread commands. If this variable is @code{nil}, articles in -the same thread with different subjects will not be included in the -operation in question. If this variable is @code{fuzzy}, only articles -that have subjects fuzzily equal will be included (@pxref{Fuzzy -Matching}). - - -@node Sorting -@section Sorting - -@findex gnus-thread-sort-by-total-score -@findex gnus-thread-sort-by-date -@findex gnus-thread-sort-by-score -@findex gnus-thread-sort-by-subject -@findex gnus-thread-sort-by-author -@findex gnus-thread-sort-by-number -@vindex gnus-thread-sort-functions -If you are using a threaded summary display, you can sort the threads by -setting @code{gnus-thread-sort-functions}, which is a list of functions. -By default, sorting is done on article numbers. Ready-made sorting -predicate functions include @code{gnus-thread-sort-by-number}, -@code{gnus-thread-sort-by-author}, @code{gnus-thread-sort-by-subject}, -@code{gnus-thread-sort-by-date}, @code{gnus-thread-sort-by-score}, and -@code{gnus-thread-sort-by-total-score}. - -Each function takes two threads and returns non-@code{nil} if the first -thread should be sorted before the other. Note that sorting really is -normally done by looking only at the roots of each thread. If you use -more than one function, the primary sort key should be the last function -in the list. You should probably always include -@code{gnus-thread-sort-by-number} in the list of sorting -functions---preferably first. This will ensure that threads that are -equal with respect to the other sort criteria will be displayed in -ascending article order. - -If you would like to sort by score, then by subject, and finally by -number, you could do something like: - -@lisp -(setq gnus-thread-sort-functions - '(gnus-thread-sort-by-number - gnus-thread-sort-by-subject - gnus-thread-sort-by-total-score)) -@end lisp - -The threads that have highest score will be displayed first in the -summary buffer. When threads have the same score, they will be sorted -alphabetically. The threads that have the same score and the same -subject will be sorted by number, which is (normally) the sequence in -which the articles arrived. - -If you want to sort by score and then reverse arrival order, you could -say something like: - -@lisp -(setq gnus-thread-sort-functions - '((lambda (t1 t2) - (not (gnus-thread-sort-by-number t2 t1))) - gnus-thread-sort-by-score)) -@end lisp - -@vindex gnus-thread-score-function -The function in the @code{gnus-thread-score-function} variable (default -@code{+}) is used for calculating the total score of a thread. Useful -functions might be @code{max}, @code{min}, or squared means, or whatever -tickles your fancy. - -@findex gnus-article-sort-functions -@findex gnus-article-sort-by-date -@findex gnus-article-sort-by-score -@findex gnus-article-sort-by-subject -@findex gnus-article-sort-by-author -@findex gnus-article-sort-by-number -If you are using an unthreaded display for some strange reason or other, -you have to fiddle with the @code{gnus-article-sort-functions} variable. -It is very similar to the @code{gnus-thread-sort-functions}, except that -it uses slightly different functions for article comparison. Available -sorting predicate functions are @code{gnus-article-sort-by-number}, -@code{gnus-article-sort-by-author}, @code{gnus-article-sort-by-subject}, -@code{gnus-article-sort-by-date}, and @code{gnus-article-sort-by-score}. - -If you want to sort an unthreaded summary display by subject, you could -say something like: - -@lisp -(setq gnus-article-sort-functions - '(gnus-article-sort-by-number - gnus-article-sort-by-subject)) -@end lisp - - - -@node Asynchronous Fetching -@section Asynchronous Article Fetching -@cindex asynchronous article fetching -@cindex article pre-fetch -@cindex pre-fetch - -If you read your news from an @sc{nntp} server that's far away, the -network latencies may make reading articles a chore. You have to wait -for a while after pressing @kbd{n} to go to the next article before the -article appears. Why can't Gnus just go ahead and fetch the article -while you are reading the previous one? Why not, indeed. - -First, some caveats. There are some pitfalls to using asynchronous -article fetching, especially the way Gnus does it. - -Let's say you are reading article 1, which is short, and article 2 is -quite long, and you are not interested in reading that. Gnus does not -know this, so it goes ahead and fetches article 2. You decide to read -article 3, but since Gnus is in the process of fetching article 2, the -connection is blocked. - -To avoid these situations, Gnus will open two (count 'em two) -connections to the server. Some people may think this isn't a very nice -thing to do, but I don't see any real alternatives. Setting up that -extra connection takes some time, so Gnus startup will be slower. - -Gnus will fetch more articles than you will read. This will mean that -the link between your machine and the @sc{nntp} server will become more -loaded than if you didn't use article pre-fetch. The server itself will -also become more loaded---both with the extra article requests, and the -extra connection. - -Ok, so now you know that you shouldn't really use this thing... unless -you really want to. - -@vindex gnus-asynchronous -Here's how: Set @code{gnus-asynchronous} to @code{t}. The rest should -happen automatically. - -@vindex gnus-use-article-prefetch -You can control how many articles are to be pre-fetched by setting -@code{gnus-use-article-prefetch}. This is 30 by default, which means -that when you read an article in the group, the backend will pre-fetch -the next 30 articles. If this variable is @code{t}, the backend will -pre-fetch all the articles it can without bound. If it is -@code{nil}, no pre-fetching will be done. - -@vindex gnus-async-prefetch-article-p -@findex gnus-async-read-p -There are probably some articles that you don't want to pre-fetch---read -articles, for instance. The @code{gnus-async-prefetch-article-p} variable controls whether an article is to be pre-fetched. This function should -return non-@code{nil} when the article in question is to be -pre-fetched. The default is @code{gnus-async-read-p}, which returns -@code{nil} on read articles. The function is called with an article -data structure as the only parameter. - -If, for instance, you wish to pre-fetch only unread articles shorter than 100 lines, you could say something like: - -@lisp -(defun my-async-short-unread-p (data) - "Return non-nil for short, unread articles." - (and (gnus-data-unread-p data) - (< (mail-header-lines (gnus-data-header data)) - 100))) - -(setq gnus-async-prefetch-article-p 'my-async-short-unread-p) -@end lisp - -These functions will be called many, many times, so they should -preferably be short and sweet to avoid slowing down Gnus too much. -It's probably a good idea to byte-compile things like this. - -@vindex gnus-prefetched-article-deletion-strategy -Articles have to be removed from the asynch buffer sooner or later. The -@code{gnus-prefetched-article-deletion-strategy} says when to remove -articles. This is a list that may contain the following elements: - -@table @code -@item read -Remove articles when they are read. - -@item exit -Remove articles when exiting the group. -@end table - -The default value is @code{(read exit)}. - -@vindex gnus-use-header-prefetch -If @code{gnus-use-header-prefetch} is non-@code{nil}, prefetch articles -from the next group. - - -@node Article Caching -@section Article Caching -@cindex article caching -@cindex caching - -If you have an @emph{extremely} slow @sc{nntp} connection, you may -consider turning article caching on. Each article will then be stored -locally under your home directory. As you may surmise, this could -potentially use @emph{huge} amounts of disk space, as well as eat up all -your inodes so fast it will make your head swim. In vodka. - -Used carefully, though, it could be just an easier way to save articles. - -@vindex gnus-use-long-file-name -@vindex gnus-cache-directory -@vindex gnus-use-cache -To turn caching on, set @code{gnus-use-cache} to @code{t}. By default, -all articles ticked or marked as dormant will then be copied -over to your local cache (@code{gnus-cache-directory}). Whether this -cache is flat or hierarchal is controlled by the -@code{gnus-use-long-file-name} variable, as usual. - -When re-selecting a ticked or dormant article, it will be fetched from the -cache instead of from the server. As articles in your cache will never -expire, this might serve as a method of saving articles while still -keeping them where they belong. Just mark all articles you want to save -as dormant, and don't worry. - -When an article is marked as read, is it removed from the cache. - -@vindex gnus-cache-remove-articles -@vindex gnus-cache-enter-articles -The entering/removal of articles from the cache is controlled by the -@code{gnus-cache-enter-articles} and @code{gnus-cache-remove-articles} -variables. Both are lists of symbols. The first is @code{(ticked -dormant)} by default, meaning that ticked and dormant articles will be -put in the cache. The latter is @code{(read)} by default, meaning that -articles marked as read are removed from the cache. Possibly -symbols in these two lists are @code{ticked}, @code{dormant}, -@code{unread} and @code{read}. - -@findex gnus-jog-cache -So where does the massive article-fetching and storing come into the -picture? The @code{gnus-jog-cache} command will go through all -subscribed newsgroups, request all unread articles, and store them in -the cache. You should only ever, ever ever ever, use this command if 1) -your connection to the @sc{nntp} server is really, really, really slow -and 2) you have a really, really, really huge disk. Seriously. - -@vindex gnus-uncacheable-groups -It is likely that you do not want caching on some groups. For instance, -if your @code{nnml} mail is located under your home directory, it makes no -sense to cache it somewhere else under your home directory. Unless you -feel that it's neat to use twice as much space. To limit the caching, -you could set the @code{gnus-uncacheable-groups} regexp to -@samp{^nnml}, for instance. This variable is @code{nil} by -default. - -@findex gnus-cache-generate-nov-databases -@findex gnus-cache-generate-active -@vindex gnus-cache-active-file -The cache stores information on what articles it contains in its active -file (@code{gnus-cache-active-file}). If this file (or any other parts -of the cache) becomes all messed up for some reason or other, Gnus -offers two functions that will try to set things right. @kbd{M-x -gnus-cache-generate-nov-databases} will (re)build all the @sc{nov} -files, and @kbd{gnus-cache-generate-active} will (re)generate the active -file. - - -@node Persistent Articles -@section Persistent Articles -@cindex persistent articles - -Closely related to article caching, we have @dfn{persistent articles}. -In fact, it's just a different way of looking at caching, and much more -useful in my opinion. - -Say you're reading a newsgroup, and you happen on to some valuable gem -that you want to keep and treasure forever. You'd normally just save it -(using one of the many saving commands) in some file. The problem with -that is that it's just, well, yucky. Ideally you'd prefer just having -the article remain in the group where you found it forever; untouched by -the expiry going on at the news server. - -This is what a @dfn{persistent article} is---an article that just won't -be deleted. It's implemented using the normal cache functions, but -you use two explicit commands for managing persistent articles: - -@table @kbd - -@item * -@kindex * (Summary) -@findex gnus-cache-enter-article -Make the current article persistent (@code{gnus-cache-enter-article}). - -@item M-* -@kindex M-* (Summary) -@findex gnus-cache-remove-article -Remove the current article from the persistent articles -(@code{gnus-cache-remove-article}). This will normally delete the -article. -@end table - -Both these commands understand the process/prefix convention. - -To avoid having all ticked articles (and stuff) entered into the cache, -you should set @code{gnus-use-cache} to @code{passive} if you're just -interested in persistent articles: - -@lisp -(setq gnus-use-cache 'passive) -@end lisp - - -@node Article Backlog -@section Article Backlog -@cindex backlog -@cindex article backlog - -If you have a slow connection, but the idea of using caching seems -unappealing to you (and it is, really), you can help the situation some -by switching on the @dfn{backlog}. This is where Gnus will buffer -already read articles so that it doesn't have to re-fetch articles -you've already read. This only helps if you are in the habit of -re-selecting articles you've recently read, of course. If you never do -that, turning the backlog on will slow Gnus down a little bit, and -increase memory usage some. - -@vindex gnus-keep-backlog -If you set @code{gnus-keep-backlog} to a number @var{n}, Gnus will store -at most @var{n} old articles in a buffer for later re-fetching. If this -variable is non-@code{nil} and is not a number, Gnus will store -@emph{all} read articles, which means that your Emacs will grow without -bound before exploding and taking your machine down with you. I put -that in there just to keep y'all on your toes. - -This variable is @code{nil} by default. - - -@node Saving Articles -@section Saving Articles -@cindex saving articles - -Gnus can save articles in a number of ways. Below is the documentation -for saving articles in a fairly straight-forward fashion (i.e., little -processing of the article is done before it is saved). For a different -approach (uudecoding, unsharing) you should use @code{gnus-uu} -(@pxref{Decoding Articles}). - -@vindex gnus-save-all-headers -If @code{gnus-save-all-headers} is non-@code{nil}, Gnus will not delete -unwanted headers before saving the article. - -@vindex gnus-saved-headers -If the preceding variable is @code{nil}, all headers that match the -@code{gnus-saved-headers} regexp will be kept, while the rest will be -deleted before saving. - -@table @kbd - -@item O o -@itemx o -@kindex O o (Summary) -@kindex o (Summary) -@findex gnus-summary-save-article -@c @icon{gnus-summary-save-article} -Save the current article using the default article saver -(@code{gnus-summary-save-article}). - -@item O m -@kindex O m (Summary) -@findex gnus-summary-save-article-mail -Save the current article in mail format -(@code{gnus-summary-save-article-mail}). - -@item O r -@kindex O r (Summary) -@findex gnus-summary-save-article-rmail -Save the current article in rmail format -(@code{gnus-summary-save-article-rmail}). - -@item O f -@kindex O f (Summary) -@findex gnus-summary-save-article-file -@c @icon{gnus-summary-save-article-file} -Save the current article in plain file format -(@code{gnus-summary-save-article-file}). - -@item O F -@kindex O F (Summary) -@findex gnus-summary-write-article-file -Write the current article in plain file format, overwriting any previous -file contents (@code{gnus-summary-write-article-file}). - -@item O b -@kindex O b (Summary) -@findex gnus-summary-save-article-body-file -Save the current article body in plain file format -(@code{gnus-summary-save-article-body-file}). - -@item O h -@kindex O h (Summary) -@findex gnus-summary-save-article-folder -Save the current article in mh folder format -(@code{gnus-summary-save-article-folder}). - -@item O v -@kindex O v (Summary) -@findex gnus-summary-save-article-vm -Save the current article in a VM folder -(@code{gnus-summary-save-article-vm}). - -@item O p -@kindex O p (Summary) -@findex gnus-summary-pipe-output -Save the current article in a pipe. Uhm, like, what I mean is---Pipe -the current article to a process (@code{gnus-summary-pipe-output}). -@end table - -@vindex gnus-prompt-before-saving -All these commands use the process/prefix convention -(@pxref{Process/Prefix}). If you save bunches of articles using these -functions, you might get tired of being prompted for files to save each -and every article in. The prompting action is controlled by -the @code{gnus-prompt-before-saving} variable, which is @code{always} by -default, giving you that excessive prompting action you know and -loathe. If you set this variable to @code{t} instead, you'll be prompted -just once for each series of articles you save. If you like to really -have Gnus do all your thinking for you, you can even set this variable -to @code{nil}, which means that you will never be prompted for files to -save articles in. Gnus will simply save all the articles in the default -files. - - -@vindex gnus-default-article-saver -You can customize the @code{gnus-default-article-saver} variable to make -Gnus do what you want it to. You can use any of the four ready-made -functions below, or you can create your own. - -@table @code - -@item gnus-summary-save-in-rmail -@findex gnus-summary-save-in-rmail -@vindex gnus-rmail-save-name -@findex gnus-plain-save-name -This is the default format, @dfn{babyl}. Uses the function in the -@code{gnus-rmail-save-name} variable to get a file name to save the -article in. The default is @code{gnus-plain-save-name}. - -@item gnus-summary-save-in-mail -@findex gnus-summary-save-in-mail -@vindex gnus-mail-save-name -Save in a Unix mail (mbox) file. Uses the function in the -@code{gnus-mail-save-name} variable to get a file name to save the -article in. The default is @code{gnus-plain-save-name}. - -@item gnus-summary-save-in-file -@findex gnus-summary-save-in-file -@vindex gnus-file-save-name -@findex gnus-numeric-save-name -Append the article straight to an ordinary file. Uses the function in -the @code{gnus-file-save-name} variable to get a file name to save the -article in. The default is @code{gnus-numeric-save-name}. - -@item gnus-summary-save-body-in-file -@findex gnus-summary-save-body-in-file -Append the article body to an ordinary file. Uses the function in the -@code{gnus-file-save-name} variable to get a file name to save the -article in. The default is @code{gnus-numeric-save-name}. - -@item gnus-summary-save-in-folder -@findex gnus-summary-save-in-folder -@findex gnus-folder-save-name -@findex gnus-Folder-save-name -@vindex gnus-folder-save-name -@cindex rcvstore -@cindex MH folders -Save the article to an MH folder using @code{rcvstore} from the MH -library. Uses the function in the @code{gnus-folder-save-name} variable -to get a file name to save the article in. The default is -@code{gnus-folder-save-name}, but you can also use -@code{gnus-Folder-save-name}, which creates capitalized names. - -@item gnus-summary-save-in-vm -@findex gnus-summary-save-in-vm -Save the article in a VM folder. You have to have the VM mail -reader to use this setting. -@end table - -@vindex gnus-article-save-directory -All of these functions, except for the last one, will save the article -in the @code{gnus-article-save-directory}, which is initialized from the -@code{SAVEDIR} environment variable. This is @file{~/News/} by -default. - -As you can see above, the functions use different functions to find a -suitable name of a file to save the article in. Below is a list of -available functions that generate names: - -@table @code - -@item gnus-Numeric-save-name -@findex gnus-Numeric-save-name -File names like @file{~/News/Alt.andrea-dworkin/45}. - -@item gnus-numeric-save-name -@findex gnus-numeric-save-name -File names like @file{~/News/alt.andrea-dworkin/45}. - -@item gnus-Plain-save-name -@findex gnus-Plain-save-name -File names like @file{~/News/Alt.andrea-dworkin}. - -@item gnus-plain-save-name -@findex gnus-plain-save-name -File names like @file{~/News/alt.andrea-dworkin}. -@end table - -@vindex gnus-split-methods -You can have Gnus suggest where to save articles by plonking a regexp into -the @code{gnus-split-methods} alist. For instance, if you would like to -save articles related to Gnus in the file @file{gnus-stuff}, and articles -related to VM in @code{vm-stuff}, you could set this variable to something -like: - -@lisp -(("^Subject:.*gnus\\|^Newsgroups:.*gnus" "gnus-stuff") - ("^Subject:.*vm\\|^Xref:.*vm" "vm-stuff") - (my-choosing-function "../other-dir/my-stuff") - ((equal gnus-newsgroup-name "mail.misc") "mail-stuff")) -@end lisp - -We see that this is a list where each element is a list that has two -elements---the @dfn{match} and the @dfn{file}. The match can either be -a string (in which case it is used as a regexp to match on the article -head); it can be a symbol (which will be called as a function with the -group name as a parameter); or it can be a list (which will be -@code{eval}ed). If any of these actions have a non-@code{nil} result, -the @dfn{file} will be used as a default prompt. In addition, the -result of the operation itself will be used if the function or form -called returns a string or a list of strings. - -You basically end up with a list of file names that might be used when -saving the current article. (All ``matches'' will be used.) You will -then be prompted for what you really want to use as a name, with file -name completion over the results from applying this variable. - -This variable is @code{((gnus-article-archive-name))} by default, which -means that Gnus will look at the articles it saves for an -@code{Archive-name} line and use that as a suggestion for the file -name. - -Here's an example function to clean up file names somewhat. If you have -lots of mail groups called things like -@samp{nnml:mail.whatever}, you may want to chop off the beginning of -these group names before creating the file name to save to. The -following will do just that: - -@lisp -(defun my-save-name (group) - (when (string-match "^nnml:mail." group) - (substring group (match-end 0)))) - -(setq gnus-split-methods - '((gnus-article-archive-name) - (my-save-name))) -@end lisp - - -@vindex gnus-use-long-file-name -Finally, you have the @code{gnus-use-long-file-name} variable. If it is -@code{nil}, all the preceding functions will replace all periods -(@samp{.}) in the group names with slashes (@samp{/})---which means that -the functions will generate hierarchies of directories instead of having -all the files in the toplevel directory -(@file{~/News/alt/andrea-dworkin} instead of -@file{~/News/alt.andrea-dworkin}.) This variable is @code{t} by default -on most systems. However, for historical reasons, this is @code{nil} on -Xenix and usg-unix-v machines by default. - -This function also affects kill and score file names. If this variable -is a list, and the list contains the element @code{not-score}, long file -names will not be used for score files, if it contains the element -@code{not-save}, long file names will not be used for saving, and if it -contains the element @code{not-kill}, long file names will not be used -for kill files. - -If you'd like to save articles in a hierarchy that looks something like -a spool, you could - -@lisp -(setq gnus-use-long-file-name '(not-save)) ; to get a hierarchy -(setq gnus-default-article-saver 'gnus-summary-save-in-file) ; no encoding -@end lisp - -Then just save with @kbd{o}. You'd then read this hierarchy with -ephemeral @code{nneething} groups---@kbd{G D} in the group buffer, and -the toplevel directory as the argument (@file{~/News/}). Then just walk -around to the groups/directories with @code{nneething}. - - -@node Decoding Articles -@section Decoding Articles -@cindex decoding articles - -Sometime users post articles (or series of articles) that have been -encoded in some way or other. Gnus can decode them for you. - -@menu -* Uuencoded Articles:: Uudecode articles. -* Shared Articles:: Unshar articles. -* PostScript Files:: Split PostScript. -* Decoding Variables:: Variables for a happy decoding. -* Viewing Files:: You want to look at the result of the decoding? -@end menu - -All these functions use the process/prefix convention -(@pxref{Process/Prefix}) for finding out what articles to work on, with -the extension that a ``single article'' means ``a single series''. Gnus -can find out by itself what articles belong to a series, decode all the -articles and unpack/view/save the resulting file(s). - -Gnus guesses what articles are in the series according to the following -simplish rule: The subjects must be (nearly) identical, except for the -last two numbers of the line. (Spaces are largely ignored, however.) - -For example: If you choose a subject called @samp{cat.gif (2/3)}, Gnus -will find all the articles that match the regexp @samp{^cat.gif -([0-9]+/[0-9]+).*$}. - -Subjects that are non-standard, like @samp{cat.gif (2/3) Part 6 of a -series}, will not be properly recognized by any of the automatic viewing -commands, and you have to mark the articles manually with @kbd{#}. - - -@node Uuencoded Articles -@subsection Uuencoded Articles -@cindex uudecode -@cindex uuencoded articles - -@table @kbd - -@item X u -@kindex X u (Summary) -@findex gnus-uu-decode-uu -@c @icon{gnus-uu-decode-uu} -Uudecodes the current series (@code{gnus-uu-decode-uu}). - -@item X U -@kindex X U (Summary) -@findex gnus-uu-decode-uu-and-save -Uudecodes and saves the current series -(@code{gnus-uu-decode-uu-and-save}). - -@item X v u -@kindex X v u (Summary) -@findex gnus-uu-decode-uu-view -Uudecodes and views the current series (@code{gnus-uu-decode-uu-view}). - -@item X v U -@kindex X v U (Summary) -@findex gnus-uu-decode-uu-and-save-view -Uudecodes, views and saves the current series -(@code{gnus-uu-decode-uu-and-save-view}). -@end table - -Remember that these all react to the presence of articles marked with -the process mark. If, for instance, you'd like to decode and save an -entire newsgroup, you'd typically do @kbd{M P a} -(@code{gnus-uu-mark-all}) and then @kbd{X U} -(@code{gnus-uu-decode-uu-and-save}). - -All this is very much different from how @code{gnus-uu} worked with -@sc{gnus 4.1}, where you had explicit keystrokes for everything under -the sun. This version of @code{gnus-uu} generally assumes that you mark -articles in some way (@pxref{Setting Process Marks}) and then press -@kbd{X u}. - -@vindex gnus-uu-notify-files -Note: When trying to decode articles that have names matching -@code{gnus-uu-notify-files}, which is hard-coded to -@samp{[Cc][Ii][Nn][Dd][Yy][0-9]+.\\(gif\\|jpg\\)}, @code{gnus-uu} will -automatically post an article on @samp{comp.unix.wizards} saying that -you have just viewed the file in question. This feature can't be turned -off. - - -@node Shared Articles -@subsection Shared Articles -@cindex unshar -@cindex shared articles - -@table @kbd - -@item X s -@kindex X s (Summary) -@findex gnus-uu-decode-unshar -Unshars the current series (@code{gnus-uu-decode-unshar}). - -@item X S -@kindex X S (Summary) -@findex gnus-uu-decode-unshar-and-save -Unshars and saves the current series (@code{gnus-uu-decode-unshar-and-save}). - -@item X v s -@kindex X v s (Summary) -@findex gnus-uu-decode-unshar-view -Unshars and views the current series (@code{gnus-uu-decode-unshar-view}). - -@item X v S -@kindex X v S (Summary) -@findex gnus-uu-decode-unshar-and-save-view -Unshars, views and saves the current series -(@code{gnus-uu-decode-unshar-and-save-view}). -@end table - - -@node PostScript Files -@subsection PostScript Files -@cindex PostScript - -@table @kbd - -@item X p -@kindex X p (Summary) -@findex gnus-uu-decode-postscript -Unpack the current PostScript series (@code{gnus-uu-decode-postscript}). - -@item X P -@kindex X P (Summary) -@findex gnus-uu-decode-postscript-and-save -Unpack and save the current PostScript series -(@code{gnus-uu-decode-postscript-and-save}). - -@item X v p -@kindex X v p (Summary) -@findex gnus-uu-decode-postscript-view -View the current PostScript series -(@code{gnus-uu-decode-postscript-view}). - -@item X v P -@kindex X v P (Summary) -@findex gnus-uu-decode-postscript-and-save-view -View and save the current PostScript series -(@code{gnus-uu-decode-postscript-and-save-view}). -@end table - - -@node Decoding Variables -@subsection Decoding Variables - -Adjective, not verb. - -@menu -* Rule Variables:: Variables that say how a file is to be viewed. -* Other Decode Variables:: Other decode variables. -* Uuencoding and Posting:: Variables for customizing uuencoding. -@end menu - - -@node Rule Variables -@subsubsection Rule Variables -@cindex rule variables - -Gnus uses @dfn{rule variables} to decide how to view a file. All these -variables are of the form - -@lisp - (list '(regexp1 command2) - '(regexp2 command2) - ...) -@end lisp - -@table @code - -@item gnus-uu-user-view-rules -@vindex gnus-uu-user-view-rules -@cindex sox -This variable is consulted first when viewing files. If you wish to use, -for instance, @code{sox} to convert an @samp{.au} sound file, you could -say something like: -@lisp -(setq gnus-uu-user-view-rules - (list '(\"\\\\.au$\" \"sox %s -t .aiff > /dev/audio\"))) -@end lisp - -@item gnus-uu-user-view-rules-end -@vindex gnus-uu-user-view-rules-end -This variable is consulted if Gnus couldn't make any matches from the -user and default view rules. - -@item gnus-uu-user-archive-rules -@vindex gnus-uu-user-archive-rules -This variable can be used to say what commands should be used to unpack -archives. -@end table - - -@node Other Decode Variables -@subsubsection Other Decode Variables - -@table @code -@vindex gnus-uu-grabbed-file-functions - -@item gnus-uu-grabbed-file-functions -All functions in this list will be called right after each file has been -successfully decoded---so that you can move or view files right away, -and don't have to wait for all files to be decoded before you can do -anything. Ready-made functions you can put in this list are: - -@table @code - -@item gnus-uu-grab-view -@findex gnus-uu-grab-view -View the file. - -@item gnus-uu-grab-move -@findex gnus-uu-grab-move -Move the file (if you're using a saving function.) -@end table - -@item gnus-uu-be-dangerous -@vindex gnus-uu-be-dangerous -Specifies what to do if unusual situations arise during decoding. If -@code{nil}, be as conservative as possible. If @code{t}, ignore things -that didn't work, and overwrite existing files. Otherwise, ask each -time. - -@item gnus-uu-ignore-files-by-name -@vindex gnus-uu-ignore-files-by-name -Files with name matching this regular expression won't be viewed. - -@item gnus-uu-ignore-files-by-type -@vindex gnus-uu-ignore-files-by-type -Files with a @sc{mime} type matching this variable won't be viewed. -Note that Gnus tries to guess what type the file is based on the name. -@code{gnus-uu} is not a @sc{mime} package (yet), so this is slightly -kludgey. - -@item gnus-uu-tmp-dir -@vindex gnus-uu-tmp-dir -Where @code{gnus-uu} does its work. - -@item gnus-uu-do-not-unpack-archives -@vindex gnus-uu-do-not-unpack-archives -Non-@code{nil} means that @code{gnus-uu} won't peek inside archives -looking for files to display. - -@item gnus-uu-view-and-save -@vindex gnus-uu-view-and-save -Non-@code{nil} means that the user will always be asked to save a file -after viewing it. - -@item gnus-uu-ignore-default-view-rules -@vindex gnus-uu-ignore-default-view-rules -Non-@code{nil} means that @code{gnus-uu} will ignore the default viewing -rules. - -@item gnus-uu-ignore-default-archive-rules -@vindex gnus-uu-ignore-default-archive-rules -Non-@code{nil} means that @code{gnus-uu} will ignore the default archive -unpacking commands. - -@item gnus-uu-kill-carriage-return -@vindex gnus-uu-kill-carriage-return -Non-@code{nil} means that @code{gnus-uu} will strip all carriage returns -from articles. - -@item gnus-uu-unmark-articles-not-decoded -@vindex gnus-uu-unmark-articles-not-decoded -Non-@code{nil} means that @code{gnus-uu} will mark unsuccessfully -decoded articles as unread. - -@item gnus-uu-correct-stripped-uucode -@vindex gnus-uu-correct-stripped-uucode -Non-@code{nil} means that @code{gnus-uu} will @emph{try} to fix -uuencoded files that have had trailing spaces deleted. - -@item gnus-uu-view-with-metamail -@vindex gnus-uu-view-with-metamail -@cindex metamail -Non-@code{nil} means that @code{gnus-uu} will ignore the viewing -commands defined by the rule variables and just fudge a @sc{mime} -content type based on the file name. The result will be fed to -@code{metamail} for viewing. - -@item gnus-uu-save-in-digest -@vindex gnus-uu-save-in-digest -Non-@code{nil} means that @code{gnus-uu}, when asked to save without -decoding, will save in digests. If this variable is @code{nil}, -@code{gnus-uu} will just save everything in a file without any -embellishments. The digesting almost conforms to RFC1153---no easy way -to specify any meaningful volume and issue numbers were found, so I -simply dropped them. - -@end table - - -@node Uuencoding and Posting -@subsubsection Uuencoding and Posting - -@table @code - -@item gnus-uu-post-include-before-composing -@vindex gnus-uu-post-include-before-composing -Non-@code{nil} means that @code{gnus-uu} will ask for a file to encode -before you compose the article. If this variable is @code{t}, you can -either include an encoded file with @kbd{C-c C-i} or have one included -for you when you post the article. - -@item gnus-uu-post-length -@vindex gnus-uu-post-length -Maximum length of an article. The encoded file will be split into how -many articles it takes to post the entire file. - -@item gnus-uu-post-threaded -@vindex gnus-uu-post-threaded -Non-@code{nil} means that @code{gnus-uu} will post the encoded file in a -thread. This may not be smart, as no other decoder I have seen is able -to follow threads when collecting uuencoded articles. (Well, I have -seen one package that does that---@code{gnus-uu}, but somehow, I don't -think that counts...) Default is @code{nil}. - -@item gnus-uu-post-separate-description -@vindex gnus-uu-post-separate-description -Non-@code{nil} means that the description will be posted in a separate -article. The first article will typically be numbered (0/x). If this -variable is @code{nil}, the description the user enters will be included -at the beginning of the first article, which will be numbered (1/x). -Default is @code{t}. - -@end table - - -@node Viewing Files -@subsection Viewing Files -@cindex viewing files -@cindex pseudo-articles - -After decoding, if the file is some sort of archive, Gnus will attempt -to unpack the archive and see if any of the files in the archive can be -viewed. For instance, if you have a gzipped tar file @file{pics.tar.gz} -containing the files @file{pic1.jpg} and @file{pic2.gif}, Gnus will -uncompress and de-tar the main file, and then view the two pictures. -This unpacking process is recursive, so if the archive contains archives -of archives, it'll all be unpacked. - -Finally, Gnus will normally insert a @dfn{pseudo-article} for each -extracted file into the summary buffer. If you go to these -``articles'', you will be prompted for a command to run (usually Gnus -will make a suggestion), and then the command will be run. - -@vindex gnus-view-pseudo-asynchronously -If @code{gnus-view-pseudo-asynchronously} is @code{nil}, Emacs will wait -until the viewing is done before proceeding. - -@vindex gnus-view-pseudos -If @code{gnus-view-pseudos} is @code{automatic}, Gnus will not insert -the pseudo-articles into the summary buffer, but view them -immediately. If this variable is @code{not-confirm}, the user won't even -be asked for a confirmation before viewing is done. - -@vindex gnus-view-pseudos-separately -If @code{gnus-view-pseudos-separately} is non-@code{nil}, one -pseudo-article will be created for each file to be viewed. If -@code{nil}, all files that use the same viewing command will be given as -a list of parameters to that command. - -@vindex gnus-insert-pseudo-articles -If @code{gnus-insert-pseudo-articles} is non-@code{nil}, insert -pseudo-articles when decoding. It is @code{t} by default. - -So; there you are, reading your @emph{pseudo-articles} in your -@emph{virtual newsgroup} from the @emph{virtual server}; and you think: -Why isn't anything real anymore? How did we get here? - - -@node Article Treatment -@section Article Treatment - -Reading through this huge manual, you may have quite forgotten that the -object of newsreaders is to actually, like, read what people have -written. Reading articles. Unfortunately, people are quite bad at -writing, so there are tons of functions and variables to make reading -these articles easier. - -@menu -* Article Highlighting:: You want to make the article look like fruit salad. -* Article Fontisizing:: Making emphasized text look niced. -* Article Hiding:: You also want to make certain info go away. -* Article Washing:: Lots of way-neat functions to make life better. -* Article Buttons:: Click on URLs, Message-IDs, addresses and the like. -* Article Date:: Grumble, UT! -* Article Signature:: What is a signature? -@end menu - - -@node Article Highlighting -@subsection Article Highlighting -@cindex highlight - -Not only do you want your article buffer to look like fruit salad, but -you want it to look like technicolor fruit salad. - -@table @kbd - -@item W H a -@kindex W H a (Summary) -@findex gnus-article-highlight -Highlight the current article (@code{gnus-article-highlight}). - -@item W H h -@kindex W H h (Summary) -@findex gnus-article-highlight-headers -@vindex gnus-header-face-alist -Highlight the headers (@code{gnus-article-highlight-headers}). The -highlighting will be done according to the @code{gnus-header-face-alist} -variable, which is a list where each element has the form @var{(regexp -name content)}. @var{regexp} is a regular expression for matching the -header, @var{name} is the face used for highlighting the header name and -@var{content} is the face for highlighting the header value. The first -match made will be used. Note that @var{regexp} shouldn't have @samp{^} -prepended---Gnus will add one. - -@item W H c -@kindex W H c (Summary) -@findex gnus-article-highlight-citation -Highlight cited text (@code{gnus-article-highlight-citation}). - -Some variables to customize the citation highlights: - -@table @code -@vindex gnus-cite-parse-max-size - -@item gnus-cite-parse-max-size -If the article size if bigger than this variable (which is 25000 by -default), no citation highlighting will be performed. - -@item gnus-cite-prefix-regexp -@vindex gnus-cite-prefix-regexp -Regexp matching the longest possible citation prefix on a line. - -@item gnus-cite-max-prefix -@vindex gnus-cite-max-prefix -Maximum possible length for a citation prefix (default 20). - -@item gnus-cite-face-list -@vindex gnus-cite-face-list -List of faces used for highlighting citations. When there are citations -from multiple articles in the same message, Gnus will try to give each -citation from each article its own face. This should make it easier to -see who wrote what. - -@item gnus-supercite-regexp -@vindex gnus-supercite-regexp -Regexp matching normal Supercite attribution lines. - -@item gnus-supercite-secondary-regexp -@vindex gnus-supercite-secondary-regexp -Regexp matching mangled Supercite attribution lines. - -@item gnus-cite-minimum-match-count -@vindex gnus-cite-minimum-match-count -Minimum number of identical prefixes we have to see before we believe -that it's a citation. - -@item gnus-cite-attribution-prefix -@vindex gnus-cite-attribution-prefix -Regexp matching the beginning of an attribution line. - -@item gnus-cite-attribution-suffix -@vindex gnus-cite-attribution-suffix -Regexp matching the end of an attribution line. - -@item gnus-cite-attribution-face -@vindex gnus-cite-attribution-face -Face used for attribution lines. It is merged with the face for the -cited text belonging to the attribution. - -@end table - - -@item W H s -@kindex W H s (Summary) -@vindex gnus-signature-separator -@vindex gnus-signature-face -@findex gnus-article-highlight-signature -Highlight the signature (@code{gnus-article-highlight-signature}). -Everything after @code{gnus-signature-separator} (@pxref{Article -Signature}) in an article will be considered a signature and will be -highlighted with @code{gnus-signature-face}, which is @code{italic} by -default. - -@end table - - -@node Article Fontisizing -@subsection Article Fontisizing -@cindex emphasis -@cindex article emphasis - -@findex gnus-article-emphasize -@kindex W e (Summary) -People commonly add emphasis to words in news articles by writing things -like @samp{_this_} or @samp{*this*}. Gnus can make this look nicer by -running the article through the @kbd{W e} -(@code{gnus-article-emphasize}) command. - -@vindex gnus-article-emphasis -How the emphasis is computed is controlled by the -@code{gnus-article-emphasis} variable. This is an alist where the first -element is a regular expression to be matched. The second is a number -that says what regular expression grouping is used to find the entire -emphasized word. The third is a number that says what regexp grouping -should be displayed and highlighted. (The text between these two -groupings will be hidden.) The fourth is the face used for -highlighting. - -@lisp -(setq gnus-article-emphasis - '(("_\\(\\w+\\)_" 0 1 gnus-emphasis-underline) - ("\\*\\(\\w+\\)\\*" 0 1 gnus-emphasis-bold))) -@end lisp - -@vindex gnus-emphasis-underline -@vindex gnus-emphasis-bold -@vindex gnus-emphasis-italic -@vindex gnus-emphasis-underline-bold -@vindex gnus-emphasis-underline-italic -@vindex gnus-emphasis-bold-italic -@vindex gnus-emphasis-underline-bold-italic -By default, there are seven rules, and they use the following faces: -@code{gnus-emphasis-bold}, @code{gnus-emphasis-italic}, -@code{gnus-emphasis-underline}, @code{gnus-emphasis-bold-italic}, -@code{gnus-emphasis-underline-italic}, -@code{gnus-emphasis-underline-bold}, and -@code{gnus-emphasis-underline-bold-italic}. - -If you want to change these faces, you can either use @kbd{M-x -customize}, or you can use @code{copy-face}. For instance, if you want -to make @code{gnus-emphasis-italic} use a red face instead, you could -say something like: - -@lisp -(copy-face 'red 'gnus-emphasis-italic) -@end lisp - - -@node Article Hiding -@subsection Article Hiding -@cindex article hiding - -Or rather, hiding certain things in each article. There usually is much -too much cruft in most articles. - -@table @kbd - -@item W W a -@kindex W W a (Summary) -@findex gnus-article-hide -Do maximum hiding on the summary buffer (@kbd{gnus-article-hide}). - -@item W W h -@kindex W W h (Summary) -@findex gnus-article-hide-headers -Hide headers (@code{gnus-article-hide-headers}). @xref{Hiding -Headers}. - -@item W W b -@kindex W W b (Summary) -@findex gnus-article-hide-boring-headers -Hide headers that aren't particularly interesting -(@code{gnus-article-hide-boring-headers}). @xref{Hiding Headers}. - -@item W W s -@kindex W W s (Summary) -@findex gnus-article-hide-signature -Hide signature (@code{gnus-article-hide-signature}). @xref{Article -Signature}. - -@item W W p -@kindex W W p (Summary) -@findex gnus-article-hide-pgp -@vindex gnus-article-hide-pgp-hook -Hide @sc{pgp} signatures (@code{gnus-article-hide-pgp}). The -@code{gnus-article-hide-pgp-hook} hook will be run after a @sc{pgp} -signature has been hidden. - -@item W W P -@kindex W W P (Summary) -@findex gnus-article-hide-pem -Hide @sc{pem} (privacy enhanced messages) cruft -(@code{gnus-article-hide-pem}). - -@item W W c -@kindex W W c (Summary) -@findex gnus-article-hide-citation -Hide citation (@code{gnus-article-hide-citation}). Some variables for -customizing the hiding: - -@table @code - -@item gnus-cite-hide-percentage -@vindex gnus-cite-hide-percentage -If the cited text is of a bigger percentage than this variable (default -50), hide the cited text. - -@item gnus-cite-hide-absolute -@vindex gnus-cite-hide-absolute -The cited text must have at least this length (default 10) before it -is hidden. - -@item gnus-cited-text-button-line-format -@vindex gnus-cited-text-button-line-format -Gnus adds buttons to show where the cited text has been hidden, and to -allow toggle hiding the text. The format of the variable is specified -by this format-like variable (@pxref{Formatting Variables}). These -specs are legal: - -@table @samp -@item b -Start point of the hidden text. -@item e -End point of the hidden text. -@item l -Length of the hidden text. -@end table - -@item gnus-cited-lines-visible -@vindex gnus-cited-lines-visible -The number of lines at the beginning of the cited text to leave shown. - -@end table - -@item W W C -@kindex W W C (Summary) -@findex gnus-article-hide-citation-in-followups -Hide cited text in articles that aren't roots -(@code{gnus-article-hide-citation-in-followups}). This isn't very -useful as an interactive command, but might be a handy function to stick -in @code{gnus-article-display-hook} (@pxref{Customizing Articles}). - -@end table - -All these ``hiding'' commands are toggles, but if you give a negative -prefix to these commands, they will show what they have previously -hidden. If you give a positive prefix, they will always hide. - -Also @pxref{Article Highlighting} for further variables for -citation customization. - - -@node Article Washing -@subsection Article Washing -@cindex washing -@cindex article washing - -We call this ``article washing'' for a really good reason. Namely, the -@kbd{A} key was taken, so we had to use the @kbd{W} key instead. - -@dfn{Washing} is defined by us as ``changing something from something to -something else'', but normally results in something looking better. -Cleaner, perhaps. - -@table @kbd - -@item W l -@kindex W l (Summary) -@findex gnus-summary-stop-page-breaking -Remove page breaks from the current article -(@code{gnus-summary-stop-page-breaking}). - -@item W r -@kindex W r (Summary) -@findex gnus-summary-caesar-message -@c @icon{gnus-summary-caesar-message} -Do a Caesar rotate (rot13) on the article buffer -(@code{gnus-summary-caesar-message}). - -@item W t -@kindex W t (Summary) -@findex gnus-summary-toggle-header -Toggle whether to display all headers in the article buffer -(@code{gnus-summary-toggle-header}). - -@item W v -@kindex W v (Summary) -@findex gnus-summary-verbose-header -Toggle whether to display all headers in the article buffer permanently -(@code{gnus-summary-verbose-header}). - -@item W m -@kindex W m (Summary) -@findex gnus-summary-toggle-mime -Toggle whether to run the article through @sc{mime} before displaying -(@code{gnus-summary-toggle-mime}). - -@item W o -@kindex W o (Summary) -@findex gnus-article-treat-overstrike -Treat overstrike (@code{gnus-article-treat-overstrike}). - -@item W w -@kindex W w (Summary) -@findex gnus-article-fill-cited-article -Do word wrap (@code{gnus-article-fill-cited-article}). If you use this -function in @code{gnus-article-display-hook}, it should be run fairly -late and certainly after any highlighting. - -You can give the command a numerical prefix to specify the width to use -when filling. - -@item W c -@kindex W c (Summary) -@findex gnus-article-remove-cr -Remove CR (@code{gnus-article-remove-cr}). - -@item W q -@kindex W q (Summary) -@findex gnus-article-de-quoted-unreadable -Treat quoted-printable (@code{gnus-article-de-quoted-unreadable}). - -@item W f -@kindex W f (Summary) -@cindex x-face -@findex gnus-article-display-x-face -@findex gnus-article-x-face-command -@vindex gnus-article-x-face-command -@vindex gnus-article-x-face-too-ugly -@iftex -@iflatex -\gnusxface{tmp/xface-karlheg.ps} -\gnusxface{tmp/xface-kyle.ps} -\gnusxface{tmp/xface-smb.ps} -@end iflatex -@end iftex -Look for and display any X-Face headers -(@code{gnus-article-display-x-face}). The command executed by this -function is given by the @code{gnus-article-x-face-command} variable. -If this variable is a string, this string will be executed in a -sub-shell. If it is a function, this function will be called with the -face as the argument. If the @code{gnus-article-x-face-too-ugly} (which -is a regexp) matches the @code{From} header, the face will not be shown. -The default action under Emacs is to fork off an @code{xv} to view the -face; under XEmacs the default action is to display the face before the -@code{From} header. (It's nicer if XEmacs has been compiled with X-Face -support---that will make display somewhat faster. If there's no native -X-Face support, Gnus will try to convert the @code{X-Face} header using -external programs from the @code{pbmplus} package and friends.) If you -want to have this function in the display hook, it should probably come -last. - -@item W b -@kindex W b (Summary) -@findex gnus-article-add-buttons -Add clickable buttons to the article (@code{gnus-article-add-buttons}). - -@item W B -@kindex W B (Summary) -@findex gnus-article-add-buttons-to-head -Add clickable buttons to the article headers -(@code{gnus-article-add-buttons-to-head}). - -@item W E l -@kindex W E l (Summary) -@findex gnus-article-strip-leading-blank-lines -Remove all blank lines from the beginning of the article -(@code{gnus-article-strip-leading-blank-lines}). - -@item W E m -@kindex W E m (Summary) -@findex gnus-article-strip-multiple-blank-lines -Replace all blank lines with empty lines and then all multiple empty -lines with a single empty line. -(@code{gnus-article-strip-multiple-blank-lines}). - -@item W E t -@kindex W E t (Summary) -@findex gnus-article-remove-trailing-blank-lines -Remove all blank lines at the end of the article -(@code{gnus-article-remove-trailing-blank-lines}). - -@item W E a -@kindex W E a (Summary) -@findex gnus-article-strip-blank-lines -Do all the three commands above -(@code{gnus-article-strip-blank-lines}). - -@item W E s -@kindex W E s (Summary) -@findex gnus-article-strip-leading-space -Remove all white space from the beginning of all lines of the article -body (@code{gnus-article-strip-leading-space}). - -@end table - - -@node Article Buttons -@subsection Article Buttons -@cindex buttons - -People often include references to other stuff in articles, and it would -be nice if Gnus could just fetch whatever it is that people talk about -with the minimum of fuzz. - -Gnus adds @dfn{buttons} to certain standard references by default: -Well-formed URLs, mail addresses and Message-IDs. This is controlled by -two variables, one that handles article bodies and one that handles -article heads: - -@table @code - -@item gnus-button-alist -@vindex gnus-button-alist -This is an alist where each entry has this form: - -@lisp -(REGEXP BUTTON-PAR USE-P FUNCTION DATA-PAR) -@end lisp - -@table @var - -@item regexp -All text that match this regular expression will be considered an -external reference. Here's a typical regexp that matches embedded URLs: -@samp{]*\\)>}. - -@item button-par -Gnus has to know which parts of the matches is to be highlighted. This -is a number that says what sub-expression of the regexp is to be -highlighted. If you want it all highlighted, you use 0 here. - -@item use-p -This form will be @code{eval}ed, and if the result is non-@code{nil}, -this is considered a match. This is useful if you want extra sifting to -avoid false matches. - -@item function -This function will be called when you click on this button. - -@item data-par -As with @var{button-par}, this is a sub-expression number, but this one -says which part of the match is to be sent as data to @var{function}. - -@end table - -So the full entry for buttonizing URLs is then - -@lisp -("]*\\)>" 0 t gnus-button-url 1) -@end lisp - -@item gnus-header-button-alist -@vindex gnus-header-button-alist -This is just like the other alist, except that it is applied to the -article head only, and that each entry has an additional element that is -used to say what headers to apply the buttonize coding to: - -@lisp -(HEADER REGEXP BUTTON-PAR USE-P FUNCTION DATA-PAR) -@end lisp - -@var{HEADER} is a regular expression. - -@item gnus-button-url-regexp -@vindex gnus-button-url-regexp -A regular expression that matches embedded URLs. It is used in the -default values of the variables above. - -@item gnus-article-button-face -@vindex gnus-article-button-face -Face used on buttons. - -@item gnus-article-mouse-face -@vindex gnus-article-mouse-face -Face used when the mouse cursor is over a button. - -@end table - - -@node Article Date -@subsection Article Date - -The date is most likely generated in some obscure timezone you've never -heard of, so it's quite nice to be able to find out what the time was -when the article was sent. - -@table @kbd - -@item W T u -@kindex W T u (Summary) -@findex gnus-article-date-ut -Display the date in UT (aka. GMT, aka ZULU) -(@code{gnus-article-date-ut}). - -@item W T l -@kindex W T l (Summary) -@findex gnus-article-date-local -Display the date in the local timezone (@code{gnus-article-date-local}). - -@item W T s -@kindex W T s (Summary) -@vindex gnus-article-time-format -@findex gnus-article-date-user -@findex format-time-string -Display the date using a user-defined format -(@code{gnus-article-date-user}). The format is specified by the -@code{gnus-article-time-format} variable, and is a string that's passed -to @code{format-time-string}. See the documentation of that variable -for a list of possible format specs. - -@item W T e -@kindex W T e (Summary) -@findex gnus-article-date-lapsed -Say how much time has elapsed between the article was posted and now -(@code{gnus-article-date-lapsed}). - -@item W T o -@kindex W T o (Summary) -@findex gnus-article-date-original -Display the original date (@code{gnus-article-date-original}). This can -be useful if you normally use some other conversion function and are -worried that it might be doing something totally wrong. Say, claiming -that the article was posted in 1854. Although something like that is -@emph{totally} impossible. Don't you trust me? *titter* - -@end table - - -@node Article Signature -@subsection Article Signature -@cindex signatures -@cindex article signature - -@vindex gnus-signature-separator -Each article is divided into two parts---the head and the body. The -body can be divided into a signature part and a text part. The variable -that says what is to be considered a signature is -@code{gnus-signature-separator}. This is normally the standard -@samp{^-- $} as mandated by son-of-RFC 1036. However, many people use -non-standard signature separators, so this variable can also be a list -of regular expressions to be tested, one by one. (Searches are done -from the end of the body towards the beginning.) One likely value is: - -@lisp -(setq gnus-signature-separator - '("^-- $" ; The standard - "^-- *$" ; A common mangling - "^-------*$" ; Many people just use a looong - ; line of dashes. Shame! - "^ *--------*$" ; Double-shame! - "^________*$" ; Underscores are also popular - "^========*$")) ; Pervert! -@end lisp - -The more permissive you are, the more likely it is that you'll get false -positives. - -@vindex gnus-signature-limit -@code{gnus-signature-limit} provides a limit to what is considered a -signature. - -@enumerate -@item -If it is an integer, no signature may be longer (in characters) than -that integer. -@item -If it is a floating point number, no signature may be longer (in lines) -than that number. -@item -If it is a function, the function will be called without any parameters, -and if it returns @code{nil}, there is no signature in the buffer. -@item -If it is a string, it will be used as a regexp. If it matches, the text -in question is not a signature. -@end enumerate - -This variable can also be a list where the elements may be of the types -listed above. - - -@node Article Commands -@section Article Commands - -@table @kbd - -@item A P -@cindex PostScript -@cindex printing -@kindex A P (Summary) -@vindex gnus-ps-print-hook -@findex gnus-summary-print-article -Generate and print a PostScript image of the article buffer -(@code{gnus-summary-print-article}). @code{gnus-ps-print-hook} will be -run just before printing the buffer. - -@end table - - -@node Summary Sorting -@section Summary Sorting -@cindex summary sorting - -You can have the summary buffer sorted in various ways, even though I -can't really see why you'd want that. - -@table @kbd - -@item C-c C-s C-n -@kindex C-c C-s C-n (Summary) -@findex gnus-summary-sort-by-number -Sort by article number (@code{gnus-summary-sort-by-number}). - -@item C-c C-s C-a -@kindex C-c C-s C-a (Summary) -@findex gnus-summary-sort-by-author -Sort by author (@code{gnus-summary-sort-by-author}). - -@item C-c C-s C-s -@kindex C-c C-s C-s (Summary) -@findex gnus-summary-sort-by-subject -Sort by subject (@code{gnus-summary-sort-by-subject}). - -@item C-c C-s C-d -@kindex C-c C-s C-d (Summary) -@findex gnus-summary-sort-by-date -Sort by date (@code{gnus-summary-sort-by-date}). - -@item C-c C-s C-l -@kindex C-c C-s C-l (Summary) -@findex gnus-summary-sort-by-lines -Sort by lines (@code{gnus-summary-sort-by-lines}). - -@item C-c C-s C-i -@kindex C-c C-s C-i (Summary) -@findex gnus-summary-sort-by-score -Sort by score (@code{gnus-summary-sort-by-score}). -@end table - -These functions will work both when you use threading and when you don't -use threading. In the latter case, all summary lines will be sorted, -line by line. In the former case, sorting will be done on a -root-by-root basis, which might not be what you were looking for. To -toggle whether to use threading, type @kbd{T T} (@pxref{Thread -Commands}). - - -@node Finding the Parent -@section Finding the Parent -@cindex parent articles -@cindex referring articles - -@findex gnus-summary-refer-parent-article -@kindex ^ (Summary) -If you'd like to read the parent of the current article, and it is not -displayed in the summary buffer, you might still be able to. That is, -if the current group is fetched by @sc{nntp}, the parent hasn't expired -and the @code{References} in the current article are not mangled, you -can just press @kbd{^} or @kbd{A r} -(@code{gnus-summary-refer-parent-article}). If everything goes well, -you'll get the parent. If the parent is already displayed in the -summary buffer, point will just move to this article. - -If given a positive numerical prefix, fetch that many articles back into -the ancestry. If given a negative numerical prefix, fetch just that -ancestor. So if you say @kbd{3 ^}, Gnus will fetch the parent, the -grandparent and the grandgrandparent of the current article. If you say -@kbd{-3 ^}, Gnus will only fetch the grandgrandparent of the current -article. - -@findex gnus-summary-refer-references -@kindex A R (Summary) -You can have Gnus fetch all articles mentioned in the @code{References} -header of the article by pushing @kbd{A R} -(@code{gnus-summary-refer-references}). - -@findex gnus-summary-refer-article -@kindex M-^ (Summary) -@cindex Message-ID -@cindex fetching by Message-ID -You can also ask the @sc{nntp} server for an arbitrary article, no -matter what group it belongs to. @kbd{M-^} -(@code{gnus-summary-refer-article}) will ask you for a -@code{Message-ID}, which is one of those long, hard-to-read thingies -that look something like @samp{<38o6up$6f2@@hymir.ifi.uio.no>}. You -have to get it all exactly right. No fuzzy searches, I'm afraid. - -The current select method will be used when fetching by -@code{Message-ID} from non-news select method, but you can override this -by giving this command a prefix. - -@vindex gnus-refer-article-method -If the group you are reading is located on a backend that does not -support fetching by @code{Message-ID} very well (like @code{nnspool}), -you can set @code{gnus-refer-article-method} to an @sc{nntp} method. It -would, perhaps, be best if the @sc{nntp} server you consult is the one -updating the spool you are reading from, but that's not really -necessary. - -Most of the mail backends support fetching by @code{Message-ID}, but do -not do a particularly excellent job at it. That is, @code{nnmbox} and -@code{nnbabyl} are able to locate articles from any groups, while -@code{nnml} and @code{nnfolder} are only able to locate articles that -have been posted to the current group. (Anything else would be too time -consuming.) @code{nnmh} does not support this at all. - - -@node Alternative Approaches -@section Alternative Approaches - -Different people like to read news using different methods. This being -Gnus, we offer a small selection of minor modes for the summary buffers. - -@menu -* Pick and Read:: First mark articles and then read them. -* Binary Groups:: Auto-decode all articles. -@end menu - - -@node Pick and Read -@subsection Pick and Read -@cindex pick and read - -Some newsreaders (like @code{nn} and, uhm, @code{Netnews} on VM/CMS) use -a two-phased reading interface. The user first marks in a summary -buffer the articles she wants to read. Then she starts reading the -articles with just an article buffer displayed. - -@findex gnus-pick-mode -@kindex M-x gnus-pick-mode -Gnus provides a summary buffer minor mode that allows -this---@code{gnus-pick-mode}. This basically means that a few process -mark commands become one-keystroke commands to allow easy marking, and -it provides one additional command for switching to the summary buffer. - -Here are the available keystrokes when using pick mode: - -@table @kbd -@item . -@kindex . (Pick) -@findex gnus-summary-mark-as-processable -Pick the article on the current line -(@code{gnus-summary-mark-as-processable}). If given a numerical prefix, -go to that article and pick it. (The line number is normally displayed -at the beginning of the summary pick lines.) - -@item SPACE -@kindex SPACE (Pick) -@findex gnus-pick-next-page -Scroll the summary buffer up one page (@code{gnus-pick-next-page}). If -at the end of the buffer, start reading the picked articles. - -@item u -@kindex u (Pick) -@findex gnus-summary-unmark-as-processable -Unpick the article (@code{gnus-summary-unmark-as-processable}). - -@item U -@kindex U (Pick) -@findex gnus-summary-unmark-all-processable -Unpick all articles (@code{gnus-summary-unmark-all-processable}). - -@item t -@kindex t (Pick) -@findex gnus-uu-mark-thread -Pick the thread (@code{gnus-uu-mark-thread}). - -@item T -@kindex T (Pick) -@findex gnus-uu-unmark-thread -Unpick the thread (@code{gnus-uu-unmark-thread}). - -@item r -@kindex r (Pick) -@findex gnus-uu-mark-region -Pick the region (@code{gnus-uu-mark-region}). - -@item R -@kindex R (Pick) -@findex gnus-uu-unmark-region -Unpick the region (@code{gnus-uu-unmark-region}). - -@item e -@kindex e (Pick) -@findex gnus-uu-mark-by-regexp -Pick articles that match a regexp (@code{gnus-uu-mark-by-regexp}). - -@item E -@kindex E (Pick) -@findex gnus-uu-unmark-by-regexp -Unpick articles that match a regexp (@code{gnus-uu-unmark-by-regexp}). - -@item b -@kindex b (Pick) -@findex gnus-uu-mark-buffer -Pick the buffer (@code{gnus-uu-mark-buffer}). - -@item B -@kindex B (Pick) -@findex gnus-uu-unmark-buffer -Unpick the buffer (@code{gnus-uu-unmark-buffer}). - -@item RET -@kindex RET (Pick) -@findex gnus-pick-start-reading -@vindex gnus-pick-display-summary -Start reading the picked articles (@code{gnus-pick-start-reading}). If -given a prefix, mark all unpicked articles as read first. If -@code{gnus-pick-display-summary} is non-@code{nil}, the summary buffer -will still be visible when you are reading. - -@end table - -If this sounds like a good idea to you, you could say: - -@lisp -(add-hook 'gnus-summary-mode-hook 'gnus-pick-mode) -@end lisp - -@vindex gnus-pick-mode-hook -@code{gnus-pick-mode-hook} is run in pick minor mode buffers. - -@vindex gnus-mark-unpicked-articles-as-read -If @code{gnus-mark-unpicked-articles-as-read} is non-@code{nil}, mark -all unpicked articles as read. The default is @code{nil}. - -@vindex gnus-summary-pick-line-format -The summary line format in pick mode is slightly different from the -standard format. At the beginning of each line the line number is -displayed. The pick mode line format is controlled by the -@code{gnus-summary-pick-line-format} variable (@pxref{Formatting -Variables}). It accepts the same format specs that -@code{gnus-summary-line-format} does (@pxref{Summary Buffer Lines}). - - -@node Binary Groups -@subsection Binary Groups -@cindex binary groups - -@findex gnus-binary-mode -@kindex M-x gnus-binary-mode -If you spend much time in binary groups, you may grow tired of hitting -@kbd{X u}, @kbd{n}, @kbd{RET} all the time. @kbd{M-x gnus-binary-mode} -is a minor mode for summary buffers that makes all ordinary Gnus article -selection functions uudecode series of articles and display the result -instead of just displaying the articles the normal way. - -@kindex g (Binary) -@findex gnus-binary-show-article -The only way, in fact, to see the actual articles is the @kbd{g} -command, when you have turned on this mode -(@code{gnus-binary-show-article}). - -@vindex gnus-binary-mode-hook -@code{gnus-binary-mode-hook} is called in binary minor mode buffers. - - -@node Tree Display -@section Tree Display -@cindex trees - -@vindex gnus-use-trees -If you don't like the normal Gnus summary display, you might try setting -@code{gnus-use-trees} to @code{t}. This will create (by default) an -additional @dfn{tree buffer}. You can execute all summary mode commands -in the tree buffer. - -There are a few variables to customize the tree display, of course: - -@table @code -@item gnus-tree-mode-hook -@vindex gnus-tree-mode-hook -A hook called in all tree mode buffers. - -@item gnus-tree-mode-line-format -@vindex gnus-tree-mode-line-format -A format string for the mode bar in the tree mode buffers. The default -is @samp{Gnus: %%b [%A] %Z}. For a list of legal specs, @pxref{Summary -Buffer Mode Line}. - -@item gnus-selected-tree-face -@vindex gnus-selected-tree-face -Face used for highlighting the selected article in the tree buffer. The -default is @code{modeline}. - -@item gnus-tree-line-format -@vindex gnus-tree-line-format -A format string for the tree nodes. The name is a bit of a misnomer, -though---it doesn't define a line, but just the node. The default value -is @samp{%(%[%3,3n%]%)}, which displays the first three characters of -the name of the poster. It is vital that all nodes are of the same -length, so you @emph{must} use @samp{%4,4n}-like specifiers. - -Legal specs are: - -@table @samp -@item n -The name of the poster. -@item f -The @code{From} header. -@item N -The number of the article. -@item [ -The opening bracket. -@item ] -The closing bracket. -@item s -The subject. -@end table - -@xref{Formatting Variables}. - -Variables related to the display are: - -@table @code -@item gnus-tree-brackets -@vindex gnus-tree-brackets -This is used for differentiating between ``real'' articles and -``sparse'' articles. The format is @var{((real-open . real-close) -(sparse-open . sparse-close) (dummy-open . dummy-close))}, and the -default is @code{((?[ . ?]) (?( . ?)) (?@{ . ?@}))}. - -@item gnus-tree-parent-child-edges -@vindex gnus-tree-parent-child-edges -This is a list that contains the characters used for connecting parent -nodes to their children. The default is @code{(?- ?\\ ?|)}. - -@end table - -@item gnus-tree-minimize-window -@vindex gnus-tree-minimize-window -If this variable is non-@code{nil}, Gnus will try to keep the tree -buffer as small as possible to allow more room for the other Gnus -windows. If this variable is a number, the tree buffer will never be -higher than that number. The default is @code{t}. Note that if you -have several windows displayed side-by-side in a frame and the tree -buffer is one of these, minimizing the tree window will also resize all -other windows displayed next to it. - -@item gnus-generate-tree-function -@vindex gnus-generate-tree-function -@findex gnus-generate-horizontal-tree -@findex gnus-generate-vertical-tree -The function that actually generates the thread tree. Two predefined -functions are available: @code{gnus-generate-horizontal-tree} and -@code{gnus-generate-vertical-tree} (which is the default). - -@end table - -Here's an example from a horizontal tree buffer: - -@example -@{***@}-(***)-[odd]-[Gun] - | \[Jan] - | \[odd]-[Eri] - | \(***)-[Eri] - | \[odd]-[Paa] - \[Bjo] - \[Gun] - \[Gun]-[Jor] -@end example - -Here's the same thread displayed in a vertical tree buffer: - -@example -@{***@} - |--------------------------\-----\-----\ -(***) [Bjo] [Gun] [Gun] - |--\-----\-----\ | -[odd] [Jan] [odd] (***) [Jor] - | | |--\ -[Gun] [Eri] [Eri] [odd] - | - [Paa] -@end example - -If you're using horizontal trees, it might be nice to display the trees -side-by-side with the summary buffer. You could add something like the -following to your @file{.gnus.el} file: - -@lisp -(setq gnus-use-trees t - gnus-generate-tree-function 'gnus-generate-horizontal-tree - gnus-tree-minimize-window nil) -(gnus-add-configuration - '(article - (vertical 1.0 - (horizontal 0.25 - (summary 0.75 point) - (tree 1.0)) - (article 1.0)))) -@end lisp - -@xref{Windows Configuration}. - - -@node Mail Group Commands -@section Mail Group Commands -@cindex mail group commands - -Some commands only make sense in mail groups. If these commands are -illegal in the current group, they will raise hell and let you know. - -All these commands (except the expiry and edit commands) use the -process/prefix convention (@pxref{Process/Prefix}). - -@table @kbd - -@item B e -@kindex B e (Summary) -@findex gnus-summary-expire-articles -Expire all expirable articles in the group -(@code{gnus-summary-expire-articles}). - -@item B M-C-e -@kindex B M-C-e (Summary) -@findex gnus-summary-expire-articles-now -Delete all the expirable articles in the group -(@code{gnus-summary-expire-articles-now}). This means that @strong{all} -articles eligible for expiry in the current group will -disappear forever into that big @file{/dev/null} in the sky. - -@item B DEL -@kindex B DEL (Summary) -@findex gnus-summary-delete-article -@c @icon{gnus-summary-mail-delete} -Delete the mail article. This is ``delete'' as in ``delete it from your -disk forever and ever, never to return again.'' Use with caution. -(@code{gnus-summary-delete-article}). - -@item B m -@kindex B m (Summary) -@cindex move mail -@findex gnus-summary-move-article -Move the article from one mail group to another -(@code{gnus-summary-move-article}). - -@item B c -@kindex B c (Summary) -@cindex copy mail -@findex gnus-summary-copy-article -@c @icon{gnus-summary-mail-copy} -Copy the article from one group (mail group or not) to a mail group -(@code{gnus-summary-copy-article}). - -@item B C -@kindex B C (Summary) -@cindex crosspost mail -@findex gnus-summary-crosspost-article -Crosspost the current article to some other group -(@code{gnus-summary-crosspost-article}). This will create a new copy of -the article in the other group, and the Xref headers of the article will -be properly updated. - -@item B i -@kindex B i (Summary) -@findex gnus-summary-import-article -Import an arbitrary file into the current mail newsgroup -(@code{gnus-summary-import-article}). You will be prompted for a file -name, a @code{From} header and a @code{Subject} header. - -@item B r -@kindex B r (Summary) -@findex gnus-summary-respool-article -Respool the mail article (@code{gnus-summary-move-article}). -@code{gnus-summary-respool-default-method} will be used as the default -select method when respooling. This variable is @code{nil} by default, -which means that the current group select method will be used instead. - -@item B w -@itemx e -@kindex B w (Summary) -@kindex e (Summary) -@findex gnus-summary-edit-article -@kindex C-c C-c (Article) -Edit the current article (@code{gnus-summary-edit-article}). To finish -editing and make the changes permanent, type @kbd{C-c C-c} -(@kbd{gnus-summary-edit-article-done}). - -@item B q -@kindex B q (Summary) -@findex gnus-summary-respool-query -If you want to re-spool an article, you might be curious as to what group -the article will end up in before you do the re-spooling. This command -will tell you (@code{gnus-summary-respool-query}). - -@item B p -@kindex B p (Summary) -@findex gnus-summary-article-posted-p -Some people have a tendency to send you "courtesy" copies when they -follow up to articles you have posted. These usually have a -@code{Newsgroups} header in them, but not always. This command -(@code{gnus-summary-article-posted-p}) will try to fetch the current -article from your news server (or rather, from -@code{gnus-refer-article-method} or @code{gnus-select-method}) and will -report back whether it found the article or not. Even if it says that -it didn't find the article, it may have been posted anyway---mail -propagation is much faster than news propagation, and the news copy may -just not have arrived yet. - -@end table - -@vindex gnus-move-split-methods -@cindex moving articles -If you move (or copy) articles regularly, you might wish to have Gnus -suggest where to put the articles. @code{gnus-move-split-methods} is a -variable that uses the same syntax as @code{gnus-split-methods} -(@pxref{Saving Articles}). You may customize that variable to create -suggestions you find reasonable. - -@lisp -(setq gnus-move-split-methods - '(("^From:.*Lars Magne" "nnml:junk") - ("^Subject:.*gnus" "nnfolder:important") - (".*" "nnml:misc"))) -@end lisp - - -@node Various Summary Stuff -@section Various Summary Stuff - -@menu -* Summary Group Information:: Information oriented commands. -* Searching for Articles:: Multiple article commands. -* Summary Generation Commands:: (Re)generating the summary buffer. -* Really Various Summary Commands:: Those pesky non-conformant commands. -@end menu - -@table @code -@vindex gnus-summary-mode-hook -@item gnus-summary-mode-hook -This hook is called when creating a summary mode buffer. - -@vindex gnus-summary-generate-hook -@item gnus-summary-generate-hook -This is called as the last thing before doing the threading and the -generation of the summary buffer. It's quite convenient for customizing -the threading variables based on what data the newsgroup has. This hook -is called from the summary buffer after most summary buffer variables -have been set. - -@vindex gnus-summary-prepare-hook -@item gnus-summary-prepare-hook -It is called after the summary buffer has been generated. You might use -it to, for instance, highlight lines or modify the look of the buffer in -some other ungodly manner. I don't care. - -@vindex gnus-summary-ignore-duplicates -@item gnus-summary-ignore-duplicates -When Gnus discovers two articles that have the same @code{Message-ID}, -it has to do something drastic. No articles are allowed to have the -same @code{Message-ID}, but this may happen when reading mail from some -sources. Gnus allows you to customize what happens with this variable. -If it is @code{nil} (which is the default), Gnus will rename the -@code{Message-ID} (for display purposes only) and display the article as -any other article. If this variable is @code{t}, it won't display the -article---it'll be as if it never existed. - -@end table - - -@node Summary Group Information -@subsection Summary Group Information - -@table @kbd - -@item H f -@kindex H f (Summary) -@findex gnus-summary-fetch-faq -@vindex gnus-group-faq-directory -Try to fetch the FAQ (list of frequently asked questions) for the -current group (@code{gnus-summary-fetch-faq}). Gnus will try to get the -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 -Give a brief description of the current group -(@code{gnus-summary-describe-group}). If given a prefix, force -rereading the description from the server. - -@item H h -@kindex H h (Summary) -@findex gnus-summary-describe-briefly -Give an extremely brief description of the most important summary -keystrokes (@code{gnus-summary-describe-briefly}). - -@item H i -@kindex H i (Summary) -@findex gnus-info-find-node -Go to the Gnus info node (@code{gnus-info-find-node}). -@end table - - -@node Searching for Articles -@subsection Searching for Articles - -@table @kbd - -@item M-s -@kindex M-s (Summary) -@findex gnus-summary-search-article-forward -Search through all subsequent articles for a regexp -(@code{gnus-summary-search-article-forward}). - -@item M-r -@kindex M-r (Summary) -@findex gnus-summary-search-article-backward -Search through all previous articles for a regexp -(@code{gnus-summary-search-article-backward}). - -@item & -@kindex & (Summary) -@findex gnus-summary-execute-command -This command will prompt you for a header field, a regular expression to -match on this field, and a command to be executed if the match is made -(@code{gnus-summary-execute-command}). If given a prefix, search -backward instead. - -@item M-& -@kindex M-& (Summary) -@findex gnus-summary-universal-argument -Perform any operation on all articles that have been marked with -the process mark (@code{gnus-summary-universal-argument}). -@end table - -@node Summary Generation Commands -@subsection Summary Generation Commands - -@table @kbd - -@item Y g -@kindex Y g (Summary) -@findex gnus-summary-prepare -Regenerate the current summary buffer (@code{gnus-summary-prepare}). - -@item Y c -@kindex Y c (Summary) -@findex gnus-summary-insert-cached-articles -Pull all cached articles (for the current group) into the summary buffer -(@code{gnus-summary-insert-cached-articles}). - -@end table - - -@node Really Various Summary Commands -@subsection Really Various Summary Commands - -@table @kbd - -@item C-d -@kindex C-d (Summary) -@findex gnus-summary-enter-digest-group -If the current article is a collection of other articles (for instance, -a digest), you might use this command to enter a group based on the that -article (@code{gnus-summary-enter-digest-group}). Gnus will try to -guess what article type is currently displayed unless you give a prefix -to this command, which forces a ``digest'' interpretation. Basically, -whenever you see a message that is a collection of other messages of -some format, you @kbd{C-d} and read these messages in a more convenient -fashion. - -@item M-C-d -@kindex M-C-d (Summary) -@findex gnus-summary-read-document -This command is very similar to the one above, but lets you gather -several documents into one biiig group -(@code{gnus-summary-read-document}). It does this by opening several -@code{nndoc} groups for each document, and then opening an -@code{nnvirtual} group on top of these @code{nndoc} groups. This -command understands the process/prefix convention -(@pxref{Process/Prefix}). - -@item C-t -@kindex C-t (Summary) -@findex gnus-summary-toggle-truncation -Toggle truncation of summary lines -(@code{gnus-summary-toggle-truncation}). This will probably confuse the -line centering function in the summary buffer, so it's not a good idea -to have truncation switched off while reading articles. - -@item = -@kindex = (Summary) -@findex gnus-summary-expand-window -Expand the summary buffer window (@code{gnus-summary-expand-window}). -If given a prefix, force an @code{article} window configuration. - -@end table - - -@node Exiting the Summary Buffer -@section Exiting the Summary Buffer -@cindex summary exit -@cindex exiting groups - -Exiting from the summary buffer will normally update all info on the -group and return you to the group buffer. - -@table @kbd - -@item Z Z -@itemx q -@kindex Z Z (Summary) -@kindex q (Summary) -@findex gnus-summary-exit -@vindex gnus-summary-exit-hook -@vindex gnus-summary-prepare-exit-hook -@c @icon{gnus-summary-exit} -Exit the current group and update all information on the group -(@code{gnus-summary-exit}). @code{gnus-summary-prepare-exit-hook} is -called before doing much of the exiting, which calls -@code{gnus-summary-expire-articles} by default. -@code{gnus-summary-exit-hook} is called after finishing the exit -process. @code{gnus-group-no-more-groups-hook} is run when returning to -group mode having no more (unread) groups. - -@item Z E -@itemx Q -@kindex Z E (Summary) -@kindex Q (Summary) -@findex gnus-summary-exit-no-update -Exit the current group without updating any information on the group -(@code{gnus-summary-exit-no-update}). - -@item Z c -@itemx c -@kindex Z c (Summary) -@kindex c (Summary) -@findex gnus-summary-catchup-and-exit -@c @icon{gnus-summary-catchup-and-exit} -Mark all unticked articles in the group as read and then exit -(@code{gnus-summary-catchup-and-exit}). - -@item Z C -@kindex Z C (Summary) -@findex gnus-summary-catchup-all-and-exit -Mark all articles, even the ticked ones, as read and then exit -(@code{gnus-summary-catchup-all-and-exit}). - -@item Z n -@kindex Z n (Summary) -@findex gnus-summary-catchup-and-goto-next-group -Mark all articles as read and go to the next group -(@code{gnus-summary-catchup-and-goto-next-group}). - -@item Z R -@kindex Z R (Summary) -@findex gnus-summary-reselect-current-group -Exit this group, and then enter it again -(@code{gnus-summary-reselect-current-group}). If given a prefix, select -all articles, both read and unread. - -@item Z G -@itemx M-g -@kindex Z G (Summary) -@kindex M-g (Summary) -@findex gnus-summary-rescan-group -@c @icon{gnus-summary-mail-get} -Exit the group, check for new articles in the group, and select the -group (@code{gnus-summary-rescan-group}). If given a prefix, select all -articles, both read and unread. - -@item Z N -@kindex Z N (Summary) -@findex gnus-summary-next-group -Exit the group and go to the next group -(@code{gnus-summary-next-group}). - -@item Z P -@kindex Z P (Summary) -@findex gnus-summary-prev-group -Exit the group and go to the previous group -(@code{gnus-summary-prev-group}). - -@item Z s -@kindex Z s (Summary) -@findex gnus-summary-save-newsrc -Save the current number of read/marked articles in the dribble buffer -and then save the dribble buffer (@code{gnus-summary-save-newsrc}). If -given a prefix, also save the @file{.newsrc} file(s). Using this -command will make exit without updating (the @kbd{Q} command) worthless. -@end table - -@vindex gnus-exit-group-hook -@code{gnus-exit-group-hook} is called when you exit the current -group. - -@findex gnus-summary-wake-up-the-dead -@findex gnus-dead-summary-mode -@vindex gnus-kill-summary-on-exit -If you're in the habit of exiting groups, and then changing your mind -about it, you might set @code{gnus-kill-summary-on-exit} to @code{nil}. -If you do that, Gnus won't kill the summary buffer when you exit it. -(Quelle surprise!) Instead it will change the name of the buffer to -something like @samp{*Dead Summary ... *} and install a minor mode -called @code{gnus-dead-summary-mode}. Now, if you switch back to this -buffer, you'll find that all keys are mapped to a function called -@code{gnus-summary-wake-up-the-dead}. So tapping any keys in a dead -summary buffer will result in a live, normal summary buffer. - -There will never be more than one dead summary buffer at any one time. - -@vindex gnus-use-cross-reference -The data on the current group will be updated (which articles you have -read, which articles you have replied to, etc.) when you exit the -summary buffer. If the @code{gnus-use-cross-reference} variable is -@code{t} (which is the default), articles that are cross-referenced to -this group and are marked as read, will also be marked as read in the -other subscribed groups they were cross-posted to. If this variable is -neither @code{nil} nor @code{t}, the article will be marked as read in -both subscribed and unsubscribed groups (@pxref{Crosspost Handling}). - - -@node Crosspost Handling -@section Crosspost Handling - -@cindex velveeta -@cindex spamming -Marking cross-posted articles as read ensures that you'll never have to -read the same article more than once. Unless, of course, somebody has -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}). - -Remember: Cross-posting is kinda ok, but posting the same article -separately to several groups is not. Massive cross-posting (aka. -@dfn{velveeta}) is to be avoided at all costs, and you can even use the -@code{gnus-summary-mail-crosspost-complaint} command to complain about -excessive crossposting (@pxref{Summary Mail Commands}). - -@cindex cross-posting -@cindex Xref -@cindex @sc{nov} -One thing that may cause Gnus to not do the cross-posting thing -correctly is if you use an @sc{nntp} server that supports @sc{xover} -(which is very nice, because it speeds things up considerably) which -does not include the @code{Xref} header in its @sc{nov} lines. This is -Evil, but all too common, alas, alack. Gnus tries to Do The Right Thing -even with @sc{xover} by registering the @code{Xref} lines of all -articles you actually read, but if you kill the articles, or just mark -them as read without reading them, Gnus will not get a chance to snoop -the @code{Xref} lines out of these articles, and will be unable to use -the cross reference mechanism. - -@cindex LIST overview.fmt -@cindex overview.fmt -To check whether your @sc{nntp} server includes the @code{Xref} header -in its overview files, try @samp{telnet your.nntp.server nntp}, -@samp{MODE READER} on @code{inn} servers, and then say @samp{LIST -overview.fmt}. This may not work, but if it does, and the last line you -get does not read @samp{Xref:full}, then you should shout and whine at -your news admin until she includes the @code{Xref} header in the -overview files. - -@vindex gnus-nov-is-evil -If you want Gnus to get the @code{Xref}s right all the time, you have to -set @code{gnus-nov-is-evil} to @code{t}, which slows things down -considerably. - -C'est la vie. - -For an alternative approach, @pxref{Duplicate Suppression}. - - -@node Duplicate Suppression -@section Duplicate Suppression - -By default, Gnus tries to make sure that you don't have to read the same -article more than once by utilizing the crossposting mechanism -(@pxref{Crosspost Handling}). However, that simple and efficient -approach may not work satisfactory for some users for various -reasons. - -@enumerate -@item -The @sc{nntp} server may fail to generate the @code{Xref} header. This -is evil and not very common. - -@item -The @sc{nntp} server may fail to include the @code{Xref} header in the -@file{.overview} data bases. This is evil and all too common, alas. - -@item -You may be reading the same group (or several related groups) from -different @sc{nntp} servers. - -@item -You may be getting mail that duplicates articles posted to groups. -@end enumerate - -I'm sure there are other situations where @code{Xref} handling fails as -well, but these four are the most common situations. - -If, and only if, @code{Xref} handling fails for you, then you may -consider switching on @dfn{duplicate suppression}. If you do so, Gnus -will remember the @code{Message-ID}s of all articles you have read or -otherwise marked as read, and then, as if by magic, mark them as read -all subsequent times you see them---in @emph{all} groups. Using this -mechanism is quite likely to be somewhat inefficient, but not overly -so. It's certainly preferable to reading the same articles more than -once. - -Duplicate suppression is not a very subtle instrument. It's more like a -sledge hammer than anything else. It works in a very simple -fashion---if you have marked an article as read, it adds this Message-ID -to a cache. The next time it sees this Message-ID, it will mark the -article as read with the @samp{M} mark. It doesn't care what group it -saw the article in. - -@table @code -@item gnus-suppress-duplicates -@vindex gnus-suppress-duplicates -If non-@code{nil}, suppress duplicates. - -@item gnus-save-duplicate-list -@vindex gnus-save-duplicate-list -If non-@code{nil}, save the list of duplicates to a file. This will -make startup and shutdown take longer, so the default is @code{nil}. -However, this means that only duplicate articles read in a single Gnus -session are suppressed. - -@item gnus-duplicate-list-length -@vindex gnus-duplicate-list-length -This variable says how many @code{Message-ID}s to keep in the duplicate -suppression list. The default is 10000. - -@item gnus-duplicate-file -@vindex gnus-duplicate-file -The name of the file to store the duplicate suppression list in. The -default is @file{~/News/suppression}. -@end table - -If you have a tendency to stop and start Gnus often, setting -@code{gnus-save-duplicate-list} to @code{t} is probably a good idea. If -you leave Gnus running for weeks on end, you may have it @code{nil}. On -the other hand, saving the list makes startup and shutdown much slower, -so that means that if you stop and start Gnus often, you should set -@code{gnus-save-duplicate-list} to @code{nil}. Uhm. I'll leave this up -to you to figure out, I think. - - -@node The Article Buffer -@chapter The Article Buffer -@cindex article buffer - -The articles are displayed in the article buffer, of which there is only -one. All the summary buffers share the same article buffer unless you -tell Gnus otherwise. - -@menu -* Hiding Headers:: Deciding what headers should be displayed. -* Using MIME:: Pushing articles through @sc{mime} before reading them. -* Customizing Articles:: Tailoring the look of the articles. -* Article Keymap:: Keystrokes available in the article buffer. -* Misc Article:: Other stuff. -@end menu - - -@node Hiding Headers -@section Hiding Headers -@cindex hiding headers -@cindex deleting headers - -The top section of each article is the @dfn{head}. (The rest is the -@dfn{body}, but you may have guessed that already.) - -@vindex gnus-show-all-headers -There is a lot of useful information in the head: the name of the person -who wrote the article, the date it was written and the subject of the -article. That's well and nice, but there's also lots of information -most people do not want to see---what systems the article has passed -through before reaching you, the @code{Message-ID}, the -@code{References}, etc. ad nauseum---and you'll probably want to get rid -of some of those lines. If you want to keep all those lines in the -article buffer, you can set @code{gnus-show-all-headers} to @code{t}. - -Gnus provides you with two variables for sifting headers: - -@table @code - -@item gnus-visible-headers -@vindex gnus-visible-headers -If this variable is non-@code{nil}, it should be a regular expression -that says what headers you wish to keep in the article buffer. All -headers that do not match this variable will be hidden. - -For instance, if you only want to see the name of the person who wrote -the article and the subject, you'd say: - -@lisp -(setq gnus-visible-headers "^From:\\|^Subject:") -@end lisp - -This variable can also be a list of regexps to match headers to -remain visible. - -@item gnus-ignored-headers -@vindex gnus-ignored-headers -This variable is the reverse of @code{gnus-visible-headers}. If this -variable is set (and @code{gnus-visible-headers} is @code{nil}), it -should be a regular expression that matches all lines that you want to -hide. All lines that do not match this variable will remain visible. - -For instance, if you just want to get rid of the @code{References} line -and the @code{Xref} line, you might say: - -@lisp -(setq gnus-ignored-headers "^References:\\|^Xref:") -@end lisp - -This variable can also be a list of regexps to match headers to -be removed. - -Note that if @code{gnus-visible-headers} is non-@code{nil}, this -variable will have no effect. - -@end table - -@vindex gnus-sorted-header-list -Gnus can also sort the headers for you. (It does this by default.) You -can control the sorting by setting the @code{gnus-sorted-header-list} -variable. It is a list of regular expressions that says in what order -the headers are to be displayed. - -For instance, if you want the name of the author of the article first, -and then the subject, you might say something like: - -@lisp -(setq gnus-sorted-header-list '("^From:" "^Subject:")) -@end lisp - -Any headers that are to remain visible, but are not listed in this -variable, will be displayed in random order after all the headers listed in this variable. - -@findex gnus-article-hide-boring-headers -@vindex gnus-article-display-hook -@vindex gnus-boring-article-headers -You can hide further boring headers by entering -@code{gnus-article-hide-boring-headers} into -@code{gnus-article-display-hook}. What this function does depends on -the @code{gnus-boring-article-headers} variable. It's a list, but this -list doesn't actually contain header names. Instead is lists various -@dfn{boring conditions} that Gnus can check and remove from sight. - -These conditions are: -@table @code -@item empty -Remove all empty headers. -@item newsgroups -Remove the @code{Newsgroups} header if it only contains the current group -name. -@item followup-to -Remove the @code{Followup-To} header if it is identical to the -@code{Newsgroups} header. -@item reply-to -Remove the @code{Reply-To} header if it lists the same address as the -@code{From} header. -@item date -Remove the @code{Date} header if the article is less than three days -old. -@end table - -To include the four first elements, you could say something like; - -@lisp -(setq gnus-boring-article-headers - '(empty newsgroups followup-to reply-to)) -@end lisp - -This is also the default value for this variable. - - -@node Using MIME -@section Using @sc{mime} -@cindex @sc{mime} - -Mime is a standard for waving your hands through the air, aimlessly, -while people stand around yawning. - -@sc{mime}, however, is a standard for encoding your articles, aimlessly, -while all newsreaders die of fear. - -@sc{mime} may specify what character set the article uses, the encoding -of the characters, and it also makes it possible to embed pictures and -other naughty stuff in innocent-looking articles. - -@vindex gnus-show-mime -@vindex gnus-show-mime-method -@vindex gnus-strict-mime -@findex metamail-buffer -Gnus handles @sc{mime} by pushing the articles through -@code{gnus-show-mime-method}, which is @code{metamail-buffer} by -default. Set @code{gnus-show-mime} to @code{t} if you want to use -@sc{mime} all the time. However, if @code{gnus-strict-mime} is -non-@code{nil}, the @sc{mime} method will only be used if there are -@sc{mime} headers in the article. If you have @code{gnus-show-mime} -set, then you'll see some unfortunate display glitches in the article -buffer. These can't be avoided. - -It might be best to just use the toggling functions from the summary -buffer to avoid getting nasty surprises. (For instance, you enter the -group @samp{alt.sing-a-long} and, before you know it, @sc{mime} has -decoded the sound file in the article and some horrible sing-a-long song -comes screaming out your speakers, and you can't find the volume -button, because there isn't one, and people are starting to look at you, -and you try to stop the program, but you can't, and you can't find the -program to control the volume, and everybody else in the room suddenly -decides to look at you disdainfully, and you'll feel rather stupid.) - -Any similarity to real events and people is purely coincidental. Ahem. - - -@node Customizing Articles -@section Customizing Articles -@cindex article customization - -@vindex gnus-article-display-hook -The @code{gnus-article-display-hook} is called after the article has -been inserted into the article buffer. It is meant to handle all -treatment of the article before it is displayed. - -@findex gnus-article-maybe-highlight -By default this hook just contains @code{gnus-article-hide-headers}, -@code{gnus-article-treat-overstrike}, and -@code{gnus-article-maybe-highlight}, but there are thousands, nay -millions, of functions you can put in this hook. For an overview of -functions @pxref{Article Highlighting}, @pxref{Article Hiding}, -@pxref{Article Washing}, @pxref{Article Buttons} and @pxref{Article -Date}. Note that the order of functions in this hook might affect -things, so you may have to fiddle a bit to get the desired results. - -You can, of course, write your own functions. The functions are called -from the article buffer, and you can do anything you like, pretty much. -There is no information that you have to keep in the buffer---you can -change everything. However, you shouldn't delete any headers. Instead -make them invisible if you want to make them go away. - - -@node Article Keymap -@section Article Keymap - -Most of the keystrokes in the summary buffer can also be used in the -article buffer. They should behave as if you typed them in the summary -buffer, which means that you don't actually have to have a summary -buffer displayed while reading. You can do it all from the article -buffer. - -A few additional keystrokes are available: - -@table @kbd - -@item SPACE -@kindex SPACE (Article) -@findex gnus-article-next-page -Scroll forwards one page (@code{gnus-article-next-page}). - -@item DEL -@kindex DEL (Article) -@findex gnus-article-prev-page -Scroll backwards one page (@code{gnus-article-prev-page}). - -@item C-c ^ -@kindex C-c ^ (Article) -@findex gnus-article-refer-article -If point is in the neighborhood of a @code{Message-ID} and you press -@kbd{r}, Gnus will try to get that article from the server -(@code{gnus-article-refer-article}). - -@item C-c C-m -@kindex C-c C-m (Article) -@findex gnus-article-mail -Send a reply to the address near point (@code{gnus-article-mail}). If -given a prefix, include the mail. - -@item s -@kindex s (Article) -@findex gnus-article-show-summary -Reconfigure the buffers so that the summary buffer becomes visible -(@code{gnus-article-show-summary}). - -@item ? -@kindex ? (Article) -@findex gnus-article-describe-briefly -Give a very brief description of the available keystrokes -(@code{gnus-article-describe-briefly}). - -@item TAB -@kindex TAB (Article) -@findex gnus-article-next-button -Go to the next button, if any (@code{gnus-article-next-button}). This -only makes sense if you have buttonizing turned on. - -@item M-TAB -@kindex M-TAB (Article) -@findex gnus-article-prev-button -Go to the previous button, if any (@code{gnus-article-prev-button}). - -@end table - - -@node Misc Article -@section Misc Article - -@table @code - -@item gnus-single-article-buffer -@vindex gnus-single-article-buffer -If non-@code{nil}, use the same article buffer for all the groups. -(This is the default.) If @code{nil}, each group will have its own -article buffer. - -@vindex gnus-article-prepare-hook -@item gnus-article-prepare-hook -This hook is called right after the article has been inserted into the -article buffer. It is mainly intended for functions that do something -depending on the contents; it should probably not be used for changing -the contents of the article buffer. - -@vindex gnus-article-display-hook -@item gnus-article-display-hook -This hook is called as the last thing when displaying an article, and is -intended for modifying the contents of the buffer, doing highlights, -hiding headers, and the like. - -@item gnus-article-mode-hook -@vindex gnus-article-mode-hook -Hook called in article mode buffers. - -@item gnus-article-mode-syntax-table -@vindex gnus-article-mode-syntax-table -Syntax table used in article buffers. It is initialized from -@code{text-mode-syntax-table}. - -@vindex gnus-article-mode-line-format -@item gnus-article-mode-line-format -This variable is a format string along the same lines as -@code{gnus-summary-mode-line-format}. It accepts the same -format specifications as that variable, with one extension: - -@table @samp -@item w -The @dfn{wash status} of the article. This is a short string with one -character for each possible article wash operation that may have been -performed. -@end table - -@vindex gnus-break-pages - -@item gnus-break-pages -Controls whether @dfn{page breaking} is to take place. If this variable -is non-@code{nil}, the articles will be divided into pages whenever a -page delimiter appears in the article. If this variable is @code{nil}, -paging will not be done. - -@item gnus-page-delimiter -@vindex gnus-page-delimiter -This is the delimiter mentioned above. By default, it is @samp{^L} -(formfeed). -@end table - - -@node Composing Messages -@chapter Composing Messages -@cindex reply -@cindex followup -@cindex post - -@kindex C-c C-c (Post) -All commands for posting and mailing will put you in a message buffer -where you can edit the article all you like, before you send the article -by pressing @kbd{C-c C-c}. @xref{Top, , Top, message, The Message -Manual}. If you are in a foreign news group, and you wish to post the -article using the foreign server, you can give a prefix to @kbd{C-c C-c} -to make Gnus try to post using the foreign server. - -@menu -* Mail:: Mailing and replying. -* Post:: Posting and following up. -* Posting Server:: What server should you post via? -* Mail and Post:: Mailing and posting at the same time. -* Archived Messages:: Where Gnus stores the messages you've sent. -@c * Posting Styles:: An easier way to configure some key elements. -@c * Drafts:: Postponing messages and rejected messages. -@c * Rejected Articles:: What happens if the server doesn't like your article? -@end menu - -Also see @pxref{Canceling and Superseding} for information on how to -remove articles you shouldn't have posted. - - -@node Mail -@section Mail - -Variables for customizing outgoing mail: - -@table @code -@item gnus-uu-digest-headers -@vindex gnus-uu-digest-headers -List of regexps to match headers included in digested messages. The -headers will be included in the sequence they are matched. - -@item gnus-add-to-list -@vindex gnus-add-to-list -If non-@code{nil}, add a @code{to-list} group parameter to mail groups -that have none when you do a @kbd{a}. - -@end table - - -@node Post -@section Post - -Variables for composing news articles: - -@table @code -@item gnus-sent-message-ids-file -@vindex gnus-sent-message-ids-file -Gnus will keep a @code{Message-ID} history file of all the mails it has -sent. If it discovers that it has already sent a mail, it will ask the -user whether to re-send the mail. (This is primarily useful when -dealing with @sc{soup} packets and the like where one is apt to send the -same packet multiple times.) This variable says what the name of this -history file is. It is @file{~/News/Sent-Message-IDs} by default. Set -this variable to @code{nil} if you don't want Gnus to keep a history -file. - -@item gnus-sent-message-ids-length -@vindex gnus-sent-message-ids-length -This variable says how many @code{Message-ID}s to keep in the history -file. It is 1000 by default. - -@end table - - -@node Posting Server -@section Posting Server - -When you press those magical @kbd{C-c C-c} keys to ship off your latest -(extremely intelligent, of course) article, where does it go? - -Thank you for asking. I hate you. - -@vindex gnus-post-method - -It can be quite complicated. Normally, Gnus will use the same native -server. However. If your native server doesn't allow posting, just -reading, you probably want to use some other server to post your -(extremely intelligent and fabulously interesting) articles. You can -then set the @code{gnus-post-method} to some other method: - -@lisp -(setq gnus-post-method '(nnspool "")) -@end lisp - -Now, if you've done this, and then this server rejects your article, or -this server is down, what do you do then? To override this variable you -can use a non-zero prefix to the @kbd{C-c C-c} command to force using -the ``current'' server for posting. - -If you give a zero prefix (i.e., @kbd{C-u 0 C-c C-c}) to that command, -Gnus will prompt you for what method to use for posting. - -You can also set @code{gnus-post-method} to a list of select methods. -If that's the case, Gnus will always prompt you for what method to use -for posting. - - -@node Mail and Post -@section Mail and Post - -Here's a list of variables relevant to both mailing and -posting: - -@table @code -@item gnus-mailing-list-groups -@findex gnus-mailing-list-groups -@cindex mailing lists - -If your news server offers groups that are really mailing lists -gatewayed to the @sc{nntp} server, you can read those groups without -problems, but you can't post/followup to them without some difficulty. -One solution is to add a @code{to-address} to the group parameters -(@pxref{Group Parameters}). An easier thing to do is set the -@code{gnus-mailing-list-groups} to a regexp that matches the groups that -really are mailing lists. Then, at least, followups to the mailing -lists will work most of the time. Posting to these groups (@kbd{a}) is -still a pain, though. - -@end table - -You may want to do spell-checking on messages that you send out. Or, if -you don't want to spell-check by hand, you could add automatic -spell-checking via the @code{ispell} package: - -@cindex ispell -@findex ispell-message -@lisp -(add-hook 'message-send-hook 'ispell-message) -@end lisp - - -@node Archived Messages -@section Archived Messages -@cindex archived messages -@cindex sent messages - -Gnus provides a few different methods for storing the mail and news you -send. The default method is to use the @dfn{archive virtual server} to -store the messages. If you want to disable this completely, the -@code{gnus-message-archive-group} variable should be @code{nil}, which -is the default. - -@vindex gnus-message-archive-method -@code{gnus-message-archive-method} says what virtual server Gnus is to -use to store sent messages. The default is: - -@lisp -(nnfolder "archive" - (nnfolder-directory "~/Mail/archive/")) -@end lisp - -You can, however, use any mail select method (@code{nnml}, -@code{nnmbox}, etc.). @code{nnfolder} is a quite likeable select method -for doing this sort of thing, though. If you don't like the default -directory chosen, you could say something like: - -@lisp -(setq gnus-message-archive-method - '(nnfolder "archive" - (nnfolder-inhibit-expiry t) - (nnfolder-active-file "~/News/sent-mail/active") - (nnfolder-directory "~/News/sent-mail/"))) -@end lisp - -@vindex gnus-message-archive-group -@cindex Gcc -Gnus will insert @code{Gcc} headers in all outgoing messages that point -to one or more group(s) on that server. Which group to use is -determined by the @code{gnus-message-archive-group} variable. - -This variable can be used to do the following: - -@itemize @bullet -@item a string -Messages will be saved in that group. -@item a list of strings -Messages will be saved in all those groups. -@item an alist of regexps, functions and forms -When a key ``matches'', the result is used. -@item @code{nil} -No message archiving will take place. This is the default. -@end itemize - -Let's illustrate: - -Just saving to a single group called @samp{MisK}: -@lisp -(setq gnus-message-archive-group "MisK") -@end lisp - -Saving to two groups, @samp{MisK} and @samp{safe}: -@lisp -(setq gnus-message-archive-group '("MisK" "safe")) -@end lisp - -Save to different groups based on what group you are in: -@lisp -(setq gnus-message-archive-group - '(("^alt" "sent-to-alt") - ("mail" "sent-to-mail") - (".*" "sent-to-misc"))) -@end lisp - -More complex stuff: -@lisp -(setq gnus-message-archive-group - '((if (message-news-p) - "misc-news" - "misc-mail"))) -@end lisp - -How about storing all news messages in one file, but storing all mail -messages in one file per month: - -@lisp -(setq gnus-message-archive-group - '((if (message-news-p) - "misc-news" - (concat "mail." (format-time-string - "%Y-%m" (current-time)))))) -@end lisp - -(XEmacs 19.13 doesn't have @code{format-time-string}, so you'll have to -use a different value for @code{gnus-message-archive-group} there.) - -Now, when you send a message off, it will be stored in the appropriate -group. (If you want to disable storing for just one particular message, -you can just remove the @code{Gcc} header that has been inserted.) The -archive group will appear in the group buffer the next time you start -Gnus, or the next time you press @kbd{F} in the group buffer. You can -enter it and read the articles in it just like you'd read any other -group. If the group gets really big and annoying, you can simply rename -if (using @kbd{G r} in the group buffer) to something -nice---@samp{misc-mail-september-1995}, or whatever. New messages will -continue to be stored in the old (now empty) group. - -That's the default method of archiving sent messages. Gnus offers a -different way for the people who don't like the default method. In that -case you should set @code{gnus-message-archive-group} to @code{nil}; -this will disable archiving. - -@table @code -@item gnus-outgoing-message-group -@vindex gnus-outgoing-message-group -All outgoing messages will be put in this group. If you want to store -all your outgoing mail and articles in the group @samp{nnml:archive}, -you set this variable to that value. This variable can also be a list of -group names. - -If you want to have greater control over what group to put each -message in, you can set this variable to a function that checks the -current newsgroup name and then returns a suitable group name (or list -of names). - -This variable can be used instead of @code{gnus-message-archive-group}, -but the latter is the preferred method. -@end table - - -@c @node Posting Styles -@c @section Posting Styles -@c @cindex posting styles -@c @cindex styles -@c -@c All them variables, they make my head swim. -@c -@c So what if you want a different @code{Organization} and signature based -@c on what groups you post to? And you post both from your home machine -@c and your work machine, and you want different @code{From} lines, and so -@c on? -@c -@c @vindex gnus-posting-styles -@c One way to do stuff like that is to write clever hooks that change the -@c variables you need to have changed. That's a bit boring, so somebody -@c came up with the bright idea of letting the user specify these things in -@c a handy alist. Here's an example of a @code{gnus-posting-styles} -@c variable: -@c -@c @lisp -@c ((".*" -@c (signature . "Peace and happiness") -@c (organization . "What me?")) -@c ("^comp" -@c (signature . "Death to everybody")) -@c ("comp.emacs.i-love-it" -@c (organization . "Emacs is it"))) -@c @end lisp -@c -@c As you might surmise from this example, this alist consists of several -@c @dfn{styles}. Each style will be applicable if the first element -@c ``matches'', in some form or other. The entire alist will be iterated -@c over, from the beginning towards the end, and each match will be -@c applied, which means that attributes in later styles that match override -@c the same attributes in earlier matching styles. So -@c @samp{comp.programming.literate} will have the @samp{Death to everybody} -@c signature and the @samp{What me?} @code{Organization} header. -@c -@c The first element in each style is called the @code{match}. If it's a -@c string, then Gnus will try to regexp match it against the group name. -@c If it's a function symbol, that function will be called with no -@c arguments. If it's a variable symbol, then the variable will be -@c referenced. If it's a list, then that list will be @code{eval}ed. In -@c any case, if this returns a non-@code{nil} value, then the style is said -@c to @dfn{match}. -@c -@c Each style may contain a arbitrary amount of @dfn{attributes}. Each -@c attribute consists of a @var{(name . value)} pair. The attribute name -@c can be one of @code{signature}, @code{organization} or @code{from}. The -@c attribute name can also be a string. In that case, this will be used as -@c a header name, and the value will be inserted in the headers of the -@c article. -@c -@c The attribute value can be a string (used verbatim), a function (the -@c return value will be used), a variable (its value will be used) or a -@c list (it will be @code{eval}ed and the return value will be used). -@c -@c So here's a new example: -@c -@c @lisp -@c (setq gnus-posting-styles -@c '((".*" -@c (signature . "~/.signature") -@c (from . "user@@foo (user)") -@c ("X-Home-Page" . (getenv "WWW_HOME")) -@c (organization . "People's Front Against MWM")) -@c ("^rec.humor" -@c (signature . my-funny-signature-randomizer)) -@c ((equal (system-name) "gnarly") -@c (signature . my-quote-randomizer)) -@c (posting-from-work-p -@c (signature . "~/.work-signature") -@c (from . "user@@bar.foo (user)") -@c (organization . "Important Work, Inc")) -@c ("^nn.+:" -@c (signature . "~/.mail-signature")))) -@c @end lisp - -@c @node Drafts -@c @section Drafts -@c @cindex drafts -@c -@c If you are writing a message (mail or news) and suddenly remember that -@c you have a steak in the oven (or some pesto in the food processor, you -@c craazy vegetarians), you'll probably wish there was a method to save the -@c message you are writing so that you can continue editing it some other -@c day, and send it when you feel its finished. -@c -@c Well, don't worry about it. Whenever you start composing a message of -@c some sort using the Gnus mail and post commands, the buffer you get will -@c automatically associate to an article in a special @dfn{draft} group. -@c If you save the buffer the normal way (@kbd{C-x C-s}, for instance), the -@c article will be saved there. (Auto-save files also go to the draft -@c group.) -@c -@c @cindex nndraft -@c @vindex gnus-draft-group-directory -@c The draft group is a special group (which is implemented as an -@c @code{nndraft} group, if you absolutely have to know) called -@c @samp{nndraft:drafts}. The variable @code{gnus-draft-group-directory} -@c controls both the name of the group and the location---the leaf element -@c in the path will be used as the name of the group. What makes this -@c group special is that you can't tick any articles in it or mark any -@c articles as read---all articles in the group are permanently unread. -@c -@c If the group doesn't exist, it will be created and you'll be subscribed -@c to it. -@c -@c @findex gnus-dissociate-buffer-from-draft -@c @kindex C-c M-d (Mail) -@c @kindex C-c M-d (Post) -@c @findex gnus-associate-buffer-with-draft -@c @kindex C-c C-d (Mail) -@c @kindex C-c C-d (Post) -@c If you're writing some super-secret message that you later want to -@c encode with PGP before sending, you may wish to turn the auto-saving -@c (and association with the draft group) off. You never know who might be -@c interested in reading all your extremely valuable and terribly horrible -@c and interesting secrets. The @kbd{C-c M-d} -@c (@code{gnus-dissociate-buffer-from-draft}) command does that for you. -@c If you change your mind and want to turn the auto-saving back on again, -@c @kbd{C-c C-d} (@code{gnus-associate-buffer-with-draft} does that. -@c -@c @vindex gnus-use-draft -@c To leave association with the draft group off by default, set -@c @code{gnus-use-draft} to @code{nil}. It is @code{t} by default. -@c -@c @findex gnus-summary-send-draft -@c @kindex S D c (Summary) -@c When you want to continue editing the article, you simply enter the -@c draft group and push @kbd{S D c} (@code{gnus-summary-send-draft}) to do -@c that. You will be placed in a buffer where you left off. -@c -@c Rejected articles will also be put in this draft group (@pxref{Rejected -@c Articles}). -@c -@c @findex gnus-summary-send-all-drafts -@c If you have lots of rejected messages you want to post (or mail) without -@c doing further editing, you can use the @kbd{S D a} command -@c (@code{gnus-summary-send-all-drafts}). This command understands the -@c process/prefix convention (@pxref{Process/Prefix}). -@c -@c -@c @node Rejected Articles -@c @section Rejected Articles -@c @cindex rejected articles -@c -@c Sometimes a news server will reject an article. Perhaps the server -@c doesn't like your face. Perhaps it just feels miserable. Perhaps -@c @emph{there be demons}. Perhaps you have included too much cited text. -@c Perhaps the disk is full. Perhaps the server is down. -@c -@c These situations are, of course, totally beyond the control of Gnus. -@c (Gnus, of course, loves the way you look, always feels great, has angels -@c fluttering around inside of it, doesn't care about how much cited text -@c you include, never runs full and never goes down.) So Gnus saves these -@c articles until some later time when the server feels better. -@c -@c The rejected articles will automatically be put in a special draft group -@c (@pxref{Drafts}). When the server comes back up again, you'd then -@c typically enter that group and send all the articles off. -@c - -@node Select Methods -@chapter Select Methods -@cindex foreign groups -@cindex select methods - -A @dfn{foreign group} is a group not read by the usual (or -default) means. It could be, for instance, a group from a different -@sc{nntp} server, it could be a virtual group, or it could be your own -personal mail group. - -A foreign group (or any group, really) is specified by a @dfn{name} and -a @dfn{select method}. To take the latter first, a select method is a -list where the first element says what backend to use (e.g. @code{nntp}, -@code{nnspool}, @code{nnml}) and the second element is the @dfn{server -name}. There may be additional elements in the select method, where the -value may have special meaning for the backend in question. - -One could say that a select method defines a @dfn{virtual server}---so -we do just that (@pxref{The Server Buffer}). - -The @dfn{name} of the group is the name the backend will recognize the -group as. - -For instance, the group @samp{soc.motss} on the @sc{nntp} server -@samp{some.where.edu} will have the name @samp{soc.motss} and select -method @code{(nntp "some.where.edu")}. Gnus will call this group -@samp{nntp+some.where.edu:soc.motss}, even though the @code{nntp} -backend just knows this group as @samp{soc.motss}. - -The different methods all have their peculiarities, of course. - -@menu -* The Server Buffer:: Making and editing virtual servers. -* Getting News:: Reading USENET news with Gnus. -* Getting Mail:: Reading your personal mail with Gnus. -* Other Sources:: Reading directories, files, SOUP packets. -* Combined Groups:: Combining groups into one group. -@end menu - - -@node The Server Buffer -@section The Server Buffer - -Traditionally, a @dfn{server} is a machine or a piece of software that -one connects to, and then requests information from. Gnus does not -connect directly to any real servers, but does all transactions through -one backend or other. But that's just putting one layer more between -the actual media and Gnus, so we might just as well say that each -backend represents a virtual server. - -For instance, the @code{nntp} backend may be used to connect to several -different actual @sc{nntp} servers, or, perhaps, to many different ports -on the same actual @sc{nntp} server. You tell Gnus which backend to -use, and what parameters to set by specifying a @dfn{select method}. - -These select method specifications can sometimes become quite -complicated---say, for instance, that you want to read from the -@sc{nntp} server @samp{news.funet.fi} on port number 13, which -hangs if queried for @sc{nov} headers and has a buggy select. Ahem. -Anyways, if you had to specify that for each group that used this -server, that would be too much work, so Gnus offers a way of naming -select methods, which is what you do in the server buffer. - -To enter the server buffer, use the @kbd{^} -(@code{gnus-group-enter-server-mode}) command in the group buffer. - -@menu -* Server Buffer Format:: You can customize the look of this buffer. -* Server Commands:: Commands to manipulate servers. -* Example Methods:: Examples server specifications. -* Creating a Virtual Server:: An example session. -* Server Variables:: Which variables to set. -* Servers and Methods:: You can use server names as select methods. -* Unavailable Servers:: Some servers you try to contact may be down. -@end menu - -@vindex gnus-server-mode-hook -@code{gnus-server-mode-hook} is run when creating the server buffer. - - -@node Server Buffer Format -@subsection Server Buffer Format -@cindex server buffer format - -@vindex gnus-server-line-format -You can change the look of the server buffer lines by changing the -@code{gnus-server-line-format} variable. This is a @code{format}-like -variable, with some simple extensions: - -@table @samp - -@item h -How the news is fetched---the backend name. - -@item n -The name of this server. - -@item w -Where the news is to be fetched from---the address. - -@item s -The opened/closed/denied status of the server. -@end table - -@vindex gnus-server-mode-line-format -The mode line can also be customized by using the -@code{gnus-server-mode-line-format} variable. The following specs are -understood: - -@table @samp -@item S -Server name. - -@item M -Server method. -@end table - -Also @pxref{Formatting Variables}. - - -@node Server Commands -@subsection Server Commands -@cindex server commands - -@table @kbd - -@item a -@kindex a (Server) -@findex gnus-server-add-server -Add a new server (@code{gnus-server-add-server}). - -@item e -@kindex e (Server) -@findex gnus-server-edit-server -Edit a server (@code{gnus-server-edit-server}). - -@item SPACE -@kindex SPACE (Server) -@findex gnus-server-read-server -Browse the current server (@code{gnus-server-read-server}). - -@item q -@kindex q (Server) -@findex gnus-server-exit -Return to the group buffer (@code{gnus-server-exit}). - -@item k -@kindex k (Server) -@findex gnus-server-kill-server -Kill the current server (@code{gnus-server-kill-server}). - -@item y -@kindex y (Server) -@findex gnus-server-yank-server -Yank the previously killed server (@code{gnus-server-yank-server}). - -@item c -@kindex c (Server) -@findex gnus-server-copy-server -Copy the current server (@code{gnus-server-copy-server}). - -@item l -@kindex l (Server) -@findex gnus-server-list-servers -List all servers (@code{gnus-server-list-servers}). - -@item s -@kindex s (Server) -@findex gnus-server-scan-server -Request that the server scan its sources for new articles -(@code{gnus-server-scan-server}). This is mainly sensible with mail -servers. - -@item g -@kindex g (Server) -@findex gnus-server-regenerate-server -Request that the server regenerate all its data structures -(@code{gnus-server-regenerate-server}). This can be useful if you have -a mail backend that has gotten out of synch. - -@end table - - -@node Example Methods -@subsection Example Methods - -Most select methods are pretty simple and self-explanatory: - -@lisp -(nntp "news.funet.fi") -@end lisp - -Reading directly from the spool is even simpler: - -@lisp -(nnspool "") -@end lisp - -As you can see, the first element in a select method is the name of the -backend, and the second is the @dfn{address}, or @dfn{name}, if you -will. - -After these two elements, there may be an arbitrary number of -@var{(variable form)} pairs. - -To go back to the first example---imagine that you want to read from -port 15 on that machine. This is what the select method should -look like then: - -@lisp -(nntp "news.funet.fi" (nntp-port-number 15)) -@end lisp - -You should read the documentation to each backend to find out what -variables are relevant, but here's an @code{nnmh} example: - -@code{nnmh} is a mail backend that reads a spool-like structure. Say -you have two structures that you wish to access: One is your private -mail spool, and the other is a public one. Here's the possible spec for -your private mail: - -@lisp -(nnmh "private" (nnmh-directory "~/private/mail/")) -@end lisp - -(This server is then called @samp{private}, but you may have guessed -that.) - -Here's the method for a public spool: - -@lisp -(nnmh "public" - (nnmh-directory "/usr/information/spool/") - (nnmh-get-new-mail nil)) -@end lisp - -If you are behind a firewall and only have access to the @sc{nntp} -server from the firewall machine, you can instruct Gnus to @code{rlogin} -on the firewall machine and telnet from there to the @sc{nntp} server. -Doing this can be rather fiddly, but your virtual server definition -should probably look something like this: - -@lisp -(nntp "firewall" - (nntp-address "the.firewall.machine") - (nntp-open-connection-function nntp-open-rlogin) - (nntp-end-of-line "\n") - (nntp-rlogin-parameters - ("telnet" "the.real.nntp.host" "nntp"))) -@end lisp - - - -@node Creating a Virtual Server -@subsection Creating a Virtual Server - -If you're saving lots of articles in the cache by using persistent -articles, you may want to create a virtual server to read the cache. - -First you need to add a new server. The @kbd{a} command does that. It -would probably be best to use @code{nnspool} to read the cache. You -could also use @code{nnml} or @code{nnmh}, though. - -Type @kbd{a nnspool RET cache RET}. - -You should now have a brand new @code{nnspool} virtual server called -@samp{cache}. You now need to edit it to have the right definitions. -Type @kbd{e} to edit the server. You'll be entered into a buffer that -will contain the following: - -@lisp -(nnspool "cache") -@end lisp - -Change that to: - -@lisp -(nnspool "cache" - (nnspool-spool-directory "~/News/cache/") - (nnspool-nov-directory "~/News/cache/") - (nnspool-active-file "~/News/cache/active")) -@end lisp - -Type @kbd{C-c C-c} to return to the server buffer. If you now press -@kbd{RET} over this virtual server, you should be entered into a browse -buffer, and you should be able to enter any of the groups displayed. - - -@node Server Variables -@subsection Server Variables - -One sticky point when defining variables (both on backends and in Emacs -in general) is that some variables are typically initialized from other -variables when the definition of the variables is being loaded. If you -change the "base" variable after the variables have been loaded, you -won't change the "derived" variables. - -This typically affects directory and file variables. For instance, -@code{nnml-directory} is @file{~/Mail/} by default, and all @code{nnml} -directory variables are initialized from that variable, so -@code{nnml-active-file} will be @file{~/Mail/active}. If you define a -new virtual @code{nnml} server, it will @emph{not} suffice to set just -@code{nnml-directory}---you have to explicitly set all the file -variables to be what you want them to be. For a complete list of -variables for each backend, see each backend's section later in this -manual, but here's an example @code{nnml} definition: - -@lisp -(nnml "public" - (nnml-directory "~/my-mail/") - (nnml-active-file "~/my-mail/active") - (nnml-newsgroups-file "~/my-mail/newsgroups")) -@end lisp - - -@node Servers and Methods -@subsection Servers and Methods - -Wherever you would normally use a select method -(e.g. @code{gnus-secondary-select-method}, in the group select method, -when browsing a foreign server) you can use a virtual server name -instead. This could potentially save lots of typing. And it's nice all -over. - - -@node Unavailable Servers -@subsection Unavailable Servers - -If a server seems to be unreachable, Gnus will mark that server as -@code{denied}. That means that any subsequent attempt to make contact -with that server will just be ignored. ``It can't be opened,'' Gnus -will tell you, without making the least effort to see whether that is -actually the case or not. - -That might seem quite naughty, but it does make sense most of the time. -Let's say you have 10 groups subscribed to on server -@samp{nephelococcygia.com}. This server is located somewhere quite far -away from you and the machine is quite slow, so it takes 1 minute just -to find out that it refuses connection to you today. If Gnus were to -attempt to do that 10 times, you'd be quite annoyed, so Gnus won't -attempt to do that. Once it has gotten a single ``connection refused'', -it will regard that server as ``down''. - -So, what happens if the machine was only feeling unwell temporarily? -How do you test to see whether the machine has come up again? - -You jump to the server buffer (@pxref{The Server Buffer}) and poke it -with the following commands: - -@table @kbd - -@item O -@kindex O (Server) -@findex gnus-server-open-server -Try to establish connection to the server on the current line -(@code{gnus-server-open-server}). - -@item C -@kindex C (Server) -@findex gnus-server-close-server -Close the connection (if any) to the server -(@code{gnus-server-close-server}). - -@item D -@kindex D (Server) -@findex gnus-server-deny-server -Mark the current server as unreachable -(@code{gnus-server-deny-server}). - -@item M-o -@kindex M-o (Server) -@findex gnus-server-open-all-servers -Open the connections to all servers in the buffer -(@code{gnus-server-open-all-servers}). - -@item M-c -@kindex M-c (Server) -@findex gnus-server-close-all-servers -Close the connections to all servers in the buffer -(@code{gnus-server-close-all-servers}). - -@item R -@kindex R (Server) -@findex gnus-server-remove-denials -Remove all marks to whether Gnus was denied connection from any servers -(@code{gnus-server-remove-denials}). - -@end table - - -@node Getting News -@section Getting News -@cindex reading news -@cindex news backends - -A newsreader is normally used for reading news. Gnus currently provides -only two methods of getting news---it can read from an @sc{nntp} server, -or it can read from a local spool. - -@menu -* NNTP:: Reading news from an @sc{nntp} server. -* News Spool:: Reading news from the local spool. -@end menu - - -@node NNTP -@subsection @sc{nntp} -@cindex nntp - -Subscribing to a foreign group from an @sc{nntp} server is rather easy. -You just specify @code{nntp} as method and the address of the @sc{nntp} -server as the, uhm, address. - -If the @sc{nntp} server is located at a non-standard port, setting the -third element of the select method to this port number should allow you -to connect to the right port. You'll have to edit the group info for -that (@pxref{Foreign Groups}). - -The name of the foreign group can be the same as a native group. In -fact, you can subscribe to the same group from as many different servers -you feel like. There will be no name collisions. - -The following variables can be used to create a virtual @code{nntp} -server: - -@table @code - -@item nntp-server-opened-hook -@vindex nntp-server-opened-hook -@cindex @sc{mode reader} -@cindex authinfo -@cindex authentification -@cindex nntp authentification -@findex nntp-send-authinfo -@findex nntp-send-mode-reader -is run after a connection has been made. It can be used to send -commands to the @sc{nntp} server after it has been contacted. By -default it sends the command @code{MODE READER} to the server with the -@code{nntp-send-mode-reader} function. This function should always be -present in this hook. - -@item nntp-authinfo-function -@vindex nntp-authinfo-function -This function will be used to send @samp{AUTHINFO} to the @sc{nntp} -server. Available functions include: - -@table @code -@item nntp-send-authinfo -@findex nntp-send-authinfo -This function will use your current login name as the user name and will -prompt you for the password. This is the default. - -@item nntp-send-nosy-authinfo -@findex nntp-send-nosy-authinfo -This function will prompt you for both user name and password. - -@item nntp-send-authinfo-from-file -@findex nntp-send-authinfo-from-file -This function will use your current login name as the user name and will -read the @sc{nntp} password from @file{~/.nntp-authinfo}. -@end table - -@item nntp-server-action-alist -@vindex nntp-server-action-alist -This is a list of regexps to match on server types and actions to be -taken when matches are made. For instance, if you want Gnus to beep -every time you connect to innd, you could say something like: - -@lisp -(setq nntp-server-action-alist - '(("innd" (ding)))) -@end lisp - -You probably don't want to do that, though. - -The default value is - -@lisp - '(("nntpd 1\\.5\\.11t" - (remove-hook 'nntp-server-opened-hook nntp-send-mode-reader))) -@end lisp - -This ensures that Gnus doesn't send the @code{MODE READER} command to -nntpd 1.5.11t, since that command chokes that server, I've been told. - -@item nntp-maximum-request -@vindex nntp-maximum-request -If the @sc{nntp} server doesn't support @sc{nov} headers, this backend -will collect headers by sending a series of @code{head} commands. To -speed things up, the backend sends lots of these commands without -waiting for reply, and then reads all the replies. This is controlled -by the @code{nntp-maximum-request} variable, and is 400 by default. If -your network is buggy, you should set this to 1. - -@item nntp-connection-timeout -@vindex nntp-connection-timeout -If you have lots of foreign @code{nntp} groups that you connect to -regularly, you're sure to have problems with @sc{nntp} servers not -responding properly, or being too loaded to reply within reasonable -time. This is can lead to awkward problems, which can be helped -somewhat by setting @code{nntp-connection-timeout}. This is an integer -that says how many seconds the @code{nntp} backend should wait for a -connection before giving up. If it is @code{nil}, which is the default, -no timeouts are done. - -@item nntp-command-timeout -@vindex nntp-command-timeout -@cindex PPP connections -@cindex dynamic IP addresses -If you're running Gnus on a machine that has a dynamically assigned -address, Gnus may become confused. If the address of your machine -changes after connecting to the @sc{nntp} server, Gnus will simply sit -waiting forever for replies from the server. To help with this -unfortunate problem, you can set this command to a number. Gnus will -then, if it sits waiting for a reply from the server longer than that -number of seconds, shut down the connection, start a new one, and resend -the command. This should hopefully be transparent to the user. A -likely number is 30 seconds. - -@item nntp-retry-on-break -@vindex nntp-retry-on-break -If this variable is non-@code{nil}, you can also @kbd{C-g} if Gnus -hangs. This will have much the same effect as the command timeout -described above. - -@item nntp-server-hook -@vindex nntp-server-hook -This hook is run as the last step when connecting to an @sc{nntp} -server. - -@findex nntp-open-rlogin -@findex nntp-open-telnet -@findex nntp-open-network-stream -@item nntp-open-connection-function -@vindex nntp-open-connection-function -This function is used to connect to the remote system. Three pre-made -functions are @code{nntp-open-network-stream}, which is the default, and -simply connects to some port or other on the remote system. The other -two are @code{nntp-open-rlogin}, which does an @samp{rlogin} on the -remote system, and then does a @samp{telnet} to the @sc{nntp} server -available there, and @code{nntp-open-telnet}, which does a @samp{telnet} -to the remote system and then another @samp{telnet} to get to the -@sc{nntp} server. - -@code{nntp-open-rlogin}-related variables: - -@table @code - -@item nntp-rlogin-parameters -@vindex nntp-rlogin-parameters -This list will be used as the parameter list given to @code{rsh}. - -@item nntp-rlogin-user-name -@vindex nntp-rlogin-user-name -User name on the remote system. - -@end table - -@code{nntp-open-telnet}-related variables: - -@table @code -@item nntp-telnet-command -@vindex nntp-telnet-command -Command used to start @code{telnet}. - -@item nntp-telnet-switches -@vindex nntp-telnet-switches -List of strings to be used as the switches to the @code{telnet} command. - -@item nntp-telnet-user-name -@vindex nntp-telnet-user-name -User name for log in on the remote system. - -@item nntp-telnet-passwd -@vindex nntp-telnet-passwd -Password to use when logging in. - -@item nntp-telnet-parameters -@vindex nntp-telnet-parameters -A list of strings executed as a command after logging in -via @code{telnet}. - -@end table - -@item nntp-end-of-line -@vindex nntp-end-of-line -String to use as end-of-line marker when talking to the @sc{nntp} -server. This is @samp{\r\n} by default, but should be @samp{\n} when -using @code{rlogin} to talk to the server. - -@item nntp-rlogin-user-name -@vindex nntp-rlogin-user-name -User name on the remote system when using the @code{rlogin} connect -function. - -@item nntp-address -@vindex nntp-address -The address of the remote system running the @sc{nntp} server. - -@item nntp-port-number -@vindex nntp-port-number -Port number to connect to when using the @code{nntp-open-network-stream} -connect function. - -@item nntp-buggy-select -@vindex nntp-buggy-select -Set this to non-@code{nil} if your select routine is buggy. - -@item nntp-nov-is-evil -@vindex nntp-nov-is-evil -If the @sc{nntp} server does not support @sc{nov}, you could set this -variable to @code{t}, but @code{nntp} usually checks automatically whether @sc{nov} -can be used. - -@item nntp-xover-commands -@vindex nntp-xover-commands -@cindex nov -@cindex XOVER -List of strings used as commands to fetch @sc{nov} lines from a -server. The default value of this variable is @code{("XOVER" -"XOVERVIEW")}. - -@item nntp-nov-gap -@vindex nntp-nov-gap -@code{nntp} normally sends just one big request for @sc{nov} lines to -the server. The server responds with one huge list of lines. However, -if you have read articles 2-5000 in the group, and only want to read -article 1 and 5001, that means that @code{nntp} will fetch 4999 @sc{nov} -lines that you will not need. This variable says how -big a gap between two consecutive articles is allowed to be before the -@code{XOVER} request is split into several request. Note that if your -network is fast, setting this variable to a really small number means -that fetching will probably be slower. If this variable is @code{nil}, -@code{nntp} will never split requests. - -@item nntp-prepare-server-hook -@vindex nntp-prepare-server-hook -A hook run before attempting to connect to an @sc{nntp} server. - -@item nntp-warn-about-losing-connection -@vindex nntp-warn-about-losing-connection -If this variable is non-@code{nil}, some noise will be made when a -server closes connection. - -@end table - - -@node News Spool -@subsection News Spool -@cindex nnspool -@cindex news spool - -Subscribing to a foreign group from the local spool is extremely easy, -and might be useful, for instance, to speed up reading groups that -contain very big articles---@samp{alt.binaries.pictures.furniture}, for -instance. - -Anyways, you just specify @code{nnspool} as the method and @samp{} (or -anything else) as the address. - -If you have access to a local spool, you should probably use that as the -native select method (@pxref{Finding the News}). It is normally faster -than using an @code{nntp} select method, but might not be. It depends. -You just have to try to find out what's best at your site. - -@table @code - -@item nnspool-inews-program -@vindex nnspool-inews-program -Program used to post an article. - -@item nnspool-inews-switches -@vindex nnspool-inews-switches -Parameters given to the inews program when posting an article. - -@item nnspool-spool-directory -@vindex nnspool-spool-directory -Where @code{nnspool} looks for the articles. This is normally -@file{/usr/spool/news/}. - -@item nnspool-nov-directory -@vindex nnspool-nov-directory -Where @code{nnspool} will look for @sc{nov} files. This is normally -@file{/usr/spool/news/over.view/}. - -@item nnspool-lib-dir -@vindex nnspool-lib-dir -Where the news lib dir is (@file{/usr/lib/news/} by default). - -@item nnspool-active-file -@vindex nnspool-active-file -The path to the active file. - -@item nnspool-newsgroups-file -@vindex nnspool-newsgroups-file -The path to the group descriptions file. - -@item nnspool-history-file -@vindex nnspool-history-file -The path to the news history file. - -@item nnspool-active-times-file -@vindex nnspool-active-times-file -The path to the active date file. - -@item nnspool-nov-is-evil -@vindex nnspool-nov-is-evil -If non-@code{nil}, @code{nnspool} won't try to use any @sc{nov} files -that it finds. - -@item nnspool-sift-nov-with-sed -@vindex nnspool-sift-nov-with-sed -@cindex sed -If non-@code{nil}, which is the default, use @code{sed} to get the -relevant portion from the overview file. If nil, @code{nnspool} will -load the entire file into a buffer and process it there. - -@end table - - -@node Getting Mail -@section Getting Mail -@cindex reading mail -@cindex mail - -Reading mail with a newsreader---isn't that just plain WeIrD? But of -course. - -@menu -* Getting Started Reading Mail:: A simple cookbook example. -* Splitting Mail:: How to create mail groups. -* Mail Backend Variables:: Variables for customizing mail handling. -* Fancy Mail Splitting:: Gnus can do hairy splitting of incoming mail. -* Mail and Procmail:: Reading mail groups that procmail create. -* Incorporating Old Mail:: What about the old mail you have? -* Expiring Mail:: Getting rid of unwanted mail. -* Washing Mail:: Removing gruft from the mail you get. -* Duplicates:: Dealing with duplicated mail. -* Not Reading Mail:: Using mail backends for reading other files. -* Choosing a Mail Backend:: Gnus can read a variety of mail formats. -@end menu - - -@node Getting Started Reading Mail -@subsection Getting Started Reading Mail - -It's quite easy to use Gnus to read your new mail. You just plonk the -mail backend of your choice into @code{gnus-secondary-select-methods}, -and things will happen automatically. - -For instance, if you want to use @code{nnml} (which is a "one file per -mail" backend), you could put the following in your @file{.gnus} file: - -@lisp -(setq gnus-secondary-select-methods - '((nnml "private"))) -@end lisp - -Now, the next time you start Gnus, this backend will be queried for new -articles, and it will move all the messages in your spool file to its -directory, which is @code{~/Mail/} by default. The new group that will -be created (@samp{mail.misc}) will be subscribed, and you can read it -like any other group. - -You will probably want to split the mail into several groups, though: - -@lisp -(setq nnmail-split-methods - '(("junk" "^From:.*Lars Ingebrigtsen") - ("crazy" "^Subject:.*die\\|^Organization:.*flabby") - ("other" ""))) -@end lisp - -This will result in three new @code{nnml} mail groups being created: -@samp{nnml:junk}, @samp{nnml:crazy}, and @samp{nnml:other}. All the -mail that doesn't fit into the first two groups will be placed in the -last group. - -This should be sufficient for reading mail with Gnus. You might want to -give the other sections in this part of the manual a perusal, though. -Especially @pxref{Choosing a Mail Backend} and @pxref{Expiring Mail}. - - -@node Splitting Mail -@subsection Splitting Mail -@cindex splitting mail -@cindex mail splitting - -@vindex nnmail-split-methods -The @code{nnmail-split-methods} variable says how the incoming mail is -to be split into groups. - -@lisp -(setq nnmail-split-methods - '(("mail.junk" "^From:.*Lars Ingebrigtsen") - ("mail.crazy" "^Subject:.*die\\|^Organization:.*flabby") - ("mail.other" ""))) -@end lisp - -This variable is a list of lists, where the first element of each of -these lists is the name of the mail group (they do not have to be called -something beginning with @samp{mail}, by the way), and the second -element is a regular expression used on the header of each mail to -determine if it belongs in this mail group. - -If the first element is the special symbol @code{junk}, then messages -that match the regexp will disappear into the aether. Use with -extreme caution. - -The second element can also be a function. In that case, it will be -called narrowed to the headers with the first element of the rule as the -argument. It should return a non-@code{nil} value if it thinks that the -mail belongs in that group. - -The last of these groups should always be a general one, and the regular -expression should @emph{always} be @samp{} so that it matches any mails -that haven't been matched by any of the other regexps. (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".) - -If you like to tinker with this yourself, you can set this variable to a -function of your choice. This function will be called without any -arguments in a buffer narrowed to the headers of an incoming mail -message. The function should return a list of group names that it -thinks should carry this mail message. - -Note that the mail backends are free to maul the poor, innocent, -incoming headers all they want to. They all add @code{Lines} headers; -some add @code{X-Gnus-Group} headers; most rename the Unix mbox -@code{From} line to something else. - -@vindex nnmail-crosspost -The mail backends all support cross-posting. If several regexps match, -the mail will be ``cross-posted'' to all those groups. -@code{nnmail-crosspost} says whether to use this mechanism or not. Note -that no articles are crossposted to the general (@samp{}) group. - -@vindex nnmail-crosspost-link-function -@cindex crosspost -@cindex links -@code{nnmh} and @code{nnml} makes crossposts by creating hard links to -the crossposted articles. However, not all file systems support hard -links. If that's the case for you, set -@code{nnmail-crosspost-link-function} to @code{copy-file}. (This -variable is @code{add-name-to-file} by default.) - -@kindex M-x nnmail-split-history -@kindex nnmail-split-history -If you wish to see where the previous mail split put the messages, you -can use the @kbd{M-x nnmail-split-history} command. - -Gnus gives you all the opportunity you could possibly want for shooting -yourself in the foot. Let's say you create a group that will contain -all the mail you get from your boss. And then you accidentally -unsubscribe from the group. Gnus will still put all the mail from your -boss in the unsubscribed group, and so, when your boss mails you ``Have -that report ready by Monday or you're fired!'', you'll never see it and, -come Tuesday, you'll still believe that you're gainfully employed while -you really should be out collecting empty bottles to save up for next -month's rent money. - - -@node Mail Backend Variables -@subsection Mail Backend Variables - -These variables are (for the most part) pertinent to all the various -mail backends. - -@table @code -@vindex nnmail-read-incoming-hook -@item nnmail-read-incoming-hook -The mail backends all call this hook after reading new mail. You can -use this hook to notify any mail watch programs, if you want to. - -@vindex nnmail-spool-file -@item nnmail-spool-file -@cindex POP mail -@cindex MAILHOST -@cindex movemail -@vindex nnmail-pop-password -@vindex nnmail-pop-password-required -The backends will look for new mail in this file. If this variable is -@code{nil}, the mail backends will never attempt to fetch mail by -themselves. If you are using a POP mail server and your name is -@samp{larsi}, you should set this variable to @samp{po:larsi}. If -your name is not @samp{larsi}, you should probably modify that -slightly, but you may have guessed that already, you smart & handsome -devil! You can also set this variable to @code{pop}, and Gnus will try -to figure out the POP mail string by itself. In any case, Gnus will -call @code{movemail} which will contact the POP server named in the -@code{MAILHOST} environment variable. If the POP server needs a -password, you can either set @code{nnmail-pop-password-required} to -@code{t} and be prompted for the password, or set -@code{nnmail-pop-password} to the password itself. - -@code{nnmail-spool-file} can also be a list of mailboxes. - -Your Emacs has to have been configured with @samp{--with-pop} before -compilation. This is the default, but some installations have it -switched off. - -When you use a mail backend, Gnus will slurp all your mail from your -inbox and plonk it down in your home directory. Gnus doesn't move any -mail if you're not using a mail backend---you have to do a lot of magic -invocations first. At the time when you have finished drawing the -pentagram, lightened the candles, and sacrificed the goat, you really -shouldn't be too surprised when Gnus moves your mail. - -@vindex nnmail-use-procmail -@vindex nnmail-procmail-suffix -@item nnmail-use-procmail -If non-@code{nil}, the mail backends will look in -@code{nnmail-procmail-directory} for incoming mail. All the files in -that directory that have names ending in @code{nnmail-procmail-suffix} -will be considered incoming mailboxes, and will be searched for new -mail. - -@vindex nnmail-crash-box -@item nnmail-crash-box -When a mail backend reads a spool file, mail is first moved to this -file, which is @file{~/.gnus-crash-box} by default. If this file -already exists, it will always be read (and incorporated) before any -other spool files. - -@vindex nnmail-prepare-incoming-hook -@item nnmail-prepare-incoming-hook -This is run in a buffer that holds all the new incoming mail, and can be -used for, well, anything, really. - -@vindex nnmail-split-hook -@item nnmail-split-hook -@findex article-decode-rfc1522 -@findex RFC1522 decoding -Hook run in the buffer where the mail headers of each message is kept -just before the splitting based on these headers is done. The hook is -free to modify the buffer contents in any way it sees fit---the buffer -is discarded after the splitting has been done, and no changes performed -in the buffer will show up in any files. @code{gnus-article-decode-rfc1522} -is one likely function to add to this hook. - -@vindex nnmail-pre-get-new-mail-hook -@vindex nnmail-post-get-new-mail-hook -@item nnmail-pre-get-new-mail-hook -@itemx nnmail-post-get-new-mail-hook -These are two useful hooks executed when treating new incoming -mail---@code{nnmail-pre-get-new-mail-hook} (is called just before -starting to handle the new mail) and -@code{nnmail-post-get-new-mail-hook} (is called when the mail handling -is done). Here's and example of using these two hooks to change the -default file modes the new mail files get: - -@lisp -(add-hook 'gnus-pre-get-new-mail-hook - (lambda () (set-default-file-modes 511))) - -(add-hook 'gnus-post-get-new-mail-hook - (lambda () (set-default-file-modes 551))) -@end lisp - -@item nnmail-tmp-directory -@vindex nnmail-tmp-directory -This variable says where to move incoming mail to -- while processing -it. This is usually done in the same directory that the mail backend -inhabits (e.g., @file{~/Mail/}), but if this variable is non-@code{nil}, -it will be used instead. - -@item nnmail-movemail-program -@vindex nnmail-movemail-program -This program is executed to move mail from the user's inbox to her home -directory. The default is @samp{movemail}. - -This can also be a function. In that case, the function will be called -with two parameters -- the name of the inbox, and the file to be moved -to. - -@item nnmail-delete-incoming -@vindex nnmail-delete-incoming -@cindex incoming mail files -@cindex deleting incoming files -If non-@code{nil}, the mail backends will delete the temporary incoming -file after splitting mail into the proper groups. This is @code{t} by -default. - -@c This is @code{nil} by -@c default for reasons of security. - -@c Since Red Gnus is an alpha release, it is to be expected to lose mail. -(No Gnus release since (ding) Gnus 0.10 (or something like that) have -lost mail, I think, but that's not the point. (Except certain versions -of Red Gnus.)) By not deleting the Incoming* files, one can be sure not -to lose mail -- if Gnus totally whacks out, one can always recover what -was lost. - -You may delete the @file{Incoming*} files at will. - -@item nnmail-use-long-file-names -@vindex nnmail-use-long-file-names -If non-@code{nil}, the mail backends will use long file and directory -names. Groups like @samp{mail.misc} will end up in directories -(assuming use of @code{nnml} backend) or files (assuming use of -@code{nnfolder} backend) like @file{mail.misc}. If it is @code{nil}, -the same group will end up in @file{mail/misc}. - -@item nnmail-delete-file-function -@vindex nnmail-delete-file-function -@findex delete-file -Function called to delete files. It is @code{delete-file} by default. - -@item nnmail-cache-accepted-message-ids -@vindex nnmail-cache-accepted-message-ids -If non-@code{nil}, put the @code{Message-ID}s of articles imported into -the backend (via @code{Gcc}, for instance) into the mail duplication -discovery cache. The default is @code{nil}. - -@end table - - -@node Fancy Mail Splitting -@subsection Fancy Mail Splitting -@cindex mail splitting -@cindex fancy mail splitting - -@vindex nnmail-split-fancy -@findex nnmail-split-fancy -If the rather simple, standard method for specifying how to split mail -doesn't allow you to do what you want, you can set -@code{nnmail-split-methods} to @code{nnmail-split-fancy}. Then you can -play with the @code{nnmail-split-fancy} variable. - -Let's look at an example value of this variable first: - -@lisp -;; Messages from the mailer daemon are not crossposted to any of -;; the ordinary groups. Warnings are put in a separate group -;; from real errors. -(| ("from" mail (| ("subject" "warn.*" "mail.warning") - "mail.misc")) - ;; Non-error messages are crossposted to all relevant - ;; groups, but we don't crosspost between the group for the - ;; (ding) list and the group for other (ding) related mail. - (& (| (any "ding@@ifi\\.uio\\.no" "ding.list") - ("subject" "ding" "ding.misc")) - ;; Other mailing lists... - (any "procmail@@informatik\\.rwth-aachen\\.de" "procmail.list") - (any "SmartList@@informatik\\.rwth-aachen\\.de" "SmartList.list") - ;; People... - (any "larsi@@ifi\\.uio\\.no" "people.Lars_Magne_Ingebrigtsen")) - ;; Unmatched mail goes to the catch all group. - "misc.misc") -@end lisp - -This variable has the format of a @dfn{split}. A split is a (possibly) -recursive structure where each split may contain other splits. Here are -the five possible split syntaxes: - -@enumerate - -@item -@samp{group}: If the split is a string, that will be taken as a group name. - -@item -@var{(FIELD VALUE SPLIT)}: If the split is a list, the first element of -which is a string, then store the message as specified by SPLIT, if -header FIELD (a regexp) contains VALUE (also a regexp). - -@item -@var{(| SPLIT...)}: If the split is a list, and the first element is -@code{|} (vertical bar), then process each SPLIT until one of them -matches. A SPLIT is said to match if it will cause the mail message to -be stored in one or more groups. - -@item -@var{(& SPLIT...)}: If the split is a list, and the first element is -@code{&}, then process all SPLITs in the list. - -@item -@code{junk}: If the split is the symbol @code{junk}, then don't save -this message anywhere. - -@item -@var{(: function arg1 arg2 ...)}: If the split is a list, and the first -element is @code{:}, then the second element will be called as a -function with @var{args} given as arguments. The function should return -a SPLIT. - -@end enumerate - -In these splits, @var{FIELD} must match a complete field name. -@var{VALUE} must match a complete word according to the fundamental mode -syntax table. You can use @code{.*} in the regexps to match partial -field names or words. In other words, all @var{VALUE}'s are wrapped in -@samp{\<} and @samp{\>} pairs. - -@vindex nnmail-split-abbrev-alist -@var{FIELD} and @var{VALUE} can also be lisp symbols, in that case they -are expanded as specified by the variable -@code{nnmail-split-abbrev-alist}. This is an alist of cons cells, where -the @code{car} of a cell contains the key, and the @code{cdr} contains the associated -value. - -@vindex nnmail-split-fancy-syntax-table -@code{nnmail-split-fancy-syntax-table} is the syntax table in effect -when all this splitting is performed. - -If you want to have Gnus create groups dynamically based on some -information in the headers (i.e., do @code{replace-match}-like -substitions in the group names), you can say things like: - -@example -(any "debian-\(\\w*\\)@@lists.debian.org" "mail.debian.\\1") -@end example - -@node Mail and Procmail -@subsection Mail and Procmail -@cindex procmail - -@cindex slocal -@cindex elm -Many people use @code{procmail} (or some other mail filter program or -external delivery agent---@code{slocal}, @code{elm}, etc) to split -incoming mail into groups. If you do that, you should set -@code{nnmail-spool-file} to @code{procmail} to ensure that the mail -backends never ever try to fetch mail by themselves. - -This also means that you probably don't want to set -@code{nnmail-split-methods} either, which has some, perhaps, unexpected -side effects. - -When a mail backend is queried for what groups it carries, it replies -with the contents of that variable, along with any groups it has figured -out that it carries by other means. None of the backends, except -@code{nnmh}, actually go out to the disk and check what groups actually -exist. (It's not trivial to distinguish between what the user thinks is -a basis for a newsgroup and what is just a plain old file or directory.) - -This means that you have to tell Gnus (and the backends) by hand what -groups exist. - -Let's take the @code{nnmh} backend as an example: - -The folders are located in @code{nnmh-directory}, say, @file{~/Mail/}. -There are three folders, @file{foo}, @file{bar} and @file{mail.baz}. - -Go to the group buffer and type @kbd{G m}. When prompted, answer -@samp{foo} for the name and @samp{nnmh} for the method. Repeat -twice for the two other groups, @samp{bar} and @samp{mail.baz}. Be sure -to include all your mail groups. - -That's it. You are now set to read your mail. An active file for this -method will be created automatically. - -@vindex nnmail-procmail-suffix -@vindex nnmail-procmail-directory -If you use @code{nnfolder} or any other backend that store more than a -single article in each file, you should never have procmail add mails to -the file that Gnus sees. Instead, procmail should put all incoming mail -in @code{nnmail-procmail-directory}. To arrive at the file name to put -the incoming mail in, append @code{nnmail-procmail-suffix} to the group -name. The mail backends will read the mail from these files. - -@vindex nnmail-resplit-incoming -When Gnus reads a file called @file{mail.misc.spool}, this mail will be -put in the @code{mail.misc}, as one would expect. However, if you want -Gnus to split the mail the normal way, you could set -@code{nnmail-resplit-incoming} to @code{t}. - -@vindex nnmail-keep-last-article -If you use @code{procmail} to split things directly into an @code{nnmh} -directory (which you shouldn't do), you should set -@code{nnmail-keep-last-article} to non-@code{nil} to prevent Gnus from -ever expiring the final article (i.e., the article with the highest -article number) in a mail newsgroup. This is quite, quite important. - -Here's an example setup: The incoming spools are located in -@file{~/incoming/} and have @samp{""} as suffixes (i.e., the incoming -spool files have the same names as the equivalent groups). The -@code{nnfolder} backend is to be used as the mail interface, and the -@code{nnfolder} directory is @file{~/fMail/}. - -@lisp -(setq nnfolder-directory "~/fMail/") -(setq nnmail-spool-file 'procmail) -(setq nnmail-procmail-directory "~/incoming/") -(setq gnus-secondary-select-methods '((nnfolder ""))) -(setq nnmail-procmail-suffix "") -@end lisp - - -@node Incorporating Old Mail -@subsection Incorporating Old Mail - -Most people have lots of old mail stored in various file formats. If -you have set up Gnus to read mail using one of the spiffy Gnus mail -backends, you'll probably wish to have that old mail incorporated into -your mail groups. - -Doing so can be quite easy. - -To take an example: You're reading mail using @code{nnml} -(@pxref{Mail Spool}), and have set @code{nnmail-split-methods} to a -satisfactory value (@pxref{Splitting Mail}). You have an old Unix mbox -file filled with important, but old, mail. You want to move it into -your @code{nnml} groups. - -Here's how: - -@enumerate -@item -Go to the group buffer. - -@item -Type `G f' and give the path to the mbox file when prompted to create an -@code{nndoc} group from the mbox file (@pxref{Foreign Groups}). - -@item -Type `SPACE' to enter the newly created group. - -@item -Type `M P b' to process-mark all articles in this group's buffer -(@pxref{Setting Process Marks}). - -@item -Type `B r' to respool all the process-marked articles, and answer -@samp{nnml} when prompted (@pxref{Mail Group Commands}). -@end enumerate - -All the mail messages in the mbox file will now also be spread out over -all your @code{nnml} groups. Try entering them and check whether things -have gone without a glitch. If things look ok, you may consider -deleting the mbox file, but I wouldn't do that unless I was absolutely -sure that all the mail has ended up where it should be. - -Respooling is also a handy thing to do if you're switching from one mail -backend to another. Just respool all the mail in the old mail groups -using the new mail backend. - - -@node Expiring Mail -@subsection Expiring Mail -@cindex article expiry - -Traditional mail readers have a tendency to remove mail articles when -you mark them as read, in some way. Gnus takes a fundamentally -different approach to mail reading. - -Gnus basically considers mail just to be news that has been received in -a rather peculiar manner. It does not think that it has the power to -actually change the mail, or delete any mail messages. If you enter a -mail group, and mark articles as ``read'', or kill them in some other -fashion, the mail articles will still exist on the system. I repeat: -Gnus will not delete your old, read mail. Unless you ask it to, of -course. - -To make Gnus get rid of your unwanted mail, you have to mark the -articles as @dfn{expirable}. This does not mean that the articles will -disappear right away, however. In general, a mail article will be -deleted from your system if, 1) it is marked as expirable, AND 2) it is -more than one week old. If you do not mark an article as expirable, it -will remain on your system until hell freezes over. This bears -repeating one more time, with some spurious capitalizations: IF you do -NOT mark articles as EXPIRABLE, Gnus will NEVER delete those ARTICLES. - -@vindex gnus-auto-expirable-newsgroups -You do not have to mark articles as expirable by hand. Groups that -match the regular expression @code{gnus-auto-expirable-newsgroups} will -have all articles that you read marked as expirable automatically. All -articles marked as expirable have an @samp{E} in the first -column in the summary buffer. - -By default, if you have auto expiry switched on, Gnus will mark all the -articles you read as expirable, no matter if they were read or unread -before. To avoid having articles marked as read marked as expirable -automatically, you can put something like the following in your -@file{.gnus} file: - -@vindex gnus-mark-article-hook -@lisp -(remove-hook 'gnus-mark-article-hook - 'gnus-summary-mark-read-and-unread-as-read) -(add-hook 'gnus-mark-article-hook 'gnus-summary-mark-unread-as-read) -@end lisp - -Note that making a group auto-expirable doesn't mean that all read -articles are expired---only the articles marked as expirable -will be expired. Also note that using the @kbd{d} command won't make -groups expirable---only semi-automatic marking of articles as read will -mark the articles as expirable in auto-expirable groups. - -Let's say you subscribe to a couple of mailing lists, and you want the -articles you have read to disappear after a while: - -@lisp -(setq gnus-auto-expirable-newsgroups - "mail.nonsense-list\\|mail.nice-list") -@end lisp - -Another way to have auto-expiry happen is to have the element -@code{auto-expire} in the group parameters of the group. - -If you use adaptive scoring (@pxref{Adaptive Scoring}) and -auto-expiring, you'll have problems. Auto-expiring and adaptive scoring -don't really mix very well. - -@vindex nnmail-expiry-wait -The @code{nnmail-expiry-wait} variable supplies the default time an -expirable article has to live. Gnus starts counting days from when the -message @emph{arrived}, not from when it was sent. The default is seven -days. - -Gnus also supplies a function that lets you fine-tune how long articles -are to live, based on what group they are in. Let's say you want to -have one month expiry period in the @samp{mail.private} group, a one day -expiry period in the @samp{mail.junk} group, and a six day expiry period -everywhere else: - -@vindex nnmail-expiry-wait-function -@lisp -(setq nnmail-expiry-wait-function - (lambda (group) - (cond ((string= group "mail.private") - 31) - ((string= group "mail.junk") - 1) - ((string= group "important") - 'never) - (t - 6)))) -@end lisp - -The group names this function is fed are ``unadorned'' group -names---no @samp{nnml:} prefixes and the like. - -The @code{nnmail-expiry-wait} variable and -@code{nnmail-expiry-wait-function} function can either be a number (not -necessarily an integer) or one of the symbols @code{immediate} or -@code{never}. - -You can also use the @code{expiry-wait} group parameter to selectively -change the expiry period (@pxref{Group Parameters}). - -@vindex nnmail-keep-last-article -If @code{nnmail-keep-last-article} is non-@code{nil}, Gnus will never -expire the final article in a mail newsgroup. This is to make life -easier for procmail users. - -@vindex gnus-total-expirable-newsgroups -By the way: That line up there, about Gnus never expiring non-expirable -articles, is a lie. If you put @code{total-expire} in the group -parameters, articles will not be marked as expirable, but all read -articles will be put through the expiry process. Use with extreme -caution. Even more dangerous is the -@code{gnus-total-expirable-newsgroups} variable. All groups that match -this regexp will have all read articles put through the expiry process, -which means that @emph{all} old mail articles in the groups in question -will be deleted after a while. Use with extreme caution, and don't come -crying to me when you discover that the regexp you used matched the -wrong group and all your important mail has disappeared. Be a -@emph{man}! Or a @emph{woman}! Whatever you feel more comfortable -with! So there! - -Most people make most of their mail groups total-expirable, though. - - -@node Washing Mail -@subsection Washing Mail -@cindex mail washing -@cindex list server brain damage -@cindex incoming mail treatment - -Mailers and list servers are notorious for doing all sorts of really, -really stupid things with mail. ``Hey, RFC822 doesn't explicitly -prohibit us from adding the string @code{wE aRe ElItE!!!!!1!!} to the -end of all lines passing through our server, so let's do that!!!!1!'' -Yes, but RFC822 wasn't designed to be read by morons. Things that were -considered to be self-evident were not discussed. So. Here we are. - -Case in point: The German version of Microsoft Exchange adds @samp{AW: -} to the subjects of replies instead of @samp{Re: }. I could pretend to -be shocked and dismayed by this, but I haven't got the energy. It is to -laugh. - -Gnus provides a plethora of functions for washing articles while -displaying them, but it might be nicer to do the filtering before -storing the mail to disc. For that purpose, we have three hooks and -various functions that can be put in these hooks. - -@table @code -@item nnmail-prepare-incoming-hook -@vindex nnmail-prepare-incoming-hook -This hook is called before doing anything with the mail and is meant for -grand, sweeping gestures. Functions to be used include: - -@table @code -@item nnheader-ms-strip-cr -@findex nnheader-ms-strip-cr -Remove trailing carriage returns from each line. This is default on -Emacs running on MS machines. - -@end table - -@item nnmail-prepare-incoming-header-hook -@vindex nnmail-prepare-incoming-header-hook -This hook is called narrowed to each header. It can be used when -cleaning up the headers. Functions that can be used include: - -@table @code -@item nnmail-remove-leading-whitespace -@findex nnmail-remove-leading-whitespace -Clear leading white space that ``helpful'' listservs have added to the -headers to make them look nice. Aaah. - -@item nnmail-remove-list-identifiers -@findex nnmail-remove-list-identifiers -Some list servers add an identifier---for example, @samp{(idm)}---to the -beginning of all @code{Subject} headers. I'm sure that's nice for -people who use stone age mail readers. This function will remove -strings that match the @code{nnmail-list-identifiers} regexp, which can -also be a list of regexp. - -For instance, if you want to remove the @samp{(idm)} and the -@samp{nagnagnag} identifiers: - -@lisp -(setq nnmail-list-identifiers - '("(idm)" "nagnagnag")) -@end lisp - -@item nnmail-remove-tabs -@findex nnmail-remove-tabs -Translate all @samp{TAB} characters into @samp{SPACE} characters. - -@end table - -@item nnmail-prepare-incoming-message-hook -@vindex nnmail-prepare-incoming-message-hook -This hook is called narrowed to each message. Functions to be used -include: - -@table @code -@item article-de-quoted-unreadable -@findex article-de-quoted-unreadable -Decode Quoted Readable encoding. - -@end table -@end table - - -@node Duplicates -@subsection Duplicates - -@vindex nnmail-treat-duplicates -@vindex nnmail-message-id-cache-length -@vindex nnmail-message-id-cache-file -@cindex duplicate mails -If you are a member of a couple of mailing lists, you will sometimes -receive two copies of the same mail. This can be quite annoying, so -@code{nnmail} checks for and treats any duplicates it might find. To do -this, it keeps a cache of old @code{Message-ID}s--- -@code{nnmail-message-id-cache-file}, which is @file{~/.nnmail-cache} by -default. The approximate maximum number of @code{Message-ID}s stored -there is controlled by the @code{nnmail-message-id-cache-length} -variable, which is 1000 by default. (So 1000 @code{Message-ID}s will be -stored.) If all this sounds scary to you, you can set -@code{nnmail-treat-duplicates} to @code{warn} (which is what it is by -default), and @code{nnmail} won't delete duplicate mails. Instead it -will insert a warning into the head of the mail saying that it thinks -that this is a duplicate of a different message. - -This variable can also be a function. If that's the case, the function -will be called from a buffer narrowed to the message in question with -the @code{Message-ID} as a parameter. The function must return either -@code{nil}, @code{warn}, or @code{delete}. - -You can turn this feature off completely by setting the variable to -@code{nil}. - -If you want all the duplicate mails to be put into a special -@dfn{duplicates} group, you could do that using the normal mail split -methods: - -@lisp -(setq nnmail-split-fancy - '(| ;; Messages duplicates go to a separate group. - ("gnus-warning" "duplication of message" "duplicate") - ;; Message from daemons, postmaster, and the like to another. - (any mail "mail.misc") - ;; Other rules. - [ ... ] )) -@end lisp - -Or something like: -@lisp -(setq nnmail-split-methods - '(("duplicates" "^Gnus-Warning:") - ;; Other rules. - [...])) -@end lisp - -Here's a neat feature: If you know that the recipient reads her mail -with Gnus, and that she has @code{nnmail-treat-duplicates} set to -@code{delete}, you can send her as many insults as you like, just by -using a @code{Message-ID} of a mail that you know that she's already -received. Think of all the fun! She'll never see any of it! Whee! - - -@node Not Reading Mail -@subsection Not Reading Mail - -If you start using any of the mail backends, they have the annoying -habit of assuming that you want to read mail with them. This might not -be unreasonable, but it might not be what you want. - -If you set @code{nnmail-spool-file} to @code{nil}, none of the backends -will ever attempt to read incoming mail, which should help. - -@vindex nnbabyl-get-new-mail -@vindex nnmbox-get-new-mail -@vindex nnml-get-new-mail -@vindex nnmh-get-new-mail -@vindex nnfolder-get-new-mail -This might be too much, if, for instance, you are reading mail quite -happily with @code{nnml} and just want to peek at some old @sc{rmail} -file you have stashed away with @code{nnbabyl}. All backends have -variables called backend-@code{get-new-mail}. If you want to disable -the @code{nnbabyl} mail reading, you edit the virtual server for the -group to have a setting where @code{nnbabyl-get-new-mail} to @code{nil}. - -All the mail backends will call @code{nn}*@code{-prepare-save-mail-hook} -narrowed to the article to be saved before saving it when reading -incoming mail. - - -@node Choosing a Mail Backend -@subsection Choosing a Mail Backend - -Gnus will read the mail spool when you activate a mail group. The mail -file is first copied to your home directory. What happens after that -depends on what format you want to store your mail in. - -@menu -* Unix Mail Box:: Using the (quite) standard Un*x mbox. -* Rmail Babyl:: Emacs programs use the rmail babyl format. -* Mail Spool:: Store your mail in a private spool? -* MH Spool:: An mhspool-like backend. -* Mail Folders:: Having one file for each group. -@end menu - - -@node Unix Mail Box -@subsubsection Unix Mail Box -@cindex nnmbox -@cindex unix mail box - -@vindex nnmbox-active-file -@vindex nnmbox-mbox-file -The @dfn{nnmbox} backend will use the standard Un*x mbox file to store -mail. @code{nnmbox} will add extra headers to each mail article to say -which group it belongs in. - -Virtual server settings: - -@table @code -@item nnmbox-mbox-file -@vindex nnmbox-mbox-file -The name of the mail box in the user's home directory. - -@item nnmbox-active-file -@vindex nnmbox-active-file -The name of the active file for the mail box. - -@item nnmbox-get-new-mail -@vindex nnmbox-get-new-mail -If non-@code{nil}, @code{nnmbox} will read incoming mail and split it -into groups. -@end table - - -@node Rmail Babyl -@subsubsection Rmail Babyl -@cindex nnbabyl -@cindex rmail mbox - -@vindex nnbabyl-active-file -@vindex nnbabyl-mbox-file -The @dfn{nnbabyl} backend will use a babyl mail box (aka. @dfn{rmail -mbox}) to store mail. @code{nnbabyl} will add extra headers to each mail -article to say which group it belongs in. - -Virtual server settings: - -@table @code -@item nnbabyl-mbox-file -@vindex nnbabyl-mbox-file -The name of the rmail mbox file. - -@item nnbabyl-active-file -@vindex nnbabyl-active-file -The name of the active file for the rmail box. - -@item nnbabyl-get-new-mail -@vindex nnbabyl-get-new-mail -If non-@code{nil}, @code{nnbabyl} will read incoming mail. -@end table - - -@node Mail Spool -@subsubsection Mail Spool -@cindex nnml -@cindex mail @sc{nov} spool - -The @dfn{nnml} spool mail format isn't compatible with any other known -format. It should be used with some caution. - -@vindex nnml-directory -If you use this backend, Gnus will split all incoming mail into files, -one file for each mail, and put the articles into the corresponding -directories under the directory specified by the @code{nnml-directory} -variable. The default value is @file{~/Mail/}. - -You do not have to create any directories beforehand; Gnus will take -care of all that. - -If you have a strict limit as to how many files you are allowed to store -in your account, you should not use this backend. As each mail gets its -own file, you might very well occupy thousands of inodes within a few -weeks. If this is no problem for you, and it isn't a problem for you -having your friendly systems administrator walking around, madly, -shouting ``Who is eating all my inodes?! Who? Who!?!'', then you should -know that this is probably the fastest format to use. You do not have -to trudge through a big mbox file just to read your new mail. - -@code{nnml} is probably the slowest backend when it comes to article -splitting. It has to create lots of files, and it also generates -@sc{nov} databases for the incoming mails. This makes it the fastest -backend when it comes to reading mail. - -Virtual server settings: - -@table @code -@item nnml-directory -@vindex nnml-directory -All @code{nnml} directories will be placed under this directory. - -@item nnml-active-file -@vindex nnml-active-file -The active file for the @code{nnml} server. - -@item nnml-newsgroups-file -@vindex nnml-newsgroups-file -The @code{nnml} group descriptions file. @xref{Newsgroups File -Format}. - -@item nnml-get-new-mail -@vindex nnml-get-new-mail -If non-@code{nil}, @code{nnml} will read incoming mail. - -@item nnml-nov-is-evil -@vindex nnml-nov-is-evil -If non-@code{nil}, this backend will ignore any @sc{nov} files. - -@item nnml-nov-file-name -@vindex nnml-nov-file-name -The name of the @sc{nov} files. The default is @file{.overview}. - -@item nnml-prepare-save-mail-hook -@vindex nnml-prepare-save-mail-hook -Hook run narrowed to an article before saving. - -@end table - -@findex nnml-generate-nov-databases -If your @code{nnml} groups and @sc{nov} files get totally out of whack, -you can do a complete update by typing @kbd{M-x -nnml-generate-nov-databases}. This command will trawl through the -entire @code{nnml} hierarchy, looking at each and every article, so it -might take a while to complete. A better interface to this -functionality can be found in the server buffer (@pxref{Server -Commands}). - - -@node MH Spool -@subsubsection MH Spool -@cindex nnmh -@cindex mh-e mail spool - -@code{nnmh} is just like @code{nnml}, except that is doesn't generate -@sc{nov} databases and it doesn't keep an active file. This makes -@code{nnmh} a @emph{much} slower backend than @code{nnml}, but it also -makes it easier to write procmail scripts for. - -Virtual server settings: - -@table @code -@item nnmh-directory -@vindex nnmh-directory -All @code{nnmh} directories will be located under this directory. - -@item nnmh-get-new-mail -@vindex nnmh-get-new-mail -If non-@code{nil}, @code{nnmh} will read incoming mail. - -@item nnmh-be-safe -@vindex nnmh-be-safe -If non-@code{nil}, @code{nnmh} will go to ridiculous lengths to make -sure that the articles in the folder are actually what Gnus thinks they -are. It will check date stamps and stat everything in sight, so -setting this to @code{t} will mean a serious slow-down. If you never -use anything but Gnus to read the @code{nnmh} articles, you do not have -to set this variable to @code{t}. -@end table - - -@node Mail Folders -@subsubsection Mail Folders -@cindex nnfolder -@cindex mbox folders -@cindex mail folders - -@code{nnfolder} is a backend for storing each mail group in a separate -file. Each file is in the standard Un*x mbox format. @code{nnfolder} -will add extra headers to keep track of article numbers and arrival -dates. - -Virtual server settings: - -@table @code -@item nnfolder-directory -@vindex nnfolder-directory -All the @code{nnfolder} mail boxes will be stored under this directory. - -@item nnfolder-active-file -@vindex nnfolder-active-file -The name of the active file. - -@item nnfolder-newsgroups-file -@vindex nnfolder-newsgroups-file -The name of the group descriptions file. @xref{Newsgroups File Format}. - -@item nnfolder-get-new-mail -@vindex nnfolder-get-new-mail -If non-@code{nil}, @code{nnfolder} will read incoming mail. -@end table - -@findex nnfolder-generate-active-file -@kindex M-x nnfolder-generate-active-file -If you have lots of @code{nnfolder}-like files you'd like to read with -@code{nnfolder}, you can use the @kbd{M-x nnfolder-generate-active-file} -command to make @code{nnfolder} aware of all likely files in -@code{nnfolder-directory}. - - -@node Other Sources -@section Other Sources - -Gnus can do more than just read news or mail. The methods described -below allow Gnus to view directories and files as if they were -newsgroups. - -@menu -* Directory Groups:: You can read a directory as if it was a newsgroup. -* Anything Groups:: Dired? Who needs dired? -* Document Groups:: Single files can be the basis of a group. -* SOUP:: Reading @sc{SOUP} packets ``offline''. -* Web Searches:: Creating groups from articles that match a string. -* Mail-To-News Gateways:: Posting articles via mail-to-news gateways. -@end menu - - -@node Directory Groups -@subsection Directory Groups -@cindex nndir -@cindex directory groups - -If you have a directory that has lots of articles in separate files in -it, you might treat it as a newsgroup. The files have to have numerical -names, of course. - -This might be an opportune moment to mention @code{ange-ftp} (and its -successor @code{ecf}), that most wonderful of all wonderful Emacs -packages. When I wrote @code{nndir}, I didn't think much about it---a -backend to read directories. Big deal. - -@code{ange-ftp} changes that picture dramatically. For instance, if you -enter the @code{ange-ftp} file name -@file{/ftp.hpc.uh.edu:/pub/emacs/ding-list/} as the directory name, -@code{ange-ftp} or @code{efs} will actually allow you to read this -directory over at @samp{sina} as a newsgroup. Distributed news ahoy! - -@code{nndir} will use @sc{nov} files if they are present. - -@code{nndir} is a ``read-only'' backend---you can't delete or expire -articles with this method. You can use @code{nnmh} or @code{nnml} for -whatever you use @code{nndir} for, so you could switch to any of those -methods if you feel the need to have a non-read-only @code{nndir}. - - -@node Anything Groups -@subsection Anything Groups -@cindex nneething - -From the @code{nndir} backend (which reads a single spool-like -directory), it's just a hop and a skip to @code{nneething}, which -pretends that any arbitrary directory is a newsgroup. Strange, but -true. - -When @code{nneething} is presented with a directory, it will scan this -directory and assign article numbers to each file. When you enter such -a group, @code{nneething} must create ``headers'' that Gnus can use. -After all, Gnus is a newsreader, in case you're -forgetting. @code{nneething} does this in a two-step process. First, it -snoops each file in question. If the file looks like an article (i.e., -the first few lines look like headers), it will use this as the head. -If this is just some arbitrary file without a head (e.g. a C source -file), @code{nneething} will cobble up a header out of thin air. It -will use file ownership, name and date and do whatever it can with these -elements. - -All this should happen automatically for you, and you will be presented -with something that looks very much like a newsgroup. Totally like a -newsgroup, to be precise. If you select an article, it will be displayed -in the article buffer, just as usual. - -If you select a line that represents a directory, Gnus will pop you into -a new summary buffer for this @code{nneething} group. And so on. You can -traverse the entire disk this way, if you feel like, but remember that -Gnus is not dired, really, and does not intend to be, either. - -There are two overall modes to this action---ephemeral or solid. When -doing the ephemeral thing (i.e., @kbd{G D} from the group buffer), Gnus -will not store information on what files you have read, and what files -are new, and so on. If you create a solid @code{nneething} group the -normal way with @kbd{G m}, Gnus will store a mapping table between -article numbers and file names, and you can treat this group like any -other groups. When you activate a solid @code{nneething} group, you will -be told how many unread articles it contains, etc., etc. - -Some variables: - -@table @code -@item nneething-map-file-directory -@vindex nneething-map-file-directory -All the mapping files for solid @code{nneething} groups will be stored -in this directory, which defaults to @file{~/.nneething/}. - -@item nneething-exclude-files -@vindex nneething-exclude-files -All files that match this regexp will be ignored. Nice to use to exclude -auto-save files and the like, which is what it does by default. - -@item nneething-map-file -@vindex nneething-map-file -Name of the map files. -@end table - - -@node Document Groups -@subsection Document Groups -@cindex nndoc -@cindex documentation group -@cindex help group - -@code{nndoc} is a cute little thing that will let you read a single file -as a newsgroup. Several files types are supported: - -@table @code -@cindex babyl -@cindex rmail mbox - -@item babyl -The babyl (rmail) mail box. -@cindex mbox -@cindex Unix mbox - -@item mbox -The standard Unix mbox file. - -@cindex MMDF mail box -@item mmdf -The MMDF mail box format. - -@item news -Several news articles appended into a file. - -@item rnews -@cindex rnews batch files -The rnews batch transport format. -@cindex forwarded messages - -@item forward -Forwarded articles. - -@item mime-digest -@cindex digest -@cindex MIME digest -@cindex 1153 digest -@cindex RFC 1153 digest -@cindex RFC 341 digest -MIME (RFC 1341) digest format. - -@item standard-digest -The standard (RFC 1153) digest format. - -@item slack-digest -Non-standard digest format---matches most things, but does it badly. -@end table - -You can also use the special ``file type'' @code{guess}, which means -that @code{nndoc} will try to guess what file type it is looking at. -@code{digest} means that @code{nndoc} should guess what digest type the -file is. - -@code{nndoc} will not try to change the file or insert any extra headers into -it---it will simply, like, let you use the file as the basis for a -group. And that's it. - -If you have some old archived articles that you want to insert into your -new & spiffy Gnus mail backend, @code{nndoc} can probably help you with -that. Say you have an old @file{RMAIL} file with mail that you now want -to split into your new @code{nnml} groups. You look at that file using -@code{nndoc} (using the @kbd{G f} command in the group buffer -(@pxref{Foreign Groups})), set the process mark on all the articles in -the buffer (@kbd{M P b}, for instance), and then re-spool (@kbd{B r}) -using @code{nnml}. If all goes well, all the mail in the @file{RMAIL} -file is now also stored in lots of @code{nnml} directories, and you can -delete that pesky @file{RMAIL} file. If you have the guts! - -Virtual server variables: - -@table @code -@item nndoc-article-type -@vindex nndoc-article-type -This should be one of @code{mbox}, @code{babyl}, @code{digest}, -@code{news}, @code{rnews}, @code{mmdf}, @code{forward}, @code{rfc934}, -@code{rfc822-forward}, @code{mime-digest}, @code{standard-digest}, -@code{slack-digest}, @code{clari-briefs} or @code{guess}. - -@item nndoc-post-type -@vindex nndoc-post-type -This variable says whether Gnus is to consider the group a news group or -a mail group. There are two legal values: @code{mail} (the default) -and @code{news}. -@end table - -@menu -* Document Server Internals:: How to add your own document types. -@end menu - - -@node Document Server Internals -@subsubsection Document Server Internals - -Adding new document types to be recognized by @code{nndoc} isn't -difficult. You just have to whip up a definition of what the document -looks like, write a predicate function to recognize that document type, -and then hook into @code{nndoc}. - -First, here's an example document type definition: - -@example -(mmdf - (article-begin . "^\^A\^A\^A\^A\n") - (body-end . "^\^A\^A\^A\^A\n")) -@end example - -The definition is simply a unique @dfn{name} followed by a series of -regexp pseudo-variable settings. Below are the possible -variables---don't be daunted by the number of variables; most document -types can be defined with very few settings: - -@table @code -@item first-article -If present, @code{nndoc} will skip past all text until it finds -something that match this regexp. All text before this will be -totally ignored. - -@item article-begin -This setting has to be present in all document type definitions. It -says what the beginning of each article looks like. - -@item head-begin-function -If present, this should be a function that moves point to the head of -the article. - -@item nndoc-head-begin -If present, this should be a regexp that matches the head of the -article. - -@item nndoc-head-end -This should match the end of the head of the article. It defaults to -@samp{^$}---the empty line. - -@item body-begin-function -If present, this function should move point to the beginning of the body -of the article. - -@item body-begin -This should match the beginning of the body of the article. It defaults -to @samp{^\n}. - -@item body-end-function -If present, this function should move point to the end of the body of -the article. - -@item body-end -If present, this should match the end of the body of the article. - -@item file-end -If present, this should match the end of the file. All text after this -regexp will be totally ignored. - -@end table - -So, using these variables @code{nndoc} is able to dissect a document -file into a series of articles, each with a head and a body. However, a -few more variables are needed since not all document types are all that -news-like---variables needed to transform the head or the body into -something that's palatable for Gnus: - -@table @code -@item prepare-body-function -If present, this function will be called when requesting an article. It -will be called with point at the start of the body, and is useful if the -document has encoded some parts of its contents. - -@item article-transform-function -If present, this function is called when requesting an article. It's -meant to be used for more wide-ranging transformation of both head and -body of the article. - -@item generate-head-function -If present, this function is called to generate a head that Gnus can -understand. It is called with the article number as a parameter, and is -expected to generate a nice head for the article in question. It is -called when requesting the headers of all articles. - -@end table - -Let's look at the most complicated example I can come up with---standard -digests: - -@example -(standard-digest - (first-article . ,(concat "^" (make-string 70 ?-) "\n\n+")) - (article-begin . ,(concat "\n\n" (make-string 30 ?-) "\n\n+")) - (prepare-body-function . nndoc-unquote-dashes) - (body-end-function . nndoc-digest-body-end) - (head-end . "^ ?$") - (body-begin . "^ ?\n") - (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$") - (subtype digest guess)) -@end example - -We see that all text before a 70-width line of dashes is ignored; all -text after a line that starts with that @samp{^End of} is also ignored; -each article begins with a 30-width line of dashes; the line separating -the head from the body may contain a single space; and that the body is -run through @code{nndoc-unquote-dashes} before being delivered. - -To hook your own document definition into @code{nndoc}, use the -@code{nndoc-add-type} function. It takes two parameters---the first is -the definition itself and the second (optional) parameter says where in -the document type definition alist to put this definition. The alist is -traversed sequentially, and @code{nndoc-TYPE-type-p} is called for a given type @code{TYPE}. So @code{nndoc-mmdf-type-p} is called to see whether a document -is of @code{mmdf} type, and so on. These type predicates should return -@code{nil} if the document is not of the correct type; @code{t} if it is -of the correct type; and a number if the document might be of the -correct type. A high number means high probability; a low number means -low probability with @samp{0} being the lowest legal number. - - -@node SOUP -@subsection SOUP -@cindex SOUP -@cindex offline - -In the PC world people often talk about ``offline'' newsreaders. These -are thingies that are combined reader/news transport monstrosities. -With built-in modem programs. Yecchh! - -Of course, us Unix Weenie types of human beans use things like -@code{uucp} and, like, @code{nntpd} and set up proper news and mail -transport things like Ghod intended. And then we just use normal -newsreaders. - -However, it can sometimes be convenient to do something a that's a bit -easier on the brain if you have a very slow modem, and you're not really -that interested in doing things properly. - -A file format called @sc{soup} has been developed for transporting news -and mail from servers to home machines and back again. It can be a bit -fiddly. - -First some terminology: - -@table @dfn - -@item server -This is the machine that is connected to the outside world and where you -get news and/or mail from. - -@item home machine -This is the machine that you want to do the actual reading and responding -on. It is typically not connected to the rest of the world in any way. - -@item packet -Something that contains messages and/or commands. There are two kinds -of packets: - -@table @dfn -@item message packets -These are packets made at the server, and typically contain lots of -messages for you to read. These are called @file{SoupoutX.tgz} by -default, where @var{X} is a number. - -@item response packets -These are packets made at the home machine, and typically contains -replies that you've written. These are called @file{SoupinX.tgz} by -default, where @var{X} is a number. - -@end table - -@end table - - -@enumerate - -@item -You log in on the server and create a @sc{soup} packet. You can either -use a dedicated @sc{soup} thingie (like the @code{awk} program), or you -can use Gnus to create the packet with its @sc{soup} commands (@kbd{O -s} and/or @kbd{G s b}; and then @kbd{G s p}) (@pxref{SOUP Commands}). - -@item -You transfer the packet home. Rail, boat, car or modem will do fine. - -@item -You put the packet in your home directory. - -@item -You fire up Gnus on your home machine using the @code{nnsoup} backend as -the native or secondary server. - -@item -You read articles and mail and answer and followup to the things you -want (@pxref{SOUP Replies}). - -@item -You do the @kbd{G s r} command to pack these replies into a @sc{soup} -packet. - -@item -You transfer this packet to the server. - -@item -You use Gnus to mail this packet out with the @kbd{G s s} command. - -@item -You then repeat until you die. - -@end enumerate - -So you basically have a bipartite system---you use @code{nnsoup} for -reading and Gnus for packing/sending these @sc{soup} packets. - -@menu -* SOUP Commands:: Commands for creating and sending @sc{soup} packets -* SOUP Groups:: A backend for reading @sc{soup} packets. -* SOUP Replies:: How to enable @code{nnsoup} to take over mail and news. -@end menu - - -@node SOUP Commands -@subsubsection SOUP Commands - -These are commands for creating and manipulating @sc{soup} packets. - -@table @kbd -@item G s b -@kindex G s b (Group) -@findex gnus-group-brew-soup -Pack all unread articles in the current group -(@code{gnus-group-brew-soup}). This command understands the -process/prefix convention. - -@item G s w -@kindex G s w (Group) -@findex gnus-soup-save-areas -Save all @sc{soup} data files (@code{gnus-soup-save-areas}). - -@item G s s -@kindex G s s (Group) -@findex gnus-soup-send-replies -Send all replies from the replies packet -(@code{gnus-soup-send-replies}). - -@item G s p -@kindex G s p (Group) -@findex gnus-soup-pack-packet -Pack all files into a @sc{soup} packet (@code{gnus-soup-pack-packet}). - -@item G s r -@kindex G s r (Group) -@findex nnsoup-pack-replies -Pack all replies into a replies packet (@code{nnsoup-pack-replies}). - -@item O s -@kindex O s (Summary) -@findex gnus-soup-add-article -This summary-mode command adds the current article to a @sc{soup} packet -(@code{gnus-soup-add-article}). It understands the process/prefix -convention (@pxref{Process/Prefix}). - -@end table - - -There are a few variables to customize where Gnus will put all these -thingies: - -@table @code - -@item gnus-soup-directory -@vindex gnus-soup-directory -Directory where Gnus will save intermediate files while composing -@sc{soup} packets. The default is @file{~/SoupBrew/}. - -@item gnus-soup-replies-directory -@vindex gnus-soup-replies-directory -This is what Gnus will use as a temporary directory while sending our -reply packets. @file{~/SoupBrew/SoupReplies/} is the default. - -@item gnus-soup-prefix-file -@vindex gnus-soup-prefix-file -Name of the file where Gnus stores the last used prefix. The default is -@samp{gnus-prefix}. - -@item gnus-soup-packer -@vindex gnus-soup-packer -A format string command for packing a @sc{soup} packet. The default is -@samp{tar cf - %s | gzip > $HOME/Soupout%d.tgz}. - -@item gnus-soup-unpacker -@vindex gnus-soup-unpacker -Format string command for unpacking a @sc{soup} packet. The default is -@samp{gunzip -c %s | tar xvf -}. - -@item gnus-soup-packet-directory -@vindex gnus-soup-packet-directory -Where Gnus will look for reply packets. The default is @file{~/}. - -@item gnus-soup-packet-regexp -@vindex gnus-soup-packet-regexp -Regular expression matching @sc{soup} reply packets in -@code{gnus-soup-packet-directory}. - -@end table - - -@node SOUP Groups -@subsubsection @sc{soup} Groups -@cindex nnsoup - -@code{nnsoup} is the backend for reading @sc{soup} packets. It will -read incoming packets, unpack them, and put them in a directory where -you can read them at leisure. - -These are the variables you can use to customize its behavior: - -@table @code - -@item nnsoup-tmp-directory -@vindex nnsoup-tmp-directory -When @code{nnsoup} unpacks a @sc{soup} packet, it does it in this -directory. (@file{/tmp/} by default.) - -@item nnsoup-directory -@vindex nnsoup-directory -@code{nnsoup} then moves each message and index file to this directory. -The default is @file{~/SOUP/}. - -@item nnsoup-replies-directory -@vindex nnsoup-replies-directory -All replies will be stored in this directory before being packed into a -reply packet. The default is @file{~/SOUP/replies/"}. - -@item nnsoup-replies-format-type -@vindex nnsoup-replies-format-type -The @sc{soup} format of the replies packets. The default is @samp{?n} -(rnews), and I don't think you should touch that variable. I probably -shouldn't even have documented it. Drats! Too late! - -@item nnsoup-replies-index-type -@vindex nnsoup-replies-index-type -The index type of the replies packet. The default is @samp{?n}, which -means ``none''. Don't fiddle with this one either! - -@item nnsoup-active-file -@vindex nnsoup-active-file -Where @code{nnsoup} stores lots of information. This is not an ``active -file'' in the @code{nntp} sense; it's an Emacs Lisp file. If you lose -this file or mess it up in any way, you're dead. The default is -@file{~/SOUP/active}. - -@item nnsoup-packer -@vindex nnsoup-packer -Format string command for packing a reply @sc{soup} packet. The default -is @samp{tar cf - %s | gzip > $HOME/Soupin%d.tgz}. - -@item nnsoup-unpacker -@vindex nnsoup-unpacker -Format string command for unpacking incoming @sc{soup} packets. The -default is @samp{gunzip -c %s | tar xvf -}. - -@item nnsoup-packet-directory -@vindex nnsoup-packet-directory -Where @code{nnsoup} will look for incoming packets. The default is -@file{~/}. - -@item nnsoup-packet-regexp -@vindex nnsoup-packet-regexp -Regular expression matching incoming @sc{soup} packets. The default is -@samp{Soupout}. - -@end table - - -@node SOUP Replies -@subsubsection SOUP Replies - -Just using @code{nnsoup} won't mean that your postings and mailings end -up in @sc{soup} reply packets automagically. You have to work a bit -more for that to happen. - -@findex nnsoup-set-variables -The @code{nnsoup-set-variables} command will set the appropriate -variables to ensure that all your followups and replies end up in the -@sc{soup} system. - -In specific, this is what it does: - -@lisp -(setq message-send-news-function 'nnsoup-request-post) -(setq message-send-mail-function 'nnsoup-request-mail) -@end lisp - -And that's it, really. If you only want news to go into the @sc{soup} -system you just use the first line. If you only want mail to be -@sc{soup}ed you use the second. - - -@node Web Searches -@subsection Web Searches -@cindex nnweb -@cindex DejaNews -@cindex Alta Vista -@cindex InReference -@cindex Usenet searches -@cindex searching the Usenet - -It's, like, too neat to search the Usenet for articles that match a -string, but it, like, totally @emph{sucks}, like, totally, to use one of -those, like, Web browsers, and you, like, have to, rilly, like, look at -the commercials, so, like, with Gnus you can do @emph{rad}, rilly, -searches without having to use a browser. - -The @code{nnweb} backend allows an easy interface to the mighty search -engine. You create an @code{nnweb} group, enter a search pattern, and -then enter the group and read the articles like you would any normal -group. The @kbd{G w} command in the group buffer (@pxref{Foreign -Groups}) will do this in an easy-to-use fashion. - -@code{nnweb} groups don't really lend themselves to being solid -groups---they have a very fleeting idea of article numbers. In fact, -each time you enter an @code{nnweb} group (not even changing the search -pattern), you are likely to get the articles ordered in a different -manner. Not even using duplicate suppression (@pxref{Duplicate -Suppression}) will help, since @code{nnweb} doesn't even know the -@code{Message-ID} of the articles before reading them using some search -engines (DejaNews, for instance). The only possible way to keep track -of which articles you've read is by scoring on the @code{Date} -header---mark all articles posted before the last date you read the -group as read. - -If the search engine changes its output substantially, @code{nnweb} -won't be able to parse it and will fail. One could hardly fault the Web -providers if they were to do this---their @emph{raison d'être} is to -make money off of advertisements, not to provide services to the -community. Since @code{nnweb} washes the ads off all the articles, one -might think that the providers might be somewhat miffed. We'll see. - -You must have the @code{url} and @code{w3} package installed to be able -to use @code{nnweb}. - -Virtual server variables: - -@table @code -@item nnweb-type -@vindex nnweb-type -What search engine type is being used. The currently supported types -are @code{dejanews}, @code{altavista} and @code{reference}. - -@item nnweb-search -@vindex nnweb-search -The search string to feed to the search engine. - -@item nnweb-max-hits -@vindex nnweb-max-hits -Advisory maximum number of hits per search to display. The default is -100. - -@item nnweb-type-definition -@vindex nnweb-type-definition -Type-to-definition alist. This alist says what @code{nnweb} should do -with the various search engine types. The following elements must be -present: - -@table @code -@item article -Function to decode the article and provide something that Gnus -understands. - -@item map -Function to create an article number to message header and URL alist. - -@item search -Function to send the search string to the search engine. - -@item address -The address the aforementioned function should send the search string -to. - -@item id -Format string URL to fetch an article by @code{Message-ID}. -@end table - -@end table - - - -@node Mail-To-News Gateways -@subsection Mail-To-News Gateways -@cindex mail-to-news gateways -@cindex gateways - -If your local @code{nntp} server doesn't allow posting, for some reason -or other, you can post using one of the numerous mail-to-news gateways. -The @code{nngateway} backend provides the interface. - -Note that you can't read anything from this backend---it can only be -used to post with. - -Server variables: - -@table @code -@item nngateway-address -@vindex nngateway-address -This is the address of the mail-to-news gateway. - -@item nngateway-header-transformation -@vindex nngateway-header-transformation -News headers often have to be transformed in some odd way or other -for the mail-to-news gateway to accept it. This variable says what -transformation should be called, and defaults to -@code{nngateway-simple-header-transformation}. The function is called -narrowed to the headers to be transformed and with one parameter---the -gateway address. - -This default function just inserts a new @code{To} header based on the -@code{Newsgroups} header and the gateway address. -For instance, an article with this @code{Newsgroups} header: - -@example -Newsgroups: alt.religion.emacs -@end example - -will get this @code{From} header inserted: - -@example -To: alt-religion-emacs@@GATEWAY -@end example - -@end table - -So, to use this, simply say something like: - -@lisp -(setq gnus-post-method '(nngateway "GATEWAY.ADDRESS")) -@end lisp - - -@node Combined Groups -@section Combined Groups - -Gnus allows combining a mixture of all the other group types into bigger -groups. - -@menu -* Virtual Groups:: Combining articles from many groups. -* Kibozed Groups:: Looking through parts of the newsfeed for articles. -@end menu - - -@node Virtual Groups -@subsection Virtual Groups -@cindex nnvirtual -@cindex virtual groups - -An @dfn{nnvirtual group} is really nothing more than a collection of -other groups. - -For instance, if you are tired of reading many small groups, you can -put them all in one big group, and then grow tired of reading one -big, unwieldy group. The joys of computing! - -You specify @code{nnvirtual} as the method. The address should be a -regexp to match component groups. - -All marks in the virtual group will stick to the articles in the -component groups. So if you tick an article in a virtual group, the -article will also be ticked in the component group from whence it came. -(And vice versa---marks from the component groups will also be shown in -the virtual group.) - -Here's an example @code{nnvirtual} method that collects all Andrea Dworkin -newsgroups into one, big, happy newsgroup: - -@lisp -(nnvirtual "^alt\\.fan\\.andrea-dworkin$\\|^rec\\.dworkin.*") -@end lisp - -The component groups can be native or foreign; everything should work -smoothly, but if your computer explodes, it was probably my fault. - -Collecting the same group from several servers might actually be a good -idea if users have set the Distribution header to limit distribution. -If you would like to read @samp{soc.motss} both from a server in Japan -and a server in Norway, you could use the following as the group regexp: - -@example -"^nntp+some.server.jp:soc.motss$\\|^nntp+some.server.no:soc.motss$" -@end example - -This should work kinda smoothly---all articles from both groups should -end up in this one, and there should be no duplicates. Threading (and -the rest) will still work as usual, but there might be problems with the -sequence of articles. Sorting on date might be an option here -(@pxref{Selecting a Group}). - -One limitation, however---all groups included in a virtual -group have to be alive (i.e., subscribed or unsubscribed). Killed or -zombie groups can't be component groups for @code{nnvirtual} groups. - -@vindex nnvirtual-always-rescan -If the @code{nnvirtual-always-rescan} is non-@code{nil}, -@code{nnvirtual} will always scan groups for unread articles when -entering a virtual group. If this variable is @code{nil} (which is the -default) and you read articles in a component group after the virtual -group has been activated, the read articles from the component group -will show up when you enter the virtual group. You'll also see this -effect if you have two virtual groups that have a component group in -common. If that's the case, you should set this variable to @code{t}. -Or you can just tap @code{M-g} on the virtual group every time before -you enter it---it'll have much the same effect. - - -@node Kibozed Groups -@subsection Kibozed Groups -@cindex nnkiboze -@cindex kibozing - -@dfn{Kibozing} is defined by @sc{oed} as ``grepping through (parts of) -the news feed''. @code{nnkiboze} is a backend that will do this for -you. Oh joy! Now you can grind any @sc{nntp} server down to a halt -with useless requests! Oh happiness! - -@kindex G k (Group) -To create a kibozed group, use the @kbd{G k} command in the group -buffer. - -The address field of the @code{nnkiboze} method is, as with -@code{nnvirtual}, a regexp to match groups to be ``included'' in the -@code{nnkiboze} group. That's where most similarities between @code{nnkiboze} -and @code{nnvirtual} end. - -In addition to this regexp detailing component groups, an @code{nnkiboze} group -must have a score file to say what articles are to be included in -the group (@pxref{Scoring}). - -@kindex M-x nnkiboze-generate-groups -@findex nnkiboze-generate-groups -You must run @kbd{M-x nnkiboze-generate-groups} after creating the -@code{nnkiboze} groups you want to have. This command will take time. Lots of -time. Oodles and oodles of time. Gnus has to fetch the headers from -all the articles in all the component groups and run them through the -scoring process to determine if there are any articles in the groups -that are to be part of the @code{nnkiboze} groups. - -Please limit the number of component groups by using restrictive -regexps. Otherwise your sysadmin may become annoyed with you, and the -@sc{nntp} site may throw you off and never let you back in again. -Stranger things have happened. - -@code{nnkiboze} component groups do not have to be alive---they can be dead, -and they can be foreign. No restrictions. - -@vindex nnkiboze-directory -The generation of an @code{nnkiboze} group means writing two files in -@code{nnkiboze-directory}, which is @file{~/News/} by default. One -contains the @sc{nov} header lines for all the articles in the group, -and the other is an additional @file{.newsrc} file to store information -on what groups have been searched through to find component articles. - -Articles marked as read in the @code{nnkiboze} group will have -their @sc{nov} lines removed from the @sc{nov} file. - - -@node Scoring -@chapter Scoring -@cindex scoring - -Other people use @dfn{kill files}, but we here at Gnus Towers like -scoring better than killing, so we'd rather switch than fight. They do -something completely different as well, so sit up straight and pay -attention! - -@vindex gnus-summary-mark-below -All articles have a default score (@code{gnus-summary-default-score}), -which is 0 by default. This score may be raised or lowered either -interactively or by score files. Articles that have a score lower than -@code{gnus-summary-mark-below} are marked as read. - -Gnus will read any @dfn{score files} that apply to the current group -before generating the summary buffer. - -There are several commands in the summary buffer that insert score -entries based on the current article. You can, for instance, ask Gnus to -lower or increase the score of all articles with a certain subject. - -There are two sorts of scoring entries: Permanent and temporary. -Temporary score entries are self-expiring entries. Any entries that are -temporary and have not been used for, say, a week, will be removed -silently to help keep the sizes of the score files down. - -@menu -* Summary Score Commands:: Adding score entries for the current group. -* Group Score Commands:: General score commands. -* Score Variables:: Customize your scoring. (My, what terminology). -* Score File Format:: What a score file may contain. -* Score File Editing:: You can edit score files by hand as well. -* Adaptive Scoring:: Big Sister Gnus knows what you read. -* Home Score File:: How to say where new score entries are to go. -* Followups To Yourself:: Having Gnus notice when people answer you. -* Scoring Tips:: How to score effectively. -* Reverse Scoring:: That problem child of old is not problem. -* Global Score Files:: Earth-spanning, ear-splitting score files. -* Kill Files:: They are still here, but they can be ignored. -* Converting Kill Files:: Translating kill files to score files. -* GroupLens:: Getting predictions on what you like to read. -* Advanced Scoring:: Using logical expressions to build score rules. -* Score Decays:: It can be useful to let scores wither away. -@end menu - - -@node Summary Score Commands -@section Summary Score Commands -@cindex score commands - -The score commands that alter score entries do not actually modify real -score files. That would be too inefficient. Gnus maintains a cache of -previously loaded score files, one of which is considered the -@dfn{current score file alist}. The score commands simply insert -entries into this list, and upon group exit, this list is saved. - -The current score file is by default the group's local score file, even -if no such score file actually exists. To insert score commands into -some other score file (e.g. @file{all.SCORE}), you must first make this -score file the current one. - -General score commands that don't actually change the score file: - -@table @kbd - -@item V s -@kindex V s (Summary) -@findex gnus-summary-set-score -Set the score of the current article (@code{gnus-summary-set-score}). - -@item V S -@kindex V S (Summary) -@findex gnus-summary-current-score -Display the score of the current article -(@code{gnus-summary-current-score}). - -@item V t -@kindex V t (Summary) -@findex gnus-score-find-trace -Display all score rules that have been used on the current article -(@code{gnus-score-find-trace}). - -@item V R -@kindex V R (Summary) -@findex gnus-summary-rescore -Run the current summary through the scoring process -(@code{gnus-summary-rescore}). This might be useful if you're playing -around with your score files behind Gnus' back and want to see the -effect you're having. - -@item V a -@kindex V a (Summary) -@findex gnus-summary-score-entry -Add a new score entry, and allow specifying all elements -(@code{gnus-summary-score-entry}). - -@item V c -@kindex V c (Summary) -@findex gnus-score-change-score-file -Make a different score file the current -(@code{gnus-score-change-score-file}). - -@item V e -@kindex V e (Summary) -@findex gnus-score-edit-current-scores -Edit the current score file (@code{gnus-score-edit-current-scores}). -You will be popped into a @code{gnus-score-mode} buffer (@pxref{Score -File Editing}). - -@item V f -@kindex V f (Summary) -@findex gnus-score-edit-file -Edit a score file and make this score file the current one -(@code{gnus-score-edit-file}). - -@item V F -@kindex V F (Summary) -@findex gnus-score-flush-cache -Flush the score cache (@code{gnus-score-flush-cache}). This is useful -after editing score files. - -@item V C -@kindex V C (Summary) -@findex gnus-score-customize -Customize a score file in a visually pleasing manner -(@code{gnus-score-customize}). - -@end table - -The rest of these commands modify the local score file. - -@table @kbd - -@item V m -@kindex V m (Summary) -@findex gnus-score-set-mark-below -Prompt for a score, and mark all articles with a score below this as -read (@code{gnus-score-set-mark-below}). - -@item V x -@kindex V x (Summary) -@findex gnus-score-set-expunge-below -Prompt for a score, and add a score rule to the current score file to -expunge all articles below this score -(@code{gnus-score-set-expunge-below}). -@end table - -The keystrokes for actually making score entries follow a very regular -pattern, so there's no need to list all the commands. (Hundreds of -them.) - -@enumerate -@item -The first key is either @kbd{I} (upper case i) for increasing the score -or @kbd{L} for lowering the score. -@item -The second key says what header you want to score on. The following -keys are available: -@table @kbd - -@item a -Score on the author name. - -@item s -Score on the subject line. - -@item x -Score on the Xref line---i.e., the cross-posting line. - -@item t -Score on thread---the References line. - -@item d -Score on the date. - -@item l -Score on the number of lines. - -@item i -Score on the Message-ID. - -@item f -Score on followups. - -@item b -Score on the body. - -@item h -Score on the head. -@end table - -@item -The third key is the match type. Which match types are legal depends on -what headers you are scoring on. - -@table @code - -@item strings - -@table @kbd - -@item e -Exact matching. - -@item s -Substring matching. - -@item f -Fuzzy matching (@pxref{Fuzzy Matching}). - -@item r -Regexp matching -@end table - -@item date -@table @kbd - -@item b -Before date. - -@item a -At date. - -@item n -This date. -@end table - -@item number -@table @kbd - -@item < -Less than number. - -@item = -Equal to number. - -@item > -Greater than number. -@end table -@end table - -@item -The fourth and final key says whether this is a temporary (i.e., expiring) -score entry, or a permanent (i.e., non-expiring) score entry, or whether -it is to be done immediately, without adding to the score file. -@table @kbd - -@item t -Temporary score entry. - -@item p -Permanent score entry. - -@item i -Immediately scoring. -@end table - -@end enumerate - -So, let's say you want to increase the score on the current author with -exact matching permanently: @kbd{I a e p}. If you want to lower the -score based on the subject line, using substring matching, and make a -temporary score entry: @kbd{L s s t}. Pretty easy. - -To make things a bit more complicated, there are shortcuts. If you use -a capital letter on either the second or third keys, Gnus will use -defaults for the remaining one or two keystrokes. The defaults are -``substring'' and ``temporary''. So @kbd{I A} is the same as @kbd{I a s -t}, and @kbd{I a R} is the same as @kbd{I a r t}. - -@vindex gnus-score-mimic-keymap -The @code{gnus-score-mimic-keymap} says whether these commands will -pretend they are keymaps or not. - - -@node Group Score Commands -@section Group Score Commands -@cindex group score commands - -There aren't many of these as yet, I'm afraid. - -@table @kbd - -@item W f -@kindex W f (Group) -@findex gnus-score-flush-cache -Gnus maintains a cache of score alists to avoid having to reload them -all the time. This command will flush the cache -(@code{gnus-score-flush-cache}). - -@end table - - -@node Score Variables -@section Score Variables -@cindex score variables - -@table @code - -@item gnus-use-scoring -@vindex gnus-use-scoring -If @code{nil}, Gnus will not check for score files, and will not, in -general, do any score-related work. This is @code{t} by default. - -@item gnus-kill-killed -@vindex gnus-kill-killed -If this variable is @code{nil}, Gnus will never apply score files to -articles that have already been through the kill process. While this -may save you lots of time, it also means that if you apply a kill file -to a group, and then change the kill file and want to run it over you -group again to kill more articles, it won't work. You have to set this -variable to @code{t} to do that. (It is @code{t} by default.) - -@item gnus-kill-files-directory -@vindex gnus-kill-files-directory -All kill and score files will be stored in this directory, which is -initialized from the @code{SAVEDIR} environment variable by default. -This is @file{~/News/} by default. - -@item gnus-score-file-suffix -@vindex gnus-score-file-suffix -Suffix to add to the group name to arrive at the score file name -(@samp{SCORE} by default.) - -@item gnus-score-uncacheable-files -@vindex gnus-score-uncacheable-files -@cindex score cache -All score files are normally cached to avoid excessive re-loading of -score files. However, if this might make you Emacs grow big and -bloated, so this regexp can be used to weed out score files unlikely to be needed again. It would be a bad idea to deny caching of -@file{all.SCORE}, while it might be a good idea to not cache -@file{comp.infosystems.www.authoring.misc.ADAPT}. In fact, this -variable is @samp{ADAPT$} by default, so no adaptive score files will -be cached. - -@item gnus-save-score -@vindex gnus-save-score -If you have really complicated score files, and do lots of batch -scoring, then you might set this variable to @code{t}. This will make -Gnus save the scores into the @file{.newsrc.eld} file. - -@item gnus-score-interactive-default-score -@vindex gnus-score-interactive-default-score -Score used by all the interactive raise/lower commands to raise/lower -score with. Default is 1000, which may seem excessive, but this is to -ensure that the adaptive scoring scheme gets enough room to play with. -We don't want the small changes from the adaptive scoring to overwrite -manually entered data. - -@item gnus-summary-default-score -@vindex gnus-summary-default-score -Default score of an article, which is 0 by default. - -@item gnus-summary-expunge-below -@vindex gnus-summary-expunge-below -Don't display the summary lines of articles that have scores lower than -this variable. This is @code{nil} by default, which means that no -articles will be hidden. - -@item gnus-score-over-mark -@vindex gnus-score-over-mark -Mark (in the third column) used for articles with a score over the -default. Default is @samp{+}. - -@item gnus-score-below-mark -@vindex gnus-score-below-mark -Mark (in the third column) used for articles with a score below the -default. Default is @samp{-}. - -@item gnus-score-find-score-files-function -@vindex gnus-score-find-score-files-function -Function used to find score files for the current group. This function -is called with the name of the group as the argument. - -Predefined functions available are: -@table @code - -@item gnus-score-find-single -@findex gnus-score-find-single -Only apply the group's own score file. - -@item gnus-score-find-bnews -@findex gnus-score-find-bnews -Apply all score files that match, using bnews syntax. This is the -default. If the current group is @samp{gnu.emacs.gnus}, for instance, -@file{all.emacs.all.SCORE}, @file{not.alt.all.SCORE} and -@file{gnu.all.SCORE} would all apply. In short, the instances of -@samp{all} in the score file names are translated into @samp{.*}, and -then a regexp match is done. - -This means that if you have some score entries that you want to apply to -all groups, then you put those entries in the @file{all.SCORE} file. - -The score files are applied in a semi-random order, although Gnus will -try to apply the more general score files before the more specific score -files. It does this by looking at the number of elements in the score -file names---discarding the @samp{all} elements. - -@item gnus-score-find-hierarchical -@findex gnus-score-find-hierarchical -Apply all score files from all the parent groups. This means that you -can't have score files like @file{all.SCORE}, but you can have -@file{SCORE}, @file{comp.SCORE} and @file{comp.emacs.SCORE}. - -@end table -This variable can also be a list of functions. In that case, all these -functions will be called, and all the returned lists of score files will -be applied. These functions can also return lists of score alists -directly. In that case, the functions that return these non-file score -alists should probably be placed before the ``real'' score file -functions, to ensure that the last score file returned is the local -score file. Phu. - -@item gnus-score-expiry-days -@vindex gnus-score-expiry-days -This variable says how many days should pass before an unused score file -entry is expired. If this variable is @code{nil}, no score file entries -are expired. It's 7 by default. - -@item gnus-update-score-entry-dates -@vindex gnus-update-score-entry-dates -If this variable is non-@code{nil}, matching score entries will have -their dates updated. (This is how Gnus controls expiry---all -non-matching entries will become too old while matching entries will -stay fresh and young.) However, if you set this variable to @code{nil}, -even matching entries will grow old and will have to face that oh-so -grim reaper. - -@item gnus-score-after-write-file-function -@vindex gnus-score-after-write-file-function -Function called with the name of the score file just written. - -@end table - - -@node Score File Format -@section Score File Format -@cindex score file format - -A score file is an @code{emacs-lisp} file that normally contains just a -single form. Casual users are not expected to edit these files; -everything can be changed from the summary buffer. - -Anyway, if you'd like to dig into it yourself, here's an example: - -@lisp -(("from" - ("Lars Ingebrigtsen" -10000) - ("Per Abrahamsen") - ("larsi\\|lmi" -50000 nil R)) - ("subject" - ("Ding is Badd" nil 728373)) - ("xref" - ("alt.politics" -1000 728372 s)) - ("lines" - (2 -100 nil <)) - (mark 0) - (expunge -1000) - (mark-and-expunge -10) - (read-only nil) - (orphan -10) - (adapt t) - (files "/hom/larsi/News/gnu.SCORE") - (exclude-files "all.SCORE") - (local (gnus-newsgroup-auto-expire t) - (gnus-summary-make-false-root 'empty)) - (eval (ding))) -@end lisp - -This example demonstrates most score file elements. For a different -approach, see @pxref{Advanced Scoring}. - -Even though this looks much like lisp code, nothing here is actually -@code{eval}ed. The lisp reader is used to read this form, though, so it -has to be legal syntactically, if not semantically. - -Six keys are supported by this alist: - -@table @code - -@item STRING -If the key is a string, it is the name of the header to perform the -match on. Scoring can only be performed on these eight headers: -@code{From}, @code{Subject}, @code{References}, @code{Message-ID}, -@code{Xref}, @code{Lines}, @code{Chars} and @code{Date}. In addition to -these headers, there are three strings to tell Gnus to fetch the entire -article and do the match on larger parts of the article: @code{Body} -will perform the match on the body of the article, @code{Head} will -perform the match on the head of the article, and @code{All} will -perform the match on the entire article. Note that using any of these -last three keys will slow down group entry @emph{considerably}. The -final ``header'' you can score on is @code{Followup}. These score -entries will result in new score entries being added for all follow-ups -to articles that matches these score entries. - -Following this key is a arbitrary number of score entries, where each -score entry has one to four elements. -@enumerate - -@item -The first element is the @dfn{match element}. On most headers this will -be a string, but on the Lines and Chars headers, this must be an -integer. - -@item -If the second element is present, it should be a number---the @dfn{score -element}. This number should be an integer in the neginf to posinf -interval. This number is added to the score of the article if the match -is successful. If this element is not present, the -@code{gnus-score-interactive-default-score} number will be used -instead. This is 1000 by default. - -@item -If the third element is present, it should be a number---the @dfn{date -element}. This date says when the last time this score entry matched, -which provides a mechanism for expiring the score entries. It this -element is not present, the score entry is permanent. The date is -represented by the number of days since December 31, 1 BCE. - -@item -If the fourth element is present, it should be a symbol---the @dfn{type -element}. This element specifies what function should be used to see -whether this score entry matches the article. What match types that can -be used depends on what header you wish to perform the match on. -@table @dfn - -@item From, Subject, References, Xref, Message-ID -For most header types, there are the @code{r} and @code{R} (regexp), as -well as @code{s} and @code{S} (substring) types, and @code{e} and -@code{E} (exact match), and @code{w} (word match) types. If this -element is not present, Gnus will assume that substring matching should -be used. @code{R}, @code{S}, and @code{E} differ from the others in -that the matches will be done in a case-sensitive manner. All these -one-letter types are really just abbreviations for the @code{regexp}, -@code{string}, @code{exact}, and @code{word} types, which you can use -instead, if you feel like. - -@item Lines, Chars -These two headers use different match types: @code{<}, @code{>}, -@code{=}, @code{>=} and @code{<=}. When matching on @code{Lines}, be -careful because some backends (like @code{nndir}) do not generate -@code{Lines} header, so every article ends up being marked as having 0 -lines. This can lead to strange results if you happen to lower score of -the articles with few lines. - -@item Date -For the Date header we have three kinda silly match types: -@code{before}, @code{at} and @code{after}. I can't really imagine this -ever being useful, but, like, it would feel kinda silly not to provide -this function. Just in case. You never know. Better safe than sorry. -Once burnt, twice shy. Don't judge a book by its cover. Never not have -sex on a first date. (I have been told that at least one person, and I -quote, ``found this function indispensable'', however.) - -@cindex ISO8601 -@cindex date -A more useful match type is @code{regexp}. With it, you can match the -date string using a regular expression. The date is normalized to -ISO8601 compact format first---@var{YYYYMMDD}@code{T}@var{HHMMSS}. If -you want to match all articles that have been posted on April 1st in -every year, you could use @samp{....0401.........} as a match string, -for instance. (Note that the date is kept in its original time zone, so -this will match articles that were posted when it was April 1st where -the article was posted from. Time zones are such wholesome fun for the -whole family, eh?) - -@item Head, Body, All -These three match keys use the same match types as the @code{From} (etc) -header uses. - -@item Followup -This match key is somewhat special, in that it will match the -@code{From} header, and affect the score of not only the matching -articles, but also all followups to the matching articles. This allows -you e.g. increase the score of followups to your own articles, or -decrease the score of followups to the articles of some known -trouble-maker. Uses the same match types as the @code{From} header -uses. (Using this match key will lead to creation of @file{ADAPT} -files.) - -@item Thread -This match key works along the same lines as the @code{Followup} match -key. If you say that you want to score on a (sub-)thread started by an article with a @code{Message-ID} @var{X}, then you add a -@samp{thread} match. This will add a new @samp{thread} match for each -article that has @var{X} in its @code{References} header. (These new -@samp{thread} matches will use the @code{Message-ID}s of these matching -articles.) This will ensure that you can raise/lower the score of an -entire thread, even though some articles in the thread may not have -complete @code{References} headers. Note that using this may lead to -undeterministic scores of the articles in the thread. (Using this match -key will lead to creation of @file{ADAPT} files.) -@end table -@end enumerate - -@cindex Score File Atoms -@item mark -The value of this entry should be a number. Any articles with a score -lower than this number will be marked as read. - -@item expunge -The value of this entry should be a number. Any articles with a score -lower than this number will be removed from the summary buffer. - -@item mark-and-expunge -The value of this entry should be a number. Any articles with a score -lower than this number will be marked as read and removed from the -summary buffer. - -@item thread-mark-and-expunge -The value of this entry should be a number. All articles that belong to -a thread that has a total score below this number will be marked as read -and removed from the summary buffer. @code{gnus-thread-score-function} -says how to compute the total score for a thread. - -@item files -The value of this entry should be any number of file names. These files -are assumed to be score files as well, and will be loaded the same way -this one was. - -@item exclude-files -The clue of this entry should be any number of files. These files will -not be loaded, even though they would normally be so, for some reason or -other. - -@item eval -The value of this entry will be @code{eval}el. This element will be -ignored when handling global score files. - -@item read-only -Read-only score files will not be updated or saved. Global score files -should feature this atom (@pxref{Global Score Files}). - -@item orphan -The value of this entry should be a number. Articles that do not have -parents will get this number added to their scores. Imagine you follow -some high-volume newsgroup, like @samp{comp.lang.c}. Most likely you -will only follow a few of the threads, also want to see any new threads. - -You can do this with the following two score file entries: - -@example - (orphan -500) - (mark-and-expunge -100) -@end example - -When you enter the group the first time, you will only see the new -threads. You then raise the score of the threads that you find -interesting (with @kbd{I T} or @kbd{I S}), and ignore (@kbd{C y}) the -rest. Next time you enter the group, you will see new articles in the -interesting threads, plus any new threads. - -I.e.---the orphan score atom is for high-volume groups where there -exist a few interesting threads which can't be found automatically by -ordinary scoring rules. - -@item adapt -This entry controls the adaptive scoring. If it is @code{t}, the -default adaptive scoring rules will be used. If it is @code{ignore}, no -adaptive scoring will be performed on this group. If it is a list, this -list will be used as the adaptive scoring rules. If it isn't present, -or is something other than @code{t} or @code{ignore}, the default -adaptive scoring rules will be used. If you want to use adaptive -scoring on most groups, you'd set @code{gnus-use-adaptive-scoring} to -@code{t}, and insert an @code{(adapt ignore)} in the groups where you do -not want adaptive scoring. If you only want adaptive scoring in a few -groups, you'd set @code{gnus-use-adaptive-scoring} to @code{nil}, and -insert @code{(adapt t)} in the score files of the groups where you want -it. - -@item adapt-file -All adaptive score entries will go to the file named by this entry. It -will also be applied when entering the group. This atom might be handy -if you want to adapt on several groups at once, using the same adaptive -file for a number of groups. - -@item local -@cindex local variables -The value of this entry should be a list of @code{(VAR VALUE)} pairs. -Each @var{var} will be made buffer-local to the current summary buffer, -and set to the value specified. This is a convenient, if somewhat -strange, way of setting variables in some groups if you don't like hooks -much. -@end table - - -@node Score File Editing -@section Score File Editing - -You normally enter all scoring commands from the summary buffer, but you -might feel the urge to edit them by hand as well, so we've supplied you -with a mode for that. - -It's simply a slightly customized @code{emacs-lisp} mode, with these -additional commands: - -@table @kbd - -@item C-c C-c -@kindex C-c C-c (Score) -@findex gnus-score-edit-done -Save the changes you have made and return to the summary buffer -(@code{gnus-score-edit-done}). - -@item C-c C-d -@kindex C-c C-d (Score) -@findex gnus-score-edit-insert-date -Insert the current date in numerical format -(@code{gnus-score-edit-insert-date}). This is really the day number, if -you were wondering. - -@item C-c C-p -@kindex C-c C-p (Score) -@findex gnus-score-pretty-print -The adaptive score files are saved in an unformatted fashion. If you -intend to read one of these files, you want to @dfn{pretty print} it -first. This command (@code{gnus-score-pretty-print}) does that for -you. - -@end table - -Type @kbd{M-x gnus-score-mode} to use this mode. - -@vindex gnus-score-mode-hook -@code{gnus-score-menu-hook} is run in score mode buffers. - -In the summary buffer you can use commands like @kbd{V f} and @kbd{V -e} to begin editing score files. - - -@node Adaptive Scoring -@section Adaptive Scoring -@cindex adaptive scoring - -If all this scoring is getting you down, Gnus has a way of making it all -happen automatically---as if by magic. Or rather, as if by artificial -stupidity, to be precise. - -@vindex gnus-use-adaptive-scoring -When you read an article, or mark an article as read, or kill an -article, you leave marks behind. On exit from the group, Gnus can sniff -these marks and add score elements depending on what marks it finds. -You turn on this ability by setting @code{gnus-use-adaptive-scoring} to -@code{t} or @code{(line)}. If you want score adaptively on separate -words appearing in the subjects, you should set this variable to -@code{(word)}. If you want to use both adaptive methods, set this -variable to @code{(word line)}. - -@vindex gnus-default-adaptive-score-alist -To give you complete control over the scoring process, you can customize -the @code{gnus-default-adaptive-score-alist} variable. For instance, it -might look something like this: - -@lisp -(defvar gnus-default-adaptive-score-alist - '((gnus-unread-mark) - (gnus-ticked-mark (from 4)) - (gnus-dormant-mark (from 5)) - (gnus-del-mark (from -4) (subject -1)) - (gnus-read-mark (from 4) (subject 2)) - (gnus-expirable-mark (from -1) (subject -1)) - (gnus-killed-mark (from -1) (subject -3)) - (gnus-kill-file-mark) - (gnus-ancient-mark) - (gnus-low-score-mark) - (gnus-catchup-mark (from -1) (subject -1)))) -@end lisp - -As you see, each element in this alist has a mark as a key (either a -variable name or a ``real'' mark---a character). Following this key is -a arbitrary number of header/score pairs. If there are no header/score -pairs following the key, no adaptive scoring will be done on articles -that have that key as the article mark. For instance, articles with -@code{gnus-unread-mark} in the example above will not get adaptive score -entries. - -Each article can have only one mark, so just a single of these rules -will be applied to each article. - -To take @code{gnus-del-mark} as an example---this alist says that all -articles that have that mark (i.e., are marked with @samp{D}) will have a -score entry added to lower based on the @code{From} header by -4, and -lowered by @code{Subject} by -1. Change this to fit your prejudices. - -If you have marked 10 articles with the same subject with -@code{gnus-del-mark}, the rule for that mark will be applied ten times. -That means that that subject will get a score of ten times -1, which -should be, unless I'm much mistaken, -10. - -If you have auto-expirable (mail) groups (@pxref{Expiring Mail}), all -the read articles will be marked with the @samp{E} mark. This'll -probably make adaptive scoring slightly impossible, so auto-expiring and -adaptive scoring doesn't really mix very well. - -The headers you can score on are @code{from}, @code{subject}, -@code{message-id}, @code{references}, @code{xref}, @code{lines}, -@code{chars} and @code{date}. In addition, you can score on -@code{followup}, which will create an adaptive score entry that matches -on the @code{References} header using the @code{Message-ID} of the -current article, thereby matching the following thread. - -You can also score on @code{thread}, which will try to score all -articles that appear in a thread. @code{thread} matches uses a -@code{Message-ID} to match on the @code{References} header of the -article. If the match is made, the @code{Message-ID} of the article is -added to the @code{thread} rule. (Think about it. I'd recommend two -aspirins afterwards.) - -If you use this scheme, you should set the score file atom @code{mark} -to something small---like -300, perhaps, to avoid having small random -changes result in articles getting marked as read. - -After using adaptive scoring for a week or so, Gnus should start to -become properly trained and enhance the authors you like best, and kill -the authors you like least, without you having to say so explicitly. - -You can control what groups the adaptive scoring is to be performed on -by using the score files (@pxref{Score File Format}). This will also -let you use different rules in different groups. - -@vindex gnus-adaptive-file-suffix -The adaptive score entries will be put into a file where the name is the -group name with @code{gnus-adaptive-file-suffix} appended. The default -is @samp{ADAPT}. - -@vindex gnus-score-exact-adapt-limit -When doing adaptive scoring, substring or fuzzy matching would probably -give you the best results in most cases. However, if the header one -matches is short, the possibility for false positives is great, so if -the length of the match is less than -@code{gnus-score-exact-adapt-limit}, exact matching will be used. If -this variable is @code{nil}, exact matching will always be used to avoid -this problem. - -@vindex gnus-default-adaptive-word-score-alist -As mentioned above, you can adapt either on individual words or entire -headers. If you adapt on words, the -@code{gnus-default-adaptive-word-score-alist} variable says what score -each instance of a word should add given a mark. - -@lisp -(setq gnus-default-adaptive-word-score-alist - `((,gnus-read-mark . 30) - (,gnus-catchup-mark . -10) - (,gnus-killed-mark . -20) - (,gnus-del-mark . -15))) -@end lisp - -This is the default value. If you have adaption on words enabled, every -word that appears in subjects of articles marked with -@code{gnus-read-mark} will result in a score rule that increase the -score with 30 points. - -@vindex gnus-default-ignored-adaptive-words -@vindex gnus-ignored-adaptive-words -Words that appear in the @code{gnus-default-ignored-adaptive-words} list -will be ignored. If you wish to add more words to be ignored, use the -@code{gnus-ignored-adaptive-words} list instead. - -@vindex gnus-adaptive-word-syntax-table -When the scoring is done, @code{gnus-adaptive-word-syntax-table} is the -syntax table in effect. It is similar to the standard syntax table, but -it considers numbers to be non-word-constituent characters. - -After using this scheme for a while, it might be nice to write a -@code{gnus-psychoanalyze-user} command to go through the rules and see -what words you like and what words you don't like. Or perhaps not. - -Note that the adaptive word scoring thing is highly experimental and is -likely to change in the future. Initial impressions seem to indicate -that it's totally useless as it stands. Some more work (involving more -rigorous statistical methods) will have to be done to make this useful. - - -@node Home Score File -@section Home Score File - -The score file where new score file entries will go is called the -@dfn{home score file}. This is normally (and by default) the score file -for the group itself. For instance, the home score file for -@samp{gnu.emacs.gnus} is @file{gnu.emacs.gnus.SCORE}. - -However, this may not be what you want. It is often convenient to share -a common home score file among many groups---all @samp{emacs} groups -could perhaps use the same home score file. - -@vindex gnus-home-score-file -The variable that controls this is @code{gnus-home-score-file}. It can -be: - -@enumerate -@item -A string. Then this file will be used as the home score file for all -groups. - -@item -A function. The result of this function will be used as the home score -file. The function will be called with the name of the group as the -parameter. - -@item -A list. The elements in this list can be: - -@enumerate -@item -@var{(regexp file-name)}. If the @var{regexp} matches the group name, -the @var{file-name} will will be used as the home score file. - -@item -A function. If the function returns non-nil, the result will be used as -the home score file. - -@item -A string. Use the string as the home score file. -@end enumerate - -The list will be traversed from the beginning towards the end looking -for matches. - -@end enumerate - -So, if you want to use just a single score file, you could say: - -@lisp -(setq gnus-home-score-file - "my-total-score-file.SCORE") -@end lisp - -If you want to use @file{gnu.SCORE} for all @samp{gnu} groups and -@file{rec.SCORE} for all @samp{rec} groups (and so on), you can say: - -@lisp -(setq gnus-home-score-file - 'gnus-hierarchial-home-score-file) -@end lisp - -This is a ready-made function provided for your convenience. - -If you want to have one score file for the @samp{emacs} groups and -another for the @samp{comp} groups, while letting all other groups use -their own home score files: - -@lisp -(setq gnus-home-score-file - ;; All groups that match the regexp "\\.emacs" - '("\\.emacs" "emacs.SCORE") - ;; All the comp groups in one score file - ("^comp" "comp.SCORE")) -@end lisp - -@vindex gnus-home-adapt-file -@code{gnus-home-adapt-file} works exactly the same way as -@code{gnus-home-score-file}, but says what the home adaptive score file -is instead. All new adaptive file entries will go into the file -specified by this variable, and the same syntax is allowed. - -In addition to using @code{gnus-home-score-file} and -@code{gnus-home-adapt-file}, you can also use group parameters -(@pxref{Group Parameters}) and topic parameters (@pxref{Topic -Parameters}) to achieve much the same. Group and topic parameters take -precedence over this variable. - - -@node Followups To Yourself -@section Followups To Yourself - -Gnus offers two commands for picking out the @code{Message-ID} header in -the current buffer. Gnus will then add a score rule that scores using -this @code{Message-ID} on the @code{References} header of other -articles. This will, in effect, increase the score of all articles that -respond to the article in the current buffer. Quite useful if you want -to easily note when people answer what you've said. - -@table @code - -@item gnus-score-followup-article -@findex gnus-score-followup-article -This will add a score to articles that directly follow up your own -article. - -@item gnus-score-followup-thread -@findex gnus-score-followup-thread -This will add a score to all articles that appear in a thread ``below'' -your own article. -@end table - -@vindex message-sent-hook -These two functions are both primarily meant to be used in hooks like -@code{message-sent-hook}. - -If you look closely at your own @code{Message-ID}, you'll notice that -the first two or three characters are always the same. Here's two of -mine: - -@example - - -@end example - -So ``my'' ident on this machine is @samp{x6}. This can be -exploited---the following rule will raise the score on all followups to -myself: - -@lisp -("references" - ("" 1000 nil r)) -@end lisp - -Whether it's the first two or first three characters that are ``yours'' -is system-dependent. - - -@node Scoring Tips -@section Scoring Tips -@cindex scoring tips - -@table @dfn - -@item Crossposts -@cindex crossposts -@cindex scoring crossposts -If you want to lower the score of crossposts, the line to match on is -the @code{Xref} header. -@lisp -("xref" (" talk.politics.misc:" -1000)) -@end lisp - -@item Multiple crossposts -If you want to lower the score of articles that have been crossposted to -more than, say, 3 groups: -@lisp -("xref" ("[^:\n]+:[0-9]+ +[^:\n]+:[0-9]+ +[^:\n]+:[0-9]+" -1000 nil r)) -@end lisp - -@item Matching on the body -This is generally not a very good idea---it takes a very long time. -Gnus actually has to fetch each individual article from the server. But -you might want to anyway, I guess. Even though there are three match -keys (@code{Head}, @code{Body} and @code{All}), you should choose one -and stick with it in each score file. If you use any two, each article -will be fetched @emph{twice}. If you want to match a bit on the -@code{Head} and a bit on the @code{Body}, just use @code{All} for all -the matches. - -@item Marking as read -You will probably want to mark articles that has a score below a certain -number as read. This is most easily achieved by putting the following -in your @file{all.SCORE} file: -@lisp -((mark -100)) -@end lisp -You may also consider doing something similar with @code{expunge}. - -@item Negated character classes -If you say stuff like @code{[^abcd]*}, you may get unexpected results. -That will match newlines, which might lead to, well, The Unknown. Say -@code{[^abcd\n]*} instead. -@end table - - -@node Reverse Scoring -@section Reverse Scoring -@cindex reverse scoring - -If you want to keep just articles that have @samp{Sex with Emacs} in the -subject header, and expunge all other articles, you could put something -like this in your score file: - -@lisp -(("subject" - ("Sex with Emacs" 2)) - (mark 1) - (expunge 1)) -@end lisp - -So, you raise all articles that match @samp{Sex with Emacs} and mark the -rest as read, and expunge them to boot. - - -@node Global Score Files -@section Global Score Files -@cindex global score files - -Sure, other newsreaders have ``global kill files''. These are usually -nothing more than a single kill file that applies to all groups, stored -in the user's home directory. Bah! Puny, weak newsreaders! - -What I'm talking about here are Global Score Files. Score files from -all over the world, from users everywhere, uniting all nations in one -big, happy score file union! Ange-score! New and untested! - -@vindex gnus-global-score-files -All you have to do to use other people's score files is to set the -@code{gnus-global-score-files} variable. One entry for each score file, -or each score file directory. Gnus will decide by itself what score -files are applicable to which group. - -Say you want to use the score file -@file{/ftp@@ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE} and -all score files in the @file{/ftp@@ftp.some-where:/pub/score} directory: - -@lisp -(setq gnus-global-score-files - '("/ftp@@ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE" - "/ftp@@ftp.some-where:/pub/score/")) -@end lisp - -@findex gnus-score-search-global-directories -Simple, eh? Directory names must end with a @samp{/}. These -directories are typically scanned only once during each Gnus session. -If you feel the need to manually re-scan the remote directories, you can -use the @code{gnus-score-search-global-directories} command. - -Note that, at present, using this option will slow down group entry -somewhat. (That is---a lot.) - -If you want to start maintaining score files for other people to use, -just put your score file up for anonymous ftp and announce it to the -world. Become a retro-moderator! Participate in the retro-moderator -wars sure to ensue, where retro-moderators battle it out for the -sympathy of the people, luring them to use their score files on false -premises! Yay! The net is saved! - -Here are some tips for the would-be retro-moderator, off the top of my -head: - -@itemize @bullet - -@item -Articles heavily crossposted are probably junk. -@item -To lower a single inappropriate article, lower by @code{Message-ID}. -@item -Particularly brilliant authors can be raised on a permanent basis. -@item -Authors that repeatedly post off-charter for the group can safely be -lowered out of existence. -@item -Set the @code{mark} and @code{expunge} atoms to obliterate the nastiest -articles completely. - -@item -Use expiring score entries to keep the size of the file down. You -should probably have a long expiry period, though, as some sites keep -old articles for a long time. -@end itemize - -... I wonder whether other newsreaders will support global score files -in the future. @emph{Snicker}. Yup, any day now, newsreaders like Blue -Wave, xrn and 1stReader are bound to implement scoring. Should we start -holding our breath yet? - - -@node Kill Files -@section Kill Files -@cindex kill files - -Gnus still supports those pesky old kill files. In fact, the kill file -entries can now be expiring, which is something I wrote before Daniel -Quinlan thought of doing score files, so I've left the code in there. - -In short, kill processing is a lot slower (and I do mean @emph{a lot}) -than score processing, so it might be a good idea to rewrite your kill -files into score files. - -Anyway, a kill file is a normal @code{emacs-lisp} file. You can put any -forms into this file, which means that you can use kill files as some -sort of primitive hook function to be run on group entry, even though -that isn't a very good idea. - -Normal kill files look like this: - -@lisp -(gnus-kill "From" "Lars Ingebrigtsen") -(gnus-kill "Subject" "ding") -(gnus-expunge "X") -@end lisp - -This will mark every article written by me as read, and remove the -marked articles from the summary buffer. Very useful, you'll agree. - -Other programs use a totally different kill file syntax. If Gnus -encounters what looks like a @code{rn} kill file, it will take a stab at -interpreting it. - -Two summary functions for editing a GNUS kill file: - -@table @kbd - -@item M-k -@kindex M-k (Summary) -@findex gnus-summary-edit-local-kill -Edit this group's kill file (@code{gnus-summary-edit-local-kill}). - -@item M-K -@kindex M-K (Summary) -@findex gnus-summary-edit-global-kill -Edit the general kill file (@code{gnus-summary-edit-global-kill}). -@end table - -Two group mode functions for editing the kill files: - -@table @kbd - -@item M-k -@kindex M-k (Group) -@findex gnus-group-edit-local-kill -Edit this group's kill file (@code{gnus-group-edit-local-kill}). - -@item M-K -@kindex M-K (Group) -@findex gnus-group-edit-global-kill -Edit the general kill file (@code{gnus-group-edit-global-kill}). -@end table - -Kill file variables: - -@table @code -@item gnus-kill-file-name -@vindex gnus-kill-file-name -A kill file for the group @samp{soc.motss} is normally called -@file{soc.motss.KILL}. The suffix appended to the group name to get -this file name is detailed by the @code{gnus-kill-file-name} variable. -The ``global'' kill file (not in the score file sense of ``global'', of -course) is just called @file{KILL}. - -@vindex gnus-kill-save-kill-file -@item gnus-kill-save-kill-file -If this variable is non-@code{nil}, Gnus will save the -kill file after processing, which is necessary if you use expiring -kills. - -@item gnus-apply-kill-hook -@vindex gnus-apply-kill-hook -@findex gnus-apply-kill-file-unless-scored -@findex gnus-apply-kill-file -A hook called to apply kill files to a group. It is -@code{(gnus-apply-kill-file)} by default. If you want to ignore the -kill file if you have a score file for the same group, you can set this -hook to @code{(gnus-apply-kill-file-unless-scored)}. If you don't want -kill files to be processed, you should set this variable to @code{nil}. - -@item gnus-kill-file-mode-hook -@vindex gnus-kill-file-mode-hook -A hook called in kill-file mode buffers. - -@end table - - -@node Converting Kill Files -@section Converting Kill Files -@cindex kill files -@cindex converting kill files - -If you have loads of old kill files, you may want to convert them into -score files. If they are ``regular'', you can use -the @file{gnus-kill-to-score.el} package; if not, you'll have to do it -by hand. - -The kill to score conversion package isn't included in Gnus by default. -You can fetch it from -@file{http://www.ifi.uio.no/~larsi/ding-other/gnus-kill-to-score}. - -If your old kill files are very complex---if they contain more -non-@code{gnus-kill} forms than not, you'll have to convert them by -hand. Or just let them be as they are. Gnus will still use them as -before. - - -@node GroupLens -@section GroupLens -@cindex GroupLens - -GroupLens is a collaborative filtering system that helps you work -together with other people to find the quality news articles out of the -huge volume of news articles generated every day. - -To accomplish this the GroupLens system combines your opinions about -articles you have already read with the opinions of others who have done -likewise and gives you a personalized prediction for each unread news -article. Think of GroupLens as a matchmaker. GroupLens watches how you -rate articles, and finds other people that rate articles the same way. -Once it has found some people you agree with it tells you, in the form -of a prediction, what they thought of the article. You can use this -prediction to help you decide whether or not you want to read the -article. - -@menu -* Using GroupLens:: How to make Gnus use GroupLens. -* Rating Articles:: Letting GroupLens know how you rate articles. -* Displaying Predictions:: Displaying predictions given by GroupLens. -* GroupLens Variables:: Customizing GroupLens. -@end menu - - -@node Using GroupLens -@subsection Using GroupLens - -To use GroupLens you must register a pseudonym with your local Better -Bit Bureau (BBB). -@samp{http://www.cs.umn.edu/Research/GroupLens/bbb.html} is the only -better bit in town at the moment. - -Once you have registered you'll need to set a couple of variables. - -@table @code - -@item gnus-use-grouplens -@vindex gnus-use-grouplens -Setting this variable to a non-@code{nil} value will make Gnus hook into -all the relevant GroupLens functions. - -@item grouplens-pseudonym -@vindex grouplens-pseudonym -This variable should be set to the pseudonym you got when registering -with the Better Bit Bureau. - -@item grouplens-newsgroups -@vindex grouplens-newsgroups -A list of groups that you want to get GroupLens predictions for. - -@end table - -That's the minimum of what you need to get up and running with GroupLens. -Once you've registered, GroupLens will start giving you scores for -articles based on the average of what other people think. But, to get -the real benefit of GroupLens you need to start rating articles -yourself. Then the scores GroupLens gives you will be personalized for -you, based on how the people you usually agree with have already rated. - - -@node Rating Articles -@subsection Rating Articles - -In GroupLens, an article is rated on a scale from 1 to 5, inclusive. -Where 1 means something like this article is a waste of bandwidth and 5 -means that the article was really good. The basic question to ask -yourself is, "on a scale from 1 to 5 would I like to see more articles -like this one?" - -There are four ways to enter a rating for an article in GroupLens. - -@table @kbd - -@item r -@kindex r (GroupLens) -@findex bbb-summary-rate-article -This function will prompt you for a rating on a scale of one to five. - -@item k -@kindex k (GroupLens) -@findex grouplens-score-thread -This function will prompt you for a rating, and rate all the articles in -the thread. This is really useful for some of those long running giant -threads in rec.humor. - -@end table - -The next two commands, @kbd{n} and @kbd{,} take a numerical prefix to be -the score of the article you're reading. - -@table @kbd - -@item 1-5 n -@kindex n (GroupLens) -@findex grouplens-next-unread-article -Rate the article and go to the next unread article. - -@item 1-5 , -@kindex , (GroupLens) -@findex grouplens-best-unread-article -Rate the article and go to the next unread article with the highest score. - -@end table - -If you want to give the current article a score of 4 and then go to the -next article, just type @kbd{4 n}. - - -@node Displaying Predictions -@subsection Displaying Predictions - -GroupLens makes a prediction for you about how much you will like a -news article. The predictions from GroupLens are on a scale from 1 to -5, where 1 is the worst and 5 is the best. You can use the predictions -from GroupLens in one of three ways controlled by the variable -@code{gnus-grouplens-override-scoring}. - -@vindex gnus-grouplens-override-scoring -There are three ways to display predictions in grouplens. You may -choose to have the GroupLens scores contribute to, or override the -regular gnus scoring mechanism. override is the default; however, some -people prefer to see the Gnus scores plus the grouplens scores. To get -the separate scoring behavior you need to set -@code{gnus-grouplens-override-scoring} to @code{'separate}. To have the -GroupLens predictions combined with the grouplens scores set it to -@code{'override} and to combine the scores set -@code{gnus-grouplens-override-scoring} to @code{'combine}. When you use -the combine option you will also want to set the values for -@code{grouplens-prediction-offset} and -@code{grouplens-score-scale-factor}. - -@vindex grouplens-prediction-display -In either case, GroupLens gives you a few choices for how you would like -to see your predictions displayed. The display of predictions is -controlled by the @code{grouplens-prediction-display} variable. - -The following are legal values for that variable. - -@table @code -@item prediction-spot -The higher the prediction, the further to the right an @samp{*} is -displayed. - -@item confidence-interval -A numeric confidence interval. - -@item prediction-bar -The higher the prediction, the longer the bar. - -@item confidence-bar -Numerical confidence. - -@item confidence-spot -The spot gets bigger with more confidence. - -@item prediction-num -Plain-old numeric value. - -@item confidence-plus-minus -Prediction +/- confidence. - -@end table - - -@node GroupLens Variables -@subsection GroupLens Variables - -@table @code - -@item gnus-summary-grouplens-line-format -The summary line format used in GroupLens-enhanced summary buffers. It -accepts the same specs as the normal summary line format (@pxref{Summary -Buffer Lines}). The default is @samp{%U%R%z%l%I%(%[%4L: %-20,20n%]%) -%s\n}. - -@item grouplens-bbb-host -Host running the bbbd server. @samp{grouplens.cs.umn.edu} is the -default. - -@item grouplens-bbb-port -Port of the host running the bbbd server. The default is 9000. - -@item grouplens-score-offset -Offset the prediction by this value. In other words, subtract the -prediction value by this number to arrive at the effective score. The -default is 0. - -@item grouplens-score-scale-factor -This variable allows the user to magnify the effect of GroupLens scores. -The scale factor is applied after the offset. The default is 1. - -@end table - - -@node Advanced Scoring -@section Advanced Scoring - -Scoring on Subjects and From headers is nice enough, but what if you're -really interested in what a person has to say only when she's talking -about a particular subject? Or what if you really don't want to -read what person A has to say when she's following up to person B, but -want to read what she says when she's following up to person C? - -By using advanced scoring rules you may create arbitrarily complex -scoring patterns. - -@menu -* Advanced Scoring Syntax:: A definition. -* Advanced Scoring Examples:: What they look like. -* Advanced Scoring Tips:: Getting the most out of it. -@end menu - - -@node Advanced Scoring Syntax -@subsection Advanced Scoring Syntax - -Ordinary scoring rules have a string as the first element in the rule. -Advanced scoring rules have a list as the first element. The second -element is the score to be applied if the first element evaluated to a -non-@code{nil} value. - -These lists may consist of three logical operators, one redirection -operator, and various match operators. - -Logical operators: - -@table @code -@item & -@itemx and -This logical operator will evaluate each of its arguments until it finds -one that evaluates to @code{false}, and then it'll stop. If all arguments -evaluate to @code{true} values, then this operator will return -@code{true}. - -@item | -@itemx or -This logical operator will evaluate each of its arguments until it finds -one that evaluates to @code{true}. If no arguments are @code{true}, -then this operator will return @code{false}. - -@item ! -@itemx not -@itemx ¬ -This logical operator only takes a single argument. It returns the -logical negation of the value of its argument. - -@end table - -There is an @dfn{indirection operator} that will make its arguments -apply to the ancestors of the current article being scored. For -instance, @code{1-} will make score rules apply to the parent of the -current article. @code{2-} will make score rules apply to the -grandparent of the current article. Alternatively, you can write -@code{^^}, where the number of @code{^}s (carets) says how far back into -the ancestry you want to go. - -Finally, we have the match operators. These are the ones that do the -real work. Match operators are header name strings followed by a match -and a match type. A typical match operator looks like @samp{("from" -"Lars Ingebrigtsen" s)}. The header names are the same as when using -simple scoring, and the match types are also the same. - - -@node Advanced Scoring Examples -@subsection Advanced Scoring Examples - -Let's say you want to increase the score of articles written by Lars -when he's talking about Gnus: - -@example -((& - ("from" "Lars Ingebrigtsen") - ("subject" "Gnus")) - 1000) -@end example - -Quite simple, huh? - -When he writes long articles, he sometimes has something nice to say: - -@example -((& - ("from" "Lars Ingebrigtsen") - (| - ("subject" "Gnus") - ("lines" 100 >))) - 1000) -@end example - -However, when he responds to things written by Reig Eigil Logge, you -really don't want to read what he's written: - -@example -((& - ("from" "Lars Ingebrigtsen") - (1- ("from" "Reig Eigir Logge"))) - -100000) -@end example - -Everybody that follows up Redmondo when he writes about disappearing -socks should have their scores raised, but only when they talk about -white socks. However, when Lars talks about socks, it's usually not -very interesting: - -@example -((& - (1- - (& - ("from" "redmondo@@.*no" r) - ("body" "disappearing.*socks" t))) - (! ("from" "Lars Ingebrigtsen")) - ("body" "white.*socks")) - 1000) -@end example - -The possibilities are endless. - - -@node Advanced Scoring Tips -@subsection Advanced Scoring Tips - -The @code{&} and @code{|} logical operators do short-circuit logic. -That is, they stop processing their arguments when it's clear what the -result of the operation will be. For instance, if one of the arguments -of an @code{&} evaluates to @code{false}, there's no point in evaluating -the rest of the arguments. This means that you should put slow matches -(@samp{body}, @samp{header}) last and quick matches (@samp{from}, -@samp{subject}) first. - -The indirection arguments (@code{1-} and so on) will make their -arguments work on previous generations of the thread. If you say -something like: - -@example -... -(1- - (1- - ("from" "lars"))) -... -@end example - -Then that means "score on the from header of the grandparent of the -current article". An indirection is quite fast, but it's better to say: - -@example -(1- - (& - ("from" "Lars") - ("subject" "Gnus"))) -@end example - -than it is to say: - -@example -(& - (1- ("from" "Lars")) - (1- ("subject" "Gnus"))) -@end example - - -@node Score Decays -@section Score Decays -@cindex score decays -@cindex decays - -You may find that your scores have a tendency to grow without -bounds, especially if you're using adaptive scoring. If scores get too -big, they lose all meaning---they simply max out and it's difficult to -use them in any sensible way. - -@vindex gnus-decay-scores -@findex gnus-decay-score -@vindex gnus-score-decay-function -Gnus provides a mechanism for decaying scores to help with this problem. -When score files are loaded and @code{gnus-decay-scores} is -non-@code{nil}, Gnus will run the score files through the decaying -mechanism thereby lowering the scores of all non-permanent score rules. -The decay itself if performed by the @code{gnus-score-decay-function} -function, which is @code{gnus-decay-score} by default. Here's the -definition of that function: - -@lisp -(defun gnus-decay-score (score) - "Decay SCORE according to `gnus-score-decay-constant' and `gnus-score-decay-scale'." - (floor - (- score - (* (if (< score 0) 1 -1) - (min (abs score) - (max gnus-score-decay-constant - (* (abs score) - gnus-score-decay-scale))))))) -@end lisp - -@vindex gnus-score-decay-scale -@vindex gnus-score-decay-constant -@code{gnus-score-decay-constant} is 3 by default and -@code{gnus-score-decay-scale} is 0.05. This should cause the following: - -@enumerate -@item -Scores between -3 and 3 will be set to 0 when this function is called. - -@item -Scores with magnitudes between 3 and 60 will be shrunk by 3. - -@item -Scores with magnitudes greater than 60 will be shrunk by 5% of the -score. -@end enumerate - -If you don't like this decay function, write your own. It is called -with the score to be decayed as its only parameter, and it should return -the new score, which should be an integer. - -Gnus will try to decay scores once a day. If you haven't run Gnus for -four days, Gnus will decay the scores four times, for instance. - - -@node Various -@chapter Various - -@menu -* Process/Prefix:: A convention used by many treatment commands. -* Interactive:: Making Gnus ask you many questions. -* Formatting Variables:: You can specify what buffers should look like. -* Windows Configuration:: Configuring the Gnus buffer windows. -* Compilation:: How to speed Gnus up. -* Mode Lines:: Displaying information in the mode lines. -* Highlighting and Menus:: Making buffers look all nice and cozy. -* Buttons:: Get tendonitis 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. -* Moderation:: What to do if you're a moderator. -* XEmacs Enhancements:: There are more pictures and stuff under XEmacs. -* Fuzzy Matching:: What's the big fuzz? -* Thwarting Email Spam:: A how-to on avoiding unsolited commercial email. -* Various Various:: Things that are really various. -@end menu - - -@node Process/Prefix -@section Process/Prefix -@cindex process/prefix convention - -Many functions, among them functions for moving, decoding and saving -articles, use what is known as the @dfn{Process/Prefix convention}. - -This is a method for figuring out what articles the user wants the -command to be performed on. - -It goes like this: - -If the numeric prefix is N, perform the operation on the next N -articles, starting with the current one. If the numeric prefix is -negative, perform the operation on the previous N articles, starting -with the current one. - -@vindex transient-mark-mode -If @code{transient-mark-mode} in non-@code{nil} and the region is -active, all articles in the region will be worked upon. - -If there is no numeric prefix, but some articles are marked with the -process mark, perform the operation on the articles marked with -the process mark. - -If there is neither a numeric prefix nor any articles marked with the -process mark, just perform the operation on the current article. - -Quite simple, really, but it needs to be made clear so that surprises -are avoided. - -Commands that react to the process mark will push the current list of -process marked articles onto a stack and will then clear all process -marked articles. You can restore the previous configuration with the -@kbd{M P y} command (@pxref{Setting Process Marks}). - -@vindex gnus-summary-goto-unread -One thing that seems to shock & horrify lots of people is that, for -instance, @kbd{3 d} does exactly the same as @kbd{d} @kbd{d} @kbd{d}. -Since each @kbd{d} (which marks the current article as read) by default -goes to the next unread article after marking, this means that @kbd{3 d} -will mark the next three unread articles as read, no matter what the -summary buffer looks like. Set @code{gnus-summary-goto-unread} to -@code{nil} for a more straightforward action. - - -@node Interactive -@section Interactive -@cindex interaction - -@table @code - -@item gnus-novice-user -@vindex gnus-novice-user -If this variable is non-@code{nil}, you are either a newcomer to the -World of Usenet, or you are very cautious, which is a nice thing to be, -really. You will be given questions of the type ``Are you sure you want -to do this?'' before doing anything dangerous. This is @code{t} by -default. - -@item gnus-expert-user -@vindex gnus-expert-user -If this variable is non-@code{nil}, you will never ever be asked any -questions by Gnus. It will simply assume you know what you're doing, no -matter how strange. - -@item gnus-interactive-catchup -@vindex gnus-interactive-catchup -Require confirmation before catching up a group if non-@code{nil}. It -is @code{t} by default. - -@item gnus-interactive-exit -@vindex gnus-interactive-exit -Require confirmation before exiting Gnus. This variable is @code{t} by -default. -@end table - - -@node Formatting Variables -@section Formatting Variables -@cindex formatting variables - -Throughout this manual you've probably noticed lots of variables called things like @code{gnus-group-line-format} and -@code{gnus-summary-mode-line-format}. These control how Gnus is to -output lines in the various buffers. There's quite a lot of them. -Fortunately, they all use the same syntax, so there's not that much to -be annoyed by. - -Here's an example format spec (from the group buffer): @samp{%M%S%5y: -%(%g%)\n}. We see that it is indeed extremely ugly, and that there are -lots of percentages everywhere. - -@menu -* Formatting Basics:: A formatting variable is basically a format string. -* Advanced Formatting:: Modifying output in various ways. -* User-Defined Specs:: Having Gnus call your own functions. -* Formatting Fonts:: Making the formatting look colorful and nice. -@end menu - -Currently Gnus uses the following formatting variables: -@code{gnus-group-line-format}, @code{gnus-summary-line-format}, -@code{gnus-server-line-format}, @code{gnus-topic-line-format}, -@code{gnus-group-mode-line-format}, -@code{gnus-summary-mode-line-format}, -@code{gnus-article-mode-line-format}, -@code{gnus-server-mode-line-format}, and -@code{gnus-summary-pick-line-format}. - -All these format variables can also be arbitrary elisp forms. In that -case, they will be @code{eval}ed to insert the required lines. - -@kindex M-x gnus-update-format -@findex gnus-update-format -Gnus includes a command to help you while creating your own format -specs. @kbd{M-x gnus-update-format} will @code{eval} the current form, -update the spec in question and pop you to a buffer where you can -examine the resulting lisp code to be run to generate the line. - - - -@node Formatting Basics -@subsection Formatting Basics - -Each @samp{%} element will be replaced by some string or other when the -buffer in question is generated. @samp{%5y} means ``insert the @samp{y} -spec, and pad with spaces to get a 5-character field''. - -As with normal C and Emacs Lisp formatting strings, the numerical -modifier between the @samp{%} and the formatting type character will -@dfn{pad} the output so that it is always at least that long. -@samp{%5y} will make the field always (at least) five characters wide by -padding with spaces to the left. If you say @samp{%-5y}, it will pad to -the right instead. - -You may also wish to limit the length of the field to protect against -particularly wide values. For that you can say @samp{%4,6y}, which -means that the field will never be more than 6 characters wide and never -less than 4 characters wide. - - -@node Advanced Formatting -@subsection Advanced Formatting - -It is frequently useful to post-process the fields in some way. -Padding, limiting, cutting off parts and suppressing certain values can -be achieved by using @dfn{tilde modifiers}. A typical tilde spec might -look like @samp{%~(cut 3)~(ignore "0")y}. - -These are the legal modifiers: - -@table @code -@item pad -@itemx pad-left -Pad the field to the left with spaces until it reaches the required -length. - -@item pad-right -Pad the field to the right with spaces until it reaches the required -length. - -@item max -@itemx max-left -Cut off characters from the left until it reaches the specified length. - -@item max-right -Cut off characters from the right until it reaches the specified -length. - -@item cut -@itemx cut-left -Cut off the specified number of characters from the left. - -@item cut-right -Cut off the specified number of characters from the right. - -@item ignore -Return an empty string if the field is equal to the specified value. - -@item form -Use the specified form as the field value when the @samp{@@} spec is -used. -@end table - -Let's take an example. The @samp{%o} spec in the summary mode lines -will return a date in compact ISO8601 format---@samp{19960809T230410}. -This is quite a mouthful, so we want to shave off the century number and -the time, leaving us with a six-character date. That would be -@samp{%~(cut-left 2)~(max-right 6)~(pad 6)o}. (Cutting is done before -maxing, and we need the padding to ensure that the date is never less -than 6 characters to make it look nice in columns.) - -Ignoring is done first; then cutting; then maxing; and then as the very -last operation, padding. - -If you use lots of these advanced thingies, you'll find that Gnus gets -quite slow. This can be helped enormously by running @kbd{M-x -gnus-compile} when you are satisfied with the look of your lines. -@xref{Compilation}. - - -@node User-Defined Specs -@subsection User-Defined Specs - -All the specs allow for inserting user defined specifiers---@samp{u}. -The next character in the format string should be a letter. Gnus -will call the function @code{gnus-user-format-function-}@samp{X}, where -@samp{X} is the letter following @samp{%u}. The function will be passed -a single parameter---what the parameter means depends on what buffer -it's being called from. The function should return a string, which will -be inserted into the buffer just like information from any other -specifier. This function may also be called with dummy values, so it -should protect against that. - -You can also use tilde modifiers (@pxref{Advanced Formatting} to achieve -much the same without defining new functions. Here's an example: -@samp{%~(form (count-lines (point-min) (point)))@@}. The form -given here will be evaluated to yield the current line number, and then -inserted. - - -@node Formatting Fonts -@subsection Formatting Fonts - -There are specs for highlighting, and these are shared by all the format -variables. Text inside the @samp{%(} and @samp{%)} specifiers will get -the special @code{mouse-face} property set, which means that it will be -highlighted (with @code{gnus-mouse-face}) when you put the mouse pointer -over it. - -Text inside the @samp{%[} and @samp{%]} specifiers will have their -normal faces set using @code{gnus-face-0}, which is @code{bold} by -default. If you say @samp{%1[}, you'll get @code{gnus-face-1} instead, -and so on. Create as many faces as you wish. The same goes for the -@code{mouse-face} specs---you can say @samp{%3(hello%)} to have -@samp{hello} mouse-highlighted with @code{gnus-mouse-face-3}. - -Here's an alternative recipe for the group buffer: - -@lisp -;; Create three face types. -(setq gnus-face-1 'bold) -(setq gnus-face-3 'italic) - -;; We want the article count to be in -;; a bold and green face. So we create -;; a new face called `my-green-bold'. -(copy-face 'bold 'my-green-bold) -;; Set the color. -(set-face-foreground 'my-green-bold "ForestGreen") -(setq gnus-face-2 'my-green-bold) - -;; Set the new & fancy format. -(setq gnus-group-line-format - "%M%S%3@{%5y%@}%2[:%] %(%1@{%g%@}%)\n") -@end lisp - -I'm sure you'll be able to use this scheme to create totally unreadable -and extremely vulgar displays. Have fun! - -Note that the @samp{%(} specs (and friends) do not make any sense on the -mode-line variables. - - -@node Windows Configuration -@section Windows Configuration -@cindex windows configuration - -No, there's nothing here about X, so be quiet. - -@vindex gnus-use-full-window -If @code{gnus-use-full-window} non-@code{nil}, Gnus will delete all -other windows and occupy the entire Emacs screen by itself. It is -@code{t} by default. - -@vindex gnus-buffer-configuration -@code{gnus-buffer-configuration} describes how much space each Gnus -buffer should be given. Here's an excerpt of this variable: - -@lisp -((group (vertical 1.0 (group 1.0 point) - (if gnus-carpal (group-carpal 4)))) - (article (vertical 1.0 (summary 0.25 point) - (article 1.0)))) -@end lisp - -This is an alist. The @dfn{key} is a symbol that names some action or -other. For instance, when displaying the group buffer, the window -configuration function will use @code{group} as the key. A full list of -possible names is listed below. - -The @dfn{value} (i.e., the @dfn{split}) says how much space each buffer -should occupy. To take the @code{article} split as an example - - -@lisp -(article (vertical 1.0 (summary 0.25 point) - (article 1.0))) -@end lisp - -This @dfn{split} says that the summary buffer should occupy 25% of upper -half of the screen, and that it is placed over the article buffer. As -you may have noticed, 100% + 25% is actually 125% (yup, I saw y'all -reaching for that calculator there). However, the special number -@code{1.0} is used to signal that this buffer should soak up all the -rest of the space available after the rest of the buffers have taken -whatever they need. There should be only one buffer with the @code{1.0} -size spec per split. - -Point will be put in the buffer that has the optional third element -@code{point}. - -Here's a more complicated example: - -@lisp -(article (vertical 1.0 (group 4) - (summary 0.25 point) - (if gnus-carpal (summary-carpal 4)) - (article 1.0))) -@end lisp - -If the size spec is an integer instead of a floating point number, -then that number will be used to say how many lines a buffer should -occupy, not a percentage. - -If the @dfn{split} looks like something that can be @code{eval}ed (to be -precise---if the @code{car} of the split is a function or a subr), this -split will be @code{eval}ed. If the result is non-@code{nil}, it will -be used as a split. This means that there will be three buffers if -@code{gnus-carpal} is @code{nil}, and four buffers if @code{gnus-carpal} -is non-@code{nil}. - -Not complicated enough for you? Well, try this on for size: - -@lisp -(article (horizontal 1.0 - (vertical 0.5 - (group 1.0) - (gnus-carpal 4)) - (vertical 1.0 - (summary 0.25 point) - (summary-carpal 4) - (article 1.0)))) -@end lisp - -Whoops. Two buffers with the mystery 100% tag. And what's that -@code{horizontal} thingie? - -If the first element in one of the split is @code{horizontal}, Gnus will -split the window horizontally, giving you two windows side-by-side. -Inside each of these strips you may carry on all you like in the normal -fashion. The number following @code{horizontal} says what percentage of -the screen is to be given to this strip. - -For each split, there @emph{must} be one element that has the 100% tag. -The splitting is never accurate, and this buffer will eat any leftover -lines from the splits. - -To be slightly more formal, here's a definition of what a legal split -may look like: - -@example -split = frame | horizontal | vertical | buffer | form -frame = "(frame " size *split ")" -horizontal = "(horizontal " size *split ")" -vertical = "(vertical " size *split ")" -buffer = "(" buffer-name " " size *[ "point" ] ")" -size = number | frame-params -buffer-name = group | article | summary ... -@end example - -The limitations are that the @code{frame} split can only appear as the -top-level split. @var{form} should be an Emacs Lisp form that should -return a valid split. We see that each split is fully recursive, and -may contain any number of @code{vertical} and @code{horizontal} splits. - -@vindex gnus-window-min-width -@vindex gnus-window-min-height -@cindex window height -@cindex window width -Finding the right sizes can be a bit complicated. No window may be less -than @code{gnus-window-min-height} (default 1) characters high, and all -windows must be at least @code{gnus-window-min-width} (default 1) -characters wide. Gnus will try to enforce this before applying the -splits. If you want to use the normal Emacs window width/height limit, -you can just set these two variables to @code{nil}. - -If you're not familiar with Emacs terminology, @code{horizontal} and -@code{vertical} splits may work the opposite way of what you'd expect. -Windows inside a @code{horizontal} split are shown side-by-side, and -windows within a @code{vertical} split are shown above each other. - -@findex gnus-configure-frame -If you want to experiment with window placement, a good tip is to call -@code{gnus-configure-frame} directly with a split. This is the function -that does all the real work when splitting buffers. Below is a pretty -nonsensical configuration with 5 windows; two for the group buffer and -three for the article buffer. (I said it was nonsensical.) If you -@code{eval} the statement below, you can get an idea of how that would -look straight away, without going through the normal Gnus channels. -Play with it until you're satisfied, and then use -@code{gnus-add-configuration} to add your new creation to the buffer -configuration list. - -@lisp -(gnus-configure-frame - '(horizontal 1.0 - (vertical 10 - (group 1.0) - (article 0.3 point)) - (vertical 1.0 - (article 1.0) - (horizontal 4 - (group 1.0) - (article 10))))) -@end lisp - -You might want to have several frames as well. No prob---just use the -@code{frame} split: - -@lisp -(gnus-configure-frame - '(frame 1.0 - (vertical 1.0 - (summary 0.25 point) - (article 1.0)) - (vertical ((height . 5) (width . 15) - (user-position . t) - (left . -1) (top . 1)) - (picon 1.0)))) - -@end lisp - -This split will result in the familiar summary/article window -configuration in the first (or ``main'') frame, while a small additional -frame will be created where picons will be shown. As you can see, -instead of the normal @code{1.0} top-level spec, each additional split -should have a frame parameter alist as the size spec. -@xref{Frame Parameters, , Frame Parameters, elisp, The GNU Emacs Lisp -Reference Manual}. Under XEmacs, a frame property list will be -accepted, too---for instance, @code{(height 5 width 15 left -1 top 1)} -is such a plist. - -Here's a list of all possible keys for -@code{gnus-buffer-configuration}: - -@code{group}, @code{summary}, @code{article}, @code{server}, -@code{browse}, @code{message}, @code{pick}, @code{info}, -@code{summary-faq}, @code{edit-group}, @code{edit-server}, -@code{edit-score}, @code{post}, @code{reply}, @code{forward}, -@code{reply-yank}, @code{mail-bounce}, @code{draft}, @code{pipe}, -@code{bug}, @code{compose-bounce}. - -Note that the @code{message} key is used for both -@code{gnus-group-mail} and @code{gnus-summary-mail-other-window}. If -it is desirable to distinguish between the two, something like this -might be used: - -@lisp -(message (horizontal 1.0 - (vertical 1.0 (message 1.0 point)) - (vertical 0.24 - (if (buffer-live-p gnus-summary-buffer) - '(summary 0.5)) - (group 1.0))))) -@end lisp - -@findex gnus-add-configuration -Since the @code{gnus-buffer-configuration} variable is so long and -complicated, there's a function you can use to ease changing the config -of a single setting: @code{gnus-add-configuration}. If, for instance, -you want to change the @code{article} setting, you could say: - -@lisp -(gnus-add-configuration - '(article (vertical 1.0 - (group 4) - (summary .25 point) - (article 1.0)))) -@end lisp - -You'd typically stick these @code{gnus-add-configuration} calls in your -@file{.gnus.el} file or in some startup hook---they should be run after -Gnus has been loaded. - -@vindex gnus-always-force-window-configuration -If all windows mentioned in the configuration are already visible, Gnus -won't change the window configuration. If you always want to force the -``right'' window configuration, you can set -@code{gnus-always-force-window-configuration} to non-@code{nil}. - - -@node Compilation -@section Compilation -@cindex compilation -@cindex byte-compilation - -@findex gnus-compile - -Remember all those line format specification variables? -@code{gnus-summary-line-format}, @code{gnus-group-line-format}, and so -on. Now, Gnus will of course heed whatever these variables are, but, -unfortunately, changing them will mean a quite significant slow-down. -(The default values of these variables have byte-compiled functions -associated with them, while the user-generated versions do not, of -course.) - -To help with this, you can run @kbd{M-x gnus-compile} after you've -fiddled around with the variables and feel that you're (kind of) -satisfied. This will result in the new specs being byte-compiled, and -you'll get top speed again. Gnus will save these compiled specs in the -@file{.newsrc.eld} file. (User-defined functions aren't compiled by -this function, though---you should compile them yourself by sticking -them into the @code{.gnus.el} file and byte-compiling that file.) - - -@node Mode Lines -@section Mode Lines -@cindex mode lines - -@vindex gnus-updated-mode-lines -@code{gnus-updated-mode-lines} says what buffers should keep their mode -lines updated. It is a list of symbols. Supported symbols include -@code{group}, @code{article}, @code{summary}, @code{server}, -@code{browse}, and @code{tree}. If the corresponding symbol is present, -Gnus will keep that mode line updated with information that may be -pertinent. If this variable is @code{nil}, screen refresh may be -quicker. - -@cindex display-time - -@vindex gnus-mode-non-string-length -By default, Gnus displays information on the current article in the mode -lines of the summary and article buffers. The information Gnus wishes -to display (e.g. the subject of the article) is often longer than the -mode lines, and therefore have to be cut off at some point. The -@code{gnus-mode-non-string-length} variable says how long the other -elements on the line is (i.e., the non-info part). If you put -additional elements on the mode line (e.g. a clock), you should modify -this variable: - -@c Hook written by Francesco Potorti` -@lisp -(add-hook 'display-time-hook - (lambda () (setq gnus-mode-non-string-length - (+ 21 - (if line-number-mode 5 0) - (if column-number-mode 4 0) - (length display-time-string))))) -@end lisp - -If this variable is @code{nil} (which is the default), the mode line -strings won't be chopped off, and they won't be padded either. Note -that the default is unlikely to be desirable, as even the percentage -complete in the buffer may be crowded off the mode line; the user should -configure this variable appropriately for her configuration. - - -@node Highlighting and Menus -@section Highlighting and Menus -@cindex visual -@cindex highlighting -@cindex menus - -@vindex gnus-visual -The @code{gnus-visual} variable controls most of the Gnus-prettifying -aspects. If @code{nil}, Gnus won't attempt to create menus or use fancy -colors or fonts. This will also inhibit loading the @file{gnus-vis.el} -file. - -This variable can be a list of visual properties that are enabled. The -following elements are legal, and are all included by default: - -@table @code -@item group-highlight -Do highlights in the group buffer. -@item summary-highlight -Do highlights in the summary buffer. -@item article-highlight -Do highlights in the article buffer. -@item highlight -Turn on highlighting in all buffers. -@item group-menu -Create menus in the group buffer. -@item summary-menu -Create menus in the summary buffers. -@item article-menu -Create menus in the article buffer. -@item browse-menu -Create menus in the browse buffer. -@item server-menu -Create menus in the server buffer. -@item score-menu -Create menus in the score buffers. -@item menu -Create menus in all buffers. -@end table - -So if you only want highlighting in the article buffer and menus in all -buffers, you could say something like: - -@lisp -(setq gnus-visual '(article-highlight menu)) -@end lisp - -If you want highlighting only and no menus whatsoever, you'd say: - -@lisp -(setq gnus-visual '(highlight)) -@end lisp - -If @code{gnus-visual} is @code{t}, highlighting and menus will be used -in all Gnus buffers. - -Other general variables that influence the look of all buffers include: - -@table @code -@item gnus-mouse-face -@vindex gnus-mouse-face -This is the face (i.e., font) used for mouse highlighting in Gnus. No -mouse highlights will be done if @code{gnus-visual} is @code{nil}. - -@end table - -There are hooks associated with the creation of all the different menus: - -@table @code - -@item gnus-article-menu-hook -@vindex gnus-article-menu-hook -Hook called after creating the article mode menu. - -@item gnus-group-menu-hook -@vindex gnus-group-menu-hook -Hook called after creating the group mode menu. - -@item gnus-summary-menu-hook -@vindex gnus-summary-menu-hook -Hook called after creating the summary mode menu. - -@item gnus-server-menu-hook -@vindex gnus-server-menu-hook -Hook called after creating the server mode menu. - -@item gnus-browse-menu-hook -@vindex gnus-browse-menu-hook -Hook called after creating the browse mode menu. - -@item gnus-score-menu-hook -@vindex gnus-score-menu-hook -Hook called after creating the score mode menu. - -@end table - - -@node Buttons -@section Buttons -@cindex buttons -@cindex mouse -@cindex click - -Those new-fangled @dfn{mouse} contraptions is very popular with the -young, hep kids who don't want to learn the proper way to do things -these days. Why, I remember way back in the summer of '89, when I was -using Emacs on a Tops 20 system. Three hundred users on one single -machine, and every user was running Simula compilers. Bah! - -Right. - -@vindex gnus-carpal -Well, you can make Gnus display bufferfuls of buttons you can click to -do anything by setting @code{gnus-carpal} to @code{t}. Pretty simple, -really. Tell the chiropractor I sent you. - - -@table @code - -@item gnus-carpal-mode-hook -@vindex gnus-carpal-mode-hook -Hook run in all carpal mode buffers. - -@item gnus-carpal-button-face -@vindex gnus-carpal-button-face -Face used on buttons. - -@item gnus-carpal-header-face -@vindex gnus-carpal-header-face -Face used on carpal buffer headers. - -@item gnus-carpal-group-buffer-buttons -@vindex gnus-carpal-group-buffer-buttons -Buttons in the group buffer. - -@item gnus-carpal-summary-buffer-buttons -@vindex gnus-carpal-summary-buffer-buttons -Buttons in the summary buffer. - -@item gnus-carpal-server-buffer-buttons -@vindex gnus-carpal-server-buffer-buttons -Buttons in the server buffer. - -@item gnus-carpal-browse-buffer-buttons -@vindex gnus-carpal-browse-buffer-buttons -Buttons in the browse buffer. -@end table - -All the @code{buttons} variables are lists. The elements in these list -are either cons cells where the @code{car} contains a text to be displayed and -the @code{cdr} contains a function symbol, or a simple string. - - -@node Daemons -@section Daemons -@cindex demons -@cindex daemons - -Gnus, being larger than any program ever written (allegedly), does lots -of strange stuff that you may wish to have done while you're not -present. For instance, you may want it to check for new mail once in a -while. Or you may want it to close down all connections to all servers -when you leave Emacs idle. And stuff like that. - -Gnus will let you do stuff like that by defining various -@dfn{handlers}. Each handler consists of three elements: A -@var{function}, a @var{time}, and an @var{idle} parameter. - -Here's an example of a handler that closes connections when Emacs has -been idle for thirty minutes: - -@lisp -(gnus-demon-close-connections nil 30) -@end lisp - -Here's a handler that scans for PGP headers every hour when Emacs is -idle: - -@lisp -(gnus-demon-scan-pgp 60 t) -@end lisp - -This @var{time} parameter and than @var{idle} parameter work together -in a strange, but wonderful fashion. Basically, if @var{idle} is -@code{nil}, then the function will be called every @var{time} minutes. - -If @var{idle} is @code{t}, then the function will be called after -@var{time} minutes only if Emacs is idle. So if Emacs is never idle, -the function will never be called. But once Emacs goes idle, the -function will be called every @var{time} minutes. - -If @var{idle} is a number and @var{time} is a number, the function will -be called every @var{time} minutes only when Emacs has been idle for -@var{idle} minutes. - -If @var{idle} is a number and @var{time} is @code{nil}, the function -will be called once every time Emacs has been idle for @var{idle} -minutes. - -And if @var{time} is a string, it should look like @samp{07:31}, and -the function will then be called once every day somewhere near that -time. Modified by the @var{idle} parameter, of course. - -@vindex gnus-demon-timestep -(When I say ``minute'' here, I really mean @code{gnus-demon-timestep} -seconds. This is 60 by default. If you change that variable, -all the timings in the handlers will be affected.) - -@vindex gnus-use-demon -To set the whole thing in motion, though, you have to set -@code{gnus-use-demon} to @code{t}. - -So, if you want to add a handler, you could put something like this in -your @file{.gnus} file: - -@findex gnus-demon-add-handler -@lisp -(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-scan-timestamps}, @code{gnus-demon-add-rescan}, and -@code{gnus-demon-add-scanmail}. Just put those functions in your -@file{.gnus} if you want those abilities. - -@findex gnus-demon-init -@findex gnus-demon-cancel -@vindex gnus-demon-handlers -If you add handlers to @code{gnus-demon-handlers} directly, you should -run @code{gnus-demon-init} to make the changes take hold. To cancel all -daemons, you can use the @code{gnus-demon-cancel} function. - -Note that adding daemons can be pretty naughty if you overdo it. Adding -functions that scan all news and mail from all servers every two seconds -is a sure-fire way of getting booted off any respectable system. So -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 @samp{alt.nocem.misc} newsgroup. - -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. - -@item gnus-nocem-groups -@vindex gnus-nocem-groups -Gnus will look for NoCeM messages in the groups in this list. The -default is @code{("news.lists.filters" "news.admin.net-abuse.bulletins" -"alt.nocem.misc" "news.admin.net-abuse.announce")}. - -@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 @code{("Automoose-1" -"clewis@@ferret.ocunix.on.ca;" "jem@@xpat.com;" "red@@redpoll.mrfs.oh.us -(Richard E. Depew)")}; fine, upstanding citizens all of them. - -Known despammers that you can put in this list include: - -@table @samp -@item clewis@@ferret.ocunix.on.ca; -@cindex Chris Lewis -Chris Lewis---Major Canadian despammer who has probably canceled more -usenet abuse than anybody else. - -@item Automoose-1 -@cindex CancelMoose[tm] -The CancelMoose[tm] on autopilot. The CancelMoose[tm] is reputed to be -Norwegian, and was the person(s) who invented NoCeM. - -@item jem@@xpat.com; -@cindex Jem -John Milburn---despammer located in Korea who is getting very busy these -days. - -@item red@@redpoll.mrfs.oh.us (Richard E. Depew) -Richard E. Depew---lone American despammer. He mostly cancels binary -postings to non-binary groups and removes spews (regurgitated articles). -@end table - -You do not have to heed NoCeM messages from all these people---just the -ones you want to listen to. - -@item gnus-nocem-verifyer -@vindex gnus-nocem-verifyer -@findex mc-verify -This should be a function for verifying that the NoCeM issuer is who she -says she is. The default is @code{mc-verify}, which is a Mailcrypt -function. If this is too slow and you don't care for verification -(which may be dangerous), you can set this variable to @code{nil}. - -If you want signed NoCeM messages to be verified and unsigned messages -not to be verified (but used anyway), you could do something like: - -@lisp -(setq gnus-nocem-verifyer 'my-gnus-mc-verify) - -(defun my-gnus-mc-verify () - (not (eq 'forged - (ignore-errors - (if (mc-verify) - t - 'forged))))) -@end lisp - -This might be dangerous, though. - -@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. - -@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 - -It is very useful to be able to undo actions one has done. In normal -Emacs buffers, it's easy enough---you just push the @code{undo} button. -In Gnus buffers, however, it isn't that simple. - -The things Gnus displays in its buffer is of no value whatsoever to -Gnus---it's all just data designed to look nice to the user. -Killing a group in the group buffer with @kbd{C-k} makes the line -disappear, but that's just a side-effect of the real action---the -removal of the group in question from the internal Gnus structures. -Undoing something like that can't be done by the normal Emacs -@code{undo} function. - -Gnus tries to remedy this somewhat by keeping track of what the user -does and coming up with actions that would reverse the actions the user -takes. When the user then presses the @code{undo} key, Gnus will run -the code to reverse the previous action, or the previous actions. -However, not all actions are easily reversible, so Gnus currently offers -a few key functions to be undoable. These include killing groups, -yanking groups, and changing the list of read articles of groups. -That's it, really. More functions may be added in the future, but each -added function means an increase in data to be stored, so Gnus will -never be totally undoable. - -@findex gnus-undo-mode -@vindex gnus-use-undo -@findex gnus-undo -The undoability is provided by the @code{gnus-undo-mode} minor mode. It -is used if @code{gnus-use-undo} is non-@code{nil}, which is the -default. The @kbd{M-C-_} key performs the @code{gnus-undo} command -command, which should feel kinda like the normal Emacs @code{undo} -command. - - -@node Moderation -@section Moderation -@cindex moderation - -If you are a moderator, you can use the @file{gnus-mdrtn.el} package. -It is not included in the standard Gnus package. Write a mail to -@samp{larsi@@gnus.org} and state what group you moderate, and you'll -get a copy. - -The moderation package is implemented as a minor mode for summary -buffers. Put - -@lisp -(add-hook 'gnus-summary-mode-hook 'gnus-moderate) -@end lisp - -in your @file{.gnus.el} file. - -If you are the moderator of @samp{rec.zoofle}, this is how it's -supposed to work: - -@enumerate -@item -You split your incoming mail by matching on -@samp{Newsgroups:.*rec.zoofle}, which will put all the to-be-posted -articles in some mail group---for instance, @samp{nnml:rec.zoofle}. - -@item -You enter that group once in a while and post articles using the @kbd{e} -(edit-and-post) or @kbd{s} (just send unedited) commands. - -@item -If, while reading the @samp{rec.zoofle} newsgroup, you happen upon some -articles that weren't approved by you, you can cancel them with the -@kbd{c} command. -@end enumerate - -To use moderation mode in these two groups, say: - -@lisp -(setq gnus-moderated-list - "^nnml:rec.zoofle$\\|^rec.zoofle$") -@end lisp - - -@node XEmacs Enhancements -@section XEmacs Enhancements -@cindex XEmacs - -XEmacs is able to display pictures and stuff, so Gnus has taken -advantage of that. - -@menu -* Picons:: How to display pictures of what your reading. -* Smileys:: Show all those happy faces the way they were meant to be shown. -* Toolbar:: Click'n'drool. -* XVarious:: Other XEmacsy Gnusey variables. -@end menu - - -@node Picons -@subsection Picons - -@iftex -@iflatex -\gnuspicon{tmp/picons-att.ps} -\gnuspicon{tmp/picons-berkeley.ps} -\gnuspicon{tmp/picons-caltech.ps} -\gnuspicon{tmp/picons-canada.ps} -\gnuspicon{tmp/picons-cr.ps} -\gnuspicon{tmp/picons-cygnus.ps} -\gnuspicon{tmp/picons-gov.ps} -\gnuspicon{tmp/picons-mit.ps} -\gnuspicon{tmp/picons-nasa.ps} -\gnuspicon{tmp/picons-qmw.ps} -\gnuspicon{tmp/picons-rms.ps} -\gnuspicon{tmp/picons-ruu.ps} -@end iflatex -@end iftex - -So... You want to slow down your news reader even more! This is a -good way to do so. Its also a great way to impress people staring -over your shoulder as you read news. - -@menu -* Picon Basics:: What are picons and How do I get them. -* Picon Requirements:: Don't go further if you aren't using XEmacs. -* Easy Picons:: Displaying Picons---the easy way. -* Hard Picons:: The way you should do it. You'll learn something. -* Picon Configuration:: Other variables you can trash/tweak/munge/play with. -@end menu - - -@node Picon Basics -@subsubsection Picon Basics - -What are Picons? To quote directly from the Picons Web site: - -@quotation -@dfn{Picons} is short for ``personal icons''. They're small, -constrained images used to represent users and domains on the net, -organized into databases so that the appropriate image for a given -e-mail address can be found. Besides users and domains, there are picon -databases for Usenet newsgroups and weather forecasts. The picons are -in either monochrome @code{XBM} format or color @code{XPM} and -@code{GIF} formats. -@end quotation - -For instructions on obtaining and installing the picons databases, point -your Web browser at -@file{http://www.cs.indiana.edu/picons/ftp/index.html}. - -@vindex gnus-picons-database -Gnus expects picons to be installed into a location pointed to by -@code{gnus-picons-database}. - - -@node Picon Requirements -@subsubsection Picon Requirements - -To have Gnus display Picons for you, you must be running XEmacs -19.13 or greater since all other versions of Emacs aren't yet able to -display images. - -Additionally, you must have @code{xpm} support compiled into XEmacs. - -@vindex gnus-picons-convert-x-face -If you want to display faces from @code{X-Face} headers, you must have -the @code{netpbm} utilities installed, or munge the -@code{gnus-picons-convert-x-face} variable to use something else. - - -@node Easy Picons -@subsubsection Easy Picons - -To enable displaying picons, simply put the following line in your -@file{~/.gnus} file and start Gnus. - -@lisp -(setq gnus-use-picons t) -(add-hook 'gnus-article-display-hook 'gnus-article-display-picons t) -(add-hook 'gnus-summary-prepare-hook 'gnus-group-display-picons t) -(add-hook 'gnus-article-display-hook 'gnus-picons-article-display-x-face) -@end lisp - - -@node Hard Picons -@subsubsection Hard Picons - -Gnus can display picons for you as you enter and leave groups and -articles. It knows how to interact with three sections of the picons -database. Namely, it can display the picons newsgroup pictures, -author's face picture(s), and the authors domain. To enable this -feature, you need to first decide where to display them. - -@table @code - -@item gnus-picons-display-where -@vindex gnus-picons-display-where -Where the picon images should be displayed. It is @code{picons} by -default (which by default maps to the buffer @samp{*Picons*}). Other -valid places could be @code{article}, @code{summary}, or -@samp{*scratch*} for all I care. Just make sure that you've made the -buffer visible using the standard Gnus window configuration -routines---@pxref{Windows Configuration}. - -@end table - -@iftex -@iflatex -\gnuspicon{tmp/picons-seuu.ps} -\gnuspicon{tmp/picons-stanford.ps} -\gnuspicon{tmp/picons-sun.ps} -\gnuspicon{tmp/picons-ubc.ps} -\gnuspicon{tmp/picons-ufl.ps} -\gnuspicon{tmp/picons-uio.ps} -\gnuspicon{tmp/picons-unit.ps} -\gnuspicon{tmp/picons-upenn.ps} -\gnuspicon{tmp/picons-wesleyan.ps} -@end iflatex -@end iftex - -Note: If you set @code{gnus-use-picons} to @code{t}, it will set up your -window configuration for you to include the @code{picons} buffer. - -Now that you've made that decision, you need to add the following -functions to the appropriate hooks so these pictures will get -displayed at the right time. - -@vindex gnus-article-display-hook -@vindex gnus-picons-display-where -@table @code -@item gnus-article-display-picons -@findex gnus-article-display-picons -Looks up and displays the picons for the author and the author's domain -in the @code{gnus-picons-display-where} buffer. Should be added to the -@code{gnus-article-display-hook}. - -@item gnus-group-display-picons -@findex gnus-article-display-picons -Displays picons representing the current group. This function should -be added to the @code{gnus-summary-prepare-hook} or to the -@code{gnus-article-display-hook} if @code{gnus-picons-display-where} -is set to @code{article}. - -@item gnus-picons-article-display-x-face -@findex gnus-article-display-picons -Decodes and displays the X-Face header if present. This function -should be added to @code{gnus-article-display-hook}. - -@end table - -Note: You must append them to the hook, so make sure to specify 't' -for the append flag of @code{add-hook}: - -@lisp -(add-hook 'gnus-article-display-hook 'gnus-article-display-picons t) -@end lisp - - -@node Picon Configuration -@subsubsection Picon Configuration - -The following variables offer further control over how things are -done, where things are located, and other useless stuff you really -don't need to worry about. - -@table @code -@item gnus-picons-database -@vindex gnus-picons-database -The location of the picons database. Should point to a directory -containing the @file{news}, @file{domains}, @file{users} (and so on) -subdirectories. Defaults to @file{/usr/local/faces}. - -@item gnus-picons-news-directory -@vindex gnus-picons-news-directory -Sub-directory of the faces database containing the icons for -newsgroups. - -@item gnus-picons-user-directories -@vindex gnus-picons-user-directories -List of subdirectories to search in @code{gnus-picons-database} for user -faces. @code{("local" "users" "usenix" "misc")} is the default. - -@item gnus-picons-domain-directories -@vindex gnus-picons-domain-directories -List of subdirectories to search in @code{gnus-picons-database} for -domain name faces. Defaults to @code{("domains")}. Some people may -want to add @samp{unknown} to this list. - -@item gnus-picons-convert-x-face -@vindex gnus-picons-convert-x-face -The command to use to convert the @code{X-Face} header to an X bitmap -(@code{xbm}). Defaults to @code{(format "@{ echo '/* Width=48, -Height=48 */'; uncompface; @} | icontopbm | pbmtoxbm > %s" -gnus-picons-x-face-file-name)} - -@item gnus-picons-x-face-file-name -@vindex gnus-picons-x-face-file-name -Names a temporary file to store the @code{X-Face} bitmap in. Defaults -to @code{(format "/tmp/picon-xface.%s.xbm" (user-login-name))}. - -@item gnus-picons-buffer -@vindex gnus-picons-buffer -The name of the buffer that @code{picons} points to. Defaults to -@samp{*Icon Buffer*}. - -@end table - - -@node Smileys -@subsection Smileys -@cindex smileys - -@dfn{Smiley} is a package separate from Gnus, but since Gnus is -currently the only package that uses Smiley, it is documented here. - -In short---to use Smiley in Gnus, put the following in your -@file{.gnus.el} file: - -@lisp -(add-hook 'gnus-article-display-hook 'gnus-smiley-display t) -@end lisp - -Smiley maps text smiley faces---@samp{:-)}, @samp{:-=}, @samp{:-(} and -the like---to pictures and displays those instead of the text smiley -faces. The conversion is controlled by a list of regexps that matches -text and maps that to file names. - -@vindex smiley-nosey-regexp-alist -@vindex smiley-deformed-regexp-alist -Smiley supplies two example conversion alists by default: -@code{smiley-deformed-regexp-alist} (which matches @samp{:)}, @samp{:(} -and so on), and @code{smiley-nosey-regexp-alist} (which matches -@samp{:-)}, @samp{:-(} and so on). - -The alist used is specified by the @code{smiley-regexp-alist} variable, -which defaults to the value of @code{smiley-deformed-regexp-alist}. - -Here's the default value of @code{smiley-smiley-regexp-alist}: - -@lisp -(setq smiley-nosey-regexp-alist - '(("\\(:-+[<«]+\\)\\W" 1 "FaceAngry.xpm") - ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm") - ("\\(:-+D\\)\\W" 1 "FaceGrinning.xpm") - ("\\(:-+[@}»]+\\)\\W" 1 "FaceHappy.xpm") - ("\\(:-*)+\\)\\W" 1 "FaceHappy.xpm") - ("\\(:-+[/\\\"]+\\)\\W" 1 "FaceIronic.xpm") - ("\\([8|]-+[|Oo%]\\)\\W" 1 "FaceKOed.xpm") - ("\\([:|]-+#+\\)\\W" 1 "FaceNyah.xpm") - ("\\(:-+[(@{]+\\)\\W" 1 "FaceSad.xpm") - ("\\(:-+[Oo\*]\\)\\W" 1 "FaceStartled.xpm") - ("\\(:-+|\\)\\W" 1 "FaceStraight.xpm") - ("\\(:-+p\\)\\W" 1 "FaceTalking.xpm") - ("\\(:-+d\\)\\W" 1 "FaceTasty.xpm") - ("\\(;-+[>)@}»]+\\)\\W" 1 "FaceWinking.xpm") - ("\\(:-+[Vvµ]\\)\\W" 1 "FaceWry.xpm") - ("\\(][:8B]-[)>]\\)\\W" 1 "FaceDevilish.xpm") - ("\\([:|]-+P\\)\\W" 1 "FaceYukky.xpm"))) -@end lisp - -The first item in each element is the regexp to be matched; the second -element is the regexp match group that is to be replaced by the picture; -and the third element is the name of the file to be displayed. - -The following variables customize where Smiley will look for these -files, as well as the color to be used and stuff: - -@table @code - -@item smiley-data-directory -@vindex smiley-data-directory -Where Smiley will look for smiley faces files. - -@item smiley-flesh-color -@vindex smiley-flesh-color -Skin color. The default is @samp{yellow}, which is really racist. - -@item smiley-features-color -@vindex smiley-features-color -Color of the features of the face. The default is @samp{black}. - -@item smiley-tongue-color -@vindex smiley-tongue-color -Color of the tongue. The default is @samp{red}. - -@item smiley-circle-color -@vindex smiley-circle-color -Color of the circle around the face. The default is @samp{black}. - -@item smiley-mouse-face -@vindex smiley-mouse-face -Face used for mouse highlighting over the smiley face. - -@end table - - -@node Toolbar -@subsection Toolbar - -@table @code - -@item gnus-use-toolbar -@vindex gnus-use-toolbar -If @code{nil}, don't display toolbars. If non-@code{nil}, it should be -one of @code{default-toolbar}, @code{top-toolbar}, @code{bottom-toolbar}, -@code{right-toolbar}, or @code{left-toolbar}. - -@item gnus-group-toolbar -@vindex gnus-group-toolbar -The toolbar in the group buffer. - -@item gnus-summary-toolbar -@vindex gnus-summary-toolbar -The toolbar in the summary buffer. - -@item gnus-summary-mail-toolbar -@vindex gnus-summary-mail-toolbar -The toolbar in the summary buffer of mail groups. - -@end table - - -@node XVarious -@subsection Various XEmacs Variables - -@table @code -@item gnus-xmas-glyph-directory -@vindex gnus-xmas-glyph-directory -This is where Gnus will look for pictures. Gnus will normally -auto-detect this directory, but you may set it manually if you have an -unusual directory structure. - -@item gnus-xmas-logo-color-alist -@vindex gnus-xmas-logo-color-alist -This is an alist where the key is a type symbol and the values are the -foreground and background color of the splash page glyph. - -@item gnus-xmas-logo-color-style -@vindex gnus-xmas-logo-color-style -This is the key used to look up the color in the alist described above. -Legal values include @code{flame}, @code{pine}, @code{moss}, -@code{irish}, @code{sky}, @code{tin}, @code{velvet}, @code{grape}, -@code{labia}, @code{berry}, @code{neutral}, and @code{september}. - -@item gnus-xmas-modeline-glyph -@vindex gnus-xmas-modeline-glyph -A glyph displayed in all Gnus mode lines. It is a tiny gnu head by -default. - -@end table - - -@node Fuzzy Matching -@section Fuzzy Matching -@cindex fuzzy matching - -Gnus provides @dfn{fuzzy matching} of @code{Subject} lines when doing -things like scoring, thread gathering and thread comparison. - -As opposed to regular expression matching, fuzzy matching is very fuzzy. -It's so fuzzy that there's not even a definition of what @dfn{fuzziness} -means, and the implementation has changed over time. - -Basically, it tries to remove all noise from lines before comparing. -@samp{Re: }, parenthetical remarks, white space, and so on, are filtered -out of the strings before comparing the results. This often leads to -adequate results---even when faced with strings generated by text -manglers masquerading as newsreaders. - - -@node Thwarting Email Spam -@section Thwarting Email Spam -@cindex email spam -@cindex spam -@cindex UCE -@cindex unsolicited commercial email - -In these last days of the Usenet, commercial vultures are hanging about -and grepping through news like crazy to find email addresses they can -foist off their scams and products to. As a reaction to this, many -people have started putting nonsense addresses into their @code{From} -lines. I think this is counterproductive---it makes it difficult for -people to send you legitimate mail in response to things you write, as -well as making it difficult to see who wrote what. This rewriting may -perhaps be a bigger menace than the unsolicited commercial email itself -in the end. - -The biggest problem I have with email spam is that it comes in under -false pretenses. I press @kbd{g} and Gnus merrily informs me that I -have 10 new emails. I say ``Golly gee! Happy is me!'' and select the -mail group, only to find two pyramid schemes, seven advertisements -(``New! Miracle tonic for growing full, lustrouos hair on your toes!'') -and one mail asking me to repent and find some god. - -This is annoying. - -The way to deal with this is having Gnus split out all spam into a -@samp{spam} mail group (@pxref{Splitting Mail}). - -First, pick one (1) legal mail address that you can be reached at, and -put it in your @code{From} header of all your news articles. (I've -chosen @samp{larsi@@trym.ifi.uio.no}, but for many addresses on the form -@samp{larsi+usenet@@ifi.uio.no} will be a better choice. Ask your -sysadm whether your sendmail installation accepts keywords in the local -part of the mail address.) - -@lisp -(setq message-default-news-headers - "From: Lars Magne Ingebrigtsen \n") -@end lisp - -Then put the following split rule in @code{nnmail-split-fancy} -(@pxref{Fancy Mail Splitting}): - -@lisp -( - ... - (to "larsi@@trym.ifi.uio.no" - (| ("subject" "re:.*" "misc") - ("references" ".*@@.*" "misc") - "spam")) - ... -) -@end lisp - -This says that all mail to this address is suspect, but if it has a -@code{Subject} that starts with a @samp{Re:} or has a @code{References} -header, it's probably ok. All the rest goes to the @samp{spam} group. -(This idea probably comes from Tim Pierce.) - -In addition, many mail spammers talk directly to your @code{smtp} server -and do not include your email address explicitly in the @code{To} -header. Why they do this is unknown---perhaps it's to thwart this -twarting scheme? In any case, this is trivial to deal with---you just -put anything not addressed to you in the @samp{spam} group by ending -your fancy split rule in this way: - -@lisp -( - ... - (to "larsi" "misc") - "spam") -@end lisp - -In my experience, this will sort virtually everything into the right -group. You still have to check the @samp{spam} group from time to time to -check for legitimate mail, though. If you feel like being a good net -citizen, you can even send off complaints to the proper authorities on -each unsolicited commercial email---at your leisure. - -If you are also a lazy net citizen, you will probably prefer complaining -automatically with the @file{gnus-junk.el} package, availiable FOR FREE -at @file{}. -Since most e-mail spam is sent automatically, this may reconcile the -cosmic balance somewhat. - -This works for me. It allows people an easy way to contact me (they can -just press @kbd{r} in the usual way), and I'm not bothered at all with -spam. It's a win-win situation. Forging @code{From} headers to point -to non-existant domains is yucky, in my opinion. - - -@node Various Various -@section Various Various -@cindex mode lines -@cindex highlights - -@table @code - -@item gnus-home-directory -All Gnus path variables will be initialized from this variable, which -defaults to @file{~/}. - -@item gnus-directory -@vindex gnus-directory -Most Gnus storage path variables will be initialized from this variable, -which defaults to the @samp{SAVEDIR} environment variable, or -@file{~/News/} if that variable isn't set. - -@item gnus-default-directory -@vindex gnus-default-directory -Not related to the above variable at all---this variable says what the -default directory of all Gnus buffers should be. If you issue commands -like @kbd{C-x C-f}, the prompt you'll get starts in the current buffer's -default directory. If this variable is @code{nil} (which is the -default), the default directory will be the default directory of the -buffer you were in when you started Gnus. - -@item gnus-verbose -@vindex gnus-verbose -This variable is an integer between zero and ten. The higher the value, -the more messages will be displayed. If this variable is zero, Gnus -will never flash any messages, if it is seven (which is the default), -most important messages will be shown, and if it is ten, Gnus won't ever -shut up, but will flash so many messages it will make your head swim. - -@item gnus-verbose-backends -@vindex gnus-verbose-backends -This variable works the same way as @code{gnus-verbose}, but it applies -to the Gnus backends instead of Gnus proper. - -@item nnheader-max-head-length -@vindex nnheader-max-head-length -When the backends read straight heads of articles, they all try to read -as little as possible. This variable (default 4096) specifies -the absolute max length the backends will try to read before giving up -on finding a separator line between the head and the body. If this -variable is @code{nil}, there is no upper read bound. If it is -@code{t}, the backends won't try to read the articles piece by piece, -but read the entire articles. This makes sense with some versions of -@code{ange-ftp} or @code{efs}. - -@item nnheader-head-chop-length -@vindex nnheader-head-chop-length -This variable (default 2048) says how big a piece of each article to -read when doing the operation described above. - -@item nnheader-file-name-translation-alist -@vindex nnheader-file-name-translation-alist -@cindex file names -@cindex illegal characters in file names -@cindex characters in file names -This is an alist that says how to translate characters in file names. -For instance, if @samp{:} is illegal as a file character in file names -on your system (you OS/2 user you), you could say something like: - -@lisp -(setq nnheader-file-name-translation-alist - '((?: . ?_))) -@end lisp - -In fact, this is the default value for this variable on OS/2 and MS -Windows (phooey) systems. - -@item gnus-hidden-properties -@vindex gnus-hidden-properties -This is a list of properties to use to hide ``invisible'' text. It is -@code{(invisible t intangible t)} by default on most systems, which -makes invisible text invisible and intangible. - -@item gnus-parse-headers-hook -@vindex gnus-parse-headers-hook -A hook called before parsing headers. It can be used, for instance, to -gather statistics on the headers fetched, or perhaps you'd like to prune -some headers. I don't see why you'd want that, though. - -@item gnus-shell-command-separator -@vindex gnus-shell-command-separator -String used to separate two shell commands. The default is @samp{;}. - - -@end table - - -@node The End -@chapter The End - -Well, that's the manual---you can get on with your life now. Keep in -touch. Say hello to your cats from me. - -My @strong{ghod}---I just can't stand goodbyes. Sniffle. - -Ol' Charles Reznikoff said it pretty well, so I leave the floor to him: - -@quotation -@strong{Te Deum} - -@sp 1 -Not because of victories @* -I sing,@* -having none,@* -but for the common sunshine,@* -the breeze,@* -the largess of the spring. - -@sp 1 -Not for victory@* -but for the day's work done@* -as well as I was able;@* -not for a seat upon the dais@* -but at the common table.@* -@end quotation - - -@node Appendices -@chapter Appendices - -@menu -* History:: How Gnus got where it is today. -* Terminology:: We use really difficult, like, words here. -* Customization:: Tailoring Gnus to your needs. -* Troubleshooting:: What you might try if things do not work. -* A Programmers Guide to Gnus:: Rilly, rilly technical stuff. -* Emacs for Heathens:: A short introduction to Emacsian terms. -* Frequently Asked Questions:: A question-and-answer session. -@end menu - - -@node History -@section History - -@cindex history -@sc{gnus} was written by Masanobu @sc{Umeda}. When autumn crept up in -'94, Lars Magne Ingebrigtsen grew bored and decided to rewrite Gnus. - -If you want to investigate the person responsible for this outrage, you -can point your (feh!) web browser to -@file{http://www.ifi.uio.no/~larsi/}. This is also the primary -distribution point for the new and spiffy versions of Gnus, and is known -as The Site That Destroys Newsrcs And Drives People Mad. - -During the first extended alpha period of development, the new Gnus was -called ``(ding) Gnus''. @dfn{(ding)} is, of course, short for -@dfn{ding is not Gnus}, which is a total and utter lie, but who cares? -(Besides, the ``Gnus'' in this abbreviation should probably be -pronounced ``news'' as @sc{Umeda} intended, which makes it a more -appropriate name, don't you think?) - -In any case, after spending all that energy on coming up with a new and -spunky name, we decided that the name was @emph{too} spunky, so we -renamed it back again to ``Gnus''. But in mixed case. ``Gnus'' vs. -``@sc{gnus}''. New vs. old. - -The first ``proper'' release of Gnus 5 was done in November 1995 when it -was included in the Emacs 19.30 distribution (132 (ding) Gnus releases -plus 15 Gnus 5.0 releases). - -In May 1996 the next Gnus generation (aka. ``September Gnus'' (after 99 -releases)) was released under the name ``Gnus 5.2'' (40 releases). - -On July 28th 1996 work on Red Gnus was begun, and it was released on -January 25th 1997 (after 84 releases) as ``Gnus 5.4''. - -If you happen upon a version of Gnus that has a prefixed name -- -``(ding) Gnus'', ``September Gnus'', ``Red Gnus'', ``Quassia Gnus'' -- -don't panic. Don't let it know that you're frightened. Back away. -Slowly. Whatever you do, don't run. Walk away, calmly, until you're -out of its reach. Find a proper released version of Gnus and snuggle up -to that instead. - -@menu -* Why?:: What's the point of Gnus? -* Compatibility:: Just how compatible is Gnus with @sc{gnus}? -* Conformity:: Gnus tries to conform to all standards. -* Emacsen:: Gnus can be run on a few modern Emacsen. -* Contributors:: Oodles of people. -* New Features:: Pointers to some of the new stuff in Gnus. -* Newest Features:: Features so new that they haven't been written yet. -@end menu - - -@node Why? -@subsection Why? - -What's the point of Gnus? - -I want to provide a ``rad'', ``happening'', ``way cool'' and ``hep'' -newsreader, that lets you do anything you can think of. That was my -original motivation, but while working on Gnus, it has become clear to -me that this generation of newsreaders really belong in the stone age. -Newsreaders haven't developed much since the infancy of the net. If the -volume continues to rise with the current rate of increase, all current -newsreaders will be pretty much useless. How do you deal with -newsgroups that have thousands of new articles each day? How do you -keep track of millions of people who post? - -Gnus offers no real solutions to these questions, but I would very much -like to see Gnus being used as a testing ground for new methods of -reading and fetching news. Expanding on @sc{Umeda}-san's wise decision -to separate the newsreader from the backends, Gnus now offers a simple -interface for anybody who wants to write new backends for fetching mail -and news from different sources. I have added hooks for customizations -everywhere I could imagine it being useful. By doing so, I'm inviting -every one of you to explore and invent. - -May Gnus never be complete. @kbd{C-u 100 M-x all-hail-emacs} and -@kbd{C-u 100 M-x all-hail-xemacs}. - - -@node Compatibility -@subsection Compatibility - -@cindex compatibility -Gnus was designed to be fully compatible with @sc{gnus}. Almost all key -bindings have been kept. More key bindings have been added, of course, -but only in one or two obscure cases have old bindings been changed. - -Our motto is: -@quotation -@cartouche -@center In a cloud bones of steel. -@end cartouche -@end quotation - -All commands have kept their names. Some internal functions have changed -their names. - -The @code{gnus-uu} package has changed drastically. @xref{Decoding -Articles}. - -One major compatibility question is the presence of several summary -buffers. All variables relevant while reading a group are -buffer-local to the summary buffer they belong in. Although many -important variables have their values copied into their global -counterparts whenever a command is executed in the summary buffer, this -change might lead to incorrect values being used unless you are careful. - -All code that relies on knowledge of @sc{gnus} internals will probably -fail. To take two examples: Sorting @code{gnus-newsrc-alist} (or -changing it in any way, as a matter of fact) is strictly verboten. Gnus -maintains a hash table that points to the entries in this alist (which -speeds up many functions), and changing the alist directly will lead to -peculiar results. - -@cindex hilit19 -@cindex highlighting -Old hilit19 code does not work at all. In fact, you should probably -remove all hilit code from all Gnus hooks -(@code{gnus-group-prepare-hook} and @code{gnus-summary-prepare-hook}). -Gnus provides various integrated functions for highlighting. These are -faster and more accurate. To make life easier for everybody, Gnus will -by default remove all hilit calls from all hilit hooks. Uncleanliness! -Away! - -Packages like @code{expire-kill} will no longer work. As a matter of -fact, you should probably remove all old @sc{gnus} packages (and other -code) when you start using Gnus. More likely than not, Gnus already -does what you have written code to make @sc{gnus} do. (Snicker.) - -Even though old methods of doing things are still supported, only the -new methods are documented in this manual. If you detect a new method of -doing something while reading this manual, that does not mean you have -to stop doing it the old way. - -Gnus understands all @sc{gnus} startup files. - -@kindex M-x gnus-bug -@findex gnus-bug -@cindex reporting bugs -@cindex bugs -Overall, a casual user who hasn't written much code that depends on -@sc{gnus} internals should suffer no problems. If problems occur, -please let me know by issuing that magic command @kbd{M-x gnus-bug}. - - -@node Conformity -@subsection Conformity - -No rebels without a clue here, ma'am. We conform to all standards known -to (wo)man. Except for those standards and/or conventions we disagree -with, of course. - -@table @strong - -@item RFC 822 -@cindex RFC 822 -There are no known breaches of this standard. - -@item RFC 1036 -@cindex RFC 1036 -There are no known breaches of this standard, either. - -@item Good Net-Keeping Seal of Approval -@cindex Good Net-Keeping Seal of Approval -Gnus has been through the Seal process and failed. I think it'll pass -the next inspection. - -@item Son-of-RFC 1036 -@cindex Son-of-RFC 1036 -We do have some breaches to this one. - -@table @emph - -@item MIME -Gnus does no MIME handling, and this standard-to-be seems to think that -MIME is the bees' knees, so we have major breakage here. - -@item X-Newsreader -This is considered to be a ``vanity header'', while I consider it to be -consumer information. After seeing so many badly formatted articles -coming from @code{tin} and @code{Netscape} I know not to use either of -those for posting articles. I would not have known that if it wasn't -for the @code{X-Newsreader} header. -@end table - -@end table - -If you ever notice Gnus acting non-compliant with regards to the texts -mentioned above, don't hesitate to drop a note to Gnus Towers and let us -know. - - -@node Emacsen -@subsection Emacsen -@cindex Emacsen -@cindex XEmacs -@cindex Mule -@cindex Emacs - -Gnus should work on : - -@itemize @bullet - -@item -Emacs 19.32 and up. - -@item -XEmacs 19.14 and up. - -@item -Mule versions based on Emacs 19.32 and up. - -@end itemize - -Gnus will absolutely not work on any Emacsen older than that. Not -reliably, at least. - -There are some vague differences between Gnus on the various -platforms---XEmacs features more graphics (a logo and a toolbar)---but -other than that, things should look pretty much the same under all -Emacsen. - - -@node Contributors -@subsection Contributors -@cindex contributors - -The new Gnus version couldn't have been done without the help of all the -people on the (ding) mailing list. Every day for over a year I have -gotten billions of nice bug reports from them, filling me with joy, -every single one of them. Smooches. The people on the list have been -tried beyond endurance, what with my ``oh, that's a neat idea , yup, I'll release it right away no wait, that doesn't -work at all , yup, I'll ship that one off right away no, wait, that absolutely does not work'' policy for releases. -Micro$oft---bah. Amateurs. I'm @emph{much} worse. (Or is that -``worser''? ``much worser''? ``worsest''?) - -I would like to take this opportunity to thank the Academy for... oops, -wrong show. - -@itemize @bullet - -@item -Masanobu @sc{Umeda}---the writer of the original @sc{gnus}. - -@item -Per Abrahamsen---custom, scoring, highlighting and @sc{soup} code (as -well as numerous other things). - -@item -Luis Fernandes---design and graphics. - -@item -Erik Naggum---help, ideas, support, code and stuff. - -@item -Wes Hardaker---@file{gnus-picon.el} and the manual section on -@dfn{picons} (@pxref{Picons}). - -@item -Kim-Minh Kaplan---further work on the picon code. - -@item -Brad Miller---@file{gnus-gl.el} and the GroupLens manual section -(@pxref{GroupLens}). - -@item -Sudish Joseph---innumerable bug fixes. - -@item -Ilja Weis---@file{gnus-topic.el}. - -@item -Steven L. Baur---lots and lots and lots of bugs detections and fixes. - -@item -Vladimir Alexiev---the refcard and reference booklets. - -@item -Felix Lee & Jamie Zawinsky---I stole some pieces from the XGnus -distribution by Felix Lee and JWZ. - -@item -Scott Byer---@file{nnfolder.el} enhancements & rewrite. - -@item -Peter Mutsaers---orphan article scoring code. - -@item -Ken Raeburn---POP mail support. - -@item -Hallvard B Furuseth---various bits and pieces, especially dealing with -.newsrc files. - -@item -Brian Edmonds---@file{gnus-bbdb.el}. - -@item -David Moore---rewrite of @file{nnvirtual.el} and many other things. - -@item -Kevin Davidson---came up with the name @dfn{ding}, so blame him. - -@item -François Pinard---many, many interesting and thorough bug reports. - -@end itemize - -This manual was proof-read by Adrian Aichner, with Ricardo Nassif, Mark -Borges, and Jost Krieger proof-reading parts of the manual. - -The following people have contributed many patches and suggestions: - -Christopher Davis, -Andrew Eskilsson, -Kai Grossjohann, -David Kågedal, -Richard Pieri, -Fabrice Popineau, -Daniel Quinlan, -Jason L. Tibbitts, III, -and -Jack Vinson. - -Also thanks to the following for patches and stuff: - -Adrian Aichner, -Peter Arius, -Matt Armstrong, -Marc Auslander, -Chris Bone, -Mark Borges, -Lance A. Brown, -Kees de Bruin, -Martin Buchholz, -Kevin Buhr, -Alastair Burt, -Joao Cachopo, -Zlatko Calusic, -Massimo Campostrini, -Dan Christensen, -Michael R. Cook, -Glenn Coombs, -Frank D. Cringle, -Geoffrey T. Dairiki, -Andre Deparade, -Ulrik Dickow, -Dave Disser, -Joev Dubach, -Michael Welsh Duggan, -Paul Eggert, -Michael Ernst, -Luc Van Eycken, -Sam Falkner, -Paul Franklin, -Guy Geens, -Arne Georg Gleditsch, -David S. Goldberg, -D. Hall, -Magnus Hammerin, -Raja R. Harinath, -Hisashige Kenji, @c Hisashige -Marc Horowitz, -Gunnar Horrigmo, -Brad Howes, -François Felix Ingrand, -Ishikawa Ichiro, @c Ishikawa -Lee Iverson, -Rajappa Iyer, -Randell Jesup, -Fred Johansen, -Greg Klanderman, -Karl Kleinpaste, -Peter Skov Knudsen, -Shuhei Kobayashi, @c Kobayashi -Thor Kristoffersen, -Jens Lautenbacher, -Carsten Leonhardt, -James LewisMoss, -Christian Limpach, -Markus Linnala, -Dave Love, -Tonny Madsen, -Shlomo Mahlab, -Nat Makarevitch, -David Martin, -Gordon Matzigkeit, -Timo Metzemakers, -Richard Mlynarik, -Lantz Moore, -Morioka Tomohiko, @c Morioka -Erik Toubro Nielsen, -Hrvoje Niksic, -Andy Norman, -C. R. Oldham, -Alexandre Oliva, -Ken Olstad, -Masaharu Onishi, @c Onishi -Hideki Ono, @c Ono -William Perry, -Stephen Peters, -Ulrich Pfeifer, -John McClary Prevost, -Colin Rafferty, -Bart Robinson, -Jason Rumney, -Dewey M. Sasser, -Loren Schall, -Dan Schmidt, -Ralph Schleicher, -Philippe Schnoebelen, -Randal L. Schwartz, -Danny Siu, -Paul D. Smith, -Jeff Sparkes, -Toby Speight, -Michael Sperber, -Darren Stalder, -Richard Stallman, -Greg Stark, -Paul Stodghill, -Kurt Swanson, -Samuel Tardieu, -Teddy, -Chuck Thompson, -Philippe Troin, -Aaron M. Ucko, -Jan Vroonhof, -Barry A. Warsaw, -Christoph Wedler, -Joe Wells, -and -Katsumi Yamaoka. @c Yamaoka - -For a full overview of what each person has done, the ChangeLogs -included in the Gnus alpha distributions should give ample reading -(550kB and counting). - -Apologies to everybody that I've forgotten, of which there are many, I'm -sure. - -Gee, that's quite a list of people. I guess that must mean that there -actually are people who are using Gnus. Who'd'a thunk it! - - -@node New Features -@subsection New Features -@cindex new features - -@menu -* ding Gnus:: New things in Gnus 5.0/5.1, the first new Gnus. -* September Gnus:: The Thing Formally Known As Gnus 5.3/5.3. -* Red Gnus:: Third time best---Gnus 5.4/5.5. -@end menu - -These lists are, of course, just @emph{short} overviews of the -@emph{most} important new features. No, really. There are tons more. -Yes, we have feeping creaturism in full effect. - - -@node ding Gnus -@subsubsection (ding) Gnus - -New features in Gnus 5.0/5.1: - -@itemize @bullet - -@item -The look of all buffers can be changed by setting format-like variables -(@pxref{Group Buffer Format} and @pxref{Summary Buffer Format}). - -@item -Local spool and several @sc{nntp} servers can be used at once -(@pxref{Select Methods}). - -@item -You can combine groups into virtual groups (@pxref{Virtual Groups}). - -@item -You can read a number of different mail formats (@pxref{Getting Mail}). -All the mail backends implement a convenient mail expiry scheme -(@pxref{Expiring Mail}). - -@item -Gnus can use various strategies for gathering threads that have lost -their roots (thereby gathering loose sub-threads into one thread) or it -can go back and retrieve enough headers to build a complete thread -(@pxref{Customizing Threading}). - -@item -Killed groups can be displayed in the group buffer, and you can read -them as well (@pxref{Listing Groups}). - -@item -Gnus can do partial group updates---you do not have to retrieve the -entire active file just to check for new articles in a few groups -(@pxref{The Active File}). - -@item -Gnus implements a sliding scale of subscribedness to groups -(@pxref{Group Levels}). - -@item -You can score articles according to any number of criteria -(@pxref{Scoring}). You can even get Gnus to find out how to score -articles for you (@pxref{Adaptive Scoring}). - -@item -Gnus maintains a dribble buffer that is auto-saved the normal Emacs -manner, so it should be difficult to lose much data on what you have -read if your machine should go down (@pxref{Auto Save}). - -@item -Gnus now has its own startup file (@file{.gnus}) to avoid cluttering up -the @file{.emacs} file. - -@item -You can set the process mark on both groups and articles and perform -operations on all the marked items (@pxref{Process/Prefix}). - -@item -You can grep through a subset of groups and create a group from the -results (@pxref{Kibozed Groups}). - -@item -You can list subsets of groups according to, well, anything -(@pxref{Listing Groups}). - -@item -You can browse foreign servers and subscribe to groups from those -servers (@pxref{Browse Foreign Server}). - -@item -Gnus can fetch articles, asynchronously, on a second connection to the -server (@pxref{Asynchronous Fetching}). - -@item -You can cache articles locally (@pxref{Article Caching}). - -@item -The uudecode functions have been expanded and generalized -(@pxref{Decoding Articles}). - -@item -You can still post uuencoded articles, which was a little-known feature -of @sc{gnus}' past (@pxref{Uuencoding and Posting}). - -@item -Fetching parents (and other articles) now actually works without -glitches (@pxref{Finding the Parent}). - -@item -Gnus can fetch FAQs and group descriptions (@pxref{Group Information}). - -@item -Digests (and other files) can be used as the basis for groups -(@pxref{Document Groups}). - -@item -Articles can be highlighted and customized (@pxref{Customizing -Articles}). - -@item -URLs and other external references can be buttonized (@pxref{Article -Buttons}). - -@item -You can do lots of strange stuff with the Gnus window & frame -configuration (@pxref{Windows Configuration}). - -@item -You can click on buttons instead of using the keyboard -(@pxref{Buttons}). - -@end itemize - - -@node September Gnus -@subsubsection September Gnus - -New features in Gnus 5.2/5.3: - -@itemize @bullet - -@item -A new message composition mode is used. All old customization variables -for @code{mail-mode}, @code{rnews-reply-mode} and @code{gnus-msg} are -now obsolete. - -@item -Gnus is now able to generate @dfn{sparse} threads---threads where -missing articles are represented by empty nodes (@pxref{Customizing -Threading}). - -@lisp -(setq gnus-build-sparse-threads 'some) -@end lisp - -@item -Outgoing articles are stored on a special archive server -(@pxref{Archived Messages}). - -@item -Partial thread regeneration now happens when articles are -referred. - -@item -Gnus can make use of GroupLens predictions (@pxref{GroupLens}). - -@item -Picons (personal icons) can be displayed under XEmacs (@pxref{Picons}). - -@item -A @code{trn}-like tree buffer can be displayed (@pxref{Tree Display}). - -@lisp -(setq gnus-use-trees t) -@end lisp - -@item -An @code{nn}-like pick-and-read minor mode is available for the summary -buffers (@pxref{Pick and Read}). - -@lisp -(add-hook 'gnus-summary-mode-hook 'gnus-pick-mode) -@end lisp - -@item -In binary groups you can use a special binary minor mode (@pxref{Binary -Groups}). - -@item -Groups can be grouped in a folding topic hierarchy (@pxref{Group -Topics}). - -@lisp -(add-hook 'gnus-group-mode-hook 'gnus-topic-mode) -@end lisp - -@item -Gnus can re-send and bounce mail (@pxref{Summary Mail Commands}). - -@item -Groups can now have a score, and bubbling based on entry frequency -is possible (@pxref{Group Score}). - -@lisp -(add-hook 'gnus-summary-exit-hook 'gnus-summary-bubble-group) -@end lisp - -@item -Groups can be process-marked, and commands can be performed on -groups of groups (@pxref{Marking Groups}). - -@item -Caching is possible in virtual groups. - -@item -@code{nndoc} now understands all kinds of digests, mail boxes, rnews -news batches, ClariNet briefs collections, and just about everything -else (@pxref{Document Groups}). - -@item -Gnus has a new backend (@code{nnsoup}) to create/read SOUP packets -(@pxref{SOUP}). - -@item -The Gnus cache is much faster. - -@item -Groups can be sorted according to many criteria (@pxref{Sorting -Groups}). - -@item -New group parameters have been introduced to set list-addresses and -expiry times (@pxref{Group Parameters}). - -@item -All formatting specs allow specifying faces to be used -(@pxref{Formatting Fonts}). - -@item -There are several more commands for setting/removing/acting on process -marked articles on the @kbd{M P} submap (@pxref{Setting Process Marks}). - -@item -The summary buffer can be limited to show parts of the available -articles based on a wide range of criteria. These commands have been -bound to keys on the @kbd{/} submap (@pxref{Limiting}). - -@item -Articles can be made persistent with the @kbd{*} command -(@pxref{Persistent Articles}). - -@item -All functions for hiding article elements are now toggles. - -@item -Article headers can be buttonized (@pxref{Article Washing}). - -@lisp -(add-hook 'gnus-article-display-hook - 'gnus-article-add-buttons-to-head) -@end lisp - -@item -All mail backends support fetching articles by @code{Message-ID}. - -@item -Duplicate mail can now be treated properly (@pxref{Duplicates}). - -@item -All summary mode commands are available directly from the article -buffer (@pxref{Article Keymap}). - -@item -Frames can be part of @code{gnus-buffer-configuration} (@pxref{Windows -Configuration}). - -@item -Mail can be re-scanned by a daemonic process (@pxref{Daemons}). - -@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 -(setq gnus-permanently-visible-groups "^nnml:") -@end lisp - -@item -Many new hooks have been introduced to make customizing easier. - -@item -Gnus respects the @code{Mail-Copies-To} header. - -@item -Threads can be gathered by looking at the @code{References} header -(@pxref{Customizing Threading}). - -@lisp -(setq gnus-summary-thread-gathering-function - 'gnus-gather-threads-by-references) -@end lisp - -@item -Read articles can be stored in a special backlog buffer to avoid -refetching (@pxref{Article Backlog}). - -@lisp -(setq gnus-keep-backlog 50) -@end lisp - -@item -A clean copy of the current article is always stored in a separate -buffer to allow easier treatment. - -@item -Gnus can suggest where to save articles (@pxref{Saving Articles}). - -@item -Gnus doesn't have to do as much prompting when saving (@pxref{Saving -Articles}). - -@lisp -(setq gnus-prompt-before-saving t) -@end lisp - -@item -@code{gnus-uu} can view decoded files asynchronously while fetching -articles (@pxref{Other Decode Variables}). - -@lisp -(setq gnus-uu-grabbed-file-functions 'gnus-uu-grab-view) -@end lisp - -@item -Filling in the article buffer now works properly on cited text -(@pxref{Article Washing}). - -@item -Hiding cited text adds buttons to toggle hiding, and how much -cited text to hide is now customizable (@pxref{Article Hiding}). - -@lisp -(setq gnus-cited-lines-visible 2) -@end lisp - -@item -Boring headers can be hidden (@pxref{Article Hiding}). - -@lisp -(add-hook 'gnus-article-display-hook - 'gnus-article-hide-boring-headers t) -@end lisp - -@item -Default scoring values can now be set from the menu bar. - -@item -Further syntax checking of outgoing articles have been added. - -@end itemize - - -@node Red Gnus -@subsubsection Red Gnus - -New features in Gnus 5.4/5.5: - -@itemize @bullet - -@item -@file{nntp.el} has been totally rewritten in an asynchronous fashion. - -@item -Article prefetching functionality has been moved up into -Gnus (@pxref{Asynchronous Fetching}). - -@item -Scoring can now be performed with logical operators like @code{and}, -@code{or}, @code{not}, and parent redirection (@pxref{Advanced -Scoring}). - -@item -Article washing status can be displayed in the -article mode line (@pxref{Misc Article}). - -@item -@file{gnus.el} has been split into many smaller files. - -@item -Suppression of duplicate articles based on Message-ID can be done -(@pxref{Duplicate Suppression}). - -@lisp -(setq gnus-suppress-duplicates t) -@end lisp - -@item -New variables for specifying what score and adapt files are to be -considered home score and adapt files (@pxref{Home Score File}) have -been added. - -@item -@code{nndoc} was rewritten to be easily extendable (@pxref{Document -Server Internals}). - -@item -Groups can inherit group parameters from parent topics (@pxref{Topic -Parameters}). - -@item -Article editing has been revamped and is now actually usable. - -@item -Signatures can be recognized in more intelligent fashions -(@pxref{Article Signature}). - -@item -Summary pick mode has been made to look more @code{nn}-like. Line -numbers are displayed and the @kbd{.} command can be used to pick -articles (@code{Pick and Read}). - -@item -Commands for moving the @file{.newsrc.eld} from one server to -another have been added (@pxref{Changing Servers}). - -@item -There's a way now to specify that ``uninteresting'' fields be suppressed -when generating lines in buffers (@pxref{Advanced Formatting}). - -@item -Several commands in the group buffer can be undone with @kbd{M-C-_} -(@pxref{Undo}). - -@item -Scoring can be done on words using the new score type @code{w} -(@pxref{Score File Format}). - -@item -Adaptive scoring can be done on a Subject word-by-word basis -(@pxref{Adaptive Scoring}). - -@lisp -(setq gnus-use-adaptive-scoring '(word)) -@end lisp - -@item -Scores can be decayed (@pxref{Score Decays}). - -@lisp -(setq gnus-decay-scores t) -@end lisp - -@item -Scoring can be performed using a regexp on the Date header. The Date is -normalized to compact ISO 8601 format first (@pxref{Score File Format}). - -@item -A new command has been added to remove all data on articles from -the native server (@pxref{Changing Servers}). - -@item -A new command for reading collections of documents -(@code{nndoc} with @code{nnvirtual} on top) has been added---@kbd{M-C-d} -(@pxref{Really Various Summary Commands}). - -@item -Process mark sets can be pushed and popped (@pxref{Setting Process -Marks}). - -@item -A new mail-to-news backend makes it possible to post even when the NNTP -server doesn't allow posting (@pxref{Mail-To-News Gateways}). - -@item -A new backend for reading searches from Web search engines -(@dfn{DejaNews}, @dfn{Alta Vista}, @dfn{InReference}) has been added -(@pxref{Web Searches}). - -@item -Groups inside topics can now be sorted using the standard sorting -functions, and each topic can be sorted independently (@pxref{Topic -Sorting}). - -@item -Subsets of the groups can be sorted independently (@code{Sorting -Groups}). - -@item -Cached articles can be pulled into the groups (@pxref{Summary Generation -Commands}). - -@item -Score files are now applied in a more reliable order (@pxref{Score -Variables}). - -@item -Reports on where mail messages end up can be generated (@pxref{Splitting -Mail}). - -@item -More hooks and functions have been added to remove junk from incoming -mail before saving the mail (@pxref{Washing Mail}). - -@item -Emphasized text can be properly fontisized: - -@lisp -(add-hook 'gnus-article-display-hook 'gnus-article-emphasize) -@end lisp - -@end itemize - - -@node Newest Features -@subsection Newest Features -@cindex todo - -Also known as the @dfn{todo list}. Sure to be implemented before the -next millennium. - -Be afraid. Be very afraid. - -@itemize @bullet -@item -Native @sc{mime} support is something that should be done. -@item -Really do unbinhexing. -@end itemize - -And much, much, much more. There is more to come than has already been -implemented. (But that's always true, isn't it?) - -@file{} is where the actual -up-to-the-second todo list is located, so if you're really curious, you -could point your Web browser over that-a-way. - -@iftex - -@node The Manual -@section The Manual -@cindex colophon -@cindex manual - -This manual was generated from a TeXinfo file and then run through -either @code{texi2dvi} -@iflatex -or my own home-brewed TeXinfo to \LaTeX\ transformer, -and then run through @code{latex} and @code{dvips} -@end iflatex -to get what you hold in your hands now. - -The following conventions have been used: - -@enumerate - -@item -This is a @samp{string} - -@item -This is a @kbd{keystroke} - -@item -This is a @file{file} - -@item -This is a @code{symbol} - -@end enumerate - -So if I were to say ``set @code{flargnoze} to @samp{yes}'', that would -mean: - -@lisp -(setq flargnoze "yes") -@end lisp - -If I say ``set @code{flumphel} to @code{yes}'', that would mean: - -@lisp -(setq flumphel 'yes) -@end lisp - -@samp{yes} and @code{yes} are two @emph{very} different things---don't -ever get them confused. - -@iflatex -@c @head -Of course, everything in this manual is of vital interest, so you should -read it all. Several times. However, if you feel like skimming the -manual, look for that gnu head you should see in the margin over -there---it means that what's being discussed is of more importance than -the rest of the stuff. (On the other hand, if everything is infinitely -important, how can anything be more important than that? Just one more -of the mysteries of this world, I guess.) -@end iflatex - -@end iftex - - -@node Terminology -@section Terminology - -@cindex terminology -@table @dfn - -@item news -@cindex news -This is what you are supposed to use this thing for---reading news. -News is generally fetched from a nearby @sc{nntp} server, and is -generally publicly available to everybody. If you post news, the entire -world is likely to read just what you have written, and they'll all -snigger mischievously. Behind your back. - -@item mail -@cindex mail -Everything that's delivered to you personally is mail. Some news/mail -readers (like Gnus) blur the distinction between mail and news, but -there is a difference. Mail is private. News is public. Mailing is -not posting, and replying is not following up. - -@item reply -@cindex reply -Send a mail to the person who has written what you are reading. - -@item follow up -@cindex follow up -Post an article to the current newsgroup responding to the article you -are reading. - -@item backend -@cindex backend -Gnus gets fed articles from a number of backends, both news and mail -backends. Gnus does not handle the underlying media, so to speak---this -is all done by the backends. - -@item native -@cindex native -Gnus will always use one method (and backend) as the @dfn{native}, or -default, way of getting news. - -@item foreign -@cindex foreign -You can also have any number of foreign groups active at the same time. -These are groups that use non-native non-secondary backends for getting -news. - -@item secondary -@cindex secondary -Secondary backends are somewhere half-way between being native and being -foreign, but they mostly act like they are native. - -@item article -@cindex article -A message that has been posted as news. - -@item mail message -@cindex mail message -A message that has been mailed. - -@item message -@cindex message -A mail message or news article - -@item head -@cindex head -The top part of a message, where administrative information (etc.) is -put. - -@item body -@cindex body -The rest of an article. Everything not in the head is in the -body. - -@item header -@cindex header -A line from the head of an article. - -@item headers -@cindex headers -A collection of such lines, or a collection of heads. Or even a -collection of @sc{nov} lines. - -@item @sc{nov} -@cindex nov -When Gnus enters a group, it asks the backend for the headers of all -unread articles in the group. Most servers support the News OverView -format, which is more compact and much faster to read and parse than the -normal @sc{head} format. - -@item level -@cindex levels -Each group is subscribed at some @dfn{level} or other (1-9). The ones -that have a lower level are ``more'' subscribed than the groups with a -higher level. In fact, groups on levels 1-5 are considered -@dfn{subscribed}; 6-7 are @dfn{unsubscribed}; 8 are @dfn{zombies}; and 9 -are @dfn{killed}. Commands for listing groups and scanning for new -articles will all use the numeric prefix as @dfn{working level}. - -@item killed groups -@cindex killed groups -No information on killed groups is stored or updated, which makes killed -groups much easier to handle than subscribed groups. - -@item zombie groups -@cindex zombie groups -Just like killed groups, only slightly less dead. - -@item active file -@cindex active file -The news server has to keep track of what articles it carries, and what -groups exist. All this information in stored in the active file, which -is rather large, as you might surmise. - -@item bogus groups -@cindex bogus groups -A group that exists in the @file{.newsrc} file, but isn't known to the -server (i.e., it isn't in the active file), is a @emph{bogus group}. -This means that the group probably doesn't exist (any more). - -@item server -@cindex server -A machine one can connect to and get news (or mail) from. - -@item select method -@cindex select method -A structure that specifies the backend, the server and the virtual -server parameters. - -@item virtual server -@cindex virtual server -A named select method. Since a select method defines all there is to -know about connecting to a (physical) server, taking the thing as a -whole is a virtual server. - -@item washing -@cindex washing -Taking a buffer and running it through a filter of some sort. The -result will (more often than not) be cleaner and more pleasing than the -original. - -@item ephemeral groups -@cindex ephemeral groups -Most groups store data on what articles you have read. @dfn{Ephemeral} -groups are groups that will have no data stored---when you exit the -group, it'll disappear into the aether. - -@item solid groups -@cindex solid groups -This is the opposite of ephemeral groups. All groups listed in the -group buffer are solid groups. - -@item sparse articles -@cindex sparse articles -These are article placeholders shown in the summary buffer when -@code{gnus-build-sparse-threads} has been switched on. - -@end table - - -@node Customization -@section Customization -@cindex general customization - -All variables are properly documented elsewhere in this manual. This -section is designed to give general pointers on how to customize Gnus -for some quite common situations. - -@menu -* Slow/Expensive Connection:: You run a local Emacs and get the news elsewhere. -* Slow Terminal Connection:: You run a remote Emacs. -* Little Disk Space:: You feel that having large setup files is icky. -* Slow Machine:: You feel like buying a faster machine. -@end menu - - -@node Slow/Expensive Connection -@subsection Slow/Expensive @sc{nntp} Connection - -If you run Emacs on a machine locally, and get your news from a machine -over some very thin strings, you want to cut down on the amount of data -Gnus has to get from the @sc{nntp} server. - -@table @code - -@item gnus-read-active-file -Set this to @code{nil}, which will inhibit Gnus from requesting the -entire active file from the server. This file is often v. large. You -also have to set @code{gnus-check-new-newsgroups} and -@code{gnus-check-bogus-newsgroups} to @code{nil} to make sure that Gnus -doesn't suddenly decide to fetch the active file anyway. - -@item gnus-nov-is-evil -This one has to be @code{nil}. If not, grabbing article headers from -the @sc{nntp} server will not be very fast. Not all @sc{nntp} servers -support @sc{xover}; Gnus will detect this by itself. -@end table - - -@node Slow Terminal Connection -@subsection Slow Terminal Connection - -Let's say you use your home computer for dialing up the system that runs -Emacs and Gnus. If your modem is slow, you want to reduce (as much as -possible) the amount of data sent over the wires. - -@table @code - -@item gnus-auto-center-summary -Set this to @code{nil} to inhibit Gnus from re-centering the summary -buffer all the time. If it is @code{vertical}, do only vertical -re-centering. If it is neither @code{nil} nor @code{vertical}, do both -horizontal and vertical recentering. - -@item gnus-visible-headers -Cut down on the headers included in the articles to the -minimum. You can, in fact, make do without them altogether---most of the -useful data is in the summary buffer, anyway. Set this variable to -@samp{^NEVVVVER} or @samp{From:}, or whatever you feel you need. - -@item gnus-article-display-hook -Set this hook to all the available hiding commands: -@lisp -(setq gnus-article-display-hook - '(gnus-article-hide-headers gnus-article-hide-signature - gnus-article-hide-citation)) -@end lisp - -@item gnus-use-full-window -By setting this to @code{nil}, you can make all the windows smaller. -While this doesn't really cut down much generally, it means that you -have to see smaller portions of articles before deciding that you didn't -want to read them anyway. - -@item gnus-thread-hide-subtree -If this is non-@code{nil}, all threads in the summary buffer will be -hidden initially. - -@item gnus-updated-mode-lines -If this is @code{nil}, Gnus will not put information in the buffer mode -lines, which might save some time. -@end table - - -@node Little Disk Space -@subsection Little Disk Space -@cindex disk space - -The startup files can get rather large, so you may want to cut their -sizes a bit if you are running out of space. - -@table @code - -@item gnus-save-newsrc-file -If this is @code{nil}, Gnus will never save @file{.newsrc}---it will -only save @file{.newsrc.eld}. This means that you will not be able to -use any other newsreaders than Gnus. This variable is @code{t} by -default. - -@item gnus-save-killed-list -If this is @code{nil}, Gnus will not save the list of dead groups. You -should also set @code{gnus-check-new-newsgroups} to @code{ask-server} -and @code{gnus-check-bogus-newsgroups} to @code{nil} if you set this -variable to @code{nil}. This variable is @code{t} by default. - -@end table - - -@node Slow Machine -@subsection Slow Machine -@cindex slow machine - -If you have a slow machine, or are just really impatient, there are a -few things you can do to make Gnus run faster. - -Set @code{gnus-check-new-newsgroups} and -@code{gnus-check-bogus-newsgroups} to @code{nil} to make startup faster. - -Set @code{gnus-show-threads}, @code{gnus-use-cross-reference} and -@code{gnus-nov-is-evil} to @code{nil} to make entering and exiting the -summary buffer faster. - -Set @code{gnus-article-display-hook} to @code{nil} to make article -processing a bit faster. - - -@node Troubleshooting -@section Troubleshooting -@cindex troubleshooting - -Gnus works @emph{so} well straight out of the box---I can't imagine any -problems, really. - -Ahem. - -@enumerate - -@item -Make sure your computer is switched on. - -@item -Make sure that you really load the current Gnus version. If you have -been running @sc{gnus}, you need to exit Emacs and start it up again before -Gnus will work. - -@item -Try doing an @kbd{M-x gnus-version}. If you get something that looks -like @samp{Gnus v5.46; nntp 4.0} you have the right files loaded. If, -on the other hand, you get something like @samp{NNTP 3.x} or @samp{nntp -flee}, you have some old @file{.el} files lying around. Delete these. - -@item -Read the help group (@kbd{G h} in the group buffer) for a FAQ and a -how-to. - -@item -@vindex max-lisp-eval-depth -Gnus works on many recursive structures, and in some extreme (and very -rare) cases Gnus may recurse down ``too deeply'' and Emacs will beep at -you. If this happens to you, set @code{max-lisp-eval-depth} to 500 or -something like that. -@end enumerate - -If all else fails, report the problem as a bug. - -@cindex bugs -@cindex reporting bugs - -@kindex M-x gnus-bug -@findex gnus-bug -If you find a bug in Gnus, you can report it with the @kbd{M-x gnus-bug} -command. @kbd{M-x set-variable RET debug-on-error RET t RET}, and send -me the backtrace. I will fix bugs, but I can only fix them if you send -me a precise description as to how to reproduce the bug. - -You really can never be too detailed in a bug report. Always use the -@kbd{M-x gnus-bug} command when you make bug reports, even if it creates -a 10Kb mail each time you use it, and even if you have sent me your -environment 500 times before. I don't care. I want the full info each -time. - -It is also important to remember that I have no memory whatsoever. If -you send a bug report, and I send you a reply, and then you just send -back ``No, it's not! Moron!'', I will have no idea what you are -insulting me about. Always over-explain everything. It's much easier -for all of us---if I don't have all the information I need, I will just -mail you and ask for more info, and everything takes more time. - -If the problem you're seeing is very visual, and you can't quite explain -it, copy the Emacs window to a file (with @code{xwd}, for instance), put -it somewhere it can be reached, and include the URL of the picture in -the bug report. - -If you just need help, you are better off asking on -@samp{gnu.emacs.gnus}. I'm not very helpful. - -@cindex gnu.emacs.gnus -@cindex ding mailing list -You can also ask on the ding mailing list---@samp{ding@@gnus.org}. -Write to @samp{ding-request@@gnus.org} to subscribe. - - -@node A Programmers Guide to Gnus -@section A Programmer@'s Guide to Gnus - -It is my hope that other people will figure out smart stuff that Gnus -can do, and that other people will write those smart things as well. To -facilitate that I thought it would be a good idea to describe the inner -workings of Gnus. And some of the not-so-inner workings, while I'm at -it. - -You can never expect the internals of a program not to change, but I -will be defining (in some details) the interface between Gnus and its -backends (this is written in stone), the format of the score files -(ditto), data structures (some are less likely to change than others) -and general methods of operation. - -@menu -* Gnus Utility Functions:: Common functions and variable to use. -* Backend Interface:: How Gnus communicates with the servers. -* Score File Syntax:: A BNF definition of the score file standard. -* Headers:: How Gnus stores headers internally. -* Ranges:: A handy format for storing mucho numbers. -* Group Info:: The group info format. -* Emacs/XEmacs Code:: Gnus can be run under all modern Emacsen. -* Various File Formats:: Formats of files that Gnus use. -@end menu - - -@node Gnus Utility Functions -@subsection Gnus Utility Functions -@cindex Gnus utility functions -@cindex utility functions -@cindex functions -@cindex internal variables - -When writing small functions to be run from hooks (and stuff), it's -vital to have access to the Gnus internal functions and variables. -Below is a list of the most common ones. - -@table @code - -@item gnus-newsgroup-name -@vindex gnus-newsgroup-name -This variable holds the name of the current newsgroup. - -@item gnus-find-method-for-group -@findex gnus-find-method-for-group -A function that returns the select method for @var{group}. - -@item gnus-group-real-name -@findex gnus-group-real-name -Takes a full (prefixed) Gnus group name, and returns the unprefixed -name. - -@item gnus-group-prefixed-name -@findex gnus-group-prefixed-name -Takes an unprefixed group name and a select method, and returns the full -(prefixed) Gnus group name. - -@item gnus-get-info -@findex gnus-get-info -Returns the group info list for @var{group}. - -@item gnus-add-current-to-buffer-list -@findex gnus-add-current-to-buffer-list -Adds the current buffer to the list of buffers to be killed on Gnus -exit. - -@item gnus-continuum-version -@findex gnus-continuum-version -Takes a Gnus version string as a parameter and returns a floating point -number. Earlier versions will always get a lower number than later -versions. - -@item gnus-group-read-only-p -@findex gnus-group-read-only-p -Says whether @var{group} is read-only or not. - -@item gnus-news-group-p -@findex gnus-news-group-p -Says whether @var{group} came from a news backend. - -@item gnus-ephemeral-group-p -@findex gnus-ephemeral-group-p -Says whether @var{group} is ephemeral or not. - -@item gnus-server-to-method -@findex gnus-server-to-method -Returns the select method corresponding to @var{server}. - -@item gnus-server-equal -@findex gnus-server-equal -Says whether two virtual servers are equal. - -@item gnus-group-native-p -@findex gnus-group-native-p -Says whether @var{group} is native or not. - -@item gnus-group-secondary-p -@findex gnus-group-secondary-p -Says whether @var{group} is secondary or not. - -@item gnus-group-foreign-p -@findex gnus-group-foreign-p -Says whether @var{group} is foreign or not. - -@item group-group-find-parameter -@findex group-group-find-parameter -Returns the parameter list of @var{group}. If given a second parameter, -returns the value of that parameter for @var{group}. - -@item gnus-group-set-parameter -@findex gnus-group-set-parameter -Takes three parameters; @var{group}, @var{parameter} and @var{value}. - -@item gnus-narrow-to-body -@findex gnus-narrow-to-body -Narrows the current buffer to the body of the article. - -@item gnus-check-backend-function -@findex gnus-check-backend-function -Takes two parameters, @var{function} and @var{group}. If the backend -@var{group} comes from supports @var{function}, return non-@code{nil}. - -@lisp -(gnus-check-backend-function "request-scan" "nnml:misc") -=> t -@end lisp - -@item gnus-read-method -@findex gnus-read-method -Prompts the user for a select method. - -@end table - - -@node Backend Interface -@subsection Backend Interface - -Gnus doesn't know anything about @sc{nntp}, spools, mail or virtual -groups. It only knows how to talk to @dfn{virtual servers}. A virtual -server is a @dfn{backend} and some @dfn{backend variables}. As examples -of the first, we have @code{nntp}, @code{nnspool} and @code{nnmbox}. As -examples of the latter we have @code{nntp-port-number} and -@code{nnmbox-directory}. - -When Gnus asks for information from a backend---say @code{nntp}---on -something, it will normally include a virtual server name in the -function parameters. (If not, the backend should use the ``current'' -virtual server.) For instance, @code{nntp-request-list} takes a virtual -server as its only (optional) parameter. If this virtual server hasn't -been opened, the function should fail. - -Note that a virtual server name has no relation to some physical server -name. Take this example: - -@lisp -(nntp "odd-one" - (nntp-address "ifi.uio.no") - (nntp-port-number 4324)) -@end lisp - -Here the virtual server name is @samp{odd-one} while the name of -the physical server is @samp{ifi.uio.no}. - -The backends should be able to switch between several virtual servers. -The standard backends implement this by keeping an alist of virtual -server environments that they pull down/push up when needed. - -There are two groups of interface functions: @dfn{required functions}, -which must be present, and @dfn{optional functions}, which Gnus will -always check for presence before attempting to call 'em. - -All these functions are expected to return data in the buffer -@code{nntp-server-buffer} (@samp{ *nntpd*}), which is somewhat -unfortunately named, but we'll have to live with it. When I talk about -@dfn{resulting data}, I always refer to the data in that buffer. When I -talk about @dfn{return value}, I talk about the function value returned by -the function call. Functions that fail should return @code{nil} as the -return value. - -Some backends could be said to be @dfn{server-forming} backends, and -some might be said not to be. The latter are backends that generally -only operate on one group at a time, and have no concept of ``server'' --- they have a group, and they deliver info on that group and nothing -more. - -In the examples and definitions I will refer to the imaginary backend -@code{nnchoke}. - -@cindex @code{nnchoke} - -@menu -* Required Backend Functions:: Functions that must be implemented. -* Optional Backend Functions:: Functions that need not be implemented. -* Error Messaging:: How to get messages and report errors. -* Writing New Backends:: Extending old backends. -* Hooking New Backends Into Gnus:: What has to be done on the Gnus end. -* Mail-like Backends:: Some tips on mail backends. -@end menu - - -@node Required Backend Functions -@subsubsection Required Backend Functions - -@table @code - -@item (nnchoke-retrieve-headers ARTICLES &optional GROUP SERVER FETCH-OLD) - -@var{articles} is either a range of article numbers or a list of -@code{Message-ID}s. Current backends do not fully support either---only -sequences (lists) of article numbers, and most backends do not support -retrieval of @code{Message-ID}s. But they should try for both. - -The result data should either be HEADs or NOV lines, and the result -value should either be @code{headers} or @code{nov} to reflect this. -This might later be expanded to @code{various}, which will be a mixture -of HEADs and NOV lines, but this is currently not supported by Gnus. - -If @var{fetch-old} is non-@code{nil} it says to try fetching "extra -headers", in some meaning of the word. This is generally done by -fetching (at most) @var{fetch-old} extra headers less than the smallest -article number in @code{articles}, and filling the gaps as well. The -presence of this parameter can be ignored if the backend finds it -cumbersome to follow the request. If this is non-@code{nil} and not a -number, do maximum fetches. - -Here's an example HEAD: - -@example -221 1056 Article retrieved. -Path: ifi.uio.no!sturles -From: sturles@@ifi.uio.no (Sturle Sunde) -Newsgroups: ifi.discussion -Subject: Re: Something very droll -Date: 27 Oct 1994 14:02:57 +0100 -Organization: Dept. of Informatics, University of Oslo, Norway -Lines: 26 -Message-ID: <38o8e1$a0o@@holmenkollen.ifi.uio.no> -References: <38jdmq$4qu@@visbur.ifi.uio.no> -NNTP-Posting-Host: holmenkollen.ifi.uio.no -. -@end example - -So a @code{headers} return value would imply that there's a number of -these in the data buffer. - -Here's a BNF definition of such a buffer: - -@example -headers = *head -head = error / valid-head -error-message = [ "4" / "5" ] 2number " " eol -valid-head = valid-message *header "." eol -valid-message = "221 " " Article retrieved." eol -header = eol -@end example - -If the return value is @code{nov}, the data buffer should contain -@dfn{network overview database} lines. These are basically fields -separated by tabs. - -@example -nov-buffer = *nov-line -nov-line = 8*9 [ field ] eol -field = -@end example - -For a closer look at what should be in those fields, -@pxref{Headers}. - - -@item (nnchoke-open-server SERVER &optional DEFINITIONS) - -@var{server} is here the virtual server name. @var{definitions} is a -list of @code{(VARIABLE VALUE)} pairs that define this virtual server. - -If the server can't be opened, no error should be signaled. The backend -may then choose to refuse further attempts at connecting to this -server. In fact, it should do so. - -If the server is opened already, this function should return a -non-@code{nil} value. There should be no data returned. - - -@item (nnchoke-close-server &optional SERVER) - -Close connection to @var{server} and free all resources connected -to it. Return @code{nil} if the server couldn't be closed for some -reason. - -There should be no data returned. - - -@item (nnchoke-request-close) - -Close connection to all servers and free all resources that the backend -have reserved. All buffers that have been created by that backend -should be killed. (Not the @code{nntp-server-buffer}, though.) This -function is generally only called when Gnus is shutting down. - -There should be no data returned. - - -@item (nnchoke-server-opened &optional SERVER) - -If @var{server} is the current virtual server, and the connection to the -physical server is alive, then this function should return a -non-@code{nil} vlue. This function should under no circumstances -attempt to reconnect to a server we have lost connection to. - -There should be no data returned. - - -@item (nnchoke-status-message &optional SERVER) - -This function should return the last error message from @var{server}. - -There should be no data returned. - - -@item (nnchoke-request-article ARTICLE &optional GROUP SERVER TO-BUFFER) - -The result data from this function should be the article specified by -@var{article}. This might either be a @code{Message-ID} or a number. -It is optional whether to implement retrieval by @code{Message-ID}, but -it would be nice if that were possible. - -If @var{to-buffer} is non-@code{nil}, the result data should be returned -in this buffer instead of the normal data buffer. This is to make it -possible to avoid copying large amounts of data from one buffer to -another, while Gnus mainly requests articles to be inserted directly -into its article buffer. - -If it is at all possible, this function should return a cons cell where -the @code{car} is the group name the article was fetched from, and the @code{cdr} is -the article number. This will enable Gnus to find out what the real -group and article numbers are when fetching articles by -@code{Message-ID}. If this isn't possible, @code{t} should be returned -on successful article retrieval. - - -@item (nnchoke-request-group GROUP &optional SERVER FAST) - -Get data on @var{group}. This function also has the side effect of -making @var{group} the current group. - -If @var{FAST}, don't bother to return useful data, just make @var{group} -the current group. - -Here's an example of some result data and a definition of the same: - -@example -211 56 1000 1059 ifi.discussion -@end example - -The first number is the status, which should be 211. Next is the -total number of articles in the group, the lowest article number, the -highest article number, and finally the group name. Note that the total -number of articles may be less than one might think while just -considering the highest and lowest article numbers, but some articles -may have been canceled. Gnus just discards the total-number, so -whether one should take the bother to generate it properly (if that is a -problem) is left as an exercise to the reader. - -@example -group-status = [ error / info ] eol -error = [ "4" / "5" ] 2 " " -info = "211 " 3* [ " " ] -@end example - - -@item (nnchoke-close-group GROUP &optional SERVER) - -Close @var{group} and free any resources connected to it. This will be -a no-op on most backends. - -There should be no data returned. - - -@item (nnchoke-request-list &optional SERVER) - -Return a list of all groups available on @var{server}. And that means -@emph{all}. - -Here's an example from a server that only carries two groups: - -@example -ifi.test 0000002200 0000002000 y -ifi.discussion 3324 3300 n -@end example - -On each line we have a group name, then the highest article number in -that group, the lowest article number, and finally a flag. - -@example -active-file = *active-line -active-line = name " " " " " " flags eol -name = -flags = "n" / "y" / "m" / "x" / "j" / "=" name -@end example - -The flag says whether the group is read-only (@samp{n}), is moderated -(@samp{m}), is dead (@samp{x}), is aliased to some other group -(@samp{=other-group}) or none of the above (@samp{y}). - - -@item (nnchoke-request-post &optional SERVER) - -This function should post the current buffer. It might return whether -the posting was successful or not, but that's not required. If, for -instance, the posting is done asynchronously, it has generally not been -completed by the time this function concludes. In that case, this -function should set up some kind of sentinel to beep the user loud and -clear if the posting could not be completed. - -There should be no result data from this function. - -@end table - - -@node Optional Backend Functions -@subsubsection Optional Backend Functions - -@table @code - -@item (nnchoke-retrieve-groups GROUPS &optional SERVER) - -@var{groups} is a list of groups, and this function should request data -on all those groups. How it does it is of no concern to Gnus, but it -should attempt to do this in a speedy fashion. - -The return value of this function can be either @code{active} or -@code{group}, which says what the format of the result data is. The -former is in the same format as the data from -@code{nnchoke-request-list}, while the latter is a buffer full of lines -in the same format as @code{nnchoke-request-group} gives. - -@example -group-buffer = *active-line / *group-status -@end example - - -@item (nnchoke-request-update-info GROUP INFO &optional SERVER) - -A Gnus group info (@pxref{Group Info}) is handed to the backend for -alterations. This comes in handy if the backend really carries all the -information (as is the case with virtual and imap groups). This -function should destructively alter the info to suit its needs, and -should return the (altered) group info. - -There should be no result data from this function. - - -@item (nnchoke-request-type GROUP &optional ARTICLE) - -When the user issues commands for ``sending news'' (@kbd{F} in the -summary buffer, for instance), Gnus has to know whether the article the -user is following up on is news or mail. This function should return -@code{news} if @var{article} in @var{group} is news, @code{mail} if it -is mail and @code{unknown} if the type can't be decided. (The -@var{article} parameter is necessary in @code{nnvirtual} groups which -might very well combine mail groups and news groups.) Both @var{group} -and @var{article} may be @code{nil}. - -There should be no result data from this function. - - -@item (nnchoke-request-update-mark GROUP ARTICLE MARK) - -If the user tries to set a mark that the backend doesn't like, this -function may change the mark. Gnus will use whatever this function -returns as the mark for @var{article} instead of the original -@var{mark}. If the backend doesn't care, it must return the original -@var{mark}, and not @code{nil} or any other type of garbage. - -The only use for this I can see is what @code{nnvirtual} does with -it---if a component group is auto-expirable, marking an article as read -in the virtual group should result in the article being marked as -expirable. - -There should be no result data from this function. - - -@item (nnchoke-request-scan &optional GROUP SERVER) - -This function may be called at any time (by Gnus or anything else) to -request that the backend check for incoming articles, in one way or -another. A mail backend will typically read the spool file or query the -POP server when this function is invoked. The @var{group} doesn't have -to be heeded---if the backend decides that it is too much work just -scanning for a single group, it may do a total scan of all groups. It -would be nice, however, to keep things local if that's practical. - -There should be no result data from this function. - - -@item (nnchoke-request-group-description GROUP &optional SERVER) - -The result data from this function should be a description of -@var{group}. - -@example -description-line = name description eol -name = -description = -@end example - -@item (nnchoke-request-list-newsgroups &optional SERVER) - -The result data from this function should be the description of all -groups available on the server. - -@example -description-buffer = *description-line -@end example - - -@item (nnchoke-request-newgroups DATE &optional SERVER) - -The result data from this function should be all groups that were -created after @samp{date}, which is in normal human-readable date -format. The data should be in the active buffer format. - - -@item (nnchoke-request-create-group GROUP &optional SERVER) - -This function should create an empty group with name @var{group}. - -There should be no return data. - - -@item (nnchoke-request-expire-articles ARTICLES &optional GROUP SERVER FORCE) - -This function should run the expiry process on all articles in the -@var{articles} range (which is currently a simple list of article -numbers.) It is left up to the backend to decide how old articles -should be before they are removed by this function. If @var{force} is -non-@code{nil}, all @var{articles} should be deleted, no matter how new -they are. - -This function should return a list of articles that it did not/was not -able to delete. - -There should be no result data returned. - - -@item (nnchoke-request-move-article ARTICLE GROUP SERVER ACCEPT-FORM -&optional LAST) - -This function should move @var{article} (which is a number) from -@var{group} by calling @var{accept-form}. - -This function should ready the article in question for moving by -removing any header lines it has added to the article, and generally -should ``tidy up'' the article. Then it should @code{eval} -@var{accept-form} in the buffer where the ``tidy'' article is. This -will do the actual copying. If this @code{eval} returns a -non-@code{nil} value, the article should be removed. - -If @var{last} is @code{nil}, that means that there is a high likelihood -that there will be more requests issued shortly, so that allows some -optimizations. - -The function should return a cons where the @code{car} is the group name and -the @code{cdr} is the article number that the article was entered as. - -There should be no data returned. - - -@item (nnchoke-request-accept-article GROUP &optional SERVER LAST) - -This function takes the current buffer and inserts it into @var{group}. -If @var{last} in @code{nil}, that means that there will be more calls to -this function in short order. - -The function should return a cons where the @code{car} is the group name and -the @code{cdr} is the article number that the article was entered as. - -There should be no data returned. - - -@item (nnchoke-request-replace-article ARTICLE GROUP BUFFER) - -This function should remove @var{article} (which is a number) from -@var{group} and insert @var{buffer} there instead. - -There should be no data returned. - - -@item (nnchoke-request-delete-group GROUP FORCE &optional SERVER) - -This function should delete @var{group}. If @var{force}, it should -really delete all the articles in the group, and then delete the group -itself. (If there is such a thing as ``the group itself''.) - -There should be no data returned. - - -@item (nnchoke-request-rename-group GROUP NEW-NAME &optional SERVER) - -This function should rename @var{group} into @var{new-name}. All -articles in @var{group} should move to @var{new-name}. - -There should be no data returned. - -@end table - - -@node Error Messaging -@subsubsection Error Messaging - -@findex nnheader-report -@findex nnheader-get-report -The backends should use the function @code{nnheader-report} to report -error conditions---they should not raise errors when they aren't able to -perform a request. The first argument to this function is the backend -symbol, and the rest are interpreted as arguments to @code{format} if -there are multiple of them, or just a string if there is one of them. -This function must always returns @code{nil}. - -@lisp -(nnheader-report 'nnchoke "You did something totally bogus") - -(nnheader-report 'nnchoke "Could not request group %s" group) -@end lisp - -Gnus, in turn, will call @code{nnheader-get-report} when it gets a -@code{nil} back from a server, and this function returns the most -recently reported message for the backend in question. This function -takes one argument---the server symbol. - -Internally, these functions access @var{backend}@code{-status-string}, -so the @code{nnchoke} backend will have its error message stored in -@code{nnchoke-status-string}. - - -@node Writing New Backends -@subsubsection Writing New Backends - -Many backends are quite similar. @code{nnml} is just like -@code{nnspool}, but it allows you to edit the articles on the server. -@code{nnmh} is just like @code{nnml}, but it doesn't use an active file, -and it doesn't maintain overview databases. @code{nndir} is just like -@code{nnml}, but it has no concept of ``groups'', and it doesn't allow -editing articles. - -It would make sense if it were possible to ``inherit'' functions from -backends when writing new backends. And, indeed, you can do that if you -want to. (You don't have to if you don't want to, of course.) - -All the backends declare their public variables and functions by using a -package called @code{nnoo}. - -To inherit functions from other backends (and allow other backends to -inherit functions from the current backend), you should use the -following macros: - -@table @code - -@item nnoo-declare -This macro declares the first parameter to be a child of the subsequent -parameters. For instance: - -@lisp -(nnoo-declare nndir - nnml nnmh) -@end lisp - -@code{nndir} has declared here that it intends to inherit functions from -both @code{nnml} and @code{nnmh}. - -@item defvoo -This macro is equivalent to @code{defvar}, but registers the variable as -a public server variable. Most state-oriented variables should be -declared with @code{defvoo} instead of @code{defvar}. - -In addition to the normal @code{defvar} parameters, it takes a list of -variables in the parent backends to map the variable to when executing -a function in those backends. - -@lisp -(defvoo nndir-directory nil - "Where nndir will look for groups." - nnml-current-directory nnmh-current-directory) -@end lisp - -This means that @code{nnml-current-directory} will be set to -@code{nndir-directory} when an @code{nnml} function is called on behalf -of @code{nndir}. (The same with @code{nnmh}.) - -@item nnoo-define-basics -This macro defines some common functions that almost all backends should -have. - -@example -(nnoo-define-basics nndir) -@end example - -@item deffoo -This macro is just like @code{defun} and takes the same parameters. In -addition to doing the normal @code{defun} things, it registers the -function as being public so that other backends can inherit it. - -@item nnoo-map-functions -This macro allows mapping of functions from the current backend to -functions from the parent backends. - -@example -(nnoo-map-functions nndir - (nnml-retrieve-headers 0 nndir-current-group 0 0) - (nnmh-request-article 0 nndir-current-group 0 0)) -@end example - -This means that when @code{nndir-retrieve-headers} is called, the first, -third, and fourth parameters will be passed on to -@code{nnml-retrieve-headers}, while the second parameter is set to the -value of @code{nndir-current-group}. - -@item nnoo-import -This macro allows importing functions from backends. It should be the -last thing in the source file, since it will only define functions that -haven't already been defined. - -@example -(nnoo-import nndir - (nnmh - nnmh-request-list - nnmh-request-newgroups) - (nnml)) -@end example - -This means that calls to @code{nndir-request-list} should just be passed -on to @code{nnmh-request-list}, while all public functions from -@code{nnml} that haven't been defined in @code{nndir} yet should be -defined now. - -@end table - -Below is a slightly shortened version of the @code{nndir} backend. - -@lisp -;;; nndir.el --- single directory newsgroup access for Gnus -;; Copyright (C) 1995,96 Free Software Foundation, Inc. - -;;; Code: - -(require 'nnheader) -(require 'nnmh) -(require 'nnml) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nndir - nnml nnmh) - -(defvoo nndir-directory nil - "Where nndir will look for groups." - nnml-current-directory nnmh-current-directory) - -(defvoo nndir-nov-is-evil nil - "*Non-nil means that nndir will never retrieve NOV headers." - nnml-nov-is-evil) - -(defvoo nndir-current-group "" nil nnml-current-group nnmh-current-group) -(defvoo nndir-top-directory nil nil nnml-directory nnmh-directory) -(defvoo nndir-get-new-mail nil nil nnml-get-new-mail nnmh-get-new-mail) - -(defvoo nndir-status-string "" nil nnmh-status-string) -(defconst nndir-version "nndir 1.0") - -;;; Interface functions. - -(nnoo-define-basics nndir) - -(deffoo nndir-open-server (server &optional defs) - (setq nndir-directory - (or (cadr (assq 'nndir-directory defs)) - server)) - (unless (assq 'nndir-directory defs) - (push `(nndir-directory ,server) defs)) - (push `(nndir-current-group - ,(file-name-nondirectory (directory-file-name nndir-directory))) - defs) - (push `(nndir-top-directory - ,(file-name-directory (directory-file-name nndir-directory))) - defs) - (nnoo-change-server 'nndir server defs)) - -(nnoo-map-functions nndir - (nnml-retrieve-headers 0 nndir-current-group 0 0) - (nnmh-request-article 0 nndir-current-group 0 0) - (nnmh-request-group nndir-current-group 0 0) - (nnmh-close-group nndir-current-group 0)) - -(nnoo-import nndir - (nnmh - nnmh-status-message - nnmh-request-list - nnmh-request-newgroups)) - -(provide 'nndir) -@end lisp - - -@node Hooking New Backends Into Gnus -@subsubsection Hooking New Backends Into Gnus - -@vindex gnus-valid-select-methods -Having Gnus start using your new backend is rather easy---you just -declare it with the @code{gnus-declare-backend} functions. This will -enter the backend into the @code{gnus-valid-select-methods} variable. - -@code{gnus-declare-backend} takes two parameters---the backend name and -an arbitrary number of @dfn{abilities}. - -Here's an example: - -@lisp -(gnus-declare-backend "nnchoke" 'mail 'respool 'address) -@end lisp - -The abilities can be: - -@table @code -@item mail -This is a mailish backend---followups should (probably) go via mail. -@item post -This is a newsish backend---followups should (probably) go via news. -@item post-mail -This backend supports both mail and news. -@item none -This is neither a post nor mail backend---it's something completely -different. -@item respool -It supports respooling---or rather, it is able to modify its source -articles and groups. -@item address -The name of the server should be in the virtual server name. This is -true for almost all backends. -@item prompt-address -The user should be prompted for an address when doing commands like -@kbd{B} in the group buffer. This is true for backends like -@code{nntp}, but not @code{nnmbox}, for instance. -@end table - - -@node Mail-like Backends -@subsubsection Mail-like Backends - -One of the things that separate the mail backends from the rest of the -backends is the heavy dependence by the mail backends on common -functions in @file{nnmail.el}. For instance, here's the definition of -@code{nnml-request-scan}: - -@lisp -(deffoo nnml-request-scan (&optional group server) - (setq nnml-article-file-alist nil) - (nnmail-get-new-mail 'nnml 'nnml-save-nov nnml-directory group)) -@end lisp - -It simply calls @code{nnmail-get-new-mail} with a few parameters, -and @code{nnmail} takes care of all the moving and splitting of the -mail. - -This function takes four parameters. - -@table @var -@item method -This should be a symbol to designate which backend is responsible for -the call. - -@item exit-function -This function should be called after the splitting has been performed. - -@item temp-directory -Where the temporary files should be stored. - -@item group -This optional argument should be a group name if the splitting is to be -performed for one group only. -@end table - -@code{nnmail-get-new-mail} will call @var{backend}@code{-save-mail} to -save each article. @var{backend}@code{-active-number} will be called to -find the article number assigned to this article. - -The function also uses the following variables: -@var{backend}@code{-get-new-mail} (to see whether to get new mail for -this backend); and @var{backend}@code{-group-alist} and -@var{backend}@code{-active-file} to generate the new active file. -@var{backend}@code{-group-alist} should be a group-active alist, like -this: - -@example -(("a-group" (1 . 10)) - ("some-group" (34 . 39))) -@end example - - -@node Score File Syntax -@subsection Score File Syntax - -Score files are meant to be easily parsable, but yet extremely -mallable. It was decided that something that had the same read syntax -as an Emacs Lisp list would fit that spec. - -Here's a typical score file: - -@lisp -(("summary" - ("win95" -10000 nil s) - ("Gnus")) - ("from" - ("Lars" -1000)) - (mark -100)) -@end lisp - -BNF definition of a score file: - -@example -score-file = "" / "(" *element ")" -element = rule / atom -rule = string-rule / number-rule / date-rule -string-rule = "(" quote string-header quote space *string-match ")" -number-rule = "(" quote number-header quote space *number-match ")" -date-rule = "(" quote date-header quote space *date-match ")" -quote = -string-header = "subject" / "from" / "references" / "message-id" / - "xref" / "body" / "head" / "all" / "followup" -number-header = "lines" / "chars" -date-header = "date" -string-match = "(" quote quote [ "" / [ space score [ "" / - space date [ "" / [ space string-match-t ] ] ] ] ] ")" -score = "nil" / -date = "nil" / -string-match-t = "nil" / "s" / "substring" / "S" / "Substring" / - "r" / "regex" / "R" / "Regex" / - "e" / "exact" / "E" / "Exact" / - "f" / "fuzzy" / "F" / "Fuzzy" -number-match = "(" [ "" / [ space score [ "" / - space date [ "" / [ space number-match-t ] ] ] ] ] ")" -number-match-t = "nil" / "=" / "<" / ">" / ">=" / "<=" -date-match = "(" quote quote [ "" / [ space score [ "" / - space date [ "" / [ space date-match-t ] ] ] ] ")" -date-match-t = "nil" / "at" / "before" / "after" -atom = "(" [ required-atom / optional-atom ] ")" -required-atom = mark / expunge / mark-and-expunge / files / - exclude-files / read-only / touched -optional-atom = adapt / local / eval -mark = "mark" space nil-or-number -nil-or-number = "nil" / -expunge = "expunge" space nil-or-number -mark-and-expunge = "mark-and-expunge" space nil-or-number -files = "files" *[ space ] -exclude-files = "exclude-files" *[ space ] -read-only = "read-only" [ space "nil" / space "t" ] -adapt = "adapt" [ space "ignore" / space "t" / space adapt-rule ] -adapt-rule = "(" *[ *[ "(" ")" ] ")" -local = "local" *[ space "(" space

")" ] -eval = "eval" space -space = *[ " " / / ] -@end example - -Any unrecognized elements in a score file should be ignored, but not -discarded. - -As you can see, white space is needed, but the type and amount of white -space is irrelevant. This means that formatting of the score file is -left up to the programmer---if it's simpler to just spew it all out on -one looong line, then that's ok. - -The meaning of the various atoms are explained elsewhere in this -manual (@pxref{Score File Format}). - - -@node Headers -@subsection Headers - -Internally Gnus uses a format for storing article headers that -corresponds to the @sc{nov} format in a mysterious fashion. One could -almost suspect that the author looked at the @sc{nov} specification and -just shamelessly @emph{stole} the entire thing, and one would be right. - -@dfn{Header} is a severely overloaded term. ``Header'' is used in -RFC1036 to talk about lines in the head of an article (e.g., -@code{From}). It is used by many people as a synonym for -``head''---``the header and the body''. (That should be avoided, in my -opinion.) And Gnus uses a format internally that it calls ``header'', -which is what I'm talking about here. This is a 9-element vector, -basically, with each header (ouch) having one slot. - -These slots are, in order: @code{number}, @code{subject}, @code{from}, -@code{date}, @code{id}, @code{references}, @code{chars}, @code{lines}, -@code{xref}. There are macros for accessing and setting these -slots---they all have predictable names beginning with -@code{mail-header-} and @code{mail-header-set-}, respectively. - -The @code{xref} slot is really a @code{misc} slot. Any extra info will -be put in there. - - -@node Ranges -@subsection Ranges - -@sc{gnus} introduced a concept that I found so useful that I've started -using it a lot and have elaborated on it greatly. - -The question is simple: If you have a large amount of objects that are -identified by numbers (say, articles, to take a @emph{wild} example) -that you want to qualify as being ``included'', a normal sequence isn't -very useful. (A 200,000 length sequence is a bit long-winded.) - -The solution is as simple as the question: You just collapse the -sequence. - -@example -(1 2 3 4 5 6 10 11 12) -@end example - -is transformed into - -@example -((1 . 6) (10 . 12)) -@end example - -To avoid having those nasty @samp{(13 . 13)} elements to denote a -lonesome object, a @samp{13} is a valid element: - -@example -((1 . 6) 7 (10 . 12)) -@end example - -This means that comparing two ranges to find out whether they are equal -is slightly tricky: - -@example -((1 . 5) 7 8 (10 . 12)) -@end example - -and - -@example -((1 . 5) (7 . 8) (10 . 12)) -@end example - -are equal. In fact, any non-descending list is a range: - -@example -(1 2 3 4 5) -@end example - -is a perfectly valid range, although a pretty long-winded one. This is -also legal: - -@example -(1 . 5) -@end example - -and is equal to the previous range. - -Here's a BNF definition of ranges. Of course, one must remember the -semantic requirement that the numbers are non-descending. (Any number -of repetition of the same number is allowed, but apt to disappear in -range handling.) - -@example -range = simple-range / normal-range -simple-range = "(" number " . " number ")" -normal-range = "(" start-contents ")" -contents = "" / simple-range *[ " " contents ] / - number *[ " " contents ] -@end example - -Gnus currently uses ranges to keep track of read articles and article -marks. I plan on implementing a number of range operators in C if The -Powers That Be are willing to let me. (I haven't asked yet, because I -need to do some more thinking on what operators I need to make life -totally range-based without ever having to convert back to normal -sequences.) - - -@node Group Info -@subsection Group Info - -Gnus stores all permanent info on groups in a @dfn{group info} list. -This list is from three to six elements (or more) long and exhaustively -describes the group. - -Here are two example group infos; one is a very simple group while the -second is a more complex one: - -@example -("no.group" 5 (1 . 54324)) - -("nnml:my.mail" 3 ((1 . 5) 9 (20 . 55)) - ((tick (15 . 19)) (replied 3 6 (19 . 3))) - (nnml "") - (auto-expire (to-address "ding@@gnus.org"))) -@end example - -The first element is the @dfn{group name}---as Gnus knows the group, -anyway. The second element is the @dfn{subscription level}, which -normally is a small integer. The third element is a list of ranges of -read articles. The fourth element is a list of lists of article marks -of various kinds. The fifth element is the select method (or virtual -server, if you like). The sixth element is a list of @dfn{group -parameters}, which is what this section is about. - -Any of the last three elements may be missing if they are not required. -In fact, the vast majority of groups will normally only have the first -three elements, which saves quite a lot of cons cells. - -Here's a BNF definition of the group info format: - -@example -info = "(" group space level space read - [ "" / [ space marks-list [ "" / [ space method [ "" / - space parameters ] ] ] ] ] ")" -group = quote quote -level = -read = range -marks-lists = nil / "(" *marks ")" -marks = "(" range ")" -method = "(" *elisp-forms ")" -parameters = "(" *elisp-forms ")" -@end example - -Actually that @samp{marks} rule is a fib. A @samp{marks} is a -@samp{} consed on to a @samp{range}, but that's a bitch to say -in pseudo-BNF. - -If you have a Gnus info and want to access the elements, Gnus offers a -series of macros for getting/setting these elements. - -@table @code -@item gnus-info-group -@itemx gnus-info-set-group -@findex gnus-info-group -@findex gnus-info-set-group -Get/set the group name. - -@item gnus-info-rank -@itemx gnus-info-set-rank -@findex gnus-info-rank -@findex gnus-info-set-rank -Get/set the group rank. - -@item gnus-info-level -@itemx gnus-info-set-level -@findex gnus-info-level -@findex gnus-info-set-level -Get/set the group level. - -@item gnus-info-score -@itemx gnus-info-set-score -@findex gnus-info-score -@findex gnus-info-set-score -Get/set the group score. - -@item gnus-info-read -@itemx gnus-info-set-read -@findex gnus-info-read -@findex gnus-info-set-read -Get/set the ranges of read articles. - -@item gnus-info-marks -@itemx gnus-info-set-marks -@findex gnus-info-marks -@findex gnus-info-set-marks -Get/set the lists of ranges of marked articles. - -@item gnus-info-method -@itemx gnus-info-set-method -@findex gnus-info-method -@findex gnus-info-set-method -Get/set the group select method. - -@item gnus-info-params -@itemx gnus-info-set-params -@findex gnus-info-params -@findex gnus-info-set-params -Get/set the group parameters. -@end table - -All the getter functions take one parameter---the info list. The setter -functions take two parameters---the info list and the new value. - -The last three elements in the group info aren't mandatory, so it may be -necessary to extend the group info before setting the element. If this -is necessary, you can just pass on a non-@code{nil} third parameter to -the three final setter functions to have this happen automatically. - - -@node Emacs/XEmacs Code -@subsection Emacs/XEmacs Code -@cindex XEmacs -@cindex Emacsen - -While Gnus runs under Emacs, XEmacs and Mule, I decided that one of the -platforms must be the primary one. I chose Emacs. Not because I don't -like XEmacs or Mule, but because it comes first alphabetically. - -This means that Gnus will byte-compile under Emacs with nary a warning, -while XEmacs will pump out gigabytes of warnings while byte-compiling. -As I use byte-compilation warnings to help me root out trivial errors in -Gnus, that's very useful. - -I've also consistently used Emacs function interfaces, but have used -Gnusey aliases for the functions. To take an example: Emacs defines a -@code{run-at-time} function while XEmacs defines a @code{start-itimer} -function. I then define a function called @code{gnus-run-at-time} that -takes the same parameters as the Emacs @code{run-at-time}. When running -Gnus under Emacs, the former function is just an alias for the latter. -However, when running under XEmacs, the former is an alias for the -following function: - -@lisp -(defun gnus-xmas-run-at-time (time repeat function &rest args) - (start-itimer - "gnus-run-at-time" - `(lambda () - (,function ,@@args)) - time repeat)) -@end lisp - -This sort of thing has been done for bunches of functions. Gnus does -not redefine any native Emacs functions while running under XEmacs---it -does this @code{defalias} thing with Gnus equivalents instead. Cleaner -all over. - -In the cases where the XEmacs function interface was obviously cleaner, -I used it instead. For example @code{gnus-region-active-p} is an alias -for @code{region-active-p} in XEmacs, whereas in Emacs it is a function. - -Of course, I could have chosen XEmacs as my native platform and done -mapping functions the other way around. But I didn't. The performance -hit these indirections impose on Gnus under XEmacs should be slight. - - -@node Various File Formats -@subsection Various File Formats - -@menu -* Active File Format:: Information on articles and groups available. -* Newsgroups File Format:: Group descriptions. -@end menu - - -@node Active File Format -@subsubsection Active File Format - -The active file lists all groups available on the server in -question. It also lists the highest and lowest current article numbers -in each group. - -Here's an excerpt from a typical active file: - -@example -soc.motss 296030 293865 y -alt.binaries.pictures.fractals 3922 3913 n -comp.sources.unix 1605 1593 m -comp.binaries.ibm.pc 5097 5089 y -no.general 1000 900 y -@end example - -Here's a pseudo-BNF definition of this file: - -@example -active = *group-line -group-line = group space high-number space low-number space flag -group = -space = " " -high-number = -low-number = -flag = "y" / "n" / "m" / "j" / "x" / "=" group -@end example - - -@node Newsgroups File Format -@subsubsection Newsgroups File Format - -The newsgroups file lists groups along with their descriptions. Not all -groups on the server have to be listed, and not all groups in the file -have to exist on the server. The file is meant purely as information to -the user. - -The format is quite simple; a group name, a tab, and the description. -Here's the definition: - -@example -newsgroups = *line -line = group tab description -group = -tab = -description = -@end example - - -@node Emacs for Heathens -@section Emacs for Heathens - -Believe it or not, but some people who use Gnus haven't really used -Emacs much before they embarked on their journey on the Gnus Love Boat. -If you are one of those unfortunates whom ``@kbd{M-C-a}'', ``kill the -region'', and ``set @code{gnus-flargblossen} to an alist where the key -is a regexp that is used for matching on the group name'' are magical -phrases with little or no meaning, then this appendix is for you. If -you are already familiar with Emacs, just ignore this and go fondle your -cat instead. - -@menu -* Keystrokes:: Entering text and executing commands. -* Emacs Lisp:: The built-in Emacs programming language. -@end menu - - -@node Keystrokes -@subsection Keystrokes - -@itemize @bullet -@item -Q: What is an experienced Emacs user? - -@item -A: A person who wishes that the terminal had pedals. -@end itemize - -Yes, when you use Emacs, you are apt to use the control key, the shift -key and the meta key a lot. This is very annoying to some people -(notably @code{vi}le users), and the rest of us just love the hell out -of it. Just give up and submit. Emacs really does stand for -``Escape-Meta-Alt-Control-Shift'', and not ``Editing Macros'', as you -may have heard from other disreputable sources (like the Emacs author). - -The shift keys are normally located near your pinky fingers, and are -normally used to get capital letters and stuff. You probably use it all -the time. The control key is normally marked ``CTRL'' or something like -that. The meta key is, funnily enough, never marked as such on any -keyboard. The one I'm currently at has a key that's marked ``Alt'', -which is the meta key on this keyboard. It's usually located somewhere -to the left hand side of the keyboard, usually on the bottom row. - -Now, us Emacs people don't say ``press the meta-control-m key'', -because that's just too inconvenient. We say ``press the @kbd{M-C-m} -key''. @kbd{M-} is the prefix that means ``meta'' and ``C-'' is the -prefix that means ``control''. So ``press @kbd{C-k}'' means ``press -down the control key, and hold it down while you press @kbd{k}''. -``Press @kbd{M-C-k}'' means ``press down and hold down the meta key and -the control key and then press @kbd{k}''. Simple, ay? - -This is somewhat complicated by the fact that not all keyboards have a -meta key. In that case you can use the ``escape'' key. Then @kbd{M-k} -means ``press escape, release escape, press @kbd{k}''. That's much more -work than if you have a meta key, so if that's the case, I respectfully -suggest you get a real keyboard with a meta key. You can't live without -it. - - - -@node Emacs Lisp -@subsection Emacs Lisp - -Emacs is the King of Editors because it's really a Lisp interpreter. -Each and every key you tap runs some Emacs Lisp code snippet, and since -Emacs Lisp is an interpreted language, that means that you can configure -any key to run any arbitrary code. You just, like, do it. - -Gnus is written in Emacs Lisp, and is run as a bunch of interpreted -functions. (These are byte-compiled for speed, but it's still -interpreted.) If you decide that you don't like the way Gnus does -certain things, it's trivial to have it do something a different way. -(Well, at least if you know how to write Lisp code.) However, that's -beyond the scope of this manual, so we are simply going to talk about -some common constructs that you normally use in your @file{.emacs} file -to customize Gnus. - -If you want to set the variable @code{gnus-florgbnize} to four (4), you -write the following: - -@lisp -(setq gnus-florgbnize 4) -@end lisp - -This function (really ``special form'') @code{setq} is the one that can -set a variable to some value. This is really all you need to know. Now -you can go and fill your @code{.emacs} file with lots of these to change -how Gnus works. - -If you have put that thing in your @code{.emacs} file, it will be read -and @code{eval}ed (which is lisp-ese for ``run'') the next time you -start Emacs. If you want to change the variable right away, simply say -@kbd{C-x C-e} after the closing parenthesis. That will @code{eval} the -previous ``form'', which is a simple @code{setq} statement here. - -Go ahead---just try it, if you're located at your Emacs. After you -@kbd{C-x C-e}, you will see @samp{4} appear in the echo area, which -is the return value of the form you @code{eval}ed. - -Some pitfalls: - -If the manual says ``set @code{gnus-read-active-file} to @code{some}'', -that means: - -@lisp -(setq gnus-read-active-file 'some) -@end lisp - -On the other hand, if the manual says ``set @code{gnus-nntp-server} to -@samp{nntp.ifi.uio.no}'', that means: - -@lisp -(setq gnus-nntp-server "nntp.ifi.uio.no") -@end lisp - -So be careful not to mix up strings (the latter) with symbols (the -former). The manual is unambiguous, but it can be confusing. - - -@include gnus-faq.texi - -@node Index -@chapter Index -@printindex cp - -@node Key Index -@chapter Key Index -@printindex ky - -@summarycontents -@contents -@bye - -@iftex -@iflatex -\end{document} -@end iflatex -@end iftex - -@c End: - diff -r 6866abce6aaf -r 6075d714658b man/hm--html-mode.texi --- a/man/hm--html-mode.texi Mon Aug 13 09:50:16 2007 +0200 +++ b/man/hm--html-mode.texi Mon Aug 13 09:51:16 2007 +0200 @@ -4,7 +4,7 @@ @settitle HM HTML Mode @setchapternewpage odd @comment %**end of header (This is for running Texinfo on a region.) -@comment $Id: hm--html-mode.texi,v 1.3 1997/05/29 23:50:32 steve Exp $ +@comment $Id: hm--html-mode.texi,v 1.4 1997/07/26 22:10:08 steve Exp $ @ifinfo This file documents the Elisp package @code{hm--html-menus}. @@ -40,12 +40,12 @@ @end iftex @titlepage @sp 10 -@center @titlefont{The Elisp Package hm---html-menus} +@center @titlefont{The Elisp Package hm{-}{-}html{-}menus} @sp 4 @center by Heiko Münkel @sp 4 -@center Version 5.7, May 1997 +@center Version 5.8, July 1997 @page @vskip 0pt plus 1filll Copyright @copyright{} 1997 Heiko Münkel @@ -91,7 +91,7 @@ * Installation:: How to install the package * Customization:: How to customize the package * Add New Elements:: How to add new HTML elements -* Use With psgml-html:: Use this package as an add-on minor mode +* Use With Other Major Modes:: * Internal Drag And Drop:: The HTML independent drag and drop package * Template Minor Mode:: The HTML independent template package * Hints For Emacs 19 Users:: Missing features in the Emacs 19 @@ -132,16 +132,17 @@ @findex hm--html-mode @findex hm--html-minor-mode -This document describes the Elisp package @emph{hm---html-menus 5.7}. +This document describes the Elisp package @emph{hm---html-menus 5.8}. The version of the document is:@* -$Id: hm--html-mode.texi,v 1.3 1997/05/29 23:50:32 steve Exp $ +$Id: hm--html-mode.texi,v 1.4 1997/07/26 22:10:08 steve Exp $ The package provides commands and various popup and pulldown menus for an HTML mode called @dfn{hm---html-mode}, a mode for writing HTML pages for the World Wide Web (WWW). It also provides a minor mode -(@dfn{hm---html-minor-mode}), which can be used together with another -HTML major mode, like the psgml-html modes in XEmacs 19.14. +(@dfn{hm---html-minor-mode}), which can be used together with other HTML +major modes, like the psgml-html mode in XEmacs 19.14 or other major +edit modes, like the perl-mode. You can easily view the HTML documents by calling the browsers w3 (a nice elisp package from William M. Perry), Netscape, or Mosaic directly @@ -211,6 +212,10 @@ @itemx adapt.el Provides (emulates XEmacs) functions for the use of this package with GNU Emacs 19. +@itemx drop +An xbm file with the drag and drop mouse pointer in the XEmacs. +@itemx dropmsk +An xbm file with the mask for the drag and drop mouse pointer in the XEmacs. @itemx hm--html.el Provides functions to write html pages. It defines all commands which insert html elements and entities. @@ -271,6 +276,17 @@ @item Put all the *.el files in one of your XEmacs (or emacs) lisp load directories (e.g. site-lisp/hm--html-menus). +@item @emph{For XEmacs only}: Put the files @file{drop} and @file{dropmsk} +in the directory specified by the lisp variable +@code{idd-data-directory}. By default it is +@file{/lib/xemacs-/etc/idd} (eg: if you have installed +the XEmacs 19.15 at your site in @file{/usr/local}, then it is the +directory @file{/usr/local/xemacs/lib/xemacs-19.15/etc/idd}. + +If you'd like to put the files in another directory, then you must set +the variable @code{idd-data-directory} to this directory (eg: +@code{(setq idd-data-directory "/usr/local/data")}) + @item Put the following in your .emacs (or default.el or site-init.el): @lisp (autoload 'hm--html-mode "hm--html-mode" "HTML major mode." t) @@ -365,6 +381,16 @@ adapt the package better to your special needs. How to do this is described in this chapter. +Since the XEmacs 19.15 and 20.2 a special package can be used for the +customization of lisp packages. This package uses now also this +feature. Therefore you can set all user variables with the help of the +Customize submenu, which can be selected in the Option menu. If you use +it, the variables will currently be saved in a special customization +file and not in one of the configuration files (@pxref{Customization +(Configuration) Files, Customization (Configuration) Files}) of this +package. Please look at the @file{NEWS} file or the info manuals of the +XEmacs to find out more about the customization package. + @menu * Customization (Configuration) Files:: * Customization Variables:: @@ -437,6 +463,9 @@ The environment variables overwrite the lisp variables. +You can prevent the loading of the site specific customization file +by starting the emacs with the -no-site-file flag. + You can also put the site specific customization in any standard emacs customization file like, @file{default.el}. But an advantage to using @file{hm--site-configuration-file.el} is that it is very likely @@ -462,6 +491,13 @@ its path. If you write the filename without its extension (.el), emacs tries first to load a compiled version of the file. +If neither the environment variable nor the lisp variable is set, the +variable @code{init-file-user} will be respected. This means, that +you'll get the @file{~other-user/.hm--html-configuration.el}, if you've +started the emacs with the options @code{-u other-user}. In all cases, +no user specific customization file will be loaded, if the @code{-q} +option was given to the emacs. + You can also put the user specific customization in your @file{.emacs}. It's up to you to decide which way is better. @@ -949,7 +985,7 @@ @cindex date @cindex changed comment @cindex created comment -@vindex hm--html-automatic-new-date +@vindex hm--html-automatic-update-title-date @vindex hm--html-automatic-changed-comment @vindex hm--html-automatic-create-modified-line @vindex hm--html-automatic-update-modified-line @@ -1093,10 +1129,10 @@ @itemize @bullet @item @code{hm--html-minor-mode-prefix-key}: The prefix key for the key tables -in @code{hm--html-minor-mode}. +in the minor mode @code{hm--html-minor-mode}. @item -@code{hm--html-mode-prefix-key}: The prefix key for the hm--html keys in -@code{hm--html-mode}. +@code{hm--html-mode-prefix-key}: The prefix key for the keys in the +major mode @code{hm--html-mode}. @end itemize @@ -1220,7 +1256,7 @@ @end itemize -@node Add New Elements, Use With psgml-html, Customization, Top +@node Add New Elements, Use With Other Major Modes, Customization, Top @comment node-name, next, previous, up @chapter Add New Elements @cindex add new html elements @@ -1318,17 +1354,23 @@ the submenu groups. -@node Use With psgml-html, Internal Drag And Drop, Add New Elements, Top +@node Use With Other Major Modes, Internal Drag And Drop, Add New Elements, Top @comment node-name, next, previous, up -@chapter Use With psgml-html -@cindex use with other HTML modes +@chapter Use With Other Major Modes +@cindex use with other major modes +@cindex use with psgml-html +@cindex psgml-html @findex hm--html-minor-mode The package provides a minor mode called @code{hm--html-minor-mode}, -which could be used to join the features of this package with another -HTML package. Currently this is only tested with the psgml-html mode in -XEmacs. Please let me know if it works or not with other packages -or in Emacs 19. +which could be used to join the features of this package with other HTML +packages or use it's features in other major edit modes. This is +usefull, if you'd like to extend another HTML mode or if you'll write +program code, which contain HTML parts. + +Currently this is tested with the psgml-html mode, the @code{perl-mode} +and the @code{java-mode}. Please let me know if it works or not with +other packages. If you'd like to use the minor mode in psgml-html mode, put the following line in your @file{.emacs}: @@ -1344,7 +1386,7 @@ lisp file of the psgml-html mode. -@node Internal Drag And Drop, Template Minor Mode, Use With psgml-html, Top +@node Internal Drag And Drop, Template Minor Mode, Use With Other Major Modes, Top @comment node-name, next, previous, up @chapter Internal Drag And Drop @cindex drag and drop @@ -1377,6 +1419,14 @@ @cindex customization @cindex configuration +Since the XEmacs 19.15 and 20.2 a special package can be used for the +customization of lisp packages. The internal drag and drop package uses +now also this feature. Therefore you can set all user variables with the +help of the Customize submenu, which can be selected in the Option menu. +If you use it, the variables will currently be saved in a special +customization file. Please look at the @file{NEWS} file or the info +manuals of the XEmacs to find out more about the customization package. + The internal drag and drop functions may be used in all modes. Therefore their general customization isn't done in @file{hm--html-configuration.el}. Its variables are defined in the file @@ -1389,6 +1439,7 @@ @menu * Defining The Drag And Drop Actions:: * The Mouse Bindings:: +* The Drag And Drop Mouse Pointer:: @end menu @node Defining The Drag And Drop Actions, The Mouse Bindings, Drag And Drop Customization, Drag And Drop Customization @@ -1495,7 +1546,7 @@ @end lisp -@node The Mouse Bindings, , Defining The Drag And Drop Actions, Drag And Drop Customization +@node The Mouse Bindings, The Drag And Drop Mouse Pointer, Defining The Drag And Drop Actions, Drag And Drop Customization @comment node-name, next, previous, up @subsection The Mouse Bindings @cindex mouse bindings @@ -1557,6 +1608,51 @@ region can't be started with that type of mouse binding. @end itemize +@node The Drag And Drop Mouse Pointer, , The Mouse Bindings, Drag And Drop Customization +@comment node-name, next, previous, up +@subsection The Drag And Drop Mouse Pointer +@cindex mouse pointer glyph +@vindex idd-mouse-pointer-image +@vindex idd-data-directory +@vindex idd-overwrite-mouse-pointers +@vindex idd-drag-and-drop-pointer-glyph +@findex idd-make-drag-and-drop-pointer-glyph + +In the XEmacs the mouse pointer glyph (shape) can be set to any +glyph. This is used during the drag and drop command to indicate, that +the command is active. There exists the following three variables to +customize this: + +@itemize @bullet +@item +@code{idd-mouse-pointer-image}: The name of the xbm file with the mouse +pointer image. By default this is the file @file{drop}. There exists +also a file called @file{dropmsk}, which contains the mask image. The +mask file is loaded automaticly. + +@item +@code{idd-data-directory}: The name fo the directory, where the file +@code{idd-mouse-pointer-image} is searched. By default this is the +subdirectory @file{idd} in the XEmacs install directory +@code{data-directory}. + +@item +@code{idd-overwrite-mouse-pointers}: A list with pointer glyph +variables, which should be overwritten by the +@code{idd-drag-and-drop-pointer-glyph}. If it is nil, the pointer wont +be changed. Currently it must be nil in the Emacs. +@end itemize + +If one of the variables @code{idd-mouse-pointer-image} or +@code{idd-data-directory} is changed, the command +@code{idd-make-drag-and-drop-pointer-glyph} must be called. This command +builds the mouse pointer glyph, which is stored in +@code{idd-drag-and-drop-pointer-glyph}. + +I don't know how to set the the mouse pointer in the Emacs to a drag and +drop image. Any hints for doing this are welcome. + + @node The Drag And Drop Commands, , Drag And Drop Customization, Internal Drag And Drop @comment node-name, next, previous, up @section The Drag And Drop Commands @@ -1879,10 +1975,18 @@ @vindex tmpl-sign @vindex tmpl-minor-mode-map +Since the XEmacs 19.15 and 20.2 a special package can be used for the +customization of lisp packages. The internal drag and drop package uses +now also this feature. Therefore you can set all user variables with the +help of the Customize submenu, which can be selected in the Option menu. +If you use it, the variables will currently be saved in a special +customization file. Please look at the @file{NEWS} file or the info +manuals of the XEmacs to find out more about the customization package. + Templates may be used for all editing modes, not only for -@code{hm--html-mode}. Therefore their general customization isn't done in -@file{hm--html-configuration.el}. Template variables are defined in the file -@file{tmpl-minor-mode.el} instead. You can set them in your +@code{hm--html-mode}. Therefore their general customization isn't done +in @file{hm--html-configuration.el}. Template variables are defined in +the file @file{tmpl-minor-mode.el} instead. You can set them in your @file{.emacs} or in one of the other emacs init files (e.g. @file{default.el}). The following are the main variables for customization. @@ -2101,6 +2205,11 @@ The history variable determined by @code{tmpl-history-variable-name} isn't used, because the function @code{read-file-name} doesn't support it in the Emacs 19. + +@item +The mouse pointer shape (glyph) wont be changed in the Emacs 19 during a +drag and drop command. For that a way is needed to set the mouse pointer +shape to an image. @end itemize diff -r 6866abce6aaf -r 6075d714658b man/lispref/minibuf.texi --- a/man/lispref/minibuf.texi Mon Aug 13 09:50:16 2007 +0200 +++ b/man/lispref/minibuf.texi Mon Aug 13 09:51:16 2007 +0200 @@ -1,6 +1,6 @@ @c -*-texinfo-*- @c This is part of the XEmacs Lisp Reference Manual. -@c Copyright (C) 1990, 1991, 1992, 1993, 1994 Free Software Foundation, Inc. +@c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1997 Free Software Foundation, Inc. @c See the file lispref.texi for copying conditions. @setfilename ../../info/minibuf.info @node Minibuffers, Command Loop, Read and Print, Top @@ -319,7 +319,7 @@ @noindent Typing @key{RET} right away would exit the minibuffer and evaluate the expression, thus moving point forward one word. -@code{edit-and-eval-command} returns @code{nil} in this example. +@code{edit-and-eval-command} returns @code{t} in this example. @end defun @node Minibuffer History @@ -395,6 +395,18 @@ A history list for arguments that are Lisp expressions to evaluate. @end defvar +@defvar Info-minibuffer-history +A history list for Info mode's minibuffer. +@end defvar + +@defvar Manual-page-minibuffer-history +A history list for @code{manual-entry}. +@end defvar + + There are many other minibuffer history lists, defined by various +libraries. An @kbd{M-x apropos} search for @samp{history} should prove +fruitful in discovering them. + @node Completion @section Completion @cindex completion diff -r 6866abce6aaf -r 6075d714658b man/lispref/streams.texi --- a/man/lispref/streams.texi Mon Aug 13 09:50:16 2007 +0200 +++ b/man/lispref/streams.texi Mon Aug 13 09:51:16 2007 +0200 @@ -483,8 +483,8 @@ @group last-output - @result{} (10 34 116 117 112 116 117 111 32 101 104 - 116 32 115 105 32 115 105 104 84 34 10) + @result{} (?\n ?\" ?t ?u ?p ?t ?u ?o ?\ ?e ?h ?t + ?\ ?s ?i ?\ ?s ?i ?h ?T ?\" ?\n) @end group @end example diff -r 6866abce6aaf -r 6075d714658b man/message.texi --- a/man/message.texi Mon Aug 13 09:50:16 2007 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,1157 +0,0 @@ -\input texinfo @c -*-texinfo-*- - -@setfilename message -@settitle Message 5.4.63 Manual -@synindex fn cp -@synindex vr cp -@synindex pg cp -@iftex -@finalout -@end iftex -@setchapternewpage odd - -@ifinfo - -This file documents Message, the Emacs message composition mode. - -Copyright (C) 1996 Free Software Foundation, Inc. - -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. - -@ignore -Permission is granted to process this file through Tex and print the -results, provided the printed document carries copying permission -notice identical to this one except for the removal of this paragraph -(this paragraph not being relevant to the printed manual). - -@end ignore -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided also that the -entire resulting derived work is distributed under the terms of a -permission notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions. -@end ifinfo - -@tex - -@titlepage -@title Message 5.4.63 Manual - -@author by Lars Magne Ingebrigtsen -@page - -@vskip 0pt plus 1filll -Copyright @copyright{} 1996 Free Software Foundation, Inc. - -Permission is granted to make and distribute verbatim copies of -this manual provided the copyright notice and this permission notice -are preserved on all copies. - -Permission is granted to copy and distribute modified versions of this -manual under the conditions for verbatim copying, provided that the -entire resulting derived work is distributed under the terms of a -permission notice identical to this one. - -Permission is granted to copy and distribute translations of this manual -into another language, under the above conditions for modified versions. - -@end titlepage -@page - -@end tex - -@node Top -@top Message - -All message composition (both mail and news) takes place in Message mode -buffers. - -@menu -* Interface:: Setting up message buffers. -* Commands:: Commands you can execute in message mode buffers. -* Variables:: Customizing the message buffers. -* Compatibility:: Making Message backwards compatible. -* Index:: Variable, function and concept index. -* Key Index:: List of Message mode keys. -@end menu - -This manual corresponds to Message 5.4.63. Message is distributed with -the Gnus distribution bearing the same version number as this manual -has. - - -@node Interface -@chapter Interface - -When a program (or a person) wants to respond to a message -- reply, -follow up, forward, cancel -- the program (or person) should just put -point in the buffer where the message is and call the required command. -@code{Message} will then pop up a new @code{message} mode buffer with -appropriate headers filled out, and the user can edit the message before -sending it. - -@menu -* New Mail Message:: Editing a brand new mail message. -* New News Message:: Editing a brand new news message. -* Reply:: Replying via mail. -* Wide Reply:: Responding to all people via mail. -* Followup:: Following up via news. -* Canceling News:: Canceling a news article. -* Superseding:: Superseding a message. -* Forwarding:: Forwarding a message via news or mail. -* Resending:: Resending a mail message. -* Bouncing:: Bouncing a mail message. -@end menu - - -@node New Mail Message -@section New Mail Message - -@findex message-mail -The @code{message-mail} command pops up a new message buffer. - -Two optional parameters are accepted: The first will be used as the -@code{To} header and the second as the @code{Subject} header. If these -aren't present, those two headers will be empty. - - -@node New News Message -@section New News Message - -@findex message-news -The @code{message-news} command pops up a new message buffer. - -This function accepts two optional parameters. The first will be used -as the @code{Newsgroups} header and the second as the @code{Subject} -header. If these aren't present, those two headers will be empty. - - -@node Reply -@section Reply - -@findex message-reply -The @code{message-reply} function pops up a message buffer that's a -reply to the message in the current buffer. - -@vindex message-reply-to-function -Message uses the normal methods to determine where replies are to go, -but you can change the behavior to suit your needs by fiddling with the -@code{message-reply-to-function} variable. - -If you want the replies to go to the @code{Sender} instead of the -@code{From}, you could do something like this: - -@lisp -(setq message-reply-to-function - (lambda () - (cond ((equal (mail-fetch-field "from") "somebody") - (mail-fetch-field "sender")) - (t - nil)))) -@end lisp - -This function will be called narrowed to the head of the article that is -being replied to. - -As you can see, this function should return a string if it has an -opinion as to what the To header should be. If it does not, it should -just return @code{nil}, and the normal methods for determining the To -header will be used. - -This function can also return a list. In that case, each list element -should be a cons, where the car should be the name of an header -(eg. @code{Cc}) and the cdr should be the header value -(eg. @samp{larsi@@ifi.uio.no}). All these headers will be inserted into -the head of the outgoing mail. - - -@node Wide Reply -@section Wide Reply - -@findex message-wide-reply -The @code{message-wide-reply} pops up a message buffer that's a wide -reply to the message in the current buffer. A @dfn{wide reply} is a -reply that goes out to all people listed in the @code{To}, @code{From} -(or @code{Reply-to}) and @code{Cc} headers. - -@vindex message-wide-reply-to-function -Message uses the normal methods to determine where wide replies are to go, -but you can change the behavior to suit your needs by fiddling with the -@code{message-wide-reply-to-function}. It is used in the same way as -@code{message-reply-to-function} (@pxref{Reply}). - -@findex rmail-dont-reply-to-names -Addresses that match the @code{rmail-dont-reply-to-names} regular -expression will be removed from the @code{Cc} header. - - -@node Followup -@section Followup - -@findex message-followup -The @code{message-followup} command pops up a message buffer that's a -followup to the message in the current buffer. - -@vindex message-followup-to-function -Message uses the normal methods to determine where followups are to go, -but you can change the behavior to suit your needs by fiddling with the -@code{message-followup-to-function}. It is used in the same way as -@code{message-reply-to-function} (@pxref{Reply}). - -@vindex message-use-followup-to -The @code{message-use-followup-to} variable says what to do about -@code{Followup-To} headers. If it is @code{use}, always use the value. -If it is @code{ask} (which is the default), ask whether to use the -value. If it is @code{t}, use the value unless it is @samp{poster}. If -it is @code{nil}, don't use the value. - - -@node Canceling News -@section Canceling News - -@findex message-cancel-news -The @code{message-cancel-news} command cancels the article in the -current buffer. - - -@node Superseding -@section Superseding - -@findex message-supersede -The @code{message-supersede} command pops up a message buffer that will -supersede the message in the current buffer. - -@vindex message-ignored-supersedes-headers -Headers matching the @code{message-ignored-supersedes-headers} are -removed before popping up the new message buffer. The default is@* -@samp{^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|@* -^Received:\\|^X-From-Line:\\|Return-Path:}. - - - -@node Forwarding -@section Forwarding - -@findex message-forward -The @code{message-forward} command pops up a message buffer to forward -the message in the current buffer. If given a prefix, forward using -news. - -@table @code -@item message-forward-start-separator -@vindex message-forward-start-separator -Delimiter inserted before forwarded messages. The default is@* -@samp{------- Start of forwarded message -------\n}. - -@vindex message-forward-end-separator -@item message-forward-end-separator -@vindex message-forward-end-separator -Delimiter inserted after forwarded messages. The default is@* -@samp{------- End of forwarded message -------\n}. - -@item message-signature-before-forwarded-message -@vindex message-signature-before-forwarded-message -If this variable is @code{t}, which it is by default, your personal -signature will be inserted before the forwarded message. If not, the -forwarded message will be inserted first in the new mail. - -@item message-included-forward-headers -@vindex message-included-forward-headers -Regexp matching header lines to be included in forwarded messages. - -@end table - - -@node Resending -@section Resending - -@findex message-resend -The @code{message-resend} command will prompt the user for an address -and resend the message in the current buffer to that address. - -@vindex message-ignored-resent-headers -Headers that match the @code{message-ignored-resent-headers} regexp will -be removed before sending the message. The default is -@samp{^Return-receipt}. - - -@node Bouncing -@section Bouncing - -@findex message-bounce -The @code{message-bounce} command will, if the current buffer contains a -bounced mail message, pop up a message buffer stripped of the bounce -information. A @dfn{bounced message} is typically a mail you've sent -out that has been returned by some @code{mailer-daemon} as -undeliverable. - -@vindex message-ignored-bounced-headers -Headers that match the @code{message-ignored-bounced-headers} regexp -will be removed before popping up the buffer. The default is -@samp{^Received:}. - - -@node Commands -@chapter Commands - -@menu -* Header Commands:: Commands for moving to headers. -* Movement:: Moving around in message buffers. -* Insertion:: Inserting things into message buffers. -* Various Commands:: Various things. -* Sending:: Actually sending the message. -* Mail Aliases:: How to use mail aliases. -@end menu - - -@node Header Commands -@section Header Commands - -All these commands move to the header in question. If it doesn't exist, -it will be inserted. - -@table @kbd - -@item C-c ? -@kindex C-c ? -@findex message-goto-to -Describe the message mode. - -@item C-c C-f C-t -@kindex C-c C-f C-t -@findex message-goto-to -Go to the @code{To} header (@code{message-goto-to}). - -@item C-c C-f C-b -@kindex C-c C-f C-b -@findex message-goto-bcc -Go to the @code{Bcc} header (@code{message-goto-bcc}). - -@item C-c C-f C-f -@kindex C-c C-f C-f -@findex message-goto-fcc -Go to the @code{Fcc} header (@code{message-goto-fcc}). - -@item C-c C-f C-c -@kindex C-c C-f C-c -@findex message-goto-cc -Go to the @code{Cc} header (@code{message-goto-cc}). - -@item C-c C-f C-s -@kindex C-c C-f C-s -@findex message-goto-subject -Go to the @code{Subject} header (@code{message-goto-subject}). - -@item C-c C-f C-r -@kindex C-c C-f C-r -@findex message-goto-reply-to -Go to the @code{Reply-To} header (@code{message-goto-reply-to}). - -@item C-c C-f C-n -@kindex C-c C-f C-n -@findex message-goto-newsgroups -Go to the @code{Newsgroups} header (@code{message-goto-newsgroups}). - -@item C-c C-f C-d -@kindex C-c C-f C-d -@findex message-goto-distribution -Go to the @code{Distribution} header (@code{message-goto-distribution}). - -@item C-c C-f C-o -@kindex C-c C-f C-o -@findex message-goto-followup-to -Go to the @code{Followup-To} header (@code{message-goto-followup-to}). - -@item C-c C-f C-k -@kindex C-c C-f C-k -@findex message-goto-keywords -Go to the @code{Keywords} header (@code{message-goto-keywords}). - -@item C-c C-f C-u -@kindex C-c C-f C-u -@findex message-goto-summary -Go to the @code{Summary} header (@code{message-goto-summary}). - -@end table - - -@node Movement -@section Movement - -@table @kbd -@item C-c C-b -@kindex C-c C-b -@findex message-goto-body -Move to the beginning of the body of the message -(@code{message-goto-body}). - -@item C-c C-i -@kindex C-c C-i -@findex message-goto-signature -Move to the signature of the message (@code{message-goto-signature}). - -@end table - - -@node Insertion -@section Insertion - -@table @kbd - -@item C-c C-y -@kindex C-c C-y -@findex message-yank-original -Yank the message that's being replied to into the message buffer -(@code{message-yank-original}). - -@item C-c C-q -@kindex C-c C-q -@findex message-fill-yanked-message -Fill the yanked message (@code{message-fill-yanked-message}). - -@item C-c C-w -@kindex C-c C-w -@findex message-insert-signature -Insert a signature at the end of the buffer -(@code{message-insert-signature}). - -@end table - -@table @code -@item message-ignored-cited-headers -@vindex message-ignored-cited-headers -All headers that match this regexp will be removed from yanked -messages. The default is @samp{.}, which means that all headers will be -removed. - -@item message-citation-line-function -@vindex message-citation-line-function -Function called to insert the citation line. The default is -@code{message-insert-citation-line}. - -@item message-yank-prefix -@vindex message-yank-prefix -@cindex yanking -@cindex quoting -When you are replying to or following up an article, you normally want -to quote the person you are answering. Inserting quoted text is done by -@dfn{yanking}, and each quoted line you yank will have -@code{message-yank-prefix} prepended to it. The default is @samp{> }. -If it is @code{nil}, just indent the message. - -@item message-indentation-spaces -@vindex message-indentation-spaces -Number of spaces to indent yanked messages. - -@item message-cite-function -@vindex message-cite-function -@findex message-cite-original -@findex sc-cite-original -@cindex Supercite -Function for citing an original message. The default is -@code{message-cite-original}. You can also set it to -@code{sc-cite-original} to use Supercite. - -@item message-indent-citation-function -@vindex message-indent-citation-function -Function for modifying a citation just inserted in the mail buffer. -This can also be a list of functions. Each function can find the -citation between @code{(point)} and @code{(mark t)}. And each function -should leave point and mark around the citation text as modified. - -@item message-signature -@vindex message-signature -String to be inserted at the end of the message buffer. If @code{t} -(which is the default), the @code{message-signature-file} file will be -inserted instead. If a function, the result from the function will be -used instead. If a form, the result from the form will be used instead. -If this variable is @code{nil}, no signature will be inserted at all. - -@item message-signature-file -@vindex message-signature-file -File containing the signature to be inserted at the end of the buffer. -The default is @samp{~/.signature}. - -@end table - -Note that RFC1036 says that a signature should be preceded by the three -characters @samp{-- } on a line by themselves. This is to make it -easier for the recipient to automatically recognize and process the -signature. So don't remove those characters, even though you might feel -that they ruin your beautiful design, like, totally. - -Also note that no signature should be more than four lines long. -Including ASCII graphics is an efficient way to get everybody to believe -that you are silly and have nothing important to say. - - - -@node Various Commands -@section Various Commands - -@table @kbd - -@item C-c C-r -@kindex C-c C-r -@findex message-caesar-buffer-body -Caesar rotate (aka. rot13) the current message -(@code{message-caesar-buffer-body}). If narrowing is in effect, just -rotate the visible portion of the buffer. A numerical prefix says how -many places to rotate the text. The default is 13. - -@item C-c C-e -@kindex C-c C-e -@findex message-elide-region -Elide the text between point and mark (@code{message-elide-region}). -The text is killed and an ellipsis (@samp{[...]}) will be inserted in -its place. - -@item C-c C-t -@kindex C-c C-t -@findex message-insert-to -Insert a @code{To} header that contains the @code{Reply-To} or -@code{From} header of the message you're following up -(@code{message-insert-to}). - -@item C-c C-n -@kindex C-c C-n -@findex message-insert-newsgroups -Insert a @code{Newsgroups} header that reflects the @code{Followup-To} -or @code{Newsgroups} header of the article you're replying to -(@code{message-insert-newsgroups}). - -@item C-c M-r -@kindex C-c M-r -@findex message-rename-buffer -Rename the buffer (@code{message-rename-buffer}). If given a prefix, -prompt for a new buffer name. - -@end table - - -@node Sending -@section Sending - -@table @kbd -@item C-c C-c -@kindex C-c C-c -@findex message-send-and-exit -Send the message and bury the current buffer -(@code{message-send-and-exit}). - -@item C-c C-s -@kindex C-c C-s -@findex message-send -Send the message (@code{message-send}). - -@item C-c C-d -@kindex C-c C-d -@findex message-dont-send -Bury the message buffer and exit (@code{message-dont-send}). - -@item C-c C-k -@kindex C-c C-k -@findex message-kill-buffer -Kill the message buffer and exit (@code{message-kill-buffer}). - -@end table - - - -@node Mail Aliases -@section Mail Aliases -@cindex mail aliases -@cindex aliases - -@vindex message-mail-alias-type -The @code{message-mail-alias-type} variable controls what type of mail -alias expansion to use. Currently only one form is supported---Message -uses @code{mailabbrev} to handle mail aliases. If this variable is -@code{nil}, no mail alias expansion will be performed. - -@code{mailabbrev} works by parsing the @file{/etc/mailrc} and -@file{~/.mailrc} files. These files look like: - -@example -alias lmi "Lars Magne Ingebrigtsen " -alias ding "ding@@ifi.uio.no (ding mailing list)" -@end example - -After adding lines like this to your @file{~/.mailrc} file, you should -be able to just write @samp{lmi} in the @code{To} or @code{Cc} (and so -on) headers and press @kbd{SPC} to expand the alias. - -No expansion will be performed upon sending of the message---all -expansions have to be done explicitly. - - - -@node Variables -@chapter Variables - -@menu -* Message Headers:: General message header stuff. -* Mail Headers:: Customizing mail headers. -* Mail Variables:: Other mail variables. -* News Headers:: Customizing news headers. -* News Variables:: Other news variables. -* Various Message Variables:: Other message variables. -* Sending Variables:: Variables for sending. -* Message Buffers:: How Message names its buffers. -* Message Actions:: Actions to be performed when exiting. -@end menu - - -@node Message Headers -@section Message Headers - -Message is quite aggressive on the message generation front. It has -to be -- it's a combined news and mail agent. To be able to send -combined messages, it has to generate all headers itself to ensure that -mail and news copies of messages look sufficiently similar. - -@table @code - -@item message-generate-headers-first -@vindex message-generate-headers-first -If non-@code{nil}, generate all headers before starting to compose the -message. - -@item message-from-style -@vindex message-from-style -Specifies how @code{From} headers should look. There are four legal -values: - -@table @code -@item nil -Just the address -- @samp{king@@grassland.com}. - -@item parens -@samp{king@@grassland.com (Elvis Parsley)}. - -@item angles -@samp{Elvis Parsley }. - -@item default -Look like @code{angles} if that doesn't require quoting, and -@code{parens} if it does. If even @code{parens} requires quoting, use -@code{angles} anyway. - -@end table - -@item message-deletable-headers -@vindex message-deletable-headers -Headers in this list that were previously generated by Message will be -deleted before posting. Let's say you post an article. Then you decide -to post it again to some other group, you naughty boy, so you jump back -to the @code{*post-buf*} buffer, edit the @code{Newsgroups} line, and -ship it off again. By default, this variable makes sure that the old -generated @code{Message-ID} is deleted, and a new one generated. If -this isn't done, the entire empire would probably crumble, anarchy would -prevail, and cats would start walking on two legs and rule the world. -Allegedly. - -@item message-default-headers -@vindex message-default-headers -This string is inserted at the end of the headers in all message -buffers. - -@end table - - -@node Mail Headers -@section Mail Headers - -@table @code -@item message-required-mail-headers -@vindex message-required-mail-headers -@xref{News Headers}, for the syntax of this variable. It is -@code{(From Date Subject (optional . In-Reply-To) Message-ID Lines -(optional . X-Mailer))} by default. - -@item message-ignored-mail-headers -@vindex message-ignored-mail-headers -Regexp of headers to be removed before mailing. The default is -@samp{^Gcc:\\|^Fcc:}. - -@item message-default-mail-headers -@vindex message-default-mail-headers -This string is inserted at the end of the headers in all message -buffers that are initialized as mail. - -@end table - - -@node Mail Variables -@section Mail Variables - -@table @code -@item message-send-mail-function -@vindex message-send-mail-function -Function used to send the current buffer as mail. The default is -@code{message-send-mail-with-sendmail}. If you prefer using MH -instead, set this variable to @code{message-send-mail-with-mh}. - -@item message-mh-deletable-headers -@vindex message-mh-deletable-headers -Most versions of MH doesn't like being fed messages that contain the -headers in this variable. If this variable is non-@code{nil} (which is -the default), these headers will be removed before mailing. Set it to -@code{nil} if your MH can handle these headers. - -@end table - - -@node News Headers -@section News Headers - -@vindex message-required-news-headers -@code{message-required-news-headers} a list of header symbols. These -headers will either be automatically generated, or, if that's -impossible, they will be prompted for. The following symbols are legal: - -@table @code - -@item From -@cindex From -@findex user-full-name -@findex user-mail-address -This required header will be filled out with the result of the -@code{message-make-from} function, which depends on the -@code{message-from-style}, @code{user-full-name}, -@code{user-mail-address} variables. - -@item Subject -@cindex Subject -This required header will be prompted for if not present already. - -@item Newsgroups -@cindex Newsgroups -This required header says which newsgroups the article is to be posted -to. If it isn't present already, it will be prompted for. - -@item Organization -@cindex organization -This optional header will be filled out depending on the -@code{message-user-organization} variable. -@code{message-user-organization-file} will be used if this variable is -@code{t}. This variable can also be a string (in which case this string -will be used), or it can be a function (which will be called with no -parameters and should return a string to be used). - -@item Lines -@cindex Lines -This optional header will be computed by Message. - -@item Message-ID -@cindex Message-ID -@vindex mail-host-address -@findex system-name -@cindex Sun -This required header will be generated by Message. A unique ID will be -created based on the date, time, user name and system name. Message will -use @code{mail-host-address} as the fully qualified domain name (FQDN) -of the machine if that variable is defined. If not, it will use -@code{system-name}, which doesn't report a FQDN on some machines -- -notably Suns. - -@item X-Newsreader -@cindex X-Newsreader -This optional header will be filled out according to the -@code{message-newsreader} local variable. - -@item X-Mailer -This optional header will be filled out according to the -@code{message-mailer} local variable, unless there already is an -@code{X-Newsreader} header present. - -@item In-Reply-To -This optional header is filled out using the @code{Date} and @code{From} -header of the article being replied to. - -@item Expires -@cindex Expires -This extremely optional header will be inserted according to the -@code{message-expires} variable. It is highly deprecated and shouldn't -be used unless you know what you're doing. - -@item Distribution -@cindex Distribution -This optional header is filled out according to the -@code{message-distribution-function} variable. It is a deprecated and -much misunderstood header. - -@item Path -@cindex path -This extremely optional header should probably never be used. -However, some @emph{very} old servers require that this header is -present. @code{message-user-path} further controls how this -@code{Path} header is to look. If it is @code{nil}, use the server name -as the leaf node. If it is a string, use the string. If it is neither -a string nor @code{nil}, use the user name only. However, it is highly -unlikely that you should need to fiddle with this variable at all. -@end table - -@findex yow -@cindex Mime-Version -In addition, you can enter conses into this list. The car of this cons -should be a symbol. This symbol's name is the name of the header, and -the cdr can either be a string to be entered verbatim as the value of -this header, or it can be a function to be called. This function should -return a string to be inserted. For instance, if you want to insert -@code{Mime-Version: 1.0}, you should enter @code{(Mime-Version . "1.0")} -into the list. If you want to insert a funny quote, you could enter -something like @code{(X-Yow . yow)} into the list. The function -@code{yow} will then be called without any arguments. - -If the list contains a cons where the car of the cons is -@code{optional}, the cdr of this cons will only be inserted if it is -non-@code{nil}. - -Other variables for customizing outgoing news articles: - -@table @code - -@item message-syntax-checks -@vindex message-syntax-checks -If non-@code{nil}, Message will attempt to check the legality of the -headers, as well as some other stuff, before posting. You can control -the granularity of the check by adding or removing elements from this -list. Legal elements are: - -@table @code -@item subject-cmsg -Check the subject for commands. -@item sender -@cindex Sender -Insert a new @code{Sender} header if the @code{From} header looks odd. -@item multiple-headers -Check for the existence of multiple equal headers. -@item sendsys -@cindex sendsys -Check for the existence of version and sendsys commands. -@item message-id -Check whether the @code{Message-ID} looks ok. -@item from -Check whether the @code{From} header seems nice. -@item long-lines -@cindex long lines -Check for too long lines. -@item control-chars -Check for illegal characters. -@item size -Check for excessive size. -@item new-text -Check whether there is any new text in the messages. -@item signature -Check the length of the signature. -@item approved -@cindex approved -Check whether the article has an @code{Approved} header, which is -something only moderators should include. -@item empty -Check whether the article is empty. -@item empty-headers -Check whether any of the headers are empty. -@item existing-newsgroups -Check whether the newsgroups mentioned in the @code{Newsgroups} and -@code{Followup-To} headers exist. -@item valid-newsgroups -Check whether the @code{Newsgroups} and @code{Followup-to} headers -are valid syntactically. -@item repeated-newsgroups -Check whether the @code{Newsgroups} and @code{Followup-to} headers -contains repeated group names. -@item shorten-followup-to -Check whether to add a @code{Followup-to} header to shorten the number -of groups to post to. -@end table - -All these conditions are checked by default. - -@item message-ignored-news-headers -@vindex message-ignored-news-headers -Regexp of headers to be removed before posting. The default is@* -@samp{^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:}. - -@item message-default-news-headers -@vindex message-default-news-headers -This string is inserted at the end of the headers in all message -buffers that are initialized as news. - -@end table - - -@node News Variables -@section News Variables - -@table @code -@item message-send-news-function -@vindex message-send-news-function -Function used to send the current buffer as news. The default is -@code{message-send-news}. - -@item message-post-method -@vindex message-post-method -Method used for posting a prepared news message. - -@end table - - -@node Various Message Variables -@section Various Message Variables - -@table @code -@item message-signature-separator -@vindex message-signature-separator -Regexp matching the signature separator. It is @samp{^-- *$} by -default. - -@item mail-header-separator -@vindex mail-header-separator -String used to separate the headers from the body. It is @samp{--text -follows this line--} by default. - -@item message-directory -@vindex message-directory -Directory used by many mailey things. The default is @file{~/Mail/}. - -@item message-autosave-directory -@vindex message-autosave-directory -Directory where message buffers will be autosaved to. - -@item message-signature-setup-hook -@vindex message-signature-setup-hook -Hook run when initializing the message buffer. It is run after the -headers have been inserted but before the signature has been inserted. - -@item message-setup-hook -@vindex message-setup-hook -Hook run as the last thing when the message buffer has been initialized. - -@item message-header-setup-hook -@vindex message-header-setup-hook -Hook called narrowed to the headers after initializing the headers. - -For instance, if you're running Gnus and wish to insert a -@samp{Mail-Copies-To} header in all your news articles and all messages -you send to mailing lists, you could do something like the following: - -@lisp -(defun my-message-header-setup-hook () - (let ((group (or gnus-newsgroup-name ""))) - (when (or (message-fetch-field "newsgroups") - (gnus-group-find-parameter group 'to-address) - (gnus-group-find-parameter group 'to-list)) - (insert "Mail-Copies-To: never\n")))) - -(add-hook 'message-header-setup-hook 'my-message-header-setup-hook) -@end lisp - -@item message-send-hook -@vindex message-send-hook -Hook run before sending messages. - -If you want to add certain headers before sending, you can use the -@code{message-add-header} function in this hook. For instance: -@findex message-add-header - -@lisp -(add-hook 'message-send-hook 'my-message-add-content) -(defun my-message-add-content () - (message-add-header - "Mime-Version: 1.0" - "Content-Type: text/plain" - "Content-Transfer-Encoding: 7bit")) -@end lisp - -This function won't add the header if the header is already present. - -@item message-send-mail-hook -@vindex message-send-mail-hook -Hook run before sending mail messages. - -@item message-send-news-hook -@vindex message-send-news-hook -Hook run before sending news messages. - -@item message-sent-hook -@vindex message-sent-hook -Hook run after sending messages. - -@item message-mode-syntax-table -@vindex message-mode-syntax-table -Syntax table used in message mode buffers. - -@item message-send-method-alist -@vindex message-send-method-alist - -Alist of ways to send outgoing messages. Each element has the form - -@lisp -(TYPE PREDICATE FUNCTION) -@end lisp - -@table @var -@item type -A symbol that names the method. - -@item predicate -A function called without any parameters to determine whether the -message is a message of type @var{type}. - -@item function -A function to be called if @var{predicate} returns non-@code{nil}. -@var{function} is called with one parameter -- the prefix. -@end table - -@lisp -((news message-news-p message-send-via-news) - (mail message-mail-p message-send-via-mail)) -@end lisp - - - -@end table - - - -@node Sending Variables -@section Sending Variables - -@table @code - -@item message-fcc-handler-function -@vindex message-fcc-handler-function -A function called to save outgoing articles. This function will be -called with the name of the file to store the article in. The default -function is @code{rmail-output} which saves in Unix mailbox format. - -@item message-courtesy-message -@vindex message-courtesy-message -When sending combined messages, this string is inserted at the start of -the mailed copy. If the string contains the format spec @samp{%s}, the -newsgroups the article has been posted to will be inserted there. If -this variable is @code{nil}, no such courtesy message will be added. -The default value is @samp{"The following message is a courtesy copy of -an article\nthat has been posted to %s as well.\n\n"}. - -@end table - - -@node Message Buffers -@section Message Buffers - -Message will generate new buffers with unique buffer names when you -request a message buffer. When you send the message, the buffer isn't -normally killed off. Its name is changed and a certain number of old -message buffers are kept alive. - -@table @code -@item message-generate-new-buffers -@vindex message-generate-new-buffers -If non-@code{nil}, generate new buffers. The default is @code{t}. If -this is a function, call that function with three parameters: The type, -the to address and the group name. (Any of these may be @code{nil}.) -The function should return the new buffer name. - -@item message-max-buffers -@vindex message-max-buffers -This variable says how many old message buffers to keep. If there are -more message buffers than this, the oldest buffer will be killed. The -default is 10. If this variable is @code{nil}, no old message buffers -will ever be killed. - -@item message-send-rename-function -@vindex message-send-rename-function -After sending a message, the buffer is renamed from, for instance, -@samp{*reply to Lars*} to @samp{*sent reply to Lars*}. If you don't -like this, set this variable to a function that renames the buffer in a -manner you like. If you don't want to rename the buffer at all, you can -say: - -@lisp -(setq message-send-rename-function 'ignore) -@end lisp - -@item message-kill-buffer-on-exit -@findex message-kill-buffer-on-exit -If non-@code{nil}, kill the buffer immediately on exit. - -@end table - - -@node Message Actions -@section Message Actions - -When Message is being used from a news/mail reader, the reader is likely -to want to perform some task after the message has been sent. Perhaps -return to the previous window configuration or mark an article as -replied. - -@vindex message-kill-actions -@vindex message-postpone-actions -@vindex message-exit-actions -@vindex message-send-actions -The user may exit from the message buffer in various ways. The most -common is @kbd{C-c C-c}, which sends the message and exits. Other -possibilities are @kbd{C-c C-s} which just sends the message, @kbd{C-c -C-d} which postpones the message editing and buries the message buffer, -and @kbd{C-c C-k} which kills the message buffer. Each of these actions -have lists associated with them that contains actions to be executed: -@code{message-send-actions}, @code{message-exit-actions}, -@code{message-postpone-actions}, and @code{message-kill-actions}. - -Message provides a function to interface with these lists: -@code{message-add-action}. The first parameter is the action to be -added, and the rest of the arguments are which lists to add this action -to. Here's an example from Gnus: - -@lisp - (message-add-action - `(set-window-configuration ,(current-window-configuration)) - 'exit 'postpone 'kill) -@end lisp - -This restores the Gnus window configuration when the message buffer is -killed, postponed or exited. - -An @dfn{action} can be either: a normal function, or a list where the -@code{car} is a function and the @code{cdr} is the list of arguments, or -a form to be @code{eval}ed. - - -@node Compatibility -@chapter Compatibility -@cindex compatibility - -Message uses virtually only its own variables---older @code{mail-} -variables aren't consulted. To force Message to take those variables -into account, you can put the following in your @code{.emacs} file: - -@lisp -(require 'messcompat) -@end lisp - -This will initialize many Message variables from the values in the -corresponding mail variables. - - - -@node Index -@chapter Index -@printindex cp - -@node Key Index -@chapter Key Index -@printindex ky - -@summarycontents -@contents -@bye - -@c End: diff -r 6866abce6aaf -r 6075d714658b src/ChangeLog --- a/src/ChangeLog Mon Aug 13 09:50:16 2007 +0200 +++ b/src/ChangeLog Mon Aug 13 09:51:16 2007 +0200 @@ -1,3 +1,48 @@ +1997-07-25 David Moore + + * alloc.c (Fmake_byte_code): GC protect newly allocated function + when looking up filename. + +1997-07-25 SL Baur + + * Makefile.in.in: Added support for linking with dmalloc. + +1997-07-25 P E Jareth Hein + + * xselect.c (x_atom_to_symbol): Fixed a memory corruption bug + where a possibly MULEified string was getting freed before use. + +1997-07-21 SL Baur + + * callproc.c: New variable Vdata_directory_list. + * emacsfns.h: Declare it. + + * fns.c (Frequire): Undo previous change. + + * print.c (print_internal): Handle circular objects like Emacs + handles them (and as documented in the Lispref). + + * database.c (Fputdatabase): Complain when `val' is not a string. + + * event-stream.c (command_builder_find_leaf): Guard menubar + accelerator stuffs with HAVE_MENUBAR. + * gui-x.c (popup_selection_callback): Ditto. + +1997-07-20 SL Baur + + * event-stream.c (menu_move_up): Guard menubar accelerator code + with HAVE_MENUBARS. + + * emacs.c (decode_path): New function, derived from latter portion + of decode_env_path. + (decode_env_path): Break out the naughty bits -- shouldn't do + getenv and separator parsing in one function. + New variable Vpackage_path. + (vars_of_emacs): Use it. + + * editfns.c (Fstring_to_char): Return nil instead of `0' for empty + string. + 1997-07-10 Hrvoje Niksic * fileio.c (Finsert_file_contents_internal): Handle non-regular diff -r 6866abce6aaf -r 6075d714658b src/Makefile.in.in --- a/src/Makefile.in.in Mon Aug 13 09:50:16 2007 +0200 +++ b/src/Makefile.in.in Mon Aug 13 09:51:16 2007 +0200 @@ -184,6 +184,7 @@ rallocobjs = ralloc.o #endif +malloclib = #ifndef SYSTEM_MALLOC # ifdef GNU_MALLOC /* New GNU malloc */ # ifdef ERROR_CHECK_MALLOC @@ -200,6 +201,9 @@ #else /* SYSTEM_MALLOC */ mallocobjs = mallocdocsrc = +#ifdef USE_DEBUG_MALLOC +malloclib = -ldmalloc +#endif /* USE_DEBUG_MALLOC */ #endif /* SYSTEM_MALLOC */ #ifdef HAVE_X_WINDOWS @@ -258,7 +262,7 @@ ## should not be told about. otherobjs = $(BTL_objs) lastfile.o $(mallocobjs) $(rallocobjs) $(X11_objs) -LIBES = $(lwlib_libs) $(quantify_libs) $(ld_libs_all) $(lib_gcc) +LIBES = $(lwlib_libs) $(quantify_libs) $(malloclib) $(ld_libs_all) $(lib_gcc) #ifdef I18N3 mo_dir = ${etcdir} diff -r 6866abce6aaf -r 6075d714658b src/alloc.c --- a/src/alloc.c Mon Aug 13 09:50:16 2007 +0200 +++ b/src/alloc.c Mon Aug 13 09:51:16 2007 +0200 @@ -67,7 +67,10 @@ /* Define this to use malloc/free with no freelist for all datatypes, the hope being that some debugging tools may help detect freed memory references */ -/* #define ALLOC_NO_POOLS */ +#ifdef USE_DEBUG_MALLOC /* Taking the above comment at face value -slb */ +#include +#define ALLOC_NO_POOLS +#endif #include "puresize.h" @@ -364,6 +367,10 @@ /* like malloc and realloc but check for no memory left, and block input. */ +#ifdef xmalloc +#undef xmalloc +#endif + void * xmalloc (int size) { @@ -383,6 +390,10 @@ return val; } +#ifdef xrealloc +#undef xrealloc +#endif + void * xrealloc (void *block, int size) { @@ -453,6 +464,10 @@ #endif +#ifdef xstrdup +#undef xstrdup +#endif + char * xstrdup (CONST char *str) { @@ -1599,9 +1614,12 @@ b->annotated = Vload_file_name_internal_the_purecopy; else if (!NILP (Vload_file_name_internal)) { + struct gcpro gcpro1; + GCPRO1(val); /* don't let val or b get reaped */ Vload_file_name_internal_the_purecopy = Fpurecopy (Ffile_name_nondirectory (Vload_file_name_internal)); b->annotated = Vload_file_name_internal_the_purecopy; + UNGCPRO; } #endif diff -r 6866abce6aaf -r 6075d714658b src/callproc.c --- a/src/callproc.c Mon Aug 13 09:50:16 2007 +0200 +++ b/src/callproc.c Mon Aug 13 09:51:16 2007 +0200 @@ -55,6 +55,7 @@ #endif /* DOS_NT */ Lisp_Object Vexec_path, Vexec_directory, Vdata_directory, Vdoc_directory; +Lisp_Object Vdata_directory_list; Lisp_Object Vconfigure_info_directory, Vsite_directory; /* The default base directory XEmacs is installed under. */ @@ -1157,17 +1158,23 @@ DEFVAR_LISP ("exec-directory", &Vexec_directory /* Directory of architecture-dependent files that come with XEmacs, -especially executable programs intended for Emacs to invoke. +especially executable programs intended for XEmacs to invoke. */ ); DEFVAR_LISP ("data-directory", &Vdata_directory /* Directory of architecture-independent files that come with XEmacs, -intended for Emacs to use. +intended for XEmacs to use. */ ); + DEFVAR_LISP ("data-directory-list", &Vdata_directory_list /* +List of directories of architecture-independent files that come with XEmacs +or were installed as packages, and are intended for XEmacs to use. +*/ ); + Vdata_directory_list = Qnil; + DEFVAR_LISP ("site-directory", &Vsite_directory /* Directory of architecture-independent files that do not come with XEmacs, -intended for Emacs to use. +intended for XEmacs to use. */ ); /* FSF puts the DOC file into data-directory. They do a bunch of diff -r 6866abce6aaf -r 6075d714658b src/config.h.in --- a/src/config.h.in Mon Aug 13 09:50:16 2007 +0200 +++ b/src/config.h.in Mon Aug 13 09:51:16 2007 +0200 @@ -66,7 +66,7 @@ /* Used to identify the XEmacs version in stack traces. */ -#undef CANONICAL_VERSION +#undef STACK_TRACE_EYE_CATCHER /* Allow the configurer to specify (additional) package directories. */ #undef PACKAGE_PATH @@ -86,6 +86,9 @@ /* Use the system malloc? */ #undef USE_SYSTEM_MALLOC +/* Use a debugging malloc? */ +#undef USE_DEBUG_MALLOC + /* Compile in TTY support? */ #undef HAVE_TTY @@ -406,6 +409,9 @@ /* Compile in support for OffiX Drag and Drop? Requires libdnd. */ #undef HAVE_OFFIX_DND +/* Compile in support for WindowMaker Application Icons. */ +#undef HAVE_WINDOWMAKER + /* Define this if you want Mule support (multi-byte character support). There may be some performance penalty, although it should be small if you're working with ASCII files. */ @@ -416,6 +422,7 @@ #undef HAVE_XIM #undef XIM_XLIB #undef XIM_MOTIF +#undef USE_XFONTSET /* Non-XIM input methods for use with Mule. */ #undef HAVE_CANNA diff -r 6866abce6aaf -r 6075d714658b src/database.c --- a/src/database.c Mon Aug 13 09:50:16 2007 +0200 +++ b/src/database.c Mon Aug 13 09:51:16 2007 +0200 @@ -652,9 +652,10 @@ struct database_struct *db; int status; struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - + CHECK_DATABASE (dbase); CHECK_STRING (key); + CHECK_STRING (val); db = XDATABASE (dbase); if (!DATABASE_LIVE_P (db)) signal_simple_error ("Attempting to access closed database", dbase); diff -r 6866abce6aaf -r 6075d714658b src/device-x.c --- a/src/device-x.c Mon Aug 13 09:50:16 2007 +0200 +++ b/src/device-x.c Mon Aug 13 09:51:16 2007 +0200 @@ -303,6 +303,25 @@ XIM_init_device(d); #endif /* HAVE_XIM */ +#ifdef HAVE_WINDOWMAKER + XtVaSetValues(DEVICE_XT_APP_SHELL (d), + XtNmappedWhenManaged, False, + XtNwidth, 1, + XtNheight, 1, + NULL); + XtRealizeWidget(DEVICE_XT_APP_SHELL (d)); + { + int argc; + char **argv; + + make_argc_argv (Vcommand_line_args, &argc, &argv); + XSetCommand (XtDisplay (DEVICE_XT_APP_SHELL (d)), + XtWindow (DEVICE_XT_APP_SHELL (d)), argv, argc); + free_argc_argv (argv); + + } +#endif /* HAVE_WINDOWMAKER */ + Vx_initial_argv_list = make_arg_list (argc, argv); free_argc_argv (argv); diff -r 6866abce6aaf -r 6075d714658b src/editfns.c --- a/src/editfns.c Mon Aug 13 09:50:16 2007 +0200 +++ b/src/editfns.c Mon Aug 13 09:51:16 2007 +0200 @@ -194,6 +194,7 @@ DEFUN ("string-to-char", Fstring_to_char, 1, 1, 0, /* Convert arg STRING to a character, the first character of that string. +An empty string will return the constant `nil'. */ (str)) { @@ -203,8 +204,10 @@ p = XSTRING (str); if (string_length (p) != 0) return make_char (string_char (p, 0)); - else /* #### Gag me! */ - return Qzero; + else + /* This used to return Qzero. That is broken, broken, broken. */ + /* It might be kinder to signal an error directly. -slb */ + return Qnil; } diff -r 6866abce6aaf -r 6075d714658b src/emacs.c --- a/src/emacs.c Mon Aug 13 09:50:16 2007 +0200 +++ b/src/emacs.c Mon Aug 13 09:51:16 2007 +0200 @@ -94,6 +94,9 @@ Lisp_Object Vemacs_beta_version; Lisp_Object Vxemacs_codename; +/* Package directories built in at configure time */ +Lisp_Object Vpackage_path; + /* The name under which XEmacs was invoked, with any leading directory names discarded. */ Lisp_Object Vinvocation_name; @@ -451,10 +454,7 @@ } /* Make stack traces always identify version + configuration */ -/* C makes this bizarre circumlocution necessary. */ -#define PASTE_1(x,y) PASTE_2(x,y) -#define PASTE_2(x,y) x##y -#define main_1 PASTE_1(main_, CANONICAL_VERSION) +#define main_1 STACK_TRACE_EYE_CATCHER static DOESNT_RETURN main_1 (int argc, char **argv, char **envp) @@ -2139,18 +2139,12 @@ #endif Lisp_Object -decode_env_path (CONST char *evarname, CONST char *default_) +decode_path (CONST char *path) { - REGISTER CONST char *path = 0; REGISTER CONST char *p; Lisp_Object lpath = Qnil; - if (evarname) - path = (char *) egetenv (evarname); - if (!path) - path = default_; - if (!path) - return Qnil; + if (!path || !strlen(path)) return Qnil; #if defined (MSDOS) || defined (WIN32) dostounix_filename (path); @@ -2172,6 +2166,20 @@ return Fnreverse (lpath); } +Lisp_Object +decode_env_path (CONST char *evarname, CONST char *default_) +{ + REGISTER CONST char *path = 0; + if (evarname) + path = (char *) egetenv (evarname); + if (!path) + path = default_; + if (!path) + return Qnil; + else + return decode_path(path); +} + DEFUN ("noninteractive", Fnoninteractive, 0, 0, 0, /* Non-nil return value means XEmacs is running without interactive terminal. */ @@ -2348,6 +2356,14 @@ #endif Vxemacs_codename = Fpurecopy (build_string (XEMACS_CODENAME)); + DEFVAR_LISP ("package-path", &Vpackage_path /* +List of directories configured for package searching. +*/ ); +#ifndef PACKAGE_PATH +#define PACKAGE_PATH "/etc/xemacs:~/.xemacs" +#endif + Vpackage_path = decode_path(PACKAGE_PATH); + DEFVAR_BOOL ("noninteractive", &noninteractive1 /* Non-nil means XEmacs is running without interactive terminal. */ ); diff -r 6866abce6aaf -r 6075d714658b src/emacsfns.h --- a/src/emacsfns.h Mon Aug 13 09:50:16 2007 +0200 +++ b/src/emacsfns.h Mon Aug 13 09:51:16 2007 +0200 @@ -217,7 +217,7 @@ /* Defined in callproc.c */ extern Lisp_Object Vexec_path, Vexec_directory, Vdata_directory, - Vdoc_directory, Vsite_directory; + Vdata_directory_list, Vdoc_directory, Vsite_directory; /* Defined in casefiddle.c */ @@ -534,7 +534,8 @@ Lisp_Object make_arg_list (int argc, char **argv); void make_argc_argv (Lisp_Object argv_list, int *argc, char ***argv); void free_argc_argv (char **argv); -Lisp_Object decode_env_path (CONST char *evarname, CONST char *def); +Lisp_Object decode_env_path (CONST char *evarname, CONST char *default_); +Lisp_Object decode_path (CONST char *path); /* Nonzero means don't do interactive redisplay and don't change tty modes */ extern int noninteractive; Lisp_Object Fkill_emacs (Lisp_Object arg); diff -r 6866abce6aaf -r 6075d714658b src/event-stream.c --- a/src/event-stream.c Mon Aug 13 09:50:16 2007 +0200 +++ b/src/event-stream.c Mon Aug 13 09:51:16 2007 +0200 @@ -3021,7 +3021,7 @@ return event_binding (event0, 1); } -#ifdef HAVE_X_WINDOWS +#if defined(HAVE_X_WINDOWS) && defined(HAVE_MENUBARS) static void menu_move_up (void) { @@ -3498,8 +3498,12 @@ return Qnil; } -void -event_menu_accelerate () + +DEFUN ("accelerate-menu", Faccelerate_menu, 0, 0, "_", /* +Make the menubar active. Menu items can be selected using menu accelerators +or by actions defined in menu-accelerator-map. +*/ + ()) { struct console *con = XCONSOLE (Vselected_console); struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con)); @@ -3515,8 +3519,10 @@ /* menu accelerator keys don't go into keyboard macros */ if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro)) con->kbd_macro_ptr = con->kbd_macro_end; + + return Qnil; } -#endif /* HAVE_X_WINDOWS */ +#endif /* HAVE_X_WINDOWS && HAVE_MENUBARS */ /* See if we can do function-key-map or key-translation-map translation on the current events in the command builder. If so, do this, and @@ -3646,7 +3652,7 @@ return Qnil; /* if we're currently in a menu accelerator, check there for further events */ -#ifdef HAVE_X_WINDOWS +#if defined(HAVE_X_WINDOWS) && defined(HAVE_MENUBAR) if (lw_menu_active) { result = command_builder_operate_menu_accelerator (builder); @@ -3660,7 +3666,7 @@ if (NILP (result)) #endif result = command_builder_find_leaf_1 (builder); -#ifdef HAVE_X_WINDOWS +#if defined(HAVE_X_WINDOWS) && defined(HAVE_MENUBAR) if (NILP (result) && EQ (Vmenu_accelerator_enabled, Qmenu_fallback)) result = command_builder_find_menu_accelerator (builder); @@ -4858,6 +4864,7 @@ DEFSUBR (Fthis_command_keys); DEFSUBR (Freset_this_command_lengths); DEFSUBR (Fopen_dribble_file); + DEFSUBR (Faccelerate_menu); defsymbol (&Qpre_command_hook, "pre-command-hook"); defsymbol (&Qpost_command_hook, "post-command-hook"); diff -r 6866abce6aaf -r 6075d714658b src/events.h --- a/src/events.h Mon Aug 13 09:50:16 2007 +0200 +++ b/src/events.h Mon Aug 13 09:51:16 2007 +0200 @@ -515,8 +515,6 @@ struct console *c, int fd); #endif /* HAVE_UNIXOID_EVENT_LOOP */ -void event_menu_accelerate (void); - extern int emacs_is_blocking; extern Lisp_Object Vcontrolling_terminal; diff -r 6866abce6aaf -r 6075d714658b src/extents.c --- a/src/extents.c Mon Aug 13 09:50:16 2007 +0200 +++ b/src/extents.c Mon Aug 13 09:51:16 2007 +0200 @@ -1282,7 +1282,7 @@ #ifdef SOE_DEBUG -static char *print_extent_1 (char *buf, Lisp_Object extent); +static void print_extent_1 (char *buf, Lisp_Object extent); static void print_extent_2 (EXTENT e) @@ -2939,7 +2939,7 @@ return extent->plist; } -static char * +static void print_extent_1 (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { EXTENT ext = XEXTENT (obj); diff -r 6866abce6aaf -r 6075d714658b src/fns.c --- a/src/fns.c Mon Aug 13 09:50:16 2007 +0200 +++ b/src/fns.c Mon Aug 13 09:51:16 2007 +0200 @@ -3452,7 +3452,7 @@ Vautoload_queue = Qt; call4 (Qload, NILP (file_name) ? Fsymbol_name (feature) : file_name, - Qt, Qt, Qnil); + Qnil, Qt, Qnil); tem = Fmemq (feature, Vfeatures); if (NILP (tem)) diff -r 6866abce6aaf -r 6075d714658b src/frame-x.c --- a/src/frame-x.c Mon Aug 13 09:50:16 2007 +0200 +++ b/src/frame-x.c Mon Aug 13 09:51:16 2007 +0200 @@ -365,7 +365,11 @@ if (NILP (rest)) return; f = XFRAME (XCAR (rest)); + +#ifndef HAVE_WINDOWMAKER x_wm_maybe_store_wm_command (f); +#endif /* HAVE_WINDOWMAKER */ + } } @@ -1865,7 +1869,11 @@ { /* tell the window manager about us. */ x_wm_store_class_hints (shell_widget, XtName (frame_widget)); + +#ifndef HAVE_WINDOWMAKER x_wm_maybe_store_wm_command (f); +#endif /* HAVE_WINDOWMAKER */ + x_wm_hack_wm_protocols (shell_widget); } @@ -2439,8 +2447,10 @@ Widget w = FRAME_X_SHELL_WIDGET (f); Lisp_Object popup, frame; +#ifndef HAVE_WINDOWMAKER if (FRAME_X_TOP_LEVEL_FRAME_P (f)) x_wm_maybe_move_wm_command (f); +#endif /* HAVE_WINDOWMAKER */ /* Frames with the popup property are using other frames as their widget parent. Deleting them are their parent has already been diff -r 6866abce6aaf -r 6075d714658b src/gui-x.c --- a/src/gui-x.c Mon Aug 13 09:50:16 2007 +0200 +++ b/src/gui-x.c Mon Aug 13 09:51:16 2007 +0200 @@ -293,7 +293,11 @@ /* This is the timestamp used for asserting focus so we need to get an up-to-date value event if no events has been dispatched to emacs */ +#if defined(HAVE_MENUBAR) DEVICE_X_MOUSE_TIMESTAMP (d) = x_focus_timestamp_really_sucks_fix_me_better; +#else + DEVICE_X_MOUSE_TIMESTAMP (d) = DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d); +#endif signal_special_Xt_user_event (frame, fn, arg); } diff -r 6866abce6aaf -r 6075d714658b src/menubar.c --- a/src/menubar.c Mon Aug 13 09:50:16 2007 +0200 +++ b/src/menubar.c Mon Aug 13 09:51:16 2007 +0200 @@ -178,22 +178,11 @@ return Qnil; } -DEFUN ("accelerate-menu", Faccelerate_menu, 0, 0, "_", /* -Make the menubar active. Menu items can be selected using menu accelerators -or by actions defined in menu-accelerator-map. -*/ - ()) -{ - event_menu_accelerate (); - return Qnil; -} - void syms_of_menubar (void) { defsymbol (&Qcurrent_menubar, "current-menubar"); DEFSUBR (Fpopup_menu); - DEFSUBR (Faccelerate_menu); } void diff -r 6866abce6aaf -r 6075d714658b src/print.c --- a/src/print.c Mon Aug 13 09:50:16 2007 +0200 +++ b/src/print.c Mon Aug 13 09:51:16 2007 +0200 @@ -54,6 +54,10 @@ /* Avoid actual stack overflow in print. */ static int print_depth; +/* Detect most circularities to print finite output. */ +#define PRINT_CIRCLE 200 +Lisp_Object being_printed[PRINT_CIRCLE]; + /* Maximum length of list or vector to print in full; noninteger means effectively infinity */ @@ -901,9 +905,25 @@ output. */ #endif + /* Detect circularities and truncate them. + No need to offer any alternative--this is better than an error. */ + if (CONSP (obj) || VECTORP (obj) || COMPILED_FUNCTIONP (obj)) + { + int i; + for (i = 0; i < print_depth; i++) + if (EQ (obj, being_printed[i])) + { + sprintf (buf, "#%d", i); + write_c_string (buf, printcharfun); + return; + } + } + + + being_printed[print_depth] = obj; print_depth++; - if (print_depth > 200) + if (print_depth > PRINT_CIRCLE) error ("Apparently circular structure being printed"); switch (XTYPE (obj)) diff -r 6866abce6aaf -r 6075d714658b src/s/freebsd.h --- a/src/s/freebsd.h Mon Aug 13 09:50:16 2007 +0200 +++ b/src/s/freebsd.h Mon Aug 13 09:51:16 2007 +0200 @@ -33,8 +33,8 @@ #define LIBS_SYSTEM "-lutil" #endif -/* Kludge to work around setlocale(LC_ALL,...) not working before 01/1997 */ -#if __FreeBSD_version < 199701 +/* Kludge to work around setlocale(LC_ALL,...) not working after 01/1997 */ +#if __FreeBSD_version >= 199701 #include #define setlocale(locale_category, locale_spec) setlocale(LC_CTYPE, locale_spec) #endif @@ -72,7 +72,7 @@ #endif /* NO_SHARED_LIBS */ #define HAVE_GETLOADAVG -/* #define NO_TERMIO */ /* mrb */ +/* #define NO_TERMIO */ /* detected in configure */ #define DECLARE_GETPWUID_WITH_UID_T /* freebsd uses OXTABS instead of the expected TAB3. */ diff -r 6866abce6aaf -r 6075d714658b src/xselect.c --- a/src/xselect.c Mon Aug 13 09:50:16 2007 +0200 +++ b/src/xselect.c Mon Aug 13 09:51:16 2007 +0200 @@ -247,14 +247,16 @@ #endif { + Lisp_Object newsym; CONST char *intstr; char *str = XGetAtomName (display, atom); if (! str) return Qnil; GET_C_CHARPTR_INT_CTEXT_DATA_ALLOCA (str, intstr); + newsym = intern (intstr); XFree (str); - return intern (intstr); + return newsym; } } diff -r 6866abce6aaf -r 6075d714658b version.sh --- a/version.sh Mon Aug 13 09:50:16 2007 +0200 +++ b/version.sh Mon Aug 13 09:51:16 2007 +0200 @@ -1,5 +1,5 @@ #!/bin/sh emacs_major_version=20 emacs_minor_version=3 -emacs_beta_version=14 -xemacs_codename="Vienna" +emacs_beta_version=15 +xemacs_codename="Berlin"