diff options
| author | Stefan Monnier <monnier@iro.umontreal.ca> | 2010-09-13 16:40:48 +0200 |
|---|---|---|
| committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2010-09-13 16:40:48 +0200 |
| commit | cc390e46c7ba95b76ea133d98fd386214cd01709 (patch) | |
| tree | ead4400d22bd07214b782ff7e46e79d473fac419 | |
| parent | c566235d981eba73c88bbff00b6a1d88360b6e9f (diff) | |
| parent | c5fe4acb5fb456d6e8e147d8bc7981ce56c5c03d (diff) | |
| download | emacs-cc390e46c7ba95b76ea133d98fd386214cd01709.tar.gz | |
Merge from trunk
734 files changed, 18806 insertions, 15630 deletions
diff --git a/ChangeLog b/ChangeLog index 71b597d889b..66fa0f859aa 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,25 @@ +2010-09-10 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * configure.in: Check for libxml2. + +2010-09-09 Glenn Morris <rgm@gnu.org> + + * make-dist: No more TODO files under lisp/. + +2010-09-04 Eli Zaretskii <eliz@gnu.org> + + * config.bat: Produce lisp/gnus/_dir-locals.el from + lisp/gnus/.dir-locals.el. + +2010-08-23 Andreas Schwab <schwab@linux-m68k.org> + + * configure.in: Fix check for librsvg, imagemagick and + MagickExportImagePixels. + +2010-08-18 Joakim Verona <joakim@verona.se> + + * Makefile.in, configure.in: Checks for ImageMagick. + 2010-08-10 Dan Nicolaescu <dann@ics.uci.edu> * configure.in (AC_PREREQ): Require autoconf 2.65. diff --git a/admin/ChangeLog b/admin/ChangeLog index 22777674373..d3bc51bd9f6 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,11 @@ +2010-09-05 Juanma Barranquero <lekktu@gmail.com> + + * unidata/BidiMirroring.txt: Update from + http://www.unicode.org/Public/6.0.0/ucd/BidiMirroring-6.0.0d2.txt + + * unidata/UnicodeData.txt: Update from + http://www.unicode.org/Public/6.0.0/ucd/UnicodeData-6.0.0d7.txt + 2010-08-09 Andreas Schwab <schwab@linux-m68k.org> * CPP-DEFINES (WORDS_BIG_ENDIAN): Remove. diff --git a/admin/unidata/BidiMirroring.txt b/admin/unidata/BidiMirroring.txt index 761ddf0d486..902f9a6b886 100644 --- a/admin/unidata/BidiMirroring.txt +++ b/admin/unidata/BidiMirroring.txt @@ -1,12 +1,12 @@ # BidiMirroring-6.0.0.txt -# Date: 2009-11-10, 17:09:00 PST [KW] +# Date: 2010-06-21, 12:09:00 PDT [KW] # # Bidi_Mirroring_Glyph Property # # This file is an informative contributory data file in the # Unicode Character Database. # -# Copyright (c) 1991-2009 Unicode, Inc. +# Copyright (c) 1991-2010 Unicode, Inc. # For terms of use, see http://www.unicode.org/terms_of_use.html # # This data file lists characters that have the Bidi_Mirrored=True property @@ -473,8 +473,8 @@ FF63; FF62 # [BEST FIT] HALFWIDTH RIGHT CORNER BRACKET # 22FF; Z NOTATION BAG MEMBERSHIP # 2320; TOP HALF INTEGRAL # 2321; BOTTOM HALF INTEGRAL -# 27CC; LONG DIVISION # 27C0; THREE DIMENSIONAL ANGLE +# 27CC; LONG DIVISION # 27D3; LOWER RIGHT CORNER WITH DOT # 27D4; UPPER LEFT CORNER WITH DOT # 27DC; LEFT MULTIMAP diff --git a/admin/unidata/Makefile.in b/admin/unidata/Makefile.in index 91a3640fff7..e7b0fbe4bf9 100644 --- a/admin/unidata/Makefile.in +++ b/admin/unidata/Makefile.in @@ -21,7 +21,7 @@ EMACS = ../../src/emacs DSTDIR = ../../lisp/international -RUNEMACS = ${EMACS} -Q --multibyte -batch +RUNEMACS = ${EMACS} -Q -batch all: ${DSTDIR}/charprop.el ../../src/biditype.h ../../src/bidimirror.h diff --git a/admin/unidata/UnicodeData.txt b/admin/unidata/UnicodeData.txt index 95cff5311b3..8d7222b1378 100644 --- a/admin/unidata/UnicodeData.txt +++ b/admin/unidata/UnicodeData.txt @@ -1699,7 +1699,7 @@ 06DB;ARABIC SMALL HIGH THREE DOTS;Mn;230;NSM;;;;;N;;;;; 06DC;ARABIC SMALL HIGH SEEN;Mn;230;NSM;;;;;N;;;;; 06DD;ARABIC END OF AYAH;Cf;0;AN;;;;;N;;;;; -06DE;ARABIC START OF RUB EL HIZB;Me;0;NSM;;;;;N;;;;; +06DE;ARABIC START OF RUB EL HIZB;So;0;ON;;;;;N;;;;; 06DF;ARABIC SMALL HIGH ROUNDED ZERO;Mn;230;NSM;;;;;N;;;;; 06E0;ARABIC SMALL HIGH UPRIGHT RECTANGULAR ZERO;Mn;230;NSM;;;;;N;;;;; 06E1;ARABIC SMALL HIGH DOTLESS HEAD OF KHAH;Mn;230;NSM;;;;;N;;;;; @@ -5640,9 +5640,9 @@ 19D7;NEW TAI LUE DIGIT SEVEN;Nd;0;L;;7;7;7;N;;;;; 19D8;NEW TAI LUE DIGIT EIGHT;Nd;0;L;;8;8;8;N;;;;; 19D9;NEW TAI LUE DIGIT NINE;Nd;0;L;;9;9;9;N;;;;; -19DA;NEW TAI LUE THAM DIGIT ONE;Nd;0;L;;1;1;1;N;;;;; -19DE;NEW TAI LUE SIGN LAE;Po;0;ON;;;;;N;;;;; -19DF;NEW TAI LUE SIGN LAEV;Po;0;ON;;;;;N;;;;; +19DA;NEW TAI LUE THAM DIGIT ONE;No;0;L;;;1;1;N;;;;; +19DE;NEW TAI LUE SIGN LAE;So;0;ON;;;;;N;;;;; +19DF;NEW TAI LUE SIGN LAEV;So;0;ON;;;;;N;;;;; 19E0;KHMER SYMBOL PATHAMASAT;So;0;ON;;;;;N;;;;; 19E1;KHMER SYMBOL MUOY KOET;So;0;ON;;;;;N;;;;; 19E2;KHMER SYMBOL PII KOET;So;0;ON;;;;;N;;;;; @@ -7119,6 +7119,7 @@ 20B6;LIVRE TOURNOIS SIGN;Sc;0;ET;;;;;N;;;;; 20B7;SPESMILO SIGN;Sc;0;ET;;;;;N;;;;; 20B8;TENGE SIGN;Sc;0;ET;;;;;N;;;;; +20B9;INDIAN RUPEE SIGN;Sc;0;ET;;;;;N;;;;; 20D0;COMBINING LEFT HARPOON ABOVE;Mn;230;NSM;;;;;N;NON-SPACING LEFT HARPOON ABOVE;;;; 20D1;COMBINING RIGHT HARPOON ABOVE;Mn;230;NSM;;;;;N;NON-SPACING RIGHT HARPOON ABOVE;;;; 20D2;COMBINING LONG VERTICAL LINE OVERLAY;Mn;1;NSM;;;;;N;NON-SPACING LONG VERTICAL BAR OVERLAY;;;; @@ -7176,7 +7177,7 @@ 2115;DOUBLE-STRUCK CAPITAL N;Lu;0;L;<font> 004E;;;;N;DOUBLE-STRUCK N;;;; 2116;NUMERO SIGN;So;0;ON;<compat> 004E 006F;;;;N;NUMERO;;;; 2117;SOUND RECORDING COPYRIGHT;So;0;ON;;;;;N;;;;; -2118;SCRIPT CAPITAL P;So;0;ON;;;;;N;SCRIPT P;;;; +2118;SCRIPT CAPITAL P;Sm;0;ON;;;;;N;SCRIPT P;;;; 2119;DOUBLE-STRUCK CAPITAL P;Lu;0;L;<font> 0050;;;;N;DOUBLE-STRUCK P;;;; 211A;DOUBLE-STRUCK CAPITAL Q;Lu;0;L;<font> 0051;;;;N;DOUBLE-STRUCK Q;;;; 211B;SCRIPT CAPITAL R;Lu;0;L;<font> 0052;;;;N;SCRIPT R;;;; diff --git a/admin/unidata/makefile.w32-in b/admin/unidata/makefile.w32-in index 85dfb135df8..58cea29db8b 100644 --- a/admin/unidata/makefile.w32-in +++ b/admin/unidata/makefile.w32-in @@ -27,7 +27,7 @@ lisp = $(CURDIR)/../../lisp # lisp/subdirs.el is not generated yet when the commands below run. EMACSLOADPATH = $(lisp);$(lisp)/international;$(lisp)/emacs-lisp # Quote EMACS so it could be a file name with embedded whitespace -RUNEMACS = "$(EMACS)" -Q --multibyte -batch +RUNEMACS = "$(EMACS)" -Q -batch all: $(DSTDIR)/charprop.el ../../src/biditype.h ../../src/bidimirror.h diff --git a/config.bat b/config.bat index aac4e108b09..802cacc8897 100644 --- a/config.bat +++ b/config.bat @@ -250,6 +250,7 @@ cd .. rem ----------------------------------------------------------------------
Echo Configuring the lisp directory...
cd lisp
+If Exist gnus\.dir-locals.el update gnus/.dir-locals.el gnus/_dir-locals.el
sed -f ../msdos/sedlisp.inp < Makefile.in > Makefile
cd ..
rem ----------------------------------------------------------------------
diff --git a/configure b/configure index 3eaf150a25e..6afb63b6c96 100755 --- a/configure +++ b/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.66 for emacs 24.0.50. +# Generated by GNU Autoconf 2.67 for emacs 24.0.50. # # # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, @@ -660,6 +660,8 @@ BLESSMAIL_TARGET LIBS_MAIL liblockfile ALLOCA +LIBXML2_LIBS +LIBXML2_CFLAGS LIBXSM LIBGPM LIBGIF @@ -688,6 +690,8 @@ DBUS_CFLAGS GTK_OBJ GTK_LIBS GTK_CFLAGS +IMAGEMAGICK_LIBS +IMAGEMAGICK_CFLAGS RSVG_LIBS RSVG_CFLAGS VMLIMIT_OBJ @@ -805,6 +809,8 @@ with_tiff with_gif with_png with_rsvg +with_xml2 +with_imagemagick with_xft with_libotf with_m17n_flt @@ -904,8 +910,9 @@ do fi case $ac_option in - *=*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; - *) ac_optarg=yes ;; + *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *=) ac_optarg= ;; + *) ac_optarg=yes ;; esac # Accept the important Cygnus configure options, so we can diagnose typos. @@ -1511,6 +1518,8 @@ Optional Packages: --without-gif don't compile with GIF image support --without-png don't compile with PNG image support --without-rsvg don't compile with SVG image support + --without-xml2 don't compile with XML parsing support + --with-imagemagick compile with ImageMagick image support --without-xft don't use XFT for anti aliased fonts --without-libotf don't use libotf for OpenType font support --without-m17n-flt don't use m17n-flt for text shaping @@ -1613,7 +1622,7 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF emacs configure 24.0.50 -generated by GNU Autoconf 2.66 +generated by GNU Autoconf 2.67 Copyright (C) 2010 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation @@ -1731,7 +1740,7 @@ $as_echo "$ac_try_echo"; } >&5 mv -f conftest.er1 conftest.err fi $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 - test $ac_status = 0; } >/dev/null && { + test $ac_status = 0; } > conftest.i && { test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || test ! -s conftest.err }; then : @@ -1794,7 +1803,7 @@ if ac_fn_c_try_cpp "$LINENO"; then : else ac_header_preproc=no fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5 $as_echo "$ac_header_preproc" >&6; } @@ -1973,7 +1982,7 @@ if ac_fn_c_try_cpp "$LINENO"; then : else eval "$3=no" fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext fi eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 @@ -2164,7 +2173,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by emacs $as_me 24.0.50, which was -generated by GNU Autoconf 2.66. Invocation command line was +generated by GNU Autoconf 2.67. Invocation command line was $ $0 $@ @@ -2422,7 +2431,7 @@ $as_echo "$as_me: loading site script $ac_site_file" >&6;} || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "failed to load site script $ac_site_file -See \`config.log' for more details" "$LINENO" 5; } +See \`config.log' for more details" "$LINENO" 5 ; } fi done @@ -2736,6 +2745,22 @@ else fi +# Check whether --with-xml2 was given. +if test "${with_xml2+set}" = set; then : + withval=$with_xml2; +else + with_xml2=yes +fi + + +# Check whether --with-imagemagick was given. +if test "${with_imagemagick+set}" = set; then : + withval=$with_imagemagick; +else + with_imagemagick=no +fi + + # Check whether --with-xft was given. if test "${with_xft+set}" = set; then : @@ -2956,7 +2981,7 @@ do stringfreelist) ac_gc_check_string_free_list=1 ;; xmallocoverrun) ac_xmalloc_overrun=1 ;; conslist) ac_gc_check_cons_list=1 ;; - *) as_fn_error $? "unknown check category $check" "$LINENO" 5 ;; + *) as_fn_error $? "unknown check category $check" "$LINENO" 5 ;; esac done IFS="$ac_save_IFS" @@ -3123,7 +3148,7 @@ fi $as_echo "$ac_cv_build" >&6; } case $ac_cv_build in *-*-*) ;; -*) as_fn_error $? "invalid value of canonical build" "$LINENO" 5;; +*) as_fn_error $? "invalid value of canonical build" "$LINENO" 5 ;; esac build=$ac_cv_build ac_save_IFS=$IFS; IFS='-' @@ -3156,7 +3181,7 @@ fi $as_echo "$ac_cv_host" >&6; } case $ac_cv_host in *-*-*) ;; -*) as_fn_error $? "invalid value of canonical host" "$LINENO" 5;; +*) as_fn_error $? "invalid value of canonical host" "$LINENO" 5 ;; esac host=$ac_cv_host ac_save_IFS=$IFS; IFS='-' @@ -3765,7 +3790,7 @@ fi test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "no acceptable C compiler found in \$PATH -See \`config.log' for more details" "$LINENO" 5; } +See \`config.log' for more details" "$LINENO" 5 ; } # Provide some information about the compiler. $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 @@ -3880,7 +3905,7 @@ sed 's/^/| /' conftest.$ac_ext >&5 { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error 77 "C compiler cannot create executables -See \`config.log' for more details" "$LINENO" 5; } +See \`config.log' for more details" "$LINENO" 5 ; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } @@ -3923,7 +3948,7 @@ else { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of executables: cannot compile and link -See \`config.log' for more details" "$LINENO" 5; } +See \`config.log' for more details" "$LINENO" 5 ; } fi rm -f conftest conftest$ac_cv_exeext { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 @@ -3982,7 +4007,7 @@ $as_echo "$ac_try_echo"; } >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot run C compiled programs. If you meant to cross compile, use \`--host'. -See \`config.log' for more details" "$LINENO" 5; } +See \`config.log' for more details" "$LINENO" 5 ; } fi fi fi @@ -4034,7 +4059,7 @@ sed 's/^/| /' conftest.$ac_ext >&5 { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of object files: cannot compile -See \`config.log' for more details" "$LINENO" 5; } +See \`config.log' for more details" "$LINENO" 5 ; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi @@ -4366,7 +4391,7 @@ else # Broken: fails on valid input. continue fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. @@ -4382,11 +4407,11 @@ else ac_preproc_ok=: break fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.err conftest.$ac_ext +rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok; then : break fi @@ -4425,7 +4450,7 @@ else # Broken: fails on valid input. continue fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. @@ -4441,18 +4466,18 @@ else ac_preproc_ok=: break fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.err conftest.$ac_ext +rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "C preprocessor \"$CPP\" fails sanity check -See \`config.log' for more details" "$LINENO" 5; } +See \`config.log' for more details" "$LINENO" 5 ; } fi ac_ext=c @@ -4955,7 +4980,7 @@ else # Broken: fails on valid input. continue fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. @@ -4971,11 +4996,11 @@ else ac_preproc_ok=: break fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.err conftest.$ac_ext +rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok; then : break fi @@ -5014,7 +5039,7 @@ else # Broken: fails on valid input. continue fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext # OK, works on sane cases. Now check whether nonexistent headers # can be detected and how. @@ -5030,18 +5055,18 @@ else ac_preproc_ok=: break fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext done # Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. -rm -f conftest.err conftest.$ac_ext +rm -f conftest.i conftest.err conftest.$ac_ext if $ac_preproc_ok; then : else { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "C preprocessor \"$CPP\" fails sanity check -See \`config.log' for more details" "$LINENO" 5; } +See \`config.log' for more details" "$LINENO" 5 ; } fi ac_ext=c @@ -7247,7 +7272,7 @@ $as_echo "#define AC_APPLE_UNIVERSAL_BUILD 1" >>confdefs.h ;; #( *) as_fn_error $? "unknown endianness - presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;; + presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;; esac @@ -7399,7 +7424,7 @@ if test "x$with_x" = xno; then have_x=disabled else case $x_includes,$x_libraries in #( - *\'*) as_fn_error $? "cannot use X directory names containing '" "$LINENO" 5;; #( + *\'*) as_fn_error $? "cannot use X directory names containing '" "$LINENO" 5 ;; #( *,NONE | NONE,*) if test "${ac_cv_have_x+set}" = set; then : $as_echo_n "(cached) " >&6 else @@ -7503,7 +7528,7 @@ else fi done fi -rm -f conftest.err conftest.$ac_ext +rm -f conftest.err conftest.i conftest.$ac_ext fi # $ac_x_includes = no if test "$ac_x_libraries" = no; then @@ -8592,7 +8617,7 @@ $as_echo "no" >&6; } fi if test $succeeded = yes; then - : + HAVE_RSVG=yes else : fi @@ -8600,8 +8625,7 @@ $as_echo "no" >&6; } - if test ".${RSVG_CFLAGS}" != "."; then - HAVE_RSVG=yes + if test $HAVE_RSVG = yes; then $as_echo "#define HAVE_RSVG 1" >>confdefs.h @@ -8611,6 +8635,126 @@ $as_echo "#define HAVE_RSVG 1" >>confdefs.h fi fi +HAVE_IMAGEMAGICK=no +if test "${with_imagemagick}" != "no"; then + IMAGEMAGICK_MODULE="Wand" + + succeeded=no + + # Extract the first word of "pkg-config", so it can be a program name with args. +set dummy pkg-config; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + case $PKG_CONFIG in + [\\/]* | ?:[\\/]*) + ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no" + ;; +esac +fi +PKG_CONFIG=$ac_cv_path_PKG_CONFIG +if test -n "$PKG_CONFIG"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 +$as_echo "$PKG_CONFIG" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + + if test "$PKG_CONFIG" = "no" ; then + : + else + PKG_CONFIG_MIN_VERSION=0.9.0 + if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $IMAGEMAGICK_MODULE" >&5 +$as_echo_n "checking for $IMAGEMAGICK_MODULE... " >&6; } + + if $PKG_CONFIG --exists "$IMAGEMAGICK_MODULE" 2>&5; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + succeeded=yes + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking IMAGEMAGICK_CFLAGS" >&5 +$as_echo_n "checking IMAGEMAGICK_CFLAGS... " >&6; } + IMAGEMAGICK_CFLAGS=`$PKG_CONFIG --cflags "$IMAGEMAGICK_MODULE"|sed -e 's,///*,/,g'` + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $IMAGEMAGICK_CFLAGS" >&5 +$as_echo "$IMAGEMAGICK_CFLAGS" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking IMAGEMAGICK_LIBS" >&5 +$as_echo_n "checking IMAGEMAGICK_LIBS... " >&6; } + IMAGEMAGICK_LIBS=`$PKG_CONFIG --libs "$IMAGEMAGICK_MODULE"|sed -e 's,///*,/,g'` + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $IMAGEMAGICK_LIBS" >&5 +$as_echo "$IMAGEMAGICK_LIBS" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + IMAGEMAGICK_CFLAGS="" + IMAGEMAGICK_LIBS="" + ## If we have a custom action on failure, don't print errors, but + ## do set a variable so people can do so. + IMAGEMAGICK_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "$IMAGEMAGICK_MODULE"` + + fi + + + + else + echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer." + echo "*** See http://www.freedesktop.org/software/pkgconfig" + fi + fi + + if test $succeeded = yes; then + HAVE_IMAGEMAGICK=yes + else + : + fi + + + + + if test $HAVE_IMAGEMAGICK = yes; then + +$as_echo "#define HAVE_IMAGEMAGICK 1" >>confdefs.h + + CFLAGS="$CFLAGS $IMAGEMAGICK_CFLAGS" + LIBS="$IMAGEMAGICK_LIBS $LIBS" + for ac_func in MagickExportImagePixels +do : + ac_fn_c_check_func "$LINENO" "MagickExportImagePixels" "ac_cv_func_MagickExportImagePixels" +if test "x$ac_cv_func_MagickExportImagePixels" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_MAGICKEXPORTIMAGEPIXELS 1 +_ACEOF + +fi +done + + fi +fi + HAVE_GTK=no if test "${with_gtk3}" = "yes"; then @@ -8846,7 +8990,7 @@ done if test "${GTK_COMPILES}" != "yes"; then if test "$USE_X_TOOLKIT" != "maybe"; then - as_fn_error $? "Gtk+ wanted, but it does not compile, see config.log. Maybe some x11-devel files missing?" "$LINENO" 5; + as_fn_error $? "Gtk+ wanted, but it does not compile, see config.log. Maybe some x11-devel files missing?" "$LINENO" 5 ; fi else HAVE_GTK=yes @@ -10945,6 +11089,112 @@ $as_echo "#define HAVE_X_SM 1" >>confdefs.h fi +### Use libxml (-lxml2) if available +if test "${with_xml2}" != "no"; then + ### I'm not sure what the version number should be, so I just guessed. + + succeeded=no + + # Extract the first word of "pkg-config", so it can be a program name with args. +set dummy pkg-config; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + case $PKG_CONFIG in + [\\/]* | ?:[\\/]*) + ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then + ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no" + ;; +esac +fi +PKG_CONFIG=$ac_cv_path_PKG_CONFIG +if test -n "$PKG_CONFIG"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 +$as_echo "$PKG_CONFIG" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + + if test "$PKG_CONFIG" = "no" ; then + HAVE_LIBXML2=no + else + PKG_CONFIG_MIN_VERSION=0.9.0 + if $PKG_CONFIG --atleast-pkgconfig-version $PKG_CONFIG_MIN_VERSION; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for libxml-2.0 > 2.2.0" >&5 +$as_echo_n "checking for libxml-2.0 > 2.2.0... " >&6; } + + if $PKG_CONFIG --exists "libxml-2.0 > 2.2.0" 2>&5; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + succeeded=yes + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBXML2_CFLAGS" >&5 +$as_echo_n "checking LIBXML2_CFLAGS... " >&6; } + LIBXML2_CFLAGS=`$PKG_CONFIG --cflags "libxml-2.0 > 2.2.0"|sed -e 's,///*,/,g'` + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBXML2_CFLAGS" >&5 +$as_echo "$LIBXML2_CFLAGS" >&6; } + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking LIBXML2_LIBS" >&5 +$as_echo_n "checking LIBXML2_LIBS... " >&6; } + LIBXML2_LIBS=`$PKG_CONFIG --libs "libxml-2.0 > 2.2.0"|sed -e 's,///*,/,g'` + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LIBXML2_LIBS" >&5 +$as_echo "$LIBXML2_LIBS" >&6; } + else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + LIBXML2_CFLAGS="" + LIBXML2_LIBS="" + ## If we have a custom action on failure, don't print errors, but + ## do set a variable so people can do so. + LIBXML2_PKG_ERRORS=`$PKG_CONFIG --errors-to-stdout --print-errors "libxml-2.0 > 2.2.0"` + + fi + + + + else + echo "*** Your version of pkg-config is too old. You need version $PKG_CONFIG_MIN_VERSION or newer." + echo "*** See http://www.freedesktop.org/software/pkgconfig" + fi + fi + + if test $succeeded = yes; then + HAVE_LIBXML2=yes + else + HAVE_LIBXML2=no + fi + + if test "${HAVE_LIBXML2}" = "yes"; then + +$as_echo "#define HAVE_LIBXML2 1" >>confdefs.h + + fi +fi + + + # If netdb.h doesn't declare h_errno, we must declare it by hand. { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether netdb declares h_errno" >&5 $as_echo_n "checking whether netdb declares h_errno... " >&6; } @@ -14551,6 +14801,7 @@ echo " Does Emacs use -ltiff? ${HAVE_TIFF}" echo " Does Emacs use a gif library? ${HAVE_GIF} $LIBGIF" echo " Does Emacs use -lpng? ${HAVE_PNG}" echo " Does Emacs use -lrsvg-2? ${HAVE_RSVG}" +echo " Does Emacs use imagemagick? ${HAVE_IMAGEMAGICK}" echo " Does Emacs use -lgpm? ${HAVE_GPM}" echo " Does Emacs use -ldbus? ${HAVE_DBUS}" echo " Does Emacs use -lgconf? ${HAVE_GCONF}" @@ -15110,7 +15361,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # values after options handling. ac_log=" This file was extended by emacs $as_me 24.0.50, which was -generated by GNU Autoconf 2.66. Invocation command line was +generated by GNU Autoconf 2.67. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS @@ -15176,7 +15427,7 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ emacs config.status 24.0.50 -configured by $0, generated by GNU Autoconf 2.66, +configured by $0, generated by GNU Autoconf 2.67, with options \\"\$ac_cs_config\\" Copyright (C) 2010 Free Software Foundation, Inc. @@ -15195,11 +15446,16 @@ ac_need_defaults=: while test $# != 0 do case $1 in - --*=*) + --*=?*) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` ac_shift=: ;; + --*=) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= + ac_shift=: + ;; *) ac_option=$1 ac_optarg=$2 @@ -15221,6 +15477,7 @@ do $ac_shift case $ac_optarg in *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + '') as_fn_error $? "missing file argument" ;; esac as_fn_append CONFIG_FILES " '$ac_optarg'" ac_need_defaults=false;; @@ -15310,7 +15567,7 @@ do "leim/Makefile") CONFIG_FILES="$CONFIG_FILES leim/Makefile" ;; "default") CONFIG_COMMANDS="$CONFIG_COMMANDS default" ;; - *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5 ;; esac done @@ -15660,7 +15917,7 @@ do esac case $ac_mode$ac_tag in :[FHL]*:*);; - :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5 ;; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac @@ -15688,7 +15945,7 @@ do [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || - as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5 ;; esac case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac as_fn_append ac_file_inputs " '$ac_f'" @@ -15715,7 +15972,7 @@ $as_echo "$as_me: creating $ac_file" >&6;} case $ac_tag in *:-:* | *:-) cat >"$tmp/stdin" \ - || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; esac ;; esac diff --git a/configure.in b/configure.in index ada0b189d3c..03e4e1a2a00 100644 --- a/configure.in +++ b/configure.in @@ -155,6 +155,8 @@ OPTION_DEFAULT_ON([tiff],[don't compile with TIFF image support]) OPTION_DEFAULT_ON([gif],[don't compile with GIF image support]) OPTION_DEFAULT_ON([png],[don't compile with PNG image support]) OPTION_DEFAULT_ON([rsvg],[don't compile with SVG image support]) +OPTION_DEFAULT_ON([xml2],[don't compile with XML parsing support]) +OPTION_DEFAULT_OFF([imagemagick],[compile with ImageMagick image support]) OPTION_DEFAULT_ON([xft],[don't use XFT for anti aliased fonts]) OPTION_DEFAULT_ON([libotf],[don't use libotf for OpenType font support]) @@ -1824,12 +1826,11 @@ if test "${HAVE_X11}" = "yes" || test "${NS_IMPL_GNUSTEP}" = "yes"; then RSVG_REQUIRED=2.11.0 RSVG_MODULE="librsvg-2.0 >= $RSVG_REQUIRED" - PKG_CHECK_MODULES(RSVG, $RSVG_MODULE, :, :) + PKG_CHECK_MODULES(RSVG, $RSVG_MODULE, HAVE_RSVG=yes, :) AC_SUBST(RSVG_CFLAGS) AC_SUBST(RSVG_LIBS) - if test ".${RSVG_CFLAGS}" != "."; then - HAVE_RSVG=yes + if test $HAVE_RSVG = yes; then AC_DEFINE(HAVE_RSVG, 1, [Define to 1 if using librsvg.]) CFLAGS="$CFLAGS $RSVG_CFLAGS" LIBS="$RSVG_LIBS $LIBS" @@ -1837,6 +1838,21 @@ if test "${HAVE_X11}" = "yes" || test "${NS_IMPL_GNUSTEP}" = "yes"; then fi fi +HAVE_IMAGEMAGICK=no +if test "${with_imagemagick}" != "no"; then + IMAGEMAGICK_MODULE="Wand" + PKG_CHECK_MODULES(IMAGEMAGICK, $IMAGEMAGICK_MODULE, HAVE_IMAGEMAGICK=yes, :) + AC_SUBST(IMAGEMAGICK_CFLAGS) + AC_SUBST(IMAGEMAGICK_LIBS) + + if test $HAVE_IMAGEMAGICK = yes; then + AC_DEFINE(HAVE_IMAGEMAGICK, 1, [Define to 1 if using imagemagick.]) + CFLAGS="$CFLAGS $IMAGEMAGICK_CFLAGS" + LIBS="$IMAGEMAGICK_LIBS $LIBS" + AC_CHECK_FUNCS(MagickExportImagePixels) + fi +fi + HAVE_GTK=no if test "${with_gtk3}" = "yes"; then @@ -2520,6 +2536,17 @@ if test "${HAVE_X11}" = "yes"; then fi AC_SUBST(LIBXSM) +### Use libxml (-lxml2) if available +if test "${with_xml2}" != "no"; then + ### I'm not sure what the version number should be, so I just guessed. + PKG_CHECK_MODULES(LIBXML2, libxml-2.0 > 2.2.0, HAVE_LIBXML2=yes, HAVE_LIBXML2=no) + if test "${HAVE_LIBXML2}" = "yes"; then + AC_DEFINE(HAVE_LIBXML2, 1, [Define to 1 if you have the libxml library (-lxml2).]) + fi +fi +AC_SUBST(LIBXML2_LIBS) +AC_SUBST(LIBXML2_CFLAGS) + # If netdb.h doesn't declare h_errno, we must declare it by hand. AC_CACHE_CHECK(whether netdb declares h_errno, emacs_cv_netdb_declares_h_errno, @@ -3662,6 +3689,7 @@ echo " Does Emacs use -ltiff? ${HAVE_TIFF}" echo " Does Emacs use a gif library? ${HAVE_GIF} $LIBGIF" echo " Does Emacs use -lpng? ${HAVE_PNG}" echo " Does Emacs use -lrsvg-2? ${HAVE_RSVG}" +echo " Does Emacs use imagemagick? ${HAVE_IMAGEMAGICK}" echo " Does Emacs use -lgpm? ${HAVE_GPM}" echo " Does Emacs use -ldbus? ${HAVE_DBUS}" echo " Does Emacs use -lgconf? ${HAVE_GCONF}" diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index 8285a313191..225cf9dcd74 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,3 +1,23 @@ +2010-09-09 Glenn Morris <rgm@gnu.org> + + * xresources.texi: Untabify. + +2010-09-06 Chong Yidong <cyd@stupidchicken.com> + + * dired.texi (Dired Enter): Minor doc fix (Bug#6982). + +2010-09-06 Glenn Morris <rgm@gnu.org> + + * misc.texi (Saving Emacs Sessions): Mention desktop-path. (Bug#6948) + +2010-09-02 Jan Djärv <jan.h.d@swipnet.se> + + * frames.texi (Cut/Paste Other App): Remove vut-buffer text. + +2010-08-21 Glenn Morris <rgm@gnu.org> + + * misc.texi (Amusements): Mention bubbles and animate. + 2010-07-31 Eli Zaretskii <eliz@gnu.org> * files.texi (Visiting): Add more index entries for diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index c8b4264d486..4a5d52b64ad 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -75,13 +75,12 @@ a directory name. The variable @code{dired-listing-switches} specifies the options to give to @code{ls} for listing the directory; this string @emph{must} -contain @samp{-l}. If you use a numeric prefix argument with the -@code{dired} command, you can specify the @code{ls} switches with the -minibuffer before you enter the directory specification. No matter -how they are specified, the @code{ls} switches can include short -options (that is, single characters) requiring no arguments, and long -options (starting with @samp{--}) whose arguments are specified with -@samp{=}. +contain @samp{-l}. If you use a prefix argument with the @code{dired} +command, you can specify the @code{ls} switches with the minibuffer +before you enter the directory specification. No matter how they are +specified, the @code{ls} switches can include short options (that is, +single characters) requiring no arguments, and long options (starting +with @samp{--}) whose arguments are specified with @samp{=}. On MS-Windows and MS-DOS systems, Emacs @emph{emulates} @code{ls}; see @ref{ls in Lisp}, for options and peculiarities of that emulation. diff --git a/doc/emacs/frames.texi b/doc/emacs/frames.texi index fb7413e8593..df4f0beff9e 100644 --- a/doc/emacs/frames.texi +++ b/doc/emacs/frames.texi @@ -273,15 +273,6 @@ the kill ring. This prevents you from losing the existing selection, at the risk of large memory consumption if other applications generate large selections. -@cindex cut buffer -@vindex x-cut-buffer-max - Whenever Emacs saves some text to the primary selection, it may also -save it to the @dfn{cut buffer}. The cut buffer is an obsolete -predecessor to the primary selection; most modern applications do not -use it. Saving text to the cut buffer is slow and inefficient, so -Emacs only does it if the text is shorter than the value of -@code{x-cut-buffer-max} (20000 characters by default). - You can yank the primary selection into Emacs using the usual yank commands, such as @kbd{C-y} (@code{yank}) and @kbd{Mouse-2} (@code{mouse-yank-at-click}). These commands actually check the diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index 387e1be715a..ea4b39bdece 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -2349,8 +2349,11 @@ sessions, or add this line in your init file (@pxref{Init File}): @findex desktop-change-dir @findex desktop-revert +@vindex desktop-path If you turn on @code{desktop-save-mode} in your init file, then when Emacs starts, it looks for a saved desktop in the current directory. +(More precisely, it looks in the directories specified by +@var{desktop-path}, and uses the first desktop it finds.) Thus, you can have separate saved desktops in different directories, and the starting directory determines which one Emacs reloads. You can save the current desktop and reload one saved in another directory @@ -2784,6 +2787,10 @@ bored, try an argument of 9. Sit back and watch. If you want a little more personal involvement, try @kbd{M-x gomoku}, which plays the game Go Moku with you. +@findex bubbles + @kbd{M-x bubbles} is a game in which the object is to remove as many +bubbles as you can in the smallest number of moves. + @findex blackbox @findex mpuz @findex 5x5 @@ -2832,6 +2839,11 @@ bats. @kbd{M-x solitaire} plays a game of solitaire in which you jump pegs across other pegs. +@findex animate-birthday-present +@cindex animate +The @code{animate} package makes text dance. For an example, try +@kbd{M-x animate-birthday-present}. + @findex studlify-region @cindex StudlyCaps @kbd{M-x studlify-region} studlify-cases the region, producing diff --git a/doc/emacs/xresources.texi b/doc/emacs/xresources.texi index 2a543eeee08..ecf5c02f32b 100644 --- a/doc/emacs/xresources.texi +++ b/doc/emacs/xresources.texi @@ -480,7 +480,7 @@ Emacs.menu*.font: 8x16 For dialog boxes, use @samp{dialog*}: @example -Emacs.dialog*.faceName: Sans-12 +Emacs.dialog*.faceName: Sans-12 @end example @noindent diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index fe64ca9d835..e3df5fab9e9 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,72 @@ +2010-09-11 Stefan Monnier <monnier@iro.umontreal.ca> + + * syntax.texi (Syntax Flags): Document new `c' flag. + +2010-09-09 Glenn Morris <rgm@gnu.org> + + * display.texi (ImageMagick Images): General cleanup. + +2010-09-06 Alexander Klimov <alserkli@inbox.ru> (tiny change) + + * files.texi (Directory Names): Use \` rather than ^. + +2010-09-02 Jan Djärv <jan.h.d@swipnet.se> + + * text.texi (Low-Level Kill Ring): + * frames.texi (Window System Selections): Remove cut buffer + documentation. + +2010-08-28 Eli Zaretskii <eliz@gnu.org> + + * display.texi (Fringe Size/Pos): Add a cross-reference to "Layout + Parameters", where the default fringe width is described. + + * frames.texi (Window Frame Parameters, Basic Parameters) + (Position Parameters, Layout Parameters, Management Parameters) + (Cursor Parameters, Font and Color Parameters): Add indexing for + frame parameters. (Bug#6929) + +2010-08-25 Tom Tromey <tromey@redhat.com> + + * vol2.texi (Top): Update. + * vol1.texi (Top): Update. + * tips.texi (Library Headers): Mention Package-Version and + Package-Requires. + * package.texi: New file. + * os.texi (System Interface): Update pointers. + * elisp.texi (Top): Link to new nodes. Include package.texi. + * anti.texi (Antinews): Update pointers. + +2010-08-25 Eli Zaretskii <eliz@gnu.org> + + * processes.texi (Filter Functions): Fix last change. + +2010-08-24 Markus Triska <triska@gmx.at> + + * processes.texi (Filter Functions): Use `buffer-live-p' instead + of `buffer-name' in the main text as well as in the example + (Bug#3098). + +2010-08-22 Chong Yidong <cyd@stupidchicken.com> + + * nonascii.texi (Text Representations): + * loading.texi (Loading Non-ASCII): + * compile.texi (Byte Compilation): Don't mention obsolete + --unibyte command-line argument. + +2010-08-22 Chong Yidong <cyd@stupidchicken.com> + + * modes.texi (Defining Minor Modes): Doc fix (Bug#6880). + +2010-08-22 Chong Yidong <cyd@stupidchicken.com> + + * objects.texi (Bool-Vector Type): Minor definition tweak (Bug#6878). + +2010-08-20 Eli Zaretskii <eliz@gnu.org> + + * commands.texi (Misc Events): Add cross-references to where + POSITION of a mouse event is described in detail. + 2010-08-08 Christoph <cschol2112@googlemail.com> * control.texi (Handling Errors) <error-message-string>: Fix arg name. diff --git a/doc/lispref/anti.texi b/doc/lispref/anti.texi index 11b8220d290..92e0432b842 100644 --- a/doc/lispref/anti.texi +++ b/doc/lispref/anti.texi @@ -6,7 +6,7 @@ @c This node must have no pointers. -@node Antinews, GNU Free Documentation License, System Interface, Top +@node Antinews, GNU Free Documentation License, Packaging, Top @appendix Emacs 22 Antinews @c Update the elisp.texi, vol1.texi, vol2.texi Antinews menu entries @c with the above version number. diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index d22cfd955cb..17cfcc0def8 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -1616,7 +1616,8 @@ These kinds of event are generated by moving a mouse wheel. Their usual meaning is a kind of scroll or zoom. The element @var{position} is a list describing the position of the -event, in the same format as used in a mouse-click event. +event, in the same format as used in a mouse-click event (@pxref{Click +Events}). @vindex mouse-wheel-up-event @vindex mouse-wheel-down-event @@ -1633,9 +1634,10 @@ selected in an application outside of Emacs, and then dragged and dropped onto an Emacs frame. The element @var{position} is a list describing the position of the -event, in the same format as used in a mouse-click event, and -@var{files} is the list of file names that were dragged and dropped. -The usual way to handle this event is by visiting these files. +event, in the same format as used in a mouse-click event (@pxref{Click +Events}), and @var{files} is the list of file names that were dragged +and dropped. The usual way to handle this event is by visiting these +files. This kind of event is generated, at present, only on some kinds of systems. diff --git a/doc/lispref/compile.texi b/doc/lispref/compile.texi index 1c28664e7c3..69b57f19ea7 100644 --- a/doc/lispref/compile.texi +++ b/doc/lispref/compile.texi @@ -22,12 +22,6 @@ hardware (as true compiled code is), byte-code is completely transportable from machine to machine without recompilation. It is not, however, as fast as true compiled code. - Compiling a Lisp file with the Emacs byte compiler always reads the -file as multibyte text, even if Emacs was started with @samp{--unibyte}, -unless the file specifies otherwise. This is so that compilation gives -results compatible with running the same file without compilation. -@xref{Loading Non-ASCII}. - In general, any version of Emacs can run byte-compiled code produced by recent earlier versions of Emacs, but the reverse is not true. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 9f07fb42ef4..037c334ab88 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -3214,7 +3214,9 @@ width from the window's frame. The values of these variables take effect when you display the buffer in a window. If you change them while the buffer is visible, you can call @code{set-window-buffer} to display it once again in the -same window, to make the changes take effect. +same window, to make the changes take effect. A buffer that does not +specify values for these variables will use the default values +specified for the frame; see @ref{Layout Parameters}. @defun set-window-fringes window left &optional right outside-margins This function sets the fringe widths of window @var{window}. @@ -4039,6 +4041,7 @@ displayed (@pxref{Display Feature Testing}). * GIF Images:: Special features for GIF format. * TIFF Images:: Special features for TIFF format. * PostScript Images:: Special features for PostScript format. +* ImageMagick Images:: Special features available through ImageMagick. * Other Image Types:: Various other formats are supported. * Defining Images:: Convenient ways to define an image for later use. * Showing Images:: Convenient ways to display an image once it is defined. @@ -4463,6 +4466,60 @@ specifying the bounding box of the PostScript image, analogous to the @end example @end table +@node ImageMagick Images +@subsection ImageMagick Images +@cindex ImageMagick images +@cindex images, support for more formats + + If you build Emacs with ImageMagick (@url{http://www.imagemagick.org}) +support, you can use the ImageMagick library to load many image formats. + +@findex imagemagick-types +The function @code{imagemagick-types} returns a list of image file +extensions that your installation of ImageMagick supports. To enable +support, you must call the function @code{imagemagick-register-types}. + +@vindex imagemagick-types-inhibit +The variable @code{imagemagick-types-inhibit} specifies a list of +image types that you do @emph{not} want ImageMagick to handle. There +may be overlap between image loaders in your Emacs installation, and +you may prefer to use a different one for a given image type (which +@c FIXME how is this priority determined? +loader will be used in practice depends on the priority of the loaders). +@c FIXME why are these uppercase when image-types is lower-case? +@c FIXME what are the possibe options? Are these actually file extensions? +For example, if you never want to use the ImageMagick loader to use +JPEG files, add @code{JPG} to this list. + +@vindex imagemagick-render-type +You can set the variable @code{imagemagick-render-type} to choose +between screen render methods for the ImageMagick loader. The options +are: @code{0}, a conservative method which works with older +@c FIXME details of this "newer method"? +@c Presumably it is faster but may be less "robust"? +ImageMagick versions (it is a bit slow, but robust); and @code{1}, +a newer ImageMagick method. + +Images loaded with ImageMagick support a few new display specifications: + +@table @code +@item :width, :height +The @code{:width} and @code{:height} keywords are used for scaling the +image. If only one of them is specified, the other one will be +calculated so as to preserve the aspect ratio. If both are specified, +aspect ratio may not be preserved. + +@item :rotation +Specifies a rotation angle in degrees. + +@item :index +Specifies which image to view inside an image bundle file format, such +as TIFF or DJVM. You can use the @code{image-metadata} function to +retrieve the total number of images in an image bundle (this is +similar to how GIF files work). +@end table + + @node Other Image Types @subsection Other Image Types @cindex PBM diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 30f085f69de..7f0a2ff5a37 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -159,6 +159,8 @@ Cover art by Etienne Suvasa. * System Interface:: Getting the user id, system type, environment variables, and other such things. +* Packaging:: Preparing Lisp code for distribution. + Appendices * Antinews:: Info for users downgrading to Emacs 22. @@ -1395,6 +1397,12 @@ Operating System Interface * Session Management:: Saving and restoring state with X Session Management. +Preparing Lisp code for distribution + +* Packaging Basics:: The basic concepts of Emacs Lisp packages. +* Simple Packages:: How to package a single .el file. +* Multi-file Packages:: How to package multiple files. + Starting Up Emacs * Startup Summary:: Sequence of actions Emacs performs at startup. @@ -1491,6 +1499,8 @@ Object Internals @include display.texi @include os.texi +@include package.texi + @c MOVE to Emacs Manual: include misc-modes.texi @c appendices diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index abdd2814b56..23fd2376a57 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -1933,7 +1933,7 @@ The variable @code{directory-abbrev-alist} contains an alist of abbreviations to use for file directories. Each element has the form @code{(@var{from} . @var{to})}, and says to replace @var{from} with @var{to} when it appears in a directory name. The @var{from} string is -actually a regular expression; it should always start with @samp{^}. +actually a regular expression; it should always start with @samp{\`}. The @var{to} string should be an ordinary absolute directory name. Do not use @samp{~} to stand for a home directory in that string. The function @code{abbreviate-file-name} performs these substitutions. @@ -1946,9 +1946,9 @@ and so on are normally accessed through symbolic links named @file{/fsf} and so on. @example -(("^/home/fsf" . "/fsf") - ("^/home/gp" . "/gp") - ("^/home/gd" . "/gd")) +(("\\`/home/fsf" . "/fsf") + ("\\`/home/gp" . "/gp") + ("\\`/home/gd" . "/gd")) @end example @end defopt diff --git a/doc/lispref/frames.texi b/doc/lispref/frames.texi index a54a65b0743..d27010d2096 100644 --- a/doc/lispref/frames.texi +++ b/doc/lispref/frames.texi @@ -461,6 +461,7 @@ Line Arguments for Emacs Invocation, emacs, The GNU Emacs Manual}. @node Window Frame Parameters @subsection Window Frame Parameters +@cindex frame parameters for windowed displays Just what parameters a frame has depends on what display mechanism it uses. This section describes the parameters that have special @@ -489,16 +490,19 @@ terminal frames. frame. @code{title} and @code{name} are meaningful on all terminals. @table @code +@vindex display, a frame parameter @item display The display on which to open this frame. It should be a string of the form @code{"@var{host}:@var{dpy}.@var{screen}"}, just like the @code{DISPLAY} environment variable. +@vindex display-type, a frame parameter @item display-type This parameter describes the range of possible colors that can be used in this frame. Its value is @code{color}, @code{grayscale} or @code{mono}. +@vindex title, a frame parameter @item title If a frame has a non-@code{nil} title, it appears in the window system's title bar at the top of the frame, and also in the mode line @@ -507,6 +511,7 @@ of windows in that frame if @code{mode-line-frame-identification} uses Emacs is not using a window system, and can only display one frame at a time. @xref{Frame Titles}. +@vindex name, a frame parameter @item name The name of the frame. The frame name serves as a default for the frame title, if the @code{title} parameter is unspecified or @code{nil}. If @@ -520,11 +525,13 @@ looking up X resources for the frame. @node Position Parameters @subsubsection Position Parameters +@cindex window position on display Position parameters' values are normally measured in pixels, but on text-only terminals they count characters or lines instead. @table @code +@vindex left, a frame parameter @item left The position, in pixels, of the left (or right) edge of the frame with respect to the left (or right) edge of the screen. The value may be: @@ -550,11 +557,13 @@ Some window managers ignore program-specified positions. If you want to be sure the position you specify is not ignored, specify a non-@code{nil} value for the @code{user-position} parameter as well. +@vindex top, a frame parameter @item top The screen position of the top (or bottom) edge, in pixels, with respect to the top (or bottom) edge of the screen. It works just like @code{left}, except vertically instead of horizontally. +@vindex icon-left, a frame parameter @item icon-left The screen position of the left edge @emph{of the frame's icon}, in pixels, counting from the left edge of the screen. This takes effect if @@ -564,11 +573,13 @@ If you specify a value for this parameter, then you must also specify a value for @code{icon-top} and vice versa. The window manager may ignore these two parameters. +@vindex icon-top, a frame parameter @item icon-top The screen position of the top edge @emph{of the frame's icon}, in pixels, counting from the top edge of the screen. This takes effect if and when the frame is iconified. +@vindex user-position, a frame parameter @item user-position When you create a frame and specify its screen position with the @code{left} and @code{top} parameters, use this parameter to say whether @@ -576,6 +587,7 @@ the specified position was user-specified (explicitly requested in some way by a human user) or merely program-specified (chosen by a program). A non-@code{nil} value says the position was user-specified. +@cindex window positions and window managers Window managers generally heed user-specified positions, and some heed program-specified positions too. But many ignore program-specified positions, placing the window in a default fashion or letting the user @@ -591,24 +603,31 @@ parameters represent the user's stated preference; otherwise, use @node Size Parameters @subsubsection Size Parameters +@cindex window size on display Size parameters' values are normally measured in pixels, but on text-only terminals they count characters or lines instead. @table @code +@vindex height, a frame parameter @item height The height of the frame contents, in characters. (To get the height in pixels, call @code{frame-pixel-height}; see @ref{Size and Position}.) +@vindex width, a frame parameter @item width The width of the frame contents, in characters. (To get the width in pixels, call @code{frame-pixel-width}; see @ref{Size and Position}.) +@vindex user-size, a frame parameter @item user-size This does for the size parameters @code{height} and @code{width} what -the @code{user-position} parameter (see above) does for the position -parameters @code{top} and @code{left}. +the @code{user-position} parameter (@pxref{Position Parameters, +user-position}) does for the position parameters @code{top} and +@code{left}. +@cindex full-screen frames +@vindex fullscreen, a frame parameter @item fullscreen Specify that width, height or both shall be maximized. The value @code{fullwidth} specifies that width shall be as wide as possible. @@ -623,33 +642,42 @@ covers the whole screen. @node Layout Parameters @subsubsection Layout Parameters +@cindex layout parameters of frames +@cindex frame layout parameters These frame parameters enable or disable various parts of the frame, or control their sizes. @table @code +@vindex border-width, a frame parameter @item border-width The width in pixels of the frame's border. +@vindex internal-border-width, a frame parameter @item internal-border-width The distance in pixels between text (or fringe) and the frame's border. +@vindex vertical-scroll-bars, a frame parameter @item vertical-scroll-bars Whether the frame has scroll bars for vertical scrolling, and which side of the frame they should be on. The possible values are @code{left}, @code{right}, and @code{nil} for no scroll bars. @ignore +@vindex horizontal-scroll-bars, a frame parameter @item horizontal-scroll-bars Whether the frame has scroll bars for horizontal scrolling (non-@code{nil} means yes). Horizontal scroll bars are not currently implemented. @end ignore +@vindex scroll-bar-width, a frame parameter @item scroll-bar-width The width of vertical scroll bars, in pixels, or @code{nil} meaning to use the default width. +@vindex left-fringe, a frame parameter +@vindex right-fringe, a frame parameter @item left-fringe @itemx right-fringe The default width of the left and right fringes of windows in this @@ -666,22 +694,26 @@ fringe. However, you can force one fringe or the other to a precise width by specifying that width as a negative integer. If both widths are negative, only the left fringe gets the specified width. +@vindex menu-bar-lines, a frame parameter @item menu-bar-lines The number of lines to allocate at the top of the frame for a menu bar. The default is 1. A value of @code{nil} means don't display a menu bar. @xref{Menu Bar}. (The X toolkit and GTK allow at most one menu bar line; they treat larger values as 1.) +@vindex tool-bar-lines, a frame parameter @item tool-bar-lines The number of lines to use for the tool bar. A value of @code{nil} means don't display a tool bar. (GTK and Nextstep allow at most one tool bar line; they treat larger values as 1.) +@vindex tool-bar-position, a frame parameter @item tool-bar-position The position of the tool bar. Currently only for the GTK tool bar. Value can be one of @code{top}, @code{bottom} @code{left}, @code{right}. The default is @code{top}. +@vindex line-spacing, a frame parameter @item line-spacing Additional space to leave below each text line, in pixels (a positive integer). @xref{Line Height}, for more information. @@ -694,6 +726,7 @@ integer). @xref{Line Height}, for more information. with which buffers have been, or should, be displayed in the frame. @table @code +@vindex minibuffer, a frame parameter @item minibuffer Whether this frame has its own minibuffer. The value @code{t} means yes, @code{nil} means no, @code{only} means this frame is just a @@ -703,6 +736,7 @@ frame), the frame uses that minibuffer. This frame parameter takes effect when the frame is created, and can not be changed afterwards. +@vindex buffer-predicate, a frame parameter @item buffer-predicate The buffer-predicate function for this frame. The function @code{other-buffer} uses this predicate (from the selected frame) to @@ -711,61 +745,73 @@ decide which buffers it should consider, if the predicate is not each buffer; if the predicate returns a non-@code{nil} value, it considers that buffer. +@vindex buffer-list, a frame parameter @item buffer-list -A list of buffers that have been selected in this frame, -ordered most-recently-selected first. +A list of buffers that have been selected in this frame, ordered +most-recently-selected first. +@vindex unsplittable, a frame parameter @item unsplittable If non-@code{nil}, this frame's window is never split automatically. @end table @node Management Parameters @subsubsection Window Management Parameters -@cindex window manager, and frame parameters +@cindex window manager interaction, and frame parameters These frame parameters, meaningful only on window system displays, interact with the window manager. @table @code +@vindex visibility, a frame parameter @item visibility The state of visibility of the frame. There are three possibilities: @code{nil} for invisible, @code{t} for visible, and @code{icon} for iconified. @xref{Visibility of Frames}. +@vindex auto-raise, a frame parameter @item auto-raise Whether selecting the frame raises it (non-@code{nil} means yes). +@vindex auto-lower, a frame parameter @item auto-lower Whether deselecting the frame lowers it (non-@code{nil} means yes). +@vindex icon-type, a frame parameter @item icon-type The type of icon to use for this frame when it is iconified. If the value is a string, that specifies a file containing a bitmap to use. Any other non-@code{nil} value specifies the default bitmap icon (a picture of a gnu); @code{nil} specifies a text icon. +@vindex icon-name, a frame parameter @item icon-name The name to use in the icon for this frame, when and if the icon appears. If this is @code{nil}, the frame's title is used. +@vindex window-id, a frame parameter @item window-id The number of the window-system window used by the frame to contain the actual Emacs windows. +@vindex outer-window-id, a frame parameter @item outer-window-id The number of the outermost window-system window used for the whole frame. +@vindex wait-for-wm, a frame parameter @item wait-for-wm If non-@code{nil}, tell Xt to wait for the window manager to confirm geometry changes. Some window managers, including versions of Fvwm2 and KDE, fail to confirm, so Xt hangs. Set this to @code{nil} to prevent hanging with those window managers. +@vindex sticky, a frame parameter @item sticky If non-@code{nil}, the frame is visible on all virtual desktops on systems with virtual desktops. @ignore +@vindex parent-id, a frame parameter @item parent-id @c ??? Not yet working. The X window number of the window that should be the parent of this one. @@ -777,10 +823,12 @@ it and see if it works.) @node Cursor Parameters @subsubsection Cursor Parameters +@cindex cursor, and frame parameters This frame parameter controls the way the cursor looks. @table @code +@vindex cursor-type, a frame parameter @item cursor-type How to display the cursor. Legitimate values are: @@ -832,10 +880,12 @@ and bar becomes a narrower bar). @node Font and Color Parameters @subsubsection Font and Color Parameters +@cindex font and color, frame parameters These frame parameters control the use of fonts and colors. @table @code +@vindex font-backend, a frame parameter @item font-backend A list of symbols, specifying the @dfn{font backends} to use for drawing fonts in the frame, in order of priority. On X, there are @@ -844,10 +894,12 @@ driver) and @code{xft} (the Xft font driver). On other systems, there is only one available font backend, so it does not make sense to modify this frame parameter. +@vindex background-mode, a frame parameter @item background-mode This parameter is either @code{dark} or @code{light}, according to whether the background color is a light one or a dark one. +@vindex tty-color-mode, a frame parameter @item tty-color-mode @cindex standard colors for character terminals This parameter overrides the terminal's color support as given by the @@ -863,6 +915,7 @@ If the parameter's value is a symbol, it specifies a number through the value of @code{tty-color-mode-alist}, and the associated number is used instead. +@vindex screen-gamma, a frame parameter @item screen-gamma @cindex gamma correction If this is a number, Emacs performs ``gamma correction'' which adjusts @@ -882,6 +935,7 @@ If your monitor displays colors too light, you should specify a that makes colors darker. A screen gamma value of 1.5 may give good results for LCD color displays. +@vindex alpha, a frame parameter @item alpha @cindex opacity, frame @cindex transparency, frame @@ -909,37 +963,45 @@ automatically equivalent to particular face attributes of particular faces (@pxref{Standard Faces,,, emacs, The Emacs Manual}): @table @code +@vindex font, a frame parameter @item font The name of the font for displaying text in the frame. This is a string, either a valid font name for your system or the name of an Emacs fontset (@pxref{Fontsets}). It is equivalent to the @code{font} attribute of the @code{default} face. +@vindex foreground-color, a frame parameter @item foreground-color The color to use for the image of a character. It is equivalent to the @code{:foreground} attribute of the @code{default} face. +@vindex background-color, a frame parameter @item background-color The color to use for the background of characters. It is equivalent to the @code{:background} attribute of the @code{default} face. +@vindex mouse-color, a frame parameter @item mouse-color The color for the mouse pointer. It is equivalent to the @code{:background} attribute of the @code{mouse} face. +@vindex cursor-color, a frame parameter @item cursor-color The color for the cursor that shows point. It is equivalent to the @code{:background} attribute of the @code{cursor} face. +@vindex border-color, a frame parameter @item border-color The color for the border of the frame. It is equivalent to the @code{:background} attribute of the @code{border} face. +@vindex scroll-bar-foreground, a frame parameter @item scroll-bar-foreground If non-@code{nil}, the color for the foreground of scroll bars. It is equivalent to the @code{:foreground} attribute of the @code{scroll-bar} face. +@vindex scroll-bar-background, a frame parameter @item scroll-bar-background If non-@code{nil}, the color for the background of scroll bars. It is equivalent to the @code{:background} attribute of the @@ -1923,28 +1985,6 @@ with X conventions.) The default for @var{data-type} is @code{STRING}. @end defun -@cindex cut buffer -The X server also has a set of eight numbered @dfn{cut buffers} which can -store text or other data being moved between applications. Cut buffers -are considered obsolete, but Emacs supports them for the sake of X -clients that still use them. Cut buffers are numbered from 0 to 7. - -@defun x-get-cut-buffer &optional n -This function returns the contents of cut buffer number @var{n}. -If omitted @var{n} defaults to 0. -@end defun - -@defun x-set-cut-buffer string &optional push -@anchor{Definition of x-set-cut-buffer} -This function stores @var{string} into the first cut buffer (cut buffer -0). If @var{push} is @code{nil}, only the first cut buffer is changed. -If @var{push} is non-@code{nil}, that says to move the values down -through the series of cut buffers, much like the way successive kills in -Emacs move down the kill ring. In other words, the previous value of -the first cut buffer moves into the second cut buffer, and the second to -the third, and so on through all eight cut buffers. -@end defun - @defopt selection-coding-system This variable specifies the coding system to use when reading and writing selections or the clipboard. @xref{Coding diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi index bbdd67fc3a5..dee2a0252eb 100644 --- a/doc/lispref/loading.texi +++ b/doc/lispref/loading.texi @@ -367,13 +367,6 @@ example) is read without decoding, the text of the program will be unibyte text, and its string constants will be unibyte strings. @xref{Coding Systems}. - To make the results more predictable, Emacs always performs decoding -into the multibyte representation when loading Lisp files, even if it -was started with the @samp{--unibyte} option. This means that string -constants with non-@acronym{ASCII} characters translate into multibyte -strings. The only exception is when a particular file specifies no -decoding. - The reason Emacs is designed this way is so that Lisp programs give predictable results, regardless of how Emacs was started. In addition, this enables programs that depend on using multibyte text to work even diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 3953da59b93..12f16b67663 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -1411,14 +1411,20 @@ The string @var{lighter} says what to display in the mode line when the mode is enabled; if it is @code{nil}, the mode is not displayed in the mode line. -The optional argument @var{keymap} specifies the keymap for the minor mode. -It can be a variable name, whose value is the keymap, or it can be an alist -specifying bindings in this form: +The optional argument @var{keymap} specifies the keymap for the minor +mode. If non-@code{nil}, it should be a variable name (whose value is +a keymap), a keymap, or an alist of the form @example (@var{key-sequence} . @var{definition}) @end example +@noindent +where each @var{key-sequence} and @var{definition} are arguments +suitable for passing to @code{define-key} (@pxref{Changing Key +Bindings}). If @var{keymap} is a keymap or an alist, this also +defines the variable @code{@var{mode}-map}. + The above three arguments @var{init-value}, @var{lighter}, and @var{keymap} can be (partially) omitted when @var{keyword-args} are used. The @var{keyword-args} consist of keywords followed by diff --git a/doc/lispref/nonascii.texi b/doc/lispref/nonascii.texi index 00a1dffed6a..40c78d97da7 100644 --- a/doc/lispref/nonascii.texi +++ b/doc/lispref/nonascii.texi @@ -102,9 +102,6 @@ it contains unibyte encoded text or binary non-text data. You cannot set this variable directly; instead, use the function @code{set-buffer-multibyte} to change a buffer's representation. - -The @samp{--unibyte} command line option does its job by setting the -default value to @code{nil} early in startup. @end defvar @defun position-bytes position diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi index 1a72fdf671c..b0b0e1d0042 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -1189,8 +1189,8 @@ Syntax tables (@pxref{Syntax Tables}). @node Bool-Vector Type @subsection Bool-Vector Type - A @dfn{bool-vector} is a one-dimensional array of elements that -must be @code{t} or @code{nil}. + A @dfn{bool-vector} is a one-dimensional array whose elements must +be @code{t} or @code{nil}. The printed representation of a bool-vector is like a string, except that it begins with @samp{#&} followed by the length. The string diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 4f37eb10b7a..dd827234272 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -5,7 +5,7 @@ @c Free Software Foundation, Inc. @c See the file elisp.texi for copying conditions. @setfilename ../../info/os -@node System Interface, Antinews, Display, Top +@node System Interface, Packaging, Display, Top @chapter Operating System Interface This chapter is about starting and getting out of Emacs, access to diff --git a/doc/lispref/package.texi b/doc/lispref/package.texi new file mode 100644 index 00000000000..138f8d934e6 --- /dev/null +++ b/doc/lispref/package.texi @@ -0,0 +1,197 @@ +@c -*-texinfo-*- +@c This is part of the GNU Emacs Lisp Reference Manual. +@c Copyright (C) 2010 +@c Free Software Foundation, Inc. +@c See the file elisp.texi for copying conditions. +@setfilename ../../info/package +@node Packaging, Antinews, System Interface, Top +@chapter Preparing Lisp code for distribution +@cindex packaging + + Emacs provides a standard way for Emacs Lisp code to be distributed +to users. This approach lets users easily download, install, +uninstall, and upgrade Lisp code that they might want to use. + + A @dfn{package} is simply one or more files, formatted and bundled +in a particular way. Typically a package includes primarily Emacs +Lisp code, but it is possible to create other kinds of packages as +well. + +@menu +* Packaging Basics:: The basic concepts of Emacs Lisp packages. +* Simple Packages:: How to package a single .el file. +* Multi-file Packages:: How to package multiple files. +@end menu + +@node Packaging Basics +@section Packaging Basics +@cindex packaging basics + + A package has a few attributes: +@cindex package attributes + +@table @asis +@item Name +A string, the name of the package. This attribute is mandatory. If +it does not exist, the package cannot be installed by the package +manager. + +@item Version +A version number, which is anything that can be parsed by +@code{version-to-list}. This attribute is mandatory. If it does not +exist, the package cannot be installed by the package manager. + +@item Brief description +This is shown to the user in the package menu buffer. It is just a +single line. On a terminal with 80 characters per line, there are +only 36 characters available in the package menu mode for showing the +brief description, so it is best to keep it very brief. If no brief +name is given, an empty string is used. + +@item Long description +This can be a @file{README} file or the like. This is available to +the user before the package is installed, via the package menu. It +should more fully describe the package and its capabilities, so a user +can read it to decide whether he wants to install the package. This +attribute is optional. + +@item Dependencies +This is a list of other packages and their minimal acceptable +versions. This is used both at download time (to make sure all the +needed code is available) and at activation time (to ensure a package +is only activated if all its dependencies have been successfully +activated). This attribute is optional. + +@item Manual +A package can optionally include an Info manual. +@end table + + Conceptually, a package goes through several state transitions (in +reality some of these transitions are grouped together): + +@table @asis +@item Download +Fetch the package from somewhere. + +@item Install +Unpack the package, or write a @file{.el} file into the appropriate +install directory. This step also includes extracting autoloads and +byte-compiling the Emacs Lisp code. + +@item Activate +Update @code{load-path} and @code{Info-directory-list} and evaluate +the autoloads, so that the package is ready for the user to use. +@end table + + It is best for users if packages do not do too much work at +activation time. The best approach is to have activation consist of +some autoloads and little more. + +@node Simple Packages +@section Simple Packages +@cindex single file packages + + The simplest package consists of a single Emacs Lisp source file. +In this case, all the attributes of the package (@pxref{Packaging +Basics}) are taken from this file. + + The package system expects this @file{.el} file to conform to the +Emacs Lisp library header conventions. @xref{Library Headers}. + + The name of the package is the same as the base name of the +@file{.el} file, as written in the first comment line. For example, +given the header line: + +@smallexample +;;; superfrobnicator.el --- frobnicate and bifurcate flanges +@end smallexample + +the package name will be @samp{superfrobnicator}. + + The short description of the package is also taken from the first +line of the file. + + If the file has a ``Commentary'' header, then it is used as the long +description. + + The version of the package comes either from the ``Package-Version'' +header, if it exists, or from the ``Version'' header. A package is +required to have a version number. Each release of a package must be +accompanied by an increase in the version number. + + If the file has a ``Package-Requires'' header, then that is used as +the package dependencies. Otherwise, the package is assumed not to +have any dependencies. + + A single-file package cannot have an Info manual. + + The file will be scanned for autoload cookies at install time. +@xref{Autoload}. + +@node Multi-file Packages +@section Multi-file Packages +@cindex multi-file packages + + A multi-file package is just a @file{.tar} file. While less +convenient to create than a single-file package, a multi-file package +also offers more features: it can include an Info manual, multiple +Emacs Lisp files, and also other data files needed by a package. + + The contents of the @file{.tar} file must all appear beneath a +single directory, named after the package and version. Files can +appear in subdirectories of this top-most directory, but Emacs Lisp +code will only be found (and thus byte-compiled) at the top-most +level. Also, the @file{.tar} file is typically also given this same +name. For example, if you are distributing version 1.3 of the +superfrobnicator, the package file would be named +``superfrobnicator-1.3.tar'' and the contents would all appear in the +directory @file{superfrobnicator-1.3} in that @file{.tar}. + + The package must include a @file{-pkg.el} file, named after the +package. In our example above, this file would be called +@file{superfrobnicator-pkg.el}. This file must have a single form in +it, a call to @code{define-package}. The package dependencies and +brief description are taken from this form. + +@defun define-package name version &optional docstring requirements +Define a package. @var{name} is the name of the package, a string. +@var{version} is the package's version, a string. It must be in a +form that can be understood by @code{version-to-list}. +@var{docstring} is the short description of the package. +@var{requirements} is a list of required packages and their versions. +@end defun + + If a @file{README} file exists in the content directory, then it is +used as the long description. + + If the package has an Info manual, you should distribute the needed +info files, plus a @file{dir} file made with @command{install-info}. +@xref{Invoking install-info, Invoking install-info, Invoking +install-info, texinfo, Texinfo}. + + Do not include any @file{.elc} files in the package. Those will be +created at install time. Note that there is no way to control the +order in which files are byte-compiled; your package must be robust +here. + + The installation process will scan all the @file{.el} files in the +package for autoload cookies. @xref{Autoload}. They are extracted +into a @file{-autoloads.el} file (e.g., +@file{superfrobnicator-autoloads.el}), so do not include a file of +that name in your package. + + Any other files in the @file{.tar} file are simply unpacked when the +package is installed. This can be useful if your package needs +auxiliary data files --- e.g., icons or sounds. + + Emacs Lisp code installed via the package manager must take special +care to be location-independent. One easy way to do this is to make +references to auxiliary data files relative to @var{load-file-name}. +For example: + +@smallexample +(defconst superfrobnicator-base (file-name-directory load-file-name)) + +(defun superfrobnicator-fetch-image (file) + (expand-file-name file superfrobnicator-base)) +@end smallexample diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi index 747d865b0e1..89f97f99de3 100644 --- a/doc/lispref/processes.texi +++ b/doc/lispref/processes.texi @@ -1273,22 +1273,24 @@ process's buffer, mimicking the actions of Emacs when there is no filter. Such filter functions need to use @code{set-buffer} in order to be sure to insert in that buffer. To avoid setting the current buffer semipermanently, these filter functions must save and restore the -current buffer. They should also update the process marker, and in some -cases update the value of point. Here is how to do these things: +current buffer. They should also check whether the buffer is still +alive, update the process marker, and in some cases update the value +of point. Here is how to do these things: @smallexample @group (defun ordinary-insertion-filter (proc string) - (with-current-buffer (process-buffer proc) - (let ((moving (= (point) (process-mark proc)))) + (when (buffer-live-p (process-buffer proc)) + (with-current-buffer (process-buffer proc) + (let ((moving (= (point) (process-mark proc)))) @end group @group - (save-excursion - ;; @r{Insert the text, advancing the process marker.} - (goto-char (process-mark proc)) - (insert string) - (set-marker (process-mark proc) (point))) - (if moving (goto-char (process-mark proc)))))) + (save-excursion + ;; @r{Insert the text, advancing the process marker.} + (goto-char (process-mark proc)) + (insert string) + (set-marker (process-mark proc) (point))) + (if moving (goto-char (process-mark proc))))))) @end group @end smallexample @@ -1315,12 +1317,6 @@ expression searching or matching had to explicitly save and restore the match data. Now Emacs does this automatically for filter functions; they never need to do it explicitly. @xref{Match Data}. - A filter function that writes the output into the buffer of the -process should check whether the buffer is still alive. If it tries to -insert into a dead buffer, it will get an error. The expression -@code{(buffer-name (process-buffer @var{process}))} returns @code{nil} -if the buffer is dead. - The output to the function may come in chunks of any size. A program that produces the same output twice in a row may send it as one batch of 200 characters one time, and five batches of 40 characters the next. If diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi index 9add9b76e79..a608db16f89 100644 --- a/doc/lispref/syntax.texi +++ b/doc/lispref/syntax.texi @@ -292,19 +292,21 @@ identifying them as generic string delimiters. @cindex syntax flags In addition to the classes, entries for characters in a syntax table -can specify flags. There are seven possible flags, represented by the -characters @samp{1}, @samp{2}, @samp{3}, @samp{4}, @samp{b}, @samp{n}, -and @samp{p}. - - All the flags except @samp{n} and @samp{p} are used to describe -multi-character comment delimiters. The digit flags indicate that a -character can @emph{also} be part of a comment sequence, in addition to -the syntactic properties associated with its character class. The flags -are independent of the class and each other for the sake of characters -such as @samp{*} in C mode, which is a punctuation character, @emph{and} -the second character of a start-of-comment sequence (@samp{/*}), -@emph{and} the first character of an end-of-comment sequence -(@samp{*/}). +can specify flags. There are eight possible flags, represented by the +characters @samp{1}, @samp{2}, @samp{3}, @samp{4}, @samp{b}, @samp{c}, +@samp{n}, and @samp{p}. + + All the flags except @samp{p} are used to describe comment +delimiters. The digit flags are used for comment delimiters made up +of 2 characters. They indicate that a character can @emph{also} be +part of a comment sequence, in addition to the syntactic properties +associated with its character class. The flags are independent of the +class and each other for the sake of characters such as @samp{*} in +C mode, which is a punctuation character, @emph{and} the second +character of a start-of-comment sequence (@samp{/*}), @emph{and} the +first character of an end-of-comment sequence (@samp{*/}). The flags +@samp{b}, @samp{c}, and @samp{n} are used to qualify the corresponding +comment delimiter. Here is a table of the possible flags for a character @var{c}, and what they mean: @@ -325,63 +327,62 @@ sequence. @samp{4} means @var{c} is the second character of such a sequence. @item -@c Emacs 19 feature @samp{b} means that @var{c} as a comment delimiter belongs to the -alternative ``b'' comment style. +alternative ``b'' comment style. For a two-character comment starter, +this flag is only significant on the second char, and for a 2-character +comment ender it is only significant on the first char. -Emacs supports two comment styles simultaneously in any one syntax -table. This is for the sake of C++. Each style of comment syntax has -its own comment-start sequence and its own comment-end sequence. Each -comment must stick to one style or the other; thus, if it starts with -the comment-start sequence of style ``b,'' it must also end with the -comment-end sequence of style ``b.'' +@item +@samp{c} means that @var{c} as a comment delimiter belongs to the +alternative ``c'' comment style. For a two-character comment +delimiter, @samp{c} on either character makes it of style ``c''. -The two comment-start sequences must begin with the same character; only -the second character may differ. Mark the second character of the -``b''-style comment-start sequence with the @samp{b} flag. +@item +@samp{n} on a comment delimiter character specifies +that this kind of comment can be nested. For a two-character +comment delimiter, @samp{n} on either character makes it +nestable. -A comment-end sequence (one or two characters) applies to the ``b'' -style if its first character has the @samp{b} flag set; otherwise, it -applies to the ``a'' style. +Emacs supports several comment styles simultaneously in any one syntax +table. A comment style is a set of flags @samp{b}, @samp{c}, and +@samp{n}, so there can be up to 8 different comment styles. +Each comment delimiter has a style and only matches comment delimiters +of the same style. Thus if a comment starts with the comment-start +sequence of style ``bn'', it will extend until the next matching +comment-end sequence of style ``bn''. -The appropriate comment syntax settings for C++ are as follows: +The appropriate comment syntax settings for C++ can be as follows: @table @asis @item @samp{/} -@samp{124b} +@samp{124} @item @samp{*} -@samp{23} +@samp{23b} @item newline -@samp{>b} +@samp{>} @end table This defines four comment-delimiting sequences: @table @asis @item @samp{/*} -This is a comment-start sequence for ``a'' style because the -second character, @samp{*}, does not have the @samp{b} flag. +This is a comment-start sequence for ``b'' style because the +second character, @samp{*}, has the @samp{b} flag. @item @samp{//} -This is a comment-start sequence for ``b'' style because the second -character, @samp{/}, does have the @samp{b} flag. +This is a comment-start sequence for ``a'' style because the second +character, @samp{/}, does not have the @samp{b} flag. @item @samp{*/} -This is a comment-end sequence for ``a'' style because the first -character, @samp{*}, does not have the @samp{b} flag. +This is a comment-end sequence for ``b'' style because the first +character, @samp{*}, does have the @samp{b} flag. @item newline -This is a comment-end sequence for ``b'' style, because the newline -character has the @samp{b} flag. +This is a comment-end sequence for ``a'' style, because the newline +character does not have the @samp{b} flag. @end table @item -@samp{n} on a comment delimiter character specifies -that this kind of comment can be nested. For a two-character -comment delimiter, @samp{n} on either character makes it -nestable. - -@item @c Emacs 19 feature @samp{p} identifies an additional ``prefix character'' for Lisp syntax. These characters are treated as whitespace when they appear between diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index a7c4a3e62f4..ff4e65d299f 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -59,6 +59,7 @@ the character after point. position stored in a register. * Base 64:: Conversion to or from base 64 encoding. * MD5 Checksum:: Compute the MD5 "message digest"/"checksum". +* Parsing HTML:: Parsing HTML and XML. * Atomic Changes:: Installing several buffer changes "atomically". * Change Hooks:: Supplying functions to be run when text is changed. @end menu @@ -1126,16 +1127,13 @@ use @code{string=} to compare it with the last text Emacs provided.) @defvar interprogram-cut-function This variable provides a way of communicating killed text to other programs, when you are using a window system. Its value should be -@code{nil} or a function of one required and one optional argument. +@code{nil} or a function of one required argument. If the value is a function, @code{kill-new} and @code{kill-append} call -it with the new first element of the kill ring as the first argument. -The second, optional, argument has the same meaning as the @var{push} -argument to @code{x-set-cut-buffer} (@pxref{Definition of -x-set-cut-buffer}) and only affects the second and later cut buffers. +it with the new first element of the kill ring as the argument. The normal use of this function is to set the window system's primary -selection (and first cut buffer) from the newly killed text. +selection from the newly killed text. @xref{Window System Selections}. @end defvar @@ -4109,6 +4107,49 @@ using the specified or chosen coding system. However, if coding instead. @end defun +@node Parsing HTML +@section Parsing HTML +@cindex parsing html +@cindex parsing xml + +Emacs provides an interface to the @code{libxml2} library via two +functions: @code{html-parse-buffer} and @code{xml-parse-buffer}. The +HTML function will parse ``real world'' HTML and try to return a +sensible parse tree, while the XML function is somewhat stricter about +syntax. + +They both take a two optional parameter. The first is a buffer, and +the second is a base URL to be used to expand relative URLs in the +document, if any. + +Here's an example demonstrating the structure of the parsed data you +get out. Given this HTML document: + +@example +<html><hEad></head><body width=101><div class=thing>Foo<div>Yes +@end example + +You get this parse tree: + +@example +(html + (head) + (body + (:width . "101") + (div + (:class . "thing") + (text . "Foo") + (div + (text . "Yes\n"))))) +@end example + +It's a simple tree structure, where the @code{car} for each node is +the name of the node, and the @code{cdr} is the value, or the list of +values. + +Attributes are coded the same way as child nodes, but with @samp{:} as +the first character. + @node Atomic Changes @section Atomic Change Groups @cindex atomic changes diff --git a/doc/lispref/tips.texi b/doc/lispref/tips.texi index de281b0e147..bf3afcf53ee 100644 --- a/doc/lispref/tips.texi +++ b/doc/lispref/tips.texi @@ -1052,6 +1052,31 @@ Please use that command to see a list of the meaningful keywords. This field is important; it's how people will find your package when they're looking for things by topic area. To separate the keywords, you can use spaces, commas, or both. + +@item Package-Version +If @samp{Version} is not suitable for use by the package manager, then +a package can define @samp{Package-Version}; it will be used instead. +This is handy if @samp{Version} is an RCS id or something else that +cannot be parsed by @code{version-to-list}. @xref{Packaging Basics}. + +@item Package-Requires +If this exists, it names packages on which the current package depends +for proper operation. @xref{Packaging Basics}. This is used by the +package manager both at download time (to ensure that a complete set +of packages is downloaded) and at activation time (to ensure that a +package is activated if and only if all its dependencies have been). + +Its format is a list of lists. The @code{car} of each sub-list is the +name of a package, as a symbol. The @code{cadr} of each sub-list is +the minimum acceptable version number, as a string. For instance: + +@smallexample +;; Package-Requires: ((gnus "1.0") (bubbles "2.7.2")) +@end smallexample + +The package code automatically defines a package named @samp{emacs} +with the version number of the currently running Emacs. This can be +used to require a minimal version of Emacs for a package. @end table Just about every Lisp library ought to have the @samp{Author} and diff --git a/doc/lispref/vol1.texi b/doc/lispref/vol1.texi index 4c0ae27c043..cbc26ebcec6 100644 --- a/doc/lispref/vol1.texi +++ b/doc/lispref/vol1.texi @@ -180,6 +180,8 @@ Reference Manual, corresponding to GNU Emacs version @value{EMACSVER}. * System Interface:: Getting the user id, system type, environment variables, and other such things. +* Packaging:: Preparing Lisp code for distribution. + Appendices * Antinews:: Info for users downgrading to Emacs 22. @@ -1415,6 +1417,12 @@ Operating System Interface * Session Management:: Saving and restoring state with X Session Management. +Preparing Lisp code for distribution + +* Packaging Basics:: The basic concepts of Emacs Lisp packages. +* Simple Packages:: How to package a single .el file. +* Multi-file Packages:: How to package multiple files. + Starting Up Emacs * Startup Summary:: Sequence of actions Emacs performs at startup. diff --git a/doc/lispref/vol2.texi b/doc/lispref/vol2.texi index 195b89ce3f6..44052e5bd5d 100644 --- a/doc/lispref/vol2.texi +++ b/doc/lispref/vol2.texi @@ -179,6 +179,8 @@ Reference Manual, corresponding to GNU Emacs version @value{EMACSVER}. * System Interface:: Getting the user id, system type, environment variables, and other such things. +* Packaging:: Preparing Lisp code for distribution. + Appendices * Antinews:: Info for users downgrading to Emacs 22. @@ -1414,6 +1416,12 @@ Operating System Interface * Session Management:: Saving and restoring state with X Session Management. +Preparing Lisp code for distribution + +* Packaging Basics:: The basic concepts of Emacs Lisp packages. +* Simple Packages:: How to package a single .el file. +* Multi-file Packages:: How to package multiple files. + Starting Up Emacs * Startup Summary:: Sequence of actions Emacs performs at startup. diff --git a/doc/man/ChangeLog b/doc/man/ChangeLog index 2b2cbb90a9e..47f059e7d3c 100644 --- a/doc/man/ChangeLog +++ b/doc/man/ChangeLog @@ -1,3 +1,7 @@ +2010-08-26 Sven Joachim <svenjoac@gmx.de> + + * emacs.1: Mention "maximized" value for the "fullscreen" X resource. + 2010-05-07 Chong Yidong <cyd@stupidchicken.com> * Version 23.2 released. diff --git a/doc/man/emacs.1 b/doc/man/emacs.1 index 15b7a73259b..2ad9e2c543a 100644 --- a/doc/man/emacs.1 +++ b/doc/man/emacs.1 @@ -403,11 +403,12 @@ sets the window's text color. The desired fullscreen size. The value can be one of .IR fullboth , +.IR maximized , .IR fullwidth , or .IR fullheight , -which correspond to the command-line options `\-fs', `\-fw', and -`\-fh', respectively. +which correspond to the command-line options `\-fs', `-mm', `\-fw', +and `\-fh', respectively. Note that this applies to the initial frame only. .TP .BR geometry " (class " Geometry ) diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 67de15fd2f8..29cf98e3330 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,84 @@ +2010-09-09 Michael Albinus <michael.albinus@gmx.de> + + * tramp.texi: Remove Japanese manual. Fix typo. + + * trampver.texi: Update release number. Remove japanesemanual. + +2010-09-09 Glenn Morris <rgm@gnu.org> + + * org.texi: Restore clobbered changes (copyright years, untabify). + +2010-09-04 Julien Danjou <julien@danjou.info> (tiny change) + + * gnus.texi (Adaptive Scoring): Fix typo. + +2010-09-03 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Article Display): Document gnus-html-show-images. + +2010-09-02 Jan Djärv <jan.h.d@swipnet.se> + + * cl.texi (Basic Setf): Remove x-get-cut-buffer and x-get-cutbuffer. + +2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (HTML): Document gnus-max-image-proportion. + +2010-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (HTML): Document gnus-blocked-images. + + * message.texi (Wide Reply): Document message-prune-recipient-rules. + +2010-08-30 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Summary Mail Commands): Note that only the addresses from + the first message are used for wide replies. + (Changing Servers): Remove documentation on gnus-change-server and + friends, since it's been removed. + +2010-08-29 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Drafts): Mention B DEL. + +2010-08-29 Tim Landscheidt <tim@tim-landscheidt.de> (tiny change) + + * gnus.texi (Delayed Articles): Mention that the Date header is the + original one, even if you delay. + +2010-08-29 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Asynchronous Fetching): Document + gnus-async-post-fetch-function. + (HTML): Made into its own section. + +2010-08-26 Michael Albinus <michael.albinus@gmx.de> + + Sync with Tramp 2.1.19. + + * tramp.texi (Inline methods, Default Method): Mention + `tramp-inline-compress-start-size'. Remove "kludgy" phrase. Remove + remark about doubled "-t" argument. + (Auto-save and Backup): Remove reference to Emacs 21. + (Filename Syntax): Describe port numbers. + (Frequently Asked Questions): Adapt supported (X)Emacs versions. Adapt + supported MS Windows versions. Remove obsolete URL. Recommend "sshx" + and "scpx" for echoing shells. Use the $() syntax, texi2dvi reports + errors with the backquotes. + (External packages): File attributes cache flushing for asynchronous + processes. + (Traces and Profiles): Describe verbose level 9. + + * trampver.texi: Update release number. + +2010-08-23 Michael Albinus <michael.albinus@gmx.de> + + * dbus.texi (Alternative Buses): New chapter. + +2010-08-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * cl.texi (Mapping over Sequences): Rename mapc => cl-mapc. + 2010-08-09 Jay Belanger <jay.p.belanger@gmail.com> * calc.texi (Customizing Calc): Rearrange description of new diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 85e691d4b62..ed04d98ef92 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -286,7 +286,3 @@ users' netrc files. @bye @c End: - -@ignore - arch-tag: 7b835fd3-473f-40fc-9776-1c4e49d26c94 -@end ignore diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index 755b2f3f1b7..de57ff7d095 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -1043,10 +1043,10 @@ frame-visible-p window-hscroll frame-width window-point get-register window-start getenv window-width -global-key-binding x-get-cut-buffer -keymap-parent x-get-cutbuffer -local-key-binding x-get-secondary-selection -mark x-get-selection +global-key-binding x-get-secondary-selection +keymap-parent x-get-selection +local-key-binding +mark mark-marker @end smallexample @@ -3763,10 +3763,10 @@ that it passes in the list pointers themselves rather than the @code{car}s of the advancing pointers. @end defun -@defun mapc function seq &rest more-seqs +@defun cl-mapc function seq &rest more-seqs This function is like @code{mapcar*}, except that the values returned by @var{function} are ignored and thrown away rather than being -collected into a list. The return value of @code{mapc} is @var{seq}, +collected into a list. The return value of @code{cl-mapc} is @var{seq}, the first sequence. This function is more general than the Emacs primitive @code{mapc}. @end defun diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index 248884532df..f4f96d55391 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -53,6 +53,7 @@ another. An overview of D-Bus can be found at * Asynchronous Methods:: Calling methods non-blocking. * Receiving Method Calls:: Offering own methods. * Signals:: Sending and receiving signals. +* Alternative Buses:: Alternative buses. * Errors and Events:: Errors and events. * Index:: Index including concepts, functions, variables. @@ -1579,6 +1580,56 @@ which objects the GNU/Linux @code{hal} daemon adds. @end defun +@node Alternative Buses +@chapter Alternative buses. +@cindex bus names +@cindex UNIX domain socket + +Until now, we have spoken about the system and the session buses, +which are the default buses to be connected to. However, it is +possible to connect to any bus, from which the address is known. This +is a UNIX domain socket. Everywhere, where a @var{bus} is mentioned +as argument of a function (the symbol @code{:system} or the symbol +@code{:session}), this address can be used instead. The connection to +this bus must be initialized first. + +@defun dbus-init-bus bus +Establish the connection to D-Bus @var{bus}. + +@var{bus} can be either the symbol @code{:system} or the symbol +@code{:session}, or it can be a string denoting the address of the +corresponding bus. For the system and session busses, this function +is called when loading @file{dbus.el}, there is no need to call it +again. + +Example: You open another session bus in a terminal window on your host: + +@example +# eval `dbus-launch --auto-syntax` +# echo $DBUS_SESSION_BUS_ADDRESS + +@print{} unix:abstract=/tmp/dbus-JoFtAVG92w,guid=2f320a1ebe50b7ef58e +@end example + +In Emacs, you can access to this bus via its address: + +@lisp +(setq my-bus + "unix:abstract=/tmp/dbus-JoFtAVG92w,guid=2f320a1ebe50b7ef58e") + +@result{} "unix:abstract=/tmp/dbus-JoFtAVG92w,guid=2f320a1ebe50b7ef58e" + +(dbus-init-bus my-bus) + +@result{} nil + +(dbus-get-unique-name my-bus) + +@result{} ":1.0" +@end lisp +@end defun + + @node Errors and Events @chapter Errors and events. @cindex debugging diff --git a/doc/misc/doclicense.texi b/doc/misc/doclicense.texi index d3ae2f92b20..a511ffcd5a8 100644 --- a/doc/misc/doclicense.texi +++ b/doc/misc/doclicense.texi @@ -505,7 +505,3 @@ to permit their use in free software. @c Local Variables: @c ispell-local-pdict: "ispell-dict" @c End: - -@ignore - arch-tag: c1679162-1d8a-4f02-bc52-2e71765f0165 -@end ignore diff --git a/doc/misc/ediff.texi b/doc/misc/ediff.texi index 4259fccb390..451d6d0a5ff 100644 --- a/doc/misc/ediff.texi +++ b/doc/misc/ediff.texi @@ -1986,8 +1986,7 @@ If it is @code{combined} then the region in buffer C will look like this: @comment Use @set to avoid triggering merge conflict detectors like CVS. -@set seven-left <<<<<<< -@set seven-right >>>>>>> +@set seven-left @example @value{seven-left} variant A the difference region from buffer A diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi index 713a55c7cc7..3e996e945fb 100644 --- a/doc/misc/emacs-mime.texi +++ b/doc/misc/emacs-mime.texi @@ -394,7 +394,7 @@ variable will cause @samp{text/html} parts to be treated as attachments. @item mm-text-html-renderer @vindex mm-text-html-renderer This selects the function used to render @acronym{HTML}. The predefined -renderers are selected by the symbols @code{w3}, +renderers are selected by the symbols @code{gnus-article-html}, @code{w3}, @code{w3m}@footnote{See @uref{http://emacs-w3m.namazu.org/} for more information about emacs-w3m}, @code{links}, @code{lynx}, @code{w3m-standalone} or @code{html2text}. If @code{nil} use an @@ -1889,7 +1889,3 @@ Documentation of the text/plain format parameter for flowed text. @c mode: texinfo @c coding: iso-8859-1 @c End: - -@ignore - arch-tag: c7ef2fd0-a91c-4e10-aa52-c1a2b11b1a8d -@end ignore diff --git a/doc/misc/gnus-coding.texi b/doc/misc/gnus-coding.texi index fd637ece6a8..22b74c900b0 100644 --- a/doc/misc/gnus-coding.texi +++ b/doc/misc/gnus-coding.texi @@ -387,7 +387,3 @@ changed. @c mode: texinfo @c coding: iso-8859-1 @c End: - -@ignore - arch-tag: ab15234c-2c8a-4cbd-8111-1811bcc6f931 -@end ignore diff --git a/doc/misc/gnus-faq.texi b/doc/misc/gnus-faq.texi index 78a22740e32..ed74092eb0a 100644 --- a/doc/misc/gnus-faq.texi +++ b/doc/misc/gnus-faq.texi @@ -2331,7 +2331,3 @@ NUA is an acronym for News User Agent, it's the program you use to read and write Usenet news. @end table - -@ignore -arch-tag: 64dc5692-edb4-4848-a965-7aa0181acbb8 -@end ignore diff --git a/doc/misc/gnus-news.el b/doc/misc/gnus-news.el index 49a170800ac..e31cca9f37f 100644 --- a/doc/misc/gnus-news.el +++ b/doc/misc/gnus-news.el @@ -113,5 +113,4 @@ paragraph-separate: \"[ ]*$\"\nend:\n") (insert gnus-news-trailer) (write-region (point-min) (point-max) outfile)))) -;; arch-tag: e23cdd27-eafd-4ba0-816f-98f5edb0dc29 ;;; gnus-news.el ends here diff --git a/doc/misc/gnus-news.texi b/doc/misc/gnus-news.texi index 29246313c84..e820ceae4a8 100644 --- a/doc/misc/gnus-news.texi +++ b/doc/misc/gnus-news.texi @@ -325,7 +325,3 @@ moving articles to a group that has not turned auto-expire on. @end itemize @c gnus-news.texi ends here. - -@ignore - arch-tag: 872c7569-4340-4d73-9d1d-7826d9f94a51 -@end ignore diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index c3a7058289d..7248897f05b 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -632,7 +632,7 @@ Select Methods * Getting Mail:: Reading your personal mail with Gnus. * Browsing the Web:: Getting messages from a plethora of Web sources. * IMAP:: Using Gnus as a @acronym{IMAP} client. -* Other Sources:: Reading directories, files, SOUP packets. +* Other Sources:: Reading directories, files. * Combined Groups:: Combining groups into one group. * Email Based Diary:: Using mails to manage diary events in Gnus. * Gnus Unplugged:: Reading news and mail offline. @@ -695,9 +695,6 @@ Browsing the Web * Archiving Mail:: * Web Searches:: Creating groups from articles that match a string. -* Slashdot:: Reading the Slashdot comments. -* Ultimate:: The Ultimate Bulletin Board systems. -* Web Archive:: Reading mailing list archived on web. * RSS:: Reading RDF site summary. * Customizing W3:: Doing stuff to Emacs/W3 from Gnus. @@ -715,23 +712,15 @@ Other Sources * 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''. * Mail-To-News Gateways:: Posting articles via mail-to-news gateways. Document Groups * Document Server Internals:: How to add your own document types. -SOUP - -* SOUP Commands:: Commands for creating and sending @sc{soup} packets -* SOUP Groups:: A back end for reading @sc{soup} packets. -* SOUP Replies:: How to enable @code{nnsoup} to take over mail and news. - Combined Groups * Virtual Groups:: Combining articles from many groups. -* Kibozed Groups:: Looking through parts of the newsfeed for articles. Email Based Diary @@ -1295,7 +1284,7 @@ parameter (@pxref{Topic Parameters}). For instance, a @code{subscribe} topic parameter that looks like @example -"nnslashdot" +"nnml" @end example will mean that all groups that match that regex will be subscribed under @@ -1385,31 +1374,11 @@ 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. +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. @kindex M-x gnus-group-clear-data @findex gnus-group-clear-data @@ -2654,15 +2623,6 @@ 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 @@ -4450,8 +4410,7 @@ which point to the ``real'' message files (if mbox is used, copies are made). Since mairix already presents search results in such a virtual mail folder, it is very well suited for using it as an external program for creating @emph{smart} mail folders, which represent certain mail -searches. This is similar to a Kiboze group (@pxref{Kibozed Groups}), -but much faster. +searches. @node nnmairix requirements @subsubsection nnmairix requirements @@ -6043,6 +6002,11 @@ threads. This variable can also be a number. In that case, center the window at the given number of lines from the top. +@item gnus-summary-stop-at-end-of-message +@vindex gnus-summary-stop-at-end-of-message +If non-@code{nil}, don't go to the next article when hitting +@kbd{SPC}, and you're at the end of the article. + @end table @@ -6350,7 +6314,8 @@ present, that's used instead. @findex gnus-summary-wide-reply-with-original Mail a wide reply to the current article and include the original message (@code{gnus-summary-wide-reply-with-original}). This command uses -the process/prefix convention. +the process/prefix convention, but only uses the headers from the +first article to determine the recipients. @item S v @kindex S v (Summary) @@ -6414,8 +6379,6 @@ the posting style of the current group. If given a prefix, disable that. If the prefix is 1, prompt for a group name to find the posting style. @item S i -@itemx i -@kindex i (Summary) @kindex S i (Summary) @findex gnus-summary-news-other-window Prepare a news (@code{gnus-summary-news-other-window}). By default, @@ -6753,6 +6716,12 @@ Presumably, you want to use the demon for sending due delayed articles. Just don't forget to set that up :-) @end table +When delaying an article with @kbd{C-c C-j}, Message mode will +automatically add a @code{"Date"} header with the current time. In +many cases you probably want the @code{"Date"} header to reflect the +time the message is sent instead. To do this, you have to delete +@code{Date} from @code{message-draft-headers}. + @node Marking Articles @section Marking Articles @@ -6861,10 +6830,6 @@ Marked as read by a catchup (@code{gnus-catchup-mark}). @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 @@ -7835,7 +7800,7 @@ This is a rather obscure variable that few will find useful. It's intended for those non-news newsgroups where the back end has to fetch quite a lot to present the summary buffer, and where it's impossible to go back to parents of articles. This is mostly the case in the -web-based groups, like the @code{nnultimate} groups. +web-based groups. If you don't use those, then it's safe to leave this as the default @code{nil}. If you want to use this variable, it should be a regexp @@ -8271,6 +8236,16 @@ 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-async-post-fetch-function +@findex gnus-html-prefetch-images +After an article has been prefetched, this +@code{gnus-async-post-fetch-function} will be called. The buffer will +be narrowed to the region of the article that was fetched. A useful +value would be @code{gnus-html-prefetch-images}, which will prefetch +and store images referenced in the article, so that you don't have to +wait for them to be fetched when you read the article. This is useful +for @acronym{HTML} messages that have external images. + @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 @@ -10376,6 +10351,14 @@ Piconify all news headers (i. e., @code{Newsgroups} and Remove all images from the article buffer (@code{gnus-article-remove-images}). +@item W D W +@kindex W D W (Summary) +@findex gnus-html-show-images +If you're reading an @acronym{HTML} article rendered with +@code{gnus-article-html}, then you can insert any blocked images in +the buffer with this command. +(@code{gnus-html-show-images}). + @end table @@ -12186,6 +12169,7 @@ tell Gnus otherwise. @menu * Hiding Headers:: Deciding what headers should be displayed. * Using MIME:: Pushing articles through @acronym{MIME} before reading them. +* HTML:: Reading @acronym{HTML} messages. * Customizing Articles:: Tailoring the look of the articles. * Article Keymap:: Keystrokes available in the article buffer. * Misc Article:: Other stuff. @@ -12482,6 +12466,68 @@ Any similarity to real events and people is purely coincidental. Ahem. Also @pxref{MIME Commands}. +@node HTML +@section @acronym{HTML} +@cindex @acronym{HTML} + +If you have @code{w3m} installed on your system, Gnus can display +@acronym{HTML} articles in the article buffer. There are many Gnus +add-ons for doing this, using various approaches, but there's one +(sort of) built-in method that's used by default. + +For a complete overview, consult @xref{Display Customization, +,Display Customization, emacs-mime, The Emacs MIME Manual}. This +section only describes the default method. + +@table @code +@item mm-text-html-renderer +@vindex mm-text-html-renderer +If set to @code{gnus-article-html}, Gnus will use the built-in method, +that's based on @code{curl} and @code{w3m}. + +@item gnus-blocked-images +@vindex gnus-blocked-images +Images that have @acronym{URL}s that match this regexp won't be +fetched and displayed. For instance, do block all @acronym{URL}s that +have the string ``ads'' in them, do the following: + +@lisp +(setq gnus-blocked-images "ads") +@end lisp + +The default is to block all external images. + +@item gnus-html-cache-directory +@vindex gnus-html-cache-directory +Gnus will download and cache images according to how +@code{gnus-blocked-images} is set. These images will be stored in +this directory. + +@item gnus-html-cache-size +@vindex gnus-html-cache-size +When @code{gnus-html-cache-size} bytes have been used in that +directory, the oldest files will be deleted. The default is 500MB. + +@item gnus-html-frame-width +@vindex gnus-html-frame-width +The width to use when rendering HTML. The default is 70. + +@item gnus-max-image-proportion +@vindex gnus-max-image-proportion +How big pictures displayed are in relation to the window they're in. +A value of 0.7 (the default) means that they are allowed to take up +70% of the width and height of the window. If they are larger than +this, and Emacs supports it, then the images will be rescaled down to +fit these criteria. + +@end table + +To use this, make sure that you have @code{w3m} and @code{curl} +installed. If you have, then Gnus should display @acronym{HTML} +automatically. + + + @node Customizing Articles @section Customizing Articles @cindex article customization @@ -13559,6 +13605,9 @@ If you have some messages that you wish not to send, you can use the @kbd{D t} (@code{gnus-draft-toggle-sending}) command to mark the message as unsendable. This is a toggling command. +Finally, if you want to delete a draft, use the normal @kbd{B DEL} +command (@pxref{Mail Group Commands}). + @node Rejected Articles @section Rejected Articles @@ -13689,7 +13738,7 @@ The different methods all have their peculiarities, of course. * Getting Mail:: Reading your personal mail with Gnus. * Browsing the Web:: Getting messages from a plethora of Web sources. * IMAP:: Using Gnus as a @acronym{IMAP} client. -* Other Sources:: Reading directories, files, SOUP packets. +* Other Sources:: Reading directories, files. * Combined Groups:: Combining groups into one group. * Email Based Diary:: Using mails to manage diary events in Gnus. * Gnus Unplugged:: Reading news and mail offline. @@ -17350,9 +17399,6 @@ interfaces to these sources. @menu * Archiving Mail:: * Web Searches:: Creating groups from articles that match a string. -* Slashdot:: Reading the Slashdot comments. -* Ultimate:: The Ultimate Bulletin Board systems. -* Web Archive:: Reading mailing list archived on web. * RSS:: Reading RDF site summary. * Customizing W3:: Doing stuff to Emacs/W3 from Gnus. @end menu @@ -17495,159 +17541,6 @@ Format string URL to fetch an article by @code{Message-ID}. @end table -@node Slashdot -@subsection Slashdot -@cindex Slashdot -@cindex nnslashdot - -@uref{http://slashdot.org/, Slashdot} is a popular news site, with -lively discussion following the news articles. @code{nnslashdot} will -let you read this forum in a convenient manner. - -The easiest way to read this source is to put something like the -following in your @file{~/.gnus.el} file: - -@lisp -(setq gnus-secondary-select-methods - '((nnslashdot ""))) -@end lisp - -This will make Gnus query the @code{nnslashdot} back end for new comments -and groups. The @kbd{F} command will subscribe each new news article as -a new Gnus group, and you can read the comments by entering these -groups. (Note that the default subscription method is to subscribe new -groups as zombies. Other methods are available (@pxref{Subscription -Methods}). - -If you want to remove an old @code{nnslashdot} group, the @kbd{G DEL} -command is the most handy tool (@pxref{Foreign Groups}). - -When following up to @code{nnslashdot} comments (or posting new -comments), some light @acronym{HTML}izations will be performed. In -particular, text quoted with @samp{> } will be quoted with -@samp{blockquote} instead, and signatures will have @samp{br} added to -the end of each line. Other than that, you can just write @acronym{HTML} -directly into the message buffer. Note that Slashdot filters out some -@acronym{HTML} forms. - -The following variables can be altered to change its behavior: - -@table @code -@item nnslashdot-threaded -Whether @code{nnslashdot} should display threaded groups or not. The -default is @code{t}. To be able to display threads, @code{nnslashdot} -has to retrieve absolutely all comments in a group upon entry. If a -threaded display is not required, @code{nnslashdot} will only retrieve -the comments that are actually wanted by the user. Threading is nicer, -but much, much slower than unthreaded. - -@item nnslashdot-login-name -@vindex nnslashdot-login-name -The login name to use when posting. - -@item nnslashdot-password -@vindex nnslashdot-password -The password to use when posting. - -@item nnslashdot-directory -@vindex nnslashdot-directory -Where @code{nnslashdot} will store its files. The default is -@file{~/News/slashdot/}. - -@item nnslashdot-active-url -@vindex nnslashdot-active-url -The @acronym{URL} format string that will be used to fetch the -information on news articles and comments. The default is@* -@samp{http://slashdot.org/search.pl?section=&min=%d}. - -@item nnslashdot-comments-url -@vindex nnslashdot-comments-url -The @acronym{URL} format string that will be used to fetch comments. - -@item nnslashdot-article-url -@vindex nnslashdot-article-url -The @acronym{URL} format string that will be used to fetch the news -article. The default is -@samp{http://slashdot.org/article.pl?sid=%s&mode=nocomment}. - -@item nnslashdot-threshold -@vindex nnslashdot-threshold -The score threshold. The default is -1. - -@item nnslashdot-group-number -@vindex nnslashdot-group-number -The number of old groups, in addition to the ten latest, to keep -updated. The default is 0. - -@end table - - - -@node Ultimate -@subsection Ultimate -@cindex nnultimate -@cindex Ultimate Bulletin Board - -@uref{http://www.ultimatebb.com/, The Ultimate Bulletin Board} is -probably the most popular Web bulletin board system used. It has a -quite regular and nice interface, and it's possible to get the -information Gnus needs to keep groups updated. - -The easiest way to get started with @code{nnultimate} is to say -something like the following in the group buffer: @kbd{B nnultimate RET -http://www.tcj.com/messboard/ubbcgi/ RET}. (Substitute the @acronym{URL} -(not including @samp{Ultimate.cgi} or the like at the end) for a forum -you're interested in; there's quite a list of them on the Ultimate web -site.) Then subscribe to the groups you're interested in from the -server buffer, and read them from the group buffer. - -The following @code{nnultimate} variables can be altered: - -@table @code -@item nnultimate-directory -@vindex nnultimate-directory -The directory where @code{nnultimate} stores its files. The default is@* -@file{~/News/ultimate/}. -@end table - - -@node Web Archive -@subsection Web Archive -@cindex nnwarchive -@cindex Web Archive - -Some mailing lists only have archives on Web servers, such as -@uref{http://www.egroups.com/} and -@uref{http://www.mail-archive.com/}. It has a quite regular and nice -interface, and it's possible to get the information Gnus needs to keep -groups updated. - -@findex gnus-group-make-warchive-group -The easiest way to get started with @code{nnwarchive} is to say -something like the following in the group buffer: @kbd{M-x -gnus-group-make-warchive-group RET @var{an_egroup} RET egroups RET -www.egroups.com RET @var{your@@email.address} RET}. (Substitute the -@var{an_egroup} with the mailing list you subscribed, the -@var{your@@email.address} with your email address.), or to browse the -back end by @kbd{B nnwarchive RET mail-archive RET}. - -The following @code{nnwarchive} variables can be altered: - -@table @code -@item nnwarchive-directory -@vindex nnwarchive-directory -The directory where @code{nnwarchive} stores its files. The default is@* -@file{~/News/warchive/}. - -@item nnwarchive-login -@vindex nnwarchive-login -The account name on the web server. - -@item nnwarchive-passwd -@vindex nnwarchive-passwd -The password for your account on the web server. -@end table - @node RSS @subsection RSS @cindex nnrss @@ -18584,7 +18477,6 @@ newsgroups. * 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''. * Mail-To-News Gateways:: Posting articles via mail-to-news gateways. @end menu @@ -18952,289 +18844,6 @@ correct type. A high number means high probability; a low number means low probability with @samp{0} being the lowest valid 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 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} back end 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 back end 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 SOUP Groups -@cindex nnsoup - -@code{nnsoup} is the back end 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}. - -@item nnsoup-always-save -@vindex nnsoup-always-save -If non-@code{nil}, save the replies buffer after each posted message. - -@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 Mail-To-News Gateways @subsection Mail-To-News Gateways @cindex mail-to-news gateways @@ -19321,7 +18930,6 @@ groups. @menu * Virtual Groups:: Combining articles from many groups. -* Kibozed Groups:: Looking through parts of the newsfeed for articles. @end menu @@ -19411,58 +19019,6 @@ from component groups---group parameters, for instance, are not inherited. -@node Kibozed Groups -@subsection Kibozed Groups -@cindex nnkiboze -@cindex kibozing - -@dfn{Kibozing} is defined by the @acronym{OED} as ``grepping through -(parts of) the news feed''. @code{nnkiboze} is a back end that will -do this for you. Oh joy! Now you can grind any @acronym{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 -@acronym{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/kiboze/} by default. -One contains the @acronym{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 @acronym{NOV} lines removed from the @acronym{NOV} file. - - @node Email Based Diary @section Email Based Diary @cindex diary @@ -22018,7 +21574,7 @@ is @file{ADAPT}. @vindex gnus-adaptive-pretty-print Adaptive score files can get huge and are not meant to be edited by human hands. If @code{gnus-adaptive-pretty-print} is @code{nil} (the -deafult) those files will not be written in a human readable way. +default) those files will not be written in a human readable way. @vindex gnus-score-exact-adapt-limit When doing adaptive scoring, substring or fuzzy matching would probably @@ -27811,10 +27367,6 @@ 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}). @@ -27959,8 +27511,7 @@ news batches, ClariNet briefs collections, and just about everything else (@pxref{Document Groups}). @item -Gnus has a new back end (@code{nnsoup}) to create/read SOUP packets -(@pxref{SOUP}). +Gnus has a new back end (@code{nnsoup}) to create/read SOUP packets. @item The Gnus cache is much faster. @@ -29521,11 +29072,9 @@ Gnus not to use @acronym{NOV}. As the variables for the other back ends, there are @code{nndiary-nov-is-evil}, @code{nndir-nov-is-evil}, @code{nnfolder-nov-is-evil}, @code{nnimap-nov-is-evil}, -@code{nnml-nov-is-evil}, @code{nnspool-nov-is-evil}, and -@code{nnwarchive-nov-is-evil}. Note that a non-@code{nil} value for -@code{gnus-nov-is-evil} overrides all those variables.@footnote{Although -the back ends @code{nnkiboze}, @code{nnslashdot}, @code{nnultimate}, and -@code{nnwfm} don't have their own nn*-nov-is-evil.} +@code{nnml-nov-is-evil}, and @code{nnspool-nov-is-evil}. Note that a +non-@code{nil} value for @code{gnus-nov-is-evil} overrides all those +variables. @end table @@ -31356,7 +30905,3 @@ former). The manual is unambiguous, but it can be confusing. @c mode: texinfo @c coding: iso-8859-1 @c End: - -@ignore - arch-tag: c9fa47e7-78ca-4681-bda9-9fef45d1c819 -@end ignore diff --git a/doc/misc/message.texi b/doc/misc/message.texi index 283d29c0de4..6b922476596 100644 --- a/doc/misc/message.texi +++ b/doc/misc/message.texi @@ -182,6 +182,37 @@ Addresses that match the @code{message-dont-reply-to-names} regular expression (or list of regular expressions) will be removed from the @code{Cc} header. A value of @code{nil} means exclude your name only. +@vindex message-prune-recipient-rules +@code{message-prune-recipient-rules} is used to prune the addresses +used when doing a wide reply. It's meant to be used to remove +duplicate addresses and the like. It's a list of lists, where the +first element is a regexp to match the address to trigger the rule, +and the second is a regexp that will be expanded based on the first, +to match addresses to be pruned. + +It's complicated to explain, but it's easy to use. + +For instance, if you get an email from @samp{foo@@example.org}, but +@samp{foo@@zot.example.org} is also in the @code{Cc} list, then your +wide reply will go out to both these addresses, since they are unique. + +To avoid this, do something like the following: + +@lisp +(setq message-prune-recipient-rules + '(("^\\([^@@]+\\)@@\\(.*\\)" "\\1@@.*[.]\\2"))) +@end lisp + +If, for instance, you want all wide replies that involve messages from +@samp{cvs@@example.org} to go to that address, and nowhere else (i.e., +remove all other recipients if @samp{cvs@@example.org} is in the +recipient list: + +@lisp +(setq message-prune-recipient-rules + '(("cvs@@example.org" "."))) +@end lisp + @vindex message-wide-reply-confirm-recipients If @code{message-wide-reply-confirm-recipients} is non-@code{nil} you will be asked to confirm that you want to reply to multiple @@ -1645,7 +1676,8 @@ the problem will actually occur. @cindex split large message The limitation of messages sent as message/partial. The lower bound of message size in characters, beyond which the message should be sent -in several parts. If it is @code{nil}, the size is unlimited. +in several parts. If it is @code{nil} (which is the default), the +size is unlimited. @end table @@ -2441,7 +2473,3 @@ basis of the new @code{Cc} header, except if this header is @bye @c End: - -@ignore - arch-tag: 16ab76af-a281-4e34-aed6-5624569f7601 -@end ignore diff --git a/doc/misc/org.texi b/doc/misc/org.texi index 9074f171e4b..97b8d3ebc03 100644 --- a/doc/misc/org.texi +++ b/doc/misc/org.texi @@ -51,7 +51,8 @@ e.g., @copying This manual is for Org version @value{VERSION}. -Copyright @copyright{} 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation +Copyright @copyright{} 2004, 2005, 2006, 2007, 2008, 2009, 2010 +Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -101,400 +102,400 @@ with contributions by David O'Toole, Bastien Guerry, Philip Rooke, Dan Davison, @end ifnottex @menu -* Introduction:: Getting started -* Document Structure:: A tree works like your brain -* Tables:: Pure magic for quick formatting -* Hyperlinks:: Notes in context -* TODO Items:: Every tree branch can be a TODO item -* Tags:: Tagging headlines and matching sets of tags -* Properties and Columns:: Storing information about an entry -* Dates and Times:: Making items useful for planning -* Capture - Refile - Archive:: The ins and outs for projects -* Agenda Views:: Collecting information into views -* Markup:: Prepare text for rich export -* Exporting:: Sharing and publishing of notes -* Publishing:: Create a web site of linked Org files -* Working With Source Code:: Export, evaluate, and tangle code blocks -* Miscellaneous:: All the rest which did not fit elsewhere -* Hacking:: How to hack your way around -* MobileOrg:: Viewing and capture on a mobile device -* History and Acknowledgments:: How Org came into being -* Main Index:: An index of Org's concepts and features -* Key Index:: Key bindings and where they are described -* Variable Index:: Variables mentioned in the manual +* Introduction:: Getting started +* Document Structure:: A tree works like your brain +* Tables:: Pure magic for quick formatting +* Hyperlinks:: Notes in context +* TODO Items:: Every tree branch can be a TODO item +* Tags:: Tagging headlines and matching sets of tags +* Properties and Columns:: Storing information about an entry +* Dates and Times:: Making items useful for planning +* Capture - Refile - Archive:: The ins and outs for projects +* Agenda Views:: Collecting information into views +* Markup:: Prepare text for rich export +* Exporting:: Sharing and publishing of notes +* Publishing:: Create a web site of linked Org files +* Working With Source Code:: Export, evaluate, and tangle code blocks +* Miscellaneous:: All the rest which did not fit elsewhere +* Hacking:: How to hack your way around +* MobileOrg:: Viewing and capture on a mobile device +* History and Acknowledgments:: How Org came into being +* Main Index:: An index of Org's concepts and features +* Key Index:: Key bindings and where they are described +* Variable Index:: Variables mentioned in the manual @detailmenu --- The Detailed Node Listing --- Introduction -* Summary:: Brief summary of what Org does -* Installation:: How to install a downloaded version of Org -* Activation:: How to activate Org for certain buffers -* Feedback:: Bug reports, ideas, patches etc. -* Conventions:: Type-setting conventions in the manual +* Summary:: Brief summary of what Org does +* Installation:: How to install a downloaded version of Org +* Activation:: How to activate Org for certain buffers +* Feedback:: Bug reports, ideas, patches etc. +* Conventions:: Type-setting conventions in the manual Document structure -* Outlines:: Org is based on Outline mode -* Headlines:: How to typeset Org tree headlines -* Visibility cycling:: Show and hide, much simplified -* Motion:: Jumping to other headlines -* Structure editing:: Changing sequence and level of headlines -* Sparse trees:: Matches embedded in context -* Plain lists:: Additional structure within an entry -* Drawers:: Tucking stuff away -* Blocks:: Folding blocks -* Footnotes:: How footnotes are defined in Org's syntax -* Orgstruct mode:: Structure editing outside Org +* Outlines:: Org is based on Outline mode +* Headlines:: How to typeset Org tree headlines +* Visibility cycling:: Show and hide, much simplified +* Motion:: Jumping to other headlines +* Structure editing:: Changing sequence and level of headlines +* Sparse trees:: Matches embedded in context +* Plain lists:: Additional structure within an entry +* Drawers:: Tucking stuff away +* Blocks:: Folding blocks +* Footnotes:: How footnotes are defined in Org's syntax +* Orgstruct mode:: Structure editing outside Org Tables -* Built-in table editor:: Simple tables -* Column width and alignment:: Overrule the automatic settings -* Column groups:: Grouping to trigger vertical lines -* Orgtbl mode:: The table editor as minor mode -* The spreadsheet:: The table editor has spreadsheet capabilities -* Org-Plot:: Plotting from org tables +* Built-in table editor:: Simple tables +* Column width and alignment:: Overrule the automatic settings +* Column groups:: Grouping to trigger vertical lines +* Orgtbl mode:: The table editor as minor mode +* The spreadsheet:: The table editor has spreadsheet capabilities +* Org-Plot:: Plotting from org tables The spreadsheet -* References:: How to refer to another field or range -* Formula syntax for Calc:: Using Calc to compute stuff -* Formula syntax for Lisp:: Writing formulas in Emacs Lisp -* Field formulas:: Formulas valid for a single field -* Column formulas:: Formulas valid for an entire column +* References:: How to refer to another field or range +* Formula syntax for Calc:: Using Calc to compute stuff +* Formula syntax for Lisp:: Writing formulas in Emacs Lisp +* Field formulas:: Formulas valid for a single field +* Column formulas:: Formulas valid for an entire column * Editing and debugging formulas:: Fixing formulas -* Updating the table:: Recomputing all dependent fields -* Advanced features:: Field names, parameters and automatic recalc +* Updating the table:: Recomputing all dependent fields +* Advanced features:: Field names, parameters and automatic recalc Hyperlinks -* Link format:: How links in Org are formatted -* Internal links:: Links to other places in the current file -* External links:: URL-like links to the world -* Handling links:: Creating, inserting and following -* Using links outside Org:: Linking from my C source code? -* Link abbreviations:: Shortcuts for writing complex links -* Search options:: Linking to a specific location -* Custom searches:: When the default search is not enough +* Link format:: How links in Org are formatted +* Internal links:: Links to other places in the current file +* External links:: URL-like links to the world +* Handling links:: Creating, inserting and following +* Using links outside Org:: Linking from my C source code? +* Link abbreviations:: Shortcuts for writing complex links +* Search options:: Linking to a specific location +* Custom searches:: When the default search is not enough Internal links -* Radio targets:: Make targets trigger links in plain text +* Radio targets:: Make targets trigger links in plain text TODO items -* TODO basics:: Marking and displaying TODO entries -* TODO extensions:: Workflow and assignments -* Progress logging:: Dates and notes for progress -* Priorities:: Some things are more important than others -* Breaking down tasks:: Splitting a task into manageable pieces -* Checkboxes:: Tick-off lists +* TODO basics:: Marking and displaying TODO entries +* TODO extensions:: Workflow and assignments +* Progress logging:: Dates and notes for progress +* Priorities:: Some things are more important than others +* Breaking down tasks:: Splitting a task into manageable pieces +* Checkboxes:: Tick-off lists Extended use of TODO keywords -* Workflow states:: From TODO to DONE in steps -* TODO types:: I do this, Fred does the rest -* Multiple sets in one file:: Mixing it all, and still finding your way -* Fast access to TODO states:: Single letter selection of a state -* Per-file keywords:: Different files, different requirements -* Faces for TODO keywords:: Highlighting states -* TODO dependencies:: When one task needs to wait for others +* Workflow states:: From TODO to DONE in steps +* TODO types:: I do this, Fred does the rest +* Multiple sets in one file:: Mixing it all, and still finding your way +* Fast access to TODO states:: Single letter selection of a state +* Per-file keywords:: Different files, different requirements +* Faces for TODO keywords:: Highlighting states +* TODO dependencies:: When one task needs to wait for others Progress logging -* Closing items:: When was this entry marked DONE? -* Tracking TODO state changes:: When did the status change? -* Tracking your habits:: How consistent have you been? +* Closing items:: When was this entry marked DONE? +* Tracking TODO state changes:: When did the status change? +* Tracking your habits:: How consistent have you been? Tags -* Tag inheritance:: Tags use the tree structure of the outline -* Setting tags:: How to assign tags to a headline -* Tag searches:: Searching for combinations of tags +* Tag inheritance:: Tags use the tree structure of the outline +* Setting tags:: How to assign tags to a headline +* Tag searches:: Searching for combinations of tags Properties and columns -* Property syntax:: How properties are spelled out -* Special properties:: Access to other Org-mode features -* Property searches:: Matching property values -* Property inheritance:: Passing values down the tree -* Column view:: Tabular viewing and editing -* Property API:: Properties for Lisp programmers +* Property syntax:: How properties are spelled out +* Special properties:: Access to other Org-mode features +* Property searches:: Matching property values +* Property inheritance:: Passing values down the tree +* Column view:: Tabular viewing and editing +* Property API:: Properties for Lisp programmers Column view -* Defining columns:: The COLUMNS format property -* Using column view:: How to create and use column view -* Capturing column view:: A dynamic block for column view +* Defining columns:: The COLUMNS format property +* Using column view:: How to create and use column view +* Capturing column view:: A dynamic block for column view Defining columns -* Scope of column definitions:: Where defined, where valid? -* Column attributes:: Appearance and content of a column +* Scope of column definitions:: Where defined, where valid? +* Column attributes:: Appearance and content of a column Dates and times -* Timestamps:: Assigning a time to a tree entry -* Creating timestamps:: Commands which insert timestamps -* Deadlines and scheduling:: Planning your work -* Clocking work time:: Tracking how long you spend on a task -* Resolving idle time:: Resolving time if you've been idle -* Effort estimates:: Planning work effort in advance -* Relative timer:: Notes with a running timer +* Timestamps:: Assigning a time to a tree entry +* Creating timestamps:: Commands which insert timestamps +* Deadlines and scheduling:: Planning your work +* Clocking work time:: Tracking how long you spend on a task +* Resolving idle time:: Resolving time if you've been idle +* Effort estimates:: Planning work effort in advance +* Relative timer:: Notes with a running timer Creating timestamps -* The date/time prompt:: How Org-mode helps you entering date and time -* Custom time format:: Making dates look different +* The date/time prompt:: How Org-mode helps you entering date and time +* Custom time format:: Making dates look different Deadlines and scheduling -* Inserting deadline/schedule:: Planning items -* Repeated tasks:: Items that show up again and again +* Inserting deadline/schedule:: Planning items +* Repeated tasks:: Items that show up again and again Capture - Refile - Archive -* Capture:: Capturing new stuff -* Attachments:: Add files to tasks -* RSS Feeds:: Getting input from RSS feeds -* Protocols:: External (e.g. Browser) access to Emacs and Org -* Refiling notes:: Moving a tree from one place to another -* Archiving:: What to do with finished projects +* Capture:: Capturing new stuff +* Attachments:: Add files to tasks +* RSS Feeds:: Getting input from RSS feeds +* Protocols:: External (e.g. Browser) access to Emacs and Org +* Refiling notes:: Moving a tree from one place to another +* Archiving:: What to do with finished projects Capture -* Setting up capture:: Where notes will be stored -* Using capture:: Commands to invoke and terminate capture -* Capture templates:: Define the outline of different note types +* Setting up capture:: Where notes will be stored +* Using capture:: Commands to invoke and terminate capture +* Capture templates:: Define the outline of different note types Capture templates -* Template elements:: What is needed for a complete template entry -* Template expansion:: Filling in information about time and context +* Template elements:: What is needed for a complete template entry +* Template expansion:: Filling in information about time and context Archiving -* Moving subtrees:: Moving a tree to an archive file -* Internal archiving:: Switch off a tree but keep it in the file +* Moving subtrees:: Moving a tree to an archive file +* Internal archiving:: Switch off a tree but keep it in the file Agenda views -* Agenda files:: Files being searched for agenda information -* Agenda dispatcher:: Keyboard access to agenda views -* Built-in agenda views:: What is available out of the box? -* Presentation and sorting:: How agenda items are prepared for display -* Agenda commands:: Remote editing of Org trees -* Custom agenda views:: Defining special searches and views -* Exporting Agenda Views:: Writing a view to a file -* Agenda column view:: Using column view for collected entries +* Agenda files:: Files being searched for agenda information +* Agenda dispatcher:: Keyboard access to agenda views +* Built-in agenda views:: What is available out of the box? +* Presentation and sorting:: How agenda items are prepared for display +* Agenda commands:: Remote editing of Org trees +* Custom agenda views:: Defining special searches and views +* Exporting Agenda Views:: Writing a view to a file +* Agenda column view:: Using column view for collected entries The built-in agenda views -* Weekly/daily agenda:: The calendar page with current tasks -* Global TODO list:: All unfinished action items +* Weekly/daily agenda:: The calendar page with current tasks +* Global TODO list:: All unfinished action items * Matching tags and properties:: Structured information with fine-tuned search -* Timeline:: Time-sorted view for single file -* Search view:: Find entries by searching for text -* Stuck projects:: Find projects you need to review +* Timeline:: Time-sorted view for single file +* Search view:: Find entries by searching for text +* Stuck projects:: Find projects you need to review Presentation and sorting -* Categories:: Not all tasks are equal -* Time-of-day specifications:: How the agenda knows the time -* Sorting of agenda items:: The order of things +* Categories:: Not all tasks are equal +* Time-of-day specifications:: How the agenda knows the time +* Sorting of agenda items:: The order of things Custom agenda views -* Storing searches:: Type once, use often -* Block agenda:: All the stuff you need in a single buffer -* Setting Options:: Changing the rules +* Storing searches:: Type once, use often +* Block agenda:: All the stuff you need in a single buffer +* Setting Options:: Changing the rules Markup for rich export -* Structural markup elements:: The basic structure as seen by the exporter -* Images and tables:: Tables and Images will be included -* Literal examples:: Source code examples with special formatting -* Include files:: Include additional files into a document -* Index entries:: Making an index -* Macro replacement:: Use macros to create complex output -* Embedded LaTeX:: LaTeX can be freely used inside Org documents +* Structural markup elements:: The basic structure as seen by the exporter +* Images and tables:: Tables and Images will be included +* Literal examples:: Source code examples with special formatting +* Include files:: Include additional files into a document +* Index entries:: Making an index +* Macro replacement:: Use macros to create complex output +* Embedded LaTeX:: LaTeX can be freely used inside Org documents Structural markup elements -* Document title:: Where the title is taken from -* Headings and sections:: The document structure as seen by the exporter -* Table of contents:: The if and where of the table of contents -* Initial text:: Text before the first heading? -* Lists:: Lists -* Paragraphs:: Paragraphs -* Footnote markup:: Footnotes -* Emphasis and monospace:: Bold, italic, etc. -* Horizontal rules:: Make a line -* Comment lines:: What will *not* be exported +* Document title:: Where the title is taken from +* Headings and sections:: The document structure as seen by the exporter +* Table of contents:: The if and where of the table of contents +* Initial text:: Text before the first heading? +* Lists:: Lists +* Paragraphs:: Paragraphs +* Footnote markup:: Footnotes +* Emphasis and monospace:: Bold, italic, etc. +* Horizontal rules:: Make a line +* Comment lines:: What will *not* be exported Embedded La@TeX{} -* Special symbols:: Greek letters and other symbols -* Subscripts and superscripts:: Simple syntax for raising/lowering text -* LaTeX fragments:: Complex formulas made easy -* Previewing LaTeX fragments:: What will this snippet look like? -* CDLaTeX mode:: Speed up entering of formulas +* Special symbols:: Greek letters and other symbols +* Subscripts and superscripts:: Simple syntax for raising/lowering text +* LaTeX fragments:: Complex formulas made easy +* Previewing LaTeX fragments:: What will this snippet look like? +* CDLaTeX mode:: Speed up entering of formulas Exporting -* Selective export:: Using tags to select and exclude trees -* Export options:: Per-file export settings -* The export dispatcher:: How to access exporter commands -* ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding -* HTML export:: Exporting to HTML -* LaTeX and PDF export:: Exporting to La@TeX{}, and processing to PDF -* DocBook export:: Exporting to DocBook -* TaskJuggler export:: Exporting to TaskJuggler -* Freemind export:: Exporting to Freemind mind maps -* XOXO export:: Exporting to XOXO -* iCalendar export:: Exporting in iCalendar format +* Selective export:: Using tags to select and exclude trees +* Export options:: Per-file export settings +* The export dispatcher:: How to access exporter commands +* ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding +* HTML export:: Exporting to HTML +* LaTeX and PDF export:: Exporting to La@TeX{}, and processing to PDF +* DocBook export:: Exporting to DocBook +* TaskJuggler export:: Exporting to TaskJuggler +* Freemind export:: Exporting to Freemind mind maps +* XOXO export:: Exporting to XOXO +* iCalendar export:: Exporting in iCalendar format HTML export -* HTML Export commands:: How to invoke HTML export -* Quoting HTML tags:: Using direct HTML in Org-mode -* Links in HTML export:: How links will be interpreted and formatted -* Tables in HTML export:: How to modify the formatting of tables -* Images in HTML export:: How to insert figures into HTML output -* Text areas in HTML export:: An alternative way to show an example -* CSS support:: Changing the appearance of the output -* JavaScript support:: Info and Folding in a web browser +* HTML Export commands:: How to invoke HTML export +* Quoting HTML tags:: Using direct HTML in Org-mode +* Links in HTML export:: How links will be interpreted and formatted +* Tables in HTML export:: How to modify the formatting of tables +* Images in HTML export:: How to insert figures into HTML output +* Text areas in HTML export:: An alternative way to show an example +* CSS support:: Changing the appearance of the output +* JavaScript support:: Info and Folding in a web browser La@TeX{} and PDF export -* LaTeX/PDF export commands:: Which key invokes which commands -* Header and sectioning:: Setting up the export file structure -* Quoting LaTeX code:: Incorporating literal La@TeX{} code -* Tables in LaTeX export:: Options for exporting tables to La@TeX{} -* Images in LaTeX export:: How to insert figures into La@TeX{} output -* Beamer class export:: Turning the file into a presentation +* LaTeX/PDF export commands:: Which key invokes which commands +* Header and sectioning:: Setting up the export file structure +* Quoting LaTeX code:: Incorporating literal La@TeX{} code +* Tables in LaTeX export:: Options for exporting tables to La@TeX{} +* Images in LaTeX export:: How to insert figures into La@TeX{} output +* Beamer class export:: Turning the file into a presentation DocBook export -* DocBook export commands:: How to invoke DocBook export -* Quoting DocBook code:: Incorporating DocBook code in Org files -* Recursive sections:: Recursive sections in DocBook -* Tables in DocBook export:: Tables are exported as HTML tables -* Images in DocBook export:: How to insert figures into DocBook output -* Special characters:: How to handle special characters +* DocBook export commands:: How to invoke DocBook export +* Quoting DocBook code:: Incorporating DocBook code in Org files +* Recursive sections:: Recursive sections in DocBook +* Tables in DocBook export:: Tables are exported as HTML tables +* Images in DocBook export:: How to insert figures into DocBook output +* Special characters:: How to handle special characters Publishing -* Configuration:: Defining projects -* Uploading files:: How to get files up on the server -* Sample configuration:: Example projects -* Triggering publication:: Publication commands +* Configuration:: Defining projects +* Uploading files:: How to get files up on the server +* Sample configuration:: Example projects +* Triggering publication:: Publication commands Configuration -* Project alist:: The central configuration variable -* Sources and destinations:: From here to there -* Selecting files:: What files are part of the project? -* Publishing action:: Setting the function doing the publishing -* Publishing options:: Tweaking HTML export -* Publishing links:: Which links keep working after publishing? -* Sitemap:: Generating a list of all pages -* Generating an index:: An index that reaches across pages +* Project alist:: The central configuration variable +* Sources and destinations:: From here to there +* Selecting files:: What files are part of the project? +* Publishing action:: Setting the function doing the publishing +* Publishing options:: Tweaking HTML export +* Publishing links:: Which links keep working after publishing? +* Sitemap:: Generating a list of all pages +* Generating an index:: An index that reaches across pages Sample configuration -* Simple example:: One-component publishing -* Complex example:: A multi-component publishing example +* Simple example:: One-component publishing +* Complex example:: A multi-component publishing example Working with source code -* Structure of code blocks:: Code block syntax described -* Editing source code:: Language major-mode editing -* Exporting code blocks:: Export contents and/or results -* Extracting source code:: Create pure source code files -* Evaluating code blocks:: Place results of evaluation in the Org-mode buffer -* Library of Babel:: Use and contribute to a library of useful code blocks -* Languages:: List of supported code block languages -* Header arguments:: Configure code block functionality -* Results of evaluation:: How evaluation results are handled -* Noweb reference syntax:: Literate programming in Org-mode +* Structure of code blocks:: Code block syntax described +* Editing source code:: Language major-mode editing +* Exporting code blocks:: Export contents and/or results +* Extracting source code:: Create pure source code files +* Evaluating code blocks:: Place results of evaluation in the Org-mode buffer +* Library of Babel:: Use and contribute to a library of useful code blocks +* Languages:: List of supported code block languages +* Header arguments:: Configure code block functionality +* Results of evaluation:: How evaluation results are handled +* Noweb reference syntax:: Literate programming in Org-mode * Key bindings and useful functions:: Work quickly with code blocks -* Batch execution:: Call functions from the command line +* Batch execution:: Call functions from the command line Header arguments -* Using header arguments:: Different ways to set header arguments -* Specific header arguments:: List of header arguments +* Using header arguments:: Different ways to set header arguments +* Specific header arguments:: List of header arguments Using header arguments * System-wide header arguments:: Set global default values -* Language-specific header arguments:: Set default values by language +* Language-specific header arguments:: Set default values by language * Buffer-wide header arguments:: Set default values for a specific buffer * Header arguments in Org-mode properties:: Set default values for a buffer or heading * Code block specific header arguments:: The most common way to set values Specific header arguments -* var:: Pass arguments to code blocks -* results:: Specify the type of results and how they will be collected and handled -* file:: Specify a path for file output -* dir:: Specify the default directory for code block execution -* exports:: Export code and/or results -* tangle:: Toggle tangling and specify file name -* no-expand:: Turn off variable assignment and noweb expansion during tangling -* session:: Preserve the state of code evaluation -* noweb:: Toggle expansion of noweb references -* cache:: Avoid re-evaluating unchanged code blocks -* hlines:: Handle horizontal lines in tables -* colnames:: Handle column names in tables -* rownames:: Handle row names in tables -* shebang:: Make tangled files executable +* var:: Pass arguments to code blocks +* results:: Specify the type of results and how they will be collected and handled +* file:: Specify a path for file output +* dir:: Specify the default directory for code block execution +* exports:: Export code and/or results +* tangle:: Toggle tangling and specify file name +* no-expand:: Turn off variable assignment and noweb expansion during tangling +* session:: Preserve the state of code evaluation +* noweb:: Toggle expansion of noweb references +* cache:: Avoid re-evaluating unchanged code blocks +* hlines:: Handle horizontal lines in tables +* colnames:: Handle column names in tables +* rownames:: Handle row names in tables +* shebang:: Make tangled files executable Miscellaneous -* Completion:: M-TAB knows what you need -* Speed keys:: Electric commands at the beginning of a headline -* Code evaluation security:: Org mode files evaluate inline code -* Customization:: Adapting Org to your taste -* In-buffer settings:: Overview of the #+KEYWORDS -* The very busy C-c C-c key:: When in doubt, press C-c C-c -* Clean view:: Getting rid of leading stars in the outline -* TTY keys:: Using Org on a tty -* Interaction:: Other Emacs packages +* Completion:: M-TAB knows what you need +* Speed keys:: Electric commands at the beginning of a headline +* Code evaluation security:: Org mode files evaluate inline code +* Customization:: Adapting Org to your taste +* In-buffer settings:: Overview of the #+KEYWORDS +* The very busy C-c C-c key:: When in doubt, press C-c C-c +* Clean view:: Getting rid of leading stars in the outline +* TTY keys:: Using Org on a tty +* Interaction:: Other Emacs packages Interaction with other packages -* Cooperation:: Packages Org cooperates with -* Conflicts:: Packages that lead to conflicts +* Cooperation:: Packages Org cooperates with +* Conflicts:: Packages that lead to conflicts Hacking -* Hooks:: Who to reach into Org's internals -* Add-on packages:: Available extensions -* Adding hyperlink types:: New custom link types -* Context-sensitive commands:: How to add functionality to such commands -* Tables in arbitrary syntax:: Orgtbl for La@TeX{} and other programs -* Dynamic blocks:: Automatically filled blocks -* Special agenda views:: Customized views +* Hooks:: Who to reach into Org's internals +* Add-on packages:: Available extensions +* Adding hyperlink types:: New custom link types +* Context-sensitive commands:: How to add functionality to such commands +* Tables in arbitrary syntax:: Orgtbl for La@TeX{} and other programs +* Dynamic blocks:: Automatically filled blocks +* Special agenda views:: Customized views * Extracting agenda information:: Postprocessing of agenda information -* Using the property API:: Writing programs that use entry properties -* Using the mapping API:: Mapping over all or selected entries +* Using the property API:: Writing programs that use entry properties +* Using the mapping API:: Mapping over all or selected entries Tables and lists in arbitrary syntax -* Radio tables:: Sending and receiving radio tables -* A LaTeX example:: Step by step, almost a tutorial -* Translator functions:: Copy and modify -* Radio lists:: Doing the same for lists +* Radio tables:: Sending and receiving radio tables +* A LaTeX example:: Step by step, almost a tutorial +* Translator functions:: Copy and modify +* Radio lists:: Doing the same for lists MobileOrg -* Setting up the staging area:: Where to interact with the mobile device -* Pushing to MobileOrg:: Uploading Org files and agendas -* Pulling from MobileOrg:: Integrating captured and flagged items +* Setting up the staging area:: Where to interact with the mobile device +* Pushing to MobileOrg:: Uploading Org files and agendas +* Pulling from MobileOrg:: Integrating captured and flagged items @end detailmenu @end menu @@ -504,11 +505,11 @@ MobileOrg @cindex introduction @menu -* Summary:: Brief summary of what Org does -* Installation:: How to install a downloaded version of Org -* Activation:: How to activate Org for certain buffers -* Feedback:: Bug reports, ideas, patches etc. -* Conventions:: Type-setting conventions in the manual +* Summary:: Brief summary of what Org does +* Installation:: How to install a downloaded version of Org +* Activation:: How to activate Org for certain buffers +* Feedback:: Bug reports, ideas, patches etc. +* Conventions:: Type-setting conventions in the manual @end menu @node Summary, Installation, Introduction, Introduction @@ -805,17 +806,17 @@ Org is based on Outline mode and provides flexible commands to edit the structure of the document. @menu -* Outlines:: Org is based on Outline mode -* Headlines:: How to typeset Org tree headlines -* Visibility cycling:: Show and hide, much simplified -* Motion:: Jumping to other headlines -* Structure editing:: Changing sequence and level of headlines -* Sparse trees:: Matches embedded in context -* Plain lists:: Additional structure within an entry -* Drawers:: Tucking stuff away -* Blocks:: Folding blocks -* Footnotes:: How footnotes are defined in Org's syntax -* Orgstruct mode:: Structure editing outside Org +* Outlines:: Org is based on Outline mode +* Headlines:: How to typeset Org tree headlines +* Visibility cycling:: Show and hide, much simplified +* Motion:: Jumping to other headlines +* Structure editing:: Changing sequence and level of headlines +* Sparse trees:: Matches embedded in context +* Plain lists:: Additional structure within an entry +* Drawers:: Tucking stuff away +* Blocks:: Folding blocks +* Footnotes:: How footnotes are defined in Org's syntax +* Orgstruct mode:: Structure editing outside Org @end menu @node Outlines, Headlines, Document Structure, Document Structure @@ -1640,12 +1641,12 @@ calculator). @end ifnotinfo @menu -* Built-in table editor:: Simple tables -* Column width and alignment:: Overrule the automatic settings -* Column groups:: Grouping to trigger vertical lines -* Orgtbl mode:: The table editor as minor mode -* The spreadsheet:: The table editor has spreadsheet capabilities -* Org-Plot:: Plotting from org tables +* Built-in table editor:: Simple tables +* Column width and alignment:: Overrule the automatic settings +* Column groups:: Grouping to trigger vertical lines +* Orgtbl mode:: The table editor as minor mode +* The spreadsheet:: The table editor has spreadsheet capabilities +* Org-Plot:: Plotting from org tables @end menu @node Built-in table editor, Column width and alignment, Tables, Tables @@ -2019,14 +2020,14 @@ fields in the table corresponding to the references at the point in the formula, moving these references by arrow keys @menu -* References:: How to refer to another field or range -* Formula syntax for Calc:: Using Calc to compute stuff -* Formula syntax for Lisp:: Writing formulas in Emacs Lisp -* Field formulas:: Formulas valid for a single field -* Column formulas:: Formulas valid for an entire column +* References:: How to refer to another field or range +* Formula syntax for Calc:: Using Calc to compute stuff +* Formula syntax for Lisp:: Writing formulas in Emacs Lisp +* Field formulas:: Formulas valid for a single field +* Column formulas:: Formulas valid for an entire column * Editing and debugging formulas:: Fixing formulas -* Updating the table:: Recomputing all dependent fields -* Advanced features:: Field names, parameters and automatic recalc +* Updating the table:: Recomputing all dependent fields +* Advanced features:: Field names, parameters and automatic recalc @end menu @node References, Formula syntax for Calc, The spreadsheet, The spreadsheet @@ -2730,14 +2731,14 @@ Like HTML, Org provides links inside a file, external links to other files, Usenet articles, emails, and much more. @menu -* Link format:: How links in Org are formatted -* Internal links:: Links to other places in the current file -* External links:: URL-like links to the world -* Handling links:: Creating, inserting and following -* Using links outside Org:: Linking from my C source code? -* Link abbreviations:: Shortcuts for writing complex links -* Search options:: Linking to a specific location -* Custom searches:: When the default search is not enough +* Link format:: How links in Org are formatted +* Internal links:: Links to other places in the current file +* External links:: URL-like links to the world +* Handling links:: Creating, inserting and following +* Using links outside Org:: Linking from my C source code? +* Link abbreviations:: Shortcuts for writing complex links +* Search options:: Linking to a specific location +* Custom searches:: When the default search is not enough @end menu @node Link format, Internal links, Hyperlinks, Hyperlinks @@ -2830,7 +2831,7 @@ several times in direct succession goes back to positions recorded earlier. @menu -* Radio targets:: Make targets trigger links in plain text +* Radio targets:: Make targets trigger links in plain text @end menu @node Radio targets, , Internal links, Internal links @@ -3285,12 +3286,12 @@ throughout your notes file. Org-mode compensates for this by providing methods to give you an overview of all the things that you have to do. @menu -* TODO basics:: Marking and displaying TODO entries -* TODO extensions:: Workflow and assignments -* Progress logging:: Dates and notes for progress -* Priorities:: Some things are more important than others -* Breaking down tasks:: Splitting a task into manageable pieces -* Checkboxes:: Tick-off lists +* TODO basics:: Marking and displaying TODO entries +* TODO extensions:: Workflow and assignments +* Progress logging:: Dates and notes for progress +* Priorities:: Some things are more important than others +* Breaking down tasks:: Splitting a task into manageable pieces +* Checkboxes:: Tick-off lists @end menu @node TODO basics, TODO extensions, TODO Items, TODO Items @@ -3382,13 +3383,13 @@ Note that @i{tags} are another way to classify headlines in general and TODO items in particular (@pxref{Tags}). @menu -* Workflow states:: From TODO to DONE in steps -* TODO types:: I do this, Fred does the rest -* Multiple sets in one file:: Mixing it all, and still finding your way -* Fast access to TODO states:: Single letter selection of a state -* Per-file keywords:: Different files, different requirements -* Faces for TODO keywords:: Highlighting states -* TODO dependencies:: When one task needs to wait for others +* Workflow states:: From TODO to DONE in steps +* TODO types:: I do this, Fred does the rest +* Multiple sets in one file:: Mixing it all, and still finding your way +* Fast access to TODO states:: Single letter selection of a state +* Per-file keywords:: Different files, different requirements +* Faces for TODO keywords:: Highlighting states +* TODO dependencies:: When one task needs to wait for others @end menu @node Workflow states, TODO types, TODO extensions, TODO extensions @@ -3679,9 +3680,9 @@ information on how to clock working time for a task, see @ref{Clocking work time}. @menu -* Closing items:: When was this entry marked DONE? -* Tracking TODO state changes:: When did the status change? -* Tracking your habits:: How consistent have you been? +* Closing items:: When was this entry marked DONE? +* Tracking TODO state changes:: When did the status change? +* Tracking your habits:: How consistent have you been? @end menu @node Closing items, Tracking TODO state changes, Progress logging, Progress logging @@ -4143,9 +4144,9 @@ You may specify special faces for specific tags using the variable (@pxref{Faces for TODO keywords}). @menu -* Tag inheritance:: Tags use the tree structure of the outline -* Setting tags:: How to assign tags to a headline -* Tag searches:: Searching for combinations of tags +* Tag inheritance:: Tags use the tree structure of the outline +* Setting tags:: How to assign tags to a headline +* Tag searches:: Searching for combinations of tags @end menu @node Tag inheritance, Setting tags, Tags, Tags @@ -4432,12 +4433,12 @@ Properties can be conveniently edited and viewed in column view (@pxref{Column view}). @menu -* Property syntax:: How properties are spelled out -* Special properties:: Access to other Org-mode features -* Property searches:: Matching property values -* Property inheritance:: Passing values down the tree -* Column view:: Tabular viewing and editing -* Property API:: Properties for Lisp programmers +* Property syntax:: How properties are spelled out +* Special properties:: Access to other Org-mode features +* Property searches:: Matching property values +* Property inheritance:: Passing values down the tree +* Column view:: Tabular viewing and editing +* Property API:: Properties for Lisp programmers @end menu @node Property syntax, Special properties, Properties and Columns, Properties and Columns @@ -4673,9 +4674,9 @@ Column view also works in agenda buffers (@pxref{Agenda Views}) where queries have collected selected items, possibly from a number of files. @menu -* Defining columns:: The COLUMNS format property -* Using column view:: How to create and use column view -* Capturing column view:: A dynamic block for column view +* Defining columns:: The COLUMNS format property +* Using column view:: How to create and use column view +* Capturing column view:: A dynamic block for column view @end menu @node Defining columns, Using column view, Column view, Column view @@ -4687,8 +4688,8 @@ Setting up a column view first requires defining the columns. This is done by defining a column format line. @menu -* Scope of column definitions:: Where defined, where valid? -* Column attributes:: Appearance and content of a column +* Scope of column definitions:: Where defined, where valid? +* Column attributes:: Appearance and content of a column @end menu @node Scope of column definitions, Column attributes, Defining columns, Defining columns @@ -4770,7 +4771,7 @@ values. @example :COLUMNS: %25ITEM %9Approved(Approved?)@{X@} %Owner %11Status \@footnote{Please note that the COLUMNS definition must be on a single line---it is wrapped here only because of formatting constraints.} - %10Time_Estimate@{:@} %CLOCKSUM + %10Time_Estimate@{:@} %CLOCKSUM :Owner_ALL: Tammy Mark Karl Lisa Don :Status_ALL: "In progress" "Not started yet" "Finished" "" :Approved_ALL: "[ ]" "[X]" @@ -4970,13 +4971,13 @@ something was created or last changed. However, in Org-mode this term is used in a much wider sense. @menu -* Timestamps:: Assigning a time to a tree entry -* Creating timestamps:: Commands which insert timestamps -* Deadlines and scheduling:: Planning your work -* Clocking work time:: Tracking how long you spend on a task -* Resolving idle time:: Resolving time if you've been idle -* Effort estimates:: Planning work effort in advance -* Relative timer:: Notes with a running timer +* Timestamps:: Assigning a time to a tree entry +* Creating timestamps:: Commands which insert timestamps +* Deadlines and scheduling:: Planning your work +* Clocking work time:: Tracking how long you spend on a task +* Resolving idle time:: Resolving time if you've been idle +* Effort estimates:: Planning work effort in advance +* Relative timer:: Notes with a running timer @end menu @@ -5132,8 +5133,8 @@ the following column). @menu -* The date/time prompt:: How Org-mode helps you entering date and time -* Custom time format:: Making dates look different +* The date/time prompt:: How Org-mode helps you entering date and time +* Custom time format:: Making dates look different @end menu @node The date/time prompt, Custom time format, Creating timestamps, Creating timestamps @@ -5365,8 +5366,8 @@ late warnings. However, it will show the item on each day where the sexp entry matches. @menu -* Inserting deadline/schedule:: Planning items -* Repeated tasks:: Items that show up again and again +* Inserting deadline/schedule:: Planning items +* Repeated tasks:: Items that show up again and again @end menu @node Inserting deadline/schedule, Repeated tasks, Deadlines and scheduling, Deadlines and scheduling @@ -5888,12 +5889,12 @@ system, tasks and projects need to be moved around. Moving completed project trees to an archive file keeps the system compact and fast. @menu -* Capture:: Capturing new stuff -* Attachments:: Add files to tasks -* RSS Feeds:: Getting input from RSS feeds -* Protocols:: External (e.g. Browser) access to Emacs and Org -* Refiling notes:: Moving a tree from one place to another -* Archiving:: What to do with finished projects +* Capture:: Capturing new stuff +* Attachments:: Add files to tasks +* RSS Feeds:: Getting input from RSS feeds +* Protocols:: External (e.g. Browser) access to Emacs and Org +* Refiling notes:: Moving a tree from one place to another +* Archiving:: What to do with finished projects @end menu @node Capture, Attachments, Capture - Refile - Archive, Capture - Refile - Archive @@ -5921,9 +5922,9 @@ flow. The basic process of capturing is very similar to remember, but Org does enhance it with templates and more. @menu -* Setting up capture:: Where notes will be stored -* Using capture:: Commands to invoke and terminate capture -* Capture templates:: Define the outline of different note types +* Setting up capture:: Where notes will be stored +* Using capture:: Commands to invoke and terminate capture +* Capture templates:: Define the outline of different note types @end menu @node Setting up capture, Using capture, Capture, Capture @@ -6016,8 +6017,8 @@ place where you started the capture process. @menu -* Template elements:: What is needed for a complete template entry -* Template expansion:: Filling in information about time and context +* Template elements:: What is needed for a complete template entry +* Template expansion:: Filling in information about time and context @end menu @node Template elements, Template expansion, Capture templates, Capture templates @@ -6326,8 +6327,8 @@ information. Here is just an example: @example (setq org-feed-alist '(("Slashdot" - "http://rss.slashdot.org/Slashdot/slashdot" - "~/txt/org/feeds.org" "Slashdot Entries"))) + "http://rss.slashdot.org/Slashdot/slashdot" + "~/txt/org/feeds.org" "Slashdot Entries"))) @end example @noindent @@ -6440,8 +6441,8 @@ Archive the current entry using the command specified in the variable @end table @menu -* Moving subtrees:: Moving a tree to an archive file -* Internal archiving:: Switch off a tree but keep it in the file +* Moving subtrees:: Moving a tree to an archive file +* Internal archiving:: Switch off a tree but keep it in the file @end menu @node Moving subtrees, Internal archiving, Archiving, Archiving @@ -6618,14 +6619,14 @@ window configuration is restored when the agenda exits: @code{org-agenda-restore-windows-after-quit}. @menu -* Agenda files:: Files being searched for agenda information -* Agenda dispatcher:: Keyboard access to agenda views -* Built-in agenda views:: What is available out of the box? -* Presentation and sorting:: How agenda items are prepared for display -* Agenda commands:: Remote editing of Org trees -* Custom agenda views:: Defining special searches and views -* Exporting Agenda Views:: Writing a view to a file -* Agenda column view:: Using column view for collected entries +* Agenda files:: Files being searched for agenda information +* Agenda dispatcher:: Keyboard access to agenda views +* Built-in agenda views:: What is available out of the box? +* Presentation and sorting:: How agenda items are prepared for display +* Agenda commands:: Remote editing of Org trees +* Custom agenda views:: Defining special searches and views +* Exporting Agenda Views:: Writing a view to a file +* Agenda column view:: Using column view for collected entries @end menu @node Agenda files, Agenda dispatcher, Agenda Views, Agenda Views @@ -6767,12 +6768,12 @@ a number of special tags matches. @xref{Custom agenda views}. In this section we describe the built-in views. @menu -* Weekly/daily agenda:: The calendar page with current tasks -* Global TODO list:: All unfinished action items +* Weekly/daily agenda:: The calendar page with current tasks +* Global TODO list:: All unfinished action items * Matching tags and properties:: Structured information with fine-tuned search -* Timeline:: Time-sorted view for single file -* Search view:: Find entries by searching for text -* Stuck projects:: Find projects you need to review +* Timeline:: Time-sorted view for single file +* Search view:: Find entries by searching for text +* Stuck projects:: Find projects you need to review @end menu @node Weekly/daily agenda, Global TODO list, Built-in agenda views, Built-in agenda views @@ -7237,9 +7238,9 @@ The prefix is followed by a cleaned-up version of the outline headline associated with the item. @menu -* Categories:: Not all tasks are equal -* Time-of-day specifications:: How the agenda knows the time -* Sorting of agenda items:: The order of things +* Categories:: Not all tasks are equal +* Time-of-day specifications:: How the agenda knows the time +* Sorting of agenda items:: The order of things @end menu @node Categories, Time-of-day specifications, Presentation and sorting, Presentation and sorting @@ -7628,12 +7629,12 @@ Internet, and outside of business hours, with something like this: @group (defun org-my-auto-exclude-function (tag) (and (cond - ((string= tag "Net") - (/= 0 (call-process "/sbin/ping" nil nil nil - "-c1" "-q" "-t1" "mail.gnu.org"))) - ((or (string= tag "Errand") (string= tag "Call")) - (let ((hour (nth 2 (decode-time)))) - (or (< hour 8) (> hour 21))))) + ((string= tag "Net") + (/= 0 (call-process "/sbin/ping" nil nil nil + "-c1" "-q" "-t1" "mail.gnu.org"))) + ((or (string= tag "Errand") (string= tag "Call")) + (let ((hour (nth 2 (decode-time)))) + (or (< hour 8) (> hour 21))))) (concat "-" tag))) (setq org-agenda-auto-exclude-function 'org-my-auto-exclude-function) @@ -7963,9 +7964,9 @@ agenda buffers. Custom agenda commands will be accessible through the dispatcher (@pxref{Agenda dispatcher}), just like the default commands. @menu -* Storing searches:: Type once, use often -* Block agenda:: All the stuff you need in a single buffer -* Setting Options:: Changing the rules +* Storing searches:: Type once, use often +* Block agenda:: All the stuff you need in a single buffer +* Setting Options:: Changing the rules @end menu @node Storing searches, Block agenda, Custom agenda views, Custom agenda views @@ -8350,29 +8351,29 @@ Org-mode has rules on how to prepare text for rich export. This section summarizes the markup rules used in an Org-mode buffer. @menu -* Structural markup elements:: The basic structure as seen by the exporter -* Images and tables:: Tables and Images will be included -* Literal examples:: Source code examples with special formatting -* Include files:: Include additional files into a document -* Index entries:: Making an index -* Macro replacement:: Use macros to create complex output -* Embedded LaTeX:: LaTeX can be freely used inside Org documents +* Structural markup elements:: The basic structure as seen by the exporter +* Images and tables:: Tables and Images will be included +* Literal examples:: Source code examples with special formatting +* Include files:: Include additional files into a document +* Index entries:: Making an index +* Macro replacement:: Use macros to create complex output +* Embedded LaTeX:: LaTeX can be freely used inside Org documents @end menu @node Structural markup elements, Images and tables, Markup, Markup @section Structural markup elements @menu -* Document title:: Where the title is taken from -* Headings and sections:: The document structure as seen by the exporter -* Table of contents:: The if and where of the table of contents -* Initial text:: Text before the first heading? -* Lists:: Lists -* Paragraphs:: Paragraphs -* Footnote markup:: Footnotes -* Emphasis and monospace:: Bold, italic, etc. -* Horizontal rules:: Make a line -* Comment lines:: What will *not* be exported +* Document title:: Where the title is taken from +* Headings and sections:: The document structure as seen by the exporter +* Table of contents:: The if and where of the table of contents +* Initial text:: Text before the first heading? +* Lists:: Lists +* Paragraphs:: Paragraphs +* Footnote markup:: Footnotes +* Emphasis and monospace:: Bold, italic, etc. +* Horizontal rules:: Make a line +* Comment lines:: What will *not* be exported @end menu @node Document title, Headings and sections, Structural markup elements, Structural markup elements @@ -8801,11 +8802,11 @@ If you observe a few conventions, Org-mode knows how to find it and what to do with it. @menu -* Special symbols:: Greek letters and other symbols -* Subscripts and superscripts:: Simple syntax for raising/lowering text -* LaTeX fragments:: Complex formulas made easy -* Previewing LaTeX fragments:: What will this snippet look like? -* CDLaTeX mode:: Speed up entering of formulas +* Special symbols:: Greek letters and other symbols +* Subscripts and superscripts:: Simple syntax for raising/lowering text +* LaTeX fragments:: Complex formulas made easy +* Previewing LaTeX fragments:: What will this snippet look like? +* CDLaTeX mode:: Speed up entering of formulas @end menu @node Special symbols, Subscripts and superscripts, Embedded LaTeX, Embedded LaTeX @@ -9064,17 +9065,17 @@ Org supports export of selected regions when @code{transient-mark-mode} is enabled (default in Emacs 23). @menu -* Selective export:: Using tags to select and exclude trees -* Export options:: Per-file export settings -* The export dispatcher:: How to access exporter commands -* ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding -* HTML export:: Exporting to HTML -* LaTeX and PDF export:: Exporting to La@TeX{}, and processing to PDF -* DocBook export:: Exporting to DocBook -* TaskJuggler export:: Exporting to TaskJuggler -* Freemind export:: Exporting to Freemind mind maps -* XOXO export:: Exporting to XOXO -* iCalendar export:: Exporting in iCalendar format +* Selective export:: Using tags to select and exclude trees +* Export options:: Per-file export settings +* The export dispatcher:: How to access exporter commands +* ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding +* HTML export:: Exporting to HTML +* LaTeX and PDF export:: Exporting to La@TeX{}, and processing to PDF +* DocBook export:: Exporting to DocBook +* TaskJuggler export:: Exporting to TaskJuggler +* Freemind export:: Exporting to Freemind mind maps +* XOXO export:: Exporting to XOXO +* iCalendar export:: Exporting in iCalendar format @end menu @node Selective export, Export options, Exporting, Exporting @@ -9327,14 +9328,14 @@ HTML formatting, in ways similar to John Gruber's @emph{markdown} language, but with additional support for tables. @menu -* HTML Export commands:: How to invoke HTML export -* Quoting HTML tags:: Using direct HTML in Org-mode -* Links in HTML export:: How links will be interpreted and formatted -* Tables in HTML export:: How to modify the formatting of tables -* Images in HTML export:: How to insert figures into HTML output -* Text areas in HTML export:: An alternative way to show an example -* CSS support:: Changing the appearance of the output -* JavaScript support:: Info and Folding in a web browser +* HTML Export commands:: How to invoke HTML export +* Quoting HTML tags:: Using direct HTML in Org-mode +* Links in HTML export:: How links will be interpreted and formatted +* Tables in HTML export:: How to modify the formatting of tables +* Images in HTML export:: How to insert figures into HTML output +* Text areas in HTML export:: An alternative way to show an example +* CSS support:: Changing the appearance of the output +* JavaScript support:: Info and Folding in a web browser @end menu @node HTML Export commands, Quoting HTML tags, HTML export, HTML export @@ -9681,12 +9682,12 @@ implement links and cross references, the PDF output file will be fully linked. @menu -* LaTeX/PDF export commands:: Which key invokes which commands -* Header and sectioning:: Setting up the export file structure -* Quoting LaTeX code:: Incorporating literal La@TeX{} code -* Tables in LaTeX export:: Options for exporting tables to La@TeX{} -* Images in LaTeX export:: How to insert figures into La@TeX{} output -* Beamer class export:: Turning the file into a presentation +* LaTeX/PDF export commands:: Which key invokes which commands +* Header and sectioning:: Setting up the export file structure +* Quoting LaTeX code:: Incorporating literal La@TeX{} code +* Tables in LaTeX export:: Options for exporting tables to La@TeX{} +* Images in LaTeX export:: How to insert figures into La@TeX{} output +* Beamer class export:: Turning the file into a presentation @end menu @node LaTeX/PDF export commands, Header and sectioning, LaTeX and PDF export, LaTeX and PDF export @@ -10011,12 +10012,12 @@ tools and stylesheets. Currently DocBook exporter only supports DocBook V5.0. @menu -* DocBook export commands:: How to invoke DocBook export -* Quoting DocBook code:: Incorporating DocBook code in Org files -* Recursive sections:: Recursive sections in DocBook -* Tables in DocBook export:: Tables are exported as HTML tables -* Images in DocBook export:: How to insert figures into DocBook output -* Special characters:: How to handle special characters +* DocBook export commands:: How to invoke DocBook export +* Quoting DocBook code:: Incorporating DocBook code in Org files +* Recursive sections:: Recursive sections in DocBook +* Tables in DocBook export:: Tables are exported as HTML tables +* Images in DocBook export:: How to insert figures into DocBook output +* Special characters:: How to handle special characters @end menu @node DocBook export commands, Quoting DocBook code, DocBook export, DocBook export @@ -10442,10 +10443,10 @@ conversion so that files are available in both formats on the server. Publishing has been contributed to Org by David O'Toole. @menu -* Configuration:: Defining projects -* Uploading files:: How to get files up on the server -* Sample configuration:: Example projects -* Triggering publication:: Publication commands +* Configuration:: Defining projects +* Uploading files:: How to get files up on the server +* Sample configuration:: Example projects +* Triggering publication:: Publication commands @end menu @node Configuration, Uploading files, Publishing, Publishing @@ -10455,14 +10456,14 @@ Publishing needs significant configuration to specify files, destination and many other properties of a project. @menu -* Project alist:: The central configuration variable -* Sources and destinations:: From here to there -* Selecting files:: What files are part of the project? -* Publishing action:: Setting the function doing the publishing -* Publishing options:: Tweaking HTML export -* Publishing links:: Which links keep working after publishing? -* Sitemap:: Generating a list of all pages -* Generating an index:: An index that reaches across pages +* Project alist:: The central configuration variable +* Sources and destinations:: From here to there +* Selecting files:: What files are part of the project? +* Publishing action:: Setting the function doing the publishing +* Publishing options:: Tweaking HTML export +* Publishing links:: Which links keep working after publishing? +* Sitemap:: Generating a list of all pages +* Generating an index:: An index that reaches across pages @end menu @node Project alist, Sources and destinations, Configuration, Configuration @@ -10836,8 +10837,8 @@ project publishing only a set of Org files. The second example is more complex, with a multi-component project. @menu -* Simple example:: One-component publishing -* Complex example:: A multi-component publishing example +* Simple example:: One-component publishing +* Complex example:: A multi-component publishing example @end menu @node Simple example, Complex example, Sample configuration, Sample configuration @@ -10966,18 +10967,18 @@ Davison and Eric Schulte, and was originally named Org-babel. The following sections describe Org-mode's code block handling facilities. @menu -* Structure of code blocks:: Code block syntax described -* Editing source code:: Language major-mode editing -* Exporting code blocks:: Export contents and/or results -* Extracting source code:: Create pure source code files -* Evaluating code blocks:: Place results of evaluation in the Org-mode buffer -* Library of Babel:: Use and contribute to a library of useful code blocks -* Languages:: List of supported code block languages -* Header arguments:: Configure code block functionality -* Results of evaluation:: How evaluation results are handled -* Noweb reference syntax:: Literate programming in Org-mode +* Structure of code blocks:: Code block syntax described +* Editing source code:: Language major-mode editing +* Exporting code blocks:: Export contents and/or results +* Extracting source code:: Create pure source code files +* Evaluating code blocks:: Place results of evaluation in the Org-mode buffer +* Library of Babel:: Use and contribute to a library of useful code blocks +* Languages:: List of supported code block languages +* Header arguments:: Configure code block functionality +* Results of evaluation:: How evaluation results are handled +* Noweb reference syntax:: Literate programming in Org-mode * Key bindings and useful functions:: Work quickly with code blocks -* Batch execution:: Call functions from the command line +* Batch execution:: Call functions from the command line @end menu @comment node-name, next, previous, up @@ -11271,8 +11272,8 @@ section provides an overview of the use of header arguments, and then describes each header argument in detail. @menu -* Using header arguments:: Different ways to set header arguments -* Specific header arguments:: List of header arguments +* Using header arguments:: Different ways to set header arguments +* Specific header arguments:: List of header arguments @end menu @node Using header arguments, Specific header arguments, Header arguments, Header arguments @@ -11282,7 +11283,7 @@ The values of header arguments can be set in five different ways, each more specific (and having higher priority) than the last. @menu * System-wide header arguments:: Set global default values -* Language-specific header arguments:: Set default values by language +* Language-specific header arguments:: Set default values by language * Buffer-wide header arguments:: Set default values for a specific buffer * Header arguments in Org-mode properties:: Set default values for a buffer or heading * Code block specific header arguments:: The most common way to set values @@ -11419,25 +11420,25 @@ Header arguments for ``Library of Babel'' or function call lines can be set as s The following header arguments are defined: @menu -* var:: Pass arguments to code blocks -* results:: Specify the type of results and how they will +* var:: Pass arguments to code blocks +* results:: Specify the type of results and how they will be collected and handled -* file:: Specify a path for file output -* dir:: Specify the default (possibly remote) +* file:: Specify a path for file output +* dir:: Specify the default (possibly remote) directory for code block execution -* exports:: Export code and/or results -* tangle:: Toggle tangling and specify file name -* no-expand:: Turn off variable assignment and noweb +* exports:: Export code and/or results +* tangle:: Toggle tangling and specify file name +* no-expand:: Turn off variable assignment and noweb expansion during tangling * comments:: Toggle insertion of comments in tangled code files -* session:: Preserve the state of code evaluation -* noweb:: Toggle expansion of noweb references -* cache:: Avoid re-evaluating unchanged code blocks -* hlines:: Handle horizontal lines in tables -* colnames:: Handle column names in tables -* rownames:: Handle row names in tables -* shebang:: Make tangled files executable +* session:: Preserve the state of code evaluation +* noweb:: Toggle expansion of noweb references +* cache:: Avoid re-evaluating unchanged code blocks +* hlines:: Handle horizontal lines in tables +* colnames:: Handle column names in tables +* rownames:: Handle row names in tables +* shebang:: Make tangled files executable * eval:: Limit evaluation of specific code blocks @end menu @@ -12292,15 +12293,15 @@ emacsclient \ @chapter Miscellaneous @menu -* Completion:: M-TAB knows what you need -* Speed keys:: Electric commands at the beginning of a headline -* Code evaluation security:: Org mode files evaluate inline code -* Customization:: Adapting Org to your taste -* In-buffer settings:: Overview of the #+KEYWORDS -* The very busy C-c C-c key:: When in doubt, press C-c C-c -* Clean view:: Getting rid of leading stars in the outline -* TTY keys:: Using Org on a tty -* Interaction:: Other Emacs packages +* Completion:: M-TAB knows what you need +* Speed keys:: Electric commands at the beginning of a headline +* Code evaluation security:: Org mode files evaluate inline code +* Customization:: Adapting Org to your taste +* In-buffer settings:: Overview of the #+KEYWORDS +* The very busy C-c C-c key:: When in doubt, press C-c C-c +* Clean view:: Getting rid of leading stars in the outline +* TTY keys:: Using Org on a tty +* Interaction:: Other Emacs packages @end menu @@ -12928,8 +12929,8 @@ Org lives in the world of GNU Emacs and interacts in various ways with other code out there. @menu -* Cooperation:: Packages Org cooperates with -* Conflicts:: Packages that lead to conflicts +* Cooperation:: Packages Org cooperates with +* Conflicts:: Packages that lead to conflicts @end menu @node Cooperation, Conflicts, Interaction, Interaction @@ -13077,9 +13078,9 @@ fixed this problem: @lisp (add-hook 'org-mode-hook - (lambda () - (org-set-local 'yas/trigger-key [tab]) - (define-key yas/keymap [tab] 'yas/next-field-group))) + (lambda () + (org-set-local 'yas/trigger-key [tab]) + (define-key yas/keymap [tab] 'yas/next-field-group))) @end lisp @item @file{windmove.el} by Hovav Shacham @@ -13121,16 +13122,16 @@ This appendix covers some aspects where users can extend the functionality of Org. @menu -* Hooks:: Who to reach into Org's internals -* Add-on packages:: Available extensions -* Adding hyperlink types:: New custom link types -* Context-sensitive commands:: How to add functionality to such commands -* Tables in arbitrary syntax:: Orgtbl for La@TeX{} and other programs -* Dynamic blocks:: Automatically filled blocks -* Special agenda views:: Customized views +* Hooks:: Who to reach into Org's internals +* Add-on packages:: Available extensions +* Adding hyperlink types:: New custom link types +* Context-sensitive commands:: How to add functionality to such commands +* Tables in arbitrary syntax:: Orgtbl for La@TeX{} and other programs +* Dynamic blocks:: Automatically filled blocks +* Special agenda views:: Customized views * Extracting agenda information:: Postprocessing of agenda information -* Using the property API:: Writing programs that use entry properties -* Using the mapping API:: Mapping over all or selected entries +* Using the property API:: Writing programs that use entry properties +* Using the mapping API:: Mapping over all or selected entries @end menu @node Hooks, Add-on packages, Hacking, Hacking @@ -13322,10 +13323,10 @@ can use Org's facilities to edit and structure lists by turning @menu -* Radio tables:: Sending and receiving radio tables -* A LaTeX example:: Step by step, almost a tutorial -* Translator functions:: Copy and modify -* Radio lists:: Doing the same for lists +* Radio tables:: Sending and receiving radio tables +* A LaTeX example:: Step by step, almost a tutorial +* Translator functions:: Copy and modify +* Radio lists:: Doing the same for lists @end menu @node Radio tables, A LaTeX example, Tables in arbitrary syntax, Tables in arbitrary syntax @@ -14098,9 +14099,9 @@ in-buffer settings, but it will understand the logistics of TODO state (@pxref{Setting tags}) only for those set in these variables. @menu -* Setting up the staging area:: Where to interact with the mobile device -* Pushing to MobileOrg:: Uploading Org files and agendas -* Pulling from MobileOrg:: Integrating captured and flagged items +* Setting up the staging area:: Where to interact with the mobile device +* Pushing to MobileOrg:: Uploading Org files and agendas +* Pulling from MobileOrg:: Integrating captured and flagged items @end menu @node Setting up the staging area, Pushing to MobileOrg, MobileOrg, MobileOrg diff --git a/doc/misc/pgg.texi b/doc/misc/pgg.texi index 640dfd8f749..eefada00d9a 100644 --- a/doc/misc/pgg.texi +++ b/doc/misc/pgg.texi @@ -497,7 +497,3 @@ If non-@code{nil}, don't check the checksum of the packets. @bye @c End: - -@ignore - arch-tag: 0c205838-34b9-41a5-b9d7-49ae57ccac85 -@end ignore diff --git a/doc/misc/sasl.texi b/doc/misc/sasl.texi index 8a8421b4870..80ea9bc45be 100644 --- a/doc/misc/sasl.texi +++ b/doc/misc/sasl.texi @@ -267,7 +267,3 @@ At the first time @var{step} should be set to @code{nil}. @bye @c End: - -@ignore - arch-tag: dc9650be-a953-40bf-bc55-24fe5f19d875 -@end ignore diff --git a/doc/misc/sieve.texi b/doc/misc/sieve.texi index 9a1a0faf4c8..edf429aea77 100644 --- a/doc/misc/sieve.texi +++ b/doc/misc/sieve.texi @@ -356,7 +356,3 @@ A Protocol for Remotely Managing Sieve Scripts @bye @c End: - -@ignore - arch-tag: 6e3ad0af-2eaf-4f35-a081-d40f4a683ec3 -@end ignore diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index b9c83be457e..604130d2606 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -16,7 +16,7 @@ @include trampver.texi -@c Macro for formatting a filename according to the repective syntax. +@c Macro for formatting a filename according to the respective syntax. @c xxx and yyy are auxiliary macros in order to omit leading and @c trailing whitespace. Not very elegant, but I don't know it better. @@ -105,11 +105,6 @@ If you're using the other Emacs flavor, you should read the @end ifset @ifhtml -@ifset jamanual -This manual is also available as a @uref{@value{japanesemanual}, -Japanese translation}. -@end ifset - The latest release of @value{tramp} is available for @uref{ftp://ftp.gnu.org/gnu/tramp/, download}, or you may see @ref{Obtaining Tramp} for more details, including the CVS server @@ -171,7 +166,6 @@ Installing @value{tramp} with your @value{emacsname} * Installation parameters:: Parameters in order to control installation. * Load paths:: How to plug-in @value{tramp} into your environment. -* Japanese manual:: Japanese manual. @end ifset diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index d882baf9a86..107e4d70aa3 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -9,7 +9,7 @@ @c In the Tramp CVS, the version number is auto-frobbed from @c configure.ac, so you should edit that file and run @c "autoconf && ./configure" to change the version number. -@set trampver 2.1.19-pre +@set trampver 2.2.0-pre @c Other flags from configuration @set instprefix /usr/local @@ -56,7 +56,6 @@ @set emacsothername XEmacs @set emacsotherdir xemacs @set emacsotherfilename tramp-xemacs.html -@set japanesemanual tramp_ja-emacs.html @end ifset @c XEmacs counterparts. @@ -73,7 +72,6 @@ @set emacsothername GNU Emacs @set emacsotherdir emacs @set emacsotherfilename tramp-emacs.html -@set japanesemanual tramp_ja-xemacs.html @end ifset @ignore diff --git a/etc/ChangeLog b/etc/ChangeLog index b40fc71708f..7069d0b9ecb 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,29 @@ +2010-09-11 Glenn Morris <rgm@gnu.org> + + * emacs.bash, emacs.csh, ms-kermit: Remove obsolete files (use + emacsclient -a instead of the first two). + +2010-09-10 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * NEWS: Mention the new libxml2 functions. + +2010-08-25 Kenichi Handa <handa@m17n.org> + + * HELLO: Change designation sequences for Arabic text. + +2010-08-23 Michael Albinus <michael.albinus@gmx.de> + + * NEWS: dbus.el supports alternative buses. + +2010-08-22 Alex Harsanyi <harsanyi@mac.com> (tiny change) + + * emacs3.py: Import imp module and use it (Bug#5756). + +2010-08-14 Eli Zaretskii <eliz@gnu.org> + + * tutorials/TUTORIAL.he: Use MAQAF instead of hyphen where appropriate. + Fix a few typos. + 2010-08-08 Ken Brown <kbrown@cornell.edu> * PROBLEMS: Mention problem with Cygwin 1.5.19. diff --git a/etc/HELLO b/etc/HELLO index 621f061a664..f7320f7301f 100644 --- a/etc/HELLO +++ b/etc/HELLO @@ -4,7 +4,7 @@ Non-ASCII examples: Europe: ,A!(BHola!, Gr,A|_(B Gott, Hyv,Add(B p,Ad(Biv,Add(B, Tere ,Au(Bhtust, Bon,Cu(Bu Cze,B6f(B!, Dobr,B}(B den, ,L7T`PRabRcYbU(B!, ,FCei\(B ,Fsar(B, $,1J2J0J;J0J@JOJ=J1J0(B Africa: $(3!A!,!>(B - Middle/Near East: ,Hylem(B, ,GGdSqdGe(B ,GYdjce(B + Middle/Near East: ,Hylem(B, $,1-g.$-s.1.$-g.%(B $,1-y.$.*.#.%(B South Asia: $,19h9n9x:-9d:'(B, $,15h5n5x6-5d6'(B, $,1?(?.?8?M>u?>?0(B, $,1@H@N@X@m@5@^@P@"(B, $,1;6;A;#;?;,;G(B, $,1AFAzB4AvB=B AqB*(B, $,1<U<C<5<m<5<N<m(B, $,1=h=n=x>-=U=~=p=B(B, $(7"7"!#C!;"E"S"G!;"7"2"[!;"D"["#"G!>(B South East Asia: $,1\'\f\:\V\4\?\]\:(B, (1JP:R-4U(B, $,1H9H$HZHYH"H<HLH5HK(B, ,TJGQJ4U$CQ:(B, Ch,1`(Bo b,1U(Bn @@ -16,7 +16,7 @@ Non-ASCII examples: LANGUAGE (NATIVE NAME) HELLO ---------------------- ----- Amharic ($,1O M[MmN{(B) $,1M`MKM](B -Arabic $,1ro(B(,GGdYQHjqI(B) ,GGdSqdGe(B ,GYdjce(B +Arabic $,1ro(B($,1-g.$-y-q-h.*.1-i(B) $,1-g.$-s.1.$-g.%(B $,1-y.$.*.#.%(B Bengali ($,17,7>6b727>(B) $,17(7.787M6u7>70(B Braille $,2(3(1('('(5(B Burmese ($,1H9H\H4HZH9HL(B) $,1H9H$HZHYH"H<HLH5HK(B @@ -59,6 +59,10 @@ automatically select it. * Startup Changes in Emacs 24.1 +** The --unibyte, --multibyte, --no-multibyte, and --no-unibyte +command line arguments no longer have any effect. (They were declared +obsolete in Emacs 23.) + * Changes in Emacs 24.1 @@ -106,9 +110,24 @@ is taken from the desktop settings. ** GTK tool bars can be placed on the left/right or top/bottom of the frame. The frame-parameter tool-bar-position controls this. It takes the values -top, left, tight or bottom. The Options => Show/Hide menu has entries +top, left, right or bottom. The Options => Show/Hide menu has entries for this. +** ImageMagick support. +It is now possible to use the Imagemagick library to load many new +image formats in Emacs. To enable this, use the configure option +`--with-imagemagick'. + +The new function `imagemagick-types' returns a list of image file +extensions that your installation of ImageMagick supports. The +function `imagemagick-register-types' enables ImageMagick support for +these imaeg types, minus those listed in `imagemagick-types-inhibit'. + +See the Emacs Lisp Reference Manual for more information. + +** The colors for selected text (the region face) are taken from the GTK +theme when Emacs is built with GTK. + ** Emacs uses GTK tooltips by default if built with GTK. You can turn that off by customizing x-gtk-use-system-tooltips. @@ -153,8 +172,12 @@ for `list-colors-display'. ** An Emacs Lisp package manager is now included. This is a convenient way to download and install additional packages, -from elpa.gnu.org. `M-x package-list-packages' shows a list of -packages, which can be selected for installation. +from elpa.gnu.org. + +*** `M-x list-packages' shows a list of packages, which can be +selected for installation. + +*** New command `describe-package', bound to `C-h P'. *** By default, all installed packages are loaded and activated automatically when Emacs starts up. To disable this, set @@ -188,28 +211,43 @@ should use delete-char with a negative argument instead. ** Selection changes. -The way Emacs interacts with the clipboard and primary selection, by -default, is now similar to other X applications. In particular, kill -and yank use the clipboard, in addition to the primary selection. +The default handling of clipboard and primary selections has been +changed to conform with other X applications. -*** `select-active-regions' now defaults to `lazy'. -This means that any active region made with shift-selection or mouse -dragging, or acted on by Emacs (e.g. with M-w or C-w), is -automatically added to the primary window selection. +*** `select-active-regions' now defaults to t, so active regions set +the primary selection. + +It also accepts a new value, `lazy', which means to only set the +primary selection for temporarily active regions (usually made by +mouse-dragging or shift-selection). + +*** `mouse-2' is now bound to `mouse-yank-primary'. *** `x-select-enable-clipboard' now defaults to t. +Thus, killing and yanking now use the clipboard (in addition to the +kill ring). *** `x-select-enable-primary' now defaults to nil. *** `mouse-drag-copy-region' now defaults to nil. -*** `mouse-2' is now bound to `mouse-yank-primary'. +*** Support for X cut buffers has been removed. * Changes in Specialized Modes and Packages in Emacs 24.1 +** FIXME: xdg-open for browse-url and reportbug, 2010/08. (Close bug#4546?) + ** Archive Mode has basic support to browse 7z archives. +** ERC changes + +*** New vars `erc-autojoin-timing' and `erc-autojoin-delay'. +If the value of `erc-autojoin-timing' is 'ident, ERC autojoins after a +successful NickServ identification, or after `erc-autojoin-delay' +seconds. The default value, 'ident, means to autojoin immediately +after connecting. + ** In ido-mode, C-v is no longer bound to ido-toggle-vc. The reason is that this interferes with cua-mode. @@ -279,10 +317,32 @@ For example, adding "(diff-mode . ((mode . whitespace)))" to your variables `sql-product', `sql-user', `sql-server', `sql-database' and `sql-port' can now be safely used as local variables. +*** `sql-dialect' is a synonym for `sql-product'. + *** Added ability to login with a port on MySQL. The custom variable `sql-port' can be specified for connection to MySQL servers. +*** Dynamic selection of product in an SQL interactive session. +If you use `sql-product-interactive' to start an SQL interactive +session it uses the current value of `sql-product'. Preceding the +invocation with C-u will force it to ask for the product before +creating the session. + +*** Renaming a SQL interactive buffer when it is created. +Prefixing the SQL interactive commands (`sql-sqlite', `sql-postgres', +`sql-mysql', etc.) with C-u will force a new interactive session to be +started and will prompt for the new name. This will reduce the need +for `sql-rename-buffer' is most common use cases. + +*** Command continuation prompts in SQL interactive mode are suppressed. +Multiple line commands in SQL interactive mode, generate command +continuation prompts which needlessly confuse the output. These +prompts are now filtered out from the output. This change impacts +multiple line SQL statements entered with C-j between each line, +statements yanked into the buffer and statements sent with +`sql-send-*' functions. + *** Custom variables control prompting for login parameters. Each supported product has a custom variable `sql-*-login-params' which is a list of the parameters to be prompted for before a @@ -302,7 +362,8 @@ names (without the directory portion). Generally these strings will be of the form ".+\.SUF" where SUF is the desired file suffix. When :completion is specified, the ARG corresponds to the PREDICATE -argument to the `completing-read' function. +argument to the `completing-read' function (a list of possible values +or a function returning such a list). *** Added `sql-connection-alist' to record login parameter values. An alist for recording different username, database and server @@ -368,9 +429,16 @@ enabled by default in 23.1. supports multithread non-stop debugging and debugging of several threads simultaneously. +** D-Bus + +*** It is possible now, to access alternative buses than the default +system or session bus. + * New Modes and Packages in Emacs 24.1 +** New global minor modes electric-pair-mode and electric-indent-mode. + ** pcase.el provides the ML-style pattern matching macro `pcase'. ** smie.el is a package providing a simple generic indentation engine. @@ -412,6 +480,20 @@ has now been removed. * Lisp changes in Emacs 24.1 +** New variable syntax-propertize-function to set syntax-table properties. +Replaces font-lock-syntactic-keywords which are now obsolete. +This allows syntax-table properties to be set independently from font-lock: +just call syntax-propertize to make sure the text is propertized. +Together with this new variable come a new hook +syntax-propertize-extend-region-functions, as well as two helper functions: +syntax-propertize-via-font-lock to reuse old font-lock-syntactic-keywords +as-is; and syntax-propertize-rules which provides a new way to specify +syntactic rules. + +** New hook post-self-insert-hook run at the end of self-insert-command. + ++++ +** Syntax tables support a new "comment style c" additionally to style b. ** frame-local variables cannot be let-bound any more. ** prog-mode is a new major-mode meant to be the parent of programming mode. ** define-minor-mode accepts a new keyword :variable. @@ -436,6 +518,14 @@ by the Graphic Control Extension of the image. *** `image-extension-data' is renamed to `image-metadata'. +** XML and HTML parsing + +*** If Emacs is compiled with libxml2 support (which is the default), +two new Emacs Lisp-level functions are defined: `html-parse-string' +(which will parse "real world" HTML) and `xml-parse-string' (which +parses XML). Both return an Emacs Lisp parse tree. See the Emacs +Lisp Reference Manual for details. + ** Isearch *** New hook `isearch-update-post-hook' that runs in `isearch-update'. @@ -625,6 +625,508 @@ http://lists.gnu.org/archive/html/emacs-devel/2008-02/msg02234.html the window associated with that modeline. http://lists.gnu.org/archive/html/emacs-devel/2007-09/msg02416.html +* Things to be done for specific packages or features + +** ImageMagick support + +*** image-type-header-regexps priorities the jpeg loader over the +ImageMagick one. This is not wrong, but how should a user go about +prefering the ImageMagick loader? The user might like zooming etc in jpegs. + +Try (setq image-type-header-regexps nil) for a quick hack to prefer +ImageMagick over the jpg loader. + +*** For some reason its unbearably slow to look at a page in a large +image bundle using the :index feature. The ImageMagick "display" +command is also a bit slow, but nowhere near as slow as the Emacs +code. It seems ImageMagick tries to unpack every page when loading the +bundle. This feature is not the primary usecase in Emacs though. + +ImageMagick 6.6.2-9 introduced a bugfix for single page djvu load. It +is now much faster to use the :index feature, but still not very fast. + +*** Try to cache the num pages calculation. It can take a while to +calculate the number of pages, and if you need to do it for each page +view, page-flipping becomes uselessly slow. + +*** Integrate with image-dired. + +*** Integrate with docview. + +*** Integrate with image-mode. +Some work has been done, e.g. M-x image-transform-fit-to-height will +fit the image to the height of the Emacs window. + +*** Look for optimizations for handling images with low depth. +Currently the code seems to default to 24 bit RGB which is costly for +images with lower bit depth. + +*** Decide what to do with some uncommitted imagemagick support +functions for image size etc. + +*** Test with more systems. +Tested on Fedora 12, 14, and the libmagick that ships with it. +I also tried using an ImageMagick compiled from their SVN, in +parallel with the one packaged by Fedora, it worked well. +Ubuntu 8.04 was tested, but it seems it ships a broken ImageMagick. + +** nxml mode + +*** High priority + +**** Command to insert an element template, including all required +attributes and child elements. When there's a choice of elements +possible, we could insert a comment, and put an overlay on that +comment that makes it behave like a button with a pop-up menu to +select the appropriate choice. + +**** Command to tag a region. With a schema should complete using legal +tags, but should work without a schema as well. + +**** Provide a way to conveniently rename an element. With a schema should +complete using legal tags, but should work without a schema as well. + +*** Outlining + +**** Implement C-c C-o C-q. + +**** Install pre/post command hook for moving out of invisible section. + +**** Put a modify hook on invisible sections that expands them. + +**** Integrate dumb folding somehow. + +**** An element should be able to be its own heading. + +**** Optimize to avoid complete buffer scan on each command. + +**** Make it work with HTML-style headings (i.e. level indicated by +name of heading element rather than depth of section nesting). + +**** Recognize root element as a section provided it has a title, even +if it doesn't match section-element-name-regex. + +**** Support for incremental search automatically making hidden text visible. + +**** Allow title to be an attribute. + +**** Command that says to recognize the tag at point as a section/heading. + +**** Explore better ways to determine when an element is a section +or a heading. + +**** rng-next-error needs to either ignore invisible portion or reveal it +(maybe use isearch oriented text properties). + +**** Errors within hidden section should be highlighted by underlining the +ellipsis. + +**** Make indirect buffers work. + +**** How should nxml-refresh outline recover from non well-formed tags? + +**** Hide tags in title elements? + +**** Use overlays instead of text properties for holding outline state? +Necessary for indirect buffers to work? + +**** Allow an outline to go in the speedbar. + +**** Split up outlining manual section into subsections. + +**** More detail in the manual about each outlining command. + +**** More menu entries for hiding/showing? + +**** Indication of many lines have been hidden? + +*** Locating schemas + +**** Should rng-validate-mode give the user an opportunity to specify a +schema if there is currently none? Or should it at least give a hint +to the user how to specify a non-vacuous schema? + +**** Support for adding new schemas to schema-locating files. +Add documentElement and namespace elements. + +**** C-c C-w should be able to report current type id. + +**** Implement doctypePublicId. + +**** Implement typeIdBase. + +**** Implement typeIdProcessingInstruction. + +**** Support xml:base. + +**** Implement group. + +**** Find preferred prefix from schema-locating files. Get rid of +rng-preferred-prefix-alist. + +**** Inserting document element with vacuous schema should complete using +document elements declared in schema locating files, and set schema +appropriately. + +**** Add a ruleType attribute to the <include> element? + +**** Allow processing instruction in prolog to contain the compact syntax +schema directly. + +**** Use RDDL to locate a schema based on the namespace URI. + +**** Should not prompt to add redundant association to schema locating file. + +**** Command to reload current schema. + +*** Schema-sensitive features + +**** Should filter dynamic markup possibilities using schema validity, by +adding hook to nxml-mode. + +**** Dynamic markup word should (at least optionally) be able to look in +other buffers that are using nxml-mode. + +**** Should clicking on Invalid move to next error if already on an error? + +**** Take advantage of a:documentation. Needs change to schema format. + +**** Provide feasible validation (as in Jing) toggle. + +**** Save the validation state as a property on the error overlay to enable +more detailed diagnosis. + +**** Provide an Error Summary buffer showing all the validation errors. + +**** Pop-up menu. What is useful? Tag a region (should be greyed out if +the region is not balanced). Suggestions based on error messages. + +**** Have configurable list of namespace URIs so that we can provide +namespace URI completion on extension elements or with schema-less documents. + +**** Allow validation to handle XInclude. + +**** ID/IDREF support. + +*** Completion + +**** Make it work with icomplete. Only use a function to complete when +some of the possible names have undeclared namespaces. + +**** How should C-return in mixed text work? + +**** When there's a vacuous schema, C-return after < will insert the end-tag. +Is this a bug or a feature? + +**** After completing start-tag, ensure we don't get unhelpful message +from validation + +**** Syntax table for completion. + +**** Should complete start-tag name with a space if namespace attributes +are required. + +**** When completing start-tag name with no prefix and it doesn't match +should try to infer namespace from local name. + +**** Should completion pay attention to characters after point? If so, how? + +**** When completing start-tag name, add required atts if only one required +attribute. + +**** When completing attribute name, add attribute value if only one value +is possible. + +**** After attribute-value completion, insert space after close delimiter +if more attributes are required. + +**** Complete on enumerated data values in elements. + +**** When in context that allows only elements, should get tag +completion without having to type < first. + +**** When immediately after start-tag name, and name is valid and not +prefix of any other name, should C-return complete on attribute names? + +**** When completing attributes, more consistent to ignore all attributes +after point. + +**** Inserting attribute value completions needs to be sensitive to what +delimiter is used so that it quotes the correct character. + +**** Complete on encoding-names in XML decl. + +**** Complete namespace declarations by searching for all namespaces +mentioned in the schema. + +*** Well-formed XML support + +**** Deal better with Mule-UCS + +**** Deal with UTF-8 BOM when reading. + +**** Complete entity names. + +**** Provide some support for entity names for MathML. + +**** Command to repeat the last tag. + +**** Support for changing between character references and characters. +Need to check that context is one in which character references are +allowed. xmltok prolog parsing will need to distinguish parameter +literals from other kinds of literal. + +**** Provide a comment command to bind to M-; that works better than the +normal one. + +**** Make indenting in a multi-line comment work. + +**** Structure view. Separate buffer displaying element tree. +Be able to navigate from structure view to document and vice-versa. + +**** Flash matching >. + +**** Smart selection command that selects increasingly large syntactically +coherent chunks of XML. If point is in an attribute value, first +select complete value; then if command is repeated, select value plus +delimiters, then select attribute name as well, then complete +start-tag, then complete element, then enclosing element, etc. + +**** ispell integration. + +**** Block-level items in mixed content should be indented, e.g: + <para>This is list: + <ul> + <li>item</li> + +**** Provide option to indent like this: + <para>This is a paragraph + occupying multiple lines.</para> + +**** Option to add make a / that closes a start-tag electrically insert a +space for the XHTML guys. + +**** C-M-q should work. + +*** Datatypes + +**** Figure out workaround for CJK characters with regexps. + +**** Does category C contain Cn? + +**** Do ENTITY datatype properly. + +*** XML Parsing Library + +**** Parameter entity parsing option, nil (never), t (always), +unless-standalone (unless standalone="yes" in XML declaration). + +**** When a file is currently being edited, there should be an option to +use its buffer instead of the on-disk copy. + +*** Handling all XML features + +**** Provide better support for editing external general parsed entities. +Perhaps provide a way to force ignoring undefined entities; maybe turn +this on automatically with <?xml encoding=""?> (with no version +pseudo-att). + +**** Handle internal general entity declarations containing elements. + +**** Handle external general entity declarations. + +**** Handle default attribute declarations in internal subset. + +**** Handle parameter entities (including DTD). + +*** RELAX NG + +**** Do complete schema checking, at least optionally. + +**** Detect include/external loops during schema parse. + +**** Coding system detection for schemas. Should use utf-8/utf-16 per the +spec. But also need to allow encodings other than UTF-8/16 to support +CJK charsets that Emacs cannot represent in Unicode. + +*** Catching XML errors + +**** Check public identifiers. + +**** Check default attribute values. + +*** Performance + +**** Explore whether overlay-recenter can cure overlays performance problems. + +**** Cache schemas. Need to have list of files and mtimes. + +**** Make it possible to reduce rng-validate-chunk-size significantly, +perhaps to 500 bytes, without bad performance impact: don't do +redisplay on every chunk; pass continue functions on other uses of +rng-do-some-validation. + +**** Cache after first tag. + +**** Introduce a new name class that is a choice between names (so that +we can use member) + +**** intern-choice should simplify after patterns with same 1st/2nd args + +**** Large numbers of overlays slow things down dramatically. Represent +errors using text properties. This implies we cannot incrementally +keep track of the number of errors, in order to determine validity. +Instead, when validation completes, scan for any characters with an +error text property; this seems to be fast enough even with large +buffers. Problem with error at end of buffer, where there's no +character; need special variable for this. Need to merge face from +font-lock with the error face: use :inherit attribute with list of two +faces. How do we avoid making rng-valid depend on nxml-mode? + +*** Error recovery + +**** Don't stop at newline in looking for close of start-tag. + +**** Use indentation to guide recovery from mismatched end-tags + +**** Don't keep parsing when currently not well-formed but previously +well-formed + +**** Try to recover from a bad start-tag by popping an open element if +there was a mismatched end-tag unaccounted for. + +**** Try to recover from a bad start-tag open on the hypothesis that there +was an error in the namespace URI. + +**** Better recovery from ill-formed XML declarations. + +*** Useability improvements + +**** Should print a "Parsing..." message during long movements. + +**** Provide better position for reference to undefined pattern error. + +**** Put Well-formed in the mode-line when validating against any-content. + +**** Trim marking of illegal data for leading and trailing whitespace. + +**** Show Invalid status as soon as we are sure it's invalid, rather than +waiting for everything to be completely up to date. + +**** When narrowed, Valid or Invalid status should probably consider only +validity of narrowed region. + +*** Bug fixes + +**** Need to give an error for a document like: <foo/><![CDATA[ ]]> + +**** Make nxml-forward-balanced-item work better for the prolog. + +**** Make filling and indenting comments work in the prolog. + +**** Should delete RNC Input buffers. + +**** Figure out what regex use for NCName and use it consistently, + +**** Should have not-well-formed tokens in ref. + +**** Require version in XML declaration? Probably not because prevents +use for external parsed entities. At least forbid standalone without version. + +**** Reject schema that compiles to rng-not-allowed-ipattern. + +**** Move point backwards on schema parse error so that it's on the right token. + +*** Internal + +**** Use rng-quote-string consistently. + +**** Use parsing library for XML to texinfo conversion. + +**** Rename xmltok.el to nxml-token.el. Use nxml-t- prefix instead of +xmltok-. Change nxml-t-type to nxml-t-token-type, nxml-t-start to +nxml-t-token-start. + +**** Can we set fill-prefix to nil and rely on indenting? + +**** xmltok should make available replacement text of entities containing +elements + +**** In rng-valid, instead of using modification-hooks and +insert-behind-hooks on dependent overlays, use same technique as nxml-mode. + +**** Port to XEmacs. Issues include: Unicode (XEmacs seems to be based on +Mule-UCS); overlays/text properties vs extents; absence of +fontification-functions hook. + +*** Fontification + +**** Allow face to depend on element qname, attribute qname, attribute +value. Use list with pairs of (R . F), where R specifies regexps and +F specifies faces. How can this list be made to depend on the document type? + +*** Other + +**** Support RELAX NG XML syntax (use XML parsing library). + +**** Support W3C XML Schema (use XML parsing library). + +**** Command to infer schema from current document (like trang). + +*** Schemas + +**** XSLT schema should take advantage of RELAX NG to express cooccurrence +constraints on attributes (e.g. xsl:template). + +*** Documentation + +**** Move material from README to manual. + +**** Document encodings. + +*** Notes + +**** How can we allow an error to be displayed on a different token from +where it is detected? In particular, for a missing closing ">" we +will need to display it at the beginning of the following token. At the +moment, when we parse the following token the error overlay will get cleared. + +**** How should rng-goto-next-error deal with narrowing? + +**** Perhaps should merge errors having same start position even if they +have different ends. + +**** How to handle surrogates? One possibility is to be compatible with +utf8.e: represent as sequence of 4 chars. But utf-16 is incompatible +with this. + +**** Should we distinguish well-formedness errors from invalidity errors? +(I think not: we may want to recover from a bad start-tag by implying +an end-tag.) + +**** Seems to be a bug with Emacs, where a mouse movement that causes +help-echo text to appear counts as pending input but does not cause +idle timer to be restarted. + +**** Use XML to represent this file. + +**** I had a TODO which said simply "split-string". What did I mean? + +**** Investigate performance on large files all on one line. + +*** Issues for Emacs versions >= 22 + +**** Take advantage of UTF-8 CJK support. + +**** Supply a next-error-function. + +**** Investigate this NEWS item "Emacs now tries to set up buffer coding +systems for HTML/XML files automatically." + +**** Take advantage of the pointer text property. + +**** Leverage char-displayable-p. + * Internal changes ** Cleanup all the GC_ mark bit stuff -- there is no longer any distinction diff --git a/etc/compilation.txt b/etc/compilation.txt index 2041b7f0acc..9cf39c90f9f 100644 --- a/etc/compilation.txt +++ b/etc/compilation.txt @@ -102,42 +102,30 @@ Feature: This is an example for backtrace. Scenario: undefined step # features/cucumber.feature:3 Given this is undefined # features/cucumber.feature:4 - Scenario: assertion false (Test::Unit) # features/cucumber.feature:6 - Given this will generate 'assert false' # features/step_definitions/default_steps.rb:1 + Scenario: assertion false (Test::Unit) # foo/bar.feature:6 + Given this will generate 'assert false' # foo/bar.rb:1 <false> is not true. (Test::Unit::AssertionFailedError) - /home/gusev/.rvm/rubies/ruby-1.8.7-p249/lib/ruby/1.8/test/unit/assertions.rb:48:in `assert_block' - /home/gusev/.rvm/rubies/ruby-1.8.7-p249/lib/ruby/1.8/test/unit/assertions.rb:500:in `_wrap_assertion' - /home/gusev/.rvm/rubies/ruby-1.8.7-p249/lib/ruby/1.8/test/unit/assertions.rb:46:in `assert_block' - /home/gusev/.rvm/rubies/ruby-1.8.7-p249/lib/ruby/1.8/test/unit/assertions.rb:63:in `assert' - /home/gusev/.rvm/rubies/ruby-1.8.7-p249/lib/ruby/1.8/test/unit/assertions.rb:495:in `_wrap_assertion' - /home/gusev/.rvm/rubies/ruby-1.8.7-p249/lib/ruby/1.8/test/unit/assertions.rb:61:in `assert' - ./features/step_definitions/default_steps.rb:2:in `/^this will generate 'assert false'$/' + /home/gusev/.rvm/foo/bar.rb:48:in `assert_block' + /home/gusev/.rvm/foo/bar.rb:500:in `_wrap_assertion' features/cucumber.feature:7:in `Given this will generate 'assert false'' - Scenario: assertion false (RSpec) # features/cucumber.feature:9 - Given this will generate 'should be_true' # features/step_definitions/default_steps.rb:5 + Scenario: assertion false (RSpec) # foo/bar.feature:9 + Given this will generate 'should be_true' # foo/bar.rb:5 expected true to be false (Spec::Expectations::ExpectationNotMetError) - ./features/step_definitions/default_steps.rb:6:in `/^this will generate 'should be_true'$/' - features/cucumber.feature:10:in `Given this will generate 'should be_true'' + ./foo/bar/baz.rb:6:in `/^this will generate 'should be_true'$/' + foo/bar.feature:10:in `Given this will generate 'should be_true'' - Scenario: backtrace in step definition # features/cucumber.feature:12 - Given this will generate backtrace # features/step_definitions/default_steps.rb:9 + Scenario: backtrace in step definition # foo/bar.feature:12 + Given this will generate backtrace # foo/sbar.rb:9 (RuntimeError) - ./features/step_definitions/default_steps.rb:10:in `/^this will generate backtrace$/' - features/cucumber.feature:13:in `Given this will generate backtrace' - - Scenario: deeep backtrace in step definition # features/cucumber.feature:15 - Given this will generate deep backtrace # features/step_definitions/default_steps.rb:13 - (RuntimeError) - ./features/step_definitions/default_steps.rb:18:in `deep' - ./features/step_definitions/default_steps.rb:14:in `/^this will generate deep backtrace$/' - features/cucumber.feature:16:in `Given this will generate deep backtrace' + ./foo/bar.rb:10:in `/^this will generate backtrace$/' + foo/bar.feature:13:in `Given this will generate backtrace' Failing Scenarios: -cucumber features/cucumber.feature:6 # Scenario: assertion false (Test::Unit) -cucumber features/cucumber.feature:9 # Scenario: assertion false (RSpec) -cucumber features/cucumber.feature:12 # Scenario: backtrace in step definition -cucumber features/cucumber.feature:15 # Scenario: deeep backtrace in step definition +cucumber foo/cucumber.feature:6 # Scenario: assertion false (Test::Unit) +cucumber foo/cucumber.feature:9 # Scenario: assertion false (RSpec) +cucumber foo/cucumber.feature:12 # Scenario: backtrace in step definition +cucumber foo/cucumber.feature:15 # Scenario: deeep backtrace in step definition 5 scenarios (4 failed, 1 undefined) 5 steps (4 failed, 1 undefined) diff --git a/etc/emacs.bash b/etc/emacs.bash deleted file mode 100644 index 5cebee1227d..00000000000 --- a/etc/emacs.bash +++ /dev/null @@ -1,71 +0,0 @@ -### emacs.bash --- contact/resume an existing Emacs, or start a new one - -## Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -## Free Software Foundation, Inc. - -## Author: Noah Friedman - -## This file is part of GNU Emacs. - -## GNU Emacs is free software: you can redistribute it and/or modify -## it under the terms of the GNU General Public License as published by -## the Free Software Foundation, either version 3 of the License, or -## (at your option) any later version. - -## GNU Emacs is distributed in the hope that it will be useful, -## but WITHOUT ANY WARRANTY; without even the implied warranty of -## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -## GNU General Public License for more details. - -## You should have received a copy of the GNU General Public License -## along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -### Commentary: - -## This file is obsolete. Use emacsclient -a instead. - -## This defines a bash command named `edit' which contacts/resumes an -## existing emacs or starts a new one if none exists. - -## One way or another, any arguments are passed to emacs to specify files -## (provided you have loaded `resume.el'). - -## This function assumes the emacs program is named `emacs' and is somewhere -## in your load path. If either of these is not true, the most portable -## (and convenient) thing to do is to make an alias called emacs which -## refers to the real program, e.g. -## -## alias emacs=/usr/local/bin/gemacs - -function edit () -{ - local windowsys="${WINDOW_PARENT+sun}" - - windowsys="${windowsys:-${DISPLAY+x}}" - - if [ -n "${windowsys:+set}" ]; then - # Do not just test if these files are sockets. On some systems - # ordinary files or fifos are used instead. Just see if they exist. - if [ -e "${HOME}/.emacs_server" -o -e "/tmp/emacs${UID}/server" ]; then - emacsclient "$@" - return $? - else - echo "edit: starting emacs in background..." 1>&2 - fi - - case "${windowsys}" in - x ) (emacs "$@" &) ;; - sun ) echo "unsupported window system"; return 1 ;; - esac - else - if jobs %emacs 2> /dev/null ; then - echo "$(pwd)" "$@" >| ${HOME}/.emacs_args && fg %emacs - else - emacs "$@" - fi - fi -} - - -# arch-tag: 1e1b74b9-bf2c-4b23-870f-9eebff7515cb -### emacs.bash ends here diff --git a/etc/emacs.csh b/etc/emacs.csh deleted file mode 100644 index ef860727284..00000000000 --- a/etc/emacs.csh +++ /dev/null @@ -1,31 +0,0 @@ -### emacs.csh - -## Add legal notice if non-trivial amounts of code are added. - -## Author: Michael DeCorte - -### Commentary: - -## This file is obsolete. Use emacsclient -a instead. - -## This defines a csh command named `edit' which resumes an -## existing Emacs or starts a new one if none exists. -## One way or another, any arguments are passed to Emacs to specify files -## (provided you have loaded `resume.el'). - -## These are the possible values of $whichjob -## 1 = new ordinary emacs (the -nw is so that it doesn't try to do X) -## 2 = resume emacs -## 3 = new emacs under X (-i is so that you get a reasonable icon) -## 4 = resume emacs under X -set EMACS_PATTERN="^\[[0-9]\] . Stopped ............ $EMACS" - -alias edit 'set emacs_command=("emacs -nw \!*" "fg %emacs" "emacs -i \!* &"\ - "emacsclient \!* &") ; \ - jobs >! $HOME/.jobs; grep "$EMACS_PATTERN" < $HOME/.jobs >& /dev/null; \ - @ isjob = ! $status; \ - @ whichjob = 1 + $isjob + $?DISPLAY * 2 + $?WINDOW_PARENT * 4; \ - test -S ~/.emacs_server && emacsclient \!* \ - || echo `pwd` \!* >! ~/.emacs_args && eval $emacs_command[$whichjob]' - -# arch-tag: 433d58df-15b9-446f-ad37-f0393e3a23d4 diff --git a/etc/emacs3.py b/etc/emacs3.py index fd2e7c97c53..de81848e5c3 100644 --- a/etc/emacs3.py +++ b/etc/emacs3.py @@ -1,10 +1,3 @@ -""" -Warning: This file is automatically generated from emacs2.py with the -2to3 script. Do not hand edit. -""" - -"""Definitions used by commands sent to inferior Python in python.el.""" - # Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. # Author: Dave Love <fx@gnu.org> @@ -23,7 +16,7 @@ Warning: This file is automatically generated from emacs2.py with the # You should have received a copy of the GNU General Public License # along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. -import os, sys, traceback, inspect, __main__ +import os, sys, traceback, inspect, imp, __main__ try: set @@ -216,7 +209,7 @@ def eimport (mod, dir): try: try: if mod in __dict__ and inspect.ismodule (__dict__[mod]): - reload (__dict__[mod]) + imp.reload (__dict__[mod]) else: __dict__[mod] = __import__ (mod) except: diff --git a/etc/gnus/gnus-setup.ast b/etc/gnus/gnus-setup.ast index 31eeee024e1..f2493b8653f 100644 --- a/etc/gnus/gnus-setup.ast +++ b/etc/gnus/gnus-setup.ast @@ -48,8 +48,3 @@ Run M-x assistant and use the news-server.ast file as input. @c Local variables: @c mode: texinfo @c End: - -@ignore - arch-tag: 6b7b200b-9169-4b44-8b32-b73773fa71af -@end ignore - diff --git a/etc/ms-kermit b/etc/ms-kermit deleted file mode 100644 index ba53add6a78..00000000000 --- a/etc/ms-kermit +++ /dev/null @@ -1,172 +0,0 @@ -;;; The code here is forced by the interface, and is not subject to -;;; copyright, constituting the only possible expression of the algorithm -;;; in this format. - -;;; This file is designed for an 8-bit connection. -;;; Use the file ms-7bkermit if you have a 7-bit connection. - -;; Meta key mappings for EMACS -;; By Robert Earl (rearl@watnxt3.ucr.edu) -;; May 13, 1990 -;; -;; WARNING: -;; requires an 8-bit path to host. many dialups and lans won't pass the -;; eighth bit by default and may require a special command to turn this -;; off. `screen' is known to mask the eighth bit of input as well. - -set term controls 8-bit -set translation key off - -;; control keys -set key \3449 \128 ;; m-c-@ -set key \3358 \129 ;; m-c-a -set key \3376 \130 ;; m-c-b -set key \3374 \131 ;; m-c-c -set key \3360 \132 ;; m-c-d -set key \3346 \133 ;; m-c-e -set key \3361 \134 ;; m-c-f -set key \3362 \135 ;; m-c-g -set key \3342 \136 ;; m-bs -set key \3363 \136 ;; m-c-h (sends same code as above) -set key \2469 \137 ;; m-tab -set key \3351 \137 ;; m-c-i (same as above) -set key \3364 \138 ;; m-c-j -set key \3365 \139 ;; m-c-k -set key \3366 \140 ;; m-c-l -;set key \3378 \141 ;; m-c-m -set key \2332 \141 ;; m-ret (sends same code as above) -set key \3377 \142 ;; m-c-n -set key \3352 \143 ;; m-c-o -set key \3353 \144 ;; m-c-p -set key \3344 \145 ;; m-c-q -set key \3347 \146 ;; m-c-r -set key \3359 \147 ;; m-c-s -set key \3348 \148 ;; m-c-t -set key \3350 \149 ;; m-c-u -set key \3375 \150 ;; m-c-v -set key \3345 \151 ;; m-c-w -set key \3373 \152 ;; m-c-x -set key \3349 \153 ;; m-c-y -set key \3372 \154 ;; m-c-z - -;; misc keys -;set key \3354 \155 ;; m-c-[ -set key \2305 \155 ;; m-esc (sends same as above) -set key \3371 \156 ;; m-c-\ -set key \3355 \157 ;; m-c-] -set key \3453 \158 ;; m-c-^ -set key \3458 \159 ;; m-c-_ - -;; \160 is conspicuously missing here-- -;; alt-spc doesn't generate a distinct scan code... -;; neither do shift-spc and ctrl-spc. -;; no idea why. - -set key \2936 \161 ;; m-! -set key \2856 \162 ;; m-" -set key \2938 \163 ;; m-# -set key \2939 \164 ;; m-$ -set key \2940 \165 ;; m-% -set key \2942 \166 ;; m-& -set key \2344 \167 ;; m-' -set key \2944 \168 ;; m-( -set key \2945 \169 ;; m-) -set key \2943 \170 ;; m-* -set key \2947 \171 ;; m-+ -set key \2355 \172 ;; m-, -set key \2434 \173 ;; m-- -set key \2356 \174 ;; m-. -set key \2357 \175 ;; m-/ - -;; number keys -set key \2433 \176 ;; m-0 -set key \2424 \177 ;; m-1 -set key \2425 \178 -set key \2426 \179 -set key \2427 \180 -set key \2428 \181 -set key \2429 \182 -set key \2430 \183 -set key \2431 \184 -set key \2432 \185 ;; m-9 - -set key \2855 \186 ;; m-: -set key \2343 \187 ;; m-; -set key \2867 \188 ;; m-< -set key \2435 \189 ;; m-= -set key \2868 \190 ;; m-> -set key \2869 \191 ;; m-? -set key \2937 \192 ;; m-@ - -;; shifted A-Z -set key \2846 \193 ;; m-A -set key \2864 \194 -set key \2862 \195 -set key \2848 \196 -set key \2834 \197 -set key \2849 \198 -set key \2850 \199 -set key \2851 \200 -set key \2839 \201 -set key \2852 \202 -set key \2853 \203 -set key \2854 \204 -set key \2866 \205 -set key \2865 \206 -set key \2840 \207 -set key \2841 \208 -set key \2832 \209 -set key \2835 \210 -set key \2847 \211 -set key \2836 \212 -set key \2838 \213 -set key \2863 \214 -set key \2833 \215 -set key \2861 \216 -set key \2837 \217 -set key \2860 \218 ;; m-Z - -set key \2330 \219 ;; m-[ -set key \2347 \220 ;; m-\ -set key \2331 \221 ;; m-] -set key \2941 \222 ;; m-^ -set key \2946 \223 ;; m-_ -set key \2345 \224 ;; m-` - -;; lowercase a-z -set key \2334 \225 ;; m-a -set key \2352 \226 -set key \2350 \227 -set key \2336 \228 -set key \2322 \229 -set key \2337 \230 -set key \2338 \231 -set key \2339 \232 -set key \2327 \233 -set key \2340 \234 -set key \2341 \235 -set key \2342 \236 -set key \2354 \237 -set key \2353 \238 -set key \2328 \239 -set key \2329 \240 -set key \2320 \241 -set key \2323 \242 -set key \2335 \243 -set key \2324 \244 -set key \2326 \245 -set key \2351 \246 -set key \2321 \247 -set key \2349 \248 -set key \2325 \249 -set key \2348 \250 ;; m-z - -;; more shifted misc. keys -set key \2842 \251 ;; m-{ -set key \2859 \252 ;; m-| -set key \2843 \253 ;; m-} -set key \2857 \254 ;; m-~ -set key \2318 \255 ;; m-del - - -;;; arch-tag: 93cefb0a-2b07-4d09-ae78-4d807b15645d diff --git a/etc/refcards/gnus-refcard.tex b/etc/refcards/gnus-refcard.tex index ec9451587bd..1b23188cd93 100644 --- a/etc/refcards/gnus-refcard.tex +++ b/etc/refcards/gnus-refcard.tex @@ -1425,5 +1425,3 @@ %%% mode: latex %%% TeX-master: t %%% End: - -% arch-tag: be438b0e-6832-4afb-8c56-5f84743e5cd1 diff --git a/etc/tutorials/TUTORIAL.he b/etc/tutorials/TUTORIAL.he index a72bf72d4d6..8c376314d2e 100644 --- a/etc/tutorials/TUTORIAL.he +++ b/etc/tutorials/TUTORIAL.he @@ -1,6 +1,6 @@ -שיעור ר×שון בשימוש ב-Emacs. זכויות שימוש ר××” בסוף המסמך. +שיעור ר×שון בשימוש ב־Emacs. זכויות שימוש ר××” בסוף המסמך. -פקודות רבות של Emacs משתמשות במקש CONTROL (×œ×¤×¢×ž×™× ×”×•× ×ž×¡×•×ž×Ÿ ב-CTRL ×ו CTL) +פקודות רבות של Emacs משתמשות במקש CONTROL (×œ×¤×¢×ž×™× ×”×•× ×ž×¡×•×ž×Ÿ ב־CTRL ×ו CTL) ×ו במקש META (×œ×¤×¢×ž×™× ×ž×¡×•×ž×Ÿ EDIT ×ו ALT). ×‘×ž×§×•× ×œ×¦×™×™×Ÿ ×ת כל השמות ×”××¤×©×¨×™×™× ×‘×›×œ פע×, × ×©×ª×ž×© ×‘×§×™×¦×•×¨×™× ×”×‘××™×: @@ -10,13 +10,13 @@ ×× ×‘×ž×§×œ×“×ª ×ין ××£ ×חד ממקשי META ×ו EDIT ×ו ALT, ×פשר להקיש ולשחרר מקש ESC ו××– להקיש <תו>. ×× ×• × ×›×ª×•×‘ <ESC> עבור מקש ESC. -הערה חשובה: כדי לצ×ת מ-Emacs יש להקיש C-x C-c (×©× ×™ תוי×, משמ×ל לימין). +הערה חשובה: כדי לצ×ת מ־Emacs יש להקיש C-x C-c (×©× ×™ תוי×, משמ×ל לימין). כדי להפסיק פקודה ב×מצע ההקשה, יש להקיש C-g. המחרוזת ">>" בקצה ×”×™×ž× ×™ ×ž×¡×ž× ×ª הור×ות ×¢×‘×•×¨×›× ×›×“×™ ×œ× ×¡×•×ª להשתמש בפקודה כלשהי. לדוגמה: <<שורות ריקות ×ª×ª×•×•×¡×¤× ×” סביב השורה הב××” ×¢"×™ help-with-tutorial>> [×מצע העמוד הוש×ר ריק למטרות לימודיות. הטקסט ממשיך להלן] ->> הקישו עתה C-v (הצג העמוד הב×) על-×ž× ×ª ×œ×”×ª×§×“× ×œ×¢×ž×•×“ הב×. (קדימה, × ×¡×• +>> הקישו עתה C-v (הצג העמוד הב×) ×¢×œÖ¾×ž× ×ª ×œ×”×ª×§×“× ×œ×¢×ž×•×“ הב×. (קדימה, × ×¡×• ×–×ת ×¢"×™ לחיצה והחזקה של מקש CONTROL והקשה על v.) מעתה והל××”, ×¢×œ×™×›× ×œ×¢×©×•×ª ×–×ת בכל ×¤×¢× ×©×ª×¡×™×™×ž×• ×œ×§×¨×•× ×ת המוצג על המסך. @@ -28,7 +28,7 @@ (החזיקו מקש META והקישו v ×ו הקישו â€<ESC>v‬ ×× ×ין במקלדת מקש META ×ו EDIT ×ו ALT). ->> × ×¡×• עתה כמה ×¤×¢×ž×™× ×œ×”×§×™×© M-v ו×חר-כך C-v. +>> × ×¡×• עתה כמה ×¤×¢×ž×™× ×œ×”×§×™×© M-v ו×חר־כך C-v. * ×¡×™×›×•× ×¢×“ ×›×ן @@ -42,24 +42,24 @@ כך שהטקסט ליד הסמן ×™×™×ž×¦× ×‘×ž×¨×›×– התצוגה (שימו לב: CONTROL-L ×•×œ× CONTROL-1.) ->> מצ×ו ×ת הסמן על-גבי התצוגה וזכרו ×ת הטקסט לידו. ל×חר מכן הקישו C-l. +>> מצ×ו ×ת הסמן על־גבי התצוגה וזכרו ×ת הטקסט לידו. ל×חר מכן הקישו C-l. מצ×ו ×ת הסמן ×©× ×™×ª ושימו לב ×©×”×•× ×¢×“×™×™×Ÿ ליד ×ותו הטקסט, ×בל עכשיו ×”×•× ×‘×ž×¨×›×– התצוגה. ×× ×ª×§×™×©×• C-l שוב, קטע הטקסט ×”×–×” יזוז לקצה העליון של התצוגה. הקישו C-l שוב ×•×”×•× ×™×–×•×– לתחתית התצוגה. -×’× ×ž×§×©×™ PageUp ו-PageDn, ×× ×”× ×§×™×™×ž×™× ×‘×ž×§×œ×“×ª שלכ×, ×™×›×•×œ×™× ×œ×©×ž×© ×œ×ª× ×•×¢×” -×‘×¢×ž×•×“×™× ×©×œ×ž×™×, ××•×œ× ×”×©×™×ž×•×© ב-C-v ו-M-v יעיל יותר. +×’× ×ž×§×©×™ PageUp ו־PageDn, ×× ×”× ×§×™×™×ž×™× ×‘×ž×§×œ×“×ª שלכ×, ×™×›×•×œ×™× ×œ×©×ž×© ×œ×ª× ×•×¢×” +×‘×¢×ž×•×“×™× ×©×œ×ž×™×, ××•×œ× ×”×©×™×ž×•×© ב־C-v ו־M-v יעיל יותר. * ×ª× ×•×¢×ª סמן בסיסית ------------------ ×ª× ×•×¢×” ×‘×¢×ž×•×“×™× ×©×œ×ž×™× ×”×™× ×” שימושית, ×בל כיצד × ×™×ª×Ÿ להגיע ×œ×ž×§×•× ×¡×¤×¦×™×¤×™ -בתוך הטקסט שעל-גבי התצוגה? +בתוך הטקסט שעל־גבי התצוגה? × ×™×ª×Ÿ לעשות ×–×ת בכמה דרכי×. ×פשר למשל להשתמש במקשי החצי×, ××•×œ× ×™×”×™×” ×–×” יעיל יותר ×× ×ª×—×–×™×§×• ×ת ×”×™×“×™×™× ×ž×¢×œ החלק ×”×¡×˜× ×“×¨×˜×™ של המקלדת ותשתמשו -בפקודות C-p, C-b, C-f ו-C-n. פקודות ×לו שוות ערך ל×רבעת מקשי החצי×, +בפקודות C-p, C-b, C-f ו־C-n. פקודות ×לו שוות ערך ל×רבעת מקשי החצי×, כדלקמן: שורה קודמת, C-p @@ -70,58 +70,58 @@ : השורה הב××”, C-n ->> השתמשו במקשי C-n ו-C-p על-×ž× ×ª להגיע לשורה ×”×מצעית של הדי×גרמה. - הקישו C-l כדי למרכז ×ת הדי×גרמה על-גבי התצוגה. +>> השתמשו במקשי C-n ו־C-p ×¢×œÖ¾×ž× ×ª להגיע לשורה ×”×מצעית של הדי×גרמה. + הקישו C-l כדי למרכז ×ת הדי×גרמה על־גבי התצוגה. קל יותר לזכור ×ת ×”×ž×§×©×™× ×”×œ×œ×• ב×מצעות ×”×ž×œ×™× ×©×”× ×ž×™×™×¦×’×™×: -P מ-previous (קוד×), N מ-Next (הב×), B מ-Backward (×חורה) -ו-F מ-Forward (קדימה). מקשי ×”×ª× ×•×¢×” ×”×‘×¡×™×¡×™×™× ×”×œ×œ×• ישמשו ××ª×›× ×›×œ הזמן. +P מ־previous (קוד×), N מ־Next (הב×), B מ־Backward (×חורה) +ו־F מ־Forward (קדימה). מקשי ×”×ª× ×•×¢×” ×”×‘×¡×™×¡×™×™× ×”×œ×œ×• ישמשו ××ª×›× ×›×œ הזמן. >> הקישו C-n כמה ×¤×¢×ž×™× ×›×“×™ ×œ×ž×§× ×ת הסמן בשורה זו. ->> ×”× ×™×¢×• ×ת הסמן בתוך השורה ×¢× C-f ו×חר-כך למעלה ×¢× C-p. +>> ×”× ×™×¢×• ×ת הסמן בתוך השורה ×¢× C-f ו×חר־כך למעלה ×¢× C-p. שימו לב מה עושה C-p ×›×שר הסמן × ×ž×¦× ×‘×מצע השורה. כל שורה של טקטס מסתיימת בתו מיוחד ×”× ×§×¨× Newline. תו ×–×” מפריד בין השורה לזו ש×חריה. (בדרך כלל, השורה ×”××—×¨×•× ×” בקובץ ×ª×¡×ª×™×™× ××£ ×”×™× -ב-Newline, ×ך Emacs ××™× ×• זקוק לכך.) +ב־Newline, ×ך Emacs ××™× ×• זקוק לכך.) >> × ×¡×• C-b בתחילת שורה. ×”×•× ×™×’×¨×•× ×œ×¡×ž×Ÿ ×œ× ×•×¢ לסוף השורה הקודמת. ×–×ת, - ×ž×©×•× ×©×”×•× × ×¢ ×חורה וחולף על-×¤× ×™ תו ×”-Newline. + ×ž×©×•× ×©×”×•× × ×¢ ×חורה וחולף ×¢×œÖ¾×¤× ×™ תו ×”Ö¾Newline. -×’× C-f יכול לחלוף על-×¤× ×™ Newline, בדיוק כמו C-b. +×’× C-f יכול לחלוף ×¢×œÖ¾×¤× ×™ Newline, בדיוק כמו C-b. >> הקישו C-b עוד כמה ×¤×¢×ž×™× ×›×“×™ לקבל הרגשה היכן × ×ž×¦× ×”×¡×ž×Ÿ. עתה הקישו C-f מספר ×¤×¢×ž×™× ×”×“×¨×•×© לשוב לסוף השורה. ו××– הקישו C-f עוד ×¤×¢× ×חת כדי ×œ× ×•×¢ לתחילת השורה הב××”. כשהסמן ×™×•×¦× ×ž×’×‘×•×œ×•×ª הטקסט המוצג, חלקי הטקסט מעבר לחלק המוצג × ×›× ×¡×™× -לתצוגה. לזה קור××™× "גלילה". גלילה מ×פשרת ל-Emacs ×œ×”× ×™×¢ ×ת הסמן ×œ×ž×§×•× +לתצוגה. לזה קור××™× "גלילה". גלילה מ×פשרת ל־Emacs ×œ×”× ×™×¢ ×ת הסמן ×œ×ž×§×•× ×›×œ×©×”×• בטקסט מבלי שהסמן ×™×™×¢×œ× ×ž×”×ª×¦×•×’×”. >> × ×¡×• ×œ×”× ×™×¢ ×ת הסמן ×ל מחוץ לתצוגה ×¢"×™ הקשת C-n ושימו לב למה שקורה. -×× ×ª× ×•×¢×” תו-תו ×יטית מדי, תוכלו ×œ× ×•×¢ ×ž×™×œ×™× ×©×œ×ž×•×ª. M-f â€(META-f) מזיז +×× ×ª× ×•×¢×” תו־תו ×יטית מדי, תוכלו ×œ× ×•×¢ ×ž×™×œ×™× ×©×œ×ž×•×ª. M-f â€(META-f) מזיז ×ת הסמן מילה ×חת קדימה ו×ילו M-b ×–×– מילה ×חורה. ->> הקישו M-f ו-M-b מספר פעמי×. +>> הקישו M-f ו־M-b מספר פעמי×. ×× ×”×¡×ž×Ÿ × ×ž×¦× ×‘×מצע מילה, M-f ×–×– לסוף המילה. ×× ×”×¡×ž×Ÿ × ×ž×¦× ×‘×™×Ÿ שתי מלי×, M-f עובר ×ת המילה הב××” ×•× ×¢×¦×¨ בסופה. M-b פועל ב×ופן דומה בכיוון הפוך. ->> הקישו עתה M-f ו-M-b ×¤×¢×ž×™× ×חדות, ×•×’× C-f ו-C-b פה ×•×©× ×›×“×™ שתוכלו - ×œ×”×ª×¨×©× ×ž×”×ª×•×¦××” של M-f ו-M-b במקומות ×©×•× ×™× ×‘×ª×•×š ובין המלי×. +>> הקישו עתה M-f ו־M-b ×¤×¢×ž×™× ×חדות, ×•×’× C-f ו־C-b פה ×•×©× ×›×“×™ שתוכלו + ×œ×”×ª×¨×©× ×ž×”×ª×•×¦××” של M-f ו־M-b במקומות ×©×•× ×™× ×‘×ª×•×š ובין המלי×. -שימו לב להקבלה שבין C-f ו-C-b מצד ×חד ו-M-f ו-M-b מהצד ×”×©× ×™. ×œ×¢×ª×™× +שימו לב להקבלה שבין C-f ו־C-b מצד ×חד ו־M-f ו־M-b מהצד ×”×©× ×™. ×œ×¢×ª×™× ×§×¨×•×‘×•×ª מ×ד ×ž×§×©×™× ×¢× META ×ž×©×ž×©×™× ×œ×¤×¢×•×œ×•×ª הקשורות ליחידות של שפה (מלי×, משפטי×, פסק×ות) ו×ילו ×ž×§×©×™× ×¢× CONTROL ×¤×•×¢×œ×™× ×¢×œ יחידות בסיסיות ש××™× ×Ÿ תלויות בסוג הטקסט ×©×”×™× ×›×š ×¢×•×¨×›×™× (תוי×, שורות, וכד'). -ההקבלה ×”×–×ת קיימת ×’× ×œ×’×‘×™ שורות ומשפטי×: C-a ו-C-e × ×¢×™× ×œ×ª×—×™×œ×ª השורה -וסופה, בהת×מה, ו×ילו M-a ו-M-e × ×¢×™× ×œ×ª×—×™×œ×ª המשפט וסופו. +ההקבלה ×”×–×ת קיימת ×’× ×œ×’×‘×™ שורות ומשפטי×: C-a ו־C-e × ×¢×™× ×œ×ª×—×™×œ×ª השורה +וסופה, בהת×מה, ו×ילו M-a ו־M-e × ×¢×™× ×œ×ª×—×™×œ×ª המשפט וסופו. ->> × ×¡×• עתה שתי הקשות על C-a ו×חר-כך שתי הקשות על C-e. - × ×¡×• ×©× ×™ M-a ו×חר-כך ×©× ×™ M-e. +>> × ×¡×• עתה שתי הקשות על C-a ו×חר־כך שתי הקשות על C-e. + × ×¡×• ×©× ×™ M-a ו×חר־כך ×©× ×™ M-e. שימו לב שחזרה על C-a ××™× ×” עושה דבר, ו×ילו כל הקשה חוזרת על M-a ×ž× ×™×¢×” ×ת הסמן במשפט × ×•×¡×£. ××ž× × ×ין ×›×ן ×× ×œ×•×’×™×” מושלמת, ×בל התוצ××” × ×¨×ית @@ -152,20 +152,20 @@ M-f עובר ×ת המילה הב××” ×•× ×¢×¦×¨ בסופה. M-b פועל ב×ו ×לו הן הפקודות ×”× ×¤×•×¦×•×ª ביותר. שתי פקודות ×ª× ×•×¢×” חשובות ×חרת הן â€M-<‬ â€(META פחות), ×שר × ×¢×” לתחילת -הטקסט, ו-â€M->‬ â€(META יותר), ×שר × ×¢×” לסוף הטקסט. +הטקסט, ו־â€M->‬ â€(META יותר), ×שר × ×¢×” לסוף הטקסט. ברוב המקלדות המקש ">" × ×ž×¦× ×ž×¢×œ הפסיק, לכן כדי להקישו יש צורך ללחוץ ולהחזיק מקש Shift. ב×ופן דומה יש ללחוץ על Shift כדי להקיש â€M-<‬כי ×חרת ×”×™×” ×™×•×¦× M-פסיק. >> × ×¡×• עתה â€M-<‬ כדי להגיע לתחילת השיעור. - ×חר-כך הקישו C-v מספר פעמי×, עד שתגיעו לכ×ן. + ×חר־כך הקישו C-v מספר פעמי×, עד שתגיעו לכ×ן. >> עכשיו × ×¡×• â€M->‬ כדי להגיע לסוף השיעור. ל×חר מכן הקישו M-v כמה ×¤×¢×ž×™× ×›×“×™ לחזור לכ×ן. × ×™×ª×Ÿ להזיז ×ת הסמן ×’× ×‘×¢×–×¨×ª מקשי החצי×, ×× ×”× ×§×™×™×ž×™× ×‘×ž×§×œ×“×ª שלכ×. -×בל ×× ×—× ×• ×ž×ž×œ×™×¦×™× ×œ×œ×ž×•×“ להשתמש ב-C-b, C-f, C-n ו-C-p משלוש סיבות. +×בל ×× ×—× ×• ×ž×ž×œ×™×¦×™× ×œ×œ×ž×•×“ להשתמש ב־C-b, C-f, C-n ו־C-p משלוש סיבות. ×§×•×“× ×›×œ, ×”× ×™×¢×‘×“×• ×¢× ×›×œ מקלדת. ×©× ×™×ª, כשתתרגלו לעבוד ×¢× Emacs, תר×ו ×›×™ השימוש ×‘×ž×§×©×™× ×לו מהיר יותר מהשימוש ×‘×—×¦×™× (מכיון ש×ין צורך להזיז ×ת היד מהחלק העיקרי של המקלדת). ושלישית, ×›×©×”×ž×§×©×™× ×”×œ×œ×• יהפכו להרגל, @@ -173,7 +173,7 @@ M-f עובר ×ת המילה הב××” ×•× ×¢×¦×¨ בסופה. M-b פועל ב×ו רוב הפקודות של Emacs מקבלות ××¨×’×•×ž× ×˜ × ×•×ž×¨×™; עבור רוב הפקודות ×”××¨×’×•×ž× ×˜ משמש ×›×ž×•× ×” של מספר החזרות על הפקודה. כדי לספק ××¨×’×•×ž× ×˜ לפקודה, יש להקיש -C-u ו×חר-כך ספרות, וז×ת ×œ×¤× ×™ ×©×ž×§×™×©×™× ×ת הפקודה עצמה. ×¢× ×‘×ž×§×œ×“×ª ×§×™×™× +C-u ו×חר־כך ספרות, וז×ת ×œ×¤× ×™ ×©×ž×§×™×©×™× ×ת הפקודה עצמה. ×¢× ×‘×ž×§×œ×“×ª ×§×™×™× ×ž×§×© META (×ו EDIT ×ו ALT), יש ×’× ×פשרות ×חרת לציין ××¨×’×•×ž× ×˜ × ×•×ž×¨×™: הקישו ×ת הספרות תוך כדי החזקת מקש META. ×× ×• ×ž×ž×œ×™×¦×™× ×¢×œ C-u ×ž×©×•× ×©×”×•× ×™×¢×‘×•×“ ×¢× ×›×œ מקלדת. ×”××¨×’×•×ž× ×˜ ×”× ×•×ž×¨×™ × ×§×¨× ×’× "××¨×’×•×ž× ×˜ קידומת" (prefix @@ -189,16 +189,16 @@ argument) ×ž×©×•× ×ž×§×™×©×™× ×ותו ×œ×¤× ×™ הפקודה ×ליה ×”×•× × ×ž×©×ª×ž×©×•×ª בו כדגלון -- × ×•×›×—×•×ª×• של ×”××¨×’×•×ž× ×˜, ×œ×œ× ×§×©×¨ לערכו המספרי, גורמת לפקודה ×œ×”×ª× ×”×’ קצת ×חרת. -â€C-v ו-M-v יוצ××™× ×ž×”×›×œ×œ ×”×–×” ב×ופן ×חר. כשפקודות ×לו מקבלות ××¨×’×•×ž× ×˜, +â€C-v ו־M-v יוצ××™× ×ž×”×›×œ×œ ×”×–×” ב×ופן ×חר. כשפקודות ×לו מקבלות ××¨×’×•×ž× ×˜, הן ×’×•×œ×œ×™× ×ת התצוגה כמספר ×”×–×” של שורות, ×•×œ× ×‘×“×¤×™×. למשל, C-u 8 C-v -יגלול ×ת התצוגה ב-8 שורות. +יגלול ×ת התצוגה ב־8 שורות. >> × ×¡×• עתה להקיש C-u 8 C-v. -כתוצ××”, התצוגה היתה צריכה לזוז ב-8 שורות. ×× ×‘×¨×¦×•× ×›× ×œ×’×œ×•×œ בחזרה, -×פשר להשיג ×–×ת ×¢"×™ מתן ××¨×’×•×ž× ×˜ ל-M-v. +כתוצ××”, התצוגה היתה צריכה לזוז ב־8 שורות. ×× ×‘×¨×¦×•× ×›× ×œ×’×œ×•×œ בחזרה, +×פשר להשיג ×–×ת ×¢"×™ מתן ××¨×’×•×ž× ×˜ ל־M-v. -×× ×”×¤×¢×œ×ª× ×ת Emacs על-גבי מערכת ×—×œ×•× ×ית כגון X ×ו MS-Windows, ××ª× +×× ×”×¤×¢×œ×ª× ×ת Emacs על־גבי מערכת ×—×œ×•× ×ית כגון X ×ו MS-Windows, ××ª× ×¦×¨×™×›×™× ×œ×¨×ות פס צר וגבוה, ששמו פס גלילה (scroll bar) בצידו של החלון של Emacs. (שימו לב ×©×‘×©× ×™ צידי החלון ×§×™×™×ž×™× ×¤×¡×™× × ×•×¡×¤×™×. ×לה × ×§×¨××™× "השוליי×" -- "fringes" -- ×•×ž×©×ž×©×™× ×œ×”×¦×’×ª ×¡×™×ž× ×™ המשך שורה ×•×¡×™×ž×•× ×™× @@ -231,7 +231,7 @@ argument) ×ž×©×•× ×ž×§×™×©×™× ×ותו ×œ×¤× ×™ הפקודה ×ליה ×”×•× × * פקודות ×ž× ×•×˜×¨×œ×•×ª ----------------- -מספר פקודות ב-Emacs ×ž× ×•×˜×¨×œ×•×ª ×‘×›×•×•× ×” כדי ×©×ž×©×ª×ž×©×™× ×ž×ª×—×™×œ×™× ×œ× ×™×¤×¢×™×œ×• +מספר פקודות ב־Emacs ×ž× ×•×˜×¨×œ×•×ª ×‘×›×•×•× ×” כדי ×©×ž×©×ª×ž×©×™× ×ž×ª×—×™×œ×™× ×œ× ×™×¤×¢×™×œ×• ×ותן בדרך מקרה. ×× ×ª×§×™×©×• ×ת ×חת הפקודות הללו, Emacs יציג הודעה המת×רת ×ת הפקודה ויש×ל @@ -262,13 +262,13 @@ argument) ×ž×©×•× ×ž×§×™×©×™× ×ותו ×œ×¤× ×™ הפקודה ×ליה ×”×•× × >> הקישו C-x 1 ושימו לב שהחלון ×¢× ×”×”×¡×‘×¨ על C-f × ×¢×œ×. פקודה זו ×©×•× ×” מכל ש×ר הפקודות ×©×œ×ž×“× ×• עד ×›×” בכך ×©×”×™× ×ž×›×™×œ×” ×©× ×™ תוי×. -×”×™× ×ž×ª×—×™×œ×” ×¢× ×”×ª×• CONTROL-x. פקודות רבות מ×ד מתחילות ב-CONTROL-x; חלק +×”×™× ×ž×ª×—×™×œ×” ×¢× ×”×ª×• CONTROL-x. פקודות רבות מ×ד מתחילות ב־CONTROL-x; חלק גדול מהן עוסקות ×‘×—×œ×•× ×•×ª, קבצי×, ×—×•×¦×¦×™× ×•× ×•×©××™× ×“×•×ž×™× ×חרי×. פקודות ×לו מכילות ×©× ×™×, שלושה ו×פילו ×רבעה תוי×. * ×”×›× ×¡×” ומחיקה -------------- +-------------- ×× ×‘×¨×¦×•× ×›× ×œ×”×›× ×™×¡ טקסט, פשוט הקישו על ×”×ž×§×©×™× ×”×ž×ª×ימי×. ×ª×•×™× ×¨×’×™×œ×™×, כגון A, ×, 7, * וכד' ×ž×ª×¤×¨×©×™× ×¢"×™ Emacs כטקסט ומיד ×ž×ª×•×•×¡×¤×™× ×œ×˜×§×¡×˜ @@ -278,15 +278,15 @@ argument) ×ž×©×•× ×ž×§×™×©×™× ×ותו ×œ×¤× ×™ הפקודה ×ליה ×”×•× × ×œ×ž×—×™×§×ª התו ×”×חרון ×©×”×§×©×ª× ×”×§×™×©×• <DelBack>. המקש ש×× ×• קור××™× ×œ×• <DelBack> יכול ×œ×”×ª×§×¨× ×‘×©×ž×•×ª ×©×•× ×™× -- "Delete", "DEL" ×ו "Backspace". בדרך כלל זהו מקש גדול ובולט ×©× ×ž×¦× ×œ× ×”×¨×—×§ ממקש <Return>, ×•×”×•× ×ž×©×ž×© ××ª×›× ×œ×ž×—×™×§×ª -התו ×חרון ×’× ×‘×ª×•×›× ×™×•×ª ×חרות, ×œ× ×¨×§ ב-Emacs. +התו ×חרון ×’× ×‘×ª×•×›× ×™×•×ª ×חרות, ×œ× ×¨×§ ב־Emacs. ×× ×§×™×™× ×‘×ž×§×œ×“×ª ×©×œ×›× ×ž×§×© גדול שעליו ×¨×©×•× <Backspace>, ××– זהון המקש ×שר -ישמש ×›-<DelBack>. ×’× ×× ×™×”×™×” מקש ×חר המסומן ב-"Delete" ×‘×ž×§×•× ×חרת ×–×” -××™× ×• ×”-<DelBack> שלכ×. +ישמש ×›Ö¾<DelBack>. ×’× ×× ×™×”×™×” מקש ×חר המסומן ב־"Delete" ×‘×ž×§×•× ×חרת ×–×” +××™× ×• ×”Ö¾<DelBack> שלכ×. ב×ופן כללי יותר, <DelBack> מוחק ×ת התו ×©×§×•×“× ×œ×ž×™×§×•× ×”×¡×ž×Ÿ. ->> הקישו עתה מספר תוי×, ו×חר-כך מחקו ××•×ª× ×¢"×™ הקשות ×חדות +>> הקישו עתה מספר תוי×, ו×חר־כך מחקו ××•×ª× ×¢"×™ הקשות ×חדות על <DelBack>. ×ל תחששו ×œ×©× ×•×ª ×ת הקובץ ×”×–×” -- העותק המקורי של השיעור ייש×ר ×œ×œ× ×©×™× ×•×™. ××ª× ×¢×•×‘×“×™× ×¢×œ העותק ×”×ישי שלכ×. @@ -297,24 +297,24 @@ argument) ×ž×©×•× ×ž×§×™×©×™× ×ותו ×œ×¤× ×™ הפקודה ×ליה ×”×•× × >> הקישו טקסט עד שתגיעו לקצה השורה, ו××– תמשיכו להקיש עוד טקסט. כתוצ××”, תר×ו שמופיעה שורת המשך. ->> עתה הקישו <DelBack> על-×ž× ×ª למחוק טקסט עד שהשורה תיעשה קצרה מספיק - ותת××™× ×œ×©×•×¨×” בודדת על-גבי התצוגה. שורת ההמשך תיעל×. +>> עתה הקישו <DelBack> ×¢×œÖ¾×ž× ×ª למחוק טקסט עד שהשורה תיעשה קצרה מספיק + ותת××™× ×œ×©×•×¨×” בודדת על־גבי התצוגה. שורת ההמשך תיעל×. -× ×™×ª×Ÿ למחוק ×ת תו ×”-Newline כמו כל תו ×חר. מחיקת ×”-Newline בין שתי +× ×™×ª×Ÿ למחוק ×ת תו ×”Ö¾Newline כמו כל תו ×חר. מחיקת ×”Ö¾Newline בין שתי שורות תמזג ×ת השורות לשורה ×חת. ×× ×”×©×•×¨×” המשולבת תהיה ×רוכה מרוחב התצוגה, ×”×™× ×ª×•×¦×’ ×¢× ×©×•×¨×ª המשך. >> ×”× ×™×¢×• ×ת הסמן לתחילת השורה והקישו <DelBack>. כתוצ××”, השורה תתמזג ×× ×§×•×“×ž×ª×”. ->> עתה הקישו <Return> כדי להחזיר ×ת ×”-Newline שמחקת×. +>> עתה הקישו <Return> כדי להחזיר ×ת ×”Ö¾Newline שמחקת×. -זכרו ×›×™ לרוב הפקודות ב-Emacs ×פשר לציין מספר חזרות. ×’× ×ª×•×™ טקסט +זכרו ×›×™ לרוב הפקודות ב־Emacs ×פשר לציין מספר חזרות. ×’× ×ª×•×™ טקסט ×©×™×™×›×™× ×œ×§×‘×•×¦×ª פקודות זו. חזרה על תו טקסט ×ž×›× ×™×¡×” ×ותו מספר פעמי×. ->> × ×¡×• ×–×ת עכשיו -- הקישו ‪C-u 8 *‬ על-×ž× ×ª ×œ×”×›× ×™×¡ ********. +>> × ×¡×• ×–×ת עכשיו -- הקישו ‪C-u 8 *‬ ×¢×œÖ¾×ž× ×ª ×œ×”×›× ×™×¡ ********. -ובכן, ×œ×ž×“×ª× ×ת ×”×ופן הבסיסי ביותר להדפיס משהו ב-Emacs ולתקן שגי×ות. +ובכן, ×œ×ž×“×ª× ×ת ×”×ופן הבסיסי ביותר להדפיס משהו ב־Emacs ולתקן שגי×ות. ×פשר למחוק ×’× ×ž×œ×™× ×•××£ שורות שלמות. להלן ×¡×™×›×•× ×¤×§×•×“×•×ª המחיקה: â€<Delback> מחק תו ×©×œ×¤× ×™ הסמן @@ -326,9 +326,9 @@ argument) ×ž×©×•× ×ž×§×™×©×™× ×ותו ×œ×¤× ×™ הפקודה ×ליה ×”×•× × â€C-k גזור טקסט מהסמן ועד סוף השורה â€M-k גזור טקסט עד סוף המשפט ×”× ×•×›×—×™. -שימו לב שהיחס בין <Delback> ו-C-d לעומת M-<Delback>‎ ו-M-d ×ž×ž×©×™×›×™× ×ת -ההקבלה שבין C-f ו-M-f (××ž× × <Delback> ××™× × ×• תו בקרה, ×‘×•× × ×–× ×™×— ×ת -×”× ×§×•×“×” הזו לעת-עתה). C-k ו-M-k ×“×•×ž×™× ×œ-C-e ו-M-e, ×× × ×§×‘×™×œ שורות +שימו לב שהיחס בין <Delback> ו־C-d לעומת M-<Delback>‎ ו־M-d ×ž×ž×©×™×›×™× ×ת +ההקבלה שבין C-f ו־M-f (××ž× × <Delback> ××™× × ×• תו בקרה, ×‘×•× × ×–× ×™×— ×ת +×”× ×§×•×“×” הזו לעת־עתה). C-k ו־M-k ×“×•×ž×™× ×œÖ¾C-e ו־M-e, ×× × ×§×‘×™×œ שורות למשפטי×. ×‘× ×•×¡×£, קיימת שיטה ×חידה שמ×פשרת לגזור קטע כלשהו של טקסט. ×œ×©× ×›×š, תגיעו @@ -340,25 +340,25 @@ C-w. כתוצ××”, כל הטקסט בין ×©× ×™ המקומות הללו ×™×™×’× >> הקישו C-<SPC>‎. â€Emacs צריך להציג הודעה ×”×ומרת "Mark set" בתחתית התצוגה. >> ×”× ×™×¢×• ×ת הסמן ×ל ×”×ות צ בשורה ×”×©× ×™×” של הפיסקה. ->> הקישו C-w. בכך תגזרו ×ת חלק הטקסט שמתחיל ב-ב ×•×ž×¡×ª×™×™× ×œ×¤× ×™ ×”-צ. +>> הקישו C-w. בכך תגזרו ×ת חלק הטקסט שמתחיל ב־ב ×•×ž×¡×ª×™×™× ×œ×¤× ×™ ה־צ. -ההבדל בין "מחיקה" ("deletion") ו-"גזירה" ("killing") ×”×•× ×©×”×˜×§×¡×˜ +ההבדל בין "מחיקה" ("deletion") ו־"גזירה" ("killing") ×”×•× ×©×”×˜×§×¡×˜ "הגזור" × ×™×ª×Ÿ ל×חזור ×•×œ×”×›× ×¡×” (×‘×ž×§×•× ×›×œ×©×”×•× ×‘×˜×§×¡×˜), ו×ילו טקסט "מחוק" ×œ× × ×™×ª×Ÿ ×œ×”×›× ×™×¡ מחדש בשיטה זו. (×בל × ×™×ª×Ÿ לבטל ×ת מחיקה -- ר××” להלן.) ×חזור הטקסט הגזור × ×§×¨× "הדבקה" ("yanking"). ב×ופן כללי, פקודות ×שר עלולות ×œ×”×¢×œ×™× ×›×ž×•×™×•×ª גדולות של טקסט תמיד גוזרות ×ת הטקסט (כך ×©× ×™×ª×Ÿ ×™×”×™×” בקלות לשחזרו) בעוד הפקודות שמורידות תו בודד ×ו שורות ריקות ותוי רווח -- -מוחקות (כך ×©×œ× × ×™×ª×Ÿ להדביק ×ת הטקסט ×©× ×ž×—×§). כך, <Delback> ו-C-d ×ž×•×—×§×™× +מוחקות (כך ×©×œ× × ×™×ª×Ÿ להדביק ×ת הטקסט ×©× ×ž×—×§). כך, <Delback> ו־C-d ×ž×•×—×§×™× ×›×שר ×ž×¤×¢×™×œ×™× ××•×ª× ×œ×œ× ××¨×’×•×ž× ×˜, ×בל ×’×•×–×¨×™× ×›×שר ×ž×¤×¢×™×œ×™× ××•×ª× ×¢× ××¨×’×•×ž× ×˜. ->> ×”× ×™×¢×• ×ת הסמן לתחילת שורה ש××™× ×” ריקה. ×חר-כך הקישו C-k כדי לגזור +>> ×”× ×™×¢×• ×ת הסמן לתחילת שורה ש××™× ×” ריקה. ×חר־כך הקישו C-k כדי לגזור ×ת כל הטקסט של ×ותה שורה. ->> הקישו C-k ×¤×¢× × ×•×¡×¤×ª. שימו לב ×©×”×•× ×’×•×–×¨ ×ת ×”-Newline שבסוף השורה. +>> הקישו C-k ×¤×¢× × ×•×¡×¤×ª. שימו לב ×©×”×•× ×’×•×–×¨ ×ת ×”Ö¾Newline שבסוף השורה. -שימו לב ש-C-k בודד גוזר ×ת תכולת השורה, ו-C-k × ×•×¡×£ גוזר ×’× ×ת השורה +שימו לב ש־C-k בודד גוזר ×ת תכולת השורה, ו־C-k × ×•×¡×£ גוזר ×’× ×ת השורה עצמה ×•×’×•×¨× ×œ×©×ר השורות ×œ× ×•×¢ כלפי מעלה. C-k מפרש ×ת ×”××¨×’×•×ž× ×˜ ×”× ×•×ž×¨×™ -ב×ופן מיוחד: ×”×•× ×’×•×–×¨ כמספר ×”×–×” שורות, כולל ×”-Newlines שלהן. ×–×” ×©×•× ×” -×ž×¡×ª× ×”×¤×¢×œ×” חוזרת: C-u 2 C-k גוזר שתי שורות כולל ×”-Newlines שלהן, +ב×ופן מיוחד: ×”×•× ×’×•×–×¨ כמספר ×”×–×” שורות, כולל ×”Ö¾Newlines שלהן. ×–×” ×©×•× ×” +×ž×¡×ª× ×”×¤×¢×œ×” חוזרת: C-u 2 C-k גוזר שתי שורות כולל ×”Ö¾Newlines שלהן, ו×ילו הקשה על C-k ×¤×¢×ž×™×™× ×œ× ×¢×•×©×” כן. ×חזור הטקסט ×©×’×–×¨× ×• × ×§×¨× "הדבקה" ("yanking"). (תחשבו על ×–×” כעל שליפה @@ -366,21 +366,21 @@ C-w. כתוצ××”, כל הטקסט בין ×©× ×™ המקומות הללו ×™×™×’× ×‘×ותו ×ž×§×•× ×ž×ž× ×• × ×’×–×¨ ×ו ×‘×ž×§×•× ×חר כלשהו בתוך הטקסט ש××ª× ×¢×•×¨×›×™×, ×ו ×פילו בקובץ ×חר. × ×™×ª×Ÿ להדביק ×ת ×ותו הטקסט מספר ×¤×¢×ž×™× ×•×‘×›×š ליצור ×¢×•×ª×§×™× ×ž×¨×•×‘×™× ×ž×ž× ×•. ×ª×•×›× ×™×•×ª עריכה ×חרות משתמשות ×‘×ž×•× ×—×™× "cutting" -ו-"pasting" ×‘×ž×§×•× "killing" ו-"yanking" (ר××” ×ת מילון ×”×ž×•× ×—×™× ×‘×¤×¨×§ -×”-"Glossary" של מדריך למשתמשי Emacs). +ו־"pasting" ×‘×ž×§×•× "killing" ו־"yanking" (ר××” ×ת מילון ×”×ž×•× ×—×™× ×‘×¤×¨×§ +×”Ö¾"Glossary" של מדריך למשתמשי Emacs). הפקודה להדבקה ×”×™× C-y. ×”×™× ×ž×›× ×™×¡×” ×ת הטקסט הגזור ×‘×ž×§×•× ×”× ×•×›×—×™ של הסמן. >> × ×¡×• ×–×ת: הקישו C-y כדי ל×חזר טקסט ×©×’×–×¨×ª× ×§×•×“× ×œ×›×Ÿ. ×× ×ª×§×™×©×• C-k מספר ×¤×¢×ž×™× ×‘×¨×¦×£, כל הטקסט ×©×’×–×¨×ª× ×‘×“×¨×š זו × ×©×ž×¨ ביחד, כך -ש-C-y בודד ידביק ×ת כולו בבת ×חת. +ש־C-y בודד ידביק ×ת כולו בבת ×חת. >> עשו ×–×ת עתה: הקישו C-k כמה פעמי×. עכשיו ל×חזור הטקסט שגזרת×: ->> הקישו C-y. ×חר-כך ×”× ×™×¢×• ×ת הסמן כמה שורות כלפי מטה והקישו C-y שוב. +>> הקישו C-y. ×חר־כך ×”× ×™×¢×• ×ת הסמן כמה שורות כלפי מטה והקישו C-y שוב. כפי שר×ית×, כך תוכלו להעתיק חלק מהטקסט ×ž×ž×§×•× ×œ×ž×§×•×. מה לעשות ×× ×™×© ×œ×›× ×˜×§×¡×˜ להדבקה, ×בל ×‘×™× ×ª×™×™× ×’×–×¨×ª× ×˜×§×¡×˜ ×חר? C-y ידביק @@ -394,7 +394,7 @@ C-w. כתוצ××”, כל הטקסט בין ×©× ×™ המקומות הללו ×™×™×’× ×× ×ª×§×™×©×• M-y מספיק ×¤×¢×ž×™× ×‘×–×• ×חר זו, תגיעו חזרה ×œ× ×§×•×“×ª ההתחלה (טקסט ×©×’×–×¨×ª× ×œ××—×¨×•× ×”). ->> גזרו שורה, ×חר-כך ×ª× ×™×¢×• ×ת הסמן ×× ×” ו×× ×”, ולבסוף גזרו שורה × ×•×¡×¤×ª. +>> גזרו שורה, ×חר־כך ×ª× ×™×¢×• ×ת הסמן ×× ×” ו×× ×”, ולבסוף גזרו שורה × ×•×¡×¤×ª. הקישו C-y כדי ל×חזר ×ת השורה ×”×©× ×™×” שגזרת×. עתה הקישו M-y והשורה ש××—×–×¨×ª× ×ª×•×—×œ×£ בשורה הר××©×•× ×” שגזרת×. הקישו M-y מספר ×¤×¢×ž×™× × ×•×¡×¤×•×ª ושימו לב לתוצ×ות. המשיכו להקיש M-y @@ -415,14 +415,14 @@ C-x u ברצף מבטלת ×©×™× ×•×™×™× ×©×œ פקודות קודמות, ×חת ופקודות גלילה) ××™× ×Ÿ × ×¡×¤×¨×•×ª ×•×ª×•×™× ×©×ž×›× ×™×¡×™× ×ת ×¢×¦×ž× ×ž×§×•×‘×¦×™× ×‘×§×‘×•×¦×•×ª של עד 20, כדי להקטין ×ת מספר ×”×¤×¢×ž×™× ×©×™×© להקיש C-x u כדי לבטל ×”×›× ×¡×ª טקסט. ->> גזרו שורה זו ×¢× C-k, ×חר-כך הקישו C-x u ×•×”×™× ×ª×•×¤×™×¢ שוב. +>> גזרו שורה זו ×¢× C-k, ×חר־כך הקישו C-x u ×•×”×™× ×ª×•×¤×™×¢ שוב. â€C-_‎ ×”×™× ×” דרך חלופית להפעיל ×ת פקודת הביטול. ×”×™× ×¤×•×¢×œ×ª בדיוק כמו C-x u, ×בל קלה יותר להקשה מספר ×¤×¢×ž×™× ×‘×–×• ×חר זו. החסרון של C-_‎ ×”×•× ×©×‘×›×ž×” מקלדות ×œ× ×‘×¨×•×¨ מ×ליו כיצד להקיש ×–×ת. זו הסיבה לקיומו של C-x u. במקלדות ×חדות × ×™×ª×Ÿ להקיש C-_‎ ×¢"×™ החזקת CONTROL והקשת לוכסן /. -××¨×’×•×ž× ×˜ × ×•×ž×¨×™ ל-C-_‎ ×ו ל-C-x u משמש כמספר החזרות על הפקודה. +××¨×’×•×ž× ×˜ × ×•×ž×¨×™ ל־C-_‎ ×ו ל־C-x u משמש כמספר החזרות על הפקודה. × ×™×ª×Ÿ לבטל מחיקה של טקסט בדיוק כמו ×©× ×™×ª×Ÿ לבטל גזירה. ×”×”×‘×“×œ×™× ×‘×™×Ÿ מחיקה וגזירה ×ž×©×¤×™×¢×™× ×¢×œ ×™×›×•×œ×ª×›× ×œ×”×“×‘×™×§ ×ת הטקסט הגזור ×¢× C-y; ×”× ××™× × ×—×©×•×‘×™× @@ -432,8 +432,8 @@ C-x u ברצף מבטלת ×©×™× ×•×™×™× ×©×œ פקודות קודמות, ×חת * ×§×‘×¦×™× ------- -על-×ž× ×ª שהטקסט ×©×¢×¨×›×ª× ×™×™×©×ž×¨, יש ×œ×©×™× ×ותו בקובץ. ×חרת, ×”×•× ×™×™×¢×œ× ×‘×¨×’×¢ -שתצ×ו מ-Emacs. כדי ×œ×©×™× ×ת הטקס בקובץ, יש "לפתוח" ("find") ×ת הקובץ +×¢×œÖ¾×ž× ×ª שהטקסט ×©×¢×¨×›×ª× ×™×™×©×ž×¨, יש ×œ×©×™× ×ותו בקובץ. ×חרת, ×”×•× ×™×™×¢×œ× ×‘×¨×’×¢ +שתצ×ו מ־Emacs. כדי ×œ×©×™× ×ת הטקס בקובץ, יש "לפתוח" ("find") ×ת הקובץ ×œ×¤× ×™ ×©×ž×ª×—×™×œ×™× ×œ×”×§×™×© טקסט. (×©× ×חר לכך ×”×•× "לפקוד" ×ת הקובץ - "visit".) פתיחת הקובץ משמעותה שתוכן הקובץ מוצג בתוך Emacs. ×ž×‘×—×™× ×•×ª רבות הדבר @@ -445,8 +445,8 @@ C-x u ברצף מבטלת ×©×™× ×•×™×™× ×©×œ פקודות קודמות, ×חת ×× ×ª×‘×™×˜×• בחלק התחתון של התצוגה, תר×ו ×©× ×©×•×¨×” בולטת שמתחילה ומסתיימת ×‘×ž×§×¤×™× ×•×œ×™×“ הקצה השמ×לי שלה כתוב "TUTORIAL.he". חלק ×–×” של התצוגה בדרך כלל מציג ×ת ×©× ×”×§×•×‘×¥ ×ותו ××ª× ×¤×•×§×“×™×. כרגע ××ª× ×¤×•×§×“×™× ×§×•×‘×¥ ×‘×©× -"TUTORIAL.he" ×©×”×•× ×¢×•×ª×§ הטיוטה ×”×ישי ×©×œ×›× ×©×œ שיעור השימוש ב-Emacs. -פתיחת קובץ כלשהו ב-Emacs תציג ×ת שמו של הקובץ ×‘×ž×§×•× ×–×”. +"TUTORIAL.he" ×©×”×•× ×¢×•×ª×§ הטיוטה ×”×ישי ×©×œ×›× ×©×œ שיעור השימוש ב־Emacs. +פתיחת קובץ כלשהו ב־Emacs תציג ×ת שמו של הקובץ ×‘×ž×§×•× ×–×”. היבט ×חד מיוחד של פתיחת קובץ ×”×•× ×©×™×© לציין ×ת ×©× ×”×§×•×‘×¥ ×שר ×‘×¨×¦×•× ×›× ×œ×¤×ª×•×—. ×× ×• ××•×ž×¨×™× ×©×”×¤×§×•×“×” "קור×ת ××¨×’×•×ž× ×˜ מהמסוף" (במקרה ×–×” ×”××¨×’×•×ž× ×˜ @@ -455,21 +455,21 @@ C-x u ברצף מבטלת ×©×™× ×•×™×™× ×©×œ פקודות קודמות, ×חת â€C-x C-f פתח קובץ â€Emacs מבקש שתקישו ×ת ×©× ×”×§×•×‘×¥. ×©× ×”×§×•×‘×¥ שתקישו מופיע בשורה ×”×ª×—×ª×•× ×” של -התצוגה. שורה זו × ×§×¨×ת "×ž×™× ×™-חוצץ" ("minibuffer") ×›×©×”×™× ×ž×©×ž×©×ª לסוג ×–×” +התצוגה. שורה זו × ×§×¨×ת "×ž×™× ×™Ö¾×—×•×¦×¥" ("minibuffer") ×›×©×”×™× ×ž×©×ž×©×ª לסוג ×–×” של קלט. × ×™×ª×Ÿ להשתמש בכל פקודות העריכה הרגילות של Emacs ×›×©×ž×§×™×©×™× ×ת ×©× ×”×§×•×‘×¥ בחוצץ ×–×”. -×× ×˜×¨× ×¡×™×™×ž×ª× ×œ×”×§×™×© ×ת ×©× ×”×§×•×‘×¥ (×ו כל סוג ×חר של קלט ×‘×ž×™× ×™-חוצץ), +×× ×˜×¨× ×¡×™×™×ž×ª× ×œ×”×§×™×© ×ת ×©× ×”×§×•×‘×¥ (×ו כל סוג ×חר של קלט ×‘×ž×™× ×™Ö¾×—×•×¦×¥), × ×™×ª×Ÿ לבטל ×ת הפקודה בעזרת C-g. ->> הקישו C-x C-f ו×חר-כך הקישו C-g. ×–×” מבטל ×ת ×”×ž×™× ×™-חוצץ ×•×’× ×ž×‘×˜×œ - ×ת הפקודה C-x C-f שהשתמשה ×‘×ž×™× ×™-חוצץ. התוצ××” ×”×™× ×©××£ קובץ ×œ× × ×¤×ª×—. +>> הקישו C-x C-f ו×חר־כך הקישו C-g. ×–×” מבטל ×ת ×”×ž×™× ×™Ö¾×—×•×¦×¥ ×•×’× ×ž×‘×˜×œ + ×ת הפקודה C-x C-f שהשתמשה ×‘×ž×™× ×™Ö¾×—×•×¦×¥. התוצ××” ×”×™× ×©××£ קובץ ×œ× × ×¤×ª×—. -×ž×©×¡×™×™×ž×ª× ×œ×”×§×™×© ×ת ×©× ×”×§×•×‘×¥, הקישו <Return> ×œ×¡×™×™× ×ת הקלט. ×ו-××– תיגש -C-x C-f לעבודה ×•×ª×ž×¦× ×•×ª×¤×ª×— ×ת הקובץ שבחרת×. ×”×ž×™× ×™-חוצץ × ×¢×œ× ×›×שר -פקודת ×”-C-x C-f ×ª×¡×™×™× ×ת עבודתה. +×ž×©×¡×™×™×ž×ª× ×œ×”×§×™×© ×ת ×©× ×”×§×•×‘×¥, הקישו <Return> ×œ×¡×™×™× ×ת הקלט. ×ו־××– תיגש +C-x C-f לעבודה ×•×ª×ž×¦× ×•×ª×¤×ª×— ×ת הקובץ שבחרת×. ×”×ž×™× ×™Ö¾×—×•×¦×¥ × ×¢×œ× ×›×שר +פקודת ×”Ö¾C-x C-f ×ª×¡×™×™× ×ת עבודתה. -זמן קצר ×חר-כך תוכן הקובץ יופיע על-גבי התצוגה ותוכלו לבצע בו ×©×™× ×•×™×™×. +זמן קצר ×חר־כך תוכן הקובץ יופיע על־גבי התצוגה ותוכלו לבצע בו ×©×™× ×•×™×™×. כשתחליטו לשמור ×ת ×”×©×™× ×•×™×™×, הקישו ×ת הפקודה הב××”: â€C-x C-s שמור ×ת הקובץ @@ -479,13 +479,13 @@ C-x C-f לעבודה ×•×ª×ž×¦× ×•×ª×¤×ª×— ×ת הקובץ שבחרת×. ×”×ž×™× ×œ×יבוד. ×”×©× ×”×—×“×© × ×•×¦×¨ ×¢"×™ הוספת "~" בסוף ×”×©× ×”×ž×§×•×¨×™ של הקובץ. כשהשמירה מסתיימת, Emacs מציג בשורה ×”×ª×—×ª×•× ×” ×ת ×©× ×”×§×•×‘×¥ ×©× ×©×ž×¨. × ×¡×• -לשמור ×œ×¢×ª×™× ×ž×–×•×ž× ×•×ª על-×ž× ×ª ×œ×”×™×ž× ×¢ מל×בד יותר מדי מהעבודה ×©×œ×›× ×× ×”×ž×—×©×‘ +לשמור ×œ×¢×ª×™× ×ž×–×•×ž× ×•×ª ×¢×œÖ¾×ž× ×ª ×œ×”×™×ž× ×¢ מל×בד יותר מדי מהעבודה ×©×œ×›× ×× ×”×ž×—×©×‘ ייפול (ר××” להלן פיסקה על שמירה ×וטומטית). >> הקישו C-x C-s כדי לשמור ×ת העותק ×©×œ×›× ×©×œ השיעור. כתוצ××”, תופיע ההודעה "Wrote ... TUTORIAL.he" בתחתית התצוגה. -× ×™×ª×Ÿ לפתוח קובץ ×§×™×™× ×¢×œ-×ž× ×ª לצפות בו ×ו לערוך ×ותו. × ×™×ª×Ÿ ×’× ×œ×¤×ª×•×— קובץ +× ×™×ª×Ÿ לפתוח קובץ ×§×™×™× ×¢×œÖ¾×ž× ×ª לצפות בו ×ו לערוך ×ותו. × ×™×ª×Ÿ ×’× ×œ×¤×ª×•×— קובץ ש××™× ×• קיי×. זו הדרך ליצור ×§×‘×¦×™× ×—×“×©×™× ×‘×¢×–×¨×ª Emacs: פתחו ×ת הקובץ שיהיה תחילה ריק ו××– התחילו להקיש טקסט לתוכו. כשתפעילו ×ת פקודת השמירה, Emacs ייצור ×ת הקובץ ×¢× ×”×˜×§×¡×˜ שהקשת×. מ×ותו רגע ו×ילך, תוכלו לחשוב @@ -495,11 +495,11 @@ Emacs ייצור ×ת הקובץ ×¢× ×”×˜×§×¡×˜ שהקשת×. מ×ותו רגע * ×—×•×¦×¦×™× -------- -×× ×ª×¤×ª×—×• קובץ × ×•×¡×£ ×¢× C-x C-f, הקובץ הר×שון עדיין × ×©×ר פתוח ב-Emacs. +×× ×ª×¤×ª×—×• קובץ × ×•×¡×£ ×¢× C-x C-f, הקובץ הר×שון עדיין × ×©×ר פתוח ב־Emacs. תוכלו לחזור ×ליו ×¢"×™ C-x C-f. כך תוכלו לפתוח מספר רב של קבצי×. >> × ×™×¦×•×¨ עתה קובץ ×‘×©× "foo" ×¢"×™ הקשת C-x C-f foo <Return>‎. - ×חר-כך ×”×›× ×™×¡×• קצת טקסט, ערכו ×ותו ולבסוף שמרו בקובץ "foo" + ×חר־כך ×”×›× ×™×¡×• קצת טקסט, ערכו ×ותו ולבסוף שמרו בקובץ "foo" ×¢"×™ C-x C-s. עתה חזרו לשיעור בעזרת C-x C-f TUTORIAL.he <Return>‎. â€Emacs מחזיק כל קובץ בתוך יישות ×‘×©× "חוצץ" ("buffer"). פתיחת קובץ יוצרת @@ -523,12 +523,12 @@ Emacs ייצור ×ת הקובץ ×¢× ×”×˜×§×¡×˜ שהקשת×. מ×ותו רגע בפקודה C-x b. פקודה זו תחייב ××•×ª×›× ×œ×”×§×™×© ×ת ×©× ×”×—×•×¦×¥. >> הקישו C-x b foo <Return>‎ כדי לחזור לחוצץ "foo" ×שר מחזיק טקסט של - הקובץ "foo". ×חר-כך הקישו C-x b TUTORIAL.he <Return>‎ כדי לשוב + הקובץ "foo". ×חר־כך הקישו C-x b TUTORIAL.he <Return>‎ כדי לשוב לשיעור ×–×”. ברוב ×”×ž×§×¨×™× ×©× ×”×—×•×¦×¥ ×–×”×” ×œ×©× ×”×§×•×‘×¥ (×œ×œ× ×©× ×”×ª×™×§×™×” שלו). ×בל ×ין ×–×” תמיד כך. רשימת ×”×—×•×¦×¦×™× ×©× ×•×¦×¨×ª ×¢"×™ C-x C-b תמיד תציג ×ת שמות כל ×”×—×•×¦×¦×™× -×”×§×™×™×ž×™× ×‘-Emacs. +×”×§×™×™×ž×™× ×‘Ö¾Emacs. כל טקסט שמוצג בחלון של Emacs ×”×™× ×• תמיד חלק של חוצץ כלשהו. ×§×™×™×ž×™× ×—×•×¦×¦×™× ×©××™× × ×§×©×•×¨×™× ×œ×©×•× ×§×•×‘×¥. לדוגמ×, החוצץ ×‘×©× "*Buffer List*" ××™× ×• @@ -537,9 +537,9 @@ Emacs ייצור ×ת הקובץ ×¢× ×”×˜×§×¡×˜ שהקשת×. מ×ותו רגע שהופיעו בשורה ×”×ª×—×ª×•× ×” במהלך ×¢×‘×•×“×ª×›× ×‘×ª×•×š Emacs. >> הקישו C-x b *Messages* <Return>‎ כדי לצפות בחוצץ של הודעות. - ×חר-כך הקישו C-x b TUTORIAL.he <Return>‎ על-×ž× ×ª לחזור לשיעור ×–×”. + ×חר־כך הקישו C-x b TUTORIAL.he <Return>‎ ×¢×œÖ¾×ž× ×ª לחזור לשיעור ×–×”. -×× ×¢×©×™×ª× ×©×™× ×•×™×™× ×‘×˜×§×¡×˜ של קובץ ו×חר-כך ×¤×ª×—×ª× ×§×•×‘×¥ ×חר, ×ין הדבר שומר +×× ×¢×©×™×ª× ×©×™× ×•×™×™× ×‘×˜×§×¡×˜ של קובץ ו×חר־כך ×¤×ª×—×ª× ×§×•×‘×¥ ×חר, ×ין הדבר שומר ×ת ×”×©×™× ×•×™×™× ×©×¢×©×™×ª× ×œ×§×•×‘×¥ הר×שון. ×”×©×™× ×•×™×™× ×”×œ×œ×• × ×©××¨×™× ×‘×ª×•×š Emacs, בתוך החוצץ של ×ותו קובץ. יצירתו ועריכתו של הקובץ ×”× ×•×¡×£ ××™× × ×ž×©×¤×™×¢×™× ×¢×œ החוצץ של הקובץ הר×שון. דבר ×–×” ×”×•× ×©×™×ž×•×©×™, ×ך משמעותו ×”×™× ×©×™×© צורך @@ -552,7 +552,7 @@ C-x C-s. לכן קיימת פקודה â€C-x s עובר על כל ×”×—×•×¦×¦×™× ×שר ×ž×›×™×œ×™× ×©×™× ×•×™×™× ×©×˜×¨× × ×©×ž×¨×•. לגבי כל חוצץ ×›×–×” ×”×•× ×©×•×ל ××ª×›× ×”×× ×œ×©×ž×•×¨ ×ותו ×ו ל×. ->> ×”×›× ×™×¡×• שורה של טקסט ו×חר-כך הקישו C-x s. +>> ×”×›× ×™×¡×• שורה של טקסט ו×חר־כך הקישו C-x s. ×”×•× ×¦×¨×™×š לש×ול ×”×× ×œ×©×ž×•×¨ חוצץ ×‘×©× TUTORIAL.he. השיבו בחיוב ×¢"×™ הקשה על "y". @@ -560,8 +560,8 @@ C-x C-s. לכן קיימת פקודה * הרחבת ×וסף הפקודות -------------------- -מספר הפקודות ב-Emacs גדול בהרבה ממה ×©× ×™×ª×Ÿ להפעיל ×¢"×™ כל תוי ×”-control -וה-meta. כדי להתגבר על בעיה זו, Emacs משתמש בפקודות X המרחיבות (eXtend) +מספר הפקודות ב־Emacs גדול בהרבה ממה ×©× ×™×ª×Ÿ להפעיל ×¢"×™ כל תוי ×”Ö¾control +וה־meta. כדי להתגבר על בעיה זו, Emacs משתמש בפקודות X המרחיבות (eXtend) ×ת ×וסף הפקודות הרגיל. פקודות הרחבה ×לו הן שתי×: â€C-x הרחבת תו. תו בודד ×©×‘× ×חריו ×ž×©×œ×™× ×ת הפקודה. @@ -569,24 +569,24 @@ C-x C-s. לכן קיימת פקודה בעזרת שתי ×לו × ×™×ª×Ÿ להפעיל פקודות שימושיות שבהן ×ž×©×ª×ž×©×™× ×œ×¢×ª×™× ×¨×—×•×§×•×ª יותר מ×שר פקודות ×©×œ×ž×“×ª× ×¢×“ עכשיו. כמה מהן כבר ר×ית×: C-x C-f לפתיחת -קובץ, ו-C-x C-s לשמירת קובץ, לדוגמ×. ×“×•×’×ž× × ×•×¡×¤×ª ×”×™× ×¤×§×•×“×” לצ×ת -מ-Emacs -- â€C-x C-c. (כש××ª× ×ž×¤×¢×™×œ×™× C-x C-c, ×ל תד×גו ×œ×©×™× ×•×™×™× ×©×˜×¨× +קובץ, ו־C-x C-s לשמירת קובץ, לדוגמ×. ×“×•×’×ž× × ×•×¡×¤×ª ×”×™× ×¤×§×•×“×” לצ×ת +מ־Emacs -- â€C-x C-c. (כש××ª× ×ž×¤×¢×™×œ×™× C-x C-c, ×ל תד×גו ×œ×©×™× ×•×™×™× ×©×˜×¨× × ×©×ž×¨×•; C-x C-c מציע לשמור כל קובץ ×©×©×™× ×™×ª× ×œ×¤× ×™ ×©×”×•× ×ž×¡×™×™× ×ת Emacs.) ×× ××ª× ×ž×©×ª×ž×©×™× ×‘×¦×’ גרפי ×שר תומך במספר ×ª×•×›× ×™×•×ª במקביל, ××™× ×›× ×–×§×•×§×™× -לפקודה מיוחדת כדי לעבור מ-Emacs ×œ×ª×•×›× ×™×ª ×חרת. ×פשר לעשות ×–×ת בעזרת +לפקודה מיוחדת כדי לעבור מ־Emacs ×œ×ª×•×›× ×™×ª ×חרת. ×פשר לעשות ×–×ת בעזרת העכבר ×ו פקודות של ×ž× ×”×œ ×”×—×œ×•× ×•×ª. ×ול×, ×›×שר ××ª× ×ž×©×ª×ž×©×™× ×‘×ª×¦×•×’×” -טקסטו×לית שמסוגלת להציג רק ×ª×•×›× ×™×ª ×חת בו-×–×ž× ×™×ª, תצטרכו "להשעות" -("suspend") ×ת Emacs על-×ž× ×ª לעבור ×œ×ª×•×›× ×™×ª ×חרת. +טקסטו×לית שמסוגלת להציג רק ×ª×•×›× ×™×ª ×חת ×‘×•Ö¾×–×ž× ×™×ª, תצטרכו "להשעות" +("suspend") ×ת Emacs ×¢×œÖ¾×ž× ×ª לעבור ×œ×ª×•×›× ×™×ª ×חרת. -הפקודה C-z יוצ×ת מ-Emacs *ב×ופן ×–×ž× ×™* -- כך שתוכלו לשוב ×ליו מ×וחר +הפקודה C-z יוצ×ת מ־Emacs *ב×ופן ×–×ž× ×™* -- כך שתוכלו לשוב ×ליו מ×וחר יותר ולהמשיך מ×ותה × ×§×•×“×”. ×›×שר Emacs רץ על תצוגת טקסט, C-z "משעה" ×ת Emacs: ×”×•× ×ž×—×–×™×¨ ××ª×›× ×œ×©×•×¨×ª הפקודות הבסיסית של מערכת ההפעלה ("shell"), -×בל ××™× ×• ×ž×¡×™×™× ×ת Emacs. ברוב המערכות, כדי להמשיך ×‘×¢×‘×•×“×ª×›× ×‘-Emacs, +×בל ××™× ×• ×ž×¡×™×™× ×ת Emacs. ברוב המערכות, כדי להמשיך ×‘×¢×‘×•×“×ª×›× ×‘Ö¾Emacs, תצטרכו להקיש ×ת הפקודה "fg" ×ו â€"%emacs"‬. -הרגע ×”× ×›×•×Ÿ להשתמש ב-C-x C-c ×”×•× ×›×שר ××ª× ×¢×•×ž×“×™× ×œ×”×ª× ×ª×§ (log out). -כמו-כן, תצטרכו להשתמש בו כדי לצ×ת מ-Emacs שהופעל ×¢"×™ ×ª×•×›× ×™×•×ª ×חרות +הרגע ×”× ×›×•×Ÿ להשתמש ב־C-x C-c ×”×•× ×›×שר ××ª× ×¢×•×ž×“×™× ×œ×”×ª× ×ª×§ (log out). +כמו־כן, תצטרכו להשתמש בו כדי לצ×ת מ־Emacs שהופעל ×¢"×™ ×ª×•×›× ×™×•×ª ×חרות כגון קרי×ת דו×ר ××œ×§×˜×¨×•× ×™ -- ×ª×•×›× ×™×•×ª ×לו ×œ× ×ª×ž×™×“ יודעות להסתדר ×¢× ×”×©×¢×™×™×ª Emacs. @@ -597,7 +597,7 @@ Emacs: ×”×•× ×ž×—×–×™×¨ ××ª×›× ×œ×©×•×¨×ª הפקודות הבסיסית של â€C-x s שמור ×—×•×¦×¦×™× ××—×“×™× â€C-x C-b הצג רשימת ×—×•×¦×¦×™× â€C-x b החלף חוצץ - â€C-x C-c ×¦× ×ž-Emacs + â€C-x C-c ×¦× ×žÖ¾Emacs â€C-x 1 הש×ר רק חלון ×חד ומחק כל הש×ר â€C-x u בטל פקודה ××—×¨×•× ×” @@ -605,9 +605,9 @@ Emacs: ×”×•× ×ž×—×–×™×¨ ××ª×›× ×œ×©×•×¨×ª הפקודות הבסיסית של ספציפיות רק ל××•×¤× ×™ פעולה (modes) מיוחדי×. ×“×•×’×ž× ×œ×›×š ×”×™× ×¤×§×•×“×” replace-string (החלף מחרוזת) ×שר מחליפה מחרוזת ×חת ×‘×ž×©× ×” בכל החוצץ. ×חרי שתקישו M-x, â€Emacs מציג M-x בתחתית התצוגה ומחכה שתקישו ×ת ×©× -הפקודה, במקרה ×–×” "replace-string". מספיק שתקישו "repl s<TAB>‎" ו-Emacs +הפקודה, במקרה ×–×” "replace-string". מספיק שתקישו "repl s<TAB>‎" ו־Emacs ×™×©×œ×™× ×ת ×”×©× ×”×ž×œ×. (<TAB> ×”×•× ×ž×§×© Tab, בדרך כלל תמצ×ו ×ותו מעל מקש -×”-CapsLock ×ו Shift, ליד הקצה השמ×לי של המקלדת.) סיימו ×ת ×©× ×”×¤×§×•×“×” +×”Ö¾CapsLock ×ו Shift, ליד הקצה השמ×לי של המקלדת.) סיימו ×ת ×©× ×”×¤×§×•×“×” ×¢"×™ הקשת <Return>. הפקודה להחלפת מחרוזת זקוקה ×œ×©× ×™ ××¨×’×•×ž× ×˜×™× -- המחרוזת שתוחלף וזו שתחליף @@ -625,7 +625,7 @@ replace-string (החלף מחרוזת) ×שר מחליפה מחרוזת ×חת × ---------------- ×©×™× ×•×™×™× ×©×¢×¨×›×ª× ×‘×§×•×‘×¥ ×בל ×˜×¨× ×©×ž×¨×ª× ×¢×œ×•×œ×™× ×œ×œ×›×ª ל×יבוד ×× ×”×ž×—×©×‘ ×©×œ×›× -× ×ª×§×¢. על-×ž× ×ª להגן ×¢×œ×™×›× ×ž×¤× ×™ ×¡×›× ×” זו, Emacs שומר ×œ×¢×ª×™× ×ž×–×•×ž× ×•×ª כל קובץ +× ×ª×§×¢. ×¢×œÖ¾×ž× ×ª להגן ×¢×œ×™×›× ×ž×¤× ×™ ×¡×›× ×” זו, Emacs שומר ×œ×¢×ª×™× ×ž×–×•×ž× ×•×ª כל קובץ ×©× ×ž×¦× ×‘×¢×¨×™×›×”. השמירה ×”×וטומטית ×”×–×ת × ×¢×©×™×ª לקובץ × ×¤×¨×“ ששמו מתחיל ×•×ž×¡×ª×™×™× ×‘×ª×• #. לדוגמ×, ×× ×”×™× ×›× ×¢×•×¨×›×™× ×§×•×‘×¥ ×‘×©× "hello.c", קובץ השמירה ×”×וטומטית שיווצר עבורו ×™×™×§×¨× "#hello.c#". שמירה רגילה של הקובץ על ×™×“×›× @@ -633,8 +633,8 @@ replace-string (החלף מחרוזת) ×שר מחליפה מחרוזת ×חת × ×× ×”×ž×—×©×‘ ×כן × ×ª×§×¢, תוכלו ×œ× ×¦×™×œ ×ת ×”×©×™× ×•×™×™× ×©×œ× ×”×¡×¤×§×ª× ×œ×©×ž×•×¨. ×œ×©× ×›×š, יש לפתוח ×ת הקובץ כרגיל (×ת הקובץ בשמו המקורי, ×œ× ×ת קובץ השמירה -×”×וטומטית), ו×חר-כך להקיש M-x recover-file <Return>‎. כש-Emacs יבקש -×ישור, הקישו yes<Return>‎ כדי ש-Emacs ישחזר ×ת הקובץ כפי ×©× ×©×ž×¨ +×”×וטומטית), ו×חר־כך להקיש M-x recover-file <Return>‎. כש־Emacs יבקש +×ישור, הקישו yes<Return>‎ כדי ש־Emacs ישחזר ×ת הקובץ כפי ×©× ×©×ž×¨ ×וטומטית. @@ -659,7 +659,7 @@ replace-string (החלף מחרוזת) ×שר מחליפה מחרוזת ×חת × ×ת ×ž×™×§×•×ž×›× ×”× ×•×›×—×™ בתוך הטקסט, ל×מור ×›×™ NN ××—×•×–×™× ×ž×”×˜×§×¡×˜ ×§×•×“×ž×™× ×œ×˜×§×¡×˜ המוצג כרגע בחלון. ×× ×”×ž×•×¦×’ בחלון כולל ×ת תחילת הטקסט, תר×ו ×©× "Top" ×‘×ž×§×•× "0% ". ×× ×”×ž×•×¦×’ בחלון כולל ×ת סוף הטקסט, תר×ו ×©× "Bot" â€(bottom). -×× ×”×˜×§×¡×˜ כל-כך קצר שכולו מוצג בחלון, שורת הסטטוס תציג "All". +×× ×”×˜×§×¡×˜ כל־כך קצר שכולו מוצג בחלון, שורת הסטטוס תציג "All". ×”×ות L והמספר ש×חריה ×ž×¦×™×™× ×™× ×ת ×”×ž×™×§×•× ×”× ×•×›×—×™ בדרך ×חרת: ×”× ×ž×¨××™× ×ת מספר השורה שבה × ×ž×¦× ×”×¡×ž×Ÿ. @@ -672,7 +672,7 @@ replace-string (החלף מחרוזת) ×שר מחליפה מחרוזת ×חת × ×›×¢×ª. ברירת המחדל ×”×™× Fundamental, ×”×ופן הבסיס, שבו ××ª× ×ž×©×ª×ž×©×™× ×›×¢×ª. זוהי ×“×•×’×ž× ×©×œ "×ופן עריכה ר×שי" (major mode). -ל-Emacs ××•×¤× ×™ עריכה ר××©×™×™× ×¨×‘×™× ×•×ž×’×•×•× ×™×. חלק ×ž×”× × ×•×¢×“×• לעריכה של שפת +ל־Emacs ××•×¤× ×™ עריכה ר××©×™×™× ×¨×‘×™× ×•×ž×’×•×•× ×™×. חלק ×ž×”× × ×•×¢×“×• לעריכה של שפת ×ª×›× ×•×ª מסוימת ו/×ו סוג ×ž×¡×•×™× ×©×œ טקסט, כגון Lisp mode, Text mode וכד'. בכל רגע × ×ª×•×Ÿ רק ×ופן עיקרי ×חד יכול להיות פעיל ושמו תמיד מצויין בשורת הסטטוס ב×ותו ×ž×§×•× ×‘×• כרגע ××ª× ×¨×•××™× "Fundamental". @@ -684,31 +684,31 @@ replace-string (החלף מחרוזת) ×שר מחליפה מחרוזת ×חת × ×œ×ž×©×œ הפקודה להפעיל ×ת ×”×ופן Fundamental ×”×™× ×” M-x fundamental-mode. ×× ×‘×›×•×•× ×ª×›× ×œ×¢×¨×•×š טקסט בשפה ×× ×•×©×™×ª כלשהי, כמו הקובץ ×”×–×”, כד××™ ×œ×›× -להשתמש ב-Text mode. +להשתמש ב־Text mode. >> הקישו M-x text-mode <Return>‎. ×ל ד××’×”: ××£ ×חת מפקודות Emacs ×©×œ×ž×“×ª× ×¢×“ ×›×” ×ž×©× ×” ×ת ×”×ª× ×”×’×•×ª×” ב×ופן -מהותי. ×¢× ×–×ת, שימו לב ש-M-f ו-M-b ×ž×ª×™×™×—×¡×™× ×¢×›×©×™×• ל-'גרש' כחלק מהמילה. -×œ×¤× ×™-כן, ב-Fundamental mode, â€M-f ו-M-b ×”×ª× ×”×’×• ×¢× ×”×’×¨×© כמפריד בין +מהותי. ×¢× ×–×ת, שימו לב ש־M-f ו־M-b ×ž×ª×™×™×—×¡×™× ×¢×›×©×™×• ל־'גרש' כחלק מהמילה. +×œ×¤× ×™Ö¾×›×Ÿ, ב־Fundamental mode, â€M-f ו־M-b ×”×ª× ×”×’×• ×¢× ×”×’×¨×© כמפריד בין מילי×. -××•×¤× ×™× ×¨××©×™×™× ×‘×“×¨×š-כלל ×ž×©× ×™× ×§×œ×•×ª ×ת ×”×ª× ×”×’×•×ª הפקודות: רוב הפקודות +××•×¤× ×™× ×¨××©×™×™× ×‘×“×¨×šÖ¾×›×œ×œ ×ž×©× ×™× ×§×œ×•×ª ×ת ×”×ª× ×”×’×•×ª הפקודות: רוב הפקודות עדיין "עושות ×ותה עבודה" בכל ×”××•×¤× ×™× ×”×¨×שיי×, ×בל עושות ×ותה קצת ×חרת. לצפיה בתיעוד של ×”×ופן הר×שי ×”× ×•×›×—×™ יש להקיש C-h m. ->> השתמשו ב-C-u C-v ×¤×¢× ×חת ×ו יותר כדי ×œ×”×‘×™× ×©×•×¨×” זו לר×שית התצוגה. ->> עתה הקישו C-h m כדי לר×ות במה Text mode ×©×•× ×” מה-Fundamental mode. +>> השתמשו ב־C-u C-v ×¤×¢× ×חת ×ו יותר כדי ×œ×”×‘×™× ×©×•×¨×” זו לר×שית התצוגה. +>> עתה הקישו C-h m כדי לר×ות במה Text mode ×©×•× ×” מה־Fundamental mode. >> לבסוף, הקישו C-x 1 כדי לסלק ×ת התיעוד מהתצוגה. -××•×¤× ×™× ×¨××©×™×™× × ×§×¨××™× ×›×š ×ž×©×•× ×©×§×™×™×ž×™× ×’× ××•×¤× ×™-×ž×©× ×” (minor modes). +××•×¤× ×™× ×¨××©×™×™× × ×§×¨××™× ×›×š ×ž×©×•× ×©×§×™×™×ž×™× ×’× ××•×¤× ×™Ö¾×ž×©× ×” (minor modes). ××•×¤× ×™ ×ž×©× ×” ××™× × ×ž×”×•×•×™× ×—×œ×•×¤×” ל××•×¤× ×™× ×”×¨×שיי×, ×”× ×¨×§ ×ž×©× ×™× ××•×ª× ×‘×ž×§×¦×ª. -כל ×ופן-×ž×©× ×” × ×™×ª×Ÿ להפעלה ×ו ביטול ×œ×œ× ×ª×œ×•×ª בכל ש×ר ××•×¤× ×™ ×”×ž×©× ×” ×•×œ×œ× -תלות ב×ופן הר×שי ×”× ×•×›×—×™. לכן תוכלו להפעיל ×ופן-×ž×©× ×” ×חד ×ו יותר, ×ו ××£ -×ופן-×ž×©× ×”. +כל ××•×¤×ŸÖ¾×ž×©× ×” × ×™×ª×Ÿ להפעלה ×ו ביטול ×œ×œ× ×ª×œ×•×ª בכל ש×ר ××•×¤× ×™ ×”×ž×©× ×” ×•×œ×œ× +תלות ב×ופן הר×שי ×”× ×•×›×—×™. לכן תוכלו להפעיל ××•×¤×ŸÖ¾×ž×©× ×” ×חד ×ו יותר, ×ו ××£ +××•×¤×ŸÖ¾×ž×©× ×”. -×חד מ××•×¤× ×™-×”×ž×©× ×” ×”×©×™×ž×•×©×™×™× ×‘×™×•×ª×¨, במיוחד ×œ×©× ×¢×¨×™×›×ª טקס בשפת-×× ×•×©, ×”×•× +×חד מ××•×¤× ×™Ö¾×”×ž×©× ×” ×”×©×™×ž×•×©×™×™× ×‘×™×•×ª×¨, במיוחד ×œ×©× ×¢×¨×™×›×ª טקס בשפת־×× ×•×©, ×”×•× Auto Fill mode. ×›×שר ×ופן ×–×” מופעל, Emacs ×וטומטית פותח שורה חדשה ×‘×¡×™×•× ×ž×™×œ×” ×× ×”×˜×§×¡×˜ ×©×”×§×©×ª× ×רוך מדי בשביל שורה ×חת. @@ -717,17 +717,17 @@ Auto Fill mode. ×›×שר ×ופן ×–×” מופעל, Emacs ×וטומטית פות זו מפעילה ×ת ×”×ופן כש××™× ×• פעיל ומבטלת ×ותו ×›×©×”×•× ×¤×¢×™×œ. לפעולה זו קור××™× "מיתוג" -- הפקודה "ממתגת" ×ת ×”×ופן. ->> הקישו עתה M-x auto-fill-mode <Return>‎. ×חר-כך הקישו "שדגכ " (×¢× +>> הקישו עתה M-x auto-fill-mode <Return>‎. ×חר־כך הקישו "שדגכ " (×¢× ×”×¨×•×•×— בסוף) שוב ושוב עד שתיפתח שורה חדשה. ×”×¨×•×•×—×™× ×—×©×•×‘×™× ×ž×©×•× - ש-Auto Fill mode שובר שורות ×ך ורק ברווח שבין המלי×. + ש־Auto Fill mode שובר שורות ×ך ורק ברווח שבין המלי×. -×”×©×•×œ×™×™× (margin) ש-Emacs שומר בדרך-כלל ×ž×ª×—×™×œ×™× ×חרי 70 תווי×, ×בל × ×™×ª×Ÿ +×”×©×•×œ×™×™× (margin) ש־Emacs שומר בדרך־כלל ×ž×ª×—×™×œ×™× ×חרי 70 תווי×, ×בל × ×™×ª×Ÿ ×œ×©× ×•×ª הגדרה זו בעזרת הפקודה C-x f. פקודה זו מקבלת ×ת ההגדרה החדשה של ×”×©×•×œ×™×™× ×›××¨×’×•×ž× ×˜ × ×•×ž×¨×™. ->> הקישו C-x f ×¢× ××¨×’×•×ž× ×˜ של 20. (C-u 2 0 C-x f). ×חר-כך הקישו טקסט - כלשהו ושימו לב ש-Emacs פותח שורות חדשות ×חרי 20 ×ª×•×•×™× ×œ×›×œ היותר. - לבסוף, החזירו ×ת הגדרת ×”×©×•×œ×™×™× ×œ-70 ×¢"×™ שימוש חוזר ב-C-x f. +>> הקישו C-x f ×¢× ××¨×’×•×ž× ×˜ של 20. (C-u 2 0 C-x f). ×חר־כך הקישו טקסט + כלשהו ושימו לב ש־Emacs פותח שורות חדשות ×חרי 20 ×ª×•×•×™× ×œ×›×œ היותר. + לבסוף, החזירו ×ת הגדרת ×”×©×•×œ×™×™× ×œÖ¾70 ×¢"×™ שימוש חוזר ב־C-x f. ×× ×¢×¨×›×ª× ×©×™× ×•×™×™× ×‘×מצע פסקה, Auto Fill mode ×œ× ×™×ž×œ× ×©×•×¨×•×ª מחדש ב×ופן ×וטומטי. @@ -747,15 +747,15 @@ Auto Fill mode. ×›×שר ×ופן ×–×” מופעל, Emacs ×וטומטית פות החיפוש של Emacs ×”×™× ×• "מצטבר" ("incremental"). פירוש הדבר ×”×•× ×©×”×—×™×¤×•×© מתבצע במקביל ×œ×”×§×©×ª×›× ×ת המחרוזת ×ותה ×‘×¨×¦×•× ×›× ×œ×ž×¦×•×. -הפקודה להתחיל בחיפוש ×”×™× C-s לחיפוש קדימה ו-C-r לחיפוש ×חורה. חכו! ×ל +הפקודה להתחיל בחיפוש ×”×™× C-s לחיפוש קדימה ו־C-r לחיפוש ×חורה. חכו! ×ל תפעילו ×ותן עדיין. כשתקישו C-s, תר×ו שב×זור תצוגת ההד יופיע הטקסט "I-search". ×–×” ×ומר -ש-Emacs × ×ž×¦× ×‘×ž×¦×‘ "חיפוש מצטבר" ("incremental search") ×•×”×•× ×ž×ž×ª×™×Ÿ +ש־Emacs × ×ž×¦× ×‘×ž×¦×‘ "חיפוש מצטבר" ("incremental search") ×•×”×•× ×ž×ž×ª×™×Ÿ ×œ×”×§×©×ª×›× ×ת המחרוזת ×ותה ×‘×¨×¦×•× ×›× ×œ×ž×¦×•×. הקשה על <Return> מסיימת ×ת החיפוש. ->> הקישו עתה C-s כדי להתחיל בחיפוש. ל×ט-ל×ט, ×ות-×ות, הקישו ×ת המילה +>> הקישו עתה C-s כדי להתחיל בחיפוש. ל×ט־ל×ט, ×ות־×ות, הקישו ×ת המילה "סמן", ×¢× ×”×¤×¡×§×” ×חרי כל ×ות, ושימו לב ×œ×”×ª× ×”×’×•×ª הסמן. ×–×” עתה מצ××ª× ×ת המילה "סמן" ×¤×¢× ×חת. >> הקישו C-s שוב, כדי ×œ×ž×¦×•× ×ת "סמן" במקומות × ×•×¡×¤×™× ×‘×˜×§×¡×˜. @@ -770,18 +770,18 @@ Auto Fill mode. ×›×שר ×ופן ×–×” מופעל, Emacs ×וטומטית פות (הערה: במערכות ×חדות הקשה על C-s מקפיעה ×ת תצוגת המסך, כך ×©×œ× ×ª×¨×ו יותר ×©×•× ×¤×œ×˜ של Emacs. משמעות הדבר ×©×ª×›×•× ×ª מערכת ההפעלה ששמה "flow -control" מופעלת ×¢"×™ C-s ו××™× ×” מעבירה ×ת C-s ל-Emacs. לביטול הקפ×ת +control" מופעלת ×¢"×™ C-s ו××™× ×” מעבירה ×ת C-s ל־Emacs. לביטול הקפ×ת התצוגה במערכות ×לו יש להקיש C-q.) ×× ×‘×ž×”×œ×š החיפוש תקישו על <Delback>, תר×ו שהתו ×”×חרון של המחרוזת המבוקשת × ×ž×—×§ והחיפוש חוזר ×œ×ž×§×•× ×”×§×•×“× ×‘×• × ×ž×¦××” המחרוזת ×œ×œ× ×”×ª×• ×”×חרון. -למשל, × × ×™×— ×©×”×§×©×ª× "ס" על-×ž× ×ª ×œ×ž×¦×•× ×ת ×”×ž×§×•× ×”×‘× ×‘×• מופיעה ×”×ות "ס". ×× +למשל, × × ×™×— ×©×”×§×©×ª× "ס" ×¢×œÖ¾×ž× ×ª ×œ×ž×¦×•× ×ת ×”×ž×§×•× ×”×‘× ×‘×• מופיעה ×”×ות "ס". ×× ×¢×›×©×™×• תקישו "מ", הסמן יזוז ×œ×ž×§×•× ×‘×• × ×ž×¦× "סמ". עתה הקישו <Delback>. -×”-"מ" × ×ž×—×§ מהמחרוזת והסמן חוזר ×œ×ž×§×•× ×‘×• ×”×•× ×ž×¦× ×ת "ס" לר××©×•× ×”. +×”Ö¾"מ" × ×ž×—×§ מהמחרוזת והסמן חוזר ×œ×ž×§×•× ×‘×• ×”×•× ×ž×¦× ×ת "ס" לר××©×•× ×”. ×× ×‘×ž×”×œ×š החיפוש תפעילו פקודה כלשהי ×¢"×™ הקשה על מקש תוך לחיצה על CONTROL ×ו META, החיפוש יסתיי×. (כמה ×ª×•×•×™× ×™×•×¦××™× ×ž×›×œ×œ ×–×” -- ×לו ×ª×•×•×™× -×ž×™×•×—×“×™× ×‘×¢×ª חיפוש, כדוגמת C-s ו-C-r.) +×ž×™×•×—×“×™× ×‘×¢×ª חיפוש, כדוגמת C-s ו־C-r.) הקשה על C-s מתחילה חיפוש ×©×ž× ×¡×” ×œ×ž×¦×•× ×ת המחרוזת _×חרי_ הסמן. ×× ×‘×¨×¦×•× ×›× ×œ×ž×¦×•× ×ž×©×”×• בטקסט ×”×§×•×“× ×œ×ž×§×•× ×”× ×•×›×—×™, הקישו C-r ×‘×ž×§×•× C-s. כל @@ -792,7 +792,7 @@ CONTROL ×ו META, החיפוש יסתיי×. (כמה ×ª×•×•×™× ×™×•×¦××™× ×ž --------------- ×חת ×”×ª×›×•× ×•×ª ×”× ×•×—×•×ª של Emacs ×”×™× ×›×™ × ×™×ª×Ÿ להציג יותר מחלון ×חד על המסך -בו-×–×ž× ×™×ª. (הערה: Emacs משתמש ×‘×ž×•× ×— "frame" -- "×ª×‘× ×™×ª" -- בשביל מה +×‘×•Ö¾×–×ž× ×™×ª. (הערה: Emacs משתמש ×‘×ž×•× ×— "frame" -- "×ª×‘× ×™×ª" -- בשביל מה ×©×ª×•×›× ×™×•×ª ×חרות ×ž×›× ×•×ª "חלון". ×ª×‘× ×™×•×ª מתו×רות בפסקה הב××”. תוכלו ×œ×ž×¦×•× ×ת רשימת ×”×ž×•× ×—×™× ×©×œ Emacs בפרק "Glossary" של מדריך משתמש.) @@ -804,15 +804,15 @@ CONTROL ×ו META, החיפוש יסתיי×. (כמה ×ª×•×•×™× ×™×•×¦××™× ×ž >> הקישו C-M-v כדי לגלול ×ת החלון התחתון. (×× ×‘×ž×§×œ×“×ª ×©×œ×›× ×ין מקש META ×מיתי, הקישו ‎<ESC> C-v כתחליף.) ->> הקישו C-x o â€("o" ×”×•× ×¨×ž×– ל-"other", "×חר") על-×ž× ×ª להעביר ×ת הסמן +>> הקישו C-x o â€("o" ×”×•× ×¨×ž×– ל־"other", "×חר") ×¢×œÖ¾×ž× ×ª להעביר ×ת הסמן לחלון התחתון. ->> הקישו C-v ו-M-v בחלון התחתון כדי לגלול ×ותו. +>> הקישו C-v ו־M-v בחלון התחתון כדי לגלול ×ותו. המשיכו ×œ×§×¨×•× ×”×•×¨×ות ×לו בחלון העליון. >> הקישו C-x o שוב לחזור לחלון העליון. - הסמן בחלון העליון ייש×ר ×‘×ž×§×•× ×‘×• ×”×•× ×”×™×” ×œ×¤× ×™-כן. + הסמן בחלון העליון ייש×ר ×‘×ž×§×•× ×‘×• ×”×•× ×”×™×” ×œ×¤× ×™Ö¾×›×Ÿ. -תוכלו להמשיך להשתמש ב-C-x o כדי לדלג בין ×©× ×™ ×”×—×œ×•× ×•×ª. לכל חלון ×ž×™×§×•× +תוכלו להמשיך להשתמש ב־C-x o כדי לדלג בין ×©× ×™ ×”×—×œ×•× ×•×ª. לכל חלון ×ž×™×§×•× ×¡×ž×Ÿ משלו, ×בל רק חלון ×חד מציג ×ת הסמן בכל רגע. כל פקודות העריכה הרגילות פועלות על החלון שבו מוצג הסמן. ×× ×• קור××™× ×œ×—×œ×•×Ÿ ×–×” "החלון ×”× ×‘×—×¨". @@ -823,30 +823,30 @@ CONTROL ×ו META, החיפוש יסתיי×. (כמה ×ª×•×•×™× ×™×•×¦××™× ×ž â€C-M-v ×”×™× ×“×•×’×ž× ×חת של פקודת CONTROL-META. ×× ×‘×ž×§×œ×“×ª ×©×œ×›× ×§×™×™× ×ž×§×© META ×מיתי, תוכלו להקיש ×ת הפקודה ×¢"×™ לחיצה והחזקה של מקשי CONTROL -ו-META ×’× ×™×—×“ ו××– להקיש v. הסדר שבו תלחצו על CONTROL ו-META ××™× ×• ×ž×©× ×” +ו־META ×’× ×™×—×“ ו××– להקיש v. הסדר שבו תלחצו על CONTROL ו־META ××™× ×• ×ž×©× ×” ×›×™ ×©× ×™ ×”×ž×§×©×™× ×”×œ×œ×• ×¤×•×¢×œ×™× ×¢"×™ ×©×™× ×•×™ התו המוקש יחד ×ית×. -×× ×ין במקלדת מקש META ×מיתי ו××ª× ×ž×©×ª×ž×©×™× ×‘-<ESC> כתחליף, הסדר כן +×× ×ין במקלדת מקש META ×מיתי ו××ª× ×ž×©×ª×ž×©×™× ×‘Ö¾<ESC> כתחליף, הסדר כן ×ž×©× ×”: ×—×™×™×‘×™× ×œ×”×§×™×© <ESC> ורק ל×חר מכן CONTROL-v, וז×ת ×ž×©×•× -ש-CONTROL-<ESC> v ×œ× ×™×¢×‘×•×“. <ESC> ×”×•× ×ª×• בזכות עצמו, ×©×œ× ×›×ž×• CONTROL +ש־CONTROL-<ESC> v ×œ× ×™×¢×‘×•×“. <ESC> ×”×•× ×ª×• בזכות עצמו, ×©×œ× ×›×ž×• CONTROL ×ו META. >> הקישו C-x 1 (בחלון העליון) כדי לסלק ×ת החלון התחתון. (×ילו ×”×§×©×ª× C-x 1 בחלון התחתון, ×”×™×™×ª× ×ž×¡×œ×§×™× ×ת החלון העליון. תוכלו -לחשוב על פקודה זו ×›-"הש×ר רק חלון ×חד -- החלון בו ×× ×™ × ×ž×¦× ×¢×ª×”".) +לחשוב על פקודה זו ×›Ö¾"הש×ר רק חלון ×חד -- החלון בו ×× ×™ × ×ž×¦× ×¢×ª×”".) -×ין חובה להציג ×ת ×ותו החוצץ ×‘×©× ×™ ×”×—×œ×•× ×•×ª. תוכלו להשתמש ב-C-x C-f +×ין חובה להציג ×ת ×ותו החוצץ ×‘×©× ×™ ×”×—×œ×•× ×•×ª. תוכלו להשתמש ב־C-x C-f לפתיחת קובץ ב×חד ×”×—×œ×•× ×•×ª -- דבר ×–×” ××™× ×• משפיע על החלון ×”×©× ×™. ×פשר ×’× -לפתוח ×§×‘×¦×™× ×©×•× ×™× ×‘×›×œ ×חד ×ž×©× ×™ ×”×—×œ×•× ×•×ª ב×ופן בלתי-תלוי. +לפתוח ×§×‘×¦×™× ×©×•× ×™× ×‘×›×œ ×חד ×ž×©× ×™ ×”×—×œ×•× ×•×ª ב×ופן בלתי־תלוי. ×”× ×” עוד שיטה להשתמש ×‘×©× ×™ ×—×œ×•× ×•×ª להצגה של ×©× ×™ ×“×‘×¨×™× ×©×•× ×™×: ->> הקישו C-x 4 C-f ו×חר-כך הקישו ×©× ×©×œ ×חד ×”×§×‘×¦×™× ×©×œ×›×. +>> הקישו C-x 4 C-f ו×חר־כך הקישו ×©× ×©×œ ×חד ×”×§×‘×¦×™× ×©×œ×›×. סיימו ×¢× <Return>. שימו לב שהקובץ המבוקש מוצג בחלון התחתון. הסמן מדלג ×œ×©× ××£ הו×. ->> הקישו C-x o לעבור לחלון העליון ו×חר-כך הקישו C-x 1 כדי לסלק ×ת +>> הקישו C-x o לעבור לחלון העליון ו×חר־כך הקישו C-x 1 כדי לסלק ×ת החלון התחתון. @@ -866,8 +866,8 @@ META ×מיתי, תוכלו להקיש ×ת הפקודה ×¢"×™ לחיצה והח >> הקישו M-x delete-frame <Return>‎. ×”×ª×‘× ×™×ª שבה ×”×§×©×ª× ×ת הפקודה תיסגר ×•×ª×™×¢×œ× ×ž×”×ž×¡×š. -כמו-כן, × ×™×ª×Ÿ לסגור ×ª×‘× ×™×ª בדרך הרגילה ×”× ×ª×ž×›×ª ×¢"×™ ×ž× ×”×œ ×”×—×œ×•× ×•×ª של המערכת -×©×œ×›× (בדרך-כלל, ×¢"×™ הקלקה על הכפתור המסומן ב-"X" ×‘×¤×™× ×” ×¢×œ×™×•× ×” של +כמו־כן, × ×™×ª×Ÿ לסגור ×ª×‘× ×™×ª בדרך הרגילה ×”× ×ª×ž×›×ª ×¢"×™ ×ž× ×”×œ ×”×—×œ×•× ×•×ª של המערכת +×©×œ×›× (בדרך־כלל, ×¢"×™ הקלקה על הכפתור המסומן ב־"X" ×‘×¤×™× ×” ×¢×œ×™×•× ×” של ×”×ª×‘× ×™×ª.) ×©×•× ×ž×™×“×¢ ××™× ×• הולך לעיבוד ×›×שר ×¡×•×’×¨×™× ×ª×‘× ×™×ª (×ו חלון). המידע ×”×–×” פשוט יורד מהתצוגה, ×בל × ×™×ª×Ÿ ל×חזרו מ×וחר יותר. @@ -881,12 +881,12 @@ META ×מיתי, תוכלו להקיש ×ת הפקודה ×¢"×™ לחיצה והח כדי להחלץ מרמת עריכה רקורסיבית יש להקיש <ESC> <ESC> <ESC>. זוהי פקודה כללית של "הימלטות". × ×™×ª×Ÿ להשתמש בה ×’× ×›×“×™ לסלק ×—×œ×•× ×•×ª ×ž×™×•×ª×¨×™× ×•×œ×™×¦×™××” -מתוך ×ž×™× ×™-חוצץ. +מתוך ×ž×™× ×™Ö¾×—×•×¦×¥. ->> הקישו M-x כדי ×œ×”×™×›× ×¡ ×œ×ž×™× ×™-חוצץ; ×חר-כך הקישו <ESC> <ESC> <ESC> כדי +>> הקישו M-x כדי ×œ×”×™×›× ×¡ ×œ×ž×™× ×™Ö¾×—×•×¦×¥; ×חר־כך הקישו <ESC> <ESC> <ESC> כדי להיחלץ מש×. -הקשה על C-g ×œ× ×ª×—×œ×¥ ××ª×›× ×ž×¨×ž×•×ª עריכה רקורסיביות. ×–×ת, ×ž×©×•× ×©-C-g מבטל +הקשה על C-g ×œ× ×ª×—×œ×¥ ××ª×›× ×ž×¨×ž×•×ª עריכה רקורסיביות. ×–×ת, ×ž×©×•× ×©Ö¾C-g מבטל פקודות ו××¨×’×•×ž× ×˜×™× _במסגרת_ הרמה הרקורסיבית, מבלי לצ×ת ×ž×ž× ×”. @@ -894,14 +894,14 @@ META ×מיתי, תוכלו להקיש ×ת הפקודה ×¢"×™ לחיצה והח ------------------ בשיעור הר×שון ×”×–×” ×”×©×ª×“×œ× ×• לתת ×‘×™×“×™×›× ×ž×™×“×¢ ש×ך יספיק להתחלת השימוש ×©×œ×›× -ב-Emacs. â€Emacs מכיל כל-כך הרבה ש×ין ×©×•× ×פשרות לת×ר ולהסביר ×›×ן ×ת +ב־Emacs. â€Emacs מכיל כל־כך הרבה ש×ין ×©×•× ×פשרות לת×ר ולהסביר ×›×ן ×ת הכל. ×ול×, סביר שתרצו ללמוד יותר על Emacs שכן יש בו עוד הרבה ×ª×›×•× ×•×ª שימושיות. Emacs כולל פקודות ×œ×©× ×§×¨×™×ת תיעוד על הפקודות של Emacs. -הפעלת פקודות "עזרה" ×לו תמיד מתחילה במקש CONTROL-h שעל-כן × ×§×¨× "מקש +הפעלת פקודות "עזרה" ×לו תמיד מתחילה במקש CONTROL-h שעל־כן × ×§×¨× "מקש עזרה" ("help"). -להפעלת פקודות עזרה יש להקיש ×ת C-h ו×חר-כך עוד תו שמבקש עזרה מסוג -מסויי×. ×× ××ª× _ב×מת_ ×בודי×, הקישו C-h ?‎ ו-Emacs יציג ×ת סוגי העזרה +להפעלת פקודות עזרה יש להקיש ×ת C-h ו×חר־כך עוד תו שמבקש עזרה מסוג +מסויי×. ×× ××ª× _ב×מת_ ×בודי×, הקישו C-h ?‎ ו־Emacs יציג ×ת סוגי העזרה ×©×”×•× ×ž×¢×ž×™×“ לרשותכ×. ×× ×”×§×©×ª× C-h ובסופו של דבר ×”×—×œ×˜×ª× ×©×ין צורך ×‘×©×•× ×¢×–×¨×”, פשוט הקישו C-g לבטל ×ת הפקודה. @@ -931,7 +931,7 @@ M-x help <Return>‎ כתחליף.) כתוצ××”, יוצגו ×”×©× ×•×”×ª×™×¢×•×“ של ×”×¤×•× ×§×¦×™×” בחלון Emacs × ×¤×¨×“. כשתסיימו ×œ×§×¨×•× ×ת התיעוד, הקישו C-x 1 כדי לסלק ×ת חלון העזרה. ×œ× ×—×™×™×‘×™× ×œ×¢×©×•×ª ×–×ת -מיד. ×פשר לבצע קצת עריכה תוך שימוש בתיעוד המוצג ורק ×חר-כך להקיש C-x 1. +מיד. ×פשר לבצע קצת עריכה תוך שימוש בתיעוד המוצג ורק ×חר־כך להקיש C-x 1. ×”× ×” עוד כמה פקודות עזרה שימושיות: @@ -939,12 +939,12 @@ M-x help <Return>‎ כתחליף.) >> × ×¡×• להקיש C-h f previous-line <Return>‎. כתוצ××”, יוצג תיעוד ×ž×œ× ×©×œ ×”×¤×•× ×§×¦×™×” המממשת ×ת הפקודה C-p כפי ×©×”×•× - ידוע ל-Emacs. + ידוע ל־Emacs. פקודה דומה C-h v מציגה תיעוד של ×ž×©×ª× ×”, כולל ×לו ש×ת ×”×¢×¨×›×™× ×©×œ×”× × ×™×ª×Ÿ ×œ×©× ×•×ª כדי ×œ×§×¡×˜× ×ת Emacs. יש להקיש ×ת ×©× ×”×ž×©×ª× ×” ×›×שר Emacs יבקש ×–×ת. - â€C-h a פקודות ×‘× ×•×’×¢ ×œ× ×•×©× ×ž×¡×•×™×™×. הקישו מילת מפתח ו-Emacs + â€C-h a פקודות ×‘× ×•×’×¢ ×œ× ×•×©× ×ž×¡×•×™×™×. הקישו מילת מפתח ו־Emacs יציג ×ת רשימת הפקודות ששמותיהן מכילות ×ת מילת המפתח. כל הפקודות הללו × ×™×ª× ×•×ª להפעלה ×¢"×™ META-x. עבור חלק מהפקודות תוצג ×’× ×¡×“×¨×ª ×ž×§×©×™× ×©×ž×¤×¢×™×œ×” ×ת הפקודה. @@ -963,7 +963,7 @@ find-file. ידועה ×’× ×‘×©× "Info".) פקודה ×–×ת פותחת חוצץ מיוחד הקרוי "*info*" שבו תוכלו ×œ×§×¨×•× ×ž×“×¨×™×›×™× ×”×ž×•×ª×§× ×™× ×‘×ž×¢×¨×›×ª שלכ×. הקישו m emacs <Return>‎ כדי ×œ×§×¨×•× ×‘×ž×“×¨×™×š למשתמשי Emacs. - ×× ××™× ×›× ×ž×›×™×¨×™× ×ת Info, הקישו ? ו-Emacs יקח ××ª×›× + ×× ××™× ×›× ×ž×›×™×¨×™× ×ת Info, הקישו ? ו־Emacs יקח ××ª×›× ×œ×©×™×¢×•×¨ על ×”×ª×›×•× ×•×ª של Info mode. כשתסיימו ×¢× ×”×©×™×¢×•×¨ ×”×–×”, ×× ×• בהחלט ×ž×ž×œ×™×¦×™× ×œ×”×©×ª×ž×© במדריך Emacs בתור התיעוד העיקרי שלכ×. @@ -972,13 +972,13 @@ find-file. * עוד ×ª×›×•× ×•×ª ------------ -תוכלו ללמוד עוד על-×ודות Emacs ×¢"×™ קרי××” במדריך למשתמש שלו, ×× ×›×¡×¤×¨ +תוכלו ללמוד עוד על־×ודות Emacs ×¢"×™ קרי××” במדריך למשתמש שלו, ×× ×›×¡×¤×¨ מודפס ×ו בגירסה ×ž×§×•×•× ×ª בתוך Emacs עצמו. (תוכלו להגיע ×ל המדריך דרך תפריט Help ×ו ×¢"×™ הקשה על C-h r.) ××•×œ× ×©×ª×™ ×ª×›×•× ×•×ª שבווד××™ ימצ×ו חן -×‘×¢×™× ×™×›× ×”×Ÿ השלמה ×שר חוסכת הקשות, ו-dired שמ×פשרת טיפול × ×•×— בקבצי×. +×‘×¢×™× ×™×›× ×”×Ÿ השלמה ×שר חוסכת הקשות, ו־dired שמ×פשרת טיפול × ×•×— בקבצי×. השלמה ×”×™× ×“×¨×š ×œ×”×™×ž× ×¢ מהקשות מיותרות. למשל, ×× ×‘×¨×¦×•× ×›× ×œ×¢×‘×•×¨ לחוצץ -*Messages*, תוכלו להקיש C-x b *M<Tab>‎ ו-Emacs ×™×©×œ×™× ×ת ש×ר ×”×ותיות של +*Messages*, תוכלו להקיש C-x b *M<Tab>‎ ו־Emacs ×™×©×œ×™× ×ת ש×ר ×”×ותיות של ×©× ×”×—×•×¦×¥ ככל ×©× ×™×ª×Ÿ להסיק ממה שהקשת×. השלמה פועלת ×’× ×¢×œ שמות הפקודות ושמות קבצי×. ×ª×›×•× ×ª ההשלמה מתו×רת במלו××” במדריך למשתמש Emacs בצומת (node) ×‘×©× "Completion". @@ -993,7 +993,7 @@ find-file. * ×œ×¡×™×•× ------- -כדי לצ×ת מ-Emacs יש להקיש C-x C-c. +כדי לצ×ת מ־Emacs יש להקיש C-x C-c. שיעור ×–×” × ×›×ª×‘ כדי להיות מובן לכל ×”×ž×©×ª×ž×©×™× ×”×—×“×©×™×, לכן ×× ×ž×¦××ª× ×©×ž×©×”×• ×›×ן ××™× ×• ברור, ×ל תשבו ות×שימו ×ת ×¢×¦×ž×›× -- ×ª×ª×œ×•× × ×•! @@ -1002,8 +1002,8 @@ find-file. * זכויות שימוש -------------- -שיעור ×–×” ×”×™× ×• צ××¦× ×©×œ שורה ×רוכה של ×©×™×¢×•×¨×™× ×‘×©×™×ž×•×© ב-Emacs, החל מהגרסה -הר××©×•× ×” ×©× ×›×ª×‘×” ×¢"×™ Stuart Cracraft עבור גירסת ×”-Emacs המקורית. +שיעור ×–×” ×”×™× ×• צ××¦× ×©×œ שורה ×רוכה של ×©×™×¢×•×¨×™× ×‘×©×™×ž×•×© ב־Emacs, החל מהגרסה +הר××©×•× ×” ×©× ×›×ª×‘×” ×¢"×™ Stuart Cracraft עבור גירסת ×”Ö¾Emacs המקורית. גירסה זו של השיעור ×”×™× ×” חלק מחבילת GNU Emacs. ×”×™× ×ž×•×’× ×ª בזכויות ×™×•×¦×¨×™× ×•× ×™×ª× ×ª להעתקה והפצת ×¢×•×ª×§×™× ×‘×ª× ××™× ×ž×¡×•×™×™×ž×™× ×›×“×œ×§×ž×Ÿ: @@ -1016,11 +1016,11 @@ Software Foundation, ×× ×‘×’×¨×¡× 3 של הרשיון, ו×× (×›×ופציה בכל ×’×¨×¡× ×ž×וחרת יותר. â€GNU Emacs מופץ מתוך תקווה ×©×”×•× ×™×‘×™× ×ª×•×¢×œ×ª, ××•×œ× ×œ×œ× ×›×œ כתב ×חריות; -×פילו ×œ× ×חריות-במשתמע של סחירות ×ו הת×מה ל×יזו תכלית מסוימת. לפרטי×, -×× × ×¢×™×™× ×• ב-GNU General Public License. +×פילו ×œ× ×חריות־במשתמע של סחירות ×ו הת×מה ל×יזו תכלית מסוימת. לפרטי×, +×× × ×¢×™×™× ×• ב־GNU General Public License. â€GNU Emacs ×מור להיות מלווה בעותק של GNU General Public License; ×× ×œ× -×§×™×‘×œ×ª× ×ותו, תוכלו ×œ×ž×¦×•× ×ותו ב-â€<http://www.gnu.org/licenses/>‬. +×§×™×‘×œ×ª× ×ותו, תוכלו ×œ×ž×¦×•× ×ותו ב־â€<http://www.gnu.org/licenses/>‬. ×”× ×›× ×ž×•×–×ž× ×™× ×œ×§×¨×•× ×ת הקובץ COPYING ו××– ×כן לחלק ×¢×•×ª×§×™× ×©×œ GNU Emacs לחבריכ×. עזרו ×œ× ×• לחסל ×ת "הבעלות" על ×ª×•×›× ×” ש××™× ×” ××œ× ×—×‘×œ×” ×‘×ª×•×›× ×”, diff --git a/leim/ChangeLog b/leim/ChangeLog index 174102b7817..1233aaf3062 100644 --- a/leim/ChangeLog +++ b/leim/ChangeLog @@ -1,3 +1,31 @@ +2010-08-28 Kenichi Handa <handa@m17n.org> + + * quail/japanese.el (quail-japanese-update-translation): Fix + handling of invalid key. + +2010-08-15 Andreas Schwab <schwab@linux-m68k.org> + + * quail/vntelex.el ("vietnamese-telex"): Doc fix. + + * quail/georgian.el: Remove extra backslashes. + +2010-08-14 Andreas Schwab <schwab@linux-m68k.org> + + * quail/arabic.el: Quote [ and ]. + * quail/latin-ltx.el: Likewise. + + * quail/greek.el ("greek", "greek-postfix"): Change string to + character. + +2010-08-13 Kenichi Handa <handa@m17n.org> + + * quail/greek.el ("greek-postfix"): Add rules for Greek style + quotes. + +2010-08-09 Kenichi Handa <handa@m17n.org> + + * quail/greek.el ("greek"): Add rules for Greek style quotes. + 2010-05-15 Glenn Morris <rgm@gnu.org> * Makefile.in (install): Remove references to CVS-related files. diff --git a/leim/Makefile.in b/leim/Makefile.in index 6eb18bc76d9..ba70319ca1e 100644 --- a/leim/Makefile.in +++ b/leim/Makefile.in @@ -48,7 +48,7 @@ buildlisppath=${srcdir}/../lisp # How to run Emacs. RUN-EMACS = EMACSLOADPATH=$(buildlisppath) LC_ALL=C \ - ${BUILT-EMACS} -batch --no-init-file --no-site-file --multibyte + ${BUILT-EMACS} -batch --no-init-file --no-site-file # Subdirectories to be made if ${srcdir} is different from the current # directory. diff --git a/leim/makefile.w32-in b/leim/makefile.w32-in index dbebc32602c..f55fbbf816c 100644 --- a/leim/makefile.w32-in +++ b/leim/makefile.w32-in @@ -37,7 +37,7 @@ BUILT_EMACS = $(THISDIR)/$(dot)$(dot)/src/$(BLD)/emacs.exe buildlisppath=$(CURDIR)/$(dot)$(dot)/lisp # How to run Emacs. -RUN_EMACS = "$(BUILT_EMACS)" -batch --no-init-file --no-site-file --multibyte +RUN_EMACS = "$(BUILT_EMACS)" -batch --no-init-file --no-site-file # Set EMACSLOADPATH correctly (already defined in environment). EMACSLOADPATH=$(buildlisppath) diff --git a/leim/quail/arabic.el b/leim/quail/arabic.el index 4e613cad16e..cb77183bc96 100644 --- a/leim/quail/arabic.el +++ b/leim/quail/arabic.el @@ -57,8 +57,8 @@ Based on Arabic table in X Keyboard Configuration DB. ("A" ?Ù) ("S" ?Ù) - ("D" ?]) - ("F" ?[) + ("D" ?\]) + ("F" ?\[) ("G" ["لأ"]) ("H" ?Ø£) ("J" ?Ù€) diff --git a/leim/quail/georgian.el b/leim/quail/georgian.el index 0101a930d37..a063d126667 100644 --- a/leim/quail/georgian.el +++ b/leim/quail/georgian.el @@ -51,7 +51,7 @@ ("n" ?ნ) ("o" ?áƒ) (".p" ?პ) - ("\+z" ?ჟ) + ("+z" ?ჟ) ("r" ?რ) ("s" ?ს) (".t" ?ტ) @@ -60,14 +60,14 @@ ("k" ?ქ) (".g" ?ღ) ("q" ?ყ) - ("\+s" ?შ) - ("\+c" ?ჩ) + ("+s" ?შ) + ("+c" ?ჩ) ("c" ?ც) ("j" ?ძ) (".c" ?წ) - (".\+c" ?áƒ) + (".+c" ?áƒ) ("x" ?ხ) - ("\+j" ?ჯ) + ("+j" ?ჯ) ("h" ?ჰ) ("q1" ?ჴ) ("e0" ?ჱ) diff --git a/leim/quail/greek.el b/leim/quail/greek.el index 1085ca229cf..688b247b0b5 100644 --- a/leim/quail/greek.el +++ b/leim/quail/greek.el @@ -1279,7 +1279,9 @@ e.g. (";:i" ?,F@(B) (":;i" ?,F@(B) (";:y" ?,F`(B) - (":;y" ?,F`(B)) + (":;y" ?,F`(B) + (";<" ?$(Q)((B) + (";>" ?$(Q)2(B)) (quail-define-package "greek-postfix" "GreekPost" ",FX(B" nil @@ -1419,7 +1421,12 @@ e.g. ("i:;" ?,F@(B) ("i;:" ?,F@(B) ("y:;" ?,F`(B) - ("y;:" ?,F`(B)) + ("y;:" ?,F`(B) + ;; These two are asymmetric with ";<" and ";>" in "greek" input + ;; method. But, as the other Latin postfix methods adopt "<<" and + ;; ">>", it may be better to follow them. + ("<<" ?$(Q)((B) + (">>" ?$(Q)2(B)) ;; arch-tag: 2a37e042-db1b-4ecf-b755-117775a3c150 diff --git a/leim/quail/japanese.el b/leim/quail/japanese.el index e1f7e74e030..42d83c6b806 100644 --- a/leim/quail/japanese.el +++ b/leim/quail/japanese.el @@ -43,20 +43,25 @@ (or quail-current-str quail-current-key) "")) (if (integerp control-flag) - (if (= control-flag 0) - (setq quail-current-str (aref quail-current-key 0)) - (cond ((= (aref quail-current-key 0) ?n) + (let ((keylen (length quail-current-key))) + (cond ((= control-flag 0) + (setq quail-current-str (aref quail-current-key 0) + control-flag t)) + ((= (aref quail-current-key 0) ?n) (setq quail-current-str ?$B$s(B) (if (and quail-japanese-use-double-n + (> keylen 0) (= (aref quail-current-key 1) ?n)) (setq control-flag t))) - ((= (aref quail-current-key 0) (aref quail-current-key 1)) + ((and (> keylen 1) + (= (aref quail-current-key 0) (aref quail-current-key 1))) (setq quail-current-str ?$B$C(B)) (t (setq quail-current-str (aref quail-current-key 0)))) (if (integerp control-flag) (setq unread-command-events - (list (aref quail-current-key control-flag))))))) + (string-to-list + (substring quail-current-key control-flag))))))) control-flag) ;; Convert Hiragana <-> Katakana in the current translation region. diff --git a/leim/quail/latin-ltx.el b/leim/quail/latin-ltx.el index 5001c4dd0ef..8b58bf39d54 100644 --- a/leim/quail/latin-ltx.el +++ b/leim/quail/latin-ltx.el @@ -653,7 +653,7 @@ system, including many technical ones. Examples: ("\\lambda" ?λ) ("\\langle" ?〈) ("\\lbrace" ?{) - ("\\lbrack" ?[) + ("\\lbrack" ?\[) ("\\lceil" ?⌈) ("\\ldots" ?…) ("\\le" ?≤) @@ -788,7 +788,7 @@ system, including many technical ones. Examples: ("\\quad" ?â€) ("\\rangle" ?〉) ("\\rbrace" ?}) - ("\\rbrack" ?]) + ("\\rbrack" ?\]) ("\\rceil" ?⌉) ("\\rfloor" ?⌋) ("\\rightarrow" ?→) diff --git a/leim/quail/vntelex.el b/leim/quail/vntelex.el index 8af020b093c..4a94a4be59c 100644 --- a/leim/quail/vntelex.el +++ b/leim/quail/vntelex.el @@ -53,7 +53,7 @@ Other diacritics: acute s as -> ,1a(B grave f af -> ,1`(B hook above r ar -> ,1d(B - tilde x ax -> ,1c(B + tilde x ax -> ,1c(B dot below j aj -> ,1U(B d bar dd -> ,1p(B diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 6ac9bf19a24..4f3f386310a 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,54 @@ +2010-08-11 Jan Djärv <jan.h.d@swipnet.se> + + * fakemail.c: Include stdlib.h for getenv. Remove declaration of + popen, fclose and pclose. + (my_name, fatal, error, put_line): Use const char* + (main): Remove extern getenv, mail_program_name is const char*. + + * update-game-score.c (get_prefix, write_scores, main): Use const char*. + + * sorted-doc.c (error, fatal, states): Use const char *. + + * pop.h (pop_multi_first): Use const char *. + (_ARGS): Remove. + + * pop.c (pop_multi_first, socket_connection, sendline): Use conat char*. + + * movemail.c (fatal, error, concat): Use const char *. + + * make-docfile.c (error, fatal, scan_c_file, scan_lisp_file): Use + const char *. + + * etags.c (compressor, language, Ada_suffix, Ada_help, Asm_suffixes) + (Asm_help, default_C_suffixes, default_C_help, Cplusplus_suffixes) + (Cplusplus_help, Cjava_suffixes, Cobol_suffixes, Cstar_suffixes) + (Erlang_suffixes, Erlang_help, Forth_suffixes, Forth_help) + (Fortran_suffixes, Fortran_help, HTML_suffixes, HTML_help) + (Lisp_suffixes, Lisp_help, Lua_suffixes, Lua_help) + (Makefile_filenames, Makefile_help, Objc_suffixes, Objc_help) + (Pascal_suffixes, Pascal_help, Perl_suffixes, Perl_interpreters) + (Perl_help, PHP_suffixes, PHP_help, plain_C_suffixses, PS_suffixes) + (PS_help, Prolog_suffixes, Prolog_help, Python_suffixes, Python_help) + (Scheme_suffixes, Scheme_help, TeX_suffixes, TeX_help, Texinfo_suffixes) + (Texinfo_help, Yacc_suffixes, Yacc_help, auto_help, none_help) + (no_lang_help, print_language_names) + (get_language_from_interpreter, get_language_from_filename) + (init, make_tag, struct C_stab_entry, write_classname, TEX_defenv) + (TEX_decode_env, nocase_tail, savestr, savenstr, fatal, pfatal) + (concat): Use const char*. + + * emacsclient.c (message, sock_err_message, send_to_emacs) + (quote_argument, set_local_socket) + (start_daemon_and_retry_set_socket): Use const char*. + + * ebrowse.c (struct member): filename, def_filename is const. + (struct sym): filename, sfilename is const. + (struct kw): name is const. + (add_sym, yyerror, token_string, insert_keyword, main): Use const char*. + + * b2m.c (concat, fatal): Use const char*. + (main): Don't assign labels a string literal. + 2010-08-07 Juanma Barranquero <lekktu@gmail.com> * ebrowse.c (usage, version, mark_virtual): diff --git a/lib-src/b2m.c b/lib-src/b2m.c index f31b33f9780..803d75e233c 100644 --- a/lib-src/b2m.c +++ b/lib-src/b2m.c @@ -68,9 +68,9 @@ extern char *strtok(char *, const char *); long *xmalloc (unsigned int size); long *xrealloc (char *ptr, unsigned int size); -char *concat (char *s1, char *s2, char *s3); +char *concat (const char *s1, const char *s2, const char *s3); long readline (struct linebuffer *linebuffer, register FILE *stream); -void fatal (char *message) NO_RETURN; +void fatal (const char *message) NO_RETURN; /* * xnew -- allocate storage. SYNOPSIS: Type *xnew (int n, Type); @@ -170,6 +170,7 @@ main (int argc, char **argv) continue; else if (data.buffer[1] == '\f') { + static char babyl[] = "X-Babyl-Labels: "; if (first) first = FALSE; else if (! last_was_blank_line) @@ -177,7 +178,7 @@ main (int argc, char **argv) /* Save labels. */ readline (&data, stdin); p = strtok (data.buffer, " ,\r\n\t"); - labels = "X-Babyl-Labels: "; + labels = babyl; while ((p = strtok (NULL, " ,\r\n\t"))) labels = concat (labels, p, ", "); @@ -218,7 +219,7 @@ main (int argc, char **argv) * concatenate those of s1, s2, s3. */ char * -concat (char *s1, char *s2, char *s3) +concat (const char *s1, const char *s2, const char *s3) { int len1 = strlen (s1), len2 = strlen (s2), len3 = strlen (s3); char *result = xnew (len1 + len2 + len3 + 1, char); @@ -305,7 +306,7 @@ xrealloc (char *ptr, unsigned int size) } void -fatal (char *message) +fatal (const char *message) { fprintf (stderr, "%s: %s\n", progname, message); exit (EXIT_FAILURE); diff --git a/lib-src/ebrowse.c b/lib-src/ebrowse.c index 40e72939429..1fcbb8662f5 100644 --- a/lib-src/ebrowse.c +++ b/lib-src/ebrowse.c @@ -249,10 +249,10 @@ struct member int vis; /* Visibility (public, ...). */ int flags; /* See F_* above. */ char *regexp; /* Matching regular expression. */ - char *filename; /* Don't free this shared string. */ + const char *filename; /* Don't free this shared string. */ int pos; /* Buffer position of occurrence. */ char *def_regexp; /* Regular expression matching definition. */ - char *def_filename; /* File name of definition. */ + const char *def_filename; /* File name of definition. */ int def_pos; /* Buffer position of definition. */ char name[1]; /* Member name. */ }; @@ -294,8 +294,8 @@ struct sym struct member *types; /* List of local types. */ char *regexp; /* Matching regular expression. */ int pos; /* Buffer position. */ - char *filename; /* File in which it can be found. */ - char *sfilename; /* File in which members can be found. */ + const char *filename; /* File in which it can be found. */ + const char *sfilename; /* File in which members can be found. */ struct sym *namesp; /* Namespace in which defined. . */ char name[1]; /* Name of the class. */ }; @@ -353,7 +353,7 @@ int yyline; /* The name of the current input file. */ -char *filename; +const char *filename; /* Three character class vectors, and macros to test membership of characters. */ @@ -444,7 +444,7 @@ int tk = -1; struct kw { - char *name; /* Spelling. */ + const char *name; /* Spelling. */ int tk; /* Token value. */ struct kw *next; /* Next in collision chain. */ }; @@ -470,10 +470,10 @@ struct search_path *search_path_tail; int yylex (void); void yyparse (void); void re_init_parser (void); -char *token_string (int); +const char *token_string (int); char *matching_regexp (void); void init_sym (void); -struct sym *add_sym (char *, struct sym *); +struct sym *add_sym (const char *, struct sym *); void add_link (struct sym *, struct sym *); void add_member_defn (struct sym *, char *, char *, int, unsigned, int, int, int); @@ -489,7 +489,7 @@ void mark_inherited_virtual (void); void leave_namespace (void); void enter_namespace (char *); void register_namespace_alias (char *, struct link *); -void insert_keyword (char *, int); +void insert_keyword (const char *, int); void re_init_scanner (void); void init_scanner (void); void process_file (char *); @@ -517,7 +517,7 @@ struct sym *parse_classname (void); struct sym *parse_qualified_ident_or_type (char **); void parse_qualified_param_ident_or_type (char **); int globals (int); -void yyerror (char *, char *); +void yyerror (const char *, const char *); void usage (int) NO_RETURN; void version (void) NO_RETURN; @@ -531,7 +531,7 @@ void version (void) NO_RETURN; name and line number. */ void -yyerror (char *format, char *s) +yyerror (const char *format, const char *s) { fprintf (stderr, "%s:%d: ", filename, yyline); fprintf (stderr, format, s); @@ -605,11 +605,11 @@ init_sym (void) create a new symbol and set it to default values. */ struct sym * -add_sym (char *name, struct sym *nested_in_class) +add_sym (const char *name, struct sym *nested_in_class) { struct sym *sym; unsigned h; - char *s; + const char *s; struct sym *scope = nested_in_class ? nested_in_class : current_namespace; for (s = name, h = 0; *s; ++s) @@ -1975,7 +1975,7 @@ matching_regexp (void) /* Return a printable representation of token T. */ -char * +const char * token_string (int t) { static char b[3]; @@ -2111,9 +2111,9 @@ re_init_scanner (void) table. */ void -insert_keyword (char *name, int tk) +insert_keyword (const char *name, int tk) { - char *s; + const char *s; unsigned h = 0; struct kw *k = (struct kw *) xmalloc (sizeof *k); @@ -2839,7 +2839,7 @@ operator_name (int *sc) { static int id_size = 0; static char *id = NULL; - char *s; + const char *s; int len; MATCH (); @@ -3680,7 +3680,7 @@ main (int argc, char **argv) { int i; int any_inputfiles = 0; - static char *out_filename = DEFAULT_OUTFILE; + static const char *out_filename = DEFAULT_OUTFILE; static char **input_filenames = NULL; static int input_filenames_size = 0; static int n_input_files; diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index cbc1dfe3f6a..e8ffbe7c562 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -134,7 +134,7 @@ int eval = 0; int current_frame = 1; /* The display on which Emacs should work. --display. */ -char *display = NULL; +const char *display = NULL; /* The parent window ID, if we are opening a frame via XEmbed. */ char *parent_id = NULL; @@ -150,7 +150,7 @@ const char *alternate_editor = NULL; char *socket_name = NULL; /* If non-NULL, the filename of the authentication file. */ -char *server_file = NULL; +const char *server_file = NULL; /* PID of the Emacs server process. */ int emacs_pid = 0; @@ -479,7 +479,7 @@ ttyname (int fd) /* Display a normal or error message. On Windows, use a message box if compiled as a Windows app. */ void -message (int is_error, char *message, ...) +message (int is_error, const char *message, ...) { char msg[2048]; va_list args; @@ -724,7 +724,7 @@ HSOCKET emacs_socket = 0; /* On Windows, the socket library was historically separate from the standard C library, so errors are handled differently. */ void -sock_err_message (char *function_name) +sock_err_message (const char *function_name) { #ifdef WINDOWSNT char* msg = NULL; @@ -748,7 +748,7 @@ sock_err_message (char *function_name) - the buffer is full (but this shouldn't happen) Otherwise, we just accumulate it. */ void -send_to_emacs (HSOCKET s, char *data) +send_to_emacs (HSOCKET s, const char *data) { while (data) { @@ -787,10 +787,11 @@ send_to_emacs (HSOCKET s, char *data) Does not change the string. Outputs the result to S. */ void -quote_argument (HSOCKET s, char *str) +quote_argument (HSOCKET s, const char *str) { char *copy = (char *) xmalloc (strlen (str) * 2 + 1); - char *p, *q; + const char *p; + char *q; p = str; q = copy; @@ -1026,7 +1027,7 @@ set_tcp_socket (void) /* Returns 1 if PREFIX is a prefix of STRING. */ static int -strprefix (char *prefix, char *string) +strprefix (const char *prefix, const char *string) { return !strncmp (prefix, string, strlen (prefix)); } @@ -1215,8 +1216,8 @@ set_local_socket (void) int sock_status = 0; int default_sock = !socket_name; int saved_errno = 0; - char *server_name = "server"; - char *tmpdir; + const char *server_name = "server"; + const char *tmpdir; if (socket_name && !strchr (socket_name, '/') && !strchr (socket_name, '\\')) @@ -1479,11 +1480,13 @@ start_daemon_and_retry_set_socket (void) } else { - char *d_argv[] = {"emacs", "--daemon", 0 }; + char emacs[] = "emacs"; + char daemon[] = "--daemon"; + char *d_argv[] = {emacs, daemon, 0 }; if (socket_name != NULL) { /* Pass --daemon=socket_name as argument. */ - char *deq = "--daemon="; + const char *deq = "--daemon="; char *daemon_arg = alloca (strlen (deq) + strlen (socket_name) + 1); strcpy (daemon_arg, deq); diff --git a/lib-src/etags.c b/lib-src/etags.c index b78686dde57..42e4017ab50 100644 --- a/lib-src/etags.c +++ b/lib-src/etags.c @@ -272,18 +272,18 @@ typedef void Lang_function (FILE *); typedef struct { - char *suffix; /* file name suffix for this compressor */ - char *command; /* takes one arg and decompresses to stdout */ + const char *suffix; /* file name suffix for this compressor */ + const char *command; /* takes one arg and decompresses to stdout */ } compressor; typedef struct { - char *name; /* language name */ - char *help; /* detailed help for the language */ + const char *name; /* language name */ + const char *help; /* detailed help for the language */ Lang_function *function; /* parse function */ - char **suffixes; /* name suffixes of this language's files */ - char **filenames; /* names of this language's files */ - char **interpreters; /* interpreters for this language */ + const char **suffixes; /* name suffixes of this language's files */ + const char **filenames; /* names of this language's files */ + const char **interpreters; /* interpreters for this language */ bool metasource; /* source used to generate other sources */ } language; @@ -304,7 +304,7 @@ typedef struct node_st { /* sorting structure */ struct node_st *left, *right; /* left and right sons */ fdesc *fdp; /* description of file to whom tag belongs */ - char *name; /* tag name */ + char *name; /* tag name */ char *regex; /* search regexp */ bool valid; /* write this tag on the tag file */ bool is_func; /* function tag: use regexp in CTAGS mode */ @@ -399,7 +399,7 @@ static language *get_language_from_interpreter (char *); static language *get_language_from_filename (char *, bool); static void readline (linebuffer *, FILE *); static long readline_internal (linebuffer *, FILE *); -static bool nocase_tail (char *); +static bool nocase_tail (const char *); static void get_tag (char *, char **); static void analyse_regex (char *); @@ -407,8 +407,8 @@ static void free_regexps (void); static void regex_tag_multiline (void); static void error (const char *, const char *); static void suggest_asking_for_help (void) NO_RETURN; -void fatal (char *, char *) NO_RETURN; -static void pfatal (char *) NO_RETURN; +void fatal (const char *, const char *) NO_RETURN; +static void pfatal (const char *) NO_RETURN; static void add_node (node *, node **); static void init (void); @@ -418,15 +418,15 @@ static void find_entries (FILE *); static void free_tree (node *); static void free_fdesc (fdesc *); static void pfnote (char *, bool, char *, int, int, long); -static void make_tag (char *, int, bool, char *, int, int, long); +static void make_tag (const char *, int, bool, char *, int, int, long); static void invalidate_nodes (fdesc *, node **); static void put_entries (node *); -static char *concat (char *, char *, char *); +static char *concat (const char *, const char *, const char *); static char *skip_spaces (char *); static char *skip_non_spaces (char *); -static char *savenstr (char *, int); -static char *savestr (char *); +static char *savenstr (const char *, int); +static char *savestr (const char *); static char *etags_strchr (const char *, int); static char *etags_strrchr (const char *, int); static int etags_strcasecmp (const char *, const char *); @@ -469,7 +469,7 @@ static linebuffer token_name; /* a buffer containing a tag name */ /* boolean "functions" (see init) */ static bool _wht[CHARS], _nin[CHARS], _itk[CHARS], _btk[CHARS], _etk[CHARS]; -static char +static const char /* white chars */ *white = " \f\t\n\r\v", /* not in a name */ @@ -569,9 +569,9 @@ static compressor compressors[] = */ /* Ada code */ -static char *Ada_suffixes [] = +static const char *Ada_suffixes [] = { "ads", "adb", "ada", NULL }; -static char Ada_help [] = +static const char Ada_help [] = "In Ada code, functions, procedures, packages, tasks and types are\n\ tags. Use the `--packages-only' option to create tags for\n\ packages only.\n\ @@ -589,7 +589,7 @@ body of the package `bidule', while `M-x find-tag <RET> bidule <RET>'\n\ will just search for any tag `bidule'."; /* Assembly code */ -static char *Asm_suffixes [] = +static const char *Asm_suffixes [] = { "a", /* Unix assembler */ "asm", /* Microcontroller assembly */ "def", /* BSO/Tasking definition includes */ @@ -600,7 +600,7 @@ static char *Asm_suffixes [] = "src", /* BSO/Tasking C compiler output */ NULL }; -static char Asm_help [] = +static const char Asm_help [] = "In assembler code, labels appearing at the beginning of a line,\n\ followed by a colon, are tags."; @@ -608,10 +608,10 @@ followed by a colon, are tags."; /* Note that .c and .h can be considered C++, if the --c++ flag was given, or if the `class' or `template' keywords are met inside the file. That is why default_C_entries is called for these. */ -static char *default_C_suffixes [] = +static const char *default_C_suffixes [] = { "c", "h", NULL }; #if CTAGS /* C help for Ctags */ -static char default_C_help [] = +static const char default_C_help [] = "In C code, any C function is a tag. Use -t to tag typedefs.\n\ Use -T to tag definitions of `struct', `union' and `enum'.\n\ Use -d to tag `#define' macro definitions and `enum' constants.\n\ @@ -619,7 +619,7 @@ Use --globals to tag global variables.\n\ You can tag function declarations and external variables by\n\ using `--declarations', and struct members by using `--members'."; #else /* C help for Etags */ -static char default_C_help [] = +static const char default_C_help [] = "In C code, any C function or typedef is a tag, and so are\n\ definitions of `struct', `union' and `enum'. `#define' macro\n\ definitions and `enum' constants are tags unless you specify\n\ @@ -631,12 +631,12 @@ You can tag function declarations and external variables by\n\ using `--declarations'."; #endif /* C help for Ctags and Etags */ -static char *Cplusplus_suffixes [] = +static const char *Cplusplus_suffixes [] = { "C", "c++", "cc", "cpp", "cxx", "H", "h++", "hh", "hpp", "hxx", "M", /* Objective C++ */ "pdb", /* Postscript with C syntax */ NULL }; -static char Cplusplus_help [] = +static const char Cplusplus_help [] = "In C++ code, all the tag constructs of C code are tagged. (Use\n\ --help --lang=c --lang=c++ for full help.)\n\ In addition to C tags, member functions are also recognized. Member\n\ @@ -645,131 +645,131 @@ Tags for variables and functions in classes are named `CLASS::VARIABLE'\n\ and `CLASS::FUNCTION'. `operator' definitions have tag names like\n\ `operator+'."; -static char *Cjava_suffixes [] = +static const char *Cjava_suffixes [] = { "java", NULL }; static char Cjava_help [] = "In Java code, all the tags constructs of C and C++ code are\n\ tagged. (Use --help --lang=c --lang=c++ --lang=java for full help.)"; -static char *Cobol_suffixes [] = +static const char *Cobol_suffixes [] = { "COB", "cob", NULL }; static char Cobol_help [] = "In Cobol code, tags are paragraph names; that is, any word\n\ starting in column 8 and followed by a period."; -static char *Cstar_suffixes [] = +static const char *Cstar_suffixes [] = { "cs", "hs", NULL }; -static char *Erlang_suffixes [] = +static const char *Erlang_suffixes [] = { "erl", "hrl", NULL }; -static char Erlang_help [] = +static const char Erlang_help [] = "In Erlang code, the tags are the functions, records and macros\n\ defined in the file."; -char *Forth_suffixes [] = +const char *Forth_suffixes [] = { "fth", "tok", NULL }; -static char Forth_help [] = +static const char Forth_help [] = "In Forth code, tags are words defined by `:',\n\ constant, code, create, defer, value, variable, buffer:, field."; -static char *Fortran_suffixes [] = +static const char *Fortran_suffixes [] = { "F", "f", "f90", "for", NULL }; -static char Fortran_help [] = +static const char Fortran_help [] = "In Fortran code, functions, subroutines and block data are tags."; -static char *HTML_suffixes [] = +static const char *HTML_suffixes [] = { "htm", "html", "shtml", NULL }; -static char HTML_help [] = +static const char HTML_help [] = "In HTML input files, the tags are the `title' and the `h1', `h2',\n\ `h3' headers. Also, tags are `name=' in anchors and all\n\ occurrences of `id='."; -static char *Lisp_suffixes [] = +static const char *Lisp_suffixes [] = { "cl", "clisp", "el", "l", "lisp", "LSP", "lsp", "ml", NULL }; -static char Lisp_help [] = +static const char Lisp_help [] = "In Lisp code, any function defined with `defun', any variable\n\ defined with `defvar' or `defconst', and in general the first\n\ argument of any expression that starts with `(def' in column zero\n\ is a tag."; -static char *Lua_suffixes [] = +static const char *Lua_suffixes [] = { "lua", "LUA", NULL }; -static char Lua_help [] = +static const char Lua_help [] = "In Lua scripts, all functions are tags."; -static char *Makefile_filenames [] = +static const char *Makefile_filenames [] = { "Makefile", "makefile", "GNUMakefile", "Makefile.in", "Makefile.am", NULL}; -static char Makefile_help [] = +static const char Makefile_help [] = "In makefiles, targets are tags; additionally, variables are tags\n\ unless you specify `--no-globals'."; -static char *Objc_suffixes [] = +static const char *Objc_suffixes [] = { "lm", /* Objective lex file */ "m", /* Objective C file */ NULL }; -static char Objc_help [] = +static const char Objc_help [] = "In Objective C code, tags include Objective C definitions for classes,\n\ class categories, methods and protocols. Tags for variables and\n\ functions in classes are named `CLASS::VARIABLE' and `CLASS::FUNCTION'.\n\ (Use --help --lang=c --lang=objc --lang=java for full help.)"; -static char *Pascal_suffixes [] = +static const char *Pascal_suffixes [] = { "p", "pas", NULL }; -static char Pascal_help [] = +static const char Pascal_help [] = "In Pascal code, the tags are the functions and procedures defined\n\ in the file."; /* " // this is for working around an Emacs highlighting bug... */ -static char *Perl_suffixes [] = +static const char *Perl_suffixes [] = { "pl", "pm", NULL }; -static char *Perl_interpreters [] = +static const char *Perl_interpreters [] = { "perl", "@PERL@", NULL }; -static char Perl_help [] = +static const char Perl_help [] = "In Perl code, the tags are the packages, subroutines and variables\n\ defined by the `package', `sub', `my' and `local' keywords. Use\n\ `--globals' if you want to tag global variables. Tags for\n\ subroutines are named `PACKAGE::SUB'. The name for subroutines\n\ defined in the default package is `main::SUB'."; -static char *PHP_suffixes [] = +static const char *PHP_suffixes [] = { "php", "php3", "php4", NULL }; -static char PHP_help [] = +static const char PHP_help [] = "In PHP code, tags are functions, classes and defines. Unless you use\n\ the `--no-members' option, vars are tags too."; -static char *plain_C_suffixes [] = +static const char *plain_C_suffixes [] = { "pc", /* Pro*C file */ NULL }; -static char *PS_suffixes [] = +static const char *PS_suffixes [] = { "ps", "psw", NULL }; /* .psw is for PSWrap */ -static char PS_help [] = +static const char PS_help [] = "In PostScript code, the tags are the functions."; -static char *Prolog_suffixes [] = +static const char *Prolog_suffixes [] = { "prolog", NULL }; -static char Prolog_help [] = +static const char Prolog_help [] = "In Prolog code, tags are predicates and rules at the beginning of\n\ line."; -static char *Python_suffixes [] = +static const char *Python_suffixes [] = { "py", NULL }; -static char Python_help [] = +static const char Python_help [] = "In Python code, `def' or `class' at the beginning of a line\n\ generate a tag."; /* Can't do the `SCM' or `scm' prefix with a version number. */ -static char *Scheme_suffixes [] = +static const char *Scheme_suffixes [] = { "oak", "sch", "scheme", "SCM", "scm", "SM", "sm", "ss", "t", NULL }; -static char Scheme_help [] = +static const char Scheme_help [] = "In Scheme code, tags include anything defined with `def' or with a\n\ construct whose name starts with `def'. They also include\n\ variables set with `set!' at top level in the file."; -static char *TeX_suffixes [] = +static const char *TeX_suffixes [] = { "bib", "clo", "cls", "ltx", "sty", "TeX", "tex", NULL }; -static char TeX_help [] = +static const char TeX_help [] = "In LaTeX text, the argument of any of the commands `\\chapter',\n\ `\\section', `\\subsection', `\\subsubsection', `\\eqno', `\\label',\n\ `\\ref', `\\cite', `\\bibitem', `\\part', `\\appendix', `\\entry',\n\ @@ -781,28 +781,28 @@ Other commands can be specified by setting the environment variable\n\ TEXTAGS=\"mycommand:myothercommand\"."; -static char *Texinfo_suffixes [] = +static const char *Texinfo_suffixes [] = { "texi", "texinfo", "txi", NULL }; -static char Texinfo_help [] = +static const char Texinfo_help [] = "for texinfo files, lines starting with @node are tagged."; -static char *Yacc_suffixes [] = +static const char *Yacc_suffixes [] = { "y", "y++", "ym", "yxx", "yy", NULL }; /* .ym is Objective yacc file */ -static char Yacc_help [] = +static const char Yacc_help [] = "In Bison or Yacc input files, each rule defines as a tag the\n\ nonterminal it constructs. The portions of the file that contain\n\ C code are parsed as C code (use --help --lang=c --lang=yacc\n\ for full help)."; -static char auto_help [] = +static const char auto_help [] = "`auto' is not a real language, it indicates to use\n\ a default language for files base on file name suffix and file contents."; -static char none_help [] = +static const char none_help [] = "`none' is not a real language, it indicates to only do\n\ regexp processing on files."; -static char no_lang_help [] = +static const char no_lang_help [] = "No detailed help available for this language."; @@ -851,7 +851,7 @@ static void print_language_names (void) { language *lang; - char **name, **ext; + const char **name, **ext; puts ("\nThese are the currently supported languages, along with the\n\ default file names and dot suffixes:"); @@ -1467,7 +1467,7 @@ static language * get_language_from_interpreter (char *interpreter) { language *lang; - char **iname; + const char **iname; if (interpreter == NULL) return NULL; @@ -1489,7 +1489,7 @@ static language * get_language_from_filename (char *file, int case_sensitive) { language *lang; - char **name, **ext, *suffix; + const char **name, **ext, *suffix; /* Try whole file name first. */ for (lang = lang_names; lang->name != NULL; lang++) @@ -1721,7 +1721,7 @@ process_file (FILE *fh, char *fn, language *lang) static void init (void) { - register char *sp; + register const char *sp; register int i; for (i = 0; i < CHARS; i++) @@ -1900,23 +1900,23 @@ find_entries (FILE *inf) * etags.el needs to use the same characters that are in NONAM. */ static void -make_tag (char *name, int namelen, int is_func, char *linestart, int linelen, int lno, long int cno) - /* tag name, or NULL if unnamed */ - /* tag length */ - /* tag is a function */ - /* start of the line where tag is */ - /* length of the line where tag is */ - /* line number */ - /* character number */ +make_tag (const char *name, /* tag name, or NULL if unnamed */ + int namelen, /* tag length */ + int is_func, /* tag is a function */ + char *linestart, /* start of the line where tag is */ + int linelen, /* length of the line where tag is */ + int lno, /* line number */ + long int cno) /* character number */ { bool named = (name != NULL && namelen > 0); + char *nname = NULL; if (!CTAGS && named) /* maybe set named to false */ /* Let's try to make an implicit tag name, that is, create an unnamed tag such that etags.el can guess a name from it. */ { int i; - register char *cp = name; + register const char *cp = name; for (i = 0; i < namelen; i++) if (notinname (*cp++)) @@ -1935,10 +1935,9 @@ make_tag (char *name, int namelen, int is_func, char *linestart, int linelen, in } if (named) - name = savenstr (name, namelen); - else - name = NULL; - pfnote (name, is_func, linestart, linelen, lno, cno); + nname = savenstr (name, namelen); + + pfnote (nname, is_func, linestart, linelen, lno, cno); } /* Record a tag. */ @@ -2361,7 +2360,7 @@ and replace lines between %< and %> with its output, then: /* Command-line: gperf -m 5 */ /* Computed positions: -k'2-3' */ -struct C_stab_entry { char *name; int c_ext; enum sym_type type; }; +struct C_stab_entry { const char *name; int c_ext; enum sym_type type; }; /* maximum key range = 33, duplicates = 0 */ #ifdef __GNUC__ @@ -2550,7 +2549,7 @@ static enum /* * When objdef is different from onone, objtag is the name of the class. */ -static char *objtag = "<uninited>"; +static const char *objtag = "<uninited>"; /* * Yet another little state machine to deal with preprocessor lines. @@ -2613,7 +2612,7 @@ static struct tok */ static void pushclass_above (int, char *, int); static void popclass_above (int); -static void write_classname (linebuffer *, char *qualifier); +static void write_classname (linebuffer *, const char *qualifier); static struct { char **cname; /* nested class names */ @@ -2661,7 +2660,7 @@ popclass_above (int bracelev) } static void -write_classname (linebuffer *cn, char *qualifier) +write_classname (linebuffer *cn, const char *qualifier) { int i, len; int qlen = strlen (qualifier); @@ -3092,7 +3091,7 @@ C_entries (int c_ext, FILE *inf) int curndx, newndx; /* indices for current and new lb */ register int tokoff; /* offset in line of start of current token */ register int toklen; /* length of current token */ - char *qualifier; /* string used to qualify names */ + const char *qualifier; /* string used to qualify names */ int qlen; /* length of qualifier */ int bracelev; /* current brace level */ int bracketlev; /* current bracket level */ @@ -4127,12 +4126,10 @@ Fortran_functions (FILE *inf) * Philippe Waroquiers (1998) */ -static void Ada_getit (FILE *, char *); - /* Once we are positioned after an "interesting" keyword, let's get the real tag value necessary. */ static void -Ada_getit (FILE *inf, char *name_qualifier) +Ada_getit (FILE *inf, const char *name_qualifier) { register char *cp; char *name; @@ -4961,13 +4958,13 @@ static linebuffer *TEX_toktab = NULL; /* Table with tag tokens */ /* Default set of control sequences to put into TEX_toktab. The value of environment var TEXTAGS is prepended to this. */ -static char *TEX_defenv = "\ +static const char *TEX_defenv = "\ :chapter:section:subsection:subsubsection:eqno:label:ref:cite:bibitem\ :part:appendix:entry:index:def\ :newcommand:renewcommand:newenvironment:renewenvironment"; static void TEX_mode (FILE *); -static void TEX_decode_env (char *, char *); +static void TEX_decode_env (const char *, const char *); static char TEX_esc = '\\'; static char TEX_opgrp = '{'; @@ -5075,9 +5072,9 @@ TEX_mode (FILE *inf) /* Read environment and prepend it to the default string. Build token table. */ static void -TEX_decode_env (char *evarname, char *defenv) +TEX_decode_env (const char *evarname, const char *defenv) { - register char *env, *p; + register const char *env, *p; int i, len; /* Append default string to environment. */ @@ -5085,10 +5082,7 @@ TEX_decode_env (char *evarname, char *defenv) if (!env) env = defenv; else - { - char *oldenv = env; - env = concat (oldenv, defenv, ""); - } + env = concat (env, defenv, ""); /* Allocate a token table */ for (len = 1, p = env; p;) @@ -5713,6 +5707,7 @@ add_regex (char *regexp_pattern, language *lang) { static struct re_pattern_buffer zeropattern; char sep, *pat, *name, *modifiers; + char empty[] = ""; const char *err; struct re_pattern_buffer *patbuf; regexp *rp; @@ -5744,7 +5739,7 @@ add_regex (char *regexp_pattern, language *lang) if (modifiers == NULL) /* no terminating separator --> no name */ { modifiers = name; - name = ""; + name = empty; } else modifiers += 1; /* skip separator */ @@ -5972,7 +5967,7 @@ regex_tag_multiline (void) static bool -nocase_tail (char *cp) +nocase_tail (const char *cp) { register int len = 0; @@ -6289,7 +6284,7 @@ readline (linebuffer *lbp, FILE *stream) * with xnew where the string CP has been copied. */ static char * -savestr (char *cp) +savestr (const char *cp) { return savenstr (cp, strlen (cp)); } @@ -6299,7 +6294,7 @@ savestr (char *cp) * the string CP has been copied for at most the first LEN characters. */ static char * -savenstr (char *cp, int len) +savenstr (const char *cp, int len) { register char *dp; @@ -6408,14 +6403,14 @@ skip_non_spaces (char *cp) /* Print error message and exit. */ void -fatal (char *s1, char *s2) +fatal (const char *s1, const char *s2) { error (s1, s2); exit (EXIT_FAILURE); } static void -pfatal (char *s1) +pfatal (const char *s1) { perror (s1); exit (EXIT_FAILURE); @@ -6441,7 +6436,7 @@ error (const char *s1, const char *s2) /* Return a newly-allocated string whose contents concatenate those of s1, s2, s3. */ static char * -concat (char *s1, char *s2, char *s3) +concat (const char *s1, const char *s2, const char *s3) { int len1 = strlen (s1), len2 = strlen (s2), len3 = strlen (s3); char *result = xnew (len1 + len2 + len3 + 1, char); diff --git a/lib-src/fakemail.c b/lib-src/fakemail.c index 72e1b7179c0..16baeb266a8 100644 --- a/lib-src/fakemail.c +++ b/lib-src/fakemail.c @@ -30,7 +30,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #if defined (BSD_SYSTEM) && !defined (USE_FAKEMAIL) /* This program isnot used in BSD, so just avoid loader complaints. */ int -main () +main (void) { return 0; } @@ -59,6 +59,7 @@ main () #include <ctype.h> #include <time.h> #include <pwd.h> +#include <stdlib.h> /* This is to declare cuserid. */ #ifdef HAVE_UNISTD_H @@ -140,21 +141,16 @@ struct linebuffer lb; #define MAIL_PROGRAM_NAME "/bin/mail" #endif -static char *my_name; +static const char *my_name; static char *the_date; static char *the_user; static line_list file_preface; static stream_list the_streams; static boolean no_problems = true; -static void fatal (char *s1) NO_RETURN; - -extern FILE *popen (const char *, const char *); -extern int fclose (FILE *), pclose (FILE *); +static void fatal (const char *s1) NO_RETURN; #ifdef CURRENT_USER -extern struct passwd *getpwuid (); -extern unsigned short geteuid (); static struct passwd *my_entry; #define cuserid(s) \ (my_entry = getpwuid (((int) geteuid ())), \ @@ -166,7 +162,7 @@ static struct passwd *my_entry; /* Print error message. `s1' is printf control string, `s2' is arg for it. */ static void -error (char *s1, char *s2) +error (const char *s1, const char *s2) { printf ("%s: ", my_name); printf (s1, s2); @@ -177,7 +173,7 @@ error (char *s1, char *s2) /* Print error message and exit. */ static void -fatal (char *s1) +fatal (const char *s1) { error ("%s", s1); exit (EXIT_FAILURE); @@ -464,20 +460,20 @@ put_string (char *s) } void -put_line (char *string) +put_line (const char *string) { register stream_list rem; for (rem = the_streams; rem != ((stream_list) NULL); rem = rem->rest_streams) { - char *s = string; + const char *s = string; int column = 0; /* Divide STRING into lines. */ while (*s != 0) { - char *breakpos; + const char *breakpos; /* Find the last char that fits. */ for (breakpos = s; *breakpos && column < 78; ++breakpos) @@ -699,13 +695,11 @@ main (int argc, char **argv) char *command_line; header the_header; long name_length; - char *mail_program_name; + const char *mail_program_name; char buf[BUFLEN + 1]; register int size; FILE *the_pipe; - extern char *getenv (const char *); - mail_program_name = getenv ("FAKEMAILER"); if (!(mail_program_name && *mail_program_name)) mail_program_name = MAIL_PROGRAM_NAME; diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index 7fe63bed506..4824731672b 100644 --- a/lib-src/make-docfile.c +++ b/lib-src/make-docfile.c @@ -68,9 +68,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #endif int scan_file (char *filename); -int scan_lisp_file (char *filename, char *mode); -int scan_c_file (char *filename, char *mode); -void fatal (char *s1, char *s2) NO_RETURN; +int scan_lisp_file (const char *filename, const char *mode); +int scan_c_file (char *filename, const char *mode); +void fatal (const char *s1, const char *s2) NO_RETURN; #ifdef MSDOS /* s/msdos.h defines this as sys_chdir, but we're not linking with the @@ -92,7 +92,7 @@ char *progname; /* VARARGS1 */ void -error (char *s1, char *s2) +error (const char *s1, const char *s2) { fprintf (stderr, "%s: ", progname); fprintf (stderr, s1, s2); @@ -103,7 +103,7 @@ error (char *s1, char *s2) /* VARARGS1 */ void -fatal (char *s1, char *s2) +fatal (const char *s1, const char *s2) { error (s1, s2); exit (EXIT_FAILURE); @@ -233,10 +233,10 @@ struct rcsoc_state /* A keyword we look for at the beginning of lines. If found, it is not copied, and SAW_KEYWORD is set to true. */ - char *keyword; + const char *keyword; /* The current point we've reached in an occurrence of KEYWORD in the input stream. */ - char *cur_keyword_ptr; + const char *cur_keyword_ptr; /* Set to true if we saw an occurrence of KEYWORD. */ int saw_keyword; }; @@ -326,7 +326,7 @@ scan_keyword_or_put_char (int ch, struct rcsoc_state *state) keyword, but it was a false alarm. Output the part we scanned. */ { - char *p; + const char *p; for (p = state->keyword; p < state->cur_keyword_ptr; p++) put_char (*p, state); @@ -521,7 +521,7 @@ write_c_args (FILE *out, char *func, char *buf, int minargs, int maxargs) Accepts any word starting DEF... so it finds DEFSIMPLE and DEFPRED. */ int -scan_c_file (char *filename, char *mode) +scan_c_file (char *filename, const char *mode) { FILE *infile; register int c; @@ -834,7 +834,7 @@ read_lisp_symbol (FILE *infile, char *buffer) } int -scan_lisp_file (char *filename, char *mode) +scan_lisp_file (const char *filename, const char *mode) { FILE *infile; register int c; diff --git a/lib-src/movemail.c b/lib-src/movemail.c index bb4a922014c..4ccdc93688c 100644 --- a/lib-src/movemail.c +++ b/lib-src/movemail.c @@ -147,11 +147,11 @@ static char *mail_spool_name (); char *strerror (int); #endif -static void fatal (char *s1, char *s2, char *s3) NO_RETURN; -static void error (char *s1, char *s2, char *s3); +static void fatal (const char *s1, const char *s2, const char *s3) NO_RETURN; +static void error (const char *s1, const char *s2, const char *s3); static void pfatal_with_name (char *name) NO_RETURN; static void pfatal_and_delete (char *name) NO_RETURN; -static char *concat (char *s1, char *s2, char *s3); +static char *concat (const char *s1, const char *s2, const char *s3); static long *xmalloc (unsigned int size); #ifdef MAIL_USE_POP static int popmail (char *mailbox, char *outfile, int preserve, char *password, int reverse_order); @@ -589,7 +589,7 @@ mail_spool_name (inname) /* Print error message and exit. */ static void -fatal (char *s1, char *s2, char *s3) +fatal (const char *s1, const char *s2, const char *s3) { if (delete_lockname) unlink (delete_lockname); @@ -601,7 +601,7 @@ fatal (char *s1, char *s2, char *s3) are args for it or null. */ static void -error (char *s1, char *s2, char *s3) +error (const char *s1, const char *s2, const char *s3) { fprintf (stderr, "movemail: "); if (s3) @@ -630,7 +630,7 @@ pfatal_and_delete (char *name) /* Return a newly-allocated string whose contents concatenate those of s1, s2, s3. */ static char * -concat (char *s1, char *s2, char *s3) +concat (const char *s1, const char *s2, const char *s3) { int len1 = strlen (s1), len2 = strlen (s2), len3 = strlen (s3); char *result = (char *) xmalloc (len1 + len2 + len3 + 1); diff --git a/lib-src/pop.c b/lib-src/pop.c index 26a992fa0b0..9eabbd2041e 100644 --- a/lib-src/pop.c +++ b/lib-src/pop.c @@ -110,7 +110,7 @@ extern int h_errno; static int socket_connection (char *, int); static int pop_getline (popserver, char **); -static int sendline (popserver, char *); +static int sendline (popserver, const char *); static int fullwrite (int, char *, int); static int getok (popserver); #if 0 @@ -676,7 +676,7 @@ pop_top_flush (popserver server) } int -pop_multi_first (popserver server, char *command, char **response) +pop_multi_first (popserver server, const char *command, char **response) { if (server->in_multi) { @@ -988,7 +988,7 @@ socket_connection (char *host, int flags) struct servent *servent; struct sockaddr_in addr; char found_port = 0; - char *service; + const char *service; int sock; char *realhost; #ifdef KERBEROS @@ -1414,7 +1414,7 @@ pop_getline (popserver server, char **line) * Side effects: Closes the connection on error. */ static int -sendline (popserver server, char *line) +sendline (popserver server, const char *line) { #define SENDLINE_ERROR "Error writing to POP server: " int ret; diff --git a/lib-src/pop.h b/lib-src/pop.h index 4b6853e77c8..2ba3fab83a0 100644 --- a/lib-src/pop.h +++ b/lib-src/pop.h @@ -49,39 +49,31 @@ typedef struct _popserver *popserver; #define POP_NO_HESIOD (1<<1) #define POP_NO_GETPASS (1<<2) -#ifdef __STDC__ -#define _ARGS(a) a -#else -#define _ARGS(a) () -#endif - -extern popserver pop_open _ARGS((char *host, char *username, char *password, - int flags)); -extern int pop_stat _ARGS((popserver server, int *count, int *size)); -extern int pop_list _ARGS((popserver server, int message, int **IDs, - int **size)); -extern int pop_retrieve _ARGS((popserver server, int message, int markfrom, - char **)); -extern int pop_retrieve_first _ARGS((popserver server, int message, - char **response)); -extern int pop_retrieve_next _ARGS((popserver server, char **line)); -extern int pop_retrieve_flush _ARGS((popserver server)); -extern int pop_top_first _ARGS((popserver server, int message, int lines, - char **response)); -extern int pop_top_next _ARGS((popserver server, char **line)); -extern int pop_top_flush _ARGS((popserver server)); -extern int pop_multi_first _ARGS((popserver server, char *command, - char **response)); -extern int pop_multi_next _ARGS((popserver server, char **line)); -extern int pop_multi_flush _ARGS((popserver server)); -extern int pop_delete _ARGS((popserver server, int message)); -extern int pop_noop _ARGS((popserver server)); -extern int pop_last _ARGS((popserver server)); -extern int pop_reset _ARGS((popserver server)); -extern int pop_quit _ARGS((popserver server)); -extern void pop_close _ARGS((popserver)); - -#undef _ARGS +extern popserver pop_open (char *host, char *username, char *password, + int flags); +extern int pop_stat (popserver server, int *count, int *size); +extern int pop_list (popserver server, int message, int **IDs, + int **size); +extern int pop_retrieve (popserver server, int message, int markfrom, + char **); +extern int pop_retrieve_first (popserver server, int message, + char **response); +extern int pop_retrieve_next (popserver server, char **line); +extern int pop_retrieve_flush (popserver server); +extern int pop_top_first (popserver server, int message, int lines, + char **response); +extern int pop_top_next (popserver server, char **line); +extern int pop_top_flush (popserver server); +extern int pop_multi_first (popserver server, const char *command, + char **response); +extern int pop_multi_next (popserver server, char **line); +extern int pop_multi_flush (popserver server); +extern int pop_delete (popserver server, int message); +extern int pop_noop (popserver server); +extern int pop_last (popserver server); +extern int pop_reset (popserver server); +extern int pop_quit (popserver server); +extern void pop_close (popserver); /* arch-tag: 76cc5f58-8e86-48fa-bc72-a7c6cb1c4f1c (do not change this comment) */ diff --git a/lib-src/sorted-doc.c b/lib-src/sorted-doc.c index 595633b76d8..db3f3029532 100644 --- a/lib-src/sorted-doc.c +++ b/lib-src/sorted-doc.c @@ -65,7 +65,7 @@ struct docstr /* Allocated thing for an entry. */ /* Print error message. `s1' is printf control string, `s2' is arg for it. */ void -error (char *s1, char *s2) +error (const char *s1, const char *s2) { fprintf (stderr, "sorted-doc: "); fprintf (stderr, s1, s2); @@ -75,7 +75,7 @@ error (char *s1, char *s2) /* Print error message and exit. */ void -fatal (char *s1, char *s2) +fatal (const char *s1, const char *s2) { error (s1, s2); exit (EXIT_FAILURE); @@ -117,7 +117,7 @@ enum state WAITING, BEG_NAME, NAME_GET, BEG_DESC, DESC_GET }; -char *states[] = +const char *states[] = { "WAITING", "BEG_NAME", "NAME_GET", "BEG_DESC", "DESC_GET" }; diff --git a/lib-src/update-game-score.c b/lib-src/update-game-score.c index 30208d5c8d2..b8e1147d1c1 100644 --- a/lib-src/update-game-score.c +++ b/lib-src/update-game-score.c @@ -157,8 +157,8 @@ get_user_id (void) return buf->pw_name; } -char * -get_prefix (int running_suid, char *user_prefix) +const char * +get_prefix (int running_suid, const char *user_prefix) { if (!running_suid && user_prefix == NULL) lose ("Not using a shared game directory, and no prefix given."); @@ -178,7 +178,8 @@ main (int argc, char **argv) { int c, running_suid; void *lockstate; - char *user_id, *scorefile, *prefix, *user_prefix = NULL; + char *user_id, *scorefile; + const char *prefix, *user_prefix = NULL; struct stat buf; struct score_entry *scores; int newscore, scorecount, reverse = 0, max = MAX_SCORES; @@ -451,7 +452,7 @@ lock_file (const char *filename, void **state) int fd; struct stat buf; int attempts = 0; - char *lockext = ".lockfile"; + const char *lockext = ".lockfile"; char *lockpath = malloc (strlen (filename) + strlen (lockext) + 60); if (!lockpath) return -1; diff --git a/lisp/ChangeLog.trunk b/lisp/ChangeLog.trunk index 5d005c4e8a2..f0e59a6c6a6 100644 --- a/lisp/ChangeLog.trunk +++ b/lisp/ChangeLog.trunk @@ -1,3 +1,1526 @@ +2010-09-13 Daiki Ueno <ueno@unixuser.org> + + * epa-file.el (epa-file-insert-file-contents): If visiting, bind + buffer-file-name to avoid file-locking. (Bug#7026) + +2010-09-13 Julien Danjou <julien@danjou.info> + + * notifications.el (notifications-notify): Add support for + image-path and sound-name. + (notifications-specification-version): Add this variable. + +2010-09-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (y-or-n-p): New function, moved from src/fns.c. Use read-key. + +2010-09-12 Leo <sdl.web@gmail.com> + + * net/rcirc.el (rcirc-server-commands, rcirc-client-commands) + (rcirc-completion-start): New variables. + (rcirc-nick-completions): Rename to rcirc-completions. + (rcirc-nick-completion-start-offset): Delete. + (rcirc-completion-at-point): New function for constructing + completion data for both nicks and irc commands. Add to + completion-at-point-functions in rcirc mode. + (rcirc-complete): Rename from rcirc-nick-complete; use + rcirc-completion-at-point. + (defun-rcirc-command): Update rcirc-client-commands. + +2010-09-11 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/bytecomp.el (byte-compile-file): Create .elc files + atomically, to avoid parallel build errors. (Bug#4196) + +2010-09-11 Michael R. Mauger <mmaug@yahoo.com> + + * progmodes/sql.el: Version 2.6 + (sql-dialect): Synonym for "sql-product". + (sql-find-sqli-buffer, sql-set-sqli-buffer-generally) + (sql-set-sqli-buffer, sql-show-sqli-buffer, sql-interactive-mode): + Set "sql-buffer" to buffer name not buffer object so multiple sql + interactive buffers work properly. Reverts misguided changes in + earlier work. + (sql-comint): Make sure different buffer name is used if "*SQL*" + buffer is for a different product. + (sql-make-alternate-buffer-name): Fix bug with "sql-database" + login param. + (sql-oracle, sql-sybase, sql-informix, sql-sqlite, sql-mysql) + (sql-solid, sql-ingres, sql-ms, sql-postgres, sql-interbase) + (sql-db2, sql-linter, sql-product-interactive, sql-rename-buffer): + Accept new buffer name or prompt for one. + (sql-port): Default to zero. + (sql-comint-mysql): Handle "sql-port" as a numeric. + (sql-port-history): Delete unused variable. + (sql-get-login): Default "sql-port" to a number. + (sql-product-alist): Correct Postgres prompt and terminator + regexp. + (sql-sqlite-program): Dynamically detect presence of "sqlite" or + "sqlite3" executables. + (sql-sqlite-login-params): Add "*.sqlite[23]?" database name + pattern. + (sql-buffer-live-p): New function. + (sql-mode-menu, sql-send-string): Use it. + (sql-mode-oracle-font-lock-keywords): Improve SQL*Plus REMARK + syntax pattern. + (sql-mode-postgres-font-lock-keywords): Support Postgres V9. + (sql-mode-sqlite-font-lock-keywords): Hilight sqlite commands. + +2010-09-10 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/netrc.el (netrc-credentials): New conveniency function. + +2010-09-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * textmodes/texinfo.el (texinfo-syntax-propertize-function): New fun + to replace texinfo-font-lock-syntactic-keywords. + (texinfo-mode): Use it. + + * textmodes/tex-mode.el (tex-common-initialization, doctex-mode): + Use syntax-propertize-function. + + * textmodes/sgml-mode.el (sgml-syntax-propertize-function): New var to + replace sgml-font-lock-syntactic-keywords. + (sgml-mode): Use it. + + * textmodes/reftex.el (font-lock-syntactic-keywords): Don't declare + since we don't use it. + + * textmodes/bibtex.el (bibtex-mode): Use syntax-propertize-function. + + * progmodes/vhdl-mode.el (vhdl-mode): Use syntax-propertize-function + if available. + (vhdl-fontify-buffer): Adjust. + + * progmodes/tcl.el (tcl-syntax-propertize-function): New var to + replace tcl-font-lock-syntactic-keywords. + (tcl-mode): Use it. + + * progmodes/simula.el (simula-syntax-propertize-function): New var to + replace simula-font-lock-syntactic-keywords. + (simula-mode): Use it. + + * progmodes/sh-script.el (sh-st-symbol): Remove. + (sh-font-lock-close-heredoc, sh-font-lock-open-heredoc): Add eol arg. + (sh-font-lock-flush-syntax-ppss-cache, sh-font-lock-here-doc): Remove. + (sh-font-lock-quoted-subshell): Assume we've already matched $(. + (sh-font-lock-paren): Set syntax-multiline. + (sh-font-lock-syntactic-keywords): Remove. + (sh-syntax-propertize-function): New function to replace it. + (sh-mode): Use it. + + * progmodes/ruby-mode.el (ruby-here-doc-beg-re): + Define while compiling. + (ruby-here-doc-end-re, ruby-here-doc-beg-match) + (ruby-font-lock-syntactic-keywords, ruby-comment-beg-syntax) + (syntax-ppss, ruby-in-ppss-context-p, ruby-in-here-doc-p) + (ruby-here-doc-find-end, ruby-here-doc-beg-syntax) + (ruby-here-doc-end-syntax): Only define when + syntax-propertize is not available. + (ruby-syntax-propertize-function, ruby-syntax-propertize-heredoc): + New functions. + (ruby-in-ppss-context-p): Update to new syntax of heredocs. + (electric-indent-chars): Silence bytecompiler. + (ruby-mode): Use prog-mode, syntax-propertize-function, and + electric-indent-chars. + + * progmodes/python.el (python-syntax-propertize-function): New var to + replace python-font-lock-syntactic-keywords. + (python-mode): Use it. + (python-quote-syntax): Simplify and adjust to new use. + + * progmodes/perl-mode.el (perl-syntax-propertize-function): New fun to + replace perl-font-lock-syntactic-keywords. + (perl-syntax-propertize-special-constructs): New fun to replace + perl-font-lock-special-syntactic-constructs. + (perl-font-lock-syntactic-face-function): New fun. + (perl-mode): Use it. + + * progmodes/octave-mod.el (octave-syntax-propertize-sqs): New function + to replace octave-font-lock-close-quotes. + (octave-syntax-propertize-function): New function to replace + octave-font-lock-syntactic-keywords. + (octave-mode): Use it. + + * progmodes/mixal-mode.el (mixal-syntax-propertize-function): New var; + replaces mixal-font-lock-syntactic-keywords. + (mixal-mode): Use it. + + * progmodes/make-mode.el (makefile-syntax-propertize-function): + New var; replaces makefile-font-lock-syntactic-keywords. + (makefile-mode): Use it. + (makefile-imake-mode): Adjust. + + * progmodes/js.el (js--regexp-literal): Define while compiling. + (js-syntax-propertize-function): New var; replaces + js-font-lock-syntactic-keywords. + (js-mode): Use it. + + * progmodes/gud.el (gdb-script-syntax-propertize-function): New var; + replaces gdb-script-font-lock-syntactic-keywords. + (gdb-script-mode): Use it. + + * progmodes/fortran.el (fortran-mode): Use syntax-propertize-function. + (fortran--font-lock-syntactic-keywords): New var. + (fortran-line-length): Update syntax-propertize-function and + fortran--font-lock-syntactic-keywords. + + * progmodes/cperl-mode.el (cperl-mode): Use syntax-propertize-function. + + * progmodes/cfengine.el (cfengine-mode): + Use syntax-propertize-function. + (cfengine-font-lock-syntactic-keywords): Remove. + + * progmodes/autoconf.el (autoconf-mode): + Use syntax-propertize-function. + (autoconf-font-lock-syntactic-keywords): Remove. + + * progmodes/ada-mode.el (ada-set-syntax-table-properties) + (ada-after-change-function, ada-initialize-syntax-table-properties) + (ada-handle-syntax-table-properties): Only define when + syntax-propertize is not available. + (ada-mode): Use syntax-propertize-function. + + * font-lock.el (font-lock-syntactic-keywords): Make obsolete. + (font-lock-fontify-syntactic-keywords-region): Move handling of + font-lock-syntactically-fontified to... + (font-lock-default-fontify-region): ...here. + Let syntax-propertize-function take precedence. + (font-lock-fontify-syntactically-region): Cal syntax-propertize. + + * emacs-lisp/syntax.el (syntax-propertize-function) + (syntax-propertize-chunk-size, syntax-propertize--done) + (syntax-propertize-extend-region-functions): New vars. + (syntax-propertize-wholelines, syntax-propertize-multiline) + (syntax-propertize--shift-groups, syntax-propertize-via-font-lock) + (syntax-propertize): New functions. + (syntax-propertize-rules): New macro. + (syntax-ppss-flush-cache): Set syntax-propertize--done. + (syntax-ppss): Call syntax-propertize. + + * emacs-lisp/regexp-opt.el (regexp-opt-depth): Skip named groups. + +2010-09-10 AgustÃn MartÃn <agustin.martin@hispalinux.es> + + * textmodes/ispell.el (ispell-init-process): Improve comments. + XEmacs compatibility changes regarding (add-hook) 'local option + and (set-process-query-on-exit-flag). + +2010-09-09 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp-cache.el (tramp-parse-connection-properties): + Set tramp-autoload cookie. + +2010-09-09 Glenn Morris <rgm@gnu.org> + + * image.el (imagemagick-types-inhibit): Add :type, :version, :group. + (imagemagick-register-types): Doc fix. + +2010-09-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/octave-mod.el (electric-indent-chars): Silence bytecomp. + + * progmodes/js.el (require): Require is already "eval-and-compile". + (js--re-search-forward): Avoid `eval'. Preserve the error data. + (js--re-search-backward): Use js--re-search-forward. + + * progmodes/fortran.el (fortran-line-length): Don't recompute + syntactic keywords redundantly a second time. + + * progmodes/ada-mode.el: Replace "(set '" with setq. + (ada-mode): Simplify. + (ada-create-case-exception, ada-adjust-case-interactive) + (ada-adjust-case-region, ada-format-paramlist, ada-indent-current) + (ada-search-ignore-string-comment, ada-move-to-start) + (ada-move-to-end): Use with-syntax-table. + + * font-lock.el (save-buffer-state): Remove `varlist' arg. + (font-lock-unfontify-region, font-lock-default-fontify-region): + Update usage correspondingly. + (font-lock-fontify-syntactic-keywords-region): + Set parse-sexp-lookup-properties buffer-locally here. + (font-lock-fontify-syntactically-region): Remove unused `ppss' arg. + + * simple.el (blink-matching-open): Don't burp if we can't find a match. + +2010-09-08 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/bytecomp.el (byte-compile-report-ops): + Error if not compiled with -DBYTE_CODE_METER. + + * emacs-lisp/bytecomp.el (byte-recompile-directory): + Ignore dir-locals-file. + +2010-09-08 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/compile.el (compilation-error-regexp-alist-alist): + Not a const. + (compilation-error-regexp-alist-alist): Rule out ": " in file names + for the `gnu' messages. + (compilation-set-skip-threshold): New command. + (compilation-start): Use \' rather than $. + (compilation-forget-errors): Use clrhash. + +2010-09-08 AgustÃn MartÃn <agustin.martin@hispalinux.es> + + * textmodes/ispell.el (ispell-valid-dictionary-list): + Simplify logic. + +2010-09-08 Michael Albinus <michael.albinus@gmx.de> + + Migrate to Tramp 2.2. Rearrange load dependencies. + (Bug#1529, Bug#5448, Bug#5705) + + * Makefile.in (TRAMP_DIR, TRAMP_SRC): New variables. + ($(TRAMP_DIR)/tramp-loaddefs.el): New target. + (LOADDEFS): Add $(lisp)/net/tramp-loaddefs.el. + + * net/tramp.el (top): Remove all other tramp-* loads except + tramp-compat.el. Remove all changes to tramp-unload-hook for + other tramp-* packages. Rearrange defun order. Change calls of + `tramp-compat-call-process', `tramp-compat-decimal-to-octal', + `tramp-compat-octal-to-decimal' to new function names. + (tramp-terminal-type, tramp-initial-end-of-output) + (tramp-methods, tramp-foreign-file-name-handler-alist) + (tramp-tramp-file-p, tramp-completion-mode-p) + (tramp-send-command-and-check, tramp-get-remote-path) + (tramp-get-remote-tmpdir, tramp-get-remote-ln) + (tramp-shell-quote-argument): Set tramp-autoload cookie. + (with-file-property, with-connection-property): Move to + tramp-cache.el. + (tramp-local-call-process, tramp-decimal-to-octal) + (tramp-octal-to-decimal): Move to tramp-compat.el. + (tramp-handle-shell-command): Do not require 'shell. + (tramp-compute-multi-hops): No special handling for tramp-gw-* + symbols. + (tramp-unload-tramp): Do not call `tramp-unload-file-name-handlers'. + + * net/tramp-cache.el (top): Require 'tramp. Add to + `tramp-unload-hook'. + (tramp-cache-data, tramp-get-file-property) + (tramp-set-file-property, tramp-flush-file-property) + (tramp-flush-directory-property, tramp-get-connection-property) + (tramp-set-connection-property, tramp-flush-connection-property) + (tramp-cache-print, tramp-list-connections): Set tramp-autoload + cookie. + (with-file-property, with-connection-property): New defuns, moved + from tramp.el. + (tramp-flush-file-function): Use `with-parsed-tramp-file-name' + macro. + + * net/tramp-cmds.el (top): Add to `tramp-unload-hook'. + (tramp-version): Set tramp-autoload cookie. + + * net/tramp-compat.el (top): Require 'tramp-loaddefs. Remove all + changes to tramp-unload-hook for other tramp-* packages. Add to + `tramp-unload-hook'. + (tramp-compat-decimal-to-octal, tramp-compat-octal-to-decimal) + (tramp-compat-call-process): New defuns, moved from tramp.el. + + * net/tramp-fish.el (top) Require just 'tramp. Add objects to + `tramp-methods' and `tramp-foreign-file-name-handler-alist'. Add + to `tramp-unload-hook'. Change call of + `tramp-compat-decimal-to-octal' to new function name. + (tramp-fish-method): Make it a defconst. + (tramp-fish-file-name-p): Make it a defsubst. + (tramp-fish-method, tramp-fish-file-name-handler) + (tramp-fish-file-name-p): Set tramp-autoload cookie. + + * net/tramp-ftp.el (top) Add objects to `tramp-methods' and + `tramp-foreign-file-name-handler-alist'. Add to + `tramp-unload-hook'. + (tramp-ftp-method): Make it a defconst. + (tramp-ftp-file-name-p): Make it a defsubst. + (tramp-ftp-method, tramp-ftp-file-name-handler) + (tramp-ftp-file-name-p): Set tramp-autoload cookie. + + * net/tramp-gvfs.el (top) Add objects to `tramp-methods' and + `tramp-foreign-file-name-handler-alist'. Add to + `tramp-unload-hook'. Change checks, whether package can be + loaded. + (tramp-gvfs-file-name-p): Make it a defsubst. + (tramp-gvfs-methods, tramp-gvfs-file-name-handler) + (tramp-gvfs-file-name-p): Set tramp-autoload cookie. + (tramp-gvfs-handle-file-directory-p): New defun. + (tramp-gvfs-file-name-handler-alist): Use it. + + * net/tramp-gw.el (top) Add objects to `tramp-methods' and + `tramp-foreign-file-name-handler-alist'. Add to + `tramp-unload-hook'. + (tramp-gw-tunnel-method, tramp-gw-default-tunnel-port) + (tramp-gw-socks-method, tramp-gw-default-socks-port): Make it a + defconst. + (tramp-gw-tunnel-method, tramp-gw-socks-method) + (tramp-gw-open-connection): Set tramp-autoload cookie. + + * net/tramp-imap.el (top) Require just 'tramp. Add objects to + `tramp-methods' and `tramp-foreign-file-name-handler-alist'. Add + to `tramp-unload-hook'. Change checks, whether package can be + loaded. + (tramp-imap-file-name-p): Make it a defsubst. + (tramp-imap-method, tramp-imaps-method) + (tramp-imap-file-name-handler) + (tramp-imap-file-name-p): Set tramp-autoload cookie. + + * net/tramp-smb.el (top) Require just 'tramp. Add objects to + `tramp-methods' and `tramp-foreign-file-name-handler-alist'. Add + to `tramp-unload-hook'. Change checks, whether package can be + loaded. Change call of `tramp-compat-decimal-to-octal' to new + function name. + (tramp-smb-tunnel-method): Make it a defconst. + (tramp-smb-file-name-p): Make it a defsubst. + (tramp-smb-method, tramp-smb-file-name-handler) + (tramp-smb-file-name-p): Set tramp-autoload cookie. + + * net/tramp-uu.el (top) Add to `tramp-unload-hook'. + (tramp-uuencode-region): Set tramp-autoload cookie. + + * net/trampver.el (top) Add to `tramp-unload-hook'. + (tramp-version, tramp-bug-report-address): Set tramp-autoload + cookie. Update release number. + +2010-09-07 AgustÃn MartÃn <agustin.martin@hispalinux.es> + + * textmodes/ispell.el (ispell-start-process): Make sure original + arg list is properly initialized (Bug#6993, Bug#6994). + +2010-09-06 Alexander Klimov <alserkli@inbox.ru> (tiny change) + + * files.el (directory-abbrev-alist): Use \` as default regexp. + + * emacs-lisp/rx.el (rx-any): Don't explode ranges that end in special + chars like - or ] (bug#6984). + (rx-any-condense-range): Explode 2-char ranges. + +2010-09-06 Glenn Morris <rgm@gnu.org> + + * desktop.el (desktop-path): Bump :version after 2009-09-15 change. + +2010-09-06 Stefan Monnier <monnier@iro.umontreal.ca> + + * textmodes/bibtex.el: + * proced.el: Update to new email for Roland Winkler <winkler@gnu.org>. + +2010-09-05 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/imap.el (imap-message-map): Remove optional buffer parameter, + since no callers use it. + (imap-message-get): Ditto. + (imap-message-put): Ditto. + (imap-mailbox-map): Ditto. + (imap-mailbox-put): Ditto. + (imap-mailbox-get): Ditto. + (imap-mailbox-get): Revert last change for this function. + +2010-09-05 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/imap.el (imap-fetch-safe): Remove function, and alter all + callers to use `imap-fetch' instead. According to the comments, this + should be safe, since all other IMAP clients use the 1:* syntax. + (imap-enable-exchange-bug-workaround): Remove. + (imap-debug): Remove -- doesn't seem very useful. + +2010-09-05 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * net/imap.el (imap-log): New convenience function used throughout + instead of repeating the same code all over the place. + +2010-09-05 David De La Harpe Golden <david@harpegolden.net> + + * mouse.el (mouse-save-then-kill): Save region to kill-ring + when mouse-drag-copy-region is non-nil (Bug#6956). + +2010-09-05 Chong Yidong <cyd@stupidchicken.com> + + * dired.el (dired-ls-sorting-switches, dired-sort-by-name-regexp): + Improve regexps (Bug#6987). + (dired-sort-toggle): Search more robustly for -t flag. + + * files.el (get-free-disk-space): Search more robustly for + "available" column. Suggested by Ehud Karni + <ehud@unix.mvs.co.il>. + +2010-09-05 Juanma Barranquero <lekktu@gmail.com> + + * international/uni-bidi.el: + * international/uni-category.el: + * international/uni-combining.el: + * international/uni-decimal.el: + * international/uni-mirrored.el: + * international/uni-name.el: Regenerate. + +2010-09-04 Stefan Monnier <monnier@iro.umontreal.ca> + + * electric.el (electric-indent-post-self-insert-function): + Don't reindent with a sloppy indentation function. + + * emacs-lisp/syntax.el (syntax-ppss): More sanity check to catch + border case in change-log-mode. + +2010-09-04 Chong Yidong <cyd@stupidchicken.com> + + * progmodes/compile.el (compilation-error-regexp-alist-alist): + Remove ruby regexp; handle Ruby errors with gcc-include and gnu. + Recognize leading tab in gcc-include regexp. Ignore names with + leading "from" or "in" in gnu regexp (Bug#6937). + +2010-09-04 Stefan Monnier <monnier@iro.umontreal.ca> + + Avoid global recursive calls to kill-buffer-hooks; fit into 80 cols. + * textmodes/ispell.el (ispell-process-buffer-name): Remove. + (ispell-start-process): Avoid setq and simplify logic. + (ispell-init-process): Setup kill-buffer-hook locally when needed. + (kill-buffer-hook): Don't use it globally with code that uses + expand-file-name since that may call kill-buffer via + code_conversion_restore. + +2010-09-04 Noorul Islam K M <noorul@noorul.com> (tiny change) + + * emacs-lisp/package.el (package-directory-list): Only call + file-name-nondirectory on a string. + +2010-09-02 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/package.el (package--download-one-archive): + Ensure that archive-contents is valid before saving it. + (package-activate-1, package-mark-obsolete, define-package) + (package-compute-transaction, package-list-maybe-add): Use push. + +2010-09-03 Stefan Monnier <monnier@iro.umontreal.ca> + + Use SMIE's blink-paren for octave-mode. + * progmodes/octave-mod.el (octave-font-lock-close-quotes): + Backslashes do not escape single-quotes, single-quotes do. + (octave-block-else-regexp, octave-block-end-regexp) + (octave-block-match-alist): Remove. + (octave-smie-bnf-table): New var, with old content. + (octave-smie-op-levels): Use it. + (octave-smie-closer-alist): New var. + (octave-mode): Use it. Setup smie-blink-matching and electric-indent. + (octave-blink-matching-block-open): Remove. + (octave-reindent-then-newline-and-indent, octave-electric-semi) + (octave-electric-space): Let self-insert-command run expand-abbrev and + blink parens. + + * electric.el (electricity): New group. + (electric-indent-chars): New var. + (electric-indent-post-self-insert-function): New fun. + (electric-indent-mode): New minor mode. + (electric-pair-skip-self): New custom. + (electric-pair-post-self-insert-function): New function. + (electric-pair-mode): New minor mode. + + * calc/calc-aent.el (calcAlg-blink-matching-check): New fun, to replace + calcAlg-blink-matching-open. + (calc-alg-ent-map, calc-alg-ent-esc-map): Initialize in the declaration. + (calc-do-alg-entry): Only touch the part of the keymap that varies. + Use the new blink-matching-check-function. + + Provide blink-matching support to SMIE. + * emacs-lisp/smie.el (smie-bnf-closer-alist): New function. + (smie-blink-matching-triggers, smie-blink-matching-inners): New vars. + (smie-blink-matching-check, smie-blink-matching-open): New functions. + + * simple.el (newline): Fix last change to properly remove itself from + the hook. + +2010-09-02 Stefan Monnier <monnier@iro.umontreal.ca> + + * simple.el (newline): Eliminate optimization. + Use post-self-insert-hook to set hard-newline and things before + running post-self-insert-hook. + (blink-matching-check-mismatch): New function. + (blink-matching-check-function): New variable. + (blink-matching-open): Use them. + Skip back forward over prefix chars skipped by forward-sexp. + Don't check if the parens are backslash escaped. + (blink-paren-post-self-insert-function): Check backslash escaping here. + +2010-09-02 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/package.el (package-menu-mode-map): + Change package-menu-revert bindings to revert-buffer. + (package-menu-mode): Set revert-buffer-function. + (package-menu-revert): Doc fix. + +2010-09-02 AgustÃn MartÃn <agustin.martin@hispalinux.es> + + * textmodes/ispell.el (ispell-init-process): Use "~/" as + `default-directory' unless using Ispell per-directory personal + dictionaries and not in a mini-buffer under XEmacs. + (kill-buffer-hook): Do not kill ispell process on exit when + `ispell-process-directory' is "~/". (Bug#6143) + +2010-09-02 Jan Djärv <jan.h.d@swipnet.se> + + * simple.el (kill-new): Call interprogram-cut-function with only + one argument. + + * term.el (term-mouse-paste): Don't call x-get-cutbuffer. + Remove cut buffer from error message. + + * term/x-win.el (x-select-text): + * term/pc-win.el (x-selection-value): + * term/ns-win.el (x-selection-value): + * eshell/em-term.el: + * w32-fns.el (x-get-selection-value): + * mouse-sel.el (mouse-sel-set-selection-function): + * frame.el (display-selections-p): Remove cut-buffer in documentation. + + * term/x-win.el: Update documentation for x-last-selected-text-*. + (x-last-selected-text-cut, x-last-selected-text-cut-encoded) + (x-last-cut-buffer-coding, x-cut-buffer-max): Remove. + (x-select-text): Remove argument PUSH, update documentation. Remove + cut-buffer code. + (x-selection-value-internal): Was previously x-selection-value. + (x-selection-value): Rename from x-cut-buffer-or-selection-value. + Update documentation, remove cut-buffer code. Call + x-selection-value-internal. + (x-clipboard-yank): Call x-selection-value-internal. + (x-initialize-window-system): Remove setting of x-cut-buffer-max. + + * term/pc-win.el (x-last-selected-text): + x-cut-buffer-or-selection-value renamed to x-selection-value + (x-select-text): Remove argument PUSH, update documentation. + + * term/ns-win.el (x-setup-function-keys, ns-last-selected-text): + x-cut-buffer-or-selection-value renamed to x-selection-value + (x-selection-value): Renamed from x-cut-buffer-or-selection-value. + (x-select-text): Remove argument PUSH, update documentation. + + * emacs-lisp/cl-macs.el (x-get-cutbuffer, x-get-cut-buffer): Remove. + + * w32-fns.el (x-last-selected-text): + x-cut-buffer-or-selection-value renamed to x-selection-value. + (x-cut-buffer-max): Remove. + (x-select-text): Remove argument PUSH, update documentation. + + * simple.el (interprogram-cut-function): Remove mention of PUSH. + + * select.el (x-get-cut-buffer, x-set-cut-buffer): Remove. + + * mouse-sel.el (mouse-sel-get-selection-function): + x-cut-buffer-or-selection-value renamed to x-selection-value. + (x-select-text): Remove optional push. + +2010-09-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * simple.el (blink-paren-function): Move from C to here. + (blink-paren-post-self-insert-function): New function. + (post-self-insert-hook): Use it. + + * emacs-lisp/pcase.el (pcase-split-memq): + Fix overenthusiastic optimisation. + (pcase-u1): Handle the case of a lambda pred. + +2010-08-31 Kenichi Handa <handa@m17n.org> + + * international/mule-cmds.el (standard-display-european-internal): + Setup standard-display-table for 8-bit characters by storing 8-bit + characters in the element vector. + + * disp-table.el (standard-display-8bit): Setup + standard-display-table for 8-bit characters by storing 8-bit + characters in the element vector. + (standard-display-european): Likewise. + +2010-08-31 Masatake YAMATO <yamato@redhat.com> + + * textmodes/nroff-mode.el (nroff-view): New command. + (nroff-mode-map): Bind it to C-c C-c. + +2010-08-31 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/smie.el (smie-down-list): New command. + + Remove old indentation and navigation code on octave-mode. + * progmodes/octave-mod.el (octave-mode-map): Remap down-list to + smie-down-list rather than add a binding for octave-down-block. + (octave-mark-block, octave-blink-matching-block-open): + Rely on forward-sexp-function. + (octave-fill-paragraph): Don't narrow, so you can use + indent-according-to-mode. + (octave-block-begin-regexp, octave-block-begin-or-end-regexp): Remove. + (octave-in-block-p, octave-re-search-forward-kw) + (octave-re-search-backward-kw, octave-indent-calculate) + (octave-end-as-array-index-p, octave-block-end-offset) + (octave-scan-blocks, octave-forward-block, octave-backward-block) + (octave-down-block, octave-backward-up-block, octave-up-block) + (octave-before-magic-comment-p, octave-indent-line): Remove. + +2010-08-31 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/package.el (package--read-archive-file): Just use + `read', to avoid copying an additional string. + (package-menu-mode): Set header-line-format here. + (package-menu-refresh, package-menu-revert): Signal an error if + not in the Package Menu. + (package-menu-package-list): New var. + (package--generate-package-list): Operate on the current buffer; + don't assume that it is *Packages*, since the user may rename it. + Allow persistent package listings and sort keys using + package-menu-package-list and package-menu-package-sort-key. + (package-menu--version-predicate): Fix version calculation. + (package-menu-sort-by-column): Don't select the window. + (package--list-packages): Create the *Packages* buffer. + Set package-menu-package-list-key. + (list-packages): Sorting by status is now the default. + (package-buffer-info): Use match-string-no-properties. + (define-package): Add a &rest argument for future proofing, but + don't use it yet. + (package-install-from-buffer, package-install-buffer-internal): + Merge into a single function, package-install-from-buffer. + (package-install-file): Change caller. + + * finder.el: Load finder-inf using `require'. + (finder-list-matches): Sorting by status is now the default. + (finder-compile-keywords): Simpify printing. + +2010-08-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/octave-mod.el (octave-font-lock-keywords): Use regexp-opt. + (octave-mode-map): Remove special bindings for forward/backward-block + and octave-backward-up-block. Use smie-close-block. + (octave-continuation-marker-regexp): New var. + (octave-continuation-regexp): Use it. + (octave-operator-table, octave-smie-op-levels) + (octave-operator-regexp, octave-smie-indent-rules): New vars. + (octave-smie-backward-token, octave-smie-forward-token): New funs. + (octave-mode): Use SMIE. + (octave-close-block): Delete. + +2010-08-30 Eli Zaretskii <eliz@gnu.org> + + * menu-bar.el (menu-bar-edit-menu) <"Paste">: Check selection in + CLIPBOARD, not in PRIMARY. (Bug#6944) + +2010-08-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/smie.el (smie-indent-offset-rule): Let :parent take + a list of parents. + (smie-indent-column): Allow indirection through variables. + + * composite.el (save-buffer-state): Delete, unused. + * font-lock.el (save-buffer-state): Use with-silent-modifications. + (font-lock-default-fontify-region): Use with-syntax-table. + * jit-lock.el (with-buffer-unmodified): Remove. + (with-buffer-prepared-for-jit-lock): Use with-silent-modifications. + + Use `declare' in defmacros. + * window.el (save-selected-window): + * subr.el (with-temp-file, with-temp-message, with-syntax-table): + * progmodes/python.el (def-python-skeleton): + * net/dbus.el (dbus-ignore-errors): + * jka-cmpr-hook.el (with-auto-compression-mode): + * international/mule.el (with-category-table): + * emacs-lisp/timer.el (with-timeout): + * emacs-lisp/lisp-mnt.el (lm-with-file): + * emacs-lisp/eieio.el (with-slots): + * emacs-lisp/easymenu.el (easy-menu-define): + * emacs-lisp/debug.el (debugger-env-macro): + * emacs-lisp/cl-compat.el (Multiple-value-bind, Multiple-value-setq) + (Multiple-value-call, Multiple-value-prog1): + * emacs-lisp/cl-seq.el (cl-parsing-keywords, cl-check-key) + (cl-check-test-nokey, cl-check-test, cl-check-match): Move indent and + edebug rule to definition. + * emacs-lisp/lisp-mode.el (save-selected-window) + (with-current-buffer, combine-after-change-calls) + (with-output-to-string, with-temp-file, with-temp-buffer) + (with-temp-message, with-syntax-table, read-if, eval-after-load) + (dolist, dotimes, when, unless): + * emacs-lisp/byte-run.el (inline): Remove indent rule, redundant. + +2010-08-29 Chong Yidong <cyd@stupidchicken.com> + + * finder.el: Require `package'. + (finder-known-keywords): Tweak descriptions. Retire `oop' keyword. + (finder-package-info): Var deleted. + (finder-keywords-hash, finder--builtins-alist): New vars. + (finder-compile-keywords): Compute package--builtins and + finder-keywords-hash instead of finder-keywords-hash, respecting + the "Package" header. + (finder-unknown-keywords, finder-list-matches): + Use finder-keywords-hash and package--list-packages. + (finder-mode): Don't set font-lock-defaults. + (finder-exit): We don't use "*Finder-package*" and "*Finder + Category*" buffers anymore. + + * emacs-lisp/package.el (package--builtins-base): Var deleted. + (package--builtins): Set default value to nil. + (package-initialize): Load precomputed value of package--builtins + from finder-inf.el. + (package-alist, package-compute-transaction) + (package-download-transaction): Improve docstring. + (package-read-all-archive-contents): Do not change + package--builtins here. + (list-packages): Make package-list-packages an alias for this. + Sort by status by default. + (package--list-packages): Add optional PACKAGES arg. + (describe-package-1): Use font-lock-face property. For built-in + packages, insert file commentary. + (package--generate-package-list): Rename from + package-list-packages-internal; all callers changed. Add optional + PACKAGES arg. Add alphabetical sort fallbacks. + (package-menu--version-predicate, package-menu--status-predicate) + (package-menu--description-predicate) + (package-menu--name-predicate): New functions. + + * info.el (Info-finder-find-node): Search package-alist instead of + finder-package-info. + +2010-08-29 Chong Yidong <cyd@stupidchicken.com> + + * subr.el (version-regexp-alist): Don't use "a" and "b" for + "alpha" and "beta". + (version-to-list): Handle versions like "10.3d". + +2010-08-28 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/macroexp.el (macroexpand-all-1): Use pcase. + (macroexp-accumulate): Use `declare'. + +2010-08-27 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * whitespace.el (whitespace-style): Adjust type declaration. + +2010-08-26 Magnus Henoch <magnus.henoch@gmail.com> + + * net/tramp-gvfs.el (tramp-gvfs-handle-copy-file): Do not pass + empty argument to gvfs-copy. + +2010-08-26 Chong Yidong <cyd@stupidchicken.com> + + * net/tramp-compat.el (tramp-compat-delete-file): Rewrite to + handle new TRASH arg of `delete-file'. + +2010-08-26 Christian Lynbech <christian.lynbech@tieto.com> (tiny change) + + * net/tramp.el (tramp-handle-insert-directory): Don't use + `forward-word', its default syntax could be changed. + +2010-08-26 Toru TSUNEYOSHI <t_tuneyosi@hotmail.com> + Michael Albinus <michael.albinus@gmx.de> + + Implement compression for inline methods. + + * net/tramp.el (tramp-inline-compress-start-size): New defcustom. + (tramp-copy-size-limit): Allow also nil. + (tramp-inline-compress-commands): New defconst. + (tramp-find-inline-compress, tramp-get-inline-compress) + (tramp-get-inline-coding): New defuns. + (tramp-get-remote-coding, tramp-get-local-coding): Remove, + replaced by `tramp-get-inline-coding'. + (tramp-handle-file-local-copy, tramp-handle-write-region) + (tramp-method-out-of-band-p): Use `tramp-get-inline-coding'. + +2010-08-26 Noah Lavine <noah549@gmail.com> (tiny change) + + Detect ssh 'ControlMaster' argument automatically in some cases. + + * net/tramp.el (tramp-detect-ssh-controlmaster): New defun. + (tramp-default-method): Use it. + +2010-08-26 Karel KlÃÄ <kklic@redhat.com> + + * net/tramp.el (tramp-file-name-for-operation): + Add file-selinux-context. + +2010-08-26 Åukasz Stelmach <lukasz.stelmach@iem.pw.edu.pl> (tiny change) + + * play/cookie1.el (read-cookie): Fix off-by-one error (bug#6921). + +2010-08-26 Chong Yidong <cyd@stupidchicken.com> + + * simple.el (beginning-of-buffer, end-of-buffer): Doc fix + (Bug#6907). + +2010-08-26 Nathan Weizenbaum <nweiz@cressida.sea.corp.google.com> (tiny change) + + * progmodes/js.el: Make indentation more customizable (Bug#6914). + (js-paren-indent-offset, js-square-indent-offset) + (js-curly-indent-offset): New options. + (js--proper-indentation): Use them. + +2010-08-26 Daniel Colascione <dan.colascione@gmail.com> + + * progmodes/sh-script.el (sh-get-indent-info): Use syntax-ppss + instead of inspecting font-lock properties (Bug#6916). + +2010-08-26 David Reitter <david.reitter@gmail.com> + + * server.el (server-visit-files): Run pre-command-hook and + post-command-hook for each buffer while it is current + (Bug#6910). + (server-execute): Do not run hooks here. + +2010-08-26 Michael Albinus <michael.albinus@gmx.de> + + Sync with Tramp 2.1.19. + + * net/tramp-cmds.el (tramp-cleanup-all-connections) + (tramp-reporter-dump-variable, tramp-load-report-modules) + (tramp-append-tramp-buffers): Use `tramp-compat-funcall'. + (tramp-bug): Recommend setting of `tramp-verbose' to 9. + + * net/tramp-compat.el (top): Do not autoload + `tramp-handle-file-remote-p'. Load tramp-util.el and tramp-vc.el + only when `start-file-process' is not bound. + (byte-compile-not-obsolete-vars): Define if not bound. + (tramp-compat-funcall): New defmacro. + (tramp-compat-line-beginning-position) + (tramp-compat-line-end-position) + (tramp-compat-temporary-file-directory) + (tramp-compat-make-temp-file, tramp-compat-file-attributes) + (tramp-compat-copy-file, tramp-compat-copy-directory) + (tramp-compat-delete-file, tramp-compat-delete-directory) + (tramp-compat-number-sequence, tramp-compat-process-running-p): + Use it. + (tramp-advice-file-expand-wildcards): Do not use + `tramp-handle-file-remote-p'. + (tramp-compat-make-temp-file): Simplify fallback implementation. + (tramp-compat-copy-file): Add PRESERVE-SELINUX-CONTEXT. + (tramp-compat-copy-tree): Remove function. + (tramp-compat-delete-file): New defun. + (tramp-compat-delete-directory): Provide implementation for older + Emacsen. + (tramp-compat-file-attributes): Handle only + `wrong-number-of-arguments' error. + + * net/tramp-fish.el (tramp-fish-handle-copy-file): Add + PRESERVE_SELINUX_CONTEXT. + (tramp-fish-handle-delete-file): Add TRASH arg. + (tramp-fish-handle-directory-files-and-attributes): + Do not use `tramp-fish-handle-file-attributes. + (tramp-fish-handle-file-local-copy) + (tramp-fish-handle-insert-file-contents) + (tramp-fish-maybe-open-connection): Use `with-progress-reporter'. + + * net/tramp-gvfs.el (top): Require url-util. + (tramp-gvfs-mount-point): Remove. + (tramp-gvfs-file-name-handler-alist): Add `file-selinux-context' + and `set-file-selinux-context'. + (tramp-gvfs-stringify-dbus-message, tramp-gvfs-send-command) + (tramp-gvfs-handle-file-selinux-context) + (tramp-gvfs-handle-set-file-selinux-context): New defuns. + (with-tramp-dbus-call-method): Format trace message. + (tramp-gvfs-handle-copy-file): Handle PRESERVE-SELINUX-CONTEXT. + (tramp-gvfs-handle-copy-file, tramp-gvfs-handle-rename-file): + Implement backup call, when operation on local files fails. Use + progress reporter. Flush properties of changed files. + (tramp-gvfs-handle-delete-file): Add TRASH arg. Use + `tramp-compat-delete-file'. + (tramp-gvfs-handle-expand-file-name): Expand "~/". + (tramp-gvfs-handle-make-directory): Make more traces. + (tramp-gvfs-handle-write-region): Protect deleting tmpfile. + (tramp-gvfs-url-file-name): Hexify file name in url. + (tramp-gvfs-fuse-file-name): Take also prefix (like dav shares) + into account for the resulting file name. + (tramp-gvfs-handler-askquestion): Preserve current message, in + order to let progress reporter continue afterwards. (Bug#6257) + Return dummy mountpoint, when the answer is "no". See + `tramp-gvfs-maybe-open-connection'. + (tramp-gvfs-handler-mounted-unmounted) + (tramp-gvfs-connection-mounted-p): Test also for new mountspec + attribute "default_location". Set "prefix" property. Handle + default-location. + (tramp-gvfs-mount-spec): Return both prefix and mountspec. + (tramp-gvfs-maybe-open-connection): Test, whether mountpoint + exists. Raise an error, if not (due to a corresponding answer + "no" in interactive questions, for example). Use + `tramp-compat-funcall'. + + * net/tramp-imap.el (top): Autoload `epg-make-context'. + (tramp-imap-handle-copy-file): Add PRESERVE-SELINUX-CONTEXT. + (tramp-imap-do-copy-or-rename-file) + (tramp-imap-handle-insert-file-contents) + (tramp-imap-handle-file-local-copy): Use `with-progress-reporter'. + (tramp-imap-handle-delete-file): Add TRASH arg. + + * net/tramp-smb.el (tramp-smb-handle-copy-file): Add + PRESERVE-SELINUX-CONTEXT. + (tramp-smb-handle-copy-file) + (tramp-smb-handle-file-local-copy, tramp-smb-handle-rename-file) + (tramp-smb-handle-write-region, tramp-smb-maybe-open-connection): + Use `with-progress-reporter'. + (tramp-smb-handle-delete-file): Add TRASH arg. + + * net/tramp.el (tramp-methods): Move hostname to the end in all + ssh `tramp-login-args'. Add `tramp-async-args' attribute where + appropriate. + (tramp-verbose): Describe verbose level 9. + (tramp-completion-function-alist) + (tramp-file-name-regexp, tramp-chunksize) + (tramp-local-coding-commands, tramp-remote-coding-commands) + (with-connection-property, tramp-completion-mode-p) + (tramp-action-process-alive, tramp-action-out-of-band) + (tramp-check-for-regexp, tramp-file-name-p, tramp-equal-remote) + (tramp-exists-file-name-handler): Fix docstring. + (tramp-remote-process-environment): Use `format' instead of + `concat'. Protect version string by apostroph. + (tramp-shell-prompt-pattern): Do not use a shy group in case of + XEmacs. + (tramp-file-name-regexp-unified) + (tramp-completion-file-name-regexp-unified): On W32 systems, do + not regard the volume letter as remote filename. (Bug#5447) + (tramp-perl-file-attributes) + (tramp-perl-directory-files-and-attributes): Don't pass "$3". + (tramp-vc-registered-read-file-names): Read input as + here-document, otherwise the command could exceed maximum length + of command line. + (tramp-file-name-handler-alist): Add `file-selinux-context' and + `set-file-selinux-context'. + (tramp-debug-message): Add `tramp-compat-funcall' to ignored + backtrace functions. + (tramp-error-with-buffer): Don't show the connection buffer when + we are in completion mode. + (tramp-progress-reporter-update, tramp-remote-selinux-p) + (tramp-handle-file-selinux-context) + (tramp-handle-set-file-selinux-context, tramp-process-sentinel) + (tramp-connectable-p, tramp-open-shell, tramp-get-remote-trash): + New defuns. + (with-progress-reporter): New defmacro. + (tramp-debug-outline-regexp): New defconst. + (top, tramp-rfn-eshadow-setup-minibuffer) + (tramp-rfn-eshadow-update-overlay, tramp-handle-set-file-times) + (tramp-handle-dired-compress-file, tramp-handle-shell-command) + (tramp-completion-mode-p, tramp-check-for-regexp) + (tramp-open-connection-setup-interactive-shell) + (tramp-compute-multi-hops, tramp-read-passwd, tramp-clear-passwd) + (tramp-time-diff, tramp-coding-system-change-eol-conversion) + (tramp-set-process-query-on-exit-flag, tramp-unload-tramp): + Use `tramp-compat-funcall'. + (tramp-handle-make-symbolic-link): Flush file properties. + (tramp-handle-load, tramp-handle-file-local-copy) + (tramp-handle-insert-file-contents, tramp-handle-write-region) + (tramp-handle-vc-registered, tramp-maybe-send-script) + (tramp-find-shell): Use `with-progress-reporter'. + (tramp-do-file-attributes-with-stat): Add space in format string, + in order to work around a bug in pdksh. Reported by Gilles Pion + <gpion@lfdj.com>. + (tramp-handle-verify-visited-file-modtime): Do not send a command + when the connection is not established. + (tramp-handle-set-file-times): Simplify the check for utc. + (tramp-handle-directory-files-and-attributes) + (tramp-get-remote-path): Use `copy-tree'. + (tramp-completion-handle-file-name-all-completions): Ensure, that + non remote files are still checked. Oops. + (tramp-handle-copy-file, tramp-do-copy-or-rename-file): Handle + PRESERVE-SELINUX-CONTEXT. + (tramp-do-copy-or-rename-file): Add progress reporter. + (tramp-do-copy-or-rename-file-directly): Do not use + `tramp-handle-file-remote-p'. + (tramp-do-copy-or-rename-file-out-of-band): + Use `tramp-compat-delete-directory'. + (tramp-do-copy-or-rename-file-out-of-band) + (tramp-compute-multi-hops, tramp-maybe-open-connection): + Use `format-spec-make'. + (tramp-handle-delete-file): Add TRASH arg. + (tramp-handle-dired-uncache): Flush directory cache, not only file + cache. + (tramp-handle-expand-file-name) + (tramp-completion-handle-file-name-all-completions) + (tramp-completion-handle-file-name-completion): Use + `tramp-connectable-p'. + (tramp-handle-start-file-process): Set connection property "vec". + Use it, in order to invalidate file caches. Check only for + `remote-tty' process property. + Implement tty setting. (Bug#4604, Bug#6360) + (tramp-file-name-for-operation): Add `call-process-region' and + `set-file-selinux-context'. + (tramp-find-foreign-file-name-handler) + (tramp-advice-make-auto-save-file-name) + (tramp-set-auto-save-file-modes): Remove superfluous check for + `stringp'. This is done inside `tramp-tramp-file-p'. + (tramp-file-name-handler): Trace 'quit. Catch the error for some + operations when we are in completion mode. This gives the user + the chance to correct the file name in the minibuffer. + (tramp-completion-mode-p): Use `non-essential'. + (tramp-handle-file-name-all-completions): Backward/ XEmacs + compatibility: Use `completion-ignore-case' if + `read-file-name-completion-ignore-case' does not exist. + (tramp-get-debug-buffer): Use `tramp-debug-outline-regexp'. + (tramp-find-shell, tramp-open-connection-setup-interactive-shell): + `tramp-open-shell'. + (tramp-action-password): Hide password prompt before next run. + (tramp-process-actions): Widen connection buffer for the trace. + (tramp-open-connection-setup-interactive-shell): Set `remote-tty' + process property. Trace stty settings if `tramp-verbose' >= 9. + Apply workaround for IRIX64 bug. Move argument of last + `tramp-send-command' where it belongs to. + (tramp-maybe-open-connection): Use `async-args' and `gw-args' in + front of `login-args'. + (tramp-get-ls-command, tramp-get-ls-command-with-dired): Run tests + on "/dev/null" instead of "/". + (tramp-get-ls-command-with-dired): Make test for "--dired" + stronger. + (tramp-set-auto-save-file-modes): Adapt version check. + (tramp-set-process-query-on-exit-flag): Fix wrong parentheses. + (tramp-handle-process-file): Call the program in a subshell, in + order to preserve working directory. + (tramp-handle-shell-command): Don't use hard-wired "/bin/sh" but + `tramp-remote-sh' from `tramp-methods'. + (tramp-get-ls-command): Make test for "--color=never" stronger. + (tramp-check-for-regexp): Use (forward-line 1). + + * net/trampver.el: Update release number. + +2010-08-26 Chong Yidong <cyd@stupidchicken.com> + + * help.el (help-map): Bind `C-h P' to describe-package. + + * menu-bar.el (menu-bar-describe-menu): Add describe-package. + + * emacs-lisp/package.el (package-refresh-contents): Catch errors + when downloading archives. + (describe-package-1): Add package commentary. + (package-install-button-action): New function. + (package-menu-mode-map): Bind ? to package-menu-describe-package. + (package-menu-view-commentary): Function removed. + (package-list-packages-internal): Hide the `package' package too. + +2010-08-25 Kenichi Handa <handa@m17n.org> + + * language/misc-lang.el ("Arabic"): New language environment. + Setup composition-function-table for Arabic characters. + + * international/fontset.el (setup-default-fontset): Fix typo for + arabic OTF spec (fini->fina). + +2010-08-25 Jan Djärv <jan.h.d@swipnet.se> + + * menu-bar.el (menu-bar-set-tool-bar-position): Set frame parameter + on all frames. + +2010-08-24 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * whitespace.el: Allow cleaning up blanks without blank + visualization (Bug#6651). Adjust help window for + whitespace-toggle-options (Bug#6479). Allow to use fill-column + instead of whitespace-line-column (from EmacsWiki). New version + 13.1. + (whitespace-style): Added new value 'face. Adjust docstring. + (whitespace-space, whitespace-hspace, whitespace-tab): Adjust + foreground property face. + (whitespace-line-column): Adjust docstring and type declaration. + (whitespace-style-value-list, whitespace-toggle-option-alist) + (whitespace-help-text): Adjust const initialization. + (whitespace-toggle-options, global-whitespace-toggle-options): + Adjust docstring. + (whitespace-display-window, whitespace-interactive-char) + (whitespace-style-face-p, whitespace-color-on): Adjust code. + (whitespace-help-scroll): New fun. + +2010-08-24 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/package.el (list-packages): Alias for + package-list-packages. + +2010-08-24 Kevin Ryde <user42@zip.com.au> + + * textmodes/flyspell.el (flyspell-check-tex-math-command): Doc fix + (Bug#5651). + + * progmodes/ruby-mode.el (ruby): Add defgroup. + +2010-08-24 Chong Yidong <cyd@stupidchicken.com> + + * progmodes/python.el: Add Ipython support (Bug#5390). + (python-shell-prompt-alist) + (python-shell-continuation-prompt-alist): New options. + (python--set-prompt-regexp): New function. + (inferior-python-mode, run-python, python-shell): Require + ansi-color. Use python--set-prompt-regexp to set the comint + prompt based on the Python interpreter. + (python--prompt-regexp): New var. + (python-check-comint-prompt) + (python-comint-output-filter-function): Use it. + (run-python): Use a pipe (Bug#5694). + +2010-08-24 Fabian Ezequiel Gallina <galli.87@gmail.com> (tiny change) + + * progmodes/python.el (python-send-region): Send a different + Python command if Ipython is in use. + (python-check-version): Use a Python command to find the version. + +2010-08-24 Chong Yidong <cyd@stupidchicken.com> + + * mouse.el (mouse-yank-primary): Avoid setting primary when + deactivating the mark (Bug#6872). + +2010-08-23 Chris Foote <chris@foote.com.au> (tiny change) + + * progmodes/python.el (python-block-pairs): Allow use of "finally" + with "else" (Bug#3991). + +2010-08-23 Michael Albinus <michael.albinus@gmx.de> + + * net/dbus.el: Accept UNIX domain sockets as bus address. + (top): Don't initialize `dbus-registered-objects-table' anymore, + this is done in dbusbind,c. + (dbus-check-event): Adapt test for bus. + (dbus-return-values-table, dbus-unregister-service) + (dbus-event-bus-name, dbus-introspect, dbus-register-property): + Adapt doc string. + +2010-08-23 Juanma Barranquero <lekktu@gmail.com> + + * ido.el (ido-use-virtual-buffers): Fix typo in docstring. + +2010-08-22 Juri Linkov <juri@jurta.org> + + * simple.el (read-extended-command): New function with the logic + for `completing-read' moved to Elisp from `execute-extended-command'. + Use `function-called-at-point' in `minibuffer-default-add-function' + to get a command name for M-n (bug#5364, bug#5214). + +2010-08-22 Chong Yidong <cyd@stupidchicken.com> + + * startup.el (command-line-1): Issue warning for ignored arguments + --unibyte, etc (Bug#6886). + +2010-08-22 Leo <sdl.web@gmail.com> + + * net/rcirc.el (rcirc-add-or-remove): Accept a list of elements. + (ignore, bright, dim, keyword): Split list of nicknames before + passing to rcirc-add-or-remove (Bug#6894). + +2010-08-22 Chong Yidong <cyd@stupidchicken.com> + + * emacs-lisp/easy-mmode.el (define-minor-mode): Doc fix (Bug#6880). + +2010-08-22 Leo <sdl.web@gmail.com> + + Fix buffer-list rename&refresh after killing a buffer in ido. + * lisp/ido.el: Revert Óscar's. + (ido-kill-buffer-at-head): Exit the minibuffer with ido-exit=refresh. + Remember the buffers at head, rather than their name. + * lisp/iswitchb.el (iswitchb-kill-buffer): Re-make the list. + +2010-08-22 Kirk Kelsey <kirk.kelsey@0x4b.net> (tiny change) + Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/make-mode.el (makefile-fill-paragraph): Account for the + extra backslash added to each line (bug#6890). + +2010-08-22 Stefan Monnier <monnier@iro.umontreal.ca> + + * subr.el (read-key): Don't echo keystrokes (bug#6883). + +2010-08-22 Glenn Morris <rgm@gnu.org> + + * menu-bar.el (menu-bar-games-menu): Add landmark. + +2010-08-22 Glenn Morris <rgm@gnu.org> + + * align.el (align-regexp): Make group and spacing arguments + use the interactive defaults when non-interactive. (Bug#6698) + + * mail/rmail.el (rmail-forward): Replace mail-text-start with its + expansion, so as not to need sendmail. + (mail-text-start): Remove declaration. + (rmail-retry-failure): Require sendmail. + +2010-08-22 Chong Yidong <cyd@stupidchicken.com> + + * subr.el (read-key): Don't hide the menu-bar entries (bug#6881). + +2010-08-22 Michael Albinus <michael.albinus@gmx.de> + + * progmodes/flymake.el (flymake-start-syntax-check-process): + Use `start-file-process' in order to let it run also on remote hosts. + +2010-08-22 Kenichi Handa <handa@m17n.org> + + * files.el: Add `word-wrap' as safe local variable. + +2010-08-22 Glenn Morris <rgm@gnu.org> + + * woman.el (woman-translate): Case matters. (Bug#6849) + +2010-08-22 Chong Yidong <cyd@stupidchicken.com> + + * simple.el (kill-region): Doc fix (Bug#6787). + +2010-08-22 Glenn Morris <rgm@gnu.org> + + * calendar/diary-lib.el (diary-header-line-format): + Fit it to the window, not the frame. + +2010-08-22 Andreas Schwab <schwab@linux-m68k.org> + + * subr.el (ignore-errors): Add debug declaration. + +2010-08-22 Geoff Gole <geoffgole@gmail.com> (tiny change) + + * whitespace.el (whitespace-color-off): Remove post-command-hook + locally. + +2010-08-21 Stefan Monnier <monnier@iro.umontreal.ca> + + * vc/add-log.el (add-log-file-name): Don't get confused by symlinks. + +2010-08-21 Chong Yidong <cyd@stupidchicken.com> + + * cus-edit.el (custom-group-value-create): Add extra newline + before end line (Bug#6876). + +2010-08-21 Chong Yidong <cyd@stupidchicken.com> + + * mouse.el (mouse-save-then-kill): Don't save region to kill ring + when extending it. Before killing on the second click, check if + the buffer is the correct one. Doc fix. + (mouse-secondary-save-then-kill): Allow usage without first + calling mouse-start-secondary, by defaulting to point. Don't save + an empty secondary selection. Doc fix. + +2010-08-21 Vinicius Jose Latorre <viniciusjl@ig.com.br> + + * whitespace.el: Fix slow cursor movement (Bug#6172). Reported by + Christoph Groth <cwg@falma.de> and Liu Xin <x_liu@neusoft.com>. + New version 13.0. + (whitespace-empty-at-bob-regexp, whitespace-empty-at-eob-regexp): + Adjust initialization. + (whitespace-bob-marker, whitespace-eob-marker) + (whitespace-buffer-changed): New vars. + (whitespace-cleanup, whitespace-color-on, whitespace-color-off) + (whitespace-empty-at-bob-regexp, whitespace-empty-at-eob-regexp) + (whitespace-post-command-hook, whitespace-display-char-on): + Adjust code. + (whitespace-looking-back, whitespace-buffer-changed): New funs. + (whitespace-space-regexp, whitespace-tab-regexp): Fun eliminated. + +2010-08-19 Stefan Monnier <monnier@iro.umontreal.ca> + + * files.el (locate-file-completion-table): Only list the .el and .elc + extensions if there's no other choice (bug#5955). + + * facemenu.el (facemenu-self-insert-data): New var. + (facemenu-post-self-insert-function, facemenu-set-self-insert-face): + New functions. + (facemenu-add-face): Use them. + + * simple.el (blink-matching-open): Obey forward-sexp-function. + +2010-08-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * simple.el (prog-mode-map): New var. + (prog-indent-sexp): New command. + + * progmodes/octave-mod.el (octave-mode-menu): Make toggle buttons. + + * progmodes/prolog.el (smie): Require. + + * emacs-lisp/smie.el (smie-default-backward-token) + (smie-default-forward-token): Strip properties. + (smie-next-sexp): Be more careful with associative operators. + (smie-forward-sexp-command): Generalize. + (smie-backward-sexp-command): Simplify. + (smie-closer-alist): New var. + (smie-close-block): New command. + (smie-indent-debug-log): New var. + (smie-indent-offset-rule): Add a few more cases. + (smie-indent-column): New function. + (smie-indent-after-keyword): Use it. + (smie-indent-keyword): Use it. + Fix up the opener code's point position. + (smie-indent-comment): Only applies at BOL. + (smie-indent-debug): New command. + + * emacs-lisp/autoload.el (make-autoload): Preload the macros's + declarations that are useful before running the macro. + +2010-08-18 Joakim Verona <joakim@verona.se> + + * image.el (imagemagick-types-inhibit): New variable. + (imagemagick-register-types): New function. + * image-mode.el (image-transform-properties): New function. + (image-transform-set-scale, image-transform-fit-to-height) + (image-transform-set-rotation, image-transform-set-resize) + (image-transform-fit-to-width, image-transform-fit-to-height): + New functions. + (image-toggle-display-image): Support image transforms. + +2010-08-18 Katsumi Yamaoka <yamaoka@jpl.org> + + * image.el (create-animated-image): Don't add heuristic mask to image + (Bug#6839). + +2010-08-18 Jan Djärv <jan.h.d@swipnet.se> + + * term/ns-win.el (ns-get-pasteboard, ns-set-pasteboard): + Use QCLIPBOARD instead of QPRIMARY (Bug#6677). + +2010-08-17 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/lisp.el (up-list): Obey forward-sexp-function if set. + + Font-lock '...' strings, plus various simplifications and fixes. + * progmodes/octave-mod.el (octave-font-lock-keywords): Use regexp-opt. + (octave-font-lock-close-quotes): New function. + (octave-font-lock-syntactic-keywords): New var. + (octave-mode): Use it. Set beginning-of-defun-function. + (octave-mode-map): Don't override the <foo>-defun commands. + (octave-mode-menu): Pass it directly to easy-menu-define; + remove (now generic) <foo>-defun commands; use info-lookup-symbol. + (octave-block-match-alist): Fix up last change so that + octave-close-block uses the more specific keyword. + (info-lookup-mode): Silence byte-compiler. + (octave-beginning-of-defun): Not interactive any more. + Optimize slightly. + (octave-end-of-defun, octave-mark-defun, octave-in-defun-p): Remove. + (octave-indent-defun, octave-send-defun): Use mark-defun instead. + (octave-completion-at-point-function): Make sure point is within + beg..end. + (octave-reindent-then-newline-and-indent): + Use reindent-then-newline-and-indent. + (octave-add-octave-menu): Remove. + +2010-08-17 Jan Djärv <jan.h.d@swipnet.se> + + * mail/emacsbug.el (report-emacs-bug-insert-to-mailer) + (report-emacs-bug-can-use-xdg-email): New functions. + (report-emacs-bug): Set can-xdg-email to result of + report-emacs-bug-can-use-xdg-email. If can-xdg-email bind + \C-cm to report-emacs-bug-insert-to-mailer and add help text + about it. + + * net/browse-url.el (browse-url-default-browser): Add cond + for browse-url-xdg-open. + (browse-url-can-use-xdg-open, browse-url-xdg-open): New functions. + +2010-08-17 Glenn Morris <rgm@gnu.org> + + * progmodes/cc-engine.el (c-new-BEG, c-new-END) + (c-fontify-recorded-types-and-refs): Define for compiler. + * progmodes/cc-mode.el (c-new-BEG, c-new-END): Move definitions + before use. + + * calendar/icalendar.el (icalendar--convert-recurring-to-diary): + Fix format call. + +2010-08-17 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-handle-make-symbolic-link): Flush file + properties. + (tramp-handle-process-file): Call the program in a subshell, in + order to preserve working directory. + (tramp-action-password): Hide password prompt before next run. + (tramp-process-actions): Widen connection buffer for the trace. + +2010-08-16 Deniz Dogan <deniz.a.m.dogan@gmail.com> + + * net/rcirc.el (rcirc-log-process-buffers): New option. + (rcirc-print): Use it. + (rcirc-generate-log-filename): New function. + (rcirc-log-filename-function): Change default to + rcirc-generate-log-filename (Bug#6828). + +2010-08-16 Chong Yidong <cyd@stupidchicken.com> + + * simple.el (deactivate-mark): If select-active-regions is `only', + only set selection for temporarily active regions. + + * cus-start.el: Change defcustom for select-active-regions. + +2010-08-15 Chong Yidong <cyd@stupidchicken.com> + + * mouse.el (mouse--drag-set-mark-and-point): New function. + (mouse-drag-track): Use LOCATION arg to push-mark. + Use mouse--drag-set-mark-and-point to take click-count into + consideration when updating point and mark (Bug#6840). + +2010-08-15 Chong Yidong <cyd@stupidchicken.com> + + * progmodes/compile.el (compilation-error-regexp-alist-alist): + Give the Ruby rule a lower priority than Gnu (Bug#6778). + +2010-08-14 Å tÄ›pán NÄ›mec <stepnem@gmail.com> (tiny change) + + * font-lock.el (lisp-font-lock-keywords-2): + Add combine-after-change-calls, condition-case-no-debug, + with-demoted-errors, and with-silent-modifications (Bug#6025). + +2010-08-14 Kevin Ryde <user42@zip.com.au> + + * emacs-lisp/copyright.el (copyright-update-year) + (copyright-update): Temporary switch-to-buffer to ensure the + buffer change being queried is visible (Bug#5394). + +2010-08-14 Tom Tromey <tromey@redhat.com> + + * progmodes/etags.el (tags-file-name): Mark safe if stringp + (Bug#6733). + +2010-08-14 Eli Zaretskii <eliz@gnu.org> + + * mouse.el (mouse-yank-primary): Fix mouse-2 on MS-Windows and + MS-DOS. (Bug#6689) + +2010-08-13 Jan Djärv <jan.h.d@swipnet.se> + + * menu-bar.el (menu-bar-set-tool-bar-position): New function. + (menu-bar-showhide-tool-bar-menu-customize-enable-left) + (menu-bar-showhide-tool-bar-menu-customize-enable-right) + (menu-bar-showhide-tool-bar-menu-customize-enable-top) + (menu-bar-showhide-tool-bar-menu-customize-enable-bottom): + Call menu-bar-set-tool-bar-position. + +2010-08-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * progmodes/octave-mod.el (octave-mode-syntax-table): Use the new "c" + comment style (bug#6834). + * progmodes/scheme.el (scheme-mode-syntax-table): + * emacs-lisp/lisp-mode.el (lisp-mode-syntax-table): Remove spurious + "b" flag in "' 14b" syntax. + + * progmodes/octave-mod.el (octave-mode-map): Remove special bindings + for (un)commenting the region and performing completion. + (octave-mode-menu): Use standard commands for help and completion. + (octave-mode-syntax-table): Support %{..%} comments (sort of). + (octave-mode): Use define-derived-mode. + Set completion-at-point-functions and don't set columns. + Don't disable adaptive-fill-regexp. + (octave-describe-major-mode, octave-comment-region) + (octave-uncomment-region, octave-comment-indent) + (octave-indent-for-comment): Remove. + (octave-indent-calculate): Rename from calculate-octave-indent. + (octave-indent-line, octave-fill-paragraph): Update caller. + (octave-initialize-completions): No need to make an alist. + (octave-completion-at-point-function): New function. + (octave-complete-symbol): Use it. + (octave-insert-defun): Use define-skeleton. + + * progmodes/octave-mod.el (octave-mode): Set comment-add. + (octave-mode-map): Use comment-dwim (bug#6829). + +2010-08-12 Antoine Levitt <antoine.levitt@gmail.com> (tiny change) + + * cus-edit.el (custom-save-variables, custom-save-faces): Fix up + indentation of inserted comment. + +2010-08-11 Jan Djärv <jan.h.d@swipnet.se> + + * faces.el (region): Add type gtk that uses gtk colors. + + * dynamic-setting.el (dynamic-setting-handle-config-changed-event): + Handle theme-name change. + +2010-08-10 Michael R. Mauger <mmaug@yahoo.com> + + * progmodes/sql.el: Version 2.5 + (sql-product-alist): Add :prompt-cont-regexp property for several + database products. + (sql-prompt-cont-regexp): New variable. + (sql-output-newline-count, sql-output-by-send): + New variables. Record number of newlines in input text. + (sql-send-string): Handle multiple filters and count newlines. + (sql-send-magic-terminator): Count terminator newline. + (sql-interactive-remove-continuation-prompt): Filters output to + remove continuation prompts; one for each newline. + (sql-interactive-mode): Set up new variables, prompt regexp and + output filter. + (sql-mode-sqlite-font-lock-keywords): Correct some keywords. + (sql-make-alternate-buffer-name): Correct buffer name in edge cases. + 2010-08-10 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/pcase.el: New file. @@ -79,7 +1602,7 @@ (ctext-standard-encodings): New variable. (ctext-non-standard-encodings-table): List only elements for non-standard encodings. - (ctext-pre-write-conversion): Adjusted for the above change. + (ctext-pre-write-conversion): Adjust for the above change. Check ctext-standard-encodings. * international/mule-conf.el (compound-text): Doc fix. @@ -132,7 +1655,7 @@ * align.el (align-default-spacing): Doc fix. (align-region-heuristic, align-regexp): Fix typos in docstrings. -2010-08-08 Stephen Peters <speters@itasoftware.com> +2010-08-08 Stephen Peters <speters@itasoftware.com> * calendar/icalendar.el (icalendar--split-value): Fixed splitting regexp. (Bug#6766) @@ -2968,7 +4491,8 @@ * minibuffer.el (tags-completion-at-point-function): New function. (completion-at-point-functions): Use it. - * cedet/semantic.el (semantic-completion-at-point-function): New function. + * cedet/semantic.el (semantic-completion-at-point-function): + New function. (semantic-mode): Use semantic-completion-at-point-function for completion-at-point-functions instead. @@ -3018,8 +4542,8 @@ 2010-04-28 Chong Yidong <cyd@stupidchicken.com> - * progmodes/bug-reference.el (bug-reference-url-format): Revert - 2010-04-27 change due to security risk. + * progmodes/bug-reference.el (bug-reference-url-format): + Revert 2010-04-27 change due to security risk. 2010-04-28 Stefan Monnier <monnier@iro.umontreal.ca> @@ -3194,8 +4718,7 @@ * ido.el (ido-init-completion-maps): For ido-switch-buffer, C-o toggles the use of virtual buffers. - (ido-buffer-internal): Guard `ido-use-virtual-buffers' global - value. + (ido-buffer-internal): Guard `ido-use-virtual-buffers' global value. (ido-toggle-virtual-buffers): New function. 2010-04-21 Juanma Barranquero <lekktu@gmail.com> @@ -3772,7 +5295,7 @@ Enable recentf-mode if using virtual buffers. * ido.el (recentf-list): Declare for byte-compiler. - (ido-virtual-buffers): Move up to silence byte-compiler. Add docstring. + (ido-virtual-buffers): Move up to silence byte-compiler. Add docstring. (ido-make-buffer-list): Simplify. (ido-add-virtual-buffers-to-list): Simplify. Enable recentf-mode. @@ -5283,8 +6806,8 @@ 2010-01-21 Alan Mackenzie <acm@muc.de> Fix a situation where deletion of a cpp construct throws an error. - * progmodes/cc-engine.el (c-invalidate-state-cache): Before - invoking c-with-all-but-one-cpps-commented-out, check that the + * progmodes/cc-engine.el (c-invalidate-state-cache): + Before invoking c-with-all-but-one-cpps-commented-out, check that the special cpp construct is still in the buffer. (c-parse-state): Record the special cpp with markers, not numbers. @@ -6011,7 +7534,7 @@ * ps-print.el (ps-face-attributes): It was not returning the attribute face for faces specified as string. Reported by harven - <harven@free.fr>. + <harven@free.fr>. (Bug#5254) (ps-print-version): New version 7.3.5. 2009-12-18 Ulf Jasper <ulf.jasper@web.de> diff --git a/lisp/Makefile.in b/lisp/Makefile.in index e6f2a66ec8e..391375b2d18 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -33,10 +33,9 @@ VPATH = $(srcdir) # to use an absolute file name. EMACS = ${abs_top_builddir}/src/emacs -# Command line flags for Emacs. This must include --multibyte, -# otherwise some files will not compile. +# Command line flags for Emacs. -EMACSOPT = -batch --no-site-file --multibyte +EMACSOPT = -batch --no-site-file # Extra flags to pass to the byte compiler BYTE_COMPILE_EXTRA_FLAGS = @@ -57,7 +56,8 @@ ETAGS = ../lib-src/etags LOADDEFS = $(lisp)/calendar/cal-loaddefs.el \ $(lisp)/calendar/diary-loaddefs.el \ $(lisp)/calendar/hol-loaddefs.el \ - $(lisp)/mh-e/mh-loaddefs.el + $(lisp)/mh-e/mh-loaddefs.el \ + $(lisp)/net/tramp-loaddefs.el # Elisp files auto-generated. AUTOGENEL = loaddefs.el \ @@ -340,6 +340,24 @@ $(MH_E_DIR)/mh-loaddefs.el: $(MH_E_SRC) --eval "(setq make-backup-files nil)" \ -f batch-update-autoloads $(MH_E_DIR) +# Update TRAMP internal autoloads. Maybe we could move trmp*.el into +# an own subdirectory. OTOH, it does not hurt to keep them in +# lisp/net. +TRAMP_DIR = $(lisp)/net +TRAMP_SRC = $(TRAMP_DIR)/tramp.el $(TRAMP_DIR)/tramp-cache.el \ + $(TRAMP_DIR)/tramp-cmds.el $(TRAMP_DIR)/tramp-compat.el \ + $(TRAMP_DIR)/tramp-fish.el $(TRAMP_DIR)/tramp-ftp.el \ + $(TRAMP_DIR)/tramp-gvfs.el $(TRAMP_DIR)/tramp-gw.el \ + $(TRAMP_DIR)/tramp-imap.el $(TRAMP_DIR)/tramp-smb.el \ + $(TRAMP_DIR)/tramp-uu.el $(TRAMP_DIR)/trampver.el + +$(TRAMP_DIR)/tramp-loaddefs.el: $(TRAMP_SRC) + $(emacs) -l autoload \ + --eval "(setq generate-autoload-cookie \";;;###tramp-autoload\")" \ + --eval "(setq generated-autoload-file \"$@\")" \ + --eval "(setq make-backup-files nil)" \ + -f batch-update-autoloads $(TRAMP_DIR) + CAL_DIR = $(lisp)/calendar ## Those files that may contain internal calendar autoload cookies. ## Avoids circular dependency warning for *-loaddefs.el. diff --git a/lisp/abbrev.el b/lisp/abbrev.el index a1fc3f90bf6..6e48360587f 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: abbrev convenience +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/abbrevlist.el b/lisp/abbrevlist.el index bf51a3dc418..5f9cbee2cf5 100644 --- a/lisp/abbrevlist.el +++ b/lisp/abbrevlist.el @@ -6,6 +6,7 @@ ;; Maintainer: FSF ;; Keywords: abbrev +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/align.el b/lisp/align.el index 9d811327021..0812d362875 100644 --- a/lisp/align.el +++ b/lisp/align.el @@ -1,7 +1,7 @@ ;;; align.el --- align text to a specific column, by regexp -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw@gnu.org> ;; Maintainer: FSF @@ -944,6 +944,8 @@ region, call `align-regexp' and type in that regular expression." (list (concat "\\(\\s-*\\)" (read-string "Align regexp: ")) 1 align-default-spacing nil)))) + (or group (setq group 1)) + (or spacing (setq spacing align-default-spacing)) (let ((rule (list (list nil (cons 'regexp regexp) (cons 'group (abs group)) diff --git a/lisp/ansi-color.el b/lisp/ansi-color.el index 00162c99219..6bc95fa8d94 100644 --- a/lisp/ansi-color.el +++ b/lisp/ansi-color.el @@ -244,9 +244,9 @@ A possible way to install this would be: (when (boundp 'font-lock-syntactic-keywords) (remove-text-properties beg end '(syntax-table nil))) ;; instead of just using (remove-text-properties beg end '(face - ;; nil)), we find regions with a non-nil face test-property, skip + ;; nil)), we find regions with a non-nil face text-property, skip ;; positions with the ansi-color property set, and remove the - ;; remaining face test-properties. + ;; remaining face text-properties. (while (setq beg (text-property-not-all beg end 'face nil)) (setq beg (or (text-property-not-all beg end 'ansi-color t) end)) (when (get-text-property beg 'face) diff --git a/lisp/apropos.el b/lisp/apropos.el index 09de0c08e19..d62721e157c 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -6,6 +6,7 @@ ;; Author: Joe Wells <jbw@bigbird.bu.edu> ;; Daniel Pfeiffer <occitan@esperanto.org> (rewrite) ;; Keywords: help +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/bindings.el b/lisp/bindings.el index eba6bf7a78a..d19db2c779e 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -6,6 +6,7 @@ ;; Maintainer: FSF ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 9ec78309f9d..e0f00d3553d 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: convenience +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/button.el b/lisp/button.el index 2a9a49c399a..c771474da3a 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -5,6 +5,7 @@ ;; ;; Author: Miles Bader <miles@gnu.org> ;; Keywords: extensions +;; Package: emacs ;; ;; This file is part of GNU Emacs. ;; diff --git a/lisp/calc/calc-aent.el b/lisp/calc/calc-aent.el index 30f15f04905..472133be84f 100644 --- a/lisp/calc/calc-aent.el +++ b/lisp/calc/calc-aent.el @@ -315,10 +315,24 @@ The value t means abort and give an error message.") calc-dollar-used 0))) (calc-handle-whys)))) -(defvar calc-alg-ent-map nil +(defvar calc-alg-ent-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (define-key map "'" 'calcAlg-previous) + (define-key map "`" 'calcAlg-edit) + (define-key map "\C-m" 'calcAlg-enter) + (define-key map "\C-j" 'calcAlg-enter) + map) "The keymap used for algebraic entry.") -(defvar calc-alg-ent-esc-map nil +(defvar calc-alg-ent-esc-map + (let ((map (make-keymap)) + (i 33)) + (set-keymap-parent map esc-map) + (while (< i 127) + (define-key map (vector i) 'calcAlg-escape) + (setq i (1+ i))) + map) "The keymap used for escapes in algebraic entry.") (defvar calc-alg-exp) @@ -326,19 +340,8 @@ The value t means abort and give an error message.") ;;;###autoload (defun calc-do-alg-entry (&optional initial prompt no-normalize history) (let* ((calc-buffer (current-buffer)) - (blink-paren-function 'calcAlg-blink-matching-open) + (blink-matching-check-function 'calcAlg-blink-matching-check) (calc-alg-exp 'error)) - (unless calc-alg-ent-map - (setq calc-alg-ent-map (copy-keymap minibuffer-local-map)) - (define-key calc-alg-ent-map "'" 'calcAlg-previous) - (define-key calc-alg-ent-map "`" 'calcAlg-edit) - (define-key calc-alg-ent-map "\C-m" 'calcAlg-enter) - (define-key calc-alg-ent-map "\C-j" 'calcAlg-enter) - (let ((i 33)) - (setq calc-alg-ent-esc-map (copy-keymap esc-map)) - (while (< i 127) - (aset (nth 1 calc-alg-ent-esc-map) i 'calcAlg-escape) - (setq i (1+ i))))) (define-key calc-alg-ent-map "\e" nil) (if (eq calc-algebraic-mode 'total) (define-key calc-alg-ent-map "\e" calc-alg-ent-esc-map) @@ -430,18 +433,9 @@ The value t means abort and give an error message.") exp)) (exit-minibuffer)))) -(defun calcAlg-blink-matching-open () - (let ((rightpt (point)) - (leftpt nil) - (rightchar (preceding-char)) - leftchar - rightsyntax - leftsyntax) - (save-excursion - (condition-case () - (setq leftpt (scan-sexps rightpt -1) - leftchar (char-after leftpt)) - (error nil))) +(defun calcAlg-blink-matching-check (leftpt rightpt) + (let ((rightchar (char-before rightpt)) + (leftchar (if leftpt (char-after leftpt)))) (if (and leftpt (or (and (= rightchar ?\)) (= leftchar ?\[)) @@ -450,20 +444,9 @@ The value t means abort and give an error message.") (save-excursion (goto-char leftpt) (looking-at ".+\\(\\.\\.\\|\\\\dots\\|\\\\ldots\\)"))) - (let ((leftsaved (aref (syntax-table) leftchar)) - (rightsaved (aref (syntax-table) rightchar))) - (unwind-protect - (progn - (cond ((= leftchar ?\[) - (aset (syntax-table) leftchar (cons 4 ?\))) - (aset (syntax-table) rightchar (cons 5 ?\[))) - (t - (aset (syntax-table) leftchar (cons 4 ?\])) - (aset (syntax-table) rightchar (cons 5 ?\()))) - (blink-matching-open)) - (aset (syntax-table) leftchar leftsaved) - (aset (syntax-table) rightchar rightsaved))) - (blink-matching-open)))) + ;; [2..5) perfectly valid! + nil + (blink-matching-check-mismatch leftpt rightpt)))) ;;;###autoload (defun calc-alg-digit-entry () diff --git a/lisp/calendar/appt.el b/lisp/calendar/appt.el index 7fcaab9da34..ad36531bb40 100644 --- a/lisp/calendar/appt.el +++ b/lisp/calendar/appt.el @@ -6,6 +6,7 @@ ;; Author: Neil Mager <neilm@juliet.ll.mit.edu> ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-bahai.el b/lisp/calendar/cal-bahai.el index 7270d423409..7b8f61a7a84 100644 --- a/lisp/calendar/cal-bahai.el +++ b/lisp/calendar/cal-bahai.el @@ -6,6 +6,7 @@ ;; Author: John Wiegley <johnw@gnu.org> ;; Keywords: calendar ;; Human-Keywords: Bahá'à calendar, Bahá'Ã, Baha'i, Bahai, calendar, diary +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-china.el b/lisp/calendar/cal-china.el index f9946c18045..0fc63e7eaac 100644 --- a/lisp/calendar/cal-china.el +++ b/lisp/calendar/cal-china.el @@ -7,6 +7,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: Chinese calendar, calendar, holidays, diary +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-coptic.el b/lisp/calendar/cal-coptic.el index 16cc6672727..69612edab38 100644 --- a/lisp/calendar/cal-coptic.el +++ b/lisp/calendar/cal-coptic.el @@ -7,6 +7,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: Coptic calendar, Ethiopic calendar, calendar, diary +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el index c541caa5696..d27bc8480a7 100644 --- a/lisp/calendar/cal-dst.el +++ b/lisp/calendar/cal-dst.el @@ -8,6 +8,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: daylight saving time, calendar, diary, holidays +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el index 9b252eb3dc4..98a118f232f 100644 --- a/lisp/calendar/cal-french.el +++ b/lisp/calendar/cal-french.el @@ -8,6 +8,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: French Revolutionary calendar, calendar, diary +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el index 2a7556ff322..98c1a29df7c 100644 --- a/lisp/calendar/cal-hebrew.el +++ b/lisp/calendar/cal-hebrew.el @@ -8,6 +8,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: Hebrew calendar, calendar, diary +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-html.el b/lisp/calendar/cal-html.el index 33066b201bf..d4210027600 100644 --- a/lisp/calendar/cal-html.el +++ b/lisp/calendar/cal-html.el @@ -7,6 +7,7 @@ ;; Keywords: calendar ;; Human-Keywords: calendar, diary, HTML ;; Created: 23 Aug 2002 +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-islam.el b/lisp/calendar/cal-islam.el index 1c09f1db113..da631a9710a 100644 --- a/lisp/calendar/cal-islam.el +++ b/lisp/calendar/cal-islam.el @@ -7,6 +7,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: Islamic calendar, calendar, diary +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-iso.el b/lisp/calendar/cal-iso.el index 0762860b0ba..3c5055defb6 100644 --- a/lisp/calendar/cal-iso.el +++ b/lisp/calendar/cal-iso.el @@ -7,6 +7,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: ISO calendar, calendar, diary +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-julian.el b/lisp/calendar/cal-julian.el index d1cea19be40..0cf9388a4b0 100644 --- a/lisp/calendar/cal-julian.el +++ b/lisp/calendar/cal-julian.el @@ -7,6 +7,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: Julian calendar, Julian day number, calendar, diary +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-mayan.el b/lisp/calendar/cal-mayan.el index de079b122c7..d2e4810fa82 100644 --- a/lisp/calendar/cal-mayan.el +++ b/lisp/calendar/cal-mayan.el @@ -8,6 +8,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: Mayan calendar, Maya, calendar, diary +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el index 521cd2dce2d..877be9556fb 100644 --- a/lisp/calendar/cal-menu.el +++ b/lisp/calendar/cal-menu.el @@ -8,6 +8,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: calendar, popup menus, menu bar +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-move.el b/lisp/calendar/cal-move.el index 89e45bef779..e569e8c424c 100644 --- a/lisp/calendar/cal-move.el +++ b/lisp/calendar/cal-move.el @@ -7,6 +7,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: calendar +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el index 95ae2f165bb..5c624ddcf01 100644 --- a/lisp/calendar/cal-persia.el +++ b/lisp/calendar/cal-persia.el @@ -7,6 +7,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: Persian calendar, calendar, diary +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el index 46fb0869787..e6ba1ad3439 100644 --- a/lisp/calendar/cal-tex.el +++ b/lisp/calendar/cal-tex.el @@ -8,6 +8,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: Calendar, LaTeX +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/cal-x.el b/lisp/calendar/cal-x.el index 90a4c5d33b8..377646147b9 100644 --- a/lisp/calendar/cal-x.el +++ b/lisp/calendar/cal-x.el @@ -8,6 +8,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: calendar, dedicated frames +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 8fb464aa7e6..39354bd31e3 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -383,14 +383,14 @@ The format of the header is specified by `diary-header-line-format'." "Some text is hidden - press \"s\" in calendar \ before edit/copy" "Diary")) - ?\s (frame-width))) + ?\s (window-width))) "Format of the header line displayed by `diary-simple-display'. Only used if `diary-header-line-flag' is non-nil." :group 'diary :type 'sexp :initialize 'custom-initialize-default :set 'diary-set-header - :version "22.1") + :version "23.3") ; frame-width -> window-width ;; The first version of this also checked for diary-selective-display ;; in the non-fancy case. This was an attempt to distinguish between diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el index 0cafc85a24b..af61fdf149e 100644 --- a/lisp/calendar/holidays.el +++ b/lisp/calendar/holidays.el @@ -6,6 +6,7 @@ ;; Author: Edward M. Reingold <reingold@cs.uiuc.edu> ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: holidays, calendar +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/icalendar.el b/lisp/calendar/icalendar.el index 2dcf75758c0..0be138906b6 100644 --- a/lisp/calendar/icalendar.el +++ b/lisp/calendar/icalendar.el @@ -7,6 +7,7 @@ ;; Created: August 2002 ;; Keywords: calendar ;; Human-Keywords: calendar, diary, iCalendar, vCalendar +;; Version: 0.19 ;; This file is part of GNU Emacs. @@ -2092,6 +2093,7 @@ END-T is the event's end time in diary format." (format "(diary-cyclic %d %s) " (* interval 7) dtstart-conv)) + dtstart-conv (if count until-1-conv until-conv) )) (setq result diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el index 37a68888854..58111a036d1 100644 --- a/lisp/calendar/lunar.el +++ b/lisp/calendar/lunar.el @@ -7,6 +7,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: moon, lunar phases, calendar, diary +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/parse-time.el b/lisp/calendar/parse-time.el index fd62d909f36..71e32b9db4c 100644 --- a/lisp/calendar/parse-time.el +++ b/lisp/calendar/parse-time.el @@ -220,5 +220,4 @@ unknown are returned as nil." (provide 'parse-time) -;; arch-tag: 07066094-45a8-4c68-b307-86195e2c1103 ;;; parse-time.el ends here diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el index 3d6ab73e778..8cf831f9945 100644 --- a/lisp/calendar/solar.el +++ b/lisp/calendar/solar.el @@ -8,6 +8,7 @@ ;; Maintainer: Glenn Morris <rgm@gnu.org> ;; Keywords: calendar ;; Human-Keywords: sunrise, sunset, equinox, solstice, calendar, diary, holidays +;; Package: calendar ;; This file is part of GNU Emacs. diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 914d2d33928..d99d13e431d 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -364,5 +364,4 @@ This function does not work for SECONDS greater than `most-positive-fixnum'." (provide 'time-date) -;; arch-tag: addcf07b-b20a-465b-af72-550b8ac5190f ;;; time-date.el ends here diff --git a/lisp/case-table.el b/lisp/case-table.el index 53d30bf2819..1e5974d7d1a 100644 --- a/lisp/case-table.el +++ b/lisp/case-table.el @@ -6,6 +6,7 @@ ;; Author: Howard Gayle ;; Maintainer: FSF ;; Keywords: i18n +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/cedet/cedet-cscope.el b/lisp/cedet/cedet-cscope.el index bff80222f78..18cb7071d5c 100644 --- a/lisp/cedet/cedet-cscope.el +++ b/lisp/cedet/cedet-cscope.el @@ -3,6 +3,7 @@ ;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> +;; Package: cedet ;; This file is part of GNU Emacs. diff --git a/lisp/cedet/cedet-files.el b/lisp/cedet/cedet-files.el index 9dacf062288..bb7137ddad2 100644 --- a/lisp/cedet/cedet-files.el +++ b/lisp/cedet/cedet-files.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <eric@siege-engine.com> +;; Package: cedet ;; This file is part of GNU Emacs. diff --git a/lisp/cedet/cedet-global.el b/lisp/cedet/cedet-global.el index 3a34ca44e25..b98bd316935 100644 --- a/lisp/cedet/cedet-global.el +++ b/lisp/cedet/cedet-global.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <eric@siege-engine.com> +;; Package: cedet ;; This file is part of GNU Emacs. diff --git a/lisp/cedet/cedet-idutils.el b/lisp/cedet/cedet-idutils.el index 562749dda00..44c325b78cd 100644 --- a/lisp/cedet/cedet-idutils.el +++ b/lisp/cedet/cedet-idutils.el @@ -5,6 +5,7 @@ ;; Author: Eric M. Ludlam <eric@siege-engine.com> ;; Version: 0.2 ;; Keywords: OO, lisp +;; Package: cedet ;; This file is part of GNU Emacs. diff --git a/lisp/cedet/cedet.el b/lisp/cedet/cedet.el index b15745aac76..6a6d09fda69 100644 --- a/lisp/cedet/cedet.el +++ b/lisp/cedet/cedet.el @@ -5,7 +5,7 @@ ;; Author: David Ponce <david@dponce.com> ;; Maintainer: Eric M. Ludlam <zappo@gnu.org> -;; Version: 0.2 +;; Version: 1.0pre7 ;; Keywords: OO, lisp ;; This file is part of GNU Emacs. diff --git a/lisp/cedet/data-debug.el b/lisp/cedet/data-debug.el index ed8441d2df0..f48de002fe3 100644 --- a/lisp/cedet/data-debug.el +++ b/lisp/cedet/data-debug.el @@ -5,6 +5,7 @@ ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Version: 0.2 ;; Keywords: OO, lisp +;; Package: cedet ;; This file is part of GNU Emacs. diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el index 46fcdb000f8..807c7797668 100644 --- a/lisp/cedet/ede.el +++ b/lisp/cedet/ede.el @@ -5,6 +5,7 @@ ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: project, make +;; Version: 1.0pre7 ;; This file is part of GNU Emacs. diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index 99e594a4638..f5d3f54f205 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -4,7 +4,8 @@ ;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam <zappo@gnu.org> -;; Keywords: syntax +;; Keywords: syntax tools +;; Version: 2.0pre7 ;; This file is part of GNU Emacs. diff --git a/lisp/cedet/srecode.el b/lisp/cedet/srecode.el index a903ffd0af1..d6c218f2b5a 100644 --- a/lisp/cedet/srecode.el +++ b/lisp/cedet/srecode.el @@ -4,6 +4,7 @@ ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: codegeneration +;; Version: 1.0pre7 ;; This file is part of GNU Emacs. diff --git a/lisp/comint.el b/lisp/comint.el index 128965fc11f..641be4f4d22 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -8,6 +8,7 @@ ;; Simon Marshall <simon@gnu.org> ;; Maintainer: FSF ;; Keywords: processes +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/composite.el b/lisp/composite.el index d886be5a463..1ecfec86b5d 100644 --- a/lisp/composite.el +++ b/lisp/composite.el @@ -8,6 +8,7 @@ ;; Author: Kenichi HANDA <handa@etl.go.jp> ;; (according to ack.texi) ;; Keywords: mule, multilingual, character composition +;; Package: emacs ;; This file is part of GNU Emacs. @@ -412,27 +413,6 @@ after a sequence of character events." ;;; Automatic character composition. -;; Copied from font-lock.el. -(eval-when-compile - ;; Borrowed from lazy-lock.el. - ;; We use this to preserve or protect things when modifying text properties. - (defmacro save-buffer-state (varlist &rest body) - "Bind variables according to VARLIST and eval BODY restoring buffer state." - `(let* ,(append varlist - '((modified (buffer-modified-p)) (buffer-undo-list t) - (inhibit-read-only t) (inhibit-point-motion-hooks t) - (inhibit-modification-hooks t) - deactivate-mark buffer-file-name buffer-file-truename)) - ,@body - (unless modified - (restore-buffer-modified-p nil)))) - ;; Fixme: This makes bootstrapping fail with this error. - ;; Symbol's function definition is void: eval-defun - ;;(def-edebug-spec save-buffer-state let) - ) - -(put 'save-buffer-state 'lisp-indent-function 1) - ;; These macros must match with C macros LGSTRING_XXX and LGLYPH_XXX in font.h (defsubst lgstring-header (gstring) (aref gstring 0)) (defsubst lgstring-set-header (gstring header) (aset gstring 0 header)) diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el index 249dd51acda..230410772ab 100644 --- a/lisp/cus-dep.el +++ b/lisp/cus-dep.el @@ -5,6 +5,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/cus-edit.el b/lisp/cus-edit.el index bb2f67422e3..a333be289ed 100644 --- a/lisp/cus-edit.el +++ b/lisp/cus-edit.el @@ -6,6 +6,7 @@ ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Maintainer: FSF ;; Keywords: help, faces +;; Package: emacs ;; This file is part of GNU Emacs. @@ -4097,8 +4098,8 @@ If GROUPS-ONLY non-nil, return only those members that are groups." (custom-group-state-update widget) (progress-reporter-done reporter)) ;; End line - (let ((p (point))) - (insert "\n") + (let ((p (1+ (point)))) + (insert "\n\n") (put-text-property p (1+ p) 'face '(:underline t)) (overlay-put (make-overlay p (1+ p)) 'before-string @@ -4404,10 +4405,10 @@ This function does not save the buffer." (unless (bolp) (princ "\n")) (princ "(custom-set-variables - ;; custom-set-variables was added by Custom. - ;; If you edit it by hand, you could mess it up, so be careful. - ;; Your init file should contain only one such instance. - ;; If there is more than one, they won't work right.\n") + ;; custom-set-variables was added by Custom. + ;; If you edit it by hand, you could mess it up, so be careful. + ;; Your init file should contain only one such instance. + ;; If there is more than one, they won't work right.\n") (dolist (symbol saved-list) (let ((spec (car-safe (get symbol 'theme-value))) (value (get symbol 'saved-value)) @@ -4480,10 +4481,10 @@ This function does not save the buffer." (unless (bolp) (princ "\n")) (princ "(custom-set-faces - ;; custom-set-faces was added by Custom. - ;; If you edit it by hand, you could mess it up, so be careful. - ;; Your init file should contain only one such instance. - ;; If there is more than one, they won't work right.\n") + ;; custom-set-faces was added by Custom. + ;; If you edit it by hand, you could mess it up, so be careful. + ;; Your init file should contain only one such instance. + ;; If there is more than one, they won't work right.\n") (dolist (symbol saved-list) (let ((spec (car-safe (get symbol 'theme-face))) (value (get symbol 'saved-face)) diff --git a/lisp/cus-face.el b/lisp/cus-face.el index 5cb808c2e38..f6a07507f2c 100644 --- a/lisp/cus-face.el +++ b/lisp/cus-face.el @@ -5,6 +5,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: help, faces +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/cus-start.el b/lisp/cus-start.el index 10214d39a0d..161de5e78ec 100644 --- a/lisp/cus-start.el +++ b/lisp/cus-start.el @@ -5,6 +5,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. @@ -198,8 +199,8 @@ Leaving \"Default\" unchecked is equivalent with specifying a default of (help-event-list keyboard (repeat (sexp :format "%v"))) (menu-prompting menu boolean) (select-active-regions killing - (choice (const :tag "lazy" lazy) - (const :tag "always" t) + (choice (const :tag "always" t) + (const :tag "only shift-selection or mouse-drag" only) (const :tag "off" nil)) "24.1") (suggest-key-bindings keyboard (choice (const :tag "off" nil) diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index 0fb6e485de1..77ea09cfe9a 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -6,6 +6,7 @@ ;; Author: Alex Schroeder <alex@gnu.org> ;; Maintainer: FSF ;; Keywords: help, faces +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/custom.el b/lisp/custom.el index 273c67dc66d..d6ecc6dfbd5 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -6,6 +6,7 @@ ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Maintainer: FSF ;; Keywords: help, faces +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/desktop.el b/lisp/desktop.el index 8f0b8075cdf..b4d3dfd55c8 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -226,7 +226,7 @@ the normal hook `desktop-not-loaded-hook' is run." The base name of the file is specified in `desktop-base-file-name'." :type '(repeat directory) :group 'desktop - :version "22.1") + :version "23.2") ; user-emacs-directory added (defcustom desktop-missing-file-warning nil "If non-nil, offer to recreate the buffer of a deleted file. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 62d6928c024..f4b79414c6a 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -6,6 +6,7 @@ ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>. ;; Maintainer: FSF ;; Keywords: files +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/dired-x.el b/lisp/dired-x.el index 2dc7475e9e3..45fdda71356 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -7,6 +7,7 @@ ;; Lawrence R. Dodd <dodd@roebling.poly.edu> ;; Maintainer: Romain Francoise <rfrancoise@gnu.org> ;; Keywords: dired extensions files +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/dired.el b/lisp/dired.el index fa3a15b97be..3fdb82ca7d3 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -7,6 +7,7 @@ ;; Author: Sebastian Kremer <sk@thp.uni-koeln.de> ;; Maintainer: FSF ;; Keywords: files +;; Package: emacs ;; This file is part of GNU Emacs. @@ -3248,12 +3249,16 @@ variable `dired-listing-switches'. To temporarily override the listing format, use `\\[universal-argument] \\[dired]'.") (defvar dired-sort-by-date-regexp - (concat "^-[^" dired-ls-sorting-switches - "]*t[^" dired-ls-sorting-switches "]*$") + (concat "\\(\\`\\| \\)-[^- ]*t" + ;; `dired-ls-sorting-switches' after -t overrides -t. + "[^ " dired-ls-sorting-switches "]*" + "\\(\\(\\`\\| +\\)\\(--[^ ]+\\|-[^- t" + dired-ls-sorting-switches "]+\\)\\)* *$") "Regexp recognized by Dired to set `by date' mode.") (defvar dired-sort-by-name-regexp - (concat "^-[^t" dired-ls-sorting-switches "]+$") + (concat "\\`\\(\\(\\`\\| +\\)\\(--[^ ]+\\|" + "-[^- t" dired-ls-sorting-switches "]+\\)\\)* *$") "Regexp recognized by Dired to set `by name' mode.") (defvar dired-sort-inhibit nil @@ -3279,8 +3284,8 @@ The idea is to set this buffer-locally in special dired buffers.") (force-mode-line-update))) (defun dired-sort-toggle-or-edit (&optional arg) - "Toggle between sort by date/name and refresh the dired buffer. -With a prefix argument you can edit the current listing switches instead." + "Toggle sorting by date, and refresh the Dired buffer. +With a prefix argument, edit the current listing switches instead." (interactive "P") (when dired-sort-inhibit (error "Cannot sort this dired buffer")) @@ -3291,24 +3296,24 @@ With a prefix argument you can edit the current listing switches instead." (defun dired-sort-toggle () ;; Toggle between sort by date/name. Reverts the buffer. - (setq dired-actual-switches - (let (case-fold-search) - (if (string-match " " dired-actual-switches) - ;; New toggle scheme: add/remove a trailing " -t" - (if (string-match " -t\\'" dired-actual-switches) - (substring dired-actual-switches 0 (match-beginning 0)) - (concat dired-actual-switches " -t")) - ;; old toggle scheme: look for some 't' switch and add/remove it - (concat - "-l" - (dired-replace-in-string (concat "[-lt" - dired-ls-sorting-switches "]") - "" - dired-actual-switches) - (if (string-match (concat "[t" dired-ls-sorting-switches "]") - dired-actual-switches) - "" - "t"))))) + (let ((sorting-by-date (string-match dired-sort-by-date-regexp + dired-actual-switches)) + ;; Regexp for finding (possibly embedded) -t switches. + (switch-regexp "\\(\\`\\| \\)-\\([a-su-zA-Z]*\\)\\(t\\)\\([^ ]*\\)") + case-fold-search) + ;; Remove the -t switch. + (while (string-match switch-regexp dired-actual-switches) + (if (and (equal (match-string 2 dired-actual-switches) "") + (equal (match-string 4 dired-actual-switches) "")) + ;; Remove a stand-alone -t switch. + (setq dired-actual-switches + (replace-match "" t t dired-actual-switches)) + ;; Remove a switch of the form -XtY for some X and Y. + (setq dired-actual-switches + (replace-match "" t t dired-actual-switches 3)))) + ;; Now, if we weren't sorting by date before, add the -t switch. + (unless sorting-by-date + (setq dired-actual-switches (concat dired-actual-switches " -t")))) (dired-sort-set-modeline) (revert-buffer)) @@ -3534,7 +3539,7 @@ Ask means pop up a menu for the user to select one of copy, move or link." ;;;;;; dired-run-shell-command dired-do-shell-command dired-do-async-shell-command ;;;;;; dired-clean-directory dired-do-print dired-do-touch dired-do-chown ;;;;;; dired-do-chgrp dired-do-chmod dired-compare-directories dired-backup-diff -;;;;;; dired-diff) "dired-aux" "dired-aux.el" "07676ea25af17f5d50cc5db4f53bddc0") +;;;;;; dired-diff) "dired-aux" "dired-aux.el" "416d272299fd4774c47c2f677ee640a4") ;;; Generated autoloads from dired-aux.el (autoload 'dired-diff "dired-aux" "\ @@ -3987,7 +3992,7 @@ true then the type of the file linked to by FILE is printed instead. ;;;*** ;;;### (autoloads (dired-do-relsymlink dired-jump) "dired-x" "dired-x.el" -;;;;;; "6c492aba3ca0d36a4cd7b02fb9c1cc10") +;;;;;; "27c312d6d5d40d8cb4ef8d62e30d5f4a") ;;; Generated autoloads from dired-x.el (autoload 'dired-jump "dired-x" "\ diff --git a/lisp/disp-table.el b/lisp/disp-table.el index 286c8f319ff..e9bdd3d9be3 100644 --- a/lisp/disp-table.el +++ b/lisp/disp-table.el @@ -7,6 +7,7 @@ ;; Based on a previous version by Howard Gayle ;; Maintainer: FSF ;; Keywords: i18n +;; Package: emacs ;; This file is part of GNU Emacs. @@ -109,11 +110,27 @@ Valid symbols are `truncation', `wrap', `escape', `control', ;;;###autoload (defun standard-display-8bit (l h) - "Display characters in the range L to H literally." + "Display characters representing raw bytes in the range L to H literally. + +On a terminal display, each character in the range is displayed +by sending the corresponding byte directly to the terminal. + +On a graphic display, each character in the range is displayed +using the default font by a glyph whose code is the corresponding +byte. + +Note that ASCII printable characters (SPC to TILDA) are displayed +in the default way after this call." (or standard-display-table (setq standard-display-table (make-display-table))) + (if (> h 255) + (setq h 255)) (while (<= l h) - (aset standard-display-table l (if (or (< l ?\s) (>= l 127)) (vector l))) + (if (< l 128) + (aset standard-display-table l + (if (or (< l ?\s) (= l 127)) (vector l))) + (let ((c (unibyte-char-to-multibyte l))) + (aset standard-display-table c (vector c)))) (setq l (1+ l)))) ;;;###autoload @@ -235,9 +252,12 @@ in `.emacs'." (and (null arg) (char-table-p standard-display-table) ;; Test 161, because 160 displays as a space. - (equal (aref standard-display-table 161) [161]))) + (equal (aref standard-display-table + (unibyte-char-to-multibyte 161)) + (vector (unibyte-char-to-multibyte 161))))) (progn - (standard-display-default 160 255) + (standard-display-default + (unibyte-char-to-multibyte 160) (unibyte-char-to-multibyte 255)) (unless (or (memq window-system '(x w32 ns))) (and (terminal-coding-system) (set-terminal-coding-system nil)))) diff --git a/lisp/dnd.el b/lisp/dnd.el index d7cbb641bab..7b9d0c0786c 100644 --- a/lisp/dnd.el +++ b/lisp/dnd.el @@ -6,6 +6,7 @@ ;; Author: Jan Djärv <jan.h.d@swipnet.se> ;; Maintainer: FSF ;; Keywords: window, drag, drop +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el index e343446a366..b840319113d 100644 --- a/lisp/dos-fns.el +++ b/lisp/dos-fns.el @@ -5,6 +5,7 @@ ;; Maintainer: Morten Welinder <terra@diku.dk> ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/dos-vars.el b/lisp/dos-vars.el index 8af147e78f6..e153df3e743 100644 --- a/lisp/dos-vars.el +++ b/lisp/dos-vars.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el index 424ea0a701d..0962ae5f13a 100644 --- a/lisp/dos-w32.el +++ b/lisp/dos-w32.el @@ -5,6 +5,7 @@ ;; Maintainer: Geoff Voelker <voelker@cs.washington.edu> ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/dynamic-setting.el b/lisp/dynamic-setting.el index f61a0078e17..cfa1053c44d 100644 --- a/lisp/dynamic-setting.el +++ b/lisp/dynamic-setting.el @@ -5,6 +5,7 @@ ;; Author: Jan Djärv <jan.h.d@swipnet.se> ;; Maintainer: FSF ;; Keywords: font, system-font, tool-bar-style +;; Package: emacs ;; This file is part of GNU Emacs. @@ -96,6 +97,11 @@ Changes can be ((eq type 'font-render) (font-setting-change-default-font display-name nil)) + ;; This is a bit heavy, ideally we would just clear faces + ;; on the affected display, and perhaps only the relevant + ;; faces. Oh well. + ((eq type 'theme-name) (clear-face-cache)) + ((eq type 'tool-bar-style) (force-mode-line-update t))))) (define-key special-event-map [config-changed-event] diff --git a/lisp/electric.el b/lisp/electric.el index fb3e462efba..8e9d23be231 100644 --- a/lisp/electric.el +++ b/lisp/electric.el @@ -24,10 +24,23 @@ ;;; Commentary: -; zaaaaaaap +;; "Electric" has been used in Emacs to refer to different things. +;; Among them: +;; +;; - electric modes and buffers: modes that typically pop-up in a modal kind of +;; way a transient buffer that automatically disappears as soon as the user +;; is done with it. +;; +;; - electric keys: self inserting keys which additionally perform some side +;; operation which happens to be often convenient at that time. Examples of +;; such side operations are: reindenting code, inserting a newline, +;; ... auto-fill-mode and abbrev-mode can be considered as built-in forms of +;; electric key behavior. ;;; Code: +(eval-when-compile (require 'cl)) + ;; This loop is the guts for non-standard modes which retain control ;; until some event occurs. It is a `do-forever', the only way out is ;; to throw. It assumes that you have set up the keymap, window, and @@ -157,6 +170,135 @@ (fit-window-to-buffer win max-height)) win))) +;;; Electric keys. + +(defgroup electricity () + "Electric behavior for self inserting keys." + :group 'editing) + +;; Electric indentation. + +(defvar electric-indent-chars '(?\n) + "Characters that should cause automatic reindentation.") + +(defun electric-indent-post-self-insert-function () + ;; FIXME: This reindents the current line, but what we really want instead is + ;; to reindent the whole affected text. That's the current line for simple + ;; cases, but not all cases. We do take care of the newline case in an + ;; ad-hoc fashion, but there are still missing cases such as the case of + ;; electric-pair-mode wrapping a region with a pair of parens. + ;; There might be a way to get it working by analyzing buffer-undo-list, but + ;; it looks challenging. + (when (and (memq last-command-event electric-indent-chars) + ;; Don't reindent while inserting spaces at beginning of line. + (or (not (memq last-command-event '(?\s ?\t))) + (save-excursion (skip-chars-backward " \t") (not (bolp)))) + ;; Not in a string or comment. + (not (nth 8 (syntax-ppss)))) + ;; For newline, we want to reindent both lines and basically behave like + ;; reindent-then-newline-and-indent (whose code we hence copied). + (when (and (eq last-command-event ?\n) + ;; Don't reindent the previous line if the indentation function + ;; is not a real one. + (not (memq indent-line-function + '(indent-relative indent-relative-maybe))) + ;; Sanity check. + (eq (char-before) last-command-event)) + (let ((pos (copy-marker (1- (point)) t))) + (save-excursion + (goto-char pos) + (indent-according-to-mode) + ;; We are at EOL before the call to indent-according-to-mode, and + ;; after it we usually are as well, but not always. We tried to + ;; address it with `save-excursion' but that uses a normal marker + ;; whereas we need `move after insertion', so we do the + ;; save/restore by hand. + (goto-char pos) + ;; Remove the trailing whitespace after indentation because + ;; indentation may (re)introduce the whitespace. + (delete-horizontal-space t)))) + (indent-according-to-mode))) + +;;;###autoload +(define-minor-mode electric-indent-mode + "Automatically reindent lines of code when inserting particular chars. +`electric-indent-chars' specifies the set of chars that should cause reindentation." + :global t + :group 'electricity + (if electric-indent-mode + (add-hook 'post-self-insert-hook + #'electric-indent-post-self-insert-function) + (remove-hook 'post-self-insert-hook + #'electric-indent-post-self-insert-function))) + +;; Electric pairing. + +(defcustom electric-pair-skip-self t + "If non-nil, skip char instead of inserting a second closing paren. +When inserting a closing paren character right before the same character, +just skip that character instead, so that hitting ( followed by ) results +in \"()\" rather than \"())\". +This can be convenient for people who find it easier to hit ) than C-f." + :type 'boolean) + +(defun electric-pair-post-self-insert-function () + (let* ((syntax (and (eq (char-before) last-command-event) ; Sanity check. + (char-syntax last-command-event))) + ;; FIXME: when inserting the closer, we should maybe use + ;; self-insert-command, although it may prove tricky running + ;; post-self-insert-hook recursively, and we wouldn't want to trigger + ;; blink-matching-open. + (closer (if (eq syntax ?\() + (cdr (aref (syntax-table) last-command-event)) + last-command-event))) + (cond + ;; Wrap a pair around the active region. + ((and (memq syntax '(?\( ?\" ?\$)) (use-region-p)) + (if (> (mark) (point)) + (goto-char (mark)) + ;; We already inserted the open-paren but at the end of the region, + ;; so we have to remove it and start over. + (delete-char -1) + (save-excursion + (goto-char (mark)) + (insert last-command-event))) + (insert closer)) + ;; Backslash-escaped: no pairing, no skipping. + ((save-excursion + (goto-char (1- (point))) + (not (zerop (% (skip-syntax-backward "\\") 2)))) + nil) + ;; Skip self. + ((and (memq syntax '(?\) ?\" ?\$)) + electric-pair-skip-self + (eq (char-after) last-command-event)) + ;; This is too late: rather than insert&delete we'd want to only skip (or + ;; insert in overwrite mode). The difference is in what goes in the + ;; undo-log and in the intermediate state which might be visible to other + ;; post-self-insert-hook. We'll just have to live with it for now. + (delete-char 1)) + ;; Insert matching pair. + ((not (or (not (memq syntax `(?\( ?\" ?\$))) + overwrite-mode + ;; I find it more often preferable not to pair when the + ;; same char is next. + (eq last-command-event (char-after)) + (eq last-command-event (char-before (1- (point)))) + ;; I also find it often preferable not to pair next to a word. + (eq (char-syntax (following-char)) ?w))) + (save-excursion (insert closer)))))) + +;;;###autoload +(define-minor-mode electric-pair-mode + "Automatically pair-up parens when inserting an open paren." + :global t + :group 'electricity + (if electric-pair-mode + (add-hook 'post-self-insert-hook + #'electric-pair-post-self-insert-function) + (remove-hook 'post-self-insert-hook + #'electric-pair-post-self-insert-function))) + (provide 'electric) ;; arch-tag: dae045eb-dc2d-4fb7-9f27-9cc2ce277be8 diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 9267bc8ac91..578e0877d30 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -7,6 +7,7 @@ ;; Maintainer: FSF ;; Created: 12 Dec 1992 ;; Keywords: extensions, lisp, tools +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/authors.el b/lisp/emacs-lisp/authors.el index 5aea033fc78..3bfa076d71c 100644 --- a/lisp/emacs-lisp/authors.el +++ b/lisp/emacs-lisp/authors.el @@ -6,6 +6,7 @@ ;; Author: Gerd Moellmann <gerd@gnu.org> ;; Maintainer: Kim F. Storm <storm@cua.dk> ;; Keywords: maint +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index c5316d06429..30c384aff91 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -6,6 +6,7 @@ ;; Author: Roland McGrath <roland@gnu.org> ;; Keywords: maint +;; Package: emacs ;; This file is part of GNU Emacs. @@ -109,29 +110,48 @@ or macro definition or a defcustom)." (let* ((macrop (memq car '(defmacro defmacro*))) (name (nth 1 form)) (args (case car - ((defun defmacro defun* defmacro* - define-overloadable-function) (nth 2 form)) - ((define-skeleton) '(&optional str arg)) - ((define-generic-mode define-derived-mode - define-compilation-mode) nil) - (t))) + ((defun defmacro defun* defmacro* + define-overloadable-function) (nth 2 form)) + ((define-skeleton) '(&optional str arg)) + ((define-generic-mode define-derived-mode + define-compilation-mode) nil) + (t))) (body (nthcdr (get car 'doc-string-elt) form)) (doc (if (stringp (car body)) (pop body)))) (when (listp args) ;; Add the usage form at the end where describe-function-1 ;; can recover it. (setq doc (help-add-fundoc-usage doc args))) - ;; `define-generic-mode' quotes the name, so take care of that - (list 'autoload (if (listp name) name (list 'quote name)) file doc - (or (and (memq car '(define-skeleton define-derived-mode - define-generic-mode - easy-mmode-define-global-mode - define-global-minor-mode - define-globalized-minor-mode - easy-mmode-define-minor-mode - define-minor-mode)) t) - (eq (car-safe (car body)) 'interactive)) - (if macrop (list 'quote 'macro) nil)))) + (let ((exp + ;; `define-generic-mode' quotes the name, so take care of that + (list 'autoload (if (listp name) name (list 'quote name)) + file doc + (or (and (memq car '(define-skeleton define-derived-mode + define-generic-mode + easy-mmode-define-global-mode + define-global-minor-mode + define-globalized-minor-mode + easy-mmode-define-minor-mode + define-minor-mode)) t) + (eq (car-safe (car body)) 'interactive)) + (if macrop (list 'quote 'macro) nil)))) + (when macrop + ;; Special case to autoload some of the macro's declarations. + (let ((decls (nth (if (stringp (nth 3 form)) 4 3) form)) + (exps '())) + (when (eq (car decls) 'declare) + ;; FIXME: We'd like to reuse macro-declaration-function, + ;; but we can't since it doesn't return anything. + (dolist (decl decls) + (case (car-safe decl) + (indent + (push `(put ',name 'lisp-indent-function ',(cadr decl)) + exps)) + (doc-string + (push `(put ',name 'doc-string-elt ',(cadr decl)) exps)))) + (when exps + (setq exp `(progn ,exp ,@exps)))))) + exp))) ;; For defclass forms, use `eieio-defclass-autoload'. ((eq car 'defclass) diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el index 998cee15342..96e2fb41e89 100644 --- a/lisp/emacs-lisp/backquote.el +++ b/lisp/emacs-lisp/backquote.el @@ -6,6 +6,7 @@ ;; Author: Rick Sladkey <jrs@world.std.com> ;; Maintainer: FSF ;; Keywords: extensions, internal +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 4c0094dd78b..9ce3c2eb323 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -7,6 +7,7 @@ ;; Hallvard Furuseth <hbf@ulrik.uio.no> ;; Maintainer: FSF ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index dbbf057ae22..6ce141eb8e6 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -7,6 +7,7 @@ ;; Hallvard Furuseth <hbf@ulrik.uio.no> ;; Maintainer: FSF ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. @@ -65,7 +66,6 @@ The return value of this function is not used." ;; Redefined in byte-optimize.el. ;; This is not documented--it's not clear that we should promote it. (fset 'inline 'progn) -(put 'inline 'lisp-indent-function 0) ;;; Interface to inline functions. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index df93528683c..e1b5b402b28 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1,12 +1,14 @@ ;;; bytecomp.el --- compilation of Lisp code into byte code ;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002, -;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;; Free Software Foundation, Inc. ;; Author: Jamie Zawinski <jwz@lucid.com> ;; Hallvard Furuseth <hbf@ulrik.uio.no> ;; Maintainer: FSF ;; Keywords: lisp +;; Package: emacs ;; This file is part of GNU Emacs. @@ -1665,6 +1667,9 @@ that already has a `.elc' file." (if (and (string-match emacs-lisp-file-regexp bytecomp-source) (file-readable-p bytecomp-source) (not (auto-save-file-name-p bytecomp-source)) + (not (string-equal dir-locals-file + (file-name-nondirectory + bytecomp-source))) (setq bytecomp-dest (byte-compile-dest-file bytecomp-source)) (if (file-exists-p bytecomp-dest) @@ -1811,17 +1816,25 @@ The value is non-nil if there were no errors, nil if errors." (insert "\n") ; aaah, unix. (if (file-writable-p target-file) ;; We must disable any code conversion here. - (let ((coding-system-for-write 'no-conversion)) + (let ((coding-system-for-write 'no-conversion) + ;; Write to a tempfile so that if another Emacs + ;; process is trying to load target-file (eg in a + ;; parallel bootstrap), it does not risk getting a + ;; half-finished file. (Bug#4196) + (tempfile (make-temp-name target-file))) (if (memq system-type '(ms-dos 'windows-nt)) (setq buffer-file-type t)) - (when (file-exists-p target-file) - ;; Remove the target before writing it, so that any - ;; hard-links continue to point to the old file (this makes - ;; it possible for installed files to share disk space with - ;; the build tree, without causing problems when emacs-lisp - ;; files in the build tree are recompiled). - (delete-file target-file)) - (write-region (point-min) (point-max) target-file)) + (write-region (point-min) (point-max) tempfile nil 1) + ;; This has the intentional side effect that any + ;; hard-links to target-file continue to + ;; point to the old file (this makes it possible + ;; for installed files to share disk space with + ;; the build tree, without causing problems when + ;; emacs-lisp files in the build tree are + ;; recompiled). Previously this was accomplished by + ;; deleting target-file before writing it. + (rename-file tempfile target-file t) + (message "Wrote %s" target-file)) ;; This is just to give a better error message than write-region (signal 'file-error (list "Opening output file" @@ -4648,6 +4661,8 @@ and corresponding effects." (defvar byte-code-meter) (defun byte-compile-report-ops () + (or (boundp 'byte-metering-on) + (error "You must build Emacs with -DBYTE_CODE_METER to use this")) (with-output-to-temp-buffer "*Meter*" (set-buffer "*Meter*") (let ((i 0) n op off) diff --git a/lisp/emacs-lisp/cl-compat.el b/lisp/emacs-lisp/cl-compat.el index 68d7c0ae3ba..f4923b6f8c6 100644 --- a/lisp/emacs-lisp/cl-compat.el +++ b/lisp/emacs-lisp/cl-compat.el @@ -6,6 +6,7 @@ ;; Author: Dave Gillespie <daveg@synaptics.com> ;; Version: 2.02 ;; Keywords: extensions +;; Package: emacs ;; This file is part of GNU Emacs. @@ -70,11 +71,6 @@ ;;; by capitalizing the first letter: Values, Multiple-value-*, ;;; to avoid conflict with the new-style definitions in cl-macs. -(put 'Multiple-value-bind 'lisp-indent-function 2) -(put 'Multiple-value-setq 'lisp-indent-function 2) -(put 'Multiple-value-call 'lisp-indent-function 1) -(put 'Multiple-value-prog1 'lisp-indent-function 1) - (defvar *mvalues-values* nil) (defun Values (&rest val-forms) @@ -90,18 +86,22 @@ (list *mvalues-temp*)))) (defmacro Multiple-value-call (function &rest args) + (declare (indent 1)) (list 'apply function (cons 'append (mapcar (function (lambda (x) (list 'Multiple-value-list x))) args)))) (defmacro Multiple-value-bind (vars form &rest body) + (declare (indent 2)) (list* 'multiple-value-bind vars (list 'Multiple-value-list form) body)) (defmacro Multiple-value-setq (vars form) + (declare (indent 2)) (list 'multiple-value-setq vars (list 'Multiple-value-list form))) (defmacro Multiple-value-prog1 (form &rest body) + (declare (indent 1)) (list 'prog1 form (list* 'let '((*mvalues-values* nil)) body))) diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index c6aae373589..b7c908882ed 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -5,6 +5,7 @@ ;; Author: Dave Gillespie <daveg@synaptics.com> ;; Keywords: extensions +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el index e4f605d4fd0..4e7ada8851f 100644 --- a/lisp/emacs-lisp/cl-indent.el +++ b/lisp/emacs-lisp/cl-indent.el @@ -7,6 +7,7 @@ ;; Created: July 1987 ;; Maintainer: FSF ;; Keywords: lisp, tools +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index b14c879fcf7..db2ae88b8b7 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -10,7 +10,7 @@ ;;;;;; ceiling* floor* isqrt lcm gcd cl-progv-before cl-set-frame-visible-p ;;;;;; cl-map-overlays cl-map-intervals cl-map-keymap-recursively ;;;;;; notevery notany every some mapcon mapcan mapl maplist map -;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "deb3495d75c36a222e5238eadb8e347c") +;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "20c8c875ff1d11dd819e15a1f25afd73") ;;; Generated autoloads from cl-extra.el (autoload 'coerce "cl-extra" "\ @@ -277,12 +277,12 @@ Not documented ;;;;;; assert check-type typep deftype cl-struct-setf-expander defstruct ;;;;;; define-modify-macro callf2 callf letf* letf rotatef shiftf ;;;;;; remf cl-do-pop psetf setf get-setf-method defsetf define-setf-method -;;;;;; declare the locally multiple-value-setq multiple-value-bind -;;;;;; lexical-let* lexical-let symbol-macrolet macrolet labels -;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist -;;;;;; do* do loop return-from return block etypecase typecase ecase -;;;;;; case load-time-value eval-when destructuring-bind function* -;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "36cafd5054969b5bb0b1ce6a21605fed") +;;;;;; declare locally multiple-value-setq multiple-value-bind lexical-let* +;;;;;; lexical-let symbol-macrolet macrolet labels flet progv psetq +;;;;;; do-all-symbols do-symbols dotimes dolist do* do loop return-from +;;;;;; return block etypecase typecase ecase case load-time-value +;;;;;; eval-when destructuring-bind function* defmacro* defun* gentemp +;;;;;; gensym) "cl-macs" "cl-macs.el" "c10b5cbebb5267291ef15c782c0271a6") ;;; Generated autoloads from cl-macs.el (autoload 'gensym "cl-macs" "\ @@ -535,11 +535,6 @@ Not documented \(fn &rest BODY)" nil (quote macro)) -(autoload 'the "cl-macs" "\ -Not documented - -\(fn TYPE FORM)" nil (quote macro)) - (autoload 'declare "cl-macs" "\ Not documented @@ -759,7 +754,7 @@ surrounded by (block NAME ...). ;;;;;; find nsubstitute-if-not nsubstitute-if nsubstitute substitute-if-not ;;;;;; substitute-if substitute delete-duplicates remove-duplicates ;;;;;; delete-if-not delete-if delete* remove-if-not remove-if remove* -;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "ec3ea1c77742734db8496272fe5721be") +;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "7b7531276ddf8457abecdd487d3cf0b7") ;;; Generated autoloads from cl-seq.el (autoload 'reduce "cl-seq" "\ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 694a06f8338..f6d66c64c7a 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -6,6 +6,7 @@ ;; Author: Dave Gillespie <daveg@synaptics.com> ;; Version: 2.02 ;; Keywords: extensions +;; Package: emacs ;; This file is part of GNU Emacs. @@ -1818,8 +1819,6 @@ Example: (defsetf window-start set-window-start) (defsetf window-width () (store) (list 'progn (list 'enlarge-window (list '- store '(window-width)) t) store)) -(defsetf x-get-cutbuffer x-store-cutbuffer t) -(defsetf x-get-cut-buffer x-store-cut-buffer t) ; groan. (defsetf x-get-secondary-selection x-own-secondary-selection t) (defsetf x-get-selection x-own-selection t) diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index a823e9015db..a5070e4acea 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el @@ -6,6 +6,7 @@ ;; Author: Dave Gillespie <daveg@synaptics.com> ;; Version: 2.02 ;; Keywords: extensions +;; Package: emacs ;; This file is part of GNU Emacs. @@ -47,6 +48,7 @@ ;;; this file independent from cl-macs. (defmacro cl-parsing-keywords (kwords other-keys &rest body) + (declare (indent 2) (debug (sexp sexp &rest form))) (cons 'let* (cons (mapcar @@ -83,13 +85,13 @@ (car cl-keys-temp))) '(setq cl-keys-temp (cdr (cdr cl-keys-temp))))))) body)))) -(put 'cl-parsing-keywords 'lisp-indent-function 2) -(put 'cl-parsing-keywords 'edebug-form-spec '(sexp sexp &rest form)) (defmacro cl-check-key (x) + (declare (debug edebug-forms)) (list 'if 'cl-key (list 'funcall 'cl-key x) x)) (defmacro cl-check-test-nokey (item x) + (declare (debug edebug-forms)) (list 'cond (list 'cl-test (list 'eq (list 'not (list 'funcall 'cl-test item x)) @@ -100,20 +102,17 @@ (list 'equal item x) (list 'eq item x))))) (defmacro cl-check-test (item x) + (declare (debug edebug-forms)) (list 'cl-check-test-nokey item (list 'cl-check-key x))) (defmacro cl-check-match (x y) + (declare (debug edebug-forms)) (setq x (list 'cl-check-key x) y (list 'cl-check-key y)) (list 'if 'cl-test (list 'eq (list 'not (list 'funcall 'cl-test x y)) 'cl-test-not) (list 'if (list 'numberp x) (list 'equal x y) (list 'eq x y)))) -(put 'cl-check-key 'edebug-form-spec 'edebug-forms) -(put 'cl-check-test 'edebug-form-spec 'edebug-forms) -(put 'cl-check-test-nokey 'edebug-form-spec 'edebug-forms) -(put 'cl-check-match 'edebug-form-spec 'edebug-forms) - (defvar cl-test) (defvar cl-test-not) (defvar cl-if) (defvar cl-if-not) (defvar cl-key) diff --git a/lisp/emacs-lisp/cl-specs.el b/lisp/emacs-lisp/cl-specs.el index acfd3504ec7..776ce5e9ca1 100644 --- a/lisp/emacs-lisp/cl-specs.el +++ b/lisp/emacs-lisp/cl-specs.el @@ -4,6 +4,7 @@ ;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Daniel LaLiberte <liberte@holonexus.org> ;; Keywords: lisp, tools, maint +;; Package: emacs ;; LCD Archive Entry: ;; cl-specs.el|Daniel LaLiberte|liberte@holonexus.org diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el index 6f7a43af844..43eb61b0bee 100644 --- a/lisp/emacs-lisp/copyright.el +++ b/lisp/emacs-lisp/copyright.el @@ -158,13 +158,15 @@ When this is `function', only ask when called non-interactively." (unless (string= (buffer-substring (- (match-end 3) 2) (match-end 3)) (substring copyright-current-year -2)) (if (or noquery - ;; Fixes some point-moving oddness (bug#2209). - (save-excursion - (y-or-n-p (if replace - (concat "Replace copyright year(s) by " - copyright-current-year "? ") - (concat "Add " copyright-current-year - " to copyright? "))))) + (save-window-excursion + (switch-to-buffer (current-buffer)) + ;; Fixes some point-moving oddness (bug#2209). + (save-excursion + (y-or-n-p (if replace + (concat "Replace copyright year(s) by " + copyright-current-year "? ") + (concat "Add " copyright-current-year + " to copyright? ")))))) (if replace (replace-match copyright-current-year t t nil 3) (let ((size (save-excursion (skip-chars-backward "0-9")))) @@ -224,8 +226,10 @@ version \\([0-9]+\\), or (at" (string-to-number copyright-current-gpl-version)) (or noquery (save-match-data - (y-or-n-p (format "Replace GPL version by %s? " - copyright-current-gpl-version)))) + (save-window-excursion + (switch-to-buffer (current-buffer)) + (y-or-n-p (format "Replace GPL version by %s? " + copyright-current-gpl-version))))) (progn (if (match-end 2) ;; Esperanto bilingual comment in two-column.el diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index b8ff3c03ee9..17fcf7ad6c5 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -514,9 +514,9 @@ Applies to the frame whose line point is on in the backtrace." (insert ? ))) (beginning-of-line)) -(put 'debugger-env-macro 'lisp-indent-function 0) (defmacro debugger-env-macro (&rest body) "Run BODY in original environment." + (declare (indent 0)) `(save-excursion (if (null (buffer-name debugger-old-buffer)) ;; old buffer deleted diff --git a/lisp/emacs-lisp/derived.el b/lisp/emacs-lisp/derived.el index d6f717ccda7..3456d1a63fb 100644 --- a/lisp/emacs-lisp/derived.el +++ b/lisp/emacs-lisp/derived.el @@ -7,6 +7,7 @@ ;; Author: David Megginson (dmeggins@aix1.uottawa.ca) ;; Maintainer: FSF ;; Keywords: extensions +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/easy-mmode.el b/lisp/emacs-lisp/easy-mmode.el index 5a21946183e..e11572dfc62 100644 --- a/lisp/emacs-lisp/easy-mmode.el +++ b/lisp/emacs-lisp/easy-mmode.el @@ -5,6 +5,7 @@ ;; Author: Georges Brun-Cottan <Georges.Brun-Cottan@inria.fr> ;; Maintainer: Stefan Monnier <monnier@gnu.org> +;; Package: emacs ;; Keywords: extensions lisp @@ -86,25 +87,23 @@ replacing its case-insensitive matches with the literal string in LIGHTER." ;;;###autoload (defmacro define-minor-mode (mode doc &optional init-value lighter keymap &rest body) "Define a new minor mode MODE. -This function defines the associated control variable MODE, keymap MODE-map, -and toggle command MODE. - +This defines the control variable MODE and the toggle command MODE. DOC is the documentation for the mode toggle command. + Optional INIT-VALUE is the initial value of the mode's variable. Optional LIGHTER is displayed in the modeline when the mode is on. -Optional KEYMAP is the default (defvar) keymap bound to the mode keymap. - If it is a list, it is passed to `easy-mmode-define-keymap' - in order to build a valid keymap. It's generally better to use - a separate MODE-map variable than to use this argument. -The above three arguments can be skipped if keyword arguments are -used (see below). - -BODY contains code to execute each time the mode is activated or deactivated. - It is executed after toggling the mode, - and before running the hook variable `MODE-hook'. - Before the actual body code, you can write keyword arguments (alternating - keywords and values). These following keyword arguments are supported (other - keywords will be passed to `defcustom' if the minor mode is global): +Optional KEYMAP is the default keymap bound to the mode keymap. + If non-nil, it should be a variable name (whose value is a keymap), + a keymap, or a list of arguments for `easy-mmode-define-keymap'. + If KEYMAP is a keymap or list, this also defines the variable MODE-map. + +BODY contains code to execute each time the mode is enabled or disabled. + It is executed after toggling the mode, and before running MODE-hook. + Before the actual body code, you can write keyword arguments, i.e. + alternating keywords and values. These following special keywords + are supported (other keywords are passed to `defcustom' if the minor + mode is global): + :group GROUP Custom group name to use in all generated `defcustom' forms. Defaults to MODE without the possible trailing \"-mode\". Don't use this default group name unless you have written a diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el index 470f0f67779..9992861fc3c 100644 --- a/lisp/emacs-lisp/easymenu.el +++ b/lisp/emacs-lisp/easymenu.el @@ -5,6 +5,7 @@ ;; Keywords: emulations ;; Author: Richard Stallman <rms@gnu.org> +;; Package: emacs ;; This file is part of GNU Emacs. @@ -43,8 +44,6 @@ menus, turn this variable off, otherwise it is probably better to keep it on.") (if (stringp s) (intern s) s)) ;;;###autoload -(put 'easy-menu-define 'lisp-indent-function 'defun) -;;;###autoload (defmacro easy-menu-define (symbol maps doc menu) "Define a menu bar submenu in maps MAPS, according to MENU. @@ -150,6 +149,7 @@ unselectable text. A string consisting solely of hyphens is displayed as a solid horizontal line. A menu item can be a list with the same format as MENU. This is a submenu." + (declare (indent defun)) `(progn ,(if symbol `(defvar ,symbol nil ,doc)) (easy-menu-do-define (quote ,symbol) ,maps ,doc ,menu))) diff --git a/lisp/emacs-lisp/eieio-base.el b/lisp/emacs-lisp/eieio-base.el index b573af29ee2..91cb5642fb7 100644 --- a/lisp/emacs-lisp/eieio-base.el +++ b/lisp/emacs-lisp/eieio-base.el @@ -6,6 +6,7 @@ ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Version: 0.2 ;; Keywords: OO, lisp +;; Package: eieio ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/eieio-comp.el b/lisp/emacs-lisp/eieio-comp.el index a2b955a280b..0e76f4bb331 100644 --- a/lisp/emacs-lisp/eieio-comp.el +++ b/lisp/emacs-lisp/eieio-comp.el @@ -5,7 +5,8 @@ ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Version: 0.2 -;; Keywords: oop, lisp, tools +;; Keywords: lisp, tools +;; Package: eieio ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el index 268d60fc196..12ff23b311f 100644 --- a/lisp/emacs-lisp/eieio-custom.el +++ b/lisp/emacs-lisp/eieio-custom.el @@ -6,6 +6,7 @@ ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Version: 0.2 ;; Keywords: OO, lisp +;; Package: eieio ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/eieio-datadebug.el b/lisp/emacs-lisp/eieio-datadebug.el index 5dc54f5c35e..b58fbfd3f08 100644 --- a/lisp/emacs-lisp/eieio-datadebug.el +++ b/lisp/emacs-lisp/eieio-datadebug.el @@ -4,6 +4,7 @@ ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Keywords: OO, lisp +;; Package: eieio ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index 375ce0bc6d6..ca3850562c8 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el @@ -6,6 +6,7 @@ ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Version: 0.2 ;; Keywords: OO, lisp +;; Package: eieio ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/eieio-speedbar.el b/lisp/emacs-lisp/eieio-speedbar.el index e4c1c50aa8f..e16c3a17438 100644 --- a/lisp/emacs-lisp/eieio-speedbar.el +++ b/lisp/emacs-lisp/eieio-speedbar.el @@ -6,6 +6,7 @@ ;; Author: Eric M. Ludlam <zappo@gnu.org> ;; Version: 0.2 ;; Keywords: OO, tools +;; Package: eieio ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index f5e684e1323..34fb5b9c9fc 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -1610,6 +1610,7 @@ SPEC-LIST is of a form similar to `let'. For example: Where each VAR is the local variable given to the associated SLOT. A slot specified without a variable name is given a variable name of the same name as the slot." + (declare (indent 2)) ;; Transform the spec-list into a symbol-macrolet spec-list. (let ((mappings (mapcar (lambda (entry) (let ((var (if (listp entry) (car entry) entry)) @@ -1618,8 +1619,6 @@ variable name of the same name as the slot." spec-list))) (append (list 'symbol-macrolet mappings) body))) -(put 'with-slots 'lisp-indent-function 2) - ;;; Simple generators, and query functions. None of these would do ;; well embedded into an object. diff --git a/lisp/emacs-lisp/float-sup.el b/lisp/emacs-lisp/float-sup.el index 6a05bda82ae..6bdc9073ddf 100644 --- a/lisp/emacs-lisp/float-sup.el +++ b/lisp/emacs-lisp/float-sup.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/generic.el b/lisp/emacs-lisp/generic.el index b6e8427ea1c..51b23c3f402 100644 --- a/lisp/emacs-lisp/generic.el +++ b/lisp/emacs-lisp/generic.el @@ -6,6 +6,7 @@ ;; Author: Peter Breton <pbreton@cs.umb.edu> ;; Created: Fri Sep 27 1996 ;; Keywords: generic, comment, font-lock +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/helper.el b/lisp/emacs-lisp/helper.el index b7cb8b93c2f..6a597429328 100644 --- a/lisp/emacs-lisp/helper.el +++ b/lisp/emacs-lisp/helper.el @@ -6,6 +6,7 @@ ;; Author: K. Shane Hartman ;; Maintainer: FSF ;; Keywords: help +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el index 10b7baf294f..7df65acb283 100644 --- a/lisp/emacs-lisp/lisp-mnt.el +++ b/lisp/emacs-lisp/lisp-mnt.el @@ -298,6 +298,7 @@ The returned value is a list of strings, one per line." (defmacro lm-with-file (file &rest body) "Execute BODY in a buffer containing the contents of FILE. If FILE is nil, execute BODY in the current buffer." + (declare (indent 1) (debug t)) (let ((filesym (make-symbol "file"))) `(let ((,filesym ,file)) (if ,filesym @@ -311,9 +312,6 @@ If FILE is nil, execute BODY in the current buffer." (with-syntax-table emacs-lisp-mode-syntax-table ,@body)))))) -(put 'lm-with-file 'lisp-indent-function 1) -(put 'lm-with-file 'edebug-form-spec t) - ;; Fixme: Probably this should be amalgamated with copyright.el; also ;; we need a check for ranges in copyright years. diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 1185f79806f..b4ac0eebf6d 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: lisp, languages +;; Package: emacs ;; This file is part of GNU Emacs. @@ -85,7 +86,7 @@ (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table))) (modify-syntax-entry ?\[ "_ " table) (modify-syntax-entry ?\] "_ " table) - (modify-syntax-entry ?# "' 14b" table) + (modify-syntax-entry ?# "' 14" table) (modify-syntax-entry ?| "\" 23bn" table) table) "Syntax table used in `lisp-mode'.") @@ -1217,31 +1218,17 @@ This function also returns nil meaning don't specify the indentation." (put 'prog2 'lisp-indent-function 2) (put 'save-excursion 'lisp-indent-function 0) (put 'save-window-excursion 'lisp-indent-function 0) -(put 'save-selected-window 'lisp-indent-function 0) (put 'save-restriction 'lisp-indent-function 0) (put 'save-match-data 'lisp-indent-function 0) (put 'save-current-buffer 'lisp-indent-function 0) -(put 'with-current-buffer 'lisp-indent-function 1) -(put 'combine-after-change-calls 'lisp-indent-function 0) -(put 'with-output-to-string 'lisp-indent-function 0) -(put 'with-temp-file 'lisp-indent-function 1) -(put 'with-temp-buffer 'lisp-indent-function 0) -(put 'with-temp-message 'lisp-indent-function 1) -(put 'with-syntax-table 'lisp-indent-function 1) (put 'let 'lisp-indent-function 1) (put 'let* 'lisp-indent-function 1) (put 'while 'lisp-indent-function 1) (put 'if 'lisp-indent-function 2) -(put 'read-if 'lisp-indent-function 2) (put 'catch 'lisp-indent-function 1) (put 'condition-case 'lisp-indent-function 2) (put 'unwind-protect 'lisp-indent-function 1) (put 'with-output-to-temp-buffer 'lisp-indent-function 1) -(put 'eval-after-load 'lisp-indent-function 1) -(put 'dolist 'lisp-indent-function 1) -(put 'dotimes 'lisp-indent-function 1) -(put 'when 'lisp-indent-function 1) -(put 'unless 'lisp-indent-function 1) (defun indent-sexp (&optional endpos) "Indent each line of the list starting just after point. diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 4ef6dab8968..e799dcd77c1 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: lisp, languages +;; Package: emacs ;; This file is part of GNU Emacs. @@ -142,7 +143,13 @@ This command assumes point is not in a string or comment." (or arg (setq arg 1)) (let ((inc (if (> arg 0) 1 -1))) (while (/= arg 0) - (goto-char (or (scan-lists (point) inc 1) (buffer-end arg))) + (if forward-sexp-function + (condition-case err + (while (let ((pos (point))) + (forward-sexp inc) + (/= (point) pos))) + (scan-error (goto-char (nth 2 err)))) + (goto-char (or (scan-lists (point) inc 1) (buffer-end arg)))) (setq arg (- arg inc))))) (defun kill-sexp (&optional arg) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 876b9a468ac..6dfd47b4ad1 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -52,6 +52,7 @@ possible (for instance, when BODY just returns VAR unchanged, the result will be eq to LIST). \(fn (VAR LIST) BODY...)" + (declare (indent 1)) (let ((var (car var+list)) (list (cadr var+list)) (shared (make-symbol "shared")) @@ -72,7 +73,6 @@ result will be eq to LIST). (push ,new-el ,unshared)) (setq ,tail (cdr ,tail))) (nconc (nreverse ,unshared) ,shared)))) -(put 'macroexp-accumulate 'lisp-indent-function 1) (defun macroexpand-all-forms (forms &optional skip) "Return FORMS with macros expanded. FORMS is a list of forms. @@ -107,80 +107,69 @@ Assumes the caller has bound `macroexpand-all-environment'." macroexpand-all-environment) ;; Normal form; get its expansion, and then expand arguments. (setq form (macroexpand form macroexpand-all-environment)) - (if (consp form) - (let ((fun (car form))) - (cond - ((eq fun 'cond) - (maybe-cons fun (macroexpand-all-clauses (cdr form)) form)) - ((eq fun 'condition-case) - (maybe-cons - fun - (maybe-cons (cadr form) - (maybe-cons (macroexpand-all-1 (nth 2 form)) - (macroexpand-all-clauses (nthcdr 3 form) 1) - (cddr form)) - (cdr form)) - form)) - ((eq fun 'defmacro) - (push (cons (cadr form) (cons 'lambda (cddr form))) - macroexpand-all-environment) - (macroexpand-all-forms form 3)) - ((eq fun 'defun) - (macroexpand-all-forms form 3)) - ((memq fun '(defvar defconst)) - (macroexpand-all-forms form 2)) - ((eq fun 'function) - (if (and (consp (cadr form)) (eq (car (cadr form)) 'lambda)) - (maybe-cons fun - (maybe-cons (macroexpand-all-forms (cadr form) 2) - nil - (cdr form)) - form) - form)) - ((memq fun '(let let*)) - (maybe-cons fun - (maybe-cons (macroexpand-all-clauses (cadr form) 1) - (macroexpand-all-forms (cddr form)) - (cdr form)) - form)) - ((eq fun 'quote) - form) - ((and (consp fun) (eq (car fun) 'lambda)) - ;; Embedded lambda in function position. - (maybe-cons (macroexpand-all-forms fun 2) - (macroexpand-all-forms (cdr form)) - form)) - ;; The following few cases are for normal function calls that - ;; are known to funcall one of their arguments. The byte - ;; compiler has traditionally handled these functions specially - ;; by treating a lambda expression quoted by `quote' as if it - ;; were quoted by `function'. We make the same transformation - ;; here, so that any code that cares about the difference will - ;; see the same transformation. - ;; First arg is a function: - ((and (memq fun '(apply mapcar mapatoms mapconcat mapc)) - (consp (cadr form)) - (eq (car (cadr form)) 'quote)) - ;; We don't use `maybe-cons' since there's clearly a change. - (cons fun - (cons (macroexpand-all-1 (cons 'function (cdr (cadr form)))) - (macroexpand-all-forms (cddr form))))) - ;; Second arg is a function: - ((and (eq fun 'sort) - (consp (nth 2 form)) - (eq (car (nth 2 form)) 'quote)) - ;; We don't use `maybe-cons' since there's clearly a change. - (cons fun - (cons (macroexpand-all-1 (cadr form)) - (cons (macroexpand-all-1 - (cons 'function (cdr (nth 2 form)))) - (macroexpand-all-forms (nthcdr 3 form)))))) - (t - ;; For everything else, we just expand each argument (for - ;; setq/setq-default this works alright because the variable names - ;; are symbols). - (macroexpand-all-forms form 1)))) - form))) + (pcase form + (`(cond . ,clauses) + (maybe-cons 'cond (macroexpand-all-clauses clauses) form)) + (`(condition-case . ,(or `(,err ,body . ,handlers) dontcare)) + (maybe-cons + 'condition-case + (maybe-cons err + (maybe-cons (macroexpand-all-1 body) + (macroexpand-all-clauses handlers 1) + (cddr form)) + (cdr form)) + form)) + (`(defmacro ,name . ,args-and-body) + (push (cons name (cons 'lambda args-and-body)) + macroexpand-all-environment) + (macroexpand-all-forms form 3)) + (`(defun . ,_) (macroexpand-all-forms form 3)) + (`(,(or `defvar `defconst) . ,_) (macroexpand-all-forms form 2)) + (`(function ,(and f `(lambda . ,_))) + (maybe-cons 'function + (maybe-cons (macroexpand-all-forms f 2) + nil + (cdr form)) + form)) + (`(,(or `function `quote) . ,_) form) + (`(,(and fun (or `let `let*)) . ,(or `(,bindings . ,body) dontcare)) + (maybe-cons fun + (maybe-cons (macroexpand-all-clauses bindings 1) + (macroexpand-all-forms body) + (cdr form)) + form)) + (`(,(and fun `(lambda . ,_)) . ,args) + ;; Embedded lambda in function position. + (maybe-cons (macroexpand-all-forms fun 2) + (macroexpand-all-forms args) + form)) + ;; The following few cases are for normal function calls that + ;; are known to funcall one of their arguments. The byte + ;; compiler has traditionally handled these functions specially + ;; by treating a lambda expression quoted by `quote' as if it + ;; were quoted by `function'. We make the same transformation + ;; here, so that any code that cares about the difference will + ;; see the same transformation. + ;; First arg is a function: + (`(,(and fun (or `apply `mapcar `mapatoms `mapconcat `mapc)) ',f . ,args) + ;; We don't use `maybe-cons' since there's clearly a change. + (cons fun + (cons (macroexpand-all-1 (list 'function f)) + (macroexpand-all-forms args)))) + ;; Second arg is a function: + (`(,(and fun (or `sort)) ,arg1 ',f . ,args) + ;; We don't use `maybe-cons' since there's clearly a change. + (cons fun + (cons (macroexpand-all-1 arg1) + (cons (macroexpand-all-1 + (list 'function f)) + (macroexpand-all-forms args))))) + (`(,_ . ,_) + ;; For every other list, we just expand each argument (for + ;; setq/setq-default this works alright because the variable names + ;; are symbols). + (macroexpand-all-forms form 1)) + (t form)))) ;;;###autoload (defun macroexpand-all (form &optional environment) diff --git a/lisp/emacs-lisp/package-x.el b/lisp/emacs-lisp/package-x.el index b93950049e0..38c4d5bbe35 100644 --- a/lisp/emacs-lisp/package-x.el +++ b/lisp/emacs-lisp/package-x.el @@ -6,6 +6,7 @@ ;; Created: 10 Mar 2007 ;; Version: 0.9 ;; Keywords: tools +;; Package: package ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 2e8c7dc7d4f..54c6a09dd9d 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -216,6 +216,7 @@ If VERSION is nil, the package is not loaded (it is \"disabled\")." (declare-function lm-header "lisp-mnt" (header)) (declare-function lm-commentary "lisp-mnt" (&optional file)) (declare-function dired-delete-file "dired" (file &optional recursive trash)) +(defvar url-http-end-of-headers) (defcustom package-archives '(("gnu" . "http://elpa.gnu.org/packages/")) "An alist of archives from which to fetch. @@ -259,8 +260,9 @@ packages in `package-directory-list'." ;; Defaults are subdirs named "elpa" in the site-lisp dirs. (let (result) (dolist (f load-path) - (if (equal (file-name-nondirectory f) "site-lisp") - (push (expand-file-name "elpa" f) result))) + (and (stringp f) + (equal (file-name-nondirectory f) "site-lisp") + (push (expand-file-name "elpa" f) result))) (nreverse result)) "List of additional directories containing Emacs Lisp packages. Each directory name should be absolute. @@ -272,46 +274,35 @@ contrast, `package-user-dir' contains packages for personal use." :group 'package :version "24.1") -(defconst package--builtins-base - ;; We use package-version split here to make sure to pick up the - ;; minor version. - `((emacs . [,(version-to-list emacs-version) nil - "GNU Emacs"]) - (package . [,(version-to-list package-el-version) - nil "Simple package system for GNU Emacs"])) - "Packages which are always built-in.") - -(defvar package--builtins - (delq nil - (append - package--builtins-base - (if (>= emacs-major-version 22) - ;; FIXME: emacs 22 includes tramp, rcirc, maybe - ;; other things... - '((erc . [(5 2) nil "Internet Relay Chat client"]) - ;; The external URL is version 1.15, so make sure the - ;; built-in one looks newer. - (url . [(1 16) nil "URL handling libary"]))) - (if (>= emacs-major-version 23) - '(;; Strangely, nxml-version is missing in Emacs 23. - ;; We pick the merge date as the version. - (nxml . [(20071123) nil "Major mode for XML documents"]) - (bubbles . [(0 5) nil "A puzzle game"]))))) - "Alist of all built-in packages. -Maps the package name to a vector [VERSION REQS DOCSTRING].") +;; The value is precomputed in finder-inf.el, but don't load that +;; until it's needed (i.e. when `package-intialize' is called). +(defvar package--builtins nil + "Alist of built-in packages. +Each element has the form (PKG . DESC), where PKG is a package +name (a symbol) and DESC is a vector that describes the package. + +The vector DESC has the form [VERSION REQS DOCSTRING]. + VERSION is a version list. + REQS is a list of packages (symbols) required by the package. + DOCSTRING is a brief description of the package.") (put 'package--builtins 'risky-local-variable t) -(defvar package-alist package--builtins +(defvar package-alist nil "Alist of all packages available for activation. -This maps the package name to a vector [VERSION REQS DOCSTRING]. +Each element has the form (PKG . DESC), where PKG is a package +name (a symbol) and DESC is a vector that describes the package. -The value is generated by `package-load-descriptor', usually -called via `package-initialize'. For user customizations of -which packages to load/activate, see `package-load-list'.") +The vector DESC has the form [VERSION REQS DOCSTRING]. + VERSION is a version list. + REQS is a list of packages (symbols) required by the package. + DOCSTRING is a brief description of the package. + +This variable is set automatically by `package-load-descriptor', +called via `package-initialize'. To change which packages are +loaded and/or activated, customize `package-load-list'.") (put 'package-archive-contents 'risky-local-variable t) -(defvar package-activated-list - (mapcar #'car package-alist) +(defvar package-activated-list nil "List of the names of currently activated packages.") (put 'package-activated-list 'risky-local-variable t) @@ -416,16 +407,15 @@ updates `package-alist' and `package-obsolete-alist'." (error "Internal error: could not find directory for %s-%s" name version-str)) ;; Add info node. - (if (file-exists-p (expand-file-name "dir" pkg-dir)) - (progn - ;; FIXME: not the friendliest, but simple. - (require 'info) - (info-initialize) - (setq Info-directory-list (cons pkg-dir Info-directory-list)))) + (when (file-exists-p (expand-file-name "dir" pkg-dir)) + ;; FIXME: not the friendliest, but simple. + (require 'info) + (info-initialize) + (push pkg-dir Info-directory-list)) ;; Add to load path, add autoloads, and activate the package. - (setq load-path (cons pkg-dir load-path)) + (push pkg-dir load-path) (load (expand-file-name (concat name "-autoloads") pkg-dir) nil t) - (setq package-activated-list (cons package package-activated-list)) + (push package package-activated-list) ;; Don't return nil. t)) @@ -476,22 +466,22 @@ Return nil if the package could not be activated." (setcdr elt (cons (cons (package-desc-vers pkg-vec) pkg-vec) (cdr elt)))) ;; Make a new association. - (setq package-obsolete-alist - (cons (cons package (list (cons (package-desc-vers pkg-vec) - pkg-vec))) - package-obsolete-alist))))) + (push (cons package (list (cons (package-desc-vers pkg-vec) + pkg-vec))) + package-obsolete-alist)))) -;; (define-package "emacs" "21.4.1" "GNU Emacs core package.") -;; (define-package "erc" "5.1" "ERC - irc client" '((emacs "21.0"))) (defun define-package (name-str version-string - &optional docstring requirements) + &optional docstring requirements + &rest extra-properties) "Define a new package. NAME is the name of the package, a string. VERSION-STRING is the version of the package, a dotted sequence of integers. DOCSTRING is the optional description. REQUIREMENTS is a list of requirements on other packages. -Each requirement is of the form (OTHER-PACKAGE \"VERSION\")." +Each requirement is of the form (OTHER-PACKAGE \"VERSION\"). + +EXTRA-PROPERTIES is currently unused." (let* ((name (intern name-str)) (pkg-desc (assq name package-alist)) (new-version (version-to-list version-string)) @@ -514,7 +504,7 @@ Each requirement is of the form (OTHER-PACKAGE \"VERSION\")." (setq package-alist (delq pkg-desc package-alist)) (package-mark-obsolete (car pkg-desc) (cdr pkg-desc))) ;; Add package to the alist. - (setq package-alist (cons new-pkg-desc package-alist))) + (push new-pkg-desc package-alist)) ;; You can have two packages with the same version, for instance ;; one in the system package directory and one in your private ;; directory. We just let the first one win. @@ -672,7 +662,19 @@ It will move point to somewhere in the headers." (version-list-<= min-version (package-desc-vers (cdr pkg-desc)))))) -(defun package-compute-transaction (result requirements) +(defun package-compute-transaction (package-list requirements) + "Return a list of packages to be installed, including PACKAGE-LIST. +PACKAGE-LIST should be a list of package names (symbols). + +REQUIREMENTS should be a list of additional requirements; each +element in this list should have the form (PACKAGE VERSION), +where PACKAGE is a package name and VERSION is the required +version of that package (as a list). + +This function recursively computes the requirements of the +packages in REQUIREMENTS, and returns a list of all the packages +that must be installed. Packages that are already installed are +not included in this list." (dolist (elt requirements) (let* ((next-pkg (car elt)) (next-version (cadr elt))) @@ -703,25 +705,25 @@ but version %s required" (symbol-name next-pkg) (package-version-join next-version) (package-version-join (package-desc-vers (cdr pkg-desc))))) ;; Only add to the transaction if we don't already have it. - (unless (memq next-pkg result) - (setq result (cons next-pkg result))) - (setq result - (package-compute-transaction result + (unless (memq next-pkg package-list) + (push next-pkg package-list)) + (setq package-list + (package-compute-transaction package-list (package-desc-reqs (cdr pkg-desc)))))))) - result) + package-list) (defun package-read-from-string (str) "Read a Lisp expression from STR. Signal an error if the entire string was not used." (let* ((read-data (read-from-string str)) - (more-left - (condition-case nil - ;; The call to `ignore' suppresses a compiler warning. - (progn (ignore (read-from-string - (substring str (cdr read-data)))) - t) - (end-of-file nil)))) + (more-left + (condition-case nil + ;; The call to `ignore' suppresses a compiler warning. + (progn (ignore (read-from-string + (substring str (cdr read-data)))) + t) + (end-of-file nil)))) (if more-left (error "Can't read whole string") (car read-data)))) @@ -731,48 +733,33 @@ Signal an error if the entire string was not used." Will return the data from the file, or nil if the file does not exist. Will throw an error if the archive version is too new." (let ((filename (expand-file-name file package-user-dir))) - (if (file-exists-p filename) - (with-temp-buffer - (insert-file-contents-literally filename) - (let ((contents (package-read-from-string - (buffer-substring-no-properties (point-min) - (point-max))))) - (if (> (car contents) package-archive-version) - (error "Package archive version %d is greater than %d - upgrade package.el" - (car contents) package-archive-version)) - (cdr contents)))))) + (when (file-exists-p filename) + (with-temp-buffer + (insert-file-contents-literally filename) + (let ((contents (read (current-buffer)))) + (if (> (car contents) package-archive-version) + (error "Package archive version %d is higher than %d" + (car contents) package-archive-version)) + (cdr contents)))))) (defun package-read-all-archive-contents () - "Re-read `archive-contents' and `builtin-packages', if they exist. -Set `package-archive-contents' and `package--builtins' if successful. -Throw an error if the archive version is too new." + "Re-read `archive-contents', if it exists. +If successful, set `package-archive-contents'." (dolist (archive package-archives) - (package-read-archive-contents (car archive))) - (let ((builtins (package--read-archive-file "builtin-packages"))) - (if builtins - ;; Version 1 of 'builtin-packages' is a list where the car is - ;; a split emacs version and the cdr is an alist suitable for - ;; package--builtins. - (let ((our-version (version-to-list emacs-version)) - (result package--builtins-base)) - (setq package--builtins - (dolist (elt builtins result) - (if (version-list-<= (car elt) our-version) - (setq result (append (cdr elt) result))))))))) + (package-read-archive-contents (car archive)))) (defun package-read-archive-contents (archive) - "Re-read `archive-contents' and `builtin-packages' for ARCHIVE. -If successful, set `package-archive-contents' and `package--builtins'. + "Re-read archive contents for ARCHIVE. +If successful, set the variable `package-archive-contents'. If the archive version is too new, signal an error." - (let ((archive-contents (package--read-archive-file - (concat "archives/" archive - "/archive-contents")))) - (if archive-contents - ;; Version 1 of 'archive-contents' is identical to our - ;; internal representation. - ;; TODO: merge archive lists - (dolist (package archive-contents) - (package--add-to-archive-contents package archive))))) + ;; Version 1 of 'archive-contents' is identical to our internal + ;; representation. + (let* ((dir (concat "archives/" archive)) + (contents-file (concat dir "/archive-contents")) + contents) + (when (setq contents (package--read-archive-file contents-file)) + (dolist (package contents) + (package--add-to-archive-contents package archive))))) (defun package--add-to-archive-contents (package archive) "Add the PACKAGE from the given ARCHIVE if necessary. @@ -786,9 +773,13 @@ Also, add the originating archive to the end of the package vector." (version-list-< (aref existing-package 0) version)) (add-to-list 'package-archive-contents entry)))) -(defun package-download-transaction (transaction) - "Download and install all the packages in the given transaction." - (dolist (elt transaction) +(defun package-download-transaction (package-list) + "Download and install all the packages in PACKAGE-LIST. +PACKAGE-LIST should be a list of package names (symbols). +This function assumes that all package requirements in +PACKAGE-LIST are satisfied, i.e. that PACKAGE-LIST is computed +using `package-compute-transaction'." + (dolist (elt package-list) (let* ((desc (cdr (assq elt package-archive-contents))) ;; As an exception, if package is "held" in ;; `package-load-list', download the held version. @@ -839,61 +830,60 @@ Otherwise return nil." v-str)))) (defun package-buffer-info () - "Return a vector of information about the package in the current buffer. -The vector looks like [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY] -FILENAME is the file name, a string. It does not have the \".el\" extension. + "Return a vector describing the package in the current buffer. +The vector has the form + + [FILENAME REQUIRES DESCRIPTION VERSION COMMENTARY] + +FILENAME is the file name, a string, sans the \".el\" extension. REQUIRES is a requires list, or nil. -DESCRIPTION is the package description (a string). +DESCRIPTION is the package description, a string. VERSION is the version, a string. COMMENTARY is the commentary section, a string, or nil if none. -Throws an exception if the buffer does not contain a conforming package. -If there is a package, narrows the buffer to the file's boundaries. -May narrow buffer or move point even on failure." + +If the buffer does not contain a conforming package, signal an +error. If there is a package, narrow the buffer to the file's +boundaries." (goto-char (point-min)) - (if (re-search-forward "^;;; \\([^ ]*\\)\\.el --- \\(.*\\)$" nil t) - (let ((file-name (match-string 1)) - (desc (match-string 2)) - (start (progn (beginning-of-line) (point)))) - (if (search-forward (concat ";;; " file-name ".el ends here")) - (progn - ;; Try to include a trailing newline. - (forward-line) - (narrow-to-region start (point)) - (require 'lisp-mnt) - ;; Use some headers we've invented to drive the process. - (let* ((requires-str (lm-header "package-requires")) - (requires (if requires-str - (package-read-from-string requires-str))) - ;; Prefer Package-Version, because if it is - ;; defined the package author probably wants us - ;; to use it. Otherwise try Version. - (pkg-version - (or (package-strip-rcs-id (lm-header "package-version")) - (package-strip-rcs-id (lm-header "version")))) - (commentary (lm-commentary))) - (unless pkg-version - (error - "Package does not define a usable \"Version\" or \"Package-Version\" header")) - ;; Turn string version numbers into list form. - (setq requires - (mapcar - (lambda (elt) - (list (car elt) - (version-to-list (car (cdr elt))))) - requires)) - (set-text-properties 0 (length file-name) nil file-name) - (set-text-properties 0 (length pkg-version) nil pkg-version) - (set-text-properties 0 (length desc) nil desc) - (vector file-name requires desc pkg-version commentary))) - (error "Package missing a terminating comment"))) - (error "No starting comment for package"))) + (unless (re-search-forward "^;;; \\([^ ]*\\)\\.el --- \\(.*\\)$" nil t) + (error "Packages lacks a file header")) + (let ((file-name (match-string-no-properties 1)) + (desc (match-string-no-properties 2)) + (start (line-beginning-position))) + (unless (search-forward (concat ";;; " file-name ".el ends here")) + (error "Package lacks a terminating comment")) + ;; Try to include a trailing newline. + (forward-line) + (narrow-to-region start (point)) + (require 'lisp-mnt) + ;; Use some headers we've invented to drive the process. + (let* ((requires-str (lm-header "package-requires")) + (requires (if requires-str + (package-read-from-string requires-str))) + ;; Prefer Package-Version; if defined, the package author + ;; probably wants us to use it. Otherwise try Version. + (pkg-version + (or (package-strip-rcs-id (lm-header "package-version")) + (package-strip-rcs-id (lm-header "version")))) + (commentary (lm-commentary))) + (unless pkg-version + (error + "Package lacks a \"Version\" or \"Package-Version\" header")) + ;; Turn string version numbers into list form. + (setq requires + (mapcar + (lambda (elt) + (list (car elt) + (version-to-list (car (cdr elt))))) + requires)) + (vector file-name requires desc pkg-version commentary)))) (defun package-tar-file-info (file) "Find package information for a tar file. FILE is the name of the tar file to examine. The return result is a vector like `package-buffer-info'." (unless (string-match "^\\(.+\\)-\\([0-9.]+\\)\\.tar$" file) - (error "`%s' doesn't have a package-ish name" file)) + (error "Invalid package name `%s'" file)) (let* ((pkg-name (file-name-nondirectory (match-string-no-properties 1 file))) (pkg-version (match-string-no-properties 2 file)) ;; Extract the package descriptor. @@ -904,20 +894,19 @@ The return result is a vector like `package-buffer-info'." pkg-name "-pkg.el"))) (pkg-def-parsed (package-read-from-string pkg-def-contents))) (unless (eq (car pkg-def-parsed) 'define-package) - (error "%s-pkg.el doesn't contain `define-package' sexp" pkg-name)) - (let ((name-str (nth 1 pkg-def-parsed)) + (error "No `define-package' sexp is present in `%s-pkg.el'" pkg-name)) + (let ((name-str (nth 1 pkg-def-parsed)) (version-string (nth 2 pkg-def-parsed)) - (docstring (nth 3 pkg-def-parsed)) - (requires (nth 4 pkg-def-parsed)) - + (docstring (nth 3 pkg-def-parsed)) + (requires (nth 4 pkg-def-parsed)) (readme (shell-command-to-string ;; Requires GNU tar. (concat "tar -xOf " file " " pkg-name "-" pkg-version "/README")))) (unless (equal pkg-version version-string) - (error "Inconsistent versions!")) + (error "Package has inconsistent versions")) (unless (equal pkg-name name-str) - (error "Inconsistent names!")) + (error "Package has inconsistent names")) ;; Kind of a hack. (if (string-match ": Not found in archive" readme) (setq readme nil)) @@ -925,18 +914,27 @@ The return result is a vector like `package-buffer-info'." (if (eq (car requires) 'quote) (setq requires (car (cdr requires)))) (setq requires - (mapcar - (lambda (elt) - (list (car elt) - (version-to-list (car (cdr elt))))) - requires)) + (mapcar (lambda (elt) + (list (car elt) + (version-to-list (cadr elt)))) + requires)) (vector pkg-name requires docstring version-string readme)))) -(defun package-install-buffer-internal (pkg-info type) +;;;###autoload +(defun package-install-from-buffer (pkg-info type) + "Install a package from the current buffer. +When called interactively, the current buffer is assumed to be a +single .el file that follows the packaging guidelines; see info +node `(elisp)Packaging'. + +When called from Lisp, PKG-INFO is a vector describing the +information, of the type returned by `package-buffer-info'; and +TYPE is the package type (either `single' or `tar')." + (interactive (list (package-buffer-info) 'single)) (save-excursion (save-restriction (let* ((file-name (aref pkg-info 0)) - (requires (aref pkg-info 1)) + (requires (aref pkg-info 1)) (desc (if (string= (aref pkg-info 2) "") "No description available." (aref pkg-info 2))) @@ -956,15 +954,6 @@ The return result is a vector like `package-buffer-info'." (package-initialize))))) ;;;###autoload -(defun package-install-from-buffer () - "Install a package from the current buffer. -The package is assumed to be a single .el file which -follows the elisp comment guidelines; see -info node `(elisp)Library Headers'." - (interactive) - (package-install-buffer-internal (package-buffer-info) 'single)) - -;;;###autoload (defun package-install-file (file) "Install a package from a file. The file can either be a tar file or an Emacs Lisp file." @@ -972,9 +961,10 @@ The file can either be a tar file or an Emacs Lisp file." (with-temp-buffer (insert-file-contents-literally file) (cond - ((string-match "\\.el$" file) (package-install-from-buffer)) + ((string-match "\\.el$" file) + (package-install-from-buffer (package-buffer-info) 'single)) ((string-match "\\.tar$" file) - (package-install-buffer-internal (package-tar-file-info file) 'tar)) + (package-install-from-buffer (package-tar-file-info file) 'tar)) (t (error "Unrecognized extension `%s'" (file-name-extension file)))))) (defun package-delete (name version) @@ -1001,22 +991,27 @@ The file can either be a tar file or an Emacs Lisp file." (re-search-forward "^$" nil 'move) (forward-char) (delete-region (point-min) (point)) - (make-directory dir t) - (setq buffer-file-name (expand-file-name file dir)) - (let ((version-control 'never)) - (save-buffer))) + ;; Read the retrieved buffer to make sure it is valid (e.g. it + ;; may fetch a URL redirect page). + (when (listp (read buffer)) + (make-directory dir t) + (setq buffer-file-name (expand-file-name file dir)) + (let ((version-control 'never)) + (save-buffer)))) (kill-buffer buffer))) (defun package-refresh-contents () "Download the ELPA archive description if needed. -Invoking this will ensure that Emacs knows about the latest versions -of all packages. This will let Emacs make them available for -download." +This informs Emacs about the latest versions of all packages, and +makes them available for download." (interactive) (unless (file-exists-p package-user-dir) (make-directory package-user-dir t)) (dolist (archive package-archives) - (package--download-one-archive archive "archive-contents")) + (condition-case nil + (package--download-one-archive archive "archive-contents") + (error (message "Failed to download `%s' archive." + (car archive))))) (package-read-all-archive-contents)) ;;;###autoload @@ -1024,6 +1019,9 @@ download." "Load Emacs Lisp packages, and activate them. The variable `package-load-list' controls which packages to load." (interactive) + (require 'finder-inf nil t) + (setq package-alist package--builtins) + (setq package-activated-list (mapcar #'car package-alist)) (setq package-obsolete-alist nil) (package-load-all-descriptors) (package-read-all-archive-contents) @@ -1052,9 +1050,7 @@ The variable `package-load-list' controls which packages to load." guess) "Describe package: ") packages nil t nil nil guess)) - (list (if (equal val "") - guess - (intern val))))) + (list (if (equal val "") guess (intern val))))) (if (or (null package) (null (symbolp package))) (message "You did not specify a package") (help-setup-xref (list #'describe-package package) @@ -1064,38 +1060,65 @@ The variable `package-load-list' controls which packages to load." (describe-package-1 package))))) (defun describe-package-1 (package) - (let ((desc (cdr (assq package package-alist))) - reqs version installable) + (require 'lisp-mnt) + (let ((package-name (symbol-name package)) + (built-in (assq package package--builtins)) + desc pkg-dir reqs version installable) (prin1 package) (princ " is ") - (cond - (desc - ;; This package is loaded (i.e. in `package-alist'). - (let (pkg-dir) - (setq version (package-version-join (package-desc-vers desc))) - (if (assq package package--builtins) - (princ "a built-in package.\n\n") - (setq pkg-dir (package--dir (symbol-name package) version)) - (if pkg-dir - (progn - (insert "a package installed in `") - (help-insert-xref-button (file-name-as-directory pkg-dir) - 'help-package-def pkg-dir) - (insert "'.\n\n")) - ;; This normally does not happen. - (insert "a deleted package.\n\n") - (setq version nil))))) - (t - ;; An uninstalled package. - (setq desc (cdr (assq package package-archive-contents)) + (if (setq desc (cdr (assq package package-alist))) + ;; This package is loaded (i.e. in `package-alist'). + (progn + (setq version (package-version-join (package-desc-vers desc))) + (cond (built-in + (princ "a built-in package.\n\n")) + ((setq pkg-dir (package--dir package-name version)) + (insert "an installed package.\n\n")) + (t ;; This normally does not happen. + (insert "a deleted package.\n\n") + (setq version nil)))) + ;; This package is not installed. + (setq desc (cdr (assq package package-archive-contents)) version (package-version-join (package-desc-vers desc)) installable t) - (insert "an installable package.\n\n"))) - (if version - (insert " Version: " version "\n")) + (insert "an uninstalled package.\n\n")) + + (insert " " (propertize "Status" 'font-lock-face 'bold) ": ") + (cond (pkg-dir + (insert (propertize "Installed" + 'font-lock-face 'font-lock-comment-face)) + (insert " in `") + ;; Todo: Add button for uninstalling. + (help-insert-xref-button (file-name-as-directory pkg-dir) + 'help-package-def pkg-dir) + (insert "'.")) + (installable + (insert "Available -- ") + (let ((button-text (if (display-graphic-p) + "Install" + "[Install]")) + (button-face (if (display-graphic-p) + '(:box (:line-width 2 :color "dark grey") + :background "light grey" + :foreground "black") + 'link))) + (insert-text-button button-text + 'face button-face + 'follow-link t + 'package-symbol package + 'action 'package-install-button-action))) + (built-in + (insert (propertize "Built-in" + 'font-lock-face 'font-lock-builtin-face) ".")) + (t (insert "Deleted."))) + (insert "\n") + (and version + (> (length version) 0) + (insert " " + (propertize "Version" 'font-lock-face 'bold) ": " version "\n")) (setq reqs (package-desc-reqs desc)) (when reqs - (insert " Requires: ") + (insert " " (propertize "Requires" 'font-lock-face 'bold) ": ") (let ((first t) name vers text) (dolist (req reqs) @@ -1110,28 +1133,53 @@ The variable `package-load-list' controls which packages to load." (t (insert ", "))) (help-insert-xref-button text 'help-package name)) (insert "\n"))) - (insert " Description: " (package-desc-doc desc) "\n") - ;; Todo: button for uninstalling a package. - (when installable - (let ((button-text (if (display-graphic-p) - "Install" - "[Install]")) - (button-face (if (display-graphic-p) - '(:box (:line-width 2 :color "dark grey") - :background "light grey" - :foreground "black") - 'link))) - (insert "\n") - (insert-text-button button-text - 'face button-face - 'follow-link t - 'package-symbol package - 'action (lambda (button) - (package-install - (button-get button 'package-symbol)) - (revert-buffer nil t) - (goto-char (point-min)))) - (insert "\n"))))) + (insert " " (propertize "Summary" 'font-lock-face 'bold) + ": " (package-desc-doc desc) "\n\n") + + (if (assq package package--builtins) + ;; For built-in packages, insert the commentary. + (let ((fn (locate-file (concat package-name ".el") load-path + load-file-rep-suffixes)) + (opoint (point))) + (insert (or (lm-commentary fn) "")) + (save-excursion + (goto-char opoint) + (when (re-search-forward "^;;; Commentary:\n" nil t) + (replace-match "")) + (while (re-search-forward "^\\(;+ ?\\)" nil t) + (replace-match "")))) + (let ((readme (expand-file-name (concat package-name "-readme.txt") + package-user-dir))) + ;; For elpa packages, try downloading the commentary. If that + ;; fails, try an existing readme file in `package-user-dir'. + (cond ((let ((buffer (ignore-errors + (url-retrieve-synchronously + (concat (package-archive-url package) + package-name "-readme.txt")))) + response) + (when buffer + (with-current-buffer buffer + (setq response (url-http-parse-response)) + (if (or (< response 200) (>= response 300)) + (setq response nil) + (setq buffer-file-name + (expand-file-name readme package-user-dir)) + (delete-region (point-min) (1+ url-http-end-of-headers)) + (save-buffer))) + (when response + (insert-buffer-substring buffer) + (kill-buffer buffer) + t)))) + ((file-readable-p readme) + (insert-file-contents readme) + (goto-char (point-max)))))))) + +(defun package-install-button-action (button) + (let ((package (button-get button 'package-symbol))) + (when (y-or-n-p (format "Install package `%s'? " package)) + (package-install package) + (revert-buffer nil t) + (goto-char (point-min))))) ;;;; Package menu mode. @@ -1148,12 +1196,14 @@ The variable `package-load-list' controls which packages to load." (define-key map "\177" 'package-menu-backup-unmark) (define-key map "d" 'package-menu-mark-delete) (define-key map "i" 'package-menu-mark-install) - (define-key map "g" 'package-menu-revert) + (define-key map "g" 'revert-buffer) (define-key map "r" 'package-menu-refresh) (define-key map "~" 'package-menu-mark-obsolete-for-deletion) (define-key map "x" 'package-menu-execute) (define-key map "h" 'package-menu-quick-help) - (define-key map "?" 'package-menu-view-commentary) + (define-key map "?" 'package-menu-describe-package) + (define-key map [follow-link] 'mouse-face) + (define-key map [mouse-2] 'mouse-select-window) (define-key map [menu-bar package-menu] (cons "Package" menu-map)) (define-key menu-map [mq] '(menu-item "Quit" quit-window @@ -1180,7 +1230,7 @@ The variable `package-load-list' controls which packages to load." :help "Mark a package for installation and move to the next line")) (define-key menu-map [s3] '("--")) (define-key menu-map [mg] - '(menu-item "Update package list" package-menu-revert + '(menu-item "Update package list" revert-buffer :help "Update the list of packages")) (define-key menu-map [mr] '(menu-item "Refresh package list" package-menu-refresh @@ -1205,6 +1255,7 @@ The variable `package-load-list' controls which packages to load." (defvar package-menu-sort-button-map (let ((map (make-sparse-keymap))) (define-key map [header-line mouse-1] 'package-menu-sort-by-column) + (define-key map [header-line mouse-2] 'package-menu-sort-by-column) (define-key map [follow-link] 'mouse-face) map) "Local keymap for package menu sort buttons.") @@ -1222,25 +1273,52 @@ Letters do not insert themselves; instead, they are commands. (setq mode-name "Package Menu") (setq truncate-lines t) (setq buffer-read-only t) - ;; Support Emacs 21. - (if (fboundp 'run-mode-hooks) - (run-mode-hooks 'package-menu-mode-hook) - (run-hooks 'package-menu-mode-hook))) + (setq revert-buffer-function 'package-menu-revert) + (setq header-line-format + (mapconcat + (lambda (pair) + (let ((column (car pair)) + (name (cdr pair))) + (concat + ;; Insert a space that aligns the button properly. + (propertize " " 'display (list 'space :align-to column) + 'face 'fixed-pitch) + ;; Set up the column button. + (propertize name + 'column-name name + 'help-echo "mouse-1: sort by column" + 'mouse-face 'highlight + 'keymap package-menu-sort-button-map)))) + ;; We take a trick from buff-menu and have a dummy leading + ;; space to align the header line with the beginning of the + ;; text. This doesn't really work properly on Emacs 21, but + ;; it is close enough. + '((0 . "") + (2 . "Package") + (20 . "Version") + (32 . "Status") + (43 . "Description")) + "")) + (run-mode-hooks 'package-menu-mode-hook)) (defun package-menu-refresh () - "Download the ELPA archive. -This fetches the file describing the current contents of -the Emacs Lisp Package Archive, and then refreshes the -package menu. This lets you see what new packages are -available for download." + "Download the Emacs Lisp package archive. +This fetches the contents of each archive specified in +`package-archives', and then refreshes the package menu." (interactive) + (unless (eq major-mode 'package-menu-mode) + (error "The current buffer is not a Package Menu")) (package-refresh-contents) - (package-list-packages-internal)) + (package--generate-package-list)) -(defun package-menu-revert () - "Update the list of packages." +(defun package-menu-revert (&optional arg noconfirm) + "Update the list of packages. +This function is the `revert-buffer-function' for Package Menu +buffers. The arguments are ignored." (interactive) - (package-list-packages-internal)) + (unless (eq major-mode 'package-menu-mode) + (error "The current buffer is not a Package Menu")) + (package--generate-package-list)) (defun package-menu-describe-package () "Describe the package in the current line." @@ -1297,32 +1375,8 @@ available for download." (interactive) (message "n-ext, i-nstall, d-elete, u-nmark, x-ecute, r-efresh, h-elp")) -(defun package-menu-view-commentary () - "Display information about this package. -For single-file packages, shows the commentary section from the header. -For larger packages, shows the README file." - (interactive) - (let* ((pkg-name (package-menu-get-package)) - (buffer (url-retrieve-synchronously - (concat (package-archive-url pkg-name) - pkg-name - "-readme.txt"))) - start-point ok) - (with-current-buffer buffer - ;; FIXME: it would be nice to work with any URL type. - (setq start-point url-http-end-of-headers) - (setq ok (eq (url-http-parse-response) 200))) - (let ((new-buffer (get-buffer-create "*Package Info*"))) - (with-current-buffer new-buffer - (let ((buffer-read-only nil)) - (erase-buffer) - (insert "Package information for " pkg-name "\n\n") - (if ok - (insert-buffer-substring buffer start-point) - (insert "This package lacks a README file or commentary.\n")) - (goto-char (point-min)) - (view-mode))) - (display-buffer new-buffer t)))) +(define-obsolete-function-alias + 'package-menu-view-commentary 'package-menu-describe-package "24.1") ;; Return the name of the package on the current line. (defun package-menu-get-package () @@ -1405,151 +1459,161 @@ Emacs." (defun package-list-maybe-add (package version status description result) (unless (assoc (cons package version) result) - (setq result (cons (list (cons package version) status description) - result))) + (push (list (cons package version) status description) result)) result) -;; This decides how we should sort; nil means by package name. -(defvar package-menu-sort-key nil) +(defvar package-menu-package-list nil + "List of packages to display in the Package Menu buffer. +A value of nil means to display all packages.") -(defun package-list-packages-internal () - (package-initialize) ; FIXME: do this here? - (with-current-buffer (get-buffer-create "*Packages*") +(defvar package-menu-sort-key nil + "Sort key for the current Package Menu buffer.") + +(defun package--generate-package-list () + "Populate the current Package Menu buffer." + (package-initialize) + (let ((inhibit-read-only t) + info-list name desc hold builtin) (setq buffer-read-only nil) (erase-buffer) - (let ((info-list) - name desc hold - builtin) - ;; List installed packages - (dolist (elt package-alist) - ;; Ignore the Emacs package. - (setq name (car elt) - desc (cdr elt) - hold (assq name package-load-list)) - (unless (eq name 'emacs) - (setq info-list - (package-list-maybe-add - name (package-desc-vers desc) - ;; FIXME: it turns out to be tricky to see if this - ;; package is presently activated. - (cond ((stringp (cadr hold)) - "held") - ((and (setq builtin (assq name package--builtins)) - (version-list-= - (package-desc-vers (cdr builtin)) - (package-desc-vers desc))) - "built-in") - (t "installed")) - (package-desc-doc desc) - info-list)))) - ;; List available packages - (dolist (elt package-archive-contents) - (setq name (car elt) - desc (cdr elt) - hold (assq name package-load-list)) - (unless (and hold (stringp (cadr hold)) - (package-installed-p - name (version-to-list (cadr hold)))) - (setq info-list - (package-list-maybe-add name - (package-desc-vers desc) - (if (and hold (null (cadr hold))) - "disabled" - "available") - (package-desc-doc (cdr elt)) - info-list)))) - ;; List obsolete packages - (mapc (lambda (elt) - (mapc (lambda (inner-elt) - (setq info-list - (package-list-maybe-add (car elt) - (package-desc-vers - (cdr inner-elt)) - "obsolete" - (package-desc-doc - (cdr inner-elt)) - info-list))) - (cdr elt))) - package-obsolete-alist) - (let ((selector (cond - ((string= package-menu-sort-key "Version") - ;; FIXME this doesn't work. - #'(lambda (e) (cdr (car e)))) - ((string= package-menu-sort-key "Status") - #'(lambda (e) (car (cdr e)))) - ((string= package-menu-sort-key "Description") - #'(lambda (e) (car (cdr (cdr e))))) - (t ; "Package" is default. - #'(lambda (e) (symbol-name (car (car e)))))))) + ;; List installed packages + (dolist (elt package-alist) + (setq name (car elt)) + (when (and (not (eq name 'emacs)) ; Hide the `emacs' package. + (or (null package-menu-package-list) + (memq name package-menu-package-list))) + (setq desc (cdr elt) + hold (cadr (assq name package-load-list)) + builtin (cdr (assq name package--builtins))) + (setq info-list + (package-list-maybe-add + name (package-desc-vers desc) + ;; FIXME: it turns out to be tricky to see if this + ;; package is presently activated. + (cond ((stringp hold) "held") + ((and builtin + (version-list-= + (package-desc-vers builtin) + (package-desc-vers desc))) + "built-in") + (t "installed")) + (package-desc-doc desc) + info-list)))) + + ;; List available and disabled packages + (dolist (elt package-archive-contents) + (setq name (car elt) + desc (cdr elt) + hold (assq name package-load-list)) + (when (or (null package-menu-package-list) + (memq name package-menu-package-list)) (setq info-list - (sort info-list - (lambda (left right) - (let ((vleft (funcall selector left)) - (vright (funcall selector right))) - (string< vleft vright)))))) - (mapc (lambda (elt) - (package-print-package (car (car elt)) - (cdr (car elt)) - (car (cdr elt)) - (car (cdr (cdr elt))))) - info-list)) + (package-list-maybe-add name + (package-desc-vers desc) + (if (and hold (null (cadr hold))) + "disabled" + "available") + (package-desc-doc (cdr elt)) + info-list)))) + ;; List obsolete packages + (mapc (lambda (elt) + (mapc (lambda (inner-elt) + (setq info-list + (package-list-maybe-add (car elt) + (package-desc-vers + (cdr inner-elt)) + "obsolete" + (package-desc-doc + (cdr inner-elt)) + info-list))) + (cdr elt))) + package-obsolete-alist) + + (setq info-list + (sort info-list + (cond ((string= package-menu-sort-key "Package") + 'package-menu--name-predicate) + ((string= package-menu-sort-key "Version") + 'package-menu--version-predicate) + ((string= package-menu-sort-key "Description") + 'package-menu--description-predicate) + (t ; By default, sort by package status + 'package-menu--status-predicate)))) + + (dolist (elt info-list) + (package-print-package (car (car elt)) + (cdr (car elt)) + (car (cdr elt)) + (car (cdr (cdr elt))))) (goto-char (point-min)) + (set-buffer-modified-p nil) (current-buffer))) +(defun package-menu--version-predicate (left right) + (let ((vleft (or (cdr (car left)) '(0))) + (vright (or (cdr (car right)) '(0)))) + (if (version-list-= vleft vright) + (package-menu--name-predicate left right) + (version-list-< vleft vright)))) + +(defun package-menu--status-predicate (left right) + (let ((sleft (cadr left)) + (sright (cadr right))) + (cond ((string= sleft sright) + (package-menu--name-predicate left right)) + ((string= sleft "available") t) + ((string= sright "available") nil) + ((string= sleft "installed") t) + ((string= sright "installed") nil) + ((string= sleft "held") t) + ((string= sright "held") nil) + ((string= sleft "built-in") t) + ((string= sright "built-in") nil) + ((string= sleft "obsolete") t) + ((string= sright "obsolete") nil) + (t (string< sleft sright))))) + +(defun package-menu--description-predicate (left right) + (let ((sleft (car (cddr left))) + (sright (car (cddr right)))) + (if (string= sleft sright) + (package-menu--name-predicate left right) + (string< sleft sright)))) + +(defun package-menu--name-predicate (left right) + (string< (symbol-name (caar left)) + (symbol-name (caar right)))) + (defun package-menu-sort-by-column (&optional e) - "Sort the package menu by the last column clicked on." - (interactive (list last-input-event)) - (if e (mouse-select-window e)) + "Sort the package menu by the column of the mouse click E." + (interactive "e") (let* ((pos (event-start e)) (obj (posn-object pos)) (col (if obj (get-text-property (cdr obj) 'column-name (car obj)) - (get-text-property (posn-point pos) 'column-name)))) - (setq package-menu-sort-key col)) - (package-list-packages-internal)) - -(defun package--list-packages () - "Display a list of packages. -Helper function that does all the work for the user-facing functions." - (with-current-buffer (package-list-packages-internal) + (get-text-property (posn-point pos) 'column-name))) + (buf (window-buffer (posn-window (event-start e))))) + (with-current-buffer buf + (when (eq major-mode 'package-menu-mode) + (setq package-menu-sort-key col) + (package--generate-package-list))))) + +(defun package--list-packages (&optional packages) + "Generate and pop to the *Packages* buffer. +Optional PACKAGES is a list of names of packages (symbols) to +list; the default is to display everything in `package-alist'." + (with-current-buffer (get-buffer-create "*Packages*") (package-menu-mode) - ;; Set up the header line. - (setq header-line-format - (mapconcat - (lambda (pair) - (let ((column (car pair)) - (name (cdr pair))) - (concat - ;; Insert a space that aligns the button properly. - (propertize " " 'display (list 'space :align-to column) - 'face 'fixed-pitch) - ;; Set up the column button. - (if (string= name "Version") - name - (propertize name - 'column-name name - 'help-echo "mouse-1: sort by column" - 'mouse-face 'highlight - 'keymap package-menu-sort-button-map))))) - ;; We take a trick from buff-menu and have a dummy leading - ;; space to align the header line with the beginning of the - ;; text. This doesn't really work properly on Emacs 21, - ;; but it is close enough. - '((0 . "") - (2 . "Package") - (20 . "Version") - (32 . "Status") - (43 . "Description")) - "")) - + (set (make-local-variable 'package-menu-package-list) packages) + (set (make-local-variable 'package-menu-sort-key) nil) + (package--generate-package-list) ;; It's okay to use pop-to-buffer here. The package menu buffer - ;; has keybindings, and the user just typed 'M-x - ;; package-list-packages', suggesting that they might want to use - ;; them. + ;; has keybindings, and the user just typed `M-x list-packages', + ;; suggesting that they might want to use them. (pop-to-buffer (current-buffer)))) ;;;###autoload -(defun package-list-packages () +(defun list-packages () "Display a list of packages. Fetches the updated list of packages before displaying. The list is displayed in a buffer named `*Packages*'." @@ -1557,6 +1621,9 @@ The list is displayed in a buffer named `*Packages*'." (package-refresh-contents) (package--list-packages)) +;;;###autoload +(defalias 'package-list-packages 'list-packages) + (defun package-list-packages-no-fetch () "Display a list of packages. Does not fetch the updated list of packages before displaying. diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 03d760b2df5..b2b27a0e0d6 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -1,6 +1,6 @@ ;;; pcase.el --- ML-style pattern-matching macro for Elisp -;; Copyright (C) 2010 Stefan Monnier +;; Copyright (C) 2010 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> ;; Keywords: @@ -290,9 +290,13 @@ MATCH is the pattern that needs to be matched, of the form: (defun pcase-split-memq (elems pat) ;; Based on pcase-split-eq. (cond - ;; The same match will give the same result. + ;; The same match will give the same result, but we don't know how + ;; to check it. + ;; (??? + ;; (cons :pcase-succeed nil)) + ;; A match for one of the elements may succeed or fail. ((and (eq (car-safe pat) '\`) (member (cadr pat) elems)) - (cons :pcase-succeed nil)) + nil) ;; A different match will fail if this one succeeds. ((and (eq (car-safe pat) '\`) ;; (or (integerp (cadr pat)) (symbolp (cadr pat)) @@ -383,18 +387,20 @@ and otherwise defers to REST which is a list of branches of the form `(,(cadr upat) ,sym) (let* ((exp (cadr upat)) ;; `vs' is an upper bound on the vars we need. - (vs (pcase-fgrep (mapcar #'car vars) exp))) - (if vs - ;; Let's not replace `vars' in `exp' since it's - ;; too difficult to do it right, instead just - ;; let-bind `vars' around `exp'. - `(let ,(mapcar (lambda (var) - (list var (cdr (assq var vars)))) - vs) - ;; FIXME: `vars' can capture `sym'. E.g. - ;; (pcase x ((and `(,x . ,y) (pred (fun x))))) - (,@exp ,sym)) - `(,@exp ,sym)))) + (vs (pcase-fgrep (mapcar #'car vars) exp)) + (call (if (functionp exp) + `(,exp ,sym) `(,@exp ,sym)))) + (if (null vs) + call + ;; Let's not replace `vars' in `exp' since it's + ;; too difficult to do it right, instead just + ;; let-bind `vars' around `exp'. + `(let ,(mapcar (lambda (var) + (list var (cdr (assq var vars)))) + vs) + ;; FIXME: `vars' can capture `sym'. E.g. + ;; (pcase x ((and `(,x . ,y) (pred (fun x))))) + ,call)))) (pcase-u1 matches code vars then-rest) (pcase-u else-rest)))) ((symbolp upat) @@ -483,7 +489,7 @@ and if not, defers to REST which is a list of branches of the form (pcase-u1 matches code vars then-rest) (pcase-u else-rest)))) (t (error "Unkown QPattern %s" qpat)))) - + (provide 'pcase) ;;; pcase.el ends here diff --git a/lisp/emacs-lisp/regexp-opt.el b/lisp/emacs-lisp/regexp-opt.el index 78eba19a253..a1494741572 100644 --- a/lisp/emacs-lisp/regexp-opt.el +++ b/lisp/emacs-lisp/regexp-opt.el @@ -120,7 +120,7 @@ This means the number of non-shy regexp grouping constructs (string-match regexp "") ;; Count the number of open parentheses in REGEXP. (let ((count 0) start last) - (while (string-match "\\\\(\\(\\?:\\)?" regexp start) + (while (string-match "\\\\(\\(\\?[0-9]*:\\)?" regexp start) (setq start (match-end 0)) ; Start of next search. (when (and (not (match-beginning 1)) (subregexp-context-p regexp (match-beginning 0) last)) diff --git a/lisp/emacs-lisp/rx.el b/lisp/emacs-lisp/rx.el index 85fe3514b01..522d452c2dc 100644 --- a/lisp/emacs-lisp/rx.el +++ b/lisp/emacs-lisp/rx.el @@ -427,7 +427,7 @@ Only both edges of each range is checked." (mapcar (lambda (e) (cond ((= (car e) (cdr e)) (list (car e))) - ;; ((= (1+ (car e)) (cdr e)) (list (car e) (cdr e))) + ((= (1+ (car e)) (cdr e)) (list (car e) (cdr e))) ((list e)))) l)) (delete-dups str)))) @@ -545,7 +545,10 @@ ARG is optional." ((numberp e) (string e)) ((consp e) (if (and (= (1+ (car e)) (cdr e)) - (null (memq (car e) '(?\] ?-)))) + ;; rx-any-condense-range should + ;; prevent this case from happening. + (null (memq (car e) '(?\] ?-))) + (null (memq (cdr e) '(?\] ?-)))) (string (car e) (cdr e)) (string (car e) ?- (cdr e)))) (e))) diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index fb1e4737d39..c6df851b0e5 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -65,6 +65,9 @@ ;;; Code: +;; FIXME: I think the behavior on empty lines is wrong. It shouldn't +;; look at the next token on subsequent lines. + (eval-when-compile (require 'cl)) (defvar comment-continue) @@ -72,6 +75,26 @@ ;;; Building precedence level tables from BNF specs. +;; We have 4 different representations of a "grammar": +;; - a BNF table, which is a list of BNF rules of the form +;; (NONTERM RHS1 ... RHSn) where each RHS is a list of terminals (tokens) +;; or nonterminals. Any element in these lists which does not appear as +;; the `car' of a BNF rule is taken to be a terminal. +;; - A list of precedences (key word "precs"), is a list, sorted +;; from lowest to highest precedence, of precedence classes that +;; have the form (ASSOCIATIVITY TERMINAL1 .. TERMINALn), where +;; ASSOCIATIVITY can be `assoc', `left', `right' or `nonassoc'. +;; - a 2 dimensional precedence table (key word "prec2"), is a 2D +;; table recording the precedence relation (can be `<', `=', `>', or +;; nil) between each pair of tokens. +;; - a precedence-level table (key word "levels"), while is a alist +;; giving for each token its left and right precedence level (a +;; number or nil). This is used in `smie-op-levels'. +;; The prec2 tables are only intermediate data structures: the source +;; code normally provides a mix of BNF and precs tables, and then +;; turns them into a levels table, which is what's used by the rest of +;; the SMIE code. + (defun smie-set-prec2tab (table x y val &optional override) (assert (and x y)) (let* ((key (cons x y)) @@ -155,9 +178,9 @@ one of those elements share the same precedence level and associativity." (if (not (member (car shr) nts)) (pushnew (car shr) last-ops) (pushnew (car shr) last-nts) - (when (consp (cdr shr)) - (assert (not (member (cadr shr) nts))) - (pushnew (cadr shr) last-ops))))) + (when (consp (cdr shr)) + (assert (not (member (cadr shr) nts))) + (pushnew (cadr shr) last-ops))))) (push (cons nt first-ops) first-ops-table) (push (cons nt last-ops) last-ops-table) (push (cons nt first-nts) first-nts-table) @@ -203,13 +226,105 @@ one of those elements share the same precedence level and associativity." (setq rhs (cdr rhs))))) prec2)) +;; (defun smie-prec2-closer-alist (prec2 include-inners) +;; "Build a closer-alist from a PREC2 table. +;; The return value is in the same form as `smie-closer-alist'. +;; INCLUDE-INNERS if non-nil means that inner keywords will be included +;; in the table, e.g. the table will include things like (\"if\" . \"else\")." +;; (let* ((non-openers '()) +;; (non-closers '()) +;; ;; For each keyword, this gives the matching openers, if any. +;; (openers (make-hash-table :test 'equal)) +;; (closers '()) +;; (done nil)) +;; ;; First, find the non-openers and non-closers. +;; (maphash (lambda (k v) +;; (unless (or (eq v '<) (member (cdr k) non-openers)) +;; (push (cdr k) non-openers)) +;; (unless (or (eq v '>) (member (car k) non-closers)) +;; (push (car k) non-closers))) +;; prec2) +;; ;; Then find the openers and closers. +;; (maphash (lambda (k _) +;; (unless (member (car k) non-openers) +;; (puthash (car k) (list (car k)) openers)) +;; (unless (or (member (cdr k) non-closers) +;; (member (cdr k) closers)) +;; (push (cdr k) closers))) +;; prec2) +;; ;; Then collect the matching elements. +;; (while (not done) +;; (setq done t) +;; (maphash (lambda (k v) +;; (when (eq v '=) +;; (let ((aopeners (gethash (car k) openers)) +;; (dopeners (gethash (cdr k) openers)) +;; (new nil)) +;; (dolist (o aopeners) +;; (unless (member o dopeners) +;; (setq new t) +;; (push o dopeners))) +;; (when new +;; (setq done nil) +;; (puthash (cdr k) dopeners openers))))) +;; prec2)) +;; ;; Finally, dump the resulting table. +;; (let ((alist '())) +;; (maphash (lambda (k v) +;; (when (or include-inners (member k closers)) +;; (dolist (opener v) +;; (unless (equal opener k) +;; (push (cons opener k) alist))))) +;; openers) +;; alist))) + +(defun smie-bnf-closer-alist (bnf &optional no-inners) + ;; We can also build this closer-alist table from a prec2 table, + ;; but it takes more work, and the order is unpredictable, which + ;; is a problem for smie-close-block. + ;; More convenient would be to build it from a levels table since we + ;; always have this table (contrary to the BNF), but it has all the + ;; disadvantages of the prec2 case plus the disadvantage that the levels + ;; table has lost some info which would result in extra invalid pairs. + "Build a closer-alist from a BNF table. +The return value is in the same form as `smie-closer-alist'. +NO-INNERS if non-nil means that inner keywords will be excluded +from the table, e.g. the table will not include things like (\"if\" . \"else\")." + (let ((nts (mapcar #'car bnf)) ;non terminals. + (alist '())) + (dolist (nt bnf) + (dolist (rhs (cdr nt)) + (unless (or (< (length rhs) 2) (member (car rhs) nts)) + (if no-inners + (let ((last (car (last rhs)))) + (unless (member last nts) + (pushnew (cons (car rhs) last) alist :test #'equal))) + ;; Reverse so that the "real" closer gets there first, + ;; which is important for smie-close-block. + (dolist (term (reverse (cdr rhs))) + (unless (member term nts) + (pushnew (cons (car rhs) term) alist :test #'equal))))))) + (nreverse alist))) + + (defun smie-prec2-levels (prec2) + ;; FIXME: Rather than only return an alist of precedence levels, we should + ;; also extract other useful data from it: + ;; - matching sets of block openers&closers (which can otherwise become + ;; collapsed into a single equivalence class in smie-op-levels) for + ;; smie-close-block as well as to detect mismatches in smie-next-sexp + ;; or in blink-paren (as well as to do the blink-paren for inner + ;; keywords like the "in" of "let..in..end"). + ;; - better default indentation rules (i.e. non-zero indentation after inner + ;; keywords like the "in" of "let..in..end") for smie-indent-after-keyword. + ;; Of course, maybe those things would be even better handled in the + ;; bnf->prec function. "Take a 2D precedence table and turn it into an alist of precedence levels. PREC2 is a table as returned by `smie-precs-precedence-table' or `smie-bnf-precedence-table'." ;; For each operator, we create two "variables" (corresponding to ;; the left and right precedence level), which are represented by - ;; cons cells. Those are the vary cons cells that appear in the + ;; cons cells. Those are the very cons cells that appear in the ;; final `table'. The value of each "variable" is kept in the `car'. (let ((table ()) (csts ()) @@ -268,7 +383,7 @@ PREC2 is a table as returned by `smie-precs-precedence-table' or ;; distinguish associative operators (which will have ;; left = right). (unless (caar cst) - (setcar (car cst) i) + (setcar (car cst) i) (incf i)) (setq csts (delq cst csts)))) (unless progress @@ -321,32 +436,30 @@ it should move backward to the beginning of the previous token.") (defun smie-default-backward-token () (forward-comment (- (point))) - (buffer-substring (point) - (progn (if (zerop (skip-syntax-backward ".")) - (skip-syntax-backward "w_'")) - (point)))) + (buffer-substring-no-properties + (point) + (progn (if (zerop (skip-syntax-backward ".")) + (skip-syntax-backward "w_'")) + (point)))) (defun smie-default-forward-token () (forward-comment (point-max)) - (buffer-substring (point) - (progn (if (zerop (skip-syntax-forward ".")) - (skip-syntax-forward "w_'")) - (point)))) + (buffer-substring-no-properties + (point) + (progn (if (zerop (skip-syntax-forward ".")) + (skip-syntax-forward "w_'")) + (point)))) (defun smie-associative-p (toklevels) ;; in "a + b + c" we want to stop at each +, but in - ;; "if a then b else c" we don't want to stop at each keyword. + ;; "if a then b elsif c then d else c" we don't want to stop at each keyword. ;; To distinguish the two cases, we made smie-prec2-levels choose ;; different levels for each part of "if a then b else c", so that ;; by checking if the left-level is equal to the right level, we can ;; figure out that it's an associative operator. - ;; This is not 100% foolproof, tho, since a grammar like - ;; (exp ("A" exp "C") ("A" exp "B" exp "C")) - ;; will cause "B" to have equal left and right levels, even though - ;; it is not an associative operator. - ;; A better check would be the check the actual previous operator - ;; against this one to see if it's the same, but we'd have to change - ;; `levels' to keep a stack of operators rather than only levels. + ;; This is not 100% foolproof, tho, since the "elsif" will have to have + ;; equal left and right levels (since it's optional), so smie-next-sexp + ;; has to be careful to distinguish those different cases. (eq (smie-op-left toklevels) (smie-op-right toklevels))) (defun smie-next-sexp (next-token next-sexp op-forw op-back halfsexp) @@ -371,51 +484,71 @@ Possible return values: (let* ((pos (point)) (token (funcall next-token)) (toklevels (cdr (assoc token smie-op-levels)))) - (cond ((null toklevels) (when (zerop (length token)) - (condition-case err - (progn (goto-char pos) (funcall next-sexp 1) nil) - (scan-error (throw 'return (list t (caddr err))))) + (condition-case err + (progn (goto-char pos) (funcall next-sexp 1) nil) + (scan-error (throw 'return + (list t (caddr err) + (buffer-substring-no-properties + (caddr err) + (+ (caddr err) + (if (< (point) (caddr err)) + -1 1))))))) (if (eq pos (point)) ;; We did not move, so let's abort the loop. (throw 'return (list t (point)))))) ((null (funcall op-back toklevels)) ;; A token like a paren-close. (assert (funcall op-forw toklevels)) ;Otherwise, why mention it? - (push (funcall op-forw toklevels) levels)) + (push toklevels levels)) (t - (while (and levels (< (funcall op-back toklevels) (car levels))) + (while (and levels (< (funcall op-back toklevels) + (funcall op-forw (car levels)))) (setq levels (cdr levels))) (cond ((null levels) (if (and halfsexp (funcall op-forw toklevels)) - (push (funcall op-forw toklevels) levels) + (push toklevels levels) (throw 'return (prog1 (list (or (car toklevels) t) (point) token) (goto-char pos))))) (t - (if (and levels (= (funcall op-back toklevels) (car levels))) - (setq levels (cdr levels))) - (cond - ((null levels) + (let ((lastlevels levels)) + (if (and levels (= (funcall op-back toklevels) + (funcall op-forw (car levels)))) + (setq levels (cdr levels))) + ;; We may have found a match for the previously pending + ;; operator. Is this the end? (cond + ;; Keep looking as long as we haven't matched the + ;; topmost operator. + (levels + (if (funcall op-forw toklevels) + (push toklevels levels))) + ;; We matched the topmost operator. If the new operator + ;; is the last in the corresponding BNF rule, we're done. ((null (funcall op-forw toklevels)) + ;; It is the last element, let's stop here. (throw 'return (list nil (point) token))) - ((smie-associative-p toklevels) + ;; If the new operator is not the last in the BNF rule, + ;; ans is not associative, it's one of the inner operators + ;; (like the "in" in "let .. in .. end"), so keep looking. + ((not (smie-associative-p toklevels)) + (push toklevels levels)) + ;; The new operator is associative. Two cases: + ;; - it's really just an associative operator (like + or ;) + ;; in which case we should have stopped right before. + ((and lastlevels + (smie-associative-p (car lastlevels))) (throw 'return (prog1 (list (or (car toklevels) t) (point) token) (goto-char pos)))) - ;; We just found a match to the previously pending operator - ;; but this new operator is still part of a larger RHS. - ;; E.g. we're now looking at the "then" in - ;; "if a then b else c". So we have to keep parsing the - ;; rest of the construct. - (t (push (funcall op-forw toklevels) levels)))) - (t - (if (funcall op-forw toklevels) - (push (funcall op-forw toklevels) levels)))))))) + ;; - it's an associative operator within a larger construct + ;; (e.g. an "elsif"), so we should just ignore it and keep + ;; looking for the closing element. + (t (setq levels lastlevels)))))))) levels) (setq halfsexp nil))))) @@ -430,11 +563,11 @@ Possible return values: (t POS TOKEN): same thing but for an open-paren or the beginning of buffer. (nil POS TOKEN): we skipped over a paren-like pair. nil: we skipped over an identifier, matched parentheses, ..." - (smie-next-sexp - (indirect-function smie-backward-token-function) - (indirect-function 'backward-sexp) - (indirect-function 'smie-op-left) - (indirect-function 'smie-op-right) + (smie-next-sexp + (indirect-function smie-backward-token-function) + (indirect-function 'backward-sexp) + (indirect-function 'smie-op-left) + (indirect-function 'smie-op-right) halfsexp)) (defun smie-forward-sexp (&optional halfsexp) @@ -448,44 +581,196 @@ Possible return values: (t POS TOKEN): same thing but for an open-paren or the beginning of buffer. (nil POS TOKEN): we skipped over a paren-like pair. nil: we skipped over an identifier, matched parentheses, ..." - (smie-next-sexp - (indirect-function smie-forward-token-function) - (indirect-function 'forward-sexp) - (indirect-function 'smie-op-right) - (indirect-function 'smie-op-left) + (smie-next-sexp + (indirect-function smie-forward-token-function) + (indirect-function 'forward-sexp) + (indirect-function 'smie-op-right) + (indirect-function 'smie-op-left) halfsexp)) +;;; Miscellanous commands using the precedence parser. + (defun smie-backward-sexp-command (&optional n) "Move backward through N logical elements." - (interactive "p") - (if (< n 0) - (smie-forward-sexp-command (- n)) - (let ((forward-sexp-function nil)) - (while (> n 0) - (decf n) - (let ((pos (point)) - (res (smie-backward-sexp 'halfsexp))) - (if (and (car res) (= pos (point)) (not (bolp))) - (signal 'scan-error - (list "Containing expression ends prematurely" - (cadr res) (cadr res))) - nil)))))) + (interactive "^p") + (smie-forward-sexp-command (- n))) (defun smie-forward-sexp-command (&optional n) "Move forward through N logical elements." + (interactive "^p") + (let ((forw (> n 0)) + (forward-sexp-function nil)) + (while (/= n 0) + (setq n (- n (if forw 1 -1))) + (let ((pos (point)) + (res (if forw + (smie-forward-sexp 'halfsexp) + (smie-backward-sexp 'halfsexp)))) + (if (and (car res) (= pos (point)) (not (if forw (eobp) (bobp)))) + (signal 'scan-error + (list "Containing expression ends prematurely" + (cadr res) (cadr res))) + nil))))) + +(defvar smie-closer-alist nil + "Alist giving the closer corresponding to an opener.") + +(defun smie-close-block () + "Close the closest surrounding block." + (interactive) + (let ((closer + (save-excursion + (backward-up-list 1) + (if (looking-at "\\s(") + (string (cdr (syntax-after (point)))) + (let* ((open (funcall smie-forward-token-function)) + (closer (cdr (assoc open smie-closer-alist))) + (levels (list (assoc open smie-op-levels))) + (seen '()) + (found '())) + (cond + ;; Even if we improve the auto-computation of closers, + ;; there are still cases where we need manual + ;; intervention, e.g. for Octave's use of `until' + ;; as a pseudo-closer of `do'. + (closer) + ((or (equal levels '(nil)) (nth 1 (car levels))) + (error "Doesn't look like a block")) + (t + ;; FIXME: With grammars like Octave's, every closer ("end", + ;; "endif", "endwhile", ...) has the same level, so we'd need + ;; to look at the BNF or at least at the 2D prec-table, in + ;; order to find the right closer for a given opener. + (while levels + (let ((level (pop levels))) + (dolist (other smie-op-levels) + (when (and (eq (nth 2 level) (nth 1 other)) + (not (memq other seen))) + (push other seen) + (if (nth 2 other) + (push other levels) + (push (car other) found)))))) + (cond + ((null found) (error "No known closer for opener %s" open)) + ;; FIXME: what should we do if there are various closers? + (t (car found)))))))))) + (unless (save-excursion (skip-chars-backward " \t") (bolp)) + (newline)) + (insert closer) + (if (save-excursion (skip-chars-forward " \t") (eolp)) + (indent-according-to-mode) + (reindent-then-newline-and-indent)))) + +(defun smie-down-list (&optional arg) + "Move forward down one level paren-like blocks. Like `down-list'. +With argument ARG, do this that many times. +A negative argument means move backward but still go down a level. +This command assumes point is not in a string or comment." (interactive "p") - (if (< n 0) - (smie-backward-sexp-command (- n)) - (let ((forward-sexp-function nil)) - (while (> n 0) - (decf n) - (let ((pos (point)) - (res (smie-forward-sexp 'halfsexp))) - (if (and (car res) (= pos (point)) (not (bolp))) - (signal 'scan-error - (list "Containing expression ends prematurely" - (cadr res) (cadr res))) - nil)))))) + (let ((start (point)) + (inc (if (< arg 0) -1 1)) + (offset (if (< arg 0) 1 0)) + (next-token (if (< arg 0) + smie-backward-token-function + smie-forward-token-function))) + (while (/= arg 0) + (setq arg (- arg inc)) + (while + (let* ((pos (point)) + (token (funcall next-token)) + (levels (assoc token smie-op-levels))) + (cond + ((zerop (length token)) + (if (if (< inc 0) (looking-back "\\s(\\|\\s)" (1- (point))) + (looking-at "\\s(\\|\\s)")) + ;; Go back to `start' in case of an error. This presumes + ;; none of the token we've found until now include a ( or ). + (progn (goto-char start) (down-list inc) nil) + (forward-sexp inc) + (/= (point) pos))) + ((and levels (null (nth (+ 1 offset) levels))) nil) + ((and levels (null (nth (- 2 offset) levels))) + (let ((end (point))) + (goto-char start) + (signal 'scan-error + (list "Containing expression ends prematurely" + pos end)))) + (t))))))) + +(defvar smie-blink-matching-triggers '(?\s ?\n) + "Chars which might trigger `blink-matching-open'. +These can include the final chars of end-tokens, or chars that are +typically inserted right after an end token. +I.e. a good choice can be: + (delete-dups + (mapcar (lambda (kw) (aref (cdr kw) (1- (length (cdr kw))))) + smie-closer-alist))") + +(defcustom smie-blink-matching-inners t + "Whether SMIE should blink to matching opener for inner keywords. +If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\"." + :type 'boolean) + +(defun smie-blink-matching-check (start end) + (save-excursion + (goto-char end) + (let ((ender (funcall smie-backward-token-function))) + (cond + ((not (and ender (rassoc ender smie-closer-alist))) + ;; This not is one of the begin..end we know how to check. + (blink-matching-check-mismatch start end)) + ((not start) t) + (t + (goto-char start) + (let ((starter (funcall smie-forward-token-function))) + (not (member (cons starter ender) smie-closer-alist)))))))) + +(defun smie-blink-matching-open () + "Blink the matching opener when applicable. +This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'." + (when (and blink-matching-paren + smie-closer-alist ; Optimization. + (eq (char-before) last-command-event) ; Sanity check. + (memq last-command-event smie-blink-matching-triggers) + (save-excursion + ;; FIXME: Here we assume that closers all end + ;; with a word-syntax char. + (unless (eq ?\w (char-syntax last-command-event)) + (forward-char -1)) + (and (looking-at "\\>") + (not (nth 8 (syntax-ppss)))))) + (save-excursion + (let ((pos (point)) + (token (funcall smie-backward-token-function))) + (if (= 1 (length token)) + ;; The trigger char is itself a token but is not + ;; one of the closers (e.g. ?\; in Octave mode), + ;; so go back to the previous token + (setq token (save-excursion + (funcall smie-backward-token-function))) + (goto-char pos)) + ;; Here we assume that smie-backward-token-function + ;; returns a token that is a string and whose content + ;; match the buffer's representation of this token. + (when (and (> (length token) 1) (stringp token) + (memq (aref token (1- (length token))) + smie-blink-matching-triggers) + (not (eq (aref token (1- (length token))) + last-command-event))) + ;; Token ends with a trigger char, so don't blink for + ;; anything else than this trigger char, lest we'd blink + ;; both when inserting the trigger char and when inserting a + ;; subsequent SPC. + (setq token nil)) + (when (and (rassoc token smie-closer-alist) + (or smie-blink-matching-inners + (null (nth 2 (assoc token smie-op-levels))))) + ;; The major mode might set blink-matching-check-function + ;; buffer-locally so that interactive calls to + ;; blink-matching-open work right, but let's not presume + ;; that's the case. + (let ((blink-matching-check-function #'smie-blink-matching-check)) + (blink-matching-open))))))) ;;; The indentation engine. @@ -505,24 +790,36 @@ Possible return values: "Rules of the following form. \((:before . TOK) . OFFSET-RULES) how to indent TOK itself. \(TOK . OFFSET-RULES) how to indent right after TOK. -\((T1 . T2) . OFFSET) how to indent token T2 w.r.t T1. -\((t . TOK) . OFFSET) how to indent TOK with respect to its parent. \(list-intro . TOKENS) declare TOKENS as being followed by what may look like a funcall but is just a sequence of expressions. \(t . OFFSET) basic indentation step. \(args . OFFSET) indentation of arguments. +\((T1 . T2) OFFSET) like ((:before . T2) (:parent T1 OFFSET)). OFFSET-RULES is a list of elements which can each either be: \(:hanging . OFFSET-RULES) if TOK is hanging, use OFFSET-RULES. \(:parent PARENT . OFFSET-RULES) if TOK's parent is PARENT, use OFFSET-RULES. \(:next TOKEN . OFFSET-RULES) if TOK is followed by TOKEN, use OFFSET-RULES. -\(:prev TOKEN . OFFSET-RULES) if TOK is preceded by TOKEN, use OFFSET-RULES. -a number the offset to use. +\(:prev TOKEN . OFFSET-RULES) if TOK is preceded by TOKEN, use +\(:bolp . OFFSET-RULES) If TOK is first on a line, use OFFSET-RULES. +OFFSET the offset to use. + +PARENT can be either the name of the parent or a list of such names. + +OFFSET can be of the form: `point' align with the token. `parent' align with the parent. +NUMBER offset by NUMBER. +\(+ OFFSETS...) use the sum of OFFSETS. +VARIABLE use the value of VARIABLE as offset. + +The precise meaning of `point' depends on various details: it can +either mean the position of the token we're indenting, or the +position of its parent, or the position right after its parent. -A nil offset for indentation after a token defaults to `smie-indent-basic'.") +A nil offset for indentation after an opening token defaults +to `smie-indent-basic'.") (defun smie-indent-hanging-p () ;; A hanging keyword is one that's at the end of a line except it's not at @@ -543,21 +840,33 @@ A nil offset for indentation after a token defaults to `smie-indent-basic'.") (cdr (assq t smie-indent-rules)) smie-indent-basic)) -(defun smie-indent-offset-rule (tokinfo &optional after) +(defvar smie-indent-debug-log) + +(defun smie-indent-offset-rule (tokinfo &optional after parent) "Apply the OFFSET-RULES in TOKINFO. Point is expected to be right in front of the token corresponding to TOKINFO. If computing the indentation after the token, then AFTER is the position -after the token." +after the token, otherwise it should be nil. +PARENT if non-nil should be the parent info returned by `smie-backward-sexp'." (let ((rules (cdr tokinfo)) - parent next prev + next prev offset) (while (consp rules) (let ((rule (pop rules))) (cond ((not (consp rule)) (setq offset rule)) + ((eq (car rule) '+) (setq offset rule)) ((eq (car rule) :hanging) (when (smie-indent-hanging-p) (setq rules (cdr rule)))) + ((eq (car rule) :bolp) + (when (smie-bolp) + (setq rules (cdr rule)))) + ((eq (car rule) :eolp) + (unless after + (error "Can't use :eolp in :before indentation rules")) + (when (> after (line-end-position)) + (setq rules (cdr rule)))) ((eq (car rule) :prev) (unless prev (save-excursion @@ -578,12 +887,63 @@ after the token." (save-excursion (if after (goto-char after)) (setq parent (smie-backward-sexp 'halfsexp)))) - (when (equal (nth 2 parent) (cadr rule)) + (when (if (listp (cadr rule)) + (member (nth 2 parent) (cadr rule)) + (equal (nth 2 parent) (cadr rule))) (setq rules (cddr rule)))) (t (error "Unknown rule %s for indentation of %s" rule (car tokinfo)))))) + ;; If `offset' is not set yet, use `rules' to handle the case where + ;; the tokinfo uses the old-style ((PARENT . TOK). OFFSET). + (unless offset (setq offset rules)) + (when (boundp 'smie-indent-debug-log) + (push (list (point) offset tokinfo) smie-indent-debug-log)) offset)) +(defun smie-indent-column (offset &optional base parent virtual-point) + "Compute the actual column to use for a given OFFSET. +BASE is the base position to use, and PARENT is the parent info, if any. +If VIRTUAL-POINT is non-nil, then `point' is virtual." + (cond + ((eq (car-safe offset) '+) + (apply '+ (mapcar (lambda (offset) (smie-indent-column offset nil parent)) + (cdr offset)))) + ((integerp offset) + (+ offset + (case base + ((nil) 0) + (parent (goto-char (cadr parent)) + (smie-indent-virtual)) + (t + (goto-char base) + ;; For indentation after "(let" in SML-mode, we end up accumulating + ;; the offset of "(" and the offset of "let", so we use `min' to try + ;; and get it right either way. + (min (smie-indent-virtual) (current-column)))))) + ((eq offset 'point) + ;; In indent-keyword, if we're indenting `then' wrt `if', we want to use + ;; indent-virtual rather than use just current-column, so that we can + ;; apply the (:before . "if") rule which does the "else if" dance in SML. + ;; But in other cases, we do not want to use indent-virtual + ;; (e.g. indentation of "*" w.r.t "+", or ";" wrt "("). We could just + ;; always use indent-virtual and then have indent-rules say explicitly + ;; to use `point' after things like "(" or "+" when they're not at EOL, + ;; but you'd end up with lots of those rules. + ;; So we use a heuristic here, which is that we only use virtual if + ;; the parent is tightly linked to the child token (they're part of + ;; the same BNF rule). + (if (and virtual-point (null (car parent))) ;Black magic :-( + (smie-indent-virtual) (current-column))) + ((eq offset 'parent) + (unless parent + (setq parent (or (smie-backward-sexp 'halfsexp) :notfound))) + (if (consp parent) (goto-char (cadr parent))) + (smie-indent-virtual)) + ((eq offset nil) nil) + ((and (symbolp offset) (boundp 'offset)) + (smie-indent-column (symbol-value offset) base parent virtual-point)) + (t (error "Unknown indentation offset %s" offset)))) + (defun smie-indent-forward-token () "Skip token forward and return it, along with its levels." (let ((tok (funcall smie-forward-token-function))) @@ -620,13 +980,13 @@ in order to figure out the indentation of some other (further down) point." ;; Obey the `fixindent' special comment. (and (smie-bolp) (save-excursion - (comment-normalize-vars) - (re-search-forward (concat comment-start-skip - "fixindent" - comment-end-skip) - ;; 1+ to account for the \n comment termination. - (1+ (line-end-position)) t)) - (current-column))) + (comment-normalize-vars) + (re-search-forward (concat comment-start-skip + "fixindent" + comment-end-skip) + ;; 1+ to account for the \n comment termination. + (1+ (line-end-position)) t)) + (current-column))) (defun smie-indent-bob () ;; Start the file at column 0. @@ -655,85 +1015,130 @@ in order to figure out the indentation of some other (further down) point." (toklevels (smie-indent-forward-token)) (token (pop toklevels))) (if (null (car toklevels)) - ;; Different case: - ;; - smie-bolp: "indent according to others". - ;; - common hanging: "indent according to others". - ;; - SML-let hanging: "indent like parent". - ;; - if-after-else: "indent-like parent". - ;; - middle-of-line: "trust current position". - (cond - ((null (cdr toklevels)) nil) ;Not a keyword. - ((smie-bolp) - ;; For an open-paren-like thingy at BOL, always indent only - ;; based on other rules (typically smie-indent-after-keyword). - nil) - (t - (let* ((tokinfo (or (assoc (cons :before token) smie-indent-rules) - ;; By default use point unless we're hanging. - (cons (cons :before token) - '((:hanging nil) point)))) - (after (prog1 (point) (goto-char pos))) - (offset (smie-indent-offset-rule tokinfo))) - (cond - ((eq offset 'point) (current-column)) - ((eq offset 'parent) - (let ((parent (smie-backward-sexp 'halfsexp))) - (if parent (goto-char (cadr parent)))) - (smie-indent-virtual)) - ((eq offset nil) nil) - (t (error "Unhandled offset %s in %s" - offset (cons :before token))))))) + (save-excursion + (goto-char pos) + ;; Different cases: + ;; - smie-bolp: "indent according to others". + ;; - common hanging: "indent according to others". + ;; - SML-let hanging: "indent like parent". + ;; - if-after-else: "indent-like parent". + ;; - middle-of-line: "trust current position". + (cond + ((null (cdr toklevels)) nil) ;Not a keyword. + ((smie-bolp) + ;; For an open-paren-like thingy at BOL, always indent only + ;; based on other rules (typically smie-indent-after-keyword). + nil) + (t + ;; We're only ever here for virtual-indent, which is why + ;; we can use (current-column) as answer for `point'. + (let* ((tokinfo (or (assoc (cons :before token) + smie-indent-rules) + ;; By default use point unless we're hanging. + `((:before . ,token) (:hanging nil) point))) + ;; (after (prog1 (point) (goto-char pos))) + (offset (smie-indent-offset-rule tokinfo))) + (smie-indent-column offset))))) ;; FIXME: This still looks too much like black magic!! ;; FIXME: Rather than a bunch of rules like (PARENT . TOKEN), we ;; want a single rule for TOKEN with different cases for each PARENT. - (let ((res (smie-backward-sexp 'halfsexp)) tmp) + (let* ((parent (smie-backward-sexp 'halfsexp)) + (tokinfo + (or (assoc (cons (caddr parent) token) + smie-indent-rules) + (assoc (cons :before token) smie-indent-rules) + ;; Default rule. + `((:before . ,token) + ;; (:parent open 0) + point))) + (offset (save-excursion + (goto-char pos) + (smie-indent-offset-rule tokinfo nil parent)))) + ;; Different behaviors: + ;; - align with parent. + ;; - parent + offset. + ;; - after parent's column + offset (actually, after or before + ;; depending on where backward-sexp stopped). + ;; ? let it drop to some other indentation function (almost never). + ;; ? parent + offset + parent's own offset. + ;; Different cases: + ;; - bump into a same-level operator. + ;; - bump into a specific known parent. + ;; - find a matching open-paren thingy. + ;; - bump into some random parent. + ;; ? borderline case (almost never). + ;; ? bump immediately into a parent. (cond ((not (or (< (point) pos) - (and (cadr res) (< (cadr res) pos)))) + (and (cadr parent) (< (cadr parent) pos)))) ;; If we didn't move at all, that means we didn't really skip - ;; what we wanted. + ;; what we wanted. Should almost never happen, other than + ;; maybe when an infix or close-paren is at the beginning + ;; of a buffer. nil) - ((eq (car res) (car toklevels)) + ((eq (car parent) (car toklevels)) ;; We bumped into a same-level operator. align with it. - (goto-char (cadr res)) - ;; Don't use (smie-indent-virtual :not-hanging) here, because we - ;; want to jump back over a sequence of same-level ops such as - ;; a -> b -> c - ;; -> d - ;; So as to align with the earliest appropriate place. - (smie-indent-virtual)) - ((setq tmp (assoc (cons (caddr res) token) - smie-indent-rules)) - (goto-char (cadr res)) - (+ (cdr tmp) (smie-indent-virtual))) ;:not-hanging - ;; FIXME: The rules ((t . TOK) . OFFSET) either indent - ;; relative to "before the parent" or "after the parent", - ;; depending on details of the grammar. - ((null (car res)) - (assert (eq (point) (cadr res))) - (goto-char (cadr res)) - (+ (or (cdr (assoc (cons t token) smie-indent-rules)) 0) - (smie-indent-virtual))) ;:not-hanging - ((and (= (point) pos) (smie-bolp)) - ;; Since we started at BOL, we're not computing a virtual - ;; indentation, and we're still at the starting point, so the - ;; next (default) rule can't be used since it uses `current-column' - ;; which would cause. indentation to depend on itself. - ;; We could just return nil, but OTOH that's not good enough in - ;; some cases. Instead, we want to combine the offset-rules for - ;; the current token with the offset-rules of the previous one. - (+ (or (cdr (assoc (cons t token) smie-indent-rules)) 0) - ;; FIXME: This is odd. Can't we make it use - ;; smie-indent-(calculate|virtual) somehow? - (smie-indent-after-keyword))) - (t - (+ (or (cdr (assoc (cons t token) smie-indent-rules)) 0) - (current-column))))))))) + (if (and (smie-bolp) (/= (point) pos) + (save-excursion + (goto-char (goto-char (cadr parent))) + (not (smie-bolp))) + ;; Check the offset of `token' rather then its parent + ;; because its parent may have used a special rule. E.g. + ;; function foo; + ;; line2; + ;; line3; + ;; The ; on the first line had a special rule, but when + ;; indenting line3, we don't care about it and want to + ;; align with line2. + (memq offset '(point nil))) + ;; If the parent is at EOL and its children are indented like + ;; itself, then we can just obey the indentation chosen for the + ;; child. + ;; This is important for operators like ";" which + ;; are usually at EOL (and have an offset of 0): otherwise we'd + ;; always go back over all the statements, which is + ;; a performance problem and would also mean that fixindents + ;; in the middle of such a sequence would be ignored. + ;; + ;; This is a delicate point! + ;; Even if the offset is not 0, we could follow the same logic + ;; and subtract the offset from the child's indentation. + ;; But that would more often be a bad idea: OT1H we generally + ;; want to reuse the closest similar indentation point, so that + ;; the user's choice (or the fixindents) are obeyed. But OTOH + ;; we don't want this to affect "unrelated" parts of the code. + ;; E.g. a fixindent in the body of a "begin..end" should not + ;; affect the indentation of the "end". + (current-column) + (goto-char (cadr parent)) + ;; Don't use (smie-indent-virtual :not-hanging) here, because we + ;; want to jump back over a sequence of same-level ops such as + ;; a -> b -> c + ;; -> d + ;; So as to align with the earliest appropriate place. + (smie-indent-virtual))) + (tokinfo + (if (and (= (point) pos) (smie-bolp) + (or (eq offset 'point) + (and (consp offset) (memq 'point offset)))) + ;; Since we started at BOL, we're not computing a virtual + ;; indentation, and we're still at the starting point, so + ;; we can't use `current-column' which would cause + ;; indentation to depend on itself. + nil + (smie-indent-column offset 'parent parent + ;; If we're still at pos, indent-virtual + ;; will inf-loop. + (unless (= (point) pos) 'virtual)))))))))) (defun smie-indent-comment () - ;; Indentation of a comment. - (and (looking-at comment-start-skip) + "Compute indentation of a comment." + ;; Don't do it for virtual indentations. We should normally never be "in + ;; front of a comment" when doing virtual-indentation anyway. And if we are + ;; (as can happen in octave-mode), moving forward can lead to inf-loops. + (and (smie-bolp) + (looking-at comment-start-skip) (save-excursion (forward-comment (point-max)) (skip-chars-forward " \t\r\n") @@ -745,12 +1150,12 @@ in order to figure out the indentation of some other (further down) point." (comment-string-strip comment-continue t t)))) (and (< 0 (length continue)) (looking-at (regexp-quote continue)) (nth 4 (syntax-ppss)) - (let ((ppss (syntax-ppss))) - (save-excursion - (forward-line -1) - (if (<= (point) (nth 8 ppss)) - (progn (goto-char (1+ (nth 8 ppss))) (current-column)) - (skip-chars-forward " \t") + (let ((ppss (syntax-ppss))) + (save-excursion + (forward-line -1) + (if (<= (point) (nth 8 ppss)) + (progn (goto-char (1+ (nth 8 ppss))) (current-column)) + (skip-chars-forward " \t") (if (looking-at (regexp-quote continue)) (current-column)))))))) @@ -761,26 +1166,25 @@ in order to figure out the indentation of some other (further down) point." (toklevel (smie-indent-backward-token)) (tok (car toklevel)) (tokinfo (assoc tok smie-indent-rules))) + ;; Set some default indent rules. (if (and toklevel (null (cadr toklevel)) (null tokinfo)) (setq tokinfo (list (car toklevel)))) ;; (if (and tokinfo (null toklevel)) ;; (error "Token %S has indent rule but has no parsing info" tok)) (when toklevel + (unless tokinfo + ;; The default indentation after a keyword/operator is 0 for + ;; infix and t for prefix. + ;; Using the BNF syntax, we could come up with better + ;; defaults, but we only have the precedence levels here. + (setq tokinfo (list tok 'default-rule + (if (cadr toklevel) 0 (smie-indent-offset t))))) (let ((offset - (cond - (tokinfo (or (smie-indent-offset-rule tokinfo pos) - (smie-indent-offset t))) - ;; The default indentation after a keyword/operator - ;; is 0 for infix and t for prefix. - ;; Using the BNF syntax, we could come up with - ;; better defaults, but we only have the - ;; precedence levels here. - ((null (cadr toklevel)) (smie-indent-offset t)) - (t 0)))) - ;; For indentation after "(let" in SML-mode, we end up accumulating - ;; the offset of "(" and the offset of "let", so we use `min' to try - ;; and get it right either way. - (+ (min (smie-indent-virtual) (current-column)) offset)))))) + (or (smie-indent-offset-rule tokinfo pos) + (smie-indent-offset t)))) + (let ((before (point))) + (goto-char pos) + (smie-indent-column offset before))))))) (defun smie-indent-exps () ;; Indentation of sequences of simple expressions without @@ -828,6 +1232,7 @@ in order to figure out the indentation of some other (further down) point." (positions ;; We're the first arg. (goto-char (car positions)) + ;; FIXME: Use smie-indent-column. (+ (smie-indent-offset 'args) ;; We used to use (smie-indent-virtual), but that ;; doesn't seem right since it might then indent args less than @@ -836,8 +1241,8 @@ in order to figure out the indentation of some other (further down) point." (defvar smie-indent-functions '(smie-indent-fixindent smie-indent-bob smie-indent-close smie-indent-comment - smie-indent-comment-continue smie-indent-keyword smie-indent-after-keyword - smie-indent-exps) + smie-indent-comment-continue smie-indent-keyword smie-indent-after-keyword + smie-indent-exps) "Functions to compute the indentation. Each function is called with no argument, shouldn't move point, and should return either nil if it has no opinion, or an integer representing the column @@ -851,7 +1256,7 @@ to which that point should be aligned, if we were to reindent it.") "Indent current line using the SMIE indentation engine." (interactive) (let* ((savep (point)) - (indent (condition-case nil + (indent (condition-case-no-debug nil (save-excursion (forward-line 0) (skip-chars-forward " \t") @@ -866,7 +1271,14 @@ to which that point should be aligned, if we were to reindent it.") (save-excursion (indent-line-to indent)) (indent-line-to indent))))) -;;;###autoload +(defun smie-indent-debug () + "Show the rules used to compute indentation of current line." + (interactive) + (let ((smie-indent-debug-log '())) + (smie-indent-calculate) + ;; FIXME: please improve! + (message "%S" smie-indent-debug-log))) + (defun smie-setup (op-levels indent-rules) (set (make-local-variable 'smie-indent-rules) indent-rules) (set (make-local-variable 'smie-op-levels) op-levels) diff --git a/lisp/emacs-lisp/syntax.el b/lisp/emacs-lisp/syntax.el index 5cc89596ef5..ad0166e7af0 100644 --- a/lisp/emacs-lisp/syntax.el +++ b/lisp/emacs-lisp/syntax.el @@ -34,7 +34,6 @@ ;; - do something about the case where the syntax-table is changed. ;; This typically happens with tex-mode and its `$' operator. -;; - move font-lock-syntactic-keywords in here. Then again, maybe not. ;; - new functions `syntax-state', ... to replace uses of parse-partial-state ;; with something higher-level (similar to syntax-ppss-context). ;; - interaction with mmm-mode. @@ -47,6 +46,249 @@ (defvar font-lock-beginning-of-syntax-function) +;;; Applying syntax-table properties where needed. + +(defvar syntax-propertize-function nil + ;; Rather than a -functions hook, this is a -function because it's easier + ;; to do a single scan than several scans: with multiple scans, one cannot + ;; assume that the text before point has been propertized, so syntax-ppss + ;; gives unreliable results (and stores them in its cache to boot, so we'd + ;; have to flush that cache between each function, and we couldn't use + ;; syntax-ppss-flush-cache since that would not only flush the cache but also + ;; reset syntax-propertize--done which should not be done in this case). + "Mode-specific function to apply the syntax-table properties. +Called with 2 arguments: START and END.") + +(defvar syntax-propertize-chunk-size 500) + +(defvar syntax-propertize-extend-region-functions + '(syntax-propertize-wholelines) + "Special hook run just before proceeding to propertize a region. +This is used to allow major modes to help `syntax-propertize' find safe buffer +positions as beginning and end of the propertized region. Its most common use +is to solve the problem of /identification/ of multiline elements by providing +a function that tries to find such elements and move the boundaries such that +they do not fall in the middle of one. +Each function is called with two arguments (START and END) and it should return +either a cons (NEW-START . NEW-END) or nil if no adjustment should be made. +These functions are run in turn repeatedly until they all return nil. +Put first the functions more likely to cause a change and cheaper to compute.") +;; Mark it as a special hook which doesn't use any global setting +;; (i.e. doesn't obey the element t in the buffer-local value). +(make-variable-buffer-local 'syntax-propertize-extend-region-functions) + +(defun syntax-propertize-wholelines (start end) + (goto-char start) + (cons (line-beginning-position) + (progn (goto-char end) + (if (bolp) (point) (line-beginning-position 2))))) + +(defun syntax-propertize-multiline (beg end) + "Let `syntax-propertize' pay attention to the syntax-multiline property." + (when (and (> beg (point-min)) + (get-text-property (1- beg) 'syntax-multiline)) + (setq beg (or (previous-single-property-change beg 'syntax-multiline) + (point-min)))) + ;; + (when (get-text-property end 'font-lock-multiline) + (setq end (or (text-property-any end (point-max) + 'syntax-multiline nil) + (point-max)))) + (cons beg end)) + +(defvar syntax-propertize--done -1 + "Position upto which syntax-table properties have been set.") +(make-variable-buffer-local 'syntax-propertize--done) + +(defun syntax-propertize--shift-groups (re n) + (replace-regexp-in-string + "\\\\(\\?\\([0-9]+\\):" + (lambda (s) + (replace-match + (number-to-string (+ n (string-to-number (match-string 1 s)))) + t t s 1)) + re t t)) + +(defmacro syntax-propertize-rules (&rest rules) + "Make a function that applies RULES for use in `syntax-propertize-function'. +The function will scan the buffer, applying the rules where they match. +The buffer is scanned a single time, like \"lex\" would, rather than once +per rule. + +Each rule has the form (REGEXP HIGHLIGHT1 ... HIGHLIGHTn), where REGEXP +is an expression (evaluated at time of macro-expansion) that returns a regexp, +and where HIGHLIGHTs have the form (NUMBER SYNTAX) which means to +apply the property SYNTAX to the chars matched by the subgroup NUMBER +of the regular expression, if NUMBER did match. +SYNTAX is an expression that returns a value to apply as `syntax-table' +property. Some expressions are handled specially: +- if SYNTAX is a string, then it is converted with `string-to-syntax'; +- if SYNTAX has the form (prog1 EXP . EXPS) then the value returned by EXP + will be applied to the buffer before running EXPS and if EXP is a string it + is also converted with `string-to-syntax'. +The SYNTAX expression is responsible to save the `match-data' if needed +for subsequent HIGHLIGHTs. +Also SYNTAX is free to move point, in which case RULES may not be applied to +some parts of the text or may be applied several times to other parts. + +Note: back-references in REGEXPs do not work." + (declare (debug (&rest (form &rest + (numberp + [&or stringp + ("prog1" [&or stringp def-form] def-body) + def-form]))))) + (let* ((offset 0) + (branches '()) + ;; We'd like to use a real DFA-based lexer, usually, but since Emacs + ;; doesn't have one yet, we fallback on building one large regexp + ;; and use groups to determine which branch of the regexp matched. + (re + (mapconcat + (lambda (rule) + (let ((re (eval (car rule)))) + (when (and (assq 0 rule) (cdr rules)) + ;; If there's more than 1 rule, and the rule want to apply + ;; highlight to match 0, create an extra group to be able to + ;; tell when *this* match 0 has succeeded. + (incf offset) + (setq re (concat "\\(" re "\\)"))) + (setq re (syntax-propertize--shift-groups re offset)) + (let ((code '()) + (condition + (cond + ((assq 0 rule) (if (zerop offset) t + `(match-beginning ,offset))) + ((null (cddr rule)) + `(match-beginning ,(+ offset (car (cadr rule))))) + (t + `(or ,@(mapcar + (lambda (case) + `(match-beginning ,(+ offset (car case)))) + (cdr rule)))))) + (nocode t) + (offset offset)) + ;; If some of the subgroup rules include Elisp code, then we + ;; need to set the match-data so it's consistent with what the + ;; code expects. If not, then we can simply use shifted + ;; offset in our own code. + (unless (zerop offset) + (dolist (case (cdr rule)) + (unless (stringp (cadr case)) + (setq nocode nil))) + (unless nocode + (push `(let ((md (match-data 'ints))) + ;; Keep match 0 as is, but shift everything else. + (setcdr (cdr md) (nthcdr ,(* (1+ offset) 2) md)) + (set-match-data md)) + code) + (setq offset 0))) + ;; Now construct the code for each subgroup rules. + (dolist (case (cdr rule)) + (assert (null (cddr case))) + (let* ((gn (+ offset (car case))) + (action (nth 1 case)) + (thiscode + (cond + ((stringp action) + `((put-text-property + (match-beginning ,gn) (match-end ,gn) + 'syntax-table + ',(string-to-syntax action)))) + ((eq (car-safe action) 'ignore) + (cdr action)) + ((eq (car-safe action) 'prog1) + (if (stringp (nth 1 action)) + `((put-text-property + (match-beginning ,gn) (match-end ,gn) + 'syntax-table + ',(string-to-syntax (nth 1 action))) + ,@(nthcdr 2 action)) + `((let ((mb (match-beginning ,gn)) + (me (match-end ,gn)) + (syntax ,(nth 1 action))) + (if syntax + (put-text-property + mb me 'syntax-table syntax)) + ,@(nthcdr 2 action))))) + (t + `((let ((mb (match-beginning ,gn)) + (me (match-end ,gn)) + (syntax ,action)) + (if syntax + (put-text-property + mb me 'syntax-table syntax)))))))) + + (if (or (not (cddr rule)) (zerop gn)) + (setq code (nconc (nreverse thiscode) code)) + (push `(if (match-beginning ,gn) + ;; Try and generate clean code with no + ;; extraneous progn. + ,(if (null (cdr thiscode)) + (car thiscode) + `(progn ,@thiscode))) + code)))) + (push (cons condition (nreverse code)) + branches)) + (incf offset (regexp-opt-depth re)) + re)) + rules + "\\|"))) + `(lambda (start end) + (goto-char start) + (while (and (< (point) end) + (re-search-forward ,re end t)) + (cond ,@(nreverse branches)))))) + +(defun syntax-propertize-via-font-lock (keywords) + "Propertize for syntax in START..END using font-lock syntax. +KEYWORDS obeys the format used in `font-lock-syntactic-keywords'. +The return value is a function suitable for `syntax-propertize-function'." + (lexical-let ((keywords keywords)) + (lambda (start end) + (with-no-warnings + (let ((font-lock-syntactic-keywords keywords)) + (font-lock-fontify-syntactic-keywords-region start end) + ;; In case it was eval'd/compiled. + (setq keywords font-lock-syntactic-keywords)))))) + +(defun syntax-propertize (pos) + "Ensure that syntax-table properties are set upto POS." + (when (and syntax-propertize-function + (< syntax-propertize--done pos)) + ;; (message "Needs to syntax-propertize from %s to %s" + ;; syntax-propertize--done pos) + (set (make-local-variable 'parse-sexp-lookup-properties) t) + (save-excursion + (with-silent-modifications + (let* ((start (max syntax-propertize--done (point-min))) + (end (max pos + (min (point-max) + (+ start syntax-propertize-chunk-size)))) + (funs syntax-propertize-extend-region-functions)) + (while funs + (let ((new (funcall (pop funs) start end))) + (if (or (null new) + (and (>= (car new) start) (<= (cdr new) end))) + nil + (setq start (car new)) + (setq end (cdr new)) + ;; If there's been a change, we should go through the + ;; list again since this new position may + ;; warrant a different answer from one of the funs we've + ;; already seen. + (unless (eq funs + (cdr syntax-propertize-extend-region-functions)) + (setq funs syntax-propertize-extend-region-functions))))) + ;; Move the limit before calling the function, so the function + ;; can use syntax-ppss. + (setq syntax-propertize--done end) + ;; (message "syntax-propertizing from %s to %s" start end) + (remove-text-properties start end + '(syntax-table nil syntax-multiline nil)) + (funcall syntax-propertize-function start end)))))) + +;;; Incrementally compute and memoize parser state. + (defsubst syntax-ppss-depth (ppss) (nth 0 ppss)) @@ -92,6 +334,8 @@ point (where the PPSS is equivalent to nil).") (defalias 'syntax-ppss-after-change-function 'syntax-ppss-flush-cache) (defun syntax-ppss-flush-cache (beg &rest ignored) "Flush the cache of `syntax-ppss' starting at position BEG." + ;; Set syntax-propertize to refontify anything past beg. + (setq syntax-propertize--done (min beg syntax-propertize--done)) ;; Flush invalid cache entries. (while (and syntax-ppss-cache (> (caar syntax-ppss-cache) beg)) (setq syntax-ppss-cache (cdr syntax-ppss-cache))) @@ -128,6 +372,7 @@ the 2nd and 6th values of the returned state cannot be relied upon. Point is at POS when this function returns." ;; Default values. (unless pos (setq pos (point))) + (syntax-propertize pos) ;; (let ((old-ppss (cdr syntax-ppss-last)) (old-pos (car syntax-ppss-last)) @@ -209,7 +454,8 @@ Point is at POS when this function returns." (funcall syntax-begin-function) ;; Make sure it's better. (> (point) pt-best)) - ;; Simple sanity check. + ;; Simple sanity checks. + (< (point) pos) ; backward-paragraph can fail here. (not (memq (get-text-property (point) 'face) '(font-lock-string-face font-lock-doc-face font-lock-comment-face)))) diff --git a/lisp/emacs-lisp/tcover-ses.el b/lisp/emacs-lisp/tcover-ses.el index cf5e79d2a26..8df70f4d979 100644 --- a/lisp/emacs-lisp/tcover-ses.el +++ b/lisp/emacs-lisp/tcover-ses.el @@ -6,6 +6,7 @@ ;; Author: Jonathan Yavner <jyavner@engineer.com> ;; Maintainer: Jonathan Yavner <jyavner@engineer.com> ;; Keywords: spreadsheet lisp utility +;; Package: testcover ;; 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 diff --git a/lisp/emacs-lisp/tcover-unsafep.el b/lisp/emacs-lisp/tcover-unsafep.el index b300ee6dcef..47f931bf9d3 100644 --- a/lisp/emacs-lisp/tcover-unsafep.el +++ b/lisp/emacs-lisp/tcover-unsafep.el @@ -5,6 +5,7 @@ ;; Author: Jonathan Yavner <jyavner@engineer.com> ;; Maintainer: Jonathan Yavner <jyavner@engineer.com> ;; Keywords: safety lisp utility +;; Package: testcover ;; This file is part of GNU Emacs. diff --git a/lisp/emacs-lisp/timer.el b/lisp/emacs-lisp/timer.el index 94f39940b66..6ae6a86857e 100644 --- a/lisp/emacs-lisp/timer.el +++ b/lisp/emacs-lisp/timer.el @@ -4,6 +4,7 @@ ;; 2009, 2010 Free Software Foundation, Inc. ;; Maintainer: FSF +;; Package: emacs ;; This file is part of GNU Emacs. @@ -442,8 +443,6 @@ This function returns a timer object which you can use in `cancel-timer'." "This is the timer function used for the timer made by `with-timeout'." (throw tag 'timeout)) -(put 'with-timeout 'lisp-indent-function 1) - (defvar with-timeout-timers nil "List of all timers used by currently pending `with-timeout' calls.") @@ -455,6 +454,7 @@ event (such as keyboard input, input from subprocesses, or a certain time); if the program loops without waiting in any way, the timeout will not be detected. \n(fn (SECONDS TIMEOUT-FORMS...) BODY)" + (declare (indent 1)) (let ((seconds (car list)) (timeout-forms (cdr list))) `(let ((with-timeout-tag (cons nil nil)) diff --git a/lisp/emulation/cua-gmrk.el b/lisp/emulation/cua-gmrk.el index b67d09c04cf..761a3d5ec24 100644 --- a/lisp/emulation/cua-gmrk.el +++ b/lisp/emulation/cua-gmrk.el @@ -5,6 +5,7 @@ ;; Author: Kim F. Storm <storm@cua.dk> ;; Keywords: keyboard emulations convenience cua mark +;; Package: cua-base ;; This file is part of GNU Emacs. diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el index 5d50d6f48d3..2cbf4438869 100644 --- a/lisp/emulation/cua-rect.el +++ b/lisp/emulation/cua-rect.el @@ -5,6 +5,7 @@ ;; Author: Kim F. Storm <storm@cua.dk> ;; Keywords: keyboard emulations convenience CUA +;; Package: cua-base ;; This file is part of GNU Emacs. diff --git a/lisp/emulation/edt-lk201.el b/lisp/emulation/edt-lk201.el index 6cce36e42a1..e50e064077d 100644 --- a/lisp/emulation/edt-lk201.el +++ b/lisp/emulation/edt-lk201.el @@ -6,6 +6,7 @@ ;; Author: Kevin Gallagher <Kevin.Gallagher@boeing.com> ;; Maintainer: Kevin Gallagher <Kevin.Gallagher@boeing.com> ;; Keywords: emulations +;; Package: edt ;; This file is part of GNU Emacs. diff --git a/lisp/emulation/edt-mapper.el b/lisp/emulation/edt-mapper.el index e5c0ceecf1c..6bf50db5442 100644 --- a/lisp/emulation/edt-mapper.el +++ b/lisp/emulation/edt-mapper.el @@ -6,6 +6,7 @@ ;; Author: Kevin Gallagher <Kevin.Gallagher@boeing.com> ;; Maintainer: Kevin Gallagher <Kevin.Gallagher@boeing.com> ;; Keywords: emulations +;; Package: edt ;; This file is part of GNU Emacs. diff --git a/lisp/emulation/edt-pc.el b/lisp/emulation/edt-pc.el index 0cd421620ab..04128ac00b9 100644 --- a/lisp/emulation/edt-pc.el +++ b/lisp/emulation/edt-pc.el @@ -6,6 +6,7 @@ ;; Author: Kevin Gallagher <Kevin.Gallagher@boeing.com> ;; Maintainer: Kevin Gallagher <Kevin.Gallagher@boeing.com> ;; Keywords: emulations +;; Package: edt ;; This file is part of GNU Emacs. diff --git a/lisp/emulation/edt-vt100.el b/lisp/emulation/edt-vt100.el index f14bdfc79cb..9416a9ad48a 100644 --- a/lisp/emulation/edt-vt100.el +++ b/lisp/emulation/edt-vt100.el @@ -6,6 +6,7 @@ ;; Author: Kevin Gallagher <Kevin.Gallagher@boeing.com> ;; Maintainer: Kevin Gallagher <Kevin.Gallagher@boeing.com> ;; Keywords: emulations +;; Package: edt ;; This file is part of GNU Emacs. diff --git a/lisp/emulation/tpu-edt.el b/lisp/emulation/tpu-edt.el index c5dd9b3cf32..bcd67d4aff7 100644 --- a/lisp/emulation/tpu-edt.el +++ b/lisp/emulation/tpu-edt.el @@ -2438,7 +2438,7 @@ If FILE is nil, try to load a default file. The default file names are ;;;### (autoloads (tpu-set-cursor-bound tpu-set-cursor-free tpu-set-scroll-margins -;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "d003e4c2f1291eccc629926bb0f88e17") +;;;;;; tpu-cursor-free-mode) "tpu-extras" "tpu-extras.el" "78abc50917c93d2b35596d307fc638c4") ;;; Generated autoloads from tpu-extras.el (autoload 'tpu-cursor-free-mode "tpu-extras" "\ diff --git a/lisp/emulation/tpu-extras.el b/lisp/emulation/tpu-extras.el index 2fc9ce516f5..dbad4f787a0 100644 --- a/lisp/emulation/tpu-extras.el +++ b/lisp/emulation/tpu-extras.el @@ -6,6 +6,7 @@ ;; Author: Rob Riepel <riepel@networking.stanford.edu> ;; Maintainer: Rob Riepel <riepel@networking.stanford.edu> ;; Keywords: emulations +;; Package: tpu-edt ;; This file is part of GNU Emacs. diff --git a/lisp/emulation/tpu-mapper.el b/lisp/emulation/tpu-mapper.el index ed42824a8bb..b4942564eba 100644 --- a/lisp/emulation/tpu-mapper.el +++ b/lisp/emulation/tpu-mapper.el @@ -6,6 +6,7 @@ ;; Author: Rob Riepel <riepel@networking.stanford.edu> ;; Maintainer: Rob Riepel <riepel@networking.stanford.edu> ;; Keywords: emulations +;; Package: tpu-edt ;; This file is part of GNU Emacs. diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 602b442a045..07719ba45be 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -4,6 +4,7 @@ ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> +;; Package: viper ;; This file is part of GNU Emacs. diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el index 80853fd5680..be387d7724b 100644 --- a/lisp/emulation/viper-ex.el +++ b/lisp/emulation/viper-ex.el @@ -4,6 +4,7 @@ ;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> +;; Package: viper ;; This file is part of GNU Emacs. diff --git a/lisp/emulation/viper-init.el b/lisp/emulation/viper-init.el index 68f729e8b43..ebd18d47e15 100644 --- a/lisp/emulation/viper-init.el +++ b/lisp/emulation/viper-init.el @@ -4,6 +4,7 @@ ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> +;; Package: viper ;; This file is part of GNU Emacs. diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el index cfc84956dac..d75573673d7 100644 --- a/lisp/emulation/viper-keym.el +++ b/lisp/emulation/viper-keym.el @@ -4,6 +4,7 @@ ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> +;; Package: viper ;; This file is part of GNU Emacs. diff --git a/lisp/emulation/viper-macs.el b/lisp/emulation/viper-macs.el index ec31aeef428..71d565632eb 100644 --- a/lisp/emulation/viper-macs.el +++ b/lisp/emulation/viper-macs.el @@ -4,6 +4,7 @@ ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> +;; Package: viper ;; This file is part of GNU Emacs. diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el index dd1cd5362ce..9bea921e167 100644 --- a/lisp/emulation/viper-mous.el +++ b/lisp/emulation/viper-mous.el @@ -4,6 +4,7 @@ ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> +;; Package: viper ;; This file is part of GNU Emacs. diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el index 99dd305cb4c..1ad24da1ef8 100644 --- a/lisp/emulation/viper-util.el +++ b/lisp/emulation/viper-util.el @@ -4,6 +4,7 @@ ;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> +;; Package: viper ;; This file is part of GNU Emacs. diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el index 302cfa82958..04833a836a6 100644 --- a/lisp/emulation/viper.el +++ b/lisp/emulation/viper.el @@ -8,6 +8,7 @@ ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> ;; Keywords: emulations +;; Version: 3.14.1 ;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this ;; file on 20/3/2008, and the maintainer agreed that when a bug is diff --git a/lisp/env.el b/lisp/env.el index 0699e907fa8..b69f2d2b0e3 100644 --- a/lisp/env.el +++ b/lisp/env.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: processes, unix +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/epa-dired.el b/lisp/epa-dired.el index 7ba414da2f9..80ecef6f54f 100644 --- a/lisp/epa-dired.el +++ b/lisp/epa-dired.el @@ -3,6 +3,7 @@ ;; Author: Daiki Ueno <ueno@unixuser.org> ;; Keywords: PGP, GnuPG +;; Package: epa ;; This file is part of GNU Emacs. diff --git a/lisp/epa-file.el b/lisp/epa-file.el index af016eb20be..3c6cf07ea1b 100644 --- a/lisp/epa-file.el +++ b/lisp/epa-file.el @@ -3,6 +3,7 @@ ;; Author: Daiki Ueno <ueno@unixuser.org> ;; Keywords: PGP, GnuPG +;; Package: epa ;; This file is part of GNU Emacs. @@ -157,12 +158,17 @@ way." (if (or beg end) (setq string (substring string (or beg 0) end))) (save-excursion - (save-restriction - (narrow-to-region (point) (point)) - (epa-file-decode-and-insert string file visit beg end replace) - (setq length (- (point-max) (point-min)))) - (if replace - (delete-region (point) (point-max))) + ;; If visiting, bind off buffer-file-name so that + ;; file-locking will not ask whether we should + ;; really edit the buffer. + (let ((buffer-file-name + (if visit nil buffer-file-name))) + (save-restriction + (narrow-to-region (point) (point)) + (epa-file-decode-and-insert string file visit beg end replace) + (setq length (- (point-max) (point-min)))) + (if replace + (delete-region (point) (point-max)))) (if visit (set-visited-file-modtime)))) (if (and local-copy diff --git a/lisp/epa-hook.el b/lisp/epa-hook.el index 9ed2feb15bf..5fb7e2c0bf3 100644 --- a/lisp/epa-hook.el +++ b/lisp/epa-hook.el @@ -3,6 +3,7 @@ ;; Author: Daiki Ueno <ueno@unixuser.org> ;; Keywords: PGP, GnuPG +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/epa-mail.el b/lisp/epa-mail.el index 69fb6d7d7e8..09b30868115 100644 --- a/lisp/epa-mail.el +++ b/lisp/epa-mail.el @@ -3,6 +3,7 @@ ;; Author: Daiki Ueno <ueno@unixuser.org> ;; Keywords: PGP, GnuPG, mail, message +;; Package: epa ;; This file is part of GNU Emacs. diff --git a/lisp/epg-config.el b/lisp/epg-config.el index ddbdd3541ad..37c5d01fb1d 100644 --- a/lisp/epg-config.el +++ b/lisp/epg-config.el @@ -4,6 +4,7 @@ ;; Author: Daiki Ueno <ueno@unixuser.org> ;; Keywords: PGP, GnuPG +;; Package: epg ;; This file is part of GNU Emacs. diff --git a/lisp/epg.el b/lisp/epg.el index 9a75560704a..fae896c4ae0 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -4,6 +4,7 @@ ;; Author: Daiki Ueno <ueno@unixuser.org> ;; Keywords: PGP, GnuPG +;; Version: 1.0.0 ;; This file is part of GNU Emacs. diff --git a/lisp/erc/ChangeLog b/lisp/erc/ChangeLog index 6591db6cd94..90b3131ebd8 100644 --- a/lisp/erc/ChangeLog +++ b/lisp/erc/ChangeLog @@ -1,3 +1,10 @@ +2010-08-14 Vivek Dasmohapatra <vivek@etla.org> + + * erc-join.el (erc-autojoin-timing, erc-autojoin-delay): New vars. + (erc-autojoin-channels-delayed, erc-autojoin-after-ident): New + functions. + (erc-autojoin-channels): Allow autojoining after ident (Bug#5521). + 2010-08-08 Fran Litterio <flitterio@gmail.com> * erc-backend.el (erc-server-filter-function): Call diff --git a/lisp/erc/erc-join.el b/lisp/erc/erc-join.el index 7081d97fc4b..c54c2c534f3 100644 --- a/lisp/erc/erc-join.el +++ b/lisp/erc/erc-join.el @@ -42,9 +42,11 @@ (define-erc-module autojoin nil "Makes ERC autojoin on connects and reconnects." ((add-hook 'erc-after-connect 'erc-autojoin-channels) + (add-hook 'erc-nickserv-identified-hook 'erc-autojoin-after-ident) (add-hook 'erc-server-JOIN-functions 'erc-autojoin-add) (add-hook 'erc-server-PART-functions 'erc-autojoin-remove)) ((remove-hook 'erc-after-connect 'erc-autojoin-channels) + (remove-hook 'erc-nickserv-identified-hook 'erc-autojoin-after-ident) (remove-hook 'erc-server-JOIN-functions 'erc-autojoin-add) (remove-hook 'erc-server-PART-functions 'erc-autojoin-remove))) @@ -66,6 +68,24 @@ time is used again." (repeat :tag "Channels" (string :tag "Name"))))) +(defcustom erc-autojoin-timing 'connect + "When ERC should attempt to autojoin a channel. +If the value is `connect', autojoin immediately on connecting. +If the value is `ident', autojoin after successful NickServ +identification, or after `erc-autojoin-delay' seconds. +Any other value means the same as `connect'." + :group 'erc-autojoin + :type '(choice (const :tag "On Connection" 'connect) + (const :tag "When Identified" 'ident))) + +(defcustom erc-autojoin-delay 30 + "Number of seconds to wait before attempting to autojoin channels. +This only takes effect if `erc-autojoin-timing' is `ident'. +If NickServ identification occurs before this delay expires, ERC +autojoins immediately at that time." + :group 'erc-autojoin + :type 'integer) + (defcustom erc-autojoin-domain-only t "Truncate host name to the domain name when joining a server. If non-nil, and a channel on the server a.b.c is joined, then @@ -75,12 +95,60 @@ servers, presumably in the same domain." :group 'erc-autojoin :type 'boolean) +(defvar erc--autojoin-timer nil) +(make-variable-buffer-local 'erc--autojoin-timer) + +(defun erc-autojoin-channels-delayed (server nick buffer) + "Attempt to autojoin channels. +This is called from a timer set up by `erc-autojoin-channels'." + (if erc--autojoin-timer + (setq erc--autojoin-timer + (erc-cancel-timer erc--autojoin-timer))) + (with-current-buffer buffer + ;; Don't kick of another delayed autojoin or try to wait for + ;; another ident response: + (let ((erc-autojoin-delay -1) + (erc-autojoin-timing 'connect)) + (erc-log "Delayed autojoin started (no ident success detected yet)") + (erc-autojoin-channels server nick)))) + +(defun erc-autojoin-after-ident (network nick) + "Autojoin channels in `erc-autojoin-channels-alist'. +This function is run from `erc-nickserv-identified-hook'." + (if erc--autojoin-timer + (setq erc--autojoin-timer + (erc-cancel-timer erc--autojoin-timer))) + (when (eq erc-autojoin-timing 'ident) + (let ((server (or erc-server-announced-name erc-session-server)) + (joined (mapcar (lambda (buf) + (with-current-buffer buf (erc-default-target))) + (erc-channel-list erc-server-process)))) + ;; We may already be in these channels, e.g. because the + ;; autojoin timer went off. + (dolist (l erc-autojoin-channels-alist) + (when (string-match (car l) server) + (dolist (chan (cdr l)) + (unless (erc-member-ignore-case chan joined) + (erc-server-send (concat "join " chan)))))))) + nil) + (defun erc-autojoin-channels (server nick) "Autojoin channels in `erc-autojoin-channels-alist'." - (dolist (l erc-autojoin-channels-alist) - (when (string-match (car l) server) - (dolist (chan (cdr l)) - (erc-server-send (concat "join " chan)))))) + (if (eq erc-autojoin-timing 'ident) + ;; Prepare the delayed autojoin timer, in case ident doesn't + ;; happen within the allotted time limit: + (when (> erc-autojoin-delay 0) + (setq erc--autojoin-timer + (run-with-timer erc-autojoin-delay nil + 'erc-autojoin-channels-delayed + server nick (current-buffer)))) + ;; `erc-autojoin-timing' is `connect': + (dolist (l erc-autojoin-channels-alist) + (when (string-match (car l) server) + (dolist (chan (cdr l)) + (erc-server-send (concat "join " chan)))))) + ;; Return nil to avoid stomping on any other hook funcs. + nil) (defun erc-autojoin-add (proc parsed) "Add the channel being joined to `erc-autojoin-channels-alist'." diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index ce4c9a46f5b..54f87982f8f 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -12,6 +12,7 @@ ;; David Edmondson (dme@dme.org) ;; Maintainer: Michael Olson (mwolson@gnu.org) ;; Keywords: IRC, chat, client, Internet +;; Version: 5.3 ;; This file is part of GNU Emacs. diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el index 8662dd9fffb..826e7ec0d05 100644 --- a/lisp/eshell/em-term.el +++ b/lisp/eshell/em-term.el @@ -187,8 +187,7 @@ allowed." ; (if (boundp 'xemacs-logo) ; (eshell-term-send-raw-string ; (or (condition-case () (x-get-selection) (error ())) -; (x-get-cutbuffer) -; (error "No selection or cut buffer available"))) +; (error "No selection available"))) ; ;; Give temporary modes such as isearch a chance to turn off. ; (run-hooks 'mouse-leave-buffer-hook) ; (setq this-command 'yank) diff --git a/lisp/facemenu.el b/lisp/facemenu.el index 20b86676ea9..5249538d711 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -5,6 +5,7 @@ ;; Author: Boris Goldowsky <boris@gnu.org> ;; Keywords: faces +;; Package: emacs ;; This file is part of GNU Emacs. @@ -699,6 +700,22 @@ determine the correct answer." (cond ((equal a b) t) ((equal (color-values a) (color-values b))))) + +(defvar facemenu-self-insert-data nil) + +(defun facemenu-post-self-insert-function () + (when (and (car facemenu-self-insert-data) + (eq last-command (cdr facemenu-self-insert-data))) + (put-text-property (1- (point)) (point) + 'face (car facemenu-self-insert-data)) + (setq facemenu-self-insert-data nil)) + (remove-hook 'post-self-insert-hook 'facemenu-post-self-insert-function)) + +(defun facemenu-set-self-insert-face (face) + "Arrange for the next self-inserted char to have face `face'." + (setq facemenu-self-insert-data (cons face this-command)) + (add-hook 'post-self-insert-hook 'facemenu-post-self-insert-function)) + (defun facemenu-add-face (face &optional start end) "Add FACE to text between START and END. If START is nil or START to END is empty, add FACE to next typed character @@ -712,51 +729,52 @@ As a special case, if FACE is `default', then the region is left with NO face text property. Otherwise, selecting the default face would not have any effect. See `facemenu-remove-face-function'." (interactive "*xFace: \nr") - (if (and (eq face 'default) - (not (eq facemenu-remove-face-function t))) - (if facemenu-remove-face-function - (funcall facemenu-remove-face-function start end) - (if (and start (< start end)) - (remove-text-properties start end '(face default)) - (setq self-insert-face 'default - self-insert-face-command this-command))) - (if facemenu-add-face-function - (save-excursion - (if end (goto-char end)) - (save-excursion - (if start (goto-char start)) - (insert-before-markers - (funcall facemenu-add-face-function face end))) - (if facemenu-end-add-face - (insert (if (stringp facemenu-end-add-face) - facemenu-end-add-face - (funcall facemenu-end-add-face face))))) + (cond + ((and (eq face 'default) + (not (eq facemenu-remove-face-function t))) + (if facemenu-remove-face-function + (funcall facemenu-remove-face-function start end) (if (and start (< start end)) - (let ((part-start start) part-end) - (while (not (= part-start end)) - (setq part-end (next-single-property-change part-start 'face - nil end)) - (let ((prev (get-text-property part-start 'face))) - (put-text-property part-start part-end 'face - (if (null prev) - face - (facemenu-active-faces - (cons face - (if (listp prev) - prev - (list prev))) - ;; Specify the selected frame - ;; because nil would mean to use - ;; the new-frame default settings, - ;; and those are usually nil. - (selected-frame))))) - (setq part-start part-end))) - (setq self-insert-face (if (eq last-command self-insert-face-command) - (cons face (if (listp self-insert-face) - self-insert-face - (list self-insert-face))) - face) - self-insert-face-command this-command)))) + (remove-text-properties start end '(face default)) + (facemenu-set-self-insert-face 'default)))) + (facemenu-add-face-function + (save-excursion + (if end (goto-char end)) + (save-excursion + (if start (goto-char start)) + (insert-before-markers + (funcall facemenu-add-face-function face end))) + (if facemenu-end-add-face + (insert (if (stringp facemenu-end-add-face) + facemenu-end-add-face + (funcall facemenu-end-add-face face)))))) + ((and start (< start end)) + (let ((part-start start) part-end) + (while (not (= part-start end)) + (setq part-end (next-single-property-change part-start 'face + nil end)) + (let ((prev (get-text-property part-start 'face))) + (put-text-property part-start part-end 'face + (if (null prev) + face + (facemenu-active-faces + (cons face + (if (listp prev) + prev + (list prev))) + ;; Specify the selected frame + ;; because nil would mean to use + ;; the new-frame default settings, + ;; and those are usually nil. + (selected-frame))))) + (setq part-start part-end)))) + (t + (facemenu-set-self-insert-face + (if (eq last-command (cdr facemenu-self-insert-data)) + (cons face (if (listp (car facemenu-self-insert-data)) + (car facemenu-self-insert-data) + (list (car facemenu-self-insert-data)))) + face)))) (unless (facemenu-enable-faces-p) (message "Font-lock mode will override any faces you set in this buffer"))) diff --git a/lisp/faces.el b/lisp/faces.el index b7c238e14f3..400a0f1c96e 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -6,6 +6,7 @@ ;; Maintainer: FSF ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. @@ -2281,6 +2282,9 @@ terminal type to a different value." (defface region '((((class color) (min-colors 88) (background dark)) :background "blue3") + (((class color) (min-colors 88) (background light) (type gtk)) + :foreground "gtk_selection_fg_color" + :background "gtk_selection_bg_color") (((class color) (min-colors 88) (background light) (type ns)) :background "ns_selection_color") (((class color) (min-colors 88) (background light)) diff --git a/lisp/files-x.el b/lisp/files-x.el index 096f302820a..222141bd357 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -5,6 +5,7 @@ ;; Author: Juri Linkov <juri@jurta.org> ;; Maintainer: FSF ;; Keywords: files +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/files.el b/lisp/files.el index 8b131e04ebc..ef74b54ca60 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -1,3 +1,18 @@ +;; (defun auto-save-mode (arg) +;; "Toggle auto-saving of contents of current buffer. +;; With prefix argument ARG, turn auto-saving on if positive, else off." +;; (interactive) +;; (if (> arg 0) auto-save (null auto-save))) + + +;; (defun auto-fill-mode (arg) +;; "Toggle Auto Fill mode. +;; With ARG, turn Auto Fill mode on if and only if ARG is positive. +;; In Auto Fill mode, inserting a space at a column beyond `current-fill-column' +;; automatically breaks the line at a previous space." +;; (interactive) +;; (if (> arg 0) auto-fill (null auto-fill))) + ;;; files.el --- file input and output commands for Emacs ;; Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994, 1995, 1996, @@ -5,6 +20,7 @@ ;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Maintainer: FSF +;; Package: emacs ;; This file is part of GNU Emacs. @@ -66,9 +82,9 @@ Use this feature when you have directories which you normally refer to via absolute symbolic links. Make TO the name of the link, and FROM the name it is linked to." :type '(repeat (cons :format "%v" - :value ("" . "") + :value ("\\`" . "") (regexp :tag "From") - (regexp :tag "To"))) + (string :tag "To"))) :group 'abbrev :group 'find-file) @@ -757,21 +773,44 @@ one or more of those symbols." (let ((x (file-name-directory suffix))) (if x (1- (length x)) (length suffix)))))) (t - (let ((names nil) + (let ((names '()) + ;; If we have files like "foo.el" and "foo.elc", we could load one of + ;; them with "foo.el", "foo.elc", or "foo", where just "foo" is the + ;; preferred way. So if we list all 3, that gives a lot of redundant + ;; entries for the poor soul looking just for "foo". OTOH, sometimes + ;; the user does want to pay attention to the extension. We try to + ;; diffuse this tension by stripping the suffix, except when the + ;; result is a single element (i.e. usually we only list "foo" unless + ;; it's the only remaining element in the list, in which case we do + ;; list "foo", "foo.elc" and "foo.el"). + (fullnames '()) (suffix (concat (regexp-opt suffixes t) "\\'")) (string-dir (file-name-directory string)) (string-file (file-name-nondirectory string))) (dolist (dir dirs) - (unless dir - (setq dir default-directory)) - (if string-dir (setq dir (expand-file-name string-dir dir))) - (when (file-directory-p dir) - (dolist (file (file-name-all-completions - string-file dir)) - (push file names) - (when (string-match suffix file) - (setq file (substring file 0 (match-beginning 0))) - (push file names))))) + (unless dir + (setq dir default-directory)) + (if string-dir (setq dir (expand-file-name string-dir dir))) + (when (file-directory-p dir) + (dolist (file (file-name-all-completions + string-file dir)) + (if (not (string-match suffix file)) + (push file names) + (push file fullnames) + (push (substring file 0 (match-beginning 0)) names))))) + ;; Switching from names to names+fullnames creates a non-monotonicity + ;; which can cause problems with things like partial-completion. + ;; To minimize the problem, filter out completion-regexp-list, so that + ;; M-x load-library RET t/x.e TAB finds some files. + (if completion-regexp-list + (setq names (all-completions "" names))) + ;; Remove duplicates of the first element, so that we can easily check + ;; if `names' really only contains a single element. + (when (cdr names) (setcdr names (delete (car names) (cdr names)))) + (unless (cdr names) + ;; There's no more than one matching non-suffixed element, so expand + ;; the list by adding the suffixed elements as well. + (setq names (nconc names fullnames))) (completion-table-with-context string-dir names string-file pred action))))) @@ -2782,6 +2821,7 @@ asking you for confirmation." (no-update-autoloads . booleanp) (tab-width . integerp) ;; C source code (truncate-lines . booleanp) ;; C source code + (word-wrap . booleanp) ;; C source code (bidi-display-reordering . booleanp))) ;; C source code (put 'bidi-paragraph-direction 'safe-local-variable @@ -5538,12 +5578,14 @@ preference to the program given by this variable." (defun get-free-disk-space (dir) "Return the amount of free space on directory DIR's file system. -The result is a string that gives the number of free 1KB blocks, -or nil if the system call or the program which retrieve the information -fail. It returns also nil when DIR is a remote directory. - -This function calls `file-system-info' if it is available, or invokes the -program specified by `directory-free-space-program' if that is non-nil." +The return value is a string describing the amount of free +space (normally, the number of free 1KB blocks). + +This function calls `file-system-info' if it is available, or +invokes the program specified by `directory-free-space-program' +and `directory-free-space-args'. If the system call or program +is unsuccessful, or if DIR is a remote directory, this function +returns nil." (unless (file-remote-p dir) ;; Try to find the number of free blocks. Non-Posix systems don't ;; always have df, but might have an equivalent system call. @@ -5563,19 +5605,22 @@ program specified by `directory-free-space-program' if that is non-nil." directory-free-space-args dir) 0))) - ;; Usual format is a header line followed by a line of - ;; numbers. + ;; Usual format is as follows: + ;; Filesystem ... Used Available Capacity ... + ;; /dev/sda6 ...48106535 35481255 10669850 ... (goto-char (point-min)) - (forward-line 1) - (if (not (eobp)) - (progn - ;; Move to the end of the "available blocks" number. - (skip-chars-forward "^ \t") - (forward-word 3) - ;; Copy it into AVAILABLE. - (let ((end (point))) - (forward-word -1) - (buffer-substring (point) end)))))))))) + (when (re-search-forward " +Avail[^ \n]*" + (line-end-position) t) + (let ((beg (match-beginning 0)) + (end (match-end 0)) + str) + (forward-line 1) + (setq str + (buffer-substring-no-properties + (+ beg (point) (- (point-min))) + (+ end (point) (- (point-min))))) + (when (string-match "\\` *\\([^ ]+\\)" str) + (match-string 1 str)))))))))) ;; The following expression replaces `dired-move-to-filename-regexp'. (defvar directory-listing-before-filename-regexp diff --git a/lisp/finder.el b/lisp/finder.el index b7eccf3ac70..0c12a08d104 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -30,55 +30,50 @@ ;;; Code: +(require 'package) (require 'lisp-mnt) -(require 'find-func) ;for find-library(-suffixes) -;; Use `load' rather than `require' so that it doesn't get loaded -;; during byte-compilation (at which point it might be missing). -(load "finder-inf" t t) +(require 'find-func) ;for find-library(-suffixes) +(require 'finder-inf nil t) ;; These are supposed to correspond to top-level customization groups, ;; says rms. (defvar finder-known-keywords - '( - (abbrev . "abbreviation handling, typing shortcuts, macros") - ;; Too specific: - (bib . "code related to the `bib' bibliography processor") - (c . "support for the C language and related languages") - (calendar . "calendar and time management support") - (comm . "communications, networking, remote access to files") + '((abbrev . "abbreviation handling, typing shortcuts, and macros") + (bib . "bibliography processors") + (c . "C and related programming languages") + (calendar . "calendar and time management tools") + (comm . "communications, networking, and remote file access") (convenience . "convenience features for faster editing") - (data . "support for editing files of data") - (docs . "support for Emacs documentation") + (data . "editing data (non-text) files") + (docs . "Emacs documentation facilities") (emulations . "emulations of other editors") (extensions . "Emacs Lisp language extensions") - (faces . "support for multiple fonts") - (files . "support for editing and manipulating files") - (frames . "support for Emacs frames and window systems") + (faces . "fonts and colors for text") + (files . "file editing and manipulation") + (frames . "Emacs frames and window systems") (games . "games, jokes and amusements") - (hardware . "support for interfacing with exotic hardware") - (help . "support for on-line help systems") - (hypermedia . "support for links between text or other media types") - (i18n . "internationalization and alternate character-set support") + (hardware . "interfacing with system hardware") + (help . "on-line help systems") + (hypermedia . "links between text or other media types") + (i18n . "internationalization and character-set support") (internal . "code for Emacs internals, build process, defaults") (languages . "specialized modes for editing programming languages") (lisp . "Lisp support, including Emacs Lisp") (local . "code local to your site") - (maint . "maintenance aids for the Emacs development group") - (mail . "modes for electronic-mail handling") - (matching . "various sorts of searching and matching") + (maint . "Emacs development tools and aids") + (mail . "email reading and posting") + (matching . "searching, matching, and sorting") (mouse . "mouse support") - (multimedia . "images and sound support") - (news . "support for netnews reading and posting") - (oop . "support for object-oriented programming") - (outlines . "support for hierarchical outlining") - (processes . "process, subshell, compilation, and job control support") - (terminals . "support for terminal types") - (tex . "supporting code for the TeX formatter") + (multimedia . "images and sound") + (news . "USENET news reading and posting") + (outlines . "hierarchical outlining and note taking") + (processes . "processes, subshells, and compilation") + (terminals . "text terminals (ttys)") + (tex . "the TeX document formatter") (tools . "programming tools") - (unix . "front-ends/assistants for, or emulators of, UNIX-like features") + (unix . "UNIX feature interfaces and emulators") (vc . "version control") - (wp . "word processing") - )) + (wp . "word processing"))) (defvar finder-mode-map (let ((map (make-sparse-keymap)) @@ -125,8 +120,9 @@ ;;; Code for regenerating the keyword list. -(defvar finder-package-info nil - "Assoc list mapping file names to description & keyword lists.") +(defvar finder-keywords-hash nil + "Hash table mapping keywords to lists of package names. +Keywords and package names both should be symbols.") (defvar generated-finder-keywords-file "finder-inf.el" "The function `finder-compile-keywords' writes keywords into this file.") @@ -142,10 +138,91 @@ cus-load\\|finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)" (autoload 'autoload-rubric "autoload") +(defvar finder--builtins-alist + '(("calc" . calc) + ("ede" . ede) + ("erc" . erc) + ("eshell" . eshell) + ("gnus" . gnus) + ("international" . emacs) + ("language" . emacs) + ("mh-e" . mh-e) + ("semantic" . semantic) + ("analyze" . semantic) + ("bovine" . semantic) + ("decorate" . semantic) + ("symref" . semantic) + ("wisent" . semantic) + ("nxml" . nxml) + ("org" . org) + ("srecode" . srecode) + ("term" . emacs) + ("url" . url)) + "Alist of built-in package directories. +Each element should have the form (DIR . PACKAGE), where DIR is a +directory name and PACKAGE is the name of a package (a symbol). +When generating `package--builtins', Emacs assumes any file in +DIR is part of the package PACKAGE.") + (defun finder-compile-keywords (&rest dirs) - "Regenerate the keywords association list into `generated-finder-keywords-file'. -Optional arguments DIRS are a list of Emacs Lisp directories to compile from; -no arguments compiles from `load-path'." + "Regenerate list of built-in Emacs packages. +This recomputes `package--builtins' and `finder-keywords-hash', +and prints them into the file `generated-finder-keywords-file'. + +Optional DIRS is a list of Emacs Lisp directories to compile +from; the default is `load-path'." + ;; Allow compressed files also. + (setq package--builtins nil) + (setq finder-keywords-hash (make-hash-table :test 'eq)) + (let ((el-file-regexp "^\\([^=].*\\)\\.el\\(\\.\\(gz\\|Z\\)\\)?$") + package-override files base-name processed + summary keywords package version entry desc) + (dolist (d (or dirs load-path)) + (when (file-exists-p (directory-file-name d)) + (message "Directory %s" d) + (setq package-override + (intern-soft + (cdr-safe + (assoc (file-name-nondirectory (directory-file-name d)) + finder--builtins-alist)))) + (setq files (directory-files d nil el-file-regexp)) + (dolist (f files) + (unless (or (string-match finder-no-scan-regexp f) + (null (setq base-name + (and (string-match el-file-regexp f) + (intern (match-string 1 f))))) + (memq base-name processed)) + (push base-name processed) + (with-temp-buffer + (insert-file-contents (expand-file-name f d)) + (setq summary (lm-synopsis) + keywords (mapcar 'intern (lm-keywords-list)) + package (or package-override + (intern-soft (lm-header "package")) + base-name) + version (lm-header "version"))) + (when summary + (setq version (ignore-errors (version-to-list version))) + (setq entry (assq package package--builtins)) + (cond ((null entry) + (push (cons package (vector version nil summary)) + package--builtins)) + ((eq base-name package) + (setq desc (cdr entry)) + (aset desc 0 version) + (aset desc 2 summary))) + (dolist (kw keywords) + (puthash kw + (cons package + (delq package + (gethash kw finder-keywords-hash))) + finder-keywords-hash)))))))) + + (setq package--builtins + (sort package--builtins + (lambda (a b) (string< (symbol-name (car a)) + (symbol-name (car b)))))) + (save-excursion (find-file generated-finder-keywords-file) (setq buffer-undo-list t) @@ -153,40 +230,16 @@ no arguments compiles from `load-path'." (insert (autoload-rubric generated-finder-keywords-file "keyword-to-package mapping" t)) (search-backward " ") - (insert "(setq finder-package-info '(\n") - (let (processed summary keywords) - (mapc - (lambda (d) - (when (file-exists-p (directory-file-name d)) - (message "Directory %s" d) - (mapc - (lambda (f) - ;; FIXME should this not be using (expand-file-name f d)? - (unless (or (member f processed) - (string-match finder-no-scan-regexp f)) - (setq processed (cons f processed)) - (with-temp-buffer - (insert-file-contents (expand-file-name f d)) - (setq summary (lm-synopsis) - keywords (lm-keywords-list))) - (insert - (format " (\"%s\"\n " - (if (string-match "\\.\\(gz\\|Z\\)$" f) - (file-name-sans-extension f) - f))) - (prin1 summary (current-buffer)) - (insert "\n ") - (prin1 (mapcar 'intern keywords) (current-buffer)) - (insert ")\n"))) - (directory-files d nil - ;; Allow compressed files also. FIXME: - ;; generalize this, especially for - ;; MS-DOG-type filenames. - "^[^=].*\\.el\\(\\.\\(gz\\|Z\\)\\)?$" - )))) - (or dirs load-path))) - (insert " ))\n") - (eval-buffer) ; so we get the new keyword list immediately + (insert "(setq package--builtins '(\n") + (dolist (package package--builtins) + (insert " ") + (prin1 package (current-buffer)) + (insert "\n")) + (insert "))\n\n") + ;; Insert hash table. + (insert "(setq finder-keywords-hash\n ") + (prin1 finder-keywords-hash (current-buffer)) + (insert ")\n") (basic-save-buffer))) (defun finder-compile-keywords-make-dist () @@ -226,26 +279,14 @@ no arguments compiles from `load-path'." (defun finder-unknown-keywords () "Return an alist of unknown keywords and number of their occurences. -Unknown are keywords that are present in `finder-package-info' -but absent in `finder-known-keywords'." - (let ((unknown-keywords-hash (make-hash-table))) - ;; Prepare a hash where key is a keyword - ;; and value is the number of keyword occurences. - (mapc (lambda (package) - (mapc (lambda (keyword) - (unless (assq keyword finder-known-keywords) - (puthash keyword - (1+ (gethash keyword unknown-keywords-hash 0)) - unknown-keywords-hash))) - (nth 2 package))) - finder-package-info) - ;; Make an alist from the hash and sort by the keyword name. - (sort (let (unknown-keywords-list) - (maphash (lambda (key value) - (push (cons key value) unknown-keywords-list)) - unknown-keywords-hash) - unknown-keywords-list) - (lambda (a b) (string< (car a) (car b)))))) +Unknown keywords are those present in `finder-keywords-hash' but +not `finder-known-keywords'." + (let (alist) + (maphash (lambda (kw packages) + (unless (assq kw finder-known-keywords) + (push (cons kw (length packages)) alist))) + finder-keywords-hash) + (sort alist (lambda (a b) (string< (car a) (car b)))))) ;;;###autoload (defun finder-list-keywords () @@ -255,46 +296,27 @@ but absent in `finder-known-keywords'." (pop-to-buffer "*Finder*") (pop-to-buffer (get-buffer-create "*Finder*")) (finder-mode) - (setq buffer-read-only nil - buffer-undo-list t) - (erase-buffer) - (mapc - (lambda (assoc) - (let ((keyword (car assoc))) - (insert (symbol-name keyword)) - (finder-insert-at-column 14 (concat (cdr assoc) "\n")) - (finder-mouse-face-on-line))) - finder-known-keywords) - (goto-char (point-min)) - (setq finder-headmark (point) - buffer-read-only t) - (set-buffer-modified-p nil) - (balance-windows) - (finder-summary))) + (let ((inhibit-read-only t)) + (erase-buffer) + (dolist (assoc finder-known-keywords) + (let ((keyword (car assoc))) + (insert (propertize (symbol-name keyword) + 'font-lock-face 'font-lock-constant-face)) + (finder-insert-at-column 14 (concat (cdr assoc) "\n")) + (finder-mouse-face-on-line))) + (goto-char (point-min)) + (setq finder-headmark (point) + buffer-read-only t) + (set-buffer-modified-p nil) + (balance-windows) + (finder-summary)))) (defun finder-list-matches (key) - (pop-to-buffer (set-buffer (get-buffer-create "*Finder Category*"))) - (finder-mode) - (setq buffer-read-only nil - buffer-undo-list t) - (erase-buffer) - (let ((id (intern key))) - (insert - "The following packages match the keyword `" key "':\n\n") - (setq finder-headmark (point)) - (mapc - (lambda (x) - (when (memq id (cadr (cdr x))) - (insert (car x)) - (finder-insert-at-column 16 (concat (cadr x) "\n")) - (finder-mouse-face-on-line))) - finder-package-info) - (goto-char (point-min)) - (forward-line) - (setq buffer-read-only t) - (set-buffer-modified-p nil) - (shrink-window-if-larger-than-buffer) - (finder-summary))) + (let* ((id (intern key)) + (packages (gethash id finder-keywords-hash))) + (unless packages + (error "No packages matching key `%s'" key)) + (package--list-packages packages))) (define-button-type 'finder-xref 'action #'finder-goto-xref) @@ -381,8 +403,8 @@ FILE should be in a form suitable for passing to `locate-library'." \\[finder-select] more help for the item on the current line \\[finder-exit] exit Finder mode and kill the Finder buffer." :syntax-table finder-mode-syntax-table - (setq font-lock-defaults '(finder-font-lock-keywords nil nil - (("+-*/.<>=!?$%_&~^:@" . "w")) nil)) + (setq buffer-read-only t + buffer-undo-list t) (set (make-local-variable 'finder-headmark) nil)) (defun finder-summary () @@ -399,8 +421,8 @@ finder directory, \\[finder-exit] = quit, \\[finder-summary] = help"))) Delete the window and kill all Finder-related buffers." (interactive) (ignore-errors (delete-window)) - (dolist (buff '("*Finder*" "*Finder-package*" "*Finder Category*")) - (and (get-buffer buff) (kill-buffer buff)))) + (let ((buf "*Finder*")) + (and (get-buffer buf) (kill-buffer buf)))) (provide 'finder) diff --git a/lisp/foldout.el b/lisp/foldout.el index bee9227639c..4c7ef29a072 100644 --- a/lisp/foldout.el +++ b/lisp/foldout.el @@ -6,7 +6,7 @@ ;; Author: Kevin Broadey <KevinB@bartley.demon.co.uk> ;; Maintainer: FSF ;; Created: 27 Jan 1994 -;; Version: foldout.el 1.10 dated 94/05/19 at 17:09:12 +;; Version: 1.10 ;; Keywords: folding, outlines ;; This file is part of GNU Emacs. diff --git a/lisp/font-core.el b/lisp/font-core.el index d33295b3c34..a8b72539d5d 100644 --- a/lisp/font-core.el +++ b/lisp/font-core.el @@ -6,6 +6,7 @@ ;; Maintainer: FSF ;; Keywords: languages, faces +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/font-lock.el b/lisp/font-lock.el index db665857fdb..92c62010848 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -9,6 +9,7 @@ ;; Stefan Monnier ;; Maintainer: FSF ;; Keywords: languages, faces +;; Package: emacs ;; This file is part of GNU Emacs. @@ -543,6 +544,8 @@ and what they do: contexts will not be affected. This is normally set via `font-lock-defaults'.") +(make-obsolete-variable 'font-lock-syntactic-keywords + 'syntax-propertize-function "24.1") (defvar font-lock-syntax-table nil "Non-nil means use this syntax table for fontifying. @@ -611,24 +614,12 @@ Major/minor modes can set this variable if they know which option applies.") ;; ;; Borrowed from lazy-lock.el. ;; We use this to preserve or protect things when modifying text properties. - (defmacro save-buffer-state (varlist &rest body) + (defmacro save-buffer-state (&rest body) "Bind variables according to VARLIST and eval BODY restoring buffer state." - (declare (indent 1) (debug let)) - (let ((modified (make-symbol "modified"))) - `(let* ,(append varlist - `((,modified (buffer-modified-p)) - (buffer-undo-list t) - (inhibit-read-only t) - (inhibit-point-motion-hooks t) - (inhibit-modification-hooks t) - deactivate-mark - buffer-file-name - buffer-file-truename)) - (unwind-protect - (progn - ,@body) - (unless ,modified - (restore-buffer-modified-p nil)))))) + (declare (indent 0) (debug t)) + `(let ((inhibit-point-motion-hooks t)) + (with-silent-modifications + ,@body))) ;; ;; Shut up the byte compiler. (defvar font-lock-face-attributes)) ; Obsolete but respected if set. @@ -1030,7 +1021,7 @@ The region it returns may start or end in the middle of a line.") (funcall font-lock-fontify-region-function beg end loudly)) (defun font-lock-unfontify-region (beg end) - (save-buffer-state nil + (save-buffer-state (funcall font-lock-unfontify-region-function beg end))) (defun font-lock-default-fontify-buffer () @@ -1123,39 +1114,38 @@ Put first the functions more likely to cause a change and cheaper to compute.") (defun font-lock-default-fontify-region (beg end loudly) (save-buffer-state - ((parse-sexp-lookup-properties - (or parse-sexp-lookup-properties font-lock-syntactic-keywords)) - (old-syntax-table (syntax-table))) - (unwind-protect - (save-restriction - (unless font-lock-dont-widen (widen)) - ;; Use the fontification syntax table, if any. - (when font-lock-syntax-table - (set-syntax-table font-lock-syntax-table)) - ;; Extend the region to fontify so that it starts and ends at - ;; safe places. - (let ((funs font-lock-extend-region-functions) - (font-lock-beg beg) - (font-lock-end end)) - (while funs - (setq funs (if (or (not (funcall (car funs))) - (eq funs font-lock-extend-region-functions)) - (cdr funs) - ;; If there's been a change, we should go through - ;; the list again since this new position may - ;; warrant a different answer from one of the fun - ;; we've already seen. - font-lock-extend-region-functions))) - (setq beg font-lock-beg end font-lock-end)) - ;; Now do the fontification. - (font-lock-unfontify-region beg end) - (when font-lock-syntactic-keywords - (font-lock-fontify-syntactic-keywords-region beg end)) - (unless font-lock-keywords-only - (font-lock-fontify-syntactically-region beg end loudly)) - (font-lock-fontify-keywords-region beg end loudly)) - ;; Clean up. - (set-syntax-table old-syntax-table)))) + ;; Use the fontification syntax table, if any. + (with-syntax-table (or font-lock-syntax-table (syntax-table)) + (save-restriction + (unless font-lock-dont-widen (widen)) + ;; Extend the region to fontify so that it starts and ends at + ;; safe places. + (let ((funs font-lock-extend-region-functions) + (font-lock-beg beg) + (font-lock-end end)) + (while funs + (setq funs (if (or (not (funcall (car funs))) + (eq funs font-lock-extend-region-functions)) + (cdr funs) + ;; If there's been a change, we should go through + ;; the list again since this new position may + ;; warrant a different answer from one of the fun + ;; we've already seen. + font-lock-extend-region-functions))) + (setq beg font-lock-beg end font-lock-end)) + ;; Now do the fontification. + (font-lock-unfontify-region beg end) + (when (and font-lock-syntactic-keywords + (null syntax-propertize-function)) + ;; Ensure the beginning of the file is properly syntactic-fontified. + (let ((start beg)) + (when (< font-lock-syntactically-fontified start) + (setq start (max font-lock-syntactically-fontified (point-min))) + (setq font-lock-syntactically-fontified end)) + (font-lock-fontify-syntactic-keywords-region start end))) + (unless font-lock-keywords-only + (font-lock-fontify-syntactically-region beg end loudly)) + (font-lock-fontify-keywords-region beg end loudly))))) ;; The following must be rethought, since keywords can override fontification. ;; ;; Now scan for keywords, but not if we are inside a comment now. @@ -1451,11 +1441,10 @@ LIMIT can be modified by the value of its PRE-MATCH-FORM." (defun font-lock-fontify-syntactic-keywords-region (start end) "Fontify according to `font-lock-syntactic-keywords' between START and END. START should be at the beginning of a line." - ;; Ensure the beginning of the file is properly syntactic-fontified. - (when (and font-lock-syntactically-fontified - (< font-lock-syntactically-fontified start)) - (setq start (max font-lock-syntactically-fontified (point-min))) - (setq font-lock-syntactically-fontified end)) + (unless parse-sexp-lookup-properties + ;; We wouldn't go through so much trouble if we didn't intend to use those + ;; properties, would we? + (set (make-local-variable 'parse-sexp-lookup-properties) t)) ;; If `font-lock-syntactic-keywords' is a symbol, get the real keywords. (when (symbolp font-lock-syntactic-keywords) (setq font-lock-syntactic-keywords (font-lock-eval-keywords @@ -1498,19 +1487,18 @@ START should be at the beginning of a line." (defvar font-lock-comment-end-skip nil "If non-nil, Font Lock mode uses this instead of `comment-end'.") -(defun font-lock-fontify-syntactically-region (start end &optional loudly ppss) +(defun font-lock-fontify-syntactically-region (start end &optional loudly) "Put proper face on each string and comment between START and END. START should be at the beginning of a line." + (syntax-propertize end) ; Apply any needed syntax-table properties. (let ((comment-end-regexp (or font-lock-comment-end-skip (regexp-quote (replace-regexp-in-string "^ *" "" comment-end)))) - state face beg) + ;; Find the `start' state. + (state (syntax-ppss start)) + face beg) (if loudly (message "Fontifying %s... (syntactically...)" (buffer-name))) - (goto-char start) - ;; - ;; Find the `start' state. - (setq state (or ppss (syntax-ppss start))) ;; ;; Find each interesting place between here and `end'. (while @@ -2283,14 +2271,17 @@ in which C preprocessor directives are used. e.g. `asm-mode' and "inline" "lambda" "save-restriction" "save-excursion" "save-selected-window" "save-window-excursion" "save-match-data" "save-current-buffer" - "unwind-protect" "condition-case" "track-mouse" - "eval-after-load" "eval-and-compile" "eval-when-compile" - "eval-when" "eval-next-after-load" + "combine-after-change-calls" "unwind-protect" + "condition-case" "condition-case-no-debug" + "track-mouse" "eval-after-load" "eval-and-compile" + "eval-when-compile" "eval-when" "eval-next-after-load" "with-case-table" "with-category-table" - "with-current-buffer" "with-electric-help" + "with-current-buffer" "with-demoted-errors" + "with-electric-help" "with-local-quit" "with-no-warnings" "with-output-to-string" "with-output-to-temp-buffer" - "with-selected-window" "with-selected-frame" "with-syntax-table" + "with-selected-window" "with-selected-frame" + "with-silent-modifications" "with-syntax-table" "with-temp-buffer" "with-temp-file" "with-temp-message" "with-timeout" "with-timeout-handler") t) "\\>") diff --git a/lisp/format-spec.el b/lisp/format-spec.el index f5bc3e51b40..d177a43cc1f 100644 --- a/lisp/format-spec.el +++ b/lisp/format-spec.el @@ -76,5 +76,4 @@ starting with a character." (provide 'format-spec) -;; arch-tag: c22d49cf-d167-445d-b7f1-2504d4173f53 ;;; format-spec.el ends here diff --git a/lisp/format.el b/lisp/format.el index d4262e2d0e6..0436187d984 100644 --- a/lisp/format.el +++ b/lisp/format.el @@ -4,6 +4,7 @@ ;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Boris Goldowsky <boris@gnu.org> +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/frame.el b/lisp/frame.el index 8b5be93791e..7a12c9fc2e0 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. @@ -1209,8 +1210,7 @@ frame's display)." (defun display-selections-p (&optional display) "Return non-nil if DISPLAY supports selections. A selection is a way to transfer text or other data between programs -via special system buffers called `selection' or `cut buffer' or -`clipboard'. +via special system buffers called `selection' or `clipboard'. DISPLAY can be a display name, a frame, or nil (meaning the selected frame's display)." (let ((frame-type (framep-on-display display))) diff --git a/lisp/fringe.el b/lisp/fringe.el index 18a89cddd7d..600ef7ca1e1 100644 --- a/lisp/fringe.el +++ b/lisp/fringe.el @@ -6,6 +6,7 @@ ;; Author: Simon Josefsson <simon@josefsson.org> ;; Maintainer: FSF ;; Keywords: frames +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/generic-x.el b/lisp/generic-x.el index 0083989c75a..8c2e8b4bc99 100644 --- a/lisp/generic-x.el +++ b/lisp/generic-x.el @@ -6,6 +6,7 @@ ;; Author: Peter Breton <pbreton@cs.umb.edu> ;; Created: Tue Oct 08 1996 ;; Keywords: generic, comment, font-lock +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/gnus/.dir-locals.el b/lisp/gnus/.dir-locals.el new file mode 100644 index 00000000000..45abc391e62 --- /dev/null +++ b/lisp/gnus/.dir-locals.el @@ -0,0 +1 @@ +((emacs-lisp-mode . ((show-trailing-whitespace . t)))) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index fb4f6e64d02..7dca7730828 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,653 @@ +2010-09-10 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-start.el (gnus-read-active-file-1): If gnus-agent isn't set, + then do request scans from the backends. + + * gnus-sum.el (gnus-summary-update-hook): Change default to nil, to + avoid running a hook per line, since this takes a lot of time, + profiling shows. + (gnus-summary-prepare-threads): Call `gnus-summary-highlight-line' + directly if gnus-visual-p is true. + +2010-09-10 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-start.el (gnus-read-active-for-groups): Check only subscribed + groups; replace mapcar with dolist which is a bit faster; pass groups + info to gnus-read-active-file-1. + (gnus-read-active-file-1): Scan only specified groups if the new + optional arg `infos' is given. + +2010-09-09 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * mail-source.el (mail-source-fetch-pop): Use pop3-movemail again. + + * pop3.el (pop3-movemail): Removed. + (pop3-streaming-movemail): Renamed to pop3-movemail. + + * gnus-html.el (gnus-html-wash-tags): Refactor out the image bit, and + don't restrict end-tag searches to the end of the line. + +2010-09-09 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-start.el (gnus-get-unread-articles): Set the number of unread + articles of every unchecked group to t, which means unknown since the + server has never been opened. + +2010-09-08 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-html.el (gnus-html-show-alt-text): New command. + (gnus-html-browse-image): Ditto. + (gnus-html-wash-tags): Add the data to allow showing the ALT text and + to browse the image directly. + (gnus-html-wash-tags): Search for images first, so that <a><img> works + better. + + * gnus-async.el (gnus-async-article-callback): Call + `gnus-html-prefetch-images' unconditionally. + + * gnus-html.el (gnus-html-schedule-image-fetching): Decode entities + before feeding URLs to curl. + +2010-09-07 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-html.el (gnus-html-wash-tags, gnus-html-put-image): Mark cid and + internal images as deletable by `W D D'. + + * gnus-async.el (gnus-html-prefetch-images): Autoload it when compiling. + (gnus-async-article-callback): Fix typo. + +2010-09-06 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-html.el (gnus-html-wash-tags): Limit end-tag matching to the + current line to work around bugs in the output from w3m. + + * gnus-async.el (gnus-async-article-callback): Always prefetch images + for groups that want that. + + * nntp.el (nntp-wait-for-string): Supply a timeout for + accept-process-output to ensure progress. + + * gnus-start.el (gnus-get-unread-articles): If being given an explicit + level to get unread articles from, then use that for foreign groups, + too. + + * gnus-html.el (gnus-html-wash-tags): Remove <a name...> tags, which + confuses the rest of the function. + + * gnus-start.el (gnus-read-active-for-groups): Do a `gnus-request-scan' + for the methods that support -retrieve-groups, too. + + * nnml.el (nnml-save-nov): Remove some debugging-related messages. + +2010-09-06 Katsumi Yamaoka <yamaoka@jpl.org> + + * pop3.el: Require cl when compiling. + (pop3-number-of-responses): Search for "+OK", not "+OK ". + +2010-09-05 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-start.el (gnus-get-unread-articles): Don't bother with groups + that aren't going to be activated. + (gnus-get-unread-articles): Fix up the last commit. + + * gnus-html.el (gnus-article-html): Allow calling without specifying + the handle. In that case, dissect the buffer first. + + * gnus-sum.el (gnus-set-mode-line): Don't pad the mode line string. + + * nnimap.el (nnimap-open-connection): Revert the change that would look + into authinfo for imaps instead of imap. + + * gnus-start.el (gnus-activate-group): Take an optional parameter to + say that you don't want to call gnus-request-group with don-check, but + do check the reponse. This is for virtual groups only. + (gnus-get-unread-articles): Count the archive groups as secondary, so + that they're activated the same way as before. + + * nnimap.el (nnimap-request-list): Servers may return \NoSelect + case-insensitively. + (nnimap-debug): Removed. + + * mail-source.el (mail-source-fetch): Don't message if we're fetching + mail from a file, and the file doesn't exist. + + * pop3.el (pop3-streaming-movemail): Return t for success. + + * nnimap.el (nnimap-open-connection): Look for the "imaps" entry in the + .authinfo if we're using ssl connection. + + * nnvirtual.el (nnvirtual-create-mapping): Use the active info we + already have if we're in a main Gnus `g' run. + + * gnus-start.el (gnus-method-rank): Get info for virtual groups last. + +2010-09-05 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-start.el (gnus-method-rank): Replace equalp with equal. + + * nnmh.el (nnmh-request-list-1): Bind `file'. + + * pop3.el (pop3-set-process-query-on-exit-flag): New function that's an + alias to set-process-query-on-exit-flag or process-kill-without-query. + (pop3-open-server): Use it. + +2010-09-04 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * mail-source.el (mail-source-delete-crash-box): Always move the crash + box to the Incoming file. Fixes mistake in previous checkin. + + * pop3.el (pop3-send-streaming-command): Off-by-one error on the + request loop (for debugging purposes) removed. + + * nnml.el (nnml-save-nov): Message around nnml-save-nov so that the + culprit is more visible. + (nnml-save-incremental-nov, nnml-open-incremental-nov) + (nnml-add-incremental-nov): New functions to do "incremental" nov + updates, where we just append to the end of the existing nov files + without reading/writing them in full. + + * mail-source.el (mail-source-delete-crash-box): Really only check the + incoming files once in a while. + + * pop3.el (pop3-streaming-movemail): Always close the pop3 connection. + + * mail-source.el (mail-source-delete-crash-box): Only check the + incoming files for deletion once per day to save a lot of file + accesses. + + * pop3.el (pop3-logon): Fix up unbound variable typo. + + * mail-source.el (pop3-streaming-movemail): Autoload. + + * pop3.el (pop3-streaming-movemail): Respect + pop3-leave-mail-on-server. + + * mail-source.el (mail-source-fetch-pop): Use streaming pop3 + retrieval. + + * pop3.el (pop3-process-filter): Removed unused function. + (pop3-streaming-movemail, pop3-send-streaming-command) + (pop3-wait-for-messages, pop3-write-to-file) + (pop3-number-of-responses): New functions for streaming pop3 + retrieval. + + * gnus-start.el (gnus-get-unread-articles): Protect against groups that + come from no known methods. + (gnus-make-hashtable-from-newsrc-alist): Remove duplicates from .newsrc + list. + + * pop3.el (pop3-display-message-size-flag): Removed -- everybody wants + message sizes. + (pop3-movemail): Use erase-buffer instead of looping and deleting + regions, which seems rather odd. + + * gnus-agent.el (gnus-agent-load-local): Only read the agent.lib/local + file once per `g' run. + + * nnmh.el (nnmh-request-list-1): Output active lines also for empty + directories. This makes the draft queue directory work. + + * gnus-start.el (gnus-get-unread-articles): Rewrite the way we request + data from the backends, so that we only request the list of groups from + each method once. This should speed things up considerably. + + * nnvirtual.el (nnvirtual-request-list): Remove function so that we can + detect that it's not implemented. + + * nnmh.el (nnmh-request-list-1): Fix up the recursion behavior so that + we actually do recurse down into the tree, but don't stat all leaf + nodes. + + * gnus-html.el (gnus-html-show-images): If there are no images to show, + then say so instead of bugging out. + + * gnus-agent.el (gnus-agent-load-alist): Check whether the agentview + files exist before trying to read them. + + * gnus-html.el (gnus-html-wash-tags): Remove even more white space + around <pre_int>. + + * gnus-art.el (gnus-article-copy-string): Say what data we copied. + + * nnmh.el (nnmh-request-list-1): Optimize for speed. + +2010-09-03 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * mm-util.el (mm-image-load-path): Just return the image directories, + not all directories in the path in addition to the image directories. + (mm-image-load-path): Maintain a cache of the image directories so that + the `g' command in Gnus doesn't have to stat dozens of directories each + time. + + * gnus-html.el (gnus-html-put-image): Allow images to be removed. + (gnus-html-wash-tags): Add a new `i' command to insert images. + (gnus-html-insert-image): New command and keystroke. + (gnus-html-redisplay-with-images): New command and keystroke. + (gnus-html-show-images): Renamed command. + (gnus-html-wash-tags): Remove more white space before <pre_int> image + spacers. + (gnus-html-wash-tags): Decode entities at the end, so that entities + inside the tags don't mess up the rest of the "parsing". + + * gnus-agent.el (gnus-agent-auto-agentize-methods): Change the default + so that nnimap methods aren't agentized by default. There's apparently + many problems related to agent/imap behaviour. + + * gnus-art.el (gnus-article-copy-string): New command and key binding. + + * gnus-html.el: Doc fix. + +2010-09-03 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-html.el (gnus-html-put-image): Use gnus-graphic-display-p, + glyph-width and glyph-height instead of display-graphic-p and + image-size; make avoidance of displaying small images work for XEmacs. + + * gnus-util.el (gnus-graphic-display-p): Use device-on-window-system-p + for XEmacs. + + * gnus-ems.el (gnus-set-process-plist, gnus-process-plist): Change name + of symbol that holds plist data. + (gnus-process-plist): Remove plist of process after getting it. + +2010-09-02 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * message.el (message-generate-hashcash): Change default to + 'opportunistic if hashcash is installed. + + * gnus-html.el (gnus-html-rescale-image): Fix up typo in rescaling. + (gnus-html-put-image): Only call image-size once, since it's somewhat + time-consuming on remote X servers. + +2010-09-02 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-html.el (gnus-article-html): Make work buffer multibyte for + decoded contents. + (gnus-html-put-image, gnus-html-rescale-image): Pass `file' argument. + +2010-09-02 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-group.el (gnus-group-line-format): Remove %O (moderated) from + group line format, since it isn't very interesting. + + * gnus-agent.el (gnus-agent-short-article), + (gnus-agent-long-article): Increase values for these two variables, + since most people are likely to have more network connection and + storage than before. + + * gnus.el (gnus-refer-article-method): Change default to 'current. + When referring an article, the common behaviour is to refer it from the + current select method, not the native select method. The chances of + the native select method having the message in question is rather slim + these days. + + * gnus-sum.el (gnus-auto-select-subject): Change default to + `unseen-or-unread'. I think it's likely that most people want to + select an unseen article over a previously seen, but unread one. + + * gnus.el (gnus-mode-non-string-length): Change default to 30. nil + means that in the article buffer none of the minor mode elements will + be shown, usually, and this is not desirable in most cases. + + * gnus-sum.el (gnus-summary-goto-unread): Change default to nil, so + that commands like `d' (and the like) go to the next line in the + buffer, instead of the next unread article. I think this is the + behaviour that is most natural for most users. + (gnus-single-article-buffer): Change default to nil, so that people can + have as many article buffers open as they have summary buffer. I think + this is the most natural way for the groups to behave. + + * message.el (message-generate-new-buffers): Change default to + `unsent', so that all new message buffers start their names with the + string "*unsent", and it's easier to find the buffers if you move from + them. + +2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-html.el (gnus-html-wash-tags): Don't show images that are really + small. They're probably tracking images. + (gnus-html-wash-tags): Remove all <pre_int> place holders. + (gnus-html-rescale-image): Yet another try at getting the image sizing + right. + + * nntp.el (nntp-request-set-mark): Refuse to do marks if + nntp-marks-file-name is nil. + +2010-09-01 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus-html.el (gnus-html-wash-tags) + (gnus-html-schedule-image-fetching, gnus-html-image-url-blocked-p): + Better logging. + +2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nndoc.el (nndoc-type-alist): Added a new type for Google digests. + + * gnus-html.el (gnus-html-wash-tags): Check the value of + gnus-blocked-images in the summary buffer. + +2010-09-01 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus-html.el (gnus-html-image-url-blocked-p): Doc fix. + +2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-html.el (gnus-html-wash-tags): "A" is also used for links, just + like "a", it seems like. + (gnus-html-image-url-blocked-p): Take a parameter for blocked-images + since it needs to be picked from the correct buffer. + + * nnwfm.el: Removed. + + * nnlistserv.el: Removed. + +2010-09-01 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus-html.el (gnus-html-image-url-blocked-p): New function. + (gnus-html-prefetch-images, gnus-html-wash-tags): Use it. + +2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnkiboze.el: Removed. + + * nndb.el: Removed. + + * gnus-html.el (gnus-html-put-image): Use the deleted text as the image + alt text. + (gnus-html-rescale-image): Try to get the rescaling logic right for + images that are just wide and not tall. + + * gnus.el (gnus-string-or): Fix the syntax to not use eval or + overshadow variable bindings. + +2010-09-01 Teodor Zlatanov <tzz@lifelogs.com> + + * gnus-html.el (gnus-html-wash-tags) + (gnus-html-schedule-image-fetching, gnus-html-prefetch-images): Add + extra logging. + +2010-09-01 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-html.el (gnus-html-wash-tags): Delete the IMG_ALT region. + (gnus-max-image-proportion): New variable. + (gnus-html-rescale-image): New function. + (gnus-html-put-image): Rescale images. + +2010-09-01 Stefan Monnier <monnier@iro.umontreal.ca> + + Fix up some byte-compiler warnings. + * gnus.el (gnus-group-find-parameter, gnus-kill-save-kill-buffer): + * gnus-cite.el (gnus-article-highlight-citation, gnus-dissect-cited-text) + (gnus-article-fill-cited-article, gnus-article-hide-citation) + (gnus-article-hide-citation-in-followups, gnus-cite-toggle): + * gnus-group.el (gnus-group-set-mode-line, gnus-group-quit) + (gnus-group-set-info, gnus-add-mark): Use with-current-buffer. + (gnus-group-update-group): Use save-excursion and with-current-buffer. + +2010-09-01 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-html.el (gnus-article-html): Decode contents by charset. + +2010-09-01 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-html.el (gnus-html-cache-directory, gnus-html-cache-size) + (gnus-html-frame-width, gnus-blocked-images) + * message.el (message-prune-recipient-rules): Add custom version. + * gnus-sum.el (gnus-auto-expirable-marks): Bump custom version. + + * gnus-ems.el (gnus-process-get, gnus-process-put): New compatibility + functions. + + * gnus-html.el (gnus-html-curl-sentinel): Replace process-get with + gnus-process-get. + +2010-08-31 Julien Danjou <julien@danjou.info> (tiny change) + + * nnimap.el (nnimap-request-newgroups): Use nnimap-request-list-method + instead of lsub directly. + +2010-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * nnwarchive.el: Removed. + + * gnus-soup.el: Removed. + + * nnsoup.el: Removed. + + * nnultimate.el: Removed. + + * gnus-html.el (gnus-blocked-images): New variable. + + * message.el (message-prune-recipients): New function. + (message-prune-recipient-rules): New variable. + + * gnus-cite.el (gnus-article-natural-long-line-p): New function to + guess whether a long line is natural text or not. + + * gnus-html.el (gnus-html-schedule-image-fetching): Use + gnus-process-plist and friends for compatibility. + +2010-08-31 Stefan Monnier <monnier@iro.umontreal.ca> + + * gnus-html.el: Require packages that define macros used in this file. + (gnus-article-mouse-face): Declare to silence byte-compiler. + (gnus-html-curl-sentinel): Use with-current-buffer, inhibit-read-only, and + process-get. + (gnus-html-put-image): Use plist-get to avoid getf. + (gnus-html-prefetch-images): Use with-current-buffer. + +2010-08-31 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-ems.el: Provide compatibility functions for + gnus-set-process-plist. + + * gnus-sum.el (gnus-summary-stop-at-end-of-message) + * gnus.el (gnus-valid-select-methods) + * message.el (message-send-mail-partially-limit) + * mm-decode.el (mm-text-html-renderer) + * mml.el (mml-insert-mime-headers-always) + * smiley.el (smiley-regexp-alist): Bump custom version. + +2010-08-31 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-html.el: require mm-url. + (gnus-html-wash-tags): Clarify the code a bit by renaming the variable + with the url to `url'. + (gnus-html-wash-tags): Support cid: URLs/images. + +2010-08-30 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-sum.el: As per discussion 3 years, 8 weeks, 3 days, 9 hours, 57 + minutes, 56 seconds ago on the ding list, remove the `w' and `i' + bindings, as they aren't useful at all. `w' is moved to `W w'. + + * gnus-move.el: Removed file, since it doesn't really work. + + * gnus-html.el (gnus-article-html): Tell w3m that the input is + UTF-8. This seems to fix problems with some German web feeds. + + * gnus.el (gnus-group-startup-message): Put the xpm version of the logo + at the top so that the proper colours are applied. + + * gnus-art.el (gnus-article-view-part): Doc fix. + + * gnus-html.el (gnus-html-put-image): Use gnus-create-image to be + XEmacs-compatible. + (gnus-html-put-image): Don't do images on non-graphic displays. + + * nnslashdot.el: Removed this unused backend. + + * gnus-undo.el (gnus-undo-register-1): Limit the undo actions to 100 + actions. + (gnus-undo-register-1): Revert last change. + + * gnus-group.el (gnus-group-completing-read): Protect against not + having completion-styles bound. + + * mml.el (mml-insert-mime-headers-always): Change the default to t, to + make broken recipients happier. + + * gnus-html.el (gnus-html-put-image): Use gnus-put-image. + + * gnus-ems.el (gnus-put-image): Have gnus-put-image take an optional + point parameter. + + * gnus-group.el (gnus-group-completing-read): Add 'substring to + completion-styles for group selection. + +2009-02-04 Andreas Schwab <schwab@suse.de> + + * gnus-score.el (gnus-score-string): Fix regex for matching extra + headers and regexp-quote the match if necessary. + +2009-03-24 Miles Bader <miles@gnu.org> + + * smiley.el (smiley-regexp-alist): Don't delete the semicolon before + the blinking smiley. + +2009-03-24 Simon Josefsson <simon@josefsson.org> + + * smiley.el (smiley-regexp-alist): Disallow ;;) from being treated as a + blink smiley. + +2010-08-29 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-start.el (gnus-dribble-read-file): Ensure that the directory + where the dribbel file lives exists. + + * message.el (message-send-mail-partially-limit): Change the default to + nil, since most people don't want this. + + * mm-url.el (mm-url-decode-entities): Also decode entities like + ㈒. + +2009-07-16 Kevin Ryde <user42@zip.com.au> (tiny change) + + * gnus-sum.el (gnus-summary-idna-message): + * nnrss.el (nnrss-normalize-date, nnrss-discover-feed): + Hyperlink urls in docstrings with URL `...'. + +2010-08-29 Adam Sjøgren <asjo@koldfront.dk> + + * gnus-html.el (gnus-html-put-image): Use XEmacs-compatible image + functions. + +2010-08-29 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus-art.el (gnus-article-add-button): Take an optional parameter to + say what the mouseover text should be. + + * gnus-html.el (gnus-html-prefetch-images): Use the summary-local + version of the mm-w3m-safe-url-regexp variable to only download images + in the groups where we want that to happen. + + * gnus-sum.el (gnus-summary-stop-at-end-of-message): New variable. + + * gnus-art.el (gnus-article-beginning-of-window): Make into defun for + easier debugging. + (gnus-article-beginning-of-window): Add kludge to allow spacing past + big pictures in the article buffer. + + * mm-decode.el (mm-text-html-renderer): Default the html renderer to + gnus-article-html. + (mm-text-html-renderer): gnus-article-html needs curl in addition to + w3m. + + * gnus-html.el: Start a new super-simple HTML renderer based on w3m. + +2010-08-28 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * gnus.el (gnus-valid-select-methods): Remove reference to nngoogle, + which doesn't exist. + + * message.el (message-inhibit-ecomplete): New variable to allow some + function to inhibit ecomplete address storage. + (message-resend): Disable ecomplete message storage when resending + messages. + + * nntp.el (nntp-async-kluge): Remove the Emacs 20.3-related kluge. + +2010-08-27 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-sum.el (gnus-summary-move-article, gnus-summary-delete-article): + Save excursion while copying, moving, and deleting articles in order to + prevent the cursor from jumping to unforeseen place. + +2010-08-17 Glenn Morris <rgm@gnu.org> + + * gnus-sync.el: Require gnus components whose functions are used. + + * gnus-art.el (bookmark-make-record-function): + * gnus-sum.el (bookmark-yank-point, bookmark-current-bookmark): + Declare for compiler. + + * mm-url.el (mml-compute-boundary): Autoload. + +2010-08-15 Katsumi Yamaoka <yamaoka@jpl.org> + + * gnus-start.el (gnus-start-draft-setup): Move doc string forward. + +2010-08-14 Teodor Zlatanov <tzz@lifelogs.com> + + Typo fix "hoo4a" -> "hook". + + * gnus-sync.el (gnus-sync-install-hooks): Typo fix. + +2010-08-14 Glenn Morris <rgm@gnu.org> + + * gnus-sync.el (gnus-sync): Fix defgroup version. + +2010-08-13 Teodor Zlatanov <tzz@lifelogs.com> + + Doc fixes and keep unknown groups (ammended for nunion bug fix). + + * gnus-sync.el: Fix docs. + (gnus-sync-save): Keep unknown groups in `gnus-sync-newsrc-loader'. + (gnus-sync-read): Don't wipe `gnus-sync-newsrc-loader' after reading. + +2010-08-12 Teodor Zlatanov <tzz@lifelogs.com> + + Optimizations for gnus-sync.el. + + * gnus-sync.el: Add docs about gnus-sync-backend + possibilities. + (gnus-sync-save): Remove unnecessary message. + (gnus-sync-read): Optimize and show what groups were skipped. + +2010-08-12 Teodor Zlatanov <tzz@lifelogs.com> + + Minor bug fixes for gnus-sync.el. + + * gnus-sync.el (gnus-sync-unload-hook, gnus-sync-install-hooks): Don't + read the sync on get-new-news. + + * gnus-sync.el (gnus-sync-save): Define `variable' so the compiler is + quiet. + + * gnus-sync.el (gnus-sync-read): Use `gnus-sync-newsrc-offsets' (fix typo). + +2010-07-30 Lawrence Mitchell <wence@gmx.li> + + Make saving and restoring of hidden threads work with overlays. + Patch applied by Ted Zlatanov. + + * gnus-sum.el (gnus-hidden-threads-configuration) + (gnus-restore-hidden-threads-configuration): Update to deal with text + properties, rather than searching for a magic character. + +2010-08-12 Teodor Zlatanov <tzz@lifelogs.com> + + New gnus-sync.el library for synchronization of marks. + + * gnus-sync.el: New library for synchronization of marks. + + * gnus-util.el (gnus-grep-in-list): Moved from gnus-registry.el and + renamed from `gnus-registry-grep-in-list'. + + * gnus-registry.el (gnus-registry-follow-group-p): Use `gnus-grep-in-list'. + + * gnus-start.el (gnus-start-draft-setup): Make it interactive. + 2010-08-06 Katsumi Yamaoka <yamaoka@jpl.org> * rfc2047.el (rfc2047-encode): Use utf-8 as a last resort if @@ -14447,5 +15097,3 @@ See ChangeLog.2 for earlier changes. ;; fill-column: 79 ;; add-log-time-zone-rule: t ;; End: - -;;; arch-tag: 3f33a3e7-090d-492b-bedd-02a1417d32b4 diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index e43f09e5ed1..5b44c0b9937 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el @@ -465,5 +465,4 @@ MODE can be \"login\" or \"password\"." (provide 'auth-source) -;; arch-tag: ff1afe78-06e9-42c2-b693-e9f922cbe4ab ;;; auth-source.el ends here diff --git a/lisp/gnus/canlock.el b/lisp/gnus/canlock.el index 7f7f7694e0a..4298bc901cd 100644 --- a/lisp/gnus/canlock.el +++ b/lisp/gnus/canlock.el @@ -247,5 +247,4 @@ it fails." (provide 'canlock) -;; arch-tag: 033c4f09-b9f1-459d-bd0d-254430283f78 ;;; canlock.el ends here diff --git a/lisp/gnus/compface.el b/lisp/gnus/compface.el index 371d3467ec6..8c26341a6e2 100644 --- a/lisp/gnus/compface.el +++ b/lisp/gnus/compface.el @@ -58,5 +58,4 @@ or `faces-xface' and `netpbm' or `libgr-progs', for instance." (provide 'compface) -;; arch-tag: f9c78e84-98c0-4142-9682-8ba4cf4c3441 ;;; compface.el ends here diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el index d4b94a77e29..60f8c95bb2e 100644 --- a/lisp/gnus/deuglify.el +++ b/lisp/gnus/deuglify.el @@ -476,5 +476,4 @@ NODISPLAY is non-nil, don't redisplay the article buffer." ;; coding: iso-8859-1 ;; End: -;; arch-tag: 5f895cc9-51a9-487c-b42e-28844d79eb73 ;;; deuglify.el ends here diff --git a/lisp/gnus/earcon.el b/lisp/gnus/earcon.el index c2ec52e21cd..2578abc073d 100644 --- a/lisp/gnus/earcon.el +++ b/lisp/gnus/earcon.el @@ -229,5 +229,4 @@ If N is negative, move backward instead." (run-hooks 'earcon-load-hook) -;; arch-tag: 844dfeea-980c-4ed0-907f-a30bf139691c ;;; earcon.el ends here diff --git a/lisp/gnus/ecomplete.el b/lisp/gnus/ecomplete.el index 7952c37f396..1e9769f757d 100644 --- a/lisp/gnus/ecomplete.el +++ b/lisp/gnus/ecomplete.el @@ -95,7 +95,7 @@ (let* ((elems (cdr (assq type ecomplete-database))) (match (regexp-quote match)) (candidates - (sort + (sort (loop for (key count time text) in elems when (string-match match text) collect (list count time text)) @@ -156,5 +156,4 @@ (provide 'ecomplete) -;; arch-tag: 34622935-bb81-4711-a600-57b89c2ece72 ;;; ecomplete.el ends here diff --git a/lisp/gnus/flow-fill.el b/lisp/gnus/flow-fill.el index 69066de2c4e..c4c64db7ed1 100644 --- a/lisp/gnus/flow-fill.el +++ b/lisp/gnus/flow-fill.el @@ -221,5 +221,4 @@ RFC 2646 suggests 66 characters for readability." (provide 'flow-fill) -;; arch-tag: addc0040-bc53-4f17-b4bc-1eb44eed6f0b ;;; flow-fill.el ends here diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el index 640eb50a022..533d9a951b5 100644 --- a/lisp/gnus/gmm-utils.el +++ b/lisp/gnus/gmm-utils.el @@ -433,5 +433,4 @@ coding-system." (provide 'gmm-utils) -;; arch-tag: e0b60920-2ce6-40c1-bfc0-cadbbe26b602 ;;; gmm-utils.el ends here diff --git a/lisp/gnus/gnus-agent.el b/lisp/gnus/gnus-agent.el index edc4e0f3bef..bbfdc66af99 100644 --- a/lisp/gnus/gnus-agent.el +++ b/lisp/gnus/gnus-agent.el @@ -184,7 +184,7 @@ When found, offer to remove them." :type 'boolean :group 'gnus-agent) -(defcustom gnus-agent-auto-agentize-methods '(nntp nnimap) +(defcustom gnus-agent-auto-agentize-methods '(nntp) "Initially, all servers from these methods are agentized. The user may remove or add servers using the Server buffer. See Info node `(gnus)Server Buffer'." @@ -1788,7 +1788,7 @@ and that there are no duplicates." (while alist (let ((entry (pop alist))) (when (gnus-methods-equal-p gnus-command-method (gnus-info-method entry)) - (gnus-agent-flush-group (gnus-info-group entry))))))) + (gnus-agent-flush-group (gnus-info-group entry))))))) (defun gnus-agent-flush-group (group) "Flush the agent's index files such that the GROUP no longer @@ -2108,13 +2108,15 @@ doesn't exist, to valid the overview buffer." (defun gnus-agent-load-alist (group) "Load the article-state alist for GROUP." ;; Bind free variable that's used in `gnus-agent-read-agentview'. - (let ((gnus-agent-read-agentview group) - (file-name-coding-system nnmail-pathname-coding-system)) - (setq gnus-agent-article-alist - (gnus-cache-file-contents - (gnus-agent-article-name ".agentview" group) - 'gnus-agent-file-loading-cache - 'gnus-agent-read-agentview)))) + (let* ((gnus-agent-read-agentview group) + (file-name-coding-system nnmail-pathname-coding-system) + (agentview (gnus-agent-article-name ".agentview" group))) + (when (file-exists-p agentview) + (setq gnus-agent-article-alist + (gnus-cache-file-contents + agentview + 'gnus-agent-file-loading-cache + 'gnus-agent-read-agentview))))) (defun gnus-agent-read-agentview (file) "Load FILE and do a `read' there." @@ -2162,13 +2164,13 @@ doesn't exist, to valid the overview buffer." (gnus-agent-save-alist gnus-agent-read-agentview))) alist)) ((end-of-file file-error) - ;; The agentview file is missing. + ;; The agentview file is missing. (condition-case nil ;; If the agent directory exists, attempt to perform a brute-force ;; reconstruction of its contents. (let* (alist (file-name-coding-system nnmail-pathname-coding-system) - (file-attributes (directory-files-and-attributes + (file-attributes (directory-files-and-attributes (gnus-agent-article-name "" gnus-agent-read-agentview) nil "^[0-9]+$" t))) (while file-attributes @@ -2230,23 +2232,28 @@ doesn't exist, to valid the overview buffer." (gnus-agent-update-view-total-fetched-for group nil))) (defvar gnus-agent-article-local nil) +(defvar gnus-agent-article-local-times nil) (defvar gnus-agent-file-loading-local nil) (defun gnus-agent-load-local (&optional method) "Load the METHOD'S local file. The local file contains min/max article counts for each of the method's subscribed groups." (let ((gnus-command-method (or method gnus-command-method))) - (setq gnus-agent-article-local - (gnus-cache-file-contents - (gnus-agent-lib-file "local") - 'gnus-agent-file-loading-local - 'gnus-agent-read-and-cache-local)))) + (when (or (null gnus-agent-article-local-times) + (zerop gnus-agent-article-local-times)) + (setq gnus-agent-article-local + (gnus-cache-file-contents + (gnus-agent-lib-file "local") + 'gnus-agent-file-loading-local + 'gnus-agent-read-and-cache-local)) + (when gnus-agent-article-local-times + (incf gnus-agent-article-local-times))) + gnus-agent-article-local)) (defun gnus-agent-read-and-cache-local (file) "Load and read FILE then bind its contents to gnus-agent-article-local. If that variable had `dirty' (also known as modified) original contents, they are first saved to their own file." - (if (and gnus-agent-article-local (symbol-value (intern "+dirty" gnus-agent-article-local))) (gnus-agent-save-local)) @@ -2644,10 +2651,10 @@ General format specifiers can also be used. See Info node (defvar gnus-agent-predicate 'false "The selection predicate used when no other source is available.") -(defvar gnus-agent-short-article 100 +(defvar gnus-agent-short-article 500 "Articles that have fewer lines than this are short.") -(defvar gnus-agent-long-article 200 +(defvar gnus-agent-long-article 1000 "Articles that have more lines than this are long.") (defvar gnus-agent-low-score 0 @@ -3258,7 +3265,7 @@ FORCE is equivalent to setting the expiration predicates to true." (gnus-message 7 "gnus-agent-expire: Loading overview...") (nnheader-insert-file-contents nov-file) (goto-char (point-min)) - + (let (p) (while (< (setq p (point)) (point-max)) (condition-case nil @@ -4227,5 +4234,4 @@ modified." (provide 'gnus-agent) -;; arch-tag: b0ba4afc-5229-4cee-ad25-9956daa4e91e ;;; gnus-agent.el ends here diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 51be4517a77..bfdb9bd6b63 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -4414,6 +4414,8 @@ If variable `gnus-use-long-file-name' is non-nil, it is (gnus-run-hooks 'gnus-article-menu-hook))) +(defvar bookmark-make-record-function) + (defun gnus-article-mode () "Major mode for displaying an article. @@ -4821,6 +4823,22 @@ General format specifiers can also be used. See Info node (vector (caddr c) (car c) :active t)) gnus-mime-button-commands))) +(defvar gnus-url-button-commands + '((gnus-article-copy-string "u" "Copy URL to kill ring"))) + +(defvar gnus-url-button-map + (let ((map (make-sparse-keymap))) + (dolist (c gnus-url-button-commands) + (define-key map (cadr c) (car c))) + map)) + +(easy-menu-define + gnus-url-button-menu gnus-url-button-map "URL button menu." + `("Url Button" + ,@(mapcar (lambda (c) + (vector (caddr c) (car c) :active t)) + gnus-url-button-commands))) + (defmacro gnus-bind-safe-url-regexp (&rest body) "Bind `mm-w3m-safe-url-regexp' according to `gnus-safe-html-newsgroups'." `(let ((mm-w3m-safe-url-regexp @@ -5547,7 +5565,9 @@ N is the numerical prefix." 1)) (defun gnus-article-view-part (&optional n) - "View MIME part N, which is the numerical prefix." + "View MIME part N, which is the numerical prefix. +If the part is already shown, hide the part. If N is nil, view +all parts." (interactive "P") (with-current-buffer gnus-article-buffer (or (numberp n) (setq n (gnus-article-mime-match-handle-first @@ -6281,18 +6301,22 @@ Argument LINES specifies lines to be scrolled up." (gnus-article-next-page-1 lines) nil)) -(defmacro gnus-article-beginning-of-window () +(defun gnus-article-beginning-of-window () "Move point to the beginning of the window. In Emacs, the point is placed at the line number which `scroll-margin' specifies." (if (featurep 'xemacs) - '(move-to-window-line 0) - '(move-to-window-line - (min (max 0 scroll-margin) - (max 1 (- (window-height) - (if mode-line-format 1 0) - (if header-line-format 1 0) - 2)))))) + (move-to-window-line 0) + ;; There is an obscure bug in Emacs that makes it impossible to + ;; scroll past big pictures in the article buffer. Try to fix + ;; this by adding a sanity check by counting the lines visible. + (when (> (count-lines (window-start) (window-end)) 30) + (move-to-window-line + (min (max 0 scroll-margin) + (max 1 (- (window-height) + (if mode-line-format 1 0) + (if header-line-format 1 0) + 2))))))) (defun gnus-article-next-page-1 (lines) (unless (featurep 'xemacs) @@ -7805,7 +7829,11 @@ specified by `gnus-button-alist'." (unless (and (eq (car entry) 'gnus-button-url-regexp) (gnus-article-extend-url-button from start end)) (gnus-article-add-button start end - 'gnus-button-push from))))))))) + 'gnus-button-push from) + (gnus-put-text-property + start end + 'gnus-string (buffer-substring-no-properties + start end)))))))))) (defun gnus-article-extend-url-button (beg start end) "Extend url button if url is folded into two or more lines. @@ -7897,7 +7925,7 @@ url is put as the `gnus-button-url' overlay property on the button." ;;; External functions: -(defun gnus-article-add-button (from to fun &optional data) +(defun gnus-article-add-button (from to fun &optional data text) "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 nil t) @@ -7909,8 +7937,21 @@ url is put as the `gnus-button-url' overlay property on the button." (list 'gnus-callback fun) (and data (list 'gnus-data data)))) (widget-convert-button 'link from to :action 'gnus-widget-press-button + :help-echo (or text "Follow the link") + :keymap gnus-url-button-map :button-keymap gnus-widget-button-keymap)) +(defun gnus-article-copy-string () + "Copy the string in the button to the kill ring." + (interactive) + (gnus-article-check-buffer) + (let ((data (get-text-property (point) 'gnus-string))) + (when data + (with-temp-buffer + (insert data) + (copy-region-as-kill (point-min) (point-max)) + (message "Copied %s" data))))) + ;;; Internal functions: (defun gnus-article-set-globals () @@ -8723,5 +8764,4 @@ For example: (run-hooks 'gnus-art-load-hook) -;; arch-tag: 2654516f-6279-48f9-a83b-05c1fa450c33 ;;; gnus-art.el ends here diff --git a/lisp/gnus/gnus-async.el b/lisp/gnus/gnus-async.el index 432990e3c2c..979e67120d1 100644 --- a/lisp/gnus/gnus-async.el +++ b/lisp/gnus/gnus-async.el @@ -71,6 +71,13 @@ It should return non-nil if the article is to be prefetched." :group 'gnus-asynchronous :type 'function) +(defcustom gnus-async-post-fetch-function nil + "Function called after an article has been prefetched. +The function will be called narrowed to the region of the article +that was fetched." + :group 'gnus-asynchronous + :type 'function) + ;;; Internal variables. (defvar gnus-async-prefetch-article-buffer " *Async Prefetch Article*") @@ -221,12 +228,23 @@ It should return non-nil if the article is to be prefetched." `(lambda (arg) (gnus-async-article-callback arg ,group ,article ,mark ,summary ,next))) +(eval-when-compile + (autoload 'gnus-html-prefetch-images "gnus-html")) + (defun gnus-async-article-callback (arg group article mark summary next) "Function called when an async article is done being fetched." (save-excursion (setq gnus-async-current-prefetch-article nil) (when arg (gnus-async-set-buffer) + (save-excursion + (save-restriction + (narrow-to-region mark (point-max)) + ;; Prefetch images for the groups that want that. + (when (fboundp 'gnus-html-prefetch-images) + (gnus-html-prefetch-images summary)) + (when gnus-async-post-fetch-function + (funcall gnus-async-post-fetch-function summary)))) (gnus-async-with-semaphore (setq gnus-async-article-alist @@ -372,5 +390,4 @@ It should return non-nil if the article is to be prefetched." (provide 'gnus-async) -;; arch-tag: fee61de5-3ea2-4de6-8578-2f90ce89391d ;;; gnus-async.el ends here diff --git a/lisp/gnus/gnus-audio.el b/lisp/gnus/gnus-audio.el index a3ba9776645..c89faef7023 100644 --- a/lisp/gnus/gnus-audio.el +++ b/lisp/gnus/gnus-audio.el @@ -146,5 +146,4 @@ (run-hooks 'gnus-audio-load-hook) -;; arch-tag: 6f129e78-3416-4fc9-973f-6cf5ac8d654b ;;; gnus-audio.el ends here diff --git a/lisp/gnus/gnus-bcklg.el b/lisp/gnus/gnus-bcklg.el index f490d8a37d9..b3851858513 100644 --- a/lisp/gnus/gnus-bcklg.el +++ b/lisp/gnus/gnus-bcklg.el @@ -159,5 +159,4 @@ (provide 'gnus-bcklg) -;; arch-tag: 66259e56-505a-4bba-8a0d-3552c5b94e39 ;;; gnus-bcklg.el ends here diff --git a/lisp/gnus/gnus-bookmark.el b/lisp/gnus/gnus-bookmark.el index a85c1af44bb..aa3e2d70df0 100644 --- a/lisp/gnus/gnus-bookmark.el +++ b/lisp/gnus/gnus-bookmark.el @@ -828,5 +828,4 @@ probably because we were called from there." (provide 'gnus-bookmark) -;; arch-tag: 779df694-366f-46e8-84b2-1d0340e6f525 ;;; gnus-bookmark.el ends here diff --git a/lisp/gnus/gnus-cache.el b/lisp/gnus/gnus-cache.el index 113233c1d32..e3f33be8819 100644 --- a/lisp/gnus/gnus-cache.el +++ b/lisp/gnus/gnus-cache.el @@ -868,7 +868,7 @@ supported." (while (setq file (pop files)) (setq attrs (file-attributes file)) (unless (nth 0 attrs) - (incf size (float (nth 7 attrs))))))) + (incf size (float (nth 7 attrs))))))) (setq gnus-cache-need-update-total-fetched-for t) @@ -879,10 +879,10 @@ supported." (gnus-cache-with-refreshed-group group (let* ((entry (or (gnus-gethash group gnus-cache-total-fetched-hashtb) - (gnus-sethash group (make-list 2 0) + (gnus-sethash group (make-list 2 0) gnus-cache-total-fetched-hashtb))) (file-name-coding-system nnmail-pathname-coding-system) - (size (or (nth 7 (file-attributes + (size (or (nth 7 (file-attributes (or file (gnus-cache-file-name group ".overview")))) 0))) @@ -911,11 +911,10 @@ supported." (if entry (apply '+ entry) (let ((gnus-cache-inhibit-update-total-fetched-for (not no-inhibit))) - (+ + (+ (gnus-cache-update-overview-total-fetched-for group nil) (gnus-cache-update-file-total-fetched-for group nil))))))) (provide 'gnus-cache) -;; arch-tag: 05a79442-8c58-4e65-bd0a-3cbb1b89a33a ;;; gnus-cache.el ends here diff --git a/lisp/gnus/gnus-cite.el b/lisp/gnus/gnus-cite.el index adec9cfd725..7419cedac5f 100644 --- a/lisp/gnus/gnus-cite.el +++ b/lisp/gnus/gnus-cite.el @@ -407,9 +407,7 @@ lines matches `message-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 - (unless same-buffer - (set-buffer gnus-article-buffer)) + (with-current-buffer (if same-buffer (current-buffer) gnus-article-buffer) (gnus-cite-parse-maybe force) (let ((buffer-read-only nil) (alist gnus-cite-prefix-alist) @@ -462,8 +460,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps (defun gnus-dissect-cited-text () "Dissect the article buffer looking for cited text." - (save-excursion - (set-buffer gnus-article-buffer) + (with-current-buffer gnus-article-buffer (gnus-cite-parse-maybe nil t) (let ((alist gnus-cite-prefix-alist) prefix numbers number marks m) @@ -523,8 +520,7 @@ Lines matching `gnus-cite-attribution-suffix' and perhaps "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) + (with-current-buffer gnus-article-buffer (let ((buffer-read-only nil) (inhibit-point-motion-hooks t) (marks (gnus-dissect-cited-text)) @@ -552,6 +548,24 @@ If WIDTH (the numerical prefix), use that text width when filling." gnus-cite-loose-attribution-alist nil gnus-cite-article nil))))) +(defun gnus-article-natural-long-line-p () + "Return true if the current line is long, and it's natural text." + (save-excursion + (beginning-of-line) + (and + ;; The line is long. + (> (- (line-end-position) (line-beginning-position)) + (frame-width)) + ;; It doesn't start with spaces. + (not (looking-at " ")) + ;; Not cited text. + (let ((line-number (1+ (count-lines (point-min) (point)))) + citep) + (dolist (elem gnus-cite-prefix-alist) + (when (member line-number (cdr elem)) + (setq citep t))) + (not citep))))) + (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'. @@ -560,67 +574,66 @@ always hide." (interactive (append (gnus-article-hidden-arg) (list 'force))) (gnus-set-format 'cited-opened-text-button t) (gnus-set-format 'cited-closed-text-button t) - (save-excursion - (set-buffer gnus-article-buffer) - (let ((buffer-read-only nil) - marks - (inhibit-point-motion-hooks t) - (props (nconc (list 'article-type 'cite) - gnus-hidden-properties)) - (point (point-min)) - found beg end start) - (while (setq point - (text-property-any point (point-max) - 'gnus-callback - 'gnus-article-toggle-cited-text)) - (setq found t) - (goto-char point) - (gnus-article-toggle-cited-text - (get-text-property point 'gnus-data) arg) - (forward-line 1) - (setq point (point))) - (unless found - (setq marks (gnus-dissect-cited-text)) - (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 + (with-current-buffer gnus-article-buffer + (let ((buffer-read-only nil) + marks + (inhibit-point-motion-hooks t) + (props (nconc (list 'article-type 'cite) + gnus-hidden-properties)) + (point (point-min)) + found beg end start) + (while (setq point + (text-property-any point (point-max) + 'gnus-callback + 'gnus-article-toggle-cited-text)) + (setq found t) + (goto-char point) + (gnus-article-toggle-cited-text + (get-text-property point 'gnus-data) arg) + (forward-line 1) + (setq point (point))) + (unless found + (setq marks (gnus-dissect-cited-text)) + (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 (if (consp gnus-cited-lines-visible) - (car gnus-cited-lines-visible) - gnus-cited-lines-visible)) - (if (>= (point) end) - (setq beg nil) - (setq beg (point-marker)) - (when (consp gnus-cited-lines-visible) - (goto-char end) - (forward-line (- (cdr gnus-cited-lines-visible))) - (if (<= (point) beg) - (setq beg nil) + ;; Skip past lines we want to leave visible. + (when (and beg end gnus-cited-lines-visible) + (goto-char beg) + (forward-line (if (consp gnus-cited-lines-visible) + (car gnus-cited-lines-visible) + gnus-cited-lines-visible)) + (if (>= (point) end) + (setq beg nil) + (setq beg (point-marker)) + (when (consp gnus-cited-lines-visible) + (goto-char end) + (forward-line (- (cdr gnus-cited-lines-visible))) + (if (<= (point) beg) + (setq beg nil) (setq end (point-marker)))))) - (when (and beg end) - (gnus-add-wash-type 'cite) - ;; We use markers for the end-points to facilitate later - ;; wrapping and mangling of text. - (setq beg (set-marker (make-marker) beg) - end (set-marker (make-marker) end)) - (gnus-add-text-properties-when 'article-type nil beg end props) - (goto-char beg) - (when (and gnus-cite-blank-line-after-header - (not (save-excursion (search-backward "\n\n" nil t)))) - (insert "\n")) - (put-text-property - (setq start (point-marker)) - (progn + (when (and beg end) + (gnus-add-wash-type 'cite) + ;; We use markers for the end-points to facilitate later + ;; wrapping and mangling of text. + (setq beg (set-marker (make-marker) beg) + end (set-marker (make-marker) end)) + (gnus-add-text-properties-when 'article-type nil beg end props) + (goto-char beg) + (when (and gnus-cite-blank-line-after-header + (not (save-excursion (search-backward "\n\n" nil t)))) + (insert "\n")) + (put-text-property + (setq start (point-marker)) + (progn (gnus-article-add-button (point) (progn (eval gnus-cited-closed-text-button-line-format-spec) @@ -628,8 +641,8 @@ always hide." `gnus-article-toggle-cited-text (list (cons beg end) start)) (point)) - 'article-type 'annotation) - (set-marker beg (point)))))))) + 'article-type 'annotation) + (set-marker beg (point)))))))) (defun gnus-article-toggle-cited-text (args &optional arg) "Toggle hiding the text in REGION. @@ -732,11 +745,9 @@ See also the documentation for `gnus-article-highlight-citation'." (defun gnus-article-hide-citation-in-followups () "Hide cited text in non-root articles." (interactive) - (save-excursion - (set-buffer gnus-article-buffer) + (with-current-buffer gnus-article-buffer (let ((article (cdr gnus-article-current))) - (unless (save-excursion - (set-buffer gnus-summary-buffer) + (unless (with-current-buffer gnus-summary-buffer (gnus-article-displayed-root-p article)) (gnus-article-hide-citation))))) @@ -1079,8 +1090,7 @@ See also the documentation for `gnus-article-highlight-citation'." (gnus-overlay-put overlay 'face face)))))) (defun gnus-cite-toggle (prefix) - (save-excursion - (set-buffer gnus-article-buffer) + (with-current-buffer gnus-article-buffer (gnus-cite-parse-maybe nil t) (let ((buffer-read-only nil) (numbers (cdr (assoc prefix gnus-cite-prefix-alist))) @@ -1248,5 +1258,4 @@ is turned on." ;; coding: iso-8859-1 ;; End: -;; arch-tag: 1997b044-6067-471e-8c8f-dc903093098a ;;; gnus-cite.el ends here diff --git a/lisp/gnus/gnus-cus.el b/lisp/gnus/gnus-cus.el index eb0dc51936a..89b893090b5 100644 --- a/lisp/gnus/gnus-cus.el +++ b/lisp/gnus/gnus-cus.el @@ -1118,5 +1118,4 @@ articles in the thread. (provide 'gnus-cus) -;; arch-tag: a37c285a-49bc-4235-8244-804536effeaf ;;; gnus-cus.el ends here diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el index e9d1a131068..05bbaf53465 100644 --- a/lisp/gnus/gnus-delay.el +++ b/lisp/gnus/gnus-delay.el @@ -192,5 +192,4 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil." ;; coding: iso-8859-1 ;; End: -;; arch-tag: fb2ad634-a897-4142-a503-f5991ec2349d ;;; gnus-delay.el ends here diff --git a/lisp/gnus/gnus-demon.el b/lisp/gnus/gnus-demon.el index 74aebf73b1d..caf9f8784b9 100644 --- a/lisp/gnus/gnus-demon.el +++ b/lisp/gnus/gnus-demon.el @@ -319,5 +319,4 @@ minutes, the connection is closed." (provide 'gnus-demon) -;; arch-tag: 8dd5cd3d-6ae4-46b4-9b15-f5fca09fd392 ;;; gnus-demon.el ends here diff --git a/lisp/gnus/gnus-diary.el b/lisp/gnus/gnus-diary.el index 8bd4cfde3f6..18130bbb0fb 100644 --- a/lisp/gnus/gnus-diary.el +++ b/lisp/gnus/gnus-diary.el @@ -401,5 +401,4 @@ If ARG (or prefix) is non-nil, force prompting for all fields." (provide 'gnus-diary) -;; arch-tag: 98467e70-337e-4ddc-b92d-45d403ff1b4b ;;; gnus-diary.el ends here diff --git a/lisp/gnus/gnus-dired.el b/lisp/gnus/gnus-dired.el index e5c886d8672..f9502b43c06 100644 --- a/lisp/gnus/gnus-dired.el +++ b/lisp/gnus/gnus-dired.el @@ -204,7 +204,7 @@ If ARG is non-nil, open it in a new buffer." (setq method (cdr (assoc 'viewer (car (mailcap-mime-info mime-type - 'all + 'all 'no-decode))))))) (let ((view-command (mm-mailcap-command method file-name nil))) (message "viewing via %s" view-command) @@ -261,5 +261,4 @@ file to save in." (provide 'gnus-dired) -;; arch-tag: 44737731-e445-4638-a31e-713c7590ec76 ;;; gnus-dired.el ends here diff --git a/lisp/gnus/gnus-draft.el b/lisp/gnus/gnus-draft.el index c04ea13b3a9..d53873045fd 100644 --- a/lisp/gnus/gnus-draft.el +++ b/lisp/gnus/gnus-draft.el @@ -325,5 +325,4 @@ Obeys the standard process/prefix convention." (provide 'gnus-draft) -;; arch-tag: 3d92af58-8c97-4a5c-9db4-a98e85198022 ;;; gnus-draft.el ends here diff --git a/lisp/gnus/gnus-dup.el b/lisp/gnus/gnus-dup.el index 71f6a39d7d1..be909ccd798 100644 --- a/lisp/gnus/gnus-dup.el +++ b/lisp/gnus/gnus-dup.el @@ -159,5 +159,4 @@ seen in the same session." (provide 'gnus-dup) -;; arch-tag: 903e94db-7b00-4d19-83ee-cf34a81fa5fb ;;; gnus-dup.el ends here diff --git a/lisp/gnus/gnus-eform.el b/lisp/gnus/gnus-eform.el index c8f43aed798..96b645686e9 100644 --- a/lisp/gnus/gnus-eform.el +++ b/lisp/gnus/gnus-eform.el @@ -130,5 +130,4 @@ The optional LAYOUT overrides the `edit-form' window layout." (provide 'gnus-eform) -;; arch-tag: ef50678c-2c28-49ef-affc-e53b3b2c0bf6 ;;; gnus-eform.el ends here diff --git a/lisp/gnus/gnus-ems.el b/lisp/gnus/gnus-ems.el index efa74146a91..7bc59bf1b69 100644 --- a/lisp/gnus/gnus-ems.el +++ b/lisp/gnus/gnus-ems.el @@ -276,7 +276,7 @@ (defun gnus-put-image (glyph &optional string category) (let ((point (point))) - (insert-image glyph (or string " ")) + (insert-image glyph (or string "*")) (put-text-property point (point) 'gnus-image-category category) (unless string (put-text-property (1- (point)) (point) @@ -305,7 +305,47 @@ (setq start end end nil)))))) +(eval-and-compile + (if (fboundp 'set-process-plist) + (progn + (defalias 'gnus-set-process-plist 'set-process-plist) + (defalias 'gnus-process-plist 'process-plist) + (defalias 'gnus-process-get 'process-get) + (defalias 'gnus-process-put 'process-put)) + (defun gnus-set-process-plist (process plist) + "Replace the plist of PROCESS with PLIST. Returns PLIST." + (put 'gnus-process-plist-internal process plist)) + + (defun gnus-process-plist (process) + "Return the plist of PROCESS." + ;; This form works but can't prevent the plist data from + ;; growing infinitely. + ;;(get 'gnus-process-plist-internal process) + (let* ((plist (symbol-plist 'gnus-process-plist-internal)) + (tem (memq process plist))) + (prog1 + (cadr tem) + ;; Remove it from the plist data. + (when tem + (if (eq plist tem) + (progn + (setcar plist (caddr plist)) + (setcdr plist (or (cdddr plist) '(nil)))) + (setcdr (nthcdr (- (length plist) (length tem) 1) plist) + (cddr tem))))))) + + (defun gnus-process-get (process propname) + "Return the value of PROCESS' PROPNAME property. +This is the last value stored with `(gnus-process-put PROCESS PROPNAME VALUE)'." + (plist-get (gnus-process-plist process) propname)) + + (defun gnus-process-put (process propname value) + "Change PROCESS' PROPNAME property to VALUE. +It can be retrieved with `(gnus-process-get PROCESS PROPNAME)'." + (gnus-set-process-plist process + (plist-put (gnus-process-plist process) + propname value))))) + (provide 'gnus-ems) -;; arch-tag: e7360b45-14b5-4171-aa39-69a44aed3cdb ;;; gnus-ems.el ends here diff --git a/lisp/gnus/gnus-fun.el b/lisp/gnus/gnus-fun.el index 5ca707c5a39..bc1ebd4a85f 100644 --- a/lisp/gnus/gnus-fun.el +++ b/lisp/gnus/gnus-fun.el @@ -290,5 +290,4 @@ colors of the displayed X-Faces." (provide 'gnus-fun) -;; arch-tag: 9d000a69-15cc-4491-9dc0-4627484f50c1 ;;; gnus-fun.el ends here diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 7a887735fe2..5cc4ef68bd9 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -169,7 +169,7 @@ list." (function-item gnus-group-sort-by-rank) (function :tag "other" nil)))) -(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)%O\n" +(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)\n" "*Format of group lines. It works along the same lines as a normal formatting string, with some simple extensions. @@ -660,7 +660,6 @@ simple manner.") "h" gnus-group-make-help-group "u" gnus-group-make-useful-group "a" gnus-group-make-archive-group - "k" gnus-group-make-kiboze-group "l" gnus-group-nnimap-edit-acl "m" gnus-group-make-group "E" gnus-group-edit-group @@ -680,13 +679,6 @@ simple manner.") "\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 @@ -938,7 +930,6 @@ simple manner.") ["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] ["Make an ephemeral group..." gnus-group-read-ephemeral-group t] @@ -972,13 +963,6 @@ simple manner.") (easy-menu-define gnus-group-misc-menu gnus-group-mode-map "" `("Gnus" - ("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-group-brew-soup (fboundp 'gnus-soup-pack-packet)]) ["Send a mail" gnus-group-mail t] ["Send a message (mail or news)" gnus-group-post-news t] ["Create a local message" gnus-group-news t] @@ -996,7 +980,6 @@ simple manner.") ["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] @@ -1705,72 +1688,66 @@ if it is a string, only list groups matching REGEXP." "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-group-entry group))) - (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) - (gnus-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-group-entry group)))) - (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) - (gnus-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))) + (with-current-buffer gnus-group-buffer + (save-excursion + ;; 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-group-entry group))) + (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) + (gnus-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-group-entry group)))) + (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) + (gnus-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)))))) (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) + (with-current-buffer gnus-group-buffer (let* ((gformat (or gnus-group-mode-line-format-spec (gnus-set-format 'group-mode))) (gnus-tmp-news-server (cadr gnus-select-method)) @@ -1783,8 +1760,7 @@ already." (and gnus-dribble-buffer (buffer-name gnus-dribble-buffer) (buffer-modified-p gnus-dribble-buffer) - (save-excursion - (set-buffer gnus-dribble-buffer) + (with-current-buffer gnus-dribble-buffer (not (zerop (buffer-size)))))) (mode-string (eval gformat))) ;; Say whether the dribble buffer has been modified. @@ -2202,7 +2178,10 @@ be permanent." The arguments are the same as `completing-read' except that COLLECTION and HIST default to `gnus-active-hashtb' and `gnus-group-history' respectively if they are omitted." - (let (group) + (let ((completion-styles (and (boundp 'completion-styles) + completion-styles)) + group) + (push 'substring completion-styles) (mapatoms (lambda (symbol) (setq group (symbol-name symbol)) (set (intern (if (string-match "[^\000-\177]" group) @@ -3094,42 +3073,6 @@ If there is, use Gnus to create an nnrss group" (nnrss-save-server-data nil)) (error "No feeds found for %s" url)))) -(defvar nnwarchive-type-definition) -(defvar gnus-group-warchive-type-history nil) -(defvar gnus-group-warchive-login-history nil) -(defvar gnus-group-warchive-address-history nil) - -(defun gnus-group-make-warchive-group () - "Create a nnwarchive group." - (interactive) - (require 'nnwarchive) - (let* ((group (gnus-read-group "Group name: ")) - (default-type (or (car gnus-group-warchive-type-history) - (symbol-name (caar nnwarchive-type-definition)))) - (type - (gnus-string-or - (completing-read - (format "Warchive type (default %s): " default-type) - (mapcar (lambda (elem) (list (symbol-name (car elem)))) - nnwarchive-type-definition) - nil t nil 'gnus-group-warchive-type-history) - default-type)) - (address (read-string "Warchive address: " - nil 'gnus-group-warchive-address-history)) - (default-login (or (car gnus-group-warchive-login-history) - user-mail-address)) - (login - (gnus-string-or - (read-string - (format "Warchive login (default %s): " user-mail-address) - default-login 'gnus-group-warchive-login-history) - user-mail-address)) - (method - `(nnwarchive ,address - (nnwarchive-type ,(intern type)) - (nnwarchive-login ,login)))) - (gnus-group-make-group group method))) - (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." @@ -3170,41 +3113,6 @@ mail messages or news articles in files that have numeric names." (gnus-group-real-name group) (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir))))) -(defvar nnkiboze-score-file) -(declare-function nnkiboze-score-file "nnkiboze" (group)) - -(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 'list - '("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 (regexp): " - header))))) - (push (list regexp nil nil 'r) regexps)) - (push (cons header regexps) scores)) - scores))) - (gnus-group-make-group group "nnkiboze" address) - (let* ((nnkiboze-current-group group) - (score-file (car (nnkiboze-score-file ""))) - (score-dir (file-name-directory score-file))) - (unless (file-exists-p score-dir) - (make-directory score-dir)) - (with-temp-file score-file - (let (emacs-lisp-mode-hook) - (gnus-pp scores))))) - (defun gnus-group-add-to-virtual (n vgroup) "Add the current group to a virtual group." (interactive @@ -4074,23 +3982,13 @@ re-scanning. If ARG is non-nil and not a number, this will force (>= arg gnus-use-nocem)) (not 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))) + + (gnus-get-unread-articles arg) + + ;; If the user wants it, we scan for new groups. + (when (eq gnus-check-new-newsgroups 'always) + (gnus-find-new-newsgroups)) + (gnus-check-reasonable-setup) (gnus-run-hooks 'gnus-after-getting-new-news-hook) (gnus-group-list-groups (and (numberp arg) @@ -4480,8 +4378,7 @@ The hook `gnus-exit-gnus-hook' is called before actually exiting." (gnus-run-hooks 'gnus-exit-gnus-hook) (gnus-configure-windows 'group t) (when (and (gnus-buffer-live-p gnus-dribble-buffer) - (not (zerop (save-excursion - (set-buffer gnus-dribble-buffer) + (not (zerop (with-current-buffer gnus-dribble-buffer (buffer-size))))) (gnus-dribble-enter ";;; Gnus was exited on purpose without saving the .newsrc files.")) @@ -4542,13 +4439,11 @@ and the second element is the address." (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) + (with-current-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) + (with-current-buffer gnus-group-buffer (if method ;; It's a foreign group... (gnus-group-make-group @@ -4612,8 +4507,7 @@ and the second element is the address." "Mark ARTICLE in GROUP with MARK, whether the group is displayed or not." (let ((buffer (gnus-summary-buffer-name group))) (if (gnus-buffer-live-p buffer) - (save-excursion - (set-buffer (get-buffer buffer)) + (with-current-buffer (get-buffer buffer) (gnus-summary-add-mark article mark)) (gnus-add-marked-articles group (cdr (assq mark gnus-article-mark-lists)) (list article))))) @@ -4813,5 +4707,4 @@ Compacting group %s... (this may take a long time)" (provide 'gnus-group) -;; arch-tag: 2eb5440f-0bca-4091-814c-e37817536af6 ;;; gnus-group.el ends here diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el new file mode 100644 index 00000000000..8bfbaaa5279 --- /dev/null +++ b/lisp/gnus/gnus-html.el @@ -0,0 +1,466 @@ +;;; gnus-html.el --- Render HTML in a buffer. + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> +;; Keywords: html, web + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; The idea is to provide a simple, fast and pretty minimal way to +;; render HTML (including links and images) in a buffer, based on an +;; external HTML renderer (i.e., w3m). + +;;; Code: + +(eval-when-compile (require 'cl)) +(eval-when-compile (require 'mm-decode)) +(require 'mm-url) + +(defcustom gnus-html-cache-directory (nnheader-concat gnus-directory "html-cache/") + "Where Gnus will cache images it downloads from the web." + :version "24.1" + :group 'gnus-art + :type 'directory) + +(defcustom gnus-html-cache-size 500000000 + "The size of the Gnus image cache." + :version "24.1" + :group 'gnus-art + :type 'integer) + +(defcustom gnus-html-frame-width 70 + "What width to use when rendering HTML." + :version "24.1" + :group 'gnus-art + :type 'integer) + +(defcustom gnus-blocked-images "." + "Images that have URLs matching this regexp will be blocked." + :version "24.1" + :group 'gnus-art + :type 'regexp) + +(defcustom gnus-max-image-proportion 0.7 + "How big pictures displayed are in relation to the window they're in. +A value of 0.7 means that they are allowed to take up 70% of the +width and height of the window. If they are larger than this, +and Emacs supports it, then the images will be rescaled down to +fit these criteria." + :version "24.1" + :group 'gnus-art + :type 'float) + +(defvar gnus-html-image-map + (let ((map (make-sparse-keymap))) + (define-key map "u" 'gnus-article-copy-string) + (define-key map "i" 'gnus-html-insert-image) + map)) + +(defvar gnus-html-displayed-image-map + (let ((map (make-sparse-keymap))) + (define-key map "a" 'gnus-html-show-alt-text) + (define-key map "i" 'gnus-html-browse-image) + (define-key map "\r" 'gnus-html-browse-url) + (define-key map "u" 'gnus-article-copy-string) + (define-key map [tab] 'widget-forward) + map)) + +;;;###autoload +(defun gnus-article-html (&optional handle) + (let ((article-buffer (current-buffer))) + (unless handle + (setq handle (mm-dissect-buffer t))) + (save-restriction + (narrow-to-region (point) (point)) + (save-excursion + (mm-with-part handle + (let* ((coding-system-for-read 'utf-8) + (coding-system-for-write 'utf-8) + (default-process-coding-system + (cons coding-system-for-read coding-system-for-write)) + (charset (mail-content-type-get (mm-handle-type handle) + 'charset))) + (when (and charset + (setq charset (mm-charset-to-coding-system charset)) + (not (eq charset 'ascii))) + (insert (prog1 + (mm-decode-coding-string (buffer-string) charset) + (erase-buffer) + (mm-enable-multibyte)))) + (call-process-region (point-min) (point-max) + "w3m" + nil article-buffer nil + "-halfdump" + "-no-cookie" + "-I" "UTF-8" + "-O" "UTF-8" + "-o" "ext_halfdump=1" + "-o" "pre_conv=1" + "-t" (format "%s" tab-width) + "-cols" (format "%s" gnus-html-frame-width) + "-o" "display_image=on" + "-T" "text/html")))) + (gnus-html-wash-tags)))) + +(defvar gnus-article-mouse-face) + +(defun gnus-html-pre-wash () + (goto-char (point-min)) + (while (re-search-forward " *<pre_int> *</pre_int> *\n" nil t) + (replace-match "" t t)) + (goto-char (point-min)) + (while (re-search-forward "<a name[^\n>]+>" nil t) + (replace-match "" t t))) + +(defun gnus-html-wash-images () + (let (tag parameters string start end images url) + (goto-char (point-min)) + ;; Search for all the images first. + (while (re-search-forward "<img_alt \\([^>]*\\)>" nil t) + (setq parameters (match-string 1) + start (match-beginning 0)) + (delete-region start (point)) + (when (search-forward "</img_alt>" (line-end-position) t) + (delete-region (match-beginning 0) (match-end 0))) + (setq end (point)) + (when (string-match "src=\"\\([^\"]+\\)" parameters) + (setq url (match-string 1 parameters)) + (gnus-message 8 "gnus-html-wash-tags: fetching image URL %s" url) + (if (string-match "^cid:\\(.*\\)" url) + ;; URLs with cid: have their content stashed in other + ;; parts of the MIME structure, so just insert them + ;; immediately. + (let ((handle (mm-get-content-id + (setq url (match-string 1 url)))) + image) + (when handle + (mm-with-part handle + (setq image (gnus-create-image (buffer-string) + nil t)))) + (when image + (let ((string (buffer-substring start end))) + (delete-region start end) + (gnus-put-image image (gnus-string-or string "*") 'cid) + (gnus-add-image 'cid image)))) + ;; Normal, external URL. + (if (gnus-html-image-url-blocked-p + url + (if (buffer-live-p gnus-summary-buffer) + (with-current-buffer gnus-summary-buffer + gnus-blocked-images) + gnus-blocked-images)) + (progn + (widget-convert-button + 'link start end + :action 'gnus-html-insert-image + :help-echo url + :keymap gnus-html-image-map + :button-keymap gnus-html-image-map) + (let ((overlay (gnus-make-overlay start end)) + (spec (list url + (set-marker (make-marker) start) + (set-marker (make-marker) end)))) + (gnus-overlay-put overlay 'local-map gnus-html-image-map) + (gnus-overlay-put overlay 'gnus-image spec) + (gnus-put-text-property + start end + 'gnus-image spec))) + (let ((file (gnus-html-image-id url)) + width height alt-text) + (when (string-match "height=\"?\\([0-9]+\\)" parameters) + (setq height (string-to-number (match-string 1 parameters)))) + (when (string-match "width=\"?\\([0-9]+\\)" parameters) + (setq width (string-to-number (match-string 1 parameters)))) + (when (string-match "\\(alt\\|title\\)=\"\\([^\"]+\\)" + parameters) + (setq alt-text (match-string 2 parameters))) + ;; Don't fetch images that are really small. They're + ;; probably tracking pictures. + (when (and (or (null height) + (> height 4)) + (or (null width) + (> width 4))) + (if (file-exists-p file) + ;; It's already cached, so just insert it. + (let ((string (buffer-substring start end))) + ;; Delete the IMG text. + (delete-region start end) + (gnus-html-put-image file (point) string url alt-text)) + ;; We don't have it, so schedule it for fetching + ;; asynchronously. + (push (list url + (set-marker (make-marker) start) + (point-marker)) + images)))))))) + (when images + (gnus-html-schedule-image-fetching (current-buffer) (nreverse images))))) + +(defun gnus-html-wash-tags () + (let (tag parameters string start end images url) + (gnus-html-pre-wash) + (gnus-html-wash-images) + + (goto-char (point-min)) + ;; Then do the other tags. + (while (re-search-forward "<\\([^ />]+\\)\\([^>]*\\)>" nil t) + (setq tag (match-string 1) + parameters (match-string 2) + start (match-beginning 0)) + (when (plusp (length parameters)) + (set-text-properties 0 (1- (length parameters)) nil parameters)) + (delete-region start (point)) + (when (search-forward (concat "</" tag ">") nil t) + (delete-region (match-beginning 0) (match-end 0))) + (setq end (point)) + (cond + ;; Fetch and insert a picture. + ((equal tag "img_alt")) + ;; Add a link. + ((or (equal tag "a") + (equal tag "A")) + (when (string-match "href=\"\\([^\"]+\\)" parameters) + (setq url (match-string 1 parameters)) + (gnus-message 8 "gnus-html-wash-tags: fetching link URL %s" url) + (gnus-article-add-button start end + 'browse-url url + url) + (let ((overlay (gnus-make-overlay start end))) + (gnus-overlay-put overlay 'evaporate t) + (gnus-overlay-put overlay 'gnus-button-url url) + (gnus-put-text-property start end 'gnus-string url) + (when gnus-article-mouse-face + (gnus-overlay-put overlay 'mouse-face gnus-article-mouse-face))))) + ;; The upper-case IMG_ALT is apparently just an artifact that + ;; should be deleted. + ((equal tag "IMG_ALT") + (delete-region start end)) + ;; Whatever. Just ignore the tag. + (t + )) + (goto-char start)) + (goto-char (point-min)) + ;; The output from -halfdump isn't totally regular, so strip + ;; off any </pre_int>s that were left over. + (while (re-search-forward "</pre_int>\\|</internal>" nil t) + (replace-match "" t t)) + (mm-url-decode-entities))) + +(defun gnus-html-insert-image () + "Fetch and insert the image under point." + (interactive) + (gnus-html-schedule-image-fetching + (current-buffer) (list (get-text-property (point) 'gnus-image)))) + +(defun gnus-html-show-alt-text () + "Show the ALT text of the image under point." + (interactive) + (message "%s" (get-text-property (point) 'gnus-alt-text))) + +(defun gnus-html-browse-image () + "Browse the image under point." + (interactive) + (browse-url (get-text-property (point) 'gnus-image))) + +(defun gnus-html-browse-url () + "Browse the image under point." + (interactive) + (let ((url (get-text-property (point) 'gnus-string))) + (if (not url) + (message "No URL at point") + (browse-url url)))) + +(defun gnus-html-schedule-image-fetching (buffer images) + (gnus-message 8 "gnus-html-schedule-image-fetching: buffer %s, images %s" + buffer images) + (let* ((url (caar images)) + (process (start-process + "images" nil "curl" + "-s" "--create-dirs" + "--location" + "--max-time" "60" + "-o" (gnus-html-image-id url) + (mm-url-decode-entities-string url)))) + (process-kill-without-query process) + (set-process-sentinel process 'gnus-html-curl-sentinel) + (gnus-set-process-plist process (list 'images images + 'buffer buffer)))) + +(defun gnus-html-image-id (url) + (expand-file-name (sha1 url) gnus-html-cache-directory)) + +(defun gnus-html-curl-sentinel (process event) + (when (string-match "finished" event) + (let* ((images (gnus-process-get process 'images)) + (buffer (gnus-process-get process 'buffer)) + (spec (pop images)) + (file (gnus-html-image-id (car spec)))) + (when (and (buffer-live-p buffer) + ;; If the position of the marker is 1, then that + ;; means that the text it was in has been deleted; + ;; i.e., that the user has selected a different + ;; article before the image arrived. + (not (= (marker-position (cadr spec)) (point-min)))) + (with-current-buffer buffer + (let ((inhibit-read-only t) + (string (buffer-substring (cadr spec) (caddr spec)))) + (delete-region (cadr spec) (caddr spec)) + (gnus-html-put-image file (cadr spec) string)))) + (when images + (gnus-html-schedule-image-fetching buffer images))))) + +(defun gnus-html-put-image (file point string &optional url alt-text) + (when (gnus-graphic-display-p) + (let* ((image (ignore-errors + (gnus-create-image file))) + (size (and image + (if (featurep 'xemacs) + (cons (glyph-width image) (glyph-height image)) + (image-size image t))))) + (save-excursion + (goto-char point) + (if (and image + ;; Kludge to avoid displaying 30x30 gif images, which + ;; seems to be a signal of a broken image. + (not (and (if (featurep 'xemacs) + (glyphp image) + (listp image)) + (eq (if (featurep 'xemacs) + (let ((data (cdadar (specifier-spec-list + (glyph-image image))))) + (and (vectorp data) + (aref data 0))) + (plist-get (cdr image) :type)) + 'gif) + (= (car size) 30) + (= (cdr size) 30)))) + (let ((start (point))) + (setq image (gnus-html-rescale-image image file size)) + (gnus-put-image image + (gnus-string-or string "*") + 'external) + (let ((overlay (gnus-make-overlay start (point)))) + (gnus-overlay-put overlay 'local-map + gnus-html-displayed-image-map) + (gnus-put-text-property start (point) 'gnus-alt-text alt-text) + (when url + (gnus-put-text-property start (point) 'gnus-image url))) + (gnus-add-image 'external image) + t) + (insert string) + (when (fboundp 'find-image) + (setq image (find-image '((:type xpm :file "lock-broken.xpm")))) + (gnus-put-image image + (gnus-string-or string "*") + 'internal) + (gnus-add-image 'internal image)) + nil))))) + +(defun gnus-html-rescale-image (image file size) + (if (or (not (fboundp 'imagemagick-types)) + (not (get-buffer-window (current-buffer)))) + image + (let* ((width (car size)) + (height (cdr size)) + (edges (window-pixel-edges (get-buffer-window (current-buffer)))) + (window-width (truncate (* gnus-max-image-proportion + (- (nth 2 edges) (nth 0 edges))))) + (window-height (truncate (* gnus-max-image-proportion + (- (nth 3 edges) (nth 1 edges))))) + scaled-image) + (when (> height window-height) + (setq image (or (create-image file 'imagemagick nil + :height window-height) + image)) + (setq size (image-size image t))) + (when (> (car size) window-width) + (setq image (or + (create-image file 'imagemagick nil + :width window-width) + image))) + image))) + +(defun gnus-html-prune-cache () + (let ((total-size 0) + files) + (dolist (file (directory-files gnus-html-cache-directory t nil t)) + (let ((attributes (file-attributes file))) + (unless (nth 0 attributes) + (incf total-size (nth 7 attributes)) + (push (list (time-to-seconds (nth 5 attributes)) + (nth 7 attributes) file) + files)))) + (when (> total-size gnus-html-cache-size) + (setq files (sort files (lambda (f1 f2) + (< (car f1) (car f2))))) + (dolist (file files) + (when (> total-size gnus-html-cache-size) + (decf total-size (cadr file)) + (delete-file (nth 2 file))))))) + +(defun gnus-html-image-url-blocked-p (url blocked-images) + "Find out if URL is blocked by BLOCKED-IMAGES." + (let ((ret (and blocked-images + (string-match blocked-images url)))) + (if ret + (gnus-message 8 "gnus-html-image-url-blocked-p: %s blocked by regex %s" + url blocked-images) + (gnus-message 9 "gnus-html-image-url-blocked-p: %s passes regex %s" + url blocked-images)) + ret)) + +(defun gnus-html-show-images () + "Show any images that are in the HTML-rendered article buffer. +This only works if the article in question is HTML." + (interactive) + (gnus-with-article-buffer + (let ((overlays (overlays-in (point-min) (point-max))) + overlay images) + (while (setq overlay (pop overlays)) + (when (overlay-get overlay 'gnus-image) + (push (overlay-get overlay 'gnus-image) images))) + (if (not images) + (message "No images to show") + (gnus-html-schedule-image-fetching (current-buffer) images))))) + +;;;###autoload +(defun gnus-html-prefetch-images (summary) + (let (blocked-images urls) + (when (buffer-live-p summary) + (with-current-buffer summary + (setq blocked-images gnus-blocked-images)) + (save-match-data + (while (re-search-forward "<img.*src=[\"']\\([^\"']+\\)" nil t) + (let ((url (match-string 1))) + (unless (gnus-html-image-url-blocked-p url blocked-images) + (unless (file-exists-p (gnus-html-image-id url)) + (push (mm-url-decode-entities-string url) urls) + (push (gnus-html-image-id url) urls) + (push "-o" urls))))) + (let ((process + (apply 'start-process + "images" nil "curl" + "-s" "--create-dirs" + "--location" + "--max-time" "60" + urls))) + (process-kill-without-query process)))))) + +(provide 'gnus-html) + +;;; gnus-html.el ends here diff --git a/lisp/gnus/gnus-int.el b/lisp/gnus/gnus-int.el index a0795916ea7..d805f3104d2 100644 --- a/lisp/gnus/gnus-int.el +++ b/lisp/gnus/gnus-int.el @@ -365,7 +365,7 @@ If it is down, start it up (again)." (when (stringp gnus-command-method) (setq gnus-command-method (inline (gnus-server-to-method gnus-command-method)))) - (funcall (inline (gnus-get-function gnus-command-method 'request-group)) + (funcall (inline (gnus-get-function gnus-command-method 'request-group)) (gnus-group-real-name group) (nth 1 gnus-command-method) dont-check))) @@ -544,7 +544,8 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." (if group (gnus-find-method-for-group group) gnus-command-method)) (gnus-inhibit-demon t) (mail-source-plugged gnus-plugged)) - (when (or gnus-plugged (not (gnus-agent-method-p gnus-command-method))) + (when (or gnus-plugged + (not (gnus-agent-method-p gnus-command-method))) (setq gnus-internal-registry-spool-current-method gnus-command-method) (funcall (gnus-get-function gnus-command-method 'request-scan) (and group (gnus-group-real-name group)) @@ -716,5 +717,4 @@ If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned." (provide 'gnus-int) -;; arch-tag: bbc90087-9b7f-4017-a92c-3abf180ac86d ;;; gnus-int.el ends here diff --git a/lisp/gnus/gnus-kill.el b/lisp/gnus/gnus-kill.el index e81d03207cb..fc564490fc9 100644 --- a/lisp/gnus/gnus-kill.el +++ b/lisp/gnus/gnus-kill.el @@ -715,5 +715,4 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score" (provide 'gnus-kill) -;; arch-tag: b30c0f53-df1a-490b-b81e-17b13474f395 ;;; gnus-kill.el ends here diff --git a/lisp/gnus/gnus-logic.el b/lisp/gnus/gnus-logic.el index 6875c324cb2..e6d28ae26aa 100644 --- a/lisp/gnus/gnus-logic.el +++ b/lisp/gnus/gnus-logic.el @@ -225,5 +225,4 @@ (provide 'gnus-logic) -;; arch-tag: 9651a100-4a59-4b69-a55b-e511e67c0f8d ;;; gnus-logic.el ends here diff --git a/lisp/gnus/gnus-mh.el b/lisp/gnus/gnus-mh.el index 67548d7cac6..7df4b466292 100644 --- a/lisp/gnus/gnus-mh.el +++ b/lisp/gnus/gnus-mh.el @@ -109,5 +109,4 @@ Otherwise, it is like +news/group." (provide 'gnus-mh) -;; arch-tag: 2d5696d3-b363-48e5-8749-c256be56acca ;;; gnus-mh.el ends here diff --git a/lisp/gnus/gnus-ml.el b/lisp/gnus/gnus-ml.el index 30c1bfedcef..5c42ef515fa 100644 --- a/lisp/gnus/gnus-ml.el +++ b/lisp/gnus/gnus-ml.el @@ -180,5 +180,4 @@ ADDRESS is specified by a \"mailto:\" URL." (provide 'gnus-ml) -;; arch-tag: 936c0fe6-acce-4c16-87d0-eded88078896 ;;; gnus-ml.el ends here diff --git a/lisp/gnus/gnus-mlspl.el b/lisp/gnus/gnus-mlspl.el index fb2fa3511ad..509e391480c 100644 --- a/lisp/gnus/gnus-mlspl.el +++ b/lisp/gnus/gnus-mlspl.el @@ -227,5 +227,4 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns: (provide 'gnus-mlspl) -;; arch-tag: 62b3381f-1e45-4b61-be1a-29fb27703322 ;;; gnus-mlspl.el ends here diff --git a/lisp/gnus/gnus-move.el b/lisp/gnus/gnus-move.el deleted file mode 100644 index 2c7a9585fec..00000000000 --- a/lisp/gnus/gnus-move.el +++ /dev/null @@ -1,181 +0,0 @@ -;;; gnus-move.el --- commands for moving Gnus from one server to another - -;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require '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) - (mail-sources nil)) - (gnus)) - - (save-excursion - ;; Go through all groups and translate. - (let ((nntp-nov-gap nil)) - (dolist (info gnus-newsrc-alist) - (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) - (gnus-uncompress-range - (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") - (when (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 (setq to-reads (delq nil 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. <duck> - (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-group-entry group) gnus-newsrc-hashtb) - (gnus-sethash group nil gnus-newsrc-hashtb)))) - -(provide 'gnus-move) - -;; arch-tag: 503742b8-7d66-4d79-bb31-4a698070707b -;;; gnus-move.el ends here diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index f314d33c6d6..a2a2652b082 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1989,5 +1989,4 @@ this is a reply." (provide 'gnus-msg) -;; arch-tag: 9f22b2f5-1c0a-49de-916e-4c88e984852b ;;; gnus-msg.el ends here diff --git a/lisp/gnus/gnus-nocem.el b/lisp/gnus/gnus-nocem.el index c6c396d7af0..0364c963a27 100644 --- a/lisp/gnus/gnus-nocem.el +++ b/lisp/gnus/gnus-nocem.el @@ -449,5 +449,4 @@ valid issuer, which is much faster if you are selective about the issuers." (provide 'gnus-nocem) -;; arch-tag: 0e0c74ea-2f8e-4f3e-8fff-09f767c1adef ;;; gnus-nocem.el ends here diff --git a/lisp/gnus/gnus-picon.el b/lisp/gnus/gnus-picon.el index 0b3b3b5c6a2..d319fd3f768 100644 --- a/lisp/gnus/gnus-picon.el +++ b/lisp/gnus/gnus-picon.el @@ -319,5 +319,4 @@ If picons are already displayed, remove them." (provide 'gnus-picon) -;; arch-tag: fe9aede0-1b1b-463a-b4ab-807f98bcb31f ;;; gnus-picon.el ends here diff --git a/lisp/gnus/gnus-range.el b/lisp/gnus/gnus-range.el index 78b05929deb..5eb8080ac0a 100644 --- a/lisp/gnus/gnus-range.el +++ b/lisp/gnus/gnus-range.el @@ -187,7 +187,7 @@ LIST1 and LIST2 have to be sorted over <." RANGE1 and RANGE2 have to be sorted over <." (let* (out (min1 (car range1)) - (max1 (if (numberp min1) + (max1 (if (numberp min1) (if (numberp (cdr range1)) (prog1 (cdr range1) (setq range1 nil)) min1) @@ -196,8 +196,8 @@ RANGE1 and RANGE2 have to be sorted over <." (min2 (car range2)) (max2 (if (numberp min2) (if (numberp (cdr range2)) - (prog1 (cdr range2) - (setq range2 nil)) min2) + (prog1 (cdr range2) + (setq range2 nil)) min2) (prog1 (cdr min2) (setq min2 (car min2)))))) (setq range1 (cdr range1) @@ -654,5 +654,4 @@ LIST is a sorted list." (provide 'gnus-range) -;; arch-tag: 4780bdd8-5a15-4aff-be28-18727895b6ad ;;; gnus-range.el ends here diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el index db10440116b..5f945826941 100644 --- a/lisp/gnus/gnus-registry.el +++ b/lisp/gnus/gnus-registry.el @@ -1,6 +1,6 @@ ;;; gnus-registry.el --- article registry for Gnus -;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 +;;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 ;;; Free Software Foundation, Inc. ;; Author: Ted Zlatanov <tzz@lifelogs.com> @@ -72,7 +72,7 @@ :version "22.1" :group 'gnus) -(defvar gnus-registry-hashtb (make-hash-table +(defvar gnus-registry-hashtb (make-hash-table :size 256 :test 'equal) "*The article registry by Message ID.") @@ -97,7 +97,7 @@ "List of registry marks and their options. `gnus-registry-mark-article' will offer symbols from this list -for completion. +for completion. Each entry must have a character to be useful for summary mode line display and for keyboard shortcuts. @@ -121,7 +121,7 @@ display." :group 'gnus-registry :type 'symbol) -(defcustom gnus-registry-unfollowed-groups +(defcustom gnus-registry-unfollowed-groups '("delayed$" "drafts$" "queue$" "INBOX$") "List of groups that gnus-registry-split-fancy-with-parent won't return. The group names are matched, they don't have to be fully @@ -206,9 +206,9 @@ considered precious) will not be trimmed." :group 'gnus-registry :type '(repeat symbol)) -(defcustom gnus-registry-cache-file - (nnheader-concat - (or gnus-dribble-directory gnus-home-directory "~/") +(defcustom gnus-registry-cache-file + (nnheader-concat + (or gnus-dribble-directory gnus-home-directory "~/") ".gnus.registry.eld") "File where the Gnus registry will be stored." :group 'gnus-registry @@ -253,7 +253,7 @@ considered precious) will not be trimmed." (if gnus-save-startup-file-via-temp-buffer (let ((coding-system-for-write gnus-ding-file-coding-system) (standard-output (current-buffer))) - (gnus-gnus-to-quick-newsrc-format + (gnus-gnus-to-quick-newsrc-format t "gnus registry startup file" 'gnus-registry-alist) (gnus-registry-cache-whitespace file) (save-buffer)) @@ -276,7 +276,7 @@ considered precious) will not be trimmed." (unwind-protect (progn (gnus-with-output-to-file working-file - (gnus-gnus-to-quick-newsrc-format + (gnus-gnus-to-quick-newsrc-format t "gnus registry startup file" 'gnus-registry-alist)) ;; These bindings will mislead the current buffer @@ -326,7 +326,7 @@ considered precious) will not be trimmed." (when gnus-registry-clean-empty (gnus-registry-clean-empty-function)) ;; now trim and clean text properties from the registry appropriately - (setq gnus-registry-alist + (setq gnus-registry-alist (gnus-registry-remove-alist-text-properties (gnus-registry-trim (gnus-hashtable-to-alist @@ -346,7 +346,7 @@ considered precious) will not be trimmed." (dolist (group (gnus-registry-fetch-groups key)) (when (gnus-parameter-registry-ignore group) (gnus-message - 10 + 10 "gnus-registry: deleted ignored group %s from key %s" group key) (gnus-registry-delete-group key group))) @@ -361,14 +361,14 @@ considered precious) will not be trimmed." (gnus-registry-fetch-extra key 'label)) (incf count) (gnus-registry-delete-id key)) - + (unless (stringp key) - (gnus-message - 10 - "gnus-registry key %s was not a string, removing" + (gnus-message + 10 + "gnus-registry key %s was not a string, removing" key) (gnus-registry-delete-id key)))) - + gnus-registry-hashtb) count)) @@ -391,7 +391,7 @@ considered precious) will not be trimmed." (defun gnus-registry-trim (alist) "Trim alist to size, using gnus-registry-max-entries. Any entries with extra data (marks, currently) are left alone." - (if (null gnus-registry-max-entries) + (if (null gnus-registry-max-entries) alist ; just return the alist ;; else, when given max-entries, trim the alist (let* ((timehash (make-hash-table @@ -420,25 +420,25 @@ Any entries with extra data (marks, currently) are left alone." (push item precious-list) (push item junk-list)))) - (sort + (sort junk-list (lambda (a b) - (let ((t1 (or (cdr (gethash (car a) timehash)) + (let ((t1 (or (cdr (gethash (car a) timehash)) '(0 0 0))) - (t2 (or (cdr (gethash (car b) timehash)) + (t2 (or (cdr (gethash (car b) timehash)) '(0 0 0)))) (time-less-p t1 t2)))) ;; we use the return value of this setq, which is the trimmed alist (setq alist (append precious-list (nthcdr trim-length junk-list)))))) - + (defun gnus-registry-action (action data-header from &optional to method) (let* ((id (mail-header-id data-header)) (subject (gnus-string-remove-all-properties (gnus-registry-simplify-subject (mail-header-subject data-header)))) - (sender (gnus-string-remove-all-properties + (sender (gnus-string-remove-all-properties (mail-header-from data-header))) (from (gnus-group-guess-full-name-from-command-method from)) (to (if to (gnus-group-guess-full-name-from-command-method to) nil)) @@ -489,7 +489,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (let* ((refstr (or (message-fetch-field "references") "")) ; guaranteed (reply-to (message-fetch-field "in-reply-to")) ; may be nil ;; now, if reply-to is valid, append it to the References - (refstr (if reply-to + (refstr (if reply-to (concat refstr " " reply-to) refstr)) ;; these may not be used, but the code is cleaner having them up here @@ -517,8 +517,8 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." 9 "%s is looking for matches for reference %s from [%s]" log-agent reference refstr) - (dolist (group (gnus-registry-fetch-groups - reference + (dolist (group (gnus-registry-fetch-groups + reference gnus-registry-max-track-groups)) (when (and group (gnus-registry-follow-group-p group)) (gnus-message @@ -528,9 +528,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (push group found)))) ;; filter the found groups and return them ;; the found groups are the full groups - (setq found (gnus-registry-post-process-groups + (setq found (gnus-registry-post-process-groups "references" refstr found found))) - + ;; else: there were no matches, now try the extra tracking by sender ((and (gnus-registry-track-sender-p) sender @@ -543,7 +543,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." matches) (when (and this-sender (equal sender this-sender)) - (let ((groups (gnus-registry-fetch-groups + (let ((groups (gnus-registry-fetch-groups key gnus-registry-max-track-groups))) (dolist (group groups) @@ -558,9 +558,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." gnus-registry-hashtb) ;; filter the found groups and return them ;; the found groups are NOT the full groups - (setq found (gnus-registry-post-process-groups + (setq found (gnus-registry-post-process-groups "sender" sender found found-full))) - + ;; else: there were no matches, now try the extra tracking by subject ((and (gnus-registry-track-subject-p) subject @@ -572,7 +572,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." matches) (when (and this-subject (equal subject this-subject)) - (let ((groups (gnus-registry-fetch-groups + (let ((groups (gnus-registry-fetch-groups key gnus-registry-max-track-groups))) (dolist (group groups) @@ -587,7 +587,7 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." gnus-registry-hashtb) ;; filter the found groups and return them ;; the found groups are NOT the full groups - (setq found (gnus-registry-post-process-groups + (setq found (gnus-registry-post-process-groups "subject" subject found found-full)))) ;; after the (cond) we extract the actual value safely (car-safe found))) @@ -627,7 +627,7 @@ necessary." (lambda (a b) (> (gethash a freq 0) (gethash b freq 0))))))))) - + (if gnus-registry-use-long-group-names (dolist (group groups) (let ((m1 (gnus-find-method-for-group group)) @@ -661,10 +661,10 @@ necessary." "Determines if a group name should be followed. Consults `gnus-registry-unfollowed-groups' and `nnmail-split-fancy-with-parent-ignore-groups'." - (not (or (gnus-registry-grep-in-list + (not (or (gnus-grep-in-list group gnus-registry-unfollowed-groups) - (gnus-registry-grep-in-list + (gnus-grep-in-list group nnmail-split-fancy-with-parent-ignore-groups)))) @@ -708,8 +708,8 @@ Consults `gnus-registry-unfollowed-groups' and (unless (member gnus-newsgroup-name (gnus-registry-fetch-groups id)) (gnus-message 9 "Registry: Registering article %d with group %s" article gnus-newsgroup-name) - (gnus-registry-add-group - id + (gnus-registry-add-group + id gnus-newsgroup-name (gnus-registry-fetch-simplified-message-subject-fast article) (gnus-registry-fetch-sender-fast article))))))) @@ -745,14 +745,6 @@ Consults `gnus-registry-unfollowed-groups' and (assoc article (gnus-data-list nil))))) nil)) -(defun gnus-registry-grep-in-list (word list) -"Find if a WORD matches any regular expression in the given LIST." - (when (and word list) - (catch 'found - (dolist (r list) - (when (string-match r word) - (throw 'found r)))))) - (defun gnus-registry-do-marks (type function) "For each known mark, call FUNCTION for each cell of type TYPE. @@ -793,18 +785,18 @@ Uses `gnus-registry-marks' to find what shortcuts to install." (shortcut (if remove (upcase shortcut) shortcut))) (unintern function-name) (eval - `(defun + `(defun ;; function name - ,(intern function-name) + ,(intern function-name) ;; parameter definition (&rest articles) ;; documentation - ,(format + ,(format "%s the %s mark over process-marked ARTICLES." (upcase-initials variant-name) mark) ;; interactive definition - (interactive + (interactive (gnus-summary-work-articles current-prefix-arg)) ;; actual code @@ -815,49 +807,49 @@ Uses `gnus-registry-marks' to find what shortcuts to install." ;; now the user is asked if gnus-registry-install is 'ask (when (gnus-registry-install-p) - (gnus-registry-set-article-mark-internal + (gnus-registry-set-article-mark-internal ;; all this just to get the mark, I must be doing it wrong (intern ,(symbol-name mark)) articles ,remove t) (gnus-message - 9 + 9 "Applying mark %s to %d articles" ,(symbol-name mark) (length articles)) (dolist (article articles) - (gnus-summary-update-article + (gnus-summary-update-article article (assoc article (gnus-data-list nil))))))) (push (intern function-name) keys-plist) - (push shortcut keys-plist) + (push shortcut keys-plist) (push (vector (format "%s %s" (upcase-initials variant-name) (symbol-name mark)) (intern function-name) t) gnus-registry-misc-menus) (gnus-message - 9 - "Defined mark handling function %s" + 9 + "Defined mark handling function %s" function-name)))))) (gnus-define-keys-1 '(gnus-registry-mark-map "M" gnus-summary-mark-map) keys-plist) (add-hook 'gnus-summary-menu-hook (lambda () - (easy-menu-add-item + (easy-menu-add-item gnus-summary-misc-menu - nil + nil (cons "Registry Marks" gnus-registry-misc-menus)))))) ;;; use like this: -;;; (defalias 'gnus-user-format-function-M +;;; (defalias 'gnus-user-format-function-M ;;; 'gnus-registry-user-format-function-M) (defun gnus-registry-user-format-function-M (headers) (let* ((id (mail-header-message-id headers)) (marks (when id (gnus-registry-fetch-extra-marks id)))) (apply 'concat (mapcar (lambda(mark) - (let ((c + (let ((c (plist-get - (cdr-safe + (cdr-safe (assoc mark gnus-registry-marks)) :char))) (if c @@ -867,9 +859,9 @@ Uses `gnus-registry-marks' to find what shortcuts to install." (defun gnus-registry-read-mark () "Read a mark name from the user with completion." - (let ((mark (gnus-completing-read-with-default + (let ((mark (gnus-completing-read-with-default (symbol-name gnus-registry-default-mark) - "Label" + "Label" (mapcar (lambda (x) ; completion list (cons (symbol-name (car-safe x)) (car-safe x))) gnus-registry-marks)))) @@ -904,7 +896,7 @@ Uses `gnus-registry-marks' to find what shortcuts to install." (gnus-message 1 "%s mark %s with message ID %s, resulting in %S" (if remove "Removing" "Adding") mark id new-marks)) - + (apply 'gnus-registry-store-extra-marks ; set the extra marks id ; for the message ID new-marks))))) @@ -1015,7 +1007,7 @@ The message must have at least one group name." "Put a specific entry in the extras field of the registry entry for id." (let* ((extra (gnus-registry-fetch-extra id)) ;; all the entries except the one for `key' - (the-rest (gnus-assq-delete-all key (gnus-registry-fetch-extra id))) + (the-rest (gnus-assq-delete-all key (gnus-registry-fetch-extra id))) (alist (if value (gnus-registry-remove-alist-text-properties (cons (cons key value) @@ -1042,7 +1034,7 @@ Returns the first place where the trail finds a group name." (dolist (crumb trail) (when (stringp crumb) ;; push the group name into the list - (setq + (setq groups (cons (if (or (not (stringp crumb)) gnus-registry-use-long-group-names) @@ -1191,5 +1183,4 @@ Returns the first place where the trail finds a group name." (provide 'gnus-registry) -;; arch-tag: 5cba0a32-718a-4a97-8c91-0a15af21da94 ;;; gnus-registry.el ends here diff --git a/lisp/gnus/gnus-salt.el b/lisp/gnus/gnus-salt.el index 52f307d7fdd..21b9d8954fe 100644 --- a/lisp/gnus/gnus-salt.el +++ b/lisp/gnus/gnus-salt.el @@ -1045,5 +1045,4 @@ The following commands are available: (provide 'gnus-salt) -;; arch-tag: 35449164-77b3-4398-bcbd-a2e3e998f810 ;;; gnus-salt.el ends here diff --git a/lisp/gnus/gnus-score.el b/lisp/gnus/gnus-score.el index 26c01229e33..bd4a39eb7b1 100644 --- a/lisp/gnus/gnus-score.el +++ b/lisp/gnus/gnus-score.el @@ -2055,8 +2055,11 @@ score in `gnus-newsgroup-scored' by SCORE." ;; Evil hackery to make match usable in non-standard headers. (when extra - (setq match (concat "[ (](" extra " \\. \"[^)]*" - match "[^\"]*\")[ )]") + (setq match (concat "[ (](" extra " \\. \"\\([^\"]*\\\\\"\\)*[^\"]*" + (if (eq search-func 're-search-forward) + match + (regexp-quote match)) + "\\([^\"]*\\\\\"\\)*[^\"]*\")[ )]") search-func 're-search-forward)) ; XXX danger?!? (cond @@ -3119,5 +3122,4 @@ See Info node `(gnus)Scoring Tips' for examples of good regular expressions." (provide 'gnus-score) -;; arch-tag: d3922589-764d-46ae-9954-9330fd192634 ;;; gnus-score.el ends here diff --git a/lisp/gnus/gnus-setup.el b/lisp/gnus/gnus-setup.el index 9cfa6584177..d5578ff6933 100644 --- a/lisp/gnus/gnus-setup.el +++ b/lisp/gnus/gnus-setup.el @@ -189,5 +189,4 @@ score the alt hierarchy, you'd say \"!alt.all\"." t nil)) (run-hooks 'gnus-setup-load-hook) -;; arch-tag: 08e4af93-8565-46bf-905c-36229400609d ;;; gnus-setup.el ends here diff --git a/lisp/gnus/gnus-sieve.el b/lisp/gnus/gnus-sieve.el index abc63c1d1c6..a7ddbf08f7f 100644 --- a/lisp/gnus/gnus-sieve.el +++ b/lisp/gnus/gnus-sieve.el @@ -235,5 +235,4 @@ This is returned as a string." (provide 'gnus-sieve) -;; arch-tag: 3b906527-c7f3-4c86-9e82-62e2697998a3 ;;; gnus-sieve.el ends here diff --git a/lisp/gnus/gnus-soup.el b/lisp/gnus/gnus-soup.el deleted file mode 100644 index 13271a9c15a..00000000000 --- a/lisp/gnus/gnus-soup.el +++ /dev/null @@ -1,611 +0,0 @@ -;;; gnus-soup.el --- SOUP packet writing support for Gnus - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Per Abrahamsen <abraham@iesd.auc.dk> -;; Lars Magne Ingebrigtsen <larsi@gnus.org> -;; 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 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'gnus) -(require 'gnus-art) -(require 'message) -(require 'gnus-start) -(require 'gnus-range) - -(defgroup gnus-soup nil - "SOUP packet writing support for Gnus." - :group 'gnus) - -;;; User Variables: - -(defcustom gnus-soup-directory (nnheader-concat gnus-home-directory "SoupBrew/") - "Directory containing an unpacked SOUP packet." - :version "22.1" ;; Gnus 5.10.9 - :type 'directory - :group 'gnus-soup) - -(defcustom gnus-soup-replies-directory - (nnheader-concat gnus-soup-directory "SoupReplies/") - "Directory where Gnus will do processing of replies." - :version "22.1" ;; Gnus 5.10.9 - :type 'directory - :group 'gnus-soup) - -(defcustom gnus-soup-prefix-file "gnus-prefix" - "Name of the file where Gnus stores the last used prefix." - :version "22.1" ;; Gnus 5.10.9 - :type 'file - :group 'gnus-soup) - -(defcustom 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." - :version "22.1" ;; Gnus 5.10.9 - :type 'string - :group 'gnus-soup) - -(defcustom 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." - :version "22.1" ;; Gnus 5.10.9 - :type 'string - :group 'gnus-soup) - -(defcustom gnus-soup-packet-directory gnus-home-directory - "Where gnus-soup will look for REPLIES packets." - :version "22.1" ;; Gnus 5.10.9 - :type 'directory - :group 'gnus-soup) - -(defcustom gnus-soup-packet-regexp "Soupin" - "Regular expression matching SOUP REPLIES packets in `gnus-soup-packet-directory'." - :version "22.1" ;; Gnus 5.10.9 - :type 'regexp - :group 'gnus-soup) - -(defcustom gnus-soup-ignored-headers "^Xref:" - "Regexp to match headers to be removed when brewing SOUP packets." - :version "22.1" ;; Gnus 5.10.9 - :type 'regexp - :group 'gnus-soup) - -;;; Internal Variables: - -(defvar gnus-soup-encoding-type ?u - "*Soup encoding type. -`u' is USENET 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") - (let* ((articles (gnus-summary-work-articles n)) - (tmp-buf (gnus-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 - ;; Put the article in a buffer. - (set-buffer tmp-buf) - (when (gnus-request-article-this-buffer - (car articles) gnus-newsgroup-name) - (setq headers (nnheader-parse-head t)) - (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-mark-as-read (car articles) gnus-souped-mark)) - (gnus-summary-remove-process-mark (car articles)) - (setq articles (cdr articles))) - (kill-buffer tmp-buf)) - (gnus-soup-save-areas) - (gnus-set-mode-line 'summary))) - -(defun gnus-soup-pack-packet () - "Make a SOUP packet from the SOUP areas." - (interactive) - (gnus-soup-read-areas) - (if (file-exists-p gnus-soup-directory) - (if (directory-files gnus-soup-directory nil "\\.MSG$") - (gnus-soup-pack gnus-soup-directory gnus-soup-packer) - (message "No files to pack.")) - (message "No such directory: %s" gnus-soup-directory))) - -(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.*\" - -Note -- this function hasn't been implemented yet." - (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 - ((or (= gnus-soup-encoding-type ?u) - (= gnus-soup-encoding-type ?n)) ;;Gnus back compatibility. - (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-group-entry group))) - (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 () - "Write all SOUP buffers." - (interactive) - (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))) - (let ((coding-system-for-write mm-text-coding-system)) - (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-number (gnus-soup-unique-prefix dir))) - (format packer - (string-to-number (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 (eq 0 (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) - (when (file-exists-p file) - (save-excursion - (set-buffer (nnheader-find-file-noselect file 'force)) - (buffer-disable-undo) - (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-number (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) - (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 - (with-temp-file (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." - (with-temp-file (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 - (eq 0 (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 (gnus-get-buffer-create " *soup send*")) - beg end) - (cond - ((and (/= (gnus-soup-encoding-format - (gnus-soup-reply-encoding (car replies))) - ?u) - (/= (gnus-soup-encoding-format - (gnus-soup-reply-encoding (car replies))) - ?n)) ;; Gnus back compatibility. - (error "Unsupported encoding")) - ((null msg-buf) - t) - (t - (buffer-disable-undo msg-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-number - (buffer-substring - (match-beginning 1) (match-end 1))))) - (switch-to-buffer tmp-buf) - (erase-buffer) - (mm-disable-multibyte) - (insert-buffer-substring msg-buf beg end) - (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) - (method (if (functionp message-post-method) - (funcall message-post-method) - message-post-method)) - result) - (run-hooks 'message-send-news-hook) - (gnus-open-server method) - (message "Sending news via %s..." - (gnus-server-string method)) - (unless (let ((mail-header-separator "")) - (gnus-request-post method)) - (message "Couldn't send message via news: %s" - (nnheader-get-report (car method)))))) - ((string= (gnus-soup-reply-kind (car replies)) "mail") - (gnus-message 5 "Sending mail to %s..." - (mail-fetch-field "to")) - (sit-for 1) - (let ((mail-header-separator "")) - (funcall (or message-send-mail-real-function - message-send-mail-function)))) - (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) - -;; arch-tag: eddfa69d-13e8-4aea-84ef-62a526ef185c -;;; gnus-soup.el ends here diff --git a/lisp/gnus/gnus-spec.el b/lisp/gnus/gnus-spec.el index 1c5fa4741af..91a1784ca20 100644 --- a/lisp/gnus/gnus-spec.el +++ b/lisp/gnus/gnus-spec.el @@ -767,5 +767,4 @@ If PROPS, insert the result." ;; coding: iso-8859-1 ;; End: -;; arch-tag: a4328fa1-1f84-4b09-97ad-4b5767cfd50f ;;; gnus-spec.el ends here diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el index ba5609efc99..dd5e51885c2 100644 --- a/lisp/gnus/gnus-srvr.el +++ b/lisp/gnus/gnus-srvr.el @@ -1033,5 +1033,4 @@ Requesting compaction of %s... (this may take a long time)" (provide 'gnus-srvr) -;; arch-tag: c0117f64-27ca-475d-9406-8da6854c7a25 ;;; gnus-srvr.el ends here diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 9ef251f2147..1c06a774203 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -765,7 +765,7 @@ prompt the user for the name of an NNTP server to use." (when gnus-select-method (push (cons "native" gnus-select-method) gnus-predefined-server-alist)) - + (if gnus-agent (gnus-agentize)) @@ -814,6 +814,7 @@ prompt the user for the name of an NNTP server to use." (defun gnus-start-draft-setup () "Make sure the draft group exists." + (interactive) (gnus-request-create-group "drafts" '(nndraft "")) (unless (gnus-group-entry "nndraft:drafts") (let ((gnus-level-default-subscribed 1)) @@ -868,6 +869,8 @@ prompt the user for the name of an NNTP server to use." (defun gnus-dribble-read-file () "Read the dribble file from disk." (let ((dribble-file (gnus-dribble-file-name))) + (unless (file-exists-p (file-name-directory dribble-file)) + (make-directory (file-name-directory dribble-file) t)) (save-excursion (set-buffer (setq gnus-dribble-buffer (gnus-get-buffer-create @@ -1523,7 +1526,8 @@ newsgroup." (when (> (cdr cache-active) (cdr active)) (setcdr active (cdr cache-active)))))))) -(defun gnus-activate-group (group &optional scan dont-check method) +(defun gnus-activate-group (group &optional scan dont-check method + dont-sub-check) "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)))) @@ -1538,9 +1542,11 @@ If SCAN, request a scan of that group as well." (gnus-request-scan group method)) t) (if (or debug-on-error debug-on-quit) - (inline (gnus-request-group group dont-check method)) + (inline (gnus-request-group group (or dont-sub-check dont-check) + method)) (condition-case nil - (inline (gnus-request-group group dont-check method)) + (inline (gnus-request-group group (or dont-sub-check dont-check) + method)) ;;(error nil) (quit (message "Quit activating %s" group) @@ -1671,18 +1677,22 @@ If SCAN, request a scan of that group as well." (let* ((newsrc (cdr gnus-newsrc-alist)) (alevel (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)) - alevel)) + (or + 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)) + alevel))) (methods-cache nil) (type-cache nil) - scanned-methods info group active method retrieve-groups cmethod - method-type) + (gnus-agent-article-local-times 0) + (archive-method (gnus-server-to-method "archive")) + infos info group active method cmethod + method-type method-group-list entry) (gnus-message 6 "Checking new news...") (while newsrc @@ -1701,115 +1711,109 @@ If SCAN, request a scan of that group as well." ;; nil for non-foreign groups that the user has requested not be checked ;; t for unchecked foreign groups or bogus groups, or groups that can't ;; be checked, for one reason or other. - (when (setq method (gnus-info-method info)) + + ;; First go through all the groups, see what select methods they + ;; belong to, and then collect them into lists per unique select + ;; method. + (if (not (setq method (gnus-info-method info))) + (setq method gnus-select-method) (if (setq cmethod (assoc method methods-cache)) (setq method (cdr cmethod)) (setq cmethod (inline (gnus-server-get-method nil method))) (push (cons method cmethod) methods-cache) (setq method cmethod))) - (when (and method - (not (setq method-type (cdr (assoc method type-cache))))) + (setq method-group-list (assoc method type-cache)) + (unless method-group-list (setq method-type (cond - ((gnus-secondary-method-p method) + ((or (gnus-secondary-method-p method) + (and (gnus-archive-server-wanted-p) + (gnus-methods-equal-p archive-method method))) 'secondary) ((inline (gnus-server-equal gnus-select-method method)) 'primary) (t 'foreign))) - (push (cons method method-type) type-cache)) - - (cond ((and method (eq method-type 'foreign)) - ;; These groups are foreign. Check the level. - (if (<= (gnus-info-level info) foreign-level) - (when (setq active (gnus-activate-group group 'scan)) - ;; Let the Gnus agent save the active file. - (when (and gnus-agent active (gnus-online method)) - (gnus-agent-save-group-info - method (gnus-group-real-name group) active)) - (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)))) - (if (and level - ;; If `active' is nil that means the group has - ;; never been read, the group should be marked - ;; as having never been checked (see below). - active - (> (gnus-info-level info) level)) - ;; Don't check groups of which levels are higher - ;; than the one that a user specified. - (setq active 'ignore)))) - ;; These groups are native or secondary. - ((> (gnus-info-level info) alevel) - ;; We don't want these groups. - (setq active 'ignore)) - ;; Activate groups. - ((not gnus-read-active-file) - (if (gnus-check-backend-function 'retrieve-groups group) - ;; if server support gnus-retrieve-groups we push - ;; the group onto retrievegroups for later checking - (if (assoc method retrieve-groups) - (setcdr (assoc method retrieve-groups) - (cons group (cdr (assoc method retrieve-groups)))) - (push (list method group) retrieve-groups)) - ;; hack: `nnmail-get-new-mail' changes the mail-source depending - ;; on the group, so we must perform a scan for every group - ;; if the users has any directory mail sources. - ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil, - ;; for it scan all spool files even when the groups are - ;; not required. - (if (and - (or nnmail-scan-directory-mail-source-once - (null (assq 'directory mail-sources))) - (member method scanned-methods)) - (setq active (gnus-activate-group group)) - (setq active (gnus-activate-group group 'scan)) - (push method scanned-methods)) - (when active - (gnus-close-group group))))) - - ;; Get the number of unread articles in the group. - (cond - ((eq active 'ignore) - ;; Don't do anything. - ) - (active - (inline (gnus-get-unread-articles-in-group info active t))) - (t - ;; The group couldn't be reached, so we nix out the number of - ;; unread articles and stuff. - (gnus-set-active group nil) - (let ((tmp (gnus-group-entry group))) - (when tmp - (setcar tmp t)))))) - - ;; iterate through groups on methods which support gnus-retrieve-groups - ;; and fetch a partial active file and use it to find new news. - (dolist (rg retrieve-groups) - (let ((method (or (car rg) gnus-select-method)) - (groups (cdr rg))) - (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)) - (gnus-read-active-file-2 - (mapcar (lambda (group) (gnus-group-real-name group)) groups) - method) - (dolist (group groups) - (cond - ((setq active (gnus-active (gnus-info-group - (setq info (gnus-get-info group))))) - (inline (gnus-get-unread-articles-in-group info active t))) - (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-group-entry group) t))))))) + (push (setq method-group-list (list method method-type nil)) + type-cache)) + ;; Only add groups that need updating. + (if (<= (gnus-info-level info) + (if (eq (cadr method-group-list) 'foreign) + foreign-level + alevel)) + (setcar (nthcdr 2 method-group-list) + (cons info (nth 2 method-group-list))) + ;; The group is inactive, so we nix out the number of unread articles. + ;; It leads `(gnus-group-unread group)' to return t. See also + ;; `gnus-group-prepare-flat'. + (unless active + (when (setq entry (gnus-group-entry group)) + (setcar entry t))))) + + ;; Sort the methods based so that the primary and secondary + ;; methods come first. This is done for legacy reasons to try to + ;; ensure that side-effect behaviour doesn't change from previous + ;; Gnus versions. + (setq type-cache + (sort (nreverse type-cache) + (lambda (c1 c2) + (< (gnus-method-rank (cadr c1) (car c1)) + (gnus-method-rank (cadr c2) (car c2)))))) + + (while type-cache + (setq method (nth 0 (car type-cache)) + method-type (nth 1 (car type-cache)) + infos (nth 2 (car type-cache))) + (pop type-cache) + (when (and method + infos) + ;; See if any of the groups from this method require updating. + (gnus-read-active-for-groups method infos) + (dolist (info infos) + (inline (gnus-get-unread-articles-in-group + info (gnus-active (gnus-info-group info))))))) (gnus-message 6 "Checking new news...done"))) +(defun gnus-method-rank (type method) + (cond + ;; Get info for virtual groups last. + ((eq (car method) 'nnvirtual) + 200) + ((eq type 'primary) + 1) + ;; Compute the rank of the secondary methods based on where they + ;; are in the secondary select list. + ((eq type 'secondary) + (let ((i 2)) + (block nil + (dolist (smethod gnus-secondary-select-methods) + (when (equal method smethod) + (return i)) + (incf i)) + i))) + ;; Just say that all foreign groups have the same rank. + (t + 100))) + +(defun gnus-read-active-for-groups (method infos) + (with-current-buffer nntp-server-buffer + (cond + ((gnus-check-backend-function 'retrieve-groups (car method)) + (when (gnus-check-backend-function 'request-scan (car method)) + (dolist (info infos) + (gnus-request-scan (gnus-info-group info) method))) + (let (groups) + (gnus-read-active-file-2 + (dolist (info infos (nreverse groups)) + (push (gnus-group-real-name (gnus-info-group info)) groups)) + method))) + ((gnus-check-backend-function 'request-list (car method)) + (gnus-read-active-file-1 method nil infos)) + (t + (dolist (info infos) + (gnus-activate-group (gnus-info-group info) nil nil method t)))))) + ;; 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 () @@ -1830,14 +1834,18 @@ If SCAN, request a scan of that group as well." (if (setq rest (member method methods)) (gnus-info-set-method info (car rest)) (push method methods))) - (gnus-sethash - (car info) - ;; Preserve number of unread articles in groups. - (cons (and ohashtb (car (gnus-gethash (car info) ohashtb))) - prev) - gnus-newsrc-hashtb) - (setq prev alist - alist (cdr alist))) + ;; Check for duplicates. + (if (gnus-gethash (car info) gnus-newsrc-hashtb) + ;; Remove this entry from the alist. + (setcdr prev (cddr prev)) + (gnus-sethash + (car info) + ;; Preserve number of unread articles in groups. + (cons (and ohashtb (car (gnus-gethash (car info) ohashtb))) + prev) + gnus-newsrc-hashtb) + (setq prev alist)) + (setq alist (cdr alist))) ;; Make the same select-methods in `gnus-server-alist' identical ;; as well. (while methods @@ -2030,7 +2038,7 @@ If SCAN, request a scan of that group as well." (message "Quit reading the active file") nil)))))))) -(defun gnus-read-active-file-1 (method force) +(defun gnus-read-active-file-1 (method force &optional infos) (let (where mesg) (setq where (nth 1 method) mesg (format "Reading active file%s via %s..." @@ -2040,8 +2048,14 @@ If SCAN, request a scan of that group as well." (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)) + (when (and (or (and gnus-agent + (gnus-online method)) + (not gnus-agent)) + (gnus-check-backend-function 'request-scan (car method))) + (if infos + (dolist (info infos) + (gnus-request-scan (gnus-info-group info) method)) + (gnus-request-scan nil method))) (cond ((and (eq gnus-read-active-file 'some) (gnus-check-backend-function 'retrieve-groups (car method)) @@ -3192,7 +3206,4 @@ If this variable is nil, don't do anything." (provide 'gnus-start) -;; arch-tag: f4584a22-b7b7-4853-abfc-a637329af5d2 ;;; gnus-start.el ends here - - diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 93024e07280..df20456b278 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -76,6 +76,13 @@ See `gnus-group-goto-unread'." :version "23.1" ;; No Gnus :type 'boolean) +(defcustom gnus-summary-stop-at-end-of-message nil + "If non-nil, don't select the next message when using `SPC'." + :link '(custom-manual "(gnus)Group Maneuvering") + :group 'gnus-summary-maneuvering + :version "24.1" + :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 @@ -214,7 +221,7 @@ This variable will only be used if the value of :group 'gnus-summary-format :type 'string) -(defcustom gnus-summary-goto-unread t +(defcustom gnus-summary-goto-unread nil "*If t, many commands will go to the next unread article. This applies to marking commands as well as other commands that \"naturally\" select the next article, like, for instance, `SPC' at @@ -224,6 +231,7 @@ If nil, the marking commands do NOT go to the next unread article \(they go to the next article instead). If `never', commands that usually go to the next unread article, will go to the next article, whether it is read or not." + :version "24.1" :group 'gnus-summary-marks :link '(custom-manual "(gnus)Setting Marks") :type '(choice (const :tag "off" nil) @@ -342,7 +350,7 @@ newsgroups, set the variable to nil in `gnus-select-group-hook'." :type '(choice (const :tag "none" nil) (sexp :menu-tag "first" t))) -(defcustom gnus-auto-select-subject 'unread +(defcustom gnus-auto-select-subject 'unseen-or-unread "*Says what subject to place under point when entering a group. This variable can either be the symbols `first' (place point on the @@ -353,7 +361,7 @@ the first unseen article), `unseen-or-unread' (place point on the subject line of the first unseen article or, if all article have been seen, on the subject line of the first unread article), or a function to be called to place point on some subject line." - :version "22.1" + :version "24.1" :group 'gnus-group-select :type '(choice (const best) (const unread) @@ -457,9 +465,10 @@ and non-`vertical', do both horizontal and vertical recentering." :group 'gnus-summary :type 'boolean) -(defcustom gnus-single-article-buffer t +(defcustom gnus-single-article-buffer nil "*If non-nil, display all articles in the same buffer. If nil, each group will get its own article buffer." + :version "24.1" :group 'gnus-article-various :type 'boolean) @@ -531,11 +540,6 @@ string with the suggested prefix." :group 'gnus-summary-marks :type 'character) -(defcustom gnus-souped-mark ?F - "*Mark used for souped 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 @@ -659,9 +663,9 @@ string with the suggested prefix." (defcustom gnus-auto-expirable-marks (list gnus-killed-mark gnus-del-mark gnus-catchup-mark gnus-low-score-mark gnus-ancient-mark gnus-read-mark - gnus-souped-mark gnus-duplicate-mark) + gnus-duplicate-mark) "*The list of marks converted into expiration if a group is auto-expirable." - :version "21.1" + :version "24.1" :group 'gnus-summary :type '(repeat character)) @@ -981,8 +985,7 @@ This hook is not called from the non-updating exit commands like `Q'." :group 'gnus-various :type 'hook) -(defcustom gnus-summary-update-hook - (list 'gnus-summary-highlight-line) +(defcustom gnus-summary-update-hook nil "*A hook called when a summary line is changed. The hook will not be called if `gnus-visual' is nil. @@ -1251,7 +1254,7 @@ type of files to save." "Whether Gnus should parse all headers made available to it. This is mostly relevant for slow back ends where the user may wish to widen the summary buffer to include all headers -that were fetched. Say, for nnultimate groups." +that were fetched." :version "22.1" :group 'gnus-summary :type '(choice boolean regexp)) @@ -1853,7 +1856,6 @@ increase the score of each group you read." "=" 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 "f" gnus-summary-followup "F" gnus-summary-followup-with-original @@ -1875,7 +1877,6 @@ increase the score of each group you read." [follow-link] mouse-face "m" gnus-summary-mail-other-window "a" gnus-summary-post-news - "i" gnus-summary-news-other-window "x" gnus-summary-limit-to-unread "s" gnus-summary-isearch-article "t" gnus-summary-toggle-header @@ -2108,6 +2109,7 @@ increase the score of each group you read." "d" gnus-article-display-face "s" gnus-treat-smiley "D" gnus-article-remove-images + "W" gnus-html-show-images "f" gnus-treat-from-picon "m" gnus-treat-mail-picon "n" gnus-treat-newsgroups-picon) @@ -2175,8 +2177,7 @@ increase the score of each group you read." "h" gnus-summary-save-article-folder "v" gnus-summary-save-article-vm "p" gnus-summary-pipe-output - "P" gnus-summary-muttprint - "s" gnus-soup-add-article) + "P" gnus-summary-muttprint) (gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map) "b" gnus-summary-display-buttonized @@ -2440,7 +2441,6 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) ["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 with Muttprint..." gnus-summary-muttprint t] ["Print" gnus-summary-print-article ,@(if (featurep 'xemacs) '(t) @@ -3406,8 +3406,10 @@ marks of articles." (save-excursion (let (config) (goto-char (point-min)) - (while (search-forward "\r" nil t) - (push (1- (point)) config)) + (while (not (eobp)) + (when (eq (get-char-property (point-at-eol) 'invisible) 'gnus-sum) + (push (save-excursion (forward-line 0) (point)) config)) + (forward-line 1)) config))) (defun gnus-restore-hidden-threads-configuration (config) @@ -3415,10 +3417,8 @@ marks of articles." (save-excursion (let (point (inhibit-read-only t)) (while (setq point (pop config)) - (when (and (< point (point-max)) - (goto-char point) - (eq (char-after) ?\n)) - (subst-char-in-region point (1+ point) ?\n ?\r)))))) + (goto-char point) + (gnus-summary-hide-thread))))) ;; Various summary mode internalish functions. @@ -3752,6 +3752,7 @@ buffer that was in action when the last article was fetched." (error (gnus-message 5 "Error updating the summary line"))) (when (gnus-visual-p 'summary-highlight 'highlight) (forward-line -1) + (gnus-summary-highlight-line) (gnus-run-hooks 'gnus-summary-update-hook) (forward-line 1)))) @@ -3784,6 +3785,7 @@ buffer that was in action when the last article was fetched." 'score)) ;; Do visual highlighting. (when (gnus-visual-p 'summary-highlight 'highlight) + (gnus-summary-highlight-line) (gnus-run-hooks 'gnus-summary-update-hook))))) (defvar gnus-tmp-new-adopts nil) @@ -5362,7 +5364,9 @@ or a straight list of headers." 'gnus-number number) (when gnus-visual-p (forward-line -1) - (gnus-run-hooks 'gnus-summary-update-hook) + (gnus-summary-highlight-line) + (when gnus-summary-update-hook + (gnus-run-hooks 'gnus-summary-update-hook)) (forward-line 1)) (setq gnus-tmp-prev-subject simp-subject))) @@ -6050,9 +6054,7 @@ If WHERE is `summary', the summary mode line format will be used." (when (> (length mode-string) max-len) (setq mode-string (concat (truncate-string-to-width 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))) @@ -7781,7 +7783,7 @@ Also see the variable `gnus-article-skip-boring'." (setq endp (or (gnus-article-next-page lines) (gnus-article-only-boring-p)))) (when endp - (cond (stop + (cond ((or stop gnus-summary-stop-at-end-of-message) (gnus-message 3 "End of message")) (circular (gnus-summary-beginning-of-article)) @@ -8300,7 +8302,7 @@ If ALL is non-nil, limit strictly to unread articles." gnus-killed-mark gnus-spam-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) + gnus-duplicate-mark) 'reverse))) (defun gnus-summary-limit-to-headers (match &optional reverse) @@ -9518,7 +9520,7 @@ IDNA encoded domain names looks like `xn--bar'. If a string remain unencoded after running this function, it is likely an invalid IDNA string (`xn--bar' is invalid). -You must have GNU Libidn (`http://www.gnu.org/software/libidn/') +You must have GNU Libidn (URL `http://www.gnu.org/software/libidn/') installed for this command to work." (interactive "P") (if (not (and (condition-case nil (require 'idna) @@ -9848,12 +9850,14 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." ;;;!!!Why is this necessary? (set-buffer gnus-summary-buffer) - (gnus-summary-goto-subject article) (when (eq action 'move) - (gnus-summary-mark-article article gnus-canceled-mark)))) + (save-excursion + (gnus-summary-goto-subject article) + (gnus-summary-mark-article article gnus-canceled-mark))))) (push article articles-to-update-marks)) - (apply 'gnus-summary-remove-process-mark articles-to-update-marks) + (save-excursion + (apply 'gnus-summary-remove-process-mark articles-to-update-marks)) ;; Re-activate all groups that have been moved to. (with-current-buffer gnus-group-buffer (let ((gnus-group-marked to-groups)) @@ -10109,19 +10113,20 @@ confirmation before the articles are deleted." ;; 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)) - (let* ((article (car articles)) - (ghead (gnus-data-header - (assoc article (gnus-data-list nil))))) - (run-hook-with-args 'gnus-summary-article-delete-hook - 'delete ghead gnus-newsgroup-name nil - nil)) - (setq articles (cdr articles))) + (save-excursion + (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)) + (let* ((article (car articles)) + (ghead (gnus-data-header + (assoc article (gnus-data-list nil))))) + (run-hook-with-args 'gnus-summary-article-delete-hook + 'delete ghead gnus-newsgroup-name nil + nil)) + (setq articles (cdr articles)))) (when not-deleted (gnus-message 4 "Couldn't delete articles %s" not-deleted))) (gnus-summary-position-point) @@ -10732,6 +10737,7 @@ If NO-EXPIRE, auto-expiry will be inhibited." (t gnus-no-mark)) 'replied) (when (gnus-visual-p 'summary-highlight 'highlight) + (gnus-summary-highlight-line) (gnus-run-hooks 'gnus-summary-update-hook)) t) @@ -12626,6 +12632,8 @@ If ALL is a number, fetch this number of articles." (declare-function bookmark-prop-get "bookmark" (bookmark prop)) (declare-function bookmark-default-handler "bookmark" (bmk)) (declare-function bookmark-get-bookmark-record "bookmark" (bmk)) +(defvar bookmark-yank-point) +(defvar bookmark-current-buffer) (defun gnus-summary-bookmark-make-record () "Make a bookmark entry for a Gnus summary buffer." @@ -12688,5 +12696,4 @@ BOOKMARK is a bookmark name or a bookmark record." ;; coding: iso-8859-1 ;; End: -;; arch-tag: 17c6748f-6d00-4d36-bf01-835c42f31235 ;;; gnus-sum.el ends here diff --git a/lisp/gnus/gnus-sync.el b/lisp/gnus/gnus-sync.el new file mode 100644 index 00000000000..c0e52b6a8b2 --- /dev/null +++ b/lisp/gnus/gnus-sync.el @@ -0,0 +1,233 @@ +;;; gnus-sync.el --- synchronization facility for Gnus + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Ted Zlatanov <tzz@lifelogs.com> +;; Keywords: news synchronization nntp nnrss + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This is the gnus-sync.el package. + +;; Put this in your startup file (~/.gnus.el for instance) + +;; possibilities for gnus-sync-backend: +;; Tramp over SSH: /ssh:user@host:/path/to/filename +;; Tramp over IMAP: /imaps:user@yourhosthere.com:/INBOX.test/filename +;; ...or any other file Tramp and Emacs can handle... + +;; (setq gnus-sync-backend "/remote:/path.gpg" ; will use Tramp+EPA if loaded +;; gnus-sync-global-vars `(gnus-newsrc-last-checked-date) +;; gnus-sync-newsrc-groups `("nntp" "nnrss") +;; gnus-sync-newsrc-offsets `(2 3)) + +;; TODO: + +;; - after gnus-sync-read, the message counts are wrong + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'gnus) +(require 'gnus-start) +(require 'gnus-util) + +(defgroup gnus-sync nil + "The Gnus synchronization facility." + :version "24.1" + :group 'gnus) + +(defcustom gnus-sync-newsrc-groups `("nntp" "nnrss") + "List of groups to be synchronized in the gnus-newsrc-alist. +The group names are matched, they don't have to be fully +qualified. Typically you would choose all of these. That's the +default because there is no active sync backend by default, so +this setting is harmless until the user chooses a sync backend." + :group 'gnus-sync + :type '(repeat regexp)) + +(defcustom gnus-sync-newsrc-offsets '(2 3) + "List of per-group data to be synchronized." + :group 'gnus-sync + :type '(set (const :tag "Read ranges" 2) + (const :tag "Marks" 3))) + +(defcustom gnus-sync-global-vars nil + "List of global variables to be synchronized. +You may want to sync `gnus-newsrc-last-checked-date' but pretty +much any symbol is fair game. You could additionally sync +`gnus-newsrc-alist', `gnus-server-alist', `gnus-topic-topology', +and `gnus-topic-alist' to cover all the variables in +newsrc.eld (except for `gnus-format-specs' which should not be +synchronized, I believe). Also see `gnus-variable-list'." + :group 'gnus-sync + :type '(repeat (choice (variable :tag "A known variable") + (symbol :tag "Any symbol")))) + +(defcustom gnus-sync-backend nil + "The synchronization backend." + :group 'gnus-sync + :type '(radio (const :format "None" nil) + (string :tag "Sync to a file"))) + +(defvar gnus-sync-newsrc-loader nil + "Carrier for newsrc data") + +(defun gnus-sync-save () +"Save the Gnus sync data to the backend." + (interactive) + (cond + ((stringp gnus-sync-backend) + (gnus-message 7 "gnus-sync: saving to backend %s" gnus-sync-backend) + ;; populate gnus-sync-newsrc-loader from all but the first dummy + ;; entry in gnus-newsrc-alist whose group matches any of the + ;; gnus-sync-newsrc-groups + ;; TODO: keep the old contents for groups we don't have! + (let ((gnus-sync-newsrc-loader + (loop for entry in (cdr gnus-newsrc-alist) + when (gnus-grep-in-list + (car entry) ;the group name + gnus-sync-newsrc-groups) + collect (cons (car entry) + (mapcar (lambda (offset) + (cons offset (nth offset entry))) + gnus-sync-newsrc-offsets))))) + (with-temp-file gnus-sync-backend + (progn + (let ((coding-system-for-write gnus-ding-file-coding-system) + (standard-output (current-buffer))) + (princ (format ";; -*- mode:emacs-lisp; coding: %s; -*-\n" + gnus-ding-file-coding-system)) + (princ ";; Gnus sync data v. 0.0.1\n") + (let* ((print-quoted t) + (print-readably t) + (print-escape-multibyte nil) + (print-escape-nonascii t) + (print-length nil) + (print-level nil) + (print-circle nil) + (print-escape-newlines t) + (variables (cons 'gnus-sync-newsrc-loader + gnus-sync-global-vars)) + variable) + (while variables + (if (and (boundp (setq variable (pop variables))) + (symbol-value variable)) + (progn + (princ "\n(setq ") + (princ (symbol-name variable)) + (princ " '") + (prin1 (symbol-value variable)) + (princ ")\n")) + (princ "\n;;; skipping empty variable ") + (princ (symbol-name variable))))) + (gnus-message + 7 + "gnus-sync: stored variables %s and %d groups in %s" + gnus-sync-global-vars + (length gnus-sync-newsrc-loader) + gnus-sync-backend) + + ;; Idea from Dan Christensen <jdc@chow.mat.jhu.edu> + ;; Save the .eld file with extra line breaks. + (gnus-message 8 "gnus-sync: adding whitespace to %s" + gnus-sync-backend) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^(\\|(\\\"" nil t) + (replace-match "\n\\&" t)) + (goto-char (point-min)) + (while (re-search-forward " $" nil t) + (replace-match "" t t)))))))) + ;; the pass-through case: gnus-sync-backend is not a known choice + (nil))) + +(defun gnus-sync-read () +"Load the Gnus sync data from the backend." + (interactive) + (when gnus-sync-backend + (gnus-message 7 "gnus-sync: loading from backend %s" gnus-sync-backend) + (cond ((stringp gnus-sync-backend) + ;; read data here... + (if (or debug-on-error debug-on-quit) + (load gnus-sync-backend nil t) + (condition-case var + (load gnus-sync-backend nil t) + (error + (error "Error in %s: %s" gnus-sync-backend (cadr var))))) + (let ((valid-count 0) + invalid-groups) + (dolist (node gnus-sync-newsrc-loader) + (if (gnus-gethash (car node) gnus-newsrc-hashtb) + (progn + (incf valid-count) + (loop for store in (cdr node) + do (setf (nth (car store) + (assoc (car node) gnus-newsrc-alist)) + (cdr store)))) + (push (car node) invalid-groups))) + (gnus-message + 7 + "gnus-sync: loaded %d groups (out of %d) from %s" + valid-count (length gnus-sync-newsrc-loader) + gnus-sync-backend) + (when invalid-groups + (gnus-message + 7 + "gnus-sync: skipped %d groups (out of %d) from %s" + (length invalid-groups) + (length gnus-sync-newsrc-loader) + gnus-sync-backend) + (gnus-message 9 "gnus-sync: skipped groups: %s" + (mapconcat 'identity invalid-groups ", "))))) + (nil)) + ;; make the hashtable again because the newsrc-alist may have been modified + (when gnus-sync-newsrc-offsets + (gnus-message 9 "gnus-sync: remaking the newsrc hashtable") + (gnus-make-hashtable-from-newsrc-alist)))) + +;;;###autoload +(defun gnus-sync-initialize () +"Initialize the Gnus sync facility." + (interactive) + (gnus-message 5 "Initializing the sync facility") + (gnus-sync-install-hooks)) + +;;;###autoload +(defun gnus-sync-install-hooks () + "Install the sync hooks." + (interactive) + ;; (add-hook 'gnus-get-new-news-hook 'gnus-sync-read) + (add-hook 'gnus-save-newsrc-hook 'gnus-sync-save) + (add-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read)) + +(defun gnus-sync-unload-hook () + "Uninstall the sync hooks." + (interactive) + ;; (remove-hook 'gnus-get-new-news-hook 'gnus-sync-read) + (remove-hook 'gnus-save-newsrc-hook 'gnus-sync-save) + (remove-hook 'gnus-read-newsrc-el-hook 'gnus-sync-read)) + +(add-hook 'gnus-sync-unload-hook 'gnus-sync-unload-hook) + +;; this is harmless by default, until the gnus-sync-backend is set +(gnus-sync-initialize) + +(provide 'gnus-sync) + +;;; gnus-sync.el ends here diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index b99f1772d5b..89e61bcb598 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -1779,5 +1779,4 @@ If REVERSE, reverse the sorting order." (provide 'gnus-topic) -;; arch-tag: bf176856-f30c-40f0-ae77-e41529a1134c ;;; gnus-topic.el ends here diff --git a/lisp/gnus/gnus-undo.el b/lisp/gnus/gnus-undo.el index d11b778f351..5c45d3241d3 100644 --- a/lisp/gnus/gnus-undo.el +++ b/lisp/gnus/gnus-undo.el @@ -188,5 +188,4 @@ A numeric argument serves as a repeat count." (provide 'gnus-undo) -;; arch-tag: 0d787bc7-787d-499a-837f-211d2cb07f2e ;;; gnus-undo.el ends here diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index b8a1c266c93..7cdb70a3580 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -1297,6 +1297,14 @@ Return the modified alist." (setq alist (delq entry alist))) alist))) +(defun gnus-grep-in-list (word list) + "Find if a WORD matches any regular expression in the given LIST." + (when (and word list) + (catch 'found + (dolist (r list) + (when (string-match r word) + (throw 'found r)))))) + (defmacro gnus-pull (key alist &optional assoc-p) "Modify ALIST to be without KEY." (unless (symbolp alist) @@ -1572,11 +1580,9 @@ SPEC is a predicate specifier that contains stuff like `or', `and', (car (symbol-value history)))) (defun gnus-graphic-display-p () - (or (and (fboundp 'display-graphic-p) - (display-graphic-p)) - ;;;!!!This is bogus. Fixme! - (and (featurep 'xemacs) - t))) + (if (featurep 'xemacs) + (device-on-window-system-p) + (display-graphic-p))) (put 'gnus-parse-without-error 'lisp-indent-function 0) (put 'gnus-parse-without-error 'edebug-form-spec '(body)) @@ -1891,5 +1897,4 @@ is allowed once again. (Immediately, if `inhibit-quit' is nil.)" (provide 'gnus-util) -;; arch-tag: f94991af-d32b-4c97-8c26-ca12a934de49 ;;; gnus-util.el ends here diff --git a/lisp/gnus/gnus-uu.el b/lisp/gnus/gnus-uu.el index 86cd78cefa3..35120eae767 100644 --- a/lisp/gnus/gnus-uu.el +++ b/lisp/gnus/gnus-uu.el @@ -2170,5 +2170,4 @@ If no file has been included, the user will be asked for a file." (provide 'gnus-uu) -;; arch-tag: 05312384-0a83-4720-9a58-b3160b888853 ;;; gnus-uu.el ends here diff --git a/lisp/gnus/gnus-vm.el b/lisp/gnus/gnus-vm.el index 2684ecc8c0e..9ca7813702c 100644 --- a/lisp/gnus/gnus-vm.el +++ b/lisp/gnus/gnus-vm.el @@ -103,5 +103,4 @@ save those articles instead." (provide 'gnus-vm) -;; arch-tag: 42ca7f88-a12f-461d-be3e-cac7efb44866 ;;; gnus-vm.el ends here diff --git a/lisp/gnus/gnus-win.el b/lisp/gnus/gnus-win.el index 93f77634b7a..4956be9fd87 100644 --- a/lisp/gnus/gnus-win.el +++ b/lisp/gnus/gnus-win.el @@ -590,5 +590,4 @@ should have point." (provide 'gnus-win) -;; arch-tag: ccd5a394-2ddf-4397-b8f8-6d80d3e46e2b ;;; gnus-win.el ends here diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index b07dfc648c0..797f8a44bd1 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -7,6 +7,7 @@ ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> ;; Lars Magne Ingebrigtsen <larsi@gnus.org> ;; Keywords: news, mail +;; Version: 5.13 ;; This file is part of GNU Emacs. @@ -1057,14 +1058,14 @@ be set in `.emacs' instead." (symbol-value 'image-load-path)) (t load-path))) (image (find-image - `((:type svg :file "gnus.svg") - (:type png :file "gnus.png") - (:type xpm :file "gnus.xpm" + `((:type xpm :file "gnus.xpm" :color-symbols (("thing" . ,(car gnus-logo-colors)) ("shadow" . ,(cadr gnus-logo-colors)) ("oort" . "#eeeeee") ("background" . ,(face-background 'default)))) + (:type svg :file "gnus.svg") + (:type png :file "gnus.png") (:type pbm :file "gnus.pbm" ;; Account for the pbm's blackground. :background ,(face-foreground 'gnus-splash) @@ -1442,7 +1443,7 @@ Obsolete variable; use `message-user-organization' instead.") ;; Customization variables -(defcustom gnus-refer-article-method nil +(defcustom gnus-refer-article-method 'current "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 @@ -1454,6 +1455,7 @@ in the documentation of `gnus-select-method'. It can also be a list of select methods, as well as the special symbol `current', which means to use the current select method. If it is a list, Gnus will try all the methods in the list until it finds a match." + :version "24.1" :group 'gnus-server :type '(choice (const :tag "default" nil) (const current) @@ -1739,19 +1741,11 @@ slower." ("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" post-mail address prompt-address physical-address) ("nnweb" none) - ("nngoogle" post) - ("nnslashdot" post) - ("nnultimate" none) ("nnrss" none) - ("nnwfm" none) - ("nnwarchive" none) - ("nnlistserv" none) ("nnagent" post-mail) ("nnimap" post-mail address prompt-address physical-address) ("nnmaildir" mail respool address) @@ -1774,7 +1768,8 @@ this variable. I think." (const :format "%v " prompt-address) (const :format "%v " physical-address) (const :format "%v " virtual) - (const respool))))) + (const respool)))) + :version "24.1") (defun gnus-redefine-select-method-widget () "Recomputes the select-method widget based on the value of @@ -1810,12 +1805,11 @@ If this variable is nil, screen refresh may be quicker." (const summary) (const tree))) -;; Added by Keinonen Kari <kk85613@cs.tut.fi>. -(defcustom gnus-mode-non-string-length nil +(defcustom gnus-mode-non-string-length 30 "*Max length of mode-line non-string contents. If this is nil, Gnus will take space as is needed, leaving the rest -of the mode line intact. Note that the default of nil is unlikely -to be desirable; see the manual for further details." +of the mode line intact." + :version "24.1" :group 'gnus-various :type '(choice (const nil) integer)) @@ -2892,10 +2886,6 @@ gnus-registry.el will populate this if it's loaded.") ("rmailsum" rmail-update-summary) ("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) @@ -3027,8 +3017,6 @@ gnus-registry.el will populate this if it's loaded.") 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 @@ -3298,12 +3286,12 @@ with a `subscribed' parameter." (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)) + `(gnus-string-or-1 (list ,@strings))) (defun gnus-string-or-1 (strings) (let (string) (while strings - (setq string (eval (pop strings))) + (setq string (pop strings)) (if (string-match "^[ \t]*$" string) (setq string nil) (setq strings nil))) @@ -3946,8 +3934,7 @@ If SYMBOL, return the value of that symbol in the group parameters. If you call this function inside a loop, consider using the faster `gnus-group-fast-parameter' instead." - (save-excursion - (set-buffer gnus-group-buffer) + (with-current-buffer gnus-group-buffer (if symbol (gnus-group-fast-parameter group symbol allow-list) (nconc @@ -4106,8 +4093,7 @@ Returns the number of articles marked as read." (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)) + (with-current-buffer (get-file-buffer file) (when (buffer-modified-p) (save-buffer)) (kill-buffer (current-buffer)))))) @@ -4420,5 +4406,4 @@ prompt the user for the name of an NNTP server to use." (provide 'gnus) -;; arch-tag: acebeeab-f331-4f8f-a7ea-89c58c84f636 ;;; gnus.el ends here diff --git a/lisp/gnus/html2text.el b/lisp/gnus/html2text.el index 1aec654faf8..6411eb62564 100644 --- a/lisp/gnus/html2text.el +++ b/lisp/gnus/html2text.el @@ -508,5 +508,5 @@ See the documentation for that variable." ;; </Interactive functions> ;; (provide 'html2text) -;; arch-tag: e9e57b79-35d4-4de1-a647-e7e01fe56d1e + ;;; html2text.el ends here diff --git a/lisp/gnus/ietf-drums.el b/lisp/gnus/ietf-drums.el index ffcb6fa60e0..f72b09c572c 100644 --- a/lisp/gnus/ietf-drums.el +++ b/lisp/gnus/ietf-drums.el @@ -295,5 +295,4 @@ a list of address strings." (provide 'ietf-drums) -;; arch-tag: 379a0191-dbae-4ca6-a0f5-d4202c209ef9 ;;; ietf-drums.el ends here diff --git a/lisp/gnus/legacy-gnus-agent.el b/lisp/gnus/legacy-gnus-agent.el index b13033b6352..3b55220ace5 100644 --- a/lisp/gnus/legacy-gnus-agent.el +++ b/lisp/gnus/legacy-gnus-agent.el @@ -250,5 +250,4 @@ possible that the hook was persistently saved." (provide 'legacy-gnus-agent) -;; arch-tag: 845c7b8a-88f7-4468-b8d7-94e8fc72cf1a ;;; legacy-gnus-agent.el ends here diff --git a/lisp/gnus/mail-parse.el b/lisp/gnus/mail-parse.el index a774f829632..e6977705f21 100644 --- a/lisp/gnus/mail-parse.el +++ b/lisp/gnus/mail-parse.el @@ -74,5 +74,4 @@ (provide 'mail-parse) -;; arch-tag: 3e63d75c-c962-4784-ab01-7ba07ca9d2d4 ;;; mail-parse.el ends here diff --git a/lisp/gnus/mail-prsvr.el b/lisp/gnus/mail-prsvr.el index 5e386f94e29..fb63e58a04a 100644 --- a/lisp/gnus/mail-prsvr.el +++ b/lisp/gnus/mail-prsvr.el @@ -41,5 +41,4 @@ what the desired charsets is to be ignored.") (provide 'mail-prsvr) -;; arch-tag: 9ba878cc-8b43-4f7a-85b1-69b1a9a5d9f5 ;;; mail-prsvr.el ends here diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index 46f9169a6a3..662b999c288 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -466,10 +466,10 @@ the `mail-source-keyword-map' variable." ;; 1) the auth-sources user and password override everything ;; 2) it avoids macros, so it's cleaner ;; 3) it falls through to the mail-sources and then default values - (cond + (cond ((and (eq keyword :user) - (setq user-auth + (setq user-auth (nth 0 (auth-source-user-or-password '("login" "password") ;; this is "host" in auth-sources @@ -536,7 +536,7 @@ See `mail-source-bind'." (t value))) -(defun mail-source-fetch (source callback) +(defun mail-source-fetch (source callback &optional method) "Fetch mail from SOURCE and call CALLBACK zero or more times. CALLBACK will be called with the name of the file where (some of) the mail from SOURCE is put. @@ -544,6 +544,16 @@ Return the number of files that were found." (mail-source-bind-common source (if (or mail-source-plugged plugged) (save-excursion + ;; Special-case the `file' handler since it's so common and + ;; just adds noise. + (when (or (not (eq (car source) 'file)) + (mail-source-bind (file source) + (file-exists-p path))) + (nnheader-message 4 "%sReading incoming mail from %s..." + (if method + (format "%s: " method) + "") + (car source))) (let ((function (cadr (assq (car source) mail-source-fetcher-alist))) (found 0)) (unless function @@ -619,6 +629,8 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) 0) (funcall callback mail-source-crash-box info))) +(defvar mail-source-incoming-last-checked-time nil) + (defun mail-source-delete-crash-box () (when (file-exists-p mail-source-crash-box) ;; Delete or move the incoming mail out of the way. @@ -634,9 +646,16 @@ Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile) (rename-file mail-source-crash-box incoming t) ;; remove old incoming files? (when (natnump mail-source-delete-incoming) - (mail-source-delete-old-incoming - mail-source-delete-incoming - mail-source-delete-old-incoming-confirm)))))) + ;; Don't check for old incoming files more than once per day to + ;; save a lot of file accesses. + (when (or (null mail-source-incoming-last-checked-time) + (> (time-to-seconds + (time-since mail-source-incoming-last-checked-time)) + (* 24 60 60))) + (setq mail-source-incoming-last-checked-time (current-time)) + (mail-source-delete-old-incoming + mail-source-delete-incoming + mail-source-delete-old-incoming-confirm))))))) (defun mail-source-movemail (from to) "Move FROM to TO using movemail." @@ -1145,5 +1164,4 @@ This only works when `display-time' is enabled." (provide 'mail-source) -;; arch-tag: 72948025-1d17-4d6c-bb12-ef1aa2c490fd ;;; mail-source.el ends here diff --git a/lisp/gnus/mailcap.el b/lisp/gnus/mailcap.el index e725dfcea88..71ffd1225b5 100644 --- a/lisp/gnus/mailcap.el +++ b/lisp/gnus/mailcap.el @@ -335,7 +335,7 @@ nil means your home directory." :group 'mailcap) (defvar mailcap-poor-system-types - '(ms-dos ms-windows windows-nt win32 w32 mswindows) + '(ms-dos windows-nt) "Systems that don't have a Unix-like directory hierarchy.") ;;; @@ -1069,5 +1069,4 @@ If FORCE, re-parse even if already parsed." (provide 'mailcap) -;; arch-tag: 1fd4f9c9-c305-4d2e-9747-3a4d45baa0bd ;;; mailcap.el ends here diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 947b1bd53e8..13706ae55f8 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -249,6 +249,15 @@ included. Organization and User-Agent are optional." :link '(custom-manual "(message)Message Headers") :type '(repeat sexp)) +(defcustom message-prune-recipient-rules nil + "Rules for how to prune the list of recipients when doing wide replies. +This is a list of regexps and regexp matches." + :version "24.1" + :group 'message-mail + :group 'message-headers + :link '(custom-manual "(message)Wide Reply") + :type '(repeat regexp)) + (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 @@ -455,7 +464,7 @@ A value of nil means let mailer mail back a message to report errors." :link '(custom-manual "(message)Sending Variables") :type 'boolean) -(defcustom message-generate-new-buffers 'unique +(defcustom message-generate-new-buffers 'unsent "*Say whether to create a new message buffer to compose a message. Valid values include: @@ -478,6 +487,7 @@ function 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." + :version "24.1" :group 'message-buffers :link '(custom-manual "(message)Message Buffers") :type '(choice (const nil) @@ -1620,11 +1630,11 @@ If you'd like to make it possible to share draft files between XEmacs and Emacs, you may use `iso-2022-7bit' for this value at your own risk. Note that the coding-system `iso-2022-7bit' isn't suitable to all data.") -(defcustom message-send-mail-partially-limit 1000000 +(defcustom message-send-mail-partially-limit nil "The limitation of messages sent as message/partial. The lower bound of message size in characters, beyond which the message should be sent in several parts. If it is nil, the size is unlimited." - :version "21.1" + :version "24.1" :group 'message-buffers :link '(custom-manual "(message)Mail Variables") :type '(choice (const :tag "unlimited" nil) @@ -1716,13 +1726,14 @@ functionality to work." (const :tag "Never" nil) (const :tag "Always" t))) -(defcustom message-generate-hashcash (if (executable-find "hashcash") t) +(defcustom message-generate-hashcash (if (executable-find "hashcash") 'opportunistic) "*Whether to generate X-Hashcash: headers. If t, always generate hashcash headers. If `opportunistic', only generate hashcash headers if it can be done without the user waiting (i.e., only asynchronously). You must have the \"hashcash\" binary installed, see `hashcash-path'." + :version "24.1" :group 'message-headers :link '(custom-manual "(message)Mail Headers") :type '(choice (const :tag "Always" t) @@ -1739,6 +1750,7 @@ You must have the \"hashcash\" binary installed, see `hashcash-path'." (defvar message-mime-part nil) (defvar message-posting-charset nil) (defvar message-inserted-headers nil) +(defvar message-inhibit-ecomplete nil) ;; Byte-compiler warning (defvar gnus-active-hashtb) @@ -4091,7 +4103,8 @@ It should typically alter the sending method in some way or other." (run-hooks 'message-sent-hook)) (message "Sending...done") ;; Do ecomplete address snarfing. - (when (message-mail-alias-type-p 'ecomplete) + (when (and (message-mail-alias-type-p 'ecomplete) + (not message-inhibit-ecomplete)) (message-put-addresses-in-ecomplete)) ;; Mark the buffer as unmodified and delete auto-save. (set-buffer-modified-p nil) @@ -5431,7 +5444,7 @@ In posting styles use `(\"Expires\" (make-expires-date 30))'." (* 25 25))) (let ((tm (current-time))) (concat - (if (or (memq system-type '(ms-dos emx)) + (if (or (eq system-type 'ms-dos) ;; message-number-base36 doesn't handle bigints. (floatp (user-uid))) (let ((user (downcase (user-login-name)))) @@ -6449,9 +6462,7 @@ are not included." (setq buffer-file-name (expand-file-name (concat (if (memq system-type - '(ms-dos ms-windows windows-nt - cygwin cygwin32 win32 w32 - mswindows)) + '(ms-dos windows-nt cygwin)) "message" "*message*") (format-time-string "-%Y%m%d-%H%M%S")) @@ -6551,7 +6562,7 @@ The function is called with one parameter, a cons cell ..." (defun message-get-reply-headers (wide &optional to-address address-headers) (let (follow-to mct never-mct to cc author mft recipients extra) - ;; Find all relevant headers we need. + ;; Find all relevant headers we need. (save-restriction (message-narrow-to-headers-or-head) ;; Gmane renames "To". Look at "Original-To", too, if it is present in @@ -6677,6 +6688,8 @@ want to get rid of this query permanently."))) (if recip (setq recipients (delq recip recipients)))))))) + (setq recipients (message-prune-recipients recipients)) + ;; Build the header alist. Allow the user to be asked whether ;; or not to reply to all recipients in a wide reply. (setq follow-to (list (cons 'To (cdr (pop recipients))))) @@ -6690,6 +6703,22 @@ want to get rid of this query permanently."))) (push (cons 'Cc recipients) follow-to))) follow-to)) +(defun message-prune-recipients (recipients) + (dolist (rule message-prune-recipient-rules) + (let ((match (car rule)) + dup-match + address) + (dolist (recipient recipients) + (setq address (car recipient)) + (when (string-match match address) + (setq dup-match (replace-match (cadr rule) nil nil address)) + (dolist (recipient recipients) + ;; Don't delete the address that triggered this. + (when (and (not (eq address (car recipient))) + (string-match dup-match (car recipient))) + (setq recipients (delq recipient recipients)))))))) + recipients) + (defcustom message-simplify-subject-functions '(message-strip-list-identifiers message-strip-subject-re @@ -7425,6 +7454,7 @@ is for the internal use." (replace-match "X-From-Line: ")) ;; Send it. (let ((message-inhibit-body-encoding t) + (message-inhibit-ecomplete t) message-required-mail-headers message-generate-hashcash rfc2047-encode-encoded-words) @@ -8230,5 +8260,4 @@ Used in `message-simplify-recipients'." ;; coding: iso-8859-1 ;; End: -;; arch-tag: 94b32cac-4504-4b6c-8181-030ebf380ee0 ;;; message.el ends here diff --git a/lisp/gnus/messcompat.el b/lisp/gnus/messcompat.el index 1ad63627bb0..de67d8ce7ed 100644 --- a/lisp/gnus/messcompat.el +++ b/lisp/gnus/messcompat.el @@ -89,5 +89,4 @@ variable `mail-header-separator'.") (provide 'messcompat) -;; arch-tag: a76673be-905e-4bbd-8966-615370494a7b ;;; messcompat.el ends here diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el index fd42abc0ab8..5756e46b865 100644 --- a/lisp/gnus/mm-bodies.el +++ b/lisp/gnus/mm-bodies.el @@ -302,5 +302,4 @@ decoding. If it is nil, default to `mail-parse-charset'." (provide 'mm-bodies) -;; arch-tag: 41104bb6-4443-4ca9-8d5c-ff87ecf27d8d ;;; mm-bodies.el ends here diff --git a/lisp/gnus/mm-decode.el b/lisp/gnus/mm-decode.el index 410b4f045d7..725adcf559c 100644 --- a/lisp/gnus/mm-decode.el +++ b/lisp/gnus/mm-decode.el @@ -105,10 +105,9 @@ ,disposition ,description ,cache ,id)) (defcustom mm-text-html-renderer - (cond ((executable-find "w3m") - (if (locate-library "w3m") - 'w3m - 'w3m-standalone)) + (cond ((and (executable-find "w3m") + (executable-find "curl")) + 'gnus-article-html) ((executable-find "links") 'links) ((executable-find "lynx") 'lynx) ((locate-library "w3") 'w3) @@ -124,7 +123,7 @@ The defined renderer types are: `w3' : use Emacs/W3; `html2text' : use html2text; nil : use external viewer (default web browser)." - :version "23.0" ;; No Gnus + :version "24.1" :type '(choice (const w3) (const w3m :tag "emacs-w3m") (const w3m-standalone :tag "standalone w3m" ) @@ -1671,5 +1670,4 @@ If RECURSIVE, search recursively." (provide 'mm-decode) -;; arch-tag: 4f35d360-56b8-4030-9388-3ed82d359b9b ;;; mm-decode.el ends here diff --git a/lisp/gnus/mm-encode.el b/lisp/gnus/mm-encode.el index 0d609e56cbb..c6ca4c40d04 100644 --- a/lisp/gnus/mm-encode.el +++ b/lisp/gnus/mm-encode.el @@ -223,5 +223,4 @@ This is either `base64' or `quoted-printable'." (provide 'mm-encode) -;; arch-tag: 7d01bba4-d469-4851-952b-dc863f84ed66 ;;; mm-encode.el ends here diff --git a/lisp/gnus/mm-extern.el b/lisp/gnus/mm-extern.el index f40f798789c..eee741f7f69 100644 --- a/lisp/gnus/mm-extern.el +++ b/lisp/gnus/mm-extern.el @@ -167,5 +167,4 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." (provide 'mm-extern) -;; arch-tag: 9653808e-14d9-4172-86e6-adceaa05378e ;;; mm-extern.el ends here diff --git a/lisp/gnus/mm-partial.el b/lisp/gnus/mm-partial.el index f9ee64da10b..3fec4a2a975 100644 --- a/lisp/gnus/mm-partial.el +++ b/lisp/gnus/mm-partial.el @@ -150,5 +150,4 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." (provide 'mm-partial) -;; arch-tag: 460e7424-05f2-4a1d-a0f2-70ec081eff7d ;;; mm-partial.el ends here diff --git a/lisp/gnus/mm-url.el b/lisp/gnus/mm-url.el index c72f520d60a..0da136e1efc 100644 --- a/lisp/gnus/mm-url.el +++ b/lisp/gnus/mm-url.el @@ -365,15 +365,20 @@ If FOLLOW-REFRESH is non-nil, redirect refresh url in META." (defun mm-url-decode-entities () "Decode all HTML entities." (goto-char (point-min)) - (while (re-search-forward "&\\(#[0-9]+\\|[a-z]+[0-9]*\\);" nil t) - (let ((elem (if (eq (aref (match-string 1) 0) ?\#) - (let ((c (mm-ucs-to-char - (string-to-number - (substring (match-string 1) 1))))) - (if (mm-char-or-char-int-p c) c ?#)) - (or (cdr (assq (intern (match-string 1)) - mm-url-html-entities)) - ?#)))) + (while (re-search-forward "&\\(#[0-9]+\\|#x[0-9a-f]+\\|[a-z]+[0-9]*\\);" nil t) + (let* ((entity (match-string 1)) + (elem (if (eq (aref entity 0) ?\#) + (let ((c (mm-ucs-to-char + ;; Hex number: ㈒ + (if (eq (aref entity 1) ?x) + (string-to-number (substring entity 2) + 16) + ;; Decimal number:  + (string-to-number (substring entity 1)))))) + (if (mm-char-or-char-int-p c) c ?#)) + (or (cdr (assq (intern entity) + mm-url-html-entities)) + ?#)))) (unless (stringp elem) (setq elem (char-to-string elem))) (replace-match elem t t)))) @@ -418,6 +423,8 @@ spaces. Die Die Die." (mm-url-form-encode-xwfu (cdr data)))) pairs "&")) +(autoload 'mml-compute-boundary "mml") + (defun mm-url-encode-multipart-form-data (pairs &optional boundary) "Return PAIRS encoded in multipart/form-data." ;; RFC1867 @@ -494,5 +501,4 @@ spaces. Die Die Die." (provide 'mm-url) -;; arch-tag: 0594f9b3-417c-48b0-adc2-5082e1e7917f ;;; mm-url.el ends here diff --git a/lisp/gnus/mm-util.el b/lisp/gnus/mm-util.el index f657000205e..588915a1ab7 100644 --- a/lisp/gnus/mm-util.el +++ b/lisp/gnus/mm-util.el @@ -680,7 +680,7 @@ superset of iso-8859-1." "100% binary coding system.") (defvar mm-text-coding-system - (or (if (memq system-type '(windows-nt ms-dos ms-windows)) + (or (if (memq system-type '(windows-nt ms-dos)) (and (mm-coding-system-p 'raw-text-dos) 'raw-text-dos) (and (mm-coding-system-p 'raw-text) 'raw-text)) mm-binary-coding-system) @@ -692,12 +692,12 @@ superset of iso-8859-1." (defvar mm-auto-save-coding-system (cond ((mm-coding-system-p 'utf-8-emacs) ; Mule 7 - (if (memq system-type '(windows-nt ms-dos ms-windows)) + (if (memq system-type '(windows-nt ms-dos)) (if (mm-coding-system-p 'utf-8-emacs-dos) 'utf-8-emacs-dos mm-binary-coding-system) 'utf-8-emacs)) ((mm-coding-system-p 'emacs-mule) - (if (memq system-type '(windows-nt ms-dos ms-windows)) + (if (memq system-type '(windows-nt ms-dos)) (if (mm-coding-system-p 'emacs-mule-dos) 'emacs-mule-dos mm-binary-coding-system) 'emacs-mule)) @@ -1429,16 +1429,23 @@ If SUFFIX is non-nil, add that at the end of the file name." ;; Reset the umask. (set-default-file-modes umask))))) +(defvar mm-image-load-path-cache nil) + (defun mm-image-load-path (&optional package) - (let (dir result) - (dolist (path load-path (nreverse result)) - (when (and path - (file-directory-p - (setq dir (concat (file-name-directory - (directory-file-name path)) - "etc/images/" (or package "gnus/"))))) - (push dir result)) - (push path result)))) + (if (and mm-image-load-path-cache + (equal load-path (car mm-image-load-path-cache))) + (cdr mm-image-load-path-cache) + (let (dir result) + (dolist (path load-path) + (when (and path + (file-directory-p + (setq dir (concat (file-name-directory + (directory-file-name path)) + "etc/images/" (or package "gnus/"))))) + (push dir result))) + (setq result (nreverse result) + mm-image-load-path-cache (cons load-path result)) + result))) ;; Fixme: This doesn't look useful where it's used. (if (fboundp 'detect-coding-region) @@ -1653,5 +1660,4 @@ gzip, bzip2, etc. are allowed." (provide 'mm-util) -;; arch-tag: 94dc5388-825d-4fd1-bfa5-2100aa351238 ;;; mm-util.el ends here diff --git a/lisp/gnus/mm-uu.el b/lisp/gnus/mm-uu.el index 5ae9205e2f0..83b38c8ae1e 100644 --- a/lisp/gnus/mm-uu.el +++ b/lisp/gnus/mm-uu.el @@ -441,7 +441,7 @@ apply the face `mm-uu-extract'." (defun mm-uu-yenc-extract () ;; This might not be exactly correct, but we sure can't get the ;; binary data from the article buffer, since that's already in a - ;; non-binary charset. So get it from the original article buffer. + ;; non-binary charset. So get it from the original article buffer. (mm-make-handle (with-current-buffer gnus-original-article-buffer (mm-uu-copy-to-buffer start-point end-point)) (list (or (and file-name @@ -729,5 +729,4 @@ Assume text has been decoded if DECODED is non-nil." (provide 'mm-uu) -;; arch-tag: 7db076bf-53db-4320-aa19-ca76a1d2ab2c ;;; mm-uu.el ends here diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index 42e21cad514..1a2d940e2e5 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -688,5 +688,4 @@ (provide 'mm-view) -;; arch-tag: b60e749a-d05c-47f2-bccd-bdaa59327cb2 ;;; mm-view.el ends here diff --git a/lisp/gnus/mml-sec.el b/lisp/gnus/mml-sec.el index 41abfcdc9b9..267f6483d24 100644 --- a/lisp/gnus/mml-sec.el +++ b/lisp/gnus/mml-sec.el @@ -380,5 +380,4 @@ If called with a prefix argument, only encrypt (do NOT sign)." (provide 'mml-sec) -;; arch-tag: 111c56e7-df5e-4287-87d7-93ed2911ec6c ;;; mml-sec.el ends here diff --git a/lisp/gnus/mml-smime.el b/lisp/gnus/mml-smime.el index 827003f8ec7..17732997e63 100644 --- a/lisp/gnus/mml-smime.el +++ b/lisp/gnus/mml-smime.el @@ -554,5 +554,4 @@ Content-Disposition: attachment; filename=smime.p7m (provide 'mml-smime) -;; arch-tag: f1bf94d4-f2cd-4c6f-b059-ad69492817e2 ;;; mml-smime.el ends here diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 2ebd7996d77..15b1bb7096b 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -120,10 +120,10 @@ match found will be used." ,dispositions)))) :group 'message) -(defcustom mml-insert-mime-headers-always nil +(defcustom mml-insert-mime-headers-always t "If non-nil, always put Content-Type: text/plain at top of empty parts. It is necessary to work against a bug in certain clients." - :version "22.1" + :version "24.1" :type 'boolean :group 'message) @@ -1570,5 +1570,4 @@ or the `pop-to-buffer' function." (provide 'mml) -;; arch-tag: 583c96cf-1ffe-451b-a5e5-4733ae9ddd12 ;;; mml.el ends here diff --git a/lisp/gnus/mml1991.el b/lisp/gnus/mml1991.el index 3ba479574fd..8f9076cbc3f 100644 --- a/lisp/gnus/mml1991.el +++ b/lisp/gnus/mml1991.el @@ -521,5 +521,4 @@ If no one is selected, default secret key is used. " ;; coding: iso-8859-1 ;; End: -;; arch-tag: e542be18-ab28-4393-9b33-97fe9cf30706 ;;; mml1991.el ends here diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 977f4dabb67..838813e0f19 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -1420,5 +1420,4 @@ If no one is selected, default secret key is used. " (provide 'mml2015) -;; arch-tag: b04701d5-0b09-44d8-bed8-de901bf435f2 ;;; mml2015.el ends here diff --git a/lisp/gnus/nnagent.el b/lisp/gnus/nnagent.el index afacb61c3b9..263d721dad2 100644 --- a/lisp/gnus/nnagent.el +++ b/lisp/gnus/nnagent.el @@ -121,7 +121,7 @@ (deffoo nnagent-request-set-mark (group action server) (mm-with-unibyte-buffer (insert "(gnus-agent-synchronize-group-flags \"" - group + group "\" '") (gnus-pp action) (insert " \"" @@ -151,7 +151,7 @@ ;; Assume that articles with smaller numbers than the first one ;; Agent knows are gone. (setq first (caar gnus-agent-article-alist)) - (when first + (when first (while (and arts (< (car arts) first)) (pop arts))) (set-buffer nntp-server-buffer) @@ -261,5 +261,4 @@ (provide 'nnagent) -;; arch-tag: af710b77-f816-4969-af31-6fd94fb42245 ;;; nnagent.el ends here diff --git a/lisp/gnus/nnbabyl.el b/lisp/gnus/nnbabyl.el index 121dbbda787..58e848bcb5c 100644 --- a/lisp/gnus/nnbabyl.el +++ b/lisp/gnus/nnbabyl.el @@ -344,7 +344,7 @@ (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") + (nnmail-cache-insert (nnmail-fetch-field "message-id") group (nnmail-fetch-field "subject") (nnmail-fetch-field "from"))) @@ -363,7 +363,7 @@ (insert-buffer-substring buf) (when last (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id") + (nnmail-cache-insert (nnmail-fetch-field "message-id") group (nnmail-fetch-field "subject") (nnmail-fetch-field "from"))) @@ -663,5 +663,4 @@ (provide 'nnbabyl) -;; arch-tag: aa7ddedb-8c07-4c0e-beb0-58e795c2b81b ;;; nnbabyl.el ends here diff --git a/lisp/gnus/nndb.el b/lisp/gnus/nndb.el deleted file mode 100644 index 2ba7f2901a6..00000000000 --- a/lisp/gnus/nndb.el +++ /dev/null @@ -1,325 +0,0 @@ -;;; nndb.el --- nndb access for Gnus - -;; Copyright (C) 1997, 1998, 2000, 2002, 2003, 2004, 2005, 2006, 2007, -;; 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> -;; Kai Grossjohann <grossjohann@ls6.informatik.uni-dortmund.de> -;; Joe Hildebrand <joe.hildebrand@ilg.com> -;; David Blacka <davidb@rwhois.net> -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;;; 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). - -;;; Code: - -;; For Emacs < 22.2. -(eval-and-compile - (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) - -;;- -;; Register nndb with known select methods. - -(require 'gnus-start) -(unless (assoc "nndb" gnus-valid-select-methods) - (gnus-declare-backend "nndb" 'mail 'respool 'address 'prompt-address)) - -(require 'nnmail) -(require 'nnheader) -(require 'nntp) -(eval-when-compile (require 'cl)) - -;; 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 - (date-to-time (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)) - ) - - (nnheader-message 5 "") - (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-number (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))) - -;; _Something_ defines it... -(declare-function nndb-request-article "nndb" t t) - -(deffoo nndb-request-move-article - (article group server accept-form &optional last move-is-internal) - "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)) - (or (string-match "^\\([0-9]+\\)" msg) - (error "nndb: %s" msg)) - (setq art (substring msg (match-beginning 1) (match-end 1))) - (nnheader-message 5 "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 compatibility functions - -(deffoo nndb-status-message (&optional server) - "Return server status as a string." - (set-buffer nntp-server-buffer) - (buffer-string)) - -;; Import stuff from nntp - -(nnoo-import nndb - (nntp)) - -(provide 'nndb) - -;; arch-tag: 83bd6fb4-58d9-4fed-a901-c6c625ad5f8a -;;; nndb.el ends here diff --git a/lisp/gnus/nndiary.el b/lisp/gnus/nndiary.el index 62a5db6ea3e..3189d33dd5a 100644 --- a/lisp/gnus/nndiary.el +++ b/lisp/gnus/nndiary.el @@ -1584,6 +1584,4 @@ all. This may very well take some time.") (provide 'nndiary) - -;; arch-tag: 9c542b95-92e7-4ace-a038-330ab296e203 ;;; nndiary.el ends here diff --git a/lisp/gnus/nndir.el b/lisp/gnus/nndir.el index dd86fba6930..b6de7afa019 100644 --- a/lisp/gnus/nndir.el +++ b/lisp/gnus/nndir.el @@ -96,5 +96,4 @@ (provide 'nndir) -;; arch-tag: 56f09f68-0e4e-4816-818a-df80b4a394c8 ;;; nndir.el ends here diff --git a/lisp/gnus/nndoc.el b/lisp/gnus/nndoc.el index 375e300a1eb..ddeac7f9523 100644 --- a/lisp/gnus/nndoc.el +++ b/lisp/gnus/nndoc.el @@ -100,7 +100,7 @@ from the document.") (head-end . "^\t") (generate-head-function . nndoc-generate-clari-briefs-head) (article-transform-function . nndoc-transform-clari-briefs)) - + (standard-digest (first-article . ,(concat "^" (make-string 70 ?-) "\n *\n+")) (article-begin . ,(concat "^\n" (make-string 30 ?-) "\n *\n+")) @@ -118,6 +118,16 @@ from the document.") (file-end . "^End of") (prepare-body-function . nndoc-unquote-dashes) (subtype digest guess)) + (google + (pre-dissection-function . nndoc-decode-content-transfer-encoding) + (article-begin . "^== [0-9]+ of [0-9]+ ==$") + (head-begin . "^Date:") + (head-end . "^$") + (body-end-function . nndoc-digest-body-end) + (body-begin . "^$") + (file-end . "^==============================================================================$") + (prepare-body-function . nndoc-unquote-dashes) + (subtype digest guess)) (lanl-gov-announce (article-begin . "^\\\\\\\\\n") (head-begin . "^\\(Paper.*:\\|arXiv:\\)") @@ -186,6 +196,7 @@ from the document.") (defvoo nndoc-article-begin-function nil) (defvoo nndoc-generate-article-function nil) (defvoo nndoc-dissection-function nil) +(defvoo nndoc-pre-dissection-function nil) (defvoo nndoc-status-string "") (defvoo nndoc-group-alist nil) @@ -363,7 +374,8 @@ from the document.") nndoc-generate-head-function nndoc-body-begin-function nndoc-head-begin-function nndoc-generate-article-function - nndoc-dissection-function))) + nndoc-dissection-function + nndoc-pre-dissection-function))) (while vars (set (pop vars) nil))) (let (defs) @@ -445,6 +457,22 @@ from the document.") (forward-line 1) (goto-char (+ (point) (string-to-number (match-string 1)))))) +(defun nndoc-google-type-p () + (when (re-search-forward "^=3D=3D 1 of [0-9]+ =3D=3D$" nil t) + t)) + +(defun nndoc-decode-content-transfer-encoding () + (let ((encoding + (save-restriction + (message-narrow-to-head) + (message-fetch-field "content-transfer-encoding")))) + (when (and encoding + (search-forward "\n\n" nil t)) + (save-restriction + (narrow-to-region (point) (point-max)) + (mm-decode-content-transfer-encoding + (intern (downcase (mail-header-strip encoding)))))))) + (defun nndoc-babyl-type-p () (when (re-search-forward "\^_\^L *\n" nil t) t)) @@ -807,6 +835,9 @@ from the document.") ;; Remove blank lines. (while (eq (following-char) ?\n) (delete-char 1)) + (when nndoc-pre-dissection-function + (save-excursion + (funcall nndoc-pre-dissection-function))) (if nndoc-dissection-function (funcall nndoc-dissection-function) ;; Find the beginning of the file. @@ -1025,5 +1056,4 @@ symbol in the alist." (provide 'nndoc) -;; arch-tag: f5c2970e-0387-47ac-a0b3-6cc317dffabe ;;; nndoc.el ends here diff --git a/lisp/gnus/nndraft.el b/lisp/gnus/nndraft.el index 7afded2abf0..dd2b8a6b48d 100644 --- a/lisp/gnus/nndraft.el +++ b/lisp/gnus/nndraft.el @@ -202,7 +202,7 @@ are generated if and only if they are also in `message-draft-headers'.") 'nnmh-request-group (list group server dont-check))) -(deffoo nndraft-request-move-article (article group server accept-form +(deffoo nndraft-request-move-article (article group server accept-form &optional last move-is-internal) (nndraft-possibly-change-group group) (let ((buf (get-buffer-create " *nndraft move*")) @@ -313,5 +313,4 @@ are generated if and only if they are also in `message-draft-headers'.") (provide 'nndraft) -;; arch-tag: 3ce26ca0-41cb-48b1-8703-4dad35e188aa ;;; nndraft.el ends here diff --git a/lisp/gnus/nneething.el b/lisp/gnus/nneething.el index 2a80d867e56..2f05c7e7900 100644 --- a/lisp/gnus/nneething.el +++ b/lisp/gnus/nneething.el @@ -427,5 +427,4 @@ included.") (provide 'nneething) -;; arch-tag: 1277f386-88f2-4459-bb24-f3f45962a6c5 ;;; nneething.el ends here diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index 19fe8c61b7d..6413e98cc1e 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -494,7 +494,7 @@ the group. Then the marks file will be regenerated properly by Gnus.") (nnfolder-save-active nnfolder-group-alist nnfolder-active-file) (gnus-sorted-difference articles (nreverse deleted-articles))))) -(deffoo nnfolder-request-move-article (article group server accept-form +(deffoo nnfolder-request-move-article (article group server accept-form &optional last move-is-internal) (save-excursion (let ((buf (get-buffer-create " *nnfolder move*")) @@ -552,7 +552,7 @@ the group. Then the marks file will be regenerated properly by Gnus.") (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") + (nnmail-cache-insert (nnmail-fetch-field "message-id") group (nnmail-fetch-field "subject") (nnmail-fetch-field "from"))) @@ -1301,5 +1301,4 @@ This command does not work if you use short group names." (provide 'nnfolder) -;; arch-tag: a040d0f4-4f4e-445f-8972-839575c5f7e6 ;;; nnfolder.el ends here diff --git a/lisp/gnus/nngateway.el b/lisp/gnus/nngateway.el index 163aa357b2b..1c0d7753eff 100644 --- a/lisp/gnus/nngateway.el +++ b/lisp/gnus/nngateway.el @@ -89,5 +89,4 @@ parameter -- the gateway address.") (provide 'nngateway) -;; arch-tag: f7ecb92e-b10c-43d5-9a9b-1314233341fc ;;; nngateway.el ends here diff --git a/lisp/gnus/nnheader.el b/lisp/gnus/nnheader.el index 6a24f21efc1..9a90a76f7af 100644 --- a/lisp/gnus/nnheader.el +++ b/lisp/gnus/nnheader.el @@ -77,7 +77,7 @@ Integer values will in effect be rounded up to the nearest multiple of "*Length of each read operation when trying to fetch HEAD headers.") (defvar nnheader-read-timeout - (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin" + (if (string-match "windows-nt\\|os/2\\|cygwin" (symbol-name system-type)) ;; http://thread.gmane.org/v9655t3pjo.fsf@marauder.physik.uni-ulm.de ;; @@ -102,7 +102,7 @@ Shorter values mean quicker response, but are more CPU intensive.") (defvar nnheader-file-name-translation-alist (let ((case-fold-search t)) (cond - ((string-match "windows-nt\\|os/2\\|emx\\|cygwin" + ((string-match "windows-nt\\|os/2\\|cygwin" (symbol-name system-type)) (append (mapcar (lambda (c) (cons c ?_)) '(?: ?* ?\" ?< ?> ??)) @@ -786,8 +786,7 @@ If FULL, translate everything." ;; We translate -- but only the file name. We leave the directory ;; alone. (if (and (featurep 'xemacs) - (memq system-type '(cygwin32 win32 w32 mswindows windows-nt - cygwin))) + (memq system-type '(windows-nt cygwin))) ;; This is needed on NT and stuff, because ;; file-name-nondirectory is not enough to split ;; file names, containing ':', e.g. @@ -1086,5 +1085,4 @@ See `find-file-noselect' for the arguments." (provide 'nnheader) -;; arch-tag: a9c4b7d9-52ae-4ec9-b196-dfd93124d202 ;;; nnheader.el ends here diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index c76169cb2b7..d412af46d0c 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -588,11 +588,12 @@ If EXAMINE is non-nil the group is selected read-only." (imap-mailbox-select decoded-group examine)) (let (minuid maxuid) (when (> (imap-mailbox-get 'exists) 0) - (imap-fetch-safe '("1,*" . "1,*:*") "UID" nil 'nouidfetch) - (imap-message-map (lambda (uid Uid) - (setq minuid (if minuid (min minuid uid) uid) - maxuid (if maxuid (max maxuid uid) uid))) - 'UID)) + (imap-fetch "1:*" "UID" nil 'nouidfetch) + (imap-message-map + (lambda (uid Uid) + (setq minuid (if minuid (min minuid uid) uid) + maxuid (if maxuid (max maxuid uid) uid))) + 'UID)) (list (imap-mailbox-get 'exists) minuid maxuid)))))) (defun nnimap-possibly-change-group (group &optional server) @@ -833,8 +834,8 @@ If EXAMINE is non-nil the group is selected read-only." nnimap-authinfo-file) (netrc-parse nnimap-authinfo-file))) (port (if nnimap-server-port - (int-to-string nnimap-server-port) - "imap")) + (int-to-string nnimap-server-port) + "imap")) (auth-info (auth-source-user-or-password '("login" "password") server port)) (auth-user (nth 0 auth-info)) @@ -1114,14 +1115,16 @@ function is generally only called when Gnus is shutting down." (dolist (pattern (nnimap-pattern-to-list-arguments nnimap-list-pattern)) (dolist (mbx (funcall nnimap-request-list-method (cdr pattern) (car pattern))) - (or (member "\\NoSelect" (imap-mailbox-get 'list-flags mbx)) - (let* ((encoded-mbx (nnimap-encode-group-name mbx)) - (info (nnimap-find-minmax-uid encoded-mbx 'examine))) - (when info - (with-current-buffer nntp-server-buffer - (insert (format "\"%s\" %d %d y\n" - encoded-mbx (or (nth 2 info) 0) - (max 1 (or (nth 1 info) 1))))))))))) + (unless (member "\\noselect" + (mapcar #'downcase + (imap-mailbox-get 'list-flags mbx))) + (let* ((encoded-mbx (nnimap-encode-group-name mbx)) + (info (nnimap-find-minmax-uid encoded-mbx 'examine))) + (when info + (with-current-buffer nntp-server-buffer + (insert (format "\"%s\" %d %d y\n" + encoded-mbx (or (nth 2 info) 0) + (max 1 (or (nth 1 info) 1))))))))))) (gnus-message 5 "nnimap: Generating active list%s...done" (if (> (length server) 0) (concat " for " server) "")) t)) @@ -1499,8 +1502,8 @@ function is generally only called when Gnus is shutting down." (nnimap-before-find-minmax-bugworkaround) (dolist (pattern (nnimap-pattern-to-list-arguments nnimap-list-pattern)) - (dolist (mbx (imap-mailbox-lsub (cdr pattern) (car pattern) nil - nnimap-server-buffer)) + (dolist (mbx (funcall nnimap-request-list-method (cdr pattern) (car pattern) nil + nnimap-server-buffer)) (or (catch 'found (dolist (mailbox (imap-mailbox-get 'list-flags mbx nnimap-server-buffer)) @@ -1807,69 +1810,6 @@ be used in a STORE FLAGS command." "Return t if MARK can be permanently (between IMAP sessions) saved on articles, in GROUP." (imap-message-flag-permanent-p (nnimap-mark-to-flag mark))) -(when nnimap-debug - (require 'trace) - (buffer-disable-undo (get-buffer-create nnimap-debug-buffer)) - (mapc (lambda (f) (trace-function-background f nnimap-debug-buffer)) - '( - nnimap-possibly-change-server - nnimap-verify-uidvalidity - nnimap-find-minmax-uid - nnimap-before-find-minmax-bugworkaround - nnimap-possibly-change-group - ;;nnimap-replace-whitespace - nnimap-retrieve-headers-progress - nnimap-retrieve-which-headers - nnimap-group-overview-filename - nnimap-retrieve-headers-from-file - nnimap-retrieve-headers-from-server - nnimap-retrieve-headers - nnimap-open-connection - nnimap-open-server - nnimap-server-opened - nnimap-close-server - nnimap-request-close - nnimap-status-message - ;;nnimap-demule - nnimap-request-article-part - nnimap-request-article - nnimap-request-head - nnimap-request-body - nnimap-request-group - nnimap-close-group - nnimap-pattern-to-list-arguments - nnimap-request-list - nnimap-request-post - nnimap-retrieve-groups - nnimap-request-update-info-internal - nnimap-request-type - nnimap-request-set-mark - nnimap-split-to-groups - nnimap-split-find-rule - nnimap-split-find-inbox - nnimap-split-articles - nnimap-request-scan - nnimap-request-newgroups - nnimap-request-create-group - nnimap-time-substract - nnimap-date-days-ago - nnimap-request-expire-articles-progress - nnimap-request-expire-articles - nnimap-request-move-article - nnimap-request-accept-article - nnimap-request-delete-group - nnimap-request-rename-group - gnus-group-nnimap-expunge - gnus-group-nnimap-edit-acl - gnus-group-nnimap-edit-acl-done - nnimap-group-mode-hook - nnimap-mark-to-predicate - nnimap-mark-to-flag-1 - nnimap-mark-to-flag - nnimap-mark-permanent-p - ))) - (provide 'nnimap) -;; arch-tag: 2b001f20-3ff9-4094-a0ad-46807c1ba70b ;;; nnimap.el ends here diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el index c14d9a1b6aa..6096c6fb374 100644 --- a/lisp/gnus/nnir.el +++ b/lisp/gnus/nnir.el @@ -263,10 +263,10 @@ ;; I have tried to make the code expandable. Basically, it is divided ;; into two layers. The upper layer is somewhat like the `nnvirtual' -;; or `nnkiboze' backends: given a specification of what articles to -;; show from another backend, it creates a group containing exactly -;; those articles. The lower layer issues a query to a search engine -;; and produces such a specification of what articles to show from the +;; backend: given a specification of what articles to show from +;; another backend, it creates a group containing exactly those +;; articles. The lower layer issues a query to a search engine and +;; produces such a specification of what articles to show from the ;; other backend. ;; The interface between the two layers consists of the single @@ -792,7 +792,7 @@ and show thread that contains this article." (setq novitem (funcall nnir-get-article-nov-override-function artitem)) ;; else, set novitem through nnheader-parse-nov/nnheader-parse-head - (case (setq foo (gnus-retrieve-headers (list artno) + (case (setq foo (gnus-retrieve-headers (list artno) artfullgroup nil)) (nov (goto-char (point-min)) @@ -1697,5 +1697,4 @@ The Gnus backend/server information is added." ;; The end. (provide 'nnir) -;; arch-tag: 9b3fecf8-4397-4bbb-bf3c-6ac3cbbc6664 ;;; nnir.el ends here diff --git a/lisp/gnus/nnkiboze.el b/lisp/gnus/nnkiboze.el deleted file mode 100644 index 17a10e66191..00000000000 --- a/lisp/gnus/nnkiboze.el +++ /dev/null @@ -1,391 +0,0 @@ -;;; nnkiboze.el --- select virtual news access for Gnus - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; 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) -(require 'mm-util) -(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.") - -(defvoo nnkiboze-file-coding-system mm-text-coding-system - "Coding system for nnkiboze files.") - - - -(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) - (let ((nnheader-file-coding-system nnkiboze-file-coding-system)) - (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)) - num group) - (unless xref - (error "nnkiboze: No xref")) - (unless (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref) - (error "nnkiboze: Malformed xref")) - (setq num (string-to-number (match-string 2 xref)) - group (match-string 1 xref)) - (or (with-current-buffer buffer - (or (and gnus-use-cache (gnus-cache-request-article num group)) - (gnus-agent-request-article num group))) - (gnus-request-article num group buffer))))) - -(deffoo nnkiboze-request-scan (&optional group server) - (nnkiboze-possibly-change-group group) - (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) - (unless (file-exists-p nov-file) - (nnkiboze-request-scan group)) - (if (not (file-exists-p nov-file)) - (nnheader-report 'nnkiboze "Can't select group %s" group) - (let ((nnheader-file-coding-system nnkiboze-file-coding-system)) - (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) - (let ((coding-system-for-write nnkiboze-file-coding-system)) - (with-temp-file (nnkiboze-nov-file-name) - (let ((cur (current-buffer)) - (nnheader-file-coding-system nnkiboze-file-coding-system)) - (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 (nconc - (nnkiboze-score-file group) - (list (nnkiboze-nov-file-name) - (nnkiboze-nov-file-name ".newsrc"))))) - (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) - t) - -(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 ((mail-sources 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) t)))) - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-group-list-groups))) - -(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 &optional inhibit-list-groups) - (let* ((info (gnus-get-info group)) - (newsrc-file (concat nnkiboze-directory - (nnheader-translate-file-chars - (concat group ".newsrc")))) - (nov-file (concat nnkiboze-directory - (nnheader-translate-file-chars - (concat 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) - ;; Use only nnkiboze-score-file! - (gnus-score-use-all-scores nil) - (gnus-use-scoring t) - (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 num-unread) - (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)) - (let ((coding-system-for-write nnkiboze-file-coding-system)) - (gnus-make-directory (file-name-directory nov-file)) - (with-temp-file nov-file - (mm-disable-multibyte) - (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 - (gnus-info-level (gnus-get-info gname))) - (>= 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-active (caar newsrc)))) - ;; 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) - num-unread (gnus-group-unread (caar newsrc))) - (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 - (ignore-errors - (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. - (when (eq major-mode 'gnus-summary-mode) - (kill-buffer (current-buffer))))) - ;; Restore the proper info. - (when ginfo - (setcdr ginfo (cdr orig-info))) - (setcar (gnus-group-entry (caar newsrc)) num-unread))) - (setcdr (car newsrc) (cdr active)) - (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc)) - (setq newsrc (cdr newsrc))))) - ;; We save the kiboze newsrc for this group. - (gnus-make-directory (file-name-directory newsrc-file)) - (with-temp-file newsrc-file - (mm-disable-multibyte) - (insert "(setq nnkiboze-newsrc '") - (gnus-prin1 nnkiboze-newsrc) - (insert ")\n")) - (unless inhibit-list-groups - (save-excursion - (set-buffer gnus-group-buffer) - (gnus-group-list-groups))) - t)) - -(defun nnkiboze-enter-nov (buffer header group) - (save-excursion - (set-buffer buffer) - (goto-char (point-max)) - (let ((prefix (gnus-group-real-prefix group)) - (oheader (copy-sequence header)) - 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) - (with-temp-buffer - (insert (or (mail-header-xref oheader) "")) - (goto-char (point-min)) - (if (re-search-forward " [^ ]+:[0-9]+" nil t) - (goto-char (match-beginning 0)) - (or (eobp) (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)) - (mail-header-set-xref oheader (buffer-string))) - (nnheader-insert-nov oheader)))) - -(defun nnkiboze-nov-file-name (&optional suffix) - (concat (file-name-as-directory nnkiboze-directory) - (nnheader-translate-file-chars - (concat (nnkiboze-prefixed-name nnkiboze-current-group) - (or suffix ".nov"))))) - -(provide 'nnkiboze) - -;; arch-tag: 66068271-bdc9-4801-bcde-779702e73a05 -;;; nnkiboze.el ends here diff --git a/lisp/gnus/nnlistserv.el b/lisp/gnus/nnlistserv.el deleted file mode 100644 index 3e53001cec0..00000000000 --- a/lisp/gnus/nnlistserv.el +++ /dev/null @@ -1,152 +0,0 @@ -;;; nnlistserv.el --- retrieving articles via web mailing list archives - -;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> -;; Keywords: news, 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 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'nnoo) -(require 'mm-url) -(require 'nnweb) - -(nnoo-declare nnlistserv - nnweb) - -(defvoo nnlistserv-directory (nnheader-concat gnus-directory "nnlistserv/") - "Where nnlistserv will save its files." - nnweb-directory) - -(defvoo nnlistserv-name 'kk - "What search engine type is being used." - nnweb-type) - -(defvoo nnlistserv-type-definition - '((kk - (article . nnlistserv-kk-wash-article) - (map . nnlistserv-kk-create-mapping) - (search . nnlistserv-kk-search) - (address . "http://www.itk.ntnu.no/ansatte/Andresen_Trond/kk-f/%s/") - (pages "fra160396" "fra160796" "fra061196" "fra160197" - "fra090997" "fra040797" "fra130397" "nye") - (index . "date.html") - (identifier . nnlistserv-kk-identity))) - "Type-definition alist." - nnweb-type-definition) - -(defvoo nnlistserv-search nil - "Search string to feed to DejaNews." - nnweb-search) - -(defvoo nnlistserv-ephemeral-p nil - "Whether this nnlistserv server is ephemeral." - nnweb-ephemeral-p) - -;;; Internal variables - -;;; Interface functions - -(nnoo-define-basics nnlistserv) - -(nnoo-import nnlistserv - (nnweb)) - -;;; Internal functions - -;;; -;;; KK functions. -;;; - -(defun nnlistserv-kk-create-mapping () - "Perform the search and create a number-to-url alist." - (save-excursion - (set-buffer nnweb-buffer) - (let ((case-fold-search t) - (active (or (cadr (assoc nnweb-group nnweb-group-alist)) - (cons 1 0))) - (pages (nnweb-definition 'pages)) - map url page subject from ) - (while (setq page (pop pages)) - (erase-buffer) - (when (funcall (nnweb-definition 'search) page) - ;; Go through all the article hits on this page. - (goto-char (point-min)) - (mm-url-decode-entities) - (goto-char (point-min)) - (while (re-search-forward "^<li> *<a href=\"\\([^\"]+\\)\"><b>\\([^\\>]+\\)</b></a> *<[^>]+><i>\\([^>]+\\)<" nil t) - (setq url (match-string 1) - subject (match-string 2) - from (match-string 3)) - (setq url (concat (format (nnweb-definition 'address) page) url)) - (unless (nnweb-get-hashtb url) - (push - (list - (incf (cdr active)) - (make-full-mail-header - (cdr active) subject from "" - (concat "<" (nnweb-identifier url) "@kk>") - nil 0 0 url)) - map) - (nnweb-set-hashtb (cadar map) (car map)) - (nnheader-message 5 "%s %s %s" (cdr active) (point) pages))))) - ;; Return the articles in the right order. - (setq nnweb-articles - (sort (nconc nnweb-articles map) 'car-less-than-car))))) - -(defun nnlistserv-kk-wash-article () - (let ((case-fold-search t) - (headers '(sent name email subject id)) - sent name email subject id) - (mm-url-decode-entities) - (while headers - (goto-char (point-min)) - (re-search-forward (format "<!-- %s=\"\\([^\"]+\\)" (car headers)) nil t) - (set (pop headers) (match-string 1))) - (goto-char (point-min)) - (search-forward "<!-- body" nil t) - (delete-region (point-min) (progn (forward-line 1) (point))) - (goto-char (point-max)) - (search-backward "<!-- body" nil t) - (delete-region (point-max) (progn (beginning-of-line) (point))) - (mm-url-remove-markup) - (goto-char (point-min)) - (insert (format "From: %s <%s>\n" name email) - (format "Subject: %s\n" subject) - (format "Message-ID: %s\n" id) - (format "Date: %s\n\n" sent)))) - -(defun nnlistserv-kk-search (search) - (mm-url-insert - (concat (format (nnweb-definition 'address) search) - (nnweb-definition 'index))) - t) - -(defun nnlistserv-kk-identity (url) - "Return an unique identifier based on URL." - url) - -(provide 'nnlistserv) - -;; arch-tag: 7705176f-d332-4a5e-a520-d0d319445617 -;;; nnlistserv.el ends here diff --git a/lisp/gnus/nnmail.el b/lisp/gnus/nnmail.el index 8bf0cbf5de1..b7d834ecd8c 100644 --- a/lisp/gnus/nnmail.el +++ b/lisp/gnus/nnmail.el @@ -265,7 +265,7 @@ It scans low-level sorted spools even when not required." :type 'function) (defcustom nnmail-crosspost-link-function - (if (string-match "windows-nt\\|emx" (symbol-name system-type)) + (if (string-match "windows-nt" (symbol-name system-type)) 'copy-file 'add-name-to-file) "*Function called to create a copy of a file. @@ -1823,8 +1823,6 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." ;; The we go through all the existing mail source specification ;; and fetch the mail from each. (while (setq source (pop fetching-sources)) - (nnheader-message 4 "%s: Reading incoming mail from %s..." - method (car source)) (when (setq new (mail-source-fetch source @@ -1842,8 +1840,9 @@ See the Info node `(gnus)Fancy Mail Splitting' for more details." (incf i))) ;; If we did indeed read any incoming spools, we save all info. (if (zerop total) - (nnheader-message 4 "%s: Reading incoming mail (no new mail)...done" - method (car source)) + (when mail-source-plugged + (nnheader-message 4 "%s: Reading incoming mail (no new mail)...done" + method (car source))) (nnmail-save-active (nnmail-get-value "%s-group-alist" method) (nnmail-get-value "%s-active-file" method)) @@ -2052,5 +2051,4 @@ Doesn't change point." (provide 'nnmail) -;; arch-tag: fe8f671a-50db-428a-bb5d-f00462f72ed7 ;;; nnmail.el ends here diff --git a/lisp/gnus/nnmaildir.el b/lisp/gnus/nnmaildir.el index 628b4c5d2a2..827eafdc7ed 100644 --- a/lisp/gnus/nnmaildir.el +++ b/lisp/gnus/nnmaildir.el @@ -1667,5 +1667,4 @@ by nnmaildir-request-article.") ;; fill-column: 77 ;; End: -;; arch-tag: 0c4e44cd-dfde-4040-888e-5597ec771849 ;;; nnmaildir.el ends here diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el index e39149b996c..04db76b942a 100644 --- a/lisp/gnus/nnmairix.el +++ b/lisp/gnus/nnmairix.el @@ -556,7 +556,7 @@ Other back ends might or might not work.") (mapcar (lambda (arg) (- arg numcorr)) articles))) - (setq rval + (setq rval (if (eq nnmairix-backend 'nnimap) (let ((gnus-nov-is-evil t)) (nnmairix-call-backend @@ -2044,5 +2044,4 @@ VALUES may contain values for editable fields from current article." (provide 'nnmairix) -;; arch-tag: bb187498-b229-4a55-8c07-6d3f80713e94 ;;; nnmairix.el ends here diff --git a/lisp/gnus/nnmbox.el b/lisp/gnus/nnmbox.el index 5ead1c96040..7d71dc1c1e4 100644 --- a/lisp/gnus/nnmbox.el +++ b/lisp/gnus/nnmbox.el @@ -718,5 +718,4 @@ (provide 'nnmbox) -;; arch-tag: 611dd95f-be37-413a-b3ae-8b059ba93659 ;;; nnmbox.el ends here diff --git a/lisp/gnus/nnmh.el b/lisp/gnus/nnmh.el index 2289eb6081a..131861e03ec 100644 --- a/lisp/gnus/nnmh.el +++ b/lisp/gnus/nnmh.el @@ -207,40 +207,48 @@ as unread by Gnus.") (defun nnmh-request-list-1 (dir) (setq dir (expand-file-name dir)) ;; Recurse down all directories. - (let ((dirs (and (file-readable-p dir) - (nnheader-directory-files dir t nil t))) - rdir) + (let ((files (nnheader-directory-files dir t nil t)) + (max 0) + min rdir num subdirectoriesp file) ;; Recurse down directories. - (while (setq rdir (pop dirs)) - (when (and (file-directory-p rdir) - (file-readable-p rdir) - (not (equal (file-truename rdir) - (file-truename dir)))) - (nnmh-request-list-1 rdir)))) - ;; For each directory, generate an active file line. - (unless (string= (expand-file-name nnmh-toplev) dir) - (let ((files (mapcar 'string-to-number - (directory-files dir nil "^[0-9]+$" t)))) - (when files - (with-current-buffer nntp-server-buffer - (goto-char (point-max)) - (insert - (format - "%s %.0f %.0f y\n" - (progn - (string-match - (regexp-quote - (file-truename (file-name-as-directory - (expand-file-name nnmh-toplev)))) - dir) - (mm-string-to-multibyte ;Why? Isn't it multibyte already? - (mm-encode-coding-string - (nnheader-replace-chars-in-string - (substring dir (match-end 0)) - ?/ ?.) - nnmail-pathname-coding-system))) - (apply 'max files) - (apply 'min files))))))) + (setq subdirectoriesp (> (nth 1 (file-attributes dir)) 2)) + (dolist (rdir files) + (if (or (not subdirectoriesp) + (file-regular-p rdir)) + (progn + (setq file (file-name-nondirectory rdir)) + (when (string-match "^[0-9]+$" file) + (setq num (string-to-number file)) + (setq max (max max num)) + (when (or (null min) + (< num min)) + (setq min num)))) + ;; This is a directory. + (when (and (file-readable-p rdir) + (not (equal (file-truename rdir) + (file-truename dir)))) + (nnmh-request-list-1 rdir)))) + ;; For each directory, generate an active file line. + (unless (string= (expand-file-name nnmh-toplev) dir) + (with-current-buffer nntp-server-buffer + (goto-char (point-max)) + (insert + (format + "%s %.0f %.0f y\n" + (progn + (string-match + (regexp-quote + (file-truename (file-name-as-directory + (expand-file-name nnmh-toplev)))) + dir) + (mm-string-to-multibyte ;Why? Isn't it multibyte already? + (mm-encode-coding-string + (nnheader-replace-chars-in-string + (substring dir (match-end 0)) + ?/ ?.) + nnmail-pathname-coding-system))) + (or max 0) + (or min 1)))))) t) (deffoo nnmh-request-newgroups (date &optional server) @@ -287,7 +295,7 @@ as unread by Gnus.") (deffoo nnmh-close-group (group &optional server) t) -(deffoo nnmh-request-move-article (article group server accept-form +(deffoo nnmh-request-move-article (article group server accept-form &optional last move-is-internal) (let ((buf (get-buffer-create " *nnmh move*")) result) @@ -312,7 +320,7 @@ as unread by Gnus.") (nnmh-possibly-change-directory group server) (nnmail-check-syntax) (when nnmail-cache-accepted-message-ids - (nnmail-cache-insert (nnmail-fetch-field "message-id") + (nnmail-cache-insert (nnmail-fetch-field "message-id") group (nnmail-fetch-field "subject") (nnmail-fetch-field "from"))) @@ -574,5 +582,4 @@ as unread by Gnus.") (provide 'nnmh) -;; arch-tag: 36c12a98-3bad-44b3-9953-628078ef0e04 ;;; nnmh.el ends here diff --git a/lisp/gnus/nnml.el b/lisp/gnus/nnml.el index 238e0221b97..6d676bb8514 100644 --- a/lisp/gnus/nnml.el +++ b/lisp/gnus/nnml.el @@ -283,7 +283,7 @@ non-nil.") (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)) + (nnmail-get-new-mail 'nnml 'nnml-save-incremental-nov nnml-directory group)) (deffoo nnml-close-group (group &optional server) (setq nnml-article-file-alist nil) @@ -438,7 +438,7 @@ non-nil.") (setq result (car (nnml-save-mail (list (cons group (nnml-active-number group server))) - server))) + server t))) (progn (nnmail-save-active nnml-group-alist nnml-active-file) (and last (nnml-save-nov)))) @@ -449,7 +449,7 @@ non-nil.") (nnml-active-number group ,server))))) (yes-or-no-p "Moved to `junk' group; delete article? ")) (setq result 'junk) - (setq result (car (nnml-save-mail result server)))) + (setq result (car (nnml-save-mail result server t)))) (when last (nnmail-save-active nnml-group-alist nnml-active-file) (when nnmail-cache-accepted-message-ids @@ -691,7 +691,7 @@ non-nil.") (make-directory (directory-file-name dir) t) (nnheader-message 5 "Creating mail directory %s" dir)))) -(defun nnml-save-mail (group-art &optional server) +(defun nnml-save-mail (group-art &optional server full-nov) "Save a mail into the groups GROUP-ART in the nnml server SERVER. GROUP-ART is a list that each element is a cons of a group name and an article number. This function is called narrowed to an article." @@ -742,11 +742,14 @@ article number. This function is called narrowed to an article." ;; header. (setq headers (nnml-parse-head chars)) ;; Output the nov line to all nov databases that should have it. - (if nnmail-group-names-not-encoded-p + (let ((func (if full-nov + 'nnml-add-nov + 'nnml-add-incremental-nov))) + (if nnmail-group-names-not-encoded-p + (dolist (ga group-art) + (funcall func (pop dec) (cdr ga) headers)) (dolist (ga group-art) - (nnml-add-nov (pop dec) (cdr ga) headers)) - (dolist (ga group-art) - (nnml-add-nov (car ga) (cdr ga) headers)))) + (funcall func (car ga) (cdr ga) headers))))) group-art) (defun nnml-active-number (group &optional server) @@ -778,6 +781,35 @@ article number. This function is called narrowed to an article." (setcdr active (1+ (cdr active)))) (cdr active))) +(defvar nnml-incremental-nov-buffer-alist nil) + +(defun nnml-save-incremental-nov () + (save-excursion + (while nnml-incremental-nov-buffer-alist + (when (buffer-name (cdar nnml-incremental-nov-buffer-alist)) + (set-buffer (cdar nnml-incremental-nov-buffer-alist)) + (when (buffer-modified-p) + (nnmail-write-region (point-min) (point-max) + nnml-nov-buffer-file-name t 'nomesg)) + (set-buffer-modified-p nil) + (kill-buffer (current-buffer))) + (setq nnml-incremental-nov-buffer-alist + (cdr nnml-incremental-nov-buffer-alist))))) + +(defun nnml-open-incremental-nov (group) + (or (cdr (assoc group nnml-incremental-nov-buffer-alist)) + (let ((buffer (nnml-get-nov-buffer group t))) + (push (cons group buffer) nnml-incremental-nov-buffer-alist) + buffer))) + +(defun nnml-add-incremental-nov (group article headers) + "Add a nov line for the GROUP nov headers, incrementally." + (save-excursion + (set-buffer (nnml-open-incremental-nov group)) + (goto-char (point-max)) + (mail-header-set-number headers article) + (nnheader-insert-nov headers))) + (defun nnml-add-nov (group article headers) "Add a nov line for the GROUP base." (save-excursion @@ -804,16 +836,21 @@ article number. This function is called narrowed to an article." (mail-header-set-number headers number) headers)))) -(defun nnml-get-nov-buffer (group) +(defun nnml-get-nov-buffer (group &optional incrementalp) (let* ((decoded (nnml-decoded-group-name group)) - (buffer (get-buffer-create (format " *nnml overview %s*" decoded))) + (buffer (get-buffer-create (format " *nnml %soverview %s*" + (if incrementalp + "incremental " + "") + decoded))) (file-name-coding-system nnmail-pathname-coding-system)) (save-excursion (set-buffer buffer) (set (make-local-variable 'nnml-nov-buffer-file-name) (nnmail-group-pathname decoded nnml-directory nnml-nov-file-name)) (erase-buffer) - (when (file-exists-p nnml-nov-buffer-file-name) + (when (and (not incrementalp) + (file-exists-p nnml-nov-buffer-file-name)) (nnheader-insert-file-contents nnml-nov-buffer-file-name))) buffer)) @@ -1306,5 +1343,4 @@ Use the nov database for the current group if available." (provide 'nnml) -;; arch-tag: 52c97dc3-9735-45de-b439-9e4d23b52004 ;;; nnml.el ends here diff --git a/lisp/gnus/nnnil.el b/lisp/gnus/nnnil.el index f20d63e70aa..f6bc35aec3c 100644 --- a/lisp/gnus/nnnil.el +++ b/lisp/gnus/nnnil.el @@ -79,4 +79,4 @@ (provide 'nnnil) -;; arch-tag: a982a1a3-bc5e-4fb1-a233-d7657a3e3257 +;;; nnnil.el ends here diff --git a/lisp/gnus/nnoo.el b/lisp/gnus/nnoo.el index c57af29fb68..083bedc6e19 100644 --- a/lisp/gnus/nnoo.el +++ b/lisp/gnus/nnoo.el @@ -322,5 +322,4 @@ All functions will return nil and report an error." (provide 'nnoo) -;; arch-tag: 0196b5ed-6f34-4778-a455-73a971f837e7 ;;; nnoo.el ends here diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index db1df33757c..8d8a40d002a 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -498,7 +498,7 @@ nnrss: %s: Not valid XML %s and w3-parse doesn't work %s" (defun nnrss-normalize-date (date) "Return a date string of DATE in the RFC822 style. This function handles the ISO 8601 date format described in -<URL:http://www.w3.org/TR/NOTE-datetime>, and also the RFC822 style +URL `http://www.w3.org/TR/NOTE-datetime', and also the RFC822 style which RSS 2.0 allows." (let (case-fold-search vector year month day time zone cts given) (cond ((null date)) ; do nothing for this case @@ -1012,7 +1012,7 @@ whether they are `offsite' or `onsite'." (defun nnrss-discover-feed (url) "Given a page, find an RSS feed using Mark Pilgrim's -`ultra-liberal rss locator' (http://diveintomark.org/2002/08/15.html)." +`ultra-liberal rss locator' (URL `http://diveintomark.org/2002/08/15.html')." (let ((parsed-page (nnrss-fetch url))) @@ -1134,5 +1134,4 @@ prefix), return the prefix." (provide 'nnrss) -;; arch-tag: 12910c07-0cdf-44fb-8d2c-416ded64c267 ;;; nnrss.el ends here diff --git a/lisp/gnus/nnslashdot.el b/lisp/gnus/nnslashdot.el deleted file mode 100644 index 3a0d6077ad8..00000000000 --- a/lisp/gnus/nnslashdot.el +++ /dev/null @@ -1,505 +0,0 @@ -;;; nnslashdot.el --- interfacing with Slashdot - -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'nnoo) -(require 'message) -(require 'gnus-util) -(require 'gnus) -(require 'nnmail) -(require 'mm-util) -(require 'mm-url) - -(nnoo-declare nnslashdot) - -(defvoo nnslashdot-directory (nnheader-concat gnus-directory "slashdot/") - "Where nnslashdot will save its files.") - -(defvoo nnslashdot-active-url "http://slashdot.org/search.pl?section=&min=%d" - "Where nnslashdot will fetch the active file from.") - -(defvoo nnslashdot-comments-url "http://slashdot.org/comments.pl?sid=%s&threshold=%d&commentsort=%d&mode=flat&startat=%d" - "Where nnslashdot will fetch comments from.") - -(defvoo nnslashdot-article-url - "http://slashdot.org/article.pl?sid=%s&mode=nocomment" - "Where nnslashdot will fetch the article from.") - -(defvoo nnslashdot-backslash-url "http://slashdot.org/slashdot.xml" - "Where nnslashdot will fetch the stories from.") - -(defvoo nnslashdot-use-front-page nil - "Use the front page in addition to the backslash page.") - -(defvoo nnslashdot-threshold -1 - "The article threshold.") - -(defvoo nnslashdot-threaded t - "Whether the nnslashdot groups should be threaded or not.") - -(defvoo nnslashdot-group-number 0 - "The number of non-fresh groups to keep updated.") - -(defvoo nnslashdot-login-name "" - "The login name to use when posting.") - -(defvoo nnslashdot-password "" - "The password to use when posting.") - -;;; Internal variables - -(defvar nnslashdot-groups nil) -(defvar nnslashdot-buffer nil) -(defvar nnslashdot-headers nil) - -;;; Interface functions - -(nnoo-define-basics nnslashdot) - -(deffoo nnslashdot-retrieve-headers (articles &optional group server fetch-old) - (nnslashdot-possibly-change-server group server) - (condition-case why - (unless gnus-nov-is-evil - (nnslashdot-retrieve-headers-1 articles group)) - (search-failed (nnslashdot-lose why)))) - -(deffoo nnslashdot-retrieve-headers-1 (articles group) - (let* ((last (car (last articles))) - (start (if nnslashdot-threaded 1 (pop articles))) - (entry (assoc group nnslashdot-groups)) - (sid (nth 2 entry)) - (first-comments t) - headers article subject score from date lines parent point cid - s startats changed) - (save-excursion - (set-buffer nnslashdot-buffer) - (let ((case-fold-search t)) - (erase-buffer) - (when (= start 1) - (mm-url-insert (format nnslashdot-article-url sid) t) - (goto-char (point-min)) - (if (eobp) - (error "Couldn't open connection to slashdot")) - (re-search-forward "Posted by[ \t\r\n]+") - (when (looking-at "\\(<a[^>]+>\\)?[ \t\r\n]*\\([^<\r\n]+\\)") - (setq from (mm-url-decode-entities-string (match-string 2)))) - (search-forward "on ") - (setq date (nnslashdot-date-to-date - (buffer-substring (point) (1- (search-forward "<"))))) - (setq lines (/ (- (point) - (progn (forward-line 1) (point))) - 60)) - (push - (cons - 1 - (make-full-mail-header - 1 group from date - (concat "<" sid "%1@slashdot>") - "" 0 lines nil nil)) - headers) - (setq start (if nnslashdot-threaded 2 (pop articles)))) - (while (and start (<= start last)) - (setq point (goto-char (point-max))) - (mm-url-insert - (format nnslashdot-comments-url sid - nnslashdot-threshold 0 (- start 2)) - t) - (when (and nnslashdot-threaded first-comments) - (setq first-comments nil) - (goto-char (point-max)) - (while (re-search-backward "startat=\\([0-9]+\\)" nil t) - (setq s (string-to-number (match-string 1))) - (unless (memq s startats) - (push s startats))) - (setq startats (sort startats '<))) - (setq article (if (and article (< start article)) article start)) - (goto-char point) - (while (re-search-forward - "<a name=\"\\([0-9]+\\)\">\\([^<]+\\)\\(?:.*\n\\)\\{2,10\\}.*score:\\([^)]+\\))" - nil t) - (setq cid (match-string 1) - subject (match-string 2) - score (match-string 3)) - (unless (assq article (nth 4 entry)) - (setcar (nthcdr 4 entry) (cons (cons article cid) (nth 4 entry))) - (setq changed t)) - (when (string-match "^Re: *" subject) - (setq subject (concat "Re: " (substring subject (match-end 0))))) - (setq subject (mm-url-decode-entities-string subject) - from "") - (when (re-search-forward "by[ \t\n]+<[^>]+>\\([^<(]+\\)" nil t) - (setq from - (concat - (mm-url-decode-entities-string (match-string 1)) - " <nobody@slashdot.org>"))) - (search-forward "on ") - (setq date - (nnslashdot-date-to-date - (buffer-substring - (point) (progn (skip-chars-forward "^()<>\n\r") (point))))) - (setq lines (/ (abs (- (search-forward "<div") - (search-forward "</div>"))) - 70)) - (if (not - (re-search-forward ".*cid=\\([0-9]+\\)\">Parent</A>" nil t)) - (setq parent nil) - (setq parent (match-string 1)) - (when (string= parent "0") - (setq parent nil))) - (push - (cons - article - (make-full-mail-header - article - (concat subject " (" score ")") - from date - (concat "<" sid "%" cid "@slashdot>") - (if parent - (concat "<" sid "%" parent "@slashdot>") - "") - 0 lines nil nil)) - headers) - (while (and articles (<= (car articles) article)) - (pop articles)) - (setq article (1+ article))) - (if nnslashdot-threaded - (progn - (setq start (pop startats)) - (if start (setq start (+ start 2)))) - (setq start (pop articles)))))) - (if changed (nnslashdot-write-groups)) - (setq nnslashdot-headers (sort headers 'car-less-than-car)) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (mm-with-unibyte-current-buffer - (dolist (header nnslashdot-headers) - (nnheader-insert-nov (cdr header))))) - 'nov)) - -(deffoo nnslashdot-request-group (group &optional server dont-check) - (nnslashdot-possibly-change-server nil server) - (let ((elem (assoc group nnslashdot-groups))) - (cond - ((not elem) - (nnheader-report 'nnslashdot "Group does not exist")) - (t - (nnheader-report 'nnslashdot "Opened group %s" group) - (nnheader-insert - "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem) - (prin1-to-string group)))))) - -(deffoo nnslashdot-close-group (group &optional server) - (nnslashdot-possibly-change-server group server) - (when (gnus-buffer-live-p nnslashdot-buffer) - (save-excursion - (set-buffer nnslashdot-buffer) - (kill-buffer nnslashdot-buffer))) - t) - -(deffoo nnslashdot-request-article (article &optional group server buffer) - (nnslashdot-possibly-change-server group server) - (let (contents cid) - (condition-case why - (save-excursion - (set-buffer nnslashdot-buffer) - (let ((case-fold-search t)) - (goto-char (point-min)) - (when (and (stringp article) - (string-match "%\\([0-9]+\\)@" article)) - (setq cid (match-string 1 article)) - (let ((map (nth 4 (assoc group nnslashdot-groups)))) - (while map - (if (equal (cdar map) cid) - (setq article (caar map) - map nil) - (setq map (cdr map)))))) - (when (numberp article) - (if (= article 1) - (progn - (search-forward "Posted by") - (search-forward "<div class=\"intro\">") - (setq contents - (buffer-substring - (point) - (progn - (search-forward "commentwrap") - (match-beginning 0))))) - (setq cid (cdr (assq article - (nth 4 (assoc group nnslashdot-groups))))) - (search-forward (format "<a name=\"%s\">" cid)) - (setq contents - (buffer-substring - (search-forward "<div class=\"commentBody\">") - (progn - (search-forward "<div class=\"commentSub\"") - (match-beginning 0)))))))) - (search-failed (nnslashdot-lose why))) - - (when contents - (save-excursion - (set-buffer (or buffer nntp-server-buffer)) - (erase-buffer) - (mm-with-unibyte-current-buffer - (insert contents) - (goto-char (point-min)) - (while (re-search-forward "\\(<br>\r?\\)+" nil t) - (replace-match "<p>" t t)) - (goto-char (point-min)) - (insert "Content-Type: text/html\nMIME-Version: 1.0\n") - (insert "Newsgroups: " (caddr (assoc group nnslashdot-groups)) - "\n") - (let ((header (cdr (assq article nnslashdot-headers)))) - (nnheader-insert-header header)) - (nnheader-report 'nnslashdot "Fetched article %s" article)) - (cons group article))))) - -(deffoo nnslashdot-close-server (&optional server) - (when (and (nnslashdot-server-opened server) - (gnus-buffer-live-p nnslashdot-buffer)) - (save-excursion - (set-buffer nnslashdot-buffer) - (kill-buffer nnslashdot-buffer))) - (nnoo-close-server 'nnslashdot server)) - -(deffoo nnslashdot-request-list (&optional server) - (nnslashdot-possibly-change-server nil server) - (let ((number 0) - (first nnslashdot-use-front-page) - sid elem description articles gname) - (condition-case why - ;; First we do the Ultramode to get info on all the latest groups. - (progn - (mm-with-unibyte-buffer - (mm-url-insert nnslashdot-backslash-url t) - (goto-char (point-min)) - (if (eobp) - (error "Couldn't open connection to slashdot")) - (while (search-forward "<story>" nil t) - (narrow-to-region (point) (search-forward "</story>")) - (goto-char (point-min)) - (re-search-forward "<title>\\([^<]+\\)</title>") - (setq description - (mm-url-decode-entities-string (match-string 1))) - (re-search-forward "<url>\\([^<]+\\)</url>") - (setq sid (match-string 1)) - (string-match "sid=\\([0-9/]+\\)\\(.shtml\\|$\\)" sid) - (setq sid (match-string 1 sid)) - (re-search-forward "<comments>\\([^<]+\\)</comments>") - (setq articles (string-to-number (match-string 1))) - (setq gname (concat description " (" sid ")")) - (if (setq elem (assoc gname nnslashdot-groups)) - (setcar (cdr elem) articles) - (push (list gname articles sid (current-time) nil) - nnslashdot-groups)) - (goto-char (point-max)) - (widen))) - ;; Then do the older groups. - (while (or first - (> (- nnslashdot-group-number number) 0)) - (setq first nil) - (mm-with-unibyte-buffer - (let ((case-fold-search t)) - (mm-url-insert (format nnslashdot-active-url number) t) - (goto-char (point-min)) - (while (re-search-forward - "article.pl\\?sid=\\([^&]+\\).*>\\([^<]+\\)</a>" - nil t) - (setq sid (match-string 1) - description - (mm-url-decode-entities-string (match-string 2))) - (forward-line 1) - (when (re-search-forward "with \\([0-9]+\\) comment" nil t) - (setq articles (1+ (string-to-number (match-string 1))))) - (setq gname (concat description " (" sid ")")) - (if (setq elem (assoc gname nnslashdot-groups)) - (setcar (cdr elem) articles) - (push (list gname articles sid (current-time) nil) - nnslashdot-groups))))) - (incf number 30))) - (search-failed (nnslashdot-lose why))) - (nnslashdot-write-groups) - (nnslashdot-generate-active) - t)) - -(deffoo nnslashdot-request-newgroups (date &optional server) - (nnslashdot-possibly-change-server nil server) - (nnslashdot-generate-active) - t) - -(deffoo nnslashdot-request-post (&optional server) - (nnslashdot-possibly-change-server nil server) - (let ((sid (message-fetch-field "newsgroups")) - (subject (message-fetch-field "subject")) - (references (car (last (split-string - (message-fetch-field "references"))))) - body quoted pid) - (string-match "%\\([0-9]+\\)@slashdot" references) - (setq pid (match-string 1 references)) - (message-goto-body) - (narrow-to-region (point) (progn (message-goto-signature) (point))) - (goto-char (point-min)) - (while (not (eobp)) - (if (looking-at "> ") - (progn - (delete-region (point) (+ (point) 2)) - (unless quoted - (insert "<blockquote>\n")) - (setq quoted t)) - (when quoted - (insert "</blockquote>\n") - (setq quoted nil))) - (forward-line 1)) - (goto-char (point-min)) - (while (re-search-forward "^ *\n" nil t) - (replace-match "<p>\n")) - (widen) - (when (message-goto-signature) - (forward-line -1) - (insert "<p>\n") - (while (not (eobp)) - (end-of-line) - (insert "<br>") - (forward-line 1))) - (message-goto-body) - (setq body (buffer-substring (point) (point-max))) - (erase-buffer) - (mm-url-fetch-form - "http://slashdot.org/comments.pl" - `(("sid" . ,sid) - ("pid" . ,pid) - ("rlogin" . "userlogin") - ("unickname" . ,nnslashdot-login-name) - ("upasswd" . ,nnslashdot-password) - ("postersubj" . ,subject) - ("op" . "Submit") - ("postercomment" . ,body) - ("posttype" . "html"))))) - -(deffoo nnslashdot-request-delete-group (group &optional force server) - (nnslashdot-possibly-change-server group server) - (setq nnslashdot-groups (delq (assoc group nnslashdot-groups) - nnslashdot-groups)) - (nnslashdot-write-groups)) - -(deffoo nnslashdot-request-close () - (setq nnslashdot-headers nil - nnslashdot-groups nil)) - -(deffoo nnslashdot-request-expire-articles - (articles group &optional server force) - (nnslashdot-possibly-change-server group server) - (let ((item (assoc group nnslashdot-groups))) - (when item - (if (fourth item) - (when (and (>= (length articles) (cadr item)) ;; All are expirable. - (nnmail-expired-article-p - group - (fourth item) - force)) - (setq nnslashdot-groups (delq item nnslashdot-groups)) - (nnslashdot-write-groups) - (setq articles nil)) ;; all expired. - (setcdr (cddr item) (list (current-time))) - (nnslashdot-write-groups)))) - articles) - -(nnoo-define-skeleton nnslashdot) - -;;; Internal functions - -(defun nnslashdot-possibly-change-server (&optional group server) - (nnslashdot-init server) - (when (and server - (not (nnslashdot-server-opened server))) - (nnslashdot-open-server server)) - (unless nnslashdot-groups - (nnslashdot-read-groups))) - -(defun nnslashdot-make-tuple (tuple n) - (prog1 - tuple - (while (> n 1) - (unless (cdr tuple) - (setcdr tuple (list nil))) - (setq tuple (cdr tuple) - n (1- n))))) - -(defun nnslashdot-read-groups () - (let ((file (expand-file-name "groups" nnslashdot-directory))) - (when (file-exists-p file) - (mm-with-unibyte-buffer - (insert-file-contents file) - (goto-char (point-min)) - (setq nnslashdot-groups (read (current-buffer)))) - (when (and nnslashdot-groups (< (length (car nnslashdot-groups)) 5)) - (dolist (group nnslashdot-groups) - (nnslashdot-make-tuple group 5)))))) - -(defun nnslashdot-write-groups () - (with-temp-file (expand-file-name "groups" nnslashdot-directory) - (gnus-prin1 nnslashdot-groups))) - -(defun nnslashdot-init (server) - "Initialize buffers and such." - (unless (file-exists-p nnslashdot-directory) - (gnus-make-directory nnslashdot-directory)) - (unless (gnus-buffer-live-p nnslashdot-buffer) - (setq nnslashdot-buffer - (save-excursion - (nnheader-set-temp-buffer - (format " *nnslashdot %s*" server)))) - (push nnslashdot-buffer gnus-buffers))) - -(defun nnslashdot-date-to-date (sdate) - (condition-case err - (let ((elem (delete "" (split-string sdate)))) - (concat (substring (nth 0 elem) 0 3) " " - (substring (nth 1 elem) 0 3) " " - (substring (nth 2 elem) 0 2) " " - (substring (nth 3 elem) 1 6) " " - (format-time-string "%Y") " " - (nth 4 elem))) - (error ""))) - -(defun nnslashdot-generate-active () - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (dolist (elem nnslashdot-groups) - (when (numberp (cadr elem)) - (insert (prin1-to-string (car elem)) - " " (number-to-string (cadr elem)) " 1 y\n"))))) - -(defun nnslashdot-lose (why) - (error "Slashdot HTML has changed; please get a new version of nnslashdot")) - -(provide 'nnslashdot) - -;; arch-tag: aa73df7a-f7e6-4eef-bdea-5ce2f8c691b3 -;;; nnslashdot.el ends here diff --git a/lisp/gnus/nnsoup.el b/lisp/gnus/nnsoup.el deleted file mode 100644 index 3cb453818bc..00000000000 --- a/lisp/gnus/nnsoup.el +++ /dev/null @@ -1,812 +0,0 @@ -;;; nnsoup.el --- SOUP access for Gnus - -;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, -;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> -;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> -;; 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 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;;; Code: - -(require 'nnheader) -(require 'nnmail) -(require 'gnus-soup) -(require 'gnus-msg) -(require 'nnoo) -(eval-when-compile (require 'cl)) - -(nnoo-declare nnsoup) - -(defvoo nnsoup-directory (nnheader-concat gnus-home-directory "SOUP/") - "*SOUP packet directory.") - -(defvoo nnsoup-tmp-directory - (cond ((fboundp 'temp-directory) (temp-directory)) - ((boundp 'temporary-file-directory) temporary-file-directory) - ("/tmp/")) - "*Where nnsoup will store temporary files.") - -(defvoo nnsoup-replies-directory (expand-file-name "replies/" nnsoup-directory) - "*Directory where outgoing packets will be composed.") - -(defvoo nnsoup-replies-format-type ?u ;; u is USENET news format. - "*Format of the replies packages.") - -(defvoo nnsoup-replies-index-type ?n - "*Index type of the replies packages.") - -(defvoo nnsoup-active-file (expand-file-name "active" nnsoup-directory) - "Active file.") - -(defvoo nnsoup-packer (concat "tar cf - %s | gzip > " - (expand-file-name gnus-home-directory) - "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 gnus-home-directory - "*Where nnsoup will look for incoming packets.") - -(defvoo nnsoup-packet-regexp "Soupout" - "*Regular expression matching SOUP packets in `nnsoup-packet-directory'.") - -(defvoo nnsoup-always-save t - "If non-nil commit the reply buffer on each message send. -This is necessary if using message mode outside Gnus with nnsoup as a -backend for the messages.") - - - -(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 (< (cdar (car 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) (cdar (car 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 entries 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 article in the group. - (when (not article) - (setq article - (cdar (car (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-difference 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)) - (setq max (cdar (car (last 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) - (with-temp-file 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 name 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)) - (nnheader-message 5 "Incorporating file %s..." cur-prefix) - (when (file-exists-p - (setq file - (expand-file-name - (concat (gnus-soup-area-prefix area) ".IDX") - nnsoup-tmp-directory))) - (rename-file file (nnsoup-file cur-prefix))) - (when (file-exists-p - (setq file (expand-file-name - (concat (gnus-soup-area-prefix area) ".MSG") - nnsoup-tmp-directory))) - (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 - ((or (= format ?u) - (= format ?n)) ;; Gnus back compatibility. - (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 (expand-file-name file nnsoup-directory)) - (save-excursion ; Load the file. - (set-buffer (get-buffer-create buffer-name)) - (buffer-disable-undo) - (push (cons nnsoup-current-group (current-buffer)) nnsoup-buffers) - (nnheader-insert-file-contents - (expand-file-name file nnsoup-directory)) - (current-buffer)))))) - -(defun nnsoup-file (prefix &optional message) - (expand-file-name - (concat prefix (if message ".MSG" ".IDX")) - nnsoup-directory)) - -(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))) - (dolist (packet packets) - (nnheader-message 5 "nnsoup: unpacking %s..." packet) - (if (not (gnus-soup-unpack-packet - nnsoup-tmp-directory nnsoup-unpacker packet)) - (nnheader-message 5 "Couldn't unpack %s" packet) - (delete-file packet) - (nnsoup-read-areas) - (nnheader-message 5 "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 ?u) (= 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) - (nnheader-message 5 "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 (< (cdar (car areas)) article)) - (setq areas (cdr areas))) - (and areas (car areas)))) - -(defvar nnsoup-old-functions - (list message-send-mail-real-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-real-function 'nnsoup-request-mail)) - -;;;###autoload -(defun nnsoup-revert-variables () - "Revert posting and mailing methods to the standard Emacs methods." - (interactive) - (setq message-send-mail-real-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)) - (goto-char (1+ delimline)) - (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)) - (when nnsoup-always-save - (save-buffer))) - (nnheader-message 5 "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 - (expand-file-name "REPLIES" nnsoup-replies-directory)))) - (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-number (match-string 1 f1))) - (progn (string-match "/\\([0-9]+\\)\\." f2) - (string-to-number (match-string 1 f2))))))) - active group lines ident elem min) - (set-buffer (get-buffer-create " *nnsoup work*")) - (dolist (file files) - (nnheader-message 5 "Doing %s..." file) - (erase-buffer) - (nnheader-insert-file-contents file) - (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]+\\)\\." file) - (match-string 1 file))) - (if (not (setq elem (assoc group active))) - (push (list group (cons 1 lines) - (list (cons 1 lines) - (vector ident group "ucm" "" lines))) - active) - (nconc elem - (list - (list (cons (1+ (setq min (cdadr elem))) - (+ min lines)) - (vector ident group "ucm" "" lines)))) - (setcdr (cadr elem) (+ min lines)))) - (nnheader-message 5 "") - (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) - ;; Find all files that aren't known by nnsoup. - (dolist (file 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 - (expand-file-name file nnsoup-directory))) - non-files))) - -(provide 'nnsoup) - -;; arch-tag: b0451389-5703-4450-9425-f66f6b38c828 -;;; nnsoup.el ends here diff --git a/lisp/gnus/nnspool.el b/lisp/gnus/nnspool.el index cf79613ad09..cdf2b829ecc 100644 --- a/lisp/gnus/nnspool.el +++ b/lisp/gnus/nnspool.el @@ -458,5 +458,4 @@ there.") (provide 'nnspool) -;; arch-tag: bdac8d27-2934-4eee-bad0-49e6b90c0d05 ;;; nnspool.el ends here diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 03e0168de49..3cdd63084ef 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -298,13 +298,6 @@ to insert Cancel-Lock headers.") (defvoo nntp-server-xover 'try) (defvoo nntp-server-list-active-group 'try) -(defvar nntp-async-needs-kluge - (string-match "^GNU Emacs 20\\.3\\." (emacs-version)) - "*When non-nil, nntp will poll asynchronous connections -once a second. By default, this is turned on only for Emacs -20.3, which has a bug that breaks nntp's normal method of -noticing asynchronous data.") - (defvar nntp-async-timer nil) (defvar nntp-async-process-list nil) @@ -316,8 +309,8 @@ port number on server. The program should accept IMAP commands on stdin and return responses to stdout.") (defvar nntp-authinfo-rejected nil -"A custom error condition used to report 'Authentication Rejected' errors. -Condition handlers that match just this condition ensure that the nntp +"A custom error condition used to report 'Authentication Rejected' errors. +Condition handlers that match just this condition ensure that the nntp backend doesn't catch this error.") (put 'nntp-authinfo-rejected 'error-conditions '(error nntp-authinfo-rejected)) (put 'nntp-authinfo-rejected 'error-message "Authorization Rejected") @@ -1116,7 +1109,8 @@ command whose response triggered the error." t) (deffoo nntp-request-set-mark (group actions &optional server) - (unless nntp-marks-is-evil + (when (and (not nntp-marks-is-evil) + nntp-marks-file-name) (nntp-possibly-create-directory group server) (nntp-open-marks group server) (dolist (action actions) @@ -1136,7 +1130,8 @@ command whose response triggered the error." nil) (deffoo nntp-request-update-info (group info &optional server) - (unless nntp-marks-is-evil + (when (and (not nntp-marks-is-evil) + nntp-marks-file-name) (nntp-possibly-create-directory group server) (when (nntp-marks-changed-p group server) (nnheader-message 8 "Updating marks for %s..." group) @@ -1368,17 +1363,7 @@ password contained in '~/.nntp-authinfo'." nntp-process-decode decode nntp-process-callback callback nntp-process-start-point (point-max)) - (setq after-change-functions '(nntp-after-change-function)) - (if nntp-async-needs-kluge - (nntp-async-kluge process)))) - -(defun nntp-async-kluge (process) - ;; emacs 20.3 bug: process output with encoding 'binary - ;; doesn't trigger after-change-functions. - (unless nntp-async-timer - (setq nntp-async-timer - (run-at-time 1 1 'nntp-async-timer-handler))) - (add-to-list 'nntp-async-process-list process)) + (setq after-change-functions '(nntp-after-change-function)))) (defun nntp-async-timer-handler () (mapcar @@ -1783,7 +1768,7 @@ password contained in '~/.nntp-authinfo'." (while (and (setq proc (get-buffer-process buf)) (memq (process-status proc) '(open run)) (not (re-search-forward regexp nil t))) - (accept-process-output proc) + (accept-process-output proc 0.1) (set-buffer buf) (goto-char (point-min))))) @@ -2028,7 +2013,7 @@ Please refer to the following variables to customize the connection: (and nntp-pre-command (push nntp-pre-command command)) (let ((process-connection-type nil)) ;See `nntp-open-via-rlogin-and-netcat'. (apply 'start-process "nntpd" buffer command)))) - + (defun nntp-open-via-telnet-and-telnet (buffer) "Open a connection to an nntp server through an intermediate host. @@ -2195,5 +2180,4 @@ Please refer to the following variables to customize the connection: (provide 'nntp) -;; arch-tag: 8655466a-b1b5-4929-9c45-7b1b2e767271 ;;; nntp.el ends here diff --git a/lisp/gnus/nnultimate.el b/lisp/gnus/nnultimate.el deleted file mode 100644 index e65d30f2758..00000000000 --- a/lisp/gnus/nnultimate.el +++ /dev/null @@ -1,480 +0,0 @@ -;;; nnultimate.el --- interfacing with the Ultimate Bulletin Board system - -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Note: You need to have `url' and `w3' installed for this -;; backend to work. - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'nnoo) -(require 'message) -(require 'gnus-util) -(require 'gnus) -(require 'nnmail) -(require 'mm-util) -(require 'mm-url) -(require 'nnweb) -(require 'parse-time) -(autoload 'w3-parse-buffer "w3-parse") - -(nnoo-declare nnultimate) - -(defvoo nnultimate-directory (nnheader-concat gnus-directory "ultimate/") - "Where nnultimate will save its files.") - -(defvoo nnultimate-address "" - "The address of the Ultimate bulletin board.") - -;;; Internal variables - -(defvar nnultimate-groups-alist nil) -(defvoo nnultimate-groups nil) -(defvoo nnultimate-headers nil) -(defvoo nnultimate-articles nil) -(defvar nnultimate-table-regexp - "postings.*editpost\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio") - -;;; Interface functions - -(nnoo-define-basics nnultimate) - -(deffoo nnultimate-retrieve-headers (articles &optional group server fetch-old) - (nnultimate-possibly-change-server group server) - (unless gnus-nov-is-evil - (let* ((last (car (last articles))) - (did nil) - (start 1) - (entry (assoc group nnultimate-groups)) - (sid (nth 2 entry)) - (topics (nth 4 entry)) - (mapping (nth 5 entry)) - (old-total (or (nth 6 entry) 1)) - (furl "forumdisplay.cgi?action=topics&number=%d&DaysPrune=1000") - (furls (list (concat nnultimate-address (format furl sid)))) - (nnultimate-table-regexp - "postings.*editpost\\|forumdisplay\\|getbio") - headers article subject score from date lines parent point - contents tinfo fetchers map elem a href garticles topic old-max - inc datel table current-page total-contents pages - farticles forum-contents parse furl-fetched mmap farticle) - (setq map mapping) - (while (and (setq article (car articles)) - map) - ;; Skip past the articles in the map until we reach the - ;; article we're looking for. - (while (and map - (or (> article (caar map)) - (< (cadar map) (caar map)))) - (pop map)) - (when (setq mmap (car map)) - (setq farticle -1) - (while (and article - (<= article (nth 1 mmap))) - ;; Do we already have a fetcher for this topic? - (if (setq elem (assq (nth 2 mmap) fetchers)) - ;; Yes, so we just add the spec to the end. - (nconc elem (list (cons article - (+ (nth 3 mmap) (incf farticle))))) - ;; No, so we add a new one. - (push (list (nth 2 mmap) - (cons article - (+ (nth 3 mmap) (incf farticle)))) - fetchers)) - (pop articles) - (setq article (car articles))))) - ;; Now we have the mapping from/to Gnus/nnultimate article numbers, - ;; so we start fetching the topics that we need to satisfy the - ;; request. - (if (not fetchers) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer)) - (setq nnultimate-articles nil) - (mm-with-unibyte-buffer - (dolist (elem fetchers) - (setq pages 1 - current-page 1 - total-contents nil) - (while (<= current-page pages) - (erase-buffer) - (setq subject (nth 2 (assq (car elem) topics))) - (setq href (nth 3 (assq (car elem) topics))) - (if (= current-page 1) - (mm-url-insert href) - (string-match "\\.html$" href) - (mm-url-insert (concat (substring href 0 (match-beginning 0)) - "-" (number-to-string current-page) - (match-string 0 href)))) - (goto-char (point-min)) - (setq contents - (ignore-errors (w3-parse-buffer (current-buffer)))) - (setq table (nnultimate-find-forum-table contents)) - (goto-char (point-min)) - (when (re-search-forward "topic is \\([0-9]+\\) pages" nil t) - (setq pages (string-to-number (match-string 1)))) - (setq contents (cdr (nth 2 (car (nth 2 table))))) - (setq total-contents (nconc total-contents contents)) - (incf current-page)) - (when t - (let ((i 0)) - (dolist (co total-contents) - (push (list (or (nnultimate-topic-article-to-article - group (car elem) (incf i)) - 1) - co subject) - nnultimate-articles)))) - (when nil - (dolist (art (cdr elem)) - (when (nth (1- (cdr art)) total-contents) - (push (list (car art) - (nth (1- (cdr art)) total-contents) - subject) - nnultimate-articles)))))) - (setq nnultimate-articles - (sort nnultimate-articles 'car-less-than-car)) - ;; Now we have all the articles, conveniently in an alist - ;; where the key is the Gnus article number. - (dolist (articlef nnultimate-articles) - (setq article (nth 0 articlef) - contents (nth 1 articlef) - subject (nth 2 articlef)) - (setq from (mapconcat 'identity - (nnweb-text (car (nth 2 contents))) - " ") - datel (nnweb-text (nth 2 (car (cdr (nth 2 contents)))))) - (while datel - (when (string-match "Posted" (car datel)) - (setq date (substring (car datel) (match-end 0)) - datel nil)) - (pop datel)) - (when date - (setq date (delete "" (split-string date "[-, \n\t\r ]"))) - (setq date - (if (or (member "AM" date) - (member "PM" date)) - (format - "%s %s %s %s" - (nth 1 date) - (if (and (>= (length (nth 0 date)) 3) - (assoc (downcase - (substring (nth 0 date) 0 3)) - parse-time-months)) - (substring (nth 0 date) 0 3) - (car (rassq (string-to-number (nth 0 date)) - parse-time-months))) - (nth 2 date) (nth 3 date)) - (format "%s %s %s %s" - (car (rassq (string-to-number (nth 1 date)) - parse-time-months)) - (nth 0 date) (nth 2 date) (nth 3 date))))) - (push - (cons - article - (make-full-mail-header - article subject - from (or date "") - (concat "<" (number-to-string sid) "%" - (number-to-string article) - "@ultimate." server ">") - "" 0 - (/ (length (mapconcat - 'identity - (nnweb-text - (cdr (nth 2 (nth 1 (nth 2 contents))))) - "")) - 70) - nil nil)) - headers)) - (setq nnultimate-headers (sort headers 'car-less-than-car)) - (save-excursion - (set-buffer nntp-server-buffer) - (mm-with-unibyte-current-buffer - (erase-buffer) - (dolist (header nnultimate-headers) - (nnheader-insert-nov (cdr header)))))) - 'nov))) - -(defun nnultimate-topic-article-to-article (group topic article) - (catch 'found - (dolist (elem (nth 5 (assoc group nnultimate-groups))) - (when (and (= topic (nth 2 elem)) - (>= article (nth 3 elem)) - (< article (+ (- (nth 1 elem) (nth 0 elem)) 1 - (nth 3 elem)))) - (throw 'found - (+ (nth 0 elem) (- article (nth 3 elem)))))))) - -(deffoo nnultimate-request-group (group &optional server dont-check) - (nnultimate-possibly-change-server nil server) - (when (not nnultimate-groups) - (nnultimate-request-list)) - (unless dont-check - (nnultimate-create-mapping group)) - (let ((elem (assoc group nnultimate-groups))) - (cond - ((not elem) - (nnheader-report 'nnultimate "Group does not exist")) - (t - (nnheader-report 'nnultimate "Opened group %s" group) - (nnheader-insert - "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem) - (prin1-to-string group)))))) - -(deffoo nnultimate-request-close () - (setq nnultimate-groups-alist nil - nnultimate-groups nil)) - -(deffoo nnultimate-request-article (article &optional group server buffer) - (nnultimate-possibly-change-server group server) - (let ((contents (cdr (assq article nnultimate-articles)))) - (setq contents (cddr (nth 2 (nth 1 (nth 2 (car contents)))))) - (when contents - (save-excursion - (set-buffer (or buffer nntp-server-buffer)) - (erase-buffer) - (nnweb-insert-html (cons 'p (cons nil (list contents)))) - (goto-char (point-min)) - (insert "Content-Type: text/html\nMIME-Version: 1.0\n") - (let ((header (cdr (assq article nnultimate-headers)))) - (mm-with-unibyte-current-buffer - (nnheader-insert-header header))) - (nnheader-report 'nnultimate "Fetched article %s" article) - (cons group article))))) - -(deffoo nnultimate-request-list (&optional server) - (nnultimate-possibly-change-server nil server) - (mm-with-unibyte-buffer - (mm-url-insert - (if (string-match "/$" nnultimate-address) - (concat nnultimate-address "Ultimate.cgi") - nnultimate-address)) - (let ((contents (nth 2 (car (nth 2 - (nnultimate-find-forum-table - (w3-parse-buffer (current-buffer))))))) - sid elem description articles a href group forum - a1 a2) - (dolist (row contents) - (setq row (nth 2 row)) - (when (setq a (nnweb-parse-find 'a row)) - (setq group (car (last (nnweb-text a))) - href (cdr (assq 'href (nth 1 a)))) - (setq description (car (last (nnweb-text (nth 1 row))))) - (setq a1 (car (last (nnweb-text (nth 2 row))))) - (setq a2 (car (last (nnweb-text (nth 3 row))))) - (when (string-match "^[0-9]+$" a1) - (setq articles (string-to-number a1))) - (when (and a2 (string-match "^[0-9]+$" a2)) - (setq articles (max articles (string-to-number a2)))) - (when href - (string-match "number=\\([0-9]+\\)" href) - (setq forum (string-to-number (match-string 1 href))) - (if (setq elem (assoc group nnultimate-groups)) - (setcar (cdr elem) articles) - (push (list group articles forum description nil nil nil nil) - nnultimate-groups)))))) - (nnultimate-write-groups) - (nnultimate-generate-active) - t)) - -(deffoo nnultimate-request-newgroups (date &optional server) - (nnultimate-possibly-change-server nil server) - (nnultimate-generate-active) - t) - -(nnoo-define-skeleton nnultimate) - -;;; Internal functions - -(defun nnultimate-prune-days (group time) - "Compute the number of days to fetch info for." - (let ((old-time (nth 7 (assoc group nnultimate-groups)))) - (if (null old-time) - 1000 - (- (time-to-days time) (time-to-days old-time))))) - -(defun nnultimate-create-mapping (group) - (let* ((entry (assoc group nnultimate-groups)) - (sid (nth 2 entry)) - (topics (nth 4 entry)) - (mapping (nth 5 entry)) - (old-total (or (nth 6 entry) 1)) - (current-time (current-time)) - (furl - (concat "forumdisplay.cgi?action=topics&number=%d&DaysPrune=" - (number-to-string - (nnultimate-prune-days group current-time)))) - (furls (list (concat nnultimate-address (format furl sid)))) - contents forum-contents furl-fetched a subject href - garticles topic tinfo old-max inc parse) - (mm-with-unibyte-buffer - (while furls - (erase-buffer) - (mm-url-insert (pop furls)) - (goto-char (point-min)) - (setq parse (w3-parse-buffer (current-buffer))) - (setq contents - (cdr (nth 2 (car (nth 2 (nnultimate-find-forum-table - parse)))))) - (setq forum-contents (nconc contents forum-contents)) - (unless furl-fetched - (setq furl-fetched t) - ;; On the first time through this loop, we find all the - ;; forum URLs. - (dolist (a (nnweb-parse-find-all 'a parse)) - (let ((href (cdr (assq 'href (nth 1 a))))) - (when (and href - (string-match "forumdisplay.*startpoint" href)) - (push href furls)))) - (setq furls (nreverse furls)))) - ;; The main idea here is to map Gnus article numbers to - ;; nnultimate article numbers. Say there are three topics in - ;; this forum, the first with 4 articles, the seconds with 2, - ;; and the third with 1. Then this will translate into 7 Gnus - ;; article numbers, where 1-4 comes from the first topic, 5-6 - ;; from the second and 7 from the third. Now, then next time - ;; the group is entered, there's 2 new articles in topic one - ;; and 1 in topic three. Then Gnus article number 8-9 be 5-6 - ;; in topic one and 10 will be the 2 in topic three. - (dolist (row (nreverse forum-contents)) - (setq row (nth 2 row)) - (when (setq a (nnweb-parse-find 'a row)) - (setq subject (car (last (nnweb-text a))) - href (cdr (assq 'href (nth 1 a)))) - (let ((artlist (nreverse (nnweb-text row))) - art) - (while (and (not art) - artlist) - (when (string-match "^[0-9]+$" (car artlist)) - (setq art (1+ (string-to-number (car artlist))))) - (pop artlist)) - (setq garticles art)) - (when garticles - (string-match "/\\([0-9]+\\).html" href) - (setq topic (string-to-number (match-string 1 href))) - (if (setq tinfo (assq topic topics)) - (progn - (setq old-max (cadr tinfo)) - (setcar (cdr tinfo) garticles)) - (setq old-max 0) - (push (list topic garticles subject href) topics) - (setcar (nthcdr 4 entry) topics)) - (when (not (= old-max garticles)) - (setq inc (- garticles old-max)) - (setq mapping (nconc mapping - (list - (list - old-total (1- (incf old-total inc)) - topic (1+ old-max))))) - (incf old-max inc) - (setcar (nthcdr 5 entry) mapping) - (setcar (nthcdr 6 entry) old-total)))))) - (setcar (nthcdr 7 entry) current-time) - (setcar (nthcdr 1 entry) (1- old-total)) - (nnultimate-write-groups) - mapping)) - -(defun nnultimate-possibly-change-server (&optional group server) - (nnultimate-init server) - (when (and server - (not (nnultimate-server-opened server))) - (nnultimate-open-server server)) - (unless nnultimate-groups-alist - (nnultimate-read-groups) - (setq nnultimate-groups (cdr (assoc nnultimate-address - nnultimate-groups-alist))))) - -(deffoo nnultimate-open-server (server &optional defs connectionless) - (nnheader-init-server-buffer) - (if (nnultimate-server-opened server) - t - (unless (assq 'nnultimate-address defs) - (setq defs (append defs (list (list 'nnultimate-address server))))) - (nnoo-change-server 'nnultimate server defs))) - -(defun nnultimate-read-groups () - (setq nnultimate-groups-alist nil) - (let ((file (expand-file-name "groups" nnultimate-directory))) - (when (file-exists-p file) - (mm-with-unibyte-buffer - (insert-file-contents file) - (goto-char (point-min)) - (setq nnultimate-groups-alist (read (current-buffer))))))) - -(defun nnultimate-write-groups () - (setq nnultimate-groups-alist - (delq (assoc nnultimate-address nnultimate-groups-alist) - nnultimate-groups-alist)) - (push (cons nnultimate-address nnultimate-groups) - nnultimate-groups-alist) - (with-temp-file (expand-file-name "groups" nnultimate-directory) - (prin1 nnultimate-groups-alist (current-buffer)))) - -(defun nnultimate-init (server) - "Initialize buffers and such." - (unless (file-exists-p nnultimate-directory) - (gnus-make-directory nnultimate-directory))) - -(defun nnultimate-generate-active () - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (dolist (elem nnultimate-groups) - (insert (prin1-to-string (car elem)) - " " (number-to-string (cadr elem)) " 1 y\n")))) - -(defun nnultimate-find-forum-table (contents) - (catch 'found - (nnultimate-find-forum-table-1 contents))) - -(defun nnultimate-find-forum-table-1 (contents) - (dolist (element contents) - (unless (stringp element) - (when (and (eq (car element) 'table) - (nnultimate-forum-table-p element)) - (throw 'found element)) - (when (nth 2 element) - (nnultimate-find-forum-table-1 (nth 2 element)))))) - -(defun nnultimate-forum-table-p (parse) - (when (not (apply 'gnus-or - (mapcar - (lambda (p) - (nnweb-parse-find 'table p)) - (nth 2 parse)))) - (let ((href (cdr (assq 'href (nth 1 (nnweb-parse-find 'a parse 20))))) - case-fold-search) - (when (and href (string-match nnultimate-table-regexp href)) - t)))) - -(provide 'nnultimate) - -;; Local Variables: -;; coding: iso-8859-1 -;; End: - -;; arch-tag: ab6bfc45-8fe1-4647-9c78-41050eb152b8 -;;; nnultimate.el ends here diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el index 87cfd14d821..c94d1837fa9 100644 --- a/lisp/gnus/nnvirtual.el +++ b/lisp/gnus/nnvirtual.el @@ -260,13 +260,11 @@ component group will show up when you enter the virtual group.") (nnheader-report 'nnvirtual "No component groups in %s" group)) (t (setq nnvirtual-current-group group) - (when (or (not dont-check) - nnvirtual-always-rescan) - (nnvirtual-create-mapping) - (when nnvirtual-always-rescan - (nnvirtual-request-update-info - (nnvirtual-current-group) - (gnus-get-info (nnvirtual-current-group))))) + (nnvirtual-create-mapping dont-check) + (when nnvirtual-always-rescan + (nnvirtual-request-update-info + (nnvirtual-current-group) + (gnus-get-info (nnvirtual-current-group)))) (nnheader-insert "211 %d 1 %d %s\n" nnvirtual-mapping-len nnvirtual-mapping-len group)))) @@ -300,10 +298,6 @@ component group will show up when you enter the virtual group.") 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.")) @@ -674,7 +668,7 @@ the result." carticles)) -(defun nnvirtual-create-mapping () +(defun nnvirtual-create-mapping (dont-check) "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." @@ -693,7 +687,9 @@ based on the marks on the component groups." ;; 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) + (setq active (or (and dont-check + (gnus-active g)) + (gnus-activate-group g)) min (car active) max (cdr active)) (when (and active (>= max min) (not (zerop max))) @@ -809,5 +805,4 @@ based on the marks on the component groups." (provide 'nnvirtual) -;; arch-tag: ca8c8ad9-1bd8-4b0f-9722-90dc645a45f5 ;;; nnvirtual.el ends here diff --git a/lisp/gnus/nnwarchive.el b/lisp/gnus/nnwarchive.el deleted file mode 100644 index 9b4e804d48f..00000000000 --- a/lisp/gnus/nnwarchive.el +++ /dev/null @@ -1,727 +0,0 @@ -;;; nnwarchive.el --- interfacing with web archives - -;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Shenghuo Zhu <zsh@cs.rochester.edu> -;; Keywords: news egroups mail-archive - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Note: You need to have `url' (w3 0.46) or greater version -;; installed for some functions of this backend to work. - -;; Todo: -;; 1. To support more web archives. -;; 2. Generalize webmail to other MHonArc archive. - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'nnoo) -(require 'message) -(require 'gnus-util) -(require 'gnus) -(require 'gnus-bcklg) -(require 'nnmail) -(require 'mm-util) -(require 'mm-url) - -(nnoo-declare nnwarchive) - -(defvar nnwarchive-type-definition - '((egroups - (address . "www.egroups.com") - (open-url - "http://www.egroups.com/login.cgi?&login_email=%s&login_password=%s" - nnwarchive-login nnwarchive-passwd) - (list-url - "http://www.egroups.com/mygroups") - (list-dissect . nnwarchive-egroups-list) - (list-groups . nnwarchive-egroups-list-groups) - (xover-url - "http://www.egroups.com/messages/%s/%d" group aux) - (xover-last-url - "http://www.egroups.com/messages/%s/" group) - (xover-page-size . 13) - (xover-dissect . nnwarchive-egroups-xover) - (article-url - "http://www.egroups.com/message/%s/%d?source=1" group article) - (article-dissect . nnwarchive-egroups-article) - (authentication . t) - (article-offset . 0) - (xover-files . nnwarchive-egroups-xover-files)) - (mail-archive - (address . "www.mail-archive.com") - (open-url) - (list-url - "http://www.mail-archive.com/lists.html") - (list-dissect . nnwarchive-mail-archive-list) - (list-groups . nnwarchive-mail-archive-list-groups) - (xover-url - "http://www.mail-archive.com/%s/mail%d.html" group aux) - (xover-last-url - "http://www.mail-archive.com/%s/maillist.html" group) - (xover-page-size) - (xover-dissect . nnwarchive-mail-archive-xover) - (article-url - "http://www.mail-archive.com/%s/msg%05d.html" group article1) - (article-dissect . nnwarchive-mail-archive-article) - (xover-files . nnwarchive-mail-archive-xover-files) - (authentication) - (article-offset . 1)))) - -(defvar nnwarchive-default-type 'egroups) - -(defvoo nnwarchive-directory (nnheader-concat gnus-directory "warchive/") - "Where nnwarchive will save its files.") - -(defvoo nnwarchive-type nil - "The type of nnwarchive.") - -(defvoo nnwarchive-address "" - "The address of nnwarchive.") - -(defvoo nnwarchive-login nil - "Your login name for the group.") - -(defvoo nnwarchive-passwd nil - "Your password for the group.") - -(defvoo nnwarchive-groups nil) - -(defvoo nnwarchive-headers-cache nil) - -(defvoo nnwarchive-authentication nil) - -(defvoo nnwarchive-nov-is-evil nil) - -(defconst nnwarchive-version "nnwarchive 1.0") - -;;; Internal variables - -(defvoo nnwarchive-open-url nil) -(defvoo nnwarchive-open-dissect nil) - -(defvoo nnwarchive-list-url nil) -(defvoo nnwarchive-list-dissect nil) -(defvoo nnwarchive-list-groups nil) - -(defvoo nnwarchive-xover-files nil) -(defvoo nnwarchive-xover-url nil) -(defvoo nnwarchive-xover-last-url nil) -(defvoo nnwarchive-xover-dissect nil) -(defvoo nnwarchive-xover-page-size nil) - -(defvoo nnwarchive-article-url nil) -(defvoo nnwarchive-article-dissect nil) -(defvoo nnwarchive-xover-files nil) -(defvoo nnwarchive-article-offset 0) - -(defvoo nnwarchive-buffer nil) - -(defvoo nnwarchive-keep-backlog 300) -(defvar nnwarchive-backlog-articles nil) -(defvar nnwarchive-backlog-hashtb nil) - -(defvoo nnwarchive-headers nil) - - -;;; Interface functions - -(nnoo-define-basics nnwarchive) - -(defun nnwarchive-set-default (type) - (let ((defs (cdr (assq type nnwarchive-type-definition))) - def) - (dolist (def defs) - (set (intern (concat "nnwarchive-" (symbol-name (car def)))) - (cdr def))))) - -(defmacro nnwarchive-backlog (&rest form) - `(let ((gnus-keep-backlog nnwarchive-keep-backlog) - (gnus-backlog-buffer - (format " *nnwarchive backlog %s*" nnwarchive-address)) - (gnus-backlog-articles nnwarchive-backlog-articles) - (gnus-backlog-hashtb nnwarchive-backlog-hashtb)) - (unwind-protect - (progn ,@form) - (setq nnwarchive-backlog-articles gnus-backlog-articles - nnwarchive-backlog-hashtb gnus-backlog-hashtb)))) -(put 'nnwarchive-backlog 'lisp-indent-function 0) -(put 'nnwarchive-backlog 'edebug-form-spec '(form body)) - -(defun nnwarchive-backlog-enter-article (group number buffer) - (nnwarchive-backlog - (gnus-backlog-enter-article group number buffer))) - -(defun nnwarchive-get-article (article &optional group server buffer) - (if (numberp article) - (if (nnwarchive-backlog - (gnus-backlog-request-article group article - (or buffer nntp-server-buffer))) - (cons group article) - (let (contents) - (save-excursion - (set-buffer nnwarchive-buffer) - (goto-char (point-min)) - (let ((article1 (- article nnwarchive-article-offset))) - (nnwarchive-url nnwarchive-article-url)) - (setq contents (funcall nnwarchive-article-dissect group article))) - (when contents - (save-excursion - (set-buffer (or buffer nntp-server-buffer)) - (erase-buffer) - (insert contents) - (nnwarchive-backlog-enter-article group article (current-buffer)) - (nnheader-report 'nnwarchive "Fetched article %s" article) - (cons group article))))) - nil)) - -(deffoo nnwarchive-retrieve-headers (articles &optional group server fetch-old) - (nnwarchive-possibly-change-server group server) - (if (or gnus-nov-is-evil nnwarchive-nov-is-evil) - (with-temp-buffer - (with-current-buffer nntp-server-buffer - (erase-buffer)) - (let ((buf (current-buffer)) b e) - (dolist (art articles) - (nnwarchive-get-article art group server buf) - (setq b (goto-char (point-min))) - (if (search-forward "\n\n" nil t) - (forward-char -1) - (goto-char (point-max))) - (setq e (point)) - (with-current-buffer nntp-server-buffer - (insert (format "221 %d Article retrieved.\n" art)) - (insert-buffer-substring buf b e) - (insert ".\n")))) - 'headers) - (setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache))) - (save-excursion - (set-buffer nnwarchive-buffer) - (erase-buffer) - (funcall nnwarchive-xover-files group articles)) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (let (header) - (dolist (art articles) - (if (setq header (assq art nnwarchive-headers)) - (nnheader-insert-nov (cdr header)))))) - (let ((elem (assoc group nnwarchive-headers-cache))) - (if elem - (setcdr elem nnwarchive-headers) - (push (cons group nnwarchive-headers) nnwarchive-headers-cache))) - 'nov)) - -(deffoo nnwarchive-request-group (group &optional server dont-check) - (nnwarchive-possibly-change-server nil server) - (when (and (not dont-check) nnwarchive-list-groups) - (funcall nnwarchive-list-groups (list group)) - (nnwarchive-write-groups)) - (let ((elem (assoc group nnwarchive-groups))) - (cond - ((not elem) - (nnheader-report 'nnwarchive "Group does not exist")) - (t - (nnheader-report 'nnwarchive "Opened group %s" group) - (nnheader-insert - "211 %d %d %d %s\n" (or (cadr elem) 0) 1 (or (cadr elem) 0) - (prin1-to-string group)) - t)))) - -(deffoo nnwarchive-request-article (article &optional group server buffer) - (nnwarchive-possibly-change-server group server) - (nnwarchive-get-article article group server buffer)) - -(deffoo nnwarchive-close-server (&optional server) - (when (and (nnwarchive-server-opened server) - (gnus-buffer-live-p nnwarchive-buffer)) - (save-excursion - (set-buffer nnwarchive-buffer) - (kill-buffer nnwarchive-buffer))) - (nnwarchive-backlog - (gnus-backlog-shutdown)) - (nnoo-close-server 'nnwarchive server)) - -(deffoo nnwarchive-request-list (&optional server) - (nnwarchive-possibly-change-server nil server) - (save-excursion - (set-buffer nnwarchive-buffer) - (erase-buffer) - (if nnwarchive-list-url - (nnwarchive-url nnwarchive-list-url)) - (if nnwarchive-list-dissect - (funcall nnwarchive-list-dissect)) - (nnwarchive-write-groups) - (nnwarchive-generate-active)) - t) - -(deffoo nnwarchive-open-server (server &optional defs connectionless) - (nnoo-change-server 'nnwarchive server defs) - (nnwarchive-init server) - (when nnwarchive-authentication - (setq nnwarchive-login - (or nnwarchive-login - (read-string - (format "Login at %s: " server) - user-mail-address))) - (setq nnwarchive-passwd - (or nnwarchive-passwd - (read-passwd - (format "Password for %s at %s: " - nnwarchive-login server))))) - (unless nnwarchive-groups - (nnwarchive-read-groups)) - (save-excursion - (set-buffer nnwarchive-buffer) - (erase-buffer) - (if nnwarchive-open-url - (nnwarchive-url nnwarchive-open-url)) - (if nnwarchive-open-dissect - (funcall nnwarchive-open-dissect))) - t) - -(nnoo-define-skeleton nnwarchive) - -;;; Internal functions - -(defun nnwarchive-possibly-change-server (&optional group server) - (nnwarchive-init server) - (when (and server - (not (nnwarchive-server-opened server))) - (nnwarchive-open-server server))) - -(defun nnwarchive-read-groups () - (let ((file (expand-file-name (concat "groups-" nnwarchive-address) - nnwarchive-directory))) - (when (file-exists-p file) - (with-temp-buffer - (insert-file-contents file) - (goto-char (point-min)) - (setq nnwarchive-groups (read (current-buffer))))))) - -(defun nnwarchive-write-groups () - (with-temp-file (expand-file-name (concat "groups-" nnwarchive-address) - nnwarchive-directory) - (prin1 nnwarchive-groups (current-buffer)))) - -(defun nnwarchive-init (server) - "Initialize buffers and such." - (let ((type (intern server)) (defs nnwarchive-type-definition) def) - (cond - ((equal server "") - (setq type nnwarchive-default-type)) - ((assq type nnwarchive-type-definition) t) - (t - (setq type nil) - (while (setq def (pop defs)) - (when (equal (cdr (assq 'address (cdr def))) server) - (setq defs nil) - (setq type (car def)))) - (unless type - (error "Undefined server %s" server)))) - (setq nnwarchive-type type)) - (unless (file-exists-p nnwarchive-directory) - (gnus-make-directory nnwarchive-directory)) - (unless (gnus-buffer-live-p nnwarchive-buffer) - (setq nnwarchive-buffer - (save-excursion - (nnheader-set-temp-buffer - (format " *nnwarchive %s %s*" nnwarchive-type server))))) - (nnwarchive-set-default nnwarchive-type)) - -(defun nnwarchive-eval (expr) - (cond - ((consp expr) - (cons (nnwarchive-eval (car expr)) (nnwarchive-eval (cdr expr)))) - ((symbolp expr) - (eval expr)) - (t - expr))) - -(defun nnwarchive-url (xurl) - (mm-with-unibyte-current-buffer - (let ((url-confirmation-func 'identity) ;; Some hacks. - (url-cookie-multiple-line nil)) - (cond - ((eq (car xurl) 'post) - (pop xurl) - (mm-url-fetch-form (car xurl) (nnwarchive-eval (cdr xurl)))) - (t - (mm-url-insert (apply 'format (nnwarchive-eval xurl)))))))) - -(defun nnwarchive-generate-active () - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (dolist (elem nnwarchive-groups) - (insert (prin1-to-string (car elem)) - " " (number-to-string (or (cadr elem) 0)) " 1 y\n")))) - -(defun nnwarchive-paged (articles) - (let (art narts next) - (while (setq art (pop articles)) - (when (and (>= art (or next 0)) - (not (assq art nnwarchive-headers))) - (push art narts) - (setq next (+ art nnwarchive-xover-page-size)))) - narts)) - -;; egroups - -(defun nnwarchive-egroups-list-groups (groups) - (save-excursion - (let (articles) - (set-buffer nnwarchive-buffer) - (dolist (group groups) - (erase-buffer) - (nnwarchive-url nnwarchive-xover-last-url) - (goto-char (point-min)) - (when (re-search-forward "of \\([0-9]+\\)[ \t\n\r]*</title>" nil t) - (setq articles (string-to-number (match-string 1)))) - (let ((elem (assoc group nnwarchive-groups))) - (if elem - (setcar (cdr elem) articles) - (push (list group articles "") nnwarchive-groups))) - (setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache))) - (nnwarchive-egroups-xover group) - (let ((elem (assoc group nnwarchive-headers-cache))) - (if elem - (setcdr elem nnwarchive-headers) - (push (cons group nnwarchive-headers) nnwarchive-headers-cache))))))) - -(defun nnwarchive-egroups-list () - (let ((case-fold-search t) - group description elem articles) - (goto-char (point-min)) - (while - (re-search-forward "href=\"/group/\\([^/\"\> ]+\\)" nil t) - (setq group (match-string 1) - description (match-string 2)) - (if (setq elem (assoc group nnwarchive-groups)) - (setcar (cdr elem) 0) - (push (list group articles description) nnwarchive-groups)))) - t) - -(defun nnwarchive-egroups-xover (group) - (let (article subject from date) - (goto-char (point-min)) - (while (re-search-forward - "<a href=\"/group/\\([^/]+\\)/\\([0-9]+\\)[^>]+>\\([^<]+\\)<" - nil t) - (setq group (match-string 1) - article (string-to-number (match-string 2)) - subject (match-string 3)) - (forward-line 1) - (unless (assq article nnwarchive-headers) - (if (looking-at "<td[^>]+><font[^>]+>\\([^<]+\\)</font>") - (setq from (match-string 1))) - (forward-line 1) - (if (looking-at "<td[^>]+><font[^>]+>\\([^<]+\\)</font>") - (setq date (identity (match-string 1)))) - (push (cons - article - (make-full-mail-header - article - (mm-url-decode-entities-string subject) - (mm-url-decode-entities-string from) - date - (concat "<" group "%" - (number-to-string article) - "@egroup.com>") - "" - 0 0 "")) nnwarchive-headers)))) - nnwarchive-headers) - -(defun nnwarchive-egroups-article (group articles) - (goto-char (point-min)) - (if (search-forward "<pre>" nil t) - (delete-region (point-min) (point))) - (goto-char (point-max)) - (if (search-backward "</pre>" nil t) - (delete-region (point) (point-max))) - (goto-char (point-min)) - (while (re-search-forward "<a[^>]+>\\([^<]+\\)</a>" nil t) - (replace-match "\\1")) - (mm-url-decode-entities) - (buffer-string)) - -(defun nnwarchive-egroups-xover-files (group articles) - (let (aux auxs) - (setq auxs (nnwarchive-paged (sort articles '<))) - (while (setq aux (pop auxs)) - (goto-char (point-max)) - (nnwarchive-url nnwarchive-xover-url)) - (if nnwarchive-xover-dissect - (nnwarchive-egroups-xover group)))) - -;; mail-archive - -(defun nnwarchive-mail-archive-list-groups (groups) - (save-excursion - (let (articles) - (set-buffer nnwarchive-buffer) - (dolist (group groups) - (erase-buffer) - (nnwarchive-url nnwarchive-xover-last-url) - (goto-char (point-min)) - (when (re-search-forward "msg\\([0-9]+\\)\\.html" nil t) - (setq articles (1+ (string-to-number (match-string 1))))) - (let ((elem (assoc group nnwarchive-groups))) - (if elem - (setcar (cdr elem) articles) - (push (list group articles "") nnwarchive-groups))) - (setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache))) - (nnwarchive-mail-archive-xover group) - (let ((elem (assoc group nnwarchive-headers-cache))) - (if elem - (setcdr elem nnwarchive-headers) - (push (cons group nnwarchive-headers) - nnwarchive-headers-cache))))))) - -(defun nnwarchive-mail-archive-list () - (let ((case-fold-search t) - group description elem articles) - (goto-char (point-min)) - (while (re-search-forward "<a href=\"\\([^/]+\\)/\">\\([^>]+\\)<" nil t) - (setq group (match-string 1) - description (match-string 2)) - (forward-line 1) - (setq articles 0) - (if (setq elem (assoc group nnwarchive-groups)) - (setcar (cdr elem) articles) - (push (list group articles description) nnwarchive-groups)))) - t) - -(defun nnwarchive-mail-archive-xover (group) - (let (article subject from date) - (goto-char (point-min)) - (while (re-search-forward - "<A[^>]*HREF=\"msg\\([0-9]+\\)\\.html[^>]+>\\([^<]+\\)<" - nil t) - (setq article (1+ (string-to-number (match-string 1))) - subject (match-string 2)) - (forward-line 1) - (unless (assq article nnwarchive-headers) - (if (looking-at "<UL><LI><EM>From</EM>: *\\([^<]*[^< ]\\) *<\\([^&]+\\)>") - (progn - (setq from (match-string 1) - date (identity (match-string 2)))) - (setq from "" date "")) - (push (cons - article - (make-full-mail-header - article - (mm-url-decode-entities-string subject) - (mm-url-decode-entities-string from) - date - (format "<%05d%%%s>\n" (1- article) group) - "" - 0 0 "")) nnwarchive-headers)))) - nnwarchive-headers) - -(defun nnwarchive-mail-archive-xover-files (group articles) - (unless nnwarchive-headers - (erase-buffer) - (nnwarchive-url nnwarchive-xover-last-url) - (goto-char (point-min)) - (nnwarchive-mail-archive-xover group)) - (let ((minart (apply 'min articles)) - (min (apply 'min (mapcar 'car nnwarchive-headers))) - (aux 2)) - (while (> min minart) - (erase-buffer) - (nnwarchive-url nnwarchive-xover-url) - (nnwarchive-mail-archive-xover group) - (setq min (apply 'min (mapcar 'car nnwarchive-headers)))))) - -(defvar nnwarchive-caesar-translation-table nil - "Modified rot13 table. tr/@A-Z[a-z/N-Z[@A-Mn-za-m/.") - -(defun nnwarchive-make-caesar-translation-table () - "Create modified rot13 table. tr/@A-Z[a-z/N-Z[@A-Mn-za-m/." - (let ((i -1) - (table (make-string 256 0)) - (a (mm-char-int ?a)) - (A (mm-char-int ?A))) - (while (< (incf i) 256) - (aset table i i)) - (concat - (substring table 0 (1- A)) - (substring table (+ A 13) (+ A 27)) - (substring table (1- A) (+ A 13)) - (substring table (+ A 27) a) - (substring table (+ a 13) (+ a 26)) - (substring table a (+ a 13)) - (substring table (+ a 26) 255)))) - -(defun nnwarchive-from-r13 (from-r13) - (when from-r13 - (with-temp-buffer - (insert from-r13) - (let ((message-caesar-translation-table - (or nnwarchive-caesar-translation-table - (setq nnwarchive-caesar-translation-table - (nnwarchive-make-caesar-translation-table))))) - (message-caesar-region (point-min) (point-max)) - (buffer-string))))) - -(defun nnwarchive-mail-archive-article (group article) - (let (p refs url mime e - from subject date id - done - (case-fold-search t)) - (save-restriction - (goto-char (point-min)) - (when (search-forward "X-Head-End" nil t) - (beginning-of-line) - (narrow-to-region (point-min) (point)) - (mm-url-decode-entities) - (goto-char (point-min)) - (while (search-forward "<!--X-" nil t) - (replace-match "")) - (goto-char (point-min)) - (while (search-forward " -->" nil t) - (replace-match "")) - (setq from - (or (mail-fetch-field "from") - (nnwarchive-from-r13 - (mail-fetch-field "from-r13")))) - (setq date (mail-fetch-field "date")) - (setq id (mail-fetch-field "message-id")) - (setq subject (mail-fetch-field "subject")) - (goto-char (point-max)) - (widen)) - (when (search-forward "<ul>" nil t) - (forward-line) - (delete-region (point-min) (point)) - (search-forward "</ul>" nil t) - (end-of-line) - (narrow-to-region (point-min) (point)) - (mm-url-remove-markup) - (mm-url-decode-entities) - (goto-char (point-min)) - (delete-blank-lines) - (when from - (message-remove-header "from") - (goto-char (point-max)) - (insert "From: " from "\n")) - (when subject - (message-remove-header "subject") - (goto-char (point-max)) - (insert "Subject: " subject "\n")) - (when id - (goto-char (point-max)) - (insert "X-Message-ID: <" id ">\n")) - (when date - (message-remove-header "date") - (goto-char (point-max)) - (insert "Date: " date "\n")) - (goto-char (point-max)) - (widen) - (insert "\n")) - (setq p (point)) - (when (search-forward "X-Body-of-Message" nil t) - (forward-line) - (delete-region p (point)) - (search-forward "X-Body-of-Message-End" nil t) - (beginning-of-line) - (save-restriction - (narrow-to-region p (point)) - (goto-char (point-min)) - (if (> (skip-chars-forward "\040\n\r\t") 0) - (delete-region (point-min) (point))) - (while (not (eobp)) - (cond - ((looking-at "<PRE>\r?\n?") - (delete-region (match-beginning 0) (match-end 0)) - (setq p (point)) - (when (search-forward "</PRE>" nil t) - (delete-region (match-beginning 0) (match-end 0)) - (save-restriction - (narrow-to-region p (point)) - (mm-url-remove-markup) - (mm-url-decode-entities) - (goto-char (point-max))))) - ((looking-at "<P><A HREF=\"\\([^\"]+\\)") - (setq url (match-string 1)) - (delete-region (match-beginning 0) - (progn (forward-line) (point))) - ;; I hate to download the url encode it, then immediately - ;; decode it. - (insert "<#external" - " type=" - (or (and url - (string-match "\\.[^\\.]+$" url) - (mailcap-extension-to-mime - (match-string 0 url))) - "application/octet-stream") - (format " url=\"http://www.mail-archive.com/%s/%s\"" - group url) - ">\n" - "<#/external>") - (setq mime t)) - (t - (setq p (point)) - (insert "<#part type=\"text/html\" disposition=inline>") - (goto-char - (if (re-search-forward - "[\040\n\r\t]*<PRE>\\|[\040\n\r\t]*<P><A HREF=\"" - nil t) - (match-beginning 0) - (point-max))) - (insert "<#/part>") - (setq mime t))) - (setq p (point)) - (if (> (skip-chars-forward "\040\n\r\t") 0) - (delete-region p (point)))) - (goto-char (point-max)))) - (setq p (point)) - (when (search-forward "X-References-End" nil t) - (setq e (point)) - (beginning-of-line) - (search-backward "X-References" p t) - (while (re-search-forward "msg\\([0-9]+\\)\\.html" e t) - (push (concat "<" (match-string 1) "%" group ">") refs))) - (delete-region p (point-max)) - (goto-char (point-min)) - (insert (format "Message-ID: <%05d%%%s>\n" (1- article) group)) - (when refs - (insert "References:") - (while refs - (insert " " (pop refs))) - (insert "\n")) - (when mime - (unless (looking-at "$") - (search-forward "\n\n" nil t) - (forward-line -1)) - (narrow-to-region (point) (point-max)) - (insert "MIME-Version: 1.0\n" - (prog1 - (mml-generate-mime) - (delete-region (point-min) (point-max)))) - (widen))) - (buffer-string))) - -(provide 'nnwarchive) - -;; arch-tag: 1ab7a15c-777a-40e0-95c0-0c41b3963578 -;;; nnwarchive.el ends here diff --git a/lisp/gnus/nnweb.el b/lisp/gnus/nnweb.el index fcb8e93a05d..3b4f71c80aa 100644 --- a/lisp/gnus/nnweb.el +++ b/lisp/gnus/nnweb.el @@ -612,5 +612,4 @@ Valid types include `google', `dejanews', and `gmane'.") (provide 'nnweb) -;; arch-tag: f59307eb-c90f-479f-b7d2-dbd8bf51b697 ;;; nnweb.el ends here diff --git a/lisp/gnus/nnwfm.el b/lisp/gnus/nnwfm.el deleted file mode 100644 index fceb3ccd6ad..00000000000 --- a/lisp/gnus/nnwfm.el +++ /dev/null @@ -1,432 +0,0 @@ -;;; nnwfm.el --- interfacing with a web forum - -;; Copyright (C) 2000, 2002, 2003, 2004, 2005, -;; 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. - -;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> -;; Keywords: news - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Note: You need to have `url' and `w3' installed for this -;; backend to work. - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'nnoo) -(require 'message) -(require 'gnus-util) -(require 'gnus) -(require 'nnmail) -(require 'mm-util) -(require 'mm-url) -(require 'nnweb) -(autoload 'w3-parse-buffer "w3-parse") - -(nnoo-declare nnwfm) - -(defvoo nnwfm-directory (nnheader-concat gnus-directory "wfm/") - "Where nnwfm will save its files.") - -(defvoo nnwfm-address "" - "The address of the Ultimate bulletin board.") - -;;; Internal variables - -(defvar nnwfm-groups-alist nil) -(defvoo nnwfm-groups nil) -(defvoo nnwfm-headers nil) -(defvoo nnwfm-articles nil) -(defvar nnwfm-table-regexp - "postings.*editpost\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio") - -;;; Interface functions - -(nnoo-define-basics nnwfm) - -(deffoo nnwfm-retrieve-headers (articles &optional group server fetch-old) - (nnwfm-possibly-change-server group server) - (unless gnus-nov-is-evil - (let* ((last (car (last articles))) - (did nil) - (start 1) - (entry (assoc group nnwfm-groups)) - (sid (nth 2 entry)) - (topics (nth 4 entry)) - (mapping (nth 5 entry)) - (old-total (or (nth 6 entry) 1)) - (nnwfm-table-regexp "Thread.asp") - headers article subject score from date lines parent point - contents tinfo fetchers map elem a href garticles topic old-max - inc datel table string current-page total-contents pages - farticles forum-contents parse furl-fetched mmap farticle - thread-id tables hstuff bstuff time) - (setq map mapping) - (while (and (setq article (car articles)) - map) - (while (and map - (or (> article (caar map)) - (< (cadar map) (caar map)))) - (pop map)) - (when (setq mmap (car map)) - (setq farticle -1) - (while (and article - (<= article (nth 1 mmap))) - ;; Do we already have a fetcher for this topic? - (if (setq elem (assq (nth 2 mmap) fetchers)) - ;; Yes, so we just add the spec to the end. - (nconc elem (list (cons article - (+ (nth 3 mmap) (incf farticle))))) - ;; No, so we add a new one. - (push (list (nth 2 mmap) - (cons article - (+ (nth 3 mmap) (incf farticle)))) - fetchers)) - (pop articles) - (setq article (car articles))))) - ;; Now we have the mapping from/to Gnus/nnwfm article numbers, - ;; so we start fetching the topics that we need to satisfy the - ;; request. - (if (not fetchers) - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer)) - (setq nnwfm-articles nil) - (mm-with-unibyte-buffer - (dolist (elem fetchers) - (erase-buffer) - (setq subject (nth 2 (assq (car elem) topics)) - thread-id (nth 0 (assq (car elem) topics))) - (mm-url-insert - (concat nnwfm-address - (format "Item.asp?GroupID=%d&ThreadID=%d" sid - thread-id))) - (goto-char (point-min)) - (setq tables (caddar - (caddar - (cdr (caddar - (caddar - (ignore-errors - (w3-parse-buffer (current-buffer))))))))) - (setq tables (cdr (caddar (memq (assq 'div tables) tables)))) - (setq contents nil) - (dolist (table tables) - (when (eq (car table) 'table) - (setq table (caddar (caddar (caddr table))) - hstuff (delete ":link" (nnweb-text (car table))) - bstuff (car (caddar (cdr table))) - from (car hstuff)) - (when (nth 2 hstuff) - (setq time (nnwfm-date-to-time (nth 2 hstuff))) - (push (list from time bstuff) contents)))) - (setq contents (nreverse contents)) - (dolist (art (cdr elem)) - (push (list (car art) - (nth (1- (cdr art)) contents) - subject) - nnwfm-articles)))) - (setq nnwfm-articles - (sort nnwfm-articles 'car-less-than-car)) - ;; Now we have all the articles, conveniently in an alist - ;; where the key is the Gnus article number. - (dolist (articlef nnwfm-articles) - (setq article (nth 0 articlef) - contents (nth 1 articlef) - subject (nth 2 articlef)) - (setq from (nth 0 contents) - date (message-make-date (nth 1 contents))) - (push - (cons - article - (make-full-mail-header - article subject - from (or date "") - (concat "<" (number-to-string sid) "%" - (number-to-string article) - "@wfm>") - "" 0 - (/ (length (mapconcat 'identity (nnweb-text (nth 2 contents)) "")) - 70) - nil nil)) - headers)) - (setq nnwfm-headers (sort headers 'car-less-than-car)) - (save-excursion - (set-buffer nntp-server-buffer) - (mm-with-unibyte-current-buffer - (erase-buffer) - (dolist (header nnwfm-headers) - (nnheader-insert-nov (cdr header)))))) - 'nov))) - -(deffoo nnwfm-request-group (group &optional server dont-check) - (nnwfm-possibly-change-server nil server) - (when (not nnwfm-groups) - (nnwfm-request-list)) - (unless dont-check - (nnwfm-create-mapping group)) - (let ((elem (assoc group nnwfm-groups))) - (cond - ((not elem) - (nnheader-report 'nnwfm "Group does not exist")) - (t - (nnheader-report 'nnwfm "Opened group %s" group) - (nnheader-insert - "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem) - (prin1-to-string group)))))) - -(deffoo nnwfm-request-close () - (setq nnwfm-groups-alist nil - nnwfm-groups nil)) - -(deffoo nnwfm-request-article (article &optional group server buffer) - (nnwfm-possibly-change-server group server) - (let ((contents (cdr (assq article nnwfm-articles)))) - (when (setq contents (nth 2 (car contents))) - (save-excursion - (set-buffer (or buffer nntp-server-buffer)) - (erase-buffer) - (nnweb-insert-html contents) - (goto-char (point-min)) - (insert "Content-Type: text/html\nMIME-Version: 1.0\n") - (let ((header (cdr (assq article nnwfm-headers)))) - (mm-with-unibyte-current-buffer - (nnheader-insert-header header))) - (nnheader-report 'nnwfm "Fetched article %s" article) - (cons group article))))) - -(deffoo nnwfm-request-list (&optional server) - (nnwfm-possibly-change-server nil server) - (mm-with-unibyte-buffer - (mm-url-insert - (if (string-match "/$" nnwfm-address) - (concat nnwfm-address "Group.asp") - nnwfm-address)) - (let* ((nnwfm-table-regexp "Thread.asp") - (contents (w3-parse-buffer (current-buffer))) - sid elem description articles a href group forum - a1 a2) - (dolist (row (cdr (nth 2 (car (nth 2 (nnwfm-find-forum-table - contents)))))) - (setq row (nth 2 row)) - (when (setq a (nnweb-parse-find 'a row)) - (setq group (car (last (nnweb-text a))) - href (cdr (assq 'href (nth 1 a)))) - (setq description (car (last (nnweb-text (nth 1 row))))) - (setq articles - (string-to-number - (gnus-replace-in-string - (car (last (nnweb-text (nth 3 row)))) "," ""))) - (when (and href - (string-match "GroupId=\\([0-9]+\\)" href)) - (setq forum (string-to-number (match-string 1 href))) - (if (setq elem (assoc group nnwfm-groups)) - (setcar (cdr elem) articles) - (push (list group articles forum description nil nil nil nil) - nnwfm-groups)))))) - (nnwfm-write-groups) - (nnwfm-generate-active) - t)) - -(deffoo nnwfm-request-newgroups (date &optional server) - (nnwfm-possibly-change-server nil server) - (nnwfm-generate-active) - t) - -(nnoo-define-skeleton nnwfm) - -;;; Internal functions - -(defun nnwfm-new-threads-p (group time) - "See whether we want to fetch the threads for GROUP written before TIME." - (let ((old-time (nth 7 (assoc group nnwfm-groups)))) - (or (null old-time) - (time-less-p old-time time)))) - -(defun nnwfm-create-mapping (group) - (let* ((entry (assoc group nnwfm-groups)) - (sid (nth 2 entry)) - (topics (nth 4 entry)) - (mapping (nth 5 entry)) - (old-total (or (nth 6 entry) 1)) - (current-time (current-time)) - (nnwfm-table-regexp "Thread.asp") - (furls (list (concat nnwfm-address - (format "Thread.asp?GroupId=%d" sid)))) - fetched-urls - contents forum-contents a subject href - garticles topic tinfo old-max inc parse elem date - url time) - (mm-with-unibyte-buffer - (while furls - (erase-buffer) - (push (car furls) fetched-urls) - (mm-url-insert (pop furls)) - (goto-char (point-min)) - (while (re-search-forward " wr(" nil t) - (forward-char -1) - (setq elem (message-tokenize-header - (gnus-replace-in-string - (buffer-substring - (1+ (point)) - (progn - (forward-sexp 1) - (1- (point)))) - "\\\\[\"\\\\]" ""))) - (push (list - (string-to-number (nth 1 elem)) - (gnus-replace-in-string (nth 2 elem) "\"" "") - (string-to-number (nth 5 elem))) - forum-contents)) - (when (re-search-forward "href=\"\\(Thread.*DateLast=\\([^\"]+\\)\\)" - nil t) - (setq url (match-string 1) - time (nnwfm-date-to-time (gnus-url-unhex-string - (match-string 2)))) - (when (and (nnwfm-new-threads-p group time) - (not (member - (setq url (concat - nnwfm-address - (mm-url-decode-entities-string url))) - fetched-urls))) - (push url furls)))) - ;; The main idea here is to map Gnus article numbers to - ;; nnwfm article numbers. Say there are three topics in - ;; this forum, the first with 4 articles, the seconds with 2, - ;; and the third with 1. Then this will translate into 7 Gnus - ;; article numbers, where 1-4 comes from the first topic, 5-6 - ;; from the second and 7 from the third. Now, then next time - ;; the group is entered, there's 2 new articles in topic one - ;; and 1 in topic three. Then Gnus article number 8-9 be 5-6 - ;; in topic one and 10 will be the 2 in topic three. - (dolist (elem (nreverse forum-contents)) - (setq subject (nth 1 elem) - topic (nth 0 elem) - garticles (nth 2 elem)) - (if (setq tinfo (assq topic topics)) - (progn - (setq old-max (cadr tinfo)) - (setcar (cdr tinfo) garticles)) - (setq old-max 0) - (push (list topic garticles subject) topics) - (setcar (nthcdr 4 entry) topics)) - (when (not (= old-max garticles)) - (setq inc (- garticles old-max)) - (setq mapping (nconc mapping - (list - (list - old-total (1- (incf old-total inc)) - topic (1+ old-max))))) - (incf old-max inc) - (setcar (nthcdr 5 entry) mapping) - (setcar (nthcdr 6 entry) old-total)))) - (setcar (nthcdr 7 entry) current-time) - (setcar (nthcdr 1 entry) (1- old-total)) - (nnwfm-write-groups) - mapping)) - -(defun nnwfm-possibly-change-server (&optional group server) - (nnwfm-init server) - (when (and server - (not (nnwfm-server-opened server))) - (nnwfm-open-server server)) - (unless nnwfm-groups-alist - (nnwfm-read-groups) - (setq nnwfm-groups (cdr (assoc nnwfm-address - nnwfm-groups-alist))))) - -(deffoo nnwfm-open-server (server &optional defs connectionless) - (nnheader-init-server-buffer) - (if (nnwfm-server-opened server) - t - (unless (assq 'nnwfm-address defs) - (setq defs (append defs (list (list 'nnwfm-address server))))) - (nnoo-change-server 'nnwfm server defs))) - -(defun nnwfm-read-groups () - (setq nnwfm-groups-alist nil) - (let ((file (expand-file-name "groups" nnwfm-directory))) - (when (file-exists-p file) - (mm-with-unibyte-buffer - (insert-file-contents file) - (goto-char (point-min)) - (setq nnwfm-groups-alist (read (current-buffer))))))) - -(defun nnwfm-write-groups () - (setq nnwfm-groups-alist - (delq (assoc nnwfm-address nnwfm-groups-alist) - nnwfm-groups-alist)) - (push (cons nnwfm-address nnwfm-groups) - nnwfm-groups-alist) - (with-temp-file (expand-file-name "groups" nnwfm-directory) - (prin1 nnwfm-groups-alist (current-buffer)))) - -(defun nnwfm-init (server) - "Initialize buffers and such." - (unless (file-exists-p nnwfm-directory) - (gnus-make-directory nnwfm-directory))) - -(defun nnwfm-generate-active () - (save-excursion - (set-buffer nntp-server-buffer) - (erase-buffer) - (dolist (elem nnwfm-groups) - (insert (prin1-to-string (car elem)) - " " (number-to-string (cadr elem)) " 1 y\n")))) - -(defun nnwfm-find-forum-table (contents) - (catch 'found - (nnwfm-find-forum-table-1 contents))) - -(defun nnwfm-find-forum-table-1 (contents) - (dolist (element contents) - (unless (stringp element) - (when (and (eq (car element) 'table) - (nnwfm-forum-table-p element)) - (throw 'found element)) - (when (nth 2 element) - (nnwfm-find-forum-table-1 (nth 2 element)))))) - -(defun nnwfm-forum-table-p (parse) - (when (not (apply 'gnus-or - (mapcar - (lambda (p) - (nnweb-parse-find 'table p)) - (nth 2 parse)))) - (let ((href (cdr (assq 'href (nth 1 (nnweb-parse-find 'a parse 20))))) - case-fold-search) - (when (and href (string-match nnwfm-table-regexp href)) - t)))) - -(defun nnwfm-date-to-time (date) - (let ((time (mapcar #'string-to-number (split-string date "[\\.\\+ :]")))) - (encode-time 0 (nth 4 time) (nth 3 time) - (nth 0 time) (nth 1 time) - (if (< (nth 2 time) 70) - (+ 2000 (nth 2 time)) - (+ 1900 (nth 2 time)))))) - -(provide 'nnwfm) - -;; Local Variables: -;; coding: iso-8859-1 -;; End: - -;; arch-tag: d813966a-4211-4557-ad11-d1ac2bc86536 -;;; nnwfm.el ends here diff --git a/lisp/gnus/pop3.el b/lisp/gnus/pop3.el index 20f7ba34b3c..4f28dcdca46 100644 --- a/lisp/gnus/pop3.el +++ b/lisp/gnus/pop3.el @@ -33,6 +33,7 @@ ;;; Code: +(eval-when-compile (require 'cl)) (require 'mail-utils) (defvar parse-time-months) @@ -98,12 +99,6 @@ thing can fall apart and leave you with a corrupt mailbox." :type 'boolean :group 'pop3) -(defcustom pop3-display-message-size-flag t - "*If non-nil, display the size of the message that is being fetched." - :version "22.1" ;; Oort Gnus - :type 'boolean - :group 'pop3) - (defvar pop3-timestamp nil "Timestamp returned when initially connected to the POP server. Used for APOP authentication.") @@ -120,7 +115,7 @@ Used for APOP authentication.") (defalias 'pop3-accept-process-output 'nnheader-accept-process-output) ;; Borrowed from `nnheader.el': (defvar pop3-read-timeout - (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin" + (if (string-match "windows-nt\\|os/2\\|cygwin" (symbol-name system-type)) 1.0 0.01) @@ -134,15 +129,92 @@ Shorter values mean quicker response, but are more CPU intensive.") (truncate pop3-read-timeout)) 1000)))))) -(defun pop3-movemail (&optional crashbox) - "Transfer contents of a maildrop to the specified CRASHBOX." - (or crashbox (setq crashbox (expand-file-name "~/.crashbox"))) +;;;###autoload +(defun pop3-movemail (file) + "Transfer contents of a maildrop to the specified FILE. +Use streaming commands." (let* ((process (pop3-open-server pop3-mailhost pop3-port)) - (crashbuf (get-buffer-create " *pop3-retr*")) - (n 1) - message-count - message-sizes - (pop3-password pop3-password)) + message-count message-total-size) + (pop3-logon process) + (with-current-buffer (process-buffer process) + (let ((size (pop3-stat process))) + (setq message-count (car size) + message-total-size (cadr size))) + (when (plusp message-count) + (pop3-send-streaming-command + process "RETR" message-count message-total-size) + (pop3-write-to-file file) + (unless pop3-leave-mail-on-server + (pop3-send-streaming-command + process "DELE" message-count nil)))) + (pop3-quit process) + t)) + +(defun pop3-send-streaming-command (process command count total-size) + (erase-buffer) + (let ((i 1)) + (while (>= count i) + (process-send-string process (format "%s %d\r\n" command i)) + ;; Only do 100 messages at a time to avoid pipe stalls. + (when (zerop (% i 100)) + (pop3-wait-for-messages process i total-size)) + (incf i))) + (pop3-wait-for-messages process count total-size)) + +(defun pop3-wait-for-messages (process count total-size) + (while (< (pop3-number-of-responses total-size) count) + (when total-size + (message "pop3 retrieved %dKB (%d%%)" + (truncate (/ (buffer-size) 1000)) + (truncate (* (/ (* (buffer-size) 1.0) + total-size) 100)))) + (nnheader-accept-process-output process))) + +(defun pop3-write-to-file (file) + (let ((pop-buffer (current-buffer)) + (start (point-min)) + beg end + temp-buffer) + (with-temp-buffer + (setq temp-buffer (current-buffer)) + (with-current-buffer pop-buffer + (goto-char (point-min)) + (while (re-search-forward "^\\+OK" nil t) + (forward-line 1) + (setq beg (point)) + (when (re-search-forward "^\\.\r?\n" nil t) + (setq start (point)) + (forward-line -1) + (setq end (point))) + (with-current-buffer temp-buffer + (goto-char (point-max)) + (let ((hstart (point))) + (insert-buffer-substring pop-buffer beg end) + (pop3-clean-region hstart (point)) + (goto-char (point-max)) + (pop3-munge-message-separator hstart (point)) + (goto-char (point-max)))))) + (let ((coding-system-for-write 'binary)) + (goto-char (point-min)) + ;; Check whether something inserted a newline at the start and + ;; delete it. + (when (eolp) + (delete-char 1)) + (write-region (point-min) (point-max) file nil 'nomesg))))) + +(defun pop3-number-of-responses (endp) + (let ((responses 0)) + (save-excursion + (goto-char (point-min)) + (while (or (and (re-search-forward "^\\+OK" nil t) + (or (not endp) + (re-search-forward "^\\.\r?\n" nil t))) + (re-search-forward "^-ERR " nil t)) + (incf responses))) + responses)) + +(defun pop3-logon (process) + (let ((pop3-password pop3-password)) ;; for debugging only (if pop3-debug (switch-to-buffer (process-buffer process))) ;; query for password @@ -154,42 +226,7 @@ Shorter values mean quicker response, but are more CPU intensive.") ((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))) - (when (and pop3-display-message-size-flag - (> message-count 0)) - (setq message-sizes (pop3-list process))) - (unwind-protect - (while (<= n message-count) - (if pop3-display-message-size-flag - (message "Retrieving message %d of %d from %s... (%.1fk)" - n message-count pop3-mailhost - (/ (cdr (assoc n message-sizes)) - 1024.0)) - (message "Retrieving message %d of %d from %s..." - n message-count pop3-mailhost)) - (pop3-retr process n crashbuf) - (save-excursion - (set-buffer crashbuf) - (let ((coding-system-for-write 'binary)) - (write-region (point-min) (point-max) crashbox t 'nomesg)) - (set-buffer (process-buffer process)) - (while (> (buffer-size) 5000) - (goto-char (point-min)) - (forward-line 50) - (delete-region (point-min) (point)))) - (unless pop3-leave-mail-on-server - (pop3-dele process n)) - (setq n (+ 1 n)) - (pop3-accept-process-output process)) - (when (and pop3-leave-mail-on-server - (> n 1)) - (message "pop3.el doesn't support UIDL. Setting `pop3-leave-mail-on-server' -to %s might not give the result you'd expect." pop3-leave-mail-on-server) - (sit-for 1)) - (pop3-quit process)) - (kill-buffer crashbuf)) - t) + (t (error "Invalid POP3 authentication scheme"))))) (defun pop3-get-message-count () "Return the number of messages in the maildrop." @@ -229,6 +266,13 @@ this is nil, `ssl' is assumed for connexions to port (const :tag "SSL/TLS" ssl) (const starttls))) +(eval-and-compile + (if (fboundp 'set-process-query-on-exit-flag) + (defalias 'pop3-set-process-query-on-exit-flag + 'set-process-query-on-exit-flag) + (defalias 'pop3-set-process-query-on-exit-flag + 'process-kill-without-query))) + (defun pop3-open-server (mailhost port) "Open TCP connection to MAILHOST on PORT. Returns the process associated with the connection." @@ -283,22 +327,17 @@ Returns the process associated with the connection." (pop3-quit process) (error "POP server doesn't support starttls"))) process)) - (t + (t (open-network-stream "POP" (current-buffer) mailhost port)))) (let ((response (pop3-read-response process t))) (setq pop3-timestamp (substring response (or (string-match "<" response) 0) (+ 1 (or (string-match ">" response) -1))))) + (pop3-set-process-query-on-exit-flag process nil) 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)) @@ -415,10 +454,7 @@ If NOW, use that time instead." nil (goto-char (point-max)) (insert "\n")) - (narrow-to-region (point) (point-max)) - (let ((size (- (point-max) (point-min)))) - (goto-char (point-min)) - (widen) + (let ((size (- (point-max) (point)))) (forward-line -1) (insert (format "Content-Length: %s\n" size))) ))))) @@ -468,7 +504,7 @@ If NOW, use that time instead." (defun pop3-list (process &optional msg) "If MSG is nil, return an alist of (MESSAGE-ID . SIZE) pairs. Otherwise, return the size of the message-id MSG" - (pop3-send-command process (if msg + (pop3-send-command process (if msg (format "LIST %d" msg) "LIST")) (let ((response (pop3-read-response process t))) @@ -643,5 +679,4 @@ and close the connection." (provide 'pop3) -;; arch-tag: 2facc142-1d74-498e-82af-4659b64cac12 ;;; pop3.el ends here diff --git a/lisp/gnus/qp.el b/lisp/gnus/qp.el index 1b9b4ce01ec..90975c48cd3 100644 --- a/lisp/gnus/qp.el +++ b/lisp/gnus/qp.el @@ -164,5 +164,4 @@ encode lines starting with \"From\"." (provide 'qp) -;; arch-tag: db89e52a-e4a1-4b69-926f-f434f04216ba ;;; qp.el ends here diff --git a/lisp/gnus/rfc1843.el b/lisp/gnus/rfc1843.el index b491a76b9c2..9826455832b 100644 --- a/lisp/gnus/rfc1843.el +++ b/lisp/gnus/rfc1843.el @@ -192,5 +192,4 @@ ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc" (provide 'rfc1843) -;; arch-tag: 5149c301-a6ca-4731-9c9d-ba616e2cb687 ;;; rfc1843.el ends here diff --git a/lisp/gnus/rfc2045.el b/lisp/gnus/rfc2045.el index b3eaefbf690..0263129c20a 100644 --- a/lisp/gnus/rfc2045.el +++ b/lisp/gnus/rfc2045.el @@ -39,5 +39,4 @@ (provide 'rfc2045) -;; arch-tag: 9ca54127-97bc-432c-b6e2-8c59cadba306 ;;; rfc2045.el ends here diff --git a/lisp/gnus/rfc2047.el b/lisp/gnus/rfc2047.el index 27d34ee5290..628423050b9 100644 --- a/lisp/gnus/rfc2047.el +++ b/lisp/gnus/rfc2047.el @@ -1175,5 +1175,4 @@ strings are stripped." (provide 'rfc2047) -;; arch-tag: a07fe3d4-22b5-4c4a-bd89-b1f82d5d36f6 ;;; rfc2047.el ends here diff --git a/lisp/gnus/rfc2104.el b/lisp/gnus/rfc2104.el index 84cb64dfd25..c1d07231978 100644 --- a/lisp/gnus/rfc2104.el +++ b/lisp/gnus/rfc2104.el @@ -122,5 +122,4 @@ In XEmacs return just STRING." (provide 'rfc2104) -;; arch-tag: cf671d5c-a45f-4a09-815e-704e59e43950 ;;; rfc2104.el ends here diff --git a/lisp/gnus/rfc2231.el b/lisp/gnus/rfc2231.el index bb38c021cfb..7cb1740c635 100644 --- a/lisp/gnus/rfc2231.el +++ b/lisp/gnus/rfc2231.el @@ -296,5 +296,4 @@ the result of this function." (provide 'rfc2231) -;; arch-tag: c3ab751d-d108-406a-b301-68882ad8cd63 ;;; rfc2231.el ends here diff --git a/lisp/gnus/score-mode.el b/lisp/gnus/score-mode.el index 9ae3e4e9ac6..04eae85bac5 100644 --- a/lisp/gnus/score-mode.el +++ b/lisp/gnus/score-mode.el @@ -116,5 +116,4 @@ This mode is an extended emacs-lisp mode. (provide 'score-mode) -;; arch-tag: a74a416b-2505-4ad4-bc4e-a418c96b8845 ;;; score-mode.el ends here diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el index bd8741fe85f..0f16444ca39 100644 --- a/lisp/gnus/sieve-manage.el +++ b/lisp/gnus/sieve-manage.el @@ -335,7 +335,7 @@ Returns t if login was successful, nil otherwise." (defun sieve-sasl-auth (buffer mech) "Login to server using the SASL MECH method." (message "sieve: Authenticating using %s..." mech) - (if (sieve-manage-interactive-login + (if (sieve-manage-interactive-login buffer (lambda (user passwd) (let (client step tag data rsp) @@ -701,5 +701,4 @@ password is remembered in the buffer." (provide 'sieve-manage) -;; arch-tag: 321c4640-1371-4495-9baf-8ccb71dd5bd1 ;; sieve-manage.el ends here diff --git a/lisp/gnus/sieve-mode.el b/lisp/gnus/sieve-mode.el index f765589e7a0..78927009fc6 100644 --- a/lisp/gnus/sieve-mode.el +++ b/lisp/gnus/sieve-mode.el @@ -216,5 +216,4 @@ Turning on Sieve mode runs `sieve-mode-hook'." (provide 'sieve-mode) -;; arch-tag: 3b8ab76d-065d-4c52-b1e8-ab2ec21f2ace ;; sieve-mode.el ends here diff --git a/lisp/gnus/sieve.el b/lisp/gnus/sieve.el index 1b0322064df..7b014da2f83 100644 --- a/lisp/gnus/sieve.el +++ b/lisp/gnus/sieve.el @@ -380,5 +380,4 @@ Server : " server ":" (or port "2000") " (provide 'sieve) -;; arch-tag: 7f6a6d94-94e1-4654-ab9a-aee21b9b8a94 ;; sieve.el ends here diff --git a/lisp/gnus/smiley.el b/lisp/gnus/smiley.el index fbe71e7725f..afffc64f12f 100644 --- a/lisp/gnus/smiley.el +++ b/lisp/gnus/smiley.el @@ -102,7 +102,8 @@ is nil, use `smiley-style'." ;; The XEmacs version has a baroque, if not rococo, set of these. (defcustom smiley-regexp-alist - '(("\\(;-?)\\)\\W" 1 "blink") + '(("\\(;-)\\)\\W" 1 "blink") + ("[^;]\\(;)\\)\\W" 1 "blink") ("\\(:-]\\)\\W" 1 "forced") ("\\(8-)\\)\\W" 1 "braindamaged") ("\\(:-|\\)\\W" 1 "indifferent") @@ -119,6 +120,7 @@ is nil, use `smiley-style'." The elements are (REGEXP MATCH IMAGE), where MATCH is the submatch in regexp to replace with IMAGE. IMAGE is the name of an image file in `smiley-data-directory'." + :version "24.1" :type '(repeat (list regexp (integer :tag "Regexp match number") (string :tag "Image name"))) @@ -226,5 +228,4 @@ With arg, turn displaying on if and only if arg is positive." (provide 'smiley) -;; arch-tag: 5beb161b-4321-40af-8ac9-876afb8ee818 ;;; smiley.el ends here diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index b60acee445d..d836f320164 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -729,5 +729,4 @@ The following commands are available: (provide 'smime) -;; arch-tag: e3f9b938-5085-4510-8a11-6625269c9a9e ;;; smime.el ends here diff --git a/lisp/gnus/spam-report.el b/lisp/gnus/spam-report.el index 45ca4b03978..0e32e934040 100644 --- a/lisp/gnus/spam-report.el +++ b/lisp/gnus/spam-report.el @@ -95,12 +95,12 @@ undo that change.") "Report an article as spam by resending via email. Reports is as ham when HAM is set." (dolist (article articles) - (gnus-message 6 + (gnus-message 6 "Reporting %s article %d to <%s>..." (if ham "ham" "spam") article spam-report-resend-to) (unless spam-report-resend-to - (customize-set-variable + (customize-set-variable spam-report-resend-to (read-from-minibuffer "email address to resend SPAM/HAM to? "))) ;; This is ganked from the `gnus-summary-resend-message' function. @@ -267,7 +267,7 @@ This is initialized based on `user-mail-address'." (gnus-message 7 "Waiting for response from %s..." host) (while (and (memq (process-status tcp-connection) '(open run)) (zerop (buffer-size))) - (accept-process-output tcp-connection)) + (accept-process-output tcp-connection 1)) (gnus-message 7 "Waiting for response from %s... done" host))))) ;;;###autoload @@ -385,5 +385,4 @@ Process queued spam reports." (provide 'spam-report) -;; arch-tag: f6683295-ec89-4ab5-8803-8cc842293022 ;;; spam-report.el ends here. diff --git a/lisp/gnus/spam-stat.el b/lisp/gnus/spam-stat.el index 69fc2016a65..d6b20df78b8 100644 --- a/lisp/gnus/spam-stat.el +++ b/lisp/gnus/spam-stat.el @@ -674,5 +674,4 @@ COUNT defaults to 5" (provide 'spam-stat) -;; arch-tag: ff1d2200-8ddb-42fb-bb7b-1b5e20448554 ;;; spam-stat.el ends here diff --git a/lisp/gnus/spam-wash.el b/lisp/gnus/spam-wash.el index 2ef7452a0e9..d201c9eddf9 100644 --- a/lisp/gnus/spam-wash.el +++ b/lisp/gnus/spam-wash.el @@ -69,5 +69,4 @@ (provide 'spam-wash) -;; arch-tag: 3c7f94a7-c96d-4c77-bb59-950df12bc85f ;;; spam-wash.el ends here diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index 10304c00c86..d079be2fcd2 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -2941,5 +2941,4 @@ installed through `spam-necessary-extra-headers'." (provide 'spam) -;; arch-tag: 07e6e0ca-ab0a-4412-b445-1f6c72a4f27f ;;; spam.el ends here diff --git a/lisp/gnus/starttls.el b/lisp/gnus/starttls.el index 18c05bfc50f..02a557de5cc 100644 --- a/lisp/gnus/starttls.el +++ b/lisp/gnus/starttls.el @@ -311,5 +311,4 @@ GNUTLS requires a port number." (provide 'starttls) -;; arch-tag: 648b3bd8-63bd-47f5-904c-7c819aea2297 ;;; starttls.el ends here diff --git a/lisp/gnus/utf7.el b/lisp/gnus/utf7.el index ec8111fe33b..cca647d94b2 100644 --- a/lisp/gnus/utf7.el +++ b/lisp/gnus/utf7.el @@ -228,5 +228,4 @@ Characters are in raw byte pairs in narrowed buffer." (provide 'utf7) -;; arch-tag: 96078b55-85c7-4161-aed2-932c24b282c7 ;;; utf7.el ends here diff --git a/lisp/gnus/webmail.el b/lisp/gnus/webmail.el index 106445d0522..86d443aa90c 100644 --- a/lisp/gnus/webmail.el +++ b/lisp/gnus/webmail.el @@ -1148,5 +1148,4 @@ (provide 'webmail) -;; arch-tag: f75a4558-a8f6-46ec-b1c3-7a6434b3dd71 ;;; webmail.el ends here diff --git a/lisp/gnus/yenc.el b/lisp/gnus/yenc.el index 2d56d660583..9fdf62d43b3 100644 --- a/lisp/gnus/yenc.el +++ b/lisp/gnus/yenc.el @@ -136,5 +136,4 @@ (provide 'yenc) -;; arch-tag: 74df17e8-6fa8-4071-9f7d-54d548d79d9a ;;; yenc.el ends here diff --git a/lisp/help-fns.el b/lisp/help-fns.el index b02a8dcb716..af08b66b1ed 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -6,6 +6,7 @@ ;; Maintainer: FSF ;; Keywords: help, internal +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/help-macro.el b/lisp/help-macro.el index 12fa29abf58..2e0f7fad539 100644 --- a/lisp/help-macro.el +++ b/lisp/help-macro.el @@ -7,6 +7,7 @@ ;; Maintainer: FSF ;; Created: Mon Oct 1 11:42:39 1990 ;; Adapted-By: ESR +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/help-mode.el b/lisp/help-mode.el index 7a7a1ddaf79..9d10d5170ba 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: help, internal +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/help.el b/lisp/help.el index 9434201797e..a2e721dd6b3 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: help, internal +;; Package: emacs ;; This file is part of GNU Emacs. @@ -103,6 +104,7 @@ (define-key map "m" 'describe-mode) (define-key map "n" 'view-emacs-news) (define-key map "p" 'finder-by-keyword) + (define-key map "P" 'describe-package) (define-key map "r" 'info-emacs-manual) (define-key map "s" 'describe-syntax) (define-key map "t" 'help-with-tutorial) diff --git a/lisp/hex-util.el b/lisp/hex-util.el index 10142896f1d..932a7fe3543 100644 --- a/lisp/hex-util.el +++ b/lisp/hex-util.el @@ -69,5 +69,4 @@ (provide 'hex-util) -;; arch-tag: fe8aaa79-6c86-400e-813f-5a8cc4cb3859 ;;; hex-util.el ends here diff --git a/lisp/hfy-cmap.el b/lisp/hfy-cmap.el index 0eff90d2298..7aefc36224b 100644 --- a/lisp/hfy-cmap.el +++ b/lisp/hfy-cmap.el @@ -13,6 +13,7 @@ ;; Description: fallback code for colour name -> rgb mapping ;; URL: http://rtfm.etla.org/emacs/htmlfontify/ ;; Last-Updated: Sat 2003-02-15 03:49:32 +0000 +;; Package: htmlfontify ;; This file is part of GNU Emacs. diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index 035b6d384e7..bfa81595085 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -15,6 +15,7 @@ ;; Compatibility: Emacs23, Emacs22 ;; Incompatibility: Emacs19, Emacs20, Emacs21 ;; Last Updated: Thu 2009-11-19 01:31:21 +0000 +;; Version: 0.21 ;; This file is part of GNU Emacs. @@ -2348,7 +2349,7 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'." ;;;### (autoloads (hfy-fallback-colour-values htmlfontify-load-rgb-file) -;;;;;; "hfy-cmap" "hfy-cmap.el" "3de2db2d213813bb3afe170ffd66cdde") +;;;;;; "hfy-cmap" "hfy-cmap.el" "7e622e4b131ea5efbe9d258f719822d6") ;;; Generated autoloads from hfy-cmap.el (autoload 'htmlfontify-load-rgb-file "hfy-cmap" "\ diff --git a/lisp/ibuf-ext.el b/lisp/ibuf-ext.el index dcea1e57472..196838f248d 100644 --- a/lisp/ibuf-ext.el +++ b/lisp/ibuf-ext.el @@ -7,6 +7,7 @@ ;; Maintainer: John Paul Wallington <jpw@gnu.org> ;; Created: 2 Dec 2001 ;; Keywords: buffer, convenience +;; Package: ibuffer ;; This file is part of GNU Emacs. diff --git a/lisp/ibuf-macs.el b/lisp/ibuf-macs.el index 60fb7e3b820..684cfe8f51b 100644 --- a/lisp/ibuf-macs.el +++ b/lisp/ibuf-macs.el @@ -7,6 +7,7 @@ ;; Maintainer: John Paul Wallington <jpw@gnu.org> ;; Created: 6 Dec 2001 ;; Keywords: buffer, convenience +;; Package: ibuffer ;; This file is part of GNU Emacs. diff --git a/lisp/ibuffer.el b/lisp/ibuffer.el index 44e59a5c8bd..c2492818b45 100644 --- a/lisp/ibuffer.el +++ b/lisp/ibuffer.el @@ -2641,7 +2641,7 @@ will be inserted before the group at point." ;;;;;; ibuffer-backward-filter-group ibuffer-forward-filter-group ;;;;;; ibuffer-toggle-filter-group ibuffer-mouse-toggle-filter-group ;;;;;; ibuffer-interactive-filter-by-mode ibuffer-mouse-filter-by-mode -;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "e1272bfdc7c3b6e926b2a68155217303") +;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "fa9822b5ef905f06d8a03dc9ce3a2894") ;;; Generated autoloads from ibuf-ext.el (autoload 'ibuffer-auto-mode "ibuf-ext" "\ diff --git a/lisp/ido.el b/lisp/ido.el index d34893d708b..858ee3ed5b0 100644 --- a/lisp/ido.el +++ b/lisp/ido.el @@ -780,7 +780,7 @@ Essentially it works as follows: Say you are visiting a file and the buffer gets cleaned up by mignight.el. Later, you want to switch to that buffer, but find it's no longer open. With virtual buffers enabled, the buffer name stays in the buffer -list (using the ido-virtual face, and always at the end), and if +list (using the `ido-virtual' face, and always at the end), and if you select it, it opens the file back up again. This allows you to think less about whether recently opened files are still open or not. Most of the time you can quit Emacs, restart, and then @@ -1070,11 +1070,11 @@ Only used if `ido-use-virtual-buffers' is non-nil.") ;; Stores the current list of items that will be searched through. ;; The list is ordered, so that the most interesting item comes first, ;; although by default, the files visible in the current frame are put -;; at the end of the list. -(defvar ido-cur-list nil) +;; at the end of the list. Created by `ido-make-item-list'. +(defvar ido-cur-list) ;; Stores the choice list for ido-completing-read -(defvar ido-choice-list nil) +(defvar ido-choice-list) ;; Stores the list of items which are ignored when building ;; `ido-cur-list'. It is in no specific order. @@ -3400,11 +3400,9 @@ for first matching file." (if ido-temp-list (nconc ido-temp-list ido-current-buffers) (setq ido-temp-list ido-current-buffers)) - (when (and default (buffer-live-p (get-buffer default))) - (setq ido-temp-list - (cons default (delete default ido-temp-list)))) - (if ido-use-virtual-buffers - (ido-add-virtual-buffers-to-list)) + (if default + (setq ido-temp-list + (cons default (delete default ido-temp-list)))) (run-hooks 'ido-make-buffer-list-hook) ido-temp-list)) @@ -3672,7 +3670,6 @@ This is to make them appear as if they were \"virtual buffers\"." ;; Used by `ido-get-buffers-in-frames' to walk through all windows (let ((buf (buffer-name (window-buffer win)))) (unless (or (member buf ido-bufs-in-frame) - (minibufferp buf) (member buf ido-ignore-item-temp-list)) ;; Only add buf if it is not already in list. ;; This prevents same buf in two different windows being @@ -3913,27 +3910,6 @@ This is to make them appear as if they were \"virtual buffers\"." ;;(add-hook 'completion-setup-hook 'completion-setup-function) (display-completion-list completion-list))))))) -(defun ido-kill-buffer-internal (buf) - "Kill buffer BUF and rebuild ido's buffer list if needed." - (if (not (kill-buffer buf)) - ;; buffer couldn't be killed. - (setq ido-rescan t) - ;; else buffer was killed so remove name from list. - (setq ido-cur-list (delq buf ido-cur-list)) - ;; Some packages, like uniquify.el, may rename buffers when one - ;; is killed, so we need to test this condition to avoid using - ;; an outdated list of buffer names. We don't want to always - ;; rebuild the list of buffers, as this alters the previous - ;; buffer order that the user was seeing on the prompt. However, - ;; when we rebuild the list, we try to keep the previous second - ;; buffer as the first one. - (catch 'update - (dolist (b ido-cur-list) - (unless (get-buffer b) - (setq ido-cur-list (ido-make-buffer-list (cadr ido-matches))) - (setq ido-rescan t) - (throw 'update nil)))))) - ;;; KILL CURRENT BUFFER (defun ido-kill-buffer-at-head () "Kill the buffer at the head of `ido-matches'. @@ -3942,15 +3918,26 @@ If cursor is not at the end of the user input, delete to end of input." (if (not (eobp)) (delete-region (point) (line-end-position)) (let ((enable-recursive-minibuffers t) - (buf (ido-name (car ido-matches)))) - (when buf - (ido-kill-buffer-internal buf) - ;; Check if buffer still exists. - (if (get-buffer buf) - ;; buffer couldn't be killed. + (buf (ido-name (car ido-matches))) + (nextbuf (cadr ido-matches))) + (when (get-buffer buf) + ;; If next match names a buffer use the buffer object; buffer + ;; name may be changed by packages such as uniquify; mindful + ;; of virtual buffers. + (when (and nextbuf (get-buffer nextbuf)) + (setq nextbuf (get-buffer nextbuf))) + (if (null (kill-buffer buf)) + ;; Buffer couldn't be killed. (setq ido-rescan t) - ;; else buffer was killed so remove name from list. - (setq ido-cur-list (delq buf ido-cur-list))))))) + ;; Else `kill-buffer' succeeds so re-make the buffer list + ;; taking into account packages like uniquify may rename + ;; buffers. + (if (bufferp nextbuf) + (setq nextbuf (buffer-name nextbuf))) + (setq ido-default-item nextbuf + ido-text-init ido-text + ido-exit 'refresh) + (exit-minibuffer)))))) ;;; DELETE CURRENT FILE (defun ido-delete-file-at-head () @@ -3988,7 +3975,7 @@ Record command in `command-history' if optional RECORD is non-nil." ((eq method 'kill) (if record (ido-record-command 'kill-buffer buffer)) - (ido-kill-buffer-internal buffer)) + (kill-buffer buffer)) ((eq method 'other-window) (if record diff --git a/lisp/image-mode.el b/lisp/image-mode.el index a34989171bb..6e67847857f 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -4,6 +4,7 @@ ;; ;; Author: Richard Stallman <rms@gnu.org> ;; Keywords: multimedia +;; Package: emacs ;; This file is part of GNU Emacs. @@ -493,7 +494,10 @@ was inserted." (buffer-substring-no-properties (point-min) (point-max))) filename)) (type (image-type file-or-data nil data-p)) - (image (create-animated-image file-or-data type data-p)) + (image0 (create-animated-image file-or-data type data-p)) + (image (append image0 + (image-transform-properties image0) + )) (props `(display ,image intangible ,image @@ -556,6 +560,84 @@ the image file and `image-mode' showing the image as an image." (when (not (string= image-type (bookmark-prop-get bmk 'image-type))) (image-toggle-display)))) + +(defvar image-transform-minor-mode-map + (let ((map (make-sparse-keymap))) +; (define-key map [(control ?+)] 'image-scale-in) +; (define-key map [(control ?-)] 'image-scale-out) +; (define-key map [(control ?=)] 'image-scale-none) +;; (define-key map "c f h" 'image-scale-fit-height) +;; (define-key map "c ]" 'image-rotate-right) + map) + "Minor mode keymap for transforming the view of images Image mode.") + +(define-minor-mode image-transform-mode + "minor mode for scaleing and rotation" + nil "image-transform" + image-transform-minor-mode-map) + +(defvar image-transform-resize nil + "The image resize operation. See the command + `image-transform-set-scale' for more information." ) + +(defvar image-transform-rotation 0.0) + + +(defun image-transform-properties (display) + "Calculate the display properties for transformations; scaling +and rotation. " + (let* + ((size (image-size display t)) + (height + (cond + ((and (numberp image-transform-resize) (eq 100 image-transform-resize)) + nil) + ((numberp image-transform-resize) + (* image-transform-resize (cdr size))) + ((eq image-transform-resize 'fit-height) + (- (nth 3 (window-inside-pixel-edges)) (nth 1 (window-inside-pixel-edges)))) + (t nil))) + (width (if (eq image-transform-resize 'fit-width) + (- (nth 2 (window-inside-pixel-edges)) (nth 0 (window-inside-pixel-edges)))))) + + `(,@(if height (list :height height)) + ,@(if width (list :width width)) + ,@(if (not (equal 0.0 image-transform-rotation)) + (list :rotation image-transform-rotation)) + ;;TODO fit-to-* should consider the rotation angle + ))) + +(defun image-transform-set-scale (scale) + "SCALE sets the scaling for images. " + (interactive "nscale:") + (image-transform-set-resize (float scale))) + +(defun image-transform-fit-to-height () + "Fit image height to window height. " + (interactive) + (image-transform-set-resize 'fit-height)) + +(defun image-transform-fit-to-width () + "Fit image width to window width. " + (interactive) + (image-transform-set-resize 'fit-width)) + +(defun image-transform-set-resize (resize) + "Set the resize mode for images. The RESIZE value can be the +symbol fit-height which fits the image to the window height. The +symbol fit-width fits the image to the window width. A number +indicates a scaling factor. nil indicates scale to 100%. " + (setq image-transform-resize resize) + (if (eq 'image-mode major-mode) (image-toggle-display-image))) + +(defun image-transform-set-rotation (rotation) + "Set the image ROTATION angle. " + (interactive "nrotation:") + ;;TODO 0 90 180 270 degrees are the only reasonable angles here + ;;otherwise combining with rescaling will get very awkward + (setq image-transform-rotation (float rotation)) + (if (eq major-mode 'image-mode) (image-toggle-display-image))) + (provide 'image-mode) ;; arch-tag: b5b2b7e6-26a7-4b79-96e3-1546b5c4c6cb diff --git a/lisp/image.el b/lisp/image.el index 287cca81570..2ca2971b4aa 100644 --- a/lisp/image.el +++ b/lisp/image.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: multimedia +;; Package: emacs ;; This file is part of GNU Emacs. @@ -616,7 +617,7 @@ Images should not be larger than specified by `max-image-size'." (let* ((animate (memq type image-animated-types)) (image (append (list 'image :type type (if data-p :data :file) file-or-data) - (if animate '(:index 0 :mask heuristic)) + (if animate '(:index 0)) props))) (if animate (image-animate-start image)) @@ -694,6 +695,34 @@ shall be displayed." (cons images tmo)))))) +(defcustom imagemagick-types-inhibit + '(C HTML HTM TXT PDF) + ;; FIXME what are the possible options? + ;; Are these actually file-name extensions? + ;; Why are these upper-case when eg image-types is lower-case? + "Types the ImageMagick loader should not try to handle." + :type '(choice (const :tag "Let ImageMagick handle all the types it can" nil) + (repeat symbol)) + :version "24.1" + :group 'image) + +;;;###autoload +(defun imagemagick-register-types () + "Register the file types that ImageMagick is able to handle." + (let ((im-types (imagemagick-types))) + (dolist (im-inhibit imagemagick-types-inhibit) + (setq im-types (remove im-inhibit im-types))) + (dolist (im-type im-types) + (let ((extension (downcase (symbol-name im-type)))) + (push + (cons (concat "\\." extension "\\'") 'image-mode) + auto-mode-alist) + (push + (cons (concat "\\." extension "\\'") 'imagemagick) + image-type-file-name-regexps))))) + + + (provide 'image) ;; arch-tag: 8e76a07b-eb48-4f3e-a7a0-1a7ba9f096b3 diff --git a/lisp/indent.el b/lisp/indent.el index c1da4a46b9c..7116b705aff 100644 --- a/lisp/indent.el +++ b/lisp/indent.el @@ -4,6 +4,7 @@ ;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Maintainer: FSF +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/info.el b/lisp/info.el index 65b9492e351..4fa9503b14e 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -3372,7 +3372,6 @@ Build a menu of the possible matches." filename) (defvar finder-known-keywords) -(defvar finder-package-info) (declare-function find-library-name "find-func" (library)) (declare-function finder-unknown-keywords "finder" ()) (declare-function lm-commentary "lisp-mnt" (&optional file)) @@ -3388,15 +3387,14 @@ Build a menu of the possible matches." (insert "Finder Keywords\n") (insert "***************\n\n") (insert "* Menu:\n\n") - (mapc - (lambda (assoc) - (let ((keyword (car assoc))) - (insert (format "* %-14s %s.\n" - (concat (symbol-name keyword) "::") - (cdr assoc))))) - (append '((all . "All package info") - (unknown . "unknown keywords")) - finder-known-keywords))) + (dolist (assoc (append '((all . "All package info") + (unknown . "unknown keywords")) + finder-known-keywords)) + (let ((keyword (car assoc))) + (insert (format "* %s %s.\n" + (concat (symbol-name keyword) ": " + "kw:" (symbol-name keyword) ".") + (cdr assoc)))))) ((equal nodename "unknown") ;; Display unknown keywords (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n" @@ -3416,17 +3414,36 @@ Build a menu of the possible matches." Info-finder-file nodename)) (insert "Finder Package Info\n") (insert "*******************\n\n") - (mapc (lambda (package) - (insert (format "%s - %s\n" - (format "*Note %s::" (nth 0 package)) - (nth 1 package))) - (insert "Keywords: " - (mapconcat (lambda (keyword) - (format "*Note %s::" (symbol-name keyword))) - (nth 2 package) ", ") - "\n\n")) - finder-package-info)) - ((string-match-p "\\.el\\'" nodename) + (dolist (package package-alist) + (insert (format "%s - %s\n" + (format "*Note %s::" (nth 0 package)) + (nth 1 package))))) + ((string-match "\\`kw:" nodename) + (setq nodename (substring nodename (match-end 0))) + ;; Display packages that match the keyword + ;; or the list of keywords separated by comma. + (insert (format "\n\^_\nFile: %s, Node: kw:%s, Up: Top\n\n" + Info-finder-file nodename)) + (insert "Finder Packages\n") + (insert "***************\n\n") + (insert + "The following packages match the keyword `" nodename "':\n\n") + (insert "* Menu:\n\n") + (let ((keywords + (mapcar 'intern (if (string-match-p "," nodename) + (split-string nodename ",[ \t\n]*" t) + (list nodename)))) + hits desc) + (dolist (kw keywords) + (push (copy-tree (gethash kw finder-keywords-hash)) hits)) + (setq hits (delete-dups (apply 'append hits))) + (dolist (package hits) + (setq desc (cdr-safe (assq package package-alist))) + (when (vectorp desc) + (insert (format "* %-16s %s.\n" + (concat (symbol-name package) "::") + (aref desc 2))))))) + (t ;; Display commentary section (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n" Info-finder-file nodename)) @@ -3447,29 +3464,7 @@ Build a menu of the possible matches." (goto-char (point-min)) (while (re-search-forward "^;+ ?" nil t) (replace-match "" nil nil)) - (buffer-string)))))) - (t - ;; Display packages that match the keyword - ;; or the list of keywords separated by comma. - (insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n" - Info-finder-file nodename)) - (insert "Finder Packages\n") - (insert "***************\n\n") - (insert - "The following packages match the keyword `" nodename "':\n\n") - (insert "* Menu:\n\n") - (let ((keywords - (mapcar 'intern (if (string-match-p "," nodename) - (split-string nodename ",[ \t\n]*" t) - (list nodename))))) - (mapc - (lambda (package) - (unless (memq nil (mapcar (lambda (k) (memq k (nth 2 package))) - keywords)) - (insert (format "* %-16s %s.\n" - (concat (nth 0 package) "::") - (nth 1 package))))) - finder-package-info))))) + (buffer-string)))))))) ;;;###autoload (defun info-finder (&optional keywords) diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index ecb2088de89..753b1ab25e7 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -433,7 +433,7 @@ (nil . "koi8-r")) (arabic ,(font-spec :registry "iso10646-1" - :otf '(arab nil (init medi fini liga))) + :otf '(arab nil (init medi fina liga))) (nil . "MuleArabic-0") (nil . "MuleArabic-1") (nil . "MuleArabic-2") diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index c961decfed5..a3609c0ccfc 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -1952,7 +1952,7 @@ See `set-language-info-alist' for use in programs." (> (aref (number-to-string (nth 2 (x-server-version))) 0) ?3)) ;; Make non-line-break space display as a plain space. - (aset standard-display-table 160 [32])) + (aset standard-display-table (unibyte-char-to-multibyte 160) [32])) ;; Most Windows programs send out apostrophes as \222. Most X fonts ;; don't contain a character at that position. Map it to the ASCII ;; apostrophe. [This is actually RIGHT SINGLE QUOTATION MARK, @@ -1960,7 +1960,7 @@ See `set-language-info-alist' for use in programs." ;; fonts probably have the appropriate glyph at this position, ;; so they could use standard-display-8bit. It's better to use a ;; proper windows-1252 coding system. --fx] - (aset standard-display-table 146 [39])))) + (aset standard-display-table (unibyte-char-to-multibyte 146) [39])))) (defun set-language-environment-coding-systems (language-name) "Do various coding system setups for language environment LANGUAGE-NAME." @@ -2179,7 +2179,7 @@ See `set-language-info-alist' for use in programs." ("af" . "Latin-1") ; Afrikaans ("am" "Ethiopic" utf-8) ; Amharic ("an" . "Latin-9") ; Aragonese - ; ar Arabic glibc uses 8859-6 + ("ar" . "Arabic") ; as Assamese ; ay Aymara ("az" . "UTF-8") ; Azerbaijani diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 59d6ff42c97..9f1833924b3 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -326,8 +326,7 @@ Return t if file exists." (with-current-buffer buffer ;; So that we don't get completely screwed if the ;; file is encoded in some complicated character set, - ;; read it with real decoding, as a multibyte buffer, - ;; even if this is a --unibyte Emacs session. + ;; read it with real decoding, as a multibyte buffer. (set-buffer-multibyte t) ;; Don't let deactivate-mark remain set. (let (deactivate-mark) @@ -346,12 +345,7 @@ Return t if file exists." (eval-buffer buffer nil ;; This is compatible with what `load' does. (if purify-flag file fullname) - ;; If this Emacs is running with --unibyte, - ;; convert multibyte strings to unibyte - ;; after reading them. -;; (not (default-value 'enable-multibyte-characters)) - nil t - )) + nil t)) (let (kill-buffer-hook kill-buffer-query-functions) (kill-buffer buffer))) (do-after-load-evaluation fullname) @@ -2303,13 +2297,12 @@ It returns the number of characters changed." (setq table val))) (translate-region-internal start end table)) -(put 'with-category-table 'lisp-indent-function 1) - (defmacro with-category-table (table &rest body) "Execute BODY like `progn' with TABLE the current category table. The category table of the current buffer is saved, BODY is evaluated, then the saved table is restored, even in case of an abnormal exit. Value is what BODY returns." + (declare (indent 1) (debug t)) (let ((old-table (make-symbol "old-table")) (old-buffer (make-symbol "old-buffer"))) `(let ((,old-table (category-table)) diff --git a/lisp/international/uni-bidi.el b/lisp/international/uni-bidi.el Binary files differindex 7902810442b..9e571ef9d0d 100644 --- a/lisp/international/uni-bidi.el +++ b/lisp/international/uni-bidi.el diff --git a/lisp/international/uni-category.el b/lisp/international/uni-category.el Binary files differindex b81045f1a0e..80538f7b416 100644 --- a/lisp/international/uni-category.el +++ b/lisp/international/uni-category.el diff --git a/lisp/international/uni-combining.el b/lisp/international/uni-combining.el Binary files differindex 1aca7ee1d11..2ee74d8b818 100644 --- a/lisp/international/uni-combining.el +++ b/lisp/international/uni-combining.el diff --git a/lisp/international/uni-decimal.el b/lisp/international/uni-decimal.el Binary files differindex 517280885b8..22207a224b0 100644 --- a/lisp/international/uni-decimal.el +++ b/lisp/international/uni-decimal.el diff --git a/lisp/international/uni-mirrored.el b/lisp/international/uni-mirrored.el Binary files differindex a1e2e69dfaa..5129a93396d 100644 --- a/lisp/international/uni-mirrored.el +++ b/lisp/international/uni-mirrored.el diff --git a/lisp/international/uni-name.el b/lisp/international/uni-name.el Binary files differindex 335957e9548..5b9e8323d21 100644 --- a/lisp/international/uni-name.el +++ b/lisp/international/uni-name.el diff --git a/lisp/isearch.el b/lisp/isearch.el index 6f89e0ee817..f18a74c59b5 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -7,6 +7,7 @@ ;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu> ;; Maintainer: FSF ;; Keywords: matching +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/iswitchb.el b/lisp/iswitchb.el index ea4b00dc90d..081897a89b3 100644 --- a/lisp/iswitchb.el +++ b/lisp/iswitchb.el @@ -1027,8 +1027,8 @@ Return the modified list with the last element prepended to it." (defun iswitchb-kill-buffer () "Kill the buffer at the head of `iswitchb-matches'." (interactive) - (let ( (enable-recursive-minibuffers t) - buf) + (let ((enable-recursive-minibuffers t) + buf) (setq buf (car iswitchb-matches)) ;; check to see if buf is non-nil. @@ -1042,8 +1042,10 @@ Return the modified list with the last element prepended to it." (if (get-buffer buf) ;; buffer couldn't be killed. (setq iswitchb-rescan t) - ;; else buffer was killed so remove name from list. - (setq iswitchb-buflist (delq buf iswitchb-buflist))))))) + ;; Else `kill-buffer' succeeds so re-make the buffer list + ;; taking into account packages like uniquify may rename + ;; buffers + (iswitchb-make-buflist iswitchb-default)))))) ;;; VISIT CHOSEN BUFFER (defun iswitchb-visit-buffer (buffer) diff --git a/lisp/jit-lock.el b/lisp/jit-lock.el index dbe1cbe23e1..cc250567ad8 100644 --- a/lisp/jit-lock.el +++ b/lisp/jit-lock.el @@ -5,6 +5,7 @@ ;; Author: Gerd Moellmann <gerd@gnu.org> ;; Keywords: faces files +;; Package: emacs ;; This file is part of GNU Emacs. @@ -31,33 +32,13 @@ (eval-when-compile (require 'cl) - (defmacro with-buffer-unmodified (&rest body) - "Eval BODY, preserving the current buffer's modified state." - (declare (debug t)) - (let ((modified (make-symbol "modified"))) - `(let ((,modified (buffer-modified-p))) - (unwind-protect - (progn ,@body) - (unless ,modified - (restore-buffer-modified-p nil)))))) - (defmacro with-buffer-prepared-for-jit-lock (&rest body) "Execute BODY in current buffer, overriding several variables. Preserves the `buffer-modified-p' state of the current buffer." (declare (debug t)) - `(let ((buffer-undo-list t) - (inhibit-read-only t) - (inhibit-point-motion-hooks t) - (inhibit-modification-hooks t) - deactivate-mark - buffer-file-name - buffer-file-truename) - ;; Do reset the modification status from within the let, since - ;; otherwise set-buffer-modified-p may try to unlock the file. - (with-buffer-unmodified - ,@body)))) - - + `(let ((inhibit-point-motion-hooks t)) + (with-silent-modifications + ,@body)))) ;;; Customization. diff --git a/lisp/jka-cmpr-hook.el b/lisp/jka-cmpr-hook.el index da8512d7fb9..68f564c488f 100644 --- a/lisp/jka-cmpr-hook.el +++ b/lisp/jka-cmpr-hook.el @@ -6,6 +6,7 @@ ;; Author: jka@ece.cmu.edu (Jay K. Adams) ;; Maintainer: FSF ;; Keywords: data +;; Package: emacs ;; This file is part of GNU Emacs. @@ -334,6 +335,7 @@ Return the new status of auto compression (non-nil means on)." (defmacro with-auto-compression-mode (&rest body) "Evalute BODY with automatic file compression and uncompression enabled." + (declare (indent 0)) (let ((already-installed (make-symbol "already-installed"))) `(let ((,already-installed (jka-compr-installed-p))) (unwind-protect @@ -343,8 +345,6 @@ Return the new status of auto compression (non-nil means on)." ,@body) (unless ,already-installed (jka-compr-uninstall)))))) -(put 'with-auto-compression-mode 'lisp-indent-function 0) - ;; This is what we need to know about jka-compr-handler ;; in order to decide when to call it. diff --git a/lisp/language/misc-lang.el b/lisp/language/misc-lang.el index 2431c9d9e99..e2e4f29dd9e 100644 --- a/lisp/language/misc-lang.el +++ b/lisp/language/misc-lang.el @@ -40,8 +40,9 @@ IPA is International Phonetic Alphabet for English, French, German and Italian."))) -;; This is for Arabic. But, as we still don't have Arabic language -;; support, we at least define a coding system here. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Arabic +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-coding-system 'iso-8859-6 "ISO-8859-6 based encoding (MIME:ISO-8859-6)." @@ -58,6 +59,19 @@ and Italian."))) :mime-charset 'windows-1256) (define-coding-system-alias 'cp1256 'windows-1256) +(set-language-info-alist + "Arabic" '((charset unicode) + (coding-system utf-8 iso-8859-6 windows-1256) + (coding-priority utf-8 iso-8859-6 windows-1256) + (input-method . "arabic") + (sample-text . "Arabic السّلام عليكم") + (documentation . "Bidirectional editing is supported."))) + +(set-char-table-range + composition-function-table + '(#x600 . #x6FF) + (list ["[\u0600-\u06FF]+" 0 font-shape-gstring])) + (provide 'misc-lang) ;; arch-tag: 6953585c-1a1a-4c09-be82-a2518afb6074 diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index ec2a7c3b52c..f7493109d7c 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -10464,7 +10464,6 @@ Turn flymake mode off. ;;;### (autoloads (flyspell-buffer flyspell-region flyspell-mode-off ;;;;;; turn-off-flyspell turn-on-flyspell flyspell-mode flyspell-prog-mode) -;;;;;; "flyspell" "textmodes/flyspell.el" (19370 36541)) ;;; Generated autoloads from textmodes/flyspell.el (autoload 'flyspell-prog-mode "flyspell" "\ diff --git a/lisp/linum.el b/lisp/linum.el index 3d70c254775..4ab4b10a7c9 100644 --- a/lisp/linum.el +++ b/lisp/linum.el @@ -5,6 +5,7 @@ ;; Author: Markus Triska <markus.triska@gmx.at> ;; Maintainer: FSF ;; Keywords: convenience +;; Version: 0.9x ;; This file is part of GNU Emacs. diff --git a/lisp/loadup.el b/lisp/loadup.el index d4af1d4617f..7757a0e5b40 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index f91c7a808ec..4dba41e0655 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -7,6 +7,7 @@ ;; Modified by: Francis J. Wright <F.J.Wright@maths.qmw.ac.uk> ;; Maintainer: FSF ;; Keywords: unix, dired +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/macros.el b/lisp/macros.el index fa45d8c6108..cbceb96fade 100644 --- a/lisp/macros.el +++ b/lisp/macros.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: abbrev +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/mail/binhex.el b/lisp/mail/binhex.el index 4d80d021399..42d2f35baed 100644 --- a/lisp/mail/binhex.el +++ b/lisp/mail/binhex.el @@ -328,5 +328,4 @@ If HEADER-ONLY is non-nil only decode header and return filename." (provide 'binhex) -;; arch-tag: 8476badd-1e76-4f1d-a640-f9a38c72eed8 ;;; binhex.el ends here diff --git a/lisp/mail/blessmail.el b/lisp/mail/blessmail.el index 4520ea61d03..545350170ec 100644 --- a/lisp/mail/blessmail.el +++ b/lisp/mail/blessmail.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index 478d7aa075f..b3ec3fb4850 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -7,6 +7,7 @@ ;; Author: K. Shane Hartman ;; Maintainer: FSF ;; Keywords: maint mail +;; Package: emacs ;; This file is part of GNU Emacs. @@ -74,6 +75,52 @@ (declare-function message-sort-headers "message" ()) (defvar message-strip-special-text-properties) +(defun report-emacs-bug-can-use-xdg-email () + "Check if xdg-email can be used, i.e. we are on Gnome, KDE or xfce4." + (and (getenv "DISPLAY") + (executable-find "xdg-email") + (or (getenv "GNOME_DESKTOP_SESSION_ID") + ;; GNOME_DESKTOP_SESSION_ID is deprecated, check on Dbus also. + (condition-case nil + (eq 0 (call-process + "dbus-send" nil nil nil + "--dest=org.gnome.SessionManager" + "--print-reply" + "/org/gnome/SessionManager" + "org.gnome.SessionManager.CanShutdown")) + (error nil)) + (equal (getenv "KDE_FULL_SESSION") "true") + (condition-case nil + (eq 0 (call-process + "/bin/sh" nil nil nil + "-c" + "xprop -root _DT_SAVE_MODE|grep xfce4")) + (error nil))))) + +(defun report-emacs-bug-insert-to-mailer () + (interactive) + (save-excursion + (let* ((to (progn + (goto-char (point-min)) + (forward-line) + (and (looking-at "^To: \\(.*\\)") + (match-string-no-properties 1)))) + (subject (progn + (forward-line) + (and (looking-at "^Subject: \\(.*\\)") + (match-string-no-properties 1)))) + (body (progn + (forward-line 2) + (if (> (point-max) (point)) + (buffer-substring-no-properties (point) (point-max)))))) + (if (and to subject body) + (start-process "xdg-email" nil "xdg-email" + "--subject" subject + "--body" body + (concat "mailto:" to)) + (error "Subject, To or body not found"))))) + + ;;;###autoload (defun report-emacs-bug (topic &optional recent-keys) "Report a bug in GNU Emacs. @@ -93,6 +140,7 @@ Prompts for bug subject. Leaves you in a mail buffer." (prompt-properties '(field emacsbug-prompt intangible but-helpful rear-nonsticky t)) + (can-xdg-email (report-emacs-bug-can-use-xdg-email)) user-point message-end-point) (setq message-end-point (with-current-buffer (get-buffer-create "*Messages*") @@ -226,6 +274,9 @@ usually do not have translators to read other languages for them.\n\n") ;; This is so the user has to type something in order to send easily. (use-local-map (nconc (make-sparse-keymap) (current-local-map))) (define-key (current-local-map) "\C-c\C-i" 'report-emacs-bug-info) + (if can-xdg-email + (define-key (current-local-map) "\C-cm" + 'report-emacs-bug-insert-to-mailer)) ;; Could test major-mode instead. (cond ((memq mail-user-agent '(message-user-agent gnus-user-agent)) (setq report-emacs-bug-send-command "message-send-and-exit" @@ -245,6 +296,9 @@ usually do not have translators to read other languages for them.\n\n") report-emacs-bug-send-command)))) (princ (substitute-command-keys " Type \\[kill-buffer] RET to cancel (don't send it).\n")) + (if can-xdg-email + (princ (substitute-command-keys + " Type \\[report-emacs-bug-insert-to-mailer] to insert text to you preferred mail program.\n"))) (terpri) (princ (substitute-command-keys " Type \\[report-emacs-bug-info] to visit in Info the Emacs Manual section diff --git a/lisp/mail/hashcash.el b/lisp/mail/hashcash.el index c7b48cf78ed..cc3af11a47d 100644 --- a/lisp/mail/hashcash.el +++ b/lisp/mail/hashcash.el @@ -276,7 +276,7 @@ BUFFER defaults to the current buffer." (unless buffer (setq buffer (current-buffer))) (let (entry) (while (setq entry (rassq buffer hashcash-process-alist)) - (accept-process-output (car entry))))) + (accept-process-output (car entry) 1)))) (defun hashcash-processes-running-p (buffer) "Return non-nil if hashcash processes in BUFFER are still running." @@ -375,4 +375,4 @@ Prefix arg sets default accept amount temporarily." (provide 'hashcash) -;; arch-tag: 0e7fe983-a124-4392-9788-0dbcbd2c4d62 +;;; hashcash.el ends here diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index 51c490da7ab..342d735c939 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -6,6 +6,7 @@ ;; Author: Joe Wells <jbw@cs.bu.edu> ;; Maintainer: FSF ;; Keywords: mail +;; Package: mail-utils ;; This file is part of GNU Emacs. diff --git a/lisp/mail/mail-hist.el b/lisp/mail/mail-hist.el index 6700d6d2733..f129f29ea33 100644 --- a/lisp/mail/mail-hist.el +++ b/lisp/mail/mail-hist.el @@ -6,6 +6,7 @@ ;; Author: Karl Fogel <kfogel@red-bean.com> ;; Created: March, 1994 ;; Keywords: mail, history +;; Package: mail-utils ;; This file is part of GNU Emacs. diff --git a/lisp/mail/mailheader.el b/lisp/mail/mailheader.el index 44967b05bc8..960d3c65487 100644 --- a/lisp/mail/mailheader.el +++ b/lisp/mail/mailheader.el @@ -5,6 +5,7 @@ ;; Author: Erik Naggum <erik@naggum.no> ;; Keywords: tools, mail, news +;; Package: mail-utils ;; This file is part of GNU Emacs. diff --git a/lisp/mail/rmail-spam-filter.el b/lisp/mail/rmail-spam-filter.el index a3eee899a68..33f3be30cc2 100644 --- a/lisp/mail/rmail-spam-filter.el +++ b/lisp/mail/rmail-spam-filter.el @@ -4,6 +4,7 @@ ;; Free Software Foundation, Inc. ;; Keywords: email, spam, filter, rmail ;; Author: Eli Tziperman <eli AT deas.harvard.edu> +;; Package: rmail ;; This file is part of GNU Emacs. diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index fbf5c534a28..07ea7cc0d25 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -191,8 +191,6 @@ please report it with \\[report-emacs-bug].") :group 'rmail-retrieve :type '(repeat (directory))) -(declare-function mail-position-on-field "sendmail" (field &optional soft)) -(declare-function mail-text-start "sendmail" ()) (declare-function rmail-dont-reply-to "mail-utils" (destinations)) (declare-function rmail-update-summary "rmailsum" (&rest ignore)) @@ -1643,8 +1641,6 @@ The duplicate copy goes into the Rmail file just after the original." (declare-function rmail-summary-mark-deleted "rmailsum" (&optional n undel)) (declare-function rfc822-addresses "rfc822" (header-text)) (declare-function mail-abbrev-make-syntax-table "mailabbrev.el" ()) -(declare-function mail-sendmail-delimit-header "sendmail" ()) -(declare-function mail-header-end "sendmail" ()) ;; RLK feature not added in this version: ;; argument specifies inbox file or files in various ways. @@ -3686,7 +3682,8 @@ see the documentation of `rmail-resend'." ;; The mail buffer is now current. (save-excursion ;; Insert after header separator--before signature if any. - (goto-char (mail-text-start)) + (rfc822-goto-eoh) + (forward-line 1) (if (or rmail-enable-mime rmail-enable-mime-composing) (funcall rmail-insert-mime-forwarded-message-function forward-buffer) @@ -3841,6 +3838,10 @@ The message should be narrowed to just the headers." (1- (point)) (point-max))))))) +(declare-function mail-sendmail-delimit-header "sendmail" ()) +(declare-function mail-header-end "sendmail" ()) +(declare-function mail-position-on-field "sendmail" (field &optional soft)) + (defun rmail-retry-failure () "Edit a mail message which is based on the contents of the current message. For a message rejected by the mail system, extract the interesting headers and @@ -3932,6 +3933,8 @@ specifying headers which should not be copied into the new message." (goto-char (point-min)) (if bounce-indent (indent-rigidly (point-min) (point-max) bounce-indent)) + ;; FIXME better to replace sendmail functions. + (require 'sendmail) (mail-sendmail-delimit-header) (save-restriction (narrow-to-region (point-min) (mail-header-end)) @@ -4236,7 +4239,7 @@ encoded string (and the same mask) will decode the string." ;;; Start of automatically extracted autoloads. ;;;### (autoloads (rmail-edit-current-message) "rmailedit" "rmailedit.el" -;;;;;; "60db8013bf16d7999914a16cda435287") +;;;;;; "4bf8a5cdfc921b9e30680ee71b7f9ca6") ;;; Generated autoloads from rmailedit.el (autoload 'rmail-edit-current-message "rmailedit" "\ @@ -4248,7 +4251,7 @@ Edit the contents of this message. ;;;### (autoloads (rmail-next-labeled-message rmail-previous-labeled-message ;;;;;; rmail-read-label rmail-kill-label rmail-add-label) "rmailkwd" -;;;;;; "rmailkwd.el" "7027ce1ac922c0dd51262b641e4d42c1") +;;;;;; "rmailkwd.el" "112240cbb53c402294013cc49987771a") ;;; Generated autoloads from rmailkwd.el (autoload 'rmail-add-label "rmailkwd" "\ @@ -4291,7 +4294,7 @@ With prefix argument N moves forward N messages with these labels. ;;;*** -;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "4a7502b4aeb3bd5f2111b48cc6512924") +;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "9f67f3b67de9b700b128b73c52abfefa") ;;; Generated autoloads from rmailmm.el (autoload 'rmail-mime "rmailmm" "\ @@ -4307,7 +4310,7 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'. ;;;*** ;;;### (autoloads (set-rmail-inbox-list) "rmailmsc" "rmailmsc.el" -;;;;;; "b2a72d4e370f2d2b31b6f8f0794820e4") +;;;;;; "c3575020691d5769bcf08ecc932304c3") ;;; Generated autoloads from rmailmsc.el (autoload 'set-rmail-inbox-list "rmailmsc" "\ @@ -4323,7 +4326,7 @@ This applies only to the current session. ;;;### (autoloads (rmail-sort-by-labels rmail-sort-by-lines rmail-sort-by-correspondent ;;;;;; rmail-sort-by-recipient rmail-sort-by-author rmail-sort-by-subject -;;;;;; rmail-sort-by-date) "rmailsort" "rmailsort.el" "5a3b5ee477d2fbf79d0c566d776a7fd4") +;;;;;; rmail-sort-by-date) "rmailsort" "rmailsort.el" "b96e85edd736f23f1e9d54a299268d1e") ;;; Generated autoloads from rmailsort.el (autoload 'rmail-sort-by-date "rmailsort" "\ @@ -4382,7 +4385,7 @@ If prefix argument REVERSE is non-nil, sorts in reverse order. ;;;### (autoloads (rmail-summary-by-senders rmail-summary-by-topic ;;;;;; rmail-summary-by-regexp rmail-summary-by-recipients rmail-summary-by-labels -;;;;;; rmail-summary) "rmailsum" "rmailsum.el" "26b95919c7e1f8c5609ce7323aee77ae") +;;;;;; rmail-summary) "rmailsum" "rmailsum.el" "4715fb58fb191bf6b192458ea75524b2") ;;; Generated autoloads from rmailsum.el (autoload 'rmail-summary "rmailsum" "\ diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el index d01773fe6c9..02f36fd47e7 100644 --- a/lisp/mail/rmailedit.el +++ b/lisp/mail/rmailedit.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: mail +;; Package: rmail ;; This file is part of GNU Emacs. diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el index 5b9b95e5bbb..5c44b5cafa2 100644 --- a/lisp/mail/rmailkwd.el +++ b/lisp/mail/rmailkwd.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: mail +;; Package: rmail ;; This file is part of GNU Emacs. diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el index e8ca11ee349..3882c9e47c8 100644 --- a/lisp/mail/rmailmm.el +++ b/lisp/mail/rmailmm.el @@ -6,6 +6,7 @@ ;; Alex Schroeder ;; Maintainer: FSF ;; Keywords: mail +;; Package: rmail ;; This file is part of GNU Emacs. diff --git a/lisp/mail/rmailmsc.el b/lisp/mail/rmailmsc.el index fe8a627fe6b..bbb8233d89c 100644 --- a/lisp/mail/rmailmsc.el +++ b/lisp/mail/rmailmsc.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: mail +;; Package: rmail ;; This file is part of GNU Emacs. diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el index a6ff75e4efe..93d512336dc 100644 --- a/lisp/mail/rmailout.el +++ b/lisp/mail/rmailout.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: mail +;; Package: rmail ;; This file is part of GNU Emacs. diff --git a/lisp/mail/rmailsort.el b/lisp/mail/rmailsort.el index f44f36bd5ee..f4fd52c10c7 100644 --- a/lisp/mail/rmailsort.el +++ b/lisp/mail/rmailsort.el @@ -6,6 +6,7 @@ ;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp> ;; Maintainer: FSF ;; Keywords: mail +;; Package: rmail ;; This file is part of GNU Emacs. diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index 80c65cdfb57..0b8abbca6a5 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: mail +;; Package: rmail ;; This file is part of GNU Emacs. diff --git a/lisp/mail/uudecode.el b/lisp/mail/uudecode.el index b1c2a7be41d..7ab2fcd1c62 100644 --- a/lisp/mail/uudecode.el +++ b/lisp/mail/uudecode.el @@ -236,5 +236,4 @@ If FILE-NAME is non-nil, save the result to FILE-NAME." (provide 'uudecode) -;; arch-tag: e1f09ed5-62b4-4677-9f13-4e81c4fe8ce3 ;;; uudecode.el ends here diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in index 871b690f007..df997b76585 100644 --- a/lisp/makefile.w32-in +++ b/lisp/makefile.w32-in @@ -32,10 +32,9 @@ srcdir = $(CURDIR)/.. EMACS = $(THISDIR)/../bin/emacs.exe -# Command line flags for Emacs. This must include --multibyte, -# otherwise some files will not compile. +# Command line flags for Emacs. -EMACSOPT = -batch --no-init-file --no-site-file --multibyte +EMACSOPT = -batch --no-init-file --no-site-file # Extra flags to pass to the byte compiler BYTE_COMPILE_EXTRA_FLAGS = diff --git a/lisp/md4.el b/lisp/md4.el index 32e3f376b13..6b28f757dbd 100644 --- a/lisp/md4.el +++ b/lisp/md4.el @@ -225,5 +225,4 @@ integers (cons high low)." (provide 'md4) -;; arch-tag: 99d706fe-089b-42ea-9507-67ae41091e6e ;;; md4.el ends here diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index 626472605ff..6149fea4769 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -6,6 +6,7 @@ ;; Author: RMS ;; Maintainer: FSF ;; Keywords: internal, mouse +;; Package: emacs ;; This file is part of GNU Emacs. @@ -462,7 +463,7 @@ ;; Emacs compiled --without-x doesn't have ;; x-selection-exists-p. (and (fboundp 'x-selection-exists-p) - (x-selection-exists-p)) + (x-selection-exists-p 'CLIPBOARD)) kill-ring) (not buffer-read-only)) :help ,(purecopy "Paste (yank) text most recently cut/copied"))) @@ -968,6 +969,15 @@ mail status in mode line")) :help ,(purecopy "Turn menu-bar on/off") :button (:toggle . (> (frame-parameter nil 'menu-bar-lines) 0)))) +(defun menu-bar-set-tool-bar-position (position) + (customize-set-variable 'tool-bar-mode t) + (dolist (frame (frame-list)) + (set-frame-parameter frame 'tool-bar-position position)) + (customize-set-variable 'default-frame-alist + (cons (cons 'tool-bar-position position) + (assq-delete-all 'tool-bar-position + default-frame-alist)))) + (defun menu-bar-showhide-tool-bar-menu-customize-disable () "Do not display tool bars." (interactive) @@ -975,24 +985,20 @@ mail status in mode line")) (defun menu-bar-showhide-tool-bar-menu-customize-enable-left () "Display tool bars on the left side." (interactive) - (customize-set-variable 'tool-bar-mode t) - (set-frame-parameter nil 'tool-bar-position 'left)) + (menu-bar-set-tool-bar-position 'left)) (defun menu-bar-showhide-tool-bar-menu-customize-enable-right () "Display tool bars on the right side." (interactive) - (customize-set-variable 'tool-bar-mode t) - (set-frame-parameter nil 'tool-bar-position 'right)) + (menu-bar-set-tool-bar-position 'right)) (defun menu-bar-showhide-tool-bar-menu-customize-enable-top () "Display tool bars on the top side." (interactive) - (customize-set-variable 'tool-bar-mode t) - (set-frame-parameter nil 'tool-bar-position 'top)) + (menu-bar-set-tool-bar-position 'top)) (defun menu-bar-showhide-tool-bar-menu-customize-enable-bottom () "Display tool bars on the bottom side." (interactive) - (customize-set-variable 'tool-bar-mode t) - (set-frame-parameter nil 'tool-bar-position 'bottom)) + (menu-bar-set-tool-bar-position 'bottom)) (if (featurep 'move-toolbar) (progn @@ -1268,6 +1274,9 @@ mail status in mode line")) (define-key menu-bar-games-menu [life] `(menu-item ,(purecopy "Life") life :help ,(purecopy "Watch how John Conway's cellular automaton evolves"))) +(define-key menu-bar-games-menu [land] + `(menu-item ,(purecopy "Landmark") landmark + :help ,(purecopy "Watch a neural-network robot learn landmarks"))) (define-key menu-bar-games-menu [hanoi] `(menu-item ,(purecopy "Towers of Hanoi") hanoi :help ,(purecopy "Watch Towers-of-Hanoi puzzle solved by Emacs"))) @@ -1477,6 +1486,9 @@ mail status in mode line")) (define-key menu-bar-describe-menu [describe-current-display-table] `(menu-item ,(purecopy "Describe Display Table") describe-current-display-table :help ,(purecopy "Describe the current display table"))) +(define-key menu-bar-describe-menu [describe-package] + `(menu-item ,(purecopy "Describe Package...") describe-package + :help ,(purecopy "Display documentation of a Lisp package"))) (define-key menu-bar-describe-menu [describe-face] `(menu-item ,(purecopy "Describe Face...") describe-face :help ,(purecopy "Display the properties of a face"))) @@ -1608,11 +1620,11 @@ key, a click, or a menu-item"))) (define-key menu-bar-help-menu [sep2] menu-bar-separator) (define-key menu-bar-help-menu [external-packages] - `(menu-item ,(purecopy "External Packages") menu-bar-help-extra-packages + `(menu-item ,(purecopy "Finding Extra Packages") menu-bar-help-extra-packages :help ,(purecopy "Lisp packages distributed separately for use in Emacs"))) (define-key menu-bar-help-menu [find-emacs-packages] - `(menu-item ,(purecopy "Find Emacs Packages") finder-by-keyword - :help ,(purecopy "Find packages and features by keyword"))) + `(menu-item ,(purecopy "Search Built-in Packages") finder-by-keyword + :help ,(purecopy "Find built-in packages and features by keyword"))) (define-key menu-bar-help-menu [more-manuals] `(menu-item ,(purecopy "More Manuals") ,menu-bar-manuals-menu)) (define-key menu-bar-help-menu [emacs-manual] diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 3f22099bfd1..f7dc035a886 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -3,6 +3,7 @@ ;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/misc.el b/lisp/misc.el index 4b2e78a3137..6f32a3eb90f 100644 --- a/lisp/misc.el +++ b/lisp/misc.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: convenience +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/mouse-sel.el b/lisp/mouse-sel.el index bd3054a5b94..f3875e24f07 100644 --- a/lisp/mouse-sel.el +++ b/lisp/mouse-sel.el @@ -98,7 +98,7 @@ ;; ;; Selection/kill-ring interaction is retained ;; interprogram-cut-function = x-select-text -;; interprogram-paste-function = x-cut-buffer-or-selection-value +;; interprogram-paste-function = x-selection-value ;; ;; What you lose is the ability to select some text in ;; delete-selection-mode and yank over the top of it. @@ -299,7 +299,7 @@ where SELECTION-NAME = name of selection SELECTION-THING-SYMBOL = name of variable where the current selection type for this selection should be stored.") -(declare-function x-select-text "term/x-win" (text &optional push)) +(declare-function x-select-text "term/x-win" (text)) (defvar mouse-sel-set-selection-function (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) @@ -314,15 +314,15 @@ Called with two arguments: SELECTION, the name of the selection concerned, and VALUE, the text to store. -This sets the selection as well as the cut buffer for the older applications, -unless `mouse-sel-default-bindings' is `interprogram-cut-paste'.") +This sets the selection, unless `mouse-sel-default-bindings' +is `interprogram-cut-paste'.") -(declare-function x-cut-buffer-or-selection-value "term/x-win" ()) +(declare-function x-selection-value "term/x-win" ()) (defvar mouse-sel-get-selection-function (lambda (selection) (if (eq selection 'PRIMARY) - (or (x-cut-buffer-or-selection-value) + (or (x-selection-value) (bound-and-true-p x-last-selected-text) (bound-and-true-p x-last-selected-text-primary)) (x-get-selection selection))) diff --git a/lisp/mouse.el b/lisp/mouse.el index 3bc3fcefa80..02ce48787e7 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: hardware, mouse +;; Package: emacs ;; This file is part of GNU Emacs. @@ -42,7 +43,10 @@ :group 'mouse) (defcustom mouse-drag-copy-region nil - "If non-nil, mouse drag copies region to kill-ring." + "If non-nil, copy to kill-ring upon mouse adjustments of the region. + +This affects `mouse-save-then-kill' (\\[mouse-save-then-kill]) in +addition to mouse drags." :type 'boolean :version "24.1" :group 'mouse) @@ -954,8 +958,7 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by '(only) (cons 'only transient-mark-mode))) (let ((range (mouse-start-end start-point start-point click-count))) - (goto-char (nth 0 range)) - (push-mark nil t t) + (push-mark (nth 0 range) t t) (goto-char (nth 1 range))) ;; Track the mouse until we get a non-movement event. @@ -974,14 +977,8 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by end-point (posn-point end)) (if (and (eq (posn-window end) start-window) (integer-or-marker-p end-point)) - ;; If moving in the original window, move point by going - ;; to start first, so that if end is in intangible text, - ;; point jumps away from start. Don't do it if - ;; start=end, or a single click would select a region if - ;; it's on intangible text. - (unless (= start-point end-point) - (goto-char start-point) - (goto-char end-point)) + (mouse--drag-set-mark-and-point start-point + end-point click-count) (let ((mouse-row (cdr (cdr (mouse-position))))) (cond ((null mouse-row)) @@ -999,8 +996,9 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by (eq (posn-window end) start-window) (integer-or-marker-p end-point) (/= start-point end-point)) - (goto-char start-point) - (goto-char end-point)) + (mouse--drag-set-mark-and-point start-point + end-point click-count)) + ;; Find its binding. (let* ((fun (key-binding (vector (car event)))) (do-multi-click (and (> (event-click-count event) 0) @@ -1051,6 +1049,21 @@ DO-MOUSE-DRAG-REGION-POST-PROCESS should only be used by (put 'mouse-2 'event-kind 'mouse-click))) (push event unread-command-events))))))) +(defun mouse--drag-set-mark-and-point (start click click-count) + (let* ((range (mouse-start-end start click click-count)) + (beg (nth 0 range)) + (end (nth 1 range))) + (cond ((eq (mark) beg) + (goto-char end)) + ((eq (mark) end) + (goto-char beg)) + ((< click (mark)) + (set-mark end) + (goto-char beg)) + (t + (set-mark beg) + (goto-char end))))) + (defun mouse--remap-link-click-p (start-event end-event) (or (and (eq mouse-1-click-follows-link 'double) (= (event-click-count start-event) 2)) @@ -1166,8 +1179,7 @@ If MODE is 2 then do the same for lines." ((= mode 2) (list (save-excursion (goto-char start) - (beginning-of-line 1) - (point)) + (line-beginning-position 1)) (save-excursion (goto-char end) (forward-line 1) @@ -1260,15 +1272,23 @@ regardless of where you click." (interactive "e") ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) + ;; Without this, confusing things happen upon e.g. inserting into + ;; the middle of an active region. (when select-active-regions - ;; Without this, confusing things happen upon e.g. inserting into - ;; the middle of an active region. - (deactivate-mark)) + (let (select-active-regions) + (deactivate-mark))) (or mouse-yank-at-point (mouse-set-point click)) - (let ((primary (x-get-selection 'PRIMARY))) + (let ((primary + (cond + ((fboundp 'x-get-selection-value) ; MS-DOS and MS-Windows + (or (x-get-selection-value) + (x-get-selection 'PRIMARY))) + ;; FIXME: What about xterm-mouse-mode etc.? + (t + (x-get-selection 'PRIMARY))))) (if primary (insert primary) - (error "No primary selection")))) + (error "No selection is available")))) (defun mouse-kill-ring-save (click) "Copy the region between point and the mouse click in the kill ring. @@ -1282,8 +1302,7 @@ This does not delete the region; it acts like \\[kill-ring-save]." ;; whenever it was equal to the front of the kill ring, but some ;; people found that confusing. -;; A list (TEXT START END), describing the text and position of the last -;; invocation of mouse-save-then-kill. +;; The position of the last invocation of `mouse-save-then-kill'. (defvar mouse-save-then-kill-posn nil) (defun mouse-save-then-kill-delete-region (beg end) @@ -1321,111 +1340,90 @@ This does not delete the region; it acts like \\[kill-ring-save]." (undo-boundary)) (defun mouse-save-then-kill (click) - "Set the region according to CLICK; the second time, kill the region. -Assuming this command is bound to a mouse button, CLICK is the -corresponding input event. - -If the region is already active, adjust it. Normally, this -happens by moving either point or mark, whichever is closer, to -the position of CLICK. But if you have selected words or lines, -the region is adjusted by moving point or mark to the word or -line boundary closest to CLICK. - -If the region is inactive, activate it temporarily; set mark at -the original point, and move click to the position of CLICK. - -However, if this command is being called a second time (i.e. the -value of `last-command' is `mouse-save-then-kill'), kill the -region instead. If the text in the region is the same as the -text in the front of the kill ring, just delete it." + "Set the region according to CLICK; the second time, kill it. +CLICK should be a mouse click event. + +If the region is inactive, activate it temporarily. Set mark at +the original point, and move point to the position of CLICK. + +If the region is already active, adjust it. Normally, do this by +moving point or mark, whichever is closer, to CLICK. But if you +have selected whole words or lines, move point or mark to the +word or line boundary closest to CLICK instead. + +If `mouse-drag-copy-region' is non-nil, this command also saves the +new region to the kill ring (replacing the previous kill if the +previous region was just saved to the kill ring). + +If this command is called a second consecutive time with the same +CLICK position, kill the region (or delete it +if `mouse-drag-copy-region' is non-nil)" (interactive "e") - (let ((before-scroll - (with-current-buffer (window-buffer (posn-window (event-start click))) - point-before-scroll))) - (mouse-minibuffer-check click) - (let ((click-posn (posn-point (event-start click))) - ;; Don't let a subsequent kill command append to this one: - ;; prevent setting this-command to kill-region. - (this-command this-command)) - (if (and (with-current-buffer - (window-buffer (posn-window (event-start click))) - (and (mark t) - (> (mod mouse-selection-click-count 3) 0) - ;; Don't be fooled by a recent click in some other buffer. - (eq mouse-selection-click-count-buffer - (current-buffer))))) - (if (and (eq last-command 'mouse-save-then-kill) - (equal click-posn (nth 2 mouse-save-then-kill-posn))) - ;; If we click this button again without moving it, kill. - (progn - ;; Call `deactivate-mark' to save the primary selection. - (deactivate-mark) - (mouse-save-then-kill-delete-region (mark) (point)) - (setq mouse-selection-click-count 0) - (setq mouse-save-then-kill-posn nil)) - ;; Find both ends of the object selected by this click. - (let* ((range - (mouse-start-end click-posn click-posn - mouse-selection-click-count))) - ;; Move whichever end is closer to the click. - ;; That's what xterm does, and it seems reasonable. - (if (< (abs (- click-posn (mark t))) - (abs (- click-posn (point)))) - (set-mark (car range)) - (goto-char (nth 1 range))) - ;; We have already put the old region in the kill ring. - ;; Replace it with the extended region. - ;; (It would be annoying to make a separate entry.) - (kill-new (buffer-substring (point) (mark t)) t) - (mouse-set-region-1) - ;; Arrange for a repeated mouse-3 to kill this region. - (setq mouse-save-then-kill-posn - (list (car kill-ring) (point) click-posn)))) - - (if (and (eq last-command 'mouse-save-then-kill) - mouse-save-then-kill-posn - (eq (car mouse-save-then-kill-posn) (car kill-ring)) - (equal (cdr mouse-save-then-kill-posn) - (list (point) click-posn))) - ;; If this is the second time we've called - ;; mouse-save-then-kill, delete the text from the buffer. - (progn - ;; Call `deactivate-mark' to save the primary selection. - (deactivate-mark) - (mouse-save-then-kill-delete-region (point) (mark t)) - ;; After we kill, another click counts as "the first time". - (setq mouse-save-then-kill-posn nil)) - ;; This is not a repetition. - ;; We are adjusting an old selection or creating a new one. - (if (or (and (eq last-command 'mouse-save-then-kill) - mouse-save-then-kill-posn) - (and mark-active transient-mark-mode) - (and (memq last-command - '(mouse-drag-region mouse-set-region)) - (or mark-even-if-inactive - (not transient-mark-mode)))) - ;; We have a selection or suitable region, so adjust it. - (let* ((posn (event-start click)) - (new (posn-point posn))) - (select-window (posn-window posn)) - (if (numberp new) - (progn - ;; Move whichever end of the region is closer to the click. - ;; That is what xterm does, and it seems reasonable. - (if (<= (abs (- new (point))) (abs (- new (mark t)))) - (goto-char new) - (set-mark new)) - (setq deactivate-mark nil))) - (kill-new (buffer-substring (point) (mark t)) t)) - ;; Set the mark where point is, then move where clicked. - (mouse-set-mark-fast click) - (if before-scroll - (goto-char before-scroll)) - (exchange-point-and-mark) ;Why??? --Stef - (kill-new (buffer-substring (point) (mark t)))) - (mouse-set-region-1) - (setq mouse-save-then-kill-posn - (list (car kill-ring) (point) click-posn))))))) + (mouse-minibuffer-check click) + (let* ((posn (event-start click)) + (click-pt (posn-point posn)) + (window (posn-window posn)) + (buf (window-buffer window)) + ;; Don't let a subsequent kill command append to this one. + (this-command this-command) + ;; Check if the user has multi-clicked to select words/lines. + (click-count + (if (and (eq mouse-selection-click-count-buffer buf) + (with-current-buffer buf (mark t))) + mouse-selection-click-count + 0))) + (cond + ((not (numberp click-pt)) nil) + ;; If the user clicked without moving point, kill the region. + ;; This also resets `mouse-selection-click-count'. + ((and (eq last-command 'mouse-save-then-kill) + (eq click-pt mouse-save-then-kill-posn) + (eq window (selected-window))) + (if mouse-drag-copy-region + ;; Region already saved in the previous click; + ;; don't make a duplicate entry, just delete. + (delete-region (mark t) (point)) + (kill-region (mark t) (point))) + (setq mouse-selection-click-count 0) + (setq mouse-save-then-kill-posn nil)) + + ;; Otherwise, if there is a suitable region, adjust it by moving + ;; one end (whichever is closer) to CLICK-PT. + ((or (with-current-buffer buf (region-active-p)) + (and (eq window (selected-window)) + (mark t) + (or (and (eq last-command 'mouse-save-then-kill) + mouse-save-then-kill-posn) + (and (memq last-command '(mouse-drag-region + mouse-set-region)) + (or mark-even-if-inactive + (not transient-mark-mode)))))) + (select-window window) + (let* ((range (mouse-start-end click-pt click-pt click-count))) + (if (< (abs (- click-pt (mark t))) + (abs (- click-pt (point)))) + (set-mark (car range)) + (goto-char (nth 1 range))) + (setq deactivate-mark nil) + (mouse-set-region-1) + (when mouse-drag-copy-region + ;; Region already copied to kill-ring once, so replace. + (kill-new (filter-buffer-substring (mark t) (point)) t)) + ;; Arrange for a repeated mouse-3 to kill the region. + (setq mouse-save-then-kill-posn click-pt))) + + ;; Otherwise, set the mark where point is and move to CLICK-PT. + (t + (select-window window) + (mouse-set-mark-fast click) + (let ((before-scroll (with-current-buffer buf point-before-scroll))) + (if before-scroll (goto-char before-scroll))) + (exchange-point-and-mark) + (mouse-set-region-1) + (when mouse-drag-copy-region + (kill-new (filter-buffer-substring (mark t) (point)))) + (setq mouse-save-then-kill-posn click-pt))))) + (global-set-key [M-mouse-1] 'mouse-start-secondary) (global-set-key [M-drag-mouse-1] 'mouse-set-secondary) @@ -1505,9 +1503,6 @@ The function returns a non-nil value if it creates a secondary selection." ;; of one word or line. (let ((range (mouse-start-end start-point start-point click-count))) (set-marker mouse-secondary-start nil) - ;; Why the double move? --Stef - ;; (move-overlay mouse-secondary-overlay 1 1 - ;; (window-buffer start-window)) (move-overlay mouse-secondary-overlay (car range) (nth 1 range) (window-buffer start-window))) ;; Single-press: cancel any preexisting secondary selection. @@ -1601,117 +1596,99 @@ is to prevent accidents." (delete-overlay mouse-secondary-overlay)) (defun mouse-secondary-save-then-kill (click) - "Save text to point in kill ring; the second time, kill the text. -You must use this in a buffer where you have recently done \\[mouse-start-secondary]. -If the text between where you did \\[mouse-start-secondary] and where -you use this command matches the text at the front of the kill ring, -this command deletes the text. -Otherwise, it adds the text to the kill ring, like \\[kill-ring-save], -which prepares for a second click with this command to delete the text. - -If you have already made a secondary selection in that buffer, -this command extends or retracts the selection to where you click. -If you do this again in a different position, it extends or retracts -again. If you do this twice in the same position, it kills the selection." + "Set the secondary selection and save it to the kill ring. +The second time, kill it. CLICK should be a mouse click event. + +If you have not called `mouse-start-secondary' in the clicked +buffer, activate the secondary selection and set it between point +and the click position CLICK. + +Otherwise, adjust the bounds of the secondary selection. +Normally, do this by moving its beginning or end, whichever is +closer, to CLICK. But if you have selected whole words or lines, +adjust to the word or line boundary closest to CLICK instead. + +If this command is called a second consecutive time with the same +CLICK position, kill the secondary selection." (interactive "e") (mouse-minibuffer-check click) - (let ((posn (event-start click)) - (click-posn (posn-point (event-start click))) - ;; Don't let a subsequent kill command append to this one: - ;; prevent setting this-command to kill-region. - (this-command this-command)) - (or (eq (window-buffer (posn-window posn)) - (or (overlay-buffer mouse-secondary-overlay) - (if mouse-secondary-start - (marker-buffer mouse-secondary-start)))) - (error "Wrong buffer")) - (with-current-buffer (window-buffer (posn-window posn)) - (if (> (mod mouse-secondary-click-count 3) 0) - (if (not (and (eq last-command 'mouse-secondary-save-then-kill) - (equal click-posn - (car (cdr-safe (cdr-safe mouse-save-then-kill-posn)))))) - ;; Find both ends of the object selected by this click. - (let* ((range - (mouse-start-end click-posn click-posn - mouse-secondary-click-count))) - ;; Move whichever end is closer to the click. - ;; That's what xterm does, and it seems reasonable. - (if (< (abs (- click-posn (overlay-start mouse-secondary-overlay))) - (abs (- click-posn (overlay-end mouse-secondary-overlay)))) - (move-overlay mouse-secondary-overlay (car range) - (overlay-end mouse-secondary-overlay)) - (move-overlay mouse-secondary-overlay - (overlay-start mouse-secondary-overlay) - (nth 1 range))) - ;; We have already put the old region in the kill ring. - ;; Replace it with the extended region. - ;; (It would be annoying to make a separate entry.) - (kill-new (buffer-substring - (overlay-start mouse-secondary-overlay) - (overlay-end mouse-secondary-overlay)) t) - ;; Arrange for a repeated mouse-3 to kill this region. - (setq mouse-save-then-kill-posn - (list (car kill-ring) (point) click-posn))) - ;; If we click this button again without moving it, - ;; that time kill. - (progn - (mouse-save-then-kill-delete-region - (overlay-start mouse-secondary-overlay) - (overlay-end mouse-secondary-overlay)) - (setq mouse-save-then-kill-posn nil) - (setq mouse-secondary-click-count 0) - (delete-overlay mouse-secondary-overlay))) - (if (and (eq last-command 'mouse-secondary-save-then-kill) - mouse-save-then-kill-posn - (eq (car mouse-save-then-kill-posn) (car kill-ring)) - (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn))) - ;; If this is the second time we've called - ;; mouse-secondary-save-then-kill, delete the text from the buffer. - (progn - (mouse-save-then-kill-delete-region - (overlay-start mouse-secondary-overlay) - (overlay-end mouse-secondary-overlay)) - (setq mouse-save-then-kill-posn nil) - (delete-overlay mouse-secondary-overlay)) - (if (overlay-start mouse-secondary-overlay) - ;; We have a selection, so adjust it. - (progn - (if (numberp click-posn) - (progn - ;; Move whichever end of the region is closer to the click. - ;; That is what xterm does, and it seems reasonable. - (if (< (abs (- click-posn (overlay-start mouse-secondary-overlay))) - (abs (- click-posn (overlay-end mouse-secondary-overlay)))) - (move-overlay mouse-secondary-overlay click-posn - (overlay-end mouse-secondary-overlay)) - (move-overlay mouse-secondary-overlay - (overlay-start mouse-secondary-overlay) - click-posn)) - (setq deactivate-mark nil))) - (if (eq last-command 'mouse-secondary-save-then-kill) - ;; If the front of the kill ring comes from - ;; an immediately previous use of this command, - ;; replace it with the extended region. - ;; (It would be annoying to make a separate entry.) - (kill-new (buffer-substring - (overlay-start mouse-secondary-overlay) - (overlay-end mouse-secondary-overlay)) t) - (let (deactivate-mark) - (copy-region-as-kill (overlay-start mouse-secondary-overlay) - (overlay-end mouse-secondary-overlay))))) - (if mouse-secondary-start - ;; All we have is one end of a selection, - ;; so put the other end here. - (let ((start (+ 0 mouse-secondary-start))) - (kill-ring-save start click-posn) - (move-overlay mouse-secondary-overlay start click-posn)))) - (setq mouse-save-then-kill-posn - (list (car kill-ring) (point) click-posn)))) - (if (overlay-buffer mouse-secondary-overlay) - (x-set-selection 'SECONDARY - (buffer-substring - (overlay-start mouse-secondary-overlay) - (overlay-end mouse-secondary-overlay))))))) + (let* ((posn (event-start click)) + (click-pt (posn-point posn)) + (window (posn-window posn)) + (buf (window-buffer window)) + ;; Don't let a subsequent kill command append to this one. + (this-command this-command) + ;; Check if the user has multi-clicked to select words/lines. + (click-count + (if (eq (overlay-buffer mouse-secondary-overlay) buf) + mouse-secondary-click-count + 0)) + (beg (overlay-start mouse-secondary-overlay)) + (end (overlay-end mouse-secondary-overlay))) + + (cond + ((not (numberp click-pt)) nil) + + ;; If the secondary selection is not active in BUF, activate it. + ((not (eq buf (or (overlay-buffer mouse-secondary-overlay) + (if mouse-secondary-start + (marker-buffer mouse-secondary-start))))) + (select-window window) + (setq mouse-secondary-start (make-marker)) + (move-marker mouse-secondary-start (point)) + (move-overlay mouse-secondary-overlay (point) click-pt buf) + (kill-ring-save (point) click-pt)) + + ;; If the user clicked without moving point, delete the secondary + ;; selection. This also resets `mouse-secondary-click-count'. + ((and (eq last-command 'mouse-secondary-save-then-kill) + (eq click-pt mouse-save-then-kill-posn) + (eq window (selected-window))) + (mouse-save-then-kill-delete-region beg end) + (delete-overlay mouse-secondary-overlay) + (setq mouse-secondary-click-count 0) + (setq mouse-save-then-kill-posn nil)) + + ;; Otherwise, if there is a suitable secondary selection overlay, + ;; adjust it by moving one end (whichever is closer) to CLICK-PT. + ((and beg (eq buf (overlay-buffer mouse-secondary-overlay))) + (let* ((range (mouse-start-end click-pt click-pt click-count))) + (if (< (abs (- click-pt beg)) + (abs (- click-pt end))) + (move-overlay mouse-secondary-overlay (car range) end) + (move-overlay mouse-secondary-overlay beg (nth 1 range)))) + (setq deactivate-mark nil) + (if (eq last-command 'mouse-secondary-save-then-kill) + ;; If the front of the kill ring comes from an immediately + ;; previous use of this command, replace the entry. + (kill-new + (buffer-substring (overlay-start mouse-secondary-overlay) + (overlay-end mouse-secondary-overlay)) + t) + (let (deactivate-mark) + (copy-region-as-kill (overlay-start mouse-secondary-overlay) + (overlay-end mouse-secondary-overlay)))) + (setq mouse-save-then-kill-posn click-pt)) + + ;; Otherwise, set the secondary selection overlay. + (t + (select-window window) + (if mouse-secondary-start + ;; All we have is one end of a selection, so put the other + ;; end here. + (let ((start (+ 0 mouse-secondary-start))) + (kill-ring-save start click-pt) + (move-overlay mouse-secondary-overlay start click-pt))) + (setq mouse-save-then-kill-posn click-pt)))) + + ;; Finally, set the window system's secondary selection. + (let (str) + (and (overlay-buffer mouse-secondary-overlay) + (setq str (buffer-substring (overlay-start mouse-secondary-overlay) + (overlay-end mouse-secondary-overlay))) + (> (length str) 0) + (x-set-selection 'SECONDARY str)))) + (defcustom mouse-buffer-menu-maxlen 20 "Number of buffers in one pane (submenu) of the buffer menu. @@ -1892,332 +1869,6 @@ and selects that window." ;; Few buffers--put them all in one pane. (list (cons title alist)))) -;; These need to be rewritten for the new scroll bar implementation. - -;;!! ;; Commands for the scroll bar. -;;!! -;;!! (defun mouse-scroll-down (click) -;;!! (interactive "@e") -;;!! (scroll-down (1+ (cdr (mouse-coords click))))) -;;!! -;;!! (defun mouse-scroll-up (click) -;;!! (interactive "@e") -;;!! (scroll-up (1+ (cdr (mouse-coords click))))) -;;!! -;;!! (defun mouse-scroll-down-full () -;;!! (interactive "@") -;;!! (scroll-down nil)) -;;!! -;;!! (defun mouse-scroll-up-full () -;;!! (interactive "@") -;;!! (scroll-up nil)) -;;!! -;;!! (defun mouse-scroll-move-cursor (click) -;;!! (interactive "@e") -;;!! (move-to-window-line (1+ (cdr (mouse-coords click))))) -;;!! -;;!! (defun mouse-scroll-absolute (event) -;;!! (interactive "@e") -;;!! (let* ((pos (car event)) -;;!! (position (car pos)) -;;!! (length (car (cdr pos)))) -;;!! (if (<= length 0) (setq length 1)) -;;!! (let* ((scale-factor (max 1 (/ length (/ 8000000 (buffer-size))))) -;;!! (newpos (* (/ (* (/ (buffer-size) scale-factor) -;;!! position) -;;!! length) -;;!! scale-factor))) -;;!! (goto-char newpos) -;;!! (recenter '(4))))) -;;!! -;;!! (defun mouse-scroll-left (click) -;;!! (interactive "@e") -;;!! (scroll-left (1+ (car (mouse-coords click))))) -;;!! -;;!! (defun mouse-scroll-right (click) -;;!! (interactive "@e") -;;!! (scroll-right (1+ (car (mouse-coords click))))) -;;!! -;;!! (defun mouse-scroll-left-full () -;;!! (interactive "@") -;;!! (scroll-left nil)) -;;!! -;;!! (defun mouse-scroll-right-full () -;;!! (interactive "@") -;;!! (scroll-right nil)) -;;!! -;;!! (defun mouse-scroll-move-cursor-horizontally (click) -;;!! (interactive "@e") -;;!! (move-to-column (1+ (car (mouse-coords click))))) -;;!! -;;!! (defun mouse-scroll-absolute-horizontally (event) -;;!! (interactive "@e") -;;!! (let* ((pos (car event)) -;;!! (position (car pos)) -;;!! (length (car (cdr pos)))) -;;!! (set-window-hscroll (selected-window) 33))) -;;!! -;;!! (global-set-key [scroll-bar mouse-1] 'mouse-scroll-up) -;;!! (global-set-key [scroll-bar mouse-2] 'mouse-scroll-absolute) -;;!! (global-set-key [scroll-bar mouse-3] 'mouse-scroll-down) -;;!! -;;!! (global-set-key [vertical-slider mouse-1] 'mouse-scroll-move-cursor) -;;!! (global-set-key [vertical-slider mouse-2] 'mouse-scroll-move-cursor) -;;!! (global-set-key [vertical-slider mouse-3] 'mouse-scroll-move-cursor) -;;!! -;;!! (global-set-key [thumbup mouse-1] 'mouse-scroll-up-full) -;;!! (global-set-key [thumbup mouse-2] 'mouse-scroll-up-full) -;;!! (global-set-key [thumbup mouse-3] 'mouse-scroll-up-full) -;;!! -;;!! (global-set-key [thumbdown mouse-1] 'mouse-scroll-down-full) -;;!! (global-set-key [thumbdown mouse-2] 'mouse-scroll-down-full) -;;!! (global-set-key [thumbdown mouse-3] 'mouse-scroll-down-full) -;;!! -;;!! (global-set-key [horizontal-scroll-bar mouse-1] 'mouse-scroll-left) -;;!! (global-set-key [horizontal-scroll-bar mouse-2] -;;!! 'mouse-scroll-absolute-horizontally) -;;!! (global-set-key [horizontal-scroll-bar mouse-3] 'mouse-scroll-right) -;;!! -;;!! (global-set-key [horizontal-slider mouse-1] -;;!! 'mouse-scroll-move-cursor-horizontally) -;;!! (global-set-key [horizontal-slider mouse-2] -;;!! 'mouse-scroll-move-cursor-horizontally) -;;!! (global-set-key [horizontal-slider mouse-3] -;;!! 'mouse-scroll-move-cursor-horizontally) -;;!! -;;!! (global-set-key [thumbleft mouse-1] 'mouse-scroll-left-full) -;;!! (global-set-key [thumbleft mouse-2] 'mouse-scroll-left-full) -;;!! (global-set-key [thumbleft mouse-3] 'mouse-scroll-left-full) -;;!! -;;!! (global-set-key [thumbright mouse-1] 'mouse-scroll-right-full) -;;!! (global-set-key [thumbright mouse-2] 'mouse-scroll-right-full) -;;!! (global-set-key [thumbright mouse-3] 'mouse-scroll-right-full) -;;!! -;;!! (global-set-key [horizontal-scroll-bar S-mouse-2] -;;!! 'mouse-split-window-horizontally) -;;!! (global-set-key [mode-line S-mouse-2] -;;!! 'mouse-split-window-horizontally) -;;!! (global-set-key [vertical-scroll-bar S-mouse-2] -;;!! 'mouse-split-window) - -;;!! ;;;; -;;!! ;;;; Here are experimental things being tested. Mouse events -;;!! ;;;; are of the form: -;;!! ;;;; ((x y) window screen-part key-sequence timestamp) -;;!! ;; -;;!! ;;;; -;;!! ;;;; Dynamically track mouse coordinates -;;!! ;;;; -;;!! ;; -;;!! ;;(defun track-mouse (event) -;;!! ;; "Track the coordinates, absolute and relative, of the mouse." -;;!! ;; (interactive "@e") -;;!! ;; (while mouse-grabbed -;;!! ;; (let* ((pos (read-mouse-position (selected-screen))) -;;!! ;; (abs-x (car pos)) -;;!! ;; (abs-y (cdr pos)) -;;!! ;; (relative-coordinate (coordinates-in-window-p -;;!! ;; (list (car pos) (cdr pos)) -;;!! ;; (selected-window)))) -;;!! ;; (if (consp relative-coordinate) -;;!! ;; (message "mouse: [%d %d], (%d %d)" abs-x abs-y -;;!! ;; (car relative-coordinate) -;;!! ;; (car (cdr relative-coordinate))) -;;!! ;; (message "mouse: [%d %d]" abs-x abs-y))))) -;;!! -;;!! ;; -;;!! ;; Dynamically put a box around the line indicated by point -;;!! ;; -;;!! ;; -;;!! ;;(require 'backquote) -;;!! ;; -;;!! ;;(defun mouse-select-buffer-line (event) -;;!! ;; (interactive "@e") -;;!! ;; (let ((relative-coordinate -;;!! ;; (coordinates-in-window-p (car event) (selected-window))) -;;!! ;; (abs-y (car (cdr (car event))))) -;;!! ;; (if (consp relative-coordinate) -;;!! ;; (progn -;;!! ;; (save-excursion -;;!! ;; (move-to-window-line (car (cdr relative-coordinate))) -;;!! ;; (x-draw-rectangle -;;!! ;; (selected-screen) -;;!! ;; abs-y 0 -;;!! ;; (save-excursion -;;!! ;; (move-to-window-line (car (cdr relative-coordinate))) -;;!! ;; (end-of-line) -;;!! ;; (push-mark nil t) -;;!! ;; (beginning-of-line) -;;!! ;; (- (region-end) (region-beginning))) 1)) -;;!! ;; (sit-for 1) -;;!! ;; (x-erase-rectangle (selected-screen)))))) -;;!! ;; -;;!! ;;(defvar last-line-drawn nil) -;;!! ;;(defvar begin-delim "[^ \t]") -;;!! ;;(defvar end-delim "[^ \t]") -;;!! ;; -;;!! ;;(defun mouse-boxing (event) -;;!! ;; (interactive "@e") -;;!! ;; (save-excursion -;;!! ;; (let ((screen (selected-screen))) -;;!! ;; (while (= (x-mouse-events) 0) -;;!! ;; (let* ((pos (read-mouse-position screen)) -;;!! ;; (abs-x (car pos)) -;;!! ;; (abs-y (cdr pos)) -;;!! ;; (relative-coordinate -;;!! ;; (coordinates-in-window-p `(,abs-x ,abs-y) -;;!! ;; (selected-window))) -;;!! ;; (begin-reg nil) -;;!! ;; (end-reg nil) -;;!! ;; (end-column nil) -;;!! ;; (begin-column nil)) -;;!! ;; (if (and (consp relative-coordinate) -;;!! ;; (or (not last-line-drawn) -;;!! ;; (not (= last-line-drawn abs-y)))) -;;!! ;; (progn -;;!! ;; (move-to-window-line (car (cdr relative-coordinate))) -;;!! ;; (if (= (following-char) 10) -;;!! ;; () -;;!! ;; (progn -;;!! ;; (setq begin-reg (1- (re-search-forward end-delim))) -;;!! ;; (setq begin-column (1- (current-column))) -;;!! ;; (end-of-line) -;;!! ;; (setq end-reg (1+ (re-search-backward begin-delim))) -;;!! ;; (setq end-column (1+ (current-column))) -;;!! ;; (message "%s" (buffer-substring begin-reg end-reg)) -;;!! ;; (x-draw-rectangle screen -;;!! ;; (setq last-line-drawn abs-y) -;;!! ;; begin-column -;;!! ;; (- end-column begin-column) 1)))))))))) -;;!! ;; -;;!! ;;(defun mouse-erase-box () -;;!! ;; (interactive) -;;!! ;; (if last-line-drawn -;;!! ;; (progn -;;!! ;; (x-erase-rectangle (selected-screen)) -;;!! ;; (setq last-line-drawn nil)))) -;;!! -;;!! ;;; (defun test-x-rectangle () -;;!! ;;; (use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap))) -;;!! ;;; (define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing) -;;!! ;;; (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box)) -;;!! -;;!! ;; -;;!! ;; Here is how to do double clicking in lisp. About to change. -;;!! ;; -;;!! -;;!! (defvar double-start nil) -;;!! (defconst double-click-interval 300 -;;!! "Max ticks between clicks") -;;!! -;;!! (defun double-down (event) -;;!! (interactive "@e") -;;!! (if double-start -;;!! (let ((interval (- (nth 4 event) double-start))) -;;!! (if (< interval double-click-interval) -;;!! (progn -;;!! (backward-up-list 1) -;;!! ;; (message "Interval %d" interval) -;;!! (sleep-for 1))) -;;!! (setq double-start nil)) -;;!! (setq double-start (nth 4 event)))) -;;!! -;;!! (defun double-up (event) -;;!! (interactive "@e") -;;!! (and double-start -;;!! (> (- (nth 4 event ) double-start) double-click-interval) -;;!! (setq double-start nil))) -;;!! -;;!! ;;; (defun x-test-doubleclick () -;;!! ;;; (use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap))) -;;!! ;;; (define-key doubleclick-test-map mouse-button-left 'double-down) -;;!! ;;; (define-key doubleclick-test-map mouse-button-left-up 'double-up)) -;;!! -;;!! ;; -;;!! ;; This scrolls while button is depressed. Use preferable in scroll bar. -;;!! ;; -;;!! -;;!! (defvar scrolled-lines 0) -;;!! (defconst scroll-speed 1) -;;!! -;;!! (defun incr-scroll-down (event) -;;!! (interactive "@e") -;;!! (setq scrolled-lines 0) -;;!! (incremental-scroll scroll-speed)) -;;!! -;;!! (defun incr-scroll-up (event) -;;!! (interactive "@e") -;;!! (setq scrolled-lines 0) -;;!! (incremental-scroll (- scroll-speed))) -;;!! -;;!! (defun incremental-scroll (n) -;;!! (while (= (x-mouse-events) 0) -;;!! (setq scrolled-lines (1+ (* scroll-speed scrolled-lines))) -;;!! (scroll-down n) -;;!! (sit-for 300 t))) -;;!! -;;!! (defun incr-scroll-stop (event) -;;!! (interactive "@e") -;;!! (message "Scrolled %d lines" scrolled-lines) -;;!! (setq scrolled-lines 0) -;;!! (sleep-for 1)) -;;!! -;;!! ;;; (defun x-testing-scroll () -;;!! ;;; (let ((scrolling-map (function mouse-vertical-scroll-bar-prefix))) -;;!! ;;; (define-key scrolling-map mouse-button-left 'incr-scroll-down) -;;!! ;;; (define-key scrolling-map mouse-button-right 'incr-scroll-up) -;;!! ;;; (define-key scrolling-map mouse-button-left-up 'incr-scroll-stop) -;;!! ;;; (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop))) -;;!! -;;!! ;; -;;!! ;; Some playthings suitable for picture mode? They need work. -;;!! ;; -;;!! -;;!! (defun mouse-kill-rectangle (event) -;;!! "Kill the rectangle between point and the mouse cursor." -;;!! (interactive "@e") -;;!! (let ((point-save (point))) -;;!! (save-excursion -;;!! (mouse-set-point event) -;;!! (push-mark nil t) -;;!! (if (> point-save (point)) -;;!! (kill-rectangle (point) point-save) -;;!! (kill-rectangle point-save (point)))))) -;;!! -;;!! (defun mouse-open-rectangle (event) -;;!! "Kill the rectangle between point and the mouse cursor." -;;!! (interactive "@e") -;;!! (let ((point-save (point))) -;;!! (save-excursion -;;!! (mouse-set-point event) -;;!! (push-mark nil t) -;;!! (if (> point-save (point)) -;;!! (open-rectangle (point) point-save) -;;!! (open-rectangle point-save (point)))))) -;;!! -;;!! ;; Must be a better way to do this. -;;!! -;;!! (defun mouse-multiple-insert (n char) -;;!! (while (> n 0) -;;!! (insert char) -;;!! (setq n (1- n)))) -;;!! -;;!! ;; What this could do is not finalize until button was released. -;;!! -;;!! (defun mouse-move-text (event) -;;!! "Move text from point to cursor position, inserting spaces." -;;!! (interactive "@e") -;;!! (let* ((relative-coordinate -;;!! (coordinates-in-window-p (car event) (selected-window)))) -;;!! (if (consp relative-coordinate) -;;!! (cond ((> (current-column) (car relative-coordinate)) -;;!! (delete-char -;;!! (- (car relative-coordinate) (current-column)))) -;;!! ((< (current-column) (car relative-coordinate)) -;;!! (mouse-multiple-insert -;;!! (- (car relative-coordinate) (current-column)) " ")) -;;!! ((= (current-column) (car relative-coordinate)) (ding)))))) - (define-obsolete-function-alias 'mouse-choose-completion 'choose-completion "23.2") @@ -2460,10 +2111,6 @@ choose a font." (mouse-menu-bar-map) (mouse-menu-major-mode-map))))) - -;; Replaced with dragging mouse-1 -;; (global-set-key [S-mouse-1] 'mouse-set-mark) - ;; Binding mouse-1 to mouse-select-window when on mode-, header-, or ;; vertical-line prevents Emacs from signaling an error when the mouse ;; button is released after dragging these lines, on non-toolkit diff --git a/lisp/mwheel.el b/lisp/mwheel.el index 743204cbe45..2fc84c06245 100644 --- a/lisp/mwheel.el +++ b/lisp/mwheel.el @@ -4,6 +4,7 @@ ;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Maintainer: William M. Perry <wmperry@gnu.org> ;; Keywords: mouse +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 420381cf43e..fb9b57b724d 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -892,6 +892,7 @@ The order attempted is gnome-moz-remote, Mozilla, Firefox, Galeon, Konqueror, Netscape, Mosaic, Lynx in an xterm, and then W3." (apply (cond + ((browse-url-can-use-xdg-open) 'browse-url-xdg-open) ((executable-find browse-url-gnome-moz-program) 'browse-url-gnome-moz) ((executable-find browse-url-mozilla-program) 'browse-url-mozilla) ((executable-find browse-url-firefox-program) 'browse-url-firefox) @@ -905,6 +906,41 @@ Galeon, Konqueror, Netscape, Mosaic, Lynx in an xterm, and then W3." (lambda (&rest ignore) (error "No usable browser found")))) url args)) +(defun browse-url-can-use-xdg-open () + "Check if xdg-open can be used, i.e. we are on Gnome, KDE or xfce4." + (and (getenv "DISPLAY") + (executable-find "xdg-open") + ;; xdg-open may call gnome-open and that does not wait for its child + ;; to finish. This child may then be killed when the parent dies. + ;; Use nohup to work around. + (executable-find "nohup") + (or (getenv "GNOME_DESKTOP_SESSION_ID") + ;; GNOME_DESKTOP_SESSION_ID is deprecated, check on Dbus also. + (condition-case nil + (eq 0 (call-process + "dbus-send" nil nil nil + "--dest=org.gnome.SessionManager" + "--print-reply" + "/org/gnome/SessionManager" + "org.gnome.SessionManager.CanShutdown")) + (error nil)) + (equal (getenv "KDE_FULL_SESSION") "true") + (condition-case nil + (eq 0 (call-process + "/bin/sh" nil nil nil + "-c" + "xprop -root _DT_SAVE_MODE|grep xfce4")) + (error nil))))) + + +;;;###autoload +(defun browse-url-xdg-open (url &optional new-window) + (interactive (browse-url-interactive-arg "URL: ")) + (call-process "/bin/sh" nil nil nil + "-c" + (concat "nohup xdg-open " url + ">/dev/null 2>&1 </dev/null"))) + ;;;###autoload (defun browse-url-netscape (url &optional new-window) "Ask the Netscape WWW browser to load URL. diff --git a/lisp/net/dbus.el b/lisp/net/dbus.el index 870bd2e313d..8d9512d6f9f 100644 --- a/lisp/net/dbus.el +++ b/lisp/net/dbus.el @@ -92,12 +92,10 @@ (defmacro dbus-ignore-errors (&rest body) "Execute BODY; signal D-Bus error when `dbus-debug' is non-nil. Otherwise, return result of last form in BODY, or all other errors." + (declare (indent 0) (debug t)) `(condition-case err (progn ,@body) (dbus-error (when dbus-debug (signal (car err) (cdr err)))))) - -(put 'dbus-ignore-errors 'lisp-indent-function 0) -(put 'dbus-ignore-errors 'edebug-form-spec '(form body)) (font-lock-add-keywords 'emacs-lisp-mode '("\\<dbus-ignore-errors\\>")) (defvar dbus-event-error-hooks nil @@ -108,15 +106,12 @@ catched in `condition-case' by `dbus-error'.") ;;; Hash table of registered functions. -;; We create it here. So we have a simple test in dbusbind.c, whether -;; the Lisp code has been loaded. -(setq dbus-registered-objects-table (make-hash-table :test 'equal)) - (defvar dbus-return-values-table (make-hash-table :test 'equal) "Hash table for temporary storing arguments of reply messages. -A key in this hash table is a list (BUS SERIAL). BUS is either the -symbol `:system' or the symbol `:session'. SERIAL is the serial number -of the reply message. See `dbus-call-method-non-blocking-handler' and +A key in this hash table is a list (BUS SERIAL). BUS is either a +Lisp symbol, `:system' or `:session', or a string denoting the +bus address. SERIAL is the serial number of the reply message. +See `dbus-call-method-non-blocking-handler' and `dbus-call-method-non-blocking'.") (defun dbus-list-hash-table () @@ -187,8 +182,8 @@ association to the service from D-Bus." (defun dbus-unregister-service (bus service) "Unregister all objects related to SERVICE from D-Bus BUS. -BUS must be either the symbol `:system' or the symbol `:session'. -SERVICE must be a known service name." +BUS is either a Lisp symbol, `:system' or `:session', or a string +denoting the bus address. SERVICE must be a known service name." (maphash (lambda (key value) (dolist (elt value) @@ -353,15 +348,15 @@ EVENT is a list which starts with symbol `dbus-event': (dbus-event BUS TYPE SERIAL SERVICE PATH INTERFACE MEMBER HANDLER &rest ARGS) BUS identifies the D-Bus the message is coming from. It is -either the symbol `:system' or the symbol `:session'. TYPE is -the D-Bus message type which has caused the event, SERIAL is the -serial number of the received D-Bus message. SERVICE and PATH -are the unique name and the object path of the D-Bus object -emitting the message. INTERFACE and MEMBER denote the message -which has been sent. HANDLER is the function which has been -registered for this message. ARGS are the arguments passed to -HANDLER, when it is called during event handling in -`dbus-handle-event'. +either a Lisp symbol, `:system' or `:session', or a string +denoting the bus address. TYPE is the D-Bus message type which +has caused the event, SERIAL is the serial number of the received +D-Bus message. SERVICE and PATH are the unique name and the +object path of the D-Bus object emitting the message. INTERFACE +and MEMBER denote the message which has been sent. HANDLER is +the function which has been registered for this message. ARGS +are the arguments passed to HANDLER, when it is called during +event handling in `dbus-handle-event'. This function raises a `dbus-error' signal in case the event is not well formed." @@ -369,7 +364,8 @@ not well formed." (unless (and (listp event) (eq (car event) 'dbus-event) ;; Bus symbol. - (symbolp (nth 1 event)) + (or (symbolp (nth 1 event)) + (stringp (nth 1 event))) ;; Type. (and (natnump (nth 2 event)) (< dbus-message-type-invalid (nth 2 event))) @@ -434,9 +430,10 @@ If the HANDLER returns a `dbus-error', it is propagated as return message." (defun dbus-event-bus-name (event) "Return the bus name the event is coming from. -The result is either the symbol `:system' or the symbol `:session'. -EVENT is a D-Bus event, see `dbus-check-event'. This function -raises a `dbus-error' signal in case the event is not well formed." +The result is either a Lisp symbol, `:system' or `:session', or a +string denoting the bus address. EVENT is a D-Bus event, see +`dbus-check-event'. This function raises a `dbus-error' signal +in case the event is not well formed." (dbus-check-event event) (nth 1 event)) @@ -566,10 +563,11 @@ apply "Return all interfaces and sub-nodes of SERVICE, registered at object path PATH at bus BUS. -BUS must be either the symbol `:system' or the symbol `:session'. -SERVICE must be a known service name, and PATH must be a valid -object path. The last two parameters are strings. The result, -the introspection data, is a string in XML format." +BUS is either a Lisp symbol, `:system' or `:session', or a string +denoting the bus address. SERVICE must be a known service name, +and PATH must be a valid object path. The last two parameters +are strings. The result, the introspection data, is a string in +XML format." ;; We don't want to raise errors. `dbus-call-method-non-blocking' ;; is used, because the handler can be registered in our Emacs ;; instance; caller an callee would block each other. @@ -873,7 +871,8 @@ name of the property, and its value. If there are no properties, (bus service path interface property access value &optional emits-signal) "Register property PROPERTY on the D-Bus BUS. -BUS is either the symbol `:system' or the symbol `:session'. +BUS is either a Lisp symbol, `:system' or `:session', or a string +denoting the bus address. SERVICE is the D-Bus service name of the D-Bus. It must be a known name. diff --git a/lisp/net/dig.el b/lisp/net/dig.el index add3c2f7a0d..9392c73855b 100644 --- a/lisp/net/dig.el +++ b/lisp/net/dig.el @@ -184,5 +184,4 @@ Returns nil for domain/class/type queries that result in no data." (provide 'dig) -;; arch-tag: 1d61726e-9400-4013-9ae7-4035e0c7f7d6 ;;; dig.el ends here diff --git a/lisp/net/dns.el b/lisp/net/dns.el index d3717371927..2d4c2d8cd8b 100644 --- a/lisp/net/dns.el +++ b/lisp/net/dns.el @@ -151,7 +151,7 @@ If TCP-P, the first two bytes of the package with be the length field." (lsh (if (dns-get 'truncated-p spec) 1 0) -1) (lsh (if (dns-get 'recursion-desired-p spec) 1 0) 0))) (dns-write-bytes - (cond + (cond ((eq (dns-get 'response-code spec) 'no-error) 0) ((eq (dns-get 'response-code spec) 'format-error) 1) ((eq (dns-get 'response-code spec) 'server-failure) 2) @@ -438,5 +438,4 @@ If REVERSEP, look up an IP address." (provide 'dns) -;; arch-tag: d0edd0c4-4cce-4538-ae92-06c3356ee80a ;;; dns.el ends here diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el index fe41d70a090..962020f2b30 100644 --- a/lisp/net/eudc-bob.el +++ b/lisp/net/eudc-bob.el @@ -6,6 +6,7 @@ ;; Author: Oscar Figueiredo <oscar@cpe.fr> ;; Maintainer: Pavel Janík <Pavel@Janik.cz> ;; Keywords: comm +;; Package: eudc ;; This file is part of GNU Emacs. diff --git a/lisp/net/eudc-export.el b/lisp/net/eudc-export.el index 7aa30cfcb66..91abac571b8 100644 --- a/lisp/net/eudc-export.el +++ b/lisp/net/eudc-export.el @@ -6,6 +6,7 @@ ;; Author: Oscar Figueiredo <oscar@cpe.fr> ;; Maintainer: Pavel Janík <Pavel@Janik.cz> ;; Keywords: comm +;; Package: eudc ;; This file is part of GNU Emacs. diff --git a/lisp/net/eudc-hotlist.el b/lisp/net/eudc-hotlist.el index 5f165ad2e25..7798fa43d99 100644 --- a/lisp/net/eudc-hotlist.el +++ b/lisp/net/eudc-hotlist.el @@ -6,6 +6,7 @@ ;; Author: Oscar Figueiredo <oscar@cpe.fr> ;; Maintainer: Pavel Janík <Pavel@Janik.cz> ;; Keywords: comm +;; Package: eudc ;; This file is part of GNU Emacs. diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el index 5f8de5ec751..3f82816fabe 100644 --- a/lisp/net/eudc-vars.el +++ b/lisp/net/eudc-vars.el @@ -6,6 +6,7 @@ ;; Author: Oscar Figueiredo <oscar@cpe.fr> ;; Maintainer: Pavel Janík <Pavel@Janik.cz> ;; Keywords: comm +;; Package: eudc ;; This file is part of GNU Emacs. diff --git a/lisp/net/eudcb-bbdb.el b/lisp/net/eudcb-bbdb.el index 0ddfa81a501..aa4315077e4 100644 --- a/lisp/net/eudcb-bbdb.el +++ b/lisp/net/eudcb-bbdb.el @@ -6,6 +6,7 @@ ;; Author: Oscar Figueiredo <oscar@cpe.fr> ;; Maintainer: Pavel Janík <Pavel@Janik.cz> ;; Keywords: comm +;; Package: eudc ;; This file is part of GNU Emacs. diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el index fc90be96b5d..e2ca2acaddb 100644 --- a/lisp/net/eudcb-ldap.el +++ b/lisp/net/eudcb-ldap.el @@ -6,6 +6,7 @@ ;; Author: Oscar Figueiredo <oscar@cpe.fr> ;; Maintainer: Pavel Janík <Pavel@Janik.cz> ;; Keywords: comm +;; Package: eudc ;; This file is part of GNU Emacs. diff --git a/lisp/net/eudcb-mab.el b/lisp/net/eudcb-mab.el index 8705be81b04..d848b9953a3 100644 --- a/lisp/net/eudcb-mab.el +++ b/lisp/net/eudcb-mab.el @@ -6,6 +6,7 @@ ;; Author: John Wiegley <johnw@newartisans.com> ;; Maintainer: FSF ;; Keywords: comm +;; Package: eudc ;; This file is part of GNU Emacs. diff --git a/lisp/net/eudcb-ph.el b/lisp/net/eudcb-ph.el index bd2e75ced0a..c0e4f81d31c 100644 --- a/lisp/net/eudcb-ph.el +++ b/lisp/net/eudcb-ph.el @@ -6,6 +6,7 @@ ;; Author: Oscar Figueiredo <oscar@cpe.fr> ;; Maintainer: Pavel Janík <Pavel@Janik.cz> ;; Keywords: comm +;; Package: eudc ;; This file is part of GNU Emacs. diff --git a/lisp/net/hmac-def.el b/lisp/net/hmac-def.el index 5f57ea617ba..c16fffc8de4 100644 --- a/lisp/net/hmac-def.el +++ b/lisp/net/hmac-def.el @@ -80,5 +80,4 @@ If BIT is non-nil, truncate output to specified bits." (provide 'hmac-def) -;; arch-tag: 645adcef-b835-4900-a10a-11f636c982b9 ;;; hmac-def.el ends here diff --git a/lisp/net/hmac-md5.el b/lisp/net/hmac-md5.el index 045a12520a1..a0bfd36ea69 100644 --- a/lisp/net/hmac-md5.el +++ b/lisp/net/hmac-md5.el @@ -79,5 +79,4 @@ (provide 'hmac-md5) -;; arch-tag: 0ab3f4f6-3d4b-4167-a9fa-635b7fed7f27 ;;; hmac-md5.el ends here diff --git a/lisp/net/imap.el b/lisp/net/imap.el index f9c89cd8162..e286a14a0e4 100644 --- a/lisp/net/imap.el +++ b/lisp/net/imap.el @@ -267,7 +267,7 @@ See also `imap-log'." :type 'string) (defcustom imap-read-timeout (if (string-match - "windows-nt\\|os/2\\|emx\\|cygwin" + "windows-nt\\|os/2\\|cygwin" (symbol-name system-type)) 1.0 0.1) @@ -448,18 +448,6 @@ The actual value is really the text on the continuation line.") The function should take two arguments, the first the IMAP tag and the second the status (OK, NO, BAD etc) of the command.") -(defvar imap-enable-exchange-bug-workaround nil - "Send FETCH UID commands as *:* instead of *. - -When non-nil, use an alternative UIDS form. Enabling appears to -be required for some servers (e.g., Microsoft Exchange 2007) -which otherwise would trigger a response 'BAD The specified -message set is invalid.'. We don't unconditionally use this -form, since this is said to be significantly inefficient. - -This variable is set to t automatically per server if the -canonical form fails.") - ;; Utility functions: @@ -515,6 +503,16 @@ sure of changing the value of `foo'." ;; Server functions; stream stuff: +(defun imap-log (string-or-buffer) + (when imap-log + (with-current-buffer (get-buffer-create imap-log-buffer) + (imap-disable-multibyte) + (buffer-disable-undo) + (goto-char (point-max)) + (if (bufferp string-or-buffer) + (insert-buffer-substring string-or-buffer) + (insert string-or-buffer))))) + (defun imap-kerberos4-stream-p (buffer) (imap-capability 'AUTH=KERBEROS_V4 buffer)) @@ -569,12 +567,6 @@ sure of changing the value of `foo'." (setq response (match-string 1))))) (accept-process-output process 1) (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) (erase-buffer) (message "Opening Kerberos 4 IMAP connection with `%s'...%s" cmd (if response (concat "done, " response) "failed")) @@ -645,12 +637,7 @@ sure of changing the value of `foo'." (setq response (match-string 1))))) (accept-process-output process 1) (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) + (imap-log buffer) (erase-buffer) (message "GSSAPI IMAP connection: %s" (or response "failed")) (if (and response (let ((case-fold-search nil)) @@ -701,12 +688,7 @@ sure of changing the value of `foo'." (not (imap-parse-greeting))) (accept-process-output process 1) (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) + (imap-log buffer) (erase-buffer) (when (memq (process-status process) '(open run)) (setq done process)))))) @@ -740,12 +722,7 @@ sure of changing the value of `foo'." (not (imap-parse-greeting))) (accept-process-output process 1) (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) + (imap-log buffer) (when (memq (process-status process) '(open run)) process)))) @@ -764,12 +741,7 @@ sure of changing the value of `foo'." (not (imap-parse-greeting))) (accept-process-output process 1) (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) + (imap-log buffer) (when (memq (process-status process) '(open run)) process)))) @@ -803,12 +775,7 @@ sure of changing the value of `foo'." (not (imap-parse-greeting))) (accept-process-output process 1) (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) + (imap-log buffer) (erase-buffer) (when (memq (process-status process) '(open run)) (setq done process))))) @@ -845,11 +812,7 @@ sure of changing the value of `foo'." (not (re-search-forward "[0-9]+ OK.*\r?\n" nil t))) (accept-process-output process 1) (sit-for 1)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring buffer))) + (imap-log buffer) (when (and (setq tls-info (starttls-negotiate process)) (memq (process-status process) '(open run))) (setq done process))) @@ -1227,7 +1190,7 @@ password is remembered in the buffer." (when user (setq imap-username user)) (when passwd (setq imap-password passwd)) (if imap-auth - (and (setq imap-last-authenticator + (and (setq imap-last-authenticator (assq imap-auth imap-authenticator-alist)) (funcall (nth 2 imap-last-authenticator) (current-buffer)) (setq imap-state 'auth)) @@ -1340,40 +1303,38 @@ If BUFFER is nil, the current buffer is assumed." ;; Mailbox functions: -(defun imap-mailbox-put (propname value &optional mailbox buffer) - (with-current-buffer (or buffer (current-buffer)) - (if imap-mailbox-data - (put (intern (or mailbox imap-current-mailbox) imap-mailbox-data) - propname value) - (error "Imap-mailbox-data is nil, prop %s value %s mailbox %s buffer %s" - propname value mailbox (current-buffer))) - t)) +(defun imap-mailbox-put (propname value &optional mailbox) + (if imap-mailbox-data + (put (intern (or mailbox imap-current-mailbox) imap-mailbox-data) + propname value) + (error "Imap-mailbox-data is nil, prop %s value %s mailbox %s buffer %s" + propname value mailbox (current-buffer))) + t) (defsubst imap-mailbox-get-1 (propname &optional mailbox) (get (intern-soft (or mailbox imap-current-mailbox) imap-mailbox-data) propname)) (defun imap-mailbox-get (propname &optional mailbox buffer) - (let ((mailbox (imap-utf7-encode mailbox))) - (with-current-buffer (or buffer (current-buffer)) - (imap-mailbox-get-1 propname (or mailbox imap-current-mailbox))))) - -(defun imap-mailbox-map-1 (func &optional mailbox-decoder buffer) (with-current-buffer (or buffer (current-buffer)) - (let (result) - (mapatoms - (lambda (s) - (push (funcall func (if mailbox-decoder - (funcall mailbox-decoder (symbol-name s)) - (symbol-name s))) result)) - imap-mailbox-data) - result))) - -(defun imap-mailbox-map (func &optional buffer) + (imap-mailbox-get-1 propname (or (imap-utf7-encode mailbox) + imap-current-mailbox)))) + +(defun imap-mailbox-map-1 (func &optional mailbox-decoder) + (let (result) + (mapatoms + (lambda (s) + (push (funcall func (if mailbox-decoder + (funcall mailbox-decoder (symbol-name s)) + (symbol-name s))) result)) + imap-mailbox-data) + result)) + +(defun imap-mailbox-map (func) "Map a function across each mailbox in `imap-mailbox-data', returning a list. Function should take a mailbox name (a string) as the only argument." - (imap-mailbox-map-1 func 'imap-utf7-decode buffer)) + (imap-mailbox-map-1 func 'imap-utf7-decode)) (defun imap-current-mailbox (&optional buffer) (with-current-buffer (or buffer (current-buffer)) @@ -1687,29 +1648,26 @@ is non-nil return these properties." uids) (imap-message-get uids receive)))))) -(defun imap-message-put (uid propname value &optional buffer) - (with-current-buffer (or buffer (current-buffer)) - (if imap-message-data - (put (intern (number-to-string uid) imap-message-data) - propname value) - (error "Imap-message-data is nil, uid %s prop %s value %s buffer %s" - uid propname value (current-buffer))) - t)) +(defun imap-message-put (uid propname value) + (if imap-message-data + (put (intern (number-to-string uid) imap-message-data) + propname value) + (error "Imap-message-data is nil, uid %s prop %s value %s buffer %s" + uid propname value (current-buffer))) + t) -(defun imap-message-get (uid propname &optional buffer) - (with-current-buffer (or buffer (current-buffer)) - (get (intern-soft (number-to-string uid) imap-message-data) - propname))) +(defun imap-message-get (uid propname) + (get (intern-soft (number-to-string uid) imap-message-data) + propname)) -(defun imap-message-map (func propname &optional buffer) +(defun imap-message-map (func propname) "Map a function across each message in `imap-message-data', returning a list." - (with-current-buffer (or buffer (current-buffer)) - (let (result) - (mapatoms - (lambda (s) - (push (funcall func (get s 'UID) (get s propname)) result)) - imap-message-data) - result))) + (let (result) + (mapatoms + (lambda (s) + (push (funcall func (get s 'UID) (get s propname)) result)) + imap-message-data) + result)) (defmacro imap-message-envelope-date (uid &optional buffer) `(with-current-buffer (or ,buffer (current-buffer)) @@ -1805,48 +1763,6 @@ is non-nil return these properties." (format "String %s cannot be converted to a Lisp integer" number)) number))) -(defun imap-fetch-safe (uids props &optional receive nouidfetch buffer) - "Like `imap-fetch', but DTRT with Exchange 2007 bug. -However, UIDS here is a cons, where the car is the canonical form -of the UIDS specification, and the cdr is the one which works with -Exchange 2007 or, potentially, other buggy servers. -See `imap-enable-exchange-bug-workaround'." - ;; The first time we get here for a given, we'll try the canonical - ;; form. If we get the known error from the buggy server, set the - ;; flag buffer-locally (to account for connections to multiple - ;; servers), then re-try with the alternative UIDS spec. We don't - ;; unconditionally use the alternative form, since the - ;; currently-used alternatives are seriously inefficient with some - ;; servers (although they are valid). - ;; - ;; FIXME: Maybe it would be cleaner to have a flag to not signal - ;; the error (which otherwise gives a message), and test - ;; `imap-failed-tags'. Also, Other IMAP clients use other forms of - ;; request which work with Exchange, e.g. Claws does "UID FETCH 1:* - ;; (UID)" rather than "FETCH UID 1,*". Is there a good reason not - ;; to do the same? - (condition-case data - ;; Binding `debug-on-error' allows us to get the error from - ;; `imap-parse-response' -- it's normally caught by Emacs around - ;; execution of a process filter. - (let ((debug-on-error t)) - (imap-fetch (if imap-enable-exchange-bug-workaround - (cdr uids) - (car uids)) - props receive nouidfetch buffer)) - (error - (if (and (not imap-enable-exchange-bug-workaround) - ;; This is the Exchange 2007 response. It may be more - ;; robust just to check for a BAD response to the - ;; attempted fetch. - (string-match "The specified message set is invalid" - (cadr data))) - (with-current-buffer (or buffer (current-buffer)) - (set (make-local-variable 'imap-enable-exchange-bug-workaround) - t) - (imap-fetch (cdr uids) props receive nouidfetch)) - (signal (car data) (cdr data)))))) - (defun imap-message-copyuid-1 (mailbox) (if (imap-capability 'UIDPLUS) (list (nth 0 (imap-mailbox-get-1 'copyuid mailbox)) @@ -1856,7 +1772,7 @@ See `imap-enable-exchange-bug-workaround'." (imap-message-data (make-vector 2 0))) (when (imap-mailbox-examine-1 mailbox) (prog1 - (and (imap-fetch-safe '("*" . "*:*") "UID") + (and (imap-fetch "*:*" "UID") (list (imap-mailbox-get-1 'uidvalidity mailbox) (apply 'max (imap-message-map (lambda (uid prop) uid) 'UID)))) @@ -1902,7 +1818,7 @@ first element. The rest of list contains the saved articles' UIDs." (imap-message-data (make-vector 2 0))) (when (imap-mailbox-examine-1 mailbox) (prog1 - (and (imap-fetch-safe '("*" . "*:*") "UID") + (and (imap-fetch "*:*" "UID") (list (imap-mailbox-get-1 'uidvalidity mailbox) (apply 'max (imap-message-map (lambda (uid prop) uid) 'UID)))) @@ -1959,12 +1875,7 @@ on failure." (defun imap-send-command-1 (cmdstr) (setq cmdstr (concat cmdstr imap-client-eol)) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert cmdstr))) + (imap-log cmdstr) (process-send-string imap-process cmdstr)) (defun imap-send-command (command &optional buffer) @@ -2002,13 +1913,7 @@ on failure." (stream imap-stream) (eol imap-client-eol)) (with-current-buffer cmd - (and imap-log - (with-current-buffer (get-buffer-create - imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert-buffer-substring cmd))) + (imap-log cmd) (process-send-region process (point-min) (point-max))) (process-send-string process imap-client-eol)))) @@ -2084,12 +1989,7 @@ Return nil if no complete line has arrived." (with-current-buffer (process-buffer proc) (goto-char (point-max)) (insert string) - (and imap-log - (with-current-buffer (get-buffer-create imap-log-buffer) - (imap-disable-multibyte) - (buffer-disable-undo) - (goto-char (point-max)) - (insert string))) + (imap-log string) (let (end) (goto-char (point-min)) (while (setq end (imap-find-next-line)) @@ -2992,106 +2892,6 @@ Return nil if no complete line has arrived." (imap-forward) (nreverse body))))) -(when imap-debug ; (untrace-all) - (require 'trace) - (buffer-disable-undo (get-buffer-create imap-debug-buffer)) - (mapc (lambda (f) (trace-function-background f imap-debug-buffer)) - '( - imap-utf7-encode - imap-utf7-decode - imap-error-text - imap-kerberos4s-p - imap-kerberos4-open - imap-ssl-p - imap-ssl-open - imap-network-p - imap-network-open - imap-interactive-login - imap-kerberos4a-p - imap-kerberos4-auth - imap-cram-md5-p - imap-cram-md5-auth - imap-login-p - imap-login-auth - imap-anonymous-p - imap-anonymous-auth - imap-open-1 - imap-open - imap-opened - imap-ping-server - imap-authenticate - imap-close - imap-capability - imap-namespace - imap-send-command-wait - imap-mailbox-put - imap-mailbox-get - imap-mailbox-map-1 - imap-mailbox-map - imap-current-mailbox - imap-current-mailbox-p-1 - imap-current-mailbox-p - imap-mailbox-select-1 - imap-mailbox-select - imap-mailbox-examine-1 - imap-mailbox-examine - imap-mailbox-unselect - imap-mailbox-expunge - imap-mailbox-close - imap-mailbox-create-1 - imap-mailbox-create - imap-mailbox-delete - imap-mailbox-rename - imap-mailbox-lsub - imap-mailbox-list - imap-mailbox-subscribe - imap-mailbox-unsubscribe - imap-mailbox-status - imap-mailbox-acl-get - imap-mailbox-acl-set - imap-mailbox-acl-delete - imap-current-message - imap-list-to-message-set - imap-fetch-asynch - imap-fetch - imap-fetch-safe - imap-message-put - imap-message-get - imap-message-map - imap-search - imap-message-flag-permanent-p - imap-message-flags-set - imap-message-flags-del - imap-message-flags-add - imap-message-copyuid-1 - imap-message-copyuid - imap-message-copy - imap-message-appenduid-1 - imap-message-appenduid - imap-message-append - imap-body-lines - imap-envelope-from - imap-send-command-1 - imap-send-command - imap-wait-for-tag - imap-sentinel - imap-find-next-line - imap-arrival-filter - imap-parse-greeting - imap-parse-response - imap-parse-resp-text - imap-parse-resp-text-code - imap-parse-data-list - imap-parse-fetch - imap-parse-status - imap-parse-acl - imap-parse-flag-list - imap-parse-envelope - imap-parse-body-extension - imap-parse-body - ))) - (provide 'imap) -;; arch-tag: 27369ed6-33e4-482f-96f1-8bb906ba70f7 ;;; imap.el ends here diff --git a/lisp/net/netrc.el b/lisp/net/netrc.el index 99278d9ee21..408eca9bac7 100644 --- a/lisp/net/netrc.el +++ b/lisp/net/netrc.el @@ -54,12 +54,19 @@ "Netrc configuration." :group 'comm) +(defcustom netrc-file "~/.authinfo" + "File where user credentials are stored." + :type 'file + :group 'netrc) + (defvar netrc-services-file "/etc/services" "The name of the services file.") -(defun netrc-parse (file) +(defun netrc-parse (&optional file) (interactive "fFile to Parse: ") "Parse FILE and return a list of all entries in the file." + (unless file + (setq file netrc-file)) (if (listp file) file (when (file-exists-p file) @@ -160,9 +167,9 @@ MODE can be \"login\" or \"password\", suitable for passing to (defaults (or defaults '(nil))) info) (if (listp mode) - (setq info - (mapcar - (lambda (mode-element) + (setq info + (mapcar + (lambda (mode-element) (netrc-machine-user-or-password mode-element authinfo-list @@ -221,7 +228,19 @@ MODE can be \"login\" or \"password\", suitable for passing to (eq type (car (cddr service))))))) (cadr service))) +(defun netrc-credentials (machine &rest ports) + "Return a user name/password pair. +Port specifications will be prioritised in the order they are +listed in the PORTS list." + (let ((list (netrc-parse)) + found) + (while (and ports + (not found)) + (setq found (netrc-machine list machine (pop ports)))) + (when found + (list (cdr (assoc "login" found)) + (cdr (assoc "password" found)))))) + (provide 'netrc) -;; arch-tag: af9929cc-2d12-482f-936e-eb4366f9fa55 ;;; netrc.el ends here diff --git a/lisp/net/newst-backend.el b/lisp/net/newst-backend.el index 5a8f1dff5c0..590363a1f65 100644 --- a/lisp/net/newst-backend.el +++ b/lisp/net/newst-backend.el @@ -8,6 +8,7 @@ ;; URL: http://www.nongnu.org/newsticker ;; Keywords: News, RSS, Atom ;; Time-stamp: "6. Dezember 2009, 19:15:32 (ulf)" +;; Package: newsticker ;; ====================================================================== diff --git a/lisp/net/newst-plainview.el b/lisp/net/newst-plainview.el index e1bdc2cade2..a6629a40721 100644 --- a/lisp/net/newst-plainview.el +++ b/lisp/net/newst-plainview.el @@ -7,6 +7,7 @@ ;; Filename: newst-plainview.el ;; URL: http://www.nongnu.org/newsticker ;; Time-stamp: "6. Dezember 2009, 19:17:02 (ulf)" +;; Package: newsticker ;; ====================================================================== diff --git a/lisp/net/newst-reader.el b/lisp/net/newst-reader.el index ce468235b46..25ed65d04ae 100644 --- a/lisp/net/newst-reader.el +++ b/lisp/net/newst-reader.el @@ -7,6 +7,7 @@ ;; Filename: newst-reader.el ;; URL: http://www.nongnu.org/newsticker ;; Time-stamp: "6. Dezember 2009, 19:16:38 (ulf)" +;; Package: newsticker ;; ====================================================================== diff --git a/lisp/net/newst-ticker.el b/lisp/net/newst-ticker.el index 694d2cbc200..80df1a14f23 100644 --- a/lisp/net/newst-ticker.el +++ b/lisp/net/newst-ticker.el @@ -8,6 +8,7 @@ ;; URL: http://www.nongnu.org/newsticker ;; Keywords: News, RSS, Atom ;; Time-stamp: "6. Dezember 2009, 19:16:00 (ulf)" +;; Package: newsticker ;; ====================================================================== diff --git a/lisp/net/newst-treeview.el b/lisp/net/newst-treeview.el index 80bc2c70a1e..6bf0b593de3 100644 --- a/lisp/net/newst-treeview.el +++ b/lisp/net/newst-treeview.el @@ -8,6 +8,7 @@ ;; Created: 2007 ;; Keywords: News, RSS, Atom ;; Time-stamp: "6. Dezember 2009, 19:17:28 (ulf)" +;; Package: newsticker ;; ====================================================================== diff --git a/lisp/net/newsticker.el b/lisp/net/newsticker.el index 1d4b35bb61c..2566529d421 100644 --- a/lisp/net/newsticker.el +++ b/lisp/net/newsticker.el @@ -9,6 +9,7 @@ ;; Created: 17. June 2003 ;; Keywords: News, RSS, Atom ;; Time-stamp: "6. Dezember 2009, 19:15:18 (ulf)" +;; Version: 1.99 ;; ====================================================================== diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el index 91e40e3d018..517e97efe6c 100644 --- a/lisp/net/ntlm.el +++ b/lisp/net/ntlm.el @@ -27,9 +27,9 @@ ;; This library is a direct translation of the Samba release 2.2.0 ;; implementation of Windows NT and LanManager compatible password ;; encryption. -;; +;; ;; Interface functions: -;; +;; ;; ntlm-build-auth-request ;; This will return a binary string, which should be used in the ;; base64 encoded form and it is the caller's responsibility to encode @@ -40,7 +40,7 @@ ;; (which will be a binary string) as the first argument and to ;; encode the returned string with base64. The second argument user ;; should be given in user@domain format. -;; +;; ;; ntlm-get-password-hashes ;; ;; @@ -534,5 +534,4 @@ into a Unicode string. PASSWD is truncated to 128 bytes if longer." (provide 'ntlm) -;; arch-tag: 348ace18-f8e2-4176-8fe9-d9ab4e96f296 ;;; ntlm.el ends here diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 76fc1cd72dd..093892a1100 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -774,42 +774,64 @@ If SILENT is non-nil, do not print the message in any irc buffer." (setq rcirc-input-ring-index (1- rcirc-input-ring-index)) (insert (rcirc-prev-input-string -1)))) -(defvar rcirc-nick-completions nil) -(defvar rcirc-nick-completion-start-offset nil) - -(defun rcirc-complete-nick () - "Cycle through nick completions from list of nicks in channel." +(defvar rcirc-server-commands + '("/admin" "/away" "/connect" "/die" "/error" "/info" + "/invite" "/ison" "/join" "/kick" "/kill" "/links" + "/list" "/lusers" "/mode" "/motd" "/names" "/nick" + "/notice" "/oper" "/part" "/pass" "/ping" "/pong" + "/privmsg" "/quit" "/rehash" "/restart" "/service" "/servlist" + "/server" "/squery" "/squit" "/stats" "/summon" "/time" + "/topic" "/trace" "/user" "/userhost" "/users" "/version" + "/wallops" "/who" "/whois" "/whowas") + "A list of user commands by IRC server. +The value defaults to RFCs 1459 and 2812.") + +;; /me and /ctcp are not defined by `defun-rcirc-command'. +(defvar rcirc-client-commands '("/me" "/ctcp") + "A list of user commands defined by IRC client rcirc. +The list is updated automatically by `defun-rcirc-command'.") + +(defun rcirc-completion-at-point () + "Function used for `completion-at-point-functions' in `rcirc-mode'." + (let* ((beg (save-excursion + (if (re-search-backward " " rcirc-prompt-end-marker t) + (1+ (point)) + rcirc-prompt-end-marker))) + (table (if (and (= beg rcirc-prompt-end-marker) + (eq (char-after beg) ?/)) + (delete-dups + (nconc + (sort (copy-sequence rcirc-client-commands) 'string-lessp) + (sort (copy-sequence rcirc-server-commands) 'string-lessp))) + (rcirc-channel-nicks (rcirc-buffer-process) rcirc-target)))) + (list beg (point) table))) + +(defvar rcirc-completions nil) +(defvar rcirc-completion-start nil) + +(defun rcirc-complete () + "Cycle through completions from list of nicks in channel or IRC commands. +IRC command completion is performed only if '/' is the first input char." (interactive) (if (eq last-command this-command) - (setq rcirc-nick-completions - (append (cdr rcirc-nick-completions) - (list (car rcirc-nick-completions)))) - (setq rcirc-nick-completion-start-offset - (- (save-excursion - (if (re-search-backward " " rcirc-prompt-end-marker t) - (1+ (point)) - rcirc-prompt-end-marker)) - rcirc-prompt-end-marker)) - (setq rcirc-nick-completions - (let ((completion-ignore-case t)) - (all-completions - (buffer-substring - (+ rcirc-prompt-end-marker - rcirc-nick-completion-start-offset) - (point)) - (mapcar (lambda (x) (cons x nil)) - (rcirc-channel-nicks (rcirc-buffer-process) - rcirc-target)))))) - (let ((completion (car rcirc-nick-completions))) + (setq rcirc-completions + (append (cdr rcirc-completions) (list (car rcirc-completions)))) + (let ((completion-ignore-case t) + (table (rcirc-completion-at-point))) + (setq rcirc-completion-start (car table)) + (setq rcirc-completions + (all-completions (buffer-substring rcirc-completion-start + (cadr table)) + (nth 2 table))))) + (let ((completion (car rcirc-completions))) (when completion - (delete-region (+ rcirc-prompt-end-marker - rcirc-nick-completion-start-offset) - (point)) - (insert (concat completion - (if (= (+ rcirc-prompt-end-marker - rcirc-nick-completion-start-offset) - rcirc-prompt-end-marker) - ": ")))))) + (delete-region rcirc-completion-start (point)) + (insert + (concat completion + (cond + ((= (aref completion 0) ?/) " ") + ((= rcirc-completion-start rcirc-prompt-end-marker) ": ") + (t ""))))))) (defun set-rcirc-decode-coding-system (coding-system) "Set the decode coding system used in this channel." @@ -827,7 +849,7 @@ If SILENT is non-nil, do not print the message in any irc buffer." (define-key rcirc-mode-map (kbd "RET") 'rcirc-send-input) (define-key rcirc-mode-map (kbd "M-p") 'rcirc-insert-prev-input) (define-key rcirc-mode-map (kbd "M-n") 'rcirc-insert-next-input) -(define-key rcirc-mode-map (kbd "TAB") 'rcirc-complete-nick) +(define-key rcirc-mode-map (kbd "TAB") 'rcirc-complete) (define-key rcirc-mode-map (kbd "C-c C-b") 'rcirc-browse-url) (define-key rcirc-mode-map (kbd "C-c C-c") 'rcirc-edit-multiline) (define-key rcirc-mode-map (kbd "C-c C-j") 'rcirc-cmd-join) @@ -948,6 +970,9 @@ This number is independent of the number of lines in the buffer.") rcirc-buffer-alist)))) (rcirc-update-short-buffer-names)) + (add-hook 'completion-at-point-functions + 'rcirc-completion-at-point nil 'local) + (run-hooks 'rcirc-mode-hook)) (defun rcirc-update-prompt (&optional all) @@ -1085,7 +1110,7 @@ Create the buffer if it doesn't exist." (goto-char (point-max)) (when (not (equal 0 (- (point) rcirc-prompt-end-marker))) ;; delete a trailing newline - (when (bolp) + (when (eq (point) (point-at-bol)) (delete-char -1)) (let ((input (buffer-substring-no-properties rcirc-prompt-end-marker (point)))) @@ -1342,6 +1367,12 @@ Logfiles are kept in `rcirc-log-directory'." :type 'integer :group 'rcirc) +(defcustom rcirc-log-process-buffers nil + "Non-nil if rcirc process buffers should be logged to disk." + :group 'rcirc + :type 'boolean + :version "24.1") + (defun rcirc-last-quit-line (process nick target) "Return the line number where NICK left TARGET. Returns nil if the information is not recorded." @@ -1507,14 +1538,21 @@ record activity." (when (not (rcirc-channel-p rcirc-target)) 'nick))) - (when rcirc-log-flag + (when (and rcirc-log-flag + (or target + rcirc-log-process-buffers)) (rcirc-log process sender response target text)) (sit-for 0) ; displayed text before hook (run-hook-with-args 'rcirc-print-hooks process sender response target text))))) -(defcustom rcirc-log-filename-function 'rcirc-generate-new-buffer-name +(defun rcirc-generate-log-filename (process target) + (if target + (rcirc-generate-new-buffer-name process target) + (process-name process))) + +(defcustom rcirc-log-filename-function 'rcirc-generate-log-filename "A function to generate the filename used by rcirc's logging facility. It is called with two arguments, PROCESS and TARGET (see @@ -1991,16 +2029,18 @@ activity. Only run if the buffer is not visible and ;; containing the text following the /cmd. (defmacro defun-rcirc-command (command argument docstring interactive-form - &rest body) + &rest body) "Define a command." - `(defun ,(intern (concat "rcirc-cmd-" (symbol-name command))) - (,@argument &optional process target) - ,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values given" - "\nby `rcirc-buffer-process' and `rcirc-target' will be used.") - ,interactive-form - (let ((process (or process (rcirc-buffer-process))) - (target (or target rcirc-target))) - ,@body))) + `(progn + (add-to-list 'rcirc-client-commands ,(concat "/" (symbol-name command))) + (defun ,(intern (concat "rcirc-cmd-" (symbol-name command))) + (,@argument &optional process target) + ,(concat docstring "\n\nNote: If PROCESS or TARGET are nil, the values given" + "\nby `rcirc-buffer-process' and `rcirc-target' will be used.") + ,interactive-form + (let ((process (or process (rcirc-buffer-process))) + (target (or target rcirc-target))) + ,@body)))) (defun-rcirc-command msg (message) "Send private MESSAGE to TARGET." @@ -2138,12 +2178,13 @@ With a prefix arg, prompt for new topic." (rcirc-send-string process (format "PRIVMSG %s :\C-aACTION %s\C-a" target args))) -(defun rcirc-add-or-remove (set &optional elt) - (if (and elt (not (string= "" elt))) - (if (member-ignore-case elt set) - (delete elt set) - (cons elt set)) - set)) +(defun rcirc-add-or-remove (set &rest elements) + (dolist (elt elements) + (if (and elt (not (string= "" elt))) + (setq set (if (member-ignore-case elt set) + (delete elt set) + (cons elt set))))) + set) (defun-rcirc-command ignore (nick) "Manage the ignore list. @@ -2151,7 +2192,9 @@ Ignore NICK, unignore NICK if already ignored, or list ignored nicks when no NICK is given. When listing ignored nicks, the ones added to the list automatically are marked with an asterisk." (interactive "sToggle ignoring of nick: ") - (setq rcirc-ignore-list (rcirc-add-or-remove rcirc-ignore-list nick)) + (setq rcirc-ignore-list + (apply #'rcirc-add-or-remove rcirc-ignore-list + (split-string nick nil t))) (rcirc-print process nil "IGNORE" target (mapconcat (lambda (nick) @@ -2163,14 +2206,18 @@ ones added to the list automatically are marked with an asterisk." (defun-rcirc-command bright (nick) "Manage the bright nick list." (interactive "sToggle emphasis of nick: ") - (setq rcirc-bright-nicks (rcirc-add-or-remove rcirc-bright-nicks nick)) + (setq rcirc-bright-nicks + (apply #'rcirc-add-or-remove rcirc-bright-nicks + (split-string nick nil t))) (rcirc-print process nil "BRIGHT" target (mapconcat 'identity rcirc-bright-nicks " "))) (defun-rcirc-command dim (nick) "Manage the dim nick list." (interactive "sToggle deemphasis of nick: ") - (setq rcirc-dim-nicks (rcirc-add-or-remove rcirc-dim-nicks nick)) + (setq rcirc-dim-nicks + (apply #'rcirc-add-or-remove rcirc-dim-nicks + (split-string nick nil t))) (rcirc-print process nil "DIM" target (mapconcat 'identity rcirc-dim-nicks " "))) @@ -2179,7 +2226,9 @@ ones added to the list automatically are marked with an asterisk." Mark KEYWORD, unmark KEYWORD if already marked, or list marked keywords when no KEYWORD is given." (interactive "sToggle highlighting of keyword: ") - (setq rcirc-keywords (rcirc-add-or-remove rcirc-keywords keyword)) + (setq rcirc-keywords + (apply #'rcirc-add-or-remove rcirc-keywords + (split-string keyword nil t))) (rcirc-print process nil "KEYWORD" target (mapconcat 'identity rcirc-keywords " "))) diff --git a/lisp/net/sasl-cram.el b/lisp/net/sasl-cram.el index 9faeded5c3b..38d7ff4e11d 100644 --- a/lisp/net/sasl-cram.el +++ b/lisp/net/sasl-cram.el @@ -5,6 +5,7 @@ ;; Author: Daiki Ueno <ueno@unixuser.org> ;; Kenichi OKADA <okada@opaopa.org> ;; Keywords: SASL, CRAM-MD5 +;; Package: sasl ;; This file is part of GNU Emacs. @@ -46,5 +47,4 @@ (provide 'sasl-cram) -;; arch-tag: 46cb281b-975a-4fe0-a39f-3018691b1b05 ;;; sasl-cram.el ends here diff --git a/lisp/net/sasl-digest.el b/lisp/net/sasl-digest.el index 4d839296c9f..8559c8f3fa9 100644 --- a/lisp/net/sasl-digest.el +++ b/lisp/net/sasl-digest.el @@ -5,6 +5,7 @@ ;; Author: Daiki Ueno <ueno@unixuser.org> ;; Kenichi OKADA <okada@opaopa.org> ;; Keywords: SASL, DIGEST-MD5 +;; Package: sasl ;; This file is part of GNU Emacs. @@ -94,10 +95,10 @@ charset algorithm cipher-opts auth-param)." (md5-binary (concat (encode-hex-string - (md5-binary (concat (md5-binary + (md5-binary (concat (md5-binary (concat username ":" realm ":" passphrase)) ":" nonce ":" cnonce - (if authzid + (if authzid (concat ":" authzid))))) ":" nonce ":" (format "%08x" nonce-count) ":" cnonce ":" qop ":" @@ -153,5 +154,4 @@ charset algorithm cipher-opts auth-param)." (provide 'sasl-digest) -;; arch-tag: 786e02ed-1bc4-4b3c-bf34-96c27e31084d ;;; sasl-digest.el ends here diff --git a/lisp/net/sasl-ntlm.el b/lisp/net/sasl-ntlm.el index 94366f1a52a..ace50528acb 100644 --- a/lisp/net/sasl-ntlm.el +++ b/lisp/net/sasl-ntlm.el @@ -6,6 +6,7 @@ ;; Keywords: SASL, NTLM ;; Version: 1.00 ;; Created: February 2001 +;; Package: sasl ;; This file is part of GNU Emacs. @@ -62,5 +63,4 @@ challenge stored in the 2nd element of STEP. Called from `sasl-next-step'." (provide 'sasl-ntlm) -;; arch-tag: 1d9164c1-1df0-418f-b7ab-360157fd05dc ;;; sasl-ntlm.el ends here diff --git a/lisp/net/sasl.el b/lisp/net/sasl.el index c2a3f10e3d0..7f864390a52 100644 --- a/lisp/net/sasl.el +++ b/lisp/net/sasl.el @@ -267,5 +267,4 @@ It contain at least 64 bits of entropy." (provide 'sasl) -;; arch-tag: 8b3326fa-4978-4fda-93e2-cb2c6255f887 ;;; sasl.el ends here diff --git a/lisp/net/tls.el b/lisp/net/tls.el index 9a1b0bb6610..821daba6f6b 100644 --- a/lisp/net/tls.el +++ b/lisp/net/tls.el @@ -298,5 +298,4 @@ match `%s'. Connect anyway? " host)))))) (provide 'tls) -;; arch-tag: 5596d1c4-facc-4bc4-94a9-9863b928d7ac ;;; tls.el ends here diff --git a/lisp/net/tramp-cache.el b/lisp/net/tramp-cache.el index ac86fabe3a9..8241c048827 100644 --- a/lisp/net/tramp-cache.el +++ b/lisp/net/tramp-cache.el @@ -1,3 +1,5 @@ +(setq tramp-version 24) + ;;; tramp-cache.el --- file information caching for Tramp ;; Copyright (C) 2000, 2005, 2006, 2007, 2008, 2009, @@ -6,6 +8,7 @@ ;; Author: Daniel Pittman <daniel@inanna.danann.net> ;; Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes +;; Package: tramp ;; This file is part of GNU Emacs. @@ -49,24 +52,14 @@ ;;; Code: -;; Pacify byte-compiler. -(eval-when-compile - (require 'cl) - (autoload 'tramp-message "tramp") - (autoload 'tramp-tramp-file-p "tramp") - ;; We cannot autoload macro `with-parsed-tramp-file-name', it - ;; results in problems of byte-compiled code. - (autoload 'tramp-dissect-file-name "tramp") - (autoload 'tramp-file-name-method "tramp") - (autoload 'tramp-file-name-user "tramp") - (autoload 'tramp-file-name-host "tramp") - (autoload 'tramp-file-name-localname "tramp") - (autoload 'tramp-run-real-handler "tramp") - (autoload 'tramp-time-less-p "tramp") - (autoload 'time-stamp-string "time-stamp")) +(require 'tramp) +; bob, 2010 Sep 11 +; (require 'trampver.el) +(autoload 'time-stamp-string "time-stamp") ;;; -- Cache -- +;;;###tramp-autoload (defvar tramp-cache-data (make-hash-table :test 'equal) "Hash table for remote files properties.") @@ -102,6 +95,7 @@ time.") (defvar tramp-cache-data-changed nil "Whether persistent cache data have been changed.") +;;;###tramp-autoload (defun tramp-get-file-property (vec file property default) "Get the PROPERTY of FILE from the cache context of VEC. Returns DEFAULT if not set." @@ -129,6 +123,7 @@ Returns DEFAULT if not set." (tramp-message vec 8 "%s %s %s" file property value) value)) +;;;###tramp-autoload (defun tramp-set-file-property (vec file property value) "Set the PROPERTY of FILE to VALUE, in the cache context of VEC. Returns VALUE." @@ -143,6 +138,26 @@ Returns VALUE." (tramp-message vec 8 "%s %s %s" file property value) value)) +;;;###tramp-autoload +(defmacro with-file-property (vec file property &rest body) + "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache. +FILE must be a local file name on a connection identified via VEC." + `(if (file-name-absolute-p ,file) + (let ((value (tramp-get-file-property ,vec ,file ,property 'undef))) + (when (eq value 'undef) + ;; We cannot pass @body as parameter to + ;; `tramp-set-file-property' because it mangles our + ;; debug messages. + (setq value (progn ,@body)) + (tramp-set-file-property ,vec ,file ,property value)) + value) + ,@body)) + +(put 'with-file-property 'lisp-indent-function 3) +(put 'with-file-property 'edebug-form-spec t) +(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-file-property\\>")) + +;;;###tramp-autoload (defun tramp-flush-file-property (vec file) "Remove all properties of FILE in the cache context of VEC." ;; Unify localname. @@ -151,6 +166,7 @@ Returns VALUE." (tramp-message vec 8 "%s" file) (remhash vec tramp-cache-data)) +;;;###tramp-autoload (defun tramp-flush-directory-property (vec directory) "Remove all properties of DIRECTORY in the cache context of VEC. Remove also properties of all files in subdirectories." @@ -174,8 +190,7 @@ Remove also properties of all files in subdirectories." (buffer-file-name) default-directory))) (when (tramp-tramp-file-p bfn) - (let* ((v (tramp-dissect-file-name bfn)) - (localname (tramp-file-name-localname v))) + (with-parsed-tramp-file-name bfn nil (tramp-flush-file-property v localname))))) (add-hook 'before-revert-hook 'tramp-flush-file-function) @@ -192,6 +207,7 @@ Remove also properties of all files in subdirectories." ;;; -- Properties -- +;;;###tramp-autoload (defun tramp-get-connection-property (key property default) "Get the named PROPERTY for the connection. KEY identifies the connection, it is either a process or a vector. @@ -208,6 +224,7 @@ If the value is not set for the connection, returns DEFAULT." (tramp-message key 7 "%s %s" property value) value)) +;;;###tramp-autoload (defun tramp-set-connection-property (key property value) "Set the named PROPERTY of a connection to VALUE. KEY identifies the connection, it is either a process or a vector. @@ -230,6 +247,23 @@ PROPERTY is set persistent when KEY is a vector." (error nil)) value)) +;;;###tramp-autoload +(defmacro with-connection-property (key property &rest body) + "Check in Tramp for property PROPERTY, otherwise executes BODY and set." + `(let ((value (tramp-get-connection-property ,key ,property 'undef))) + (when (eq value 'undef) + ;; We cannot pass ,@body as parameter to + ;; `tramp-set-connection-property' because it mangles our debug + ;; messages. + (setq value (progn ,@body)) + (tramp-set-connection-property ,key ,property value)) + value)) + +(put 'with-connection-property 'lisp-indent-function 2) +(put 'with-connection-property 'edebug-form-spec t) +(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-connection-property\\>")) + +;;;###tramp-autoload (defun tramp-flush-connection-property (key) "Remove all properties identified by KEY. KEY identifies the connection, it is either a process or a vector." @@ -250,6 +284,7 @@ KEY identifies the connection, it is either a process or a vector." (setq tramp-cache-data-changed t) (remhash key tramp-cache-data)) +;;;###tramp-autoload (defun tramp-cache-print (table) "Print hash table TABLE." (when (hash-table-p table) @@ -270,6 +305,7 @@ KEY identifies the connection, it is either a process or a vector." table) result))) +;;;###tramp-autoload (defun tramp-list-connections () "Return a list of all known connection vectors according to `tramp-cache'." (let (result) @@ -325,6 +361,7 @@ KEY identifies the connection, it is either a process or a vector." (remove-hook 'kill-emacs-hook 'tramp-dump-connection-properties))) +;;;###tramp-autoload (defun tramp-parse-connection-properties (method) "Return a list of (user host) tuples allowed to access for METHOD. This function is added always in `tramp-get-completion-function' @@ -363,6 +400,10 @@ for all methods. Resulting data are derived from connection history." tramp-persistency-file-name (error-message-string err)) (clrhash tramp-cache-data)))) +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-cache 'force))) + (provide 'tramp-cache) ;; arch-tag: ee1739b7-7628-408c-9b96-d11a74b05d26 diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el index 0e31360a416..32cbb16b9e8 100644 --- a/lisp/net/tramp-cmds.el +++ b/lisp/net/tramp-cmds.el @@ -4,6 +4,7 @@ ;; Author: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes +;; Package: tramp ;; This file is part of GNU Emacs. @@ -128,6 +129,7 @@ This includes password cache, file cache, connection cache, buffers." ;; Tramp version is useful in a number of situations. +;;;###tramp-autoload (defun tramp-version (arg) "Print version number of tramp.el in minibuffer or current buffer." (interactive "P") @@ -386,6 +388,9 @@ please ensure that the buffers are attached to your email.\n\n") (defalias 'tramp-submit-bug 'tramp-bug) +(add-hook 'tramp-unload-hook + (lambda () (unload-feature 'tramp-cmds 'force))) + (provide 'tramp-cmds) ;;; TODO: @@ -394,7 +399,7 @@ please ensure that the buffers are attached to your email.\n\n") ;; * WIBNI there was an interactive command prompting for Tramp ;; method, hostname, username and filename and translates the user ;; input into the correct filename syntax (depending on the Emacs -;; flavor) (Reiner Steib) +;; flavor) (Reiner Steib) ;; * Let the user edit the connection properties interactively. ;; Something like `gnus-server-edit-server' in Gnus' *Server* buffer. ;; * It's just that when I come to Customize `tramp-default-user-alist' @@ -403,7 +408,7 @@ please ensure that the buffers are attached to your email.\n\n") ;; Option and should not be modified by the code. add-to-list is ;; called in several places. One way to handle that is to have a new ;; ordinary variable that gets its initial value from -;; tramp-default-user-alist and then is added to. (Pete Forman) +;; tramp-default-user-alist and then is added to. (Pete Forman) ;; arch-tag: 190d4c33-76bb-4e99-8b6f-71741f23d98c ;;; tramp-cmds.el ends here diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index 484d2be7abe..d5884574cb0 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -4,6 +4,7 @@ ;; Author: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes +;; Package: tramp ;; This file is part of GNU Emacs. @@ -30,6 +31,10 @@ (eval-when-compile + (require 'tramp-loaddefs)) + +(eval-when-compile + ;; Pacify byte-compiler. (require 'cl)) @@ -42,33 +47,20 @@ (require 'timer-funcs) (require 'timer)) - (autoload 'tramp-tramp-file-p "tramp") - (autoload 'tramp-file-name-handler "tramp") - ;; We check whether `start-file-process' is bound. (unless (fboundp 'start-file-process) ;; tramp-util offers integration into other (X)Emacs packages like ;; compile.el, gud.el etc. Not necessary in Emacs 23. (eval-after-load "tramp" - '(progn - (require 'tramp-util) - (add-hook 'tramp-unload-hook - '(lambda () - (when (featurep 'tramp-util) - (unload-feature 'tramp-util 'force)))))) + '(require 'tramp-util)) ;; Make sure that we get integration with the VC package. When it ;; is loaded, we need to pull in the integration module. Not ;; necessary in Emacs 23. (eval-after-load "vc" (eval-after-load "tramp" - '(progn - (require 'tramp-vc) - (add-hook 'tramp-unload-hook - '(lambda () - (when (featurep 'tramp-vc) - (unload-feature 'tramp-vc 'force)))))))) + '(require 'tramp-vc)))) ;; Avoid byte-compiler warnings if the byte-compiler supports this. ;; Currently, XEmacs supports this. @@ -262,6 +254,24 @@ Add the extension of FILENAME, if existing." ;; Default value in XEmacs. (t 134217727))) +(defun tramp-compat-decimal-to-octal (i) + "Return a string consisting of the octal digits of I. +Not actually used. Use `(format \"%o\" i)' instead?" + (cond ((< i 0) (error "Cannot convert negative number to octal")) + ((not (integerp i)) (error "Cannot convert non-integer to octal")) + ((zerop i) "0") + (t (concat (tramp-compat-decimal-to-octal (/ i 8)) + (number-to-string (% i 8)))))) + +;; Kudos to Gerd Moellmann for this suggestion. +(defun tramp-compat-octal-to-decimal (ostr) + "Given a string of octal digits, return a decimal number." + (let ((x (or ostr ""))) + ;; `save-match' is in `tramp-mode-string-to-int' which calls this. + (unless (string-match "\\`[0-7]*\\'" x) + (error "Non-octal junk in string `%s'" x)) + (string-to-number ostr 8))) + ;; ID-FORMAT does not exists in XEmacs. (defun tramp-compat-file-attributes (filename &optional id-format) "Like `file-attributes' for Tramp files (compat function)." @@ -396,6 +406,20 @@ This is, the first, empty, element is omitted. In XEmacs, the first element is not omitted." (delete "" (split-string string pattern))) +(defun tramp-compat-call-process + (program &optional infile destination display &rest args) + "Calls `call-process' on the local host. +This is needed because for some Emacs flavors Tramp has +defadviced `call-process' to behave like `process-file'. The +Lisp error raised when PROGRAM is nil is trapped also, returning 1." + (let ((default-directory + (if (file-remote-p default-directory) + (tramp-compat-temporary-file-directory) + default-directory))) + (if (executable-find program) + (apply 'call-process program infile destination display args) + 1))) + (defun tramp-compat-process-running-p (process-name) "Returns `t' if system process PROCESS-NAME is running for `user-login-name'." (when (stringp process-name) @@ -438,6 +462,10 @@ element is not omitted." (setenv "UNIX95" unix95) result))))) +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-compat 'force))) + (provide 'tramp-compat) ;;; TODO: diff --git a/lisp/net/tramp-fish.el b/lisp/net/tramp-fish.el index 632b400e2b3..e5d0ffd3366 100644 --- a/lisp/net/tramp-fish.el +++ b/lisp/net/tramp-fish.el @@ -4,6 +4,7 @@ ;; Author: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes +;; Package: tramp ;; This file is part of GNU Emacs. @@ -156,16 +157,14 @@ (require 'cl)) (require 'tramp) -(require 'tramp-cache) -(require 'tramp-compat) ;; Define FISH method ... -(defcustom tramp-fish-method "fish" - "*Method to connect via FISH protocol." - :group 'tramp - :type 'string) +;;;###tramp-autoload +(defconst tramp-fish-method "fish" + "*Method to connect via FISH protocol.") ;; ... and add it to the method list. +;;;###tramp-autoload (add-to-list 'tramp-methods (cons tramp-fish-method nil)) ;; Add a default for `tramp-default-user-alist'. Default is the local user. @@ -263,11 +262,13 @@ Used instead of analyzing error codes of commands.") "Alist of handler functions for Tramp FISH method. Operations not mentioned here will be handled by the default Emacs primitives.") -(defun tramp-fish-file-name-p (filename) +;;;###tramp-autoload +(defsubst tramp-fish-file-name-p (filename) "Check if it's a filename for FISH protocol." (let ((v (tramp-dissect-file-name filename))) (string= (tramp-file-name-method v) tramp-fish-method))) +;;;###tramp-autoload (defun tramp-fish-file-name-handler (operation &rest args) "Invoke the FISH related OPERATION. First arg specifies the OPERATION, second arg is a list of arguments to @@ -277,6 +278,7 @@ pass to the OPERATION." (save-match-data (apply (cdr fn) args)) (tramp-run-real-handler operation args)))) +;;;###tramp-autoload (add-to-list 'tramp-foreign-file-name-handler-alist (cons 'tramp-fish-file-name-p 'tramp-fish-file-name-handler)) @@ -687,7 +689,7 @@ target of the symlink differ." (tramp-flush-file-property v localname) (unless (tramp-fish-send-command-and-check v (format "#CHMOD %s %s" - (tramp-decimal-to-octal mode) + (tramp-compat-decimal-to-octal mode) (tramp-shell-quote-argument localname))) (tramp-error v 'file-error "Error while changing file's mode %s" filename)))) @@ -1169,6 +1171,10 @@ Returns nil if there has been an error message." (goto-char (point-min)) (looking-at tramp-fish-ok-prompt-regexp))) +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-fish 'force))) + (provide 'tramp-fish) ; ;;;; TODO: diff --git a/lisp/net/tramp-ftp.el b/lisp/net/tramp-ftp.el index 4c373cbcd82..799b974bd04 100644 --- a/lisp/net/tramp-ftp.el +++ b/lisp/net/tramp-ftp.el @@ -5,6 +5,7 @@ ;; Author: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes +;; Package: tramp ;; This file is part of GNU Emacs. @@ -29,7 +30,6 @@ ;;; Code: (require 'tramp) -(autoload 'tramp-set-connection-property "tramp-cache") (eval-when-compile @@ -98,13 +98,14 @@ present for backward compatibility." (add-hook 'tramp-ftp-unload-hook 'tramp-ftp-enable-ange-ftp) ;; Define FTP method ... -(defcustom tramp-ftp-method "ftp" - "*When this method name is used, forward all calls to Ange-FTP." - :group 'tramp - :type 'string) +;;;###tramp-autoload +(defconst tramp-ftp-method "ftp" + "*When this method name is used, forward all calls to Ange-FTP.") ;; ... and add it to the method list. -(add-to-list 'tramp-methods (cons tramp-ftp-method nil)) +;;;###tramp-autoload +(unless (featurep 'xemacs) + (add-to-list 'tramp-methods (cons tramp-ftp-method nil))) ;; Add some defaults for `tramp-default-method-alist' (add-to-list 'tramp-default-method-alist @@ -128,6 +129,7 @@ present for backward compatibility." (symbol-plist 'substitute-in-file-name)))))) +;;;###tramp-autoload (defun tramp-ftp-file-name-handler (operation &rest args) "Invoke the Ange-FTP handler for OPERATION. First arg specifies the OPERATION, second arg is a list of arguments to @@ -198,13 +200,20 @@ pass to the OPERATION." (inhibit-file-name-operation operation)) (apply 'ange-ftp-hook-function operation args))))))) -(defun tramp-ftp-file-name-p (filename) +;;;###tramp-autoload +(defsubst tramp-ftp-file-name-p (filename) "Check if it's a filename that should be forwarded to Ange-FTP." (let ((v (tramp-dissect-file-name filename))) (string= (tramp-file-name-method v) tramp-ftp-method))) -(add-to-list 'tramp-foreign-file-name-handler-alist - (cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler)) +;;;###tramp-autoload +(unless (featurep 'xemacs) + (add-to-list 'tramp-foreign-file-name-handler-alist + (cons 'tramp-ftp-file-name-p 'tramp-ftp-file-name-handler))) + +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-ftp 'force))) (provide 'tramp-ftp) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 202eaf59835..6e07ec19021 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -4,6 +4,7 @@ ;; Author: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes +;; Package: tramp ;; This file is part of GNU Emacs. @@ -107,6 +108,7 @@ (require 'url-util) (require 'zeroconf) +;;;###tramp-autoload (defcustom tramp-gvfs-methods '("dav" "davs" "obex" "synce") "*List of methods for remote files, accessed with GVFS." :group 'tramp @@ -132,11 +134,11 @@ ;; Add the methods to `tramp-methods', in order to allow minibuffer ;; completion. -(eval-after-load "tramp-gvfs" - '(when (featurep 'tramp-gvfs) - (dolist (elt tramp-gvfs-methods) - (unless (assoc elt tramp-methods) - (add-to-list 'tramp-methods (cons elt nil)))))) +;;;###tramp-autoload +(when (featurep 'dbusbind) + (dolist (elt tramp-gvfs-methods) + (unless (assoc elt tramp-methods) + (add-to-list 'tramp-methods (cons elt nil))))) (defconst tramp-gvfs-path-tramp (concat dbus-path-emacs "/Tramp") "The preceeding object path for own objects.") @@ -144,9 +146,12 @@ (defconst tramp-gvfs-service-daemon "org.gtk.vfs.Daemon" "The well known name of the GVFS daemon.") -;; Check that GVFS is available. -(unless (dbus-ping :session tramp-gvfs-service-daemon 100) - (throw 'tramp-loading nil)) +;; Check that GVFS is available. D-Bus integration is available since +;; Emacs 23 on some system types. We don't call `dbus-ping', because +;; this would load dbus.el. +(unless (and (tramp-compat-funcall 'dbus-get-unique-name :session) + (tramp-compat-process-running-p "gvfs-fuse-daemon")) + (error "Package `tramp-gvfs' not supported")) (defconst tramp-gvfs-path-mounttracker "/org/gtk/vfs/mounttracker" "The object path of the GVFS daemon.") @@ -384,7 +389,7 @@ Every entry is a list (NAME ADDRESS).") (expand-file-name . tramp-gvfs-handle-expand-file-name) ;; `file-accessible-directory-p' performed by default handler. (file-attributes . tramp-gvfs-handle-file-attributes) - (file-directory-p . tramp-smb-handle-file-directory-p) + (file-directory-p . tramp-gvfs-handle-file-directory-p) (file-executable-p . tramp-gvfs-handle-file-executable-p) (file-exists-p . tramp-gvfs-handle-file-exists-p) (file-local-copy . tramp-gvfs-handle-file-local-copy) @@ -430,13 +435,15 @@ Every entry is a list (NAME ADDRESS).") "Alist of handler functions for Tramp GVFS method. Operations not mentioned here will be handled by the default Emacs primitives.") -(defun tramp-gvfs-file-name-p (filename) +;;;###tramp-autoload +(defsubst tramp-gvfs-file-name-p (filename) "Check if it's a filename handled by the GVFS daemon." (and (tramp-tramp-file-p filename) (let ((method (tramp-file-name-method (tramp-dissect-file-name filename)))) (and (stringp method) (member method tramp-gvfs-methods))))) +;;;###tramp-autoload (defun tramp-gvfs-file-name-handler (operation &rest args) "Invoke the GVFS related OPERATION. First arg specifies the OPERATION, second arg is a list of arguments to @@ -448,8 +455,10 @@ pass to the OPERATION." ;; This might be moved to tramp.el. It shall be the first file name ;; handler. -(add-to-list 'tramp-foreign-file-name-handler-alist - (cons 'tramp-gvfs-file-name-p 'tramp-gvfs-file-name-handler)) +;;;###tramp-autoload +(when (featurep 'dbusbind) + (add-to-list 'tramp-foreign-file-name-handler-alist + (cons 'tramp-gvfs-file-name-p 'tramp-gvfs-file-name-handler))) (defun tramp-gvfs-stringify-dbus-message (message) "Convert a D-Bus message into readable UTF8 strings, used for traces." @@ -493,7 +502,7 @@ In case of an error, modify the error message by replacing `(let ((fuse-file-name (regexp-quote (tramp-gvfs-fuse-file-name ,filename))) elt) (condition-case err - (funcall ,handler ,@args) + (tramp-compat-funcall ,handler ,@args) (error (setq elt (cdr err)) (while elt @@ -646,6 +655,10 @@ is no information where to trace the message.") "Like `file-attributes' for Tramp files." (file-attributes (tramp-gvfs-fuse-file-name filename) id-format)) +(defun tramp-gvfs-handle-file-directory-p (filename) + "Like `file-directory-p' for Tramp files." + (file-directory-p (tramp-gvfs-fuse-file-name filename))) + (defun tramp-gvfs-handle-file-executable-p (filename) "Like `file-executable-p' for Tramp files." (file-executable-p (tramp-gvfs-fuse-file-name filename))) @@ -1402,6 +1415,10 @@ They are retrieved from the hal daemon." (tramp-set-completion-function "synce" '((tramp-synce-parse-device-names ""))) +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-gvfs 'force))) + (provide 'tramp-gvfs) ;;; TODO: diff --git a/lisp/net/tramp-gw.el b/lisp/net/tramp-gw.el index d76cd3b3bce..63dfd105f1c 100644 --- a/lisp/net/tramp-gw.el +++ b/lisp/net/tramp-gw.el @@ -4,6 +4,7 @@ ;; Author: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes +;; Package: tramp ;; This file is part of GNU Emacs. @@ -37,11 +38,6 @@ (require 'cl) (require 'custom)) -;; Autoload the socks library. It is used only when we access a SOCKS server. -(autoload 'socks-open-network-stream "socks") -(defvar socks-username (user-login-name)) -(defvar socks-server (list "Default server" "socks" 1080 5)) - ;; Avoid byte-compiler warnings if the byte-compiler supports this. ;; Currently, XEmacs supports this. (eval-when-compile @@ -49,21 +45,29 @@ (byte-compiler-options (warnings (- unused-vars))))) ;; Define HTTP tunnel method ... -(defvar tramp-gw-tunnel-method "tunnel" +;;;###tramp-autoload +(defconst tramp-gw-tunnel-method "tunnel" "*Method to connect HTTP gateways.") ;; ... and port. -(defvar tramp-gw-default-tunnel-port 8080 +(defconst tramp-gw-default-tunnel-port 8080 "*Default port for HTTP gateways.") ;; Define SOCKS method ... -(defvar tramp-gw-socks-method "socks" +;;;###tramp-autoload +(defconst tramp-gw-socks-method "socks" "*Method to connect SOCKS servers.") ;; ... and port. -(defvar tramp-gw-default-socks-port 1080 +(defconst tramp-gw-default-socks-port 1080 "*Default port for SOCKS servers.") +;; Autoload the socks library. It is used only when we access a SOCKS server. +(autoload 'socks-open-network-stream "socks") +(defvar socks-username (user-login-name)) +(defvar socks-server + (list "Default server" "socks" tramp-gw-default-socks-port 5)) + ;; Add a default for `tramp-default-user-alist'. Default is the local user. (add-to-list 'tramp-default-user-alist `(,tramp-gw-tunnel-method nil ,(user-login-name))) @@ -124,6 +128,7 @@ (process-send-string (tramp-get-connection-property proc "process" nil) string))) +;;;###tramp-autoload (defun tramp-gw-open-connection (vec gw-vec target-vec) "Open a remote connection to VEC (see `tramp-file-name' structure). Take GW-VEC as SOCKS or HTTP gateway, i.e. its method must be a @@ -309,6 +314,9 @@ password in password cache. This is done for the first try only." (format "Password for %s@[%s]: " socks-username (read (current-buffer))))))))) +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-gw 'force))) (provide 'tramp-gw) diff --git a/lisp/net/tramp-imap.el b/lisp/net/tramp-imap.el index 3e8883d2e07..4a5e2418cfb 100644 --- a/lisp/net/tramp-imap.el +++ b/lisp/net/tramp-imap.el @@ -4,6 +4,7 @@ ;; Author: Teodor Zlatanov <tzz@lifelogs.com> ;; Keywords: mail, comm +;; Package: tramp ;; This file is part of GNU Emacs. @@ -54,7 +55,6 @@ (require 'assoc) (require 'tramp) -(require 'tramp-compat) (autoload 'auth-source-user-or-password "auth-source") (autoload 'epg-context-operation "epg") @@ -75,21 +75,29 @@ '(add-to-list 'imap-hash-headers 'X-Size 'append)) ;; Define Tramp IMAP method ... +;;;###tramp-autoload (defconst tramp-imap-method "imap" "*Method to connect via IMAP protocol.") -(add-to-list 'tramp-methods (list tramp-imap-method '(tramp-default-port 143))) +;;;###tramp-autoload +(when (and (locate-library "epa") (locate-library "imap-hash")) + (add-to-list 'tramp-methods + (list tramp-imap-method '(tramp-default-port 143)))) ;; Add a default for `tramp-default-user-alist'. Default is the local user. (add-to-list 'tramp-default-user-alist `(,tramp-imap-method nil ,(user-login-name))) ;; Define Tramp IMAPS method ... +;;;###tramp-autoload (defconst tramp-imaps-method "imaps" "*Method to connect via secure IMAP protocol.") ;; ... and add it to the method list. -(add-to-list 'tramp-methods (list tramp-imaps-method '(tramp-default-port 993))) +;;;###tramp-autoload +(when (and (locate-library "epa") (locate-library "imap-hash")) + (add-to-list 'tramp-methods + (list tramp-imaps-method '(tramp-default-port 993)))) ;; Add a default for `tramp-default-user-alist'. Default is the local user. (add-to-list 'tramp-default-user-alist @@ -183,13 +191,15 @@ Operations not mentioned here will be handled by the default Emacs primitives.") (defvar tramp-imap-passphrase-cache nil) ;; can be t or 'never (defvar tramp-imap-passphrase nil) -(defun tramp-imap-file-name-p (filename) +;;;###tramp-autoload +(defsubst tramp-imap-file-name-p (filename) "Check if it's a filename for IMAP protocol." (let ((v (tramp-dissect-file-name filename))) (or (string= (tramp-file-name-method v) tramp-imap-method) (string= (tramp-file-name-method v) tramp-imaps-method)))) +;;;###tramp-autoload (defun tramp-imap-file-name-handler (operation &rest args) "Invoke the IMAP related OPERATION. First arg specifies the OPERATION, second arg is a list of arguments to @@ -199,8 +209,10 @@ pass to the OPERATION." (save-match-data (apply (cdr fn) args)) (tramp-run-real-handler operation args)))) -(add-to-list 'tramp-foreign-file-name-handler-alist - (cons 'tramp-imap-file-name-p 'tramp-imap-file-name-handler)) +;;;###tramp-autoload +(when (and (locate-library "epa") (locate-library "imap-hash")) + (add-to-list 'tramp-foreign-file-name-handler-alist + (cons 'tramp-imap-file-name-p 'tramp-imap-file-name-handler))) (defun tramp-imap-handle-copy-file (filename newname &optional ok-if-already-exists keep-date @@ -775,6 +787,10 @@ With NEEDED-SUBJECT, alters the imap-hash test accordingly." tramp-imap-subject-marker (if needed-subject needed-subject ""))))) +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-imap 'force))) + ;;; TODO: ;; * Implement `tramp-imap-handle-delete-directory', diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index f1ec7a9b81c..84d11972115 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -5,6 +5,7 @@ ;; Author: Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes +;; Package: tramp ;; This file is part of GNU Emacs. @@ -29,17 +30,16 @@ (eval-when-compile (require 'cl)) ; block, return (require 'tramp) -(require 'tramp-cache) -(require 'tramp-compat) ;; Define SMB method ... -(defcustom tramp-smb-method "smb" - "*Method to connect SAMBA and M$ SMB servers." - :group 'tramp - :type 'string) +;;;###tramp-autoload +(defconst tramp-smb-method "smb" + "*Method to connect SAMBA and M$ SMB servers.") ;; ... and add it to the method list. -(add-to-list 'tramp-methods (cons tramp-smb-method nil)) +;;;###tramp-autoload +(unless (memq system-type '(cygwin windows-nt)) + (add-to-list 'tramp-methods (cons tramp-smb-method nil))) ;; Add a default for `tramp-default-method-alist'. Rule: If there is ;; a domain in USER, it must be the SMB method. @@ -204,11 +204,13 @@ See `tramp-actions-before-shell' for more info.") "Alist of handler functions for Tramp SMB method. Operations not mentioned here will be handled by the default Emacs primitives.") -(defun tramp-smb-file-name-p (filename) +;;;###tramp-autoload +(defsubst tramp-smb-file-name-p (filename) "Check if it's a filename for SMB servers." (let ((v (tramp-dissect-file-name filename))) (string= (tramp-file-name-method v) tramp-smb-method))) +;;;###tramp-autoload (defun tramp-smb-file-name-handler (operation &rest args) "Invoke the SMB related OPERATION. First arg specifies the OPERATION, second arg is a list of arguments to @@ -218,8 +220,10 @@ pass to the OPERATION." (save-match-data (apply (cdr fn) args)) (tramp-run-real-handler operation args)))) -(add-to-list 'tramp-foreign-file-name-handler-alist - (cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler)) +;;;###tramp-autoload +(unless (memq system-type '(cygwin windows-nt)) + (add-to-list 'tramp-foreign-file-name-handler-alist + (cons 'tramp-smb-file-name-p 'tramp-smb-file-name-handler))) ;; File name primitives. @@ -783,7 +787,7 @@ PRESERVE-UID-GID is completely ignored." (if (tramp-smb-get-cifs-capabilities v) (format "posix_mkdir \"%s\" %s" - file (tramp-decimal-to-octal (default-file-modes))) + file (tramp-compat-decimal-to-octal (default-file-modes))) (format "mkdir \"%s\"" file))) ;; We must also flush the cache of the directory, because ;; `file-attributes' reads the values from there. @@ -892,7 +896,7 @@ target of the symlink differ." (unless (tramp-smb-send-command v (format "chmod \"%s\" %s" (tramp-smb-get-localname v) - (tramp-decimal-to-octal mode))) + (tramp-compat-decimal-to-octal mode))) (tramp-error v 'file-error "Error while changing file's mode %s" filename))))) @@ -1396,6 +1400,9 @@ Returns nil if an error message has appeared." (tramp-message vec 6 "\n%s" (buffer-string)) (not err)))) +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-smb 'force))) (provide 'tramp-smb) diff --git a/lisp/net/tramp-uu.el b/lisp/net/tramp-uu.el index 4b64387a8ba..fe6862c9240 100644 --- a/lisp/net/tramp-uu.el +++ b/lisp/net/tramp-uu.el @@ -1,10 +1,11 @@ ;;; tramp-uu.el --- uuencode in Lisp -;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, -;; 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Author: Kai Großjohann <kai.grossjohann@gmx.net> ;; Keywords: comm, terminals +;; Package: tramp ;; This file is part of GNU Emacs. @@ -49,6 +50,7 @@ "Return the byte that is encoded as CHAR." (cdr (assq char tramp-uu-b64-char-to-byte))) +;;;###tramp-autoload (defun tramp-uuencode-region (beg end) "UU-encode the region between BEG and END." ;; First we base64 encode the region, then we transmogrify that into @@ -86,6 +88,10 @@ (goto-char beg) (insert "begin 600 xxx\n")))) +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'tramp-uu 'force))) + (provide 'tramp-uu) ;; arch-tag: 7153f2c6-8be5-4cd2-8c06-0fbcf5190ef6 diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index e715ef596d0..86ece233fa6 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1,3 +1,4 @@ +(setq tramp-version 24) ;;; tramp.el --- Transparent Remote Access, Multiple Protocol ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, @@ -8,6 +9,7 @@ ;; Author: Kai Großjohann <kai.grossjohann@gmx.net> ;; Michael Albinus <michael.albinus@gmx.de> ;; Keywords: comm, processes +;; Package: tramp ;; This file is part of GNU Emacs. @@ -66,18 +68,7 @@ (when (and load-in-progress (null (current-message))) (message "Loading tramp...")) -;; The Tramp version number and bug report address, as prepared by configure. -(require 'trampver) -(add-hook 'tramp-unload-hook - (lambda () - (when (featurep 'trampver) - (unload-feature 'trampver 'force)))) - (require 'tramp-compat) -(add-hook 'tramp-unload-hook - (lambda () - (when (featurep 'tramp-compat) - (unload-feature 'tramp-compat 'force)))) (require 'format-spec) ;; As long as password.el is not part of (X)Emacs, it shouldn't @@ -95,82 +86,8 @@ (load "auth-source" 'noerror) (require 'auth-source nil 'noerror))) -;; Requiring 'tramp-cache results in an endless loop. -(autoload 'tramp-get-file-property "tramp-cache") -(autoload 'tramp-set-file-property "tramp-cache") -(autoload 'tramp-flush-file-property "tramp-cache") -(autoload 'tramp-flush-directory-property "tramp-cache") -(autoload 'tramp-get-connection-property "tramp-cache") -(autoload 'tramp-set-connection-property "tramp-cache") -(autoload 'tramp-flush-connection-property "tramp-cache") -(autoload 'tramp-parse-connection-properties "tramp-cache") -(add-hook 'tramp-unload-hook - (lambda () - (when (featurep 'tramp-cache) - (unload-feature 'tramp-cache 'force)))) - -(autoload 'tramp-uuencode-region "tramp-uu" - "Implementation of `uuencode' in Lisp.") -(add-hook 'tramp-unload-hook - (lambda () - (when (featurep 'tramp-uu) - (unload-feature 'tramp-uu 'force)))) - (autoload 'uudecode-decode-region "uudecode") -;; The following Tramp packages must be loaded after tramp.el, because -;; they require it as well. -(eval-after-load "tramp" - '(dolist - (feature - (list - - ;; Tramp interactive commands. - 'tramp-cmds - - ;; Load foreign FTP method. - (if (featurep 'xemacs) 'tramp-efs 'tramp-ftp) - - ;; tramp-smb uses "smbclient" from Samba. Not available - ;; under Cygwin and Windows, because they don't offer - ;; "smbclient". And even not necessary there, because Emacs - ;; supports UNC file names like "//host/share/localname". - (unless (memq system-type '(cygwin windows-nt)) 'tramp-smb) - - ;; Load foreign FISH method. - 'tramp-fish - - ;; tramp-gvfs needs D-Bus messages. Available since Emacs 23 - ;; on some system types. We don't call `dbus-ping', because - ;; this would load dbus.el. - (when (and (featurep 'dbusbind) - (condition-case nil - (tramp-compat-funcall 'dbus-get-unique-name :session) - (error nil)) - (tramp-compat-process-running-p "gvfs-fuse-daemon")) - 'tramp-gvfs) - - ;; Load gateways. It needs `make-network-process' from Emacs 22. - (when (functionp 'make-network-process) 'tramp-gw) - - ;; tramp-imap needs both epa (from Emacs 23.1) and imap-hash - ;; (from Emacs 23.2). - (when (and (locate-library "epa") (locate-library "imap-hash")) - 'tramp-imap))) - - (when feature - ;; We have used just some basic tests, whether a package shall - ;; be added. There might still be other errors during loading, - ;; which we will catch here. - (catch 'tramp-loading - (require feature) - (add-hook 'tramp-unload-hook - `(lambda () - (when (featurep (quote ,feature)) - (unload-feature (quote ,feature) 'force))))) - (unless (featurep feature) - (message "Loading %s failed, ignoring this package" feature))))) - ;;; User Customizable Internal Variables: (defgroup tramp nil @@ -300,6 +217,7 @@ If it is nil, inline out-of-the-band copy will be used without a check." :group 'tramp :type '(choice (const nil) integer)) +;;;###tramp-autoload (defcustom tramp-terminal-type "dumb" "*Value of TERM environment variable for logging in to remote host. Because Tramp wants to parse the output of the remote shell, it is easily @@ -320,9 +238,11 @@ files conditionalize this setup based on the TERM environment variable." The '$' character at the end is quoted; the string cannot be detected as prompt when being sent on echoing hosts, therefore.") +;;;###tramp-autoload (defconst tramp-initial-end-of-output "#$ " "Prompt when establishing a connection.") +;;;###tramp-autoload (defvar tramp-methods `(("rcp" (tramp-login-program "rsh") (tramp-login-args (("%h") ("-l" "%u"))) @@ -2097,6 +2017,7 @@ mentioned here will be handled by `tramp-file-name-handler-alist' or the normal Emacs functions.") ;; Handlers for foreign methods, like FTP or SMB, shall be plugged here. +;;;###tramp-autoload (defvar tramp-foreign-file-name-handler-alist ;; (identity . tramp-sh-file-name-handler) should always be the last ;; entry, because `identity' always matches. @@ -2107,6 +2028,257 @@ calling HANDLER.") ;;; Internal functions which must come first: + +;; ------------------------------------------------------------ +;; -- Tramp file names -- +;; ------------------------------------------------------------ +;; Conversion functions between external representation and +;; internal data structure. Convenience functions for internal +;; data structure. + +(defun tramp-file-name-p (vec) + "Check, whether VEC is a Tramp object." + (and (vectorp vec) (= 4 (length vec)))) + +(defun tramp-file-name-method (vec) + "Return method component of VEC." + (and (tramp-file-name-p vec) (aref vec 0))) + +(defun tramp-file-name-user (vec) + "Return user component of VEC." + (and (tramp-file-name-p vec) (aref vec 1))) + +(defun tramp-file-name-host (vec) + "Return host component of VEC." + (and (tramp-file-name-p vec) (aref vec 2))) + +(defun tramp-file-name-localname (vec) + "Return localname component of VEC." + (and (tramp-file-name-p vec) (aref vec 3))) + +;; The user part of a Tramp file name vector can be of kind +;; "user%domain". Sometimes, we must extract these parts. +(defun tramp-file-name-real-user (vec) + "Return the user name of VEC without domain." + (save-match-data + (let ((user (tramp-file-name-user vec))) + (if (and (stringp user) + (string-match tramp-user-with-domain-regexp user)) + (match-string 1 user) + user)))) + +(defun tramp-file-name-domain (vec) + "Return the domain name of VEC." + (save-match-data + (let ((user (tramp-file-name-user vec))) + (and (stringp user) + (string-match tramp-user-with-domain-regexp user) + (match-string 2 user))))) + +;; The host part of a Tramp file name vector can be of kind +;; "host#port". Sometimes, we must extract these parts. +(defun tramp-file-name-real-host (vec) + "Return the host name of VEC without port." + (save-match-data + (let ((host (tramp-file-name-host vec))) + (if (and (stringp host) + (string-match tramp-host-with-port-regexp host)) + (match-string 1 host) + host)))) + +(defun tramp-file-name-port (vec) + "Return the port number of VEC." + (save-match-data + (let ((host (tramp-file-name-host vec))) + (and (stringp host) + (string-match tramp-host-with-port-regexp host) + (string-to-number (match-string 2 host)))))) + +;;;###tramp-autoload +(defun tramp-tramp-file-p (name) + "Return t if NAME is a string with Tramp file name syntax." + (save-match-data + (and (stringp name) (string-match tramp-file-name-regexp name)))) + +(defun tramp-find-method (method user host) + "Return the right method string to use. +This is METHOD, if non-nil. Otherwise, do a lookup in +`tramp-default-method-alist'." + (or method + (let ((choices tramp-default-method-alist) + lmethod item) + (while choices + (setq item (pop choices)) + (when (and (string-match (or (nth 0 item) "") (or host "")) + (string-match (or (nth 1 item) "") (or user ""))) + (setq lmethod (nth 2 item)) + (setq choices nil))) + lmethod) + tramp-default-method)) + +(defun tramp-find-user (method user host) + "Return the right user string to use. +This is USER, if non-nil. Otherwise, do a lookup in +`tramp-default-user-alist'." + (or user + (let ((choices tramp-default-user-alist) + luser item) + (while choices + (setq item (pop choices)) + (when (and (string-match (or (nth 0 item) "") (or method "")) + (string-match (or (nth 1 item) "") (or host ""))) + (setq luser (nth 2 item)) + (setq choices nil))) + luser) + tramp-default-user)) + +(defun tramp-find-host (method user host) + "Return the right host string to use. +This is HOST, if non-nil. Otherwise, it is `tramp-default-host'." + (or (and (> (length host) 0) host) + tramp-default-host)) + +(defun tramp-dissect-file-name (name &optional nodefault) + "Return a `tramp-file-name' structure. +The structure consists of remote method, remote user, remote host +and localname (file name on remote host). If NODEFAULT is +non-nil, the file name parts are not expanded to their default +values." + (save-match-data + (let ((match (string-match (nth 0 tramp-file-name-structure) name))) + (unless match (error "Not a Tramp file name: %s" name)) + (let ((method (match-string (nth 1 tramp-file-name-structure) name)) + (user (match-string (nth 2 tramp-file-name-structure) name)) + (host (match-string (nth 3 tramp-file-name-structure) name)) + (localname (match-string (nth 4 tramp-file-name-structure) name))) + (when (member method '("multi" "multiu")) + (error + "`%s' method is no longer supported, see (info \"(tramp)Multi-hops\")" + method)) + (when host + (when (string-match tramp-prefix-ipv6-regexp host) + (setq host (replace-match "" nil t host))) + (when (string-match tramp-postfix-ipv6-regexp host) + (setq host (replace-match "" nil t host)))) + (if nodefault + (vector method user host localname) + (vector + (tramp-find-method method user host) + (tramp-find-user method user host) + (tramp-find-host method user host) + localname)))))) + +(defun tramp-buffer-name (vec) + "A name for the connection buffer VEC." + ;; We must use `tramp-file-name-real-host', because for gateway + ;; methods the default port will be expanded later on, which would + ;; tamper the name. + (let ((method (tramp-file-name-method vec)) + (user (tramp-file-name-user vec)) + (host (tramp-file-name-real-host vec))) + (if (not (zerop (length user))) + (format "*tramp/%s %s@%s*" method user host) + (format "*tramp/%s %s*" method host)))) + +(defun tramp-make-tramp-file-name (method user host localname) + "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME." + (concat tramp-prefix-format + (when (not (zerop (length method))) + (concat method tramp-postfix-method-format)) + (when (not (zerop (length user))) + (concat user tramp-postfix-user-format)) + (when host + (if (string-match tramp-ipv6-regexp host) + (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) + host)) + tramp-postfix-host-format + (when localname localname))) + +(defun tramp-completion-make-tramp-file-name (method user host localname) + "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME. +It must not be a complete Tramp file name, but as long as there are +necessary only. This function will be used in file name completion." + (concat tramp-prefix-format + (when (not (zerop (length method))) + (concat method tramp-postfix-method-format)) + (when (not (zerop (length user))) + (concat user tramp-postfix-user-format)) + (when (not (zerop (length host))) + (concat + (if (string-match tramp-ipv6-regexp host) + (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) + host) + tramp-postfix-host-format)) + (when localname localname))) + +(defun tramp-get-buffer (vec) + "Get the connection buffer to be used for VEC." + (or (get-buffer (tramp-buffer-name vec)) + (with-current-buffer (get-buffer-create (tramp-buffer-name vec)) + (setq buffer-undo-list t) + (setq default-directory + (tramp-make-tramp-file-name + (tramp-file-name-method vec) + (tramp-file-name-user vec) + (tramp-file-name-host vec) + "/")) + (current-buffer)))) + +(defun tramp-get-connection-buffer (vec) + "Get the connection buffer to be used for VEC. +In case a second asynchronous communication has been started, it is different +from `tramp-get-buffer'." + (or (tramp-get-connection-property vec "process-buffer" nil) + (tramp-get-buffer vec))) + +(defun tramp-get-connection-process (vec) + "Get the connection process to be used for VEC. +In case a second asynchronous communication has been started, it is different +from the default one." + (get-process + (or (tramp-get-connection-property vec "process-name" nil) + (tramp-buffer-name vec)))) + +(defun tramp-debug-buffer-name (vec) + "A name for the debug buffer for VEC." + ;; We must use `tramp-file-name-real-host', because for gateway + ;; methods the default port will be expanded later on, which would + ;; tamper the name. + (let ((method (tramp-file-name-method vec)) + (user (tramp-file-name-user vec)) + (host (tramp-file-name-real-host vec))) + (if (not (zerop (length user))) + (format "*debug tramp/%s %s@%s*" method user host) + (format "*debug tramp/%s %s*" method host)))) + +(defconst tramp-debug-outline-regexp + "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ [a-z0-9-]+ (\\([0-9]+\\)) #") + +(defun tramp-get-debug-buffer (vec) + "Get the debug buffer for VEC." + (with-current-buffer + (get-buffer-create (tramp-debug-buffer-name vec)) + (when (bobp) + (setq buffer-undo-list t) + ;; Activate `outline-mode'. This runs `text-mode-hook' and + ;; `outline-mode-hook'. We must prevent that local processes + ;; die. Yes: I've seen `flyspell-mode', which starts "ispell". + ;; Furthermore, `outline-regexp' must have the correct value + ;; already, because it is used by `font-lock-compile-keywords'. + (let ((default-directory (tramp-compat-temporary-file-directory)) + (outline-regexp tramp-debug-outline-regexp)) + (outline-mode)) + (set (make-local-variable 'outline-regexp) tramp-debug-outline-regexp) + (set (make-local-variable 'outline-level) 'tramp-outline-level)) + (current-buffer))) + +(defun tramp-outline-level () + "Return the depth to which a statement is nested in the outline. +Point must be at the beginning of a header line. + +The outline level is equal to the verbosity of the Tramp message." + (1+ (string-to-number (match-string 1)))) + (defsubst tramp-debug-message (vec fmt-string &rest args) "Append message to debug buffer. Message is formatted with FMT-STRING as control string and the remaining @@ -2266,39 +2438,6 @@ If VAR is nil, then we bind `v' to the structure and `method', `user', (put 'with-parsed-tramp-file-name 'edebug-form-spec '(form symbolp body)) (font-lock-add-keywords 'emacs-lisp-mode '("\\<with-parsed-tramp-file-name\\>")) -(defmacro with-file-property (vec file property &rest body) - "Check in Tramp cache for PROPERTY, otherwise execute BODY and set cache. -FILE must be a local file name on a connection identified via VEC." - `(if (file-name-absolute-p ,file) - (let ((value (tramp-get-file-property ,vec ,file ,property 'undef))) - (when (eq value 'undef) - ;; We cannot pass @body as parameter to - ;; `tramp-set-file-property' because it mangles our - ;; debug messages. - (setq value (progn ,@body)) - (tramp-set-file-property ,vec ,file ,property value)) - value) - ,@body)) - -(put 'with-file-property 'lisp-indent-function 3) -(put 'with-file-property 'edebug-form-spec t) -(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-file-property\\>")) - -(defmacro with-connection-property (key property &rest body) - "Check in Tramp for property PROPERTY, otherwise executes BODY and set." - `(let ((value (tramp-get-connection-property ,key ,property 'undef))) - (when (eq value 'undef) - ;; We cannot pass ,@body as parameter to - ;; `tramp-set-connection-property' because it mangles our debug - ;; messages. - (setq value (progn ,@body)) - (tramp-set-connection-property ,key ,property value)) - value)) - -(put 'with-connection-property 'lisp-indent-function 2) -(put 'with-connection-property 'edebug-form-spec t) -(font-lock-add-keywords 'emacs-lisp-mode '("\\<with-connection-property\\>")) - (defun tramp-progress-reporter-update (reporter &optional value) (let* ((parameters (cdr reporter)) (message (aref parameters 3))) @@ -2374,7 +2513,7 @@ Return the local name of the temporary file." (setq result nil) ;; This creates the file by side effect. (set-file-times result) - (set-file-modes result (tramp-octal-to-decimal "0700")))) + (set-file-modes result (tramp-compat-octal-to-decimal "0700")))) ;; Return the local part. (with-parsed-tramp-file-name result nil localname))) @@ -2414,7 +2553,7 @@ Example: ;; Windows registry. (and (memq system-type '(cygwin windows-nt)) (zerop - (tramp-local-call-process + (tramp-compat-call-process "reg" nil nil nil "query" (nth 1 (car v))))) ;; Configuration file. (file-exists-p (nth 1 (car v))))) @@ -2552,7 +2691,7 @@ target of the symlink differ." (unless ln (tramp-error l 'file-error - "Making a symbolic link. ln(1) does not exist on the remote host.")) + "Making a symbolic link. ln(1) does not exist on the remote host.")) ;; Do the 'confirm if exists' thing. (when (file-exists-p linkname) @@ -2573,6 +2712,9 @@ target of the symlink differ." (tramp-file-name-localname (tramp-dissect-file-name (expand-file-name filename))))) + (tramp-flush-file-property l (file-name-directory l-localname)) + (tramp-flush-file-property l l-localname) + ;; Right, they are on the same host, regardless of user, method, etc. ;; We now make the link on the remote machine. This will occur as the user ;; that FILENAME belongs to. @@ -3023,7 +3165,7 @@ of." (unless (zerop (tramp-send-command-and-check v (format "chmod %s %s" - (tramp-decimal-to-octal mode) + (tramp-compat-decimal-to-octal mode) (tramp-shell-quote-argument localname)))) ;; FIXME: extract the proper text from chmod's stderr. (tramp-error @@ -3054,7 +3196,7 @@ of." ;; We handle also the local part, because in older Emacsen, ;; without `set-file-times', this function is an alias for this. ;; We are local, so we don't need the UTC settings. - (tramp-local-call-process + (tramp-compat-call-process "touch" nil nil nil "-t" (format-time-string "%Y%m%d%H%M.%S" time) (tramp-shell-quote-argument filename))))) @@ -3087,7 +3229,7 @@ and gid of the corresponding user is taken. Both parameters must be integers." ;; `set-file-uid-gid'. On W32 "chown" might not work. (let ((uid (or (and (integerp uid) uid) (tramp-get-local-uid 'integer))) (gid (or (and (integerp gid) gid) (tramp-get-local-gid 'integer)))) - (tramp-local-call-process + (tramp-compat-call-process "chown" nil nil nil (format "%d:%d" uid gid) (tramp-shell-quote-argument filename)))))) @@ -3215,7 +3357,7 @@ and gid of the corresponding user is taken. Both parameters must be integers." If the file modes of FILENAME cannot be determined, return the value of `default-file-modes', without execute permissions." (or (file-modes filename) - (logand (default-file-modes) (tramp-octal-to-decimal "0666")))) + (logand (default-file-modes) (tramp-compat-octal-to-decimal "0666")))) (defun tramp-handle-file-directory-p (filename) "Like `file-directory-p' for Tramp files." @@ -3902,7 +4044,8 @@ the uid and gid from FILENAME." ;; Since this does not work reliable, we also ;; give read permissions. (set-file-modes - (concat prefix tmpfile) (tramp-octal-to-decimal "0777")) + (concat prefix tmpfile) + (tramp-compat-octal-to-decimal "0777")) (tramp-set-file-uid-gid (concat prefix tmpfile) (tramp-get-local-uid 'integer) @@ -3918,7 +4061,8 @@ the uid and gid from FILENAME." ;; We must change the ownership as local user. ;; Since this does not work reliable, we also ;; give read permissions. - (set-file-modes tmpfile (tramp-octal-to-decimal "0777")) + (set-file-modes + tmpfile (tramp-compat-octal-to-decimal "0777")) (tramp-set-file-uid-gid tmpfile (tramp-get-remote-uid v 'integer) @@ -4638,7 +4782,9 @@ beginning of local filename are not substituted." (setq outbuf (current-buffer)))) (when stderr (setq command (format "%s 2>%s" command stderr))) - ;; Send the command. It might not return in time, so we protect it. + ;; Send the command. It might not return in time, so we protect + ;; it. Call it in a subshell, in order to preserve working + ;; directory. (condition-case nil (unwind-protect (setq ret @@ -4646,7 +4792,7 @@ beginning of local filename are not substituted." v (format "\\cd %s; %s" (tramp-shell-quote-argument localname) command) - nil t)) + t t)) ;; We should show the output anyway. (when outbuf (with-current-buffer outbuf @@ -4684,20 +4830,6 @@ beginning of local filename are not substituted." (keyboard-quit) ret)))) -(defun tramp-local-call-process - (program &optional infile destination display &rest args) - "Calls `call-process' on the local host. -This is needed because for some Emacs flavors Tramp has -defadviced `call-process' to behave like `process-file'. The -Lisp error raised when PROGRAM is nil is trapped also, returning 1." - (let ((default-directory - (if (file-remote-p default-directory) - (tramp-compat-temporary-file-directory) - default-directory))) - (if (executable-find program) - (apply 'call-process program infile destination display args) - 1))) - (defun tramp-handle-call-process-region (start end program &optional delete buffer display &rest args) "Like `call-process-region' for Tramp files." @@ -4767,7 +4899,7 @@ Lisp error raised when PROGRAM is nil is trapped also, returning 1." ;; Display output. (pop-to-buffer output-buffer) (setq mode-line-process '(":%s")) - (require 'shell) (shell-mode)) + (shell-mode)) (prog1 ;; Run the process. @@ -4976,7 +5108,7 @@ coding system might not be determined. This function repairs it." ;; When the file is not readable for the owner, it ;; cannot be inserted, even it is redable for the group ;; or for everybody. - (set-file-modes local-copy (tramp-octal-to-decimal "0600")) + (set-file-modes local-copy (tramp-compat-octal-to-decimal "0600")) (when (and (null remote-copy) (tramp-get-method-parameter @@ -5214,7 +5346,8 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." ;; Ensure, that it is still readable. (when modes (set-file-modes - tmpfile (logior (or modes 0) (tramp-octal-to-decimal "0400")))) + tmpfile + (logior (or modes 0) (tramp-compat-octal-to-decimal "0400")))) ;; This is a bit lengthy due to the different methods ;; possible for file transfer. First, we check whether the @@ -5313,7 +5446,7 @@ Returns a file name in `tramp-auto-save-directory' for autosaving this file." (erase-buffer) (and ;; cksum runs locally, if possible. - (zerop (tramp-local-call-process "cksum" tmpfile t)) + (zerop (tramp-compat-call-process "cksum" tmpfile t)) ;; cksum runs remotely. (zerop (tramp-send-command-and-check @@ -5790,6 +5923,7 @@ should never be set globally, the intention is to let-bind it.") ;; Tramp file name syntax. Maybe another variable should be introduced ;; overwriting this check in such cases. Or we change Tramp file name ;; syntax in order to avoid ambiguities, like in XEmacs ... +;;;###tramp-autoload (defun tramp-completion-mode-p () "Check, whether method / user name / host name completion is active." (or @@ -6339,7 +6473,7 @@ User is always nil." (let ((default-directory (tramp-compat-temporary-file-directory)) res) (with-temp-buffer - (when (zerop (tramp-local-call-process "reg" nil t nil "query" registry)) + (when (zerop (tramp-compat-call-process "reg" nil t nil "query" registry)) (goto-char (point-min)) (while (not (eobp)) (push (tramp-parse-putty-group registry) res)))) @@ -6414,18 +6548,6 @@ hosts, or files, disagree." (tramp-shell-quote-argument v1-localname) (tramp-shell-quote-argument v2-localname)))))) -(defun tramp-buffer-name (vec) - "A name for the connection buffer VEC." - ;; We must use `tramp-file-name-real-host', because for gateway - ;; methods the default port will be expanded later on, which would - ;; tamper the name. - (let ((method (tramp-file-name-method vec)) - (user (tramp-file-name-user vec)) - (host (tramp-file-name-real-host vec))) - (if (not (zerop (length user))) - (format "*tramp/%s %s@%s*" method user host) - (format "*tramp/%s %s*" method host)))) - (defun tramp-delete-temp-file-function () "Remove temporary files related to current buffer." (when (stringp tramp-temp-buffer-file-name) @@ -6439,74 +6561,6 @@ hosts, or files, disagree." (remove-hook 'kill-buffer-hook 'tramp-delete-temp-file-function))) -(defun tramp-get-buffer (vec) - "Get the connection buffer to be used for VEC." - (or (get-buffer (tramp-buffer-name vec)) - (with-current-buffer (get-buffer-create (tramp-buffer-name vec)) - (setq buffer-undo-list t) - (setq default-directory - (tramp-make-tramp-file-name - (tramp-file-name-method vec) - (tramp-file-name-user vec) - (tramp-file-name-host vec) - "/")) - (current-buffer)))) - -(defun tramp-get-connection-buffer (vec) - "Get the connection buffer to be used for VEC. -In case a second asynchronous communication has been started, it is different -from `tramp-get-buffer'." - (or (tramp-get-connection-property vec "process-buffer" nil) - (tramp-get-buffer vec))) - -(defun tramp-get-connection-process (vec) - "Get the connection process to be used for VEC. -In case a second asynchronous communication has been started, it is different -from the default one." - (get-process - (or (tramp-get-connection-property vec "process-name" nil) - (tramp-buffer-name vec)))) - -(defun tramp-debug-buffer-name (vec) - "A name for the debug buffer for VEC." - ;; We must use `tramp-file-name-real-host', because for gateway - ;; methods the default port will be expanded later on, which would - ;; tamper the name. - (let ((method (tramp-file-name-method vec)) - (user (tramp-file-name-user vec)) - (host (tramp-file-name-real-host vec))) - (if (not (zerop (length user))) - (format "*debug tramp/%s %s@%s*" method user host) - (format "*debug tramp/%s %s*" method host)))) - -(defconst tramp-debug-outline-regexp - "[0-9]+:[0-9]+:[0-9]+\\.[0-9]+ [a-z0-9-]+ (\\([0-9]+\\)) #") - -(defun tramp-get-debug-buffer (vec) - "Get the debug buffer for VEC." - (with-current-buffer - (get-buffer-create (tramp-debug-buffer-name vec)) - (when (bobp) - (setq buffer-undo-list t) - ;; Activate `outline-mode'. This runs `text-mode-hook' and - ;; `outline-mode-hook'. We must prevent that local processes - ;; die. Yes: I've seen `flyspell-mode', which starts "ispell". - ;; Furthermore, `outline-regexp' must have the correct value - ;; already, because it is used by `font-lock-compile-keywords'. - (let ((default-directory (tramp-compat-temporary-file-directory)) - (outline-regexp tramp-debug-outline-regexp)) - (outline-mode)) - (set (make-local-variable 'outline-regexp) tramp-debug-outline-regexp) - (set (make-local-variable 'outline-level) 'tramp-outline-level)) - (current-buffer))) - -(defun tramp-outline-level () - "Return the depth to which a statement is nested in the outline. -Point must be at the beginning of a header line. - -The outline level is equal to the verbosity of the Tramp message." - (1+ (string-to-number (match-string 1)))) - (defun tramp-find-executable (vec progname dirlist &optional ignore-tilde ignore-path) "Searches for PROGNAME in $PATH and all directories mentioned in DIRLIST. @@ -6698,8 +6752,10 @@ file exists and nonzero exit status otherwise." "Query the user for a password." (with-current-buffer (process-buffer proc) (tramp-check-for-regexp proc tramp-password-prompt-regexp) - (tramp-message vec 3 "Sending %s" (match-string 1))) - (tramp-enter-password proc)) + (tramp-message vec 3 "Sending %s" (match-string 1)) + (tramp-enter-password proc) + ;; Hide password prompt. + (narrow-to-region (point-max) (point-max)))) (defun tramp-action-succeed (proc vec) "Signal success in finding shell prompt." @@ -6810,6 +6866,7 @@ The terminal type can be configured with `tramp-terminal-type'." (tramp-process-one-action proc vec actions)) (tramp-process-one-action proc vec actions))))) (with-current-buffer (tramp-get-connection-buffer vec) + (widen) (tramp-message vec 6 "\n%s" (buffer-string))) (unless (eq exit 'ok) (tramp-clear-passwd vec) @@ -7286,7 +7343,7 @@ INPUT can also be nil which means `/dev/null'. OUTPUT can be a string (which specifies a filename), or t (which means standard output and thus the current buffer), or nil (which means discard it)." - (tramp-local-call-process + (tramp-compat-call-process tramp-encoding-shell (when (and input (not (string-match "%s" cmd))) input) (if (eq output t) t nil) @@ -7389,12 +7446,10 @@ Gateway hops are already opened." (setq choices tramp-default-proxies-alist))))) ;; Handle gateways. - (when (and (boundp 'tramp-gw-tunnel-method) - (string-match (format - "^\\(%s\\|%s\\)$" - (symbol-value 'tramp-gw-tunnel-method) - (symbol-value 'tramp-gw-socks-method)) - (tramp-file-name-method (car target-alist)))) + (when (string-match + (format + "^\\(%s\\|%s\\)$" tramp-gw-tunnel-method tramp-gw-socks-method) + (tramp-file-name-method (car target-alist))) (let ((gw (pop target-alist)) (hop (pop target-alist))) ;; Is the method prepared for gateways? @@ -7691,6 +7746,7 @@ function waits for output unless NOOUTPUT is set." ;; Return value is whether end-of-output sentinel was found. found))) +;;;###tramp-autoload (defun tramp-send-command-and-check (vec command &optional subshell dont-suppress-err) "Run COMMAND and check its exit status. @@ -7799,57 +7855,57 @@ the remote host use line-endings as defined in the variable (save-match-data (logior (cond - ((char-equal owner-read ?r) (tramp-octal-to-decimal "00400")) + ((char-equal owner-read ?r) (tramp-compat-octal-to-decimal "00400")) ((char-equal owner-read ?-) 0) (t (error "Second char `%c' must be one of `r-'" owner-read))) (cond - ((char-equal owner-write ?w) (tramp-octal-to-decimal "00200")) + ((char-equal owner-write ?w) (tramp-compat-octal-to-decimal "00200")) ((char-equal owner-write ?-) 0) (t (error "Third char `%c' must be one of `w-'" owner-write))) (cond ((char-equal owner-execute-or-setid ?x) - (tramp-octal-to-decimal "00100")) + (tramp-compat-octal-to-decimal "00100")) ((char-equal owner-execute-or-setid ?S) - (tramp-octal-to-decimal "04000")) + (tramp-compat-octal-to-decimal "04000")) ((char-equal owner-execute-or-setid ?s) - (tramp-octal-to-decimal "04100")) + (tramp-compat-octal-to-decimal "04100")) ((char-equal owner-execute-or-setid ?-) 0) (t (error "Fourth char `%c' must be one of `xsS-'" owner-execute-or-setid))) (cond - ((char-equal group-read ?r) (tramp-octal-to-decimal "00040")) + ((char-equal group-read ?r) (tramp-compat-octal-to-decimal "00040")) ((char-equal group-read ?-) 0) (t (error "Fifth char `%c' must be one of `r-'" group-read))) (cond - ((char-equal group-write ?w) (tramp-octal-to-decimal "00020")) + ((char-equal group-write ?w) (tramp-compat-octal-to-decimal "00020")) ((char-equal group-write ?-) 0) (t (error "Sixth char `%c' must be one of `w-'" group-write))) (cond ((char-equal group-execute-or-setid ?x) - (tramp-octal-to-decimal "00010")) + (tramp-compat-octal-to-decimal "00010")) ((char-equal group-execute-or-setid ?S) - (tramp-octal-to-decimal "02000")) + (tramp-compat-octal-to-decimal "02000")) ((char-equal group-execute-or-setid ?s) - (tramp-octal-to-decimal "02010")) + (tramp-compat-octal-to-decimal "02010")) ((char-equal group-execute-or-setid ?-) 0) (t (error "Seventh char `%c' must be one of `xsS-'" group-execute-or-setid))) (cond ((char-equal other-read ?r) - (tramp-octal-to-decimal "00004")) + (tramp-compat-octal-to-decimal "00004")) ((char-equal other-read ?-) 0) (t (error "Eighth char `%c' must be one of `r-'" other-read))) (cond - ((char-equal other-write ?w) (tramp-octal-to-decimal "00002")) + ((char-equal other-write ?w) (tramp-compat-octal-to-decimal "00002")) ((char-equal other-write ?-) 0) (t (error "Nineth char `%c' must be one of `w-'" other-write))) (cond ((char-equal other-execute-or-sticky ?x) - (tramp-octal-to-decimal "00001")) + (tramp-compat-octal-to-decimal "00001")) ((char-equal other-execute-or-sticky ?T) - (tramp-octal-to-decimal "01000")) + (tramp-compat-octal-to-decimal "01000")) ((char-equal other-execute-or-sticky ?t) - (tramp-octal-to-decimal "01001")) + (tramp-compat-octal-to-decimal "01001")) ((char-equal other-execute-or-sticky ?-) 0) (t (error "Tenth char `%c' must be one of `xtT-'" other-execute-or-sticky))))))) @@ -8010,24 +8066,6 @@ This is used internally by `tramp-file-mode-from-int'." (and suid (upcase suid-text)) ; suid, !execute (and x "x") "-")))) ; !suid -(defun tramp-decimal-to-octal (i) - "Return a string consisting of the octal digits of I. -Not actually used. Use `(format \"%o\" i)' instead?" - (cond ((< i 0) (error "Cannot convert negative number to octal")) - ((not (integerp i)) (error "Cannot convert non-integer to octal")) - ((zerop i) "0") - (t (concat (tramp-decimal-to-octal (/ i 8)) - (number-to-string (% i 8)))))) - -;; Kudos to Gerd Moellmann for this suggestion. -(defun tramp-octal-to-decimal (ostr) - "Given a string of octal digits, return a decimal number." - (let ((x (or ostr ""))) - ;; `save-match' is in `tramp-mode-string-to-int' which calls this. - (unless (string-match "\\`[0-7]*\\'" x) - (error "Non-octal junk in string `%s'" x)) - (string-to-number ostr 8))) - (defun tramp-shell-case-fold (string) "Converts STRING to shell glob pattern which ignores case." (mapconcat @@ -8038,145 +8076,6 @@ Not actually used. Use `(format \"%o\" i)' instead?" string "")) - -;; ------------------------------------------------------------ -;; -- Tramp file names -- -;; ------------------------------------------------------------ -;; Conversion functions between external representation and -;; internal data structure. Convenience functions for internal -;; data structure. - -(defun tramp-file-name-p (vec) - "Check, whether VEC is a Tramp object." - (and (vectorp vec) (= 4 (length vec)))) - -(defun tramp-file-name-method (vec) - "Return method component of VEC." - (and (tramp-file-name-p vec) (aref vec 0))) - -(defun tramp-file-name-user (vec) - "Return user component of VEC." - (and (tramp-file-name-p vec) (aref vec 1))) - -(defun tramp-file-name-host (vec) - "Return host component of VEC." - (and (tramp-file-name-p vec) (aref vec 2))) - -(defun tramp-file-name-localname (vec) - "Return localname component of VEC." - (and (tramp-file-name-p vec) (aref vec 3))) - -;; The user part of a Tramp file name vector can be of kind -;; "user%domain". Sometimes, we must extract these parts. -(defun tramp-file-name-real-user (vec) - "Return the user name of VEC without domain." - (save-match-data - (let ((user (tramp-file-name-user vec))) - (if (and (stringp user) - (string-match tramp-user-with-domain-regexp user)) - (match-string 1 user) - user)))) - -(defun tramp-file-name-domain (vec) - "Return the domain name of VEC." - (save-match-data - (let ((user (tramp-file-name-user vec))) - (and (stringp user) - (string-match tramp-user-with-domain-regexp user) - (match-string 2 user))))) - -;; The host part of a Tramp file name vector can be of kind -;; "host#port". Sometimes, we must extract these parts. -(defun tramp-file-name-real-host (vec) - "Return the host name of VEC without port." - (save-match-data - (let ((host (tramp-file-name-host vec))) - (if (and (stringp host) - (string-match tramp-host-with-port-regexp host)) - (match-string 1 host) - host)))) - -(defun tramp-file-name-port (vec) - "Return the port number of VEC." - (save-match-data - (let ((host (tramp-file-name-host vec))) - (and (stringp host) - (string-match tramp-host-with-port-regexp host) - (string-to-number (match-string 2 host)))))) - -(defun tramp-tramp-file-p (name) - "Return t if NAME is a string with Tramp file name syntax." - (save-match-data - (and (stringp name) (string-match tramp-file-name-regexp name)))) - -(defun tramp-find-method (method user host) - "Return the right method string to use. -This is METHOD, if non-nil. Otherwise, do a lookup in -`tramp-default-method-alist'." - (or method - (let ((choices tramp-default-method-alist) - lmethod item) - (while choices - (setq item (pop choices)) - (when (and (string-match (or (nth 0 item) "") (or host "")) - (string-match (or (nth 1 item) "") (or user ""))) - (setq lmethod (nth 2 item)) - (setq choices nil))) - lmethod) - tramp-default-method)) - -(defun tramp-find-user (method user host) - "Return the right user string to use. -This is USER, if non-nil. Otherwise, do a lookup in -`tramp-default-user-alist'." - (or user - (let ((choices tramp-default-user-alist) - luser item) - (while choices - (setq item (pop choices)) - (when (and (string-match (or (nth 0 item) "") (or method "")) - (string-match (or (nth 1 item) "") (or host ""))) - (setq luser (nth 2 item)) - (setq choices nil))) - luser) - tramp-default-user)) - -(defun tramp-find-host (method user host) - "Return the right host string to use. -This is HOST, if non-nil. Otherwise, it is `tramp-default-host'." - (or (and (> (length host) 0) host) - tramp-default-host)) - -(defun tramp-dissect-file-name (name &optional nodefault) - "Return a `tramp-file-name' structure. -The structure consists of remote method, remote user, remote host -and localname (file name on remote host). If NODEFAULT is -non-nil, the file name parts are not expanded to their default -values." - (save-match-data - (let ((match (string-match (nth 0 tramp-file-name-structure) name))) - (unless match (error "Not a Tramp file name: %s" name)) - (let ((method (match-string (nth 1 tramp-file-name-structure) name)) - (user (match-string (nth 2 tramp-file-name-structure) name)) - (host (match-string (nth 3 tramp-file-name-structure) name)) - (localname (match-string (nth 4 tramp-file-name-structure) name))) - (when (member method '("multi" "multiu")) - (error - "`%s' method is no longer supported, see (info \"(tramp)Multi-hops\")" - method)) - (when host - (when (string-match tramp-prefix-ipv6-regexp host) - (setq host (replace-match "" nil t host))) - (when (string-match tramp-postfix-ipv6-regexp host) - (setq host (replace-match "" nil t host)))) - (if nodefault - (vector method user host localname) - (vector - (tramp-find-method method user host) - (tramp-find-user method user host) - (tramp-find-host method user host) - localname)))))) - (defun tramp-equal-remote (file1 file2) "Check, whether the remote parts of FILE1 and FILE2 are identical. The check depends on method, user and host name of the files. If @@ -8195,37 +8094,6 @@ would yield `t'. On the other hand, the following check results in nil: (stringp (file-remote-p file2)) (string-equal (file-remote-p file1) (file-remote-p file2)))) -(defun tramp-make-tramp-file-name (method user host localname) - "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME." - (concat tramp-prefix-format - (when (not (zerop (length method))) - (concat method tramp-postfix-method-format)) - (when (not (zerop (length user))) - (concat user tramp-postfix-user-format)) - (when host - (if (string-match tramp-ipv6-regexp host) - (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) - host)) - tramp-postfix-host-format - (when localname localname))) - -(defun tramp-completion-make-tramp-file-name (method user host localname) - "Constructs a Tramp file name from METHOD, USER, HOST and LOCALNAME. -It must not be a complete Tramp file name, but as long as there are -necessary only. This function will be used in file name completion." - (concat tramp-prefix-format - (when (not (zerop (length method))) - (concat method tramp-postfix-method-format)) - (when (not (zerop (length user))) - (concat user tramp-postfix-user-format)) - (when (not (zerop (length host))) - (concat - (if (string-match tramp-ipv6-regexp host) - (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) - host) - tramp-postfix-host-format)) - (when localname localname))) - (defun tramp-make-copy-program-file-name (vec) "Create a file name suitable to be passed to `rcp' and workalikes." (let ((user (tramp-file-name-user vec)) @@ -8273,6 +8141,7 @@ necessary only. This function will be used in file name completion." ;; Variables local to connection. +;;;###tramp-autoload (defun tramp-get-remote-path (vec) (with-connection-property ;; When `tramp-own-remote-path' is in `tramp-remote-path', we @@ -8346,6 +8215,7 @@ necessary only. This function will be used in file name completion." x)) remote-path))))) +;;;###tramp-autoload (defun tramp-get-remote-tmpdir (vec) (with-connection-property vec "tmp-directory" (let ((dir (tramp-shell-quote-argument "/tmp"))) @@ -8427,6 +8297,7 @@ necessary only. This function will be used in file name completion." (tramp-message vec 5 "Finding command to check if file exists") (tramp-find-file-exists-command vec))) +;;;###tramp-autoload (defun tramp-get-remote-ln (vec) (with-connection-property vec "ln" (tramp-message vec 5 "Finding a suitable `ln' command") @@ -8674,8 +8545,9 @@ If the `tramp-methods' entry does not exist, return nil." ;; Permissions should be set always, because there might be an old ;; auto-saved file belonging to another original file. This could ;; be a security threat. - (set-file-modes buffer-auto-save-file-name - (or (file-modes bfn) (tramp-octal-to-decimal "0600")))))) + (set-file-modes + buffer-auto-save-file-name + (or (file-modes bfn) (tramp-compat-octal-to-decimal "0600")))))) (unless (and (featurep 'xemacs) (= emacs-major-version 21) @@ -8779,7 +8651,6 @@ Return the difference in the format of a time value." (defun tramp-time-diff (t1 t2) "Return the difference between the two times, in seconds. T1 and T2 are time values (as returned by `current-time' for example)." - ;; Pacify byte-compiler with `symbol-function'. (cond ((and (fboundp 'subtract-time) (fboundp 'float-time)) (tramp-compat-funcall @@ -8855,6 +8726,7 @@ exiting if process is running." ;; CCC: This function should be rewritten so that ;; `shell-quote-argument' is not used. This way, we are safe from ;; changes in `shell-quote-argument'. +;;;###tramp-autoload (defun tramp-shell-quote-argument (s) "Similar to `shell-quote-argument', but groks newlines. Only works for Bourne-like shells." @@ -8880,11 +8752,9 @@ Only works for Bourne-like shells." (defun tramp-unload-tramp () "Discard Tramp from loading remote files." (interactive) - ;; When Tramp is not loaded yet, its autoloads are still active. - (tramp-unload-file-name-handlers) ;; ange-ftp settings must be enabled. (tramp-compat-funcall 'tramp-ftp-enable-ange-ftp) - ;; Maybe its not loaded yet. + ;; Maybe it's not loaded yet. (condition-case nil (unload-feature 'tramp 'force) (error nil))) @@ -8983,10 +8853,16 @@ Only works for Bourne-like shells." ;; expects English? Or just to set LC_MESSAGES to "C" if Tramp ;; expects only English messages? (Juri Linkov) ;; * Make shadowfile.el grok Tramp filenames. (Bug#4526, Bug#4846) -;; * Load Tramp subpackages only when needed. (Bug#1529, Bug#5448, Bug#5705) ;; * Try telnet+curl as new method. It might be useful for busybox, ;; without built-in uuencode/uudecode. ;; * Load ~/.emacs_SHELLNAME on the remote host for `shell'. +;; * I was wondering it it would be possible to use tramp even if I'm +;; actually using sshfs. But when I launch a command I would like +;; to get it executed on the remote machine where the files really +;; are. (Andrea Crotti) +;; * Run emerge on two remote files. Bug is described here: +;; <http://www.mail-archive.com/tramp-devel@nongnu.org/msg01041.html>. +;; (Bug#6850) ;; Functions for file-name-handler-alist: ;; diff-latest-backup-file -- in diff.el diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 471a344b860..7690e859310 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -6,6 +6,7 @@ ;; Author: Kai Großjohann <kai.grossjohann@gmx.net> ;; Keywords: comm, processes +;; Package: tramp ;; This file is part of GNU Emacs. @@ -30,16 +31,29 @@ ;; version check is defined in macro AC_EMACS_INFO of aclocal.m4; ;; should be changed only there. -(defconst tramp-version "2.1.19-pre" +;;;###tramp-autoload +(defconst tramp-version "2.2.0-pre" "This version of Tramp.") +;;;###tramp-autoload (defconst tramp-bug-report-address "tramp-devel@gnu.org" "Email address to send bug reports to.") ;; Check for (X)Emacs version. -(let ((x (if (or (>= emacs-major-version 22) (and (featurep 'xemacs) (= emacs-major-version 21) (>= emacs-minor-version 4))) "ok" (format "Tramp 2.1.19-pre is not fit for %s" (when (string-match "^.*$" (emacs-version)) (match-string 0 (emacs-version))))))) +(let ((x (if (or (>= emacs-major-version 22) + (and (featurep 'xemacs) + (= emacs-major-version 21) + (>= emacs-minor-version 4))) + "ok" + (format "Tramp 2.2.0-pre is not fit for %s" + (when (string-match "^.*$" (emacs-version)) + (match-string 0 (emacs-version))))))) (unless (string-match "\\`ok\\'" x) (error "%s" x))) +(add-hook 'tramp-unload-hook + (lambda () + (unload-feature 'trampver 'force))) + (provide 'trampver) ;; arch-tag: 443576ca-f8f1-4bb1-addc-5c70861e93b1 diff --git a/lisp/newcomment.el b/lisp/newcomment.el index 5d2da467347..957bab0d275 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -6,6 +6,7 @@ ;; Author: code extracted from Emacs-20's simple.el ;; Maintainer: Stefan Monnier <monnier@iro.umontreal.ca> ;; Keywords: comment uncomment +;; Package: emacs ;; This file is part of GNU Emacs. @@ -945,12 +946,12 @@ indentation to be kept as it was before narrowing." (delete-char n) (setq ,bindent (- ,bindent n))))))))))) -;; Compute the number of extra comment starter characters -;; (extra semicolons in Lisp mode, extra stars in C mode, etc.) -;; If ARG is non-nil, just follow ARG. -;; If the comment-starter is multi-char, just follow ARG. -;; Otherwise obey comment-add, and double it if EXTRA is non-nil. (defun comment-add (arg) + "Compute the number of extra comment starter characters +\(extra semicolons in Lisp mode, extra stars in C mode, etc.) +If ARG is non-nil, just follow ARG. +If the comment starter is multi-char, just follow ARG. +Otherwise obey `comment-add'." (if (and (null arg) (= (string-match "[ \t]*\\'" comment-start) 1)) (* comment-add 1) (1- (prefix-numeric-value arg)))) diff --git a/lisp/notifications.el b/lisp/notifications.el index beb63a6311b..68db58e54fa 100644 --- a/lisp/notifications.el +++ b/lisp/notifications.el @@ -42,6 +42,9 @@ (require 'dbus) +(defconst notifications-specification-version "1.1" + "The version of the Desktop Notifications Specification implemented.") + (defconst notifications-application-name "Emacs" "Default application name.") @@ -151,7 +154,14 @@ Various PARAMS can be set: :image-data This is a raw data image format which describes the width, height, rowstride, has alpha, bits per sample, channels and image data respectively. + :image-path This is represented either as a URI (file:// is the + only URI schema supported right now) or a name + in a freedesktop.org-compliant icon theme. :sound-file The path to a sound file to play when the notification pops up. + :sound-name A themeable named sound from the freedesktop.org sound naming + specification to play when the notification pops up. + Similar to icon-name,only for sounds. An example would + be \"message-new-instant\". :suppress-sound Causes the server to suppress playing any sounds, if it has that ability. :x Specifies the X location on the screen that the notification @@ -186,7 +196,9 @@ used to manipulate the notification item with (category (plist-get params :category)) (desktop-entry (plist-get params :desktop-entry)) (image-data (plist-get params :image-data)) + (image-path (plist-get params :image-path)) (sound-file (plist-get params :sound-file)) + (sound-name (plist-get params :sound-name)) (suppress-sound (plist-get params :suppress-sound)) (x (plist-get params :x)) (y (plist-get params :y)) @@ -211,10 +223,18 @@ used to manipulate the notification item with (add-to-list 'hints `(:dict-entry "image_data" (:variant :struct ,image-data)) t)) + (when image-path + (add-to-list 'hints `(:dict-entry + "image_path" + (:variant :string ,image-path)) t)) (when sound-file (add-to-list 'hints `(:dict-entry "sound-file" (:variant :string ,sound-file)) t)) + (when sound-name + (add-to-list 'hints `(:dict-entry + "sound-name" + (:variant :string ,sound-name)) t)) (when suppress-sound (add-to-list 'hints `(:dict-entry "suppress-sound" diff --git a/lisp/nxml/TODO b/lisp/nxml/TODO deleted file mode 100644 index a5ac542f942..00000000000 --- a/lisp/nxml/TODO +++ /dev/null @@ -1,468 +0,0 @@ -* High priority - -** Command to insert an element template, including all required -attributes and child elements. When there's a choice of elements -possible, we could insert a comment, and put an overlay on that -comment that makes it behave like a button with a pop-up menu to -select the appropriate choice. - -** Command to tag a region. With a schema should complete using legal -tags, but should work without a schema as well. - -** Provide a way to conveniently rename an element. With a schema should -complete using legal tags, but should work without a schema as well. - -* Outlining - -** Implement C-c C-o C-q. - -** Install pre/post command hook for moving out of invisible section. - -** Put a modify hook on invisible sections that expands them. - -** Integrate dumb folding somehow. - -** An element should be able to be its own heading. - -** Optimize to avoid complete buffer scan on each command. - -** Make it work with HTML-style headings (i.e. level indicated by -name of heading element rather than depth of section nesting). - -** Recognize root element as a section provided it has a title, even -if it doesn't match section-element-name-regex. - -** Support for incremental search automatically making hidden text -visible. - -** Allow title to be an attribute. - -** Command that says to recognize the tag at point as a section/heading. - -** Explore better ways to determine when an element is a section -or a heading. - -** rng-next-error needs to either ignore invisible portion or reveal it -(maybe use isearch oriented text properties). - -** Errors within hidden section should be highlighted by underlining the -ellipsis. - -** Make indirect buffers work. - -** How should nxml-refresh outline recover from non well-formed tags? - -** Hide tags in title elements? - -** Use overlays instead of text properties for holding outline state? -Necessary for indirect buffers to work? - -** Allow an outline to go in the speedbar. - -** Split up outlining manual section into subsections. - -** More detail in the manual about each outlining command. - -** More menu entries for hiding/showing? - -** Indication of many lines have been hidden? - -* Locating schemas - -** Should rng-validate-mode give the user an opportunity to specify a -schema if there is currently none? Or should it at least give a hint -to the user how to specify a non-vacuous schema? - -** Support for adding new schemas to schema-locating files. Add -documentElement and namespace elements. - -** C-c C-w should be able to report current type id. - -** Implement doctypePublicId. - -** Implement typeIdBase. - -** Implement typeIdProcessingInstruction. - -** Support xml:base. - -** Implement group. - -** Find preferred prefix from schema-locating files. Get rid of -rng-preferred-prefix-alist. - -** Inserting document element with vacuous schema should complete using -document elements declared in schema locating files, and set schema -appropriately. - -** Add a ruleType attribute to the <include> element? - -** Allow processing instruction in prolog to contain the compact syntax -schema directly. - -** Use RDDL to locate a schema based on the namespace URI. - -** Should not prompt to add redundant association to schema locating -file. - -** Command to reload current schema. - -* Schema-sensitive features - -** Should filter dynamic markup possibilities using schema validity, by -adding hook to nxml-mode. - -** Dynamic markup word should (at least optionally) be able to look in -other buffers that are using nxml-mode. - -** Should clicking on Invalid move to next error if already on an error? - -** Take advantage of a:documentation. Needs change to schema format. - -** Provide feasible validation (as in Jing) toggle. - -** Save the validation state as a property on the error overlay to enable -more detailed diagnosis. - -** Provide an Error Summary buffer showing all the validation errors. - -** Pop-up menu. What is useful? Tag a region (should be greyed out if -the region is not balanced). Suggestions based on error messages. - -** Have configurable list of namespace URIs so that we can provide -namespace URI completion on extension elements or with schema-less -documents. - -** Allow validation to handle XInclude. - -** ID/IDREF support. - -* Completion - -** Make it work with icomplete. Only use a function to complete when -some of the possible names have undeclared namespaces. - -** How should C-return in mixed text work? - -** When there's a vacuous schema, C-return after < will insert the -end-tag. Is this a bug or a feature? - -** After completing start-tag, ensure we don't get unhelpful message -from validation - -** Syntax table for completion. - -** Should complete start-tag name with a space if namespace attributes -are required. - -** When completing start-tag name with no prefix and it doesn't match -should try to infer namespace from local name. - -** Should completion pay attention to characters after point? If so, -how? - -** When completing start-tag name, add required atts if only one required -attribute. - -** When completing attribute name, add attribute value if only one value -is possible. - -** After attribute-value completion, insert space after close delimiter -if more attributes are required. - -** Complete on enumerated data values in elements. - -** When in context that allows only elements, should get tag -completion without having to type < first. - -** When immediately after start-tag name, and name is valid and not -prefix of any other name, should C-return complete on attribute names? - -** When completing attributes, more consistent to ignore all attributes -after point. - -** Inserting attribute value completions needs to be sensitive to what -delimiter is used so that it quotes the correct character. - -** Complete on encoding-names in XML decl. - -** Complete namespace declarations by searching for all namespaces -mentioned in the schema. - -* Well-formed XML support - -** Deal better with Mule-UCS - -** Deal with UTF-8 BOM when reading. - -** Complete entity names. - -** Provide some support for entity names for MathML. - -** Command to repeat the last tag. - -** Support for changing between character references and characters. -Need to check that context is one in which character references are -allowed. xmltok prolog parsing will need to distinguish parameter -literals from other kinds of literal. - -** Provide a comment command to bind to M-; that works better than the -normal one. - -** Make indenting in a multi-line comment work. - -** Structure view. Separate buffer displaying element tree. Be able to -navigate from structure view to document and vice-versa. - -** Flash matching >. - -** Smart selection command that selects increasingly large syntactically -coherent chunks of XML. If point is in an attribute value, first -select complete value; then if command is repeated, select value plus -delimiters, then select attribute name as well, then complete -start-tag, then complete element, then enclosing element, etc. - -** ispell integration. - -** Block-level items in mixed content should be indented, e.g: - <para>This is list: - <ul> - <li>item</li> - -** Provide option to indent like this: - -** <para>This is a paragraph - occupying multiple lines.</para> - -** Option to add make a / that closes a start-tag electrically insert a -space for the XHTML guys. - -** C-M-q should work. - -* Datatypes - -** Figure out workaround for CJK characters with regexps. - -** Does category C contain Cn? - -** Do ENTITY datatype properly. - -* XML Parsing Library - -** Parameter entity parsing option, nil (never), t (always), -unless-standalone (unless standalone="yes" in XML declaration). - -** When a file is currently being edited, there should be an option to -use its buffer instead of the on-disk copy. - -* Handling all XML features - -** Provide better support for editing external general parsed entities. -Perhaps provide a way to force ignoring undefined entities; maybe turn -this on automatically with <?xml encoding=""?> (with no version -pseudo-att). - -** Handle internal general entity declarations containing elements. - -** Handle external general entity declarations. - -** Handle default attribute declarations in internal subset. - -** Handle parameter entities (including DTD). - -* RELAX NG - -** Do complete schema checking, at least optionally. - -** Detect include/external loops during schema parse. - -** Coding system detection for schemas. Should use utf-8/utf-16 per the -spec. But also need to allow encodings other than UTF-8/16 to support -CJK charsets that Emacs cannot represent in Unicode. - -* Catching XML errors - -** Check public identifiers. - -** Check default attribute values. - -* Performance - -** Explore whether overlay-recenter can cure overlays performance -problems. - -** Cache schemas. Need to have list of files and mtimes. - -** Make it possible to reduce rng-validate-chunk-size significantly, -perhaps to 500 bytes, without bad performance impact: don't do -redisplay on every chunk; pass continue functions on other uses of -rng-do-some-validation. - -** Cache after first tag. - -** Introduce a new name class that is a choice between names (so that -we can use member) - -** intern-choice should simplify after patterns with same 1st/2nd args - -** Large numbers of overlays slow things down dramatically. Represent -errors using text properties. This implies we cannot incrementally -keep track of the number of errors, in order to determine validity. -Instead, when validation completes, scan for any characters with an -error text property; this seems to be fast enough even with large -buffers. Problem with error at end of buffer, where there's no -character; need special variable for this. Need to merge face from -font-lock with the error face: use :inherit attribute with list of two -faces. How do we avoid making rng-valid depend on nxml-mode? - -* Error recovery - -** Don't stop at newline in looking for close of start-tag. - -** Use indentation to guide recovery from mismatched end-tags - -** Don't keep parsing when currently not well-formed but previously -well-formed - -** Try to recover from a bad start-tag by popping an open element if -there was a mismatched end-tag unaccounted for. - -** Try to recover from a bad start-tag open on the hypothesis that there -was an error in the namespace URI. - -** Better recovery from ill-formed XML declarations. - -* Useability improvements - -** Should print a "Parsing..." message during long movements. - -** Provide better position for reference to undefined pattern error. - -** Put Well-formed in the mode-line when validating against any-content. - -** Trim marking of illegal data for leading and trailing whitespace. - -** Show Invalid status as soon as we are sure it's invalid, rather than -waiting for everything to be completely up to date. - -** When narrowed, Valid or Invalid status should probably consider only -validity of narrowed region. - -* Bug fixes - -** Need to give an error for a document like: <foo/><![CDATA[ ]]> - -** Make nxml-forward-balanced-item work better for the prolog. - -** Make filling and indenting comments work in the prolog. - -** Should delete RNC Input buffers. - -** Figure out what regex use for NCName and use it consistently, - -** Should have not-well-formed tokens in ref. - -** Require version in XML declaration? Probably not because prevents -use for external parsed entities. At least forbid standalone -without version. - -** Reject schema that compiles to rng-not-allowed-ipattern. - -** Move point backwards on schema parse error so that it's on the right token. - -* Internal - -** Use rng-quote-string consistently. - -** Use parsing library for XML to texinfo conversion. - -** Rename xmltok.el to nxml-token.el. Use nxml-t- prefix instead of -xmltok-. Change nxml-t-type to nxml-t-token-type, nxml-t-start to -nxml-t-token-start. - -** Can we set fill-prefix to nil and rely on indenting? - -** xmltok should make available replacement text of entities containing -elements - -** In rng-valid, instead of using modification-hooks and -insert-behind-hooks on dependent overlays, use same technique as -nxml-mode. - -** Port to XEmacs. Issues include: Unicode (XEmacs seems to be based on -Mule-UCS); overlays/text properties vs extents; absence of -fontification-functions hook. - -* Fontification - -** Allow face to depend on element qname, attribute qname, attribute -value. Use list with pairs of (R . F), where R specifies regexps and -F specifies faces. How can this list be made to depend on the -document type? - -* Other - -** Support RELAX NG XML syntax (use XML parsing library). - -** Support W3C XML Schema (use XML parsing library). - -** Command to infer schema from current document (like trang). - -* Schemas - -** XSLT schema should take advantage of RELAX NG to express cooccurrence -constraints on attributes (e.g. xsl:template). - -* Documentation - -** Move material from README to manual. - -** Document encodings. - -* Notes - -** How can we allow an error to be displayed on a different token from -where it is detected? In particular, for a missing closing ">" we -will need to display it at the beginning of the following token. At -the moment, when we parse the following token the error overlay will -get cleared. - -** How should rng-goto-next-error deal with narrowing? - -** Perhaps should merge errors having same start position even if they -have different ends. - -** How to handle surrogates? One possibility is to be compatible with -utf8.e: represent as sequence of 4 chars. But utf-16 is incompatible -with this. - -** Should we distinguish well-formedness errors from invalidity errors? -(I think not: we may want to recover from a bad start-tag by implying -an end-tag.) - -** Seems to be a bug with Emacs, where a mouse movement that causes -help-echo text to appear counts as pending input but does not cause -idle timer to be restarted. - -** Use XML to represent this file. - -** I had a TODO which said simply "split-string". What did I mean? - -** Investigate performance on large files all on one line. - -* Issues for Emacs versions >= 22 - -** Take advantage of UTF-8 CJK support. - -** Supply a next-error-function. - -** Investigate this NEWS item "Emacs now tries to set up buffer coding -systems for HTML/XML files automatically." - -** Take advantage of the pointer text property. - -** Leverage char-displayable-p. - -Local variables: -mode: outline -end: diff --git a/lisp/org/ChangeLog b/lisp/org/ChangeLog index 9fb48e00ed7..c0b3fa567c6 100644 --- a/lisp/org/ChangeLog +++ b/lisp/org/ChangeLog @@ -1,3 +1,33 @@ +2010-08-19 Glenn Morris <rgm@gnu.org> + + * org.el (org-outline-overlay-data, org-set-outline-overlay-data) + (org-save-outline-visibility): Move to org-macs. + * org-macs.el (org-outline-overlay-data, org-set-outline-overlay-data) + (org-save-outline-visibility): Move here from org.el. + (show-all): Autoload it. + * ob.el: Don't require org when compiling. + +2010-08-18 Glenn Morris <rgm@gnu.org> + + * ob.el: Require org when compiling. + (org-save-outline-visibility): Remove macro declaration. + * ob-emacs-lisp.el: Require ob-comint when compiling, for macros. + Remove unnecessary/macro declarations. + * org-docview.el: Require doc-view when compiling. + (doc-view-goto-page): Autoload rather than declaring. + (doc-view-current-page): Remove macro declaration. + +2010-08-17 Glenn Morris <rgm@gnu.org> + + * ob.el (tramp-compat-make-temp-file, org-edit-src-code) + (org-entry-get, org-table-import): Fix declarations. + (org-match-string-no-properties): Remove unnecessary declaration. + * ob-sh.el (org-babel-comint-in-buffer) + (org-babel-comint-wait-for-output, org-babel-comint-buffer-livep) + (org-babel-comint-with-output): Remove unnecessary declarations. + * ob-R.el (orgtbl-to-tsv): Fix declaration. + * org-list.el (org-entry-get): Fix declaration. + 2010-07-19 Eric Schulte <schulte.eric@gmail.com> * ob-C.el: New file. diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el index 105862c1571..d990d69b357 100644 --- a/lisp/org/ob-R.el +++ b/lisp/org/ob-R.el @@ -33,7 +33,7 @@ (require 'ob-eval) (eval-when-compile (require 'cl)) -(declare-function orgtbl-to-tsv "ob-table" (table params)) +(declare-function orgtbl-to-tsv "org-table" (table params)) (declare-function R "ext:essd-r" (&optional start-args)) (declare-function inferior-ess-send-input "ext:ess-inf" ()) diff --git a/lisp/org/ob-emacs-lisp.el b/lisp/org/ob-emacs-lisp.el index 92c3f36e2ed..2ec729f7dcd 100644 --- a/lisp/org/ob-emacs-lisp.el +++ b/lisp/org/ob-emacs-lisp.el @@ -28,15 +28,12 @@ ;;; Code: (require 'ob) +(eval-when-compile (require 'ob-comint)) (defvar org-babel-default-header-args:emacs-lisp '((:hlines . "yes") (:colnames . "no")) "Default arguments for evaluating an emacs-lisp source block.") -(declare-function org-babel-comint-with-output "ob-comint" (&rest body)) -(declare-function org-babel-comint-buffer-livep "ob-comint" (buffer)) -(declare-function org-babel-comint-wait-for-output "ob-comint" (buffer)) -(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body)) (declare-function orgtbl-to-generic "org-table" (table params)) (defun org-babel-expand-body:emacs-lisp (body params &optional processed-params) diff --git a/lisp/org/ob-sh.el b/lisp/org/ob-sh.el index 69fbefc82c4..072bc91af1c 100644 --- a/lisp/org/ob-sh.el +++ b/lisp/org/ob-sh.el @@ -34,10 +34,6 @@ (eval-when-compile (require 'cl)) (declare-function org-babel-ref-variables "ob-ref" (params)) -(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body)) -(declare-function org-babel-comint-wait-for-output "ob-comint" (buffer)) -(declare-function org-babel-comint-buffer-livep "ob-comint" (buffer)) -(declare-function org-babel-comint-with-output "ob-comint" (meta &rest body)) (declare-function orgtbl-to-generic "org-table" (table params)) (defvar org-babel-default-header-args:sh '()) diff --git a/lisp/org/ob.el b/lisp/org/ob.el index eeb60836b3f..a58fb4eca8a 100644 --- a/lisp/org/ob.el +++ b/lisp/org/ob.el @@ -25,33 +25,34 @@ ;;; Commentary: ;; See the online documentation for more information -;; +;; ;; http://orgmode.org/worg/org-contrib/babel/ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile + (require 'cl)) (require 'org-macs) (defvar org-babel-call-process-region-original) (declare-function show-all "outline" ()) -(declare-function tramp-compat-make-temp-file "tramp" (filename &optional dir-flag)) +(declare-function tramp-compat-make-temp-file "tramp-compat" + (filename &optional dir-flag)) (declare-function tramp-dissect-file-name "tramp" (name &optional nodefault)) (declare-function tramp-file-name-user "tramp" (vec)) (declare-function tramp-file-name-host "tramp" (vec)) (declare-function org-icompleting-read "org" (&rest args)) -(declare-function org-edit-src-code "org" (context code edit-buffer-name)) +(declare-function org-edit-src-code "org-src" + (&optional context code edit-buffer-name)) (declare-function org-open-at-point "org" (&optional in-emacs reference-buffer)) -(declare-function org-save-outline-visibility "org" (use-markers &rest body)) (declare-function org-narrow-to-subtree "org" ()) -(declare-function org-entry-get "org" (pom property &optional inherit)) +(declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) (declare-function org-make-options-regexp "org" (kwds &optional extra)) -(declare-function org-match-string-no-properties "org" (num &optional string)) (declare-function org-do-remove-indentation "org" (&optional n)) (declare-function org-show-context "org" (&optional key)) (declare-function org-at-table-p "org" (&optional table-type)) (declare-function org-cycle "org" (&optional arg)) (declare-function org-uniquify "org" (list)) -(declare-function org-table-import "org" (file arg)) +(declare-function org-table-import "org-table" (file arg)) (declare-function org-add-hook "org-compat" (hook function &optional append local)) (declare-function org-table-align "org-table" ()) (declare-function org-table-end "org-table" (&optional table-type)) diff --git a/lisp/org/org-docview.el b/lisp/org/org-docview.el index cac13e6ddfc..0ef5df0fda6 100644 --- a/lisp/org/org-docview.el +++ b/lisp/org/org-docview.el @@ -45,9 +45,9 @@ (require 'org) +(eval-when-compile (require 'doc-view)) ; doc-view-current-page macro -(declare-function doc-view-goto-page "doc-view" (page)) -(declare-function doc-view-current-page "doc-view" (&optional win)) +(autoload 'doc-view-goto-page "doc-view") (org-add-link-type "docview" 'org-docview-open) (add-hook 'org-store-link-functions 'org-docview-store-link) diff --git a/lisp/org/org-list.el b/lisp/org/org-list.el index f1d6520fe51..19ba1a96395 100644 --- a/lisp/org/org-list.el +++ b/lisp/org/org-list.el @@ -51,7 +51,8 @@ (declare-function org-get-indentation "org" (&optional line)) (declare-function org-timer-item "org-timer" (&optional arg)) (declare-function org-combine-plists "org" (&rest plists)) -(declare-function org-entry-get "org" (pom property &optional inherit)) +(declare-function org-entry-get "org" + (pom property &optional inherit literal-nil)) (declare-function org-narrow-to-subtree "org" ()) (declare-function org-show-subtree "org" ()) diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index abcdcdc94eb..212fae4fcc9 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -300,6 +300,66 @@ The number of levels is controlled by `org-inlinetask-min-level'" (nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level))) (format "\\*\\{1,%d\\} " nstars)))) + +;;; Saving and restoring visibility + +(defun org-outline-overlay-data (&optional use-markers) + "Return a list of the locations of all outline overlays. +The are overlays with the `invisible' property value `outline'. +The return values is a list of cons cells, with start and stop +positions for each overlay. +If USE-MARKERS is set, return the positions as markers." + (let (beg end) + (save-excursion + (save-restriction + (widen) + (delq nil + (mapcar (lambda (o) + (when (eq (overlay-get o 'invisible) 'outline) + (setq beg (overlay-start o) + end (overlay-end o)) + (and beg end (> end beg) + (if use-markers + (cons (move-marker (make-marker) beg) + (move-marker (make-marker) end)) + (cons beg end))))) + (overlays-in (point-min) (point-max)))))))) + +(autoload 'show-all "outline" nil t) + +(defun org-set-outline-overlay-data (data) + "Create visibility overlays for all positions in DATA. +DATA should have been made by `org-outline-overlay-data'." + (let (o) + (save-excursion + (save-restriction + (widen) + (show-all) + (mapc (lambda (c) + (setq o (make-overlay (car c) (cdr c))) + (overlay-put o 'invisible 'outline)) + data))))) + +(defmacro org-save-outline-visibility (use-markers &rest body) + "Save and restore outline visibility around BODY. +If USE-MARKERS is non-nil, use markers for the positions. +This means that the buffer may change while running BODY, +but it also means that the buffer should stay alive +during the operation, because otherwise all these markers will +point nowhere." + (declare (indent 1)) + `(let ((data (org-outline-overlay-data ,use-markers))) + (unwind-protect + (progn + ,@body + (org-set-outline-overlay-data data)) + (when ,use-markers + (mapc (lambda (c) + (and (markerp (car c)) (move-marker (car c) nil)) + (and (markerp (cdr c)) (move-marker (cdr c) nil))) + data))))) + + (provide 'org-macs) ;; arch-tag: 7e6a73ce-aac9-4fc0-9b30-ce6f89dc6668 diff --git a/lisp/org/org.el b/lisp/org/org.el index 5b37e0aa260..a2965e87d22 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -6190,62 +6190,6 @@ Optional argument N means put the headline into the Nth line of the window." (beginning-of-line) (recenter (prefix-numeric-value N)))) -;;; Saving and restoring visibility - -(defun org-outline-overlay-data (&optional use-markers) - "Return a list of the locations of all outline overlays. -The are overlays with the `invisible' property value `outline'. -The return values is a list of cons cells, with start and stop -positions for each overlay. -If USE-MARKERS is set, return the positions as markers." - (let (beg end) - (save-excursion - (save-restriction - (widen) - (delq nil - (mapcar (lambda (o) - (when (eq (overlay-get o 'invisible) 'outline) - (setq beg (overlay-start o) - end (overlay-end o)) - (and beg end (> end beg) - (if use-markers - (cons (move-marker (make-marker) beg) - (move-marker (make-marker) end)) - (cons beg end))))) - (overlays-in (point-min) (point-max)))))))) - -(defun org-set-outline-overlay-data (data) - "Create visibility overlays for all positions in DATA. -DATA should have been made by `org-outline-overlay-data'." - (let (o) - (save-excursion - (save-restriction - (widen) - (show-all) - (mapc (lambda (c) - (setq o (make-overlay (car c) (cdr c))) - (overlay-put o 'invisible 'outline)) - data))))) - -(defmacro org-save-outline-visibility (use-markers &rest body) - "Save and restore outline visibility around BODY. -If USE-MARKERS is non-nil, use markers for the positions. -This means that the buffer may change while running BODY, -but it also means that the buffer should stay alive -during the operation, because otherwise all these markers will -point nowhere." - (declare (indent 1)) - `(let ((data (org-outline-overlay-data ,use-markers))) - (unwind-protect - (progn - ,@body - (org-set-outline-overlay-data data)) - (when ,use-markers - (mapc (lambda (c) - (and (markerp (car c)) (move-marker (car c) nil)) - (and (markerp (cdr c)) (move-marker (cdr c) nil))) - data))))) - ;;; Folding of blocks diff --git a/lisp/password-cache.el b/lisp/password-cache.el index 7c07642a1f3..7c67ab17702 100644 --- a/lisp/password-cache.el +++ b/lisp/password-cache.el @@ -134,5 +134,4 @@ The password is removed by a timer after `password-cache-expiry' seconds." (provide 'password-cache) -;; arch-tag: ab160494-16c8-4c68-a4a1-73eebf6686e5 ;;; password-cache.el ends here diff --git a/lisp/paths.el b/lisp/paths.el index 510caa3a876..095326e9c8e 100644 --- a/lisp/paths.el +++ b/lisp/paths.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/pcmpl-cvs.el b/lisp/pcmpl-cvs.el index 8b394826e63..98d1e476669 100644 --- a/lisp/pcmpl-cvs.el +++ b/lisp/pcmpl-cvs.el @@ -4,6 +4,7 @@ ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: John Wiegley <johnw@gnu.org> +;; Package: pcomplete ;; This file is part of GNU Emacs. diff --git a/lisp/pcmpl-gnu.el b/lisp/pcmpl-gnu.el index accab1dea9d..df1f055506c 100644 --- a/lisp/pcmpl-gnu.el +++ b/lisp/pcmpl-gnu.el @@ -3,6 +3,8 @@ ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Package: pcomplete + ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify diff --git a/lisp/pcmpl-linux.el b/lisp/pcmpl-linux.el index 67ef8e76aad..59c084fffae 100644 --- a/lisp/pcmpl-linux.el +++ b/lisp/pcmpl-linux.el @@ -3,6 +3,8 @@ ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Package: pcomplete + ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify diff --git a/lisp/pcmpl-rpm.el b/lisp/pcmpl-rpm.el index 754d7ce7434..7960141f03e 100644 --- a/lisp/pcmpl-rpm.el +++ b/lisp/pcmpl-rpm.el @@ -3,6 +3,8 @@ ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, ;; 2008, 2009, 2010 Free Software Foundation, Inc. +;; Package: pcomplete + ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify diff --git a/lisp/pcmpl-unix.el b/lisp/pcmpl-unix.el index 9282fe87b5a..f2c19ca71c4 100644 --- a/lisp/pcmpl-unix.el +++ b/lisp/pcmpl-unix.el @@ -3,6 +3,8 @@ ;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Package: pcomplete + ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify diff --git a/lisp/pgg-def.el b/lisp/pgg-def.el index c506d579283..d1b78ccb30b 100644 --- a/lisp/pgg-def.el +++ b/lisp/pgg-def.el @@ -6,6 +6,7 @@ ;; Author: Daiki Ueno <ueno@unixuser.org> ;; Created: 1999/11/02 ;; Keywords: PGP, OpenPGP, GnuPG +;; Package: pgg ;; This file is part of GNU Emacs. @@ -94,5 +95,4 @@ Whether the passphrase is cached at all is controlled by (provide 'pgg-def) -;; arch-tag: c425f3ab-ed75-4055-bb46-431a418c94b7 ;;; pgg-def.el ends here diff --git a/lisp/pgg-gpg.el b/lisp/pgg-gpg.el index e8375fe58fe..97b3b3e3d42 100644 --- a/lisp/pgg-gpg.el +++ b/lisp/pgg-gpg.el @@ -4,10 +4,11 @@ ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Daiki Ueno <ueno@unixuser.org> -;; Symmetric encryption and gpg-agent support added by: +;; Symmetric encryption and gpg-agent support added by: ;; Sascha Wilde <wilde@sha-bang.de> ;; Created: 1999/10/28 ;; Keywords: PGP, OpenPGP, GnuPG +;; Package: pgg ;; This file is part of GNU Emacs. @@ -406,5 +407,4 @@ passphrase cache or user." (provide 'pgg-gpg) -;; arch-tag: 2aa5d5d8-93a0-4865-9312-33e29830e000 ;;; pgg-gpg.el ends here diff --git a/lisp/pgg-parse.el b/lisp/pgg-parse.el index 40df20bde34..2325171b68b 100644 --- a/lisp/pgg-parse.el +++ b/lisp/pgg-parse.el @@ -6,6 +6,7 @@ ;; Author: Daiki Ueno <ueno@unixuser.org> ;; Created: 1999/10/28 ;; Keywords: PGP, OpenPGP, GnuPG +;; Package: pgg ;; This file is part of GNU Emacs. @@ -518,5 +519,4 @@ (provide 'pgg-parse) -;; arch-tag: 16c2eb82-1313-4a7c-a70f-420709b5b43e ;;; pgg-parse.el ends here diff --git a/lisp/pgg-pgp.el b/lisp/pgg-pgp.el index c1c9249a736..dfa02d78353 100644 --- a/lisp/pgg-pgp.el +++ b/lisp/pgg-pgp.el @@ -6,6 +6,7 @@ ;; Author: Daiki Ueno <ueno@unixuser.org> ;; Created: 1999/11/02 ;; Keywords: PGP, OpenPGP +;; Package: pgg ;; This file is part of GNU Emacs. @@ -253,5 +254,4 @@ passphrase cache or user." (provide 'pgg-pgp) -;; arch-tag: 076b7801-37b2-49a6-97c3-218fdecde33c ;;; pgg-pgp.el ends here diff --git a/lisp/pgg-pgp5.el b/lisp/pgg-pgp5.el index cb2cfd915fb..49731190946 100644 --- a/lisp/pgg-pgp5.el +++ b/lisp/pgg-pgp5.el @@ -6,6 +6,7 @@ ;; Author: Daiki Ueno <ueno@unixuser.org> ;; Created: 1999/11/02 ;; Keywords: PGP, OpenPGP +;; Package: pgg ;; This file is part of GNU Emacs. @@ -254,5 +255,4 @@ Bourne shell or its equivalent \(not tcsh) is needed for \"2>\"." (provide 'pgg-pgp5) -;; arch-tag: 3dbd1073-6b3a-466c-9f55-5c587ffa6d7b ;;; pgg-pgp5.el ends here diff --git a/lisp/pgg.el b/lisp/pgg.el index 8209dc1608f..8827424ce34 100644 --- a/lisp/pgg.el +++ b/lisp/pgg.el @@ -602,5 +602,4 @@ within the region." (provide 'pgg) -;; arch-tag: 9cc705dd-1e6a-4c90-8dce-c3561f9a2cf4 ;;; pgg.el ends here diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el index 75c0d9b2b06..e786c6cc5c1 100644 --- a/lisp/play/cookie1.el +++ b/lisp/play/cookie1.el @@ -138,7 +138,7 @@ Optional fifth arg REQUIRE-MATCH non-nil forces a matching cookie." (vec (cookie-snarf phrase-file startmsg endmsg)) (i (length vec))) - (while (> (setq i (1- i)) 0) + (while (>= (setq i (1- i)) 0) (setq alist (cons (list (aref vec i)) alist))) (put sym 'completion-alist alist)))) nil require-match nil nil)) diff --git a/lisp/proced.el b/lisp/proced.el index 06056ed2683..ee4e7b26ca1 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. -;; Author: Roland Winkler <Roland.Winkler@physik.uni-erlangen.de> +;; Author: Roland Winkler <winkler@gnu.org> ;; Keywords: Processes, Unix ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index 227f202fef0..4bbe1e43f85 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el @@ -834,10 +834,7 @@ the 4 file locations can be clicked on and jumped to." ;; ;; On Emacs, this is done through the `syntax-table' text property. The ;; corresponding action is applied automatically each time the buffer -;; changes. If `font-lock-mode' is enabled (the default) the action is -;; set up by `font-lock-syntactic-keywords'. Otherwise, we do it -;; manually in `ada-after-change-function'. The proper method is -;; installed by `ada-handle-syntax-table-properties'. +;; changes via syntax-propertize-function. ;; ;; on XEmacs, the `syntax-table' property does not exist and we have to use a ;; slow advice to `parse-partial-sexp' to do the same thing. @@ -937,6 +934,12 @@ declares it as a word constituent." (insert (caddar change)) (setq change (cdr change))))))) +(unless (eval-when-compile (fboundp 'syntax-propertize-via-font-lock)) + ;; Before `syntax-propertize', we had to use font-lock to apply syntax-table + ;; properties, and in some cases we even had to do it manually (in + ;; `ada-after-change-function'). `ada-handle-syntax-table-properties' + ;; decides which method to use. + (defun ada-set-syntax-table-properties () "Assign `syntax-table' properties in accessible part of buffer. In particular, character constants are said to be strings, #...# @@ -991,6 +994,8 @@ OLD-LEN indicates what the length of the replaced text was." ;; Take care of `syntax-table' properties manually. (ada-initialize-syntax-table-properties))) +) ;;(not (fboundp 'syntax-propertize)) + ;;------------------------------------------------------------------ ;; Testing the grammatical context ;;------------------------------------------------------------------ @@ -1118,7 +1123,8 @@ the file name." ;;;###autoload (defun ada-mode () - "Ada mode is the major mode for editing Ada code." + "Ada mode is the major mode for editing Ada code. +\\{ada-mode-map}" (interactive) (kill-all-local-variables) @@ -1161,9 +1167,9 @@ the file name." (set (make-local-variable 'comment-padding) 0) (set (make-local-variable 'parse-sexp-lookup-properties) t)) - (set 'case-fold-search t) + (setq case-fold-search t) (if (boundp 'imenu-case-fold-search) - (set 'imenu-case-fold-search t)) + (setq imenu-case-fold-search t)) (set (make-local-variable 'fill-paragraph-function) 'ada-fill-comment-paragraph) @@ -1186,8 +1192,13 @@ the file name." '(ada-font-lock-keywords nil t ((?\_ . "w") (?# . ".")) - beginning-of-line - (font-lock-syntactic-keywords . ada-font-lock-syntactic-keywords))) + beginning-of-line)) + + (if (eval-when-compile (fboundp 'syntax-propertize-via-font-lock)) + (set (make-local-variable 'syntax-propertize-function) + (syntax-propertize-via-font-lock ada-font-lock-syntactic-keywords)) + (set (make-local-variable 'font-lock-syntactic-keywords) + ada-font-lock-syntactic-keywords)) ;; Set up support for find-file.el. (set (make-local-variable 'ff-other-file-alist) @@ -1322,22 +1333,24 @@ the file name." ;; To be run after the hook, in case the user modified ;; ada-fill-comment-prefix - (make-local-variable 'comment-start) - (if ada-fill-comment-prefix - (set 'comment-start ada-fill-comment-prefix) - (set 'comment-start "-- ")) + ;; FIXME: if the user modified ada-fill-comment-prefix in his .emacs + ;; then it was already available before running the hook, and if he + ;; modifies it in the hook, he might as well modify comment-start instead. + (set (make-local-variable 'comment-start) (or ada-fill-comment-prefix "-- ")) ;; Run this after the hook to give the users a chance to activate ;; font-lock-mode - (unless (featurep 'xemacs) + (unless (or (eval-when-compile (fboundp 'syntax-propertize-via-font-lock)) + (featurep 'xemacs)) (ada-initialize-syntax-table-properties) (add-hook 'font-lock-mode-hook 'ada-handle-syntax-table-properties nil t)) ;; the following has to be done after running the ada-mode-hook ;; because users might want to set the values of these variable ;; inside the hook - + ;; FIXME: it might even be set later on via file-local vars, no? + ;; so maybe ada-keywords should be set lazily. (cond ((eq ada-language-version 'ada83) (setq ada-keywords ada-83-keywords)) ((eq ada-language-version 'ada95) @@ -1397,25 +1410,21 @@ If WORD is not given, then the current word in the buffer is used instead. The new word is added to the first file in `ada-case-exception-file'. The standard casing rules will no longer apply to this word." (interactive) - (let ((previous-syntax-table (syntax-table)) - file-name - ) - - (cond ((stringp ada-case-exception-file) - (setq file-name ada-case-exception-file)) - ((listp ada-case-exception-file) - (setq file-name (car ada-case-exception-file))) - (t - (error (concat "No exception file specified. " - "See variable ada-case-exception-file")))) + (let ((file-name + (cond ((stringp ada-case-exception-file) + ada-case-exception-file) + ((listp ada-case-exception-file) + (car ada-case-exception-file)) + (t + (error (concat "No exception file specified. " + "See variable ada-case-exception-file")))))) - (set-syntax-table ada-mode-symbol-syntax-table) (unless word - (save-excursion - (skip-syntax-backward "w") - (setq word (buffer-substring-no-properties - (point) (save-excursion (forward-word 1) (point)))))) - (set-syntax-table previous-syntax-table) + (with-syntax-table ada-mode-symbol-syntax-table + (save-excursion + (skip-syntax-backward "w") + (setq word (buffer-substring-no-properties + (point) (save-excursion (forward-word 1) (point))))))) ;; Reread the exceptions file, in case it was modified by some other, (ada-case-read-exceptions-from-file file-name) @@ -1425,11 +1434,9 @@ The standard casing rules will no longer apply to this word." (if (and (not (equal ada-case-exception '())) (assoc-string word ada-case-exception t)) (setcar (assoc-string word ada-case-exception t) word) - (add-to-list 'ada-case-exception (cons word t)) - ) + (add-to-list 'ada-case-exception (cons word t))) - (ada-save-exceptions-to-file file-name) - )) + (ada-save-exceptions-to-file file-name))) (defun ada-create-case-exception-substring (&optional word) "Define the substring WORD as an exception for the casing system. @@ -1464,7 +1471,7 @@ word itself has a special casing." (modify-syntax-entry ?_ "." (syntax-table)) (save-excursion (skip-syntax-backward "w") - (set 'word (buffer-substring-no-properties + (setq word (buffer-substring-no-properties (point) (save-excursion (forward-word 1) (point)))))) (modify-syntax-entry ?_ (make-string 1 underscore-syntax) @@ -1633,37 +1640,30 @@ ARG is the prefix the user entered with \\[universal-argument]." (interactive "P") (if ada-auto-case - (let ((lastk last-command-event) - (previous-syntax-table (syntax-table))) - - (unwind-protect - (progn - (set-syntax-table ada-mode-symbol-syntax-table) - (cond ((or (eq lastk ?\n) - (eq lastk ?\r)) - ;; horrible kludge - (insert " ") - (ada-adjust-case) - ;; horrible dekludge - (delete-char -1) - ;; some special keys and their bindings - (cond - ((eq lastk ?\n) - (funcall ada-lfd-binding)) - ((eq lastk ?\r) - (funcall ada-ret-binding)))) - ((eq lastk ?\C-i) (ada-tab)) - ;; Else just insert the character - ((self-insert-command (prefix-numeric-value arg)))) - ;; if there is a keyword in front of the underscore - ;; then it should be part of an identifier (MH) - (if (eq lastk ?_) - (ada-adjust-case t) - (ada-adjust-case)) - ) - ;; Restore the syntax table - (set-syntax-table previous-syntax-table)) - ) + (let ((lastk last-command-event)) + + (with-syntax-table ada-mode-symbol-syntax-table + (cond ((or (eq lastk ?\n) + (eq lastk ?\r)) + ;; horrible kludge + (insert " ") + (ada-adjust-case) + ;; horrible dekludge + (delete-char -1) + ;; some special keys and their bindings + (cond + ((eq lastk ?\n) + (funcall ada-lfd-binding)) + ((eq lastk ?\r) + (funcall ada-ret-binding)))) + ((eq lastk ?\C-i) (ada-tab)) + ;; Else just insert the character + ((self-insert-command (prefix-numeric-value arg)))) + ;; if there is a keyword in front of the underscore + ;; then it should be part of an identifier (MH) + (if (eq lastk ?_) + (ada-adjust-case t) + (ada-adjust-case)))) ;; Else, no auto-casing (cond @@ -1672,10 +1672,10 @@ ARG is the prefix the user entered with \\[universal-argument]." ((eq last-command-event ?\r) (funcall ada-ret-binding)) (t - (self-insert-command (prefix-numeric-value arg)))) - )) + (self-insert-command (prefix-numeric-value arg)))))) (defun ada-activate-keys-for-case () + ;; FIXME: Use post-self-insert-hook instead of changing key bindings. "Modify the key bindings for all the keys that should readjust the casing." (interactive) ;; Save original key-bindings to allow swapping ret/lfd @@ -1735,44 +1735,41 @@ Attention: This function might take very long for big regions!" (let ((begin nil) (end nil) (keywordp nil) - (attribp nil) - (previous-syntax-table (syntax-table))) + (attribp nil)) (message "Adjusting case ...") - (unwind-protect - (save-excursion - (set-syntax-table ada-mode-symbol-syntax-table) - (goto-char to) - ;; - ;; loop: look for all identifiers, keywords, and attributes - ;; - (while (re-search-backward "\\<\\(\\sw+\\)\\>" from t) - (setq end (match-end 1)) - (setq attribp - (and (> (point) from) - (save-excursion - (forward-char -1) - (setq attribp (looking-at "'.[^']"))))) - (or - ;; do nothing if it is a string or comment - (ada-in-string-or-comment-p) - (progn - ;; - ;; get the identifier or keyword or attribute - ;; - (setq begin (point)) - (setq keywordp (looking-at ada-keywords)) - (goto-char end) - ;; - ;; casing according to user-option - ;; - (if attribp - (funcall ada-case-attribute -1) - (if keywordp - (funcall ada-case-keyword -1) - (ada-adjust-case-identifier))) - (goto-char begin)))) - (message "Adjusting case ... Done")) - (set-syntax-table previous-syntax-table)))) + (with-syntax-table ada-mode-symbol-syntax-table + (save-excursion + (goto-char to) + ;; + ;; loop: look for all identifiers, keywords, and attributes + ;; + (while (re-search-backward "\\<\\(\\sw+\\)\\>" from t) + (setq end (match-end 1)) + (setq attribp + (and (> (point) from) + (save-excursion + (forward-char -1) + (setq attribp (looking-at "'.[^']"))))) + (or + ;; do nothing if it is a string or comment + (ada-in-string-or-comment-p) + (progn + ;; + ;; get the identifier or keyword or attribute + ;; + (setq begin (point)) + (setq keywordp (looking-at ada-keywords)) + (goto-char end) + ;; + ;; casing according to user-option + ;; + (if attribp + (funcall ada-case-attribute -1) + (if keywordp + (funcall ada-case-keyword -1) + (ada-adjust-case-identifier))) + (goto-char begin)))) + (message "Adjusting case ... Done"))))) (defun ada-adjust-case-buffer () "Adjust the case of all words in the whole buffer. @@ -1803,46 +1800,39 @@ ATTENTION: This function might take very long for big buffers!" (let ((begin nil) (end nil) (delend nil) - (paramlist nil) - (previous-syntax-table (syntax-table))) - (unwind-protect - (progn - (set-syntax-table ada-mode-symbol-syntax-table) + (paramlist nil)) + (with-syntax-table ada-mode-symbol-syntax-table - ;; check if really inside parameter list - (or (ada-in-paramlist-p) - (error "Not in parameter list")) + ;; check if really inside parameter list + (or (ada-in-paramlist-p) + (error "Not in parameter list")) - ;; find start of current parameter-list - (ada-search-ignore-string-comment - (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil) - (down-list 1) - (backward-char 1) - (setq begin (point)) + ;; find start of current parameter-list + (ada-search-ignore-string-comment + (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil) + (down-list 1) + (backward-char 1) + (setq begin (point)) - ;; find end of parameter-list - (forward-sexp 1) - (setq delend (point)) - (delete-char -1) - (insert "\n") - - ;; find end of last parameter-declaration - (forward-comment -1000) - (setq end (point)) + ;; find end of parameter-list + (forward-sexp 1) + (setq delend (point)) + (delete-char -1) + (insert "\n") - ;; build a list of all elements of the parameter-list - (setq paramlist (ada-scan-paramlist (1+ begin) end)) + ;; find end of last parameter-declaration + (forward-comment -1000) + (setq end (point)) - ;; delete the original parameter-list - (delete-region begin delend) + ;; build a list of all elements of the parameter-list + (setq paramlist (ada-scan-paramlist (1+ begin) end)) - ;; insert the new parameter-list - (goto-char begin) - (ada-insert-paramlist paramlist)) + ;; delete the original parameter-list + (delete-region begin delend) - ;; restore syntax-table - (set-syntax-table previous-syntax-table) - ))) + ;; insert the new parameter-list + (goto-char begin) + (ada-insert-paramlist paramlist)))) (defun ada-scan-paramlist (begin end) "Scan the parameter list found in between BEGIN and END. @@ -2186,14 +2176,12 @@ Return the new position of point or nil if not found." Return the calculation that was done, including the reference point and the offset." (interactive) - (let ((previous-syntax-table (syntax-table)) - (orgpoint (point-marker)) + (let ((orgpoint (point-marker)) cur-indent tmp-indent prev-indent) (unwind-protect - (progn - (set-syntax-table ada-mode-symbol-syntax-table) + (with-syntax-table ada-mode-symbol-syntax-table ;; This need to be done here so that the advice is not always ;; activated (this might interact badly with other modes) @@ -2203,14 +2191,14 @@ and the offset." (save-excursion (setq cur-indent - ;; Not First line in the buffer ? - (if (save-excursion (zerop (forward-line -1))) - (progn - (back-to-indentation) - (ada-get-current-indent)) + ;; Not First line in the buffer ? + (if (save-excursion (zerop (forward-line -1))) + (progn + (back-to-indentation) + (ada-get-current-indent)) - ;; first line in the buffer - (list (point-min) 0)))) + ;; first line in the buffer + (list (point-min) 0)))) ;; Evaluate the list to get the column to indent to ;; prev-indent contains the column to indent to @@ -2242,14 +2230,10 @@ and the offset." (if (< (current-column) (current-indentation)) (back-to-indentation))) - ;; restore syntax-table - (set-syntax-table previous-syntax-table) (if (featurep 'xemacs) - (ad-deactivate 'parse-partial-sexp)) - ) + (ad-deactivate 'parse-partial-sexp))) - cur-indent - )) + cur-indent)) (defun ada-get-current-indent () "Return the indentation to use for the current line." @@ -2512,11 +2496,11 @@ and the offset." (if (looking-at "renames") (let (pos) (save-excursion - (set 'pos (ada-search-ignore-string-comment ";\\|return\\>" t))) + (setq pos (ada-search-ignore-string-comment ";\\|return\\>" t))) (if (and pos (= (downcase (char-after (car pos))) ?r)) (goto-char (car pos))) - (set 'var 'ada-indent-renames))) + (setq var 'ada-indent-renames))) (forward-comment -1000) (if (= (char-before) ?\)) @@ -2533,7 +2517,7 @@ and the offset." (looking-at "\\(function\\|procedure\\)\\>")) (progn (backward-word 1) - (set 'num-back 2) + (setq num-back 2) (looking-at "\\(function\\|procedure\\)\\>"))))) ;; The indentation depends of the value of ada-indent-return @@ -4046,8 +4030,7 @@ Point is moved at the beginning of the SEARCH-RE." (let (found begin end - parse-result - (previous-syntax-table (syntax-table))) + parse-result) ;; FIXME: need to pass BACKWARD to search-func! (unless search-func @@ -4057,67 +4040,65 @@ Point is moved at the beginning of the SEARCH-RE." ;; search until found or end-of-buffer ;; We have to test that we do not look further than limit ;; - (set-syntax-table ada-mode-symbol-syntax-table) - (while (and (not found) - (or (not limit) - (or (and backward (<= limit (point))) - (>= limit (point)))) - (funcall search-func search-re limit 1)) - (setq begin (match-beginning 0)) - (setq end (match-end 0)) - - (setq parse-result (parse-partial-sexp - (save-excursion (beginning-of-line) (point)) - (point))) - - (cond - ;; - ;; If inside a string, skip it (and the following comments) - ;; - ((ada-in-string-p parse-result) - (if (featurep 'xemacs) - (search-backward "\"" nil t) - (goto-char (nth 8 parse-result))) - (unless backward (forward-sexp 1))) - ;; - ;; If inside a comment, skip it (and the following comments) - ;; There is a special code for comments at the end of the file - ;; - ((ada-in-comment-p parse-result) - (if (featurep 'xemacs) - (progn - (forward-line 1) - (beginning-of-line) - (forward-comment -1)) - (goto-char (nth 8 parse-result))) - (unless backward - ;; at the end of the file, it is not possible to skip a comment - ;; so we just go at the end of the line - (if (forward-comment 1) - (progn - (forward-comment 1000) - (beginning-of-line)) - (end-of-line)))) - ;; - ;; directly in front of a comment => skip it, if searching forward - ;; - ((and (= (char-after begin) ?-) (= (char-after (1+ begin)) ?-)) - (unless backward (progn (forward-char -1) (forward-comment 1000)))) - - ;; - ;; found a parameter-list but should ignore it => skip it - ;; - ((and (not paramlists) (ada-in-paramlist-p)) - (if backward - (search-backward "(" nil t) - (search-forward ")" nil t))) - ;; - ;; found what we were looking for - ;; - (t - (setq found t)))) ; end of loop - - (set-syntax-table previous-syntax-table) + (with-syntax-table ada-mode-symbol-syntax-table + (while (and (not found) + (or (not limit) + (or (and backward (<= limit (point))) + (>= limit (point)))) + (funcall search-func search-re limit 1)) + (setq begin (match-beginning 0)) + (setq end (match-end 0)) + + (setq parse-result (parse-partial-sexp + (save-excursion (beginning-of-line) (point)) + (point))) + + (cond + ;; + ;; If inside a string, skip it (and the following comments) + ;; + ((ada-in-string-p parse-result) + (if (featurep 'xemacs) + (search-backward "\"" nil t) + (goto-char (nth 8 parse-result))) + (unless backward (forward-sexp 1))) + ;; + ;; If inside a comment, skip it (and the following comments) + ;; There is a special code for comments at the end of the file + ;; + ((ada-in-comment-p parse-result) + (if (featurep 'xemacs) + (progn + (forward-line 1) + (beginning-of-line) + (forward-comment -1)) + (goto-char (nth 8 parse-result))) + (unless backward + ;; at the end of the file, it is not possible to skip a comment + ;; so we just go at the end of the line + (if (forward-comment 1) + (progn + (forward-comment 1000) + (beginning-of-line)) + (end-of-line)))) + ;; + ;; directly in front of a comment => skip it, if searching forward + ;; + ((and (= (char-after begin) ?-) (= (char-after (1+ begin)) ?-)) + (unless backward (progn (forward-char -1) (forward-comment 1000)))) + + ;; + ;; found a parameter-list but should ignore it => skip it + ;; + ((and (not paramlists) (ada-in-paramlist-p)) + (if backward + (search-backward "(" nil t) + (search-forward ")" nil t))) + ;; + ;; found what we were looking for + ;; + (t + (setq found t))))) ; end of loop (if found (cons begin end) @@ -4398,122 +4379,109 @@ of the region. Otherwise, operate only on the current line." (defun ada-move-to-start () "Move point to the matching start of the current Ada structure." (interactive) - (let ((pos (point)) - (previous-syntax-table (syntax-table))) - (unwind-protect - (progn - (set-syntax-table ada-mode-symbol-syntax-table) + (let ((pos (point))) + (with-syntax-table ada-mode-symbol-syntax-table - (save-excursion - ;; - ;; do nothing if in string or comment or not on 'end ...;' - ;; or if an error occurs during processing - ;; - (or - (ada-in-string-or-comment-p) - (and (progn - (or (looking-at "[ \t]*\\<end\\>") - (backward-word 1)) - (or (looking-at "[ \t]*\\<end\\>") - (backward-word 1)) - (or (looking-at "[ \t]*\\<end\\>") - (error "Not on end ...;"))) - (ada-goto-matching-start 1) - (setq pos (point)) - - ;; - ;; on 'begin' => go on, according to user option - ;; - ada-move-to-declaration - (looking-at "\\<begin\\>") - (ada-goto-decl-start) - (setq pos (point)))) - - ) ; end of save-excursion - - ;; now really move to the found position - (goto-char pos)) - - ;; restore syntax-table - (set-syntax-table previous-syntax-table)))) + (save-excursion + ;; + ;; do nothing if in string or comment or not on 'end ...;' + ;; or if an error occurs during processing + ;; + (or + (ada-in-string-or-comment-p) + (and (progn + (or (looking-at "[ \t]*\\<end\\>") + (backward-word 1)) + (or (looking-at "[ \t]*\\<end\\>") + (backward-word 1)) + (or (looking-at "[ \t]*\\<end\\>") + (error "Not on end ...;"))) + (ada-goto-matching-start 1) + (setq pos (point)) + + ;; + ;; on 'begin' => go on, according to user option + ;; + ada-move-to-declaration + (looking-at "\\<begin\\>") + (ada-goto-decl-start) + (setq pos (point)))) + + ) ; end of save-excursion + + ;; now really move to the found position + (goto-char pos)))) (defun ada-move-to-end () "Move point to the end of the block around point. Moves to 'begin' if in a declarative part." (interactive) (let ((pos (point)) - decl-start - (previous-syntax-table (syntax-table))) - (unwind-protect - (progn - (set-syntax-table ada-mode-symbol-syntax-table) - - (save-excursion - - (cond - ;; Go to the beginning of the current word, and check if we are - ;; directly on 'begin' - ((save-excursion - (skip-syntax-backward "w") - (looking-at "\\<begin\\>")) - (ada-goto-matching-end 1) - ) - - ;; on first line of subprogram body - ;; Do nothing for specs or generic instantion, since these are - ;; handled as the general case (find the enclosing block) - ;; We also need to make sure that we ignore nested subprograms - ((save-excursion - (and (skip-syntax-backward "w") - (looking-at "\\<function\\>\\|\\<procedure\\>" ) - (ada-search-ignore-string-comment "is\\|;") - (not (= (char-before) ?\;)) - )) - (skip-syntax-backward "w") - (ada-goto-matching-end 0 t)) - - ;; on first line of task declaration - ((save-excursion - (and (ada-goto-stmt-start) - (looking-at "\\<task\\>" ) - (forward-word 1) - (ada-goto-next-non-ws) - (looking-at "\\<body\\>"))) - (ada-search-ignore-string-comment "begin" nil nil nil - 'word-search-forward)) - ;; accept block start - ((save-excursion - (and (ada-goto-stmt-start) - (looking-at "\\<accept\\>" ))) - (ada-goto-matching-end 0)) - ;; package start - ((save-excursion - (setq decl-start (and (ada-goto-decl-start t) (point))) - (and decl-start (looking-at "\\<package\\>"))) - (ada-goto-matching-end 1)) - - ;; On a "declare" keyword - ((save-excursion - (skip-syntax-backward "w") - (looking-at "\\<declare\\>")) - (ada-goto-matching-end 0 t)) - - ;; inside a 'begin' ... 'end' block - (decl-start - (goto-char decl-start) - (ada-goto-matching-end 0 t)) - - ;; (hopefully ;-) everything else - (t - (ada-goto-matching-end 1))) - (setq pos (point)) - ) + decl-start) + (with-syntax-table ada-mode-symbol-syntax-table - ;; now really move to the position found - (goto-char pos)) + (save-excursion - ;; restore syntax-table - (set-syntax-table previous-syntax-table)))) + (cond + ;; Go to the beginning of the current word, and check if we are + ;; directly on 'begin' + ((save-excursion + (skip-syntax-backward "w") + (looking-at "\\<begin\\>")) + (ada-goto-matching-end 1)) + + ;; on first line of subprogram body + ;; Do nothing for specs or generic instantion, since these are + ;; handled as the general case (find the enclosing block) + ;; We also need to make sure that we ignore nested subprograms + ((save-excursion + (and (skip-syntax-backward "w") + (looking-at "\\<function\\>\\|\\<procedure\\>" ) + (ada-search-ignore-string-comment "is\\|;") + (not (= (char-before) ?\;)) + )) + (skip-syntax-backward "w") + (ada-goto-matching-end 0 t)) + + ;; on first line of task declaration + ((save-excursion + (and (ada-goto-stmt-start) + (looking-at "\\<task\\>" ) + (forward-word 1) + (ada-goto-next-non-ws) + (looking-at "\\<body\\>"))) + (ada-search-ignore-string-comment "begin" nil nil nil + 'word-search-forward)) + ;; accept block start + ((save-excursion + (and (ada-goto-stmt-start) + (looking-at "\\<accept\\>" ))) + (ada-goto-matching-end 0)) + ;; package start + ((save-excursion + (setq decl-start (and (ada-goto-decl-start t) (point))) + (and decl-start (looking-at "\\<package\\>"))) + (ada-goto-matching-end 1)) + + ;; On a "declare" keyword + ((save-excursion + (skip-syntax-backward "w") + (looking-at "\\<declare\\>")) + (ada-goto-matching-end 0 t)) + + ;; inside a 'begin' ... 'end' block + (decl-start + (goto-char decl-start) + (ada-goto-matching-end 0 t)) + + ;; (hopefully ;-) everything else + (t + (ada-goto-matching-end 1))) + (setq pos (point)) + ) + + ;; now really move to the position found + (goto-char pos)))) (defun ada-next-procedure () "Move point to next procedure." @@ -4818,7 +4786,7 @@ Moves to 'begin' if in a declarative part." (if (featurep 'xemacs) (progn (define-key ada-mode-map [menu-bar] ada-mode-menu) - (set 'mode-popup-menu (cons "Ada mode" ada-mode-menu)))))) + (setq mode-popup-menu (cons "Ada mode" ada-mode-menu)))))) ;; ------------------------------------------------------- @@ -5040,7 +5008,7 @@ or the spec otherwise." (ada-find-src-file-in-dir (file-name-nondirectory (concat name (car suffixes)))))) (if other - (set 'is-spec other))) + (setq is-spec other))) ;; Else search in the current directory (if (file-exists-p (concat name (car suffixes))) diff --git a/lisp/progmodes/ada-prj.el b/lisp/progmodes/ada-prj.el index 0ae93c392a7..630f83e58aa 100644 --- a/lisp/progmodes/ada-prj.el +++ b/lisp/progmodes/ada-prj.el @@ -6,6 +6,7 @@ ;; Author: Emmanuel Briot <briot@gnat.com> ;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org> ;; Keywords: languages, ada, project file +;; Package: ada-mode ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/ada-stmt.el b/lisp/progmodes/ada-stmt.el index 103bc093bdb..b618b26c73a 100644 --- a/lisp/progmodes/ada-stmt.el +++ b/lisp/progmodes/ada-stmt.el @@ -9,6 +9,7 @@ ;; Rolf Ebert <ebert@waporo.muc.de> ;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org> ;; Keywords: languages, ada +;; Package: ada-mode ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/ada-xref.el b/lisp/progmodes/ada-xref.el index 9b43a0629bf..73c31f08cd3 100644 --- a/lisp/progmodes/ada-xref.el +++ b/lisp/progmodes/ada-xref.el @@ -8,6 +8,7 @@ ;; Emmanuel Briot <briot@gnat.com> ;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org> ;; Keywords: languages ada xref +;; Package: ada-mode ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/antlr-mode.el b/lisp/progmodes/antlr-mode.el index 4e93c547881..9b24ac7a1f4 100644 --- a/lisp/progmodes/antlr-mode.el +++ b/lisp/progmodes/antlr-mode.el @@ -5,7 +5,7 @@ ;; Author: Christoph.Wedler@sap.com ;; Keywords: languages, ANTLR, code generator -;; Version: (see `antlr-version' below) +;; Version: 2.2c ;; X-URL: http://antlr-mode.sourceforge.net/ ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/autoconf.el b/lisp/progmodes/autoconf.el index a56623f22da..004bb3de78d 100644 --- a/lisp/progmodes/autoconf.el +++ b/lisp/progmodes/autoconf.el @@ -43,9 +43,6 @@ (defvar autoconf-mode-hook nil "Hook run by `autoconf-mode'.") -(defconst autoconf-font-lock-syntactic-keywords - '(("\\<dnl\\>" 0 '(11)))) - (defconst autoconf-definition-regexp "AC_\\(SUBST\\|DEFINE\\(_UNQUOTED\\)?\\)(\\[*\\(\\sw+\\)\\]*") @@ -94,8 +91,8 @@ searching backwards at another AC_... command." "^[ \t]*A[CM]_\\(\\sw\\|\\s_\\)+") (set (make-local-variable 'comment-start) "dnl ") (set (make-local-variable 'comment-start-skip) "\\(?:\\<dnl\\|#\\) +") - (set (make-local-variable 'font-lock-syntactic-keywords) - autoconf-font-lock-syntactic-keywords) + (set (make-local-variable 'syntax-propertize-function) + (syntax-propertize-rules ("\\<dnl\\>" (0 "<")))) (set (make-local-variable 'font-lock-defaults) `(autoconf-font-lock-keywords nil nil (("_" . "w")))) (set (make-local-variable 'imenu-generic-expression) diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el index e52a0d70e48..8224db79ace 100644 --- a/lisp/progmodes/cc-align.el +++ b/lisp/progmodes/cc-align.el @@ -12,8 +12,8 @@ ;; 1985 Richard M. Stallman ;; Maintainer: bug-cc-mode@gnu.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: See cc-mode.el -;; Keywords: c languages oop +;; Keywords: c languages +;; Package: cc-mode ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/cc-awk.el b/lisp/progmodes/cc-awk.el index be7d2a0fd3e..6c7db25612d 100644 --- a/lisp/progmodes/cc-awk.el +++ b/lisp/progmodes/cc-awk.el @@ -6,6 +6,7 @@ ;; Author: Alan Mackenzie <acm@muc.de> (originally based on awk-mode.el) ;; Maintainer: FSF ;; Keywords: AWK, cc-mode, unix, languages +;; Package: cc-mode ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el index cde38d872b0..597267d4e5d 100644 --- a/lisp/progmodes/cc-bytecomp.el +++ b/lisp/progmodes/cc-bytecomp.el @@ -6,8 +6,8 @@ ;; Author: Martin Stjernholm ;; Maintainer: bug-cc-mode@gnu.org ;; Created: 15-Jul-2000 -;; Version: See cc-mode.el -;; Keywords: c languages oop +;; Keywords: c languages +;; Package: cc-mode ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index 02fc3950a34..b17703b0305 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -12,8 +12,8 @@ ;; 1985 Richard M. Stallman ;; Maintainer: bug-cc-mode@gnu.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: See cc-mode.el -;; Keywords: c languages oop +;; Keywords: c languages +;; Package: cc-mode ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/cc-compat.el b/lisp/progmodes/cc-compat.el index 59a336f3c69..adfac2f5f9e 100644 --- a/lisp/progmodes/cc-compat.el +++ b/lisp/progmodes/cc-compat.el @@ -8,8 +8,8 @@ ;; 1994-1999 Barry A. Warsaw ;; Maintainer: bug-cc-mode@gnu.org ;; Created: August 1994, split from cc-mode.el -;; Version: See cc-mode.el -;; Keywords: c languages oop +;; Keywords: c languages +;; Package: cc-mode ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index e5e108106f1..147a0e2dc2a 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -12,8 +12,8 @@ ;; 1985 Richard M. Stallman ;; Maintainer: bug-cc-mode@gnu.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: See cc-mode.el -;; Keywords: c languages oop +;; Keywords: c languages +;; Package: cc-mode ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index d87db0fe8b3..e389007065a 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -1,8 +1,8 @@ ;;; cc-engine.el --- core syntax guessing engine for CC mode ;; Copyright (C) 1985, 1987, 1992, 1993, 1994, 1995, 1996, 1997, 1998, -;; 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, +;; 2010 Free Software Foundation, Inc. ;; Authors: 2001- Alan Mackenzie ;; 1998- Martin Stjernholm @@ -12,8 +12,8 @@ ;; 1985 Richard M. Stallman ;; Maintainer: bug-cc-mode@gnu.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: See cc-mode.el -;; Keywords: c languages oop +;; Keywords: c languages +;; Package: cc-mode ;; This file is part of GNU Emacs. @@ -5023,6 +5023,10 @@ comment at the start of cc-engine.el for more info." (c-unmark-<->-as-paren pos)) t))) +;; Set by c-common-init in cc-mode.el. +(defvar c-new-BEG) +(defvar c-new-END) + (defun c-before-change-check-<>-operators (beg end) ;; Unmark certain pairs of "< .... >" which are currently marked as ;; template/generic delimiters. (This marking is via syntax-table @@ -5366,6 +5370,9 @@ comment at the start of cc-engine.el for more info." (goto-char safe-pos) t))) +;; cc-mode requires cc-fonts. +(declare-function c-fontify-recorded-types-and-refs "cc-fonts" ()) + (defun c-forward-<>-arglist (all-types) ;; The point is assumed to be at a "<". Try to treat it as the open ;; paren of an angle bracket arglist and move forward to the diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 219eb25368c..72703b9a5e4 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -6,8 +6,8 @@ ;; 2002- Martin Stjernholm ;; Maintainer: bug-cc-mode@gnu.org ;; Created: 07-Jan-2002 -;; Version: See cc-mode.el -;; Keywords: c languages oop +;; Keywords: c languages +;; Package: cc-mode ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index ae0ed1b928a..5cd5c0b95ca 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -12,8 +12,8 @@ ;; 1985 Richard M. Stallman ;; Maintainer: bug-cc-mode@gnu.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: See cc-mode.el -;; Keywords: c languages oop +;; Keywords: c languages +;; Package: cc-mode ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/cc-menus.el b/lisp/progmodes/cc-menus.el index ae346afa548..e27335e1f58 100644 --- a/lisp/progmodes/cc-menus.el +++ b/lisp/progmodes/cc-menus.el @@ -11,8 +11,8 @@ ;; 1985 Richard M. Stallman ;; Maintainer: bug-cc-mode@gnu.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: See cc-mode.el -;; Keywords: c languages oop +;; Keywords: c languages +;; Package: cc-mode ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index f9917ce406e..6a76a657829 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1,8 +1,8 @@ ;;; cc-mode.el --- major mode for editing C and similar languages ;; Copyright (C) 1985, 1987, 1992, 1993, 1994, 1995, 1996, 1997, 1998, -;; 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 -;; Free Software Foundation, Inc. +;; 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, +;; 2010 Free Software Foundation, Inc. ;; Authors: 2003- Alan Mackenzie ;; 1998- Martin Stjernholm @@ -12,7 +12,7 @@ ;; 1985 Richard M. Stallman ;; Maintainer: bug-cc-mode@gnu.org ;; Created: a long, long, time ago. adapted from the original c-mode.el -;; Keywords: c languages oop +;; Keywords: c languages ;; This file is part of GNU Emacs. @@ -616,6 +616,15 @@ that requires a literal mode spec at compile time." (font-lock-mode 0) (font-lock-mode 1))) +;; Buffer local variables defining the region to be fontified by a font lock +;; after-change function. They are set in c-after-change to +;; after-change-function's BEG and END, and may be modified by a +;; `c-before-font-lock-function'. +(defvar c-new-BEG 0) +(make-variable-buffer-local 'c-new-BEG) +(defvar c-new-END 0) +(make-variable-buffer-local 'c-new-END) + (defun c-common-init (&optional mode) "Common initialization for all CC Mode modes. In addition to the work done by `c-basic-common-init' and @@ -811,15 +820,6 @@ Note that the style variables are always made local to the buffer." ;;; Change hooks, linking with Font Lock. -;; Buffer local variables defining the region to be fontified by a font lock -;; after-change function. They are set in c-after-change to -;; after-change-function's BEG and END, and may be modified by a -;; `c-before-font-lock-function'. -(defvar c-new-BEG 0) -(make-variable-buffer-local 'c-new-BEG) -(defvar c-new-END 0) -(make-variable-buffer-local 'c-new-END) - ;; Buffer local variables recording Beginning/End-of-Macro position before a ;; change, when a macro straddles, respectively, the BEG or END (or both) of ;; the change region. Otherwise these have the values BEG/END. diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index ec9ffe34624..48120563b29 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el @@ -12,8 +12,8 @@ ;; 1985 Richard M. Stallman ;; Maintainer: bug-cc-mode@gnu.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: See cc-mode.el -;; Keywords: c languages oop +;; Keywords: c languages +;; Package: cc-mode ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/cc-vars.el b/lisp/progmodes/cc-vars.el index f61c2a9fd06..e965cc21928 100644 --- a/lisp/progmodes/cc-vars.el +++ b/lisp/progmodes/cc-vars.el @@ -12,8 +12,8 @@ ;; 1985 Richard M. Stallman ;; Maintainer: bug-cc-mode@gnu.org ;; Created: 22-Apr-1997 (split from cc-mode.el) -;; Version: See cc-mode.el -;; Keywords: c languages oop +;; Keywords: c languages +;; Package: cc-mode ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/cfengine.el b/lisp/progmodes/cfengine.el index 86a6be40cc5..e074e92fbe5 100644 --- a/lisp/progmodes/cfengine.el +++ b/lisp/progmodes/cfengine.el @@ -83,12 +83,6 @@ This includes those for cfservd as well as cfagent.")) ;; File, acl &c in group: { token ... } ("{[ \t]*\\([^ \t\n]+\\)" 1 font-lock-constant-face))) -(defconst cfengine-font-lock-syntactic-keywords - ;; In the main syntax-table, backslash is marked as a punctuation, because - ;; of its use in DOS-style directory separators. Here we try to recognize - ;; the cases where backslash is used as an escape inside strings. - '(("\\(\\(?:\\\\\\)+\\)\"" 1 "\\"))) - (defvar cfengine-imenu-expression `((nil ,(concat "^[ \t]*" (eval-when-compile (regexp-opt cfengine-actions t)) @@ -237,13 +231,15 @@ to the action header." (set (make-local-variable 'fill-paragraph-function) #'cfengine-fill-paragraph) (define-abbrev-table 'cfengine-mode-abbrev-table cfengine-mode-abbrevs) - ;; Fixme: Use `font-lock-syntactic-keywords' to set the args of - ;; functions in evaluated classes to string syntax, and then obey - ;; syntax properties. (setq font-lock-defaults - '(cfengine-font-lock-keywords nil nil nil beginning-of-line - (font-lock-syntactic-keywords - . cfengine-font-lock-syntactic-keywords))) + '(cfengine-font-lock-keywords nil nil nil beginning-of-line)) + ;; Fixme: set the args of functions in evaluated classes to string + ;; syntax, and then obey syntax properties. + (set (make-local-variable 'syntax-propertize-function) + ;; In the main syntax-table, \ is marked as a punctuation, because + ;; of its use in DOS-style directory separators. Here we try to + ;; recognize the cases where \ is used as an escape inside strings. + (syntax-propertize-rules ("\\(\\(?:\\\\\\)+\\)\"" (1 "\\")))) (setq imenu-generic-expression cfengine-imenu-expression) (set (make-local-variable 'beginning-of-defun-function) #'cfengine-beginning-of-defun) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index c92d6a9f052..7f0732ecffc 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -164,7 +164,7 @@ and a string describing how the process finished.") (defvar compilation-num-errors-found) -(defconst compilation-error-regexp-alist-alist +(defvar compilation-error-regexp-alist-alist '((absoft "^\\(?:[Ee]rror on \\|[Ww]arning on\\( \\)\\)?[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) @@ -237,6 +237,10 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) nil 1 nil 2 0 (2 (compilation-face '(3)))) + (gcc-include + "^\\(?:In file included \\| \\|\t\\)from \ +\\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\|$\\)\\)?" 1 2 nil (3 . 4)) + (gnu ;; The first line matches the program name for @@ -259,9 +263,11 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) ;; The core of the regexp is the one with *?. It says that a file name ;; can be composed of any non-newline char, but it also rules out some ;; valid but unlikely cases, such as a trailing space or a space - ;; followed by a -. - "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\)?\ -\\([0-9]*[^0-9\n]\\(?:[^\n ]\\| [^-/\n]\\)*?\\): ?\ + ;; followed by a -, or a colon followed by a space. + + ;; The "in \\|from " exception was added to handle messages from Ruby. + "^\\(?:[[:alpha:]][-[:alnum:].]+: ?\\|[ \t]+\\(?:in \\|from \\)\\)?\ +\\([0-9]*[^0-9\n]\\(?:[^\n :]\\| [^-/\n]\\|:[^ \n]\\)*?\\): ?\ \\([0-9]+\\)\\(?:\\([.:]\\)\\([0-9]+\\)\\)?\ \\(?:-\\([0-9]+\\)?\\(?:\\.\\([0-9]+\\)\\)?\\)?:\ \\(?: *\\(\\(?:Future\\|Runtime\\)?[Ww]arning\\|W:\\)\\|\ @@ -269,12 +275,6 @@ of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2 nil (1)) \[0-9]?\\(?:[^0-9\n]\\|$\\)\\|[0-9][0-9][0-9]\\)" 1 (2 . 5) (4 . 6) (7 . 8)) - ;; The `gnu' style above can incorrectly match gcc's "In file - ;; included from" message, so we process that first. -- cyd - (gcc-include - "^\\(?:In file included\\| \\) from \ -\\(.+\\):\\([0-9]+\\)\\(?:\\(:\\)\\|\\(,\\)\\)?" 1 2 nil (3 . 4)) - (lcc "^\\(?:E\\|\\(W\\)\\), \\([^(\n]+\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)" 2 3 4 (1)) @@ -329,10 +329,6 @@ during global destruction\\.$\\)" 1 2) "\\(?:Parse\\|Fatal\\) error: \\(.*\\) in \\(.*\\) on line \\([0-9]+\\)" 2 3 nil nil) - (ruby - "^[\t ]*\\(?:from \\)?\ -\\([^\(\n][^[:space:]\n]*\\):\\([1-9][0-9]*\\)\\(:in `.*'\\)?.*$" 1 2) - (ruby-Test::Unit "[\t ]*\\[\\([^\(].*\\):\\([1-9][0-9]*\\)\\(\\]\\)?:$" 1 2) @@ -772,12 +768,27 @@ The value can be either 2 -- skip anything less than error, 1 -- skip anything less than warning or 0 -- don't skip any messages. Note that all messages not positively identified as warning or info, are considered errors." - :type '(choice (const :tag "Warnings and info" 2) - (const :tag "Info" 1) - (const :tag "None" 0)) + :type '(choice (const :tag "Skip warnings and info" 2) + (const :tag "Skip info" 1) + (const :tag "No skip" 0)) :group 'compilation :version "22.1") +(defun compilation-set-skip-threshold (level) + "Switch the `compilation-skip-threshold' level." + (interactive + (list + (mod (if current-prefix-arg + (prefix-numeric-value current-prefix-arg) + (1+ compilation-skip-threshold)) + 3))) + (setq compilation-skip-threshold level) + (message "Skipping %s" + (case compilation-skip-threshold + (0 "Nothing") + (1 "Info messages") + (2 "Warnings and info")))) + (defcustom compilation-skip-visited nil "Compilation motion commands skip visited messages if this is t. Visited messages are ones for which the file, line and column have been jumped @@ -1218,7 +1229,7 @@ Returns the compilation buffer created." (let* ((name-of-mode (if (eq mode t) "compilation" - (replace-regexp-in-string "-mode$" "" (symbol-name mode)))) + (replace-regexp-in-string "-mode\\'" "" (symbol-name mode)))) (thisdir default-directory) outwin outbuf) (with-current-buffer @@ -2383,7 +2394,7 @@ The file-structure looks like this: (defun compilation-forget-errors () ;; In case we hit the same file/line specs, we want to recompute a new ;; marker for them, so flush our cache. - (setq compilation-locs (make-hash-table :test 'equal :weakness 'value)) + (clrhash compilation-locs) (setq compilation-gcpro nil) ;; FIXME: the old code reset the directory-stack, so maybe we should ;; put a `directory change' marker of some sort, but where? -stef diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index d69cce76faa..d89e41b38fb 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -1840,7 +1840,13 @@ or as help on variables `cperl-tips', `cperl-problems', (make-local-variable 'cperl-syntax-state) (setq cperl-syntax-state nil) ; reset syntaxification cache (if cperl-use-syntax-table-text-property - (progn + (if (boundp 'syntax-propertize-function) + (progn + ;; Reset syntaxification cache. + (set (make-local-variable 'cperl-syntax-done-to) nil) + (set (make-local-variable 'syntax-propertize-function) + (lambda (start end) + (goto-char start) (cperl-fontify-syntaxically end)))) (make-local-variable 'parse-sexp-lookup-properties) ;; Do not introduce variable if not needed, we check it! (set 'parse-sexp-lookup-properties t) diff --git a/lisp/progmodes/cwarn.el b/lisp/progmodes/cwarn.el index e4b380995d5..00c11086ce1 100644 --- a/lisp/progmodes/cwarn.el +++ b/lisp/progmodes/cwarn.el @@ -6,7 +6,7 @@ ;; Author: Anders Lindgren <andersl@andersl.com> ;; Keywords: c, languages, faces ;; X-Url: http://www.andersl.com/emacs -;; Version: 1.3.1 1999-12-13 +;; Version: 1.3.1 ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/ebnf-abn.el b/lisp/progmodes/ebnf-abn.el index 17173bd0458..a8741a30cf2 100644 --- a/lisp/progmodes/ebnf-abn.el +++ b/lisp/progmodes/ebnf-abn.el @@ -7,6 +7,7 @@ ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Keywords: wp, ebnf, PostScript ;; Version: 1.2 +;; Package: ebnf2ps ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/ebnf-bnf.el b/lisp/progmodes/ebnf-bnf.el index 3c71f29b236..45f2fe727e8 100644 --- a/lisp/progmodes/ebnf-bnf.el +++ b/lisp/progmodes/ebnf-bnf.el @@ -7,6 +7,7 @@ ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Keywords: wp, ebnf, PostScript ;; Version: 1.10 +;; Package: ebnf2ps ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/ebnf-dtd.el b/lisp/progmodes/ebnf-dtd.el index 2bd527a0222..2ca38406d4f 100644 --- a/lisp/progmodes/ebnf-dtd.el +++ b/lisp/progmodes/ebnf-dtd.el @@ -7,6 +7,7 @@ ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Keywords: wp, ebnf, PostScript ;; Version: 1.1 +;; Package: ebnf2ps ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/ebnf-ebx.el b/lisp/progmodes/ebnf-ebx.el index 901c80a7225..dd94f9e638a 100644 --- a/lisp/progmodes/ebnf-ebx.el +++ b/lisp/progmodes/ebnf-ebx.el @@ -7,6 +7,7 @@ ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Keywords: wp, ebnf, PostScript ;; Version: 1.2 +;; Package: ebnf2ps ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/ebnf-iso.el b/lisp/progmodes/ebnf-iso.el index ad5683cb7f5..fa1592bb17f 100644 --- a/lisp/progmodes/ebnf-iso.el +++ b/lisp/progmodes/ebnf-iso.el @@ -7,6 +7,7 @@ ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Keywords: wp, ebnf, PostScript ;; Version: 1.9 +;; Package: ebnf2ps ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/ebnf-otz.el b/lisp/progmodes/ebnf-otz.el index a9c4838d9e1..b005d95a806 100644 --- a/lisp/progmodes/ebnf-otz.el +++ b/lisp/progmodes/ebnf-otz.el @@ -7,6 +7,7 @@ ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Keywords: wp, ebnf, PostScript ;; Version: 1.0 +;; Package: ebnf2ps ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/ebnf-yac.el b/lisp/progmodes/ebnf-yac.el index e2a35dbc943..a7f1851cffb 100644 --- a/lisp/progmodes/ebnf-yac.el +++ b/lisp/progmodes/ebnf-yac.el @@ -7,6 +7,7 @@ ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Keywords: wp, ebnf, PostScript ;; Version: 1.4 +;; Package: ebnf2ps ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 4f0fcd77ab5..2018a71574e 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -40,6 +40,7 @@ If you set this variable, do not also set `tags-table-list'. Use the `etags' program to make a tags table file.") ;; Make M-x set-variable tags-file-name like M-x visit-tags-table. ;;;###autoload (put 'tags-file-name 'variable-interactive (purecopy "fVisit tags table: ")) +;;;###autoload (put 'tags-file-name 'safe-local-variable 'stringp) (defgroup etags nil "Tags tables." :group 'tools) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 2a198215536..712af6fd288 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1152,7 +1152,8 @@ For the format of LINE-ERR-INFO, see `flymake-ler-make-ler'." (when dir (let ((default-directory dir)) (flymake-log 3 "starting process on dir %s" default-directory))) - (setq process (apply 'start-process "flymake-proc" (current-buffer) cmd args)) + (setq process (apply 'start-file-process + "flymake-proc" (current-buffer) cmd args)) (set-process-sentinel process 'flymake-process-sentinel) (set-process-filter process 'flymake-process-filter) (push process flymake-processes) diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el index c37744bfe45..daa0fd07364 100644 --- a/lisp/progmodes/fortran.el +++ b/lisp/progmodes/fortran.el @@ -483,6 +483,7 @@ The only difference is, it returns t in a case when the default returns nil." "Maximum highlighting for Fortran mode. Consists of level 3 plus all other intrinsics not already highlighted.") +(defvar fortran--font-lock-syntactic-keywords) ;; Comments are real pain in Fortran because there is no way to ;; represent the standard comment syntax in an Emacs syntax table. ;; (We can do so for F90-style). Therefore an unmatched quote in a @@ -887,9 +888,11 @@ with no args, if that value is non-nil." fortran-font-lock-keywords-3 fortran-font-lock-keywords-4) nil t ((?/ . "$/") ("_$" . "w")) - fortran-beginning-of-subprogram - (font-lock-syntactic-keywords - . fortran-font-lock-syntactic-keywords))) + fortran-beginning-of-subprogram)) + (set (make-local-variable 'fortran--font-lock-syntactic-keywords) + (fortran-make-syntax-propertize-function)) + (set (make-local-variable 'syntax-propertize-function) + (syntax-propertize-via-font-lock fortran--font-lock-syntactic-keywords)) (set (make-local-variable 'imenu-case-fold-search) t) (set (make-local-variable 'imenu-generic-expression) fortran-imenu-generic-expression) @@ -917,11 +920,13 @@ affects all Fortran buffers, and also the default." (when (eq major-mode 'fortran-mode) (setq fortran-line-length nchars fill-column fortran-line-length - new (fortran-font-lock-syntactic-keywords)) + new (fortran-make-syntax-propertize-function)) ;; Refontify only if necessary. - (unless (equal new font-lock-syntactic-keywords) - (setq font-lock-syntactic-keywords - (fortran-font-lock-syntactic-keywords)) + (unless (equal new fortran--font-lock-syntactic-keywords) + (setq fortran--font-lock-syntactic-keywords new) + (setq syntax-propertize-function + (syntax-propertize-via-font-lock new)) + (syntax-ppss-flush-cache (point-min)) (if font-lock-mode (font-lock-mode 1)))))) (if global (buffer-list) diff --git a/lisp/progmodes/gud.el b/lisp/progmodes/gud.el index d20a14682c7..4c1471e39ec 100644 --- a/lisp/progmodes/gud.el +++ b/lisp/progmodes/gud.el @@ -3123,10 +3123,12 @@ class of the file (using s to separate nested class ids)." ("\\$\\(\\w+\\)" (1 font-lock-variable-name-face)) ("^\\s-*\\(\\w\\(\\w\\|\\s_\\)*\\)" (1 font-lock-keyword-face)))) -(defvar gdb-script-font-lock-syntactic-keywords - '(("^document\\s-.*\\(\n\\)" (1 "< b")) - ("^end\\>" - (0 (unless (eq (match-beginning 0) (point-min)) +(defconst gdb-script-syntax-propertize-function + (syntax-propertize-rules + ("^document\\s-.*\\(\n\\)" (1 "< b")) + ("^end\\(\\>\\)" + (1 (ignore + (unless (eq (match-beginning 0) (point-min)) ;; We change the \n in front, which is more difficult, but results ;; in better highlighting. If the doc is empty, the single \n is ;; both the beginning and the end of the docstring, which can't be @@ -3138,10 +3140,9 @@ class of the file (using s to separate nested class ids)." 'syntax-table (eval-when-compile (string-to-syntax "> b"))) ;; Make sure that rehighlighting the previous line won't erase our - ;; syntax-table property. + ;; syntax-table property and that modifying `end' will. (put-text-property (1- (match-beginning 0)) (match-end 0) - 'font-lock-multiline t) - nil))))) + 'syntax-multiline t))))))) (defun gdb-script-font-lock-syntactic-face (state) (cond @@ -3239,10 +3240,13 @@ Treats actions as defuns." #'gdb-script-end-of-defun) (set (make-local-variable 'font-lock-defaults) '(gdb-script-font-lock-keywords nil nil ((?_ . "w")) nil - (font-lock-syntactic-keywords - . gdb-script-font-lock-syntactic-keywords) (font-lock-syntactic-face-function - . gdb-script-font-lock-syntactic-face)))) + . gdb-script-font-lock-syntactic-face))) + ;; Recognize docstrings. + (set (make-local-variable 'syntax-propertize-function) + gdb-script-syntax-propertize-function) + (add-hook 'syntax-propertize-extend-region-functions + #'syntax-propertize-multiline 'append 'local)) ;;; tooltips for GUD diff --git a/lisp/progmodes/idlw-complete-structtag.el b/lisp/progmodes/idlw-complete-structtag.el index 696853e0929..95acc427736 100644 --- a/lisp/progmodes/idlw-complete-structtag.el +++ b/lisp/progmodes/idlw-complete-structtag.el @@ -7,6 +7,7 @@ ;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu> ;; Version: 1.2 ;; Keywords: languages +;; Package: idlwave ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/idlw-help.el b/lisp/progmodes/idlw-help.el index f6eff9c3cff..850d68e918f 100644 --- a/lisp/progmodes/idlw-help.el +++ b/lisp/progmodes/idlw-help.el @@ -6,7 +6,8 @@ ;; Authors: J.D. Smith <jdsmith@as.arizona.edu> ;; Carsten Dominik <dominik@science.uva.nl> ;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu> -;; Version: 6.1_em22 +;; Version: 6.1.22 +;; Package: idlwave ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index dbe6f179e5b..3acd396e9cd 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -7,8 +7,9 @@ ;; Carsten Dominik <dominik@astro.uva.nl> ;; Chris Chase <chase@att.com> ;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu> -;; Version: 6.1_em22 +;; Version: 6.1.22 ;; Keywords: processes +;; Package: idlwave ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/idlw-toolbar.el b/lisp/progmodes/idlw-toolbar.el index 395cfd54045..474065451d7 100644 --- a/lisp/progmodes/idlw-toolbar.el +++ b/lisp/progmodes/idlw-toolbar.el @@ -5,8 +5,9 @@ ;; Author: Carsten Dominik <dominik@astro.uva.nl> ;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu> -;; Version: 6.1_em22 +;; Version: 6.1.22 ;; Keywords: processes +;; Package: idlwave ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/idlwave.el b/lisp/progmodes/idlwave.el index 1d042c99451..dc85d094810 100644 --- a/lisp/progmodes/idlwave.el +++ b/lisp/progmodes/idlwave.el @@ -7,7 +7,7 @@ ;; Carsten Dominik <dominik@science.uva.nl> ;; Chris Chase <chase@att.com> ;; Maintainer: J.D. Smith <jdsmith@as.arizona.edu> -;; Version: 6.1_em22 +;; Version: 6.1.22 ;; Keywords: languages ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index d6feca4d8a0..ba70bb8ecce 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -7,7 +7,7 @@ ;; Maintainer: Daniel Colascione <dan.colascione@gmail.com> ;; Version: 9 ;; Date: 2009-07-25 -;; Keywords: languages, oop, javascript +;; Keywords: languages, javascript ;; This file is part of GNU Emacs. @@ -45,16 +45,16 @@ ;;; Code: -(eval-and-compile - (require 'cc-mode) - (require 'font-lock) - (require 'newcomment) - (require 'imenu) - (require 'etags) - (require 'thingatpt) - (require 'easymenu) - (require 'moz nil t) - (require 'json nil t)) + +(require 'cc-mode) +(require 'font-lock) +(require 'newcomment) +(require 'imenu) +(require 'etags) +(require 'thingatpt) +(require 'easymenu) +(require 'moz nil t) +(require 'json nil t) (eval-when-compile (require 'cl) @@ -431,11 +431,32 @@ Match group 1 is the name of the macro.") :group 'js) (defcustom js-expr-indent-offset 0 - "Number of additional spaces used for indentation of continued expressions. + "Number of additional spaces for indenting continued expressions. The value must be no less than minus `js-indent-level'." :type 'integer :group 'js) +(defcustom js-paren-indent-offset 0 + "Number of additional spaces for indenting expressions in parentheses. +The value must be no less than minus `js-indent-level'." + :type 'integer + :group 'js + :version "24.1") + +(defcustom js-square-indent-offset 0 + "Number of additional spaces for indenting expressions in square braces. +The value must be no less than minus `js-indent-level'." + :type 'integer + :group 'js + :version "24.1") + +(defcustom js-curly-indent-offset 0 + "Number of additional spaces for indenting expressions in curly braces. +The value must be no less than minus `js-indent-level'." + :type 'integer + :group 'js + :version "24.1") + (defcustom js-auto-indent-flag t "Whether to automatically indent when typing punctuation characters. If non-nil, the characters {}();,: also indent the current line @@ -704,20 +725,19 @@ as if strings, cpp macros, and comments have been removed. If invoked while inside a macro, it treats the contents of the macro as normal text." + (unless count (setq count 1)) (let ((saved-point (point)) - (search-expr - (cond ((null count) - '(js--re-search-forward-inner regexp bound 1)) - ((< count 0) - '(js--re-search-backward-inner regexp bound (- count))) - ((> count 0) - '(js--re-search-forward-inner regexp bound count))))) + (search-fun + (cond ((< count 0) (setq count (- count)) + #'js--re-search-backward-inner) + ((> count 0) #'js--re-search-forward-inner) + (t #'ignore)))) (condition-case err - (eval search-expr) + (funcall search-fun regexp bound count) (search-failed (goto-char saved-point) (unless noerror - (error (error-message-string err))))))) + (signal (car err) (cdr err))))))) (defun js--re-search-backward-inner (regexp &optional bound count) @@ -761,20 +781,7 @@ as if strings, preprocessor macros, and comments have been removed. If invoked while inside a macro, treat the macro as normal text." - (let ((saved-point (point)) - (search-expr - (cond ((null count) - '(js--re-search-backward-inner regexp bound 1)) - ((< count 0) - '(js--re-search-forward-inner regexp bound (- count))) - ((> count 0) - '(js--re-search-backward-inner regexp bound count))))) - (condition-case err - (eval search-expr) - (search-failed - (goto-char saved-point) - (unless noerror - (error (error-message-string err))))))) + (js--re-search-forward regexp bound noerror (if count (- count) -1))) (defun js--forward-expression () "Move forward over a whole JavaScript expression. @@ -1653,18 +1660,19 @@ This performs fontification according to `js--class-styles'." ;; XXX: Javascript can continue a regexp literal across lines so long ;; as the newline is escaped with \. Account for that in the regexp ;; below. -(defconst js--regexp-literal +(eval-and-compile + (defconst js--regexp-literal "[=(,:]\\(?:\\s-\\|\n\\)*\\(/\\)\\(?:\\\\/\\|[^/*]\\)\\(?:\\\\/\\|[^/]\\)*\\(/\\)" "Regexp matching a JavaScript regular expression literal. Match groups 1 and 2 are the characters forming the beginning and -end of the literal.") +end of the literal.")) -;; we want to match regular expressions only at the beginning of -;; expressions -(defconst js-font-lock-syntactic-keywords - `((,js--regexp-literal (1 "|") (2 "|"))) - "Syntactic font lock keywords matching regexps in JavaScript. -See `font-lock-keywords'.") + +(defconst js-syntax-propertize-function + (syntax-propertize-rules + ;; We want to match regular expressions only at the beginning of + ;; expressions. + (js--regexp-literal (1 "\"") (2 "\"")))) ;;; Indentation @@ -1769,14 +1777,17 @@ nil." ((eq (char-after) ?#) 0) ((save-excursion (js--beginning-of-macro)) 4) ((nth 1 parse-status) + ;; A single closing paren/bracket should be indented at the + ;; same level as the opening statement. Same goes for + ;; "case" and "default". (let ((same-indent-p (looking-at "[]})]\\|\\_<case\\_>\\|\\_<default\\_>")) (continued-expr-p (js--continued-expression-p))) - (goto-char (nth 1 parse-status)) + (goto-char (nth 1 parse-status)) ; go to the opening char (if (looking-at "[({[]\\s-*\\(/[/*]\\|$\\)") - (progn + (progn ; nothing following the opening paren/bracket (skip-syntax-backward " ") - (when (eq (char-before) ?\)) (backward-list)) + (when (eq (char-before) ?\)) (backward-list)) (back-to-indentation) (cond (same-indent-p (current-column)) @@ -1784,7 +1795,14 @@ nil." (+ (current-column) (* 2 js-indent-level) js-expr-indent-offset)) (t - (+ (current-column) js-indent-level)))) + (+ (current-column) js-indent-level + (case (char-after (nth 1 parse-status)) + (?\( js-paren-indent-offset) + (?\[ js-square-indent-offset) + (?\{ js-curly-indent-offset)))))) + ;; If there is something following the opening + ;; paren/bracket, everything else should be indented at + ;; the same level. (unless same-indent-p (forward-char) (skip-chars-forward " \t")) @@ -3286,10 +3304,9 @@ Key bindings: (set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil) (set (make-local-variable 'font-lock-defaults) - (list js--font-lock-keywords - nil nil nil nil - '(font-lock-syntactic-keywords - . js-font-lock-syntactic-keywords))) + '(js--font-lock-keywords)) + (set (make-local-variable 'syntax-propertize-function) + js-syntax-propertize-function) (set (make-local-variable 'parse-sexp-ignore-comments) t) (set (make-local-variable 'parse-sexp-lookup-properties) t) diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 15664c8e56d..187c838382b 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -505,15 +505,16 @@ not be enclosed in { } or ( )." cpp-font-lock-keywords)) -(defconst makefile-font-lock-syntactic-keywords - ;; From sh-script.el. - ;; A `#' begins a comment in sh when it is unquoted and at the beginning - ;; of a word. In the shell, words are separated by metacharacters. - ;; The list of special chars is taken from the single-unix spec of the - ;; shell command language (under `quoting') but with `$' removed. - '(("[^|&;<>()`\\\"' \t\n]\\(#+\\)" 1 "_") - ;; Change the syntax of a quoted newline so that it does not end a comment. - ("\\\\\n" 0 "."))) +(defconst makefile-syntax-propertize-function + (syntax-propertize-rules + ;; From sh-script.el. + ;; A `#' begins a comment in sh when it is unquoted and at the beginning + ;; of a word. In the shell, words are separated by metacharacters. + ;; The list of special chars is taken from the single-unix spec of the + ;; shell command language (under `quoting') but with `$' removed. + ("[^|&;<>()`\\\"' \t\n]\\(#+\\)" (1 "_")) + ;; Change the syntax of a quoted newline so that it does not end a comment. + ("\\\\\n" (0 ".")))) (defvar makefile-imenu-generic-expression `(("Dependencies" makefile-previous-dependency 1) @@ -872,9 +873,9 @@ Makefile mode can be configured by modifying the following variables: '(makefile-font-lock-keywords nil nil ((?$ . ".")) - backward-paragraph - (font-lock-syntactic-keywords - . makefile-font-lock-syntactic-keywords))) + backward-paragraph)) + (set (make-local-variable 'syntax-propertize-function) + makefile-syntax-propertize-function) ;; Add-log. (set (make-local-variable 'add-log-current-defun-function) @@ -943,15 +944,9 @@ Makefile mode can be configured by modifying the following variables: (define-derived-mode makefile-imake-mode makefile-mode "Imakefile" "An adapted `makefile-mode' that knows about imake." :syntax-table makefile-imake-mode-syntax-table - (let ((base `(makefile-imake-font-lock-keywords ,@(cdr font-lock-defaults))) - new) - ;; Remove `font-lock-syntactic-keywords' entry from font-lock-defaults. - (mapc (lambda (elt) - (unless (and (consp elt) - (eq (car elt) 'font-lock-syntactic-keywords)) - (setq new (cons elt new)))) - base) - (setq font-lock-defaults (nreverse new)))) + (set (make-local-variable 'syntax-propertize-function) nil) + (setq font-lock-defaults + `(makefile-imake-font-lock-keywords ,@(cdr font-lock-defaults)))) @@ -1300,7 +1295,9 @@ definition and conveniently use this command." (save-restriction (narrow-to-region beginning end) (makefile-backslash-region (point-min) (point-max) t) - (let ((fill-paragraph-function nil)) + (let ((fill-paragraph-function nil) + ;; Adjust fill-column to allow space for the backslash. + (fill-column (- fill-column 1))) (fill-paragraph nil)) (makefile-backslash-region (point-min) (point-max) nil) (goto-char (point-max)) @@ -1314,7 +1311,9 @@ definition and conveniently use this command." ;; resulting region. (save-restriction (narrow-to-region (point) (line-beginning-position 2)) - (let ((fill-paragraph-function nil)) + (let ((fill-paragraph-function nil) + ;; Adjust fill-column to allow space for the backslash. + (fill-column (- fill-column 1))) (fill-paragraph nil)) (makefile-backslash-region (point-min) (point-max) nil)) ;; Return non-nil to indicate it's been filled. diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el index ecb8461a9f2..94af563d88f 100644 --- a/lisp/progmodes/mixal-mode.el +++ b/lisp/progmodes/mixal-mode.el @@ -89,7 +89,7 @@ (defvar mixal-mode-syntax-table (let ((st (make-syntax-table))) ;; We need to do a bit more to make fontlocking for comments work. - ;; See mixal-font-lock-syntactic-keywords. + ;; See use of syntax-propertize-function. ;; (modify-syntax-entry ?* "<" st) (modify-syntax-entry ?\n ">" st) st) @@ -1028,13 +1028,14 @@ EXECUTION-TIME holds info about the time it takes, number or string.") ;;; Font-locking: -(defvar mixal-font-lock-syntactic-keywords - ;; Normal comments start with a * in column 0 and end at end of line. - '(("^\\*" (0 '(11))) ;(string-to-syntax "<") == '(11) - ;; Every line can end with a comment which is placed after the operand. - ;; I assume here that mnemonics without operands can not have a comment. - ("^[[:alnum:]]*[ \t]+[[:alnum:]]+[ \t]+[^ \n\t]+[ \t]*\\([ \t]\\)[^\n \t]" - (1 '(11))))) +(defconst mixal-syntax-propertize-function + (syntax-propertize-rules + ;; Normal comments start with a * in column 0 and end at end of line. + ("^\\*" (0 "<")) + ;; Every line can end with a comment which is placed after the operand. + ;; I assume here that mnemonics without operands can not have a comment. + ("^[[:alnum:]]*[ \t]+[[:alnum:]]+[ \t]+[^ \n\t]+[ \t]*\\([ \t]\\)[^\n \t]" + (1 "<")))) (defvar mixal-font-lock-keywords `(("^\\([A-Z0-9a-z]+\\)" @@ -1110,9 +1111,9 @@ Assumes that file has been compiled with debugging support." (set (make-local-variable 'comment-start) "*") (set (make-local-variable 'comment-start-skip) "^\\*[ \t]*") (set (make-local-variable 'font-lock-defaults) - `(mixal-font-lock-keywords nil nil nil nil - (font-lock-syntactic-keywords . ,mixal-font-lock-syntactic-keywords) - (parse-sexp-lookup-properties . t))) + `(mixal-font-lock-keywords)) + (set (make-local-variable 'syntax-propertize-function) + mixal-syntax-propertize-function) ;; might add an indent function in the future ;; (set (make-local-variable 'indent-line-function) 'mixal-indent-line) (set (make-local-variable 'compile-command) (concat "mixasm " diff --git a/lisp/progmodes/octave-inf.el b/lisp/progmodes/octave-inf.el index 8e64d5689d1..c526a634d86 100644 --- a/lisp/progmodes/octave-inf.el +++ b/lisp/progmodes/octave-inf.el @@ -7,6 +7,7 @@ ;; Author: John Eaton <jwe@bevo.che.wisc.edu> ;; Maintainer: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> ;; Keywords: languages +;; Package: octave-mod ;; This file is part of GNU Emacs. diff --git a/lisp/progmodes/octave-mod.el b/lisp/progmodes/octave-mod.el index 12f561c6814..bbefdaa2ccf 100644 --- a/lisp/progmodes/octave-mod.el +++ b/lisp/progmodes/octave-mod.el @@ -4,7 +4,7 @@ ;; Free Software Foundation, Inc. ;; Author: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> -;; Author: John Eaton <jwe@bevo.che.wisc.edu> +;; Author: John Eaton <jwe@octave.org> ;; Maintainer: Kurt Hornik <Kurt.Hornik@wu-wien.ac.at> ;; Keywords: languages @@ -92,7 +92,7 @@ All Octave abbrevs start with a grave accent (`)." (defvar octave-comment-char ?# "Character to start an Octave comment.") (defvar octave-comment-start - (string octave-comment-char ?\ ) + (string octave-comment-char ?\s) "String to insert to start a new Octave in-line comment.") (defvar octave-comment-start-skip "\\s<+\\s-*" "Regexp to match the start of an Octave comment up to its body.") @@ -161,8 +161,8 @@ parenthetical grouping.") (list ;; Fontify all builtin keywords. (cons (concat "\\<\\(" - (mapconcat 'identity octave-reserved-words "\\|") - (mapconcat 'identity octave-text-functions "\\|") + (regexp-opt (append octave-reserved-words + octave-text-functions)) "\\)\\>") 'font-lock-keyword-face) ;; Fontify all builtin operators. @@ -171,9 +171,7 @@ parenthetical grouping.") 'font-lock-builtin-face 'font-lock-preprocessor-face)) ;; Fontify all builtin variables. - (cons (concat "\\<\\(" - (mapconcat 'identity octave-variables "\\|") - "\\)\\>") + (cons (concat "\\<" (regexp-opt octave-variables) "\\>") 'font-lock-variable-name-face) ;; Fontify all function declarations. (list octave-function-header-regexp @@ -181,6 +179,29 @@ parenthetical grouping.") '(3 font-lock-function-name-face nil t))) "Additional Octave expressions to highlight.") +(defun octave-syntax-propertize-function (start end) + (goto-char start) + (octave-syntax-propertize-sqs end) + (funcall (syntax-propertize-rules + ;; Try to distinguish the string-quotes from the transpose-quotes. + ("[[({,; ]\\('\\)" + (1 (prog1 "\"'" (octave-syntax-propertize-sqs end))))) + (point) end)) + +(defun octave-syntax-propertize-sqs (end) + "Propertize the content/end of single-quote strings." + (when (eq (nth 3 (syntax-ppss)) ?\') + ;; A '..' string. + (when (re-search-forward + "\\(?:\\=\\|[^']\\)\\(?:''\\)*\\('\\)\\($\\|[^']\\)" end 'move) + (goto-char (match-beginning 2)) + (when (eq (char-before (match-beginning 1)) ?\\) + ;; Backslash cannot escape a single quote. + (put-text-property (1- (match-beginning 1)) (match-beginning 1) + 'syntax-table (string-to-syntax "."))) + (put-text-property (match-beginning 1) (match-end 1) + 'syntax-table (string-to-syntax "\"'"))))) + (defcustom inferior-octave-buffer "*Inferior Octave*" "Name of buffer for running an inferior Octave process." :type 'string @@ -194,27 +215,17 @@ parenthetical grouping.") (define-key map ";" 'octave-electric-semi) (define-key map " " 'octave-electric-space) (define-key map "\n" 'octave-reindent-then-newline-and-indent) - (define-key map "\e;" 'octave-indent-for-comment) (define-key map "\e\n" 'octave-indent-new-comment-line) - (define-key map "\e\t" 'octave-complete-symbol) - (define-key map "\M-\C-a" 'octave-beginning-of-defun) - (define-key map "\M-\C-e" 'octave-end-of-defun) - (define-key map "\M-\C-h" 'octave-mark-defun) (define-key map "\M-\C-q" 'octave-indent-defun) - (define-key map "\C-c;" 'octave-comment-region) - (define-key map "\C-c:" 'octave-uncomment-region) (define-key map "\C-c\C-b" 'octave-submit-bug-report) (define-key map "\C-c\C-p" 'octave-previous-code-line) (define-key map "\C-c\C-n" 'octave-next-code-line) (define-key map "\C-c\C-a" 'octave-beginning-of-line) (define-key map "\C-c\C-e" 'octave-end-of-line) - (define-key map "\C-c\M-\C-n" 'octave-forward-block) - (define-key map "\C-c\M-\C-p" 'octave-backward-block) - (define-key map "\C-c\M-\C-u" 'octave-backward-up-block) - (define-key map "\C-c\M-\C-d" 'octave-down-block) + (define-key map [remap down-list] 'smie-down-list) (define-key map "\C-c\M-\C-h" 'octave-mark-block) - (define-key map "\C-c]" 'octave-close-block) - (define-key map "\C-c/" 'octave-close-block) + (define-key map "\C-c]" 'smie-close-block) + (define-key map "\C-c/" 'smie-close-block) (define-key map "\C-c\C-f" 'octave-insert-defun) (define-key map "\C-c\C-h" 'octave-help) (define-key map "\C-c\C-il" 'octave-send-line) @@ -235,7 +246,9 @@ parenthetical grouping.") "Keymap used in Octave mode.") -(defvar octave-mode-menu + +(easy-menu-define octave-mode-menu octave-mode-map + "Menu for Octave mode." '("Octave" ("Lines" ["Previous Code Line" octave-previous-code-line t] @@ -244,16 +257,9 @@ parenthetical grouping.") ["End of Continuation" octave-end-of-line t] ["Split Line at Point" octave-indent-new-comment-line t]) ("Blocks" - ["Next Block" octave-forward-block t] - ["Previous Block" octave-backward-block t] - ["Down Block" octave-down-block t] - ["Up Block" octave-backward-up-block t] ["Mark Block" octave-mark-block t] - ["Close Block" octave-close-block t]) + ["Close Block" smie-close-block t]) ("Functions" - ["Begin of Function" octave-beginning-of-defun t] - ["End of Function" octave-end-of-defun t] - ["Mark Function" octave-mark-defun t] ["Indent Function" octave-indent-defun t] ["Insert Function" octave-insert-defun t]) "-" @@ -267,16 +273,17 @@ parenthetical grouping.") ["Kill Process" octave-kill-process t]) "-" ["Indent Line" indent-according-to-mode t] - ["Complete Symbol" octave-complete-symbol t] + ["Complete Symbol" completion-at-point t] "-" - ["Toggle Abbrev Mode" abbrev-mode t] - ["Toggle Auto-Fill Mode" auto-fill-mode t] + ["Toggle Abbrev Mode" abbrev-mode + :style toggle :selected abbrev-mode] + ["Toggle Auto-Fill Mode" auto-fill-mode + :style toggle :selected auto-fill-function] "-" ["Submit Bug Report" octave-submit-bug-report t] "-" - ["Describe Octave Mode" octave-describe-major-mode t] - ["Lookup Octave Index" octave-help t]) - "Menu for Octave mode.") + ["Describe Octave Mode" describe-mode t] + ["Lookup Octave Index" info-lookup-symbol t])) (defvar octave-mode-syntax-table (let ((table (make-syntax-table))) @@ -298,8 +305,16 @@ parenthetical grouping.") (modify-syntax-entry ?\" "\"" table) (modify-syntax-entry ?. "w" table) (modify-syntax-entry ?_ "w" table) - (modify-syntax-entry ?\% "<" table) - (modify-syntax-entry ?\# "<" table) + ;; The "b" flag only applies to the second letter of the comstart + ;; and the first letter of the comend, i.e. the "4b" below is ineffective. + ;; If we try to put `b' on the single-line comments, we get a similar + ;; problem where the % and # chars appear as first chars of the 2-char + ;; comend, so the multi-line ender is also turned into style-b. + ;; So we need the new "c" comment style. + (modify-syntax-entry ?\% "< 13" table) + (modify-syntax-entry ?\# "< 13" table) + (modify-syntax-entry ?\{ "(} 2c" table) + (modify-syntax-entry ?\} "){ 4c" table) (modify-syntax-entry ?\n ">" table) table) "Syntax table in use in `octave-mode' buffers.") @@ -320,40 +335,12 @@ Non-nil means show matching begin of block when inserting a space, newline or semicolon after an else or end keyword." :type 'boolean :group 'octave) + (defcustom octave-block-offset 2 "Extra indentation applied to statements in Octave block structures." :type 'integer :group 'octave) -(defvar octave-block-begin-regexp - (concat "\\<\\(" - (mapconcat 'identity octave-begin-keywords "\\|") - "\\)\\>")) -(defvar octave-block-else-regexp - (concat "\\<\\(" - (mapconcat 'identity octave-else-keywords "\\|") - "\\)\\>")) -(defvar octave-block-end-regexp - (concat "\\<\\(" - (mapconcat 'identity octave-end-keywords "\\|") - "\\)\\>")) -(defvar octave-block-begin-or-end-regexp - (concat octave-block-begin-regexp "\\|" octave-block-end-regexp)) -(defvar octave-block-else-or-end-regexp - (concat octave-block-else-regexp "\\|" octave-block-end-regexp)) -(defvar octave-block-match-alist - '(("do" . ("until")) - ("for" . ("endfor" "end")) - ("function" . ("endfunction")) - ("if" . ("else" "elseif" "endif" "end")) - ("switch" . ("case" "otherwise" "endswitch" "end")) - ("try" . ("catch" "end_try_catch")) - ("unwind_protect" . ("unwind_protect_cleanup" "end_unwind_protect")) - ("while" . ("endwhile" "end"))) - "Alist with Octave's matching block keywords. -Has Octave's begin keywords as keys and a list of the matching else or -end keywords as associated values.") - (defvar octave-block-comment-start (concat (make-string 2 octave-comment-char) " ") "String to insert to start a new Octave comment on an empty line.") @@ -362,8 +349,11 @@ end keywords as associated values.") "Extra indentation applied to Octave continuation lines." :type 'integer :group 'octave) +(eval-and-compile + (defconst octave-continuation-marker-regexp "\\\\\\|\\.\\.\\.")) (defvar octave-continuation-regexp - "[^#%\n]*\\(\\\\\\|\\.\\.\\.\\)\\s-*\\(\\s<.*\\)?$") + (concat "[^#%\n]*\\(" octave-continuation-marker-regexp + "\\)\\s-*\\(\\s<.*\\)?$")) (defcustom octave-continuation-string "\\" "Character string used for Octave continuation lines. Normally \\." :type 'string @@ -401,8 +391,153 @@ Non-nil means always go to the next Octave code line after sending." :group 'octave) +;;; SMIE indentation + +(require 'smie) + +(defconst octave-operator-table + '((assoc ";" "\n") (assoc ",") ; The doc claims they have equal precedence!? + (right "=" "+=" "-=" "*=" "/=") + (assoc "&&") (assoc "||") ; The doc claims they have equal precedence!? + (assoc "&") (assoc "|") ; The doc claims they have equal precedence!? + (nonassoc "<" "<=" "==" ">=" ">" "!=" "~=") + (nonassoc ":") ;No idea what this is. + (assoc "+" "-") + (assoc "*" "/" "\\" ".\\" ".*" "./") + (nonassoc "'" ".'") + (nonassoc "++" "--" "!" "~") ;And unary "+" and "-". + (right "^" "**" ".^" ".**") + ;; It's not really an operator, but for indentation purposes it + ;; could be convenient to treat it as one. + (assoc "..."))) + +(defconst octave-smie-bnf-table + '((atom) + ;; We can't distinguish the first element in a sequence with + ;; precedence grammars, so we can't distinguish the condition + ;; if the `if' from the subsequent body, for example. + ;; This has to be done later in the indentation rules. + (exp (exp "\n" exp) + ;; We need to mention at least one of the operators in this part + ;; of the grammar: if the BNF and the operator table have + ;; no overlap, SMIE can't know how they relate. + (exp ";" exp) + ("try" exp "catch" exp "end_try_catch") + ("try" exp "catch" exp "end") + ("unwind_protect" exp + "unwind_protect_cleanup" exp "end_unwind_protect") + ("unwind_protect" exp "unwind_protect_cleanup" exp "end") + ("for" exp "endfor") + ("for" exp "end") + ("do" exp "until" atom) + ("while" exp "endwhile") + ("while" exp "end") + ("if" exp "endif") + ("if" exp "else" exp "endif") + ("if" exp "elseif" exp "else" exp "endif") + ("if" exp "elseif" exp "elseif" exp "else" exp "endif") + ("if" exp "elseif" exp "elseif" exp "else" exp "end") + ("switch" exp "case" exp "endswitch") + ("switch" exp "case" exp "otherwise" exp "endswitch") + ("switch" exp "case" exp "case" exp "otherwise" exp "endswitch") + ("switch" exp "case" exp "case" exp "otherwise" exp "end") + ("function" exp "endfunction") + ("function" exp "end")) + ;; (fundesc (atom "=" atom)) + )) + +(defconst octave-smie-closer-alist + (smie-bnf-closer-alist octave-smie-bnf-table)) + +(defconst octave-smie-op-levels + (smie-prec2-levels + (smie-merge-prec2s + (smie-bnf-precedence-table + octave-smie-bnf-table + '((assoc "\n" ";"))) + + (smie-precs-precedence-table + (append octave-operator-table + '((nonassoc " -dummy- "))) ;Bogus anchor at the end. + )))) + +;; Tokenizing needs to be refined so that ";;" is treated as two +;; tokens and also so as to recognize the \n separator (and +;; corresponding continuation lines). + +(defconst octave-operator-regexp + (regexp-opt (apply 'append (mapcar 'cdr octave-operator-table)))) + +(defun octave-smie-backward-token () + (let ((pos (point))) + (forward-comment (- (point))) + (cond + ((and (not (eq (char-before) ?\;)) ;Coalesce ";" and "\n". + (> pos (line-end-position)) + (if (looking-back octave-continuation-marker-regexp (- (point) 3)) + (progn + (goto-char (match-beginning 0)) + (forward-comment (- (point))) + nil) + t) + ;; Ignore it if it's within parentheses. + (let ((ppss (syntax-ppss))) + (not (and (nth 1 ppss) + (eq ?\( (char-after (nth 1 ppss))))))) + (skip-chars-forward " \t") + ;; Why bother distinguishing \n and ;? + ";") ;;"\n" + ((and (looking-back octave-operator-regexp (- (point) 3) 'greedy) + ;; Don't mistake a string quote for a transpose. + (not (looking-back "\\s\"" (1- (point))))) + (goto-char (match-beginning 0)) + (match-string-no-properties 0)) + (t + (smie-default-backward-token))))) + +(defun octave-smie-forward-token () + (skip-chars-forward " \t") + (when (looking-at (eval-when-compile + (concat "\\(" octave-continuation-marker-regexp + "\\)[ \t]*\\($\\|[%#]\\)"))) + (goto-char (match-end 1)) + (forward-comment 1)) + (cond + ((and (looking-at "$\\|[%#]") + ;; Ignore it if it's within parentheses. + (prog1 (let ((ppss (syntax-ppss))) + (not (and (nth 1 ppss) + (eq ?\( (char-after (nth 1 ppss)))))) + (forward-comment (point-max)))) + ;; Why bother distinguishing \n and ;? + ";") ;;"\n" + ((looking-at ";[ \t]*\\($\\|[%#]\\)") + ;; Combine the ; with the subsequent \n. + (goto-char (match-beginning 1)) + (forward-comment 1) + ";") + ((and (looking-at octave-operator-regexp) + ;; Don't mistake a string quote for a transpose. + (not (looking-at "\\s\""))) + (goto-char (match-end 0)) + (match-string-no-properties 0)) + (t + (smie-default-forward-token)))) + +(defconst octave-smie-indent-rules + '((";" + (:parent ("function" "if" "while" "else" "elseif" "for" "otherwise" + "case" "try" "catch" "unwind_protect" "unwind_protect_cleanup") + ;; FIXME: don't hardcode 2. + (+ parent octave-block-offset)) + ;; (:parent "switch" 4) ;For (invalid) code between switch and case. + 0) + ((:before . "case") octave-block-offset))) + +(defvar electric-indent-chars) + ;;;###autoload -(defun octave-mode () +(define-derived-mode octave-mode prog-mode "Octave" "Major mode for editing Octave code. This mode makes it easier to write Octave code by helping with @@ -485,57 +620,80 @@ an Octave 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." - (interactive) - (kill-all-local-variables) - - (use-local-map octave-mode-map) - (setq major-mode 'octave-mode) - (setq mode-name "Octave") (setq local-abbrev-table octave-abbrev-table) - (set-syntax-table octave-mode-syntax-table) - - (make-local-variable 'indent-line-function) - (setq indent-line-function 'octave-indent-line) - - (make-local-variable 'comment-start) - (setq comment-start octave-comment-start) - (make-local-variable 'comment-end) - (setq comment-end "") - (make-local-variable 'comment-column) - (setq comment-column 32) - (make-local-variable 'comment-start-skip) - (setq comment-start-skip "\\s<+\\s-*") - (make-local-variable 'comment-indent-function) - (setq comment-indent-function 'octave-comment-indent) - - (make-local-variable 'parse-sexp-ignore-comments) - (setq parse-sexp-ignore-comments t) - (make-local-variable 'paragraph-start) - (setq paragraph-start (concat "\\s-*$\\|" page-delimiter)) - (make-local-variable 'paragraph-separate) - (setq paragraph-separate paragraph-start) - (make-local-variable 'paragraph-ignore-fill-prefix) - (setq paragraph-ignore-fill-prefix t) - (make-local-variable 'fill-paragraph-function) - (setq fill-paragraph-function 'octave-fill-paragraph) - (make-local-variable 'adaptive-fill-regexp) - (setq adaptive-fill-regexp nil) - (make-local-variable 'fill-column) - (setq fill-column 72) - (make-local-variable 'normal-auto-fill-function) - (setq normal-auto-fill-function 'octave-auto-fill) - - (make-local-variable 'font-lock-defaults) - (setq font-lock-defaults '(octave-font-lock-keywords nil nil)) - - (make-local-variable 'imenu-generic-expression) - (setq imenu-generic-expression octave-mode-imenu-generic-expression - imenu-case-fold-search nil) - - (octave-add-octave-menu) + + (smie-setup octave-smie-op-levels octave-smie-indent-rules) + (set (make-local-variable 'smie-indent-basic) 'octave-block-offset) + (set (make-local-variable 'smie-backward-token-function) + 'octave-smie-backward-token) + (set (make-local-variable 'smie-forward-token-function) + 'octave-smie-forward-token) + (set (make-local-variable 'forward-sexp-function) + 'smie-forward-sexp-command) + (set (make-local-variable 'smie-closer-alist) octave-smie-closer-alist) + ;; Only needed for interactive calls to blink-matching-open. + (set (make-local-variable 'blink-matching-check-function) + #'smie-blink-matching-check) + + (when octave-blink-matching-block + (add-hook 'post-self-insert-hook #'smie-blink-matching-open 'append 'local) + (set (make-local-variable 'smie-blink-matching-triggers) + (append smie-blink-matching-triggers '(\;) + ;; Rather than wait for SPC or ; to blink, try to blink as + ;; soon as we type the last char of a block ender. + ;; But strip ?d from this list so that we don't blink twice + ;; when the user writes "endif" (once at "end" and another + ;; time at "endif"). + (delq ?d (delete-dups + (mapcar (lambda (kw) + (aref (cdr kw) (1- (length (cdr kw))))) + smie-closer-alist)))))) + + ;; FIXME: maybe we should use (cons ?\; electric-indent-chars) + ;; since only ; is really octave-specific. + (set (make-local-variable 'electric-indent-chars) '(?\; ?\s ?\n)) + + (set (make-local-variable 'comment-start) octave-comment-start) + (set (make-local-variable 'comment-end) "") + ;; Don't set it here: it's not really a property of the language, + ;; just a personal preference of the author. + ;; (set (make-local-variable 'comment-column) 32) + (set (make-local-variable 'comment-start-skip) "\\s<+\\s-*") + (set (make-local-variable 'comment-add) 1) + + (set (make-local-variable 'parse-sexp-ignore-comments) t) + (set (make-local-variable 'paragraph-start) + (concat "\\s-*$\\|" page-delimiter)) + (set (make-local-variable 'paragraph-separate) paragraph-start) + (set (make-local-variable 'paragraph-ignore-fill-prefix) t) + (set (make-local-variable 'fill-paragraph-function) 'octave-fill-paragraph) + ;; FIXME: Why disable it? + ;; (set (make-local-variable 'adaptive-fill-regexp) nil) + ;; Again, this is not a property of the language, don't set it here. + ;; (set (make-local-variable 'fill-column) 72) + (set (make-local-variable 'normal-auto-fill-function) 'octave-auto-fill) + + (set (make-local-variable 'font-lock-defaults) + '(octave-font-lock-keywords)) + + (set (make-local-variable 'syntax-propertize-function) + #'octave-syntax-propertize-function) + + (set (make-local-variable 'imenu-generic-expression) + octave-mode-imenu-generic-expression) + (set (make-local-variable 'imenu-case-fold-search) nil) + + (add-hook 'completion-at-point-functions + 'octave-completion-at-point-function nil t) + (set (make-local-variable 'beginning-of-defun-function) + 'octave-beginning-of-defun) + + (easy-menu-add octave-mode-menu) (octave-initialize-completions) (run-mode-hooks 'octave-mode-hook)) +(defvar info-lookup-mode) + (defun octave-help () "Get help on Octave symbols from the Octave info files. Look up symbol in the function, operator and variable indices of the info files." @@ -543,74 +701,31 @@ Look up symbol in the function, operator and variable indices of the info files. (call-interactively 'info-lookup-symbol))) ;;; Miscellaneous useful functions -(defun octave-describe-major-mode () - "Describe the current major mode." - (interactive) - (describe-function major-mode)) (defsubst octave-in-comment-p () "Return t if point is inside an Octave comment." - (interactive) (save-excursion + ;; FIXME: use syntax-ppss? (nth 4 (parse-partial-sexp (line-beginning-position) (point))))) (defsubst octave-in-string-p () "Return t if point is inside an Octave string." - (interactive) (save-excursion + ;; FIXME: use syntax-ppss? (nth 3 (parse-partial-sexp (line-beginning-position) (point))))) (defsubst octave-not-in-string-or-comment-p () "Return t if point is not inside an Octave string or comment." + ;; FIXME: Use syntax-ppss? (let ((pps (parse-partial-sexp (line-beginning-position) (point)))) (not (or (nth 3 pps) (nth 4 pps))))) -(defun octave-in-block-p () - "Return t if point is inside an Octave block. -The block is taken to start at the first letter of the begin keyword and -to end after the end keyword." - (let ((pos (point))) - (save-excursion - (condition-case nil - (progn - (skip-syntax-forward "w") - (octave-up-block -1) - (octave-forward-block) - t) - (error nil)) - (< pos (point))))) (defun octave-looking-at-kw (regexp) "Like `looking-at', but sets `case-fold-search' nil." (let ((case-fold-search nil)) (looking-at regexp))) -(defun octave-re-search-forward-kw (regexp count) - "Like `re-search-forward', but sets `case-fold-search' nil, and moves point." - (let ((case-fold-search nil)) - (re-search-forward regexp nil 'move count))) - -(defun octave-re-search-backward-kw (regexp count) - "Like `re-search-backward', but sets `case-fold-search' nil, and moves point." - (let ((case-fold-search nil)) - (re-search-backward regexp nil 'move count))) - -(defun octave-in-defun-p () - "Return t if point is inside an Octave function declaration. -The function is taken to start at the `f' of `function' and to end after -the end keyword." - (let ((pos (point))) - (save-excursion - (or (and (octave-looking-at-kw "\\<function\\>") - (octave-not-in-string-or-comment-p)) - (and (octave-beginning-of-defun) - (condition-case nil - (progn - (octave-forward-block) - t) - (error nil)) - (< pos (point))))))) - (defun octave-maybe-insert-continuation-string () (if (or (octave-in-comment-p) (save-excursion @@ -620,147 +735,8 @@ the end keyword." (delete-horizontal-space) (insert (concat " " octave-continuation-string)))) -;;; Comments -(defun octave-comment-region (beg end &optional arg) - "Comment or uncomment each line in the region as Octave code. -See `comment-region'." - (interactive "r\nP") - (let ((comment-start (char-to-string octave-comment-char))) - (comment-region beg end arg))) - -(defun octave-uncomment-region (beg end &optional arg) - "Uncomment each line in the region as Octave code." - (interactive "r\nP") - (or arg (setq arg 1)) - (octave-comment-region beg end (- arg))) - ;;; Indentation -(defun calculate-octave-indent () - "Return appropriate indentation for current line as Octave code. -Returns an integer (the column to indent to) unless the line is a -comment line with fixed goal golumn. In that case, returns a list whose -car is the column to indent to, and whose cdr is the current indentation -level." - (let ((is-continuation-line - (save-excursion - (if (zerop (octave-previous-code-line)) - (looking-at octave-continuation-regexp)))) - (icol 0)) - (save-excursion - (beginning-of-line) - ;; If we can move backward out one level of parentheses, take 1 - ;; plus the indentation of that parenthesis. Otherwise, go back - ;; to the beginning of the previous code line, and compute the - ;; offset this line gives. - (if (condition-case nil - (progn - (up-list -1) - t) - (error nil)) - (setq icol (+ 1 (current-column))) - (if (zerop (octave-previous-code-line)) - (progn - (octave-beginning-of-line) - (back-to-indentation) - (setq icol (current-column)) - (let ((bot (point)) - (eol (line-end-position))) - (while (< (point) eol) - (if (octave-not-in-string-or-comment-p) - (cond - ((octave-looking-at-kw "\\<switch\\>") - (setq icol (+ icol (* 2 octave-block-offset)))) - ((octave-looking-at-kw octave-block-begin-regexp) - (setq icol (+ icol octave-block-offset))) - ((octave-looking-at-kw octave-block-else-regexp) - (if (= bot (point)) - (setq icol (+ icol octave-block-offset)))) - ((octave-looking-at-kw octave-block-end-regexp) - (if (and (not (= bot (point))) - ;; special case for `end' keyword, - ;; applied to all keywords - (not (octave-end-as-array-index-p))) - (setq icol (- icol - (octave-block-end-offset))))))) - (forward-char))) - (if is-continuation-line - (setq icol (+ icol octave-continuation-offset))))))) - (save-excursion - (back-to-indentation) - (cond - ((and (octave-looking-at-kw octave-block-else-regexp) - (octave-not-in-string-or-comment-p)) - (setq icol (- icol octave-block-offset))) - ((and (octave-looking-at-kw octave-block-end-regexp) - (octave-not-in-string-or-comment-p)) - (setq icol (- icol (octave-block-end-offset)))) - ((or (looking-at "\\s<\\s<\\s<\\S<") - (octave-before-magic-comment-p)) - (setq icol (list 0 icol))) - ((looking-at "\\s<\\S<") - (setq icol (list comment-column icol))))) - icol)) - -;; FIXME: this should probably also make sure we are actually looking -;; at the "end" keyword. -(defun octave-end-as-array-index-p () - (save-excursion - (condition-case nil - ;; Check if point is between parens - (progn (up-list 1) t) - (error nil)))) - -(defun octave-block-end-offset () - (save-excursion - (octave-backward-up-block 1) - (* octave-block-offset - (if (string-match (match-string 0) "switch") 2 1)))) - -(defun octave-before-magic-comment-p () - (save-excursion - (beginning-of-line) - (and (bobp) (looking-at "\\s-*#!")))) - -(defun octave-comment-indent () - (if (or (looking-at "\\s<\\s<\\s<") - (octave-before-magic-comment-p)) - 0 - (if (looking-at "\\s<\\s<") - (calculate-octave-indent) - (skip-syntax-backward " ") - (max (if (bolp) 0 (+ 1 (current-column))) - comment-column)))) - -(defun octave-indent-for-comment () - "Maybe insert and indent an Octave comment. -If there is no comment already on this line, create a code-level comment -\(started by two comment characters) if the line is empty, or an in-line -comment (started by one comment character) otherwise. -Point is left after the start of the comment which is properly aligned." - (interactive) - (beginning-of-line) - (if (looking-at "^\\s-*$") - (insert octave-block-comment-start) - (indent-for-comment)) - (indent-according-to-mode)) - -(defun octave-indent-line (&optional arg) - "Indent current line as Octave code. -With optional ARG, use this as offset unless this line is a comment with -fixed goal column." - (interactive) - (or arg (setq arg 0)) - (let ((icol (calculate-octave-indent)) - (relpos (- (current-column) (current-indentation)))) - (if (listp icol) - (setq icol (car icol)) - (setq icol (+ icol arg))) - (if (< icol 0) - (error "Unmatched end keyword") - (indent-line-to icol) - (if (> relpos 0) - (move-to-column (+ icol relpos)))))) (defun octave-indent-new-comment-line () "Break Octave line at point, continuing comment if within one. @@ -782,7 +758,7 @@ The new line is properly indented." "Properly indent the Octave function which contains point." (interactive) (save-excursion - (octave-mark-defun) + (mark-defun) (message "Indenting function...") (indent-region (point) (mark) nil)) (message "Indenting function...done.")) @@ -862,193 +838,33 @@ does not end in `...' or `\\' or is inside an open parenthesis list." (zerop (forward-line 1))))) (end-of-line))) -(defun octave-scan-blocks (count depth) - "Scan from point by COUNT Octave begin-end blocks. -Returns the character number of the position thus found. - -If DEPTH is nonzero, block depth begins counting from that value. -Only places where the depth in blocks becomes zero are candidates for -stopping; COUNT such places are counted. - -If the beginning or end of the buffer is reached and the depth is wrong, -an error is signaled." - (let ((min-depth (if (> depth 0) 0 depth)) - (inc (if (> count 0) 1 -1))) - (save-excursion - (while (/= count 0) - (catch 'foo - (while (or (octave-re-search-forward-kw - octave-block-begin-or-end-regexp inc) - (if (/= depth 0) - (error "Unbalanced block"))) - (if (octave-not-in-string-or-comment-p) - (progn - (cond - ((match-end 1) - (setq depth (+ depth inc))) - ((match-end 2) - (setq depth (- depth inc)))) - (if (< depth min-depth) - (error "Containing expression ends prematurely")) - (if (= depth 0) - (throw 'foo nil)))))) - (setq count (- count inc))) - (point)))) - -(defun octave-forward-block (&optional arg) - "Move forward across one balanced Octave begin-end block. -With argument, do it that many times. -Negative arg -N means move backward across N blocks." - (interactive "p") - (or arg (setq arg 1)) - (goto-char (or (octave-scan-blocks arg 0) (buffer-end arg)))) - -(defun octave-backward-block (&optional arg) - "Move backward across one balanced Octave begin-end block. -With argument, do it that many times. -Negative arg -N means move forward across N blocks." - (interactive "p") - (or arg (setq arg 1)) - (octave-forward-block (- arg))) - -(defun octave-down-block (arg) - "Move forward down one begin-end block level of Octave code. -With argument, do this that many times. -A negative argument means move backward but still go down a level. -In Lisp programs, an argument is required." - (interactive "p") - (let ((inc (if (> arg 0) 1 -1))) - (while (/= arg 0) - (goto-char (or (octave-scan-blocks inc -1) - (buffer-end arg))) - (setq arg (- arg inc))))) - -(defun octave-backward-up-block (arg) - "Move backward out of one begin-end block level of Octave code. -With argument, do this that many times. -A negative argument means move forward but still to a less deep spot. -In Lisp programs, an argument is required." - (interactive "p") - (octave-up-block (- arg))) - -(defun octave-up-block (arg) - "Move forward out of one begin-end block level of Octave code. -With argument, do this that many times. -A negative argument means move backward but still to a less deep spot. -In Lisp programs, an argument is required." - (interactive "p") - (let ((inc (if (> arg 0) 1 -1))) - (while (/= arg 0) - (goto-char (or (octave-scan-blocks inc 1) - (buffer-end arg))) - (setq arg (- arg inc))))) - (defun octave-mark-block () "Put point at the beginning of this Octave block, mark at the end. The block marked is the one that contains point or follows point." (interactive) - (let ((pos (point))) - (if (or (and (octave-in-block-p) - (skip-syntax-forward "w")) - (condition-case nil - (progn - (octave-down-block 1) - (octave-in-block-p)) - (error nil))) - (progn - (octave-up-block -1) - (push-mark (point)) - (octave-forward-block) - (exchange-point-and-mark)) - (goto-char pos) - (message "No block to mark found")))) - -(defun octave-close-block () - "Close the current Octave block on a separate line. -An error is signaled if no block to close is found." - (interactive) - (let (bb-keyword) - (condition-case nil - (progn - (save-excursion - (octave-backward-up-block 1) - (setq bb-keyword (buffer-substring-no-properties - (match-beginning 1) (match-end 1)))) - (if (save-excursion - (beginning-of-line) - (looking-at "^\\s-*$")) - (indent-according-to-mode) - (octave-reindent-then-newline-and-indent)) - (insert (car (reverse - (assoc bb-keyword - octave-block-match-alist)))) - (octave-reindent-then-newline-and-indent) - t) - (error (message "No block to close found"))))) - -(defun octave-blink-matching-block-open () - "Blink the matching Octave begin block keyword. -If point is right after an Octave else or end type block keyword, move -cursor momentarily to the corresponding begin keyword. -Signal an error if the keywords are incompatible." - (interactive) - (let (bb-keyword bb-arg eb-keyword pos eol) - (if (and (octave-not-in-string-or-comment-p) - (looking-at "\\>") - (save-excursion - (skip-syntax-backward "w") - (octave-looking-at-kw octave-block-else-or-end-regexp))) - (save-excursion - (cond - ((match-end 1) - (setq eb-keyword - (buffer-substring-no-properties - (match-beginning 1) (match-end 1))) - (octave-backward-up-block 1)) - ((match-end 2) - (setq eb-keyword - (buffer-substring-no-properties - (match-beginning 2) (match-end 2))) - (octave-backward-block))) - (setq pos (match-end 0) - bb-keyword - (buffer-substring-no-properties - (match-beginning 0) pos) - pos (+ pos 1) - eol (line-end-position) - bb-arg - (save-excursion - (save-restriction - (goto-char pos) - (while (and (skip-syntax-forward "^<" eol) - (octave-in-string-p) - (not (forward-char 1)))) - (skip-syntax-backward " ") - (buffer-substring-no-properties pos (point))))) - (if (member eb-keyword - (cdr (assoc bb-keyword octave-block-match-alist))) - (progn - (message "Matches `%s %s'" bb-keyword bb-arg) - (if (pos-visible-in-window-p) - (sit-for blink-matching-delay))) - (error "Block keywords `%s' and `%s' do not match" - bb-keyword eb-keyword)))))) + (unless (or (looking-at "\\s(") + (save-excursion + (let* ((token (funcall smie-forward-token-function)) + (level (assoc token smie-op-levels))) + (and level (null (cadr level)))))) + (backward-up-list 1)) + (mark-sexp)) (defun octave-beginning-of-defun (&optional arg) "Move backward to the beginning of an Octave function. With positive ARG, do it that many times. Negative argument -N means move forward to Nth following beginning of a function. Returns t unless search stops at the beginning or end of the buffer." - (interactive "p") (let* ((arg (or arg 1)) (inc (if (> arg 0) 1 -1)) - (found)) + (found nil) + (case-fold-search nil)) (and (not (eobp)) - (not (and (> arg 0) (octave-looking-at-kw "\\<function\\>"))) + (not (and (> arg 0) (looking-at "\\<function\\>"))) (skip-syntax-forward "w")) (while (and (/= arg 0) (setq found - (octave-re-search-backward-kw "\\<function\\>" inc))) + (re-search-backward "\\<function\\>" inc))) (if (octave-not-in-string-or-comment-p) (setq arg (- arg inc)))) (if found @@ -1056,40 +872,6 @@ Returns t unless search stops at the beginning or end of the buffer." (and (< inc 0) (goto-char (match-beginning 0))) t)))) -(defun octave-end-of-defun (&optional arg) - "Move forward to the end of an Octave function. -With positive ARG, do it that many times. Negative argument -N means -move back to Nth preceding end of a function. - -An end of a function occurs right after the end keyword matching the -`function' keyword that starts the function." - (interactive "p") - (or arg (setq arg 1)) - (and (< arg 0) (skip-syntax-backward "w")) - (and (> arg 0) (skip-syntax-forward "w")) - (if (octave-in-defun-p) - (setq arg (- arg 1))) - (if (= arg 0) (setq arg -1)) - (if (octave-beginning-of-defun (- arg)) - (octave-forward-block))) - -(defun octave-mark-defun () - "Put point at the beginning of this Octave function, mark at its end. -The function marked is the one containing point or following point." - (interactive) - (let ((pos (point))) - (if (or (octave-in-defun-p) - (and (octave-beginning-of-defun -1) - (octave-in-defun-p))) - (progn - (skip-syntax-forward "w") - (octave-beginning-of-defun) - (push-mark (point)) - (octave-end-of-defun) - (exchange-point-and-mark)) - (goto-char pos) - (message "No function to mark found")))) - ;;; Filling (defun octave-auto-fill () @@ -1154,81 +936,73 @@ otherwise." (not give-up)))) (defun octave-fill-paragraph (&optional arg) - "Fill paragraph of Octave code, handling Octave comments." - ;; FIXME: now that the default fill-paragraph takes care of similar issues, - ;; this seems obsolete. --Stef - (interactive "P") - (save-excursion - (let ((end (progn (forward-paragraph) (point))) - (beg (progn - (forward-paragraph -1) - (skip-chars-forward " \t\n") - (beginning-of-line) - (point))) - (cfc (current-fill-column)) - (ind (calculate-octave-indent)) - comment-prefix) - (save-restriction - (goto-char beg) - (narrow-to-region beg end) - (if (listp ind) (setq ind (nth 1 ind))) - (while (not (eobp)) - (condition-case nil - (octave-indent-line ind) - (error nil)) - (if (and (> ind 0) - (not - (save-excursion - (beginning-of-line) - (looking-at "^\\s-*\\($\\|\\s<+\\)")))) - (setq ind 0)) - (move-to-column cfc) - ;; First check whether we need to combine non-empty comment lines - (if (and (< (current-column) cfc) - (octave-in-comment-p) - (not (save-excursion - (beginning-of-line) - (looking-at "^\\s-*\\s<+\\s-*$")))) - ;; This is a nonempty comment line which does not extend - ;; past the fill column. If it is followed by a nonempty - ;; comment line with the same comment prefix, try to - ;; combine them, and repeat this until either we reach the - ;; fill-column or there is nothing more to combine. - (progn - ;; Get the comment prefix - (save-excursion - (beginning-of-line) - (while (and (re-search-forward "\\s<+") - (not (octave-in-comment-p)))) - (setq comment-prefix (match-string 0))) - ;; And keep combining ... - (while (and (< (current-column) cfc) - (save-excursion - (forward-line 1) - (and (looking-at - (concat "^\\s-*" - comment-prefix - "\\S<")) - (not (looking-at - (concat "^\\s-*" - comment-prefix - "\\s-*$")))))) - (delete-char 1) - (re-search-forward comment-prefix) - (delete-region (match-beginning 0) (match-end 0)) - (fixup-whitespace) - (move-to-column cfc)))) - ;; We might also try to combine continued code lines> Perhaps - ;; some other time ... - (skip-chars-forward "^ \t\n") - (delete-horizontal-space) - (if (or (< (current-column) cfc) - (and (= (current-column) cfc) (eolp))) - (forward-line 1) - (if (not (eolp)) (insert " ")) - (or (octave-auto-fill) - (forward-line 1))))) - t))) + "Fill paragraph of Octave code, handling Octave comments." + ;; FIXME: difference with generic fill-paragraph: + ;; - code lines are only split, never joined. + ;; - \n that end comments are never removed. + ;; - insert continuation marker when splitting code lines. + (interactive "P") + (save-excursion + (let ((end (progn (forward-paragraph) (copy-marker (point) t))) + (beg (progn + (forward-paragraph -1) + (skip-chars-forward " \t\n") + (beginning-of-line) + (point))) + (cfc (current-fill-column)) + comment-prefix) + (goto-char beg) + (while (< (point) end) + (condition-case nil + (indent-according-to-mode) + (error nil)) + (move-to-column cfc) + ;; First check whether we need to combine non-empty comment lines + (if (and (< (current-column) cfc) + (octave-in-comment-p) + (not (save-excursion + (beginning-of-line) + (looking-at "^\\s-*\\s<+\\s-*$")))) + ;; This is a nonempty comment line which does not extend + ;; past the fill column. If it is followed by a nonempty + ;; comment line with the same comment prefix, try to + ;; combine them, and repeat this until either we reach the + ;; fill-column or there is nothing more to combine. + (progn + ;; Get the comment prefix + (save-excursion + (beginning-of-line) + (while (and (re-search-forward "\\s<+") + (not (octave-in-comment-p)))) + (setq comment-prefix (match-string 0))) + ;; And keep combining ... + (while (and (< (current-column) cfc) + (save-excursion + (forward-line 1) + (and (looking-at + (concat "^\\s-*" + comment-prefix + "\\S<")) + (not (looking-at + (concat "^\\s-*" + comment-prefix + "\\s-*$")))))) + (delete-char 1) + (re-search-forward comment-prefix) + (delete-region (match-beginning 0) (match-end 0)) + (fixup-whitespace) + (move-to-column cfc)))) + ;; We might also try to combine continued code lines> Perhaps + ;; some other time ... + (skip-chars-forward "^ \t\n") + (delete-horizontal-space) + (if (or (< (current-column) cfc) + (and (= (current-column) cfc) (eolp))) + (forward-line 1) + (if (not (eolp)) (insert " ")) + (or (octave-auto-fill) + (forward-line 1)))) + t))) ;;; Completions @@ -1237,34 +1011,34 @@ otherwise." (if octave-completion-alist () (setq octave-completion-alist - (mapcar '(lambda (var) (cons var var)) - (append octave-reserved-words - octave-text-functions - octave-variables))))) + (append octave-reserved-words + octave-text-functions + octave-variables)))) + +(defun octave-completion-at-point-function () + "Find the text to complete and the corresponding table." + (let* ((beg (save-excursion (backward-sexp 1) (point))) + (end (point))) + (if (< beg (point)) + ;; Extend region past point, if applicable. + (save-excursion (goto-char beg) (forward-sexp 1) + (setq end (max end (point))))) + (list beg end octave-completion-alist))) (defun octave-complete-symbol () "Perform completion on Octave symbol preceding point. Compare that symbol against Octave's reserved words and builtin variables." (interactive) - (let* ((end (point)) - (beg (save-excursion (backward-sexp 1) (point)))) - (completion-in-region beg end octave-completion-alist))) - + (apply 'completion-in-region (octave-completion-at-point-function))) ;;; Electric characters && friends (defun octave-reindent-then-newline-and-indent () "Reindent current Octave line, insert newline, and indent the new line. If Abbrev mode is on, expand abbrevs first." + ;; FIXME: None of this is Octave-specific. (interactive) - (if abbrev-mode (expand-abbrev)) - (if octave-blink-matching-block - (octave-blink-matching-block-open)) - (save-excursion - (delete-region (point) (progn (skip-chars-backward " \t") (point))) - (indent-according-to-mode)) - (insert "\n") - (indent-according-to-mode)) + (reindent-then-newline-and-indent)) (defun octave-electric-semi () "Insert a semicolon in Octave mode. @@ -1272,14 +1046,12 @@ Maybe expand abbrevs and blink matching block open keywords. Reindent the line if `octave-auto-indent' is non-nil. Insert a newline if `octave-auto-newline' is non-nil." (interactive) + (setq last-command-event ?\;) (if (not (octave-not-in-string-or-comment-p)) - (insert ";") - (if abbrev-mode (expand-abbrev)) - (if octave-blink-matching-block - (octave-blink-matching-block-open)) + (self-insert-command 1) (if octave-auto-indent (indent-according-to-mode)) - (insert ";") + (self-insert-command 1) (if octave-auto-newline (newline-and-indent)))) @@ -1294,9 +1066,6 @@ Reindent the line if `octave-auto-indent' is non-nil." (progn (indent-according-to-mode) (self-insert-command 1)) - (if abbrev-mode (expand-abbrev)) - (if octave-blink-matching-block - (octave-blink-matching-block-open)) (if (and octave-auto-indent (save-excursion (skip-syntax-backward " ") @@ -1324,51 +1093,27 @@ Note that all Octave mode abbrevs start with a grave accent." (list-abbrevs)) (setq unread-command-events (list c)))))) -(defun octave-insert-defun (name args vals) +(define-skeleton octave-insert-defun "Insert an Octave function skeleton. Prompt for the function's name, arguments and return values (to be entered without parens)." - (interactive - (list - (read-from-minibuffer "Function name: " - (substring (buffer-name) 0 -2)) - (read-from-minibuffer "Arguments: ") - (read-from-minibuffer "Return values: "))) - (let ((string (format "%s %s (%s)" - (cond - ((string-equal vals "") - vals) - ((string-match "[ ,]" vals) - (concat " [" vals "] =")) - (t - (concat " " vals " ="))) - name - args)) - (prefix octave-block-comment-start)) - (if (not (bobp)) (newline)) - (insert "function" string) - (indent-according-to-mode) - (newline 2) - (insert prefix "usage: " string) - (reindent-then-newline-and-indent) - (insert prefix) - (reindent-then-newline-and-indent) - (insert prefix) - (indent-according-to-mode) - (save-excursion - (newline 2) - (insert "endfunction") - (indent-according-to-mode)))) - - -;;; Menu -(defun octave-add-octave-menu () - "Add the `Octave' menu to the menu bar in Octave mode." - (require 'easymenu) - (easy-menu-define octave-mode-menu-map octave-mode-map - "Menu keymap for Octave mode." octave-mode-menu) - (easy-menu-add octave-mode-menu-map octave-mode-map)) - + (let* ((defname (substring (buffer-name) 0 -2)) + (name (read-string (format "Function name (default %s): " defname) + nil nil defname)) + (args (read-string "Arguments: ")) + (vals (read-string "Return values: "))) + (format "%s%s (%s)" + (cond + ((string-equal vals "") vals) + ((string-match "[ ,]" vals) (concat "[" vals "] = ")) + (t (concat vals " = "))) + name + args)) + \n "function " > str \n \n + octave-block-comment-start "usage: " str \n + octave-block-comment-start \n octave-block-comment-start + \n _ \n + "endfunction" > \n) ;;; Communication with the inferior Octave process (defun octave-kill-process () @@ -1435,7 +1180,7 @@ entered without parens)." "Send current Octave function to the inferior Octave process." (interactive) (save-excursion - (octave-mark-defun) + (mark-defun) (octave-send-region (point) (mark)))) (defun octave-send-line (&optional arg) diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index f8eba5accdb..ae3acc3cda3 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -250,59 +250,76 @@ The expansion is entirely correct because it uses the C preprocessor." ;; y /.../.../ ;; ;; <file*glob> -(defvar perl-font-lock-syntactic-keywords - ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)") - `(;; Turn POD into b-style comments - ("^\\(=\\)\\sw" (1 "< b")) - ("^=cut[ \t]*\\(\n\\)" (1 "> b")) - ;; Catch ${ so that ${var} doesn't screw up indentation. - ;; This also catches $' to handle 'foo$', although it should really - ;; check that it occurs inside a '..' string. - ("\\(\\$\\)[{']" (1 ". p")) - ;; Handle funny names like $DB'stop. - ("\\$ ?{?^?[_a-zA-Z][_a-zA-Z0-9]*\\('\\)[_a-zA-Z]" (1 "_")) - ;; format statements - ("^[ \t]*format.*=[ \t]*\\(\n\\)" (1 '(7))) - ;; Funny things in `sub' arg-specs like `sub myfun ($)' or `sub ($)'. - ;; Be careful not to match "sub { (...) ... }". - ("\\<sub\\(?:[[:space:]]+[^{}[:punct:][:space:]]+\\)?[[:space:]]*(\\([^)]+\\))" - 1 '(1)) - ;; Regexp and funny quotes. Distinguishing a / that starts a regexp - ;; match from the division operator is ...interesting. - ;; Basically, / is a regexp match if it's preceded by an infix operator - ;; (or some similar separator), or by one of the special keywords - ;; corresponding to builtin functions that can take their first arg - ;; without parentheses. Of course, that presume we're looking at the - ;; *opening* slash. We can afford to mis-match the closing ones - ;; here, because they will be re-treated separately later in - ;; perl-font-lock-special-syntactic-constructs. - (,(concat "\\(?:\\(?:\\(?:^\\|[^$@&%[:word:]]\\)" - (regexp-opt '("split" "if" "unless" "until" "while" "split" - "grep" "map" "not" "or" "and")) - "\\)\\|[?:.,;=!~({[]\\|\\(^\\)\\)[ \t\n]*\\(/\\)") - (2 (if (and (match-end 1) - (save-excursion - (goto-char (match-end 1)) - ;; Not 100% correct since we haven't finished setting up - ;; the syntax-table before point, but better than nothing. - (forward-comment (- (point-max))) - (put-text-property (point) (match-end 2) - 'jit-lock-defer-multiline t) - (not (memq (char-before) - '(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[))))) - nil ;; A division sign instead of a regexp-match. - '(7)))) - ("\\(^\\|[?:.,;=!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\([^])}> \n\t]\\)" - ;; Nasty cases: - ;; /foo/m $a->m $#m $m @m %m - ;; \s (appears often in regexps). - ;; -s file - (3 (if (assoc (char-after (match-beginning 3)) - perl-quote-like-pairs) - '(15) '(7)))) - ;; Find and mark the end of funny quotes and format statements. - (perl-font-lock-special-syntactic-constructs) - )) +(defun perl-syntax-propertize-function (start end) + (let ((case-fold-search nil)) + (goto-char start) + (perl-syntax-propertize-special-constructs end) + ;; TODO: here-documents ("<<\\(\\sw\\|['\"]\\)") + (funcall + (syntax-propertize-rules + ;; Turn POD into b-style comments. Place the cut rule first since it's + ;; more specific. + ("^=cut\\>.*\\(\n\\)" (1 "> b")) + ("^\\(=\\)\\sw" (1 "< b")) + ;; Catch ${ so that ${var} doesn't screw up indentation. + ;; This also catches $' to handle 'foo$', although it should really + ;; check that it occurs inside a '..' string. + ("\\(\\$\\)[{']" (1 ". p")) + ;; Handle funny names like $DB'stop. + ("\\$ ?{?^?[_a-zA-Z][_a-zA-Z0-9]*\\('\\)[_a-zA-Z]" (1 "_")) + ;; format statements + ("^[ \t]*format.*=[ \t]*\\(\n\\)" + (1 (prog1 "\"" (perl-syntax-propertize-special-constructs end)))) + ;; Funny things in `sub' arg-specs like `sub myfun ($)' or `sub ($)'. + ;; Be careful not to match "sub { (...) ... }". + ("\\<sub\\(?:[[:space:]]+[^{}[:punct:][:space:]]+\\)?[[:space:]]*(\\([^)]+\\))" + (1 ".")) + ;; Regexp and funny quotes. Distinguishing a / that starts a regexp + ;; match from the division operator is ...interesting. + ;; Basically, / is a regexp match if it's preceded by an infix operator + ;; (or some similar separator), or by one of the special keywords + ;; corresponding to builtin functions that can take their first arg + ;; without parentheses. Of course, that presume we're looking at the + ;; *opening* slash. We can afford to mis-match the closing ones + ;; here, because they will be re-treated separately later in + ;; perl-font-lock-special-syntactic-constructs. + ((concat "\\(?:\\(?:^\\|[^$@&%[:word:]]\\)" + (regexp-opt '("split" "if" "unless" "until" "while" "split" + "grep" "map" "not" "or" "and")) + "\\|[?:.,;=!~({[]\\|\\(^\\)\\)[ \t\n]*\\(/\\)") + (2 (ignore + (if (and (match-end 1) ; / at BOL. + (save-excursion + (goto-char (match-end 1)) + (forward-comment (- (point-max))) + (put-text-property (point) (match-end 2) + 'syntax-multiline t) + (not (memq (char-before) + '(?? ?: ?. ?, ?\; ?= ?! ?~ ?\( ?\[))))) + nil ;; A division sign instead of a regexp-match. + (put-text-property (match-beginning 2) (match-end 2) + 'syntax-table (string-to-syntax "\"")) + (perl-syntax-propertize-special-constructs end))))) + ("\\(^\\|[?:.,;=!~({[ \t]\\)\\([msy]\\|q[qxrw]?\\|tr\\)\\>\\s-*\\([^])}> \n\t]\\)" + ;; Nasty cases: + ;; /foo/m $a->m $#m $m @m %m + ;; \s (appears often in regexps). + ;; -s file + ;; sub tr {...} + (3 (ignore + (if (save-excursion (goto-char (match-beginning 0)) + (forward-word -1) + (looking-at-p "sub[ \t\n]")) + ;; This is defining a function. + nil + (put-text-property (match-beginning 3) (match-end 3) + 'syntax-table + (if (assoc (char-after (match-beginning 3)) + perl-quote-like-pairs) + (string-to-syntax "|") + (string-to-syntax "\""))) + (perl-syntax-propertize-special-constructs end)))))) + (point) end))) (defvar perl-empty-syntax-table (let ((st (copy-syntax-table))) @@ -321,95 +338,123 @@ The expansion is entirely correct because it uses the C preprocessor." (modify-syntax-entry close ")" st)) st)) -(defun perl-font-lock-special-syntactic-constructs (limit) - ;; We used to do all this in a font-lock-syntactic-face-function, which - ;; did not work correctly because sometimes some parts of the buffer are - ;; treated with font-lock-syntactic-keywords but not with - ;; font-lock-syntactic-face-function (mostly because of - ;; font-lock-syntactically-fontified). That meant that some syntax-table - ;; properties were missing. So now we do the parse-partial-sexp loop - ;; ourselves directly from font-lock-syntactic-keywords, so we're sure - ;; it's done when necessary. +(defun perl-syntax-propertize-special-constructs (limit) + "Propertize special constructs like regexps and formats." (let ((state (syntax-ppss)) char) - (while (< (point) limit) - (cond - ((or (null (setq char (nth 3 state))) - (and (characterp char) (eq (char-syntax (nth 3 state)) ?\"))) - ;; Normal text, or comment, or docstring, or normal string. - nil) - ((eq (nth 3 state) ?\n) - ;; A `format' command. - (save-excursion - (when (and (re-search-forward "^\\s *\\.\\s *$" nil t) - (not (eobp))) - (put-text-property (point) (1+ (point)) 'syntax-table '(7))))) - (t - ;; This is regexp like quote thingy. - (setq char (char-after (nth 8 state))) - (save-excursion - (let ((twoargs (save-excursion - (goto-char (nth 8 state)) - (skip-syntax-backward " ") - (skip-syntax-backward "w") - (member (buffer-substring - (point) (progn (forward-word 1) (point))) - '("tr" "s" "y")))) - (close (cdr (assq char perl-quote-like-pairs))) - (pos (point)) - (st (perl-quote-syntax-table char))) - (if (not close) - ;; The closing char is the same as the opening char. - (with-syntax-table st - (parse-partial-sexp (point) (point-max) - nil nil state 'syntax-table) - (when twoargs - (parse-partial-sexp (point) (point-max) - nil nil state 'syntax-table))) - ;; The open/close chars are matched like () [] {} and <>. - (let ((parse-sexp-lookup-properties nil)) - (condition-case err - (progn - (with-syntax-table st - (goto-char (nth 8 state)) (forward-sexp 1)) - (when twoargs - (save-excursion - ;; Skip whitespace and make sure that font-lock will - ;; refontify the second part in the proper context. - (put-text-property - (point) (progn (forward-comment (point-max)) (point)) - 'font-lock-multiline t) - ;; - (unless - (or (eobp) - (save-excursion - (with-syntax-table - (perl-quote-syntax-table (char-after)) - (forward-sexp 1)) - (put-text-property pos (line-end-position) - 'jit-lock-defer-multiline t) - (looking-at "\\s-*\\sw*e"))) - (put-text-property (point) (1+ (point)) - 'syntax-table - (if (assoc (char-after) - perl-quote-like-pairs) - '(15) '(7))))))) - ;; The arg(s) is not terminated, so it extends until EOB. - (scan-error (goto-char (point-max)))))) - ;; Point is now right after the arg(s). - ;; Erase any syntactic marks within the quoted text. - (put-text-property pos (1- (point)) 'syntax-table nil) - (when (eq (char-before (1- (point))) ?$) - (put-text-property (- (point) 2) (1- (point)) - 'syntax-table '(1))) - (put-text-property (1- (point)) (point) - 'syntax-table (if close '(15) '(7))))))) - - (setq state (parse-partial-sexp (point) limit nil nil state - 'syntax-table)))) - ;; Tell font-lock that this needs not further processing. - nil) - + (cond + ((or (null (setq char (nth 3 state))) + (and (characterp char) (eq (char-syntax (nth 3 state)) ?\"))) + ;; Normal text, or comment, or docstring, or normal string. + nil) + ((eq (nth 3 state) ?\n) + ;; A `format' command. + (when (re-search-forward "^\\s *\\.\\s *\n" limit 'move) + (put-text-property (1- (point)) (point) + 'syntax-table (string-to-syntax "\"")))) + (t + ;; This is regexp like quote thingy. + (setq char (char-after (nth 8 state))) + (let ((twoargs (save-excursion + (goto-char (nth 8 state)) + (skip-syntax-backward " ") + (skip-syntax-backward "w") + (member (buffer-substring + (point) (progn (forward-word 1) (point))) + '("tr" "s" "y")))) + (close (cdr (assq char perl-quote-like-pairs))) + (st (perl-quote-syntax-table char))) + (when (with-syntax-table st + (if close + ;; For paired delimiters, Perl allows nesting them, but + ;; since we treat them as strings, Emacs does not count + ;; those delimiters in `state', so we don't know how deep + ;; we are: we have to go back to the beginning of this + ;; "string" and count from there. + (condition-case nil + (progn + ;; Start after the first char since it doesn't have + ;; paren-syntax (an alternative would be to let-bind + ;; parse-sexp-lookup-properties). + (goto-char (1+ (nth 8 state))) + (up-list 1) + t) + (scan-error nil)) + (not (or (nth 8 (parse-partial-sexp + (point) limit nil nil state 'syntax-table)) + ;; If we have a self-paired opener and a twoargs + ;; command, the form is s/../../ so we have to skip + ;; a second time. + ;; In the case of s{...}{...}, we only handle the + ;; first part here and the next below. + (when (and twoargs (not close)) + (nth 8 (parse-partial-sexp + (point) limit + nil nil state 'syntax-table))))))) + ;; Point is now right after the arg(s). + (when (eq (char-before (1- (point))) ?$) + (put-text-property (- (point) 2) (1- (point)) + 'syntax-table '(1))) + (put-text-property (1- (point)) (point) + 'syntax-table + (if close + (string-to-syntax "|") + (string-to-syntax "\""))) + ;; If we have two args with a non-self-paired starter (e.g. + ;; s{...}{...}) we're right after the first arg, so we still have to + ;; handle the second part. + (when (and twoargs close) + ;; Skip whitespace and make sure that font-lock will + ;; refontify the second part in the proper context. + (put-text-property + (point) (progn (forward-comment (point-max)) (point)) + 'syntax-multiline t) + ;; + (when (< (point) limit) + (put-text-property (point) (1+ (point)) + 'syntax-table + (if (assoc (char-after) + perl-quote-like-pairs) + ;; Put an `e' in the cdr to mark this + ;; char as "second arg starter". + (string-to-syntax "|e") + (string-to-syntax "\"e"))) + (forward-char 1) + ;; Re-use perl-syntax-propertize-special-constructs to handle the + ;; second part (the first delimiter of second part can't be + ;; preceded by "s" or "tr" or "y", so it will not be considered + ;; as twoarg). + (perl-syntax-propertize-special-constructs limit))))))))) + +(defun perl-font-lock-syntactic-face-function (state) + (cond + ((and (nth 3 state) + (eq ?e (cdr-safe (get-text-property (nth 8 state) 'syntax-table))) + ;; This is a second-arg of s{..}{...} form; let's check if this second + ;; arg is executable code rather than a string. For that, we need to + ;; look for an "e" after this second arg, so we have to hunt for the + ;; end of the arg. Depending on whether the whole arg has already + ;; been syntax-propertized or not, the end-char will have different + ;; syntaxes, so let's ignore syntax-properties temporarily so we can + ;; pretend it has not been syntax-propertized yet. + (let* ((parse-sexp-lookup-properties nil) + (char (char-after (nth 8 state))) + (paired (assq char perl-quote-like-pairs))) + (with-syntax-table (perl-quote-syntax-table char) + (save-excursion + (if (not paired) + (parse-partial-sexp (point) (point-max) + nil nil state 'syntax-table) + (condition-case nil + (progn + (goto-char (1+ (nth 8 state))) + (up-list 1)) + (scan-error (goto-char (point-max))))) + (put-text-property (nth 8 state) (point) + 'jit-lock-defer-multiline t) + (looking-at "[ \t]*\\sw*e"))))) + nil) + (t (funcall (default-value 'font-lock-syntactic-face-function) state)))) (defcustom perl-indent-level 4 "*Indentation of Perl statements with respect to containing block." @@ -574,9 +619,12 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'." perl-font-lock-keywords-1 perl-font-lock-keywords-2) nil nil ((?\_ . "w")) nil - (font-lock-syntactic-keywords - . perl-font-lock-syntactic-keywords) - (parse-sexp-lookup-properties . t))) + (font-lock-syntactic-face-function + . perl-font-lock-syntactic-face-function))) + (set (make-local-variable 'syntax-propertize-function) + #'perl-syntax-propertize-function) + (add-hook 'syntax-propertize-extend-region-functions + #'syntax-propertize-multiline 'append 'local) ;; Tell imenu how to handle Perl. (set (make-local-variable 'imenu-generic-expression) perl-imenu-generic-expression) diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index 64277dc4f82..77e334ca8d8 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -31,7 +31,7 @@ (defvar comint-prompt-regexp) (defvar comint-process-echoes) -(defvar smie-indent-basic) +(require 'smie) (defgroup prolog nil "Major mode for editing and running Prolog under Emacs." diff --git a/lisp/progmodes/ps-mode.el b/lisp/progmodes/ps-mode.el index 387a0cb6e00..9b83f77d3b8 100644 --- a/lisp/progmodes/ps-mode.el +++ b/lisp/progmodes/ps-mode.el @@ -6,7 +6,7 @@ ;; Author: Peter Kleiweg <p.c.j.kleiweg@rug.nl> ;; Maintainer: Peter Kleiweg <p.c.j.kleiweg@rug.nl> ;; Created: 20 Aug 1997 -;; Version: 1.1h, 16 Jun 2005 +;; Version: 1.1h ;; Keywords: PostScript, languages ;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index 2b09e346331..10e852223ce 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -166,29 +166,32 @@ symbol-end) . font-lock-builtin-face))) -(defconst python-font-lock-syntactic-keywords +(defconst python-syntax-propertize-function ;; Make outer chars of matching triple-quote sequences into generic ;; string delimiters. Fixme: Is there a better way? ;; First avoid a sequence preceded by an odd number of backslashes. - `((,(rx (not (any ?\\)) - ?\\ (* (and ?\\ ?\\)) - (group (syntax string-quote)) - (backref 1) - (group (backref 1))) - (2 ,(string-to-syntax "\""))) ; dummy - (,(rx (group (optional (any "uUrR"))) ; prefix gets syntax property - (optional (any "rR")) ; possible second prefix - (group (syntax string-quote)) ; maybe gets property - (backref 2) ; per first quote - (group (backref 2))) ; maybe gets property - (1 (python-quote-syntax 1)) - (2 (python-quote-syntax 2)) - (3 (python-quote-syntax 3))) - ;; This doesn't really help. -;;; (,(rx (and ?\\ (group ?\n))) (1 " ")) - )) - -(defun python-quote-syntax (n) + (syntax-propertize-rules + (;; (rx (not (any ?\\)) + ;; ?\\ (* (and ?\\ ?\\)) + ;; (group (syntax string-quote)) + ;; (backref 1) + ;; (group (backref 1))) + ;; ¡Backrefs don't work in syntax-propertize-rules! + "[^\\]\\\\\\(\\\\\\\\\\)*\\(?:''\\('\\)\\|\"\"\\(?2:\"\\)\\)" + (2 "\"")) ; dummy + (;; (rx (optional (group (any "uUrR"))) ; prefix gets syntax property + ;; (optional (any "rR")) ; possible second prefix + ;; (group (syntax string-quote)) ; maybe gets property + ;; (backref 2) ; per first quote + ;; (group (backref 2))) ; maybe gets property + ;; ¡Backrefs don't work in syntax-propertize-rules! + "\\([RUru]\\)?[Rr]?\\(?:\\('\\)'\\('\\)\\|\\(?2:\"\\)\"\\(?3:\"\\)\\)" + (3 (ignore (python-quote-syntax)))) + ;; This doesn't really help. + ;;((rx (and ?\\ (group ?\n))) (1 " ")) + )) + +(defun python-quote-syntax () "Put `syntax-table' property correctly on triple quote. Used for syntactic keywords. N is the match number (1, 2 or 3)." ;; Given a triple quote, we have to check the context to know @@ -206,28 +209,25 @@ Used for syntactic keywords. N is the match number (1, 2 or 3)." ;; x '"""' x """ \"""" x (save-excursion (goto-char (match-beginning 0)) - (cond - ;; Consider property for the last char if in a fenced string. - ((= n 3) - (let* ((font-lock-syntactic-keywords nil) - (syntax (syntax-ppss))) - (when (eq t (nth 3 syntax)) ; after unclosed fence - (goto-char (nth 8 syntax)) ; fence position - (skip-chars-forward "uUrR") ; skip any prefix - ;; Is it a matching sequence? - (if (eq (char-after) (char-after (match-beginning 2))) - (eval-when-compile (string-to-syntax "|")))))) - ;; Consider property for initial char, accounting for prefixes. - ((or (and (= n 2) ; leading quote (not prefix) - (= (match-beginning 1) (match-end 1))) ; prefix is null - (and (= n 1) ; prefix - (/= (match-beginning 1) (match-end 1)))) ; non-empty - (let ((font-lock-syntactic-keywords nil)) - (unless (eq 'string (syntax-ppss-context (syntax-ppss))) - (eval-when-compile (string-to-syntax "|"))))) - ;; Otherwise (we're in a non-matching string) the property is - ;; nil, which is OK. - ))) + (let ((syntax (save-match-data (syntax-ppss)))) + (cond + ((eq t (nth 3 syntax)) ; after unclosed fence + ;; Consider property for the last char if in a fenced string. + (goto-char (nth 8 syntax)) ; fence position + (skip-chars-forward "uUrR") ; skip any prefix + ;; Is it a matching sequence? + (if (eq (char-after) (char-after (match-beginning 2))) + (put-text-property (match-beginning 3) (match-end 3) + 'syntax-table (string-to-syntax "|")))) + ((match-end 1) + ;; Consider property for initial char, accounting for prefixes. + (put-text-property (match-beginning 1) (match-end 1) + 'syntax-table (string-to-syntax "|"))) + (t + ;; Consider property for initial char, accounting for prefixes. + (put-text-property (match-beginning 2) (match-end 2) + 'syntax-table (string-to-syntax "|")))) + ))) ;; This isn't currently in `font-lock-defaults' as probably not worth ;; it -- we basically only mess with a few normally-symbol characters. @@ -579,6 +579,33 @@ having to restart the program." "Queue of Python temp files awaiting execution. Currently-active file is at the head of the list.") +(defcustom python-shell-prompt-alist + '(("ipython" . "^In \\[[0-9]+\\]: *") + (t . "^>>> ")) + "Alist of Python input prompts. +Each element has the form (PROGRAM . REGEXP), where PROGRAM is +the value of `python-python-command' for the python process and +REGEXP is a regular expression matching the Python prompt. +PROGRAM can also be t, which specifies the default when no other +element matches `python-python-command'." + :type 'string + :group 'python + :version "24.1") + +(defcustom python-shell-continuation-prompt-alist + '(("ipython" . "^ [.][.][.]+: *") + (t . "^[.][.][.] ")) + "Alist of Python continued-line prompts. +Each element has the form (PROGRAM . REGEXP), where PROGRAM is +the value of `python-python-command' for the python process and +REGEXP is a regular expression matching the Python prompt for +continued lines. +PROGRAM can also be t, which specifies the default when no other +element matches `python-python-command'." + :type 'string + :group 'python + :version "24.1") + (defvar python-pdbtrack-is-tracking-p nil) (defconst python-pdbtrack-stack-entry-regexp @@ -755,7 +782,7 @@ Set `python-indent' locally to the value guessed." '(("else" "if" "elif" "while" "for" "try" "except") ("elif" "if" "elif") ("except" "try" "except") - ("finally" "try" "except")) + ("finally" "else" "try" "except")) "Alist of keyword matches. The car of an element is a keyword introducing a statement which can close a block opened by a keyword in the cdr.") @@ -1311,13 +1338,9 @@ See `python-check-command' for the default." ;;;; Inferior mode stuff (following cmuscheme). -;; Fixme: Make sure we can work with IPython. - (defcustom python-python-command "python" "Shell command to run Python interpreter. -Any arguments can't contain whitespace. -Note that IPython may not work properly; it must at least be used -with the `-cl' flag, i.e. use `ipython -cl'." +Any arguments can't contain whitespace." :group 'python :type 'string) @@ -1395,6 +1418,23 @@ local value.") ;; Autoloaded. (declare-function compilation-shell-minor-mode "compile" (&optional arg)) +(defvar python--prompt-regexp nil) + +(defun python--set-prompt-regexp () + (let ((prompt (cdr-safe (or (assoc python-python-command + python-shell-prompt-alist) + (assq t python-shell-prompt-alist)))) + (cprompt (cdr-safe (or (assoc python-python-command + python-shell-continuation-prompt-alist) + (assq t python-shell-continuation-prompt-alist))))) + (set (make-local-variable 'comint-prompt-regexp) + (concat "\\(" + (mapconcat 'identity + (delq nil (list prompt cprompt "^([Pp]db) ")) + "\\|") + "\\)")) + (set (make-local-variable 'python--prompt-regexp) prompt))) + ;; Fixme: This should inherit some stuff from `python-mode', but I'm ;; not sure how much: at least some keybindings, like C-c C-f; ;; syntax?; font-locking, e.g. for triple-quoted strings? @@ -1417,14 +1457,12 @@ For running multiple processes in multiple buffers, see `run-python' and \\{inferior-python-mode-map}" :group 'python + (require 'ansi-color) ; for ipython (setq mode-line-process '(":%s")) (set (make-local-variable 'comint-input-filter) 'python-input-filter) (add-hook 'comint-preoutput-filter-functions #'python-preoutput-filter nil t) - ;; Still required by `comint-redirect-send-command', for instance - ;; (and we need to match things like `>>> ... >>> '): - (set (make-local-variable 'comint-prompt-regexp) - (rx line-start (1+ (and (or (repeat 3 (any ">.")) "(Pdb)") " ")))) + (python--set-prompt-regexp) (set (make-local-variable 'compilation-error-regexp-alist) python-compilation-regexp-alist) (compilation-shell-minor-mode 1)) @@ -1521,12 +1559,12 @@ Don't save anything for STR matching `inferior-python-filter-regexp'." cmd))) (unless (shell-command-to-string cmd) (error "Can't run Python command `%s'" cmd)) - (let* ((res (shell-command-to-string (concat cmd " --version")))) - (string-match "Python \\([0-9]\\)\\.\\([0-9]\\)" res) - (unless (and (equal "2" (match-string 1 res)) - (match-beginning 2) - (>= (string-to-number (match-string 2 res)) 2)) - (error "Only Python versions >= 2.2 and < 3.0 supported"))) + (let* ((res (shell-command-to-string + (concat cmd + " -c \"from sys import version_info;\ +print version_info >= (2, 2) and version_info < (3, 0)\"")))) + (unless (string-match "True" res) + (error "Only Python versions >= 2.2 and < 3.0 are supported"))) (setq python-version-checked t))) ;;;###autoload @@ -1549,6 +1587,7 @@ buffer for a list of commands.)" (interactive (if current-prefix-arg (list (read-string "Run Python: " python-command) nil t) (list python-command))) + (require 'ansi-color) ; for ipython (unless cmd (setq cmd python-command)) (python-check-version cmd) (setq python-command cmd) @@ -1566,8 +1605,10 @@ buffer for a list of commands.)" (if path (concat path path-separator)) data-directory) process-environment)) - ;; Suppress use of pager for help output: - (process-connection-type nil)) + ;; If we use a pipe, unicode characters are not printed + ;; correctly (Bug#5794) and IPython does not work at + ;; all (Bug#5390). + (process-connection-type t)) (apply 'make-comint-in-buffer "Python" (generate-new-buffer "*Python*") (car cmdlist) nil (cdr cmdlist))) @@ -1623,7 +1664,12 @@ buffer for a list of commands.)" ;; non-ASCII. (interactive "r") (let* ((f (make-temp-file "py")) - (command (format "emacs.eexecfile(%S)" f)) + (command + ;; IPython puts the FakeModule module into __main__ so + ;; emacs.eexecfile becomes useless. + (if (string-match "^ipython" python-command) + (format "execfile %S" f) + (format "emacs.eexecfile(%S)" f))) (orig-start (copy-marker start))) (when (save-excursion (goto-char start) @@ -1823,7 +1869,9 @@ If there isn't, it's probably not appropriate to send input to return Eldoc information etc. If PROC is non-nil, check the buffer for that process." (with-current-buffer (process-buffer (or proc (python-proc))) (save-excursion - (save-match-data (re-search-backward ">>> \\=" nil t))))) + (save-match-data + (re-search-backward (concat python--prompt-regexp " *\\=") + nil t))))) ;; Fixme: Is there anything reasonable we can do with random methods? ;; (Currently only works with functions.) @@ -2237,6 +2285,7 @@ the if condition." (eval-when-compile ;; Define a user-level skeleton and add it to the abbrev table. (defmacro def-python-skeleton (name &rest elements) + (declare (indent 2)) (let* ((name (symbol-name name)) (function (intern (concat "python-insert-" name)))) `(progn @@ -2249,7 +2298,6 @@ the if condition." (define-skeleton ,function ,(format "Insert Python \"%s\" template." name) ,@elements))))) -(put 'def-python-skeleton 'lisp-indent-function 2) ;; From `skeleton-further-elements' set below: ;; `<': outdent a level; @@ -2447,12 +2495,12 @@ with skeleton expansions for compound statement templates. :group 'python (set (make-local-variable 'font-lock-defaults) '(python-font-lock-keywords nil nil nil nil - (font-lock-syntactic-keywords - . python-font-lock-syntactic-keywords) - ;; This probably isn't worth it. - ;; (font-lock-syntactic-face-function - ;; . python-font-lock-syntactic-face-function) - )) + ;; This probably isn't worth it. + ;; (font-lock-syntactic-face-function + ;; . python-font-lock-syntactic-face-function) + )) + (set (make-local-variable 'syntax-propertize-function) + python-syntax-propertize-function) (set (make-local-variable 'parse-sexp-lookup-properties) t) (set (make-local-variable 'parse-sexp-ignore-comments) t) (set (make-local-variable 'comment-start) "# ") @@ -2539,9 +2587,7 @@ Runs `jython-mode-hook' after `python-mode-hook'." "Watch output for Python prompt and exec next file waiting in queue. This function is appropriate for `comint-output-filter-functions'." ;; TBD: this should probably use split-string - (when (and (or (string-equal string ">>> ") - (and (>= (length string) 5) - (string-equal (substring string -5) "\n>>> "))) + (when (and (string-match python--prompt-regexp string) python-file-queue) (condition-case nil (delete-file (car python-file-queue)) @@ -2753,6 +2799,7 @@ comint believe the user typed this string so that (funcall (process-filter proc) proc msg)) (set-buffer curbuf)) (process-send-string proc cmd))) + ;;;###autoload (defun python-shell (&optional argprompt) "Start an interactive Python interpreter in another window. @@ -2792,6 +2839,7 @@ interaction between undo and process filters; the same problem exists in non-Python process buffers using the default (Emacs-supplied) process filter." (interactive "P") + (require 'ansi-color) ; For ipython ;; Set the default shell if not already set (when (null python-which-shell) (python-toggle-shells python-default-interpreter)) @@ -2808,10 +2856,9 @@ filter." )))) (switch-to-buffer-other-window (apply 'make-comint python-which-bufname python-which-shell nil args)) - (make-local-variable 'comint-prompt-regexp) (set-process-sentinel (get-buffer-process (current-buffer)) 'python-sentinel) - (setq comint-prompt-regexp "^>>> \\|^[.][.][.] \\|^(pdb) ") + (python--set-prompt-regexp) (add-hook 'comint-output-filter-functions 'python-comint-output-filter-function nil t) ;; pdbtrack diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index a75c5b01bb8..4d015de5198 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -43,6 +43,11 @@ (eval-when-compile (require 'cl)) +(defgroup ruby nil + "Major mode for editing Ruby code." + :prefix "ruby-" + :group 'languages) + (defconst ruby-keyword-end-re (if (string-match "\\_>" "ruby") "\\_>" @@ -95,17 +100,10 @@ (defconst ruby-block-end-re "\\<end\\>") -(defconst ruby-here-doc-beg-re +(eval-and-compile + (defconst ruby-here-doc-beg-re "\\(<\\)<\\(-\\)?\\(\\([a-zA-Z0-9_]+\\)\\|[\"]\\([^\"]+\\)[\"]\\|[']\\([^']+\\)[']\\)" - "Regexp to match the beginning of a heredoc.") - -(defconst ruby-here-doc-end-re - "^\\([ \t]+\\)?\\(.*\\)\\(.\\)$" - "Regexp to match the end of heredocs. - -This will actually match any line with one or more characters. -It's useful in that it divides up the match string so that -`ruby-here-doc-beg-match' can search for the beginning of the heredoc.") + "Regexp to match the beginning of a heredoc.")) (defun ruby-here-doc-end-match () "Return a regexp to find the end of a heredoc. @@ -118,18 +116,6 @@ This should only be called after matching against `ruby-here-doc-beg-re'." (match-string 5) (match-string 6))))) -(defun ruby-here-doc-beg-match () - "Return a regexp to find the beginning of a heredoc. - -This should only be called after matching against `ruby-here-doc-end-re'." - (let ((contents (regexp-quote (concat (match-string 2) (match-string 3))))) - (concat "<<" - (let ((match (match-string 1))) - (if (and match (> (length match) 0)) - (concat "\\(?:-\\([\"']?\\)\\|\\([\"']\\)" (match-string 1) "\\)" - contents "\\b\\(\\1\\|\\2\\)") - (concat "-?\\([\"']\\|\\)" contents "\\b\\1")))))) - (defconst ruby-delimiter (concat "[?$/%(){}#\"'`.:]\\|<<\\|\\[\\|\\]\\|\\<\\(" ruby-block-beg-re @@ -357,7 +343,7 @@ Also ignores spaces after parenthesis when 'space." (back-to-indentation) (current-column))) -(defun ruby-indent-line (&optional flag) +(defun ruby-indent-line (&optional ignored) "Correct the indentation of the current Ruby line." (interactive) (ruby-indent-to (ruby-calculate-indent))) @@ -400,8 +386,7 @@ and `\\' when preceded by `?'." "TODO: document." (save-excursion (store-match-data nil) - (let ((space (skip-chars-backward " \t")) - (start (point))) + (let ((space (skip-chars-backward " \t"))) (cond ((bolp) t) ((progn @@ -695,7 +680,7 @@ and `\\' when preceded by `?'." (beginning-of-line) (let ((ruby-indent-point (point)) (case-fold-search nil) - state bol eol begin op-end + state eol begin op-end (paren (progn (skip-syntax-forward " ") (and (char-after) (matching-paren (char-after))))) (indent 0)) @@ -775,7 +760,6 @@ and `\\' when preceded by `?'." (if (re-search-forward "^\\s *#" end t) (beginning-of-line) (setq done t)))) - (setq bol (point)) (end-of-line) ;; skip the comment at the end (skip-chars-backward " \t") @@ -1032,10 +1016,8 @@ With ARG, do it many times. Negative ARG means move forward." (ruby-beginning-of-defun) (re-search-backward "^\n" (- (point) 1) t)) -(defun ruby-indent-exp (&optional shutup-p) - "Indent each line in the balanced expression following the point. -If a prefix arg is given or SHUTUP-P is non-nil, no errors -are signalled if a balanced expression isn't found." +(defun ruby-indent-exp (&optional ignored) + "Indent each line in the balanced expression following the point." (interactive "*P") (let ((here (point-marker)) start top column (nest t)) (set-marker-insertion-type here t) @@ -1128,58 +1110,208 @@ See `add-log-current-defun-function'." (if mlist (concat mlist mname) mname) mlist))))) -(defconst ruby-font-lock-syntactic-keywords - `(;; #{ }, #$hoge, #@foo are not comments - ("\\(#\\)[{$@]" 1 (1 . nil)) - ;; the last $', $", $` in the respective string is not variable - ;; the last ?', ?", ?` in the respective string is not ascii code - ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)" - (2 (7 . nil)) - (4 (7 . nil))) - ;; $' $" $` .... are variables - ;; ?' ?" ?` are ascii codes - ("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" 3 (1 . nil)) - ;; regexps - ("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)" - (4 (7 . ?/)) - (6 (7 . ?/))) - ("^=en\\(d\\)\\_>" 1 "!") - ("^\\(=\\)begin\\_>" 1 (ruby-comment-beg-syntax)) - ;; Currently, the following case is highlighted incorrectly: - ;; - ;; <<FOO - ;; FOO - ;; <<BAR - ;; <<BAZ - ;; BAZ - ;; BAR - ;; - ;; This is because all here-doc beginnings are highlighted before any endings, - ;; so although <<BAR is properly marked as a beginning, when we get to <<BAZ - ;; it thinks <<BAR is part of a string so it's marked as well. - ;; - ;; This may be fixable by modifying ruby-in-here-doc-p to use - ;; ruby-in-non-here-doc-string-p rather than syntax-ppss-context, - ;; but I don't want to try that until we've got unit tests set up - ;; to make sure I don't break anything else. - (,(concat ruby-here-doc-beg-re ".*\\(\n\\)") - ,(+ 1 (regexp-opt-depth ruby-here-doc-beg-re)) - (ruby-here-doc-beg-syntax)) - (,ruby-here-doc-end-re 3 (ruby-here-doc-end-syntax))) - "Syntactic keywords for Ruby mode. See `font-lock-syntactic-keywords'.") - -(defun ruby-comment-beg-syntax () - "Return the syntax cell for a the first character of a =begin. +(if (eval-when-compile (fboundp #'syntax-propertize-rules)) + ;; New code that works independently from font-lock. + (progn + (defun ruby-syntax-propertize-function (start end) + "Syntactic keywords for Ruby mode. See `syntax-propertize-function'." + (goto-char start) + (ruby-syntax-propertize-heredoc end) + (funcall + (syntax-propertize-rules + ;; #{ }, #$hoge, #@foo are not comments + ("\\(#\\)[{$@]" (1 ".")) + ;; the last $', $", $` in the respective string is not variable + ;; the last ?', ?", ?` in the respective string is not ascii code + ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)" + (2 "\"") + (4 "\"")) + ;; $' $" $` .... are variables + ;; ?' ?" ?` are ascii codes + ("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" (3 ".")) + ;; regexps + ("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)" + (4 "\"/") + (6 "\"/")) + ("^=en\\(d\\)\\_>" (1 "!")) + ("^\\(=\\)begin\\_>" (1 "!")) + ;; Handle here documents. + ((concat ruby-here-doc-beg-re ".*\\(\n\\)") + (7 (prog1 "\"" (ruby-syntax-propertize-heredoc end))))) + (point) end)) + + (defun ruby-syntax-propertize-heredoc (limit) + (let ((ppss (syntax-ppss)) + (res '())) + (when (eq ?\n (nth 3 ppss)) + (save-excursion + (goto-char (nth 8 ppss)) + (beginning-of-line) + (while (re-search-forward ruby-here-doc-beg-re + (line-end-position) t) + (push (concat (ruby-here-doc-end-match) "\n") res))) + (let ((start (point))) + ;; With multiple openers on the same line, we don't know in which + ;; part `start' is, so we have to go back to the beginning. + (when (cdr res) + (goto-char (nth 8 ppss)) + (setq res (nreverse res))) + (while (and res (re-search-forward (pop res) limit 'move)) + (if (null res) + (put-text-property (1- (point)) (point) + 'syntax-table (string-to-syntax "\"")))) + ;; Make extra sure we don't move back, lest we could fall into an + ;; inf-loop. + (if (< (point) start) (goto-char start)))))) + ) + + ;; For Emacsen where syntax-propertize-rules is not (yet) available, + ;; fallback on the old font-lock-syntactic-keywords stuff. + + (defconst ruby-here-doc-end-re + "^\\([ \t]+\\)?\\(.*\\)\\(\n\\)" + "Regexp to match the end of heredocs. + +This will actually match any line with one or more characters. +It's useful in that it divides up the match string so that +`ruby-here-doc-beg-match' can search for the beginning of the heredoc.") + + (defun ruby-here-doc-beg-match () + "Return a regexp to find the beginning of a heredoc. + +This should only be called after matching against `ruby-here-doc-end-re'." + (let ((contents (regexp-quote (match-string 2)))) + (concat "<<" + (let ((match (match-string 1))) + (if (and match (> (length match) 0)) + (concat "\\(?:-\\([\"']?\\)\\|\\([\"']\\)" match "\\)" + contents "\\b\\(\\1\\|\\2\\)") + (concat "-?\\([\"']\\|\\)" contents "\\b\\1")))))) + + (defconst ruby-font-lock-syntactic-keywords + `( ;; #{ }, #$hoge, #@foo are not comments + ("\\(#\\)[{$@]" 1 (1 . nil)) + ;; the last $', $", $` in the respective string is not variable + ;; the last ?', ?", ?` in the respective string is not ascii code + ("\\(^\\|[\[ \t\n<+\(,=]\\)\\(['\"`]\\)\\(\\\\.\\|\\2\\|[^'\"`\n\\\\]\\)*?\\\\?[?$]\\(\\2\\)" + (2 (7 . nil)) + (4 (7 . nil))) + ;; $' $" $` .... are variables + ;; ?' ?" ?` are ascii codes + ("\\(^\\|[^\\\\]\\)\\(\\\\\\\\\\)*[?$]\\([#\"'`]\\)" 3 (1 . nil)) + ;; regexps + ("\\(^\\|[=(,~?:;<>]\\|\\(^\\|\\s \\)\\(if\\|elsif\\|unless\\|while\\|until\\|when\\|and\\|or\\|&&\\|||\\)\\|g?sub!?\\|scan\\|split!?\\)\\s *\\(/\\)[^/\n\\\\]*\\(\\\\.[^/\n\\\\]*\\)*\\(/\\)" + (4 (7 . ?/)) + (6 (7 . ?/))) + ("^=en\\(d\\)\\_>" 1 "!") + ("^\\(=\\)begin\\_>" 1 (ruby-comment-beg-syntax)) + ;; Currently, the following case is highlighted incorrectly: + ;; + ;; <<FOO + ;; FOO + ;; <<BAR + ;; <<BAZ + ;; BAZ + ;; BAR + ;; + ;; This is because all here-doc beginnings are highlighted before any endings, + ;; so although <<BAR is properly marked as a beginning, when we get to <<BAZ + ;; it thinks <<BAR is part of a string so it's marked as well. + ;; + ;; This may be fixable by modifying ruby-in-here-doc-p to use + ;; ruby-in-non-here-doc-string-p rather than syntax-ppss-context, + ;; but I don't want to try that until we've got unit tests set up + ;; to make sure I don't break anything else. + (,(concat ruby-here-doc-beg-re ".*\\(\n\\)") + ,(+ 1 (regexp-opt-depth ruby-here-doc-beg-re)) + (ruby-here-doc-beg-syntax)) + (,ruby-here-doc-end-re 3 (ruby-here-doc-end-syntax))) + "Syntactic keywords for Ruby mode. See `font-lock-syntactic-keywords'.") + + (defun ruby-comment-beg-syntax () + "Return the syntax cell for a the first character of a =begin. See the definition of `ruby-font-lock-syntactic-keywords'. This returns a comment-delimiter cell as long as the =begin isn't in a string or another comment." - (when (not (nth 3 (syntax-ppss))) - (string-to-syntax "!"))) + (when (not (nth 3 (syntax-ppss))) + (string-to-syntax "!"))) -(unless (functionp 'syntax-ppss) - (defun syntax-ppss (&optional pos) - (parse-partial-sexp (point-min) (or pos (point))))) + (defun ruby-in-here-doc-p () + "Return whether or not the point is in a heredoc." + (save-excursion + (let ((old-point (point)) (case-fold-search nil)) + (beginning-of-line) + (catch 'found-beg + (while (re-search-backward ruby-here-doc-beg-re nil t) + (if (not (or (ruby-in-ppss-context-p 'anything) + (ruby-here-doc-find-end old-point))) + (throw 'found-beg t))))))) + + (defun ruby-here-doc-find-end (&optional limit) + "Expects the point to be on a line with one or more heredoc openers. +Returns the buffer position at which all heredocs on the line +are terminated, or nil if they aren't terminated before the +buffer position `limit' or the end of the buffer." + (save-excursion + (beginning-of-line) + (catch 'done + (let ((eol (save-excursion (end-of-line) (point))) + (case-fold-search nil) + ;; Fake match data such that (match-end 0) is at eol + (end-match-data (progn (looking-at ".*$") (match-data))) + beg-match-data end-re) + (while (re-search-forward ruby-here-doc-beg-re eol t) + (setq beg-match-data (match-data)) + (setq end-re (ruby-here-doc-end-match)) + + (set-match-data end-match-data) + (goto-char (match-end 0)) + (unless (re-search-forward end-re limit t) (throw 'done nil)) + (setq end-match-data (match-data)) + + (set-match-data beg-match-data) + (goto-char (match-end 0))) + (set-match-data end-match-data) + (goto-char (match-end 0)) + (point))))) + + (defun ruby-here-doc-beg-syntax () + "Return the syntax cell for a line that may begin a heredoc. +See the definition of `ruby-font-lock-syntactic-keywords'. + +This sets the syntax cell for the newline ending the line +containing the heredoc beginning so that cases where multiple +heredocs are started on one line are handled correctly." + (save-excursion + (goto-char (match-beginning 0)) + (unless (or (ruby-in-ppss-context-p 'non-heredoc) + (ruby-in-here-doc-p)) + (string-to-syntax "\"")))) + + (defun ruby-here-doc-end-syntax () + "Return the syntax cell for a line that may end a heredoc. +See the definition of `ruby-font-lock-syntactic-keywords'." + (let ((pss (syntax-ppss)) (case-fold-search nil)) + ;; If we aren't in a string, we definitely aren't ending a heredoc, + ;; so we can just give up. + ;; This means we aren't doing a full-document search + ;; every time we enter a character. + (when (ruby-in-ppss-context-p 'heredoc pss) + (save-excursion + (goto-char (nth 8 pss)) ; Go to the beginning of heredoc. + (let ((eol (point))) + (beginning-of-line) + (if (and (re-search-forward (ruby-here-doc-beg-match) eol t) ; If there is a heredoc that matches this line... + (not (ruby-in-ppss-context-p 'anything)) ; And that's not inside a heredoc/string/comment... + (progn (goto-char (match-end 0)) ; And it's the last heredoc on its line... + (not (re-search-forward ruby-here-doc-beg-re eol t)))) + (string-to-syntax "\""))))))) + + (unless (functionp 'syntax-ppss) + (defun syntax-ppss (&optional pos) + (parse-partial-sexp (point-min) (or pos (point))))) + ) (defun ruby-in-ppss-context-p (context &optional ppss) (let ((ppss (or ppss (syntax-ppss (point))))) @@ -1190,10 +1322,7 @@ isn't in a string or another comment." ((eq context 'string) (nth 3 ppss)) ((eq context 'heredoc) - (and (nth 3 ppss) - ;; If it's generic string, it's a heredoc and we don't care - ;; See `parse-partial-sexp' - (not (numberp (nth 3 ppss))))) + (eq ?\n (nth 3 ppss))) ((eq context 'non-heredoc) (and (ruby-in-ppss-context-p 'anything) (not (ruby-in-ppss-context-p 'heredoc)))) @@ -1205,77 +1334,6 @@ isn't in a string or another comment." "context name `" (symbol-name context) "' is unknown")))) t))) -(defun ruby-in-here-doc-p () - "Return whether or not the point is in a heredoc." - (save-excursion - (let ((old-point (point)) (case-fold-search nil)) - (beginning-of-line) - (catch 'found-beg - (while (re-search-backward ruby-here-doc-beg-re nil t) - (if (not (or (ruby-in-ppss-context-p 'anything) - (ruby-here-doc-find-end old-point))) - (throw 'found-beg t))))))) - -(defun ruby-here-doc-find-end (&optional limit) - "Expects the point to be on a line with one or more heredoc openers. -Returns the buffer position at which all heredocs on the line -are terminated, or nil if they aren't terminated before the -buffer position `limit' or the end of the buffer." - (save-excursion - (beginning-of-line) - (catch 'done - (let ((eol (save-excursion (end-of-line) (point))) - (case-fold-search nil) - ;; Fake match data such that (match-end 0) is at eol - (end-match-data (progn (looking-at ".*$") (match-data))) - beg-match-data end-re) - (while (re-search-forward ruby-here-doc-beg-re eol t) - (setq beg-match-data (match-data)) - (setq end-re (ruby-here-doc-end-match)) - - (set-match-data end-match-data) - (goto-char (match-end 0)) - (unless (re-search-forward end-re limit t) (throw 'done nil)) - (setq end-match-data (match-data)) - - (set-match-data beg-match-data) - (goto-char (match-end 0))) - (set-match-data end-match-data) - (goto-char (match-end 0)) - (point))))) - -(defun ruby-here-doc-beg-syntax () - "Return the syntax cell for a line that may begin a heredoc. -See the definition of `ruby-font-lock-syntactic-keywords'. - -This sets the syntax cell for the newline ending the line -containing the heredoc beginning so that cases where multiple -heredocs are started on one line are handled correctly." - (save-excursion - (goto-char (match-beginning 0)) - (unless (or (ruby-in-ppss-context-p 'non-heredoc) - (ruby-in-here-doc-p)) - (string-to-syntax "|")))) - -(defun ruby-here-doc-end-syntax () - "Return the syntax cell for a line that may end a heredoc. -See the definition of `ruby-font-lock-syntactic-keywords'." - (let ((pss (syntax-ppss)) (case-fold-search nil)) - ;; If we aren't in a string, we definitely aren't ending a heredoc, - ;; so we can just give up. - ;; This means we aren't doing a full-document search - ;; every time we enter a character. - (when (ruby-in-ppss-context-p 'heredoc pss) - (save-excursion - (goto-char (nth 8 pss)) ; Go to the beginning of heredoc. - (let ((eol (point))) - (beginning-of-line) - (if (and (re-search-forward (ruby-here-doc-beg-match) eol t) ; If there is a heredoc that matches this line... - (not (ruby-in-ppss-context-p 'anything)) ; And that's not inside a heredoc/string/comment... - (progn (goto-char (match-end 0)) ; And it's the last heredoc on its line... - (not (re-search-forward ruby-here-doc-beg-re eol t)))) - (string-to-syntax "|"))))))) - (if (featurep 'xemacs) (put 'ruby-mode 'font-lock-defaults '((ruby-font-lock-keywords) @@ -1372,8 +1430,10 @@ See `font-lock-syntax-table'.") ) "Additional expressions to highlight in Ruby mode.") +(defvar electric-indent-chars) + ;;;###autoload -(defun ruby-mode () +(define-derived-mode ruby-mode prog-mode "Ruby" "Major mode for editing Ruby scripts. \\[ruby-indent-line] properly indents subexpressions of multi-line class, module, def, if, while, for, do, and case statements, taking @@ -1382,27 +1442,22 @@ nesting into account. The variable `ruby-indent-level' controls the amount of indentation. \\{ruby-mode-map}" - (interactive) - (kill-all-local-variables) - (use-local-map ruby-mode-map) - (setq mode-name "Ruby") - (setq major-mode 'ruby-mode) (ruby-mode-variables) - (set (make-local-variable 'indent-line-function) - 'ruby-indent-line) (set (make-local-variable 'imenu-create-index-function) 'ruby-imenu-create-index) (set (make-local-variable 'add-log-current-defun-function) 'ruby-add-log-current-method) (add-hook - (cond ((boundp 'before-save-hook) - (make-local-variable 'before-save-hook) - 'before-save-hook) + (cond ((boundp 'before-save-hook) 'before-save-hook) ((boundp 'write-contents-functions) 'write-contents-functions) ((boundp 'write-contents-hooks) 'write-contents-hooks)) - 'ruby-mode-set-encoding) + 'ruby-mode-set-encoding nil 'local) + + (set (make-local-variable 'electric-indent-chars) + (append '(?\{ ?\}) (if (boundp 'electric-indent-chars) + (default-value 'electric-indent-chars)))) (set (make-local-variable 'font-lock-defaults) '((ruby-font-lock-keywords) nil nil)) @@ -1410,12 +1465,12 @@ The variable `ruby-indent-level' controls the amount of indentation. ruby-font-lock-keywords) (set (make-local-variable 'font-lock-syntax-table) ruby-font-lock-syntax-table) - (set (make-local-variable 'font-lock-syntactic-keywords) - ruby-font-lock-syntactic-keywords) - (if (fboundp 'run-mode-hooks) - (run-mode-hooks 'ruby-mode-hook) - (run-hooks 'ruby-mode-hook))) + (if (eval-when-compile (fboundp 'syntax-propertize-rules)) + (set (make-local-variable 'syntax-propertize-function) + #'ruby-syntax-propertize-function) + (set (make-local-variable 'font-lock-syntactic-keywords) + ruby-font-lock-syntactic-keywords))) ;;; Invoke ruby-mode when appropriate diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index ce8a34220e4..da143db5ffb 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -107,7 +107,7 @@ ;; Special characters (modify-syntax-entry ?, "' " st) (modify-syntax-entry ?@ "' " st) - (modify-syntax-entry ?# "' 14b" st) + (modify-syntax-entry ?# "' 14" st) (modify-syntax-entry ?\\ "\\ " st) st)) diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 5f4028af89a..d41a81e38a6 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -939,7 +939,6 @@ See `sh-feature'.") ;; These are used for the syntax table stuff (derived from cperl-mode). ;; Note: parse-sexp-lookup-properties must be set to t for it to work. (defconst sh-st-punc (string-to-syntax ".")) -(defconst sh-st-symbol (string-to-syntax "_")) (defconst sh-here-doc-syntax (string-to-syntax "|")) ;; generic string (defconst sh-escaped-line-re @@ -957,7 +956,7 @@ See `sh-feature'.") (defvar sh-here-doc-re sh-here-doc-open-re) (make-variable-buffer-local 'sh-here-doc-re) -(defun sh-font-lock-close-heredoc (bol eof indented) +(defun sh-font-lock-close-heredoc (bol eof indented eol) "Determine the syntax of the \\n after an EOF. If non-nil INDENTED indicates that the EOF was indented." (let* ((eof-re (if eof (regexp-quote eof) "")) @@ -971,6 +970,8 @@ If non-nil INDENTED indicates that the EOF was indented." (ere (concat "^" (if indented "[ \t]*") eof-re "\n")) (start (save-excursion (goto-char bol) + ;; FIXME: will incorrectly find a <<EOF embedded inside + ;; the heredoc. (re-search-backward (concat sre "\\|" ere) nil t)))) ;; If subgroup 1 matched, we found an open-heredoc, otherwise we first ;; found a close-heredoc which makes the current close-heredoc inoperant. @@ -990,7 +991,7 @@ If non-nil INDENTED indicates that the EOF was indented." (sh-in-comment-or-string (point))))) ;; No <<EOF2 found after our <<. (= (point) start))) - sh-here-doc-syntax) + (put-text-property eol (1+ eol) 'syntax-table sh-here-doc-syntax)) ((not (or start (save-excursion (re-search-forward sre nil t)))) ;; There's no <<EOF either before or after us, ;; so we should remove ourselves from font-lock's keywords. @@ -1000,7 +1001,7 @@ If non-nil INDENTED indicates that the EOF was indented." (regexp-opt sh-here-doc-markers t) "\\(\n\\)")) nil)))) -(defun sh-font-lock-open-heredoc (start string) +(defun sh-font-lock-open-heredoc (start string eol) "Determine the syntax of the \\n after a <<EOF. START is the position of <<. STRING is the actual word used as delimiter (e.g. \"EOF\"). @@ -1030,13 +1031,8 @@ Point is at the beginning of the next line." ;; Don't bother fixing it now, but place a multiline property so ;; that when jit-lock-context-* refontifies the rest of the ;; buffer, it also refontifies the current line with it. - (put-text-property start (point) 'font-lock-multiline t))) - sh-here-doc-syntax)) - -(defun sh-font-lock-here-doc (limit) - "Search for a heredoc marker." - ;; This looks silly, but it's because `sh-here-doc-re' keeps changing. - (re-search-forward sh-here-doc-re limit t)) + (put-text-property start (point) 'syntax-multiline t))) + (put-text-property eol (1+ eol) 'syntax-table sh-here-doc-syntax))) (defun sh-font-lock-quoted-subshell (limit) "Search for a subshell embedded in a string. @@ -1045,9 +1041,7 @@ subshells can nest." ;; FIXME: This can (and often does) match multiple lines, yet it makes no ;; effort to handle multiline cases correctly, so it ends up being ;; rather flakey. - (when (and (re-search-forward "\"\\(?:\\(?:.\\|\n\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)" limit t) - ;; Make sure the " we matched is an opening quote. - (eq ?\" (nth 3 (syntax-ppss)))) + (when (eq ?\" (nth 3 (syntax-ppss))) ; Check we matched an opening quote. ;; bingo we have a $( or a ` inside a "" (let ((char (char-after (point))) ;; `state' can be: double-quote, backquote, code. @@ -1082,8 +1076,7 @@ subshells can nest." (double-quote nil) (t (setq state (pop states))))) (t (error "Internal error in sh-font-lock-quoted-subshell"))) - (forward-char 1))) - t)) + (forward-char 1))))) (defun sh-is-quoted-p (pos) @@ -1122,7 +1115,7 @@ subshells can nest." (when (progn (backward-char 2) (if (> start (line-end-position)) (put-text-property (point) (1+ start) - 'font-lock-multiline t)) + 'syntax-multiline t)) ;; FIXME: The `in' may just be a random argument to ;; a normal command rather than the real `in' keyword. ;; I.e. we should look back to try and find the @@ -1136,40 +1129,44 @@ subshells can nest." sh-st-punc nil)) -(defun sh-font-lock-flush-syntax-ppss-cache (limit) - ;; This should probably be a standard function provided by font-lock.el - ;; (or syntax.el). - (syntax-ppss-flush-cache (point)) - (goto-char limit) - nil) - -(defconst sh-font-lock-syntactic-keywords - ;; A `#' begins a comment when it is unquoted and at the beginning of a - ;; word. In the shell, words are separated by metacharacters. - ;; The list of special chars is taken from the single-unix spec - ;; of the shell command language (under `quoting') but with `$' removed. - `(("[^|&;<>()`\\\"' \t\n]\\(#+\\)" 1 ,sh-st-symbol) - ;; In a '...' the backslash is not escaping. - ("\\(\\\\\\)'" (1 (sh-font-lock-backslash-quote))) - ;; The previous rule uses syntax-ppss, but the subsequent rules may - ;; change the syntax, so we have to tell syntax-ppss that the states it - ;; has just computed will need to be recomputed. - (sh-font-lock-flush-syntax-ppss-cache) - ;; Make sure $@ and $? are correctly recognized as sexps. - ("\\$\\([?@]\\)" 1 ,sh-st-symbol) - ;; Find HEREDOC starters and add a corresponding rule for the ender. - (sh-font-lock-here-doc - (2 (sh-font-lock-open-heredoc - (match-beginning 0) (match-string 1)) nil t) - (5 (sh-font-lock-close-heredoc - (match-beginning 0) (match-string 4) - (and (match-beginning 3) (/= (match-beginning 3) (match-end 3)))) - nil t)) - ;; Distinguish the special close-paren in `case'. - (")" 0 (sh-font-lock-paren (match-beginning 0))) - ;; highlight (possibly nested) subshells inside "" quoted regions correctly. - ;; This should be at the very end because it uses syntax-ppss. - (sh-font-lock-quoted-subshell))) +(defun sh-syntax-propertize-function (start end) + (goto-char start) + (while (prog1 + (re-search-forward sh-here-doc-re end 'move) + (save-excursion + (save-match-data + (funcall + (syntax-propertize-rules + ;; A `#' begins a comment when it is unquoted and at the + ;; beginning of a word. In the shell, words are separated by + ;; metacharacters. The list of special chars is taken from + ;; the single-unix spec of the shell command language (under + ;; `quoting') but with `$' removed. + ("[^|&;<>()`\\\"' \t\n]\\(#+\\)" (1 "_")) + ;; In a '...' the backslash is not escaping. + ("\\(\\\\\\)'" (1 (sh-font-lock-backslash-quote))) + ;; Make sure $@ and $? are correctly recognized as sexps. + ("\\$\\([?@]\\)" (1 "_")) + ;; Distinguish the special close-paren in `case'. + (")" (0 (sh-font-lock-paren (match-beginning 0)))) + ;; Highlight (possibly nested) subshells inside "" quoted + ;; regions correctly. + ("\"\\(?:\\(?:.\\|\n\\)*?[^\\]\\(?:\\\\\\\\\\)*\\)??\\(\\$(\\|`\\)" + (1 (ignore + ;; Save excursion because we want to also apply other + ;; syntax-propertize rules within the affected region. + (save-excursion + (sh-font-lock-quoted-subshell end)))))) + (prog1 start (setq start (point))) (point))))) + (if (match-beginning 2) + ;; FIXME: actually, once we see an heredoc opener, we should just + ;; search for its ender without propertizing anything in it. + (sh-font-lock-open-heredoc + (match-beginning 0) (match-string 1) (match-beginning 2)) + (sh-font-lock-close-heredoc + (match-beginning 0) (match-string 4) + (and (match-beginning 3) (/= (match-beginning 3) (match-end 3))) + (match-beginning 5))))) (defun sh-font-lock-syntactic-face-function (state) (let ((q (nth 3 state))) @@ -1553,9 +1550,12 @@ with your script for an edit-interpret-debug cycle." sh-font-lock-keywords-1 sh-font-lock-keywords-2) nil nil ((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")) nil - (font-lock-syntactic-keywords . sh-font-lock-syntactic-keywords) (font-lock-syntactic-face-function . sh-font-lock-syntactic-face-function))) + (set (make-local-variable 'syntax-propertize-function) + #'sh-syntax-propertize-function) + (add-hook 'syntax-propertize-extend-region-functions + #'syntax-propertize-multiline 'append 'local) (set (make-local-variable 'skeleton-pair-alist) '((?` _ ?`))) (set (make-local-variable 'skeleton-pair-filter-function) 'sh-quoted-p) (set (make-local-variable 'skeleton-further-elements) @@ -2207,10 +2207,9 @@ STRING This is ignored for the purposes of calculating ;; Note: setting result to t means we are done and will return nil. ;;(This function never returns just t.) (cond - ((or (and (boundp 'font-lock-string-face) (not (bobp)) - (eq (get-text-property (1- (point)) 'face) - font-lock-string-face)) + ((or (nth 3 (syntax-ppss (point))) (eq (get-text-property (point) 'face) sh-heredoc-face)) + ;; String continuation -- don't indent (setq result t) (setq have-result t)) ((looking-at "\\s-*#") ; was (equal this-kw "#") diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el index f8d1a6aca97..34c50b6cfe5 100644 --- a/lisp/progmodes/simula.el +++ b/lisp/progmodes/simula.el @@ -163,17 +163,18 @@ for SIMULA mode to function correctly." (defvar simula-mode-syntax-table nil "Syntax table in SIMULA mode buffers.") -(defconst simula-font-lock-syntactic-keywords - `(;; `comment' directive. - ("\\<\\(c\\)omment\\>" 1 "<") - ;; end comments - (,(concat "\\<end\\>\\([^;\n]\\).*?\\(\n\\|\\(.\\)\\(;\\|" - (regexp-opt '("end" "else" "when" "otherwise")) - "\\)\\)") - (1 "< b") - (3 "> b" nil t)) - ;; non-quoted single-quote char. - ("'\\('\\)'" 1 "."))) +(defconst simula-syntax-propertize-function + (syntax-propertize-rules + ;; `comment' directive. + ("\\<\\(c\\)omment\\>" (1 "<")) + ;; end comments + ((concat "\\<end\\>\\([^;\n]\\).*?\\(\n\\|\\(.\\)\\(;\\|" + (regexp-opt '("end" "else" "when" "otherwise")) + "\\)\\)") + (1 "< b") + (3 "> b")) + ;; non-quoted single-quote char. + ("'\\('\\)'" (1 ".")))) ;; Regexps written with help from Alf-Ivar Holm <alfh@ifi.uio.no>. (defconst simula-font-lock-keywords-1 @@ -396,8 +397,9 @@ with no arguments, if that value is non-nil." (setq font-lock-defaults '((simula-font-lock-keywords simula-font-lock-keywords-1 simula-font-lock-keywords-2 simula-font-lock-keywords-3) - nil t ((?_ . "w")) nil - (font-lock-syntactic-keywords . simula-font-lock-syntactic-keywords))) + nil t ((?_ . "w")))) + (set (make-local-variable 'syntax-propertize-function) + simula-syntax-propertize-function) (abbrev-mode 1)) (defun simula-indent-exp () diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index ff75d46ff13..a80a555c13f 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -5,7 +5,7 @@ ;; Author: Alex Schroeder <alex@gnu.org> ;; Maintainer: Michael Mauger <mmaug@yahoo.com> -;; Version: 2.4 +;; Version: 2.6 ;; Keywords: comm languages processes ;; URL: http://savannah.gnu.org/cgi-bin/viewcvs/emacs/emacs/lisp/progmodes/sql.el ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SqlMode @@ -187,10 +187,10 @@ ;; 6) Define a convienence function to invoke the SQL interpreter. -;; (defun my-sql-xyz () +;; (defun my-sql-xyz (&optional buffer) ;; "Run ixyz by XyzDB as an inferior process." -;; (interactive) -;; (sql-product-interactive 'xyz)) +;; (interactive "P") +;; (sql-product-interactive 'xyz buffer)) ;;; To Do: @@ -275,8 +275,8 @@ Customizing your password will store it in your ~/.emacs file." :group 'SQL :safe 'stringp) -(defcustom sql-port nil - "Default server or host." +(defcustom sql-port 0 + "Default port." :version "24.1" :type 'number :group 'SQL @@ -336,6 +336,7 @@ Customizing your password will store it in your ~/.emacs file." :sqli-comint-func sql-comint-db2 :prompt-regexp "^db2 => " :prompt-length 7 + :prompt-cont-regexp "^db2 (cont\.) => " :input-filter sql-escape-newlines-filter) (informix @@ -357,7 +358,8 @@ Customizing your password will store it in your ~/.emacs file." :sqli-login sql-ingres-login-params :sqli-comint-func sql-comint-ingres :prompt-regexp "^\* " - :prompt-length 2) + :prompt-length 2 + :prompt-cont-regexp "^\* ") (interbase :name "Interbase" @@ -401,6 +403,7 @@ Customizing your password will store it in your ~/.emacs file." :sqli-comint-func sql-comint-mysql :prompt-regexp "^mysql> " :prompt-length 6 + :prompt-cont-regexp "^ -> " :input-filter sql-remove-tabs-filter) (oracle @@ -412,6 +415,7 @@ Customizing your password will store it in your ~/.emacs file." :sqli-comint-func sql-comint-oracle :prompt-regexp "^SQL> " :prompt-length 5 + :prompt-cont-regexp "^\\s-*\\d+> " :syntax-alist ((?$ . "w") (?# . "w")) :terminator ("\\(^/\\|;\\)" . "/") :input-filter sql-placeholders-filter) @@ -424,10 +428,11 @@ Customizing your password will store it in your ~/.emacs file." :sqli-options sql-postgres-options :sqli-login sql-postgres-login-params :sqli-comint-func sql-comint-postgres - :prompt-regexp "^.*[#>] *" + :prompt-regexp "^.*=[#>] " :prompt-length 5 + :prompt-cont-regexp "^.*[-(][#>] " :input-filter sql-remove-tabs-filter - :terminator ("\\(^[\\]g\\|;\\)" . ";")) + :terminator ("\\(^\\s-*\\\\g\\|;\\)" . ";")) (solid :name "Solid" @@ -448,7 +453,9 @@ Customizing your password will store it in your ~/.emacs file." :sqli-login sql-sqlite-login-params :sqli-comint-func sql-comint-sqlite :prompt-regexp "^sqlite> " - :prompt-length 8) + :prompt-length 8 + :prompt-cont-regexp "^ ...> " + :terminator ";") (sybase :name "Sybase" @@ -509,6 +516,10 @@ may be any one of the following: :prompt-length length of the prompt on the line. + :prompt-cont-regexp regular expression string that matches + the continuation prompt issued by the + product interpreter. + :input-filter function which can filter strings sent to the command interpreter. It is also used by the `sql-send-string', @@ -516,7 +527,8 @@ may be any one of the following: and `sql-send-buffer' functions. The function is passed the string sent to the command interpreter and must return the - filtered string. + filtered string. May also be a list of + such functions. :terminator the terminator to be sent after a `sql-send-string', `sql-send-region', @@ -539,7 +551,6 @@ settings.") (defvar sql-indirect-features '(:font-lock :sqli-program :sqli-options :sqli-login)) -;;;###autoload (defcustom sql-connection-alist nil "An alist of connection parameters for interacting with a SQL product. @@ -588,7 +599,6 @@ prompted for during login." :version "24.1" :group 'SQL) -;;;###autoload (defcustom sql-product 'ansi "Select the SQL database product used so that buffers can be highlighted properly when you open them." @@ -601,6 +611,7 @@ highlighted properly when you open them." sql-product-alist)) :group 'SQL :safe 'symbolp) +(defvaralias 'sql-dialect 'sql-product) ;; misc customization of sql.el behaviour @@ -776,7 +787,9 @@ to be safe: ;; Customization for SQLite -(defcustom sql-sqlite-program "sqlite3" +(defcustom sql-sqlite-program (or (executable-find "sqlite3") + (executable-find "sqlite") + "sqlite") "Command to start SQLite. Starts `sql-interactive-mode' after doing some setup." @@ -789,7 +802,7 @@ Starts `sql-interactive-mode' after doing some setup." :version "20.8" :group 'SQL) -(defcustom sql-sqlite-login-params '((database :file ".*\\.db")) +(defcustom sql-sqlite-login-params '((database :file ".*\\.\\(db\\|sqlite[23]?\\)")) "List of login parameters needed to connect to SQLite." :type 'sql-login-params :version "24.1" @@ -1010,9 +1023,6 @@ Starts `sql-interactive-mode' after doing some setup." (defvar sql-server-history nil "History of servers used.") -(defvar sql-port-history nil - "History of ports used.") - ;; Passwords are not kept in a history. (defvar sql-buffer nil @@ -1034,11 +1044,20 @@ You can change `sql-prompt-regexp' on `sql-interactive-mode-hook'.") You can change `sql-prompt-length' on `sql-interactive-mode-hook'.") +(defvar sql-prompt-cont-regexp nil + "Prompt pattern of statement continuation prompts.") + (defvar sql-alternate-buffer-name nil "Buffer-local string used to possibly rename the SQLi buffer. Used by `sql-rename-buffer'.") +(defun sql-buffer-live-p (buffer) + "Returns non-nil if the process associated with buffer is live." + (and buffer + (buffer-live-p (get-buffer buffer)) + (get-buffer-process buffer))) + ;; Keymap for sql-interactive-mode. (defvar sql-interactive-mode-map @@ -1076,15 +1095,11 @@ Based on `comint-mode-map'.") sql-mode-menu sql-mode-map "Menu for `sql-mode'." `("SQL" - ["Send Paragraph" sql-send-paragraph (and (buffer-live-p sql-buffer) - (get-buffer-process sql-buffer))] + ["Send Paragraph" sql-send-paragraph (sql-buffer-live-p sql-buffer)] ["Send Region" sql-send-region (and mark-active - (buffer-live-p sql-buffer) - (get-buffer-process sql-buffer))] - ["Send Buffer" sql-send-buffer (and (buffer-live-p sql-buffer) - (get-buffer-process sql-buffer))] - ["Send String" sql-send-string (and (buffer-live-p sql-buffer) - (get-buffer-process sql-buffer))] + (sql-buffer-live-p sql-buffer))] + ["Send Buffer" sql-send-buffer (sql-buffer-live-p sql-buffer)] + ["Send String" sql-send-string (sql-buffer-live-p sql-buffer)] "--" ["Start SQLi session" sql-product-interactive :visible (not sql-connection-alist) @@ -1349,7 +1364,7 @@ to add functions and PL/SQL keywords.") ;; Oracle SQL*Plus Commands (cons (concat - "^\\(?:\\(?:" (regexp-opt '( + "^\\s-*\\(?:\\(?:" (regexp-opt '( "@" "@@" "accept" "append" "archive" "attribute" "break" "btitle" "change" "clear" "column" "connect" "copy" "define" "del" "describe" "disconnect" "edit" "execute" "exit" "get" "help" @@ -1388,7 +1403,7 @@ to add functions and PL/SQL keywords.") "\\)\\b.*" ) 'font-lock-doc-face) - '("^[ \t]*rem\\(?:ark\\)?.*" . font-lock-comment-face) + '("^\\s-*rem\\(?:ark\\)?\\>.*" . font-lock-comment-face) ;; Oracle Functions (sql-font-lock-keywords-builder 'font-lock-builtin-face nil @@ -1570,81 +1585,153 @@ to add functions and PL/SQL keywords.") (defvar sql-mode-postgres-font-lock-keywords (eval-when-compile (list - ;; Postgres Functions + ;; Postgres psql commands + '("^\\s-*\\\\.*$" . font-lock-doc-face) + + ;; Postgres unreserved words but may have meaning + (sql-font-lock-keywords-builder 'font-lock-builtin-face nil "a" +"abs" "absent" "according" "ada" "alias" "allocate" "are" "array_agg" +"asensitive" "atomic" "attribute" "attributes" "avg" "base64" +"bernoulli" "bit_length" "bitvar" "blob" "blocked" "bom" "breadth" "c" +"call" "cardinality" "catalog_name" "ceil" "ceiling" "char_length" +"character_length" "character_set_catalog" "character_set_name" +"character_set_schema" "characters" "checked" "class_origin" "clob" +"cobol" "collation" "collation_catalog" "collation_name" +"collation_schema" "collect" "column_name" "columns" +"command_function" "command_function_code" "completion" "condition" +"condition_number" "connect" "connection_name" "constraint_catalog" +"constraint_name" "constraint_schema" "constructor" "contains" +"control" "convert" "corr" "corresponding" "count" "covar_pop" +"covar_samp" "cube" "cume_dist" "current_default_transform_group" +"current_path" "current_transform_group_for_type" "cursor_name" +"datalink" "datetime_interval_code" "datetime_interval_precision" "db" +"defined" "degree" "dense_rank" "depth" "deref" "derived" "describe" +"descriptor" "destroy" "destructor" "deterministic" "diagnostics" +"disconnect" "dispatch" "dlnewcopy" "dlpreviouscopy" "dlurlcomplete" +"dlurlcompleteonly" "dlurlcompletewrite" "dlurlpath" "dlurlpathonly" +"dlurlpathwrite" "dlurlscheme" "dlurlserver" "dlvalue" "dynamic" +"dynamic_function" "dynamic_function_code" "element" "empty" +"end-exec" "equals" "every" "exception" "exec" "existing" "exp" "file" +"filter" "final" "first_value" "flag" "floor" "fortran" "found" "free" +"fs" "fusion" "g" "general" "generated" "get" "go" "goto" "grouping" +"hex" "hierarchy" "host" "id" "ignore" "implementation" "import" +"indent" "indicator" "infix" "initialize" "instance" "instantiable" +"integrity" "intersection" "iterate" "k" "key_member" "key_type" "lag" +"last_value" "lateral" "lead" "length" "less" "library" "like_regex" +"link" "ln" "locator" "lower" "m" "map" "matched" "max" +"max_cardinality" "member" "merge" "message_length" +"message_octet_length" "message_text" "method" "min" "mod" "modifies" +"modify" "module" "more" "multiset" "mumps" "namespace" "nclob" +"nesting" "new" "nfc" "nfd" "nfkc" "nfkd" "nil" "normalize" +"normalized" "nth_value" "ntile" "nullable" "number" +"occurrences_regex" "octet_length" "octets" "old" "open" "operation" +"ordering" "ordinality" "others" "output" "overriding" "p" "pad" +"parameter" "parameter_mode" "parameter_name" +"parameter_ordinal_position" "parameter_specific_catalog" +"parameter_specific_name" "parameter_specific_schema" "parameters" +"pascal" "passing" "passthrough" "percent_rank" "percentile_cont" +"percentile_disc" "permission" "pli" "position_regex" "postfix" +"power" "prefix" "preorder" "public" "rank" "reads" "recovery" "ref" +"referencing" "regr_avgx" "regr_avgy" "regr_count" "regr_intercept" +"regr_r2" "regr_slope" "regr_sxx" "regr_sxy" "regr_syy" "requiring" +"respect" "restore" "result" "return" "returned_cardinality" +"returned_length" "returned_octet_length" "returned_sqlstate" "rollup" +"routine" "routine_catalog" "routine_name" "routine_schema" +"row_count" "row_number" "scale" "schema_name" "scope" "scope_catalog" +"scope_name" "scope_schema" "section" "selective" "self" "sensitive" +"server_name" "sets" "size" "source" "space" "specific" +"specific_name" "specifictype" "sql" "sqlcode" "sqlerror" +"sqlexception" "sqlstate" "sqlwarning" "sqrt" "state" "static" +"stddev_pop" "stddev_samp" "structure" "style" "subclass_origin" +"sublist" "submultiset" "substring_regex" "sum" "system_user" "t" +"table_name" "tablesample" "terminate" "than" "ties" "timezone_hour" +"timezone_minute" "token" "top_level_count" "transaction_active" +"transactions_committed" "transactions_rolled_back" "transform" +"transforms" "translate" "translate_regex" "translation" +"trigger_catalog" "trigger_name" "trigger_schema" "trim_array" +"uescape" "under" "unlink" "unnamed" "unnest" "untyped" "upper" "uri" +"usage" "user_defined_type_catalog" "user_defined_type_code" +"user_defined_type_name" "user_defined_type_schema" "var_pop" +"var_samp" "varbinary" "variable" "whenever" "width_bucket" "within" +"xmlagg" "xmlbinary" "xmlcast" "xmlcomment" "xmldeclaration" +"xmldocument" "xmlexists" "xmliterate" "xmlnamespaces" "xmlquery" +"xmlschema" "xmltable" "xmltext" "xmlvalidate" +) + + ;; Postgres non-reserved words (sql-font-lock-keywords-builder 'font-lock-builtin-face nil -"abbrev" "abs" "acos" "age" "area" "ascii" "asin" "atab2" "atan" -"atan2" "avg" "bit_length" "both" "broadcast" "btrim" "cbrt" "ceil" -"center" "char_length" "chr" "coalesce" "col_description" "convert" -"cos" "cot" "count" "current_database" "current_date" "current_schema" -"current_schemas" "current_setting" "current_time" "current_timestamp" -"current_user" "currval" "date_part" "date_trunc" "decode" "degrees" -"diameter" "encode" "exp" "extract" "floor" "get_bit" "get_byte" -"has_database_privilege" "has_function_privilege" -"has_language_privilege" "has_schema_privilege" "has_table_privilege" -"height" "host" "initcap" "isclosed" "isfinite" "isopen" "leading" -"length" "ln" "localtime" "localtimestamp" "log" "lower" "lpad" -"ltrim" "masklen" "max" "min" "mod" "netmask" "network" "nextval" -"now" "npoints" "nullif" "obj_description" "octet_length" "overlay" -"pclose" "pg_client_encoding" "pg_function_is_visible" -"pg_get_constraintdef" "pg_get_indexdef" "pg_get_ruledef" -"pg_get_userbyid" "pg_get_viewdef" "pg_opclass_is_visible" -"pg_operator_is_visible" "pg_table_is_visible" "pg_type_is_visible" -"pi" "popen" "position" "pow" "quote_ident" "quote_literal" "radians" -"radius" "random" "repeat" "replace" "round" "rpad" "rtrim" -"session_user" "set_bit" "set_byte" "set_config" "set_masklen" -"setval" "sign" "sin" "split_part" "sqrt" "stddev" "strpos" "substr" -"substring" "sum" "tan" "timeofday" "to_ascii" "to_char" "to_date" -"to_hex" "to_number" "to_timestamp" "trailing" "translate" "trim" -"trunc" "upper" "variance" "version" "width" +"abort" "absolute" "access" "action" "add" "admin" "after" "aggregate" +"also" "alter" "always" "assertion" "assignment" "at" "backward" +"before" "begin" "between" "by" "cache" "called" "cascade" "cascaded" +"catalog" "chain" "characteristics" "checkpoint" "class" "close" +"cluster" "coalesce" "comment" "comments" "commit" "committed" +"configuration" "connection" "constraints" "content" "continue" +"conversion" "copy" "cost" "createdb" "createrole" "createuser" "csv" +"current" "cursor" "cycle" "data" "database" "day" "deallocate" "dec" +"declare" "defaults" "deferred" "definer" "delete" "delimiter" +"delimiters" "dictionary" "disable" "discard" "document" "domain" +"drop" "each" "enable" "encoding" "encrypted" "enum" "escape" +"exclude" "excluding" "exclusive" "execute" "exists" "explain" +"external" "extract" "family" "first" "float" "following" "force" +"forward" "function" "functions" "global" "granted" "greatest" +"handler" "header" "hold" "hour" "identity" "if" "immediate" +"immutable" "implicit" "including" "increment" "index" "indexes" +"inherit" "inherits" "inline" "inout" "input" "insensitive" "insert" +"instead" "invoker" "isolation" "key" "language" "large" "last" +"lc_collate" "lc_ctype" "least" "level" "listen" "load" "local" +"location" "lock" "login" "mapping" "match" "maxvalue" "minute" +"minvalue" "mode" "month" "move" "name" "names" "national" "nchar" +"next" "no" "nocreatedb" "nocreaterole" "nocreateuser" "noinherit" +"nologin" "none" "nosuperuser" "nothing" "notify" "nowait" "nullif" +"nulls" "object" "of" "oids" "operator" "option" "options" "out" +"overlay" "owned" "owner" "parser" "partial" "partition" "password" +"plans" "position" "preceding" "prepare" "prepared" "preserve" "prior" +"privileges" "procedural" "procedure" "quote" "range" "read" +"reassign" "recheck" "recursive" "reindex" "relative" "release" +"rename" "repeatable" "replace" "replica" "reset" "restart" "restrict" +"returns" "revoke" "role" "rollback" "row" "rows" "rule" "savepoint" +"schema" "scroll" "search" "second" "security" "sequence" "sequences" +"serializable" "server" "session" "set" "setof" "share" "show" +"simple" "stable" "standalone" "start" "statement" "statistics" +"stdin" "stdout" "storage" "strict" "strip" "substring" "superuser" +"sysid" "system" "tables" "tablespace" "temp" "template" "temporary" +"transaction" "treat" "trigger" "trim" "truncate" "trusted" "type" +"unbounded" "uncommitted" "unencrypted" "unknown" "unlisten" "until" +"update" "vacuum" "valid" "validator" "value" "values" "version" +"view" "volatile" "whitespace" "work" "wrapper" "write" +"xmlattributes" "xmlconcat" "xmlelement" "xmlforest" "xmlparse" +"xmlpi" "xmlroot" "xmlserialize" "year" "yes" ) + ;; Postgres Reserved (sql-font-lock-keywords-builder 'font-lock-keyword-face nil -"abort" "access" "add" "after" "aggregate" "alignment" "all" "alter" -"analyze" "and" "any" "as" "asc" "assignment" "authorization" -"backward" "basetype" "before" "begin" "between" "binary" "by" "cache" -"called" "cascade" "case" "cast" "characteristics" "check" -"checkpoint" "class" "close" "cluster" "column" "comment" "commit" -"committed" "commutator" "constraint" "constraints" "conversion" -"copy" "create" "createdb" "createuser" "cursor" "cycle" "database" -"deallocate" "declare" "default" "deferrable" "deferred" "definer" -"delete" "delimiter" "desc" "distinct" "do" "domain" "drop" "each" -"element" "else" "encoding" "encrypted" "end" "escape" "except" -"exclusive" "execute" "exists" "explain" "extended" "external" "false" -"fetch" "finalfunc" "for" "force" "foreign" "forward" "freeze" "from" -"full" "function" "grant" "group" "gtcmp" "handler" "hashes" "having" -"immediate" "immutable" "implicit" "in" "increment" "index" "inherits" -"initcond" "initially" "input" "insensitive" "insert" "instead" -"internallength" "intersect" "into" "invoker" "is" "isnull" -"isolation" "join" "key" "language" "leftarg" "level" "like" "limit" -"listen" "load" "local" "location" "lock" "ltcmp" "main" "match" -"maxvalue" "merges" "minvalue" "mode" "move" "natural" "negator" -"next" "nocreatedb" "nocreateuser" "none" "not" "nothing" "notify" -"notnull" "null" "of" "offset" "oids" "on" "only" "operator" "or" -"order" "output" "owner" "partial" "passedbyvalue" "password" "plain" -"prepare" "primary" "prior" "privileges" "procedural" "procedure" -"public" "read" "recheck" "references" "reindex" "relative" "rename" -"reset" "restrict" "returns" "revoke" "rightarg" "rollback" "row" -"rule" "schema" "scroll" "security" "select" "sequence" "serializable" -"session" "set" "sfunc" "share" "show" "similar" "some" "sort1" -"sort2" "stable" "start" "statement" "statistics" "storage" "strict" -"stype" "sysid" "table" "temp" "template" "temporary" "then" "to" -"transaction" "trigger" "true" "truncate" "trusted" "type" -"unencrypted" "union" "unique" "unknown" "unlisten" "until" "update" -"usage" "user" "using" "vacuum" "valid" "validator" "values" -"variable" "verbose" "view" "volatile" "when" "where" "with" "without" -"work" +"all" "analyse" "analyze" "and" "any" "array" "asc" "as" "asymmetric" +"authorization" "binary" "both" "case" "cast" "check" "collate" +"column" "concurrently" "constraint" "create" "cross" +"current_catalog" "current_date" "current_role" "current_schema" +"current_time" "current_timestamp" "current_user" "default" +"deferrable" "desc" "distinct" "do" "else" "end" "except" "false" +"fetch" "foreign" "for" "freeze" "from" "full" "grant" "group" +"having" "ilike" "initially" "inner" "in" "intersect" "into" "isnull" +"is" "join" "leading" "left" "like" "limit" "localtime" +"localtimestamp" "natural" "notnull" "not" "null" "off" "offset" +"only" "on" "order" "or" "outer" "overlaps" "over" "placing" "primary" +"references" "returning" "right" "select" "session_user" "similar" +"some" "symmetric" "table" "then" "to" "trailing" "true" "union" +"unique" "user" "using" "variadic" "verbose" "when" "where" "window" +"with" ) ;; Postgres Data Types (sql-font-lock-keywords-builder 'font-lock-type-face nil -"anyarray" "bigint" "bigserial" "bit" "boolean" "box" "bytea" "char" -"character" "cidr" "circle" "cstring" "date" "decimal" "double" -"float4" "float8" "inet" "int2" "int4" "int8" "integer" "internal" -"interval" "language_handler" "line" "lseg" "macaddr" "money" -"numeric" "oid" "opaque" "path" "point" "polygon" "precision" "real" -"record" "regclass" "regoper" "regoperator" "regproc" "regprocedure" -"regtype" "serial" "serial4" "serial8" "smallint" "text" "time" -"timestamp" "varchar" "varying" "void" "zone" +"bigint" "bigserial" "bit" "bool" "boolean" "box" "bytea" "char" +"character" "cidr" "circle" "date" "decimal" "double" "float4" +"float8" "inet" "int" "int2" "int4" "int8" "integer" "interval" "line" +"lseg" "macaddr" "money" "numeric" "path" "point" "polygon" +"precision" "real" "serial" "serial4" "serial8" "smallint" "text" +"time" "timestamp" "timestamptz" "timetz" "tsquery" "tsvector" +"txid_snapshot" "uuid" "varbit" "varchar" "varying" "without" +"xml" "zone" ))) "Postgres SQL keywords used by font-lock. @@ -1964,15 +2051,17 @@ you define your own `sql-mode-mysql-font-lock-keywords'.") (defvar sql-mode-sqlite-font-lock-keywords (eval-when-compile (list + ;; SQLite commands + '("^[.].*$" . font-lock-doc-face) + ;; SQLite Keyword (sql-font-lock-keywords-builder 'font-lock-keyword-face nil "abort" "action" "add" "after" "all" "alter" "analyze" "and" "as" "asc" "attach" "autoincrement" "before" "begin" "between" "by" "cascade" "case" "cast" "check" "collate" "column" "commit" "conflict" -"constraint" "create" "cross" "current_date" "current_time" -"current_timestamp" "database" "default" "deferrable" "deferred" -"delete" "desc" "detach" "distinct" "drop" "each" "else" "end" -"escape" "except" "exclusive" "exists" "explain" "fail" "for" +"constraint" "create" "cross" "database" "default" "deferrable" +"deferred" "delete" "desc" "detach" "distinct" "drop" "each" "else" +"end" "escape" "except" "exclusive" "exists" "explain" "fail" "for" "foreign" "from" "full" "glob" "group" "having" "if" "ignore" "immediate" "in" "index" "indexed" "initially" "inner" "insert" "instead" "intersect" "into" "is" "isnull" "join" "key" "left" "like" @@ -1987,9 +2076,9 @@ you define your own `sql-mode-mysql-font-lock-keywords'.") ;; SQLite Data types (sql-font-lock-keywords-builder 'font-lock-type-face nil "int" "integer" "tinyint" "smallint" "mediumint" "bigint" "unsigned" -"big" "int2" "int8" "character" "varchar" "varying" "nchar" "native " +"big" "int2" "int8" "character" "varchar" "varying" "nchar" "native" "nvarchar" "text" "clob" "blob" "real" "double" "precision" "float" -"numeric" "decimal" "boolean" "date" "datetime" +"numeric" "number" "decimal" "boolean" "date" "datetime" ) ;; SQLite Functions (sql-font-lock-keywords-builder 'font-lock-builtin-face nil @@ -2002,6 +2091,7 @@ you define your own `sql-mode-mysql-font-lock-keywords'.") "typeof" "upper" "zeroblob" ;; Date/time functions "time" "julianday" "strftime" +"current_date" "current_time" "current_timestamp" ;; Aggregate functions "avg" "count" "group_concat" "max" "min" "sum" "total" ))) @@ -2478,16 +2568,18 @@ function like this: (sql-get-login 'user 'password 'database)." ((eq token 'port) ; port (setq sql-port - (read-number "Port: " sql-port)))))) - what)) + (read-number "Port: " (if (numberp sql-port) + sql-port + 0))))))) + what)) (defun sql-find-sqli-buffer () - "Returns the current default SQLi buffer or nil. -In order to qualify, the SQLi buffer must be alive, -be in `sql-interactive-mode' and have a process." - (let ((default-buffer (default-value 'sql-buffer))) - (if (and (buffer-live-p default-buffer) - (get-buffer-process default-buffer)) + "Returns the name of the current default SQLi buffer or nil. +In order to qualify, the SQLi buffer must be alive, be in +`sql-interactive-mode' and have a process." + (let ((default-buffer (default-value 'sql-buffer)) + (current-product sql-product)) + (if (sql-buffer-live-p default-buffer) default-buffer (save-current-buffer (let ((buflist (buffer-list)) @@ -2496,9 +2588,10 @@ be in `sql-interactive-mode' and have a process." found)) (let ((candidate (car buflist))) (set-buffer candidate) - (if (and (derived-mode-p 'sql-interactive-mode) - (get-buffer-process candidate)) - (setq found candidate)) + (if (and (sql-buffer-live-p candidate) + (derived-mode-p 'sql-interactive-mode) + (eq sql-product current-product)) + (setq found (buffer-name candidate))) (setq buflist (cdr buflist)))) found))))) @@ -2512,15 +2605,15 @@ using `sql-find-sqli-buffer'. If `sql-buffer' is set, (interactive) (save-excursion (let ((buflist (buffer-list)) - (default-sqli-buffer (sql-find-sqli-buffer))) - (setq-default sql-buffer default-sqli-buffer) + (default-buffer (sql-find-sqli-buffer))) + (setq-default sql-buffer default-buffer) (while (not (null buflist)) (let ((candidate (car buflist))) (set-buffer candidate) (if (and (derived-mode-p 'sql-mode) (not (buffer-live-p sql-buffer))) (progn - (setq sql-buffer default-sqli-buffer) + (setq sql-buffer default-buffer) (run-hooks 'sql-set-sqli-hook)))) (setq buflist (cdr buflist)))))) @@ -2546,11 +2639,11 @@ If you call it from anywhere else, it sets the global copy of (if (null (get-buffer-process new-buffer)) (error "Buffer %s has no process" (buffer-name new-buffer))) (if (null (with-current-buffer new-buffer - (equal major-mode 'sql-interactive-mode))) + (derived-mode-p 'sql-interactive-mode))) (error "Buffer %s is no SQLi buffer" (buffer-name new-buffer))) (if new-buffer (progn - (setq sql-buffer new-buffer) + (setq sql-buffer (buffer-name new-buffer)) (run-hooks 'sql-set-sqli-hook)))))) (defun sql-show-sqli-buffer () @@ -2559,11 +2652,11 @@ If you call it from anywhere else, it sets the global copy of This is the buffer SQL strings are sent to. It is stored in the variable `sql-buffer'. See `sql-help' on how to create such a buffer." (interactive) - (if (null (buffer-live-p sql-buffer)) + (if (null (buffer-live-p (get-buffer sql-buffer))) (message "%s has no SQLi buffer set." (buffer-name (current-buffer))) (if (null (get-buffer-process sql-buffer)) - (message "Buffer %s has no process." (buffer-name sql-buffer)) - (message "Current SQLi buffer is %s." (buffer-name sql-buffer))))) + (message "Buffer %s has no process." sql-buffer) + (message "Current SQLi buffer is %s." sql-buffer)))) (defun sql-make-alternate-buffer-name () "Return a string that can be used to rename a SQLi buffer. @@ -2585,25 +2678,34 @@ server/database name." ;; Build a name using the :sqli-login setting (setq name (apply 'concat - (apply 'append nil - (sql-for-each-login - (sql-get-product-feature sql-product :sqli-login) - (lambda (token type arg) - (cond - ((eq token 'user) (list "/" sql-user)) - ((eq token 'port) (list ":" sql-port)) - ((eq token 'server) - (list "." (if (eq type :file) - (file-name-nondirectory sql-server) - sql-server))) - ((eq token 'database) - (list "@" (if (eq type :file) - (file-name-nondirectory sql-database) - sql-database))) - - ((eq token 'password) nil) - (t nil))))))) - + (cdr + (apply 'append nil + (sql-for-each-login + (sql-get-product-feature sql-product :sqli-login) + (lambda (token type arg) + (cond + ((eq token 'user) + (unless (string= "" sql-user) + (list "/" sql-user))) + ((eq token 'port) + (unless (or (not (numberp sql-port)) + (= 0 sql-port)) + (list ":" (number-to-string sql-port)))) + ((eq token 'server) + (unless (string= "" sql-server) + (list "." + (if (eq type :file) + (file-name-nondirectory sql-server) + sql-server)))) + ((eq token 'database) + (unless (string= "" sql-database) + (list "@" + (if (eq type :file) + (file-name-nondirectory sql-database) + sql-database)))) + + ((eq token 'password) nil) + (t nil)))))))) ;; If there's a connection, use it and the name thus far (if sql-connection @@ -2623,13 +2725,35 @@ server/database name." sql-server) sql-database)) - ;; We've got a name, go with it (without the first punctuation char) - (substring name 1))))) + ;; Use the name we've got + name)))) -(defun sql-rename-buffer () - "Rename a SQLi buffer." - (interactive) - (rename-buffer (format "*SQL: %s*" sql-alternate-buffer-name) t)) +(defun sql-rename-buffer (&optional new-name) + "Rename a SQL interactive buffer. + +Prompts for the new name if command is preceeded by +\\[universal-argument]. If no buffer name is provided, then the +`sql-alternate-buffer-name' is used. + +The actual buffer name set will be \"*SQL: NEW-NAME*\". If +NEW-NAME is empty, then the buffer name will be \"*SQL*\"." + (interactive "P") + + (if (not (derived-mode-p 'sql-interactive-mode)) + (message "Current buffer is not a SQL interactive buffer") + + (cond + ((stringp new-name) + (setq sql-alternate-buffer-name new-name)) + ((listp new-name) + (setq sql-alternate-buffer-name + (read-string "Buffer name (\"*SQL: XXX*\"; enter `XXX'): " + sql-alternate-buffer-name)))) + + (rename-buffer (if (string= "" sql-alternate-buffer-name) + "*SQL*" + (format "*SQL: %s*" sql-alternate-buffer-name)) + t))) (defun sql-copy-column () "Copy current column to the end of buffer. @@ -2702,14 +2826,73 @@ Every newline in STRING will be preceded with a space and a backslash." ;;; Input sender for SQLi buffers +(defvar sql-output-newline-count 0 + "Number of newlines in the input string. + +Allows the suppression of continuation prompts.") + +(defvar sql-output-by-send nil + "Non-nil if the command in the input was generated by `sql-send-string'.") + (defun sql-input-sender (proc string) "Send STRING to PROC after applying filters." (let* ((product (with-current-buffer (process-buffer proc) sql-product)) (filter (sql-get-product-feature product :input-filter))) + ;; Apply filter(s) + (cond + ((not filter) + nil) + ((functionp filter) + (setq string (funcall filter string))) + ((listp filter) + (mapc (lambda (f) (setq string (funcall f string))) filter)) + (t nil)) + + ;; Count how many newlines in the string + (setq sql-output-newline-count 0) + (mapc (lambda (ch) + (when (eq ch ?\n) + (setq sql-output-newline-count (1+ sql-output-newline-count)))) + string) + ;; Send the string - (comint-simple-send proc (if filter (funcall filter string) string)))) + (comint-simple-send proc string))) + +;;; Strip out continuation prompts + +(defun sql-interactive-remove-continuation-prompt (oline) + "Strip out continuation prompts out of the OLINE. + +Added to the `comint-preoutput-filter-functions' hook in a SQL +interactive buffer. If `sql-outut-newline-count' is greater than +zero, then an output line matching the continuation prompt is filtered +out. If the count is one, then the prompt is replaced with a newline +to force the output from the query to appear on a new line." + (if (and sql-prompt-cont-regexp + sql-output-newline-count + (numberp sql-output-newline-count) + (>= sql-output-newline-count 1)) + (progn + (while (and oline + sql-output-newline-count + (> sql-output-newline-count 0) + (string-match sql-prompt-cont-regexp oline)) + + (setq oline + (replace-match (if (and + (= 1 sql-output-newline-count) + sql-output-by-send) + "\n" "") + nil nil oline) + sql-output-newline-count + (1- sql-output-newline-count))) + (if (= sql-output-newline-count 0) + (setq sql-output-newline-count nil)) + (setq sql-output-by-send nil)) + (setq sql-output-newline-count nil)) + oline) ;;; Sending the region to the SQLi buffer. @@ -2717,28 +2900,22 @@ Every newline in STRING will be preceded with a space and a backslash." "Send the string STR to the SQL process." (interactive "sSQL Text: ") - (let (comint-input-sender-no-newline proc) - (if (buffer-live-p sql-buffer) + (let ((comint-input-sender-no-newline nil) + (s (replace-regexp-in-string "[[:space:]\n\r]+\\'" "" str))) + (if (sql-buffer-live-p sql-buffer) (progn ;; Ignore the hoping around... (save-excursion - ;; Get the process - (setq proc (get-buffer-process sql-buffer)) - ;; Set product context (with-current-buffer sql-buffer - ;; Send the string - (sql-input-sender proc str) - - ;; Send a newline if there wasn't one on the end of the string - (unless (string-equal "\n" (substring str (1- (length str)))) - (comint-send-string proc "\n")) + ;; Send the string (trim the trailing whitespace) + (sql-input-sender (get-buffer-process sql-buffer) s) ;; Send a command terminator if we must (if sql-send-terminator - (sql-send-magic-terminator sql-buffer str sql-send-terminator)) + (sql-send-magic-terminator sql-buffer s sql-send-terminator)) - (message "Sent string to buffer %s." (buffer-name sql-buffer)))) + (message "Sent string to buffer %s." sql-buffer))) ;; Display the sql buffer (if sql-pop-to-buffer-after-send-region @@ -2771,7 +2948,7 @@ Every newline in STRING will be preceded with a space and a backslash." (defun sql-send-magic-terminator (buf str terminator) "Send TERMINATOR to buffer BUF if its not present in STR." - (let (pat term) + (let (comint-input-sender-no-newline pat term) ;; If flag is merely on(t), get product-specific terminator (if (eq terminator t) (setq terminator (sql-get-product-feature sql-product :terminator))) @@ -2792,8 +2969,13 @@ Every newline in STRING will be preceded with a space and a backslash." ;; Check to see if the pattern is present in the str already sent (unless (and pat term - (string-match (concat pat "\n?\\'") str)) - (comint-send-string buf (concat term "\n"))))) + (string-match (concat pat "\\'") str)) + (comint-simple-send (get-buffer-process buf) term) + (setq sql-output-newline-count + (if sql-output-newline-count + (1+ sql-output-newline-count) + 1))) + (setq sql-output-by-send t))) (defun sql-remove-tabs-filter (str) "Replace tab characters with spaces." @@ -2982,7 +3164,7 @@ you entered, right above the output it created. (setq local-abbrev-table sql-mode-abbrev-table) (setq abbrev-all-caps 1) ;; Exiting the process will call sql-stop. - (set-process-sentinel (get-buffer-process sql-buffer) 'sql-stop) + (set-process-sentinel (get-buffer-process (current-buffer)) 'sql-stop) ;; Save the connection name (make-local-variable 'sql-connection) ;; Create a usefull name for renaming this buffer later. @@ -2993,12 +3175,22 @@ you entered, right above the output it created. (sql-get-product-feature sql-product :prompt-regexp)) (set (make-local-variable 'sql-prompt-length) (sql-get-product-feature sql-product :prompt-length)) + (set (make-local-variable 'sql-prompt-cont-regexp) + (sql-get-product-feature sql-product :prompt-cont-regexp)) + (make-local-variable 'sql-output-newline-count) + (make-local-variable 'sql-output-by-send) + (add-hook 'comint-preoutput-filter-functions + 'sql-interactive-remove-continuation-prompt nil t) (make-local-variable 'sql-input-ring-separator) (make-local-variable 'sql-input-ring-file-name) ;; Run the mode hook (along with comint's hooks). (run-mode-hooks 'sql-interactive-mode-hook) ;; Set comint based on user overrides. - (setq comint-prompt-regexp sql-prompt-regexp) + (setq comint-prompt-regexp + (if sql-prompt-cont-regexp + (concat "\\(" sql-prompt-regexp + "\\|" sql-prompt-cont-regexp "\\)") + sql-prompt-regexp)) (setq left-margin sql-prompt-length) ;; Install input sender (set (make-local-variable 'comint-input-sender) 'sql-input-sender) @@ -3157,49 +3349,60 @@ optionally is saved to the user's init file." ;;; Entry functions for different SQL interpreters. ;;;###autoload -(defun sql-product-interactive (&optional product) +(defun sql-product-interactive (&optional product new-name) "Run PRODUCT interpreter as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. If buffer exists and a process is running, just switch to buffer `*SQL*'. +To specify the SQL product, prefix the call with +\\[universal-argument]. To set the buffer name as well, prefix +the call to \\[sql-product-interactive] with +\\[universal-argument] \\[universal-argument]. + \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" (interactive "P") + ;; Handle universal arguments if specified + (when (not (or executing-kbd-macro noninteractive)) + (when (and (listp product) + (not (cdr product)) + (numberp (car product))) + (when (>= (car product) 16) + (when (not new-name) + (setq new-name '(4))) + (setq product '(4))))) + + ;; Get the value of product that we need (setq product (cond - ((equal product '(4)) ; Universal arg, prompt for product + ((equal product '(4)) ; C-u, prompt for product (intern (completing-read "SQL product: " (mapcar (lambda (info) (symbol-name (car info))) sql-product-alist) nil 'require-match - (or (and sql-product (symbol-name sql-product)) "ansi")))) + (or (and sql-product + (symbol-name sql-product)) + "ansi")))) ((and product ; Product specified (symbolp product)) product) (t sql-product))) ; Default to sql-product + ;; If we have a product and it has a interactive mode (if product (when (sql-get-product-feature product :sqli-comint-func) - (if (and sql-buffer - (buffer-live-p sql-buffer) - (comint-check-proc sql-buffer)) + ;; If no new name specified, fall back on sql-buffer if its for + ;; the same product + (if (and (not new-name) + sql-buffer + (sql-buffer-live-p sql-buffer) + (comint-check-proc sql-buffer) + (eq product (with-current-buffer sql-buffer sql-product))) (pop-to-buffer sql-buffer) - ;; Is the current buffer in sql-mode and - ;; there is a buffer local setting of sql-buffer - (let* ((start-buffer - (and (derived-mode-p 'sql-mode) - (current-buffer))) - (start-sql-buffer - (and start-buffer - (let (found) - (dolist (var (buffer-local-variables)) - (and (consp var) - (eq (car var) 'sql-buffer) - (buffer-live-p (cdr var)) - (get-buffer-process (cdr var)) - (setq found (cdr var)))) - found))) + ;; We have a new name or sql-buffer doesn't exist or match + ;; Start by remembering where we start + (let* ((start-buffer (current-buffer)) new-sqli-buffer) ;; Get credentials. @@ -3212,15 +3415,18 @@ If buffer exists and a process is running, just switch to buffer `*SQL*'. (sql-get-product-feature product :sqli-options)) ;; Set SQLi mode. - (setq sql-interactive-product product - new-sqli-buffer (current-buffer) - sql-buffer new-sqli-buffer) - (sql-interactive-mode) + (setq new-sqli-buffer (current-buffer)) + (let ((sql-interactive-product product)) + (sql-interactive-mode)) + + ;; Set the new buffer name + (when new-name + (sql-rename-buffer new-name)) ;; Set `sql-buffer' in the start buffer - (when (and start-buffer (not start-sql-buffer)) - (with-current-buffer start-buffer - (setq sql-buffer new-sqli-buffer))) + (setq sql-buffer (buffer-name new-sqli-buffer)) + (with-current-buffer start-buffer + (setq sql-buffer (buffer-name new-sqli-buffer))) ;; All done. (message "Login...done") @@ -3232,12 +3438,22 @@ If buffer exists and a process is running, just switch to buffer `*SQL*'. PRODUCT is the SQL product. PARAMS is a list of strings which are passed as command line arguments." - (let ((program (sql-get-product-feature product :sqli-program))) + (let ((program (sql-get-product-feature product :sqli-program)) + (buf-name "SQL")) + ;; Make sure buffer name is unique + (when (get-buffer (format "*%s*" buf-name)) + (setq buf-name (format "SQL-%s" product)) + (when (get-buffer (format "*%s*" buf-name)) + (let ((i 1)) + (while (get-buffer (format "*%s*" + (setq buf-name + (format "SQL-%s%d" product i)))) + (setq i (1+ i)))))) (set-buffer - (apply 'make-comint "SQL" program nil params)))) + (apply 'make-comint buf-name program nil params)))) ;;;###autoload -(defun sql-oracle () +(defun sql-oracle (&optional buffer) "Run sqlplus by Oracle as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3252,6 +3468,11 @@ the list `sql-oracle-options'. The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-oracle]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-oracle]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3260,8 +3481,8 @@ The default comes from `process-coding-system-alist' and `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'oracle)) + (interactive "P") + (sql-product-interactive 'oracle buffer)) (defun sql-comint-oracle (product options) "Create comint buffer and connect to Oracle." @@ -3284,7 +3505,7 @@ The default comes from `process-coding-system-alist' and ;;;###autoload -(defun sql-sybase () +(defun sql-sybase (&optional buffer) "Run isql by Sybase as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3299,6 +3520,11 @@ can be stored in the list `sql-sybase-options'. The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-sybase]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-sybase]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3307,8 +3533,8 @@ The default comes from `process-coding-system-alist' and `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'sybase)) + (interactive "P") + (sql-product-interactive 'sybase buffer)) (defun sql-comint-sybase (product options) "Create comint buffer and connect to Sybase." @@ -3328,7 +3554,7 @@ The default comes from `process-coding-system-alist' and ;;;###autoload -(defun sql-informix () +(defun sql-informix (&optional buffer) "Run dbaccess by Informix as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3341,6 +3567,11 @@ the variable `sql-database' as default, if set. The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-informix]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-informix]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3349,8 +3580,8 @@ The default comes from `process-coding-system-alist' and `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'informix)) + (interactive "P") + (sql-product-interactive 'informix buffer)) (defun sql-comint-informix (product options) "Create comint buffer and connect to Informix." @@ -3365,7 +3596,7 @@ The default comes from `process-coding-system-alist' and ;;;###autoload -(defun sql-sqlite () +(defun sql-sqlite (&optional buffer) "Run sqlite as an inferior process. SQLite is free software. @@ -3382,6 +3613,11 @@ can be stored in the list `sql-sqlite-options'. The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-sqlite]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-sqlite]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3390,8 +3626,8 @@ The default comes from `process-coding-system-alist' and `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'sqlite)) + (interactive "P") + (sql-product-interactive 'sqlite buffer)) (defun sql-comint-sqlite (product options) "Create comint buffer and connect to SQLite." @@ -3407,7 +3643,7 @@ The default comes from `process-coding-system-alist' and ;;;###autoload -(defun sql-mysql () +(defun sql-mysql (&optional buffer) "Run mysql by TcX as an inferior process. Mysql versions 3.23 and up are free software. @@ -3424,6 +3660,11 @@ can be stored in the list `sql-mysql-options'. The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-mysql]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-mysql]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3432,8 +3673,8 @@ The default comes from `process-coding-system-alist' and `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'mysql)) + (interactive "P") + (sql-product-interactive 'mysql buffer)) (defun sql-comint-mysql (product options) "Create comint buffer and connect to MySQL." @@ -3444,7 +3685,7 @@ The default comes from `process-coding-system-alist' and (setq params (append (list sql-database) params))) (if (not (string= "" sql-server)) (setq params (append (list (concat "--host=" sql-server)) params))) - (if (and sql-port (numberp sql-port)) + (if (not (= 0 sql-port)) (setq params (append (list (concat "--port=" (number-to-string sql-port))) params))) (if (not (string= "" sql-password)) (setq params (append (list (concat "--password=" sql-password)) params))) @@ -3456,7 +3697,7 @@ The default comes from `process-coding-system-alist' and ;;;###autoload -(defun sql-solid () +(defun sql-solid (&optional buffer) "Run solsql by Solid as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3470,6 +3711,11 @@ defaults, if set. The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-solid]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-solid]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3478,8 +3724,8 @@ The default comes from `process-coding-system-alist' and `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'solid)) + (interactive "P") + (sql-product-interactive 'solid buffer)) (defun sql-comint-solid (product options) "Create comint buffer and connect to Solid." @@ -3497,7 +3743,7 @@ The default comes from `process-coding-system-alist' and ;;;###autoload -(defun sql-ingres () +(defun sql-ingres (&optional buffer) "Run sql by Ingres as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3510,6 +3756,11 @@ the variable `sql-database' as default, if set. The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-ingres]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-ingres]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3518,8 +3769,8 @@ The default comes from `process-coding-system-alist' and `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'ingres)) + (interactive "P") + (sql-product-interactive 'ingres buffer)) (defun sql-comint-ingres (product options) "Create comint buffer and connect to Ingres." @@ -3533,7 +3784,7 @@ The default comes from `process-coding-system-alist' and ;;;###autoload -(defun sql-ms () +(defun sql-ms (&optional buffer) "Run osql by Microsoft as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3548,6 +3799,11 @@ in the list `sql-ms-options'. The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-ms]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-ms]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3556,8 +3812,8 @@ The default comes from `process-coding-system-alist' and `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'ms)) + (interactive "P") + (sql-product-interactive 'ms buffer)) (defun sql-comint-ms (product options) "Create comint buffer and connect to Microsoft SQL Server." @@ -3584,7 +3840,7 @@ The default comes from `process-coding-system-alist' and ;;;###autoload -(defun sql-postgres () +(defun sql-postgres (&optional buffer) "Run psql by Postgres as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3599,6 +3855,11 @@ Additional command line parameters can be stored in the list The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-postgres]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-postgres]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3612,8 +3873,8 @@ Try to set `comint-output-filter-functions' like this: '(comint-strip-ctrl-m))) \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'postgres)) + (interactive "P") + (sql-product-interactive 'postgres buffer)) (defun sql-comint-postgres (product options) "Create comint buffer and connect to Postgres." @@ -3634,7 +3895,7 @@ Try to set `comint-output-filter-functions' like this: ;;;###autoload -(defun sql-interbase () +(defun sql-interbase (&optional buffer) "Run isql by Interbase as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3648,6 +3909,11 @@ defaults, if set. The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-interbase]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-interbase]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3656,8 +3922,8 @@ The default comes from `process-coding-system-alist' and `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'interbase)) + (interactive "P") + (sql-product-interactive 'interbase buffer)) (defun sql-comint-interbase (product options) "Create comint buffer and connect to Interbase." @@ -3675,7 +3941,7 @@ The default comes from `process-coding-system-alist' and ;;;###autoload -(defun sql-db2 () +(defun sql-db2 (&optional buffer) "Run db2 by IBM as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3693,6 +3959,11 @@ db2, newlines will be escaped if necessary. If you don't want that, set `comint-input-sender' back to `comint-simple-send' by writing an after advice. See the elisp manual for more information. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-db2]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + To specify a coding system for converting non-ASCII characters in the input and output to the process, use \\[universal-coding-system-argument] before \\[sql-db2]. You can also specify this with \\[set-buffer-process-coding-system] @@ -3701,8 +3972,8 @@ The default comes from `process-coding-system-alist' and `default-process-coding-system'. \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'db2)) + (interactive "P") + (sql-product-interactive 'db2 buffer)) (defun sql-comint-db2 (product options) "Create comint buffer and connect to DB2." @@ -3710,11 +3981,9 @@ The default comes from `process-coding-system-alist' and ;; make-comint. (sql-comint product options) ) -;; ;; Properly escape newlines when DB2 is interactive. -;; (setq comint-input-sender 'sql-escape-newlines-and-send)) ;;;###autoload -(defun sql-linter () +(defun sql-linter (&optional buffer) "Run inl by RELEX as an inferior process. If buffer `*SQL*' exists but no process is running, make a new process. @@ -3736,9 +4005,14 @@ an empty password. The buffer is put in SQL interactive mode, giving commands for sending input. See `sql-interactive-mode'. +To set the buffer name directly, use \\[universal-argument] +before \\[sql-linter]. Once session has started, +\\[sql-rename-buffer] can be called separately to rename the +buffer. + \(Type \\[describe-mode] in the SQL buffer for a list of commands.)" - (interactive) - (sql-product-interactive 'linter)) + (interactive "P") + (sql-product-interactive 'linter buffer)) (defun sql-comint-linter (product options) "Create comint buffer and connect to Linter." diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index 29096a23046..8f80d13bab6 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -411,9 +411,10 @@ This variable is generally set from `tcl-proc-regexp', `tcl-typeword-list', and `tcl-keyword-list' by the function `tcl-set-font-lock-keywords'.") -(defvar tcl-font-lock-syntactic-keywords - ;; Mark the few `#' that are not comment-markers. - '(("[^;[{ \t\n][ \t]*\\(#\\)" (1 "."))) +(defconst tcl-syntax-propertize-function + (syntax-propertize-rules + ;; Mark the few `#' that are not comment-markers. + ("[^;[{ \t\n][ \t]*\\(#\\)" (1 "."))) "Syntactic keywords for `tcl-mode'.") ;; FIXME need some way to recognize variables because array refs look @@ -593,9 +594,9 @@ Commands: (set (make-local-variable 'outline-level) 'tcl-outline-level) (set (make-local-variable 'font-lock-defaults) - '(tcl-font-lock-keywords nil nil nil beginning-of-defun - (font-lock-syntactic-keywords . tcl-font-lock-syntactic-keywords) - (parse-sexp-lookup-properties . t))) + '(tcl-font-lock-keywords nil nil nil beginning-of-defun)) + (set (make-local-variable 'syntax-propertize-function) + tcl-syntax-propertize-function) (set (make-local-variable 'imenu-generic-expression) tcl-imenu-generic-expression) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 4ff9cf92b8d..24768d93e6a 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -4693,8 +4693,15 @@ Key bindings: (set (make-local-variable 'font-lock-defaults) (list '(nil vhdl-font-lock-keywords) nil - (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line - '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords))) + (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line)) + (if (eval-when-compile (fboundp 'syntax-propertize-rules)) + (set (make-local-variable 'syntax-propertize-function) + (syntax-propertize-rules + ;; Mark single quotes as having string quote syntax in + ;; 'c' instances. + ("\\(\'\\).\\(\'\\)" (1 "\"'") (2 "\"'")))) + (set (make-local-variable 'font-lock-syntactic-keywords) + vhdl-font-lock-syntactic-keywords)) (unless vhdl-emacs-21 (set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode) (set (make-local-variable 'lazy-lock-defer-contextually) nil) @@ -12914,10 +12921,9 @@ This does background highlighting of translate-off regions.") "Re-initialize fontification and fontify buffer." (interactive) (setq font-lock-defaults - (list - 'vhdl-font-lock-keywords nil - (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line - '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords))) + `(vhdl-font-lock-keywords + nil ,(not vhdl-highlight-case-sensitive) ((?\_ . "w")) + beginning-of-line)) (when (fboundp 'font-lock-unset-defaults) (font-lock-unset-defaults)) ; not implemented in XEmacs (font-lock-set-defaults) diff --git a/lisp/ps-bdf.el b/lisp/ps-bdf.el index 65ec4bf101a..585b5f9eb69 100644 --- a/lisp/ps-bdf.el +++ b/lisp/ps-bdf.el @@ -15,6 +15,7 @@ ;; Author: Kenichi Handa <handa@m17n.org> ;; (according to ack.texi) ;; Keywords: wp, BDF, font, PostScript +;; Package: ps-print ;; This file is part of GNU Emacs. diff --git a/lisp/ps-def.el b/lisp/ps-def.el index 5e045bccf9a..c27ee251e08 100644 --- a/lisp/ps-def.el +++ b/lisp/ps-def.el @@ -8,6 +8,7 @@ ;; Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Keywords: wp, print, PostScript ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre +;; Package: ps-print ;; This file is part of GNU Emacs. diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el index 51c4cc20bec..df779fde39d 100644 --- a/lisp/ps-mule.el +++ b/lisp/ps-mule.el @@ -8,6 +8,7 @@ ;; Maintainer: Kenichi Handa <handa@m17n.org> (multi-byte characters) ;; Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Keywords: wp, print, PostScript, multibyte, mule +;; Package: ps-print ;; This file is part of GNU Emacs. diff --git a/lisp/ps-print.el b/lisp/ps-print.el index 7c7397a52bc..02e43ef3f0c 100644 --- a/lisp/ps-print.el +++ b/lisp/ps-print.el @@ -6656,7 +6656,7 @@ If FACE is not a valid face name, use default face." ;; But autoload them here to make the separation invisible. ;;;### (autoloads (ps-mule-end-job ps-mule-begin-job ps-mule-initialize -;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "9187df3473401876e0df4937c311fbaf") +;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "d2fcad95db7404989362657faf744796") ;;; Generated autoloads from ps-mule.el (defvar ps-multibyte-buffer nil "\ diff --git a/lisp/ps-samp.el b/lisp/ps-samp.el index 5ad1c6855d0..9fab290fc52 100644 --- a/lisp/ps-samp.el +++ b/lisp/ps-samp.el @@ -10,6 +10,7 @@ ;; Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Keywords: wp, print, PostScript ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre +;; Package: ps-print ;; This file is part of GNU Emacs. diff --git a/lisp/rect.el b/lisp/rect.el index facc6d51858..66584089910 100644 --- a/lisp/rect.el +++ b/lisp/rect.el @@ -5,6 +5,7 @@ ;; Maintainer: Didier Verna <didier@xemacs.org> ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/register.el b/lisp/register.el index 1a6d84d2c17..97b6eb0dfc8 100644 --- a/lisp/register.el +++ b/lisp/register.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/repeat.el b/lisp/repeat.el index edebbe24a84..eddaf4f020e 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -5,7 +5,7 @@ ;; Author: Will Mengarini <seldon@eskimo.com> ;; Created: Mo 02 Mar 98 -;; Version: 0.51, We 13 May 98 +;; Version: 0.51 ;; Keywords: convenience, vi, repeat ;; This file is part of GNU Emacs. diff --git a/lisp/replace.el b/lisp/replace.el index 01d971f76eb..baea2820433 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -5,6 +5,7 @@ ;; Free Software Foundation, Inc. ;; Maintainer: FSF +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/rfn-eshadow.el b/lisp/rfn-eshadow.el index 7c2cf0f96f5..fa7a9336156 100644 --- a/lisp/rfn-eshadow.el +++ b/lisp/rfn-eshadow.el @@ -5,6 +5,7 @@ ;; ;; Author: Miles Bader <miles@gnu.org> ;; Keywords: convenience minibuffer +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el index ebc00859137..8b8edab0009 100644 --- a/lisp/scroll-bar.el +++ b/lisp/scroll-bar.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: hardware +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/select.el b/lisp/select.el index 842c250df60..3e9cd2d5d53 100644 --- a/lisp/select.el +++ b/lisp/select.el @@ -174,36 +174,6 @@ are not available to other programs." (symbolp data) (integerp data))) -;;; Cut Buffer support - -(declare-function x-get-cut-buffer-internal "xselect.c") - -(defun x-get-cut-buffer (&optional which-one) - "Return the value of one of the 8 X server cut-buffers. -Optional arg WHICH-ONE should be a number from 0 to 7, defaulting to 0. -Cut buffers are considered obsolete; you should use selections instead." - (x-get-cut-buffer-internal - (if which-one - (aref [CUT_BUFFER0 CUT_BUFFER1 CUT_BUFFER2 CUT_BUFFER3 - CUT_BUFFER4 CUT_BUFFER5 CUT_BUFFER6 CUT_BUFFER7] - which-one) - 'CUT_BUFFER0))) - -(declare-function x-rotate-cut-buffers-internal "xselect.c") -(declare-function x-store-cut-buffer-internal "xselect.c") - -(defun x-set-cut-buffer (string &optional push) - "Store STRING into the X server's primary cut buffer. -If PUSH is non-nil, also rotate the cut buffers: -this means the previous value of the primary cut buffer moves to the second -cut buffer, and the second to the third, and so on (there are 8 buffers.) -Cut buffers are considered obsolete; you should use selections instead." - (or (stringp string) (signal 'wrong-type-argument (list 'stringp string))) - (if push - (x-rotate-cut-buffers-internal 1)) - (x-store-cut-buffer-internal 'CUT_BUFFER0 string)) - - ;; Functions to convert the selection into various other selection types. ;; Every selection type that Emacs handles is implemented this way, except ;; for TIMESTAMP, which is a special case. diff --git a/lisp/server.el b/lisp/server.el index b2cb829adf7..f0e88d03612 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1093,9 +1093,7 @@ The following commands are accepted by the client: (condition-case err (let* ((buffers (when files - (run-hooks 'pre-command-hook) - (prog1 (server-visit-files files proc nowait) - (run-hooks 'post-command-hook))))) + (server-visit-files files proc nowait)))) (mapc 'funcall (nreverse commands)) @@ -1166,8 +1164,13 @@ so don't mark these buffers specially, just visit them normally." (obuf (get-file-buffer filen))) (add-to-history 'file-name-history filen) (if (null obuf) - (set-buffer (find-file-noselect filen)) + (progn + (run-hooks 'pre-command-hook) + (set-buffer (find-file-noselect filen))) (set-buffer obuf) + ;; separately for each file, in sync with post-command hooks, + ;; with the new buffer current: + (run-hooks 'pre-command-hook) (cond ((file-exists-p filen) (when (not (verify-visited-file-modtime obuf)) (revert-buffer t nil))) @@ -1179,7 +1182,9 @@ so don't mark these buffers specially, just visit them normally." (unless server-buffer-clients (setq server-existing-buffer t))) (server-goto-line-column (cdr file)) - (run-hooks 'server-visit-hook)) + (run-hooks 'server-visit-hook) + ;; hooks may be specific to current buffer: + (run-hooks 'post-command-hook)) (unless nowait ;; When the buffer is killed, inform the clients. (add-hook 'kill-buffer-hook 'server-kill-buffer nil t) diff --git a/lisp/sha1.el b/lisp/sha1.el index 351af62783e..0d97ac6ce4b 100644 --- a/lisp/sha1.el +++ b/lisp/sha1.el @@ -439,5 +439,4 @@ If BINARY is non-nil, return a string in binary form." (provide 'sha1) -;; arch-tag: c0f9abd0-ffc1-4557-aac6-ece7f2d4c901 ;;; sha1.el ends here diff --git a/lisp/simple.el b/lisp/simple.el index 0ac199ea2f6..36931c7777c 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -6,6 +6,7 @@ ;; Maintainer: FSF ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. @@ -424,6 +425,19 @@ Other major modes are defined by comparison with this one." ;; Major mode meant to be the parent of programming modes. +(defvar prog-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [?\C-\M-q] 'prog-indent-sexp) + map) + "Keymap used for programming modes.") + +(defun prog-indent-sexp () + "Indent the expression after point." + (interactive) + (let ((start (point)) + (end (save-excursion (forward-sexp 1) (point)))) + (indent-region start end nil))) + (define-derived-mode prog-mode fundamental-mode "Prog" "Major mode for editing programming language source code." (set (make-local-variable 'require-final-newline) mode-require-final-newline) @@ -443,72 +457,43 @@ Call `auto-fill-function' if the current column number is greater than the value of `fill-column' and ARG is nil." (interactive "*P") (barf-if-buffer-read-only) - ;; Inserting a newline at the end of a line produces better redisplay in - ;; try_window_id than inserting at the beginning of a line, and the textual - ;; result is the same. So, if we're at beginning of line, pretend to be at - ;; the end of the previous line. - (let ((flag (and (not (bobp)) - (bolp) - ;; Make sure no functions want to be told about - ;; the range of the changes. - (not after-change-functions) - (not before-change-functions) - ;; Make sure there are no markers here. - (not (buffer-has-markers-at (1- (point)))) - (not (buffer-has-markers-at (point))) - ;; Make sure no text properties want to know - ;; where the change was. - (not (get-char-property (1- (point)) 'modification-hooks)) - (not (get-char-property (1- (point)) 'insert-behind-hooks)) - (or (eobp) - (not (get-char-property (point) 'insert-in-front-hooks))) - ;; Make sure the newline before point isn't intangible. - (not (get-char-property (1- (point)) 'intangible)) - ;; Make sure the newline before point isn't read-only. - (not (get-char-property (1- (point)) 'read-only)) - ;; Make sure the newline before point isn't invisible. - (not (get-char-property (1- (point)) 'invisible)) - ;; Make sure the newline before point has the same - ;; properties as the char before it (if any). - (< (or (previous-property-change (point)) -2) - (- (point) 2)))) - (was-page-start (and (bolp) - (looking-at page-delimiter))) - (beforepos (point))) - (if flag (backward-char 1)) - ;; Call self-insert so that auto-fill, abbrev expansion etc. happens. - ;; Set last-command-event to tell self-insert what to insert. - (let ((last-command-event ?\n) - ;; Don't auto-fill if we have a numeric argument. - ;; Also not if flag is true (it would fill wrong line); - ;; there is no need to since we're at BOL. - (auto-fill-function (if (or arg flag) nil auto-fill-function))) - (unwind-protect - (self-insert-command (prefix-numeric-value arg)) - ;; If we get an error in self-insert-command, put point at right place. - (if flag (forward-char 1)))) - ;; Even if we did *not* get an error, keep that forward-char; - ;; all further processing should apply to the newline that the user - ;; thinks he inserted. - - ;; Mark the newline(s) `hard'. - (if use-hard-newlines - (set-hard-newline-properties - (- (point) (prefix-numeric-value arg)) (point))) - ;; If the newline leaves the previous line blank, - ;; and we have a left margin, delete that from the blank line. - (or flag - (save-excursion - (goto-char beforepos) - (beginning-of-line) - (and (looking-at "[ \t]$") - (> (current-left-margin) 0) - (delete-region (point) (progn (end-of-line) (point)))))) - ;; Indent the line after the newline, except in one case: - ;; when we added the newline at the beginning of a line - ;; which starts a page. - (or was-page-start - (move-to-left-margin nil t))) + ;; Call self-insert so that auto-fill, abbrev expansion etc. happens. + ;; Set last-command-event to tell self-insert what to insert. + (let* ((was-page-start (and (bolp) (looking-at page-delimiter))) + (beforepos (point)) + (last-command-event ?\n) + ;; Don't auto-fill if we have a numeric argument. + (auto-fill-function (if arg nil auto-fill-function)) + (postproc + ;; Do the rest in post-self-insert-hook, because we want to do it + ;; *before* other functions on that hook. + (lambda () + ;; Mark the newline(s) `hard'. + (if use-hard-newlines + (set-hard-newline-properties + (- (point) (prefix-numeric-value arg)) (point))) + ;; If the newline leaves the previous line blank, and we + ;; have a left margin, delete that from the blank line. + (save-excursion + (goto-char beforepos) + (beginning-of-line) + (and (looking-at "[ \t]$") + (> (current-left-margin) 0) + (delete-region (point) + (line-end-position)))) + ;; Indent the line after the newline, except in one case: + ;; when we added the newline at the beginning of a line which + ;; starts a page. + (or was-page-start + (move-to-left-margin nil t))))) + (unwind-protect + (progn + (add-hook 'post-self-insert-hook postproc) + (self-insert-command (prefix-numeric-value arg))) + ;; We first used let-binding to protect the hook, but that was naive + ;; since add-hook affects the symbol-default value of the variable, + ;; whereas the let-binding might only protect the buffer-local value. + (remove-hook 'post-self-insert-hook postproc))) nil) (defun set-hard-newline-properties (from to) @@ -790,15 +775,16 @@ If BACKWARD-ONLY is non-nil, only delete them before point." (constrain-to-field nil orig-pos t))))) (defun beginning-of-buffer (&optional arg) - "Move point to the beginning of the buffer; leave mark at previous position. -With \\[universal-argument] prefix, do not set mark at previous position. + "Move point to the beginning of the buffer. With numeric arg N, put point N/10 of the way from the beginning. +If the buffer is narrowed, this command uses the beginning of the +accessible part of the buffer. -If the buffer is narrowed, this command uses the beginning and size -of the accessible part of the buffer. +If Transient Mark mode is disabled, leave mark at previous +position, unless a \\[universal-argument] prefix is supplied. Don't use this command in Lisp programs! -\(goto-char (point-min)) is faster and avoids clobbering the mark." +\(goto-char (point-min)) is faster." (interactive "^P") (or (consp arg) (region-active-p) @@ -815,15 +801,16 @@ Don't use this command in Lisp programs! (if (and arg (not (consp arg))) (forward-line 1))) (defun end-of-buffer (&optional arg) - "Move point to the end of the buffer; leave mark at previous position. -With \\[universal-argument] prefix, do not set mark at previous position. + "Move point to the end of the buffer. With numeric arg N, put point N/10 of the way from the end. +If the buffer is narrowed, this command uses the end of the +accessible part of the buffer. -If the buffer is narrowed, this command uses the beginning and size -of the accessible part of the buffer. +If Transient Mark mode is disabled, leave mark at previous +position, unless a \\[universal-argument] prefix is supplied. Don't use this command in Lisp programs! -\(goto-char (point-max)) is faster and avoids clobbering the mark." +\(goto-char (point-max)) is faster." (interactive "^P") (or (consp arg) (region-active-p) (push-mark)) (let ((size (- (point-max) (point-min)))) @@ -1288,6 +1275,40 @@ to get different commands to edit and resubmit." (if command-history (error "Argument %d is beyond length of command history" arg) (error "There are no previous complex commands to repeat"))))) + +(defun read-extended-command () + "Read command name to invoke in `execute-extended-command'." + (minibuffer-with-setup-hook + (lambda () + (set (make-local-variable 'minibuffer-default-add-function) + (lambda () + ;; Get a command name at point in the original buffer + ;; to propose it after M-n. + (with-current-buffer (window-buffer (minibuffer-selected-window)) + (and (commandp (function-called-at-point)) + (format "%S" (function-called-at-point))))))) + ;; Read a string, completing from and restricting to the set of + ;; all defined commands. Don't provide any initial input. + ;; Save the command read on the extended-command history list. + (completing-read + (concat (cond + ((eq current-prefix-arg '-) "- ") + ((and (consp current-prefix-arg) + (eq (car current-prefix-arg) 4)) "C-u ") + ((and (consp current-prefix-arg) + (integerp (car current-prefix-arg))) + (format "%d " (car current-prefix-arg))) + ((integerp current-prefix-arg) + (format "%d " current-prefix-arg))) + ;; This isn't strictly correct if `execute-extended-command' + ;; is bound to anything else (e.g. [menu]). + ;; It could use (key-description (this-single-command-keys)), + ;; but actually a prompt other than "M-x" would be confusing, + ;; because "M-x" is a well-known prompt to read a command + ;; and it serves as a shorthand for "Extended command: ". + "M-x ") + obarray 'commandp t nil 'extended-command-history))) + (defvar minibuffer-history nil "Default minibuffer history list. @@ -2879,11 +2900,8 @@ This variable holds a function that Emacs calls whenever text is put in the kill ring, to make the new kill available to other programs. -The function takes one or two arguments. -The first argument, TEXT, is a string containing -the text which should be made available. -The second, optional, argument PUSH, has the same meaning as the -similar argument to `x-set-cut-buffer', which see.") +The function takes one argument, TEXT, which is a string containing +the text which should be made available.") (defvar interprogram-paste-function nil "Function to call to get text cut from other programs. @@ -3000,7 +3018,7 @@ argument should still be a \"useful\" string for such uses." (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))) (setq kill-ring-yank-pointer kill-ring) (if interprogram-cut-function - (funcall interprogram-cut-function string (not replace)))) + (funcall interprogram-cut-function string))) (defun kill-append (string before-p &optional yank-handler) "Append STRING to the end of the latest kill in the kill ring. @@ -3090,7 +3108,8 @@ If the buffer is read-only, Emacs will beep and refrain from deleting the text, but put the text in the kill ring anyway. This means that you can use the killing commands to copy text from a read-only buffer. -This is the primitive for programs to kill text (as opposed to deleting it). +Lisp programs should use this function for killing text. + (To delete text, use `delete-region'.) Supply two arguments, character positions indicating the stretch of text to be killed. Any command that calls this function is a \"kill command\". @@ -3674,7 +3693,9 @@ Unless FORCE is non-nil, this function does nothing if Transient Mark mode is disabled. This function also runs `deactivate-mark-hook'." (when (or transient-mark-mode force) - (when (and select-active-regions + (when (and (if (eq select-active-regions 'only) + (eq (car-safe transient-mark-mode) 'only) + select-active-regions) (region-active-p) (display-selections-p)) ;; The var `saved-region-selection', if non-nil, is the text in @@ -5453,21 +5474,40 @@ it skips the contents of comments that end before point." :type 'boolean :group 'paren-blinking) +(defun blink-matching-check-mismatch (start end) + "Return whether or not START...END are matching parens. +END is the current point and START is the blink position. +START might be nil if no matching starter was found. +Returns non-nil if we find there is a mismatch." + (let* ((end-syntax (syntax-after (1- end))) + (matching-paren (and (consp end-syntax) + (eq (syntax-class end-syntax) 5) + (cdr end-syntax)))) + ;; For self-matched chars like " and $, we can't know when they're + ;; mismatched or unmatched, so we can only do it for parens. + (when matching-paren + (not (and start + (or + (eq (char-after start) matching-paren) + ;; The cdr might hold a new paren-class info rather than + ;; a matching-char info, in which case the two CDRs + ;; should match. + (eq matching-paren (cdr-safe (syntax-after start))))))))) + +(defvar blink-matching-check-function #'blink-matching-check-mismatch + "Function to check parentheses mismatches. +The function takes two arguments (START and END) where START is the +position just before the opening token and END is the position right after. +START can be nil, if it was not found. +The function should return non-nil if the two tokens do not match.") + (defun blink-matching-open () "Move cursor momentarily to the beginning of the sexp before point." (interactive) - (when (and (> (point) (point-min)) - blink-matching-paren - ;; Verify an even number of quoting characters precede the close. - (= 1 (logand 1 (- (point) - (save-excursion - (forward-char -1) - (skip-syntax-backward "/\\") - (point)))))) + (when (and (not (bobp)) + blink-matching-paren) (let* ((oldpos (point)) - (message-log-max nil) ; Don't log messages about paren matching. - (atdollar (eq (syntax-class (syntax-after (1- oldpos))) 8)) - (isdollar) + (message-log-max nil) ; Don't log messages about paren matching. (blinkpos (save-excursion (save-restriction @@ -5480,38 +5520,28 @@ it skips the contents of comments that end before point." (and parse-sexp-ignore-comments (not blink-matching-paren-dont-ignore-comments)))) (condition-case () - (scan-sexps oldpos -1) + (progn + (forward-sexp -1) + ;; backward-sexp skips backward over prefix chars, + ;; so move back to the matching paren. + (while (and (< (point) (1- oldpos)) + (let ((code (car (syntax-after (point))))) + (or (eq (logand 65536 code) 6) + (eq (logand 1048576 code) 1048576)))) + (forward-char 1)) + (point)) (error nil)))))) - (matching-paren - (and blinkpos - ;; Not syntax '$'. - (not (setq isdollar - (eq (syntax-class (syntax-after blinkpos)) 8))) - (let ((syntax (syntax-after blinkpos))) - (and (consp syntax) - (eq (syntax-class syntax) 4) - (cdr syntax)))))) + (mismatch (funcall blink-matching-check-function blinkpos oldpos))) (cond - ;; isdollar is for: - ;; http://lists.gnu.org/archive/html/emacs-devel/2007-10/msg00871.html - ((not (or (and isdollar blinkpos) - (and atdollar (not blinkpos)) ; see below - (eq matching-paren (char-before oldpos)) - ;; The cdr might hold a new paren-class info rather than - ;; a matching-char info, in which case the two CDRs - ;; should match. - (eq matching-paren (cdr (syntax-after (1- oldpos)))))) - (if (minibufferp) - (minibuffer-message " [Mismatched parentheses]") - (message "Mismatched parentheses"))) - ((not blinkpos) - (or blink-matching-paren-distance - ;; Don't complain when `$' with no blinkpos, because it - ;; could just be the first one typed in the buffer. - atdollar + (mismatch + (if blinkpos (if (minibufferp) - (minibuffer-message " [Unmatched parenthesis]") - (message "Unmatched parenthesis")))) + (minibuffer-message " [Mismatched parentheses]") + (message "Mismatched parentheses")) + (if (minibufferp) + (minibuffer-message " [Unmatched parenthesis]") + (message "Unmatched parenthesis")))) + ((not blinkpos) nil) ((pos-visible-in-window-p blinkpos) ;; Matching open within window, temporarily move to blinkpos but only ;; if `blink-matching-paren-on-screen' is non-nil. @@ -5554,7 +5584,29 @@ it skips the contents of comments that end before point." (message "Matches %s" (substring-no-properties open-paren-line-string))))))))) -(setq blink-paren-function 'blink-matching-open) +(defvar blink-paren-function 'blink-matching-open + "Function called, if non-nil, whenever a close parenthesis is inserted. +More precisely, a char with closeparen syntax is self-inserted.") + +(defun blink-paren-post-self-insert-function () + (when (and (eq (char-before) last-command-event) ; Sanity check. + (memq (char-syntax last-command-event) '(?\) ?\$)) + blink-paren-function + (not executing-kbd-macro) + (not noninteractive) + ;; Verify an even number of quoting characters precede the close. + (= 1 (logand 1 (- (point) + (save-excursion + (forward-char -1) + (skip-syntax-backward "/\\") + (point)))))) + (funcall blink-paren-function))) + +(add-hook 'post-self-insert-hook #'blink-paren-post-self-insert-function + ;; Most likely, this hook is nil, so this arg doesn't matter, + ;; but I use it as a reminder that this function usually + ;; likes to be run after others since it does `sit-for'. + 'append) ;; This executes C-g typed while Emacs is waiting for a command. ;; Quitting out of a program does not go through here; diff --git a/lisp/startup.el b/lisp/startup.el index 76e11491c0c..c029eff54cf 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -6,6 +6,7 @@ ;; Maintainer: FSF ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. @@ -785,15 +786,16 @@ opening the first frame (e.g. open a connection to an X server).") argi (match-string 1 argi))) (when (string-match "\\`--." orig-argi) (let ((completion (try-completion argi longopts))) - (if (eq completion t) - (setq argi (substring argi 1)) - (if (stringp completion) - (let ((elt (assoc completion longopts))) - (or elt - (error "Option `%s' is ambiguous" argi)) - (setq argi (substring (car elt) 1))) - (setq argval nil - argi orig-argi))))) + (cond ((eq completion t) + (setq argi (substring argi 1))) + ((stringp completion) + (let ((elt (assoc completion longopts))) + (unless elt + (error "Option `%s' is ambiguous" argi)) + (setq argi (substring (car elt) 1)))) + (t + (setq argval nil + argi orig-argi))))) (cond ;; The --display arg is handled partly in C, partly in Lisp. ;; When it shows up here, we just put it back to be handled @@ -2231,6 +2233,11 @@ A fancy display is used on graphic displays, normal otherwise." (move-to-column (1- cl1-column))) (setq cl1-column 0)) + ;; These command lines now have no effect. + ((string-match "\\`--?\\(no-\\)?\\(uni\\|multi\\)byte$" argi) + (display-warning 'initialization + (format "Ignoring obsolete arg %s" argi))) + ((equal argi "--") (setq just-files t)) (t diff --git a/lisp/subr.el b/lisp/subr.el index c490bb89d02..c30b42aba8f 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. @@ -219,6 +220,7 @@ Treated as a declaration when used at the right place in a (defmacro ignore-errors (&rest body) "Execute BODY; if an error occurs, return nil. Otherwise, return result of last form in BODY." + (declare (debug t) (indent 0)) `(condition-case nil (progn ,@body) (error nil))) ;;;; Basic Lisp functions. @@ -1634,6 +1636,7 @@ Return nil if there isn't one." load-elt (and loads (car loads))))) load-elt)) +(put 'eval-after-load 'lisp-indent-function 1) (defun eval-after-load (file form) "Arrange that, if FILE is ever loaded, FORM will be run at that time. If FILE is already loaded, evaluate FORM right now. @@ -1824,6 +1827,7 @@ When there's an ambiguity because the key looks like the prefix of some sort of escape sequence, the ambiguity is resolved via `read-key-delay'." (let ((overriding-terminal-local-map read-key-empty-map) (overriding-local-map nil) + (echo-keystrokes 0) (old-global-map (current-global-map)) (timer (run-with-idle-timer ;; Wait long enough that Emacs has the time to receive and @@ -1848,7 +1852,12 @@ some sort of escape sequence, the ambiguity is resolved via `read-key-delay'." (throw 'read-key keys))))))) (unwind-protect (progn - (use-global-map read-key-empty-map) + (use-global-map + (let ((map (make-sparse-keymap))) + ;; Don't hide the menu-bar and tool-bar entries. + (define-key map [menu-bar] (lookup-key global-map [menu-bar])) + (define-key map [tool-bar] (lookup-key global-map [tool-bar])) + map)) (aref (catch 'read-key (read-key-sequence-vector prompt nil t)) 0)) (cancel-timer timer) (use-global-map old-global-map)))) @@ -2711,7 +2720,7 @@ nor the buffer list." "Create a new buffer, evaluate BODY there, and write the buffer to FILE. The value returned is the value of the last form in BODY. See also `with-temp-buffer'." - (declare (debug t)) + (declare (indent 1) (debug t)) (let ((temp-file (make-symbol "temp-file")) (temp-buffer (make-symbol "temp-buffer"))) `(let ((,temp-file ,file) @@ -2733,7 +2742,7 @@ The value returned is the value of the last form in BODY. MESSAGE is written to the message log buffer if `message-log-max' is non-nil. If MESSAGE is nil, the echo area and message log buffer are unchanged. Use a MESSAGE of \"\" to temporarily clear the echo area." - (declare (debug t)) + (declare (debug t) (indent 1)) (let ((current-message (make-symbol "current-message")) (temp-message (make-symbol "with-temp-message"))) `(let ((,temp-message ,message) @@ -2763,7 +2772,7 @@ See also `with-temp-file' and `with-output-to-string'." (kill-buffer ,temp-buffer))))))) (defmacro with-silent-modifications (&rest body) - "Execute BODY, pretending it does not modifies the buffer. + "Execute BODY, pretending it does not modify the buffer. If BODY performs real modifications to the buffer's text, other than cosmetic ones, undo data may become corrupted. Typically used around modifications of text-properties which do not really @@ -3225,7 +3234,7 @@ that can be added." The syntax table of the current buffer is saved, BODY is evaluated, and the saved table is restored, even in case of an abnormal exit. Value is what BODY returns." - (declare (debug t)) + (declare (debug t) (indent 1)) (let ((old-table (make-symbol "table")) (old-buffer (make-symbol "buffer"))) `(let ((,old-table (syntax-table)) @@ -3355,6 +3364,52 @@ clone should be incorporated in the clone." (overlay-put ol2 'evaporate t) (overlay-put ol2 'text-clones dups))) +;;;; Misc functions moved over from the C side. + +(defun y-or-n-p (prompt) + "Ask user a \"y or n\" question. Return t if answer is \"y\". +The argument PROMPT is the string to display to ask the question. +It should end in a space; `y-or-n-p' adds `(y or n) ' to it. +No confirmation of the answer is requested; a single character is enough. +Also accepts Space to mean yes, or Delete to mean no. \(Actually, it uses +the bindings in `query-replace-map'; see the documentation of that variable +for more information. In this case, the useful bindings are `act', `skip', +`recenter', and `quit'.\) + +Under a windowing system a dialog box will be used if `last-nonmenu-event' +is nil and `use-dialog-box' is non-nil." + ;; ¡Beware! when I tried to edebug this code, Emacs got into a weird state + ;; where all the keys were unbound (i.e. it somehow got triggered + ;; within read-key, apparently). I had to kill it. + (let ((answer 'none) + (xprompt prompt)) + (if (and (display-popup-menus-p) + (listp last-nonmenu-event) + use-dialog-box) + (setq answer + (x-popup-dialog t `(,prompt ("yes" . act) ("No" . skip)))) + (while + (let* ((key + (let ((cursor-in-echo-area t)) + (when minibuffer-auto-raise + (raise-frame (window-frame (minibuffer-window)))) + (read-key (propertize xprompt 'face 'minibuffer-prompt))))) + (setq answer (lookup-key query-replace-map (vector key) t)) + (cond + ((memq answer '(skip act)) nil) + ((eq answer 'recenter) (recenter) t) + ((memq answer '(exit-prefix quit)) (signal 'quit nil) t) + (t t))) + (ding) + (discard-input) + (setq xprompt + (if (eq answer 'recenter) prompt + (concat "Please answer y or n. " prompt))))) + (let ((ret (eq answer 'act))) + (unless noninteractive + (message "%s %s" prompt (if ret "y" "n"))) + ret))) + ;;;; Mail user agents. ;; Here we include just enough for other packages to be able @@ -3583,11 +3638,11 @@ Usually the separator is \".\", but it can be any other string.") (defconst version-regexp-alist - '(("^[-_+ ]?a\\(lpha\\)?$" . -3) + '(("^[-_+ ]?alpha$" . -3) ("^[-_+]$" . -3) ; treat "1.2.3-20050920" and "1.2-3" as alpha releases ("^[-_+ ]cvs$" . -3) ; treat "1.2.3-CVS" as alpha release - ("^[-_+ ]?b\\(eta\\)?$" . -2) - ("^[-_+ ]?\\(pre\\|rc\\)$" . -1)) + ("^[-_+ ]?beta$" . -2) + ("^[-_+ ]?\\(pre\\|rcc\\)$" . -1)) "*Specify association between non-numeric version and its priority. This association is used to handle version string like \"1.0pre2\", @@ -3680,8 +3735,13 @@ See documentation for `version-separator' and `version-regexp-alist'." (setq al version-regexp-alist) (while (and al (not (string-match (caar al) s))) (setq al (cdr al))) - (or al (error "Invalid version syntax: '%s'" ver)) - (setq lst (cons (cdar al) lst))))) + (cond (al + (push (cdar al) lst)) + ;; Convert 22.3a to 22.3.1. + ((string-match "^[-_+ ]?\\([a-zA-Z]\\)$" s) + (push (- (aref (downcase (match-string 1 s)) 0) ?a -1) + lst)) + (t (error "Invalid version syntax: '%s'" ver)))))) (if (null lst) (error "Invalid version syntax: '%s'" ver) (nreverse lst))))) diff --git a/lisp/tabify.el b/lisp/tabify.el index c8cf877cb9c..591a9432fe5 100644 --- a/lisp/tabify.el +++ b/lisp/tabify.el @@ -4,6 +4,7 @@ ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Maintainer: FSF +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/term.el b/lisp/term.el index d5e0d149ae5..80f5dcdc01a 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -1231,8 +1231,7 @@ without any interpretation." (if (featurep 'xemacs) (term-send-raw-string (or (condition-case () (x-get-selection) (error ())) - (x-get-cutbuffer) - (error "No selection or cut buffer available"))) + (error "No selection available"))) ;; Give temporary modes such as isearch a chance to turn off. (run-hooks 'mouse-leave-buffer-hook) (setq this-command 'yank) diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index f73b3d7e67e..dd386fe1338 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -293,7 +293,7 @@ The properties returned may include `top', `left', `height', and `width'." (unless (terminal-parameter frame 'x-setup-function-keys) (with-selected-frame frame (setq interprogram-cut-function 'x-select-text - interprogram-paste-function 'x-cut-buffer-or-selection-value) + interprogram-paste-function 'x-selection-value) (let ((map (copy-keymap ns-alternatives-map))) (set-keymap-parent map (keymap-parent local-function-key-map)) (set-keymap-parent local-function-key-map map)) @@ -1003,7 +1003,7 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") (defun ns-get-pasteboard () "Returns the value of the pasteboard." - (ns-get-cut-buffer-internal 'PRIMARY)) + (ns-get-cut-buffer-internal 'CLIPBOARD)) (declare-function ns-store-cut-buffer-internal "nsselect.m" (buffer string)) @@ -1011,27 +1011,25 @@ See the documentation of `create-fontset-from-fontset-spec' for the format.") "Store STRING into the pasteboard of the Nextstep display server." ;; Check the data type of STRING. (if (not (stringp string)) (error "Nonstring given to pasteboard")) - (ns-store-cut-buffer-internal 'PRIMARY string)) + (ns-store-cut-buffer-internal 'CLIPBOARD string)) ;; We keep track of the last text selected here, so we can check the ;; current selection against it, and avoid passing back our own text -;; from x-cut-buffer-or-selection-value. +;; from x-selection-value. (defvar ns-last-selected-text nil) -(defun x-select-text (text &optional push) +(defun x-select-text (text) "Select TEXT, a string, according to the window system. -On X, put TEXT in the primary X selection. For backward -compatibility with older X applications, set the value of X cut -buffer 0 as well, and if the optional argument PUSH is non-nil, -rotate the cut buffers. If `x-select-enable-clipboard' is -non-nil, copy the text to the X clipboard as well. +On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the +clipboard. If `x-select-enable-primary' is non-nil, put TEXT in +the primary selection. On Windows, make TEXT the current selection. If `x-select-enable-clipboard' is non-nil, copy the text to the -clipboard as well. The argument PUSH is ignored. +clipboard as well. -On Nextstep, put TEXT in the pasteboard; PUSH is ignored." +On Nextstep, put TEXT in the pasteboard." ;; Don't send the pasteboard too much text. ;; It becomes slow, and if really big it causes errors. (ns-set-pasteboard text) @@ -1040,11 +1038,10 @@ On Nextstep, put TEXT in the pasteboard; PUSH is ignored." ;; Return the value of the current Nextstep selection. For ;; compatibility with older Nextstep applications, this checks cut ;; buffer 0 before retrieving the value of the primary selection. -(defun x-cut-buffer-or-selection-value () +(defun x-selection-value () (let (text) - ;; Consult the selection, then the cut buffer. Treat empty strings - ;; as if they were unset. + ;; Consult the selection. Treat empty strings as if they were unset. (or text (setq text (ns-get-pasteboard))) (if (string= text "") (setq text nil)) diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el index d9d4e3851fe..b52e408b193 100644 --- a/lisp/term/pc-win.el +++ b/lisp/term/pc-win.el @@ -192,11 +192,11 @@ the operating system.") ;; From lisp/term/w32-win.el ; -;;;; Selections and cut buffers +;;;; Selections ; ;;; We keep track of the last text selected here, so we can check the ;;; current selection against it, and avoid passing back our own text -;;; from x-cut-buffer-or-selection-value. +;;; from x-selection-value. (defvar x-last-selected-text nil) (defcustom x-select-enable-clipboard t @@ -209,27 +209,24 @@ set by Emacs is not accessible to other programs on Windows.\)" :type 'boolean :group 'killing) -(defun x-select-text (text &optional push) +(defun x-select-text (text) "Select TEXT, a string, according to the window system. -On X, put TEXT in the primary X selection. For backward -compatibility with older X applications, set the value of X cut -buffer 0 as well, and if the optional argument PUSH is non-nil, -rotate the cut buffers. If `x-select-enable-clipboard' is -non-nil, copy the text to the X clipboard as well. +On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the +clipboard. If `x-select-enable-primary' is non-nil, put TEXT in +the primary selection. On Windows, make TEXT the current selection. If `x-select-enable-clipboard' is non-nil, copy the text to the -clipboard as well. The argument PUSH is ignored. +clipboard as well. -On Nextstep, put TEXT in the pasteboard; PUSH is ignored." +On Nextstep, put TEXT in the pasteboard." (if x-select-enable-clipboard (w16-set-clipboard-data text)) (setq x-last-selected-text text)) ;;; Return the value of the current selection. -;;; Consult the selection, then the cut buffer. Treat empty strings -;;; as if they were unset. +;;; Consult the selection. Treat empty strings as if they were unset. (defun x-get-selection-value () (if x-select-enable-clipboard (let (text) diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 65ba534de42..b19e0f854d9 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1192,32 +1192,19 @@ as returned by `x-server-vendor'." ;; #x0dde THAI MAIHANAKAT Thai -;;;; Selections and cut buffers +;;;; Selections ;; We keep track of the last text selected here, so we can check the ;; current selection against it, and avoid passing back our own text -;; from x-cut-buffer-or-selection-value. We track all three +;; from x-selection-value. We track both ;; separately in case another X application only sets one of them -;; (say the cut buffer) we aren't fooled by the PRIMARY or -;; CLIPBOARD selection staying the same. +;; we aren't fooled by the PRIMARY or CLIPBOARD selection staying the same. (defvar x-last-selected-text-clipboard nil "The value of the CLIPBOARD X selection last time we selected or pasted text.") (defvar x-last-selected-text-primary nil "The value of the PRIMARY X selection last time we selected or pasted text.") -(defvar x-last-selected-text-cut nil - "The value of the X cut buffer last time we selected or pasted text. -The actual text stored in the X cut buffer is what encoded from this value.") -(defvar x-last-selected-text-cut-encoded nil - "The value of the X cut buffer last time we selected or pasted text. -This is the actual text stored in the X cut buffer.") -(defvar x-last-cut-buffer-coding 'iso-latin-1 - "The coding we last used to encode/decode the text from the X cut buffer") - -(defvar x-cut-buffer-max 20000 ; Note this value is overridden below. - "Max number of characters to put in the cut buffer. -It is said that overlarge strings are slow to put into the cut buffer.") (defcustom x-select-enable-clipboard t "Non-nil means cutting and pasting uses the clipboard. @@ -1232,29 +1219,20 @@ This is in addition to, but in preference to, the primary selection." :group 'killing :version "24.1") -(defun x-select-text (text &optional push) +(defun x-select-text (text) "Select TEXT, a string, according to the window system. -If `x-select-enable-clipboard' is non-nil, copy TEXT to the + +On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the clipboard. If `x-select-enable-primary' is non-nil, put TEXT in -the primary selection. For backward compatibility with older X -applications, this function also sets the value of X cut buffer -0, and, if the optional argument PUSH is non-nil, rotates the cut -buffers." +the primary selection. + +On Windows, make TEXT the current selection. If +`x-select-enable-clipboard' is non-nil, copy the text to the +clipboard as well. + +On Nextstep, put TEXT in the pasteboard." ;; With multi-tty, this function may be called from a tty frame. (when (eq (framep (selected-frame)) 'x) - ;; Don't send the cut buffer too much text. - ;; It becomes slow, and if really big it causes errors. - (cond ((>= (length text) x-cut-buffer-max) - (x-set-cut-buffer "" push) - (setq x-last-selected-text-cut "" - x-last-selected-text-cut-encoded "")) - (t - (setq x-last-selected-text-cut text - x-last-cut-buffer-coding 'iso-latin-1 - x-last-selected-text-cut-encoded - ;; ICCCM says cut buffer always contain ISO-Latin-1 - (encode-coding-string text 'iso-latin-1)) - (x-set-cut-buffer x-last-selected-text-cut-encoded push))) (when x-select-enable-primary (x-set-selection 'PRIMARY text) (setq x-last-selected-text-primary text)) @@ -1282,7 +1260,7 @@ The value nil is the same as this list: ;; The return value is already decoded. If x-get-selection causes an ;; error, this function return nil. -(defun x-selection-value (type) +(defun x-selection-value-internal (type) (let ((request-type (or x-select-request-type '(UTF8_STRING COMPOUND_TEXT STRING))) text) @@ -1300,17 +1278,16 @@ The value nil is the same as this list: text)) ;; Return the value of the current X selection. -;; Consult the selection, and the cut buffer. Treat empty strings -;; as if they were unset. +;; Consult the selection. Treat empty strings as if they were unset. ;; If this function is called twice and finds the same text, ;; it returns nil the second time. This is so that a single ;; selection won't be added to the kill ring over and over. -(defun x-cut-buffer-or-selection-value () +(defun x-selection-value () ;; With multi-tty, this function may be called from a tty frame. (when (eq (framep (selected-frame)) 'x) - (let (clip-text primary-text cut-text) + (let (clip-text primary-text) (when x-select-enable-clipboard - (setq clip-text (x-selection-value 'CLIPBOARD)) + (setq clip-text (x-selection-value-internal 'CLIPBOARD)) (if (string= clip-text "") (setq clip-text nil)) ;; Check the CLIPBOARD selection for 'newness', is it different @@ -1329,7 +1306,7 @@ The value nil is the same as this list: (t (setq x-last-selected-text-clipboard clip-text))))) (when x-select-enable-primary - (setq primary-text (x-selection-value 'PRIMARY)) + (setq primary-text (x-selection-value-internal 'PRIMARY)) ;; Check the PRIMARY selection for 'newness', is it different ;; from what we remebered them to be last time we did a ;; cut/paste operation. @@ -1346,69 +1323,35 @@ The value nil is the same as this list: (t (setq x-last-selected-text-primary primary-text))))) - (setq cut-text (x-get-cut-buffer 0)) - - ;; Check the x cut buffer for 'newness', is it different - ;; from what we remebered them to be last time we did a - ;; cut/paste operation. - (setq cut-text - (let ((next-coding (or next-selection-coding-system 'iso-latin-1))) - (cond ;; check cut buffer - ((or (not cut-text) (string= cut-text "")) - (setq x-last-selected-text-cut nil)) - ;; This short cut doesn't work because x-get-cut-buffer - ;; always returns a newly created string. - ;; ((eq cut-text x-last-selected-text-cut) nil) - ((and (string= cut-text x-last-selected-text-cut-encoded) - (eq x-last-cut-buffer-coding next-coding)) - ;; See the comment above. No need of this recording. - ;; Record the newer string, - ;; so subsequent calls can use the `eq' test. - ;; (setq x-last-selected-text-cut cut-text) - nil) - (t - (setq x-last-selected-text-cut-encoded cut-text - x-last-cut-buffer-coding next-coding - x-last-selected-text-cut - ;; ICCCM says cut buffer always contain ISO-Latin-1, but - ;; use next-selection-coding-system if not nil. - (decode-coding-string - cut-text next-coding)))))) - ;; As we have done one selection, clear this now. (setq next-selection-coding-system nil) ;; At this point we have recorded the current values for the - ;; selection from clipboard (if we are supposed to) primary, - ;; and cut buffer. So return the first one that has changed + ;; selection from clipboard (if we are supposed to) and primary. + ;; So return the first one that has changed ;; (which is the first non-null one). ;; ;; NOTE: There will be cases where more than one of these has ;; changed and the new values differ. This indicates that ;; something like the following has happened since the last time ;; we looked at the selections: Application X set all the - ;; selections, then Application Y set only one or two of them (say - ;; just the cut-buffer). In this case since we don't have + ;; selections, then Application Y set only one of them. + ;; In this case since we don't have ;; timestamps there is no way to know what the 'correct' value to ;; return is. The nice thing to do would be to tell the user we ;; saw multiple possible selections and ask the user which was the ;; one they wanted. - ;; This code is still a big improvement because now the user can - ;; futz with the current selection and get emacs to pay attention - ;; to the cut buffer again (previously as soon as clipboard or - ;; primary had been set the cut buffer would essentially never be - ;; checked again). - (or clip-text primary-text cut-text) + (or clip-text primary-text) ))) ;; Arrange for the kill and yank functions to set and check the clipboard. (setq interprogram-cut-function 'x-select-text) -(setq interprogram-paste-function 'x-cut-buffer-or-selection-value) +(setq interprogram-paste-function 'x-selection-value) (defun x-clipboard-yank () "Insert the clipboard contents, or the last stretch of killed text." (interactive "*") - (let ((clipboard-text (x-selection-value 'CLIPBOARD)) + (let ((clipboard-text (x-selection-value-internal 'CLIPBOARD)) (x-select-enable-clipboard t)) (if (and clipboard-text (> (length clipboard-text) 0)) (kill-new clipboard-text)) @@ -1465,9 +1408,6 @@ The value nil is the same as this list: ;; are the initial display. (eq initial-window-system 'x)) - (setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100) - x-cut-buffer-max)) - ;; Create the default fontset. (create-default-fontset) diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index e17cd9e5b28..0662acf2c50 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -9,7 +9,7 @@ ;; Mike Newton <newton@gumby.cs.caltech.edu> ;; Aaron Larson <alarson@src.honeywell.com> ;; Dirk Herrmann <D.Herrmann@tu-bs.de> -;; Maintainer: Roland Winkler <roland.winkler@physik.uni-erlangen.de> +;; Maintainer: Roland Winkler <winkler@gnu.org> ;; Keywords: BibTeX, LaTeX, TeX ;; This file is part of GNU Emacs. @@ -3027,12 +3027,14 @@ if that value is non-nil. ;; brace-delimited ones ) nil - (font-lock-syntactic-keywords . bibtex-font-lock-syntactic-keywords) (font-lock-extra-managed-props . (category)) (font-lock-mark-block-function . (lambda () (set-mark (bibtex-end-of-entry)) (bibtex-beginning-of-entry))))) + (set (make-local-variable 'syntax-propertize-function) + (syntax-propertize-via-font-lock + bibtex-font-lock-syntactic-keywords)) (setq imenu-generic-expression (list (list nil bibtex-entry-head bibtex-key-in-head)) imenu-case-fold-search t) diff --git a/lisp/textmodes/dns-mode.el b/lisp/textmodes/dns-mode.el index fa011687c1c..45ebc07d8bb 100644 --- a/lisp/textmodes/dns-mode.el +++ b/lisp/textmodes/dns-mode.el @@ -227,5 +227,4 @@ This function is run from `before-save-hook'." (provide 'dns-mode) -;; arch-tag: 6a179f0a-072f-49db-8b01-37b8f23998c0 ;;; dns-mode.el ends here diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index a9eb45939b2..be3fd5a1789 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: wp +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/textmodes/flyspell.el b/lisp/textmodes/flyspell.el index e8a92b101ef..8a73a0f818e 100644 --- a/lisp/textmodes/flyspell.el +++ b/lisp/textmodes/flyspell.el @@ -199,9 +199,9 @@ Ispell's ultimate default dictionary." (defcustom flyspell-check-tex-math-command nil "Non-nil means check even inside TeX math environment. -TeX math environments are discovered by the TEXMATHP that implemented -inside the texmathp.el Emacs package. That package may be found at: -http://strw.leidenuniv.nl/~dominik/Tools" +TeX math environments are discovered by `texmathp', implemented +inside AUCTeX package. That package may be found at +URL `http://www.gnu.org/software/auctex/'" :group 'flyspell :type 'boolean) diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el index ad591eb0e7f..ad2838adaa9 100644 --- a/lisp/textmodes/ispell.el +++ b/lisp/textmodes/ispell.el @@ -221,10 +221,10 @@ compatibility function in case `version<=' is not available." (let (ver mver) (if (string-match "[0-9]+" version start-ver) (setq start-ver (match-end 0) - ver (string-to-number (substring version (match-beginning 0) (match-end 0))))) + ver (string-to-number (match-string 0 version)))) (if (string-match "[0-9]+" minver start-mver) (setq start-mver (match-end 0) - mver (string-to-number (substring minver (match-beginning 0) (match-end 0))))) + mver (string-to-number (match-string 0 minver)))) (if (or ver mver) (progn @@ -310,7 +310,9 @@ Warning! Not checking comments, when a comment start is embedded in strings, may produce undesired results." :type '(choice (const exclusive) (const :tag "off" nil) (const :tag "on" t)) :group 'ispell) -;;;###autoload(put 'ispell-check-comments 'safe-local-variable (lambda (a) (memq a '(nil t exclusive)))) +;;;###autoload +(put 'ispell-check-comments 'safe-local-variable + (lambda (a) (memq a '(nil t exclusive)))) (defcustom ispell-query-replace-choices nil "*Corrections made throughout region when non-nil. @@ -514,7 +516,8 @@ is automatically set when defined in the file with either :type '(choice string (const :tag "default" nil)) :group 'ispell) -;;;###autoload(put 'ispell-local-dictionary 'safe-local-variable 'string-or-null-p) +;;;###autoload +(put 'ispell-local-dictionary 'safe-local-variable 'string-or-null-p) (make-variable-buffer-local 'ispell-local-dictionary) @@ -738,8 +741,8 @@ Note that the CASECHARS and OTHERCHARS slots of the alist should contain the same character set as casechars and otherchars in the LANGUAGE.aff file \(e.g., english.aff\).") -(defvar ispell-really-aspell nil) ; Non-nil if aspell extensions should be used -(defvar ispell-really-hunspell nil) ; Non-nil if hunspell extensions should be used +(defvar ispell-really-aspell nil) ; Non-nil if we can use aspell extensions. +(defvar ispell-really-hunspell nil) ; Non-nil if we can use hunspell extensions. (defvar ispell-encoding8-command nil "Command line option prefix to select UTF-8 if supported, nil otherwise. If UTF-8 if supported by spellchecker and is selectable from the command line @@ -962,7 +965,8 @@ Internal use.") (setq found (nconc found (list dict))))) (setq ispell-aspell-dictionary-alist found) ;; Add a default entry - (let ((default-dict '(nil "[[:alpha:]]" "[^[:alpha:]]" "[']" nil ("-B") nil utf-8))) + (let ((default-dict + '(nil "[[:alpha:]]" "[^[:alpha:]]" "[']" nil ("-B") nil utf-8))) (push default-dict ispell-aspell-dictionary-alist)))) (defvar ispell-aspell-data-dir nil @@ -1026,7 +1030,8 @@ Assumes that value contains no whitespace." (defun ispell-aspell-add-aliases (alist) "Find aspell's dictionary aliases and add them to dictionary ALIST. Return the new dictionary alist." - (let ((aliases (file-expand-wildcards + (let ((aliases + (file-expand-wildcards (concat (or ispell-aspell-dict-dir (setq ispell-aspell-dict-dir (ispell-get-aspell-config-value "dict-dir"))) @@ -1111,26 +1116,24 @@ The variable `ispell-library-directory' defines the library location." (let ((dicts (append ispell-local-dictionary-alist ispell-dictionary-alist)) (dict-list (cons "default" nil)) - name load-dict) + name dict-bname) (dolist (dict dicts) (setq name (car dict) - load-dict (car (cdr (member "-d" (nth 5 dict))))) + dict-bname (or (car (cdr (member "-d" (nth 5 dict)))) + name)) ;; Include if the dictionary is in the library, or dir not defined. (if (and name - ;; include all dictionaries if lib directory not known. ;; For Aspell, we already know which dictionaries exist. (or ispell-really-aspell + ;; Include all dictionaries if lib directory not known. + ;; Same for Hunspell, where ispell-library-directory is nil. (not ispell-library-directory) (file-exists-p (concat ispell-library-directory - "/" name ".hash")) - (file-exists-p (concat ispell-library-directory "/" name ".has")) - (and load-dict - (or (file-exists-p (concat ispell-library-directory - "/" load-dict ".hash")) - (file-exists-p (concat ispell-library-directory - "/" load-dict ".has")))))) - (setq dict-list (cons name dict-list)))) + "/" dict-bname ".hash")) + (file-exists-p (concat ispell-library-directory + "/" dict-bname ".has")))) + (push name dict-list))) dict-list)) ;;; define commands in menu in opposite order you want them to appear. @@ -1168,7 +1171,8 @@ The variable `ispell-library-directory' defines the library location." `(menu-item ,(purecopy "Complete Word") ispell-complete-word :help ,(purecopy "Complete word at cursor using dictionary"))) (define-key ispell-menu-map [ispell-complete-word-interior-frag] - `(menu-item ,(purecopy "Complete Word Fragment") ispell-complete-word-interior-frag + `(menu-item ,(purecopy "Complete Word Fragment") + ispell-complete-word-interior-frag :help ,(purecopy "Complete word fragment at cursor"))))) ;;;###autoload @@ -1185,7 +1189,8 @@ The variable `ispell-library-directory' defines the library location." `(menu-item ,(purecopy "Spell-Check Word") ispell-word :help ,(purecopy "Spell-check word at cursor"))) (define-key ispell-menu-map [ispell-comments-and-strings] - `(menu-item ,(purecopy "Spell-Check Comments") ispell-comments-and-strings + `(menu-item ,(purecopy "Spell-Check Comments") + ispell-comments-and-strings :help ,(purecopy "Spell-check only comments and strings"))))) ;;;###autoload @@ -1334,9 +1339,6 @@ Protects against bogus binding of `enable-multibyte-characters' in XEmacs." (defvar ispell-process-directory nil "The directory where `ispell-process' was started.") -(defvar ispell-process-buffer-name nil - "The buffer where `ispell-process' was started.") - (defvar ispell-filter nil "Output filter from piped calls to Ispell.") @@ -1400,7 +1402,8 @@ The last occurring definition in the buffer will be used.") (ispell-dictionary-keyword forward-line) (ispell-pdict-keyword forward-line) (ispell-parsing-keyword forward-line) - (,(purecopy "^---*BEGIN PGP [A-Z ]*--*") . ,(purecopy "^---*END PGP [A-Z ]*--*")) + (,(purecopy "^---*BEGIN PGP [A-Z ]*--*") + . ,(purecopy "^---*END PGP [A-Z ]*--*")) ;; assume multiline uuencoded file? "\nM.*$"? (,(purecopy "^begin [0-9][0-9][0-9] [^ \t]+$") . ,(purecopy "\nend\n")) (,(purecopy "^%!PS-Adobe-[123].0") . ,(purecopy "\n%%EOF\n")) @@ -1880,9 +1883,10 @@ Global `ispell-quit' set to start location to continue spell session." ;; setup the *Choices* buffer with valid data. (with-current-buffer (get-buffer-create ispell-choices-buffer) (setq mode-line-format - (concat "-- %b -- word: " word - " -- dict: " (or ispell-current-dictionary "default") - " -- prog: " (file-name-nondirectory ispell-program-name))) + (concat + "-- %b -- word: " word + " -- dict: " (or ispell-current-dictionary "default") + " -- prog: " (file-name-nondirectory ispell-program-name))) ;; XEmacs: no need for horizontal scrollbar in choices window (with-no-warnings (and (fboundp 'set-specifier) @@ -2280,8 +2284,9 @@ if defined." (unless (file-readable-p lookup-dict) (error "lookup-words error: Unreadable or missing plain word-list %s." lookup-dict)) - (error (concat "lookup-words error: No plain word-list found at system default " - "locations. Customize `ispell-alternate-dictionary' to set yours."))) + (error (concat "lookup-words error: No plain word-list found at system" + "default locations. " + "Customize `ispell-alternate-dictionary' to set yours."))) (let* ((process-connection-type ispell-use-ptys-p) (wild-p (string-match "\\*" word)) @@ -2332,16 +2337,16 @@ if defined." results)) -;;; "ispell-filter" is a list of output lines from the generating function. -;;; Each full line (ending with \n) is a separate item on the list. -;;; "output" can contain multiple lines, part of a line, or both. -;;; "start" and "end" are used to keep bounds on lines when "output" contains -;;; multiple lines. -;;; "ispell-filter-continue" is true when we have received only part of a -;;; line as output from a generating function ("output" did not end with \n) -;;; THIS FUNCTION WILL FAIL IF THE PROCESS OUTPUT DOESN'T END WITH \n! -;;; This is the case when a process dies or fails. The default behavior -;;; in this case treats the next input received as fresh input. +;; "ispell-filter" is a list of output lines from the generating function. +;; Each full line (ending with \n) is a separate item on the list. +;; "output" can contain multiple lines, part of a line, or both. +;; "start" and "end" are used to keep bounds on lines when "output" contains +;; multiple lines. +;; "ispell-filter-continue" is true when we have received only part of a +;; line as output from a generating function ("output" did not end with \n) +;; THIS FUNCTION WILL FAIL IF THE PROCESS OUTPUT DOESN'T END WITH \n! +;; This is the case when a process dies or fails. The default behavior +;; in this case treats the next input received as fresh input. (defun ispell-filter (process output) "Output filter function for ispell, grep, and look." @@ -2573,37 +2578,35 @@ When asynchronous processes are not supported, `run' is always returned." (defun ispell-start-process () "Start the ispell process, with support for no asynchronous processes. Keeps argument list for future ispell invocations for no async support." - (let ((default-directory default-directory) - args) - (unless (and (file-directory-p default-directory) - (file-readable-p default-directory)) - ;; Defend against bad `default-directory'. - (setq default-directory (expand-file-name "~/"))) - ;; Local dictionary becomes the global dictionary in use. - (setq ispell-current-dictionary - (or ispell-local-dictionary ispell-dictionary)) - (setq ispell-current-personal-dictionary - (or ispell-local-pdict ispell-personal-dictionary)) - (setq args (ispell-get-ispell-args)) - (if (and ispell-current-dictionary ; use specified dictionary - (not (member "-d" args))) ; only define if not overridden - (setq args - (append (list "-d" ispell-current-dictionary) args))) - (if ispell-current-personal-dictionary ; use specified pers dict - (setq args - (append args - (list "-p" - (expand-file-name ispell-current-personal-dictionary))))) - - ;; If we are using recent aspell or hunspell, make sure we use the right encoding - ;; for communication. ispell or older aspell/hunspell does not support this - (if ispell-encoding8-command - (setq args - (append args - (list - (concat ispell-encoding8-command - (symbol-name (ispell-get-coding-system))))))) - (setq args (append args ispell-extra-args)) + ;; Local dictionary becomes the global dictionary in use. + (setq ispell-current-dictionary + (or ispell-local-dictionary ispell-dictionary)) + (setq ispell-current-personal-dictionary + (or ispell-local-pdict ispell-personal-dictionary)) + (let* ((default-directory + (if (and (file-directory-p default-directory) + (file-readable-p default-directory)) + default-directory + ;; Defend against bad `default-directory'. + (expand-file-name "~/"))) + (orig-args (ispell-get-ispell-args)) + (args + (append + (if (and ispell-current-dictionary ; Not for default dict (nil) + (not (member "-d" orig-args))) ; Only define if not overridden. + (list "-d" ispell-current-dictionary)) + orig-args + (if ispell-current-personal-dictionary ; Use specified pers dict. + (list "-p" + (expand-file-name ispell-current-personal-dictionary))) + ;; If we are using recent aspell or hunspell, make sure we use the + ;; right encoding for communication. ispell or older aspell/hunspell + ;; does not support this. + (if ispell-encoding8-command + (list + (concat ispell-encoding8-command + (symbol-name (ispell-get-coding-system))))) + ispell-extra-args))) ;; Initially we don't know any buffer's local words. (setq ispell-buffer-local-name nil) @@ -2612,9 +2615,11 @@ Keeps argument list for future ispell invocations for no async support." (let ((process-connection-type ispell-use-ptys-p)) (apply 'start-process "ispell" nil ispell-program-name - "-a" ; accept single input lines - (if ispell-really-hunspell "" "-m") ; make root/affix combos not in dict - args)) ; hunspell -m option means different + "-a" ; Accept single input lines. + ;; Make root/affix combos not in dict. + ;; hunspell -m option means different. + (if ispell-really-hunspell "" "-m") + args)) (setq ispell-cmd-args args ispell-output-buffer (generate-new-buffer " *ispell-output*") ispell-session-buffer (generate-new-buffer " *ispell-session*")) @@ -2622,79 +2627,112 @@ Keeps argument list for future ispell invocations for no async support." t))) - (defun ispell-init-process () "Check status of Ispell process and start if necessary." - (if (and ispell-process - (eq (ispell-process-status) 'run) - ;; Unless we are using an explicit personal dictionary, - ;; ensure we're in the same default directory! - ;; Restart check for personal dictionary is done in - ;; `ispell-internal-change-dictionary', called from `ispell-buffer-local-dict' - (or (or ispell-local-pdict ispell-personal-dictionary) - (equal ispell-process-directory (expand-file-name default-directory)))) - (setq ispell-filter nil ispell-filter-continue nil) - ;; may need to restart to select new personal dictionary. - (ispell-kill-ispell t) - (message "Starting new Ispell process [%s] ..." - (or ispell-local-dictionary ispell-dictionary "default")) - (sit-for 0) - (setq ispell-library-directory (ispell-check-version) - ispell-process (ispell-start-process) - ispell-filter nil - ispell-filter-continue nil) - ;; When spellchecking minibuffer contents, make sure ispell process - ;; is not restarted every time the minibuffer is killed. - (if (window-minibuffer-p) - (if (fboundp 'minibuffer-selected-window) - ;; Assign ispell process to parent buffer - (setq ispell-process-directory (expand-file-name default-directory) - ispell-process-buffer-name (window-buffer (minibuffer-selected-window))) - ;; Force `ispell-process-directory' to $HOME and use a dummy name - (setq ispell-process-directory (expand-file-name "~/") - ispell-process-buffer-name " * Minibuffer-has-spellcheck-enabled")) - ;; Not in a minibuffer - (setq ispell-process-directory (expand-file-name default-directory) - ispell-process-buffer-name (buffer-name))) - (if ispell-async-processp - (set-process-filter ispell-process 'ispell-filter)) - ;; protect against bogus binding of `enable-multibyte-characters' in XEmacs - (if (and (or (featurep 'xemacs) - (and (boundp 'enable-multibyte-characters) - enable-multibyte-characters)) - (fboundp 'set-process-coding-system)) - (set-process-coding-system ispell-process (ispell-get-coding-system) - (ispell-get-coding-system))) - ;; Get version ID line - (ispell-accept-output 3) - ;; get more output if filter empty? - (if (null ispell-filter) (ispell-accept-output 3)) - (cond ((null ispell-filter) - (error "%s did not output version line" ispell-program-name)) - ((and - (stringp (car ispell-filter)) - (if (string-match "warning: " (car ispell-filter)) - (progn - (ispell-accept-output 3) ; was warn msg. - (stringp (car ispell-filter))) - (null (cdr ispell-filter))) - (string-match "^@(#) " (car ispell-filter))) - ;; got the version line as expected (we already know it's the right - ;; version, so don't bother checking again.) - nil) - (t - ;; Otherwise, it must be an error message. Show the user. - ;; But first wait to see if some more output is going to arrive. - ;; Otherwise we get cool errors like "Can't open ". - (sleep-for 1) - (ispell-accept-output 3) - (error "%s" (mapconcat 'identity ispell-filter "\n")))) - (setq ispell-filter nil) ; Discard version ID line - (let ((extended-char-mode (ispell-get-extended-character-mode))) - (if extended-char-mode ; ~ extended character mode - (ispell-send-string (concat extended-char-mode "\n")))) - (if ispell-async-processp - (set-process-query-on-exit-flag ispell-process nil)))) + (let* (;; Basename of dictionary used by the spell-checker + (dict-bname (or (car (cdr (member "-d" (ispell-get-ispell-args)))) + ispell-current-dictionary)) + ;; Use "~/" as default-directory unless using Ispell with per-dir + ;; personal dictionaries and not in a minibuffer under XEmacs + (default-directory + (if (or ispell-really-aspell + ispell-really-hunspell + ;; Protect against bad default-directory + (not (and (file-directory-p default-directory) + (file-readable-p default-directory))) + ;; Ispell and per-dir personal dicts available + (not (or (file-readable-p (concat default-directory + ".ispell_words")) + (file-readable-p (concat default-directory + ".ispell_" + (or dict-bname + "default"))))) + ;; Ispell, in a minibuffer, and XEmacs + (and (window-minibuffer-p) + (not (fboundp 'minibuffer-selected-window)))) + (expand-file-name "~/") + (expand-file-name default-directory)))) + ;; Check if process needs restart + (if (and ispell-process + (eq (ispell-process-status) 'run) + ;; Unless we are using an explicit personal dictionary, ensure + ;; we're in the same default directory! Restart check for + ;; personal dictionary is done in + ;; `ispell-internal-change-dictionary', called from + ;; `ispell-buffer-local-dict' + (or (or ispell-local-pdict ispell-personal-dictionary) + (equal ispell-process-directory default-directory))) + (setq ispell-filter nil ispell-filter-continue nil) + ;; may need to restart to select new personal dictionary. + (ispell-kill-ispell t) + (message "Starting new Ispell process [%s] ..." + (or ispell-local-dictionary ispell-dictionary "default")) + (sit-for 0) + (setq ispell-library-directory (ispell-check-version) + ispell-process (ispell-start-process) + ispell-filter nil + ispell-filter-continue nil + ispell-process-directory default-directory) + + (unless (equal ispell-process-directory (expand-file-name "~/")) + ;; At this point, `ispell-process-directory' will be "~/" unless using + ;; Ispell with directory-specific dicts and not in XEmacs minibuffer. + ;; If not, kill ispell process when killing buffer. It may be in a + ;; removable device that would otherwise become un-mountable. + (with-current-buffer + (if (and (window-minibuffer-p) ;; In minibuffer + (fboundp 'minibuffer-selected-window)) ;; Not XEmacs. + ;; In this case kill ispell only when parent buffer is killed + ;; to avoid over and over ispell kill. + (window-buffer (minibuffer-selected-window)) + (current-buffer)) + ;; 'local does not automatically make hook buffer-local in XEmacs. + (if (featurep 'xemacs) + (make-local-hook 'kill-buffer-hook)) + (add-hook 'kill-buffer-hook + (lambda () (ispell-kill-ispell t)) nil 'local))) + + (if ispell-async-processp + (set-process-filter ispell-process 'ispell-filter)) + ;; Protect against XEmacs bogus binding of `enable-multibyte-characters'. + (if (and (or (featurep 'xemacs) + (and (boundp 'enable-multibyte-characters) + enable-multibyte-characters)) + (fboundp 'set-process-coding-system)) + (set-process-coding-system ispell-process (ispell-get-coding-system) + (ispell-get-coding-system))) + ;; Get version ID line + (ispell-accept-output 3) + ;; get more output if filter empty? + (if (null ispell-filter) (ispell-accept-output 3)) + (cond ((null ispell-filter) + (error "%s did not output version line" ispell-program-name)) + ((and + (stringp (car ispell-filter)) + (if (string-match "warning: " (car ispell-filter)) + (progn + (ispell-accept-output 3) ; was warn msg. + (stringp (car ispell-filter))) + (null (cdr ispell-filter))) + (string-match "^@(#) " (car ispell-filter))) + ;; got the version line as expected (we already know it's the right + ;; version, so don't bother checking again.) + nil) + (t + ;; Otherwise, it must be an error message. Show the user. + ;; But first wait to see if some more output is going to arrive. + ;; Otherwise we get cool errors like "Can't open ". + (sleep-for 1) + (ispell-accept-output 3) + (error "%s" (mapconcat 'identity ispell-filter "\n")))) + (setq ispell-filter nil) ; Discard version ID line + (let ((extended-char-mode (ispell-get-extended-character-mode))) + (if extended-char-mode ; ~ extended character mode + (ispell-send-string (concat extended-char-mode "\n")))) + (if ispell-async-processp + (if (fboundp 'set-process-query-on-exit-flag) ;; not XEmacs + (set-process-query-on-exit-flag ispell-process nil) + (process-kill-without-query ispell-process)))))) ;;;###autoload (defun ispell-kill-ispell (&optional no-error) @@ -2716,17 +2754,10 @@ With NO-ERROR, just return non-nil if there was no Ispell running." (kill-buffer ispell-session-buffer) (setq ispell-output-buffer nil ispell-session-buffer nil)) - (setq ispell-process-buffer-name nil) (setq ispell-process nil) (message "Ispell process killed") nil)) -;; Kill ispell process when killing its associated buffer -(add-hook 'kill-buffer-hook - '(lambda () - (if (equal ispell-process-buffer-name (buffer-name)) - (ispell-kill-ispell t)))) - ;;; ispell-change-dictionary is set in some people's hooks. Maybe this should ;;; call ispell-init-process rather than wait for a spell checking command? @@ -2823,9 +2854,10 @@ Return nil if spell session is quit, (set-marker skip-region-start (- (point) (length key))) (goto-char reg-start))) (let (message-log-max) - (message "Continuing spelling check using %s with %s dictionary..." - (file-name-nondirectory ispell-program-name) - (or ispell-current-dictionary "default"))) + (message + "Continuing spelling check using %s with %s dictionary..." + (file-name-nondirectory ispell-program-name) + (or ispell-current-dictionary "default"))) (set-marker rstart reg-start) (set-marker ispell-region-end reg-end) (while (and (not ispell-quit) @@ -3090,9 +3122,9 @@ Point is placed at end of skipped region." (sit-for 2))))) -;;; Grab the next line of data. -;;; Returns a string with the line data (defun ispell-get-line (start end in-comment) + "Grab the next line of data. +Returns a string with the line data." (let ((ispell-casechars (ispell-get-casechars)) string) (cond ; LOOK AT THIS LINE AND SKIP OR PROCESS @@ -3119,7 +3151,8 @@ Point is placed at end of skipped region." (point) (+ (point) len)) coding))))) -;;; Avoid error messages when compiling for these dynamic variables. +;; Avoid error messages when compiling for these dynamic variables. +;; FIXME: dynamically scoped vars should have an "ispell-" prefix. (defvar start) (defvar end) @@ -3254,10 +3287,12 @@ Returns the sum SHIFT due to changes in word replacements." ;; (length (car poss))))) )) (if (not ispell-quit) + ;; FIXME: remove redundancy with identical code above. (let (message-log-max) - (message "Continuing spelling check using %s with %s dictionary..." - (file-name-nondirectory ispell-program-name) - (or ispell-current-dictionary "default")))) + (message + "Continuing spelling check using %s with %s dictionary..." + (file-name-nondirectory ispell-program-name) + (or ispell-current-dictionary "default")))) (sit-for 0) (setq start (marker-position line-start) end (marker-position line-end)) @@ -3330,7 +3365,7 @@ Returns the sum SHIFT due to changes in word replacements." ;;; Interactive word completion. -;;; Forces "previous-word" processing. Do we want to make this selectable? +;; Forces "previous-word" processing. Do we want to make this selectable? ;;;###autoload (defun ispell-complete-word (&optional interior-frag) diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el index 61ea89582b2..14b0b106bb3 100644 --- a/lisp/textmodes/nroff-mode.el +++ b/lisp/textmodes/nroff-mode.el @@ -55,6 +55,7 @@ (define-key map "\n" 'nroff-electric-newline) (define-key map "\en" 'nroff-forward-text-line) (define-key map "\ep" 'nroff-backward-text-line) + (define-key map "\C-c\C-c" 'nroff-view) (define-key map [menu-bar nroff-mode] (cons "Nroff" menu-map)) (define-key menu-map [nn] '(menu-item "Newline" nroff-electric-newline @@ -73,6 +74,9 @@ nroff-electric-mode :help "Auto insert closing requests if necessary" :button (:toggle . nroff-electric-mode))) + (define-key menu-map [npm] + '(menu-item "Preview as man page" nroff-view + :help "Run man on this file.")) map) "Major mode keymap for `nroff-mode'.") @@ -301,6 +305,17 @@ turns it on if arg is positive, otherwise off." :lighter " Electric" (or (derived-mode-p 'nroff-mode) (error "Must be in nroff mode"))) +(declare-function Man-getpage-in-background "man" (topic)) + +(defun nroff-view () + "Run man on this file." + (interactive) + (require 'man) + (let* ((file (buffer-file-name))) + (if file + (Man-getpage-in-background file) + (error "No associated file for the current buffer")))) + ;; Old names that were not namespace clean. (define-obsolete-function-alias 'count-text-lines 'nroff-count-text-lines "22.1") (define-obsolete-function-alias 'forward-text-line 'nroff-forward-text-line "22.1") diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el index a672dc92158..e85c0835387 100644 --- a/lisp/textmodes/page.el +++ b/lisp/textmodes/page.el @@ -1,3 +1,10 @@ +;; (push-mark (point) t) needed at the end of forward-page +;; The documentation in simple.el for set-mark says +;; To remember a location for internal use in the Lisp program, +;; store it in a Lisp variable. Example: +;; (let ((beg (point))) (forward-line 1) (delete-region beg (point)))." + + ;;; page.el --- page motion commands for Emacs ;; Copyright (C) 1985, 2001, 2002, 2003, 2004, 2005, @@ -5,6 +12,7 @@ ;; Maintainer: FSF ;; Keywords: wp convenience +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el index 2c698a836fe..4f1bcefa90e 100644 --- a/lisp/textmodes/paragraphs.el +++ b/lisp/textmodes/paragraphs.el @@ -6,6 +6,7 @@ ;; Maintainer: FSF ;; Keywords: wp +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/textmodes/reftex-auc.el b/lisp/textmodes/reftex-auc.el index 374ac990cc6..89e8d26bc65 100644 --- a/lisp/textmodes/reftex-auc.el +++ b/lisp/textmodes/reftex-auc.el @@ -6,6 +6,7 @@ ;; Author: Carsten Dominik <dominik@science.uva.nl> ;; Maintainer: auctex-devel@gnu.org ;; Version: 4.31 +;; Package: reftex ;; This file is part of GNU Emacs. diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index 3972a1df31c..79797b4791b 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el @@ -6,6 +6,7 @@ ;; Author: Carsten Dominik <dominik@science.uva.nl> ;; Maintainer: auctex-devel@gnu.org ;; Version: 4.31 +;; Package: reftex ;; This file is part of GNU Emacs. diff --git a/lisp/textmodes/reftex-dcr.el b/lisp/textmodes/reftex-dcr.el index d15cf3f9931..39fc0f4a81c 100644 --- a/lisp/textmodes/reftex-dcr.el +++ b/lisp/textmodes/reftex-dcr.el @@ -6,6 +6,7 @@ ;; Author: Carsten Dominik <dominik@science.uva.nl> ;; Maintainer: auctex-devel@gnu.org ;; Version: 4.31 +;; Package: reftex ;; This file is part of GNU Emacs. diff --git a/lisp/textmodes/reftex-global.el b/lisp/textmodes/reftex-global.el index 22e8a577d97..dc533185b24 100644 --- a/lisp/textmodes/reftex-global.el +++ b/lisp/textmodes/reftex-global.el @@ -6,6 +6,7 @@ ;; Author: Carsten Dominik <dominik@science.uva.nl> ;; Maintainer: auctex-devel@gnu.org ;; Version: 4.31 +;; Package: reftex ;; This file is part of GNU Emacs. diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index 35cae5ae874..dee7a319260 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -6,6 +6,7 @@ ;; Author: Carsten Dominik <dominik@science.uva.nl> ;; Maintainer: auctex-devel@gnu.org ;; Version: 4.31 +;; Package: reftex ;; This file is part of GNU Emacs. diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el index dc03a387082..58aaaa47a38 100644 --- a/lisp/textmodes/reftex-parse.el +++ b/lisp/textmodes/reftex-parse.el @@ -6,6 +6,7 @@ ;; Author: Carsten Dominik <dominik@science.uva.nl> ;; Maintainer: auctex-devel@gnu.org ;; Version: 4.31 +;; Package: reftex ;; This file is part of GNU Emacs. diff --git a/lisp/textmodes/reftex-ref.el b/lisp/textmodes/reftex-ref.el index b186a1ea713..23723489d13 100644 --- a/lisp/textmodes/reftex-ref.el +++ b/lisp/textmodes/reftex-ref.el @@ -6,6 +6,7 @@ ;; Author: Carsten Dominik <dominik@science.uva.nl> ;; Maintainer: auctex-devel@gnu.org ;; Version: 4.31 +;; Package: reftex ;; This file is part of GNU Emacs. diff --git a/lisp/textmodes/reftex-sel.el b/lisp/textmodes/reftex-sel.el index 90dc01a6bbe..bebeb1cd51a 100644 --- a/lisp/textmodes/reftex-sel.el +++ b/lisp/textmodes/reftex-sel.el @@ -6,6 +6,7 @@ ;; Author: Carsten Dominik <dominik@science.uva.nl> ;; Maintainer: auctex-devel@gnu.org ;; Version: 4.31 +;; Package: reftex ;; This file is part of GNU Emacs. diff --git a/lisp/textmodes/reftex-toc.el b/lisp/textmodes/reftex-toc.el index ae1690416b9..41ea83b077f 100644 --- a/lisp/textmodes/reftex-toc.el +++ b/lisp/textmodes/reftex-toc.el @@ -6,6 +6,7 @@ ;; Author: Carsten Dominik <dominik@science.uva.nl> ;; Maintainer: auctex-devel@gnu.org ;; Version: 4.31 +;; Package: reftex ;; This file is part of GNU Emacs. diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el index ce0ac32492d..5b83e7a43ad 100644 --- a/lisp/textmodes/reftex-vars.el +++ b/lisp/textmodes/reftex-vars.el @@ -6,6 +6,7 @@ ;; Author: Carsten Dominik <dominik@science.uva.nl> ;; Maintainer: auctex-devel@gnu.org ;; Version: 4.31 +;; Package: reftex ;; This file is part of GNU Emacs. diff --git a/lisp/textmodes/reftex.el b/lisp/textmodes/reftex.el index b4b0a281ca6..2a2e725e92e 100644 --- a/lisp/textmodes/reftex.el +++ b/lisp/textmodes/reftex.el @@ -599,7 +599,6 @@ on the menu bar. (defvar font-lock-mode) (defvar font-lock-keywords) (defvar font-lock-fontify-region-function) -(defvar font-lock-syntactic-keywords) ;;; ========================================================================= ;;; diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el index 87ffecd5d5a..bc1af67d587 100644 --- a/lisp/textmodes/sgml-mode.el +++ b/lisp/textmodes/sgml-mode.el @@ -293,11 +293,12 @@ Any terminating `>' or `/' is not matched.") (defvar sgml-font-lock-keywords sgml-font-lock-keywords-1 "*Rules for highlighting SGML code. See also `sgml-tag-face-alist'.") -(defvar sgml-font-lock-syntactic-keywords +(defconst sgml-syntax-propertize-function + (syntax-propertize-rules ;; Use the `b' style of comments to avoid interference with the -- ... -- ;; comments recognized when `sgml-specials' includes ?-. ;; FIXME: beware of <!--> blabla <!--> !! - '(("\\(<\\)!--" (1 "< b")) + ("\\(<\\)!--" (1 "< b")) ("--[ \t\n]*\\(>\\)" (1 "> b")) ;; Double quotes outside of tags should not introduce strings. ;; Be careful to call `syntax-ppss' on a position before the one we're @@ -477,9 +478,9 @@ Do \\[describe-key] on the following bindings to discover what they do. '((sgml-font-lock-keywords sgml-font-lock-keywords-1 sgml-font-lock-keywords-2) - nil t nil nil - (font-lock-syntactic-keywords - . sgml-font-lock-syntactic-keywords))) + nil t)) + (set (make-local-variable 'syntax-propertize-function) + sgml-syntax-propertize-function) (set (make-local-variable 'facemenu-add-face-function) 'sgml-mode-facemenu-add-face-function) (set (make-local-variable 'sgml-xml-mode) (sgml-xml-guess)) diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index da0c5396f2c..81a3816c1e8 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -488,7 +488,7 @@ An alternative value is \" . \", if you use a font with a narrow period." ;; (arg "\\(?:{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)\\|\\\\[a-z*]+\\)")) (arg "{\\(\\(?:[^{}\\]+\\|\\\\.\\|{[^}]*}\\)+\\)")) (list - ;; font-lock-syntactic-keywords causes the \ of \end{verbatim} to be + ;; tex-font-lock-syntactic-keywords causes the \ of \end{verbatim} to be ;; highlighted as tex-verbatim face. Let's undo that. ;; This is ugly and brittle :-( --Stef '("^\\(\\\\\\)end" (1 (get-text-property (match-end 1) 'face) t)) @@ -655,6 +655,7 @@ An alternative value is \" . \", if you use a font with a narrow period." ;; line is re-font-locked on its own. ;; There's a hack in tex-font-lock-keywords-1 to remove the verbatim ;; face from the \ but C-M-f still jumps to the wrong spot :-( --Stef + ;; FIXME: See gud.el for an example of a solution to a similar problem. (eval . `(,(concat "^\\(\\\\\\)end *{" (regexp-opt tex-verbatim-environments t) "}\\(.?\\)") (1 "|") (3 "<"))) @@ -1163,10 +1164,9 @@ Entering SliTeX mode runs the hook `text-mode-hook', then the hook (font-lock-syntactic-face-function . tex-font-lock-syntactic-face-function) (font-lock-unfontify-region-function - . tex-font-lock-unfontify-region) - (font-lock-syntactic-keywords - . tex-font-lock-syntactic-keywords) - (parse-sexp-lookup-properties . t))) + . tex-font-lock-unfontify-region))) + (set (make-local-variable 'syntax-propertize-function) + (syntax-propertize-via-font-lock tex-font-lock-syntactic-keywords)) ;; TABs in verbatim environments don't do what you think. (set (make-local-variable 'indent-tabs-mode) nil) ;; Other vars that should be buffer-local. @@ -2850,12 +2850,12 @@ There might be text before point." (mapcar (lambda (x) (case (car-safe x) - (font-lock-syntactic-keywords - (cons (car x) 'doctex-font-lock-syntactic-keywords)) (font-lock-syntactic-face-function (cons (car x) 'doctex-font-lock-syntactic-face-function)) (t x))) - (cdr font-lock-defaults))))) + (cdr font-lock-defaults)))) + (set (make-local-variable 'syntax-propertize-function) + (syntax-propertize-via-font-lock doctex-font-lock-syntactic-keywords))) (run-hooks 'tex-mode-load-hook) diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el index 7c71acd044b..be23a439bf3 100644 --- a/lisp/textmodes/texinfo.el +++ b/lisp/textmodes/texinfo.el @@ -310,10 +310,11 @@ chapter." ("Chapters" "^@chapter[ \t]+\\(.*\\)$" 1)) "Imenu generic expression for Texinfo mode. See `imenu-generic-expression'.") -(defvar texinfo-font-lock-syntactic-keywords - '(("\\(@\\)c\\(omment\\)?\\>" (1 "<")) - ("^\\(@\\)ignore\\>" (1 "< b")) - ("^@end ignore\\(\n\\)" (1 "> b"))) +(defconst texinfo-syntax-propertize-function + (syntax-propertize-rules + ("\\(@\\)c\\(omment\\)?\\>" (1 "<")) + ("^\\(@\\)ignore\\>" (1 "< b")) + ("^@end ignore\\(\n\\)" (1 "> b"))) "Syntactic keywords to catch comment delimiters in `texinfo-mode'.") (defconst texinfo-environments @@ -600,9 +601,9 @@ value of `texinfo-mode-hook'." (setq imenu-case-fold-search nil) (make-local-variable 'font-lock-defaults) (setq font-lock-defaults - '(texinfo-font-lock-keywords nil nil nil backward-paragraph - (font-lock-syntactic-keywords - . texinfo-font-lock-syntactic-keywords))) + '(texinfo-font-lock-keywords nil nil nil backward-paragraph)) + (set (make-local-variable 'syntax-propertize-function) + texinfo-syntax-propertize-function) (set (make-local-variable 'parse-sexp-lookup-properties) t) ;; Outline settings. diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el index 51040824b20..b6868d3a8e8 100644 --- a/lisp/textmodes/text-mode.el +++ b/lisp/textmodes/text-mode.el @@ -5,6 +5,7 @@ ;; Maintainer: FSF ;; Keywords: wp +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el index 4b83b07754d..98aaa8fe50a 100644 --- a/lisp/tool-bar.el +++ b/lisp/tool-bar.el @@ -5,6 +5,7 @@ ;; ;; Author: Dave Love <fx@gnu.org> ;; Keywords: mouse frames +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 344f01fa4cc..5987b00f92e 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -5,6 +5,7 @@ ;; Author: Gerd Moellmann <gerd@acm.org> ;; Keywords: help c mouse tools +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/tutorial.el b/lisp/tutorial.el index 15dfe86a8df..6961fafb3aa 100644 --- a/lisp/tutorial.el +++ b/lisp/tutorial.el @@ -4,6 +4,7 @@ ;; Maintainer: FSF ;; Keywords: help, internal +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/uniquify.el b/lisp/uniquify.el index 27093042efe..a654b2dcfc5 100644 --- a/lisp/uniquify.el +++ b/lisp/uniquify.el @@ -7,6 +7,7 @@ ;; Maintainer: FSF ;; Keywords: files ;; Created: 15 May 86 +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index e3f76e72e37..170bedd3b28 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,8 @@ +2010-09-11 Glenn Morris <rgm@gnu.org> + + * url-cache.el, url-gw.el, url-history.el, url-irc.el, url-util.el: + * url-vars.el: Remove leading `*' from defcustom docs. + 2010-07-27 Michael Albinus <michael.albinus@gmx.de> * url-http (url-http-parse-headers): Disable file name handlers at diff --git a/lisp/url/url-cache.el b/lisp/url/url-cache.el index 71841c9a0ca..7cff9aa923d 100644 --- a/lisp/url/url-cache.el +++ b/lisp/url/url-cache.el @@ -1,7 +1,7 @@ ;;; url-cache.el --- Uniform Resource Locator retrieval tool -;; Copyright (C) 1996, 1997, 1998, 1999, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -28,7 +28,7 @@ (defcustom url-cache-directory (expand-file-name "cache" url-configuration-directory) - "*The directory where cache files should be stored." + "The directory where cache files should be stored." :type 'directory :group 'url-file) @@ -165,7 +165,7 @@ Very fast if you have an `md5' primitive function, suitably fast otherwise." url-cache-directory)))))) (defcustom url-cache-creation-function 'url-cache-create-filename-using-md5 - "*What function to use to create a cached filename." + "What function to use to create a cached filename." :type '(choice (const :tag "MD5 of filename (low collision rate)" :value url-cache-create-filename-using-md5) (const :tag "Human readable filenames (higher collision rate)" diff --git a/lisp/url/url-gw.el b/lisp/url/url-gw.el index 9915ccc6781..714d12f3f10 100644 --- a/lisp/url/url-gw.el +++ b/lisp/url/url-gw.el @@ -37,50 +37,50 @@ :group 'url) (defcustom url-gateway-local-host-regexp nil - "*A regular expression specifying local hostnames/machines." + "A regular expression specifying local hostnames/machines." :type '(choice (const nil) regexp) :group 'url-gateway) (defcustom url-gateway-prompt-pattern "^[^#$%>;]*[#$%>;] *" ;; "bash\\|\$ *\r?$\\|> *\r?" - "*A regular expression matching a shell prompt." + "A regular expression matching a shell prompt." :type 'regexp :group 'url-gateway) (defcustom url-gateway-rlogin-host nil - "*What hostname to actually rlog into before doing a telnet." + "What hostname to actually rlog into before doing a telnet." :type '(choice (const nil) string) :group 'url-gateway) (defcustom url-gateway-rlogin-user-name nil - "*Username to log into the remote machine with when using rlogin." + "Username to log into the remote machine with when using rlogin." :type '(choice (const nil) string) :group 'url-gateway) (defcustom url-gateway-rlogin-parameters '("telnet" "-8") - "*Parameters to `url-open-rlogin'. + "Parameters to `url-open-rlogin'. This list will be used as the parameter list given to rsh." :type '(repeat string) :group 'url-gateway) (defcustom url-gateway-telnet-host nil - "*What hostname to actually login to before doing a telnet." + "What hostname to actually login to before doing a telnet." :type '(choice (const nil) string) :group 'url-gateway) (defcustom url-gateway-telnet-parameters '("exec" "telnet" "-8") - "*Parameters to `url-open-telnet'. + "Parameters to `url-open-telnet'. This list will be executed as a command after logging in via telnet." :type '(repeat string) :group 'url-gateway) (defcustom url-gateway-telnet-login-prompt "^\r*.?login:" - "*Prompt that tells us we should send our username when loggin in w/telnet." + "Prompt that tells us we should send our username when loggin in w/telnet." :type 'regexp :group 'url-gateway) (defcustom url-gateway-telnet-password-prompt "^\r*.?password:" - "*Prompt that tells us we should send our password when loggin in w/telnet." + "Prompt that tells us we should send our password when loggin in w/telnet." :type 'regexp :group 'url-gateway) @@ -95,7 +95,7 @@ This list will be executed as a command after logging in via telnet." :group 'url-gateway) (defcustom url-gateway-broken-resolution nil - "*Whether to use nslookup to resolve hostnames. + "Whether to use nslookup to resolve hostnames. This should be used when your version of Emacs cannot correctly use DNS, but your machine can. This usually happens if you are running a statically linked Emacs under SunOS 4.x." @@ -103,7 +103,7 @@ linked Emacs under SunOS 4.x." :group 'url-gateway) (defcustom url-gateway-nslookup-program "nslookup" - "*If non-nil then a string naming nslookup program." + "If non-nil then a string naming nslookup program." :type '(choice (const :tag "None" :value nil) string) :group 'url-gateway) diff --git a/lisp/url/url-history.el b/lisp/url/url-history.el index 5b4f330ed2e..0cc891b32b7 100644 --- a/lisp/url/url-history.el +++ b/lisp/url/url-history.el @@ -1,7 +1,7 @@ ;;; url-history.el --- Global history tracking for URL package -;; Copyright (C) 1996, 1997, 1998, 1999, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -35,7 +35,7 @@ :group 'url) (defcustom url-history-track nil - "*Controls whether to keep a list of all the URLs being visited. + "Controls whether to keep a list of all the URLs being visited. If non-nil, the URL package will keep track of all the URLs visited. If set to t, then the list is saved to disk at the end of each Emacs session." @@ -49,14 +49,14 @@ session." :group 'url-history) (defcustom url-history-file nil - "*The global history file for the URL package. + "The global history file for the URL package. This file contains a list of all the URLs you have visited. This file is parsed at startup and used to provide URL completion." :type '(choice (const :tag "Default" :value nil) file) :group 'url-history) (defcustom url-history-save-interval 3600 - "*The number of seconds between automatic saves of the history list. + "The number of seconds between automatic saves of the history list. Default is 1 hour. Note that if you change this variable outside of the `customize' interface after `url-do-setup' has been run, you need to run the `url-history-setup-save-timer' function manually." diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el index 1469cb9eb8b..715eecd211c 100644 --- a/lisp/url/url-irc.el +++ b/lisp/url/url-irc.el @@ -1,7 +1,7 @@ ;;; url-irc.el --- IRC URL interface -;; Copyright (C) 1996, 1997, 1998, 1999, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2004, 2005, 2006, 2007, 2008, +;; 2009, 2010 Free Software Foundation, Inc. ;; Keywords: comm, data, processes @@ -22,7 +22,8 @@ ;;; Commentary: -;; IRC URLs are defined in http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt +;; IRC URLs are defined in +;; http://www.w3.org/Addressing/draft-mirashi-url-irc-01.txt ;;; Code: @@ -32,7 +33,7 @@ (defconst url-irc-default-port 6667 "Default port for IRC connections.") (defcustom url-irc-function 'url-irc-rcirc - "*Function to actually open an IRC connection. + "Function to actually open an IRC connection. The function should take the following arguments: HOST - the hostname of the IRC server to contact PORT - the port number of the IRC server to contact diff --git a/lisp/url/url-util.el b/lisp/url/url-util.el index e92ccc76285..8beffe60a7f 100644 --- a/lisp/url/url-util.el +++ b/lisp/url/url-util.el @@ -43,7 +43,7 @@ ;;;###autoload (defcustom url-debug nil - "*What types of debug messages from the URL library to show. + "What types of debug messages from the URL library to show. Debug messages are logged to the *URL-DEBUG* buffer. If t, all messages will be logged. diff --git a/lisp/url/url-vars.el b/lisp/url/url-vars.el index 65622a06e02..74192478224 100644 --- a/lisp/url/url-vars.el +++ b/lisp/url/url-vars.el @@ -1,7 +1,7 @@ ;;; url-vars.el --- Variables for Uniform Resource Locator tool -;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Keywords: comm, data, processes, hypermedia @@ -68,7 +68,7 @@ )) (defcustom url-honor-refresh-requests t - "*Whether to do automatic page reloads. + "Whether to do automatic page reloads. These are done at the request of the document author or the server via the `Refresh' header in an HTTP response. If nil, no refresh requests will be honored. If t, all refresh requests will be honored. @@ -79,14 +79,14 @@ If non-nil and not t, the user will be asked for each refresh request." :group 'url-hairy) (defcustom url-automatic-caching nil - "*If non-nil, all documents will be automatically cached to the local disk." + "If non-nil, all documents will be automatically cached to the local disk." :type 'boolean :group 'url-cache) ;; Fixme: sanitize this. (defcustom url-cache-expired (lambda (t1 t2) (>= (- (car t2) (car t1)) 5)) - "*A function determining if a cached item has expired. + "A function determining if a cached item has expired. It takes two times (numbers) as its arguments, and returns non-nil if the second time is 'too old' when compared to the first time." :type 'function @@ -96,14 +96,14 @@ the second time is 'too old' when compared to the first time." "Where to send bug reports.") (defcustom url-personal-mail-address nil - "*Your full email address. + "Your full email address. This is what is sent to HTTP servers as the FROM field in an HTTP request." :type '(choice (const :tag "Unspecified" nil) string) :group 'url) (defcustom url-directory-index-file "index.html" - "*The filename to look for when indexing a directory. + "The filename to look for when indexing a directory. If this file exists, and is readable, then it will be viewed instead of using `dired' to view the directory." :type 'string @@ -166,14 +166,14 @@ variable." (".hqx" . "x-hqx") (".Z" . "x-compress") (".bz2" . "x-bzip2")) - "*An alist of file extensions and appropriate content-transfer-encodings." + "An alist of file extensions and appropriate content-transfer-encodings." :type '(repeat (cons :format "%v" (string :tag "Extension") (string :tag "Encoding"))) :group 'url-mime) (defcustom url-mail-command 'compose-mail - "*This function will be called whenever URL needs to send mail. + "This function will be called whenever URL needs to send mail. It should enter a mail-mode-like buffer in the current window. The commands `mail-to' and `mail-subject' should still work in this buffer, and it should use `mail-header-separator' if possible." @@ -181,7 +181,7 @@ buffer, and it should use `mail-header-separator' if possible." :group 'url) (defcustom url-proxy-services nil - "*An alist of schemes and proxy servers that gateway them. + "An alist of schemes and proxy servers that gateway them. Looks like ((\"http\" . \"hostname:portnumber\") ...). This is set up from the ACCESS_proxy environment variables." :type '(repeat (cons :format "%v" @@ -190,7 +190,7 @@ from the ACCESS_proxy environment variables." :group 'url) (defcustom url-standalone-mode nil - "*Rely solely on the cache?" + "Rely solely on the cache?" :type 'boolean :group 'url-cache) @@ -202,7 +202,7 @@ from the ACCESS_proxy environment variables." (defcustom url-bad-port-list '("25" "119" "19") - "*List of ports to warn the user about connecting to. + "List of ports to warn the user about connecting to. Defaults to just the mail, chargen, and NNTP ports so you cannot be tricked into sending fake mail or forging messages by a malicious HTML document." @@ -255,7 +255,7 @@ given priority 1 and the rest are given priority 0.5.") ;; Fixme: set from the locale. (defcustom url-mime-language-string nil - "*String to send in the Accept-language: field in HTTP requests. + "String to send in the Accept-language: field in HTTP requests. Specifies the preferred language when servers can serve documents in several languages. Use RFC 1766 abbreviations, e.g.: `en' for @@ -284,20 +284,20 @@ get the first available language (as opposed to the default)." "What OS we are on.") (defcustom url-max-password-attempts 5 - "*Maximum number of times a password will be prompted for. + "Maximum number of times a password will be prompted for. Applies when a protected document is denied by the server." :type 'integer :group 'url) (defcustom url-temporary-directory (or (getenv "TMPDIR") "/tmp") - "*Where temporary files go." + "Where temporary files go." :type 'directory :group 'url-file) (make-obsolete-variable 'url-temporary-directory 'temporary-file-directory "23.1") (defcustom url-show-status t - "*Whether to show a running total of bytes transferred. + "Whether to show a running total of bytes transferred. Can cause a large hit if using a remote X display over a slow link, or a terminal with a slow modem." :type 'boolean @@ -308,7 +308,7 @@ a terminal with a slow modem." http://www.example.com/") (defcustom url-news-server nil - "*The default news server from which to get newsgroups/articles. + "The default news server from which to get newsgroups/articles. Applies if no server is specified in the URL. Defaults to the environment variable NNTPSERVER or \"news\" if NNTPSERVER is undefined." @@ -320,13 +320,13 @@ undefined." "A regular expression that will match an absolute URL.") (defcustom url-max-redirections 30 - "*The maximum number of redirection requests to honor in a HTTP connection. + "The maximum number of redirection requests to honor in a HTTP connection. A negative number means to honor an unlimited number of redirection requests." :type 'integer :group 'url) (defcustom url-confirmation-func 'y-or-n-p - "*What function to use for asking yes or no functions. + "What function to use for asking yes or no functions. Possible values are `yes-or-no-p' or `y-or-n-p', or any function that takes a single argument (the prompt), and returns t only if a positive answer is given." @@ -336,7 +336,7 @@ answer is given." :group 'url-hairy) (defcustom url-gateway-method 'native - "*The type of gateway support to use. + "The type of gateway support to use. Should be a symbol specifying how to get a connection from the local machine. Currently supported methods: diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index cf391b2f9ac..23f1e33f181 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -755,7 +755,17 @@ Optional arg BUFFER-FILE overrides `buffer-file-name'." (if add-log-file-name-function (funcall add-log-file-name-function buffer-file) (setq buffer-file - (file-relative-name buffer-file (file-name-directory log-file))) + (let* ((dir (file-name-directory log-file)) + (rel (file-relative-name buffer-file dir))) + ;; Sometimes with symlinks, the two buffers may have names that + ;; appear to belong to different directory trees. So check the + ;; file-truenames, to see if we get a better result. + (if (not (string-match "\\`\\.\\./" rel)) + rel + (let ((new (file-relative-name (file-truename buffer-file) + (file-truename dir)))) + (if (< (length new) (length rel)) + new rel))))) ;; If we have a backup file, it's presumably because we're ;; comparing old and new versions (e.g. for deleted ;; functions) and we'll want to use the original name. diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el index 5695b058d27..4316b6e4d93 100644 --- a/lisp/vc/ediff-diff.el +++ b/lisp/vc/ediff-diff.el @@ -4,6 +4,7 @@ ;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> +;; Package: ediff ;; This file is part of GNU Emacs. diff --git a/lisp/vc/ediff-help.el b/lisp/vc/ediff-help.el index d9ca687e6b0..06a600f0af4 100644 --- a/lisp/vc/ediff-help.el +++ b/lisp/vc/ediff-help.el @@ -4,6 +4,7 @@ ;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> +;; Package: ediff ;; This file is part of GNU Emacs. diff --git a/lisp/vc/ediff-hook.el b/lisp/vc/ediff-hook.el index 390538ed009..e917d29a7b4 100644 --- a/lisp/vc/ediff-hook.el +++ b/lisp/vc/ediff-hook.el @@ -4,6 +4,7 @@ ;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> +;; Package: ediff ;; This file is part of GNU Emacs. diff --git a/lisp/vc/ediff-init.el b/lisp/vc/ediff-init.el index 0ea1e8c02f6..d1b40f7ee58 100644 --- a/lisp/vc/ediff-init.el +++ b/lisp/vc/ediff-init.el @@ -4,6 +4,7 @@ ;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> +;; Package: ediff ;; This file is part of GNU Emacs. diff --git a/lisp/vc/ediff-merg.el b/lisp/vc/ediff-merg.el index c4b94a02e0c..4c6aee15d1d 100644 --- a/lisp/vc/ediff-merg.el +++ b/lisp/vc/ediff-merg.el @@ -4,6 +4,7 @@ ;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> +;; Package: ediff ;; This file is part of GNU Emacs. diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el index a2c1043049d..39bd06fbd97 100644 --- a/lisp/vc/ediff-mult.el +++ b/lisp/vc/ediff-mult.el @@ -4,6 +4,7 @@ ;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> +;; Package: ediff ;; This file is part of GNU Emacs. diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el index 1203747fdb7..b6c7f6ab7ba 100644 --- a/lisp/vc/ediff-ptch.el +++ b/lisp/vc/ediff-ptch.el @@ -4,6 +4,7 @@ ;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> +;; Package: ediff ;; This file is part of GNU Emacs. diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index 77284a19f50..e1589e3deb4 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -4,6 +4,7 @@ ;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> +;; Package: ediff ;; This file is part of GNU Emacs. diff --git a/lisp/vc/ediff-vers.el b/lisp/vc/ediff-vers.el index e314afc24b5..581aad3e4dc 100644 --- a/lisp/vc/ediff-vers.el +++ b/lisp/vc/ediff-vers.el @@ -4,6 +4,7 @@ ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> +;; Package: ediff ;; This file is part of GNU Emacs. diff --git a/lisp/vc/ediff-wind.el b/lisp/vc/ediff-wind.el index 61213c039c0..8b16c5a4a12 100644 --- a/lisp/vc/ediff-wind.el +++ b/lisp/vc/ediff-wind.el @@ -4,6 +4,7 @@ ;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> +;; Package: ediff ;; This file is part of GNU Emacs. diff --git a/lisp/vc/ediff.el b/lisp/vc/ediff.el index cb0d6444b79..c41a6e4a1af 100644 --- a/lisp/vc/ediff.el +++ b/lisp/vc/ediff.el @@ -6,6 +6,7 @@ ;; Author: Michael Kifer <kifer@cs.stonybrook.edu> ;; Created: February 2, 1994 ;; Keywords: comparing, merging, patching, vc, tools, unix +;; Version: 2.81.4 ;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this ;; file on 20/3/2008, and the maintainer agreed that when a bug is diff --git a/lisp/vc/pcvs-defs.el b/lisp/vc/pcvs-defs.el index a49cd2f1ab1..7dda4533f6e 100644 --- a/lisp/vc/pcvs-defs.el +++ b/lisp/vc/pcvs-defs.el @@ -6,6 +6,7 @@ ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> ;; Keywords: pcl-cvs +;; Package: pcvs ;; This file is part of GNU Emacs. diff --git a/lisp/vc/pcvs-info.el b/lisp/vc/pcvs-info.el index 198b3dd057d..1ae924ff177 100644 --- a/lisp/vc/pcvs-info.el +++ b/lisp/vc/pcvs-info.el @@ -6,6 +6,7 @@ ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> ;; Keywords: pcl-cvs +;; Package: pcvs ;; This file is part of GNU Emacs. diff --git a/lisp/vc/pcvs-parse.el b/lisp/vc/pcvs-parse.el index deb11936c86..560a270a731 100644 --- a/lisp/vc/pcvs-parse.el +++ b/lisp/vc/pcvs-parse.el @@ -5,6 +5,7 @@ ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> ;; Keywords: pcl-cvs +;; Package: pcvs ;; This file is part of GNU Emacs. diff --git a/lisp/vc/pcvs-util.el b/lisp/vc/pcvs-util.el index 26f4a829a5f..595b762b2fa 100644 --- a/lisp/vc/pcvs-util.el +++ b/lisp/vc/pcvs-util.el @@ -5,6 +5,7 @@ ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> ;; Keywords: pcl-cvs +;; Package: pcvs ;; This file is part of GNU Emacs. diff --git a/lisp/vc/vc-annotate.el b/lisp/vc/vc-annotate.el index c95fe54d04a..10b88e6f14c 100644 --- a/lisp/vc/vc-annotate.el +++ b/lisp/vc/vc-annotate.el @@ -6,6 +6,7 @@ ;; Author: Martin Lorentzson <emwson@emw.ericsson.se> ;; Maintainer: FSF ;; Keywords: vc tools +;; Package: vc ;; This file is part of GNU Emacs. diff --git a/lisp/vc/vc-arch.el b/lisp/vc/vc-arch.el index a723f98b8ae..3ca9d59e3c1 100644 --- a/lisp/vc/vc-arch.el +++ b/lisp/vc/vc-arch.el @@ -5,6 +5,7 @@ ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Stefan Monnier <monnier@gnu.org> +;; Package: vc ;; This file is part of GNU Emacs. diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index bea856b28e2..78441772bd4 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -6,8 +6,9 @@ ;; Riccardo Murri <riccardo.murri@gmail.com> ;; Keywords: vc tools ;; Created: Sept 2006 -;; Version: 2008-01-04 (Bzr revno 25) +;; Version: 2008-01-04 ;; URL: http://launchpad.net/vc-bzr +;; Package: vc ;; This file is part of GNU Emacs. diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index 8f9d07723d8..ad307d3a201 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -5,6 +5,7 @@ ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel <spiegel@gnu.org> +;; Package: vc ;; This file is part of GNU Emacs. diff --git a/lisp/vc/vc-dav.el b/lisp/vc/vc-dav.el index 1036f34fe79..bd495eaf4b7 100644 --- a/lisp/vc/vc-dav.el +++ b/lisp/vc/vc-dav.el @@ -5,6 +5,7 @@ ;; Author: Bill Perry <wmperry@gnu.org> ;; Maintainer: Bill Perry <wmperry@gnu.org> ;; Keywords: url, vc +;; Package: vc ;; 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 diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 9cacef2f71b..4397251959d 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -5,6 +5,7 @@ ;; Author: Dan Nicolaescu <dann@ics.uci.edu> ;; Keywords: vc tools +;; Package: vc ;; This file is part of GNU Emacs. diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index 0b7851f0a85..b6ccae1af1b 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -6,6 +6,7 @@ ;; Author: FSF (see below for full credits) ;; Maintainer: Eric S. Raymond <esr@thyrsus.com> ;; Keywords: vc tools +;; Package: vc ;; This file is part of GNU Emacs. diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index cccccbdfd02..48a86454f74 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -4,6 +4,7 @@ ;; Author: Alexandre Julliard <julliard@winehq.org> ;; Keywords: vc tools +;; Package: vc ;; This file is part of GNU Emacs. diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 8504309e334..c087a4d9e1f 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -4,6 +4,7 @@ ;; Author: Ivan Kanis ;; Keywords: vc tools +;; Package: vc ;; This file is part of GNU Emacs. diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index cf444d204ea..91e9b8e3cd3 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -6,6 +6,7 @@ ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel <spiegel@gnu.org> +;; Package: vc ;; This file is part of GNU Emacs. diff --git a/lisp/vc/vc-mtn.el b/lisp/vc/vc-mtn.el index 03b651d9450..cb03853f865 100644 --- a/lisp/vc/vc-mtn.el +++ b/lisp/vc/vc-mtn.el @@ -4,6 +4,7 @@ ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> ;; Keywords: vc +;; Package: vc ;; This file is part of GNU Emacs. diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index 9756ec21967..1c3b4c00e32 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el @@ -6,6 +6,7 @@ ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel <spiegel@gnu.org> +;; Package: vc ;; This file is part of GNU Emacs. diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el index de476ded369..cf7d97e483d 100644 --- a/lisp/vc/vc-sccs.el +++ b/lisp/vc/vc-sccs.el @@ -6,6 +6,7 @@ ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Andre Spiegel <spiegel@gnu.org> +;; Package: vc ;; This file is part of GNU Emacs. diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index 889a60c278e..3af6842ab44 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -5,6 +5,7 @@ ;; Author: FSF (see vc.el for full credits) ;; Maintainer: Stefan Monnier <monnier@gnu.org> +;; Package: vc ;; This file is part of GNU Emacs. diff --git a/lisp/version.el b/lisp/version.el index 770409b9487..b4e2c61b570 100644 --- a/lisp/version.el +++ b/lisp/version.el @@ -6,6 +6,7 @@ ;; Maintainer: FSF ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el index 78fe793b174..1abb29febc7 100644 --- a/lisp/w32-fns.el +++ b/lisp/w32-fns.el @@ -5,6 +5,7 @@ ;; Author: Geoff Voelker <voelker@cs.washington.edu> ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. @@ -424,40 +425,32 @@ bit output with no translation." 'w32-charset-info-alist "21.1") -;;;; Selections and cut buffers +;;;; Selections ;; We keep track of the last text selected here, so we can check the ;; current selection against it, and avoid passing back our own text -;; from x-cut-buffer-or-selection-value. +;; from x-selection-value. (defvar x-last-selected-text nil) -;; It is said that overlarge strings are slow to put into the cut buffer. -;; Note this value is overridden below. -(defvar x-cut-buffer-max 20000 - "Max number of characters to put in the cut buffer.") - -(defun x-select-text (text &optional push) +(defun x-select-text (text) "Select TEXT, a string, according to the window system. -On X, put TEXT in the primary X selection. For backward -compatibility with older X applications, set the value of X cut -buffer 0 as well, and if the optional argument PUSH is non-nil, -rotate the cut buffers. If `x-select-enable-clipboard' is -non-nil, copy the text to the X clipboard as well. +On X, if `x-select-enable-clipboard' is non-nil, copy TEXT to the +clipboard. If `x-select-enable-primary' is non-nil, put TEXT in +the primary selection. On Windows, make TEXT the current selection. If `x-select-enable-clipboard' is non-nil, copy the text to the -clipboard as well. The argument PUSH is ignored. +clipboard as well. -On Nextstep, put TEXT in the pasteboard; PUSH is ignored." +On Nextstep, put TEXT in the pasteboard." (if x-select-enable-clipboard (w32-set-clipboard-data text)) (setq x-last-selected-text text)) (defun x-get-selection-value () "Return the value of the current selection. -Consult the selection, then the cut buffer. Treat empty strings as if -they were unset." +Consult the selection. Treat empty strings as if they were unset." (if x-select-enable-clipboard (let (text) ;; Don't die if x-get-selection signals an error. @@ -475,7 +468,7 @@ they were unset." (t (setq x-last-selected-text text)))))) -(defalias 'x-cut-buffer-or-selection-value 'x-get-selection-value) +(defalias 'x-selection-value 'x-get-selection-value) ;; Arrange for the kill and yank functions to set and check the clipboard. (setq interprogram-cut-function 'x-select-text) diff --git a/lisp/w32-vars.el b/lisp/w32-vars.el index c1d593ea4ec..91676dd12da 100644 --- a/lisp/w32-vars.el +++ b/lisp/w32-vars.el @@ -5,6 +5,7 @@ ;; Author: Jason Rumney <jasonr@gnu.org> ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 79ce9a330d4..4b8b9a61173 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -6,7 +6,7 @@ ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Maintainer: Vinicius Jose Latorre <viniciusjl@ig.com.br> ;; Keywords: data, wp -;; Version: 12.1 +;; Version: 13.1 ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre ;; This file is part of GNU Emacs. @@ -382,19 +382,28 @@ (defcustom whitespace-style - '(tabs spaces trailing lines space-before-tab newline - indentation empty space-after-tab - space-mark tab-mark newline-mark) + '(face + tabs spaces trailing lines space-before-tab newline + indentation empty space-after-tab + space-mark tab-mark newline-mark) "Specify which kind of blank is visualized. It's a list containing some or all of the following values: + face enable all visualization via faces (see below). + trailing trailing blanks are visualized via faces. + It has effect only if `face' (see above) + is present in `whitespace-style'. tabs TABs are visualized via faces. + It has effect only if `face' (see above) + is present in `whitespace-style'. spaces SPACEs and HARD SPACEs are visualized via faces. + It has effect only if `face' (see above) + is present in `whitespace-style'. lines lines which have columns beyond `whitespace-line-column' are highlighted via @@ -402,6 +411,8 @@ It's a list containing some or all of the following values: Whole line is highlighted. It has precedence over `lines-tail' (see below). + It has effect only if `face' (see above) + is present in `whitespace-style'. lines-tail lines which have columns beyond `whitespace-line-column' are highlighted via @@ -409,45 +420,69 @@ It's a list containing some or all of the following values: But only the part of line which goes beyond `whitespace-line-column' column. It has effect only if `lines' (see above) - is not present in `whitespace-style'. + is not present in `whitespace-style' + and if `face' (see above) is present in + `whitespace-style'. newline NEWLINEs are visualized via faces. + It has effect only if `face' (see above) + is present in `whitespace-style'. empty empty lines at beginning and/or end of buffer are visualized via faces. + It has effect only if `face' (see above) + is present in `whitespace-style'. indentation::tab 8 or more SPACEs at beginning of line are visualized via faces. + It has effect only if `face' (see above) + is present in `whitespace-style'. indentation::space TABs at beginning of line are visualized via faces. + It has effect only if `face' (see above) + is present in `whitespace-style'. indentation 8 or more SPACEs at beginning of line are visualized, if `indent-tabs-mode' (which see) is non-nil; otherwise, TABs at beginning of line are visualized via faces. + It has effect only if `face' (see above) + is present in `whitespace-style'. space-after-tab::tab 8 or more SPACEs after a TAB are visualized via faces. + It has effect only if `face' (see above) + is present in `whitespace-style'. space-after-tab::space TABs are visualized when 8 or more SPACEs occur after a TAB, via faces. + It has effect only if `face' (see above) + is present in `whitespace-style'. space-after-tab 8 or more SPACEs after a TAB are visualized, if `indent-tabs-mode' (which see) is non-nil; otherwise, the TABs are visualized via faces. + It has effect only if `face' (see above) + is present in `whitespace-style'. space-before-tab::tab SPACEs before TAB are visualized via faces. + It has effect only if `face' (see above) + is present in `whitespace-style'. space-before-tab::space TABs are visualized when SPACEs occur before TAB, via faces. + It has effect only if `face' (see above) + is present in `whitespace-style'. space-before-tab SPACEs before TAB are visualized, if `indent-tabs-mode' (which see) is non-nil; otherwise, the TABs are visualized via faces. + It has effect only if `face' (see above) + is present in `whitespace-style'. space-mark SPACEs and HARD SPACEs are visualized via display table. @@ -486,9 +521,16 @@ So, for example, if indentation and indentation::space are included in `whitespace-style' list, the indentation value is evaluated instead of indentation::space value. +One reason for not visualize spaces via faces (if `face' is not +included in `whitespace-style') is to use exclusively for +cleanning up a buffer. See `whitespace-cleanup' and +`whitespace-cleanup-region' for documentation. + See also `whitespace-display-mappings' for documentation." :type '(repeat :tag "Kind of Blank" (choice :tag "Kind of Blank Face" + (const :tag "(Face) Face visualization" + face) (const :tag "(Face) Trailing TABs, SPACEs and HARD SPACEs" trailing) (const :tag "(Face) SPACEs and HARD SPACEs" @@ -521,9 +563,9 @@ Used when `whitespace-style' includes the value `spaces'." (defface whitespace-space '((((class color) (background dark)) - (:background "grey20" :foreground "aquamarine3")) + (:background "grey20" :foreground "darkgray")) (((class color) (background light)) - (:background "LightYellow" :foreground "aquamarine3")) + (:background "LightYellow" :foreground "lightgray")) (t (:inverse-video t))) "Face used to visualize SPACE." :group 'whitespace) @@ -539,9 +581,9 @@ Used when `whitespace-style' includes the value `spaces'." (defface whitespace-hspace ; 'nobreak-space '((((class color) (background dark)) - (:background "grey24" :foreground "aquamarine3")) + (:background "grey24" :foreground "darkgray")) (((class color) (background light)) - (:background "LemonChiffon3" :foreground "aquamarine3")) + (:background "LemonChiffon3" :foreground "lightgray")) (t (:inverse-video t))) "Face used to visualize HARD SPACE." :group 'whitespace) @@ -557,9 +599,9 @@ Used when `whitespace-style' includes the value `tabs'." (defface whitespace-tab '((((class color) (background dark)) - (:background "grey22" :foreground "aquamarine3")) + (:background "grey22" :foreground "darkgray")) (((class color) (background light)) - (:background "beige" :foreground "aquamarine3")) + (:background "beige" :foreground "lightgray")) (t (:inverse-video t))) "Face used to visualize TAB." :group 'whitespace) @@ -812,7 +854,7 @@ Used when `whitespace-style' includes `indentation', :group 'whitespace) -(defcustom whitespace-empty-at-bob-regexp "\\`\\(\\([ \t]*\n\\)+\\)" +(defcustom whitespace-empty-at-bob-regexp "^\\(\\([ \t]*\n\\)+\\)" "Specify regexp for empty lines at beginning of buffer. If you're using `mule' package, there may be other characters besides: @@ -827,7 +869,7 @@ Used when `whitespace-style' includes `empty'." :group 'whitespace) -(defcustom whitespace-empty-at-eob-regexp "^\\([ \t\n]+\\)\\'" +(defcustom whitespace-empty-at-eob-regexp "^\\([ \t\n]+\\)" "Specify regexp for empty lines at end of buffer. If you're using `mule' package, there may be other characters besides: @@ -866,8 +908,13 @@ Used when `whitespace-style' includes `space-after-tab', (defcustom whitespace-line-column 80 "Specify column beyond which the line is highlighted. +It must be an integer or nil. If nil, the `fill-column' variable value is +used. + Used when `whitespace-style' includes `lines' or `lines-tail'." - :type '(integer :tag "Line Length") + :type '(choice :tag "Line Length Limit" + (integer :tag "Line Length") + (const :tag "Use fill-column" nil)) :group 'whitespace) @@ -1151,7 +1198,8 @@ See also `whitespace-newline' and `whitespace-display-mappings'." (defconst whitespace-style-value-list - '(tabs + '(face + tabs spaces trailing lines @@ -1176,7 +1224,8 @@ See also `whitespace-newline' and `whitespace-display-mappings'." (defconst whitespace-toggle-option-alist - '((?t . tabs) + '((?f . face) + (?t . tabs) (?s . spaces) (?r . trailing) (?l . lines) @@ -1228,6 +1277,19 @@ Used by `whitespace-trailing-regexp' function (which see).") "Used to save locally the font-lock refontify state. Used by `whitespace-post-command-hook' function (which see).") +(defvar whitespace-bob-marker nil + "Used to save locally the bob marker value. +Used by `whitespace-post-command-hook' function (which see).") + +(defvar whitespace-eob-marker nil + "Used to save locally the eob marker value. +Used by `whitespace-post-command-hook' function (which see).") + +(defvar whitespace-buffer-changed nil + "Used to indicate locally if buffer changed. +Used by `whitespace-post-command-hook' and `whitespace-buffer-changed' +functions (which see).") + ;;;###autoload (defun whitespace-toggle-options (arg) @@ -1243,6 +1305,7 @@ Interactively, it reads one of the following chars: CHAR MEANING (VIA FACES) + f toggle face visualization t toggle TAB visualization s toggle SPACE and HARD SPACE visualization r toggle trailing blanks visualization @@ -1271,6 +1334,7 @@ Interactively, it reads one of the following chars: Non-interactively, ARG should be a symbol or a list of symbols. The valid symbols are: + face toggle face visualization tabs toggle TAB visualization spaces toggle SPACE and HARD SPACE visualization trailing toggle trailing blanks visualization @@ -1320,6 +1384,7 @@ Interactively, it accepts one of the following chars: CHAR MEANING (VIA FACES) + f toggle face visualization t toggle TAB visualization s toggle SPACE and HARD SPACE visualization r toggle trailing blanks visualization @@ -1348,6 +1413,7 @@ Interactively, it accepts one of the following chars: Non-interactively, ARG should be a symbol or a list of symbols. The valid symbols are: + face toggle face visualization tabs toggle TAB visualization spaces toggle SPACE and HARD SPACE visualization trailing toggle trailing blanks visualization @@ -1463,10 +1529,10 @@ documentation." (let (overwrite-mode) ; enforce no overwrite (goto-char (point-min)) (when (re-search-forward - whitespace-empty-at-bob-regexp nil t) + (concat "\\`" whitespace-empty-at-bob-regexp) nil t) (delete-region (match-beginning 1) (match-end 1))) (when (re-search-forward - whitespace-empty-at-eob-regexp nil t) + (concat whitespace-empty-at-eob-regexp "\\'") nil t) (delete-region (match-beginning 1) (match-end 1))))))) ;; PROBLEM 3: 8 or more SPACEs at bol ;; PROBLEM 4: SPACEs before TAB @@ -1877,9 +1943,10 @@ cleaning up these problems." (defconst whitespace-help-text "\ - Whitespace Toggle Options - - FACES + Whitespace Toggle Options | scroll up : SPC or > | + | scroll down: M-SPC or < | + FACES \\__________________________/ + [] f - toggle face visualization [] t - toggle TAB visualization [] s - toggle SPACE and HARD SPACE visualization [] r - toggle trailing blanks visualization @@ -1953,15 +2020,13 @@ cleaning up these problems." "Display BUFFER in a new window." (goto-char (point-min)) (set-buffer-modified-p nil) - (let ((size (- (window-height) - (max window-min-height - (1+ (count-lines (point-min) - (point-max))))))) - (when (<= size 0) - (kill-buffer buffer) - (error "Frame height is too small; \ + (when (< (window-height) (* 2 window-min-height)) + (kill-buffer buffer) + (error "Window height is too small; \ can't split window to display whitespace toggle options")) - (set-window-buffer (split-window nil size) buffer))) + (let ((win (split-window))) + (set-window-buffer win buffer) + (shrink-window-if-larger-than-buffer win))) (defun whitespace-kill-buffer (buffer-name) @@ -1977,6 +2042,24 @@ can't split window to display whitespace toggle options")) (whitespace-kill-buffer whitespace-help-buffer-name)) +(defun whitespace-help-scroll (&optional up) + "Scroll help window, if it exists. + +If UP is non-nil, scroll up; otherwise, scroll down." + (condition-case data-help + (let ((buffer (get-buffer whitespace-help-buffer-name))) + (if buffer + (with-selected-window (get-buffer-window buffer) + (if up + (scroll-up 3) + (scroll-down 3))) + (ding))) + ;; handler + ((error) + ;; just ignore error + ))) + + (defun whitespace-interactive-char (local-p) "Interactive function to read a char and return a symbol. @@ -1987,6 +2070,7 @@ It accepts one of the following chars: CHAR MEANING (VIA FACES) + f toggle face visualization t toggle TAB visualization s toggle SPACE and HARD SPACE visualization r toggle trailing blanks visualization @@ -2036,9 +2120,13 @@ See also `whitespace-toggle-option-alist'." (cdr (assq ch whitespace-toggle-option-alist))))) ;; while body - (if (eq ch ?\?) - (whitespace-help-on style) - (ding))) + (cond + ((eq ch ?\?) (whitespace-help-on style)) + ((eq ch ?\ ) (whitespace-help-scroll t)) + ((eq ch ?\M- ) (whitespace-help-scroll)) + ((eq ch ?>) (whitespace-help-scroll t)) + ((eq ch ?<) (whitespace-help-scroll)) + (t (ding)))) (whitespace-help-off) (message " ")) ; clean echo area ;; handler @@ -2117,22 +2205,23 @@ resultant list will be returned." (defun whitespace-style-face-p () "Return t if there is some visualization via face." - (or (memq 'tabs whitespace-active-style) - (memq 'spaces whitespace-active-style) - (memq 'trailing whitespace-active-style) - (memq 'lines whitespace-active-style) - (memq 'lines-tail whitespace-active-style) - (memq 'newline whitespace-active-style) - (memq 'empty whitespace-active-style) - (memq 'indentation whitespace-active-style) - (memq 'indentation::tab whitespace-active-style) - (memq 'indentation::space whitespace-active-style) - (memq 'space-after-tab whitespace-active-style) - (memq 'space-after-tab::tab whitespace-active-style) - (memq 'space-after-tab::space whitespace-active-style) - (memq 'space-before-tab whitespace-active-style) - (memq 'space-before-tab::tab whitespace-active-style) - (memq 'space-before-tab::space whitespace-active-style))) + (and (memq 'face whitespace-active-style) + (or (memq 'tabs whitespace-active-style) + (memq 'spaces whitespace-active-style) + (memq 'trailing whitespace-active-style) + (memq 'lines whitespace-active-style) + (memq 'lines-tail whitespace-active-style) + (memq 'newline whitespace-active-style) + (memq 'empty whitespace-active-style) + (memq 'indentation whitespace-active-style) + (memq 'indentation::tab whitespace-active-style) + (memq 'indentation::space whitespace-active-style) + (memq 'space-after-tab whitespace-active-style) + (memq 'space-after-tab::tab whitespace-active-style) + (memq 'space-after-tab::space whitespace-active-style) + (memq 'space-before-tab whitespace-active-style) + (memq 'space-before-tab::tab whitespace-active-style) + (memq 'space-before-tab::space whitespace-active-style)))) (defun whitespace-color-on () @@ -2146,8 +2235,15 @@ resultant list will be returned." (set (make-local-variable 'whitespace-point) (point)) (set (make-local-variable 'whitespace-font-lock-refontify) + 0) + (set (make-local-variable 'whitespace-bob-marker) + (point-min-marker)) + (set (make-local-variable 'whitespace-eob-marker) + (point-max-marker)) + (set (make-local-variable 'whitespace-buffer-changed) nil) (add-hook 'post-command-hook #'whitespace-post-command-hook nil t) + (add-hook 'before-change-functions #'whitespace-buffer-changed nil t) ;; turn off font lock (set (make-local-variable 'whitespace-font-lock-mode) font-lock-mode) @@ -2158,7 +2254,7 @@ resultant list will be returned." nil (list ;; Show SPACEs - (list #'whitespace-space-regexp 1 whitespace-space t) + (list whitespace-space-regexp 1 whitespace-space t) ;; Show HARD SPACEs (list whitespace-hspace-regexp 1 whitespace-hspace t)) t)) @@ -2167,7 +2263,7 @@ resultant list will be returned." nil (list ;; Show TABs - (list #'whitespace-tab-regexp 1 whitespace-tab t)) + (list whitespace-tab-regexp 1 whitespace-tab t)) t)) (when (memq 'trailing whitespace-active-style) (font-lock-add-keywords @@ -2183,14 +2279,16 @@ resultant list will be returned." (list ;; Show "long" lines (list - (format - "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$" - whitespace-tab-width (1- whitespace-tab-width) - (/ whitespace-line-column whitespace-tab-width) - (let ((rem (% whitespace-line-column whitespace-tab-width))) - (if (zerop rem) - "" - (format ".\\{%d\\}" rem)))) + (let ((line-column (or whitespace-line-column fill-column))) + (format + "^\\([^\t\n]\\{%s\\}\\|[^\t\n]\\{0,%s\\}\t\\)\\{%d\\}%s\\(.+\\)$" + whitespace-tab-width + (1- whitespace-tab-width) + (/ line-column whitespace-tab-width) + (let ((rem (% line-column whitespace-tab-width))) + (if (zerop rem) + "" + (format ".\\{%d\\}" rem))))) (if (memq 'lines whitespace-active-style) 0 ; whole line 2) ; line tail @@ -2296,7 +2394,8 @@ resultant list will be returned." ;; turn off font lock (when (whitespace-style-face-p) (font-lock-mode 0) - (remove-hook 'post-command-hook #'whitespace-post-command-hook) + (remove-hook 'post-command-hook #'whitespace-post-command-hook t) + (remove-hook 'before-change-functions #'whitespace-buffer-changed t) (when whitespace-font-lock (setq whitespace-font-lock nil font-lock-keywords whitespace-font-lock-keywords)) @@ -2317,37 +2416,128 @@ resultant list will be returned." (defun whitespace-empty-at-bob-regexp (limit) "Match spaces at beginning of buffer which do not contain the point at \ beginning of buffer." - (and (/= whitespace-point 1) - (re-search-forward whitespace-empty-at-bob-regexp limit t))) + (let ((b (point)) + r) + (cond + ;; at bob + ((= b 1) + (setq r (and (/= whitespace-point 1) + (looking-at whitespace-empty-at-bob-regexp))) + (if r + (set-marker whitespace-bob-marker (match-end 1)) + (set-marker whitespace-bob-marker b))) + ;; inside bob empty region + ((<= limit whitespace-bob-marker) + (setq r (looking-at whitespace-empty-at-bob-regexp)) + (if r + (when (< (match-end 1) limit) + (set-marker whitespace-bob-marker (match-end 1))) + (set-marker whitespace-bob-marker b))) + ;; intersection with end of bob empty region + ((<= b whitespace-bob-marker) + (setq r (looking-at whitespace-empty-at-bob-regexp)) + (if r + (set-marker whitespace-bob-marker (match-end 1)) + (set-marker whitespace-bob-marker b))) + ;; it is not inside bob empty region + (t + (setq r nil))) + ;; move to end of matching + (and r (goto-char (match-end 1))) + r)) + + +(defsubst whitespace-looking-back (regexp limit) + (save-excursion + (when (/= 0 (skip-chars-backward " \t\n" limit)) + (unless (bolp) + (forward-line 1)) + (looking-at regexp)))) (defun whitespace-empty-at-eob-regexp (limit) "Match spaces at end of buffer which do not contain the point at end of \ buffer." - (and (/= whitespace-point (1+ (buffer-size))) - (re-search-forward whitespace-empty-at-eob-regexp limit t))) - - -(defun whitespace-space-regexp (limit) - "Match spaces." - (setq whitespace-font-lock-refontify t) - (re-search-forward whitespace-space-regexp limit t)) - - -(defun whitespace-tab-regexp (limit) - "Match tabs." - (setq whitespace-font-lock-refontify t) - (re-search-forward whitespace-tab-regexp limit t)) + (let ((b (point)) + (e (1+ (buffer-size))) + r) + (cond + ;; at eob + ((= limit e) + (when (/= whitespace-point e) + (goto-char limit) + (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b))) + (if r + (set-marker whitespace-eob-marker (match-beginning 1)) + (set-marker whitespace-eob-marker limit) + (goto-char b))) ; return back to initial position + ;; inside eob empty region + ((>= b whitespace-eob-marker) + (goto-char limit) + (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b)) + (if r + (when (> (match-beginning 1) b) + (set-marker whitespace-eob-marker (match-beginning 1))) + (set-marker whitespace-eob-marker limit) + (goto-char b))) ; return back to initial position + ;; intersection with beginning of eob empty region + ((>= limit whitespace-eob-marker) + (goto-char limit) + (setq r (whitespace-looking-back whitespace-empty-at-eob-regexp b)) + (if r + (set-marker whitespace-eob-marker (match-beginning 1)) + (set-marker whitespace-eob-marker limit) + (goto-char b))) ; return back to initial position + ;; it is not inside eob empty region + (t + (setq r nil))) + r)) + + +(defun whitespace-buffer-changed (beg end) + "Set `whitespace-buffer-changed' variable to t." + (setq whitespace-buffer-changed t)) (defun whitespace-post-command-hook () "Save current point into `whitespace-point' variable. Also refontify when necessary." - (setq whitespace-point (point)) - (let ((refontify (or (eolp) ; end of line - (= whitespace-point 1)))) ; beginning of buffer - (when (or whitespace-font-lock-refontify refontify) - (setq whitespace-font-lock-refontify refontify) + (setq whitespace-point (point)) ; current point position + (let ((refontify + (or + ;; it is at end of line ... + (and (eolp) + ;; ... with trailing SPACE or TAB + (or (= (preceding-char) ?\ ) + (= (preceding-char) ?\t))) + ;; it is at beginning of buffer (bob) + (= whitespace-point 1) + ;; the buffer was modified and ... + (and whitespace-buffer-changed + (or + ;; ... or inside bob whitespace region + (<= whitespace-point whitespace-bob-marker) + ;; ... or at bob whitespace region border + (and (= whitespace-point (1+ whitespace-bob-marker)) + (= (preceding-char) ?\n)))) + ;; it is at end of buffer (eob) + (= whitespace-point (1+ (buffer-size))) + ;; the buffer was modified and ... + (and whitespace-buffer-changed + (or + ;; ... or inside eob whitespace region + (>= whitespace-point whitespace-eob-marker) + ;; ... or at eob whitespace region border + (and (= whitespace-point (1- whitespace-eob-marker)) + (= (following-char) ?\n))))))) + (when (or refontify (> whitespace-font-lock-refontify 0)) + (setq whitespace-buffer-changed nil) + ;; adjust refontify counter + (setq whitespace-font-lock-refontify + (if refontify + 1 + (1- whitespace-font-lock-refontify))) + ;; refontify (jit-lock-refontify)))) @@ -2386,11 +2576,11 @@ Also refontify when necessary." (unless whitespace-display-table-was-local (setq whitespace-display-table-was-local t whitespace-display-table + (copy-sequence buffer-display-table)) + ;; asure `buffer-display-table' is unique + ;; when two or more windows are visible. + (setq buffer-display-table (copy-sequence buffer-display-table))) - ;; asure `buffer-display-table' is unique - ;; when two or more windows are visible. - (set (make-local-variable 'buffer-display-table) - (copy-sequence buffer-display-table)) (unless buffer-display-table (setq buffer-display-table (make-display-table))) (dolist (entry whitespace-display-mappings) diff --git a/lisp/wid-browse.el b/lisp/wid-browse.el index 698e6e805a4..96e6bd236cf 100644 --- a/lisp/wid-browse.el +++ b/lisp/wid-browse.el @@ -5,6 +5,7 @@ ;; ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Keywords: extensions +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/wid-edit.el b/lisp/wid-edit.el index dfeb6371f5e..721414b32ac 100644 --- a/lisp/wid-edit.el +++ b/lisp/wid-edit.el @@ -6,6 +6,7 @@ ;; Author: Per Abrahamsen <abraham@dina.kvl.dk> ;; Maintainer: FSF ;; Keywords: extensions +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/widget.el b/lisp/widget.el index 3e35f6c25ab..962235a25d2 100644 --- a/lisp/widget.el +++ b/lisp/widget.el @@ -7,6 +7,7 @@ ;; Keywords: help, extensions, faces, hypermedia ;; Version: 1.9920 ;; X-URL: http://www.dina.kvl.dk/~abraham/custom/ +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/lisp/window.el b/lisp/window.el index b674b480025..9a52667cea0 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -6,6 +6,7 @@ ;; Maintainer: FSF ;; Keywords: internal +;; Package: emacs ;; This file is part of GNU Emacs. @@ -54,6 +55,7 @@ This macro saves and restores the current buffer, since otherwise its normal operation could make a different buffer current. The order of recently selected windows and the buffer list ordering are not altered by this macro (unless they are altered in BODY)." + (declare (indent 0) (debug t)) `(let ((save-selected-window-window (selected-window)) ;; It is necessary to save all of these, because calling ;; select-window changes frame-selected-window for whatever diff --git a/lisp/woman.el b/lisp/woman.el index 291ebcee740..cc14091c2e7 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -7,7 +7,7 @@ ;; Maintainer: FSF ;; Keywords: help, unix ;; Adapted-By: Eli Zaretskii <eliz@gnu.org> -;; Version: see `woman-version' +;; Version: 0.551 ;; URL: http://centaur.maths.qmul.ac.uk/Emacs/WoMan/ ;; This file is part of GNU Emacs. @@ -3388,7 +3388,10 @@ Format paragraphs upto TO. Supports special chars. "Translate up to marker TO. Do this last of all transformations." (if translations (let ((matches (car translations)) - (alist (cdr translations))) + (alist (cdr translations)) + ;; Translations are case-sensitive, eg ".tr ab" does not + ;; affect "A" (bug#6849). + (case-fold-search nil)) (while (re-search-forward matches to t) ;; Done like this to retain text properties and ;; support translation of special characters: diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index 6d38fd043fe..c589382e014 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -6,6 +6,7 @@ ;; Author: Jan Djärv <jan.h.d@swipnet.se> ;; Maintainer: FSF ;; Keywords: window, drag, drop +;; Package: emacs ;; This file is part of GNU Emacs. diff --git a/make-dist b/make-dist index 95512c7f482..a113e00413b 100755 --- a/make-dist +++ b/make-dist @@ -398,10 +398,10 @@ echo "Making links to \`lisp' and its subdirectories" mkdir -p ../${tempdir}/lisp/$file ln $file/[a-zA-Z0-9]*.el ../${tempdir}/lisp/$file ln $file/[a-zA-Z0-9]*.elc ../${tempdir}/lisp/$file - ## calc/README.priv, nxml/TODO + ## calc/README.priv for f in $file/[a-zA-Z]*.xpm $file/[a-zA-Z]*.[xp]bm \ $file/README $file/ChangeLog $file/ChangeLog.*[0-9] \ - $file/README.prev $file/TODO; do + $file/README.prev; do if [ -f $f ]; then ln $f ../${tempdir}/lisp/$file fi diff --git a/msdos/ChangeLog b/msdos/ChangeLog index 7df89880410..cc9a63ef12a 100644 --- a/msdos/ChangeLog +++ b/msdos/ChangeLog @@ -1,3 +1,15 @@ +2010-08-22 Chong Yidong <cyd@stupidchicken.com> + + * sedleim.inp (RUN-EMACS): Don't use --multibyte. + +2010-08-20 Eli Zaretskii <eliz@gnu.org> + + * sed1v2.inp (IMAGEMAGICK_LIBS, IMAGEMAGICK_CFLAGS): Edit to empty. + +2010-08-15 Eli Zaretskii <eliz@gnu.org> + + * mainmake.v2 (version): Update due to change in emacs.c. + 2010-08-05 Eli Zaretskii <eliz@gnu.org> * sed1v2.inp (UNEXEC_OBJ): Edit to unexcoff.o, due to renaming of diff --git a/msdos/mainmake.v2 b/msdos/mainmake.v2 index 4bb13e367ed..79bd827d8c6 100644 --- a/msdos/mainmake.v2 +++ b/msdos/mainmake.v2 @@ -65,7 +65,7 @@ MAKESHELL=/xyzzy/command top_srcdir := $(subst \,/,$(shell cd)) # Find out which version of Emacs this is. -version := ${shell sed -n -e '/^const char emacs_version/s/^[^"]*\("[^"]*"\).*/\1/p' src/emacs.c} +version := ${shell sed -n -e '/^static const char emacs_version/s/^[^"]*\("[^"]*"\).*/\1/p' src/emacs.c} # Q: Do we need to bootstrap? # A: Only if we find admin/admin.el, i.e. we are building out of diff --git a/msdos/sed1v2.inp b/msdos/sed1v2.inp index 4be1bccefdf..e9dfc9dea3d 100644 --- a/msdos/sed1v2.inp +++ b/msdos/sed1v2.inp @@ -88,6 +88,8 @@ s/\.h\.in/.h-in/ /^CFLAGS_SOUND *=/s/@CFLAGS_SOUND@// /^RSVG_LIBS *=/s/@RSVG_LIBS@// /^RSVG_CFLAGS *=/s/@RSVG_CFLAGS@// +/^IMAGEMAGICK_LIBS *=/s/@IMAGEMAGICK_LIBS@// +/^IMAGEMAGICK_CFLAGS *=/s/@IMAGEMAGICK_CFLAGS@// /^WIDGET_OBJ *=/s/@WIDGET_OBJ@// /^CYGWIN_OBJ *=/s/@CYGWIN_OBJ@// /^MSDOS_OBJ *=/s/= */= dosfns.o msdos.o w16select.o/ diff --git a/msdos/sedleim.inp b/msdos/sedleim.inp index 20da3e64ae5..b5193e665a7 100644 --- a/msdos/sedleim.inp +++ b/msdos/sedleim.inp @@ -34,7 +34,7 @@ s|\([ ]\)echo|\1djecho|g /RUN-EMACS *=/,/^$/c\ export EMACSLOADPATH=${buildlisppath}\ -RUN-EMACS = ${BUILT-EMACS} -batch --no-init-file --no-site-file --multibyte +RUN-EMACS = ${BUILT-EMACS} -batch --no-init-file --no-site-file /^ cd ../c\ ${MAKE} -C ../src ${MFLAGS} emacs diff --git a/nt/ChangeLog b/nt/ChangeLog index 72920c2b58f..05f01767bd3 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,11 @@ +2010-08-19 Juanma Barranquero <lekktu@gmail.com> + + * addpm.c (add_registry): Create App Paths of type REG_EXPAND_SZ. + +2010-08-12 Jason Rumney <jasonr@gnu.org> + + * addpm.c (add_registry): Set path for runemacs.exe to use. + 2010-08-08 Óscar Fuentes <ofv@wanadoo.es> * cmdproxy.c (main): Use _snprintf instead of wsprintf, diff --git a/nt/addpm.c b/nt/addpm.c index 20b289f6761..de09fd5382c 100644 --- a/nt/addpm.c +++ b/nt/addpm.c @@ -62,6 +62,8 @@ DdeCallback (UINT uType, UINT uFmt, HCONV hconv, #define REG_GTK "SOFTWARE\\GTK\\2.0" #define REG_APP_PATH \ "SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\App Paths\\emacs.exe" +#define REG_RUNEMACS_PATH \ + "SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\App Paths\\runemacs.exe" static struct entry { @@ -111,7 +113,7 @@ add_registry (char *path) emacs_path = (char *) alloca (len); sprintf (emacs_path, "%s\\bin\\emacs.exe", path); - RegSetValueEx (hrootkey, NULL, 0, REG_SZ, emacs_path, len); + RegSetValueEx (hrootkey, NULL, 0, REG_EXPAND_SZ, emacs_path, len); /* Look for a GTK installation. If found, add it to the library search path for Emacs so that the image libraries it provides are available @@ -129,10 +131,26 @@ add_registry (char *path) /* Make sure the emacs bin directory continues to be searched first by including it as well. */ char *dll_paths; + HKEY runemacs_key = NULL; len = strlen (path) + 5 + size; dll_paths = (char *) alloca (size + strlen (path) + 1); sprintf (dll_paths, "%s\\bin;%s", path, gtk_path); - RegSetValueEx (hrootkey, "Path", 0, REG_SZ, dll_paths, len); + RegSetValueEx (hrootkey, "Path", 0, REG_EXPAND_SZ, + dll_paths, len); + + /* Set the same path for runemacs.exe, as the Explorer shell + looks this up, so the above does not take effect when + emacs.exe is spawned from runemacs.exe. */ + if (RegCreateKeyEx (HKEY_LOCAL_MACHINE, REG_RUNEMACS_PATH, + 0, "", REG_OPTION_NON_VOLATILE, + KEY_WRITE, NULL, &runemacs_key, NULL) + == ERROR_SUCCESS) + { + RegSetValueEx (runemacs_key, "Path", 0, REG_EXPAND_SZ, + dll_paths, len); + + RegCloseKey (runemacs_key); + } } } RegCloseKey (gtk_key); diff --git a/src/ChangeLog.trunk b/src/ChangeLog.trunk index a3e08cf699d..87b54529f2e 100644 --- a/src/ChangeLog.trunk +++ b/src/ChangeLog.trunk @@ -1,9 +1,609 @@ +2010-09-12 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * xml.c (Fhtml_parse_string, Fxml_parse_string): Mention BASE-URL. + +2010-09-12 Stefan Monnier <monnier@iro.umontreal.ca> + + * fns.c (Fy_or_n_p): Move to lisp/subr.el. + (syms_of_fns): Don't defsubr Sy_or_n_p. + * lisp.h: Don't declare Fy_or_n_p. + * fileio.c (barf_or_query_if_file_exists): Fy_or_n_p -> y-or-n-p. + +2010-09-09 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * xml.c (Fxml_parse_buffer): New function to parse XML files. + +2010-09-08 Lars Magne Ingebrigtsen <larsi@gnus.org> + + * xml.c: New file. + (Fhtml_parse_buffer): New function to interface to the libxml2 + html parsing function. + +2010-09-05 Juanma Barranquero <lekktu@gmail.com> + + * biditype.h: Regenerate. + +2010-09-04 Andreas Schwab <schwab@linux-m68k.org> + + * nsimage.m (ns_load_image): Check argument types. + + * image.c: Remove all uses of gcpro. + (xpm_load): Check all lisp types. + (pbm_load): Likewise. + (png_load): Likewise. + (jpeg_load): Likewise. + (tiff_load): Likewise. + (gif_load): Likewise. + (imagemagick_load_image): Likewise. + (imagemagick_load): Likewise. + (svg_load): Likewise. + (gs_load): Likewise. + +2010-09-04 Eli Zaretskii <eliz@gnu.org> + + * w32uniscribe.c (uniscribe_shape): Update commentary. Don't + try to reorder grapheme clusters, since LGSTRING should always + hold them in the logical order. + (uniscribe_encode_char, uniscribe_shape): Force ScriptShape to + return glyph codes in the logical order. + +2010-09-04 Andreas Schwab <schwab@linux-m68k.org> + + * image.c (imagemagick_image_p): Replace bcopy by memcpy. + (imagemagick_load_image): Fix type mismatch. + (Fimagemagick_types): Likewise. Doc fix. + +2010-09-02 Jan Djärv <jan.h.d@swipnet.se> + + * xterm.h (struct dpyinfo): Remove cut_buffers_initialized. + + * xterm.c (x_term_init): Don't set dpyinfo->cut_buffers_initialized. + + * xselect.c: Remove declaration of cut-buffer objects and functions. + (symbol_to_x_atom): Remove mapping to XA_CUT_BUFFERn. + (x_atom_to_symbol): Remove mapping to QCUT_BUFFERn. + (Fx_get_cut_buffer_internal, Fx_store_cut_buffer_internal) + (Fx_rotate_cut_buffers_internal): Remove. + (syms_of_xselect): Remove defsubr of above. + Remove intern of QCUT_BUFFERn. + +2010-09-01 Stefan Monnier <monnier@iro.umontreal.ca> + + * cmds.c (Vblink_paren_function): Remove. + (internal_self_insert): Make it insert N chars at a time. + Don't call blink-paren-function. + (Fself_insert_command): Adjust accordingly. + (syms_of_cmds): Don't declare blink-paren-function. + +2010-08-31 Kenichi Handa <handa@m17n.org> + + * dispextern.h (FACE_FOR_CHAR): Use an ASCII face for 8-bit + characters. + + * term.c (encode_terminal_code): Fix the previous change. + (produce_glyphs): Don't set it->char_to_display here. + Don't handle unibyte-display-via-language-environment here. + (produce_special_glyphs): Set temp_it.char_to_display before + calling produce_glyphs. + + * xdisp.c (get_next_display_element): Set it->char_to_display + here. Convert all 8-bit bytes from unibyte buffer/string to 8-bit + characters. + (get_overlay_arrow_glyph_row): Set it.char_to_display too before + calling PRODUCE_GLYPHS. + (append_space_for_newline): Save and store it->char_to_display. + Set it->char_to_display before calling PRODUCE_GLYPHS. + (extend_face_to_end_of_line): Set it->char_to_display before + calling PRODUCE_GLYPHS. + (get_glyph_face_and_encoding): Set the glyph code an 8-bit + character to its byte value. + (get_char_glyph_code): New function. + (produce_stretch_glyph): Set it2.char_to_display too before + calling x_produce_glyphs. + (x_produce_glyphs): Simplify by using the same code for ASCII and + non-ASCII characters. Don't set it->char_to_display here. Don't + handle unibyte-display-via-language-environment here. For a + charater of no glyph, use font->space_width instead of FONT_WIDTH. + +2010-08-31 Stefan Monnier <monnier@iro.umontreal.ca> + + * keyboard.c (Fwindow_system): Fix compilation for USE_LISP_UNION_TYPE. + +2010-08-31 Chong Yidong <cyd@stupidchicken.com> + + * keyboard.c (command_loop_1): Don't call x-set-selection on tty. + +2010-08-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * marker.c (Fcopy_marker): Make the first arg optional. + +2010-08-30 Kenichi Handa <handa@m17n.org> + + * composite.c (composition_update_it): Fix computing of + cmp_it->width. + +2010-08-29 Kenichi Handa <handa@m17n.org> + + * term.c (encode_terminal_code): Encode byte chars to the + corresponding bytes. + +2010-08-29 Jan Djärv <jan.h.d@swipnet.se> + + * nsterm.m (ns_draw_window_cursor): Draw BAR_CURSOR correct for R2L. + +2010-08-26 Kenichi Handa <handa@m17n.org> + + * xdisp.c (compute_stop_pos): Pay attention to bidi scan direction + on calling composition_compute_stop_pos. + +2010-08-25 Kenichi Handa <handa@m17n.org> + + * fontset.c (reorder_font_vector): Prefer a font-spec specifying + :otf. + + * composite.c (composition_compute_stop_pos): Don't break + composition at PT. + (composition_reseat_it): Likewise. Fix calculation of character + position starting a composition. + (Fcomposition_get_gstring): Don't limit the number of components + for automatic composition. + +2010-08-25 Kenichi Handa <handa@m17n.org> + + * composite.c (composition_compute_stop_pos): In forward search, + pay attention to the possibility that some character after ENDPOS + will be composed with charactrs before ENDPOS. + +2010-08-24 Chong Yidong <cyd@stupidchicken.com> + + * keyboard.c (command_loop_1): Don't clobber primary selection + during handle-switch-frame (Bug#6872). + +2010-08-23 Michael Albinus <michael.albinus@gmx.de> + + * dbusbind.c: Accept UNIX domain sockets as bus address. + (Fdbus_close_bus): New function. + (Vdbus_registered_buses): New variable. + (xd_initialize): Implement string as bus address. + (Fdbus_init_bus): Add bus to Vdbus_registered_buses). + (Fdbus_get_unique_name, Fdbus_call_method) + (Fdbus_call_method_asynchronously, Fdbus_method_return_internal) + (Fdbus_method_error_internal, Fdbus_send_signal) + (Fdbus_register_signal, Fdbus_register_method): Remove bus type + check. This is done in xd_initialize_bus. Adapt doc string, if + necessary. + (xd_pending_messages, xd_read_queued_messages): Loop over buses in + Vdbus_registered_buses. + (Vdbus_registered_objects_table): Create hash. + +2010-08-22 Juri Linkov <juri@jurta.org> + + * keyboard.c (Fexecute_extended_command): Move reading a command name + with `completing-read' to a new Elisp function `read-extended-command'. + Call it to read a command to `function' (bug#5364, bug#5214). + +2010-08-22 Chong Yidong <cyd@stupidchicken.com> + + * emacs.c (main): Remove handling of --unibyte arg (Bug#6886). + +2010-08-22 Andreas Schwab <schwab@linux-m68k.org> + + * eval.c (Flet, Feval, Fapply, apply_lambda): Use SAFE_ALLOCA_LISP + instead of SAFE_ALLOCA. + +2010-08-22 Chong Yidong <cyd@stupidchicken.com> + + * eval.c (Flet, Feval, Fapply, apply_lambda): Use SAFE_ALLOCA + (Bug#6214). + +2010-08-22 Jan Djärv <jan.h.d@swipnet.se> + + * doc.c (Fsnarf_documentation): Set skip_file only if p[1] is S. + +2010-08-22 Jan Djärv <jan.h.d@swipnet.se> + + * doc.c (Fsnarf_documentation): Initialize skip_file before + build-files test. + +2010-08-22 Peter O'Gorman <pogma@thewrittenword.com> (tiny change) + + * s/hpux10-20.h (HAVE_TERMIOS, NO_TERMIO, ORDINARY_LINK): + New definitions. + (HAVE_TERMIO): Remove. + +2010-08-22 Eli Zaretskii <eliz@gnu.org> + + * deps.mk (sysdep.o, msdos.o): Depend on sysselect.h. + + * sysselect.h [WINDOWSNT]: Don't define the FD_* and select stuff + for w32. + + * s/ms-w32.h (HAVE_SYS_TIMEB_H): Don't #undef HAVE_SYS_SELECT_H, + it's done in nt/config.nt. + + * makefile.w32-in ($(BLD)/sysdep.$(O)): Depend on sysselect.h. + + * unexcoff.c (report_error, make_hdr, write_segment) + (copy_text_and_data, copy_sym, mark_x, adjust_lnnoptrs, unexec): + Convert argument lists and prototypes to ANSI C. + (make_hdr, write_segment): Remove unused variables. + (unexec): Remove commented-out line. Initialize `new' to shut up + compiler warnings. + +2010-08-22 Dan Nicolaescu <dann@ics.uci.edu> + + Simplify termio code. + All non-MSDOS non-WINDOWSNT platforms define HAVE_TERMIOS, so + HAVE_TERMIO code is obsolete. + Replace HAVE_TERMIOS conditionals with !DOS_NT. + * systty.h: Do not define HAVE_TCATTR. + Remove HAVE_TERMIO, HAVE_LTCHARS and HAVE_TCHARS code. + Do not define EMACS_HAVE_TTY_PGRP. Only define + EMACS_GET_TTY_PGRP for !DOS_NT. + * sysdep.c: Include sysselect.h unconditionally. Do not include + sys/ioctl.h and termios.h, systty.h does it. Use + HAVE_SYS_UTSNAME_H instead of USG as an include guard. + (init_baud_rate): Remove HAVE_TERMIO code. + (child_setup_tty): Remove HAVE_TERMIO code. + (emacs_get_tty, emacs_set_tty): Remove HAVE_TERMIO, HAVE_TCHARS + and HAVE_LTCHARS code. Use !DOS_NT instead of HAVE_TCATTR. + (new_ltchars, new_tchars): Remove, unused. + (init_sys_modes): Remove HAVE_TERMIO, HAVE_TCHARS and HAVE_LTCHARS + code. Remove special casing for __mips__, it was a no-op. Remove + HAVE_TCATTR conditional, it is implied by HAVE_TERMIOS. + (init_sys_modes): Remove HPUX special case. + * process.c: Include stdlib.h unconditionally. Do not include + fcntl.h, systty.h does it. Remove conditional code for + HAVE_SERIAL, it is always true. + (process_send_signal): Remove HAVE_TERMIOS conditional, it's + always true when SIGNALS_VIA_CHARACTERS is true. + (Fcontinue_process, Fprocess_send_eof): Simplify conditionals: + !WINDOWSNT means HAVE_TERMIOS. + (create_process): Remove HAVE_TERMIOS, it's inside a HAVE_PTYS + conditional, which is true for all HAVE_TERMIOS systems. + * keyboard.c (init_keyboard): Do not use HAVE_TERMIO, use !DOS_NT + instead of HAVE_TERMIOS. + * emacs.c (shut_down_emacs): Use !defined DOS_NT instead of + EMACS_HAVE_TTY_PGRP. + * callproc.c (child_setup): Move EMACS_SET_TTY_PGRP use to the + non-MSDOS, non-WINDOWSNT code, it's only defined for such systems + anyway. + +2010-08-21 Eli Zaretskii <eliz@gnu.org> + + * dispnew.c (buffer_posn_from_coords): Fix off-by-one error in + mirroring pixel positions. + +2010-08-20 Dan Nicolaescu <dann@ics.uci.edu> + + * alloc.c (malloc_sbrk_used, malloc_sbrk_unused): Remove, + write only. + (init_alloc_once): Remove writes to malloc_sbrk_unused, and + malloc_sbrk_used, nothing uses them. + + * puresize.h: Remove code assuming PNTR_COMPARISON_TYPE is not + defined, unconditionally defined in lisp.h. + + * term.c: Do not include <termios.h>, systty.h does it. + + * s/unixware.h (HAVE_TCATTR): + * s/aix4-2.h (HAVE_TCATTR): Remove definitions, not needed. + systty.h defines it when HAVE_TERMIOS is defined. + +2010-08-20 Eli Zaretskii <eliz@gnu.org> + + * dispnew.c (buffer_posn_from_coords): Fix last change for text + terminals: add one-character offset for R2L lines. + + * emacs.c <emacs_version>: Add a comment regarding + msdos/mainmake.v2's dependency on the syntax of this declaration. + +2010-08-20 Eli Zaretskii <eliz@gnu.org> + + * dispnew.c (buffer_posn_from_coords): Fix calculation of buffer + position for R2L lines by mirroring the pixel position wrt the + text are box. Improve commentary. + +2010-08-20 Andreas Schwab <schwab@linux-m68k.org> + + * image.c (imagemagick_clear_image): Remove debugging output. + +2010-08-19 Stefan Monnier <monnier@iro.umontreal.ca> + + * cmds.c (Vself_insert_face, Vself_insert_face_command): Remove. + (Qpost_self_insert_hook, Vpost_self_insert_hook): New vars. + (internal_self_insert): Run Qpost_self_insert_hook rather than handle + self-insert-face. + (syms_of_cmds): Initialize the new vars. + +2010-08-19 Jason Rumney <jasonr@gnu.org> + + * w32menu.c (set_frame_menubar): Remove call to undefined function. + + * w32fns.c (w32_wnd_proc): Don't check context before initializing. + +2010-08-19 Jan Djärv <jan.h.d@swipnet.se> + + * nsselect.m (nxatoms_of_nsselect): Use "Selection" and "Secondary". + +2010-08-18 Eli Zaretskii <eliz@gnu.org> + + * xterm.c (x_draw_bar_cursor): + * w32term.c (x_draw_bar_cursor): If the character under cursor is + R2L, draw the bar cursor on its right rather than on its left. + +2010-08-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * eval.c (Fdefmacro): Only obey one declaration. + + * casefiddle.c (casify_region): Setup gl_state. + +2010-08-18 Jan Djärv <jan.h.d@swipnet.se> + + * nsterm.m (ns_define_frame_cursor): Call x_update_cursor (Bug#6868). + +2010-08-18 Jan Djärv <jan.h.d@swipnet.se> + + * gtkutil.c (update_frame_tool_bar): Literal stings are const char*. + +2010-08-18 David De La Harpe Golden <david@harpegolden.net> + + * nsselect.m (QCLIPBOARD, NXPrimaryPboard): Define. + (symbol_to_nsstring): Map QCLIPBOARD => NSGeneralPboard, + QPRIMARY => NXPrimaryPboard. + (ns_string_to_symbol): NSGeneralPboard => QCLIPBOARD, + NXPrimaryPboard => QPRIMARY. + (nxatoms_of_nsselect): NXPrimaryPboard = PrimarySelection, + NXSecondaryPboard = SecondarySelection. + (syms_of_nsselect): Intern QCLIPBOARD (Bug#6677). + +2010-08-18 Joakim Verona <joakim@verona.se> + + * image.c: Add support for ImageMagick. When HAVE_IMAGEMAGICK is + defined: + (imagemagick_image_p): New function to test for ImageMagic image. + (imagemagick_load): New function to load ImageMagick image. + (imagemagick_load_image): New function, helper for imagemagick_load. + (imagemagick-types): New function. + (Qimagemagick): New Lisp_object. + (imagemagick-render-type): New variable, decides which renderer to use. + +2010-08-17 Stefan Monnier <monnier@iro.umontreal.ca> + + * gtkutil.c (update_frame_tool_bar): Don't assume TOOL_BAR_ITEM_LABEL + is a string. + +2010-08-17 Jan Djärv <jan.h.d@swipnet.se> + + * nsfns.m (ns_frame_parm_handlers): Add a slot for the + x_set_tool_bar_position handler. + +2010-08-17 Eli Zaretskii <eliz@gnu.org> + + * w32fns.c <w32_frame_parm_handlers>: Add a slot for the + x_set_tool_bar_position handler, needed to support changes from + 2010-07-29T16:49:59Z!jan.h.d@swipnet.se for positioning the tool bar. (Bug#6796) + +2010-08-16 Jan Djärv <jan.h.d@swipnet.se> + + * nsselect.m: include keyboard.h for QPRIMARY, remove its + declaration (Bug#6863). + (syms_of_nsselect): Don't intern QPRIMARY. + + * xselect.c: Remove declaration of QPRIMARY (Bug#6864). + + * keyboard.h (QPRIMARY): Declare (Bug#6864). + +2010-08-16 Chong Yidong <cyd@stupidchicken.com> + + * keyboard.c (command_loop_1): Avoid setting selection twice, + since it's done in deactivate-mark as well. + (Vselect_active_regions): Change default to t. Replace `lazy' + with non-default value `only', meaning only set PRIMARY for + temporarily active regions. + + * insdel.c (prepare_to_modify_buffer): Handle `only' value of + select-active-regions. + +2010-08-15 Jan Djärv <jan.h.d@swipnet.se> + + * keyboard.c (parse_tool_bar_item): Put in a bad label if :label + isn't a string. + +2010-08-15 Andreas Schwab <schwab@linux-m68k.org> + + * keyboard.c (parse_tool_bar_item): Avoid excessive use of strlen. + +2010-08-15 Jan Djärv <jan.h.d@swipnet.se> + + * keyboard.c (parse_tool_bar_item): malloc buf. + Set TOOL_BAR_ITEM_LABEL to empty string if not set to + new_lbl (Bug#6855). + +2010-08-14 Eli Zaretskii <eliz@gnu.org> + + * xterm.c (x_draw_stretch_glyph_string): + * w32term.c (x_draw_stretch_glyph_string): In R2L rows, display + the cursor on the right edge of the stretch glyph. + + * xdisp.c (window_box_right_offset, window_box_right): + Fix commentary. + + * xdisp.c (Fcurrent_bidi_paragraph_direction): Fix paragraph + direction when point is inside a run of whitespace characters. + + * bidi.c (bidi_at_paragraph_end): Remove obsolete comment. + +2010-08-14 Jason Rumney <jasonr@gnu.org> + + * keyboard.c (lispy_function_keys): Do not define VK_PACKET (bug#4836) + +2010-08-14 Chong Yidong <cyd@stupidchicken.com> + + * fns.c (Fmake_hash_table): Doc fix (Bug#6851). + +2010-08-13 Jason Rumney <jasonr@gnu.org> + + * w32menu.c (simple_dialog_show): Use unicode message box if available. + (MessageBoxW_Proc): New function typedef. + (unicode-message-box): New function pointer. + (globals_of_w32menu): Import it from user32.dll. (Bug#5629) + +2010-08-13 Jan Djärv <jan.h.d@swipnet.se> + + * frame.h (Qtool_bar_position): Declare. + + * xfns.c (Fx_create_frame): Call x_default_parameter for + Qtool_bar_position. + +2010-08-13 Eli Zaretskii <eliz@gnu.org> + + * unexcoff.c: Remove the parts used when "emacs" is not defined. + (report_error, report_error_1): Ditto. + (write_segment): Remove "#if 0" unused code. + (make_hdr): Remove code that was "#ifndef NO_REMAP" before + NO_REMAP was removed (in 2010-07-29T03:25:08Z!dann@ics.uci.edu). + (start_of_text): Remove unused function (was used only if NO_REMAP + was NOT defined). + + * msdos.c (IT_set_face): Fix format string to match argument + types. + (IT_write_glyphs, IT_note_mode_line_highlight) + (IT_set_frame_parameters): Remove unused variables. + (x_set_menu_bar_lines): Declare set_menu_bar_lines. + (IT_set_terminal_modes): Disambiguate expression in if clause. + (Fmsdos_remember_default_colors): Return Qnil. + (IT_set_frame_parameters): Add parens to disambiguate boolean + expression for logging the cursor type to termscript. + (keyboard_layout_list, keypad_translate_map) + (grey_key_translate_map): Add braces in inner initializers. + (dos_rawgetc): Add parens in condition for mouse-3 button-press. + (dos_rawgetc): Remove unused label. + (XMenuActivate): Add braces to remove ambiguous `else'. + (dos_ttraw): Always return a value. + (spawnve): Declare. + (run_msdos_command): Cast 3rd arg of spawnve to "char **". + + * dosfns.h (x_set_title): Declare. + + * w16select.c (Fw16_set_clipboard_data, Fw16_get_clipboard_data): + Remove unused variables. + + * dosfns.c (Fint86, Fdos_memget, Fdos_memput): Remove unused + variables. + (init_dosfns): Declare get_lim_data. + (system_process_attributes): Declare Fget_internal_run_time. + + * xmenu.c (xmenu_show) [!USE_X_TOOLKIT && !USE_GTK]: Fix argument + list to be consistent with menu.h. + + * w32menu.c (add_menu_item, name_is_separator): Shut up compiler + warnings due to mixing of "char *" and "const char *". + +2010-08-12 Stefan Monnier <monnier@iro.umontreal.ca> + + Introduce a new comment style "c" flag. + * syntax.c (SYNTAX_FLAGS_COMMENT_STYLEB) + (SYNTAX_FLAGS_COMMENT_STYLEC): New macros. + (SYNTAX_FLAGS_COMMENT_STYLE): Use them, add an argument. + (syntax_prefix_flag_p): New function. + (Fstring_to_syntax): Understand new "c" flag. + (Finternal_describe_syntax_value): Recognize new flag; use the + SYNTAX_FLAGS_* macros. + (scan_sexps_forward, Fparse_partial_sexp): Change representation of + comment style to accomodate the new styles. + (back_comment, forw_comment, Fforward_comment, scan_lists) + (scan_sexps_forward): Update code to obey the new comment style flag. + + * syntax.h: Move SYNTAX_FLAGS_FOO() macros to syntax.c. + + * casefiddle.c (casify_region): Use the new syntax_prefix_flag_p. + +2010-08-11 Jan Djärv <jan.h.d@swipnet.se> + + * xfns.c (x_defined_color): If USE_GTK, call xg_check_special_colors + first. + (Fx_hide_tip): Check FRAME_LIVE_P (f) before calling xg_hide_tooltip. + + * gtkutil.h (xg_check_special_colors): Declare. + + * gtkutil.c (xg_check_special_colors, style_changed_cb): New functions. + (xg_create_frame_widgets): Connect theme name changes to + style_changed_cb. + + * xterm.c (emacs_class): New char[] for EMACS_CLASS. + (xim_open_dpy, xim_initialize, xim_close_dpy): Use emacs_class. + (x_term_init): Use char[] display_opt and name_opt instead of + string literal. file is const char*. + + * xsmfns.c (NOSPLASH_OPT): Change to char[]. + (smc_save_yourself_CB): Do xstrdup on all ->type and ->name for + props. Free them at the end. + + * xselect.c (Fx_get_atom_name): Use char empty[] instead of literal "". + + * xrdb.c (get_system_app): Make path const and use char *p for + non-const char. + + * xmenu.c (Fx_popup_dialog): error_name is const char*. + (xmenu_show): error parameter is const char **. pane_string is const + char *. + (button_names): Is const char *. + (xdialog_show): error_name and pane_string is const. + + * process.h (synch_process_death): Is const char*. + + * w32menu.c (w32_menu_show): + * nsmenu.m (ns_menu_show): error parameter is const char **. + + * menu.h (w32_menu_show, ns_menu_show, xmenu_show): error parameter + is const char **. + + * menu.c (Fx_popup_menu): error_name is const. + + * keyboard.h (_widget_value): Add defined USE_GTK. Replace Boolean + with unsigned char and XtPointer with void *. + + * gtkutil.h: Replace widget_value with struct _widget_value. + (enum button_type, struct _widget_value): Remove and use the one from + keyboard.h. + + * gtkutil.c (get_utf8_string): Always return an allocated string. + Parameter is const. + (create_dialog, xg_create_one_menuitem, create_menus) + (xg_item_label_same_p, xg_update_menu_item): Free result from + get_utf8_string. + (xg_separator_p, xg_item_label_same_p): label is const. + + * font.h (font_open_by_name): Make name const. + + * font.c (font_open_by_name): Make name const. + + * floatfns.c (matherr): Use a const char* variable for x->name. + + * emacs.c (main): Pass char[] to putenv instead of literal. + + * callproc.c (synch_process_death): Make const. + (Fcall_process): Make signame const. + + * nsterm.h (parseKeyEquiv, addSubmenuWithTitle) + (addDisplayItemWithImage): Use const char*. + + * nsmenu.m (parseKeyEquiv, addSubmenuWithTitle) + (addDisplayItemWithImage, update_frame_tool_bar): Use const char*. + + * nsfont.m (ns_descriptor_to_entity): Use const char*. + + * keyboard.h (_widget_value): name, value and key are const char*. + + * unexmacosx.c (unexec_error): Use const char *. + 2010-08-09 Dan Nicolaescu <dann@ics.uci.edu> * font.h (font_parse_xlfd, font_parse_fcname, font_unparse_fcname) - (font_parse_name): font_open_by_name): + (font_parse_name, font_open_by_name): * font.c (font_parse_xlfd, font_parse_fcname, font_unparse_fcname) - (font_parse_name): font_open_by_name): Remove const. + (font_parse_name, font_open_by_name): Remove const. 2010-08-09 Andreas Schwab <schwab@linux-m68k.org> @@ -64,10 +664,10 @@ 2010-08-08 Kenichi Handa <handa@m17n.org> - * charset.c: Include <stdlib.h> + * charset.c: Include <stdlib.h>. (struct charset_sort_data): New struct. (charset_compare): New function. - (Fsort_charsets): New funciton. + (Fsort_charsets): New function. (syms_of_charset): Declare Fsort_charsets as a Lisp function. * coding.c (decode_coding_iso_2022): Fix checking of dimension @@ -126,17 +726,17 @@ * s/freebsd.h (DECLARE_GETPWUID_WITH_UID_T): Remove, unused. - * xrdb.c: Remove include guard. Remove - DECLARE_GETPWUID_WITH_UID_T conditional it had no effect. + * xrdb.c: Remove include guard. + Remove DECLARE_GETPWUID_WITH_UID_T conditional it had no effect. Remove #if 0 code. Replace malloc->xmalloc, free->xfree, realloc->xrealloc instead of using #defines. 2010-08-08 Eli Zaretskii <eliz@gnu.org> * cmds.c (Fforward_line, Fbeginning_of_line, Fend_of_line): - * editfns.c (Fline_beginning_position, Fline_end_position): State - in the doc strings that start and end of line are in the logical - order. + * editfns.c (Fline_beginning_position, Fline_end_position): + State in the doc strings that start and end of line are in the + logical order. * xdisp.c (display_line): Move the handling of overlay arrow after the call to find_row_edges. (Bug#6699) diff --git a/src/Makefile.in b/src/Makefile.in index a8d400c7c39..d91b95d86e3 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -1,3 +1,4 @@ + # Makefile for GNU Emacs. # Copyright (C) 1985, 1987, 1988, 1993, 1994, 1995, 1999, 2000, 2001, 2002, # 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 @@ -222,6 +223,12 @@ CFLAGS_SOUND= @CFLAGS_SOUND@ RSVG_LIBS= @RSVG_LIBS@ RSVG_CFLAGS= @RSVG_CFLAGS@ +IMAGEMAGICK_LIBS= @IMAGEMAGICK_LIBS@ +IMAGEMAGICK_CFLAGS= @IMAGEMAGICK_CFLAGS@ + +LIBXML2_LIBS = @LIBXML2_LIBS@ +LIBXML2_CFLAGS = @LIBXML2_CFLAGS@ + ## widget.o if USE_X_TOOLKIT, otherwise empty. WIDGET_OBJ=@WIDGET_OBJ@ @@ -315,7 +322,8 @@ MKDEPDIR=@MKDEPDIR@ ## FIXME? MYCPPFLAGS only referenced in etc/DEBUG. ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(MYCPPFLAGS) -I. -I${srcdir} \ ${C_SWITCH_MACHINE} ${C_SWITCH_SYSTEM} ${C_SWITCH_X_SITE} \ - ${C_SWITCH_X_SYSTEM} ${CFLAGS_SOUND} ${RSVG_CFLAGS} ${DBUS_CFLAGS} \ + ${C_SWITCH_X_SYSTEM} ${CFLAGS_SOUND} ${RSVG_CFLAGS} ${IMAGEMAGICK_CFLAGS} \ + ${LIBXML2_CFLAGS} ${DBUS_CFLAGS} \ ${GCONF_CFLAGS} ${FREETYPE_CFLAGS} ${FONTCONFIG_CFLAGS} \ ${LIBOTF_CFLAGS} ${M17N_FLT_CFLAGS} ${DEPFLAGS} ${PROFILING_CFLAGS} \ ${C_WARNINGS_SWITCH} ${CFLAGS} @@ -344,7 +352,7 @@ obj= dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ syntax.o $(UNEXEC_OBJ) bytecode.o \ process.o callproc.o \ region-cache.o sound.o atimer.o \ - doprnt.o strftime.o intervals.o textprop.o composite.o md5.o \ + doprnt.o strftime.o intervals.o textprop.o composite.o md5.o xml.o \ $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) ## Object files used on some machine or other. @@ -590,7 +598,8 @@ SOME_MACHINE_LISP = ../lisp/mouse.elc \ ## duplicated symbols. If the standard libraries were compiled ## with GCC, we might need LIB_GCC again after them. LIBES = $(LIBS) $(LIBX_BASE) $(LIBX_OTHER) $(LIBSOUND) \ - $(RSVG_LIBS) $(DBUS_LIBS) $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) \ + $(RSVG_LIBS) ${IMAGEMAGICK_LIBS} $(DBUS_LIBS) \ + ${LIBXML2_LIBS} $(LIBGPM) $(LIBRESOLV) $(LIBS_SYSTEM) \ $(LIBS_TERMCAP) $(GETLOADAVG_LIBS) ${GCONF_LIBS} ${LIBSELINUX_LIBS} \ $(FREETYPE_LIBS) $(FONTCONFIG_LIBS) $(LIBOTF_LIBS) $(M17N_FLT_LIBS) \ $(LIB_GCC) $(LIB_MATH) $(LIB_STANDARD) $(LIB_GCC) diff --git a/src/alloc.c b/src/alloc.c index 23debbdf2e8..d83d8937722 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -214,16 +214,6 @@ int abort_on_gc; int garbage_collection_messages; -#ifndef VIRT_ADDR_VARIES -extern -#endif /* VIRT_ADDR_VARIES */ -int malloc_sbrk_used; - -#ifndef VIRT_ADDR_VARIES -extern -#endif /* VIRT_ADDR_VARIES */ -int malloc_sbrk_unused; - /* Number of live and free conses etc. */ static int total_conses, total_markers, total_symbols, total_vector_size; @@ -6234,11 +6224,6 @@ init_alloc_once (void) consing_since_gc = 0; gc_cons_threshold = 100000 * sizeof (Lisp_Object); gc_relative_threshold = 0; - -#ifdef VIRT_ADDR_VARIES - malloc_sbrk_unused = 1<<22; /* A large number */ - malloc_sbrk_used = 100000; /* as reasonable as any number */ -#endif /* VIRT_ADDR_VARIES */ } void diff --git a/src/bidi.c b/src/bidi.c index b31de597688..a6d4d1b2506 100644 --- a/src/bidi.c +++ b/src/bidi.c @@ -497,7 +497,6 @@ bidi_peek_at_next_level (struct bidi_it *bidi_it) static EMACS_INT bidi_at_paragraph_end (EMACS_INT charpos, EMACS_INT bytepos) { - /* FIXME: Why Fbuffer_local_value rather than just Fsymbol_value? */ Lisp_Object sep_re; Lisp_Object start_re; EMACS_INT val; @@ -1534,7 +1533,7 @@ bidi_level_of_next_char (struct bidi_it *bidi_it) we want it to be displayed as - {RLO}STet{PDF} + {PDF}STet{RLO} not as diff --git a/src/biditype.h b/src/biditype.h index 60fc6374f39..868aabd9ea6 100644 --- a/src/biditype.h +++ b/src/biditype.h @@ -83,7 +83,8 @@ { 0x0671, 0x06D5, STRONG_AL }, { 0x06D6, 0x06DC, WEAK_NSM }, { 0x06DD, 0x06DD, WEAK_AN }, - { 0x06DE, 0x06E4, WEAK_NSM }, + { 0x06DE, 0x06DE, NEUTRAL_ON }, + { 0x06DF, 0x06E4, WEAK_NSM }, { 0x06E5, 0x06E6, STRONG_AL }, { 0x06E7, 0x06E8, WEAK_NSM }, { 0x06E9, 0x06E9, NEUTRAL_ON }, @@ -271,7 +272,7 @@ { 0x2080, 0x2089, WEAK_EN }, { 0x208A, 0x208B, WEAK_ES }, { 0x208C, 0x208E, NEUTRAL_ON }, - { 0x20A0, 0x20B8, WEAK_ET }, + { 0x20A0, 0x20B9, WEAK_ET }, { 0x20D0, 0x20F0, WEAK_NSM }, { 0x2100, 0x2101, NEUTRAL_ON }, { 0x2103, 0x2106, NEUTRAL_ON }, diff --git a/src/callproc.c b/src/callproc.c index ca9ff93a6d9..8c1384df6a1 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -115,7 +115,7 @@ Lisp_Object Qbuffer_file_type; int synch_process_alive; /* Nonzero => this is a string explaining death of synchronous subprocess. */ -char *synch_process_death; +const char *synch_process_death; /* Nonzero => this is the signal number that terminated the subprocess. */ int synch_process_termsig; @@ -818,7 +818,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) if (synch_process_termsig) { - char *signame; + const char *signame; synchronize_system_messages_locale (); signame = strsignal (synch_process_termsig); @@ -1231,8 +1231,6 @@ child_setup (int in, int out, int err, register char **new_argv, int set_pgrp, L #else setpgrp (pid, pid); #endif /* USG */ - /* setpgrp_of_tty is incorrect here; it uses input_fd. */ - EMACS_SET_TTY_PGRP (0, &pid); #ifdef MSDOS pid = run_msdos_command (new_argv, pwd_var + 4, in, out, err, env); @@ -1251,6 +1249,9 @@ child_setup (int in, int out, int err, register char **new_argv, int set_pgrp, L report_file_error ("Spawning child process", Qnil); return cpid; #else /* not WINDOWSNT */ + /* setpgrp_of_tty is incorrect here; it uses input_fd. */ + EMACS_SET_TTY_PGRP (0, &pid); + /* execvp does not accept an environment arg so the only way to pass this environment is to set environ. Our caller is responsible for restoring the ambient value of environ. */ diff --git a/src/casefiddle.c b/src/casefiddle.c index 9545cf697a8..b6551618b2f 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -221,6 +221,8 @@ casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e) start_byte = CHAR_TO_BYTE (start); end_byte = CHAR_TO_BYTE (end); + SETUP_BUFFER_SYNTAX_TABLE(); /* For syntax_prefix_flag_p. */ + while (start < end) { int c2, len; @@ -243,7 +245,8 @@ casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e) && (!inword || flag != CASE_CAPITALIZE_UP)) c = UPCASE1 (c); if ((int) flag >= (int) CASE_CAPITALIZE) - inword = ((SYNTAX (c) == Sword) && (inword || !SYNTAX_PREFIX (c))); + inword = ((SYNTAX (c) == Sword) + && (inword || !syntax_prefix_flag_p (c))); if (c != c2) { last = start; diff --git a/src/cmds.c b/src/cmds.c index 4cb6ca199e7..f12e759b7a6 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -32,17 +32,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "dispextern.h" #include "frame.h" -Lisp_Object Qkill_forward_chars, Qkill_backward_chars, Vblink_paren_function; +Lisp_Object Qkill_forward_chars, Qkill_backward_chars; /* A possible value for a buffer's overwrite-mode variable. */ Lisp_Object Qoverwrite_mode_binary; -/* Non-nil means put this face on the next self-inserting character. */ -Lisp_Object Vself_insert_face; - -/* This is the command that set up Vself_insert_face. */ -Lisp_Object Vself_insert_face_command; - static int internal_self_insert (int, int); DEFUN ("forward-point", Fforward_point, Sforward_point, 1, 1, 0, @@ -310,50 +304,31 @@ After insertion, the value of `auto-fill-function' is called if the { int character = translate_char (Vtranslation_table_for_input, XINT (last_command_event)); - if (XINT (n) >= 2 && NILP (current_buffer->overwrite_mode)) - { - XSETFASTINT (n, XFASTINT (n) - 2); - /* The first one might want to expand an abbrev. */ - internal_self_insert (character, 1); - /* The bulk of the copies of this char can be inserted simply. - We don't have to handle a user-specified face specially - because it will get inherited from the first char inserted. */ - Finsert_char (make_number (character), n, Qt); - /* The last one might want to auto-fill. */ - internal_self_insert (character, 0); - } - else - while (XINT (n) > 0) - { - int val; - /* Ok since old and new vals both nonneg */ - XSETFASTINT (n, XFASTINT (n) - 1); - val = internal_self_insert (character, XFASTINT (n) != 0); - if (val == 2) - nonundocount = 0; - frame_make_pointer_invisible (); - } + int val = internal_self_insert (character, XFASTINT (n)); + if (val == 2) + nonundocount = 0; + frame_make_pointer_invisible (); } return Qnil; } -/* Insert character C. If NOAUTOFILL is nonzero, don't do autofill - even if it is enabled. +/* Insert N times character C If this insertion is suitable for direct output (completely simple), return 0. A value of 1 indicates this *might* not have been simple. A value of 2 means this did things that call for an undo boundary. */ static Lisp_Object Qexpand_abbrev; +static Lisp_Object Qpost_self_insert_hook, Vpost_self_insert_hook; static int -internal_self_insert (int c, int noautofill) +internal_self_insert (int c, int n) { int hairy = 0; Lisp_Object tem; register enum syntaxcode synt; - Lisp_Object overwrite, string; + Lisp_Object overwrite; /* Length of multi-byte form of C. */ int len; /* Working buffer and pointer for multi-byte form of C. */ @@ -396,32 +371,22 @@ internal_self_insert (int c, int noautofill) /* This is the character after point. */ int c2 = FETCH_CHAR (PT_BYTE); - /* Column the cursor should be placed at after this insertion. - The correct value should be calculated only when necessary. */ - int target_clm = 0; - /* Overwriting in binary-mode always replaces C2 by C. Overwriting in textual-mode doesn't always do that. It inserts newlines in the usual way, and inserts any character at end of line or before a tab if it doesn't use the whole width of the tab. */ - if (EQ (overwrite, Qoverwrite_mode_binary) - || (c != '\n' - && c2 != '\n' - && ! (c2 == '\t' - && XINT (current_buffer->tab_width) > 0 - && XFASTINT (current_buffer->tab_width) < 20 - && (target_clm = ((int) current_column () /* iftc */ - + XINT (Fchar_width (make_number (c)))), - target_clm % XFASTINT (current_buffer->tab_width))))) + if (EQ (overwrite, Qoverwrite_mode_binary)) + chars_to_delete = n; + else if (c != '\n' && c2 != '\n') { int pos = PT; int pos_byte = PT_BYTE; + /* Column the cursor should be placed at after this insertion. + The correct value should be calculated only when necessary. */ + int target_clm = ((int) current_column () /* iftc */ + + n * XINT (Fchar_width (make_number (c)))); - if (target_clm == 0) - chars_to_delete = 1; - else - { /* The actual cursor position after the trial of moving to column TARGET_CLM. It is greater than TARGET_CLM if the TARGET_CLM is middle of multi-column @@ -433,14 +398,18 @@ internal_self_insert (int c, int noautofill) chars_to_delete = PT - pos; if (actual_clm > target_clm) - { - /* We will delete too many columns. Let's fill columns + { /* We will delete too many columns. Let's fill columns by spaces so that the remaining text won't move. */ + EMACS_INT actual = PT_BYTE; + DEC_POS (actual); + if (FETCH_CHAR (actual) == '\t') + /* Rather than add spaces, let's just keep the tab. */ + chars_to_delete--; + else spaces_to_insert = actual_clm - target_clm; } - } + SET_PT_BOTH (pos, pos_byte); - hairy = 2; } hairy = 2; } @@ -451,10 +420,10 @@ internal_self_insert (int c, int noautofill) && synt != Sword && NILP (current_buffer->read_only) && PT > BEGV - && (!NILP (current_buffer->enable_multibyte_characters) - ? SYNTAX (XFASTINT (Fprevious_char ())) == Sword - : (SYNTAX (UNIBYTE_TO_CHAR (XFASTINT (Fprevious_char ()))) - == Sword))) + && (SYNTAX (!NILP (current_buffer->enable_multibyte_characters) + ? XFASTINT (Fprevious_char ()) + : UNIBYTE_TO_CHAR (XFASTINT (Fprevious_char ()))) + == Sword)) { int modiff = MODIFF; Lisp_Object sym; @@ -479,16 +448,30 @@ internal_self_insert (int c, int noautofill) if (chars_to_delete) { - string = make_string_from_bytes (str, 1, len); + int mc = ((NILP (current_buffer->enable_multibyte_characters) + && SINGLE_BYTE_CHAR_P (c)) + ? UNIBYTE_TO_CHAR (c) : c); + Lisp_Object string = Fmake_string (make_number (n), make_number (mc)); + if (spaces_to_insert) { tem = Fmake_string (make_number (spaces_to_insert), make_number (' ')); - string = concat2 (tem, string); + string = concat2 (string, tem); } replace_range (PT, PT + chars_to_delete, string, 1, 1, 1); - Fforward_char (make_number (1 + spaces_to_insert)); + Fforward_char (make_number (n + spaces_to_insert)); + } + else if (n > 1) + { + USE_SAFE_ALLOCA; + unsigned char *strn, *p; + SAFE_ALLOCA (strn, unsigned char*, n * len); + for (p = strn; n > 0; n--, p += len) + memcpy (p, str, len); + insert_and_inherit (strn, p - strn); + SAFE_FREE (); } else insert_and_inherit (str, len); @@ -496,7 +479,6 @@ internal_self_insert (int c, int noautofill) if ((CHAR_TABLE_P (Vauto_fill_chars) ? !NILP (CHAR_TABLE_REF (Vauto_fill_chars, c)) : (c == ' ' || c == '\n')) - && !noautofill && !NILP (current_buffer->auto_fill_function)) { Lisp_Object tem; @@ -514,22 +496,9 @@ internal_self_insert (int c, int noautofill) hairy = 2; } - /* If previous command specified a face to use, use it. */ - if (!NILP (Vself_insert_face) - && EQ (current_kboard->Vlast_command, Vself_insert_face_command)) - { - Fput_text_property (make_number (PT - 1), make_number (PT), - Qface, Vself_insert_face, Qnil); - Vself_insert_face = Qnil; - } + /* Run hooks for electric keys. */ + call1 (Vrun_hooks, Qpost_self_insert_hook); - if ((synt == Sclose || synt == Smath) - && !NILP (Vblink_paren_function) && INTERACTIVE - && !noautofill) - { - call0 (Vblink_paren_function); - hairy = 2; - } return hairy; } @@ -550,20 +519,13 @@ syms_of_cmds (void) Qexpand_abbrev = intern_c_string ("expand-abbrev"); staticpro (&Qexpand_abbrev); - DEFVAR_LISP ("self-insert-face", &Vself_insert_face, - doc: /* If non-nil, set the face of the next self-inserting character to this. -See also `self-insert-face-command'. */); - Vself_insert_face = Qnil; - - DEFVAR_LISP ("self-insert-face-command", &Vself_insert_face_command, - doc: /* This is the command that set up `self-insert-face'. -If `last-command' does not equal this value, we ignore `self-insert-face'. */); - Vself_insert_face_command = Qnil; + Qpost_self_insert_hook = intern_c_string ("post-self-insert-hook"); + staticpro (&Qpost_self_insert_hook); - DEFVAR_LISP ("blink-paren-function", &Vblink_paren_function, - doc: /* Function called, if non-nil, whenever a close parenthesis is inserted. -More precisely, a char with closeparen syntax is self-inserted. */); - Vblink_paren_function = Qnil; + DEFVAR_LISP ("post-self-insert-hook", &Vpost_self_insert_hook, + doc: /* Hook run at the end of `self-insert-command'. +This run is run after inserting the charater. */); + Vpost_self_insert_hook = Qnil; defsubr (&Sforward_point); defsubr (&Sforward_char); diff --git a/src/composite.c b/src/composite.c index 392da1ceba1..bc5a67ef6e2 100644 --- a/src/composite.c +++ b/src/composite.c @@ -969,7 +969,9 @@ autocmp_chars (Lisp_Object rule, EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT static Lisp_Object _work_val; static int _work_char; -/* 1 iff the character C is composable. */ +/* 1 iff the character C is composable. Characters of general + category Z? or C? are not composable except for ZWNJ and ZWJ. */ + #define CHAR_COMPOSABLE_P(C) \ ((C) == 0x200C || (C) == 0x200D \ || (_work_val = CHAR_TABLE_REF (Vunicode_category_table, (C)), \ @@ -1028,19 +1030,6 @@ composition_compute_stop_pos (struct composition_it *cmp_it, EMACS_INT charpos, cmp_it->stop_pos = endpos = start; cmp_it->ch = -1; } - if (NILP (string)) - { - /* A composition never strides over PT. */ - if (PT > charpos) - { - if (PT < endpos) - cmp_it->stop_pos = endpos = PT; - } - else if (PT < charpos && PT > endpos) - { - cmp_it->stop_pos = endpos = PT - 1; - } - } if (NILP (current_buffer->enable_multibyte_characters) || NILP (Vauto_composition_mode)) return; @@ -1091,6 +1080,16 @@ composition_compute_stop_pos (struct composition_it *cmp_it, EMACS_INT charpos, } } } + if (charpos == endpos) + { + /* We couldn't find a composition point before ENDPOS. But, + some character after ENDPOS may be composed with + characters before ENDPOS. So, we should stop at the safe + point. */ + charpos = endpos - MAX_AUTO_COMPOSITION_LOOKBACK; + if (charpos < start) + charpos = start; + } } else if (charpos > endpos) { @@ -1223,23 +1222,8 @@ composition_compute_stop_pos (struct composition_it *cmp_it, EMACS_INT charpos, int composition_reseat_it (struct composition_it *cmp_it, EMACS_INT charpos, EMACS_INT bytepos, EMACS_INT endpos, struct window *w, struct face *face, Lisp_Object string) { - if (endpos <= charpos) - { - if (NILP (string)) - { - if (endpos < 0) - endpos = BEGV; - if (endpos < PT && PT < charpos) - endpos = PT; - } - else if (endpos < 0) - endpos = 0; - } - else - { - if (NILP (string) && charpos < PT && PT < endpos) - endpos = PT; - } + if (endpos < 0) + endpos = NILP (string) ? BEGV : 0; if (cmp_it->ch == -2) { @@ -1301,7 +1285,7 @@ composition_reseat_it (struct composition_it *cmp_it, EMACS_INT charpos, EMACS_I elt = XCAR (val); if (cmp_it->lookback > 0) { - cpos -= cmp_it->lookback; + cpos = charpos - cmp_it->lookback; if (STRINGP (string)) bpos = string_char_to_byte (string, cpos); else @@ -1456,8 +1440,7 @@ composition_update_it (struct composition_it *cmp_it, EMACS_INT charpos, EMACS_I { c = XINT (LGSTRING_CHAR (gstring, i)); cmp_it->nbytes += CHAR_BYTES (c); - cmp_it->width = (LGLYPH_WIDTH (glyph) > 0 - ? CHAR_WIDTH (LGLYPH_CHAR (glyph)) : 0); + cmp_it->width += CHAR_WIDTH (c); } } return c; @@ -1763,8 +1746,6 @@ should be ignored. */) CHECK_NATNUM (from); CHECK_NATNUM (to); - if (XINT (to) > XINT (from) + MAX_COMPOSITION_COMPONENTS) - to = make_number (XINT (from) + MAX_COMPOSITION_COMPONENTS); if (! FONT_OBJECT_P (font_object)) { struct coding_system *coding; diff --git a/src/config.in b/src/config.in index ea17a54d913..199afbd78ba 100644 --- a/src/config.in +++ b/src/config.in @@ -294,6 +294,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to 1 if netdb.h declares h_errno. */ #undef HAVE_H_ERRNO +/* Define to 1 if using imagemagick. */ +#undef HAVE_IMAGEMAGICK + /* Define to 1 if you have inet sockets. */ #undef HAVE_INET_SOCKETS @@ -432,6 +435,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to 1 if you have the <mach/mach.h> header file. */ #undef HAVE_MACH_MACH_H +/* Define to 1 if you have the `MagickExportImagePixels' function. */ +#undef HAVE_MAGICKEXPORTIMAGEPIXELS + /* Define to 1 if you have the <maillock.h> header file. */ #undef HAVE_MAILLOCK_H @@ -807,6 +813,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to 1 if you have the SM library (-lSM). */ #undef HAVE_X_SM +/* Define to 1 if you have the libxml2 library (-lxml2). */ +#undef HAVE_LIBXML2 + /* Define to 1 if you want to use the X window system. */ #undef HAVE_X_WINDOWS diff --git a/src/dbusbind.c b/src/dbusbind.c index 683d6f047fa..3b6f0e543bb 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -31,6 +31,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Subroutines. */ Lisp_Object Qdbus_init_bus; +Lisp_Object Qdbus_close_bus; Lisp_Object Qdbus_get_unique_name; Lisp_Object Qdbus_call_method; Lisp_Object Qdbus_call_method_asynchronously; @@ -59,6 +60,9 @@ Lisp_Object QCdbus_type_object_path, QCdbus_type_signature; Lisp_Object QCdbus_type_array, QCdbus_type_variant; Lisp_Object QCdbus_type_struct, QCdbus_type_dict_entry; +/* Registered buses. */ +Lisp_Object Vdbus_registered_buses; + /* Hash table which keeps function definitions. */ Lisp_Object Vdbus_registered_objects_table; @@ -111,7 +115,7 @@ int xd_in_read_queued_messages = 0; } while (0) /* Macros for debugging. In order to enable them, build with - "make MYCPPFLAGS='-DDBUS_DEBUG -Wall'". */ + "MYCPPFLAGS='-DDBUS_DEBUG -Wall' make". */ #ifdef DBUS_DEBUG #define XD_DEBUG_MESSAGE(...) \ do { \ @@ -713,10 +717,10 @@ xd_retrieve_arg (unsigned int dtype, DBusMessageIter *iter) } } -/* Initialize D-Bus connection. BUS is a Lisp symbol, either :system - or :session. It tells which D-Bus to initialize. If RAISE_ERROR - is non-zero signal an error when the connection cannot be - initialized. */ +/* Initialize D-Bus connection. BUS is either a Lisp symbol, :system + or :session, or a string denoting the bus address. It tells which + D-Bus to initialize. If RAISE_ERROR is non-zero, signal an error + when the connection cannot be initialized. */ static DBusConnection * xd_initialize (Lisp_Object bus, int raise_error) { @@ -724,34 +728,66 @@ xd_initialize (Lisp_Object bus, int raise_error) DBusError derror; /* Parameter check. */ - CHECK_SYMBOL (bus); - if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus))) - if (raise_error) - XD_SIGNAL2 (build_string ("Wrong bus name"), bus); - else - return NULL; + if (!STRINGP (bus)) + { + CHECK_SYMBOL (bus); + if (!(EQ (bus, QCdbus_system_bus) || EQ (bus, QCdbus_session_bus))) + { + if (raise_error) + XD_SIGNAL2 (build_string ("Wrong bus name"), bus); + else + return NULL; + } - /* We do not want to have an autolaunch for the session bus. */ - if (EQ (bus, QCdbus_session_bus) - && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL) - if (raise_error) - XD_SIGNAL2 (build_string ("No connection to bus"), bus); - else - return NULL; + /* We do not want to have an autolaunch for the session bus. */ + if (EQ (bus, QCdbus_session_bus) + && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL) + { + if (raise_error) + XD_SIGNAL2 (build_string ("No connection to bus"), bus); + else + return NULL; + } + } /* Open a connection to the bus. */ dbus_error_init (&derror); - if (EQ (bus, QCdbus_system_bus)) - connection = dbus_bus_get (DBUS_BUS_SYSTEM, &derror); + if (STRINGP (bus)) + connection = dbus_connection_open (SDATA (bus), &derror); else - connection = dbus_bus_get (DBUS_BUS_SESSION, &derror); + if (EQ (bus, QCdbus_system_bus)) + connection = dbus_bus_get (DBUS_BUS_SYSTEM, &derror); + else + connection = dbus_bus_get (DBUS_BUS_SESSION, &derror); if (dbus_error_is_set (&derror)) - if (raise_error) - XD_ERROR (derror); - else - connection = NULL; + { + if (raise_error) + XD_ERROR (derror); + else + connection = NULL; + } + + /* If it is not the system or session bus, we must register + ourselves. Otherwise, we have called dbus_bus_get, which has + configured us to exit if the connection closes - we undo this + setting. */ + if (connection != NULL) + { + if (STRINGP (bus)) + dbus_bus_register (connection, &derror); + else + dbus_connection_set_exit_on_disconnect (connection, FALSE); + } + + if (dbus_error_is_set (&derror)) + { + if (raise_error) + XD_ERROR (derror); + else + connection = NULL; + } if (connection == NULL && raise_error) XD_SIGNAL2 (build_string ("No connection to bus"), bus); @@ -794,7 +830,8 @@ xd_add_watch (DBusWatch *watch, void *data) } /* Remove connection file descriptor from input_wait_mask. DATA is - the used bus, either QCdbus_system_bus or QCdbus_session_bus. */ + the used bus, either a string or QCdbus_system_bus or + QCdbus_session_bus. */ void xd_remove_watch (DBusWatch *watch, void *data) { @@ -830,15 +867,11 @@ xd_remove_watch (DBusWatch *watch, void *data) } DEFUN ("dbus-init-bus", Fdbus_init_bus, Sdbus_init_bus, 1, 1, 0, - doc: /* Initialize connection to D-Bus BUS. -This is an internal function, it shall not be used outside dbus.el. */) + doc: /* Initialize connection to D-Bus BUS. */) (Lisp_Object bus) { DBusConnection *connection; - /* Check parameters. */ - CHECK_SYMBOL (bus); - /* Open a connection to the bus. */ connection = xd_initialize (bus, TRUE); @@ -850,6 +883,28 @@ This is an internal function, it shall not be used outside dbus.el. */) NULL, (void*) XHASH (bus), NULL)) XD_SIGNAL1 (build_string ("Cannot add watch functions")); + /* Add bus to list of registered buses. */ + Vdbus_registered_buses = Fcons (bus, Vdbus_registered_buses); + + /* Return. */ + return Qnil; +} + +DEFUN ("dbus-close-bus", Fdbus_close_bus, Sdbus_close_bus, 1, 1, 0, + doc: /* Close connection to D-Bus BUS. */) + (Lisp_Object bus) +{ + DBusConnection *connection; + + /* Open a connection to the bus. */ + connection = xd_initialize (bus, TRUE); + + /* Decrement reference count to the bus. */ + dbus_connection_unref (connection); + + /* Remove bus from list of registered buses. */ + Vdbus_registered_buses = Fdelete (bus, Vdbus_registered_buses); + /* Return. */ return Qnil; } @@ -862,9 +917,6 @@ DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name, DBusConnection *connection; const char *name; - /* Check parameters. */ - CHECK_SYMBOL (bus); - /* Open a connection to the bus. */ connection = xd_initialize (bus, TRUE); @@ -880,7 +932,8 @@ DEFUN ("dbus-get-unique-name", Fdbus_get_unique_name, Sdbus_get_unique_name, DEFUN ("dbus-call-method", Fdbus_call_method, Sdbus_call_method, 5, MANY, 0, doc: /* Call METHOD on the D-Bus BUS. -BUS is either the symbol `:system' or the symbol `:session'. +BUS is either a Lisp symbol, `:system' or `:session', or a string +denoting the bus address. SERVICE is the D-Bus service name to be used. PATH is the D-Bus object path SERVICE is registered at. INTERFACE is an interface @@ -967,7 +1020,6 @@ usage: (dbus-call-method BUS SERVICE PATH INTERFACE METHOD &optional :timeout TI interface = args[3]; method = args[4]; - CHECK_SYMBOL (bus); CHECK_STRING (service); CHECK_STRING (path); CHECK_STRING (interface); @@ -1082,7 +1134,8 @@ DEFUN ("dbus-call-method-asynchronously", Fdbus_call_method_asynchronously, Sdbus_call_method_asynchronously, 6, MANY, 0, doc: /* Call METHOD on the D-Bus BUS asynchronously. -BUS is either the symbol `:system' or the symbol `:session'. +BUS is either a Lisp symbol, `:system' or `:session', or a string +denoting the bus address. SERVICE is the D-Bus service name to be used. PATH is the D-Bus object path SERVICE is registered at. INTERFACE is an interface @@ -1148,7 +1201,6 @@ usage: (dbus-call-method-asynchronously BUS SERVICE PATH INTERFACE METHOD HANDLE method = args[4]; handler = args[5]; - CHECK_SYMBOL (bus); CHECK_STRING (service); CHECK_STRING (path); CHECK_STRING (interface); @@ -1271,7 +1323,6 @@ usage: (dbus-method-return-internal BUS SERIAL SERVICE &rest ARGS) */) serial = args[1]; service = args[2]; - CHECK_SYMBOL (bus); CHECK_NUMBER (serial); CHECK_STRING (service); GCPRO3 (bus, serial, service); @@ -1363,7 +1414,6 @@ usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */) serial = args[1]; service = args[2]; - CHECK_SYMBOL (bus); CHECK_NUMBER (serial); CHECK_STRING (service); GCPRO3 (bus, serial, service); @@ -1436,7 +1486,8 @@ usage: (dbus-method-error-internal BUS SERIAL SERVICE &rest ARGS) */) DEFUN ("dbus-send-signal", Fdbus_send_signal, Sdbus_send_signal, 5, MANY, 0, doc: /* Send signal SIGNAL on the D-Bus BUS. -BUS is either the symbol `:system' or the symbol `:session'. +BUS is either a Lisp symbol, `:system' or `:session', or a string +denoting the bus address. SERVICE is the D-Bus service name SIGNAL is sent from. PATH is the D-Bus object path SERVICE is registered at. INTERFACE is an interface @@ -1480,7 +1531,6 @@ usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */) interface = args[3]; signal = args[4]; - CHECK_SYMBOL (bus); CHECK_STRING (service); CHECK_STRING (path); CHECK_STRING (interface); @@ -1552,7 +1602,8 @@ usage: (dbus-send-signal BUS SERVICE PATH INTERFACE SIGNAL &rest ARGS) */) } /* Check, whether there is pending input in the message queue of the - D-Bus BUS. BUS is a Lisp symbol, either :system or :session. */ + D-Bus BUS. BUS is either a Lisp symbol, :system or :session, or a + string denoting the bus address. */ int xd_get_dispatch_status (Lisp_Object bus) { @@ -1572,24 +1623,31 @@ xd_get_dispatch_status (Lisp_Object bus) ? TRUE : FALSE; } -/* Check for queued incoming messages from the system and session buses. */ +/* Check for queued incoming messages from the buses. */ int xd_pending_messages (void) { + Lisp_Object busp = Vdbus_registered_buses; + + while (!NILP (busp)) + { + /* We do not want to have an autolaunch for the session bus. */ + if (EQ ((CAR_SAFE (busp)), QCdbus_session_bus) + && getenv ("DBUS_SESSION_BUS_ADDRESS") == NULL) + continue; - /* Vdbus_registered_objects_table will be initialized as hash table - in dbus.el. When this package isn't loaded yet, it doesn't make - sense to handle D-Bus messages. */ - return (HASH_TABLE_P (Vdbus_registered_objects_table) - ? (xd_get_dispatch_status (QCdbus_system_bus) - || ((getenv ("DBUS_SESSION_BUS_ADDRESS") != NULL) - ? xd_get_dispatch_status (QCdbus_session_bus) - : FALSE)) - : FALSE); + if (xd_get_dispatch_status (CAR_SAFE (busp))) + return TRUE; + + busp = CDR_SAFE (busp); + } + + return FALSE; } -/* Read queued incoming message of the D-Bus BUS. BUS is a Lisp - symbol, either :system or :session. */ +/* Read queued incoming message of the D-Bus BUS. BUS is either a + Lisp symbol, :system or :session, or a string denoting the bus + address. */ static Lisp_Object xd_read_message (Lisp_Object bus) { @@ -1746,29 +1804,28 @@ xd_read_message (Lisp_Object bus) RETURN_UNGCPRO (Qnil); } -/* Read queued incoming messages from the system and session buses. */ +/* Read queued incoming messages from all buses. */ void xd_read_queued_messages (void) { + Lisp_Object busp = Vdbus_registered_buses; - /* Vdbus_registered_objects_table will be initialized as hash table - in dbus.el. When this package isn't loaded yet, it doesn't make - sense to handle D-Bus messages. Furthermore, we ignore all Lisp - errors during the call. */ - if (HASH_TABLE_P (Vdbus_registered_objects_table)) + xd_in_read_queued_messages = 1; + while (!NILP (busp)) { - xd_in_read_queued_messages = 1; - internal_catch (Qdbus_error, xd_read_message, QCdbus_system_bus); - internal_catch (Qdbus_error, xd_read_message, QCdbus_session_bus); - xd_in_read_queued_messages = 0; + /* We ignore all Lisp errors during the call. */ + internal_catch (Qdbus_error, xd_read_message, CAR_SAFE (busp)); + busp = CDR_SAFE (busp); } + xd_in_read_queued_messages = 0; } DEFUN ("dbus-register-signal", Fdbus_register_signal, Sdbus_register_signal, 6, MANY, 0, doc: /* Register for signal SIGNAL on the D-Bus BUS. -BUS is either the symbol `:system' or the symbol `:session'. +BUS is either a Lisp symbol, `:system' or `:session', or a string +denoting the bus address. SERVICE is the D-Bus service name used by the sending D-Bus object. It can be either a known name or the unique name of the D-Bus object @@ -1822,7 +1879,6 @@ usage: (dbus-register-signal BUS SERVICE PATH INTERFACE SIGNAL HANDLER &rest ARG signal = args[4]; handler = args[5]; - CHECK_SYMBOL (bus); if (!NILP (service)) CHECK_STRING (service); if (!NILP (path)) CHECK_STRING (path); CHECK_STRING (interface); @@ -1915,7 +1971,8 @@ DEFUN ("dbus-register-method", Fdbus_register_method, Sdbus_register_method, 6, 6, 0, doc: /* Register for method METHOD on the D-Bus BUS. -BUS is either the symbol `:system' or the symbol `:session'. +BUS is either a Lisp symbol, `:system' or `:session', or a string +denoting the bus address. SERVICE is the D-Bus service name of the D-Bus object METHOD is registered for. It must be a known name. @@ -1933,7 +1990,6 @@ used for composing the returning D-Bus message. */) DBusError derror; /* Check parameters. */ - CHECK_SYMBOL (bus); CHECK_STRING (service); CHECK_STRING (path); CHECK_STRING (interface); @@ -1978,6 +2034,10 @@ syms_of_dbusbind (void) staticpro (&Qdbus_init_bus); defsubr (&Sdbus_init_bus); + Qdbus_close_bus = intern_c_string ("dbus-close-bus"); + staticpro (&Qdbus_close_bus); + defsubr (&Sdbus_close_bus); + Qdbus_get_unique_name = intern_c_string ("dbus-get-unique-name"); staticpro (&Qdbus_get_unique_name); defsubr (&Sdbus_get_unique_name); @@ -2074,18 +2134,25 @@ syms_of_dbusbind (void) QCdbus_type_dict_entry = intern_c_string (":dict-entry"); staticpro (&QCdbus_type_dict_entry); + DEFVAR_LISP ("dbus-registered-buses", + &Vdbus_registered_buses, + doc: /* List of D-Bus buses we are polling for messages. */); + Vdbus_registered_buses = Qnil; + DEFVAR_LISP ("dbus-registered-objects-table", &Vdbus_registered_objects_table, doc: /* Hash table of registered functions for D-Bus. + There are two different uses of the hash table: for accessing registered interfaces properties, targeted by signals or method calls, and for calling handlers in case of non-blocking method call returns. In the first case, the key in the hash table is the list (BUS -INTERFACE MEMBER). BUS is either the symbol `:system' or the symbol -`:session'. INTERFACE is a string which denotes a D-Bus interface, -and MEMBER, also a string, is either a method, a signal or a property -INTERFACE is offering. All arguments but BUS must not be nil. +INTERFACE MEMBER). BUS is either a Lisp symbol, `:system' or +`:session', or a string denoting the bus address. INTERFACE is a +string which denotes a D-Bus interface, and MEMBER, also a string, is +either a method, a signal or a property INTERFACE is offering. All +arguments but BUS must not be nil. The value in the hash table is a list of quadruple lists \((UNAME SERVICE PATH OBJECT) (UNAME SERVICE PATH OBJECT) ...). @@ -2097,15 +2164,18 @@ be called when a D-Bus message, which matches the key criteria, arrives (methods and signals), or a cons cell containing the value of the property. -In the second case, the key in the hash table is the list (BUS SERIAL). -BUS is either the symbol `:system' or the symbol `:session'. SERIAL -is the serial number of the non-blocking method call, a reply is -expected. Both arguments must not be nil. The value in the hash -table is HANDLER, the function to be called when the D-Bus reply -message arrives. */); - /* We initialize Vdbus_registered_objects_table in dbus.el, because - we need to define a hash table function first. */ - Vdbus_registered_objects_table = Qnil; +In the second case, the key in the hash table is the list (BUS +SERIAL). BUS is either a Lisp symbol, `:system' or `:session', or a +string denoting the bus address. SERIAL is the serial number of the +non-blocking method call, a reply is expected. Both arguments must +not be nil. The value in the hash table is HANDLER, the function to +be called when the D-Bus reply message arrives. */); + { + Lisp_Object args[2]; + args[0] = QCtest; + args[1] = Qequal; + Vdbus_registered_objects_table = Fmake_hash_table (2, args); + } DEFVAR_LISP ("dbus-debug", &Vdbus_debug, doc: /* If non-nil, debug messages of D-Bus bindings are raised. */); diff --git a/src/deps.mk b/src/deps.mk index 8eeed3822d0..d00be96744b 100644 --- a/src/deps.mk +++ b/src/deps.mk @@ -142,7 +142,7 @@ mktime.o: mktime.c $(config_h) msdos.o: msdos.c msdos.h dosfns.h systime.h termhooks.h dispextern.h frame.h \ termopts.h termchar.h character.h coding.h ccl.h disptab.h window.h \ keyboard.h $(INTERVALS_H) buffer.h commands.h blockinput.h atimer.h \ - lisp.h $(config_h) + lisp.h sysselect.h $(config_h) nsfns.o: nsfns.m charset.h nsterm.h nsgui.h frame.h window.h buffer.h \ dispextern.h fontset.h $(INTERVALS_H) keyboard.h blockinput.h \ atimer.h systime.h epaths.h termhooks.h coding.h systime.h lisp.h $(config_h) @@ -176,7 +176,7 @@ syntax.o: syntax.c syntax.h buffer.h commands.h category.h character.h \ sysdep.o: sysdep.c syssignal.h systty.h systime.h syswait.h blockinput.h \ process.h dispextern.h termhooks.h termchar.h termopts.h coding.h \ frame.h atimer.h window.h msdos.h dosfns.h keyboard.h cm.h lisp.h \ - $(config_h) composite.h + $(config_h) composite.h sysselect.h term.o: term.c termchar.h termhooks.h termopts.h lisp.h $(config_h) \ cm.h frame.h disptab.h keyboard.h character.h charset.h coding.h ccl.h \ xterm.h msdos.h window.h keymap.h blockinput.h atimer.h systime.h \ diff --git a/src/dispextern.h b/src/dispextern.h index c36db91ea02..5138958b6db 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -1718,7 +1718,7 @@ struct face_cache This macro is only meaningful for multibyte character CHAR. */ #define FACE_FOR_CHAR(F, FACE, CHAR, POS, OBJECT) \ - (ASCII_CHAR_P (CHAR) \ + ((ASCII_CHAR_P (CHAR) || CHAR_BYTE8_P (CHAR)) \ ? (FACE)->ascii_face->id \ : face_for_char ((F), (FACE), (CHAR), (POS), (OBJECT))) @@ -2275,9 +2275,11 @@ struct it composition. */ struct composition_it cmp_it; - /* The character to display, possibly translated to multibyte - if unibyte_display_via_language_environment is set. This - is set after produce_glyphs has been called. */ + /* The character to display, possibly translated to multibyte if + multibyte_p is zero or unibyte_display_via_language_environment + is set. This is set after get_next_display_element has been + called. If we are setting it->C directly before calling + PRODUCE_GLYPHS, this should be set beforehand too. */ int char_to_display; /* If what == IT_IMAGE, the id of the image to display. */ diff --git a/src/dispnew.c b/src/dispnew.c index 35893872c73..9344d792f3d 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -5351,9 +5351,15 @@ update_frame_line (struct frame *f, int vpos) ***********************************************************************/ /* Determine what's under window-relative pixel position (*X, *Y). - Return the object (string or buffer) that's there. + Return the OBJECT (string or buffer) that's there. Return in *POS the position in that object. - Adjust *X and *Y to character positions. */ + Adjust *X and *Y to character positions. + Return in *DX and *DY the pixel coordinates of the click, + relative to the top left corner of OBJECT, or relative to + the top left corner of the character glyph at (*X, *Y) + if OBJECT is nil. + Return WIDTH and HEIGHT of the object at (*X, *Y), or zero + if the coordinates point to an empty area of the display. */ Lisp_Object buffer_posn_from_coords (struct window *w, int *x, int *y, struct display_pos *pos, Lisp_Object *object, int *dx, int *dy, int *width, int *height) @@ -5366,7 +5372,7 @@ buffer_posn_from_coords (struct window *w, int *x, int *y, struct display_pos *p #ifdef HAVE_WINDOW_SYSTEM struct image *img = 0; #endif - int x0, x1; + int x0, x1, to_x; /* We used to set current_buffer directly here, but that does the wrong thing with `face-remapping-alist' (bug#2044). */ @@ -5377,8 +5383,33 @@ buffer_posn_from_coords (struct window *w, int *x, int *y, struct display_pos *p start_display (&it, w, startp); x0 = *x - WINDOW_LEFT_MARGIN_WIDTH (w); - move_it_to (&it, -1, x0 + it.first_visible_x, *y, -1, - MOVE_TO_X | MOVE_TO_Y); + + /* First, move to the beginning of the row corresponding to *Y. We + need to be in that row to get the correct value of base paragraph + direction for the text at (*X, *Y). */ + move_it_to (&it, -1, 0, *y, -1, MOVE_TO_X | MOVE_TO_Y); + + /* TO_X is the pixel position that the iterator will compute for the + glyph at *X. We add it.first_visible_x because iterator + positions include the hscroll. */ + to_x = x0 + it.first_visible_x; + if (it.bidi_it.paragraph_dir == R2L) + /* For lines in an R2L paragraph, we need to mirror TO_X wrt the + text area. This is because the iterator, even in R2L + paragraphs, delivers glyphs as if they started at the left + margin of the window. (When we actually produce glyphs for + display, we reverse their order in PRODUCE_GLYPHS, but the + iterator doesn't know about that.) The following line adjusts + the pixel position to the iterator geometry, which is what + move_it_* routines use. (The -1 is because in a window whose + text-area width is W, the rightmost pixel position is W-1, and + it should be mirrored into zero pixel position.) */ + to_x = window_box_width (w, TEXT_AREA) - to_x - 1; + + /* Now move horizontally in the row to the glyph under *X. Second + argument is ZV to prevent move_it_in_display_line from matching + based on buffer positions. */ + move_it_in_display_line (&it, ZV, to_x, MOVE_TO_X); Fset_buffer (old_current_buffer); diff --git a/src/doc.c b/src/doc.c index f08976faf87..86d29a5a5ef 100644 --- a/src/doc.c +++ b/src/doc.c @@ -286,8 +286,7 @@ get_doc_string (Lisp_Object filepos, int unibyte, int definition) to - (get_doc_string_buffer + offset)); else { - /* Let the data determine whether the string is multibyte, - even if Emacs is running in --unibyte mode. */ + /* The data determines whether the string is multibyte. */ int nchars = multibyte_chars_in_text (get_doc_string_buffer + offset, to - (get_doc_string_buffer + offset)); return make_string_from_bytes (get_doc_string_buffer + offset, @@ -632,24 +631,28 @@ the same file name is found in the `doc-directory'. */) p = buf; end = buf + (filled < 512 ? filled : filled - 128); while (p != end && *p != '\037') p++; - /* p points to ^_Ffunctionname\n or ^_Vvarname\n. */ + /* p points to ^_Ffunctionname\n or ^_Vvarname\n or ^_Sfilename\n. */ if (p != end) { end = strchr (p, '\n'); /* See if this is a file name, and if it is a file in build-files. */ - if (p[1] == 'S' && end - p > 4 && end[-2] == '.' - && (end[-1] == 'o' || end[-1] == 'c')) + if (p[1] == 'S') { - int len = end - p - 2; - char *fromfile = alloca (len + 1); - strncpy (fromfile, &p[2], len); - fromfile[len] = 0; - if (fromfile[len-1] == 'c') - fromfile[len-1] = 'o'; - - skip_file = NILP (Fmember (build_string (fromfile), - Vbuild_files)); + skip_file = 0; + if (end - p > 4 && end[-2] == '.' + && (end[-1] == 'o' || end[-1] == 'c')) + { + int len = end - p - 2; + char *fromfile = alloca (len + 1); + strncpy (fromfile, &p[2], len); + fromfile[len] = 0; + if (fromfile[len-1] == 'c') + fromfile[len-1] = 'o'; + + skip_file = NILP (Fmember (build_string (fromfile), + Vbuild_files)); + } } sym = oblookup (Vobarray, p + 2, diff --git a/src/dosfns.c b/src/dosfns.c index 5be0a363da8..e66b50ed3ff 100644 --- a/src/dosfns.c +++ b/src/dosfns.c @@ -60,7 +60,6 @@ REGISTERS should be a vector produced by `make-register' and register int i; int no; union REGS inregs, outregs; - Lisp_Object val; CHECK_NUMBER (interrupt); no = (unsigned long) XINT (interrupt); @@ -101,7 +100,6 @@ Return the updated VECTOR. */) register int i; int offs, len; char *buf; - Lisp_Object val; CHECK_NUMBER (address); offs = (unsigned long) XINT (address); @@ -125,7 +123,6 @@ DEFUN ("msdos-memput", Fdos_memput, Sdos_memput, 2, 2, 0, register int i; int offs, len; char *buf; - Lisp_Object val; CHECK_NUMBER (address); offs = (unsigned long) XINT (address); @@ -286,6 +283,8 @@ init_dosfns (void) unsigned long xbuf = _go32_info_block.linear_address_of_transfer_buffer; #ifndef SYSTEM_MALLOC + extern void get_lim_data (void); + get_lim_data (); /* why the hell isn't this called elsewhere? */ #endif @@ -558,6 +557,7 @@ system_process_attributes (Lisp_Object pid) int i; Lisp_Object cmd_str, decoded_cmd, tem; double pmem; + EXFUN (Fget_internal_run_time, 0); #ifndef SYSTEM_MALLOC extern unsigned long ret_lim_data (); #endif diff --git a/src/dosfns.h b/src/dosfns.h index 820b6b30e43..d31401247b4 100644 --- a/src/dosfns.h +++ b/src/dosfns.h @@ -40,6 +40,7 @@ extern Lisp_Object Vdos_display_scancodes; extern int msdos_stdcolor_idx (const char *); extern Lisp_Object msdos_stdcolor_name (int); +extern void x_set_title (struct frame *, Lisp_Object); #endif /* arch-tag: a83b8c4c-63c8-451e-9e94-bc72e3e2f8bc diff --git a/src/emacs.c b/src/emacs.c index 4dc670e6032..33e0d60630b 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -91,6 +91,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #endif #endif +/* If you change the following line, remember to update + msdos/mainmake.v2 which gleans the Emacs version from it! */ static const char emacs_copyright[] = "Copyright (C) 2010 Free Software Foundation, Inc."; static const char emacs_version[] = "24.0.50"; @@ -839,8 +841,9 @@ main (int argc, char **argv) || strcmp (argv[argc-1], "bootstrap") == 0) && ! getenv ("EMACS_HEAP_EXEC")) { + static char heapexec[] = "EMACS_HEAP_EXEC=true"; /* Set this so we only do this once. */ - putenv("EMACS_HEAP_EXEC=true"); + putenv(heapexec); /* A flag to turn off address randomization which is introduced in linux kernel shipped with fedora core 4 */ @@ -1329,68 +1332,6 @@ main (int argc, char **argv) init_atimer (); running_asynch_code = 0; - /* Handle --unibyte and the EMACS_UNIBYTE envvar, - but not while dumping. */ - if (1) - { - int inhibit_unibyte = 0; - - /* --multibyte overrides EMACS_UNIBYTE. */ - if (argmatch (argv, argc, "-no-unibyte", "--no-unibyte", 4, NULL, &skip_args) - || argmatch (argv, argc, "-multibyte", "--multibyte", 4, NULL, &skip_args) - /* Ignore EMACS_UNIBYTE before dumping. */ - || (!initialized && noninteractive)) - inhibit_unibyte = 1; - - /* --unibyte requests that we set up to do everything with single-byte - buffers and strings. We need to handle this before calling - init_lread, init_editfns and other places that generate Lisp strings - from text in the environment. */ - /* Actually this shouldn't be needed as of 20.4 in a generally - unibyte environment. As handa says, environment values - aren't now decoded; also existing buffers are now made - unibyte during startup if .emacs sets unibyte. Tested with - 8-bit data in environment variables and /etc/passwd, setting - unibyte and Latin-1 in .emacs. -- Dave Love */ - if (argmatch (argv, argc, "-unibyte", "--unibyte", 4, NULL, &skip_args) - || argmatch (argv, argc, "-no-multibyte", "--no-multibyte", 4, NULL, &skip_args) - || (getenv ("EMACS_UNIBYTE") && !inhibit_unibyte)) - { - Lisp_Object old_log_max; - Lisp_Object symbol, tail; - - symbol = intern_c_string ("enable-multibyte-characters"); - Fset_default (symbol, Qnil); - - if (initialized) - { - /* Erase pre-dump messages in *Messages* now so no abort. */ - old_log_max = Vmessage_log_max; - XSETFASTINT (Vmessage_log_max, 0); - message_dolog ("", 0, 1, 0); - Vmessage_log_max = old_log_max; - } - - for (tail = Vbuffer_alist; CONSP (tail); - tail = XCDR (tail)) - { - Lisp_Object buffer; - - buffer = Fcdr (XCAR (tail)); - /* Make a multibyte buffer unibyte. */ - if (BUF_Z_BYTE (XBUFFER (buffer)) > BUF_Z (XBUFFER (buffer))) - { - struct buffer *current = current_buffer; - - set_buffer_temp (XBUFFER (buffer)); - Fset_buffer_multibyte (Qnil); - set_buffer_temp (current); - } - } - message ("Warning: unibyte sessions are obsolete and will disappear"); - } - } - no_loadup = argmatch (argv, argc, "-nl", "--no-loadup", 6, NULL, &skip_args); @@ -1603,6 +1544,10 @@ main (int argc, char **argv) #endif #endif /* HAVE_X_WINDOWS */ +#ifdef HAVE_LIBXML2 + syms_of_xml (); +#endif + syms_of_menu (); #ifdef HAVE_NTGUI @@ -1789,10 +1734,6 @@ const struct standard_args standard_args[] = { "-script", "--script", 100, 1 }, { "-daemon", "--daemon", 99, 0 }, { "-help", "--help", 90, 0 }, - { "-no-unibyte", "--no-unibyte", 83, 0 }, - { "-multibyte", "--multibyte", 82, 0 }, - { "-unibyte", "--unibyte", 81, 0 }, - { "-no-multibyte", "--no-multibyte", 80, 0 }, { "-nl", "--no-loadup", 70, 0 }, /* -d must come last before the options handled in startup.el. */ { "-d", "--display", 60, 1 }, @@ -2093,7 +2034,7 @@ shut_down_emacs (int sig, int no_x, Lisp_Object stuff) Vinhibit_redisplay = Qt; /* If we are controlling the terminal, reset terminal modes. */ -#ifdef EMACS_HAVE_TTY_PGRP +#ifndef DOS_NT { int pgrp = EMACS_GETPGRP (0); diff --git a/src/eval.c b/src/eval.c index 6d0a49c0d7e..a16d6c59809 100644 --- a/src/eval.c +++ b/src/eval.c @@ -722,8 +722,8 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */) tail = XCDR (tail); } - while (CONSP (Fcar (tail)) - && EQ (Fcar (Fcar (tail)), Qdeclare)) + if (CONSP (Fcar (tail)) + && EQ (Fcar (Fcar (tail)), Qdeclare)) { if (!NILP (Vmacro_declaration_function)) { @@ -1072,12 +1072,13 @@ usage: (let VARLIST BODY...) */) int count = SPECPDL_INDEX (); register int argnum; struct gcpro gcpro1, gcpro2; + USE_SAFE_ALLOCA; varlist = Fcar (args); /* Make space to hold the values to give the bound variables */ elt = Flength (varlist); - temps = (Lisp_Object *) alloca (XFASTINT (elt) * sizeof (Lisp_Object)); + SAFE_ALLOCA_LISP (temps, XFASTINT (elt)); /* Compute the values and store them in `temps' */ @@ -1122,7 +1123,7 @@ usage: (let VARLIST BODY...) */) specbind (Qinternal_interpreter_environment, lexenv); elt = Fprogn (Fcdr (args)); - + SAFE_FREE (); return unbind_to (count, elt); } @@ -2396,8 +2397,9 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, /* Pass a vector of evaluated arguments */ Lisp_Object *vals; register int argnum = 0; + USE_SAFE_ALLOCA; - vals = (Lisp_Object *) alloca (XINT (numargs) * sizeof (Lisp_Object)); + SAFE_ALLOCA_LISP (vals, XINT (numargs)); GCPRO3 (args_left, fun, fun); gcpro3.var = vals; @@ -2415,6 +2417,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals); UNGCPRO; + SAFE_FREE (); goto done; } @@ -2536,8 +2539,9 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) register int i, numargs; register Lisp_Object spread_arg; register Lisp_Object *funcall_args; - Lisp_Object fun; + Lisp_Object fun, retval; struct gcpro gcpro1; + USE_SAFE_ALLOCA; fun = args [0]; funcall_args = 0; @@ -2576,8 +2580,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) { /* Avoid making funcall cons up a yet another new vector of arguments by explicitly supplying nil's for optional values */ - funcall_args = (Lisp_Object *) alloca ((1 + XSUBR (fun)->max_args) - * sizeof (Lisp_Object)); + SAFE_ALLOCA_LISP (funcall_args, 1 + XSUBR (fun)->max_args); for (i = numargs; i < XSUBR (fun)->max_args;) funcall_args[++i] = Qnil; GCPRO1 (*funcall_args); @@ -2589,8 +2592,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) function itself as well as its arguments. */ if (!funcall_args) { - funcall_args = (Lisp_Object *) alloca ((1 + numargs) - * sizeof (Lisp_Object)); + SAFE_ALLOCA_LISP (funcall_args, 1 + numargs); GCPRO1 (*funcall_args); gcpro1.nvars = 1 + numargs; } @@ -2606,7 +2608,11 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) } /* By convention, the caller needs to gcpro Ffuncall's args. */ - RETURN_UNGCPRO (Ffuncall (gcpro1.nvars, funcall_args)); + retval = Ffuncall (gcpro1.nvars, funcall_args); + UNGCPRO; + SAFE_FREE (); + + return retval; } /* Run hook variables in various ways. */ @@ -3212,9 +3218,10 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, int eval_flag, struct gcpro gcpro1, gcpro2, gcpro3; register int i; register Lisp_Object tem; + USE_SAFE_ALLOCA; numargs = Flength (args); - arg_vector = (Lisp_Object *) alloca (XINT (numargs) * sizeof (Lisp_Object)); + SAFE_ALLOCA_LISP (arg_vector, XINT (numargs)); args_left = args; GCPRO3 (*arg_vector, args_left, fun); @@ -3243,6 +3250,7 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, int eval_flag, tem = call_debugger (Fcons (Qexit, Fcons (tem, Qnil))); /* Don't do it again when we return to eval. */ backtrace_list->debug_on_exit = 0; + SAFE_FREE (); return tem; } diff --git a/src/fileio.c b/src/fileio.c index a04cd4e76f5..3d08e881e8f 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -1842,7 +1842,7 @@ barf_or_query_if_file_exists (Lisp_Object absname, const unsigned char *querystr tem = format2 ("File %s already exists; %s anyway? ", absname, build_string (querystring)); if (quick) - tem = Fy_or_n_p (tem); + tem = call1 (intern ("y-or-n-p"), tem); else tem = do_yes_or_no_p (tem); UNGCPRO; diff --git a/src/floatfns.c b/src/floatfns.c index 1c3e40eefde..29e5c119a1f 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -987,16 +987,18 @@ int matherr (struct exception *x) { Lisp_Object args; + const char *name = x->name; + if (! in_float) /* Not called from emacs-lisp float routines; do the default thing. */ return 0; if (!strcmp (x->name, "pow")) - x->name = "expt"; + name = "expt"; args - = Fcons (build_string (x->name), + = Fcons (build_string (name), Fcons (make_float (x->arg1), - ((!strcmp (x->name, "log") || !strcmp (x->name, "pow")) + ((!strcmp (name, "log") || !strcmp (name, "pow")) ? Fcons (make_float (x->arg2), Qnil) : Qnil))); switch (x->type) diff --git a/src/fns.c b/src/fns.c index 83b4bd5492d..be4b99d50e6 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2447,146 +2447,6 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string. */) return sequence; } -/* Anything that calls this function must protect from GC! */ - -DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0, - doc: /* Ask user a "y or n" question. Return t if answer is "y". -Takes one argument, which is the string to display to ask the question. -It should end in a space; `y-or-n-p' adds `(y or n) ' to it. -No confirmation of the answer is requested; a single character is enough. -Also accepts Space to mean yes, or Delete to mean no. \(Actually, it uses -the bindings in `query-replace-map'; see the documentation of that variable -for more information. In this case, the useful bindings are `act', `skip', -`recenter', and `quit'.\) - -Under a windowing system a dialog box will be used if `last-nonmenu-event' -is nil and `use-dialog-box' is non-nil. */) - (Lisp_Object prompt) -{ - register Lisp_Object obj, key, def, map; - register int answer; - Lisp_Object xprompt; - Lisp_Object args[2]; - struct gcpro gcpro1, gcpro2; - int count = SPECPDL_INDEX (); - - specbind (Qcursor_in_echo_area, Qt); - - map = Fsymbol_value (intern ("query-replace-map")); - - CHECK_STRING (prompt); - xprompt = prompt; - GCPRO2 (prompt, xprompt); - -#ifdef HAVE_WINDOW_SYSTEM - if (display_hourglass_p) - cancel_hourglass (); -#endif - - while (1) - { - -#ifdef HAVE_MENUS - if (FRAME_WINDOW_P (SELECTED_FRAME ()) - && (NILP (last_nonmenu_event) || CONSP (last_nonmenu_event)) - && use_dialog_box - && have_menus_p ()) - { - Lisp_Object pane, menu; - redisplay_preserve_echo_area (3); - pane = Fcons (Fcons (build_string ("Yes"), Qt), - Fcons (Fcons (build_string ("No"), Qnil), - Qnil)); - menu = Fcons (prompt, pane); - obj = Fx_popup_dialog (Qt, menu, Qnil); - answer = !NILP (obj); - break; - } -#endif /* HAVE_MENUS */ - cursor_in_echo_area = 1; - choose_minibuf_frame (); - - { - Lisp_Object pargs[3]; - - /* Colorize prompt according to `minibuffer-prompt' face. */ - pargs[0] = build_string ("%s(y or n) "); - pargs[1] = intern ("face"); - pargs[2] = intern ("minibuffer-prompt"); - args[0] = Fpropertize (3, pargs); - args[1] = xprompt; - Fmessage (2, args); - } - - if (minibuffer_auto_raise) - { - Lisp_Object mini_frame; - - mini_frame = WINDOW_FRAME (XWINDOW (minibuf_window)); - - Fraise_frame (mini_frame); - } - - temporarily_switch_to_single_kboard (SELECTED_FRAME ()); - obj = read_filtered_event (1, 0, 0, 0, Qnil); - cursor_in_echo_area = 0; - /* If we need to quit, quit with cursor_in_echo_area = 0. */ - QUIT; - - key = Fmake_vector (make_number (1), obj); - def = Flookup_key (map, key, Qt); - - if (EQ (def, intern ("skip"))) - { - answer = 0; - break; - } - else if (EQ (def, intern ("act"))) - { - answer = 1; - break; - } - else if (EQ (def, intern ("recenter"))) - { - Frecenter (Qnil); - xprompt = prompt; - continue; - } - else if (EQ (def, intern ("quit"))) - Vquit_flag = Qt; - /* We want to exit this command for exit-prefix, - and this is the only way to do it. */ - else if (EQ (def, intern ("exit-prefix"))) - Vquit_flag = Qt; - - QUIT; - - /* If we don't clear this, then the next call to read_char will - return quit_char again, and we'll enter an infinite loop. */ - Vquit_flag = Qnil; - - Fding (Qnil); - Fdiscard_input (); - if (EQ (xprompt, prompt)) - { - args[0] = build_string ("Please answer y or n. "); - args[1] = prompt; - xprompt = Fconcat (2, args); - } - } - UNGCPRO; - - if (! noninteractive) - { - cursor_in_echo_area = -1; - message_with_string (answer ? "%s(y or n) y" : "%s(y or n) n", - xprompt, 0); - } - - unbind_to (count, Qnil); - return answer ? Qt : Qnil; -} - /* This is how C code calls `yes-or-no-p' and allows the user to redefined it. @@ -4422,13 +4282,13 @@ keys. Default is `eql'. Predefined are the tests `eq', `eql', and Default is 65. :rehash-size REHASH-SIZE - Indicates how to expand the table when it -fills up. If REHASH-SIZE is an integer, add that many space. If it -is a float, it must be > 1.0, and the new size is computed by -multiplying the old size with that factor. Default is 1.5. +fills up. If REHASH-SIZE is an integer, increase the size by that +amount. If it is a float, it must be > 1.0, and the new size is the +old size multiplied by that factor. Default is 1.5. :rehash-threshold THRESHOLD -- THRESHOLD must a float > 0, and <= 1.0. Resize the hash table when the ratio (number of entries / table size) -is greater or equal than THRESHOLD. Default is 0.8. +is greater than or equal to THRESHOLD. Default is 0.8. :weakness WEAK -- WEAK must be one of nil, t, `key', `value', `key-or-value', or `key-and-value'. If WEAK is not nil, the table @@ -5061,7 +4921,6 @@ this variable. */); defsubr (&Smapcar); defsubr (&Smapc); defsubr (&Smapconcat); - defsubr (&Sy_or_n_p); defsubr (&Syes_or_no_p); defsubr (&Sload_average); defsubr (&Sfeaturep); diff --git a/src/font.c b/src/font.c index eba75c11b2f..ae7211e92fe 100644 --- a/src/font.c +++ b/src/font.c @@ -3506,7 +3506,7 @@ font_open_by_spec (FRAME_PTR f, Lisp_Object spec) found, return Qnil. */ Lisp_Object -font_open_by_name (FRAME_PTR f, char *name) +font_open_by_name (FRAME_PTR f, const char *name) { Lisp_Object args[2]; Lisp_Object spec, ret; diff --git a/src/font.h b/src/font.h index 5f1a442b59e..c322b8e590f 100644 --- a/src/font.h +++ b/src/font.h @@ -783,7 +783,7 @@ extern void font_prepare_for_face (FRAME_PTR f, struct face *face); extern void font_done_for_face (FRAME_PTR f, struct face *face); extern Lisp_Object font_open_by_spec (FRAME_PTR f, Lisp_Object spec); -extern Lisp_Object font_open_by_name (FRAME_PTR f, char *name); +extern Lisp_Object font_open_by_name (FRAME_PTR f, const char *name); extern void font_close_object (FRAME_PTR f, Lisp_Object font_object); extern Lisp_Object font_intern_prop (const char *str, int len, int force_symbol); diff --git a/src/fontset.c b/src/fontset.c index b273ace75af..86b9ceb45db 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -283,6 +283,10 @@ fontset_id_valid_p (id) #define RFONT_DEF_OBJECT(rfont_def) AREF (rfont_def, 2) #define RFONT_DEF_SET_OBJECT(rfont_def, object) \ ASET ((rfont_def), 2, (object)) +/* Score of RFONT_DEF is an integer value; the lowest 8 bits represent + the order of listing by font backends, the higher bits represents + the order given by charset priority list. The smaller value is + preferable. */ #define RFONT_DEF_SCORE(rfont_def) XINT (AREF (rfont_def, 3)) #define RFONT_DEF_SET_SCORE(rfont_def, score) \ ASET ((rfont_def), 3, make_number (score)) @@ -412,8 +416,13 @@ reorder_font_vector (Lisp_Object font_group, struct font *font) Lisp_Object font_def = RFONT_DEF_FONT_DEF (rfont_def); Lisp_Object font_spec = FONT_DEF_SPEC (font_def); int score = RFONT_DEF_SCORE (rfont_def) & 0xFF; + Lisp_Object otf_spec = Ffont_get (font_spec, QCotf); - if (! font_match_p (font_spec, font_object)) + if (! NILP (otf_spec)) + /* A font-spec with :otf is preferable regardless of encoding + and language.. */ + ; + else if (! font_match_p (font_spec, font_object)) { Lisp_Object encoding = FONT_DEF_ENCODING (font_def); diff --git a/src/frame.h b/src/frame.h index 088b477dfce..6b307c7c3b1 100644 --- a/src/frame.h +++ b/src/frame.h @@ -1050,7 +1050,7 @@ extern Lisp_Object Qbackground_color, Qforeground_color; extern Lisp_Object Qicon, Qicon_name, Qicon_type, Qicon_left, Qicon_top; extern Lisp_Object Qinternal_border_width; extern Lisp_Object Qtooltip; -extern Lisp_Object Qmenu_bar_lines, Qtool_bar_lines; +extern Lisp_Object Qmenu_bar_lines, Qtool_bar_lines, Qtool_bar_position; extern Lisp_Object Qmouse_color; extern Lisp_Object Qname, Qtitle; extern Lisp_Object Qparent_id; diff --git a/src/gtkutil.c b/src/gtkutil.c index b1591b79f9c..dbd48eb5272 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -432,20 +432,22 @@ xg_list_remove (xg_list_node *list, xg_list_node *node) } /* Allocate and return a utf8 version of STR. If STR is already - utf8 or NULL, just return STR. - If not, a new string is allocated and the caller must free the result + utf8 or NULL, just return a copy of STR. + A new string is allocated and the caller must free the result with g_free. */ static char * -get_utf8_string (char *str) +get_utf8_string (const char *str) { - char *utf8_str = str; + char *utf8_str; if (!str) return NULL; /* If not UTF-8, try current locale. */ if (!g_utf8_validate (str, -1, NULL)) utf8_str = g_locale_to_utf8 (str, -1, 0, 0, 0); + else + return g_strdup (str); if (!utf8_str) { @@ -504,6 +506,41 @@ get_utf8_string (char *str) return utf8_str; } +/* Check for special colors used in face spec for region face. + The colors are fetched from the Gtk+ theme. + Return 1 if color was found, 0 if not. */ + +int +xg_check_special_colors (struct frame *f, + const char *color_name, + XColor *color) +{ + int success_p = 0; + if (FRAME_GTK_WIDGET (f)) + { + if (strcmp ("gtk_selection_bg_color", color_name) == 0) + { + GtkStyle *gsty = gtk_widget_get_style (FRAME_GTK_WIDGET (f)); + color->red = gsty->bg[GTK_STATE_SELECTED].red; + color->green = gsty->bg[GTK_STATE_SELECTED].green; + color->blue = gsty->bg[GTK_STATE_SELECTED].blue; + color->pixel = gsty->bg[GTK_STATE_SELECTED].pixel; + success_p = 1; + } + else if (strcmp ("gtk_selection_fg_color", color_name) == 0) + { + GtkStyle *gsty = gtk_widget_get_style (FRAME_GTK_WIDGET (f)); + color->red = gsty->fg[GTK_STATE_SELECTED].red; + color->green = gsty->fg[GTK_STATE_SELECTED].green; + color->blue = gsty->fg[GTK_STATE_SELECTED].blue; + color->pixel = gsty->fg[GTK_STATE_SELECTED].pixel; + success_p = 1; + } + } + + return success_p; +} + /*********************************************************************** @@ -896,6 +933,26 @@ xg_pix_to_gcolor (GtkWidget *w, long unsigned int pixel, GdkColor *c) gdk_colormap_query_color (map, pixel, c); } +/* Callback called when the gtk theme changes. + We notify lisp code so it can fix faces used for region for example. */ + +static void +style_changed_cb (GObject *go, + GParamSpec *spec, + gpointer user_data) +{ + struct input_event event; + GdkDisplay *gdpy = (GdkDisplay *) user_data; + const char *display_name = gdk_display_get_name (gdpy); + + EVENT_INIT (event); + event.kind = CONFIG_CHANGED_EVENT; + event.frame_or_window = make_string (display_name, strlen (display_name)); + /* Theme doesn't change often, so intern is called seldom. */ + event.arg = intern ("theme-name"); + kbd_buffer_store_event (&event); +} + /* Create and set up the GTK widgets for frame F. Return 0 if creation failed, non-zero otherwise. */ @@ -1021,6 +1078,22 @@ xg_create_frame_widgets (FRAME_PTR f) g_signal_connect (wtop, "query-tooltip", G_CALLBACK (qttip_cb), f); #endif + { + GdkScreen *screen = gtk_widget_get_screen (wtop); + GtkSettings *gs = gtk_settings_get_for_screen (screen); + /* Only connect this signal once per screen. */ + if (! g_signal_handler_find (G_OBJECT (gs), + G_SIGNAL_MATCH_FUNC, + 0, 0, 0, + G_CALLBACK (style_changed_cb), + 0)) + { + g_signal_connect (G_OBJECT (gs), "notify::gtk-theme-name", + G_CALLBACK (style_changed_cb), + gdk_screen_get_display (screen)); + } + } + UNBLOCK_INPUT; return 1; @@ -1336,7 +1409,7 @@ create_dialog (widget_value *wv, } } - if (utf8_label && utf8_label != item->value) + if (utf8_label) g_free (utf8_label); } @@ -2076,7 +2149,7 @@ static const char* separator_names[] = { }; static int -xg_separator_p (char *label) +xg_separator_p (const char *label) { if (! label) return 0; else if (strlen (label) > 3 @@ -2174,8 +2247,8 @@ xg_create_one_menuitem (widget_value *item, w = make_menu_item (utf8_label, utf8_key, item, group); - if (utf8_label && utf8_label != item->name) g_free (utf8_label); - if (utf8_key && utf8_key != item->key) g_free (utf8_key); + if (utf8_label) g_free (utf8_label); + if (utf8_key) g_free (utf8_key); cb_data = xmalloc (sizeof (xg_menu_item_cb_data)); @@ -2311,7 +2384,7 @@ create_menus (widget_value *data, gtk_menu_set_title (GTK_MENU (wmenu), utf8_label); w = gtk_menu_item_new_with_label (utf8_label); gtk_widget_set_sensitive (w, FALSE); - if (utf8_label && utf8_label != item->name) g_free (utf8_label); + if (utf8_label) g_free (utf8_label); } else if (xg_separator_p (item->name)) { @@ -2432,7 +2505,7 @@ xg_get_menu_item_label (GtkMenuItem *witem) /* Return non-zero if the menu item WITEM has the text LABEL. */ static int -xg_item_label_same_p (GtkMenuItem *witem, char *label) +xg_item_label_same_p (GtkMenuItem *witem, const char *label) { int is_same = 0; char *utf8_label = get_utf8_string (label); @@ -2443,7 +2516,7 @@ xg_item_label_same_p (GtkMenuItem *witem, char *label) else if (old_label && utf8_label) is_same = strcmp (utf8_label, old_label) == 0; - if (utf8_label && utf8_label != label) g_free (utf8_label); + if (utf8_label) g_free (utf8_label); return is_same; } @@ -2590,6 +2663,7 @@ xg_update_menubar (GtkWidget *menubar, /* Set the title of the detached window. */ gtk_menu_set_title (GTK_MENU (submenu), utf8_label); + if (utf8_label) g_free (utf8_label); iter = g_list_next (iter); val = val->next; ++pos; @@ -2729,8 +2803,8 @@ xg_update_menu_item (widget_value *val, if (! old_label || strcmp (utf8_label, old_label) != 0) gtk_label_set_text (wlbl, utf8_label); - if (utf8_key && utf8_key != val->key) g_free (utf8_key); - if (utf8_label && utf8_label != val->name) g_free (utf8_label); + if (utf8_key) g_free (utf8_key); + if (utf8_label) g_free (utf8_label); if (! val->enabled && gtk_widget_get_sensitive (w)) gtk_widget_set_sensitive (w, FALSE); @@ -4218,7 +4292,8 @@ update_frame_tool_bar (FRAME_PTR f) GtkWidget *wbutton = NULL; GtkWidget *weventbox; Lisp_Object specified_file; - char *label = SSDATA (PROP (TOOL_BAR_ITEM_LABEL)); + const char *label = (STRINGP (PROP (TOOL_BAR_ITEM_LABEL)) + ? SSDATA (PROP (TOOL_BAR_ITEM_LABEL)) : ""); ti = gtk_toolbar_get_nth_item (GTK_TOOLBAR (wtoolbar), i); diff --git a/src/gtkutil.h b/src/gtkutil.h index 75620c54d10..9b796e1138c 100644 --- a/src/gtkutil.h +++ b/src/gtkutil.h @@ -38,14 +38,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Key for data that menu items hold. */ #define XG_ITEM_DATA "emacs_menuitem" -/* Button types in menus. */ -enum button_type -{ - BUTTON_TYPE_NONE, - BUTTON_TYPE_TOGGLE, - BUTTON_TYPE_RADIO -}; - /* This is a list node in a generic list implementation. */ typedef struct xg_list_node_ { @@ -82,48 +74,13 @@ typedef struct xg_menu_item_cb_data_ } xg_menu_item_cb_data; -/* Used to specify menus and dialogs. - This is an adaption from lwlib for Gtk so we can use more of the same - code as lwlib in xmenu.c. */ -typedef struct _widget_value -{ - /* name of widget */ - Lisp_Object lname; - char *name; - /* value (meaning depend on widget type) */ - char *value; - /* keyboard equivalent. no implications for XtTranslations */ - Lisp_Object lkey; - char *key; - /* Help string or nil if none. - GC finds this string through the frame's menu_bar_vector - or through menu_items. */ - Lisp_Object help; - /* true if enabled */ - gint enabled; - /* true if selected */ - gint selected; - /* The type of a button. */ - enum button_type button_type; - /* Contents of the sub-widgets, also selected slot for checkbox */ - struct _widget_value *contents; - /* data passed to callback */ - gpointer call_data; - /* next one in the list */ - struct _widget_value *next; - - /* we resource the widget_value structures; this points to the next - one on the free list if this one has been deallocated. - */ - struct _widget_value *free_list; -} widget_value; - #ifdef HAVE_GTK_FILE_SELECTION_NEW extern int use_old_gtk_file_dialog; #endif +struct _widget_value; -extern widget_value *malloc_widget_value (void); -extern void free_widget_value (widget_value *); +extern struct _widget_value *malloc_widget_value (void); +extern void free_widget_value (struct _widget_value *); extern int xg_uses_old_file_dialog (void); @@ -138,14 +95,14 @@ extern char *xg_get_font_name (FRAME_PTR f, const char *); extern GtkWidget *xg_create_widget (const char *type, const char *name, FRAME_PTR f, - widget_value *val, + struct _widget_value *val, GCallback select_cb, GCallback deactivate_cb, GCallback hightlight_cb); extern void xg_modify_menubar_widgets (GtkWidget *menubar, FRAME_PTR f, - widget_value *val, + struct _widget_value *val, int deep_p, GCallback select_cb, GCallback deactivate_cb, @@ -199,6 +156,9 @@ extern void x_wm_set_size_hint (FRAME_PTR f, long flags, int user_position); extern void xg_set_background_color (FRAME_PTR f, unsigned long bg); +extern int xg_check_special_colors (struct frame *f, + const char *color_name, + XColor *color); extern void xg_set_frame_icon (FRAME_PTR f, Pixmap icon_pixmap, diff --git a/src/image.c b/src/image.c index 916fcfe8178..499cbf298c1 100644 --- a/src/image.c +++ b/src/image.c @@ -583,7 +583,7 @@ Lisp_Object Qxbm; Lisp_Object QCascent, QCmargin, QCrelief, Qcount, Qextension_data; Lisp_Object QCconversion, QCcolor_symbols, QCheuristic_mask; -Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask; +Lisp_Object QCindex, QCmatrix, QCcolor_adjustment, QCmask, QCgeometry, QCcrop, QCrotation; /* Other symbols. */ @@ -1735,7 +1735,6 @@ lookup_image (struct frame *f, Lisp_Object spec) struct image_cache *c; struct image *img; unsigned hash; - struct gcpro gcpro1; EMACS_TIME now; /* F must be a window-system frame, and SPEC must be a valid image @@ -1745,8 +1744,6 @@ lookup_image (struct frame *f, Lisp_Object spec) c = FRAME_IMAGE_CACHE (f); - GCPRO1 (spec); - /* Look up SPEC in the hash table of the image cache. */ hash = sxhash (spec, 0); img = search_image_cache (f, spec, hash); @@ -1838,8 +1835,6 @@ lookup_image (struct frame *f, Lisp_Object spec) EMACS_GET_TIME (now); img->timestamp = EMACS_SECS (now); - UNGCPRO; - /* Value is the image id. */ return img->id; } @@ -2179,16 +2174,13 @@ Lisp_Object x_find_image_file (Lisp_Object file) { Lisp_Object file_found, search_path; - struct gcpro gcpro1, gcpro2; int fd; - file_found = Qnil; /* TODO I think this should use something like image-load-path instead. Unfortunately, that can contain non-string elements. */ search_path = Fcons (Fexpand_file_name (build_string ("images"), Vdata_directory), Vx_bitmap_file_path); - GCPRO2 (file_found, search_path); /* Try to find FILE in data-directory/images, then x-bitmap-file-path. */ fd = openp (search_path, file, Qnil, &file_found, Qnil); @@ -2201,7 +2193,6 @@ x_find_image_file (Lisp_Object file) close (fd); } - UNGCPRO; return file_found; } @@ -2875,14 +2866,11 @@ xbm_load (struct frame *f, struct image *img) Lisp_Object file; unsigned char *contents; int size; - struct gcpro gcpro1; file = x_find_image_file (file_name); - GCPRO1 (file); if (!STRINGP (file)) { image_error ("Cannot find image file `%s'", file_name, Qnil); - UNGCPRO; return 0; } @@ -2890,12 +2878,10 @@ xbm_load (struct frame *f, struct image *img) if (contents == NULL) { image_error ("Error loading XBM image `%s'", img->spec, Qnil); - UNGCPRO; return 0; } success_p = xbm_load_image (f, img, contents, contents + size); - UNGCPRO; } else { @@ -3456,12 +3442,31 @@ xpm_load (struct frame *f, struct image *img) CONSP (tail); ++i, tail = XCDR (tail)) { - Lisp_Object name = XCAR (XCAR (tail)); - Lisp_Object color = XCDR (XCAR (tail)); - xpm_syms[i].name = (char *) alloca (SCHARS (name) + 1); - strcpy (xpm_syms[i].name, SDATA (name)); - xpm_syms[i].value = (char *) alloca (SCHARS (color) + 1); - strcpy (xpm_syms[i].value, SDATA (color)); + Lisp_Object name; + Lisp_Object color; + + if (!CONSP (XCAR (tail))) + { + xpm_syms[i].name = ""; + xpm_syms[i].value = ""; + continue; + } + name = XCAR (XCAR (tail)); + color = XCDR (XCAR (tail)); + if (STRINGP (name)) + { + xpm_syms[i].name = (char *) alloca (SCHARS (name) + 1); + strcpy (xpm_syms[i].name, SDATA (name)); + } + else + xpm_syms[i].name = ""; + if (STRINGP (color)) + { + xpm_syms[i].value = (char *) alloca (SCHARS (color) + 1); + strcpy (xpm_syms[i].value, SDATA (color)); + } + else + xpm_syms[i].value = ""; } } @@ -3487,6 +3492,9 @@ xpm_load (struct frame *f, struct image *img) if (!STRINGP (file)) { image_error ("Cannot find image file `%s'", specified_file, Qnil); +#ifdef ALLOC_XPM_COLORS + xpm_free_color_cache (); +#endif return 0; } @@ -3505,6 +3513,14 @@ xpm_load (struct frame *f, struct image *img) else { Lisp_Object buffer = image_spec_value (img->spec, QCdata, NULL); + if (!STRINGP (buffer)) + { + image_error ("Invalid image data `%s'", buffer, Qnil); +#ifdef ALLOC_XPM_COLORS + xpm_free_color_cache (); +#endif + return 0; + } #ifdef HAVE_NTGUI /* XpmCreatePixmapFromBuffer is not available in the Windows port of libxpm. But XpmCreateImageFromBuffer almost does what we want. */ @@ -4071,14 +4087,11 @@ xpm_load (struct frame *f, Lisp_Object file; unsigned char *contents; int size; - struct gcpro gcpro1; file = x_find_image_file (file_name); - GCPRO1 (file); if (!STRINGP (file)) { image_error ("Cannot find image file `%s'", file_name, Qnil); - UNGCPRO; return 0; } @@ -4086,19 +4099,22 @@ xpm_load (struct frame *f, if (contents == NULL) { image_error ("Error loading XPM image `%s'", img->spec, Qnil); - UNGCPRO; return 0; } success_p = xpm_load_image (f, img, contents, contents + size); xfree (contents); - UNGCPRO; } else { Lisp_Object data; data = image_spec_value (img->spec, QCdata, NULL); + if (!STRINGP (data)) + { + image_error ("Invalid image data `%s'", data, Qnil); + return 0; + } success_p = xpm_load_image (f, img, SDATA (data), SDATA (data) + SBYTES (data)); } @@ -5090,14 +5106,11 @@ pbm_load (struct frame *f, struct image *img) XImagePtr ximg; Lisp_Object file, specified_file; enum {PBM_MONO, PBM_GRAY, PBM_COLOR} type; - struct gcpro gcpro1; unsigned char *contents = NULL; unsigned char *end, *p; int size; specified_file = image_spec_value (img->spec, QCfile, NULL); - file = Qnil; - GCPRO1 (file); if (STRINGP (specified_file)) { @@ -5105,7 +5118,6 @@ pbm_load (struct frame *f, struct image *img) if (!STRINGP (file)) { image_error ("Cannot find image file `%s'", specified_file, Qnil); - UNGCPRO; return 0; } @@ -5113,7 +5125,6 @@ pbm_load (struct frame *f, struct image *img) if (contents == NULL) { image_error ("Error reading `%s'", file, Qnil); - UNGCPRO; return 0; } @@ -5124,6 +5135,11 @@ pbm_load (struct frame *f, struct image *img) { Lisp_Object data; data = image_spec_value (img->spec, QCdata, NULL); + if (!STRINGP (data)) + { + image_error ("Invalid image data `%s'", data, Qnil); + return 0; + } p = SDATA (data); end = p + SBYTES (data); } @@ -5134,7 +5150,6 @@ pbm_load (struct frame *f, struct image *img) image_error ("Not a PBM image: `%s'", img->spec, Qnil); error: xfree (contents); - UNGCPRO; return 0; } @@ -5336,7 +5351,6 @@ pbm_load (struct frame *f, struct image *img) img->width = width; img->height = height; */ - UNGCPRO; xfree (contents); return 1; } @@ -5576,7 +5590,6 @@ png_load (struct frame *f, struct image *img) Lisp_Object specified_data; int x, y, i; XImagePtr ximg, mask_img = NULL; - struct gcpro gcpro1; png_struct *png_ptr = NULL; png_info *info_ptr = NULL, *end_info = NULL; FILE *volatile fp = NULL; @@ -5593,8 +5606,6 @@ png_load (struct frame *f, struct image *img) /* Find out what file to load. */ specified_file = image_spec_value (img->spec, QCfile, NULL); specified_data = image_spec_value (img->spec, QCdata, NULL); - file = Qnil; - GCPRO1 (file); if (NILP (specified_data)) { @@ -5602,7 +5613,6 @@ png_load (struct frame *f, struct image *img) if (!STRINGP (file)) { image_error ("Cannot find image file `%s'", specified_file, Qnil); - UNGCPRO; return 0; } @@ -5611,7 +5621,6 @@ png_load (struct frame *f, struct image *img) if (!fp) { image_error ("Cannot open image file `%s'", file, Qnil); - UNGCPRO; return 0; } @@ -5620,13 +5629,18 @@ png_load (struct frame *f, struct image *img) || fn_png_sig_cmp (sig, 0, sizeof sig)) { image_error ("Not a PNG file: `%s'", file, Qnil); - UNGCPRO; fclose (fp); return 0; } } else { + if (!STRINGP (specified_data)) + { + image_error ("Invalid image data `%s'", specified_data, Qnil); + return 0; + } + /* Read from memory. */ tbr.bytes = SDATA (specified_data); tbr.len = SBYTES (specified_data); @@ -5637,7 +5651,6 @@ png_load (struct frame *f, struct image *img) || fn_png_sig_cmp (tbr.bytes, 0, sizeof sig)) { image_error ("Not a PNG image: `%s'", img->spec, Qnil); - UNGCPRO; return 0; } @@ -5653,7 +5666,6 @@ png_load (struct frame *f, struct image *img) if (!png_ptr) { if (fp) fclose (fp); - UNGCPRO; return 0; } @@ -5663,7 +5675,6 @@ png_load (struct frame *f, struct image *img) { fn_png_destroy_read_struct (&png_ptr, NULL, NULL); if (fp) fclose (fp); - UNGCPRO; return 0; } @@ -5673,7 +5684,6 @@ png_load (struct frame *f, struct image *img) { fn_png_destroy_read_struct (&png_ptr, &info_ptr, NULL); if (fp) fclose (fp); - UNGCPRO; return 0; } @@ -5687,7 +5697,6 @@ png_load (struct frame *f, struct image *img) xfree (pixels); xfree (rows); if (fp) fclose (fp); - UNGCPRO; return 0; } @@ -5912,7 +5921,6 @@ png_load (struct frame *f, struct image *img) x_destroy_x_image (mask_img); } - UNGCPRO; return 1; } @@ -6313,13 +6321,10 @@ jpeg_load (struct frame *f, struct image *img) int rc; unsigned long *colors; int width, height; - struct gcpro gcpro1; /* Open the JPEG file. */ specified_file = image_spec_value (img->spec, QCfile, NULL); specified_data = image_spec_value (img->spec, QCdata, NULL); - file = Qnil; - GCPRO1 (file); if (NILP (specified_data)) { @@ -6327,7 +6332,6 @@ jpeg_load (struct frame *f, struct image *img) if (!STRINGP (file)) { image_error ("Cannot find image file `%s'", specified_file, Qnil); - UNGCPRO; return 0; } @@ -6335,10 +6339,14 @@ jpeg_load (struct frame *f, struct image *img) if (fp == NULL) { image_error ("Cannot open `%s'", file, Qnil); - UNGCPRO; return 0; } } + else if (!STRINGP (specified_data)) + { + image_error ("Invalid image data `%s'", specified_data, Qnil); + return 0; + } /* Customize libjpeg's error handling to call my_error_exit when an error is detected. This function will perform a longjmp. @@ -6367,8 +6375,6 @@ jpeg_load (struct frame *f, struct image *img) /* Free pixmap and colors. */ x_clear_image (f, img); - - UNGCPRO; return 0; } @@ -6466,7 +6472,6 @@ jpeg_load (struct frame *f, struct image *img) /* Put the image into the pixmap. */ x_put_x_image (f, ximg, img->pixmap, width, height); x_destroy_x_image (ximg); - UNGCPRO; return 1; } @@ -6741,14 +6746,11 @@ tiff_load (struct frame *f, struct image *img) uint32 *buf; int rc, rc2; XImagePtr ximg; - struct gcpro gcpro1; tiff_memory_source memsrc; Lisp_Object image; specified_file = image_spec_value (img->spec, QCfile, NULL); specified_data = image_spec_value (img->spec, QCdata, NULL); - file = Qnil; - GCPRO1 (file); fn_TIFFSetErrorHandler (tiff_error_handler); fn_TIFFSetWarningHandler (tiff_warning_handler); @@ -6760,7 +6762,6 @@ tiff_load (struct frame *f, struct image *img) if (!STRINGP (file)) { image_error ("Cannot find image file `%s'", specified_file, Qnil); - UNGCPRO; return 0; } @@ -6770,12 +6771,17 @@ tiff_load (struct frame *f, struct image *img) if (tiff == NULL) { image_error ("Cannot open `%s'", file, Qnil); - UNGCPRO; return 0; } } else { + if (!STRINGP (specified_data)) + { + image_error ("Invalid image data `%s'", specified_data, Qnil); + return 0; + } + /* Memory source! */ memsrc.bytes = SDATA (specified_data); memsrc.len = SBYTES (specified_data); @@ -6794,7 +6800,6 @@ tiff_load (struct frame *f, struct image *img) if (!tiff) { image_error ("Cannot open memory source for `%s'", img->spec, Qnil); - UNGCPRO; return 0; } } @@ -6808,7 +6813,6 @@ tiff_load (struct frame *f, struct image *img) image_error ("Invalid image number `%s' in image `%s'", image, img->spec); fn_TIFFClose (tiff); - UNGCPRO; return 0; } } @@ -6822,7 +6826,6 @@ tiff_load (struct frame *f, struct image *img) { image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil); fn_TIFFClose (tiff); - UNGCPRO; return 0; } @@ -6844,7 +6847,6 @@ tiff_load (struct frame *f, struct image *img) { image_error ("Error reading TIFF image `%s'", img->spec, Qnil); xfree (buf); - UNGCPRO; return 0; } @@ -6852,7 +6854,6 @@ tiff_load (struct frame *f, struct image *img) if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap)) { xfree (buf); - UNGCPRO; return 0; } @@ -6893,7 +6894,6 @@ tiff_load (struct frame *f, struct image *img) x_destroy_x_image (ximg); xfree (buf); - UNGCPRO; return 1; } @@ -7099,7 +7099,6 @@ gif_load (struct frame *f, struct image *img) ColorMapObject *gif_color_map; unsigned long pixel_colors[256]; GifFileType *gif; - struct gcpro gcpro1; Lisp_Object image; int ino, image_height, image_width; gif_memory_source memsrc; @@ -7107,8 +7106,6 @@ gif_load (struct frame *f, struct image *img) specified_file = image_spec_value (img->spec, QCfile, NULL); specified_data = image_spec_value (img->spec, QCdata, NULL); - file = Qnil; - GCPRO1 (file); if (NILP (specified_data)) { @@ -7116,7 +7113,6 @@ gif_load (struct frame *f, struct image *img) if (!STRINGP (file)) { image_error ("Cannot find image file `%s'", specified_file, Qnil); - UNGCPRO; return 0; } @@ -7126,12 +7122,17 @@ gif_load (struct frame *f, struct image *img) if (gif == NULL) { image_error ("Cannot open `%s'", file, Qnil); - UNGCPRO; return 0; } } else { + if (!STRINGP (specified_data)) + { + image_error ("Invalid image data `%s'", specified_data, Qnil); + return 0; + } + /* Read from memory! */ current_gif_memory_src = &memsrc; memsrc.bytes = SDATA (specified_data); @@ -7143,7 +7144,6 @@ gif_load (struct frame *f, struct image *img) if (!gif) { image_error ("Cannot open memory source `%s'", img->spec, Qnil); - UNGCPRO; return 0; } } @@ -7153,7 +7153,6 @@ gif_load (struct frame *f, struct image *img) { image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil); fn_DGifCloseFile (gif); - UNGCPRO; return 0; } @@ -7163,7 +7162,6 @@ gif_load (struct frame *f, struct image *img) { image_error ("Error reading `%s'", img->spec, Qnil); fn_DGifCloseFile (gif); - UNGCPRO; return 0; } @@ -7174,7 +7172,6 @@ gif_load (struct frame *f, struct image *img) image_error ("Invalid image number `%s' in image `%s'", image, img->spec); fn_DGifCloseFile (gif); - UNGCPRO; return 0; } @@ -7196,7 +7193,6 @@ gif_load (struct frame *f, struct image *img) { image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil); fn_DGifCloseFile (gif); - UNGCPRO; return 0; } @@ -7204,7 +7200,6 @@ gif_load (struct frame *f, struct image *img) if (!x_create_x_image_and_pixmap (f, width, height, 0, &ximg, &img->pixmap)) { fn_DGifCloseFile (gif); - UNGCPRO; return 0; } @@ -7323,7 +7318,6 @@ gif_load (struct frame *f, struct image *img) x_put_x_image (f, ximg, img->pixmap, width, height); x_destroy_x_image (ximg); - UNGCPRO; return 1; } @@ -7342,6 +7336,522 @@ gif_load (struct frame *f, struct image *img) #endif /* HAVE_GIF */ +/*********************************************************************** + imagemagick +***********************************************************************/ +#if defined (HAVE_IMAGEMAGICK) +Lisp_Object Vimagemagick_render_type; + +/* The symbol `imagemagick' identifying images of this type. */ + +Lisp_Object Qimagemagick; +Lisp_Object Vimagemagick_render_type; + +/* Indices of image specification fields in imagemagick_format, below. */ + +enum imagemagick_keyword_index + { + IMAGEMAGICK_TYPE, + IMAGEMAGICK_DATA, + IMAGEMAGICK_FILE, + IMAGEMAGICK_ASCENT, + IMAGEMAGICK_MARGIN, + IMAGEMAGICK_RELIEF, + IMAGEMAGICK_ALGORITHM, + IMAGEMAGICK_HEURISTIC_MASK, + IMAGEMAGICK_MASK, + IMAGEMAGICK_BACKGROUND, + IMAGEMAGICK_HEIGHT, + IMAGEMAGICK_WIDTH, + IMAGEMAGICK_ROTATION, + IMAGEMAGICK_CROP, + IMAGEMAGICK_LAST + }; + +/* Vector of image_keyword structures describing the format + of valid user-defined image specifications. */ + +static struct image_keyword imagemagick_format[IMAGEMAGICK_LAST] = + { + {":type", IMAGE_SYMBOL_VALUE, 1}, + {":data", IMAGE_STRING_VALUE, 0}, + {":file", IMAGE_STRING_VALUE, 0}, + {":ascent", IMAGE_ASCENT_VALUE, 0}, + {":margin", IMAGE_POSITIVE_INTEGER_VALUE_OR_PAIR, 0}, + {":relief", IMAGE_INTEGER_VALUE, 0}, + {":conversion", IMAGE_DONT_CHECK_VALUE_TYPE, 0}, + {":heuristic-mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}, + {":mask", IMAGE_DONT_CHECK_VALUE_TYPE, 0}, + {":background", IMAGE_STRING_OR_NIL_VALUE, 0}, + {":height", IMAGE_INTEGER_VALUE, 0}, + {":width", IMAGE_INTEGER_VALUE, 0}, + {":rotation", IMAGE_NUMBER_VALUE, 0}, + {":crop", IMAGE_DONT_CHECK_VALUE_TYPE, 0} + }; +/* Free X resources of imagemagick image IMG which is used on frame F. */ + +static void +imagemagick_clear_image (struct frame *f, + struct image *img) +{ + x_clear_image (f, img); +} + + + +/* Return non-zero if OBJECT is a valid IMAGEMAGICK image specification. Do + this by calling parse_image_spec and supplying the keywords that + identify the IMAGEMAGICK format. */ + +static int +imagemagick_image_p (Lisp_Object object) +{ + struct image_keyword fmt[IMAGEMAGICK_LAST]; + memcpy (fmt, imagemagick_format, sizeof fmt); + + if (!parse_image_spec (object, fmt, IMAGEMAGICK_LAST, Qimagemagick)) + return 0; + + /* Must specify either the :data or :file keyword. */ + return fmt[IMAGEMAGICK_FILE].count + fmt[IMAGEMAGICK_DATA].count == 1; +} + +/* The GIF library also defines DrawRectangle, but its never used in Emacs. + Therefore rename the function so it doesnt collide with ImageMagick. */ +#define DrawRectangle DrawRectangleGif +#include <wand/MagickWand.h> + +/* imagemagick_load_image is a helper function for imagemagick_load, + which does the actual loading given contents and size, apart from + frame and image structures, passed from imagemagick_load. + + Uses librimagemagick to do most of the image processing. + + non-zero when successful. +*/ + +static int +imagemagick_load_image (/* Pointer to emacs frame structure. */ + struct frame *f, + /* Pointer to emacs image structure. */ + struct image *img, + /* String containing the IMAGEMAGICK data to + be parsed. */ + unsigned char *contents, + /* Size of data in bytes. */ + unsigned int size, + /* Filename, either pass filename or + contents/size. */ + unsigned char *filename) +{ + unsigned long width; + unsigned long height; + + MagickBooleanType + status; + + XImagePtr ximg; + Lisp_Object specified_bg; + XColor background; + int x; + int y; + + MagickWand *image_wand; + MagickWand *ping_wand; + PixelIterator *iterator; + PixelWand **pixels; + MagickPixelPacket pixel; + Lisp_Object image; + Lisp_Object value; + Lisp_Object crop, geometry; + long ino; + int desired_width, desired_height; + double rotation; + int imagemagick_rendermethod; + int pixelwidth; + ImageInfo *image_info; + ExceptionInfo *exception; + Image * im_image; + + + /* Handle image index for image types who can contain more than one + image. Interface :index is same as for GIF. First we "ping" the + image to see how many sub-images it contains. Pinging is faster + than loading the image to find out things about it. */ + image = image_spec_value (img->spec, QCindex, NULL); + ino = INTEGERP (image) ? XFASTINT (image) : 0; + ping_wand = NewMagickWand (); + MagickSetResolution (ping_wand, 2, 2); + if (filename != NULL) + { + status = MagickPingImage (ping_wand, filename); + } + else + { + status = MagickPingImageBlob (ping_wand, contents, size); + } + + if (ino >= MagickGetNumberImages (ping_wand)) + { + image_error ("Invalid image number `%s' in image `%s'", + image, img->spec); + DestroyMagickWand (ping_wand); + return 0; + } + + if (MagickGetNumberImages(ping_wand) > 1) + img->data.lisp_val = + Fcons (Qcount, + Fcons (make_number (MagickGetNumberImages (ping_wand)), + img->data.lisp_val)); + + DestroyMagickWand (ping_wand); + /* Now, after pinging, we know how many images are inside the + file. If its not a bundle, just one. */ + + if (filename != NULL) + { + image_info = CloneImageInfo ((ImageInfo *) NULL); + (void) strcpy (image_info->filename, filename); + image_info->number_scenes = 1; + image_info->scene = ino; + exception = AcquireExceptionInfo (); + + im_image = ReadImage (image_info, exception); + CatchException (exception); + + image_wand = NewMagickWandFromImage (im_image); + } + else + { + image_wand = NewMagickWand (); + status = MagickReadImageBlob (image_wand, contents, size); + } + image_error ("im read failed", Qnil, Qnil); + if (status == MagickFalse) goto imagemagick_error; + + /* If width and/or height is set in the display spec assume we want + to scale to those values. if either h or w is unspecified, the + unspecified should be calculated from the specified to preserve + aspect ratio. */ + + value = image_spec_value (img->spec, QCwidth, NULL); + desired_width = (INTEGERP (value) ? XFASTINT (value) : -1); + value = image_spec_value (img->spec, QCheight, NULL); + desired_height = (INTEGERP (value) ? XFASTINT (value) : -1); + + height = MagickGetImageHeight (image_wand); + width = MagickGetImageWidth (image_wand); + + if(desired_width != -1 && desired_height == -1) + { + /* w known, calculate h. */ + desired_height = (double) desired_width / width * height; + } + if(desired_width == -1 && desired_height != -1) + { + /* h known, calculate w. */ + desired_width = (double) desired_height / height * width; + } + if(desired_width != -1 && desired_height != -1) + { + status = MagickScaleImage (image_wand, desired_width, desired_height); + if (status == MagickFalse) + { + image_error ("Imagemagick scale failed", Qnil, Qnil); + goto imagemagick_error; + } + } + + + /* crop behaves similar to image slicing in Emacs but is more memory + efficient. */ + crop = image_spec_value (img->spec, QCcrop, NULL); + + if (CONSP (crop) && INTEGERP (XCAR (crop))) + { + /* After some testing, it seems MagickCropImage is the fastest + crop function in ImageMagick. This crop function seems to do + less copying than the alternatives, but it still reads the + entire image into memory before croping, which is aparently + difficult to avoid when using imagemagick. */ + + int w, h, x, y; + w = XFASTINT (XCAR (crop)); + crop = XCDR (crop); + if (CONSP (crop) && INTEGERP (XCAR (crop))) + { + h = XFASTINT (XCAR (crop)); + crop = XCDR (crop); + if (CONSP (crop) && INTEGERP (XCAR (crop))) + { + x = XFASTINT (XCAR (crop)); + crop = XCDR (crop); + if (CONSP (crop) && INTEGERP (XCAR (crop))) + { + y = XFASTINT (XCAR (crop)); + MagickCropImage (image_wand, w, h, x, y); + } + } + } + } + + /* Furthermore :rotation. we need background color and angle for + rotation. */ + /* + TODO background handling for rotation specified_bg = + image_spec_value (img->spec, QCbackground, NULL); if (!STRINGP + (specified_bg). */ + value = image_spec_value (img->spec, QCrotation, NULL); + if (FLOATP (value)) + { + PixelWand* background = NewPixelWand (); + PixelSetColor (background, "#ffffff");/*TODO remove hardcode*/ + + rotation = extract_float (value); + + status = MagickRotateImage (image_wand, background, rotation); + DestroyPixelWand (background); + if (status == MagickFalse) + { + image_error ("Imagemagick image rotate failed", Qnil, Qnil); + goto imagemagick_error; + } + } + + /* Finaly we are done manipulating the image, figure out resulting + width, height, and then transfer ownerwship to Emacs. */ + height = MagickGetImageHeight (image_wand); + width = MagickGetImageWidth (image_wand); + if (status == MagickFalse) + { + image_error ("Imagemagick image get size failed", Qnil, Qnil); + goto imagemagick_error; + } + + if (! check_image_size (f, width, height)) + { + image_error ("Invalid image size (see `max-image-size')", Qnil, Qnil); + goto imagemagick_error; + } + + /* We can now get a valid pixel buffer from the imagemagick file, if all + went ok. */ + + init_color_table (); + imagemagick_rendermethod = (INTEGERP (Vimagemagick_render_type) + ? XFASTINT (Vimagemagick_render_type) : 0); + if (imagemagick_rendermethod == 0) + { + /* Try to create a x pixmap to hold the imagemagick pixmap. */ + if (!x_create_x_image_and_pixmap (f, width, height, 0, + &ximg, &img->pixmap)) + { + image_error("Imagemagick X bitmap allocation failure", Qnil, Qnil); + goto imagemagick_error; + } + + /* Copy imagegmagick image to x with primitive yet robust pixel + pusher loop. This has been tested a lot with many different + images. */ + + /* Copy pixels from the imagemagick image structure to the x image map. */ + iterator = NewPixelIterator (image_wand); + if (iterator == (PixelIterator *) NULL) + { + image_error ("Imagemagick pixel iterator creation failed", + Qnil, Qnil); + goto imagemagick_error; + } + + for (y = 0; y < (long) MagickGetImageHeight (image_wand); y++) + { + pixels = PixelGetNextIteratorRow (iterator, &width); + if (pixels == (PixelWand **) NULL) + break; + for (x = 0; x < (long) width; x++) + { + PixelGetMagickColor (pixels[x], &pixel); + XPutPixel (ximg, x, y, + lookup_rgb_color (f, + pixel.red, + pixel.green, + pixel.blue)); + } + } + DestroyPixelIterator (iterator); + } + + if (imagemagick_rendermethod == 1) + { + /* Magicexportimage is normaly faster than pixelpushing. This + method is also well tested. Some aspects of this method are + ad-hoc and needs to be more researched. */ + int imagedepth = 24;/*MagickGetImageDepth(image_wand);*/ + char* exportdepth = imagedepth <= 8 ? "I" : "BGRP";/*"RGBP";*/ + /* Try to create a x pixmap to hold the imagemagick pixmap. */ + if (!x_create_x_image_and_pixmap (f, width, height, imagedepth, + &ximg, &img->pixmap)) + { + image_error("Imagemagick X bitmap allocation failure", Qnil, Qnil); + goto imagemagick_error; + } + + + /* Oddly, the below code doesnt seem to work:*/ + /* switch(ximg->bitmap_unit){ */ + /* case 8: */ + /* pixelwidth=CharPixel; */ + /* break; */ + /* case 16: */ + /* pixelwidth=ShortPixel; */ + /* break; */ + /* case 32: */ + /* pixelwidth=LongPixel; */ + /* break; */ + /* } */ + /* + Here im just guessing the format of the bitmap. + happens to work fine for: + - bw djvu images + on rgb display. + seems about 3 times as fast as pixel pushing(not carefully measured) + */ + pixelwidth = CharPixel;/*??? TODO figure out*/ +#ifdef HAVE_MAGICKEXPORTIMAGEPIXELS + MagickExportImagePixels (image_wand, + 0, 0, + width, height, + exportdepth, + pixelwidth, + /*&(img->pixmap));*/ + ximg->data); +#else + image_error ("You dont have MagickExportImagePixels, upgrade ImageMagick!", + Qnil, Qnil); +#endif + } + + +#ifdef COLOR_TABLE_SUPPORT + /* Remember colors allocated for this image. */ + img->colors = colors_in_color_table (&img->ncolors); + free_color_table (); +#endif /* COLOR_TABLE_SUPPORT */ + + + img->width = width; + img->height = height; + + /* Put the image into the pixmap, then free the X image and its + buffer. */ + x_put_x_image (f, ximg, img->pixmap, width, height); + x_destroy_x_image (ximg); + + + /* Final cleanup. image_wand should be the only resource left. */ + DestroyMagickWand (image_wand); + + return 1; + + imagemagick_error: + /* TODO more cleanup. */ + image_error ("Error parsing IMAGEMAGICK image `%s'", img->spec, Qnil); + return 0; +} + + +/* Load IMAGEMAGICK image IMG for use on frame F. Value is non-zero if + successful. this function will go into the imagemagick_type structure, and + the prototype thus needs to be compatible with that structure. */ + +static int +imagemagick_load (struct frame *f, + struct image *img) +{ + int success_p = 0; + Lisp_Object file_name; + + /* If IMG->spec specifies a file name, create a non-file spec from it. */ + file_name = image_spec_value (img->spec, QCfile, NULL); + if (STRINGP (file_name)) + { + Lisp_Object file; + + file = x_find_image_file (file_name); + if (!STRINGP (file)) + { + image_error ("Cannot find image file `%s'", file_name, Qnil); + return 0; + } + success_p = imagemagick_load_image (f, img, 0, 0, SDATA (file)); + } + /* Else its not a file, its a lisp object. Load the image from a + lisp object rather than a file. */ + else + { + Lisp_Object data; + + data = image_spec_value (img->spec, QCdata, NULL); + if (!STRINGP (data)) + { + image_error ("Invalid image data `%s'", data, Qnil); + return 0; + } + success_p = imagemagick_load_image (f, img, SDATA (data), + SBYTES (data), NULL); + } + + return success_p; +} + +/* Structure describing the image type `imagemagick'. Its the same + type of structure defined for all image formats, handled by Emacs + image functions. See struct image_type in dispextern.h. */ + +static struct image_type imagemagick_type = + { + /* An identifier showing that this is an image structure for the + IMAGEMAGICK format. */ + &Qimagemagick, + /* Handle to a function that can be used to identify a IMAGEMAGICK + file. */ + imagemagick_image_p, + /* Handle to function used to load a IMAGEMAGICK file. */ + imagemagick_load, + /* Handle to function to free resources for IMAGEMAGICK. */ + imagemagick_clear_image, + /* An internal field to link to the next image type in a list of + image types, will be filled in when registering the format. */ + NULL + }; + + + + +DEFUN ("imagemagick-types", Fimagemagick_types, Simagemagick_types, 0, 0, 0, + doc: /* Return image file types supported by ImageMagick. +Since ImageMagick recognizes a lot of file-types that clash with Emacs, +such as .c, we want to be able to alter the list at the lisp level. */) + (void) +{ + Lisp_Object typelist = Qnil; + unsigned long numf; + ExceptionInfo ex; + char **imtypes = GetMagickList ("*", &numf, &ex); + int i; + Lisp_Object Qimagemagicktype; + for (i = 0; i < numf; i++) + { + Qimagemagicktype = intern (imtypes[i]); + typelist = Fcons (Qimagemagicktype, typelist); + } + return typelist; +} + +#endif /* defined (HAVE_IMAGEMAGICK) */ + + /*********************************************************************** SVG @@ -7534,14 +8044,11 @@ svg_load (struct frame *f, struct image *img) Lisp_Object file; unsigned char *contents; int size; - struct gcpro gcpro1; file = x_find_image_file (file_name); - GCPRO1 (file); if (!STRINGP (file)) { image_error ("Cannot find image file `%s'", file_name, Qnil); - UNGCPRO; return 0; } @@ -7550,13 +8057,11 @@ svg_load (struct frame *f, struct image *img) if (contents == NULL) { image_error ("Error loading SVG image `%s'", img->spec, Qnil); - UNGCPRO; return 0; } /* If the file was slurped into memory properly, parse it. */ success_p = svg_load_image (f, img, contents, size); xfree (contents); - UNGCPRO; } /* Else its not a file, its a lisp object. Load the image from a lisp object rather than a file. */ @@ -7565,6 +8070,11 @@ svg_load (struct frame *f, struct image *img) Lisp_Object data; data = image_spec_value (img->spec, QCdata, NULL); + if (!STRINGP (data)) + { + image_error ("Invalid image data `%s'", data, Qnil); + return 0; + } success_p = svg_load_image (f, img, SDATA (data), SBYTES (data)); } @@ -7864,7 +8374,6 @@ gs_load (struct frame *f, struct image *img) { char buffer[100]; Lisp_Object window_and_pixmap_id = Qnil, loader, pt_height, pt_width; - struct gcpro gcpro1, gcpro2; Lisp_Object frame; double in_width, in_height; Lisp_Object pixel_colors = Qnil; @@ -7874,10 +8383,10 @@ gs_load (struct frame *f, struct image *img) = 1/72 in, xdpi and ydpi are stored in the frame's X display info. */ pt_width = image_spec_value (img->spec, QCpt_width, NULL); - in_width = XFASTINT (pt_width) / 72.0; + in_width = INTEGERP (pt_width) ? XFASTINT (pt_width) / 72.0 : 0; img->width = in_width * FRAME_X_DISPLAY_INFO (f)->resx; pt_height = image_spec_value (img->spec, QCpt_height, NULL); - in_height = XFASTINT (pt_height) / 72.0; + in_height = INTEGERP (pt_height) ? XFASTINT (pt_height) / 72.0 : 0; img->height = in_height * FRAME_X_DISPLAY_INFO (f)->resy; if (!check_image_size (f, img->width, img->height)) @@ -7906,8 +8415,6 @@ gs_load (struct frame *f, struct image *img) if successful. We do not record_unwind_protect here because other places in redisplay like calling window scroll functions don't either. Let the Lisp loader use `unwind-protect' instead. */ - GCPRO2 (window_and_pixmap_id, pixel_colors); - sprintf (buffer, "%lu %lu", (unsigned long) FRAME_X_WINDOW (f), (unsigned long) img->pixmap); @@ -7928,7 +8435,6 @@ gs_load (struct frame *f, struct image *img) make_number (img->height), window_and_pixmap_id, pixel_colors); - UNGCPRO; return PROCESSP (img->data.lisp_val); } @@ -8117,6 +8623,16 @@ of `image-library-alist', which see). */) return CHECK_LIB_AVAILABLE (&svg_type, init_svg_functions, libraries); #endif +#if defined (HAVE_IMAGEMAGICK) + if (EQ (type, Qimagemagick)) + { + /* MagickWandGenesis() initalizes the imagemagick library. */ + MagickWandGenesis (); + return CHECK_LIB_AVAILABLE (&imagemagick_type, init_imagemagick_functions, + libraries); + } +#endif + #ifdef HAVE_GHOSTSCRIPT if (EQ (type, Qpostscript)) return CHECK_LIB_AVAILABLE (&gs_type, init_gs_functions, libraries); @@ -8202,6 +8718,12 @@ non-numeric, there is no explicit limit on the size of images. */); staticpro (&QCheuristic_mask); QCindex = intern_c_string (":index"); staticpro (&QCindex); + QCgeometry = intern (":geometry"); + staticpro (&QCgeometry); + QCcrop = intern (":crop"); + staticpro (&QCcrop); + QCrotation = intern (":rotation"); + staticpro (&QCrotation); QCmatrix = intern_c_string (":matrix"); staticpro (&QCmatrix); QCcolor_adjustment = intern_c_string (":color-adjustment"); @@ -8262,6 +8784,12 @@ non-numeric, there is no explicit limit on the size of images. */); ADD_IMAGE_TYPE (Qpng); #endif +#if defined (HAVE_IMAGEMAGICK) + Qimagemagick = intern ("imagemagick"); + staticpro (&Qimagemagick); + ADD_IMAGE_TYPE (Qimagemagick); +#endif + #if defined (HAVE_RSVG) Qsvg = intern_c_string ("svg"); staticpro (&Qsvg); @@ -8278,6 +8806,9 @@ non-numeric, there is no explicit limit on the size of images. */); #endif /* HAVE_RSVG */ defsubr (&Sinit_image_library); +#ifdef HAVE_IMAGEMAGICK + defsubr (&Simagemagick_types); +#endif defsubr (&Sclear_image_cache); defsubr (&Simage_flush); defsubr (&Simage_size); @@ -8308,6 +8839,11 @@ The value can also be nil, meaning the cache is never cleared. The function `clear-image-cache' disregards this variable. */); Vimage_cache_eviction_delay = make_number (300); +#ifdef HAVE_IMAGEMAGICK + DEFVAR_LISP ("imagemagick-render-type", &Vimagemagick_render_type, + doc: /* Choose between ImageMagick render methods. */); +#endif + } void diff --git a/src/insdel.c b/src/insdel.c index 00025808e37..2ccc0b8eaac 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -74,7 +74,7 @@ Lisp_Object combine_after_change_buffer; Lisp_Object Qinhibit_modification_hooks; -extern Lisp_Object Vselect_active_regions, Vsaved_region_selection; +extern Lisp_Object Vselect_active_regions, Vsaved_region_selection, Qonly; /* Check all markers in the current buffer, looking for something invalid. */ @@ -2050,10 +2050,12 @@ prepare_to_modify_buffer (EMACS_INT start, EMACS_INT end, #endif /* not CLASH_DETECTION */ /* If `select-active-regions' is non-nil, save the region text. */ - if (!NILP (Vselect_active_regions) - && !NILP (current_buffer->mark_active) - && !NILP (Vtransient_mark_mode) - && NILP (Vsaved_region_selection)) + if (!NILP (current_buffer->mark_active) + && NILP (Vsaved_region_selection) + && (EQ (Vselect_active_regions, Qonly) + ? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly) + : (!NILP (Vselect_active_regions) + && !NILP (Vtransient_mark_mode)))) { int b = XINT (Fmarker_position (current_buffer->mark)); int e = XINT (make_number (PT)); diff --git a/src/keyboard.c b/src/keyboard.c index aaa9306eded..95fc275ffe8 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -368,7 +368,7 @@ Lisp_Object Vselect_active_regions; Used by the `select-active-regions' feature. */ Lisp_Object Vsaved_region_selection; -Lisp_Object Qx_set_selection, QPRIMARY, Qlazy; +Lisp_Object Qx_set_selection, QPRIMARY, Qhandle_switch_frame; Lisp_Object Qself_insert_command; Lisp_Object Qforward_char; @@ -1493,6 +1493,11 @@ cancel_hourglass_unwind (Lisp_Object arg) } #endif +/* FIXME: This is wrong rather than test window-system, we should call + a new set-selection, which will then dispatch to x-set-selection, or + tty-set-selection, or w32-set-selection, ... */ +EXFUN (Fwindow_system, 1); + Lisp_Object command_loop_1 (void) { @@ -1790,27 +1795,36 @@ command_loop_1 (void) Vtransient_mark_mode = Qnil; else if (EQ (Vtransient_mark_mode, Qonly)) Vtransient_mark_mode = Qidentity; - else if (EQ (Vselect_active_regions, Qlazy) - ? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly) - : (!NILP (Vselect_active_regions) - && !NILP (Vtransient_mark_mode))) - { - /* Set window selection. If `select-active-regions' is - `lazy', only do it for temporarily active regions. */ - int beg = XINT (Fmarker_position (current_buffer->mark)); - int end = XINT (make_number (PT)); - if (beg < end) - call2 (Qx_set_selection, QPRIMARY, - make_buffer_string (beg, end, 0)); - else if (beg > end) - call2 (Qx_set_selection, QPRIMARY, - make_buffer_string (end, beg, 0)); - } if (!NILP (Vdeactivate_mark)) + /* If `select-active-regions' is non-nil, this call to + `deactivate-mark' also sets the PRIMARY selection. */ call0 (Qdeactivate_mark); - else if (current_buffer != prev_buffer || MODIFF != prev_modiff) - call1 (Vrun_hooks, intern ("activate-mark-hook")); + else + { + /* Even if not deactivating the mark, set PRIMARY if + `select-active-regions' is non-nil. */ + if (!NILP (Fwindow_system (Qnil)) + && (EQ (Vselect_active_regions, Qonly) + ? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly) + : (!NILP (Vselect_active_regions) + && !NILP (Vtransient_mark_mode))) + && !EQ (Vthis_command, Qhandle_switch_frame)) + { + int beg = XINT (Fmarker_position (current_buffer->mark)); + int end = XINT (make_number (PT)); + if (beg < end) + call2 (Qx_set_selection, QPRIMARY, + make_buffer_string (beg, end, 0)); + else if (beg > end) + call2 (Qx_set_selection, QPRIMARY, + make_buffer_string (end, beg, 0)); + /* Don't set empty selections. */ + } + + if (current_buffer != prev_buffer || MODIFF != prev_modiff) + call1 (Vrun_hooks, intern ("activate-mark-hook")); + } Vsaved_region_selection = Qnil; } @@ -4941,9 +4955,9 @@ char const *lispy_function_keys[] = 0, /* VK_OEM_102 0xE2 */ "ico-help", /* VK_ICO_HELP 0xE3 */ "ico-00", /* VK_ICO_00 0xE4 */ - 0, /* VK_PROCESSKEY 0xE5 */ + 0, /* VK_PROCESSKEY 0xE5 - used by IME */ "ico-clear", /* VK_ICO_CLEAR 0xE6 */ - "packet", /* VK_PACKET 0xE7 */ + 0, /* VK_PACKET 0xE7 - used to pass unicode chars */ 0, /* 0xE8 */ "reset", /* VK_OEM_RESET 0xE9 */ "jump", /* VK_OEM_JUMP 0xEA */ @@ -8285,12 +8299,15 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item) return 0; } else if (EQ (key, QChelp)) - /* `:help HELP-STRING'. */ - PROP (TOOL_BAR_ITEM_HELP) = value; + /* `:help HELP-STRING'. */ + PROP (TOOL_BAR_ITEM_HELP) = value; else if (EQ (key, QClabel)) { + const char *bad_label = "!!?GARBLED ITEM?!!"; /* `:label LABEL-STRING'. */ - PROP (TOOL_BAR_ITEM_LABEL) = value; + PROP (TOOL_BAR_ITEM_HELP) = STRINGP (value) + ? value + : make_string (bad_label, strlen (bad_label)); have_label = 1; } else if (EQ (key, QCfilter)) @@ -8328,39 +8345,41 @@ parse_tool_bar_item (Lisp_Object key, Lisp_Object item) Lisp_Object capt = PROP (TOOL_BAR_ITEM_CAPTION); const char *label = SYMBOLP (key) ? (char *) SDATA (SYMBOL_NAME (key)) : ""; const char *caption = STRINGP (capt) ? (char *) SDATA (capt) : ""; - char buf[64]; - EMACS_INT max_lbl = 2*tool_bar_max_label_size; + EMACS_INT max_lbl = 2 * tool_bar_max_label_size; + char *buf = (char *) xmalloc (max_lbl + 1); Lisp_Object new_lbl; + size_t caption_len = strlen (caption); - if (strlen (caption) < max_lbl && caption[0] != '\0') + if (caption_len <= max_lbl && caption[0] != '\0') { strcpy (buf, caption); - while (buf[0] != '\0' && buf[strlen (buf) -1] == '.') - buf[strlen (buf)-1] = '\0'; - if (strlen (buf) <= max_lbl) - caption = buf; + while (caption_len > 0 && buf[caption_len - 1] == '.') + caption_len--; + buf[caption_len] = '\0'; + label = caption = buf; } - if (strlen (caption) <= max_lbl) - label = caption; - if (strlen (label) <= max_lbl && label[0] != '\0') { int i; - if (label != buf) strcpy (buf, label); + if (label != buf) + strcpy (buf, label); - for (i = 0; i < strlen (buf); ++i) - { - if (buf[i] == '-') buf[i] = ' '; - } + for (i = 0; buf[i] != '\0'; ++i) + if (buf[i] == '-') + buf[i] = ' '; label = buf; } - else label = ""; + else + label = ""; new_lbl = Fupcase_initials (make_string (label, strlen (label))); if (SCHARS (new_lbl) <= tool_bar_max_label_size) PROP (TOOL_BAR_ITEM_LABEL) = new_lbl; + else + PROP (TOOL_BAR_ITEM_LABEL) = make_string ("", 0); + free (buf); } /* If got a filter apply it on binding. */ @@ -10333,13 +10352,12 @@ give to the command you invoke, if it asks for an argument. */) (Lisp_Object prefixarg) { Lisp_Object function; - char buf[40]; int saved_last_point_position; Lisp_Object saved_keys, saved_last_point_position_buffer; Lisp_Object bindings, value; struct gcpro gcpro1, gcpro2, gcpro3; #ifdef HAVE_WINDOW_SYSTEM - /* The call to Fcompleting_read wil start and cancel the hourglass, + /* The call to Fcompleting_read will start and cancel the hourglass, but if the hourglass was already scheduled, this means that no hourglass will be shown for the actual M-x command itself. So we restart it if it is already scheduled. Note that checking @@ -10352,31 +10370,9 @@ give to the command you invoke, if it asks for an argument. */) XVECTOR (this_command_keys)->contents); saved_last_point_position_buffer = last_point_position_buffer; saved_last_point_position = last_point_position; - buf[0] = 0; GCPRO3 (saved_keys, prefixarg, saved_last_point_position_buffer); - if (EQ (prefixarg, Qminus)) - strcpy (buf, "- "); - else if (CONSP (prefixarg) && XINT (XCAR (prefixarg)) == 4) - strcpy (buf, "C-u "); - else if (CONSP (prefixarg) && INTEGERP (XCAR (prefixarg))) - sprintf (buf, "%ld ", (long) XINT (XCAR (prefixarg))); - else if (INTEGERP (prefixarg)) - sprintf (buf, "%ld ", (long) XINT (prefixarg)); - - /* This isn't strictly correct if execute-extended-command - is bound to anything else. Perhaps it should use - this_command_keys? */ - strcat (buf, "M-x "); - - /* Prompt with buf, and then read a string, completing from and - restricting to the set of all defined commands. Don't provide - any initial input. Save the command read on the extended-command - history list. */ - function = Fcompleting_read (build_string (buf), - Vobarray, Qcommandp, - Qt, Qnil, Qextended_command_history, Qnil, - Qnil); + function = call0 (intern ("read-extended-command")); #ifdef HAVE_WINDOW_SYSTEM if (hstarted) start_hourglass (); @@ -11494,11 +11490,11 @@ init_keyboard (void) Emacs on SIGINT when there are no termcap frames on the controlling terminal. */ signal (SIGINT, interrupt_signal); -#if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS) +#ifndef DOS_NT /* For systems with SysV TERMIO, C-g is set up for both SIGINT and SIGQUIT and we can't tell which one it will give us. */ signal (SIGQUIT, interrupt_signal); -#endif /* HAVE_TERMIO */ +#endif /* not DOS_NT */ } /* Note SIGIO has been undef'd if FIONREAD is missing. */ #ifdef SIGIO @@ -11713,8 +11709,8 @@ syms_of_keyboard (void) staticpro (&Qx_set_selection); QPRIMARY = intern_c_string ("PRIMARY"); staticpro (&QPRIMARY); - Qlazy = intern_c_string ("lazy"); - staticpro (&Qlazy); + Qhandle_switch_frame = intern_c_string ("handle-switch-frame"); + staticpro (&Qhandle_switch_frame); Qinput_method_exit_on_first_char = intern_c_string ("input-method-exit-on-first-char"); staticpro (&Qinput_method_exit_on_first_char); @@ -12326,16 +12322,11 @@ and tool-bar buttons. */); DEFVAR_LISP ("select-active-regions", &Vselect_active_regions, doc: /* If non-nil, an active region automatically becomes the window selection. -This takes effect only when Transient Mark mode is enabled. - -If the value is `lazy', Emacs only sets the window selection during -`deactivate-mark'; unless the region is temporarily active -(e.g. mouse-drags or shift-selection), in which case it sets the -window selection after each command. +If the value is `only', only temporarily active regions (usually made +by mouse-dragging or shift-selection) set the window selection. -For other non-nil value, Emacs sets the window selection after every -command. */); - Vselect_active_regions = Qlazy; +This takes effect only when Transient Mark mode is enabled. */); + Vselect_active_regions = Qt; DEFVAR_LISP ("saved-region-selection", &Vsaved_region_selection, diff --git a/src/keyboard.h b/src/keyboard.h index 693137b08f4..a3bb46f4454 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -318,10 +318,7 @@ extern Lisp_Object unuse_menu_items (Lisp_Object dummy); #define ENCODE_MENU_STRING(str) (str) #endif -#if defined (HAVE_NS) || defined (HAVE_NTGUI) - -typedef void * XtPointer; -typedef unsigned char Boolean; +#if defined (HAVE_NS) || defined (HAVE_NTGUI) || defined (USE_GTK) /* Definitions copied from lwlib.h */ @@ -338,32 +335,35 @@ typedef struct _widget_value { /* name of widget */ Lisp_Object lname; - char* name; + const char* name; /* value (meaning depend on widget type) */ - char* value; + const char* value; /* keyboard equivalent. no implications for XtTranslations */ Lisp_Object lkey; - char* key; + const char* key; /* Help string or nil if none. GC finds this string through the frame's menu_bar_vector or through menu_items. */ Lisp_Object help; /* true if enabled */ - Boolean enabled; + unsigned char enabled; /* true if selected */ - Boolean selected; + unsigned char selected; /* The type of a button. */ enum button_type button_type; #if defined (HAVE_NTGUI) /* true if menu title */ - Boolean title; + unsigned char title; #endif /* Contents of the sub-widgets, also selected slot for checkbox */ struct _widget_value* contents; /* data passed to callback */ - XtPointer call_data; + void *call_data; /* next one in the list */ struct _widget_value* next; +#ifdef USE_GTK + struct _widget_value *free_list; +#endif } widget_value; #endif /* HAVE_NS || HAVE_NTGUI */ @@ -440,6 +440,9 @@ extern int ignore_mouse_drag_p; extern Lisp_Object Vdouble_click_time; +/* The primary selection. */ +extern Lisp_Object QPRIMARY; + /* Forward declaration for prototypes. */ struct input_event; diff --git a/src/lisp.h b/src/lisp.h index 94851d157d1..d44c05c661f 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2542,7 +2542,6 @@ EXFUN (Ffillarray, 2); EXFUN (Fnconc, MANY); EXFUN (Fmapcar, 2); EXFUN (Fmapconcat, 3); -EXFUN (Fy_or_n_p, 1); extern Lisp_Object do_yes_or_no_p (Lisp_Object); EXFUN (Frequire, 3); EXFUN (Fprovide, 2); @@ -3607,6 +3606,11 @@ extern char *x_get_keysym_name (int); EXFUN (Fmsdos_downcase_filename, 1); #endif +#ifdef HAVE_LIBXML2 +/* Defined in xml.c */ +extern void syms_of_xml (void); +#endif + #ifdef HAVE_MENUS /* Defined in (x|w32)fns.c, nsfns.m... */ extern int have_menus_p (void); diff --git a/src/makefile.w32-in b/src/makefile.w32-in index fc86ae6cb0c..8d99d6cedfe 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -1357,6 +1357,7 @@ $(BLD)/sysdep.$(O) : \ $(SRC)/frame.h \ $(SRC)/keyboard.h \ $(SRC)/process.h \ + $(SRC)/sysselect.h \ $(SRC)/syssignal.h \ $(SRC)/systime.h \ $(SRC)/systty.h \ diff --git a/src/marker.c b/src/marker.c index 911d2e57706..b5ea80562df 100644 --- a/src/marker.c +++ b/src/marker.c @@ -806,16 +806,18 @@ marker_byte_position (Lisp_Object marker) return i; } -DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 1, 2, 0, +DEFUN ("copy-marker", Fcopy_marker, Scopy_marker, 0, 2, 0, doc: /* Return a new marker pointing at the same place as MARKER. If argument is a number, makes a new marker pointing at that position in the current buffer. +If MARKER is not specified, the new marker does not point anywhere. The optional argument TYPE specifies the insertion type of the new marker; see `marker-insertion-type'. */) (register Lisp_Object marker, Lisp_Object type) { register Lisp_Object new; + if (!NILP (marker)) CHECK_TYPE (INTEGERP (marker) || MARKERP (marker), Qinteger_or_marker_p, marker); new = Fmake_marker (); diff --git a/src/menu.c b/src/menu.c index ab20a47fba6..05a296e45fc 100644 --- a/src/menu.c +++ b/src/menu.c @@ -1065,7 +1065,7 @@ no quit occurs and `x-popup-menu' returns nil. */) Lisp_Object keymap, tem; int xpos = 0, ypos = 0; Lisp_Object title; - char *error_name = NULL; + const char *error_name = NULL; Lisp_Object selection = Qnil; FRAME_PTR f = NULL; Lisp_Object x, y, window; diff --git a/src/menu.h b/src/menu.h index c8691169ccb..5e62327da9f 100644 --- a/src/menu.h +++ b/src/menu.h @@ -46,11 +46,11 @@ extern void mouse_position_for_popup (FRAME_PTR f, int *x, int *y); #endif extern Lisp_Object w32_menu_show (FRAME_PTR, int, int, int, int, - Lisp_Object, char **); + Lisp_Object, const char **); extern Lisp_Object ns_menu_show (FRAME_PTR, int, int, int, int, - Lisp_Object, char **); + Lisp_Object, const char **); extern Lisp_Object xmenu_show (FRAME_PTR, int, int, int, int, - Lisp_Object, char **, EMACS_UINT); + Lisp_Object, const char **, EMACS_UINT); #endif /* MENU_H */ /* arch-tag: c32b2778-724d-4e85-81d7-45f98530a988 diff --git a/src/msdos.c b/src/msdos.c index ad529d00dea..086cad2ff84 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -68,8 +68,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <pc.h> #include <ctype.h> /* #include <process.h> */ -/* Damn that local process.h! Instead we can define P_WAIT ourselves. */ +/* Damn that local process.h! Instead we can define P_WAIT and + spawnve ourselves. */ #define P_WAIT 1 +extern int spawnve (int, const char *, char *const [], char *const []); #ifndef _USE_LFN #define _USE_LFN 0 @@ -827,7 +829,7 @@ IT_set_face (int face) bg = tem2; } if (tty->termscript) - fprintf (tty->termscript, "<FACE %d: %d/%d[FG:%d/BG:%d]>", face, + fprintf (tty->termscript, "<FACE %d: %lu/%lu[FG:%lu/BG:%lu]>", face, fp->foreground, fp->background, fg, bg); if (fg >= 0 && fg < 16) { @@ -859,12 +861,6 @@ IT_write_glyphs (struct frame *f, struct glyph *str, int str_len) struct frame *sf; unsigned char *conversion_buffer; - /* Do we need to consider conversion of unibyte characters to - multibyte? */ - int convert_unibyte_characters - = (NILP (current_buffer->enable_multibyte_characters) - && unibyte_display_via_language_environment); - /* If terminal_coding does any conversion, use it, otherwise use safe_terminal_coding. We can't use CODING_REQUIRE_ENCODING here because it always returns 1 if terminal_coding.src_multibyte is 1. */ @@ -1180,8 +1176,6 @@ fast_find_position (struct window *w, int pos, int *hpos, int *vpos) static void IT_note_mode_line_highlight (struct window *w, int x, int mode_line_p) { - struct frame *f = XFRAME (w->frame); - struct tty_display_info *dpyinfo = FRAME_X_DISPLAY_INFO (f); struct glyph_row *row; if (mode_line_p) @@ -1192,7 +1186,7 @@ IT_note_mode_line_highlight (struct window *w, int x, int mode_line_p) if (row->enabled_p) { struct glyph *glyph, *end; - Lisp_Object help, map; + Lisp_Object help; /* Find the glyph under X. */ glyph = (row->glyphs[TEXT_AREA] @@ -1873,6 +1867,8 @@ IT_delete_glyphs (struct frame *f, int n) void x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) { + extern void set_menu_bar_lines (struct frame *, Lisp_Object, Lisp_Object); + set_menu_bar_lines (f, value, oldval); } @@ -1939,7 +1935,7 @@ IT_set_terminal_modes (struct terminal *term) already point to the relocated buffer address returned by the Int 10h/AX=FEh call above. DJGPP v2.02 and later sets ScreenPrimary to that address at startup under DOS/V. */ - if (regs.x.es != (ScreenPrimary >> 4) & 0xffff) + if (regs.x.es != ((ScreenPrimary >> 4) & 0xffff)) screen_old_address = ScreenPrimary; screen_virtual_segment = regs.x.es; screen_virtual_offset = regs.x.di; @@ -2056,6 +2052,8 @@ DEFUN ("msdos-remember-default-colors", Fmsdos_remember_default_colors, frame colors are reversed. */ initial_screen_colors[0] = FRAME_FOREGROUND_PIXEL (f); initial_screen_colors[1] = FRAME_BACKGROUND_PIXEL (f); + + return Qnil; } void @@ -2071,7 +2069,6 @@ IT_set_frame_parameters (struct frame *f, Lisp_Object alist) int reverse = EQ (Fcdr (Fassq (Qreverse, f->param_alist)), Qt); int redraw = 0, fg_set = 0, bg_set = 0; unsigned long orig_fg, orig_bg; - Lisp_Object frame_bg, frame_fg; struct tty_display_info *tty = FRAME_TTY (f); /* If we are creating a new frame, begin with the original screen colors @@ -2195,9 +2192,10 @@ IT_set_frame_parameters (struct frame *f, Lisp_Object alist) IT_set_cursor_type (f, val); if (tty->termscript) fprintf (tty->termscript, "<CTYPE: %s>\n", - EQ (val, Qbar) || EQ (val, Qhbar) - || CONSP (val) && (EQ (XCAR (val), Qbar) - || EQ (XCAR (val), Qhbar)) + EQ (val, Qbar) + || EQ (val, Qhbar) + || (CONSP (val) && (EQ (XCAR (val), Qbar) + || EQ (XCAR (val), Qhbar))) ? "bar" : "box"); } else if (EQ (prop, Qtty_type)) @@ -2214,8 +2212,6 @@ IT_set_frame_parameters (struct frame *f, Lisp_Object alist) the current frame colors. */ if (reverse) { - Lisp_Object frame; - if (!fg_set) { FRAME_FOREGROUND_PIXEL (f) = orig_bg; @@ -2532,11 +2528,11 @@ static struct keyboard_layout_list struct dos_keyboard_map *keyboard_map; } keyboard_layout_list[] = { - 1, &us_keyboard, - 33, &fr_keyboard, - 39, &it_keyboard, - 45, &dk_keyboard, - 81, &jp_keyboard + { 1, &us_keyboard }, + { 33, &fr_keyboard }, + { 39, &it_keyboard }, + { 45, &dk_keyboard }, + { 81, &jp_keyboard } }; static struct dos_keyboard_map *keyboard; @@ -2581,17 +2577,17 @@ static struct unsigned char keypad_code; /* keypad code */ unsigned char editkey_code; /* edit key */ } keypad_translate_map[] = { - '0', '0', 0xb0, /* kp-0 */ 0x63, /* insert */ - '1', '1', 0xb1, /* kp-1 */ 0x57, /* end */ - '2', '2', 0xb2, /* kp-2 */ 0x54, /* down */ - '3', '3', 0xb3, /* kp-3 */ 0x56, /* next */ - '4', '4', 0xb4, /* kp-4 */ 0x51, /* left */ - '5', '5', 0xb5, /* kp-5 */ 0xb5, /* kp-5 */ - '6', '6', 0xb6, /* kp-6 */ 0x53, /* right */ - '7', '7', 0xb7, /* kp-7 */ 0x50, /* home */ - '8', '8', 0xb8, /* kp-8 */ 0x52, /* up */ - '9', '9', 0xb9, /* kp-9 */ 0x55, /* prior */ - '.', '-', 0xae, /* kp-decimal */ 0xff /* delete */ + { '0', '0', 0xb0, /* kp-0 */ 0x63 /* insert */ }, + { '1', '1', 0xb1, /* kp-1 */ 0x57 /* end */ }, + { '2', '2', 0xb2, /* kp-2 */ 0x54 /* down */ }, + { '3', '3', 0xb3, /* kp-3 */ 0x56 /* next */ }, + { '4', '4', 0xb4, /* kp-4 */ 0x51 /* left */ }, + { '5', '5', 0xb5, /* kp-5 */ 0xb5 /* kp-5 */ }, + { '6', '6', 0xb6, /* kp-6 */ 0x53 /* right */ }, + { '7', '7', 0xb7, /* kp-7 */ 0x50 /* home */ }, + { '8', '8', 0xb8, /* kp-8 */ 0x52 /* up */ }, + { '9', '9', 0xb9, /* kp-9 */ 0x55 /* prior */ }, + { '.', '-', 0xae, /* kp-decimal */ 0xff /* delete */} }; static struct @@ -2599,11 +2595,11 @@ static struct unsigned char char_code; /* normal code */ unsigned char keypad_code; /* keypad code */ } grey_key_translate_map[] = { - '/', 0xaf, /* kp-decimal */ - '*', 0xaa, /* kp-multiply */ - '-', 0xad, /* kp-subtract */ - '+', 0xab, /* kp-add */ - '\r', 0x8d /* kp-enter */ + { '/', 0xaf /* kp-decimal */ }, + { '*', 0xaa /* kp-multiply */ }, + { '-', 0xad /* kp-subtract */ }, + { '+', 0xab /* kp-add */ }, + { '\r', 0x8d /* kp-enter */ } }; static unsigned short @@ -3129,7 +3125,6 @@ dos_rawgetc (void) break; } - make_event: if (code == 0) continue; @@ -3237,14 +3232,14 @@ dos_rawgetc (void) /* If only one button is pressed, wait 100 msec and check again. This way, Speedy Gonzales isn't punished, while the slow get their chance. */ - if (press && mouse_pressed (1-but, &x2, &y2) - || !press && mouse_released (1-but, &x2, &y2)) + if ((press && mouse_pressed (1-but, &x2, &y2)) + || (!press && mouse_released (1-but, &x2, &y2))) button_num = 2; else { delay (100); - if (press && mouse_pressed (1-but, &x2, &y2) - || !press && mouse_released (1-but, &x2, &y2)) + if ((press && mouse_pressed (1-but, &x2, &y2)) + || (!press && mouse_released (1-but, &x2, &y2))) button_num = 2; } } @@ -3680,10 +3675,12 @@ XMenuActivate (Display *foo, XMenu *menu, int *pane, int *selidx, if (0 <= dy && dy < state[i].menu->count) { if (!state[i].menu->submenu[dy]) - if (state[i].menu->panenumber[dy]) - result = XM_SUCCESS; - else - result = XM_IA_SELECT; + { + if (state[i].menu->panenumber[dy]) + result = XM_SUCCESS; + else + result = XM_IA_SELECT; + } *pane = state[i].pane - 1; *selidx = dy; /* We hit some part of a menu, so drop extra menus that @@ -4181,7 +4178,7 @@ dos_ttraw (struct tty_display_info *tty) /* If we are called for the initial terminal, it's too early to do anything, and termscript isn't set up. */ if (tty->terminal->type == output_initial) - return; + return 2; break_stat = getcbrk (); setcbrk (0); @@ -4367,7 +4364,7 @@ run_msdos_command (unsigned char **argv, const char *working_dir, result = 0; /* emulate Unixy shell behavior with empty cmd line */ } else - result = spawnve (P_WAIT, argv[0], argv, envv); + result = spawnve (P_WAIT, argv[0], (char **)argv, envv); dup2 (inbak, 0); dup2 (outbak, 1); diff --git a/src/nsfns.m b/src/nsfns.m index aac2ef0ed3a..576131e0bdf 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -1041,6 +1041,7 @@ frame_parm_handler ns_frame_parm_handlers[] = x_set_font_backend, /* generic OK */ x_set_alpha, 0, /* x_set_sticky */ + 0, /* x_set_tool_bar_position */ }; diff --git a/src/nsfont.m b/src/nsfont.m index aaa5999e048..115986774d8 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -161,7 +161,9 @@ static NSFontDescriptor /* Converts NSFont descriptor to FONT_WEIGHT, FONT_SLANT, FONT_WIDTH, etc.. */ static Lisp_Object -ns_descriptor_to_entity (NSFontDescriptor *desc, Lisp_Object extra, char *style) +ns_descriptor_to_entity (NSFontDescriptor *desc, + Lisp_Object extra, + const char *style) { Lisp_Object font_entity = font_make_entity (); /* NSString *psName = [desc postscriptName]; */ diff --git a/src/nsimage.m b/src/nsimage.m index 13761ba5f71..a42950d1f52 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -83,19 +83,21 @@ int ns_load_image (struct frame *f, struct image *img, Lisp_Object spec_file, Lisp_Object spec_data) { - EmacsImage *eImg; + EmacsImage *eImg = nil; NSSize size; NSTRACE (ns_load_image); - if (NILP (spec_data)) + if (STRINGP (spec_file)) { eImg = [EmacsImage allocInitFromFile: spec_file]; } - else + else if (STRINGP (spec_data)) { - NSData *data = [NSData dataWithBytes: SDATA (spec_data) - length: SBYTES (spec_data)]; + NSData *data; + + data = [NSData dataWithBytes: SDATA (spec_data) + length: SBYTES (spec_data)]; eImg = [[EmacsImage alloc] initWithData: data]; [eImg setPixmapData]; } diff --git a/src/nsmenu.m b/src/nsmenu.m index c7ea6bb90fd..9534aec8f2b 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -600,9 +600,9 @@ name_is_separator ( const char *name) NSMenuItem get ignored. For now we try to display a super-single letter combo, and return the others as strings to be appended to the item title. (This is signaled by setting keyEquivModMask to 0 for now.) */ --(NSString *)parseKeyEquiv: (char *)key +-(NSString *)parseKeyEquiv: (const char *)key { - char *tpos = key; + const char *tpos = key; keyEquivModMask = NSCommandKeyMask; if (!key || !strlen (key)) @@ -719,7 +719,7 @@ name_is_separator ( const char *name) /* adds an empty submenu and returns it */ -- (EmacsMenu *)addSubmenuWithTitle: (char *)title forFrame: (struct frame *)f +- (EmacsMenu *)addSubmenuWithTitle: (const char *)title forFrame: (struct frame *)f { NSString *titleStr = [NSString stringWithUTF8String: title]; NSMenuItem *item = [self addItemWithTitle: titleStr @@ -773,7 +773,7 @@ name_is_separator ( const char *name) Lisp_Object ns_menu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps, - Lisp_Object title, char **error) + Lisp_Object title, const char **error) { EmacsMenu *pmenu; NSPoint p; @@ -836,7 +836,7 @@ ns_menu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps, { /* Create a new pane. */ Lisp_Object pane_name, prefix; - char *pane_string; + const char *pane_string; pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME); prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX); @@ -1033,7 +1033,7 @@ update_frame_tool_bar (FRAME_PTR f) struct image *img; Lisp_Object image; Lisp_Object helpObj; - char *helpText; + const char *helpText; /* If image is a vector, choose the image according to the button state. */ @@ -1153,7 +1153,7 @@ update_frame_tool_bar (FRAME_PTR f) } - (void) addDisplayItemWithImage: (EmacsImage *)img idx: (int)idx - helpText: (char *)help enabled: (BOOL)enabled + helpText: (const char *)help enabled: (BOOL)enabled { /* 1) come up w/identifier */ NSString *identifier diff --git a/src/nsselect.m b/src/nsselect.m index 23dede9c38e..9e434515edf 100644 --- a/src/nsselect.m +++ b/src/nsselect.m @@ -33,10 +33,11 @@ GNUstep port and post-20 update by Adrian Robert (arobert@cogsci.ucsd.edu) #include "lisp.h" #include "nsterm.h" #include "termhooks.h" +#include "keyboard.h" #define CUT_BUFFER_SUPPORT -Lisp_Object QPRIMARY, QSECONDARY, QTEXT, QFILE_NAME; +Lisp_Object QCLIPBOARD, QSECONDARY, QTEXT, QFILE_NAME; static Lisp_Object Vns_sent_selection_hooks; static Lisp_Object Vns_lost_selection_hooks; @@ -45,6 +46,8 @@ static Lisp_Object Vselection_converter_alist; static Lisp_Object Qforeign_selection; +/* NSGeneralPboard is pretty much analogous to X11 CLIPBOARD */ +NSString *NXPrimaryPboard; NSString *NXSecondaryPboard; @@ -60,7 +63,8 @@ static NSString * symbol_to_nsstring (Lisp_Object sym) { CHECK_SYMBOL (sym); - if (EQ (sym, QPRIMARY)) return NSGeneralPboard; + if (EQ (sym, QCLIPBOARD)) return NSGeneralPboard; + if (EQ (sym, QPRIMARY)) return NXPrimaryPboard; if (EQ (sym, QSECONDARY)) return NXSecondaryPboard; if (EQ (sym, QTEXT)) return NSStringPboardType; return [NSString stringWithUTF8String: SDATA (XSYMBOL (sym)->xname)]; @@ -71,6 +75,8 @@ static Lisp_Object ns_string_to_symbol (NSString *t) { if ([t isEqualToString: NSGeneralPboard]) + return QCLIPBOARD; + if ([t isEqualToString: NXPrimaryPboard]) return QPRIMARY; if ([t isEqualToString: NXSecondaryPboard]) return QSECONDARY; @@ -536,13 +542,14 @@ DEFUN ("ns-store-cut-buffer-internal", Fns_store_cut_buffer_internal, void nxatoms_of_nsselect (void) { - NXSecondaryPboard = @"Selection"; + NXPrimaryPboard = @"Selection"; + NXSecondaryPboard = @"Secondary"; } void syms_of_nsselect (void) { - QPRIMARY = intern ("PRIMARY"); staticpro (&QPRIMARY); + QCLIPBOARD = intern ("CLIPBOARD"); staticpro (&QCLIPBOARD); QSECONDARY = intern ("SECONDARY"); staticpro (&QSECONDARY); QTEXT = intern ("TEXT"); staticpro (&QTEXT); QFILE_NAME = intern ("FILE_NAME"); staticpro (&QFILE_NAME); diff --git a/src/nsterm.h b/src/nsterm.h index 9b7f0accad1..21b18f15cae 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -114,10 +114,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ - initWithTitle: (NSString *)title frame: (struct frame *)f; - (void)setFrame: (struct frame *)f; - (void)menuNeedsUpdate: (NSMenu *)menu; /* (delegate method) */ -- (NSString *)parseKeyEquiv: (char *)key; +- (NSString *)parseKeyEquiv: (const char *)key; - (NSMenuItem *)addItemWithWidgetValue: (void *)wvptr; - (void)fillWithWidgetValue: (void *)wvptr; -- (EmacsMenu *)addSubmenuWithTitle: (char *)title forFrame: (struct frame *)f; +- (EmacsMenu *)addSubmenuWithTitle: (const char *)title forFrame: (struct frame *)f; - (void) clear; - (Lisp_Object)runMenuAt: (NSPoint)p forFrame: (struct frame *)f keymaps: (int)keymaps; @@ -144,7 +144,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ - (void) clearActive; - (BOOL) changed; - (void) addDisplayItemWithImage: (EmacsImage *)img idx: (int)idx - helpText: (char *)help + helpText: (const char *)help enabled: (BOOL)enabled; /* delegate methods */ - (NSToolbarItem *)toolbar: (NSToolbar *)toolbar diff --git a/src/nsterm.m b/src/nsterm.m index 88d47d41972..f0efb948ab9 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -1792,6 +1792,9 @@ ns_define_frame_cursor (struct frame *f, Cursor cursor) EmacsView *view = FRAME_NS_VIEW (f); FRAME_POINTER_TYPE (f) = cursor; [[view window] invalidateCursorRectsForView: view]; + /* Redisplay assumes this function also draws the changed frame + cursor, but this function doesn't, so do it explicitly. */ + x_update_cursor (f, 1); } } @@ -2248,6 +2251,11 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, struct frame *f = WINDOW_XFRAME (w); struct glyph *phys_cursor_glyph; int overspill; + struct glyph *cursor_glyph; + + /* If cursor is out of bounds, don't draw garbage. This can happen + in mini-buffer windows when switching between echo area glyphs + and mini-buffer. */ NSTRACE (dumpcursor); //fprintf(stderr, "drawcursor (%d,%d) activep = %d\tonp = %d\tc_type = %d\twidth = %d\n",x,y, active_p,on_p,cursor_type,cursor_width); @@ -2325,6 +2333,13 @@ ns_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, case BAR_CURSOR: s = r; s.size.width = min (cursor_width, 2); //FIXME(see above) + + /* If the character under cursor is R2L, draw the bar cursor + on the right of its glyph, rather than on the left. */ + cursor_glyph = get_phys_cursor_glyph (w); + if ((cursor_glyph->resolved_level & 1) != 0) + s.origin.x += cursor_glyph->pixel_width - s.size.width; + NSRectFill (s); break; } diff --git a/src/process.c b/src/process.c index 4a658623077..f348dca7d35 100644 --- a/src/process.c +++ b/src/process.c @@ -31,9 +31,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #ifdef HAVE_INTTYPES_H #include <inttypes.h> #endif -#ifdef STDC_HEADERS #include <stdlib.h> -#endif #ifdef HAVE_UNISTD_H #include <unistd.h> @@ -61,9 +59,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #if defined(HAVE_SYS_IOCTL_H) #include <sys/ioctl.h> -#if !defined (O_NDELAY) && defined (HAVE_PTYS) && !defined(USG5) -#include <fcntl.h> -#endif /* HAVE_PTYS and no O_NDELAY */ #if defined(HAVE_NET_IF_H) #include <net/if.h> #endif /* HAVE_NET_IF_H */ @@ -182,16 +177,9 @@ extern Lisp_Object QCfilter; extern const char *get_operating_system_release (void); -/* Serial processes require termios or Windows. */ -#if defined (HAVE_TERMIOS) || defined (WINDOWSNT) -#define HAVE_SERIAL -#endif - -#ifdef HAVE_SERIAL /* From sysdep.c or w32.c */ extern int serial_open (char *port); extern void serial_configure (struct Lisp_Process *p, Lisp_Object contact); -#endif #ifndef HAVE_H_ERRNO extern int h_errno; @@ -1903,7 +1891,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) setpgrp (); #endif /* USG */ #endif /* not HAVE_SETSID */ -#if defined (HAVE_TERMIOS) && defined (LDISC1) +#if defined (LDISC1) if (pty_flag && xforkin >= 0) { struct termios t; @@ -2569,7 +2557,6 @@ OPTION is not a supported option, return nil instead; otherwise return t. */) } -#ifdef HAVE_SERIAL DEFUN ("serial-process-configure", Fserial_process_configure, Sserial_process_configure, @@ -2865,7 +2852,6 @@ usage: (make-serial-process &rest ARGS) */) UNGCPRO; return proc; } -#endif /* HAVE_SERIAL */ /* Create a network stream/datagram client/server process. Treated exactly like a normal process when reading and writing. Primary @@ -5801,9 +5787,6 @@ process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group, /* If possible, send signals to the entire pgrp by sending an input character to it. */ - /* TERMIOS is the latest and bestest, and seems most likely to - work. If the system has it, use it. */ -#ifdef HAVE_TERMIOS struct termios t; cc_t *sig_char = NULL; @@ -5835,65 +5818,6 @@ process_send_signal (Lisp_Object process, int signo, Lisp_Object current_group, } /* If we can't send the signal with a character, fall through and send it another way. */ -#else /* ! HAVE_TERMIOS */ - - /* On Berkeley descendants, the following IOCTL's retrieve the - current control characters. */ -#if defined (TIOCGLTC) && defined (TIOCGETC) - - struct tchars c; - struct ltchars lc; - - switch (signo) - { - case SIGINT: - ioctl (p->infd, TIOCGETC, &c); - send_process (proc, &c.t_intrc, 1, Qnil); - return; - case SIGQUIT: - ioctl (p->infd, TIOCGETC, &c); - send_process (proc, &c.t_quitc, 1, Qnil); - return; -#ifdef SIGTSTP - case SIGTSTP: - ioctl (p->infd, TIOCGLTC, &lc); - send_process (proc, &lc.t_suspc, 1, Qnil); - return; -#endif /* ! defined (SIGTSTP) */ - } - -#else /* ! defined (TIOCGLTC) && defined (TIOCGETC) */ - - /* On SYSV descendants, the TCGETA ioctl retrieves the current control - characters. */ -#ifdef TCGETA - struct termio t; - switch (signo) - { - case SIGINT: - ioctl (p->infd, TCGETA, &t); - send_process (proc, &t.c_cc[VINTR], 1, Qnil); - return; - case SIGQUIT: - ioctl (p->infd, TCGETA, &t); - send_process (proc, &t.c_cc[VQUIT], 1, Qnil); - return; -#ifdef SIGTSTP - case SIGTSTP: - ioctl (p->infd, TCGETA, &t); - send_process (proc, &t.c_cc[VSWTCH], 1, Qnil); - return; -#endif /* ! defined (SIGTSTP) */ - } -#else /* ! defined (TCGETA) */ - Your configuration files are messed up. - /* If your system configuration files define SIGNALS_VIA_CHARACTERS, - you'd better be using one of the alternatives above! */ -#endif /* ! defined (TCGETA) */ -#endif /* ! defined (TIOCGLTC) && defined (TIOCGETC) */ - /* In this case, the code above should alway return. */ - abort (); -#endif /* ! defined HAVE_TERMIOS */ /* The code above may fall through if it can't handle the signal. */ @@ -6065,10 +5989,9 @@ traffic. */) #ifdef WINDOWSNT if (fd_info[ p->infd ].flags & FILE_SERIAL) PurgeComm (fd_info[ p->infd ].hnd, PURGE_RXABORT | PURGE_RXCLEAR); -#endif -#ifdef HAVE_TERMIOS +#else /* not WINDOWSNT */ tcflush (p->infd, TCIFLUSH); -#endif +#endif /* not WINDOWSNT */ } p->command = Qnil; return process; @@ -6282,10 +6205,10 @@ process has been transmitted to the serial port. */) send_process (proc, "\004", 1, Qnil); else if (EQ (XPROCESS (proc)->type, Qserial)) { -#ifdef HAVE_TERMIOS +#ifndef WINDOWSNT if (tcdrain (XPROCESS (proc)->outfd) != 0) error ("tcdrain() failed: %s", emacs_strerror (errno)); -#endif +#endif /* not WINDOWSNT */ /* Do nothing on Windows because writes are blocking. */ } else @@ -7672,10 +7595,8 @@ The variable takes effect when `start-process' is called. */); defsubr (&Slist_processes); defsubr (&Sprocess_list); defsubr (&Sstart_process); -#ifdef HAVE_SERIAL defsubr (&Sserial_process_configure); defsubr (&Smake_serial_process); -#endif /* HAVE_SERIAL */ defsubr (&Sset_network_process_option); defsubr (&Smake_network_process); defsubr (&Sformat_network_address); diff --git a/src/process.h b/src/process.h index 6d4832ffde8..35b01aba6a4 100644 --- a/src/process.h +++ b/src/process.h @@ -142,7 +142,7 @@ extern int synch_process_alive; to Fcall_process. */ /* Nonzero => this is a string explaining death of synchronous subprocess. */ -extern char *synch_process_death; +extern const char *synch_process_death; /* Nonzero => this is the signal number that terminated the subprocess. */ extern int synch_process_termsig; diff --git a/src/puresize.h b/src/puresize.h index 682e8926135..3c7f92228a0 100644 --- a/src/puresize.h +++ b/src/puresize.h @@ -87,7 +87,6 @@ extern EMACS_INT pure[]; && (PNTR_COMPARISON_TYPE) XPNTR (obj) >= (PNTR_COMPARISON_TYPE) pure) #else /* not VIRT_ADDR_VARIES */ -#ifdef PNTR_COMPARISON_TYPE /* When PNTR_COMPARISON_TYPE is not the default (unsigned int). */ extern char my_edata[]; @@ -95,14 +94,6 @@ extern char my_edata[]; #define PURE_P(obj) \ ((PNTR_COMPARISON_TYPE) XPNTR (obj) < (PNTR_COMPARISON_TYPE) my_edata) -#else /* not VIRT_ADDRESS_VARIES, not PNTR_COMPARISON_TYPE */ - -extern char my_edata[]; - -#define PURE_P(obj) \ - (XPNTR (obj) < (unsigned int) my_edata) - -#endif /* PNTR_COMPARISON_TYPE */ #endif /* VIRT_ADDRESS_VARIES */ /* arch-tag: fd9b0a91-a70e-4729-a75a-6bb4ca1ce14f diff --git a/src/s/aix4-2.h b/src/s/aix4-2.h index 84920f888e1..0a3d48db639 100644 --- a/src/s/aix4-2.h +++ b/src/s/aix4-2.h @@ -55,10 +55,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Special items needed to make Emacs run on this system. */ -/* The following definition seems to be needed in AIX version 3.1.6.8. - It may not have been needed in certain earlier versions. */ -#define HAVE_TCATTR - /* AIX doesn't define this. */ #define unix 1 diff --git a/src/s/hpux10-20.h b/src/s/hpux10-20.h index ee0fa9abe02..d34ff16104b 100644 --- a/src/s/hpux10-20.h +++ b/src/s/hpux10-20.h @@ -35,9 +35,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ if system supports pty's. 'p' means it is /dev/ptym/ptyp0 */ #define FIRST_PTY_LETTER 'p' -/* Define HAVE_TERMIO if the system provides sysV-style ioctls - for terminal control. */ -#define HAVE_TERMIO +#define HAVE_TERMIOS +#define NO_TERMIO + +#define ORDINARY_LINK /* Define HAVE_PTYS if the system supports pty devices. */ #define HAVE_PTYS diff --git a/src/s/ms-w32.h b/src/s/ms-w32.h index f61fae57eff..4ae5f32e873 100644 --- a/src/s/ms-w32.h +++ b/src/s/ms-w32.h @@ -106,7 +106,6 @@ struct sigaction { #define HAVE_SOUND 1 #define LISP_FLOAT_TYPE 1 -#undef HAVE_SYS_SELECT_H #define HAVE_SYS_TIMEB_H 1 #define HAVE_SYS_TIME_H 1 #define HAVE_UNISTD_H 1 diff --git a/src/s/unixware.h b/src/s/unixware.h index ac989d48e2c..81b1b3d97fa 100644 --- a/src/s/unixware.h +++ b/src/s/unixware.h @@ -21,8 +21,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "usg5-4-common.h" -/* fnf@cygnus.com says these exist. */ -#define HAVE_TCATTR /* #define HAVE_GETWD (appears to be buggy on SVR4.2) */ #undef HAVE_GETWD diff --git a/src/syntax.c b/src/syntax.c index 9b707c6c3b7..f0a7dca42dc 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -34,6 +34,60 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "syntax.h" #include "intervals.h" +#include "category.h" + +/* Then there are seven single-bit flags that have the following meanings: + 1. This character is the first of a two-character comment-start sequence. + 2. This character is the second of a two-character comment-start sequence. + 3. This character is the first of a two-character comment-end sequence. + 4. This character is the second of a two-character comment-end sequence. + 5. This character is a prefix, for backward-prefix-chars. + 6. The char is part of a delimiter for comments of style "b". + 7. This character is part of a nestable comment sequence. + 8. The char is part of a delimiter for comments of style "c". + Note that any two-character sequence whose first character has flag 1 + and whose second character has flag 2 will be interpreted as a comment start. + + bit 6 and 8 are used to discriminate between different comment styles. + Languages such as C++ allow two orthogonal syntax start/end pairs + and bit 6 is used to determine whether a comment-end or Scommentend + ends style a or b. Comment markers can start style a, b, c, or bc. + Style a is always the default. + For 2-char comment markers, the style b flag is only looked up on the second + char of the comment marker and on the first char of the comment ender. + For style c (like to for the nested flag), the flag can be placed on any + one of the chars. + */ + +/* These macros extract specific flags from an integer + that holds the syntax code and the flags. */ + +#define SYNTAX_FLAGS_COMSTART_FIRST(flags) (((flags) >> 16) & 1) + +#define SYNTAX_FLAGS_COMSTART_SECOND(flags) (((flags) >> 17) & 1) + +#define SYNTAX_FLAGS_COMEND_FIRST(flags) (((flags) >> 18) & 1) + +#define SYNTAX_FLAGS_COMEND_SECOND(flags) (((flags) >> 19) & 1) + +#define SYNTAX_FLAGS_PREFIX(flags) (((flags) >> 20) & 1) + +#define SYNTAX_FLAGS_COMMENT_STYLEB(flags) (((flags) >> 21) & 1) +#define SYNTAX_FLAGS_COMMENT_STYLEC(flags) (((flags) >> 22) & 2) +/* FLAGS should be the flags of the main char of the comment marker, e.g. + the second for comstart and the first for comend. */ +#define SYNTAX_FLAGS_COMMENT_STYLE(flags, other_flags) \ + (SYNTAX_FLAGS_COMMENT_STYLEB (flags) \ + | SYNTAX_FLAGS_COMMENT_STYLEC (flags) \ + | SYNTAX_FLAGS_COMMENT_STYLEC (other_flags)) + +#define SYNTAX_FLAGS_COMMENT_NESTED(flags) (((flags) >> 22) & 1) + +/* These macros extract a particular flag for a given character. */ + +#define SYNTAX_COMEND_FIRST(c) \ + (SYNTAX_FLAGS_COMEND_FIRST (SYNTAX_WITH_FLAGS (c))) +#define SYNTAX_PREFIX(c) (SYNTAX_FLAGS_PREFIX (SYNTAX_WITH_FLAGS (c))) /* We use these constants in place for comment-style and string-ender-char to distinguish comments/strings started by @@ -41,7 +95,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #define ST_COMMENT_STYLE (256 + 1) #define ST_STRING_STYLE (256 + 2) -#include "category.h" Lisp_Object Qsyntax_table_p, Qsyntax_table, Qscan_error; @@ -106,6 +159,11 @@ static void scan_sexps_forward (struct lisp_parse_state *, int, Lisp_Object, int); static int in_classes (int, Lisp_Object); +/* Whether the syntax of the character C has the prefix flag set. */ +int syntax_prefix_flag_p (int c) +{ + return SYNTAX_PREFIX (c); +} struct gl_state_s gl_state; /* Global state of syntax parser. */ @@ -514,7 +572,8 @@ back_comment (EMACS_INT from, EMACS_INT from_byte, EMACS_INT stop, int comnested /* Check for 2-char comment markers. */ com2start = (SYNTAX_FLAGS_COMSTART_FIRST (syntax) && SYNTAX_FLAGS_COMSTART_SECOND (prev_syntax) - && comstyle == SYNTAX_FLAGS_COMMENT_STYLE (prev_syntax) + && (comstyle + == SYNTAX_FLAGS_COMMENT_STYLE (prev_syntax, syntax)) && (SYNTAX_FLAGS_COMMENT_NESTED (prev_syntax) || SYNTAX_FLAGS_COMMENT_NESTED (syntax)) == comnested); com2end = (SYNTAX_FLAGS_COMEND_FIRST (syntax) @@ -543,7 +602,8 @@ back_comment (EMACS_INT from, EMACS_INT from_byte, EMACS_INT stop, int comnested && SYNTAX_FLAGS_COMEND_FIRST (next_syntax)) || ((com2end || comnested) && SYNTAX_FLAGS_COMSTART_SECOND (syntax) - && comstyle == SYNTAX_FLAGS_COMMENT_STYLE (syntax) + && (comstyle + == SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_syntax)) && SYNTAX_FLAGS_COMSTART_FIRST (next_syntax))) goto lossage; /* UPDATE_SYNTAX_TABLE_FORWARD (next + 1); */ @@ -563,7 +623,7 @@ back_comment (EMACS_INT from, EMACS_INT from_byte, EMACS_INT stop, int comnested code = Scomment; /* Ignore comment starters of a different style. */ else if (code == Scomment - && (comstyle != SYNTAX_FLAGS_COMMENT_STYLE (syntax) + && (comstyle != SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0) || SYNTAX_FLAGS_COMMENT_NESTED (syntax) != comnested)) continue; @@ -613,7 +673,7 @@ back_comment (EMACS_INT from, EMACS_INT from_byte, EMACS_INT stop, int comnested break; case Sendcomment: - if (SYNTAX_FLAGS_COMMENT_STYLE (syntax) == comstyle + if (SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0) == comstyle && ((com2end && SYNTAX_FLAGS_COMMENT_NESTED (prev_syntax)) || SYNTAX_FLAGS_COMMENT_NESTED (syntax)) == comnested) /* This is the same style of comment ender as ours. */ @@ -930,6 +990,10 @@ text property. */) case 'n': val |= 1 << 22; break; + + case 'c': + val |= 1 << 23; + break; } if (val < XVECTOR (Vsyntax_code_object)->size && NILP (match)) @@ -969,12 +1033,13 @@ Defined flags are the characters 1, 2, 3, 4, b, p, and n. 3 means CHAR is the start of a two-char comment end sequence. 4 means CHAR is the second character of such a sequence. -There can be up to two orthogonal comment sequences. This is to support +There can be several orthogonal comment sequences. This is to support language modes such as C++. By default, all comment sequences are of style a, but you can set the comment sequence style to b (on the second character -of a comment-start, or the first character of a comment-end sequence) using -this flag: +of a comment-start, and the first character of a comment-end sequence) and/or +c (on any of its chars) using this flag: b means CHAR is part of comment sequence b. + c means CHAR is part of comment sequence c. n means CHAR is part of a nestable comment sequence. p means CHAR is a prefix character for `backward-prefix-chars'; @@ -1017,7 +1082,9 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value, (Lisp_Object syntax) { register enum syntaxcode code; - char desc, start1, start2, end1, end2, prefix, comstyle, comnested; + int syntax_code; + char desc, start1, start2, end1, end2, prefix, + comstyleb, comstylec, comnested; char str[2]; Lisp_Object first, match_lisp, value = syntax; @@ -1048,14 +1115,16 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value, return syntax; } - code = (enum syntaxcode) (XINT (first) & 0377); - start1 = (XINT (first) >> 16) & 1; - start2 = (XINT (first) >> 17) & 1; - end1 = (XINT (first) >> 18) & 1; - end2 = (XINT (first) >> 19) & 1; - prefix = (XINT (first) >> 20) & 1; - comstyle = (XINT (first) >> 21) & 1; - comnested = (XINT (first) >> 22) & 1; + syntax_code = XINT (first); + code = (enum syntaxcode) (syntax_code & 0377); + start1 = SYNTAX_FLAGS_COMSTART_FIRST (syntax_code); + start2 = SYNTAX_FLAGS_COMSTART_SECOND (syntax_code);; + end1 = SYNTAX_FLAGS_COMEND_FIRST (syntax_code); + end2 = SYNTAX_FLAGS_COMEND_SECOND (syntax_code); + prefix = SYNTAX_FLAGS_PREFIX (syntax_code); + comstyleb = SYNTAX_FLAGS_COMMENT_STYLEB (syntax_code); + comstylec = SYNTAX_FLAGS_COMMENT_STYLEC (syntax_code); + comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax_code); if ((int) code < 0 || (int) code >= (int) Smax) { @@ -1084,8 +1153,10 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value, if (prefix) insert ("p", 1); - if (comstyle) + if (comstyleb) insert ("b", 1); + if (comstylec) + insert ("c", 1); if (comnested) insert ("n", 1); @@ -1145,8 +1216,10 @@ DEFUN ("internal-describe-syntax-value", Finternal_describe_syntax_value, insert_string (",\n\t is the first character of a comment-end sequence"); if (end2) insert_string (",\n\t is the second character of a comment-end sequence"); - if (comstyle) + if (comstyleb) insert_string (" (comment style b)"); + if (comstylec) + insert_string (" (comment style c)"); if (comnested) insert_string (" (nestable)"); @@ -2060,7 +2133,7 @@ in_classes (int c, Lisp_Object iso_classes) FROM_BYTE is the bytepos corresponding to FROM. Do not move past STOP (a charpos). The comment over which we have to jump is of style STYLE - (either SYNTAX_COMMENT_STYLE(foo) or ST_COMMENT_STYLE). + (either SYNTAX_FLAGS_COMMENT_STYLE(foo) or ST_COMMENT_STYLE). NESTING should be positive to indicate the nesting at the beginning for nested comments and should be zero or negative else. ST_COMMENT_STYLE cannot be nested. @@ -2087,7 +2160,7 @@ forw_comment (EMACS_INT from, EMACS_INT from_byte, EMACS_INT stop, { register int c, c1; register enum syntaxcode code; - register int syntax; + register int syntax, other_syntax; if (nesting <= 0) nesting = -1; @@ -2109,7 +2182,7 @@ forw_comment (EMACS_INT from, EMACS_INT from_byte, EMACS_INT stop, syntax = SYNTAX_WITH_FLAGS (c); code = syntax & 0xff; if (code == Sendcomment - && SYNTAX_FLAGS_COMMENT_STYLE (syntax) == style + && SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0) == style && (SYNTAX_FLAGS_COMMENT_NESTED (syntax) ? (nesting > 0 && --nesting == 0) : nesting < 0)) /* we have encountered a comment end of the same style @@ -2125,7 +2198,7 @@ forw_comment (EMACS_INT from, EMACS_INT from_byte, EMACS_INT stop, if (nesting > 0 && code == Scomment && SYNTAX_FLAGS_COMMENT_NESTED (syntax) - && SYNTAX_FLAGS_COMMENT_STYLE (syntax) == style) + && SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0) == style) /* we have encountered a nested comment of the same style as the comment sequence which began this comment section */ nesting++; @@ -2134,11 +2207,13 @@ forw_comment (EMACS_INT from, EMACS_INT from_byte, EMACS_INT stop, forw_incomment: if (from < stop && SYNTAX_FLAGS_COMEND_FIRST (syntax) - && SYNTAX_FLAGS_COMMENT_STYLE (syntax) == style && (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte), - SYNTAX_COMEND_SECOND (c1)) + other_syntax = SYNTAX_WITH_FLAGS (c1), + SYNTAX_FLAGS_COMEND_SECOND (other_syntax)) + && SYNTAX_FLAGS_COMMENT_STYLE (syntax, other_syntax) == style && ((SYNTAX_FLAGS_COMMENT_NESTED (syntax) || - SYNTAX_COMMENT_NESTED (c1)) ? nesting > 0 : nesting < 0)) + SYNTAX_FLAGS_COMMENT_NESTED (other_syntax)) + ? nesting > 0 : nesting < 0)) { if (--nesting <= 0) /* we have encountered a comment end of the same style @@ -2155,10 +2230,11 @@ forw_comment (EMACS_INT from, EMACS_INT from_byte, EMACS_INT stop, && from < stop && SYNTAX_FLAGS_COMSTART_FIRST (syntax) && (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte), - SYNTAX_COMMENT_STYLE (c1) == style - && SYNTAX_COMSTART_SECOND (c1)) + other_syntax = SYNTAX_WITH_FLAGS (c1), + SYNTAX_FLAGS_COMMENT_STYLE (other_syntax, syntax) == style + && SYNTAX_FLAGS_COMSTART_SECOND (other_syntax)) && (SYNTAX_FLAGS_COMMENT_NESTED (syntax) || - SYNTAX_COMMENT_NESTED (c1))) + SYNTAX_FLAGS_COMMENT_NESTED (other_syntax))) /* we have encountered a nested comment of the same style as the comment sequence which began this comment section */ @@ -2209,7 +2285,7 @@ between them, return t; otherwise return nil. */) { do { - int comstart_first; + int comstart_first, syntax, other_syntax; if (from == stop) { @@ -2218,15 +2294,17 @@ between them, return t; otherwise return nil. */) return Qnil; } c = FETCH_CHAR_AS_MULTIBYTE (from_byte); + syntax = SYNTAX_WITH_FLAGS (c); code = SYNTAX (c); - comstart_first = SYNTAX_COMSTART_FIRST (c); - comnested = SYNTAX_COMMENT_NESTED (c); - comstyle = SYNTAX_COMMENT_STYLE (c); + comstart_first = SYNTAX_FLAGS_COMSTART_FIRST (syntax); + comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax); + comstyle = SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0); INC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_FORWARD (from); if (from < stop && comstart_first && (c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte), - SYNTAX_COMSTART_SECOND (c1))) + other_syntax = SYNTAX_WITH_FLAGS (c1), + SYNTAX_FLAGS_COMSTART_SECOND (other_syntax))) { /* We have encountered a comment start sequence and we are ignoring all text inside comments. We must record @@ -2234,8 +2312,9 @@ between them, return t; otherwise return nil. */) only a comment end of the same style actually ends the comment section. */ code = Scomment; - comstyle = SYNTAX_COMMENT_STYLE (c1); - comnested = comnested || SYNTAX_COMMENT_NESTED (c1); + comstyle = SYNTAX_FLAGS_COMMENT_STYLE (other_syntax, syntax); + comnested + = comnested || SYNTAX_FLAGS_COMMENT_NESTED (other_syntax); INC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_FORWARD (from); } @@ -2271,7 +2350,7 @@ between them, return t; otherwise return nil. */) { while (1) { - int quoted; + int quoted, syntax; if (from <= stop) { @@ -2284,15 +2363,17 @@ between them, return t; otherwise return nil. */) /* char_quoted does UPDATE_SYNTAX_TABLE_BACKWARD (from). */ quoted = char_quoted (from, from_byte); c = FETCH_CHAR_AS_MULTIBYTE (from_byte); + syntax = SYNTAX_WITH_FLAGS (c); code = SYNTAX (c); comstyle = 0; - comnested = SYNTAX_COMMENT_NESTED (c); + comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax); if (code == Sendcomment) - comstyle = SYNTAX_COMMENT_STYLE (c); - if (from > stop && SYNTAX_COMEND_SECOND (c) + comstyle = SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0); + if (from > stop && SYNTAX_FLAGS_COMEND_SECOND (syntax) && prev_char_comend_first (from, from_byte) && !char_quoted (from - 1, dec_bytepos (from_byte))) { + int other_syntax; /* We must record the comment style encountered so that later, we can match only the proper comment begin sequence of the same style. */ @@ -2301,8 +2382,10 @@ between them, return t; otherwise return nil. */) /* Calling char_quoted, above, set up global syntax position at the new value of FROM. */ c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte); - comstyle = SYNTAX_COMMENT_STYLE (c1); - comnested = comnested || SYNTAX_COMMENT_NESTED (c1); + other_syntax = SYNTAX_WITH_FLAGS (c1); + comstyle = SYNTAX_FLAGS_COMMENT_STYLE (other_syntax, syntax); + comnested + = comnested || SYNTAX_FLAGS_COMMENT_NESTED (other_syntax); } if (code == Scomment_fence) @@ -2349,7 +2432,7 @@ between them, return t; otherwise return nil. */) { /* Failure: we should go back to the end of this not-quite-endcomment. */ - if (SYNTAX(c) != code) + if (SYNTAX (c) != code) /* It was a two-char Sendcomment. */ INC_BOTH (from, from_byte); goto leave; @@ -2423,21 +2506,23 @@ scan_lists (register EMACS_INT from, EMACS_INT count, EMACS_INT depth, int sexpf { while (from < stop) { - int comstart_first, prefix; + int comstart_first, prefix, syntax, other_syntax; UPDATE_SYNTAX_TABLE_FORWARD (from); c = FETCH_CHAR_AS_MULTIBYTE (from_byte); + syntax = SYNTAX_WITH_FLAGS (c); code = SYNTAX_WITH_MULTIBYTE_CHECK (c); - comstart_first = SYNTAX_COMSTART_FIRST (c); - comnested = SYNTAX_COMMENT_NESTED (c); - comstyle = SYNTAX_COMMENT_STYLE (c); - prefix = SYNTAX_PREFIX (c); + comstart_first = SYNTAX_FLAGS_COMSTART_FIRST (syntax); + comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax); + comstyle = SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0); + prefix = SYNTAX_FLAGS_PREFIX (syntax); if (depth == min_depth) last_good = from; INC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_FORWARD (from); if (from < stop && comstart_first && (c = FETCH_CHAR_AS_MULTIBYTE (from_byte), - SYNTAX_COMSTART_SECOND (c)) + other_syntax = SYNTAX_WITH_FLAGS (c), + SYNTAX_FLAGS_COMSTART_SECOND (other_syntax)) && parse_sexp_ignore_comments) { /* we have encountered a comment start sequence and we @@ -2446,9 +2531,9 @@ scan_lists (register EMACS_INT from, EMACS_INT count, EMACS_INT depth, int sexpf only a comment end of the same style actually ends the comment section */ code = Scomment; - c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte); - comstyle = SYNTAX_COMMENT_STYLE (c1); - comnested = comnested || SYNTAX_COMMENT_NESTED (c1); + comstyle = SYNTAX_FLAGS_COMMENT_STYLE (other_syntax, syntax); + comnested + = comnested || SYNTAX_FLAGS_COMMENT_NESTED (other_syntax); INC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_FORWARD (from); } @@ -2592,29 +2677,34 @@ scan_lists (register EMACS_INT from, EMACS_INT count, EMACS_INT depth, int sexpf { while (from > stop) { + int syntax; DEC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); c = FETCH_CHAR_AS_MULTIBYTE (from_byte); + syntax= SYNTAX_WITH_FLAGS (c); code = SYNTAX_WITH_MULTIBYTE_CHECK (c); if (depth == min_depth) last_good = from; comstyle = 0; - comnested = SYNTAX_COMMENT_NESTED (c); + comnested = SYNTAX_FLAGS_COMMENT_NESTED (syntax); if (code == Sendcomment) - comstyle = SYNTAX_COMMENT_STYLE (c); - if (from > stop && SYNTAX_COMEND_SECOND (c) + comstyle = SYNTAX_FLAGS_COMMENT_STYLE (syntax, 0); + if (from > stop && SYNTAX_FLAGS_COMEND_SECOND (syntax) && prev_char_comend_first (from, from_byte) && parse_sexp_ignore_comments) { /* We must record the comment style encountered so that later, we can match only the proper comment begin sequence of the same style. */ + int c1, other_syntax; DEC_BOTH (from, from_byte); UPDATE_SYNTAX_TABLE_BACKWARD (from); code = Sendcomment; c1 = FETCH_CHAR_AS_MULTIBYTE (from_byte); - comstyle = SYNTAX_COMMENT_STYLE (c1); - comnested = comnested || SYNTAX_COMMENT_NESTED (c1); + other_syntax = SYNTAX_WITH_FLAGS (c1); + comstyle = SYNTAX_FLAGS_COMMENT_STYLE (other_syntax, syntax); + comnested + = comnested || SYNTAX_FLAGS_COMMENT_NESTED (other_syntax); } /* Quoting turns anything except a comment-ender @@ -2625,7 +2715,7 @@ scan_lists (register EMACS_INT from, EMACS_INT count, EMACS_INT depth, int sexpf DEC_BOTH (from, from_byte); code = Sword; } - else if (SYNTAX_PREFIX (c)) + else if (SYNTAX_FLAGS_PREFIX (syntax)) continue; switch (SWITCH_ENUM_CAST (code)) @@ -2949,8 +3039,11 @@ do { prev_from = from; \ oldstate = Fcdr (oldstate); oldstate = Fcdr (oldstate); tem = Fcar (oldstate); - state.comstyle = NILP (tem) ? 0 : (EQ (tem, Qsyntax_table) - ? ST_COMMENT_STYLE : 1); + state.comstyle = (NILP (tem) + ? 0 + : (EQ (tem, Qsyntax_table) + ? ST_COMMENT_STYLE + : INTEGERP (tem) ? XINT (tem) : 1)); oldstate = Fcdr (oldstate); tem = Fcar (oldstate); @@ -2995,22 +3088,25 @@ do { prev_from = from; \ while (from < end) { + int syntax; INC_FROM; code = prev_from_syntax & 0xff; if (from < end && SYNTAX_FLAGS_COMSTART_FIRST (prev_from_syntax) && (c1 = FETCH_CHAR (from_byte), - SYNTAX_COMSTART_SECOND (c1))) + syntax = SYNTAX_WITH_FLAGS (c1), + SYNTAX_FLAGS_COMSTART_SECOND (syntax))) /* Duplicate code to avoid a complex if-expression which causes trouble for the SGI compiler. */ { /* Record the comment style we have entered so that only the comment-end sequence of the same style actually terminates the comment section. */ - state.comstyle = SYNTAX_COMMENT_STYLE (c1); + state.comstyle + = SYNTAX_FLAGS_COMMENT_STYLE (syntax, prev_from_syntax); comnested = SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax); - comnested = comnested || SYNTAX_COMMENT_NESTED (c1); + comnested = comnested || SYNTAX_FLAGS_COMMENT_NESTED (syntax); state.incomment = comnested ? 1 : -1; state.comstr_start = prev_from; INC_FROM; @@ -3028,7 +3124,7 @@ do { prev_from = from; \ } else if (code == Scomment) { - state.comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax); + state.comstyle = SYNTAX_FLAGS_COMMENT_STYLE (prev_from_syntax, 0); state.incomment = (SYNTAX_FLAGS_COMMENT_NESTED (prev_from_syntax) ? 1 : -1); state.comstr_start = prev_from; @@ -3221,8 +3317,7 @@ Value is a list of elements describing final state of parsing: else an integer (the current comment nesting). 5. t if following a quote character. 6. the minimum paren-depth encountered during this scan. - 7. t if in a comment of style b; symbol `syntax-table' if the comment - should be terminated by a generic comment delimiter. + 7. style of comment, if any. 8. character address of start of comment or string; nil if not in one. 9. Intermediate data for continuation of parsing (subject to change). If third arg TARGETDEPTH is non-nil, parsing stops if the depth @@ -3258,8 +3353,10 @@ Sixth arg COMMENTSTOP non-nil means stop at the start of a comment. SET_PT (state.location); return Fcons (make_number (state.depth), - Fcons (state.prevlevelstart < 0 ? Qnil : make_number (state.prevlevelstart), - Fcons (state.thislevelstart < 0 ? Qnil : make_number (state.thislevelstart), + Fcons (state.prevlevelstart < 0 + ? Qnil : make_number (state.prevlevelstart), + Fcons (state.thislevelstart < 0 + ? Qnil : make_number (state.thislevelstart), Fcons (state.instring >= 0 ? (state.instring == ST_STRING_STYLE ? Qt : make_number (state.instring)) : Qnil, @@ -3270,8 +3367,9 @@ Sixth arg COMMENTSTOP non-nil means stop at the start of a comment. Fcons (make_number (state.mindepth), Fcons ((state.comstyle ? (state.comstyle == ST_COMMENT_STYLE - ? Qsyntax_table : Qt) : - Qnil), + ? Qsyntax_table + : make_number (state.comstyle)) + : Qnil), Fcons (((state.incomment || (state.instring >= 0)) ? make_number (state.comstr_start) diff --git a/src/syntax.h b/src/syntax.h index 9eaf553f2e5..48146572d19 100644 --- a/src/syntax.h +++ b/src/syntax.h @@ -128,56 +128,9 @@ extern Lisp_Object syntax_temp; : Qnil)) #endif -/* Then there are seven single-bit flags that have the following meanings: - 1. This character is the first of a two-character comment-start sequence. - 2. This character is the second of a two-character comment-start sequence. - 3. This character is the first of a two-character comment-end sequence. - 4. This character is the second of a two-character comment-end sequence. - 5. This character is a prefix, for backward-prefix-chars. - 6. see below - 7. This character is part of a nestable comment sequence. - Note that any two-character sequence whose first character has flag 1 - and whose second character has flag 2 will be interpreted as a comment start. - bit 6 is used to discriminate between two different comment styles. - Languages such as C++ allow two orthogonal syntax start/end pairs - and bit 6 is used to determine whether a comment-end or Scommentend - ends style a or b. Comment start sequences can start style a or b. - Style a is always the default. - */ - -/* These macros extract a particular flag for a given character. */ - -#define SYNTAX_COMSTART_FIRST(c) ((SYNTAX_WITH_FLAGS (c) >> 16) & 1) - -#define SYNTAX_COMSTART_SECOND(c) ((SYNTAX_WITH_FLAGS (c) >> 17) & 1) - -#define SYNTAX_COMEND_FIRST(c) ((SYNTAX_WITH_FLAGS (c) >> 18) & 1) - -#define SYNTAX_COMEND_SECOND(c) ((SYNTAX_WITH_FLAGS (c) >> 19) & 1) - -#define SYNTAX_PREFIX(c) ((SYNTAX_WITH_FLAGS (c) >> 20) & 1) - -#define SYNTAX_COMMENT_STYLE(c) ((SYNTAX_WITH_FLAGS (c) >> 21) & 1) - -#define SYNTAX_COMMENT_NESTED(c) ((SYNTAX_WITH_FLAGS (c) >> 22) & 1) - -/* These macros extract specific flags from an integer - that holds the syntax code and the flags. */ - -#define SYNTAX_FLAGS_COMSTART_FIRST(flags) (((flags) >> 16) & 1) - -#define SYNTAX_FLAGS_COMSTART_SECOND(flags) (((flags) >> 17) & 1) - -#define SYNTAX_FLAGS_COMEND_FIRST(flags) (((flags) >> 18) & 1) - -#define SYNTAX_FLAGS_COMEND_SECOND(flags) (((flags) >> 19) & 1) - -#define SYNTAX_FLAGS_PREFIX(flags) (((flags) >> 20) & 1) - -#define SYNTAX_FLAGS_COMMENT_STYLE(flags) (((flags) >> 21) & 1) - -#define SYNTAX_FLAGS_COMMENT_NESTED(flags) (((flags) >> 22) & 1) +/* Whether the syntax of the character C has the prefix flag set. */ +extern int syntax_prefix_flag_p (int c); /* This array, indexed by a character, contains the syntax code which that character signifies (as a char). For example, diff --git a/src/sysdep.c b/src/sysdep.c index 2ae3c509522..e7d35d46bf7 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -35,15 +35,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #endif #include "lisp.h" -/* Including stdlib.h isn't necessarily enough to get srandom - declared, e.g. without __USE_XOPEN_EXTENDED with glibc 2. */ - -/* The w32 build defines select stuff in w32.h, which is included by - sys/select.h (included below). */ -#ifndef WINDOWSNT #include "sysselect.h" -#endif - #include "blockinput.h" #ifdef WINDOWSNT @@ -84,17 +76,13 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <fcntl.h> #endif -#ifndef MSDOS -#include <sys/ioctl.h> -#endif - #include "systty.h" #include "syswait.h" -#if defined (USG) +#ifdef HAVE_SYS_UTSNAME_H #include <sys/utsname.h> #include <memory.h> -#endif /* USG */ +#endif /* HAVE_SYS_UTSNAME_H */ #include "keyboard.h" #include "frame.h" @@ -149,17 +137,6 @@ static const int baud_convert[] = 1800, 2400, 4800, 9600, 19200, 38400 }; -#ifdef HAVE_SPEED_T -#include <termios.h> -#else -#if defined (HAVE_LIBNCURSES) && ! defined (NCURSES_OSPEED_T) -#else -#if defined (HAVE_TERMIOS_H) && defined (GNU_LINUX) -#include <termios.h> -#endif -#endif -#endif - int emacs_ospeed; void croak (char *) NO_RETURN; @@ -308,32 +285,11 @@ init_baud_rate (int fd) #ifdef DOS_NT emacs_ospeed = 15; #else /* not DOS_NT */ -#ifdef HAVE_TERMIOS struct termios sg; sg.c_cflag = B9600; tcgetattr (fd, &sg); emacs_ospeed = cfgetospeed (&sg); -#else /* not TERMIOS */ -#ifdef HAVE_TERMIO - struct termio sg; - - sg.c_cflag = B9600; -#ifdef HAVE_TCATTR - tcgetattr (fd, &sg); -#else - ioctl (fd, TCGETA, &sg); -#endif - emacs_ospeed = sg.c_cflag & CBAUD; -#else /* neither TERMIOS nor TERMIO */ - struct sgttyb sg; - - sg.sg_ospeed = B9600; - if (ioctl (fd, TIOCGETP, &sg) < 0) - abort (); - emacs_ospeed = sg.sg_ospeed; -#endif /* not HAVE_TERMIO */ -#endif /* not HAVE_TERMIOS */ #endif /* not DOS_NT */ } @@ -417,7 +373,7 @@ wait_for_termination (int pid) void flush_pending_output (int channel) { -#ifdef HAVE_TERMIOS +#ifndef DOS_NT /* If we try this, we get hit with SIGTTIN, because the child's tty belongs to the child's pgrp. */ #else @@ -447,8 +403,6 @@ child_setup_tty (int out) struct emacs_tty s; EMACS_GET_TTY (out, &s); - -#if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS) s.main.c_oflag |= OPOST; /* Enable output postprocessing */ s.main.c_oflag &= ~ONLCR; /* Disable map of NL to CR-NL on output */ #ifdef NLDLY @@ -526,19 +480,7 @@ child_setup_tty (int out) s.main.c_cc[VTIME] = 0; #endif -#else /* not HAVE_TERMIO */ - - s.main.sg_flags &= ~(ECHO | CRMOD | ANYP | ALLDELAY | RAW | LCASE - | CBREAK | TANDEM); - s.main.sg_flags |= LPASS8; - s.main.sg_erase = 0377; - s.main.sg_kill = 0377; - s.lmode = LLITOUT | s.lmode; /* Don't strip 8th bit */ - -#endif /* not HAVE_TERMIO */ - EMACS_SET_TTY (out, &s, 0); - #endif /* not WINDOWSNT */ } #endif /* MSDOS */ @@ -841,38 +783,11 @@ int emacs_get_tty (int fd, struct emacs_tty *settings) { /* Retrieve the primary parameters - baud rate, character size, etcetera. */ -#ifdef HAVE_TCATTR +#ifndef DOS_NT /* We have those nifty POSIX tcmumbleattr functions. */ memset (&settings->main, 0, sizeof (settings->main)); if (tcgetattr (fd, &settings->main) < 0) return -1; - -#else -#ifdef HAVE_TERMIO - /* The SYSV-style interface? */ - if (ioctl (fd, TCGETA, &settings->main) < 0) - return -1; - -#else -#ifndef DOS_NT - /* I give up - I hope you have the BSD ioctls. */ - if (ioctl (fd, TIOCGETP, &settings->main) < 0) - return -1; -#endif /* not DOS_NT */ -#endif -#endif - - /* Suivant - Do we have to get struct ltchars data? */ -#ifdef HAVE_LTCHARS - if (ioctl (fd, TIOCGLTC, &settings->ltchars) < 0) - return -1; -#endif - - /* How about a struct tchars and a wordful of lmode bits? */ -#ifdef HAVE_TCHARS - if (ioctl (fd, TIOCGETC, &settings->tchars) < 0 - || ioctl (fd, TIOCLGET, &settings->lmode) < 0) - return -1; #endif /* We have survived the tempest. */ @@ -888,7 +803,7 @@ int emacs_set_tty (int fd, struct emacs_tty *settings, int flushp) { /* Set the primary parameters - baud rate, character size, etcetera. */ -#ifdef HAVE_TCATTR +#ifndef DOS_NT int i; /* We have those nifty POSIX tcmumbleattr functions. William J. Smith <wjs@wiis.wang.com> writes: @@ -926,34 +841,6 @@ emacs_set_tty (int fd, struct emacs_tty *settings, int flushp) else continue; } - -#else -#ifdef HAVE_TERMIO - /* The SYSV-style interface? */ - if (ioctl (fd, flushp ? TCSETAF : TCSETAW, &settings->main) < 0) - return -1; - -#else -#ifndef DOS_NT - /* I give up - I hope you have the BSD ioctls. */ - if (ioctl (fd, (flushp) ? TIOCSETP : TIOCSETN, &settings->main) < 0) - return -1; -#endif /* not DOS_NT */ - -#endif -#endif - - /* Suivant - Do we have to get struct ltchars data? */ -#ifdef HAVE_LTCHARS - if (ioctl (fd, TIOCSLTC, &settings->ltchars) < 0) - return -1; -#endif - - /* How about a struct tchars and a wordful of lmode bits? */ -#ifdef HAVE_TCHARS - if (ioctl (fd, TIOCSETC, &settings->tchars) < 0 - || ioctl (fd, TIOCLSET, &settings->lmode) < 0) - return -1; #endif /* We have survived the tempest. */ @@ -976,13 +863,6 @@ unsigned char _sobuf[BUFSIZ+8]; char _sobuf[BUFSIZ]; #endif -#ifdef HAVE_LTCHARS -static struct ltchars new_ltchars = {-1,-1,-1,-1,-1,-1}; -#endif -#ifdef HAVE_TCHARS -static struct tchars new_tchars = {-1,-1,-1,-1,-1,-1}; -#endif - /* Initialize the terminal mode on all tty devices that are currently open. */ @@ -1016,7 +896,7 @@ init_sys_modes (struct tty_display_info *tty_out) tty = *tty_out->old_tty; -#if defined (HAVE_TERMIO) || defined (HAVE_TERMIOS) +#if !defined (DOS_NT) XSETINT (Vtty_erase_char, tty.main.c_cc[VERASE]); tty.main.c_iflag |= (IGNBRK); /* Ignore break condition */ @@ -1088,12 +968,11 @@ init_sys_modes (struct tty_display_info *tty_out) of C-z */ #endif /* VSWTCH */ -#if defined (__mips__) || defined (HAVE_TCATTR) #ifdef VSUSP - tty.main.c_cc[VSUSP] = CDISABLE; /* Turn off mips handling of C-z. */ + tty.main.c_cc[VSUSP] = CDISABLE; /* Turn off handling of C-z. */ #endif /* VSUSP */ #ifdef V_DSUSP - tty.main.c_cc[V_DSUSP] = CDISABLE; /* Turn off mips handling of C-y. */ + tty.main.c_cc[V_DSUSP] = CDISABLE; /* Turn off handling of C-y. */ #endif /* V_DSUSP */ #ifdef VDSUSP /* Some systems have VDSUSP, some have V_DSUSP. */ tty.main.c_cc[VDSUSP] = CDISABLE; @@ -1129,7 +1008,6 @@ init_sys_modes (struct tty_display_info *tty_out) tty.main.c_cc[VSTOP] = CDISABLE; #endif /* VSTOP */ } -#endif /* mips or HAVE_TCATTR */ #ifdef AIX tty.main.c_cc[VSTRT] = CDISABLE; @@ -1152,41 +1030,8 @@ init_sys_modes (struct tty_display_info *tty_out) tty.main.c_iflag &= ~IGNBRK; tty.main.c_iflag &= ~BRKINT; #endif -#else /* if not HAVE_TERMIO */ -#ifndef DOS_NT - XSETINT (Vtty_erase_char, tty.main.sg_erase); - tty.main.sg_flags &= ~(ECHO | CRMOD | XTABS); - if (meta_key) - tty.main.sg_flags |= ANYP; - tty.main.sg_flags |= interrupt_input ? RAW : CBREAK; #endif /* not DOS_NT */ -#endif /* not HAVE_TERMIO */ - - /* If going to use CBREAK mode, we must request C-g to interrupt - and turn off start and stop chars, etc. If not going to use - CBREAK mode, do this anyway so as to turn off local flow - control for user coming over network on 4.2; in this case, - only t_stopc and t_startc really matter. */ -#ifndef HAVE_TERMIO -#ifdef HAVE_TCHARS - /* Note: if not using CBREAK mode, it makes no difference how we - set this */ - tty.tchars = new_tchars; - tty.tchars.t_intrc = quit_char; - if (tty_out->flow_control) - { - tty.tchars.t_startc = '\021'; - tty.tchars.t_stopc = '\023'; - } - tty.lmode = LDECCTQ | LLITOUT | LPASS8 | LNOFLSH | tty_out->old_tty.lmode; - -#endif /* HAVE_TCHARS */ -#endif /* not HAVE_TERMIO */ - -#ifdef HAVE_LTCHARS - tty.ltchars = new_ltchars; -#endif /* HAVE_LTCHARS */ #ifdef MSDOS /* Demacs 1.1.2 91/10/20 Manabu Higashida, MW Aug 1993 */ if (!tty_out->term_initted) internal_terminal_init (); @@ -1205,7 +1050,7 @@ init_sys_modes (struct tty_display_info *tty_out) if (!tty_out->flow_control) ioctl (fileno (tty_out->input), TIOCSTART, 0); #endif -#if defined (HAVE_TERMIOS) || defined (HPUX) +#if !defined (DOS_NT) #ifdef TCOON if (!tty_out->flow_control) tcflow (fileno (tty_out->input), TCOON); #endif @@ -2688,7 +2533,7 @@ strsignal (int code) } #endif /* HAVE_STRSIGNAL */ -#ifdef HAVE_TERMIOS +#ifndef DOS_NT /* For make-serial-process */ int serial_open (char *port) @@ -2717,9 +2562,6 @@ serial_open (char *port) return fd; } -#endif /* TERMIOS */ - -#ifdef HAVE_TERMIOS #if !defined (HAVE_CFMAKERAW) /* Workaround for targets which are missing cfmakeraw. */ @@ -2906,7 +2748,7 @@ serial_configure (struct Lisp_Process *p, p->childp = childp2; } -#endif /* TERMIOS */ +#endif /* not DOS_NT */ /* System depended enumeration of and access to system processes a-la ps(1). */ diff --git a/src/sysselect.h b/src/sysselect.h index ddb3e91f2e3..0c90814390c 100644 --- a/src/sysselect.h +++ b/src/sysselect.h @@ -27,6 +27,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #endif #endif +/* The w32 build defines select stuff in w32.h, which is included + where w32 needs it, but not where sysselect.h is included. The w32 + definitions in w32.h are incompatible with the below. */ +#ifndef WINDOWSNT #ifdef FD_SET #ifdef FD_SETSIZE #define MAXDESC FD_SETSIZE @@ -44,6 +48,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #define FD_ISSET(n, p) (*(p) & (1 << (n))) #define FD_ZERO(p) (*(p) = 0) #endif /* no FD_SET */ +#endif /* not WINDOWSNT */ #if !defined (HAVE_SELECT) #define select sys_select diff --git a/src/systty.h b/src/systty.h index 39feef9c3d0..8c46411cedb 100644 --- a/src/systty.h +++ b/src/systty.h @@ -17,34 +17,17 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ -#ifdef HAVE_TERMIOS -#define HAVE_TCATTR -#endif - - /* Include the proper files. */ -#ifdef HAVE_TERMIO +#ifndef DOS_NT #ifndef NO_TERMIO #include <termio.h> #endif /* not NO_TERMIO */ -#include <fcntl.h> -#else /* not HAVE_TERMIO */ -#ifdef HAVE_TERMIOS -#ifndef NO_TERMIO -#include <termio.h> -#endif #include <termios.h> #include <fcntl.h> -#else /* neither HAVE_TERMIO nor HAVE_TERMIOS */ -#ifndef DOS_NT -#include <sgtty.h> #endif /* not DOS_NT */ -#endif /* not HAVE_TERMIOS */ -#endif /* not HAVE_TERMIO */ -#ifdef __GNU_LIBRARY__ +#ifdef HAVE_SYS_IOCTL_H #include <sys/ioctl.h> -#include <termios.h> #endif #ifdef HPUX @@ -74,17 +57,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #undef SIGIO #endif -/* On TERMIOS systems, the tcmumbleattr calls take care of these - parameters, and it's a bad idea to use them (on AIX, it makes the - tty hang for a long time). */ -#if defined (TIOCGLTC) && !defined (HAVE_TERMIOS) -#define HAVE_LTCHARS -#endif - -#if defined (TIOCGETC) && !defined (HAVE_TERMIOS) -#define HAVE_TCHARS -#endif - /* Try to establish the correct character to disable terminal functions in a system-independent manner. Note that USG (at least) define @@ -111,60 +83,19 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #define EMACS_OUTQSIZE(fd, size) (ioctl ((fd), TIOCOUTQ, (size))) #endif -#ifdef HAVE_TERMIO -#ifdef TCOUTQ -#undef EMACS_OUTQSIZE -#define EMACS_OUTQSIZE(fd, size) (ioctl ((fd), TCOUTQ, (size))) -#endif -#endif - /* Manipulate a terminal's current process group. */ -/* EMACS_HAVE_TTY_PGRP is true if we can get and set the tty's current - controlling process group. - - EMACS_GET_TTY_PGRP(int FD, int *PGID) sets *PGID the terminal FD's +/* EMACS_GET_TTY_PGRP(int FD, int *PGID) sets *PGID the terminal FD's current process group. Return -1 if there is an error. EMACS_SET_TTY_PGRP(int FD, int *PGID) sets the terminal FD's current process group to *PGID. Return -1 if there is an error. */ -/* HPUX tty process group stuff doesn't work, says the anonymous voice - from the past. */ -#ifndef HPUX -#ifdef TIOCGPGRP -#define EMACS_HAVE_TTY_PGRP -#else -#ifdef HAVE_TERMIOS -#define EMACS_HAVE_TTY_PGRP -#endif /* HAVE_TERMIOS */ -#endif /* TIOCGPGRP */ -#endif /* not HPUX */ - -#ifdef EMACS_HAVE_TTY_PGRP - -#if defined (HAVE_TERMIOS) - +#ifndef DOS_NT #define EMACS_GET_TTY_PGRP(fd, pgid) (*(pgid) = tcgetpgrp ((fd))) #define EMACS_SET_TTY_PGRP(fd, pgid) (tcsetpgrp ((fd), *(pgid))) - -#else /* not HAVE_TERMIOS */ -#ifdef TIOCSPGRP - -#define EMACS_GET_TTY_PGRP(fd, pgid) (ioctl ((fd), TIOCGPGRP, (pgid))) -#define EMACS_SET_TTY_PGRP(fd, pgid) (ioctl ((fd), TIOCSPGRP, (pgid))) - -#endif /* TIOCSPGRP */ -#endif /* HAVE_TERMIOS */ - -#else /* not EMACS_SET_TTY_PGRP */ - -/* Just ignore this for now and hope for the best */ -#define EMACS_GET_TTY_PGRP(fd, pgid) 0 -#define EMACS_SET_TTY_PGRP(fd, pgif) 0 - -#endif /* not EMACS_SET_TTY_PGRP */ +#endif /* not DOS_NT */ /* EMACS_GETPGRP (arg) returns the process group of the process. */ @@ -207,32 +138,11 @@ struct emacs_tty { /* There is always one of the following elements, so there is no need for dummy get and set definitions. */ -#ifdef HAVE_TCATTR +#ifndef DOS_NT struct termios main; -#else /* not HAVE_TCATTR */ -#ifdef HAVE_TERMIO - struct termio main; -#else /* not HAVE_TERMIO */ -#ifdef DOS_NT +#else /* DOS_NT */ int main; -#else /* not DOS_NT */ - struct sgttyb main; -#endif /* not DOS_NT */ -#endif /* not HAVE_TERMIO */ -#endif /* not HAVE_TCATTR */ - -/* If we have TERMIOS, we don't need to do this - they're taken care of - by the tc*attr calls. */ -#ifndef HAVE_TERMIOS -#ifdef HAVE_LTCHARS - struct ltchars ltchars; -#endif /* HAVE_LTCHARS */ - -#ifdef HAVE_TCHARS - struct tchars tchars; - int lmode; -#endif /* HAVE_TCHARS */ -#endif /* not defined HAVE_TERMIOS */ +#endif /* DOS_NT */ }; /* Define EMACS_GET_TTY and EMACS_SET_TTY, @@ -249,7 +159,7 @@ extern int emacs_set_tty (int, struct emacs_tty *, int); /* Define EMACS_TTY_TABS_OK. */ -#ifdef HAVE_TERMIOS +#ifndef DOS_NT #ifdef TABDLY #define EMACS_TTY_TABS_OK(p) (((p)->main.c_oflag & TABDLY) != TAB3) @@ -257,21 +167,9 @@ extern int emacs_set_tty (int, struct emacs_tty *, int); #define EMACS_TTY_TABS_OK(p) 1 #endif /* not TABDLY */ -#else /* not def HAVE_TERMIOS */ -#ifdef HAVE_TERMIO - -#define EMACS_TTY_TABS_OK(p) (((p)->main.c_oflag & TABDLY) != TAB3) - -#else /* neither HAVE_TERMIO nor HAVE_TERMIOS */ - -#ifdef DOS_NT +#else /* DOS_NT */ #define EMACS_TTY_TABS_OK(p) 0 -#else /* not DOS_NT */ -#define EMACS_TTY_TABS_OK(p) (((p)->main.sg_flags & XTABS) != XTABS) -#endif /* not DOS_NT */ - -#endif /* not def HAVE_TERMIO */ -#endif /* not def HAVE_TERMIOS */ +#endif /* DOS_NT */ /* arch-tag: cf4b90bc-be41-401c-be98-40619178a712 (do not change this comment) */ diff --git a/src/term.c b/src/term.c index 4f326234956..f090cdd2792 100644 --- a/src/term.c +++ b/src/term.c @@ -31,9 +31,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include <unistd.h> #endif -#if HAVE_TERMIOS_H -#include <termios.h> /* For TIOCNOTTY. */ -#endif #ifdef HAVE_SYS_IOCTL_H #include <sys/ioctl.h> #endif @@ -692,7 +689,8 @@ encode_terminal_code (struct glyph *src, int src_len, struct coding_system *codi encode_terminal_src_size); buf = encode_terminal_src + nbytes; } - if (char_charset (c, charset_list, NULL)) + if (CHAR_BYTE8_P (c) + || char_charset (c, charset_list, NULL)) { /* Store the multibyte form of C at BUF. */ buf += CHAR_STRING (c, buf); @@ -1617,18 +1615,15 @@ produce_glyphs (struct it *it) goto done; } - /* Maybe translate single-byte characters to multibyte. */ - it->char_to_display = it->c; - - if (it->c >= 040 && it->c < 0177) + if (it->char_to_display >= 040 && it->char_to_display < 0177) { it->pixel_width = it->nglyphs = 1; if (it->glyph_row) append_glyph (it); } - else if (it->c == '\n') + else if (it->char_to_display == '\n') it->pixel_width = it->nglyphs = 0; - else if (it->c == '\t') + else if (it->char_to_display == '\t') { int absolute_x = (it->current_x + it->continuation_lines_width); @@ -1659,32 +1654,19 @@ produce_glyphs (struct it *it) it->pixel_width = nspaces; it->nglyphs = nspaces; } - else if (CHAR_BYTE8_P (it->c)) + else if (CHAR_BYTE8_P (it->char_to_display)) { - if (unibyte_display_via_language_environment - && (it->c >= 0240)) - { - it->char_to_display = BYTE8_TO_CHAR (it->c); - it->pixel_width = CHAR_WIDTH (it->char_to_display); - it->nglyphs = it->pixel_width; - if (it->glyph_row) - append_glyph (it); - } - else - { - /* Coming here means that it->c is from display table, thus - we must send the raw 8-bit byte as is to the terminal. - Although there's no way to know how many columns it - occupies on a screen, it is a good assumption that a - single byte code has 1-column width. */ - it->pixel_width = it->nglyphs = 1; - if (it->glyph_row) - append_glyph (it); - } + /* Coming here means that we must send the raw 8-bit byte as is + to the terminal. Although there's no way to know how many + columns it occupies on a screen, it is a good assumption that + a single byte code has 1-column width. */ + it->pixel_width = it->nglyphs = 1; + if (it->glyph_row) + append_glyph (it); } else { - it->pixel_width = CHAR_WIDTH (it->c); + it->pixel_width = CHAR_WIDTH (it->char_to_display); it->nglyphs = it->pixel_width; if (it->glyph_row) @@ -1920,7 +1902,7 @@ produce_special_glyphs (struct it *it, enum display_element_type what) else abort (); - temp_it.c = GLYPH_CHAR (glyph); + temp_it.c = temp_it.char_to_display = GLYPH_CHAR (glyph); temp_it.face_id = GLYPH_FACE (glyph); temp_it.len = CHAR_BYTES (temp_it.c); diff --git a/src/unexcoff.c b/src/unexcoff.c index ed319ec8e7f..cb4b8d603b5 100644 --- a/src/unexcoff.c +++ b/src/unexcoff.c @@ -74,12 +74,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ * of Dell Computer Corporation. james@bigtex.cactus.org. */ -#ifndef emacs -#define PERROR(arg) perror (arg); return -1 -#else #include <config.h> #define PERROR(file) report_error (file, new) -#endif #ifndef CANNOT_DUMP /* all rest of file! */ @@ -88,6 +84,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #ifdef MSDOS #include <fcntl.h> /* for O_RDONLY, O_RDWR */ #include <crt0.h> /* for _crt0_startup_flags and its bits */ +#include <sys/exceptn.h> static int save_djgpp_startup_flags; #define filehdr external_filehdr #define scnhdr external_scnhdr @@ -132,8 +129,7 @@ struct aouthdr #endif -extern char *start_of_text (); /* Start of text */ -extern char *start_of_data (); /* Start of initialized data */ +extern char *start_of_data (void); /* Start of initialized data */ static long block_copy_start; /* Old executable start point */ static struct filehdr f_hdr; /* File header */ @@ -155,45 +151,33 @@ static int pagemask; #define ADDR_CORRECT(x) ((char *)(x) - (char*)0) -#ifdef emacs - #include <setjmp.h> #include "lisp.h" -static -report_error (file, fd) - char *file; - int fd; +static void +report_error (const char *file, int fd) { if (fd) close (fd); report_file_error ("Cannot unexec", Fcons (build_string (file), Qnil)); } -#endif /* emacs */ #define ERROR0(msg) report_error_1 (new, msg, 0, 0); return -1 #define ERROR1(msg,x) report_error_1 (new, msg, x, 0); return -1 #define ERROR2(msg,x,y) report_error_1 (new, msg, x, y); return -1 -static -report_error_1 (fd, msg, a1, a2) - int fd; - char *msg; - int a1, a2; +static void +report_error_1 (int fd, const char *msg, int a1, int a2) { close (fd); -#ifdef emacs error (msg, a1, a2); -#else - fprintf (stderr, msg, a1, a2); - fprintf (stderr, "\n"); -#endif } -static int make_hdr (); -static int copy_text_and_data (); -static int copy_sym (); -static void mark_x (); +static int make_hdr (int, int, unsigned, unsigned, unsigned, + const char *, const char *); +static int copy_text_and_data (int, int); +static int copy_sym (int, int, const char *, const char *); +static void mark_x (const char *); /* **************************************************************** * make_hdr @@ -202,13 +186,9 @@ static void mark_x (); * Modify the text and data sizes. */ static int -make_hdr (new, a_out, data_start, bss_start, entry_address, a_name, new_name) - int new, a_out; - unsigned data_start, bss_start, entry_address; - char *a_name; - char *new_name; +make_hdr (int new, int a_out, unsigned data_start, unsigned bss_start, + unsigned entry_address, const char *a_name, const char *new_name) { - int tem; auto struct scnhdr f_thdr; /* Text section header */ auto struct scnhdr f_dhdr; /* Data section header */ auto struct scnhdr f_bhdr; /* Bss section header */ @@ -319,9 +299,6 @@ make_hdr (new, a_out, data_start, bss_start, entry_address, a_name, new_name) to correspond to what we want to dump. */ f_hdr.f_flags |= (F_RELFLG | F_EXEC); - f_ohdr.text_start = (long) start_of_text (); - f_ohdr.tsize = data_start - f_ohdr.text_start; - f_ohdr.data_start = data_start; f_ohdr.dsize = bss_start - f_ohdr.data_start; f_ohdr.bsize = bss_end - bss_start; f_thdr.s_size = f_ohdr.tsize; @@ -379,12 +356,10 @@ make_hdr (new, a_out, data_start, bss_start, entry_address, a_name, new_name) } -write_segment (new, ptr, end) - int new; - register char *ptr, *end; +void +write_segment (int new, const char *ptr, const char *end) { register int i, nwrite, ret; - char buf[80]; /* This is the normal amount to write at once. It is the size of block that NFS uses. */ int writesize = 1 << 13; @@ -417,16 +392,6 @@ write_segment (new, ptr, end) nwrite = pagesize; write (new, zeros, nwrite); } -#if 0 /* Now that we have can ask `write' to write more than a page, - it is legit for write do less than the whole amount specified. */ - else if (nwrite != ret) - { - sprintf (buf, - "unexec write failure: addr 0x%x, fileno %d, size 0x%x, wrote 0x%x, errno %d", - ptr, new, nwrite, ret, errno); - PERROR (buf); - } -#endif i += nwrite; ptr += nwrite; } @@ -437,8 +402,7 @@ write_segment (new, ptr, end) * Copy the text and data segments from memory to the new a.out */ static int -copy_text_and_data (new, a_out) - int new, a_out; +copy_text_and_data (int new, int a_out) { register char *end; register char *ptr; @@ -482,9 +446,7 @@ copy_text_and_data (new, a_out) * Copy the relocation information and symbol table from the a.out to the new */ static int -copy_sym (new, a_out, a_name, new_name) - int new, a_out; - char *a_name, *new_name; +copy_sym (int new, int a_out, const char *a_name, const char *new_name) { char page[1024]; int n; @@ -520,8 +482,7 @@ copy_sym (new, a_out, a_name, new_name) * After successfully building the new a.out, mark it executable */ static void -mark_x (name) - char *name; +mark_x (const char *name) { struct stat sbuf; int um; @@ -561,10 +522,8 @@ mark_x (name) a reasonable size buffer. But I don't have time to work on such things, so I am installing it as submitted to me. -- RMS. */ -adjust_lnnoptrs (writedesc, readdesc, new_name) - int writedesc; - int readdesc; - char *new_name; +int +adjust_lnnoptrs (int writedesc, int readdesc, const char *new_name) { register int nsyms; register int new; @@ -606,31 +565,16 @@ adjust_lnnoptrs (writedesc, readdesc, new_name) return 0; } -extern unsigned start __asm__ ("start"); - -/* - * Return the address of the start of the text segment prior to - * doing an unexec. After unexec the return value is undefined. - * See crt0.c for further explanation and _start. - * - */ - -char * -start_of_text (void) -{ - return ((char *) &start); -} - /* **************************************************************** * unexec * * driving logic. */ -unexec (new_name, a_name, data_start, bss_start, entry_address) - char *new_name, *a_name; - unsigned data_start, bss_start, entry_address; +int +unexec (const char *new_name, const char *a_name, + unsigned data_start, unsigned bss_start, unsigned entry_address) { - int new, a_out = -1; + int new = -1, a_out = -1; if (a_name && (a_out = open (a_name, O_RDONLY)) < 0) { @@ -648,7 +592,6 @@ unexec (new_name, a_name, data_start, bss_start, entry_address) ) { close (new); - /* unlink (new_name); /* Failed, unlink new a.out */ return -1; } diff --git a/src/unexmacosx.c b/src/unexmacosx.c index ef43e9bef12..5c450e062c6 100644 --- a/src/unexmacosx.c +++ b/src/unexmacosx.c @@ -267,7 +267,7 @@ unexec_copy (off_t dest, off_t src, ssize_t count) /* Debugging and informational messages routines. */ static void -unexec_error (char *format, ...) +unexec_error (const char *format, ...) { va_list ap; diff --git a/src/w16select.c b/src/w16select.c index 384b82ceff1..ef1b974752b 100644 --- a/src/w16select.c +++ b/src/w16select.c @@ -456,7 +456,7 @@ DEFUN ("w16-set-clipboard-data", Fw16_set_clipboard_data, Sw16_set_clipboard_dat (Lisp_Object string, Lisp_Object frame) { unsigned ok = 1, put_status = 0; - int nbytes, charset_info, no_crlf_conversion; + int nbytes, no_crlf_conversion; unsigned char *src, *dst = NULL; CHECK_STRING (string); @@ -494,9 +494,7 @@ DEFUN ("w16-set-clipboard-data", Fw16_set_clipboard_data, Sw16_set_clipboard_dat { /* We must encode contents of STRING according to what clipboard-coding-system specifies. */ - int bufsize; struct coding_system coding; - unsigned char *htext2; Lisp_Object coding_system = NILP (Vnext_selection_coding_system) ? Vselection_coding_system : Vnext_selection_coding_system; @@ -567,7 +565,7 @@ DEFUN ("w16-get-clipboard-data", Fw16_get_clipboard_data, Sw16_get_clipboard_dat unsigned data_size, truelen; unsigned char *htext = NULL; Lisp_Object ret = Qnil; - int no_crlf_conversion, require_decoding = 0; + int require_decoding = 0; if (NILP (frame)) frame = Fselected_frame (); @@ -608,8 +606,6 @@ DEFUN ("w16-get-clipboard-data", Fw16_get_clipboard_data, Sw16_get_clipboard_dat } if (require_decoding) { - int bufsize; - unsigned char *buf; struct coding_system coding; Lisp_Object coding_system = Vnext_selection_coding_system; diff --git a/src/w32fns.c b/src/w32fns.c index d1f21e8acdd..f91ad948828 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -3109,9 +3109,6 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) HIMC context; struct window *w; - if (!context) - break; - f = x_window_to_frame (dpyinfo, hwnd); w = XWINDOW (FRAME_SELECTED_WINDOW (f)); @@ -3129,6 +3126,10 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) - WINDOW_MODE_LINE_HEIGHT (w)); context = get_ime_context_fn (hwnd); + + if (!context) + break; + set_ime_composition_window_fn (context, &form); release_ime_context_fn (hwnd, context); } @@ -6812,6 +6813,7 @@ frame_parm_handler w32_frame_parm_handlers[] = x_set_font_backend, x_set_alpha, 0, /* x_set_sticky */ + 0, /* x_set_tool_bar_position */ }; void diff --git a/src/w32menu.c b/src/w32menu.c index 919f8505da8..0ed9bffe70c 100644 --- a/src/w32menu.c +++ b/src/w32menu.c @@ -72,10 +72,16 @@ typedef BOOL (WINAPI * SetMenuItemInfoA_Proc) ( IN UINT, IN BOOL, IN LPCMENUITEMINFOA); +typedef int (WINAPI * MessageBoxW_Proc) ( + IN HWND window, + IN WCHAR *text, + IN WCHAR *caption, + IN UINT type); GetMenuItemInfoA_Proc get_menu_item_info = NULL; SetMenuItemInfoA_Proc set_menu_item_info = NULL; AppendMenuW_Proc unicode_append_menu = NULL; +MessageBoxW_Proc unicode_message_box = NULL; Lisp_Object Qdebug_on_next_call; @@ -99,6 +105,8 @@ static int is_simple_dialog (Lisp_Object); static Lisp_Object simple_dialog_show (FRAME_PTR, Lisp_Object, Lisp_Object); #endif +static void utf8to16 (unsigned char *, int, WCHAR *); + void w32_free_menu_strings (HWND); @@ -412,12 +420,8 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p) set_buffer_internal_1 (XBUFFER (buffer)); - /* Run the Lucid hook. */ + /* Run the hooks. */ safe_run_hooks (Qactivate_menubar_hook); - /* If it has changed current-menubar from previous value, - really recompute the menubar from the value. */ - if (! NILP (Vlucid_menu_bar_dirty_flag)) - call0 (Qrecompute_lucid_menubar); safe_run_hooks (Qmenu_bar_update_hook); FRAME_MENU_BAR_ITEMS (f) = menu_bar_items (FRAME_MENU_BAR_ITEMS (f)); @@ -662,7 +666,7 @@ free_frame_menubar (FRAME_PTR f) Lisp_Object w32_menu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps, - Lisp_Object title, char **error) + Lisp_Object title, const char **error) { int i; int menu_item_selection; @@ -1220,30 +1224,73 @@ simple_dialog_show (FRAME_PTR f, Lisp_Object contents, Lisp_Object header) { int answer; UINT type; - char *text, *title; Lisp_Object lispy_answer = Qnil, temp = XCAR (contents); - if (STRINGP (temp)) - text = SDATA (temp); - else - text = ""; + type = MB_YESNO; + + /* Since we only handle Yes/No dialogs, and we already checked + is_simple_dialog, we don't need to worry about checking contents + to see what type of dialog to use. */ - if (NILP (header)) + /* Use unicode if possible, so any language can be displayed. */ + if (unicode_message_box) { - title = "Question"; - type = MB_ICONQUESTION; + WCHAR *text, *title; + + if (STRINGP (temp)) + { + char *utf8_text = SDATA (ENCODE_UTF_8 (temp)); + /* Be pessimistic about the number of characters needed. + Remember characters outside the BMP will take more than + one utf16 word, so we cannot simply use the character + length of temp. */ + int utf8_len = strlen (utf8_text); + text = alloca ((utf8_len + 1) * sizeof (WCHAR)); + utf8to16 (utf8_text, utf8_len, text); + } + else + { + text = L""; + } + + if (NILP (header)) + { + title = L"Question"; + type |= MB_ICONQUESTION; + } + else + { + title = L"Information"; + type |= MB_ICONINFORMATION; + } + + answer = unicode_message_box (FRAME_W32_WINDOW (f), text, title, type); } else { - title = "Information"; - type = MB_ICONINFORMATION; - } - type |= MB_YESNO; + char *text, *title; - /* Since we only handle Yes/No dialogs, and we already checked - is_simple_dialog, we don't need to worry about checking contents - to see what type of dialog to use. */ - answer = MessageBox (FRAME_W32_WINDOW (f), text, title, type); + /* Fall back on ANSI message box, but at least use system + encoding so questions representable by the system codepage + are encoded properly. */ + if (STRINGP (temp)) + text = SDATA (ENCODE_SYSTEM (temp)); + else + text = ""; + + if (NILP (header)) + { + title = "Question"; + type |= MB_ICONQUESTION; + } + else + { + title = "Information"; + type |= MB_ICONINFORMATION; + } + + answer = MessageBox (FRAME_W32_WINDOW (f), text, title, type); + } if (answer == IDYES) lispy_answer = build_string ("Yes"); @@ -1280,9 +1327,9 @@ simple_dialog_show (FRAME_PTR f, Lisp_Object contents, Lisp_Object header) /* Is this item a separator? */ static int -name_is_separator (char *name) +name_is_separator (const char *name) { - char *start = name; + const char *start = name; /* Check if name string consists of only dashes ('-'). */ while (*name == '-') name++; @@ -1360,7 +1407,7 @@ add_menu_item (HMENU menu, widget_value *wv, HMENU item) strcat (out_string, wv->key); } else - out_string = wv->name; + out_string = (char *)wv->name; /* Quote any special characters within the menu item's text and key binding. */ @@ -1697,6 +1744,7 @@ globals_of_w32menu (void) get_menu_item_info = (GetMenuItemInfoA_Proc) GetProcAddress (user32, "GetMenuItemInfoA"); set_menu_item_info = (SetMenuItemInfoA_Proc) GetProcAddress (user32, "SetMenuItemInfoA"); unicode_append_menu = (AppendMenuW_Proc) GetProcAddress (user32, "AppendMenuW"); + unicode_message_box = (MessageBoxW_Proc) GetProcAddress (user32, "MessageBoxW"); } /* arch-tag: 0eaed431-bb4e-4aac-a527-95a1b4f1fed0 diff --git a/src/w32term.c b/src/w32term.c index fc03034b14b..992538e0e88 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -2106,17 +2106,34 @@ x_draw_stretch_glyph_string (struct glyph_string *s) if (s->hl == DRAW_CURSOR && !x_stretch_cursor_p) { - /* If `x-stretch-block-cursor' is nil, don't draw a block cursor - as wide as the stretch glyph. */ + /* If `x-stretch-cursor' is nil, don't draw a block cursor as + wide as the stretch glyph. */ int width, background_width = s->background_width; - int x = s->x, left_x = window_box_left_offset (s->w, TEXT_AREA); + int x = s->x; - if (x < left_x) + if (!s->row->reversed_p) { - background_width -= left_x - x; - x = left_x; + int left_x = window_box_left_offset (s->w, TEXT_AREA); + + if (x < left_x) + { + background_width -= left_x - x; + x = left_x; + } + } + else + { + /* In R2L rows, draw the cursor on the right edge of the + stretch glyph. */ + int right_x = window_box_right_offset (s->w, TEXT_AREA); + + if (x + background_width > right_x) + background_width -= x - right_x; + x += background_width; } width = min (FRAME_COLUMN_WIDTH (s->f), background_width); + if (s->row->reversed_p) + x -= width; /* Draw cursor. */ x_draw_glyph_string_bg_rect (s, x, s->y, width, s->height); @@ -2130,7 +2147,10 @@ x_draw_stretch_glyph_string (struct glyph_string *s) RECT r; HDC hdc = s->hdc; - x += width; + if (!s->row->reversed_p) + x += width; + else + x = s->x; if (s->row->mouse_face_p && cursor_in_mouse_face_p (s->w)) { @@ -4877,6 +4897,11 @@ x_draw_bar_cursor (struct window *w, struct glyph_row *row, w->phys_cursor_width = width; + /* If the character under cursor is R2L, draw the bar cursor + on the right of its glyph, rather than on the left. */ + if ((cursor_glyph->resolved_level & 1) != 0) + x += cursor_glyph->pixel_width - width; + w32_fill_area (f, hdc, cursor_color, x, WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y), width, row->height); diff --git a/src/w32uniscribe.c b/src/w32uniscribe.c index 9edd6353ba3..05cc8346a50 100644 --- a/src/w32uniscribe.c +++ b/src/w32uniscribe.c @@ -180,17 +180,18 @@ uniscribe_otf_capability (struct font *font) /* Uniscribe implementation of shape for font backend. - Shape text in LGSTRING. See the docstring of `font-make-gstring' - for the format of LGSTRING. If the (N+1)th element of LGSTRING - is nil, input of shaping is from the 1st to (N)th elements. In - each input glyph, FROM, TO, CHAR, and CODE are already set. + Shape text in LGSTRING. See the docstring of + `composition-get-gstring' for the format of LGSTRING. If the + (N+1)th element of LGSTRING is nil, input of shaping is from the + 1st to (N)th elements. In each input glyph, FROM, TO, CHAR, and + CODE are already set. This function updates all fields of the input glyphs. If the output glyphs (M) are more than the input glyphs (N), (N+1)th through (M)th elements of LGSTRING are updated possibly by making a new glyph object and storing it in LGSTRING. If (M) is greater - than the length of LGSTRING, nil should be return. In that case, - this function is called again with the larger LGSTRING. */ + than the length of LGSTRING, nil should be returned. In that case, + this function is called again with a larger LGSTRING. */ static Lisp_Object uniscribe_shape (Lisp_Object lgstring) { @@ -217,6 +218,9 @@ uniscribe_shape (Lisp_Object lgstring) max_glyphs = nchars = LGSTRING_GLYPH_LEN (lgstring); done_glyphs = 0; chars = (wchar_t *) alloca (nchars * sizeof (wchar_t)); + /* FIXME: This loop assumes that characters in the input LGSTRING + are all inside the BMP. Need to encode characters beyond the BMP + as UTF-16. */ for (i = 0; i < nchars; i++) { /* lgstring can be bigger than the number of characters in it, in @@ -248,9 +252,6 @@ uniscribe_shape (Lisp_Object lgstring) return Qnil; } - /* TODO: When we get BIDI support, we need to call ScriptLayout here. - Requires that we know the surrounding context. */ - glyphs = alloca (max_glyphs * sizeof (WORD)); clusters = alloca (nchars * sizeof (WORD)); attributes = alloca (max_glyphs * sizeof (SCRIPT_VISATTR)); @@ -259,8 +260,12 @@ uniscribe_shape (Lisp_Object lgstring) for (i = 0; i < nitems; i++) { - int nglyphs, nchars_in_run, rtl = items[i].a.fRTL ? -1 : 1; + int nglyphs, nchars_in_run; nchars_in_run = items[i+1].iCharPos - items[i].iCharPos; + /* Force ScriptShape to generate glyphs in the same order as + they are in the input LGSTRING, which is in the logical + order. */ + items[i].a.fLogicalOrder = 1; /* Context may be NULL here, in which case the cache should be used without needing to select the font. */ @@ -321,7 +326,7 @@ uniscribe_shape (Lisp_Object lgstring) { int j, nclusters, from, to; - from = rtl > 0 ? 0 : nchars_in_run - 1; + from = 0; to = from; for (j = 0; j < nglyphs; j++) @@ -342,22 +347,19 @@ uniscribe_shape (Lisp_Object lgstring) gl = glyphs[j]; LGLYPH_SET_CODE (lglyph, gl); - /* Detect clusters, for linking codes back to characters. */ + /* Detect clusters, for linking codes back to + characters. */ if (attributes[j].fClusterStart) { - while (from >= 0 && from < nchars_in_run - && clusters[from] < j) - from += rtl; - if (from < 0) - from = to = 0; - else if (from >= nchars_in_run) + while (from < nchars_in_run && clusters[from] < j) + from++; + if (from >= nchars_in_run) from = to = nchars_in_run - 1; else { int k; - to = rtl > 0 ? nchars_in_run - 1 : 0; - for (k = from + rtl; k >= 0 && k < nchars_in_run; - k += rtl) + to = nchars_in_run - 1; + for (k = from + 1; k < nchars_in_run; k++) { if (clusters[k] > j) { @@ -486,6 +488,10 @@ uniscribe_encode_char (struct font *font, int c) SCRIPT_VISATTR attrs[2]; int nglyphs; + /* Force ScriptShape to generate glyphs in the logical + order. */ + items[0].a.fLogicalOrder = 1; + result = ScriptShape (context, &(uniscribe_font->cache), ch, len, 2, &(items[0].a), glyphs, clusters, attrs, &nglyphs); diff --git a/src/xdisp.c b/src/xdisp.c index 80df99fee48..2ec271cdb6b 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -217,7 +217,26 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ glyph with suitably computed width. Both the blanks and the stretch glyph are given the face of the background of the line. This way, the terminal-specific back-end can still draw the glyphs - left to right, even for R2L lines. */ + left to right, even for R2L lines. + + Note one important detail mentioned above: that the bidi reordering + engine, driven by the iterator, produces characters in R2L rows + starting at the character that will be the rightmost on display. + As far as the iterator is concerned, the geometry of such rows is + still left to right, i.e. the iterator "thinks" the first character + is at the leftmost pixel position. The iterator does not know that + PRODUCE_GLYPHS reverses the order of the glyphs that the iterator + delivers. This is important when functions from the the move_it_* + family are used to get to certain screen position or to match + screen coordinates with buffer coordinates: these functions use the + iterator geometry, which is left to right even in R2L paragraphs. + This works well with most callers of move_it_*, because they need + to get to a specific column, and columns are still numbered in the + reading order, i.e. the rightmost character in a R2L paragraph is + still column zero. But some callers do not get well with this; a + notable example is mouse clicks that need to find the character + that corresponds to certain pixel coordinates. See + buffer_posn_from_coords in dispnew.c for how this is handled. */ #include <config.h> #include <stdio.h> @@ -1208,7 +1227,7 @@ window_box_left_offset (struct window *w, int area) /* Return the window-relative coordinate of the right edge of display - area AREA of window W. AREA < 0 means return the left edge of the + area AREA of window W. AREA < 0 means return the right edge of the whole window, to the left of the right fringe of W. */ INLINE int @@ -1238,7 +1257,7 @@ window_box_left (struct window *w, int area) /* Return the frame-relative coordinate of the right edge of display - area AREA of window W. AREA < 0 means return the left edge of the + area AREA of window W. AREA < 0 means return the right edge of the whole window, to the left of the right fringe of W. */ INLINE int @@ -3158,7 +3177,7 @@ compute_stop_pos (struct it *it) { register INTERVAL iv, next_iv; Lisp_Object object, limit, position; - EMACS_INT charpos, bytepos; + EMACS_INT charpos, bytepos, stoppos; /* If nowhere else, stop at the end. */ it->stop_charpos = it->end_charpos; @@ -3248,8 +3267,12 @@ compute_stop_pos (struct it *it) } } + if (it->bidi_p && it->bidi_it.scan_dir < 0) + stoppos = -1; + else + stoppos = it->stop_charpos; composition_compute_stop_pos (&it->cmp_it, charpos, bytepos, - it->stop_charpos, it->string); + stoppos, it->string); xassert (STRINGP (it->string) || (it->stop_charpos >= BEGV @@ -5739,10 +5762,23 @@ get_next_display_element (struct it *it) struct charset *unibyte = CHARSET_FROM_ID (charset_unibyte); enum { char_is_other = 0, char_is_nbsp, char_is_soft_hyphen } nbsp_or_shy = char_is_other; - int decoded = it->c; + int c = it->c; /* This is the character to display. */ + + if (! it->multibyte_p && ! ASCII_CHAR_P (c)) + { + xassert (SINGLE_BYTE_CHAR_P (c)); + if (unibyte_display_via_language_environment) + { + c = DECODE_CHAR (unibyte, c); + if (c < 0) + c = BYTE8_TO_CHAR (it->c); + } + else + c = BYTE8_TO_CHAR (it->c); + } if (it->dp - && (dv = DISP_CHAR_VECTOR (it->dp, it->c), + && (dv = DISP_CHAR_VECTOR (it->dp, c), VECTORP (dv))) { struct Lisp_Vector *v = XVECTOR (dv); @@ -5768,21 +5804,10 @@ get_next_display_element (struct it *it) goto get_next; } - if (unibyte_display_via_language_environment - && !ASCII_CHAR_P (it->c)) - decoded = DECODE_CHAR (unibyte, it->c); - - if (it->c >= 0x80 && ! NILP (Vnobreak_char_display)) - { - if (it->multibyte_p) - nbsp_or_shy = (it->c == 0xA0 ? char_is_nbsp - : it->c == 0xAD ? char_is_soft_hyphen - : char_is_other); - else if (unibyte_display_via_language_environment) - nbsp_or_shy = (decoded == 0xA0 ? char_is_nbsp - : decoded == 0xAD ? char_is_soft_hyphen - : char_is_other); - } + if (! ASCII_CHAR_P (c) && ! NILP (Vnobreak_char_display)) + nbsp_or_shy = (c == 0xA0 ? char_is_nbsp + : c == 0xAD ? char_is_soft_hyphen + : char_is_other); /* Translate control characters into `\003' or `^C' form. Control characters coming from a display table entry are @@ -5790,27 +5815,23 @@ get_next_display_element (struct it *it) the translation. This could easily be changed but I don't believe that it is worth doing. - If it->multibyte_p is nonzero, non-printable non-ASCII - characters are also translated to octal form. + NBSP and SOFT-HYPEN are property translated too. - If it->multibyte_p is zero, eight-bit characters that - don't have corresponding multibyte char code are also + Non-printable characters and raw-byte characters are also translated to octal form. */ - if ((it->c < ' ' + if (((c < ' ' || c == 127) /* ASCII control chars */ ? (it->area != TEXT_AREA /* In mode line, treat \n, \t like other crl chars. */ - || (it->c != '\t' + || (c != '\t' && it->glyph_row && (it->glyph_row->mode_line_p || it->avoid_cursor_p)) - || (it->c != '\n' && it->c != '\t')) + || (c != '\n' && c != '\t')) : (nbsp_or_shy - || (it->multibyte_p - ? ! CHAR_PRINTABLE_P (it->c) - : (! unibyte_display_via_language_environment - ? it->c >= 0x80 - : (decoded >= 0x80 && decoded < 0xA0)))))) + || CHAR_BYTE8_P (c) + || ! CHAR_PRINTABLE_P (c)))) { - /* IT->c is a control character which must be displayed + /* C is a control character, NBSP, SOFT-HYPEN, raw-byte, + or a non-printable character which must be displayed either as '\003' or as `^C' where the '\\' and '^' can be defined in the display table. Fill IT->ctl_chars with glyphs for what we have to @@ -5822,7 +5843,7 @@ get_next_display_element (struct it *it) /* Handle control characters with ^. */ - if (it->c < 128 && it->ctl_arrow_p) + if (ASCII_CHAR_P (c) && it->ctl_arrow_p) { int g; @@ -5855,7 +5876,7 @@ get_next_display_element (struct it *it) } XSETINT (it->ctl_chars[0], g); - XSETINT (it->ctl_chars[1], it->c ^ 0100); + XSETINT (it->ctl_chars[1], c ^ 0100); ctl_len = 2; goto display_control; } @@ -5870,7 +5891,7 @@ get_next_display_element (struct it *it) face_id = merge_faces (it->f, Qnobreak_space, 0, it->face_id); - it->c = ' '; + c = ' '; XSETINT (it->ctl_chars[0], ' '); ctl_len = 1; goto display_control; @@ -5916,7 +5937,6 @@ get_next_display_element (struct it *it) if (EQ (Vnobreak_char_display, Qt) && nbsp_or_shy == char_is_soft_hyphen) { - it->c = '-'; XSETINT (it->ctl_chars[0], '-'); ctl_len = 1; goto display_control; @@ -5928,55 +5948,25 @@ get_next_display_element (struct it *it) if (nbsp_or_shy) { XSETINT (it->ctl_chars[0], escape_glyph); - it->c = (nbsp_or_shy == char_is_nbsp ? ' ' : '-'); - XSETINT (it->ctl_chars[1], it->c); + c = (nbsp_or_shy == char_is_nbsp ? ' ' : '-'); + XSETINT (it->ctl_chars[1], c); ctl_len = 2; goto display_control; } { - unsigned char str[MAX_MULTIBYTE_LENGTH]; - int len; - int i; + char str[10]; + int len, i; - /* Set IT->ctl_chars[0] to the glyph for `\\'. */ - if (CHAR_BYTE8_P (it->c)) - { - str[0] = CHAR_TO_BYTE8 (it->c); - len = 1; - } - else if (it->c < 256) - { - str[0] = it->c; - len = 1; - } - else - { - /* It's an invalid character, which shouldn't - happen actually, but due to bugs it may - happen. Let's print the char as is, there's - not much meaningful we can do with it. */ - str[0] = it->c; - str[1] = it->c >> 8; - str[2] = it->c >> 16; - str[3] = it->c >> 24; - len = 4; - } + if (CHAR_BYTE8_P (c)) + /* Display \200 instead of \17777600. */ + c = CHAR_TO_BYTE8 (c); + len = sprintf (str, "%03o", c); + XSETINT (it->ctl_chars[0], escape_glyph); for (i = 0; i < len; i++) - { - int g; - XSETINT (it->ctl_chars[i * 4], escape_glyph); - /* Insert three more glyphs into IT->ctl_chars for - the octal display of the character. */ - g = ((str[i] >> 6) & 7) + '0'; - XSETINT (it->ctl_chars[i * 4 + 1], g); - g = ((str[i] >> 3) & 7) + '0'; - XSETINT (it->ctl_chars[i * 4 + 2], g); - g = (str[i] & 7) + '0'; - XSETINT (it->ctl_chars[i * 4 + 3], g); - } - ctl_len = len * 4; + XSETINT (it->ctl_chars[i + 1], str[i]); + ctl_len = len + 1; } display_control: @@ -5991,6 +5981,11 @@ get_next_display_element (struct it *it) it->ellipsis_p = 0; goto get_next; } + it->char_to_display = c; + } + else if (success_p) + { + it->char_to_display = it->c; } } @@ -6017,7 +6012,8 @@ get_next_display_element (struct it *it) : STRINGP (it->string) ? IT_STRING_CHARPOS (*it) : IT_CHARPOS (*it)); - it->face_id = FACE_FOR_CHAR (it->f, face, it->c, pos, it->string); + it->face_id = FACE_FOR_CHAR (it->f, face, it->char_to_display, pos, + it->string); } } #endif @@ -10839,7 +10835,7 @@ note_tool_bar_highlight (struct frame *f, int x, int y) enum draw_glyphs_face draw = DRAW_IMAGE_RAISED; int mouse_down_p, rc; - /* Function note_mouse_highlight is called with negative x(y + /* Function note_mouse_highlight is called with negative X/Y values when mouse moves outside of the frame. */ if (x <= 0 || y <= 0) { @@ -16458,15 +16454,19 @@ get_overlay_arrow_glyph_row (struct window *w, Lisp_Object overlay_arrow_string) /* Get the next character. */ if (multibyte_p) - it.c = string_char_and_length (p, &it.len); + it.c = it.char_to_display = string_char_and_length (p, &it.len); else - it.c = *p, it.len = 1; + { + it.c = it.char_to_display = *p, it.len = 1; + if (! ASCII_CHAR_P (it.c)) + it.char_to_display = BYTE8_TO_CHAR (it.c); + } p += it.len; /* Get its face. */ ilisp = make_number (p - arrow_string); face = Fget_text_property (ilisp, Qface, overlay_arrow_string); - it.face_id = compute_char_face (f, it.c, face); + it.face_id = compute_char_face (f, it.char_to_display, face); /* Compute its width, get its glyphs. */ n_glyphs_before = it.glyph_row->used[TEXT_AREA]; @@ -16698,6 +16698,7 @@ append_space_for_newline (struct it *it, int default_face_p) append_space_for_newline has been called. */ enum display_element_type saved_what = it->what; int saved_c = it->c, saved_len = it->len; + int saved_char_to_display = it->char_to_display; int saved_x = it->current_x; int saved_face_id = it->face_id; struct text_pos saved_pos; @@ -16710,7 +16711,7 @@ append_space_for_newline (struct it *it, int default_face_p) it->what = IT_CHARACTER; memset (&it->position, 0, sizeof it->position); it->object = make_number (0); - it->c = ' '; + it->c = it->char_to_display = ' '; it->len = 1; if (default_face_p) @@ -16731,6 +16732,7 @@ append_space_for_newline (struct it *it, int default_face_p) it->face_id = saved_face_id; it->len = saved_len; it->c = saved_c; + it->char_to_display = saved_char_to_display; return 1; } } @@ -16863,7 +16865,7 @@ extend_face_to_end_of_line (struct it *it) it->what = IT_CHARACTER; memset (&it->position, 0, sizeof it->position); it->object = make_number (0); - it->c = ' '; + it->c = it->char_to_display = ' '; it->len = 1; /* The last row's blank glyphs should get the default face, to avoid painting the rest of the window with the region face, @@ -17962,16 +17964,22 @@ See also `bidi-paragraph-direction'. */) struct bidi_it itb; EMACS_INT pos = BUF_PT (buf); EMACS_INT bytepos = BUF_PT_BYTE (buf); + int c; if (buf != current_buffer) set_buffer_temp (buf); - /* Find previous non-empty line. */ + /* bidi_paragraph_init finds the base direction of the paragraph + by searching forward from paragraph start. We need the base + direction of the current or _previous_ paragraph, so we need + to make sure we are within that paragraph. To that end, find + the previous non-empty line. */ if (pos >= ZV && pos > BEGV) { pos--; bytepos = CHAR_TO_BYTE (pos); } - while (FETCH_BYTE (bytepos) == '\n') + while ((c = FETCH_BYTE (bytepos)) == '\n' + || c == ' ' || c == '\t' || c == '\f') { if (bytepos <= BEGV_BYTE) break; @@ -17983,6 +17991,7 @@ See also `bidi-paragraph-direction'. */) itb.charpos = pos; itb.bytepos = bytepos; itb.first_elt = 1; + itb.separator_limit = -1; bidi_paragraph_init (NEUTRAL_DIR, &itb); if (buf != current_buffer) @@ -20460,7 +20469,12 @@ get_glyph_face_and_encoding (struct frame *f, struct glyph *glyph, if (face->font) { - unsigned code = face->font->driver->encode_char (face->font, glyph->u.ch); + unsigned code; + + if (CHAR_BYTE8_P (glyph->u.ch)) + code = CHAR_TO_BYTE8 (glyph->u.ch); + else + code = face->font->driver->encode_char (face->font, glyph->u.ch); if (code != FONT_INVALID_CODE) STORE_XCHAR2B (char2b, (code >> 8), (code & 0xFF)); @@ -20475,6 +20489,26 @@ get_glyph_face_and_encoding (struct frame *f, struct glyph *glyph, } +/* Get glyph code of character C in FONT in the two-byte form CHAR2B. + Retunr 1 if FONT has a glyph for C, otherwise return 0. */ + +static INLINE int +get_char_glyph_code (int c, struct font *font, XChar2b *char2b) +{ + unsigned code; + + if (CHAR_BYTE8_P (c)) + code = CHAR_TO_BYTE8 (c); + else + code = font->driver->encode_char (font, c); + + if (code == FONT_INVALID_CODE) + return 0; + STORE_XCHAR2B (char2b, (code >> 8), (code & 0xFF)); + return 1; +} + + /* Fill glyph string S with composition components specified by S->cmp. BASE_FACE is the base face of the composition. @@ -21879,10 +21913,14 @@ produce_stretch_glyph (struct it *it) { int maxlen = ((IT_BYTEPOS (*it) >= GPT ? ZV : GPT) - IT_BYTEPOS (*it)); - it2.c = STRING_CHAR_AND_LENGTH (p, it2.len); + it2.c = it2.char_to_display = STRING_CHAR_AND_LENGTH (p, it2.len); } else - it2.c = *p, it2.len = 1; + { + it2.c = it2.char_to_display = *p, it2.len = 1; + if (! ASCII_CHAR_P (it2.c)) + it2.char_to_display = BYTE8_TO_CHAR (it2.c); + } it2.glyph_row = NULL; it2.what = IT_CHARACTER; @@ -22052,49 +22090,12 @@ x_produce_glyphs (struct it *it) if (it->what == IT_CHARACTER) { XChar2b char2b; - struct font *font; struct face *face = FACE_FROM_ID (it->f, it->face_id); - struct font_metrics *pcm; - int font_not_found_p; + struct font *font = face->font; + int font_not_found_p = font == NULL; + struct font_metrics *pcm = NULL; int boff; /* baseline offset */ - /* We may change it->multibyte_p upon unibyte<->multibyte - conversion. So, save the current value now and restore it - later. - - Note: It seems that we don't have to record multibyte_p in - struct glyph because the character code itself tells whether - or not the character is multibyte. Thus, in the future, we - must consider eliminating the field `multibyte_p' in the - struct glyph. */ - int saved_multibyte_p = it->multibyte_p; - - /* Maybe translate single-byte characters to multibyte, or the - other way. */ - it->char_to_display = it->c; - if (!ASCII_BYTE_P (it->c) - && ! it->multibyte_p) - { - if (SINGLE_BYTE_CHAR_P (it->c) - && unibyte_display_via_language_environment) - { - struct charset *unibyte = CHARSET_FROM_ID (charset_unibyte); - - /* get_next_display_element assures that this decoding - never fails. */ - it->char_to_display = DECODE_CHAR (unibyte, it->c); - it->multibyte_p = 1; - it->face_id = FACE_FOR_CHAR (it->f, face, it->char_to_display, - -1, Qnil); - face = FACE_FROM_ID (it->f, it->face_id); - } - } - - /* Get font to use. Encode IT->char_to_display. */ - get_char_face_and_encoding (it->f, it->char_to_display, it->face_id, - &char2b, it->multibyte_p, 0); - font = face->font; - font_not_found_p = font == NULL; if (font_not_found_p) { /* When no suitable font found, display an empty box based @@ -22114,16 +22115,12 @@ x_produce_glyphs (struct it *it) boff = VCENTER_BASELINE_OFFSET (font, it->f) - boff; } - if (it->char_to_display >= ' ' - && (!it->multibyte_p || it->char_to_display < 128)) + if (it->char_to_display != '\n' && it->char_to_display != '\t') { - /* Either unibyte or ASCII. */ int stretched_p; it->nglyphs = 1; - pcm = get_per_char_metric (it->f, font, &char2b); - if (it->override_ascent >= 0) { it->ascent = it->override_ascent; @@ -22136,6 +22133,15 @@ x_produce_glyphs (struct it *it) it->descent = FONT_DESCENT (font) - boff; } + if (! font_not_found_p + && get_char_glyph_code (it->char_to_display, font, &char2b)) + { + pcm = get_per_char_metric (it->f, font, &char2b); + if (pcm->width == 0 + && pcm->rbearing == 0 && pcm->lbearing == 0) + pcm = NULL; + } + if (pcm) { it->phys_ascent = pcm->ascent + boff; @@ -22147,7 +22153,7 @@ x_produce_glyphs (struct it *it) it->glyph_not_available_p = 1; it->phys_ascent = it->ascent; it->phys_descent = it->descent; - it->pixel_width = FONT_WIDTH (font); + it->pixel_width = font->space_width; } if (it->constrain_row_ascent_descent_p) @@ -22321,7 +22327,7 @@ x_produce_glyphs (struct it *it) } } } - else if (it->char_to_display == '\t') + else /* i.e. (it->char_to_display == '\t') */ { if (font->space_width > 0) { @@ -22352,85 +22358,6 @@ x_produce_glyphs (struct it *it) it->nglyphs = 1; } } - else - { - /* A multi-byte character. Assume that the display width of the - character is the width of the character multiplied by the - width of the font. */ - - /* If we found a font, this font should give us the right - metrics. If we didn't find a font, use the frame's - default font and calculate the width of the character by - multiplying the width of font by the width of the - character. */ - - pcm = get_per_char_metric (it->f, font, &char2b); - - if (font_not_found_p || !pcm) - { - int char_width = CHAR_WIDTH (it->char_to_display); - - if (char_width == 0) - /* This is a non spacing character. But, as we are - going to display an empty box, the box must occupy - at least one column. */ - char_width = 1; - it->glyph_not_available_p = 1; - it->pixel_width = font->space_width * char_width; - it->phys_ascent = FONT_BASE (font) + boff; - it->phys_descent = FONT_DESCENT (font) - boff; - } - else - { - it->pixel_width = pcm->width; - it->phys_ascent = pcm->ascent + boff; - it->phys_descent = pcm->descent - boff; - if (it->glyph_row - && (pcm->lbearing < 0 - || pcm->rbearing > pcm->width)) - it->glyph_row->contains_overlapping_glyphs_p = 1; - } - it->nglyphs = 1; - it->ascent = FONT_BASE (font) + boff; - it->descent = FONT_DESCENT (font) - boff; - if (face->box != FACE_NO_BOX) - { - int thick = face->box_line_width; - - if (thick > 0) - { - it->ascent += thick; - it->descent += thick; - } - else - thick = - thick; - - if (it->start_of_box_run_p) - it->pixel_width += thick; - if (it->end_of_box_run_p) - it->pixel_width += thick; - } - - /* If face has an overline, add the height of the overline - (1 pixel) and a 1 pixel margin to the character height. */ - if (face->overline_p) - it->ascent += overline_margin; - - take_vertical_position_into_account (it); - - if (it->ascent < 0) - it->ascent = 0; - if (it->descent < 0) - it->descent = 0; - - if (it->glyph_row) - append_glyph (it); - if (it->pixel_width == 0) - /* We assure that all visible glyphs have at least 1-pixel - width. */ - it->pixel_width = 1; - } - it->multibyte_p = saved_multibyte_p; } else if (it->what == IT_COMPOSITION && it->cmp_it.ch < 0) { @@ -22526,7 +22453,7 @@ x_produce_glyphs (struct it *it) } else { - width = FONT_WIDTH (font); + width = font->space_width; ascent = FONT_BASE (font); descent = FONT_DESCENT (font); lbearing = 0; diff --git a/src/xfns.c b/src/xfns.c index bc28ccd3a63..cb6733e8fa1 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -648,12 +648,16 @@ int x_defined_color (struct frame *f, const char *color_name, XColor *color, int alloc_p) { - int success_p; + int success_p = 0; Display *dpy = FRAME_X_DISPLAY (f); Colormap cmap = FRAME_X_COLORMAP (f); BLOCK_INPUT; - success_p = XParseColor (dpy, cmap, color_name, color); +#ifdef USE_GTK + success_p = xg_check_special_colors (f, color_name, color); +#endif + if (!success_p) + success_p = XParseColor (dpy, cmap, color_name, color); if (success_p && alloc_p) success_p = x_alloc_nearest_color (f, cmap, color); UNBLOCK_INPUT; @@ -3388,6 +3392,8 @@ This function is an internal primitive--use `make-frame' instead. */) "waitForWM", "WaitForWM", RES_TYPE_BOOLEAN); x_default_parameter (f, parms, Qfullscreen, Qnil, "fullscreen", "Fullscreen", RES_TYPE_SYMBOL); + x_default_parameter (f, parms, Qtool_bar_position, + f->tool_bar_position, 0, 0, RES_TYPE_SYMBOL); /* Compute the size of the X window. */ window_prompting = x_figure_window_size (f, parms, 1); @@ -5233,7 +5239,7 @@ Value is t if tooltip was open, nil otherwise. */) /* When using system tooltip, tip_frame is the Emacs frame on which the tip is shown. */ f = XFRAME (frame); - if (xg_hide_tooltip (f)) + if (FRAME_LIVE_P (f) && xg_hide_tooltip (f)) frame = Qnil; #endif diff --git a/src/xmenu.c b/src/xmenu.c index 0b24a8f2bd6..68b442388a5 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -111,7 +111,7 @@ Lisp_Object Qdebug_on_next_call; #if defined (USE_X_TOOLKIT) || defined (USE_GTK) static Lisp_Object xdialog_show (FRAME_PTR, int, Lisp_Object, Lisp_Object, - char **); + const char **); #endif static int update_frame_menubar (struct frame *); @@ -312,7 +312,7 @@ for instance using the window manager, then this produces a quit and #else { Lisp_Object title; - char *error_name; + const char *error_name; Lisp_Object selection; int specpdl_count = SPECPDL_INDEX (); @@ -1600,7 +1600,7 @@ create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv, Lisp_Object xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps, - Lisp_Object title, char **error, EMACS_UINT timestamp) + Lisp_Object title, const char **error, EMACS_UINT timestamp) { int i; widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0; @@ -1664,7 +1664,7 @@ xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps, { /* Create a new pane. */ Lisp_Object pane_name, prefix; - char *pane_string; + const char *pane_string; pane_name = AREF (menu_items, i + MENU_ITEMS_PANE_NAME); prefix = AREF (menu_items, i + MENU_ITEMS_PANE_PREFIX); @@ -1976,12 +1976,16 @@ create_and_show_dialog (FRAME_PTR f, widget_value *first_wv) #endif /* not USE_GTK */ -static char * button_names [] = { +static const char * button_names [] = { "button1", "button2", "button3", "button4", "button5", "button6", "button7", "button8", "button9", "button10" }; static Lisp_Object -xdialog_show (FRAME_PTR f, int keymaps, Lisp_Object title, Lisp_Object header, char **error_name) +xdialog_show (FRAME_PTR f, + int keymaps, + Lisp_Object title, + Lisp_Object header, + const char **error_name) { int i, nb_buttons=0; char dialog_name[6]; @@ -2008,7 +2012,7 @@ xdialog_show (FRAME_PTR f, int keymaps, Lisp_Object title, Lisp_Object header, c representing the text label and buttons. */ { Lisp_Object pane_name, prefix; - char *pane_string; + const char *pane_string; pane_name = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_NAME]; prefix = XVECTOR (menu_items)->contents[MENU_ITEMS_PANE_PREFIX]; pane_string = (NILP (pane_name) @@ -2239,7 +2243,7 @@ pop_down_menu (Lisp_Object arg) Lisp_Object xmenu_show (FRAME_PTR f, int x, int y, int for_click, int keymaps, - Lisp_Object title, char **error, EMACS_UINT timestamp) + Lisp_Object title, const char **error, EMACS_UINT timestamp) { Window root; XMenu *menu; diff --git a/src/xml.c b/src/xml.c new file mode 100644 index 00000000000..c1098b15a20 --- /dev/null +++ b/src/xml.c @@ -0,0 +1,141 @@ +/* Interface to libxml2. + Copyright (C) 2010 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ + +#include <config.h> + +#ifdef HAVE_LIBXML2 + +#include <setjmp.h> +#include <libxml/tree.h> +#include <libxml/parser.h> +#include <libxml/HTMLparser.h> + +#include "lisp.h" +#include "buffer.h" + +Lisp_Object make_dom (xmlNode *node) +{ + if (node->type == XML_ELEMENT_NODE) { + Lisp_Object result = Fcons (intern (node->name), Qnil); + xmlNode *child; + xmlAttr *property; + + /* First add the attributes. */ + property = node->properties; + while (property != NULL) { + if (property->children && + property->children->content) { + char *pname = xmalloc (strlen (property->name) + 2); + *pname = ':'; + strcpy(pname + 1, property->name); + result = Fcons (Fcons (intern (pname), + build_string(property->children->content)), + result); + xfree (pname); + } + property = property->next; + } + /* Then add the children of the node. */ + child = node->children; + while (child != NULL) { + result = Fcons (make_dom (child), result); + child = child->next; + } + return Fnreverse (result); + } else if (node->type == XML_TEXT_NODE) { + Lisp_Object content = Qnil; + + if (node->content) + content = build_string (node->content); + + return Fcons (intern (node->name), content); + } else + return Qnil; +} + +static Lisp_Object +parse_buffer (Lisp_Object string, Lisp_Object base_url, int htmlp) +{ + xmlDoc *doc; + xmlNode *node; + Lisp_Object result; + int ibeg, iend; + char *burl = ""; + + LIBXML_TEST_VERSION; + + CHECK_STRING (string); + + if (! NILP (base_url)) { + CHECK_STRING (base_url); + burl = SDATA (base_url); + } + + if (htmlp) + doc = htmlReadMemory (SDATA (string), SBYTES (string), burl, "utf-8", + HTML_PARSE_RECOVER|HTML_PARSE_NONET| + HTML_PARSE_NOWARNING|HTML_PARSE_NOERROR); + else + doc = xmlReadMemory (SDATA (string), SBYTES (string), burl, "utf-8", + XML_PARSE_NONET|XML_PARSE_NOWARNING| + XML_PARSE_NOERROR); + + if (doc != NULL) { + node = xmlDocGetRootElement (doc); + if (node != NULL) + result = make_dom (node); + + xmlFreeDoc (doc); + xmlCleanupParser (); + } + + return result; +} + +DEFUN ("html-parse-string", Fhtml_parse_string, Shtml_parse_string, + 0, 2, 0, + doc: /* Parse the string as an HTML document and return the parse tree. +If BASE-URL is non-nil, it will be used to expand relative URLs in +the HTML document.*/) + (Lisp_Object string, Lisp_Object base_url) +{ + return parse_buffer (string, base_url, 1); +} + +DEFUN ("xml-parse-string", Fxml_parse_string, Sxml_parse_string, + 0, 2, 0, + doc: /* Parse the string as an XML document and return the parse tree. +If BASE-URL is non-nil, it will be used to expand relative URLs in +the XML document.*/) + (Lisp_Object string, Lisp_Object base_url) +{ + return parse_buffer (string, base_url, 0); +} + + +/*********************************************************************** + Initialization + ***********************************************************************/ +void +syms_of_xml (void) +{ + defsubr (&Shtml_parse_string); + defsubr (&Sxml_parse_string); +} + +#endif /* HAVE_LIBXML2 */ diff --git a/src/xrdb.c b/src/xrdb.c index e0d948fd3a6..d81f08747ac 100644 --- a/src/xrdb.c +++ b/src/xrdb.c @@ -334,16 +334,17 @@ static XrmDatabase get_system_app (const char *class) { XrmDatabase db = NULL; - char *path; + const char *path; + char *p; path = getenv ("XFILESEARCHPATH"); if (! path) path = PATH_X_DEFAULTS; - path = search_magic_path (path, class, 0, 0); - if (path) + p = search_magic_path (path, class, 0, 0); + if (p) { - db = XrmGetFileDatabase (path); - xfree (path); + db = XrmGetFileDatabase (p); + xfree (p); } return db; @@ -360,7 +361,7 @@ get_fallback (Display *display) static XrmDatabase get_user_app (const char *class) { - char *path; + const char *path; char *file = 0; char *free_it = 0; diff --git a/src/xselect.c b/src/xselect.c index 9f15c7c2d99..7479f245a77 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -83,8 +83,6 @@ static void lisp_data_to_selection_data (Display *, Lisp_Object, unsigned char **, Atom *, unsigned *, int *, int *); static Lisp_Object clean_local_selection_data (Lisp_Object); -static void initialize_cut_buffers (Display *, Window); - /* Printing traces to stderr. */ @@ -105,9 +103,7 @@ static void initialize_cut_buffers (Display *, Window); #endif -#define CUT_BUFFER_SUPPORT - -Lisp_Object QPRIMARY, QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP, +Lisp_Object QSECONDARY, QSTRING, QINTEGER, QCLIPBOARD, QTIMESTAMP, QTEXT, QDELETE, QMULTIPLE, QINCR, QEMACS_TMP, QTARGETS, QATOM, QNULL, QATOM_PAIR; @@ -116,11 +112,6 @@ Lisp_Object QUTF8_STRING; /* This is a type of selection. */ Lisp_Object Qcompound_text_with_extensions; -#ifdef CUT_BUFFER_SUPPORT -Lisp_Object QCUT_BUFFER0, QCUT_BUFFER1, QCUT_BUFFER2, QCUT_BUFFER3, - QCUT_BUFFER4, QCUT_BUFFER5, QCUT_BUFFER6, QCUT_BUFFER7; -#endif - static Lisp_Object Vx_lost_selection_functions; static Lisp_Object Vx_sent_selection_functions; static Lisp_Object Qforeign_selection; @@ -270,16 +261,6 @@ symbol_to_x_atom (struct x_display_info *dpyinfo, Display *display, Lisp_Object if (EQ (sym, QEMACS_TMP)) return dpyinfo->Xatom_EMACS_TMP; if (EQ (sym, QTARGETS)) return dpyinfo->Xatom_TARGETS; if (EQ (sym, QNULL)) return dpyinfo->Xatom_NULL; -#ifdef CUT_BUFFER_SUPPORT - if (EQ (sym, QCUT_BUFFER0)) return XA_CUT_BUFFER0; - if (EQ (sym, QCUT_BUFFER1)) return XA_CUT_BUFFER1; - if (EQ (sym, QCUT_BUFFER2)) return XA_CUT_BUFFER2; - if (EQ (sym, QCUT_BUFFER3)) return XA_CUT_BUFFER3; - if (EQ (sym, QCUT_BUFFER4)) return XA_CUT_BUFFER4; - if (EQ (sym, QCUT_BUFFER5)) return XA_CUT_BUFFER5; - if (EQ (sym, QCUT_BUFFER6)) return XA_CUT_BUFFER6; - if (EQ (sym, QCUT_BUFFER7)) return XA_CUT_BUFFER7; -#endif if (!SYMBOLP (sym)) abort (); TRACE1 (" XInternAtom %s", (char *) SDATA (SYMBOL_NAME (sym))); @@ -315,24 +296,6 @@ x_atom_to_symbol (Display *dpy, Atom atom) return QINTEGER; case XA_ATOM: return QATOM; -#ifdef CUT_BUFFER_SUPPORT - case XA_CUT_BUFFER0: - return QCUT_BUFFER0; - case XA_CUT_BUFFER1: - return QCUT_BUFFER1; - case XA_CUT_BUFFER2: - return QCUT_BUFFER2; - case XA_CUT_BUFFER3: - return QCUT_BUFFER3; - case XA_CUT_BUFFER4: - return QCUT_BUFFER4; - case XA_CUT_BUFFER5: - return QCUT_BUFFER5; - case XA_CUT_BUFFER6: - return QCUT_BUFFER6; - case XA_CUT_BUFFER7: - return QCUT_BUFFER7; -#endif } dpyinfo = x_display_info_for_display (dpy); @@ -2258,195 +2221,6 @@ and t is the same as `SECONDARY'. */) } -#ifdef CUT_BUFFER_SUPPORT - -/* Ensure that all 8 cut buffers exist. ICCCM says we gotta... */ -static void -initialize_cut_buffers (Display *display, Window window) -{ - unsigned char *data = (unsigned char *) ""; - BLOCK_INPUT; -#define FROB(atom) XChangeProperty (display, window, atom, XA_STRING, 8, \ - PropModeAppend, data, 0) - FROB (XA_CUT_BUFFER0); - FROB (XA_CUT_BUFFER1); - FROB (XA_CUT_BUFFER2); - FROB (XA_CUT_BUFFER3); - FROB (XA_CUT_BUFFER4); - FROB (XA_CUT_BUFFER5); - FROB (XA_CUT_BUFFER6); - FROB (XA_CUT_BUFFER7); -#undef FROB - UNBLOCK_INPUT; -} - - -#define CHECK_CUT_BUFFER(symbol) \ - do { CHECK_SYMBOL ((symbol)); \ - if (!EQ((symbol), QCUT_BUFFER0) && !EQ((symbol), QCUT_BUFFER1) \ - && !EQ((symbol), QCUT_BUFFER2) && !EQ((symbol), QCUT_BUFFER3) \ - && !EQ((symbol), QCUT_BUFFER4) && !EQ((symbol), QCUT_BUFFER5) \ - && !EQ((symbol), QCUT_BUFFER6) && !EQ((symbol), QCUT_BUFFER7)) \ - signal_error ("Doesn't name a cut buffer", (symbol)); \ - } while (0) - -DEFUN ("x-get-cut-buffer-internal", Fx_get_cut_buffer_internal, - Sx_get_cut_buffer_internal, 1, 1, 0, - doc: /* Returns the value of the named cut buffer (typically CUT_BUFFER0). */) - (Lisp_Object buffer) -{ - Window window; - Atom buffer_atom; - unsigned char *data = NULL; - int bytes; - Atom type; - int format; - unsigned long size; - Lisp_Object ret; - Display *display; - struct x_display_info *dpyinfo; - struct frame *sf = SELECTED_FRAME (); - - check_x (); - - if (! FRAME_X_P (sf)) - return Qnil; - - display = FRAME_X_DISPLAY (sf); - dpyinfo = FRAME_X_DISPLAY_INFO (sf); - window = RootWindow (display, 0); /* Cut buffers are on screen 0 */ - CHECK_CUT_BUFFER (buffer); - buffer_atom = symbol_to_x_atom (dpyinfo, display, buffer); - - x_get_window_property (display, window, buffer_atom, &data, &bytes, - &type, &format, &size, 0); - - if (!data || !format) - { - xfree (data); - return Qnil; - } - - if (format != 8 || type != XA_STRING) - signal_error ("Cut buffer doesn't contain 8-bit data", - list2 (x_atom_to_symbol (display, type), - make_number (format))); - - ret = (bytes ? make_unibyte_string ((char *) data, bytes) : Qnil); - /* Use xfree, not XFree, because x_get_window_property - calls xmalloc itself. */ - xfree (data); - return ret; -} - - -DEFUN ("x-store-cut-buffer-internal", Fx_store_cut_buffer_internal, - Sx_store_cut_buffer_internal, 2, 2, 0, - doc: /* Sets the value of the named cut buffer (typically CUT_BUFFER0). */) - (Lisp_Object buffer, Lisp_Object string) -{ - Window window; - Atom buffer_atom; - unsigned char *data; - int bytes; - int bytes_remaining; - int max_bytes; - Display *display; - struct frame *sf = SELECTED_FRAME (); - - check_x (); - - if (! FRAME_X_P (sf)) - return Qnil; - - display = FRAME_X_DISPLAY (sf); - window = RootWindow (display, 0); /* Cut buffers are on screen 0 */ - - max_bytes = SELECTION_QUANTUM (display); - if (max_bytes > MAX_SELECTION_QUANTUM) - max_bytes = MAX_SELECTION_QUANTUM; - - CHECK_CUT_BUFFER (buffer); - CHECK_STRING (string); - buffer_atom = symbol_to_x_atom (FRAME_X_DISPLAY_INFO (sf), - display, buffer); - data = (unsigned char *) SDATA (string); - bytes = SBYTES (string); - bytes_remaining = bytes; - - if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized) - { - initialize_cut_buffers (display, window); - FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1; - } - - BLOCK_INPUT; - - /* Don't mess up with an empty value. */ - if (!bytes_remaining) - XChangeProperty (display, window, buffer_atom, XA_STRING, 8, - PropModeReplace, data, 0); - - while (bytes_remaining) - { - int chunk = (bytes_remaining < max_bytes - ? bytes_remaining : max_bytes); - XChangeProperty (display, window, buffer_atom, XA_STRING, 8, - (bytes_remaining == bytes - ? PropModeReplace - : PropModeAppend), - data, chunk); - data += chunk; - bytes_remaining -= chunk; - } - UNBLOCK_INPUT; - return string; -} - - -DEFUN ("x-rotate-cut-buffers-internal", Fx_rotate_cut_buffers_internal, - Sx_rotate_cut_buffers_internal, 1, 1, 0, - doc: /* Rotate the values of the cut buffers by N steps. -Positive N means shift the values forward, negative means backward. */) - (Lisp_Object n) -{ - Window window; - Atom props[8]; - Display *display; - struct frame *sf = SELECTED_FRAME (); - - check_x (); - - if (! FRAME_X_P (sf)) - return Qnil; - - display = FRAME_X_DISPLAY (sf); - window = RootWindow (display, 0); /* Cut buffers are on screen 0 */ - CHECK_NUMBER (n); - if (XINT (n) == 0) - return n; - if (! FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized) - { - initialize_cut_buffers (display, window); - FRAME_X_DISPLAY_INFO (sf)->cut_buffers_initialized = 1; - } - - props[0] = XA_CUT_BUFFER0; - props[1] = XA_CUT_BUFFER1; - props[2] = XA_CUT_BUFFER2; - props[3] = XA_CUT_BUFFER3; - props[4] = XA_CUT_BUFFER4; - props[5] = XA_CUT_BUFFER5; - props[6] = XA_CUT_BUFFER6; - props[7] = XA_CUT_BUFFER7; - BLOCK_INPUT; - XRotateWindowProperties (display, window, props, 8, XINT (n)); - UNBLOCK_INPUT; - return n; -} - -#endif - /*********************************************************************** Drag and drop support ***********************************************************************/ @@ -2596,6 +2370,7 @@ If the value is 0 or the atom is not known, return the empty string. */) { struct frame *f = check_x_frame (frame); char *name = 0; + char empty[] = ""; Lisp_Object ret = Qnil; Display *dpy = FRAME_X_DISPLAY (f); Atom atom; @@ -2612,7 +2387,7 @@ If the value is 0 or the atom is not known, return the empty string. */) BLOCK_INPUT; x_catch_errors (dpy); - name = atom ? XGetAtomName (dpy, atom) : ""; + name = atom ? XGetAtomName (dpy, atom) : empty; had_errors = x_had_errors_p (dpy); x_uncatch_errors (); @@ -2849,12 +2624,6 @@ syms_of_xselect (void) defsubr (&Sx_selection_owner_p); defsubr (&Sx_selection_exists_p); -#ifdef CUT_BUFFER_SUPPORT - defsubr (&Sx_get_cut_buffer_internal); - defsubr (&Sx_store_cut_buffer_internal); - defsubr (&Sx_rotate_cut_buffers_internal); -#endif - defsubr (&Sx_get_atom_name); defsubr (&Sx_send_client_message); defsubr (&Sx_register_dnd_atom); @@ -2936,17 +2705,6 @@ A value of 0 means wait as long as necessary. This is initialized from the Qcompound_text_with_extensions = intern_c_string ("compound-text-with-extensions"); staticpro (&Qcompound_text_with_extensions); -#ifdef CUT_BUFFER_SUPPORT - QCUT_BUFFER0 = intern_c_string ("CUT_BUFFER0"); staticpro (&QCUT_BUFFER0); - QCUT_BUFFER1 = intern_c_string ("CUT_BUFFER1"); staticpro (&QCUT_BUFFER1); - QCUT_BUFFER2 = intern_c_string ("CUT_BUFFER2"); staticpro (&QCUT_BUFFER2); - QCUT_BUFFER3 = intern_c_string ("CUT_BUFFER3"); staticpro (&QCUT_BUFFER3); - QCUT_BUFFER4 = intern_c_string ("CUT_BUFFER4"); staticpro (&QCUT_BUFFER4); - QCUT_BUFFER5 = intern_c_string ("CUT_BUFFER5"); staticpro (&QCUT_BUFFER5); - QCUT_BUFFER6 = intern_c_string ("CUT_BUFFER6"); staticpro (&QCUT_BUFFER6); - QCUT_BUFFER7 = intern_c_string ("CUT_BUFFER7"); staticpro (&QCUT_BUFFER7); -#endif - Qforeign_selection = intern_c_string ("foreign-selection"); staticpro (&Qforeign_selection); } diff --git a/src/xsmfns.c b/src/xsmfns.c index 0096110bd46..79dccfa55e1 100644 --- a/src/xsmfns.c +++ b/src/xsmfns.c @@ -87,7 +87,7 @@ Lisp_Object Vx_session_previous_id; /* The option to start Emacs without the splash screen when restarting Emacs. */ -#define NOSPLASH_OPT "--no-splash" +static char NOSPLASH_OPT[] = "--no-splash"; /* The option to make Emacs start in the given directory. */ @@ -198,14 +198,14 @@ smc_save_yourself_CB (SmcConn smcConn, SmPropValue values[20]; int val_idx = 0; int props_idx = 0; - + int i; char *cwd = NULL; char *smid_opt, *chdir_opt = NULL; /* How to start a new instance of Emacs. */ props[props_idx] = &prop_ptr[props_idx]; - props[props_idx]->name = SmCloneCommand; - props[props_idx]->type = SmLISTofARRAY8; + props[props_idx]->name = xstrdup (SmCloneCommand); + props[props_idx]->type = xstrdup (SmLISTofARRAY8); props[props_idx]->num_vals = 1; props[props_idx]->vals = &values[val_idx++]; props[props_idx]->vals[0].length = strlen (emacs_program); @@ -214,8 +214,8 @@ smc_save_yourself_CB (SmcConn smcConn, /* The name of the program. */ props[props_idx] = &prop_ptr[props_idx]; - props[props_idx]->name = SmProgram; - props[props_idx]->type = SmARRAY8; + props[props_idx]->name = xstrdup (SmProgram); + props[props_idx]->type = xstrdup (SmARRAY8); props[props_idx]->num_vals = 1; props[props_idx]->vals = &values[val_idx++]; props[props_idx]->vals[0].length = strlen (SSDATA (Vinvocation_name)); @@ -224,8 +224,8 @@ smc_save_yourself_CB (SmcConn smcConn, /* How to restart Emacs. */ props[props_idx] = &prop_ptr[props_idx]; - props[props_idx]->name = SmRestartCommand; - props[props_idx]->type = SmLISTofARRAY8; + props[props_idx]->name = xstrdup (SmRestartCommand); + props[props_idx]->type = xstrdup (SmLISTofARRAY8); /* /path/to/emacs, --smid=xxx --no-splash --chdir=dir */ props[props_idx]->num_vals = 4; props[props_idx]->vals = &values[val_idx]; @@ -258,8 +258,8 @@ smc_save_yourself_CB (SmcConn smcConn, /* User id. */ props[props_idx] = &prop_ptr[props_idx]; - props[props_idx]->name = SmUserID; - props[props_idx]->type = SmARRAY8; + props[props_idx]->name = xstrdup (SmUserID); + props[props_idx]->type = xstrdup (SmARRAY8); props[props_idx]->num_vals = 1; props[props_idx]->vals = &values[val_idx++]; props[props_idx]->vals[0].length = strlen (SSDATA (Vuser_login_name)); @@ -270,8 +270,8 @@ smc_save_yourself_CB (SmcConn smcConn, if (cwd) { props[props_idx] = &prop_ptr[props_idx]; - props[props_idx]->name = SmCurrentDirectory; - props[props_idx]->type = SmARRAY8; + props[props_idx]->name = xstrdup (SmCurrentDirectory); + props[props_idx]->type = xstrdup (SmARRAY8); props[props_idx]->num_vals = 1; props[props_idx]->vals = &values[val_idx++]; props[props_idx]->vals[0].length = strlen (cwd); @@ -286,6 +286,11 @@ smc_save_yourself_CB (SmcConn smcConn, xfree (chdir_opt); free (cwd); + for (i = 0; i < props_idx; ++i) + { + xfree (props[i]->type); + xfree (props[i]->name); + } /* See if we maybe shall interact with the user. */ if (interactStyle != SmInteractStyleAny diff --git a/src/xterm.c b/src/xterm.c index e6bf82ab5a5..2ebe8a80378 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -301,6 +301,9 @@ static Lisp_Object xg_default_icon_file; Lisp_Object Qx_gtk_map_stock; #endif +/* Some functions take this as char *, not const char *. */ +static char emacs_class[] = EMACS_CLASS; + /* Used in x_flush. */ extern XrmDatabase x_load_resources (Display *, const char *, const char *, @@ -2432,17 +2435,34 @@ x_draw_stretch_glyph_string (struct glyph_string *s) if (s->hl == DRAW_CURSOR && !x_stretch_cursor_p) { - /* If `x-stretch-block-cursor' is nil, don't draw a block cursor - as wide as the stretch glyph. */ + /* If `x-stretch-cursor' is nil, don't draw a block cursor as + wide as the stretch glyph. */ int width, background_width = s->background_width; - int x = s->x, left_x = window_box_left_offset (s->w, TEXT_AREA); + int x = s->x; - if (x < left_x) + if (!s->row->reversed_p) { - background_width -= left_x - x; - x = left_x; + int left_x = window_box_left_offset (s->w, TEXT_AREA); + + if (x < left_x) + { + background_width -= left_x - x; + x = left_x; + } + } + else + { + /* In R2L rows, draw the cursor on the right edge of the + stretch glyph. */ + int right_x = window_box_right_offset (s->w, TEXT_AREA); + + if (x + background_width > right_x) + background_width -= x - right_x; + x += background_width; } width = min (FRAME_COLUMN_WIDTH (s->f), background_width); + if (s->row->reversed_p) + x -= width; /* Draw cursor. */ x_draw_glyph_string_bg_rect (s, x, s->y, width, s->height); @@ -2455,7 +2475,10 @@ x_draw_stretch_glyph_string (struct glyph_string *s) XRectangle r; GC gc; - x += width; + if (!s->row->reversed_p) + x += width; + else + x = s->x; if (s->row->mouse_face_p && cursor_in_mouse_face_p (s->w)) { @@ -7129,14 +7152,20 @@ x_draw_bar_cursor (struct window *w, struct glyph_row *row, int width, enum text if (kind == BAR_CURSOR) { + int x = WINDOW_TEXT_TO_FRAME_PIXEL_X (w, w->phys_cursor.x); + if (width < 0) width = FRAME_CURSOR_WIDTH (f); width = min (cursor_glyph->pixel_width, width); w->phys_cursor_width = width; - XFillRectangle (dpy, window, gc, - WINDOW_TEXT_TO_FRAME_PIXEL_X (w, w->phys_cursor.x), + /* If the character under cursor is R2L, draw the bar cursor + on the right of its glyph, rather than on the left. */ + if ((cursor_glyph->resolved_level & 1) != 0) + x += cursor_glyph->pixel_width - width; + + XFillRectangle (dpy, window, gc, x, WINDOW_TO_FRAME_PIXEL_Y (w, w->phys_cursor.y), width, row->height); } @@ -7872,7 +7901,7 @@ xim_open_dpy (struct x_display_info *dpyinfo, char *resource_name) if (dpyinfo->xim) XCloseIM (dpyinfo->xim); xim = XOpenIM (dpyinfo->display, dpyinfo->xrdb, resource_name, - EMACS_CLASS); + emacs_class); dpyinfo->xim = xim; if (xim) @@ -7973,7 +8002,7 @@ xim_initialize (struct x_display_info *dpyinfo, char *resource_name) xim_inst->resource_name = (char *) xmalloc (len + 1); memcpy (xim_inst->resource_name, resource_name, len + 1); XRegisterIMInstantiateCallback (dpyinfo->display, dpyinfo->xrdb, - resource_name, EMACS_CLASS, + resource_name, emacs_class, xim_instantiate_callback, /* This is XPointer in XFree86 but (XPointer *) on Tru64, at @@ -7998,7 +8027,7 @@ xim_close_dpy (struct x_display_info *dpyinfo) #ifdef HAVE_X11R6_XIM if (dpyinfo->display) XUnregisterIMInstantiateCallback (dpyinfo->display, dpyinfo->xrdb, - NULL, EMACS_CLASS, + NULL, emacs_class, xim_instantiate_callback, NULL); xfree (dpyinfo->xim_callback_data->resource_name); xfree (dpyinfo->xim_callback_data); @@ -9709,6 +9738,9 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) } else { + static char display_opt[] = "--display"; + static char name_opt[] = "--name"; + for (argc = 0; argc < NUM_ARGV; ++argc) argv[argc] = 0; @@ -9717,11 +9749,11 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) if (! NILP (display_name)) { - argv[argc++] = "--display"; + argv[argc++] = display_opt; argv[argc++] = SDATA (display_name); } - argv[argc++] = "--name"; + argv[argc++] = name_opt; argv[argc++] = resource_name; XSetLocaleModifiers (""); @@ -9744,7 +9776,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) /* Load our own gtkrc if it exists. */ { - char *file = "~/.emacs.d/gtkrc"; + const char *file = "~/.emacs.d/gtkrc"; Lisp_Object s, abs_file; s = make_string (file, strlen (file)); @@ -10092,8 +10124,6 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo->Xatom_net_wm_name = XInternAtom (dpyinfo->display, "_NET_WM_NAME", False); - dpyinfo->cut_buffers_initialized = 0; - dpyinfo->x_dnd_atoms_size = 8; dpyinfo->x_dnd_atoms_length = 0; dpyinfo->x_dnd_atoms = xmalloc (sizeof (*dpyinfo->x_dnd_atoms) diff --git a/src/xterm.h b/src/xterm.h index 972bfb50dc3..d884945f985 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -299,8 +299,6 @@ struct x_display_info /* Atom used in XEmbed client messages. */ Atom Xatom_XEMBED; - int cut_buffers_initialized; /* Whether we're sure they all exist */ - /* The frame (if any) which has the X window that has keyboard focus. Zero if none. This is examined by Ffocus_frame in xfns.c. Note that a mere EnterNotify event can set this; if you need to know the diff --git a/test/ChangeLog b/test/ChangeLog index a226e88d883..12238560dc9 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,6 +1,14 @@ +2010-09-10 Stefan Monnier <monnier@iro.umontreal.ca> + + * indent/octave.m: Remove some `fixindent' not needed any more. + +2010-08-30 Stefan Monnier <monnier@iro.umontreal.ca> + + * indent/octave.m: New file. + 2010-08-08 Ulf Jasper <ulf.jasper@web.de> - * icalendar-testsuite.el (icalendar-testsuite-run): Added internal tests. + * icalendar-testsuite.el (icalendar-testsuite-run): Add internal tests. (icalendar-testsuite--trim, icalendar-testsuite--compare-strings) (icalendar-testsuite--run-internal-tests): New. (icalendar-testsuite--test-convert-ordinary-to-ical) @@ -13,7 +21,7 @@ (icalendar-testsuite--do-test-cycle): Use icalendar-testsuite--compare-strings (icalendar-testsuite--run-import-tests): Comment added. (icalendar-testsuite--run-import-tests) - (icalendar-testsuite--run-real-world-tests): Fixed expected results. + (icalendar-testsuite--run-real-world-tests): Fix expected results. 2010-06-25 Chong Yidong <cyd@stupidchicken.com> diff --git a/test/indent/Makefile b/test/indent/Makefile index 2a5b7f4c352..9e75f3dad57 100644 --- a/test/indent/Makefile +++ b/test/indent/Makefile @@ -8,8 +8,8 @@ clean: # - mark the places where the indentation is known to be incorrect, # and allow either ignoring those errors or not. %.test: % - -$(RM) $<.test + -$(RM) $<.new $(EMACS) --batch $< \ --eval '(indent-region (point-min) (point-max) nil)' \ - --eval '(write-region (point-min) (point-max) "$<.test")' - diff -u -B $< $<.test + --eval '(write-region (point-min) (point-max) "$<.new")' + diff -u -B $< $<.new diff --git a/test/indent/octave.m b/test/indent/octave.m new file mode 100644 index 00000000000..61db73b91e8 --- /dev/null +++ b/test/indent/octave.m @@ -0,0 +1,2318 @@ +## -*- octave -*- + +function res = tcomp (fn) + %% res = tcomp (fn) + %% imports components and rearranges them. + + if nargin ~= 1 + print_usage() + endif + + data = dlmread(fn, 3, 0); + + x = data(:,2:end); + y = 'hello'; + z = y'; + + cnty = repmat(x(:,1)(:), 10, 1); + + pop = x(:,1:10)(:); + bir = x(:,11:20)(:); + dth = x(:,21:30)(:); + imig = x(:,31:40)(:); + dmig = x(:,41:50)(:); + gq = x(:,51:60)(:); + + yrs = repmat(2000:2009, 39, 1)(:); + + res = [yrs, cnty, pop, bir, dth, imig, dmig, gq]; + +endfunction + +## Copyright (C) 2005, 2006, 2007, 2008, 2009 S�ren Hauberg +## +## This file is part of Octave. +## +## Octave is free software; you can redistribute it and/or modify it +## under the terms of the GNU General Public License as published by +## the Free Software Foundation; either version 3 of the License, or (at +## your option) any later version. +## +## Octave 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 Octave; see the file COPYING. If not, see +## <http://www.gnu.org/licenses/>. + +## -*- texinfo -*- +## @deftypefn {Command} pkg @var{command} @var{pkg_name} +## @deftypefnx {Command} pkg @var{command} @var{option} @var{pkg_name} +## This command interacts with the package manager. Different actions will +## be taken depending on the value of @var{command}. +## +## @table @samp +## @item install +## Install named packages. For example, +## @example +## pkg install image-1.0.0.tar.gz +## @end example +## @noindent +## installs the package found in the file @file{image-1.0.0.tar.gz}. +## +## The @var{option} variable can contain options that affect the manner +## in which a package is installed. These options can be one or more of +## +## @table @code +## @item -nodeps +## The package manager will disable the dependency checking. That way it +## is possible to install a package even if it depends on another package +## that's not installed on the system. @strong{Use this option with care.} +## +## @item -noauto +## The package manager will not automatically load the installed package +## when starting Octave, even if the package requests that it is. +## +## @item -auto +## The package manager will automatically load the installed package when +## starting Octave, even if the package requests that it isn't. +## +## @item -local +## A local installation is forced, even if the user has system privileges. +## +## @item -global +## A global installation is forced, even if the user doesn't normally have +## system privileges +## +## @item -verbose +## The package manager will print the output of all of the commands that are +## performed. +## @end table +## +## @item uninstall +## Uninstall named packages. For example, +## @example +## pkg uninstall image +## @end example +## @noindent +## removes the @code{image} package from the system. If another installed +## package depends on the @code{image} package an error will be issued. +## The package can be uninstalled anyway by using the @code{-nodeps} option. +## @item load +## Add named packages to the path. After loading a package it is +## possible to use the functions provided by the package. For example, +## @example +## pkg load image +## @end example +## @noindent +## adds the @code{image} package to the path. It is possible to load all +## installed packages at once with the command +## @example +## pkg load all +## @end example +## @item unload +## Removes named packages from the path. After unloading a package it is +## no longer possible to use the functions provided by the package. +## This command behaves like the @code{load} command. +## @item list +## Show a list of the currently installed packages. By requesting one or two +## output argument it is possible to get a list of the currently installed +## packages. For example, +## @example +## installed_packages = pkg list; +## @end example +## @noindent +## returns a cell array containing a structure for each installed package. +## The command +## @example +## [@var{user_packages}, @var{system_packages}] = pkg list +## @end example +## @noindent +## splits the list of installed packages into those who are installed by +## the current user, and those installed by the system administrator. +## @item describe +## Show a short description of the named installed packages, with the option +## '-verbose' also list functions provided by the package, e.g.: +## @example +## pkg describe -verbose all +## @end example +## @noindent +## will describe all installed packages and the functions they provide. +## If one output is requested a cell of structure containing the +## description and list of functions of each package is returned as +## output rather than printed on screen: +## @example +## desc = pkg ("describe", "secs1d", "image") +## @end example +## @noindent +## If any of the requested packages is not installed, pkg returns an +## error, unless a second output is requested: +## @example +## [ desc, flag] = pkg ("describe", "secs1d", "image") +## @end example +## @noindent +## @var{flag} will take one of the values "Not installed", "Loaded" or +## "Not loaded" for each of the named packages. +## @item prefix +## Set the installation prefix directory. For example, +## @example +## pkg prefix ~/my_octave_packages +## @end example +## @noindent +## sets the installation prefix to @file{~/my_octave_packages}. +## Packages will be installed in this directory. +## +## It is possible to get the current installation prefix by requesting an +## output argument. For example, +## @example +## p = pkg prefix +## @end example +## +## The location in which to install the architecture dependent files can be +## independent specified with an addition argument. For example +## +## @example +## pkg prefix ~/my_octave_packages ~/my_arch_dep_pkgs +## @end example +## @item local_list +## Set the file in which to look for information on the locally +## installed packages. Locally installed packages are those that are +## typically available only to the current user. For example +## @example +## pkg local_list ~/.octave_packages +## @end example +## It is possible to get the current value of local_list with the following +## @example +## pkg local_list +## @end example +## @item global_list +## Set the file in which to look for, for information on the globally +## installed packages. Globally installed packages are those that are +## typically available to all users. For example +## @example +## pkg global_list /usr/share/octave/octave_packages +## @end example +## It is possible to get the current value of global_list with the following +## @example +## pkg global_list +## @end example +## @item rebuild +## Rebuilds the package database from the installed directories. This can +## be used in cases where for some reason the package database is corrupted. +## It can also take the @code{-auto} and @code{-noauto} options to allow the +## autoloading state of a package to be changed. For example +## +## @example +## pkg rebuild -noauto image +## @end example +## +## will remove the autoloading status of the image package. +## @item build +## Builds a binary form of a package or packages. The binary file produced +## will itself be an Octave package that can be installed normally with +## @code{pkg}. The form of the command to build a binary package is +## +## @example +## pkg build builddir image-1.0.0.tar.gz @dots{} +## @end example +## +## @noindent +## where @code{builddir} is the name of a directory where the temporary +## installation will be produced and the binary packages will be found. +## The options @code{-verbose} and @code{-nodeps} are respected, while +## the other options are ignored. +## @end table +## @end deftypefn + +function [local_packages, global_packages] = pkg (varargin) + ## Installation prefix (FIXME: what should these be on windows?) + persistent user_prefix = false; + persistent prefix = -1; + persistent archprefix = -1; + persistent local_list = tilde_expand (fullfile ("~", ".octave_packages")); + persistent global_list = fullfile (OCTAVE_HOME (), "share", "octave", + "octave_packages"); + mlock (); + + global_install = issuperuser (); + + if (prefix == -1) + if (global_install) + prefix = fullfile (OCTAVE_HOME (), "share", "octave", "packages"); + archprefix = fullfile (octave_config_info ("libexecdir"), + "octave", "packages"); + else + prefix = fullfile ("~", "octave"); + archprefix = prefix; + endif + prefix = tilde_expand (prefix); + archprefix = tilde_expand (archprefix); + endif + + available_actions = {"list", "install", "uninstall", "load", ... + "unload", "prefix", "local_list", ... + "global_list", "rebuild", "build","describe"}; + ## Handle input + if (length (varargin) == 0 || ! iscellstr (varargin)) + print_usage (); + endif + files = {}; + deps = true; + auto = 0; + action = "none"; + verbose = false; + for i = 1:length (varargin) + switch (varargin{i}) + case "-nodeps" + deps = false; + case "-noauto" + auto = -1; + case "-auto" + auto = 1; + case "-verbose" + verbose = true; + case "-local" + global_install = false; + if (! user_prefix) + prefix = tilde_expand (fullfile ("~", "octave")); + archprefix = prefix; + endif + case "-global" + global_install = true; + if (! user_prefix) + prefix = fullfile (OCTAVE_HOME (), "share", "octave", "packages"); + archprefix = fullfile (octave_config_info ("libexecdir"), + "octave", "packages"); + endif + case available_actions + if (strcmp (action, "none")) + action = varargin{i}; + else + error ("more than one action specified"); + endif + otherwise + files{end+1} = varargin{i}; + endswitch + endfor + + ## Take action + switch (action) + case "list" + if (nargout == 0) + installed_packages (local_list, global_list); + elseif (nargout == 1) + local_packages = installed_packages (local_list, global_list); + elseif (nargout == 2) + [local_packages, global_packages] = installed_packages (local_list, + global_list); + else + error ("too many output arguments requested"); + endif + + case "install" + if (length (files) == 0) + error ("you must specify at least one filename when calling 'pkg install'"); + endif + install (files, deps, auto, prefix, archprefix, verbose, local_list, + global_list, global_install); + + case "uninstall" + if (length (files) == 0) + error ("you must specify at least one package when calling 'pkg uninstall'"); + endif + uninstall (files, deps, verbose, local_list, + global_list, global_install); + + case "load" + if (length (files) == 0) + error ("you must specify at least one package, 'all' or 'auto' when calling 'pkg load'"); + endif + load_packages (files, deps, local_list, global_list); + + case "unload" + if (length (files) == 0) + error ("you must specify at least one package or 'all' when calling 'pkg unload'"); + endif + unload_packages (files, deps, local_list, global_list); + + case "prefix" + if (length (files) == 0 && nargout == 0) + printf ("Installation prefix: %s\n", prefix); + printf ("Architecture dependent prefix: %s\n", archprefix); + elseif (length (files) == 0 && nargout >= 1) + local_packages = prefix; + global_packages = archprefix; + elseif (length (files) >= 1 && nargout <= 2 && ischar (files{1})) + prefix = files{1}; + prefix = absolute_pathname (prefix); + local_packages = prefix; + user_prefix = true; + if (length (files) >= 2 && ischar (files{2})) + archprefix = files{2}; + try + archprefix = absolute_pathname (archprefix); + catch + mkdir (archprefix); + warning ("creating the directory %s\n", archprefix); + archprefix = absolute_pathname (archprefix); + end_try_catch + global_packages = archprefix; + endif + else + error ("you must specify a prefix directory, or request an output argument"); + endif + + case "local_list" + if (length (files) == 0 && nargout == 0) + disp (local_list); + elseif (length (files) == 0 && nargout == 1) + local_packages = local_list; + elseif (length (files) == 1 && nargout == 0 && ischar (files{1})) + try + local_list = absolute_pathname (files{1}); + catch + ## Force file to be created + fclose (fopen (files{1}, "wt")); + local_list = absolute_pathname (files{1}); + end_try_catch + else + error ("you must specify a local_list file, or request an output argument"); + endif + + case "global_list" + if (length (files) == 0 && nargout == 0) + disp(global_list); + elseif (length (files) == 0 && nargout == 1) + local_packages = global_list; + elseif (length (files) == 1 && nargout == 0 && ischar (files{1})) + try + global_list = absolute_pathname (files{1}); + catch + ## Force file to be created + fclose (fopen (files{1}, "wt")); + global_list = absolute_pathname (files{1}); + end_try_catch + else + error ("you must specify a global_list file, or request an output argument"); + endif + + case "rebuild" + if (global_install) + global_packages = rebuild (prefix, archprefix, global_list, files, + auto, verbose); + global_packages = save_order (global_packages); + save (global_list, "global_packages"); + if (nargout > 0) + local_packages = global_packages; + endif + else + local_packages = rebuild (prefix, archprefix, local_list, files, auto, + verbose); + local_packages = save_order (local_packages); + save (local_list, "local_packages"); + if (nargout == 0) + clear ("local_packages"); + endif + endif + + case "build" + if (length (files) < 2) + error ("you must specify at least the build directory and one filename\nwhen calling 'pkg build'"); + endif + build (files, deps, auto, verbose); + + case "describe" + if (length (files) == 0) + error ("you must specify at least one package or 'all' when calling 'pkg describe'"); + endif + ## FIXME: the name of the output variables is inconsistent + ## with their content + switch (nargout) + case 0 + describe (files, verbose, local_list, global_list); + case 1 + pkg_desc_list = describe (files, verbose, local_list, ... + global_list); + local_packages = pkg_desc_list; + case 2 + [pkg_desc_list, flag] = describe (files, verbose, local_list, ... + global_list); + local_packages = pkg_desc_list; + global_packages = flag; + otherwise + error ("you can request at most two outputs when calling 'pkg describe'"); + endswitch + + otherwise + error ("you must specify a valid action for 'pkg'. See 'help pkg' for details"); + endswitch +endfunction + +function descriptions = rebuild (prefix, archprefix, list, files, auto, verbose) + if (isempty (files)) + [dirlist, err, msg] = readdir (prefix); + if (err) + error ("couldn't read directory %s: %s", prefix, msg); + endif + ## the two first entries of dirlist are "." and ".." + dirlist([1,2]) = []; + else + old_descriptions = installed_packages (list, list); + wd = pwd (); + unwind_protect + cd (prefix); + dirlist = glob (cellfun(@(x) cstrcat(x, '-*'), files, 'UniformOutput', 0)); + unwind_protect_cleanup + cd (wd); + end_unwind_protect + endif + descriptions = {}; + for k = 1:length (dirlist) + descfile = fullfile (prefix, dirlist{k}, "packinfo", "DESCRIPTION"); + if (verbose) + printf ("recreating package description from %s\n", dirlist{k}); + endif + if (exist (descfile, "file")) + desc = get_description (descfile); + desc.dir = fullfile (prefix, dirlist{k}); + desc.archprefix = fullfile (archprefix, cstrcat (desc.name, "-", + desc.version)); + if (auto != 0) + if (exist (fullfile (desc.dir, "packinfo", ".autoload"), "file")) + unlink (fullfile (desc.dir, "packinfo", ".autoload")); + endif + if (auto < 0) + desc.autoload = 0; + elseif (auto > 0) + desc.autoload = 1; + fclose (fopen (fullfile (desc.dir, "packinfo", ".autoload"), "wt")); + endif + else + if (exist (fullfile (desc.dir, "packinfo", ".autoload"), "file")) + desc.autoload = 1; + else + desc.autoload = 0; + endif + endif + descriptions{end + 1} = desc; + elseif (verbose) + warning ("directory %s is not a valid package", dirlist{k}); + endif + endfor + + if (! isempty (files)) + ## We are rebuilding for a particular package(s) so we should take + ## care to keep the other untouched packages in the descriptions + descriptions = {descriptions{:}, old_descriptions{:}}; + + dup = []; + for i = 1:length (descriptions) + if (find (dup, i)) + continue; + endif + for j = (i+1):length (descriptions) + if (find (dup, j)) + continue; + endif + if (strcmp (descriptions{i}.name, descriptions{j}.name)) + dup = [dup, j]; + endif + endfor + endfor + if (! isempty (dup)) + descriptions (dup) = []; + endif + endif +endfunction + +function build (files, handle_deps, autoload, verbose) + if (length (files) < 1) + error ("insufficient number of files"); + endif + builddir = files{1}; + if (! exist (builddir, "dir")) + warning ("creating build directory %s", builddir); + [status, msg] = mkdir (builddir); + if (status != 1) + error ("could not create installation directory: %s", msg); + endif + endif + builddir = absolute_pathname (builddir); + installdir = fullfile (builddir, "install"); + if (! exist (installdir, "dir")) + [status, msg] = mkdir (installdir); + if (status != 1) + error ("could not create installation directory: %s", msg); + endif + endif + files(1) = []; + buildlist = fullfile (builddir, "octave_packages"); + install (files, handle_deps, autoload, installdir, installdir, verbose, + buildlist, "", false); + unwind_protect + repackage (builddir, buildlist); + unwind_protect_cleanup + unload_packages ({"all"}, handle_deps, buildlist, ""); + if (exist (installdir, "dir")) + rm_rf (installdir); + endif + if (exist (buildlist, "file")) + unlink (buildlist); + endif + end_unwind_protect +endfunction + +function install (files, handle_deps, autoload, prefix, archprefix, verbose, + local_list, global_list, global_install) + + ## Check that the directory in prefix exist. If it doesn't: create it! + if (! exist (prefix, "dir")) + warning ("creating installation directory %s", prefix); + [status, msg] = mkdir (prefix); + if (status != 1) + error ("could not create installation directory: %s", msg); + endif + endif + + ## Get the list of installed packages. + [local_packages, global_packages] = installed_packages (local_list, + global_list); + + installed_pkgs_lst = {local_packages{:}, global_packages{:}}; + + if (global_install) + packages = global_packages; + else + packages = local_packages; + endif + + ## Uncompress the packages and read the DESCRIPTION files. + tmpdirs = packdirs = descriptions = {}; + try + ## Warn about non existent files. + for i = 1:length (files) + if (isempty (glob(files{i}))) + warning ("file %s does not exist", files{i}); + endif + endfor + + ## Unpack the package files and read the DESCRIPTION files. + files = glob (files); + packages_to_uninstall = []; + for i = 1:length (files) + tgz = files{i}; + + if (exist (tgz, "file")) + ## Create a temporary directory. + tmpdir = tmpnam (); + tmpdirs{end+1} = tmpdir; + if (verbose) + printf ("mkdir (%s)\n", tmpdir); + endif + [status, msg] = mkdir (tmpdir); + if (status != 1) + error ("couldn't create temporary directory: %s", msg); + endif + + ## Uncompress the package. + if (verbose) + printf ("untar (%s, %s)\n", tgz, tmpdir); + endif + untar (tgz, tmpdir); + + ## Get the name of the directories produced by tar. + [dirlist, err, msg] = readdir (tmpdir); + if (err) + error ("couldn't read directory produced by tar: %s", msg); + endif + + if (length (dirlist) > 3) + error ("bundles of packages are not allowed") + endif + endif + + ## The filename pointed to an uncompressed package to begin with. + if (exist (tgz, "dir")) + dirlist = {".", "..", tgz}; + endif + + if (exist (tgz, "file") || exist (tgz, "dir")) + ## The two first entries of dirlist are "." and "..". + if (exist (tgz, "file")) + packdir = fullfile (tmpdir, dirlist{3}); + else + packdir = fullfile (pwd(), dirlist{3}); + endif + packdirs{end+1} = packdir; + + ## Make sure the package contains necessary files. + verify_directory (packdir); + + ## Read the DESCRIPTION file. + filename = fullfile (packdir, "DESCRIPTION"); + desc = get_description (filename); + + ## Verify that package name corresponds with filename. + [dummy, nm] = fileparts (tgz); + if ((length (nm) >= length (desc.name)) + && ! strcmp (desc.name, nm(1:length(desc.name)))) + error ("package name '%s' doesn't correspond to its filename '%s'", + desc.name, nm); + endif + + ## Set default installation directory. + desc.dir = fullfile (prefix, cstrcat (desc.name, "-", desc.version)); + + ## Set default architectire dependent installation directory. + desc.archprefix = fullfile (archprefix, cstrcat (desc.name, "-", + desc.version)); + + ## Save desc. + descriptions{end+1} = desc; + + ## Are any of the new packages already installed? + ## If so we'll remove the old version. + for j = 1:length (packages) + if (strcmp (packages{j}.name, desc.name)) + packages_to_uninstall(end+1) = j; + endif + endfor + endif + endfor + catch + ## Something went wrong, delete tmpdirs. + for i = 1:length (tmpdirs) + rm_rf (tmpdirs{i}); + endfor + rethrow (lasterror ()); + end_try_catch + + ## Check dependencies. + if (handle_deps) + ok = true; + error_text = ""; + for i = 1:length (descriptions) + desc = descriptions{i}; + idx2 = complement (i, 1:length(descriptions)); + if (global_install) + ## Global installation is not allowed to have dependencies on locally + ## installed packages. + idx1 = complement (packages_to_uninstall, + 1:length(global_packages)); + pseudo_installed_packages = {global_packages{idx1}, ... + descriptions{idx2}}; + else + idx1 = complement (packages_to_uninstall, + 1:length(local_packages)); + pseudo_installed_packages = {local_packages{idx1}, ... + global_packages{:}, ... + descriptions{idx2}}; + endif + bad_deps = get_unsatisfied_deps (desc, pseudo_installed_packages); + ## Are there any unsatisfied dependencies? + if (! isempty (bad_deps)) + ok = false; + for i = 1:length (bad_deps) + dep = bad_deps{i}; + error_text = cstrcat (error_text, " ", desc.name, " needs ", + dep.package, " ", dep.operator, " ", + dep.version, "\n"); + endfor + endif + endfor + + ## Did we find any unsatisfied dependencies? + if (! ok) + error ("the following dependencies where unsatisfied:\n %s", error_text); + endif + endif + + ## Prepare each package for installation. + try + for i = 1:length (descriptions) + desc = descriptions{i}; + pdir = packdirs{i}; + prepare_installation (desc, pdir); + configure_make (desc, pdir, verbose); + endfor + catch + ## Something went wrong, delete tmpdirs. + for i = 1:length (tmpdirs) + rm_rf (tmpdirs{i}); + endfor + rethrow (lasterror ()); + end_try_catch + + ## Uninstall the packages that will be replaced. + try + for i = packages_to_uninstall + if (global_install) + uninstall ({global_packages{i}.name}, false, verbose, local_list, + global_list, global_install); + else + uninstall ({local_packages{i}.name}, false, verbose, local_list, + global_list, global_install); + endif + endfor + catch + ## Something went wrong, delete tmpdirs. + for i = 1:length (tmpdirs) + rm_rf (tmpdirs{i}); + endfor + rethrow (lasterror ()); + end_try_catch + + ## Install each package. + try + for i = 1:length (descriptions) + desc = descriptions{i}; + pdir = packdirs{i}; + copy_files (desc, pdir, global_install); + create_pkgadddel (desc, pdir, "PKG_ADD", global_install); + create_pkgadddel (desc, pdir, "PKG_DEL", global_install); + finish_installation (desc, pdir, global_install); + generate_lookfor_cache (desc); + endfor + catch + ## Something went wrong, delete tmpdirs. + for i = 1:length (tmpdirs) + rm_rf (tmpdirs{i}); + endfor + for i = 1:length (descriptions) + rm_rf (descriptions{i}.dir); + rm_rf (getarchdir (descriptions{i})); + endfor + rethrow (lasterror ()); + end_try_catch + + ## Check if the installed directory is empty. If it is remove it + ## from the list. + for i = length (descriptions):-1:1 + if (dirempty (descriptions{i}.dir, {"packinfo", "doc"}) && + dirempty (getarchdir (descriptions{i}))) + warning ("package %s is empty\n", descriptions{i}.name); + rm_rf (descriptions{i}.dir); + rm_rf (getarchdir (descriptions{i})); + descriptions(i) = []; + endif + endfor + + ## If the package requested that it is autoloaded, or the installer + ## requested that it is, then mark the package as autoloaded. + for i = length (descriptions):-1:1 + if (autoload > 0 || (autoload == 0 && isautoload (descriptions(i)))) + fclose (fopen (fullfile (descriptions{i}.dir, "packinfo", + ".autoload"), "wt")); + descriptions{i}.autoload = 1; + endif + endfor + + ## Add the packages to the package list. + try + if (global_install) + idx = complement (packages_to_uninstall, 1:length(global_packages)); + global_packages = save_order ({global_packages{idx}, descriptions{:}}); + save (global_list, "global_packages"); + installed_pkgs_lst = {local_packages{:}, global_packages{:}}; + else + idx = complement (packages_to_uninstall, 1:length(local_packages)); + local_packages = save_order ({local_packages{idx}, descriptions{:}}); + save (local_list, "local_packages"); + installed_pkgs_lst = {local_packages{:}, global_packages{:}}; + endif + catch + ## Something went wrong, delete tmpdirs. + for i = 1:length (tmpdirs) + rm_rf (tmpdirs{i}); + endfor + for i = 1:length (descriptions) + rm_rf (descriptions{i}.dir); + endfor + if (global_install) + printf ("error: couldn't append to %s\n", global_list); + else + printf ("error: couldn't append to %s\n", local_list); + endif + rethrow (lasterror ()); + end_try_catch + + ## All is well, let's clean up. + for i = 1:length (tmpdirs) + [status, msg] = rm_rf (tmpdirs{i}); + if (status != 1) + warning ("couldn't clean up after my self: %s\n", msg); + endif + endfor + + ## Add the newly installed packages to the path, so the user + ## can begin using them. Only load them if they are marked autoload. + if (length (descriptions) > 0) + idx = []; + for i = 1:length (descriptions) + if (isautoload (descriptions(i))) + nm = descriptions{i}.name; + for j = 1:length (installed_pkgs_lst) + if (strcmp (nm, installed_pkgs_lst{j}.name)) + idx (end + 1) = j; + break; + endif + endfor + endif + endfor + load_packages_and_dependencies (idx, handle_deps, installed_pkgs_lst, + global_install); + endif +endfunction + +function uninstall (pkgnames, handle_deps, verbose, local_list, + global_list, global_install) + ## Get the list of installed packages. + [local_packages, global_packages] = installed_packages(local_list, + global_list); + if (global_install) + installed_pkgs_lst = {local_packages{:}, global_packages{:}}; + else + installed_pkgs_lst = local_packages; + endif + + num_packages = length (installed_pkgs_lst); + delete_idx = []; + for i = 1:num_packages + cur_name = installed_pkgs_lst{i}.name; + if (any (strcmp (cur_name, pkgnames))) + delete_idx(end+1) = i; + endif + endfor + + ## Are all the packages that should be uninstalled already installed? + if (length (delete_idx) != length (pkgnames)) + if (global_install) + ## Try again for a locally installed package. + installed_pkgs_lst = local_packages; + + num_packages = length (installed_pkgs_lst); + delete_idx = []; + for i = 1:num_packages + cur_name = installed_pkgs_lst{i}.name; + if (any (strcmp (cur_name, pkgnames))) + delete_idx(end+1) = i; + endif + endfor + if (length (delete_idx) != length (pkgnames)) + ## FIXME: We should have a better error message. + warning ("some of the packages you want to uninstall are not installed"); + endif + else + ## FIXME: We should have a better error message. + warning ("some of the packages you want to uninstall are not installed"); + endif + endif + + ## Compute the packages that will remain installed. + idx = complement (delete_idx, 1:num_packages); + remaining_packages = {installed_pkgs_lst{idx}}; + + ## Check dependencies. + if (handle_deps) + error_text = ""; + for i = 1:length (remaining_packages) + desc = remaining_packages{i}; + bad_deps = get_unsatisfied_deps (desc, remaining_packages); + + ## Will the uninstallation break any dependencies? + if (! isempty (bad_deps)) + for i = 1:length (bad_deps) + dep = bad_deps{i}; + error_text = cstrcat (error_text, " ", desc.name, " needs ", + dep.package, " ", dep.operator, " ", + dep.version, "\n"); + endfor + endif + endfor + + if (! isempty (error_text)) + error ("the following dependencies where unsatisfied:\n %s", error_text); + endif + endif + + ## Delete the directories containing the packages. + for i = delete_idx + desc = installed_pkgs_lst{i}; + ## If an 'on_uninstall.m' exist, call it! + if (exist (fullfile (desc.dir, "packinfo", "on_uninstall.m"), "file")) + wd = pwd (); + cd (fullfile (desc.dir, "packinfo")); + on_uninstall (desc); + cd (wd); + endif + ## Do the actual deletion. + if (desc.loaded) + rmpath (desc.dir); + if (exist (getarchdir (desc))) + rmpath (getarchdir (desc)); + endif + endif + if (exist (desc.dir, "dir")) + [status, msg] = rm_rf (desc.dir); + if (status != 1) + error ("couldn't delete directory %s: %s", desc.dir, msg); + endif + [status, msg] = rm_rf (getarchdir (desc)); + if (status != 1) + error ("couldn't delete directory %s: %s", getarchdir (desc), msg); + endif + if (dirempty (desc.archprefix)) + rm_rf (desc.archprefix); + endif + else + warning ("directory %s previously lost", desc.dir); + endif + endfor + + ## Write a new ~/.octave_packages. + if (global_install) + if (length (remaining_packages) == 0) + unlink (global_list); + else + global_packages = save_order (remaining_packages); + save (global_list, "global_packages"); + endif + else + if (length (remaining_packages) == 0) + unlink (local_list); + else + local_packages = save_order (remaining_packages); + save (local_list, "local_packages"); + endif + endif + +endfunction + +function [pkg_desc_list, flag] = describe (pkgnames, verbose, + local_list, global_list) + + ## Get the list of installed packages. + installed_pkgs_lst = installed_packages(local_list, global_list); + num_packages = length (installed_pkgs_lst); + + + describe_all = false; + if (any (strcmp ("all", pkgnames))) + describe_all = true; + flag(1:num_packages) = {"Not Loaded"}; + num_pkgnames = num_packages; + else + num_pkgnames = length (pkgnames); + flag(1:num_pkgnames) = {"Not installed"}; + endif + + for i = 1:num_packages + curr_name = installed_pkgs_lst{i}.name; + if (describe_all) + name_pos = i; + else + name_pos = find(strcmp (curr_name, pkgnames)); + endif + + if (! isempty (name_pos)) + if (installed_pkgs_lst{i}.loaded) + flag{name_pos} = "Loaded"; + else + flag{name_pos} = "Not loaded"; + endif + + pkg_desc_list{name_pos}.name = installed_pkgs_lst{i}.name; + pkg_desc_list{name_pos}.version = installed_pkgs_lst{i}.version; + pkg_desc_list{name_pos}.description = installed_pkgs_lst{i}.description; + pkg_desc_list{name_pos}.provides = parse_pkg_idx (installed_pkgs_lst{i}.dir); + + endif + endfor + + non_inst = find (strcmp (flag, "Not installed")); + if (! isempty (non_inst)) + if (nargout < 2) + non_inst_str = sprintf (" %s ", pkgnames{non_inst}); + error ("some packages are not installed: %s", non_inst_str); + else + pkg_desc_list{non_inst} = struct ("name", {}, "description", + {}, "provides", {}); + endif + endif + + if (nargout == 0) + for i = 1:num_pkgnames + print_package_description (pkg_desc_list{i}.name, + pkg_desc_list{i}.version, + pkg_desc_list{i}.provides, + pkg_desc_list{i}.description, + flag{i}, verbose); + endfor + endif + +endfunction + +## AUXILIARY FUNCTIONS + +## Read an INDEX file. +function [pkg_idx_struct] = parse_pkg_idx (packdir) + + index_file = fullfile (packdir, "packinfo", "INDEX"); + + if (! exist (index_file, "file")) + error ("could not find any INDEX file in directory %s, try 'pkg rebuild all' to generate missing INDEX files", packdir); + endif + + + [fid, msg] = fopen (index_file, "r"); + if (fid == -1) + error ("the INDEX file %s could not be read: %s", + index_file, msg); + endif + + cat_num = 1; + pkg_idx_struct{1}.category = "Uncategorized"; + pkg_idx_struct{1}.functions = {}; + + line = fgetl (fid); + while (isempty (strfind (line, ">>")) && ! feof (fid)) + line = fgetl (fid); + endwhile + + while (! feof (fid) || line != -1) + if (! any (! isspace (line)) || line(1) == "#" || any (line == "=")) + ## Comments, blank lines or comments about unimplemented + ## functions: do nothing + ## FIXME: probably comments and pointers to external functions + ## could be treated better when printing to screen? + elseif (! isempty (strfind (line, ">>"))) + ## Skip package name and description as they are in DESCRIPTION + ## already. + elseif (! isspace (line(1))) + ## Category. + if (! isempty (pkg_idx_struct{cat_num}.functions)) + pkg_idx_struct{++cat_num}.functions = {}; + endif + pkg_idx_struct{cat_num}.category = deblank (line); + else + ## Function names. + while (any (! isspace (line))) + [fun_name, line] = strtok (line); + pkg_idx_struct{cat_num}.functions{end+1} = deblank (fun_name); + endwhile + endif + line = fgetl (fid); + endwhile + fclose (fid); +endfunction + +function print_package_description (pkg_name, pkg_ver, pkg_idx_struct, + pkg_desc, status, verbose) + + printf ("---\nPackage name:\n\t%s\n", pkg_name); + printf ("Version:\n\t%s\n", pkg_ver); + printf ("Short description:\n\t%s\n", pkg_desc); + printf ("Status:\n\t%s\n", status); + if (verbose) + printf ("---\nProvides:\n"); + for i = 1:length(pkg_idx_struct) + if (! isempty (pkg_idx_struct{i}.functions)) + printf ("%s\n", pkg_idx_struct{i}.category); + for j = 1:length(pkg_idx_struct{i}.functions) + printf ("\t%s\n", pkg_idx_struct{i}.functions{j}); + endfor + endif + endfor + endif + +endfunction + + +function pth = absolute_pathname (pth) + [status, msg, msgid] = fileattrib (pth); + if (status != 1) + error ("could not find the file or path %s", pth); + else + pth = msg.Name; + endif +endfunction + +function repackage (builddir, buildlist) + packages = installed_packages (buildlist, buildlist); + + wd = pwd(); + for i = 1 : length(packages) + pack = packages{i}; + unwind_protect + cd (builddir); + mkdir (pack.name); + mkdir (fullfile (pack.name, "inst")); + copyfile (fullfile (pack.dir, "*"), fullfile (pack.name, "inst")); + movefile (fullfile (pack.name, "inst","packinfo", "*"), pack.name); + if (exist (fullfile (pack.name, "inst","packinfo", ".autoload"), "file")) + unlink (fullfile (pack.name, "inst","packinfo", ".autoload")); + endif + rmdir (fullfile (pack.name, "inst", "packinfo")); + if (exist (fullfile (pack.name, "inst", "doc"), "dir")) + movefile (fullfile (pack.name, "inst", "doc"), pack.name); + endif + if (exist (fullfile (pack.name, "inst", "bin"), "dir")) + movefile (fullfile (pack.name, "inst", "bin"), pack.name); + endif + archdir = fullfile (pack.archprefix, cstrcat (pack.name, "-", + pack.version), getarch ()); + if (exist (archdir, "dir")) + if (exist (fullfile (pack.name, "inst", "PKG_ADD"), "file")) + unlink (fullfile (pack.name, "inst", "PKG_ADD")); + endif + if (exist (fullfile (pack.name, "inst", "PKG_DEL"), "file")) + unlink (fullfile (pack.name, "inst", "PKG_DEL")); + endif + if (exist (fullfile (archdir, "PKG_ADD"), "file")) + movefile (fullfile (archdir, "PKG_ADD"), + fullfile (pack.name, "PKG_ADD")); + endif + if (exist (fullfile (archdir, "PKG_DEL"), "file")) + movefile (fullfile (archdir, "PKG_DEL"), + fullfile (pack.name, "PKG_DEL")); + endif + else + if (exist (fullfile (pack.name, "inst", "PKG_ADD"), "file")) + movefile (fullfile (pack.name, "inst", "PKG_ADD"), + fullfile (pack.name, "PKG_ADD")); + endif + if (exist (fullfile (pack.name, "inst", "PKG_DEL"), "file")) + movefile (fullfile (pack.name, "inst", "PKG_DEL"), + fullfile (pack.name, "PKG_DEL")); + endif + endif + tfile = cstrcat (pack.name, "-", pack.version, ".tar"); + tar (tfile, pack.name); + try + gzip (tfile); + unlink (tfile); + catch + warning ("failed to compress %s", tfile); + end_try_catch + unwind_protect_cleanup + if (exist (pack.name, "dir")) + rm_rf (pack.name); + endif + cd (wd); + end_unwind_protect + endfor +endfunction + +function auto = isautoload (desc) + auto = false; + if (isfield (desc{1}, "autoload")) + a = desc{1}.autoload; + if ((isnumeric (a) && a > 0) + || (ischar (a) && (strcmpi (a, "true") + || strcmpi (a, "on") + || strcmpi (a, "yes") + || strcmpi (a, "1")))) + auto = true; + endif + endif +endfunction + +function prepare_installation (desc, packdir) + ## Is there a pre_install to call? + if (exist (fullfile (packdir, "pre_install.m"), "file")) + wd = pwd (); + try + cd (packdir); + pre_install (desc); + cd (wd); + catch + cd (wd); + rethrow (lasterror ()); + end_try_catch + endif + + ## If the directory "inst" doesn't exist, we create it. + inst_dir = fullfile (packdir, "inst"); + if (! exist (inst_dir, "dir")) + [status, msg] = mkdir (inst_dir); + if (status != 1) + rm_rf (desc.dir); + error ("the 'inst' directory did not exist and could not be created: %s", + msg); + endif + endif +endfunction + +function configure_make (desc, packdir, verbose) + ## Perform ./configure, make, make install in "src". + if (exist (fullfile (packdir, "src"), "dir")) + src = fullfile (packdir, "src"); + ## Configure. + if (exist (fullfile (src, "configure"), "file")) + flags = ""; + if (isempty (getenv ("CC"))) + flags = cstrcat (flags, " CC=\"", octave_config_info ("CC"), "\""); + endif + if (isempty (getenv ("CXX"))) + flags = cstrcat (flags, " CXX=\"", octave_config_info ("CXX"), "\""); + endif + if (isempty (getenv ("AR"))) + flags = cstrcat (flags, " AR=\"", octave_config_info ("AR"), "\""); + endif + if (isempty (getenv ("RANLIB"))) + flags = cstrcat (flags, " RANLIB=\"", octave_config_info ("RANLIB"), "\""); + endif + [status, output] = shell (strcat ("cd '", src, "'; ./configure --prefix=\"", + desc.dir, "\"", flags)); + if (status != 0) + rm_rf (desc.dir); + error ("the configure script returned the following error: %s", output); + elseif (verbose) + printf("%s", output); + endif + + endif + + ## Make. + if (exist (fullfile (src, "Makefile"), "file")) + [status, output] = shell (cstrcat ("export INSTALLDIR=\"", desc.dir, + "\"; make -C '", src, "'")); + if (status != 0) + rm_rf (desc.dir); + error ("'make' returned the following error: %s", output); + elseif (verbose) + printf("%s", output); + endif + endif + + ## Copy files to "inst" and "inst/arch" (this is instead of 'make + ## install'). + files = fullfile (src, "FILES"); + instdir = fullfile (packdir, "inst"); + archdir = fullfile (packdir, "inst", getarch ()); + + ## Get file names. + if (exist (files, "file")) + [fid, msg] = fopen (files, "r"); + if (fid < 0) + error ("couldn't open %s: %s", files, msg); + endif + filenames = char (fread (fid))'; + fclose (fid); + if (filenames(end) == "\n") + filenames(end) = []; + endif + filenames = split_by (filenames, "\n"); + delete_idx = []; + for i = 1:length (filenames) + if (! all (isspace (filenames{i}))) + filenames{i} = fullfile (src, filenames{i}); + else + delete_idx(end+1) = i; + endif + endfor + filenames(delete_idx) = []; + else + m = dir (fullfile (src, "*.m")); + oct = dir (fullfile (src, "*.oct")); + mex = dir (fullfile (src, "*.mex")); + + filenames = cellfun (@(x) fullfile (src, x), + {m.name, oct.name, mex.name}, + "UniformOutput", false); + endif + + ## Split into architecture dependent and independent files. + if (isempty (filenames)) + idx = []; + else + idx = cellfun (@is_architecture_dependent, filenames); + endif + archdependent = filenames (idx); + archindependent = filenames (!idx); + + ## Copy the files. + if (! all (isspace ([filenames{:}]))) + if (! exist (instdir, "dir")) # fixindent + mkdir (instdir); + endif + if (! all (isspace ([archindependent{:}]))) + if (verbose) + printf ("copyfile"); + printf (" %s", archindependent{:}); + printf ("%s\n", instdir); + endif + [status, output] = copyfile (archindependent, instdir); + if (status != 1) + rm_rf (desc.dir); + error ("Couldn't copy files from 'src' to 'inst': %s", output); + endif + endif + if (! all (isspace ([archdependent{:}]))) + if (verbose) + printf ("copyfile"); + printf (" %s", archdependent{:}); + printf (" %s\n", archdir); + endif + if (! exist (archdir, "dir")) + mkdir (archdir); + endif + [status, output] = copyfile (archdependent, archdir); + if (status != 1) + rm_rf (desc.dir); + error ("Couldn't copy files from 'src' to 'inst': %s", output); + endif + endif + endif + endif +endfunction + +function pkg = extract_pkg (nm, pat) + fid = fopen (nm, "rt"); + pkg = ""; + if (fid >= 0) + while (! feof (fid)) + ln = fgetl (fid); + if (ln > 0) + t = regexp (ln, pat, "tokens"); + if (! isempty (t)) + pkg = cstrcat (pkg, "\n", t{1}{1}); + endif + endif + endwhile + if (! isempty (pkg)) + pkg = cstrcat (pkg, "\n"); + endif + fclose (fid); + endif +endfunction + +function create_pkgadddel (desc, packdir, nm, global_install) + instpkg = fullfile (desc.dir, nm); + instfid = fopen (instpkg, "wt"); + ## If it is exists, most of the PKG_* file should go into the + ## architecture dependent directory so that the autoload/mfilename + ## commands work as expected. The only part that doesn't is the + ## part in the main directory. + archdir = fullfile (getarchprefix (desc), cstrcat (desc.name, "-", + desc.version), getarch ()); + if (exist (getarchdir (desc, global_install), "dir")) + archpkg = fullfile (getarchdir (desc, global_install), nm); + archfid = fopen (archpkg, "at"); + else + archpkg = instpkg; + archfid = instfid; + endif + + if (archfid >= 0 && instfid >= 0) + ## Search all dot-m files for PKG commands. + lst = dir (fullfile (packdir, "inst", "*.m")); + for i = 1:length (lst) + nam = fullfile (packdir, "inst", lst(i).name); + fwrite (instfid, extract_pkg (nam, ['^[#%][#%]* *' nm ': *(.*)$'])); + endfor # fixindent + + ## Search all C++ source files for PKG commands. + lst = dir (fullfile (packdir, "src", "*.cc")); + for i = 1:length (lst) + nam = fullfile (packdir, "src", lst(i).name); + fwrite (archfid, extract_pkg (nam, ['^//* *' nm ': *(.*)$'])); + fwrite (archfid, extract_pkg (nam, ['^/\** *' nm ': *(.*) *\*/$'])); + endfor + + ## Add developer included PKG commands. + packdirnm = fullfile (packdir, nm); + if (exist (packdirnm, "file")) + fid = fopen (packdirnm, "rt"); + if (fid >= 0) + while (! feof (fid)) + ln = fgets (fid); + if (ln > 0) + fwrite (archfid, ln); + endif + endwhile + fclose (fid); + endif + endif + + ## If the files is empty remove it. + fclose (instfid); + t = dir (instpkg); + if (t.bytes <= 0) + unlink (instpkg); + endif + + if (instfid != archfid) + fclose (archfid); + t = dir (archpkg); + if (t.bytes <= 0) + unlink (archpkg); + endif + endif + endif +endfunction + +function copy_files (desc, packdir, global_install) + ## Create the installation directory. + if (! exist (desc.dir, "dir")) + [status, output] = mkdir (desc.dir); + if (status != 1) + error ("couldn't create installation directory %s : %s", + desc.dir, output); + endif + endif + + octfiledir = getarchdir (desc); + + ## Copy the files from "inst" to installdir. + instdir = fullfile (packdir, "inst"); + if (! dirempty (instdir)) + [status, output] = copyfile (fullfile (instdir, "*"), desc.dir); + if (status != 1) + rm_rf (desc.dir); + error ("couldn't copy files to the installation directory"); + endif + if (exist (fullfile (desc.dir, getarch ()), "dir") && + ! strcmp (fullfile (desc.dir, getarch ()), octfiledir)) + if (! exist (octfiledir, "dir")) + ## Can be required to create upto three levels of dirs. + octm1 = fileparts (octfiledir); + if (! exist (octm1, "dir")) + octm2 = fileparts (octm1); + if (! exist (octm2, "dir")) + octm3 = fileparts (octm2); + if (! exist (octm3, "dir")) + [status, output] = mkdir (octm3); + if (status != 1) + rm_rf (desc.dir); + error ("couldn't create installation directory %s : %s", + octm3, output); + endif + endif + [status, output] = mkdir (octm2); + if (status != 1) + rm_rf (desc.dir); + error ("couldn't create installation directory %s : %s", + octm2, output); + endif + endif + [status, output] = mkdir (octm1); + if (status != 1) + rm_rf (desc.dir); + error ("couldn't create installation directory %s : %s", + octm1, output); + endif + endif + [status, output] = mkdir (octfiledir); + if (status != 1) + rm_rf (desc.dir); + error ("couldn't create installation directory %s : %s", + octfiledir, output); + endif + endif + [status, output] = movefile (fullfile (desc.dir, getarch (), "*"), + octfiledir); + rm_rf (fullfile (desc.dir, getarch ())); + + if (status != 1) + rm_rf (desc.dir); + rm_rf (octfiledir); + error ("couldn't copy files to the installation directory"); + endif + endif + + endif + + ## Create the "packinfo" directory. + packinfo = fullfile (desc.dir, "packinfo"); + [status, msg] = mkdir (packinfo); + if (status != 1) + rm_rf (desc.dir); + rm_rf (octfiledir); + error ("couldn't create packinfo directory: %s", msg); + endif + + ## Copy DESCRIPTION. + [status, output] = copyfile (fullfile (packdir, "DESCRIPTION"), packinfo); + if (status != 1) + rm_rf (desc.dir); + rm_rf (octfiledir); + error ("couldn't copy DESCRIPTION: %s", output); + endif + + ## Copy COPYING. + [status, output] = copyfile (fullfile (packdir, "COPYING"), packinfo); + if (status != 1) + rm_rf (desc.dir); + rm_rf (octfiledir); + error ("couldn't copy COPYING: %s", output); + endif + + ## If the file ChangeLog exists, copy it. + changelog_file = fullfile (packdir, "ChangeLog"); + if (exist (changelog_file, "file")) + [status, output] = copyfile (changelog_file, packinfo); + if (status != 1) + rm_rf (desc.dir); + rm_rf (octfiledir); + error ("couldn't copy ChangeLog file: %s", output); + endif + endif + + ## Is there an INDEX file to copy or should we generate one? + index_file = fullfile (packdir, "INDEX"); + if (exist(index_file, "file")) + [status, output] = copyfile (index_file, packinfo); + if (status != 1) + rm_rf (desc.dir); + rm_rf (octfiledir); + error ("couldn't copy INDEX file: %s", output); + endif + else + try + write_index (desc, fullfile (packdir, "inst"), + fullfile (packinfo, "INDEX"), global_install); + catch + rm_rf (desc.dir); + rm_rf (octfiledir); + rethrow (lasterror ()); + end_try_catch + endif + + ## Is there an 'on_uninstall.m' to install? + fon_uninstall = fullfile (packdir, "on_uninstall.m"); + if (exist (fon_uninstall, "file")) + [status, output] = copyfile (fon_uninstall, packinfo); + if (status != 1) + rm_rf (desc.dir); + rm_rf (octfiledir); + error ("couldn't copy on_uninstall.m: %s", output); + endif + endif + + ## Is there a doc/ directory that needs to be installed? + docdir = fullfile (packdir, "doc"); + if (exist (docdir, "dir") && ! dirempty (docdir)) + [status, output] = copyfile (docdir, desc.dir); + endif + + ## Is there a bin/ directory that needs to be installed? + ## FIXME: Need to treat architecture dependent files in bin/ + bindir = fullfile (packdir, "bin"); + if (exist (bindir, "dir") && ! dirempty (bindir)) + [status, output] = copyfile (bindir, desc.dir); + endif +endfunction + +function finish_installation (desc, packdir, global_install) + ## Is there a post-install to call? + if (exist (fullfile (packdir, "post_install.m"), "file")) + wd = pwd (); + try + cd (packdir); + post_install (desc); + cd (wd); + catch + cd (wd); + rm_rf (desc.dir); + rm_rf (getarchdir (desc), global_install); + rethrow (lasterror ()); + end_try_catch + endif +endfunction + +function generate_lookfor_cache (desc) + dirs = split_by (genpath (desc.dir), pathsep ()); + for i = 1 : length (dirs) + gen_doc_cache (fullfile (dirs{i}, "doc-cache"), dirs{i}); + endfor +endfunction + +## Make sure the package contains the essential files. +function verify_directory (dir) + needed_files = {"COPYING", "DESCRIPTION"}; + for f = needed_files + if (! exist (fullfile (dir, f{1}), "file")) + error ("package is missing file: %s", f{1}); + endif + endfor +endfunction + +## Parse the DESCRIPTION file. +function desc = get_description (filename) + [fid, msg] = fopen (filename, "r"); + if (fid == -1) + error ("the DESCRIPTION file %s could not be read: %s", filename, msg); + endif + + desc = struct (); + + line = fgetl (fid); + while (line != -1) + if (line(1) == "#") + ## Comments, do nothing. + elseif (isspace(line(1))) + ## Continuation lines + if (exist ("keyword", "var") && isfield (desc, keyword)) + desc.(keyword) = cstrcat (desc.(keyword), " ", rstrip(line)); + endif + else + ## Keyword/value pair + colon = find (line == ":"); + if (length (colon) == 0) + disp ("skipping line"); + else + colon = colon(1); + keyword = tolower (strip (line(1:colon-1))); + value = strip (line (colon+1:end)); + if (length (value) == 0) + fclose (fid); + error ("the keyword %s has an empty value", desc.keywords{end}); + endif + desc.(keyword) = value; + endif + endif + line = fgetl (fid); + endwhile + fclose (fid); + + ## Make sure all is okay. + needed_fields = {"name", "version", "date", "title", ... + "author", "maintainer", "description"}; + for f = needed_fields + if (! isfield (desc, f{1})) + error ("description is missing needed field %s", f{1}); + endif + endfor + desc.version = fix_version (desc.version); + if (isfield (desc, "depends")) + desc.depends = fix_depends (desc.depends); + else + desc.depends = ""; + endif + desc.name = tolower (desc.name); +endfunction + +## Make sure the version string v is a valid x.y.z version string +## Examples: "0.1" => "0.1.0", "monkey" => error(...). +function out = fix_version (v) + dots = find (v == "."); + if (length (dots) == 1) + major = str2num (v(1:dots-1)); + minor = str2num (v(dots+1:end)); + if (length (major) != 0 && length (minor) != 0) + out = sprintf ("%d.%d.0", major, minor); + return; + endif + elseif (length (dots) == 2) + major = str2num (v(1:dots(1)-1)); + minor = str2num (v(dots(1)+1:dots(2)-1)); + rev = str2num (v(dots(2)+1:end)); + if (length (major) != 0 && length (minor) != 0 && length (rev) != 0) + out = sprintf ("%d.%d.%d", major, minor, rev); + return; + endif + endif + error ("bad version string: %s", v); +endfunction + +## Make sure the depends field is of the right format. +## This function returns a cell of structures with the following fields: +## package, version, operator +function deps_cell = fix_depends (depends) + deps = split_by (tolower (depends), ","); + deps_cell = cell (1, length (deps)); + + ## For each dependency. + for i = 1:length (deps) + dep = deps{i}; + lpar = find (dep == "("); + rpar = find (dep == ")"); + ## Does the dependency specify a version + ## Example: package(>= version). + if (length (lpar) == 1 && length (rpar) == 1) + package = tolower (strip (dep(1:lpar-1))); + sub = dep(lpar(1)+1:rpar(1)-1); + parts = strsplit (sub, " ", true); + if (length (parts) != 2) + error ("incorrect syntax for dependency `%s' in the DESCRIPTION file\n", + dep); + endif + operator = parts{1}; + if (! any (strcmp (operator, {">", ">=", "<=", "<", "=="}))) + error ("unsupported operator: %s", operator); + endif + version = fix_version (parts{2}); + + ## If no version is specified for the dependency + ## we say that the version should be greater than + ## or equal to "0.0.0". + else + package = tolower (strip (dep)); + operator = ">="; + version = "0.0.0"; + endif + deps_cell{i} = struct ("package", package, "operator", operator, + "version", version); + endfor +endfunction + +## Strip the text of spaces from the right +## Example: " hello world " => " hello world" +## FIXME -- is this the same as deblank? +function text = rstrip (text) + chars = find (! isspace (text)); + if (length (chars) > 0) + ## FIXME: shouldn't it be text = text(1:chars(end)); + text = text (chars(1):end); + else + text = ""; + endif +endfunction + +## Strip the text of spaces from the left and the right. +## Example: " hello world " => "hello world" +function text = strip (text) + chars = find (! isspace (text)); + if (length (chars) > 0) + text = text(chars(1):chars(end)); + else + text = ""; + endif +endfunction + +## Split the text into a cell array of strings by sep. +## Example: "A, B" => {"A", "B"} (with sep = ",") +function out = split_by (text, sep) + out = strtrim (strsplit (text, sep)); +endfunction + +## Create an INDEX file for a package that doesn't provide one. +## 'desc' describes the package. +## 'dir' is the 'inst' directory in temporary directory. +## 'index_file' is the name (including path) of resulting INDEX file. +function write_index (desc, dir, index_file, global_install) + ## Get names of functions in dir + [files, err, msg] = readdir (dir); + if (err) + error ("couldn't read directory %s: %s", dir, msg); + endif + + ## Check for architecture dependent files. + tmpdir = getarchdir (desc); + if (exist (tmpdir, "dir")) + [files2, err, msg] = readdir (tmpdir); + if (err) + error ("couldn't read directory %s: %s", tmpdir, msg); + endif + files = [files; files2]; + endif + + functions = {}; + for i = 1:length (files) + file = files{i}; + lf = length (file); + if (lf > 2 && strcmp (file(end-1:end), ".m")) + functions{end+1} = file(1:end-2); + elseif (lf > 4 && strcmp (file(end-3:end), ".oct")) + functions{end+1} = file(1:end-4); + endif + endfor + + ## Does desc have a categories field? + if (! isfield (desc, "categories")) + error ("the DESCRIPTION file must have a Categories field, when no INDEX file is given"); + endif + categories = split_by (desc.categories, ","); + if (length (categories) < 1) + error ("the Category field is empty"); + endif + + ## Write INDEX. + fid = fopen (index_file, "w"); + if (fid == -1) + error ("couldn't open %s for writing.", index_file); + endif + fprintf (fid, "%s >> %s\n", desc.name, desc.title); + fprintf (fid, "%s\n", categories{1}); + fprintf (fid, " %s\n", functions{:}); + fclose (fid); +endfunction + +function bad_deps = get_unsatisfied_deps (desc, installed_pkgs_lst) + bad_deps = {}; + + ## For each dependency. + for i = 1:length (desc.depends) + dep = desc.depends{i}; + + ## Is the current dependency Octave? + if (strcmp (dep.package, "octave")) + if (! compare_versions (OCTAVE_VERSION, dep.version, dep.operator)) + bad_deps{end+1} = dep; + endif + ## Is the current dependency not Octave? + else + ok = false; + for i = 1:length (installed_pkgs_lst) + cur_name = installed_pkgs_lst{i}.name; + cur_version = installed_pkgs_lst{i}.version; + if (strcmp (dep.package, cur_name) + && compare_versions (cur_version, dep.version, dep.operator)) + ok = true; + break; + endif + endfor + if (! ok) + bad_deps{end+1} = dep; + endif + endif + endfor +endfunction + +function [out1, out2] = installed_packages (local_list, global_list) + ## Get the list of installed packages. + try + local_packages = load (local_list).local_packages; + catch + local_packages = {}; + end_try_catch + try + global_packages = load (global_list).global_packages; + catch + global_packages = {}; + end_try_catch + installed_pkgs_lst = {local_packages{:}, global_packages{:}}; + + ## Eliminate duplicates in the installed package list. + ## Locally installed packages take precedence. + dup = []; + for i = 1:length (installed_pkgs_lst) + if (find (dup, i)) + continue; + endif + for j = (i+1):length (installed_pkgs_lst) + if (find (dup, j)) + continue; + endif + if (strcmp (installed_pkgs_lst{i}.name, installed_pkgs_lst{j}.name)) + dup = [dup, j]; + endif + endfor + endfor + if (! isempty(dup)) + installed_pkgs_lst(dup) = []; + endif + + ## Now check if the package is loaded. + tmppath = strrep (path(), "\\", "/"); + for i = 1:length (installed_pkgs_lst) + if (findstr (tmppath, strrep (installed_pkgs_lst{i}.dir, "\\", "/"))) + installed_pkgs_lst{i}.loaded = true; + else + installed_pkgs_lst{i}.loaded = false; + endif + endfor + for i = 1:length (local_packages) + if (findstr (tmppath, strrep (local_packages{i}.dir, "\\", "/"))) + local_packages{i}.loaded = true; + else + local_packages{i}.loaded = false; + endif + endfor + for i = 1:length (global_packages) + if (findstr (tmppath, strrep (global_packages{i}.dir, "\\", "/"))) + global_packages{i}.loaded = true; + else + global_packages{i}.loaded = false; + endif + endfor + + ## Should we return something? + if (nargout == 2) + out1 = local_packages; + out2 = global_packages; + return; + elseif (nargout == 1) + out1 = installed_pkgs_lst; + return; + endif + + ## We shouldn't return something, so we'll print something. + num_packages = length (installed_pkgs_lst); + if (num_packages == 0) + printf ("no packages installed.\n"); + return; + endif + + ## Compute the maximal lengths of name, version, and dir. + h1 = "Package Name"; + h2 = "Version"; + h3 = "Installation directory"; + max_name_length = length (h1); + max_version_length = length (h2); + names = cell (num_packages, 1); + for i = 1:num_packages + max_name_length = max (max_name_length, + length (installed_pkgs_lst{i}.name)); + max_version_length = max (max_version_length, + length (installed_pkgs_lst{i}.version)); + names{i} = installed_pkgs_lst{i}.name; + endfor + max_dir_length = terminal_size()(2) - max_name_length - ... + max_version_length - 7; + if (max_dir_length < 20) + max_dir_length = Inf; + endif + + h1 = postpad (h1, max_name_length + 1, " "); + h2 = postpad (h2, max_version_length, " ");; + + ## Print a header. + header = sprintf("%s | %s | %s\n", h1, h2, h3); + printf (header); + tmp = sprintf (repmat ("-", 1, length(header)-1)); + tmp(length(h1)+2) = "+"; + tmp(length(h1)+length(h2)+5) = "+"; + printf ("%s\n", tmp); + + ## Print the packages. + format = sprintf ("%%%ds %%1s| %%%ds | %%s\n", max_name_length, + max_version_length); + [dummy, idx] = sort (names); + for i = 1:num_packages + cur_name = installed_pkgs_lst{idx(i)}.name; + cur_version = installed_pkgs_lst{idx(i)}.version; + cur_dir = installed_pkgs_lst{idx(i)}.dir; + if (length (cur_dir) > max_dir_length) + first_char = length (cur_dir) - max_dir_length + 4; + first_filesep = strfind (cur_dir(first_char:end), filesep()); + if (! isempty (first_filesep)) + cur_dir = cstrcat ("...", + cur_dir((first_char + first_filesep(1) - 1):end)); + else + cur_dir = cstrcat ("...", cur_dir(first_char:end)); + endif + endif + if (installed_pkgs_lst{idx(i)}.loaded) + cur_loaded = "*"; + else + cur_loaded = " "; + endif + printf (format, cur_name, cur_loaded, cur_version, cur_dir); + endfor +endfunction + +function load_packages (files, handle_deps, local_list, global_list) + installed_pkgs_lst = installed_packages (local_list, global_list); + num_packages = length (installed_pkgs_lst); + + ## Read package names and installdirs into a more convenient format. + pnames = pdirs = cell (1, num_packages); + for i = 1:num_packages + pnames{i} = installed_pkgs_lst{i}.name; + pdirs{i} = installed_pkgs_lst{i}.dir; + endfor + + ## Load all. + if (length (files) == 1 && strcmp (files{1}, "all")) + idx = [1:length(installed_pkgs_lst)]; + ## Load auto. + elseif (length (files) == 1 && strcmp (files{1}, "auto")) + idx = []; + for i = 1:length (installed_pkgs_lst) + if (exist (fullfile (pdirs{i}, "packinfo", ".autoload"), "file")) + idx (end + 1) = i; + endif + endfor + ## Load package_name1 ... + else + idx = []; + for i = 1:length (files) + idx2 = find (strcmp (pnames, files{i})); + if (! any (idx2)) + error ("package %s is not installed", files{i}); + endif + idx (end + 1) = idx2; + endfor + endif + + ## Load the packages, but take care of the ordering of dependencies. + load_packages_and_dependencies (idx, handle_deps, installed_pkgs_lst, true); +endfunction + +function unload_packages (files, handle_deps, local_list, global_list) + installed_pkgs_lst = installed_packages (local_list, global_list); + num_packages = length (installed_pkgs_lst); + + ## Read package names and installdirs into a more convenient format. + pnames = pdirs = cell (1, num_packages); + for i = 1:num_packages + pnames{i} = installed_pkgs_lst{i}.name; + pdirs{i} = installed_pkgs_lst{i}.dir; + pdeps{i} = installed_pkgs_lst{i}.depends; + endfor + + ## Get the current octave path. + p = split_by (path(), pathsep ()); + + if (length (files) == 1 && strcmp (files{1}, "all")) + ## Unload all. + dirs = pdirs; + desc = installed_pkgs_lst; + else + ## Unload package_name1 ... + dirs = {}; + desc = {}; + for i = 1:length (files) + idx = strcmp (pnames, files{i}); + if (! any (idx)) + error ("package %s is not installed", files{i}); + endif + dirs{end+1} = pdirs{idx}; + desc{end+1} = installed_pkgs_lst{idx}; + endfor + endif + + ## Check for architecture dependent directories. + archdirs = {}; + for i = 1:length (dirs) + tmpdir = getarchdir (desc{i}); + if (exist (tmpdir, "dir")) + archdirs{end+1} = dirs{i}; + archdirs{end+1} = tmpdir; + else + archdirs{end+1} = dirs{i}; + endif + endfor + + ## Unload the packages. + for i = 1:length (archdirs) + d = archdirs{i}; + idx = strcmp (p, d); + if (any (idx)) + rmpath (d); + ## FIXME: We should also check if we need to remove items from + ## EXEC_PATH. + endif + endfor +endfunction + +function [status_out, msg_out] = rm_rf (dir) + if (exist (dir)) + crr = confirm_recursive_rmdir (); + unwind_protect + confirm_recursive_rmdir (false); + [status, msg] = rmdir (dir, "s"); + unwind_protect_cleanup + confirm_recursive_rmdir (crr); + end_unwind_protect + else + status = 1; + msg = ""; + endif + if (nargout > 0) + status_out = status; + endif + if (nargout > 1) + msg_out = msg; + endif +endfunction + +function emp = dirempty (nm, ign) + if (exist (nm, "dir")) + if (nargin < 2) + ign = {".", ".."}; + else + ign = [{".", ".."}, ign]; + endif + l = dir (nm); + for i = 1:length (l) + found = false; + for j = 1:length (ign) + if (strcmp (l(i).name, ign{j})) + found = true; + break; + endif + endfor + if (! found) + emp = false; + return + endif + endfor + emp = true; + else + emp = true; + endif +endfunction + +function arch = getarch () + persistent _arch = cstrcat (octave_config_info("canonical_host_type"), ... + "-", octave_config_info("api_version")); + arch = _arch; +endfunction + +function archprefix = getarchprefix (desc, global_install) + if ((nargin == 2 && global_install) || (nargin < 2 && issuperuser ())) + archprefix = fullfile (octave_config_info ("libexecdir"), "octave", + "packages", cstrcat(desc.name, "-", desc.version)); + else + archprefix = desc.dir; + endif +endfunction + +function archdir = getarchdir (desc) + archdir = fullfile (desc.archprefix, getarch()); +endfunction + +function s = issuperuser () + if ((ispc () && ! isunix ()) || (geteuid() == 0)) + s = true; + else + s = false; + endif +endfunction + +function [status, output] = shell (cmd) + persistent have_sh; + + cmd = strrep (cmd, "\\", "/"); + if (ispc () && ! isunix ()) + if (isempty(have_sh)) + if (system("sh.exe -c \"exit\"")) + have_sh = false; + else + have_sh = true; + endif + endif + if (have_sh) + [status, output] = system (cstrcat ("sh.exe -c \"", cmd, "\"")); + else + error ("Can not find the command shell") + endif + else + [status, output] = system (cmd); + endif +endfunction + +function newdesc = save_order (desc) + newdesc = {}; + for i = 1 : length(desc) + deps = desc{i}.depends; + if (isempty (deps) || (length (deps) == 1 && + strcmp(deps{1}.package, "octave"))) + newdesc {end + 1} = desc{i}; + else + tmpdesc = {}; + for k = 1 : length (deps) + for j = 1 : length (desc) + if (strcmp (desc{j}.name, deps{k}.package)) + tmpdesc{end+1} = desc{j}; + break; + endif + endfor + endfor + if (! isempty (tmpdesc)) + newdesc = {newdesc{:}, save_order(tmpdesc){:}, desc{i}}; + else + newdesc{end+1} = desc{i}; + endif + endif + endfor + ## Eliminate the duplicates. + idx = []; + for i = 1 : length (newdesc) + for j = (i + 1) : length (newdesc) + if (strcmp (newdesc{i}.name, newdesc{j}.name)) + idx (end + 1) = j; + endif + endfor + endfor + newdesc(idx) = []; +endfunction + +function load_packages_and_dependencies (idx, handle_deps, installed_pkgs_lst, + global_install) + idx = load_package_dirs (idx, [], handle_deps, installed_pkgs_lst); + dirs = {}; + execpath = EXEC_PATH (); + for i = idx; + ndir = installed_pkgs_lst{i}.dir; + dirs{end+1} = ndir; + if (exist (fullfile (dirs{end}, "bin"), "dir")) + execpath = cstrcat (fullfile (dirs{end}, "bin"), ":", execpath); + endif + tmpdir = getarchdir (installed_pkgs_lst{i}); + if (exist (tmpdir, "dir")) + dirs{end + 1} = tmpdir; + if (exist (fullfile (dirs{end}, "bin"), "dir")) + execpath = cstrcat (fullfile (dirs{end}, "bin"), ":", execpath); + endif + endif + endfor + + ## Load the packages. + if (length (dirs) > 0) + addpath (dirs{:}); + endif + + ## Add the binaries to exec_path. + if (! strcmp (EXEC_PATH, execpath)) + EXEC_PATH (execpath); + endif +endfunction + +function idx = load_package_dirs (lidx, idx, handle_deps, installed_pkgs_lst) + for i = lidx + if (isfield (installed_pkgs_lst{i}, "loaded") && + installed_pkgs_lst{i}.loaded) + continue; + else + if (handle_deps) + deps = installed_pkgs_lst{i}.depends; + if ((length (deps) > 1) || (length (deps) == 1 && + ! strcmp(deps{1}.package, "octave"))) + tmplidx = []; + for k = 1 : length (deps) + for j = 1 : length (installed_pkgs_lst) + if (strcmp (installed_pkgs_lst{j}.name, deps{k}.package)) + tmplidx (end + 1) = j; + break; + endif + endfor + endfor + idx = load_package_dirs (tmplidx, idx, handle_deps, + installed_pkgs_lst); + endif + endif + if (isempty (find(idx == i))) + idx (end + 1) = i; + endif + endif + endfor +endfunction + +function dep = is_architecture_dependent (nm) + persistent archdepsuffix = {".oct",".mex",".a",".lib",".so",".so.*",".dll","dylib"}; + + dep = false; + for i = 1 : length (archdepsuffix) + ext = archdepsuffix{i}; + if (ext(end) == "*") + isglob = true; + ext(end) = []; + else + isglob = false; + endif + pos = findstr (nm, ext); + if (pos) + if (! isglob && (length(nm) - pos(end) != length(ext) - 1)) + continue; + endif + dep = true; + break; + endif + endfor +endfunction |