diff options
358 files changed, 20458 insertions, 7952 deletions
diff --git a/ChangeLog b/ChangeLog index 2a0dd144670..13e3657bac3 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,119 @@ +2011-02-21 Christoph Scholtes <cschol2112@gmail.com> + + * lib/makefile.w32-in: ($(BLD)/md5.$(O)): Added dependency on + $(EMACS_ROOT)/nt/inc/stdint.h. + +2011-02-21 Eli Zaretskii <eliz@gnu.org> + + * lib/makefile.w32-in ($(BLD)/filemode.$(O)): Move from + src/makefile.w32-in and adapt. Depend on stamp_BLD. + (GNULIBOBJS): Add $(BLD)/filemode.$(O). + +2011-02-20 Paul Eggert <eggert@cs.ucla.edu> + + Import filemode module from gnulib. + * .bzrignore: Add lib/sys/. + * Makefile.in (GNULIB_MODULES): Add filemode. + * lib/Makefile.am (MOSTLYCLEANDIRS): New macro. + * lib/filemode.c: Renamed from src/filemode.c and regenerated + from gnulib. This adds support for some more file types, e.g., + Cray DMF migrated files. + * lisp/emacs-lisp/find-gc.el (find-gc-source-files): Remove filemode.c. + * lib/filemode.h, lib/sys_stat.in.h, m4/filemode.m4, m4/st_dm_mode.m4: + * m4/sys_stat_h.m4: New files, generated from gnulib. + * aclocal.m4, configure, lib/Makefile.in, lib/gnulib.mk, m4/gl-comp.m4: + Regenerate. + +2011-02-20 Eli Zaretskii <eliz@gnu.org> + + * lib/makefile.w32-in ($(BLD)/md5.$(O)): Don't depend on + $(EMACS_ROOT)/nt/inc/sys/stat.h. + +2011-02-20 Paul Eggert <eggert@cs.ucla.edu> + + * configure.in (C_WARNINGS_SWITCH): Do not prepend -Wno-pointer-sign. + This undoes the 2006-01-02 change. The -Wno-pointer-sign option + is no longer needed, due to the recent SSDATA and related changes. + Perhaps -Wno-pointer-sign should also be removed from + nextstep/Cocoa/Emacs.xcodeproj/project.pbxproj but I have no easy + way to test this so I left it alone. + * configure: Regenerate. + +2011-02-20 Christoph Scholtes <cschol2112@gmail.com> + + * lib/makefile.w32-in ($(BLD)/md5.$(O)): New recipe, moved from + src/makefile.w32-in. + +2011-02-20 Paul Eggert <eggert@cs.ucla.edu> + + Import crypto/md5 and stdint modules from gnulib. + * aclocal.m4, configure, lib/Makefile.in, lib/gnulib.mk, m4/gl-comp.m4: + Regenerate. + * lib/md5.c, lib/md5.h: Rename from src/md5.h and lib/md5.h. + Import the new versions from gnulib; they assume a C99-style + <stdint.h>, supplied by the stdint module. + * lib/stdint.in.h, m4/longlong.m4, m4/stdint.m4, m4/md5.m4: New files, + imported from gnulib. + * Makefile.in (MAKEFILE_MODULES): Add crypto/md5. + * admin/notes/copyright: Remove src/md5.c and src/md5.h as + special cases. + +2011-02-19 Eli Zaretskii <eliz@gnu.org> + + * .bzrignore: Ignore cxxdefs.h and lib/*.in-h files. + Add lib/deps/. + + * config.bat: Configure in `lib'. + Generate *.Po files in lib/deps. + +2011-02-18 Paul Eggert <eggert@cs.ucla.edu> + + Import IRIX 6.5 getloadavg fixes from gnulib. + * configure, lib/getloadavg.c, m4/getloadavg.m4: Regenerate. + +2011-02-16 Paul Eggert <eggert@cs.ucla.edu> + + Import getloadavg module from gnulib. + * .bzrignore: Add lib/stdlib.h. + * Makefile.in (GNULIB_MODULES): Add getloadavg. + * admin/notes/copyright: Remove src/getloadavg.c as a special case. + * configure.in (LIBS_SYSTEM): Omit -lkstat on sol2*; gnulib does this. + (AC_CONFIG_LIBOBJ_DIR, AC_FUNC_GETLOADAVG, GETLOADAVG_FILES): + Remove; gnulib does this now. + * lib/getloadavg.c: Rename from src/getloadavg.c, and sync + from gnulib. This adds support for several other systems, such + as Tru64 4.0D, QNX, AIX perfstat, etc. It also fixes a potential + buffer overrun on Linux hosts under very high load, and on hosts + that maintain a channel to the load average file it makes sure + the file descriptor is close-on-exec (on hosts that support this) + and is not stdin, stdout, or stderr. + * lib/stdlib.in.h, m4/getloadavg.m4, m4/stdlib_h.m4: New files, + from gnulib. + * aclocal.m4, configure, lib/Makefile.in, lib/gnulib.mk, m4/gl-comp.m4: + * src/config.in: Regenerate. + +2011-02-15 Paul Eggert <eggert@cs.ucla.edu> + + Merge from gnulib. + + * install-sh: Update to scriptversion 2011-01-19.21. + + 2011-02-13 Bruno Haible <bruno@clisp.org> + + Consistent macro naming for macros that use GCC __attribute__. + * lib/ignore-value.h (_GL_ATTRIBUTE_DEPRECATED): Renamed from + ATTRIBUTE_DEPRECATED. + + 2011-02-12 Bruno Haible <bruno@clisp.org> + + setlocale: Prefer gnulib's override over libintl's override. + * lib/gettext.h (setlocale): Redefine to rpl_setlocale if + GNULIB_defined_setlocale is set. + +2011-02-13 Glenn Morris <rgm@gnu.org> + + * make-dist: Exclude generated file src/globals.h. + 2011-02-10 Paul Eggert <eggert@cs.ucla.edu> * arg-nonnull.h, c++defs.h, warn-on-use.h: Fix licenses. diff --git a/Makefile.in b/Makefile.in index e8206a6f012..b1861241882 100644 --- a/Makefile.in +++ b/Makefile.in @@ -330,7 +330,9 @@ DOS_gnulib_comp.m4 = gl-comp.m4 # Update modules from gnulib, for maintainers, who should have it in # $(gnulib_srcdir) (relative to $(srcdir) and should have build tools # as per $(gnulib_srcdir)/DEPENDENCIES. -GNULIB_MODULES = dtoastr getopt-gnu ignore-value mktime strftime +GNULIB_MODULES = \ + crypto/md5 dtoastr filemode getloadavg getopt-gnu \ + ignore-value mktime strftime GNULIB_TOOL_FLAGS = \ --import --no-changelog --no-vc-files --makefile-name=gnulib.mk sync-from-gnulib: $(gnulib_srcdir) diff --git a/aclocal.m4 b/aclocal.m4 index 17c3f919288..f66e6979882 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -987,15 +987,23 @@ AC_SUBST([am__untar]) m4_include([m4/00gnulib.m4]) m4_include([m4/c-strtod.m4]) m4_include([m4/extensions.m4]) +m4_include([m4/filemode.m4]) +m4_include([m4/getloadavg.m4]) m4_include([m4/getopt.m4]) m4_include([m4/gl-comp.m4]) m4_include([m4/gnulib-common.m4]) m4_include([m4/include_next.m4]) +m4_include([m4/longlong.m4]) +m4_include([m4/md5.m4]) m4_include([m4/mktime.m4]) m4_include([m4/multiarch.m4]) +m4_include([m4/st_dm_mode.m4]) m4_include([m4/stdbool.m4]) m4_include([m4/stddef_h.m4]) +m4_include([m4/stdint.m4]) +m4_include([m4/stdlib_h.m4]) m4_include([m4/strftime.m4]) +m4_include([m4/sys_stat_h.m4]) m4_include([m4/time_h.m4]) m4_include([m4/time_r.m4]) m4_include([m4/tm_gmtoff.m4]) diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index 7febc93bb33..dae6202b4e4 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -62,8 +62,6 @@ SIGTYPE SYSTEM_TYPE ** Machine specific macros, decribed in detail in src/m/template.h -LOAD_AVE_CVT -LOAD_AVE_TYPE VIRT_ADDR_VARIES ** Misc macros @@ -111,7 +109,6 @@ EMACS_INT EMACS_UINT FILE_SYSTEM_CASE FLOAT_CHECK_DOMAIN -FSCALE GC_LISP_OBJECT_ALIGNMENT GC_MARK_SECONDARY_STACK GC_MARK_STACK @@ -193,8 +190,6 @@ HPUX INTERNAL_TERMINAL IS_ANY_SEP IS_DIRECTORY_SEP -KERNEL_FILE -LDAV_SYMBOL LINKER LINUX_VERSION_CODE LISP_FLOAT_TYPE @@ -381,4 +376,3 @@ vfork wait write xfree - diff --git a/admin/ChangeLog b/admin/ChangeLog index 0ca88ee84d5..87ba151dc34 100644 --- a/admin/ChangeLog +++ b/admin/ChangeLog @@ -1,3 +1,17 @@ +2011-02-19 Eli Zaretskii <eliz@gnu.org> + + * admin.el (set-version): Add msdos/sed2v2.inp. + +2011-02-16 Paul Eggert <eggert@cs.ucla.edu> + + Remove no-longer needed getloadavg symbols. + * CPP-DEFINES (LOAD_AVE_CVT, LOAD_AVE_TYPE, FSCALE, KERNEL_FILE): + (LDAV_SYMBOL): Remove. + +2011-02-12 Glenn Morris <rgm@gnu.org> + + * bzrmerge.el (bzrmerge-resolve): Fix bzr revert call. + 2011-02-05 Glenn Morris <rgm@gnu.org> * bzrmerge.el (bzrmerge-warning-buffer): New constant. diff --git a/admin/admin.el b/admin/admin.el index 9f87e9b2590..717bfee702d 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -77,6 +77,10 @@ Root must be the root of an Emacs source tree." (rx (and bol "#" (0+ blank) "define" (1+ blank) "VERSION" (1+ blank) (submatch (1+ (in "0-9.")))))) + (set-version-in-file root "msdos/sed2v2.inp" version + (rx (and bol "/^#undef " (1+ not-newline) + "define VERSION" (1+ space) + (submatch (1+ (in "0-9.")))))) (set-version-in-file root "nt/makefile.w32-in" version (rx (and "VERSION" (0+ space) "=" (0+ space) (submatch (1+ (in "0-9.")))))) diff --git a/admin/bzrmerge.el b/admin/bzrmerge.el index 061af80b6cf..77e64a862c8 100644 --- a/admin/bzrmerge.el +++ b/admin/bzrmerge.el @@ -187,7 +187,9 @@ are both lists of revnos, in oldest-first order." (cond ((member file '("configure" "lisp/ldefs-boot.el" "lisp/emacs-lisp/cl-loaddefs.el")) - (call-process "bzr" nil t nil "revert" file) + ;; We are in the file's buffer, so names are relative. + (call-process "bzr" nil t nil "revert" + (file-name-nondirectory file)) (revert-buffer nil 'noconfirm)) (t (goto-char (point-max)) diff --git a/admin/notes/bzr b/admin/notes/bzr index cb2a1bd4e4f..11f0af17a3b 100644 --- a/admin/notes/bzr +++ b/admin/notes/bzr @@ -65,11 +65,26 @@ removes a file, then remove the corresponding files by hand. The following description uses bound branches, presumably it works in a similar way with unbound ones. +0) (First time only) Get the bzr changelog_merge plugin: + +cd ~/.bazaar/plugins +bzr branch lp:bzr-changelog-merge +mv bzr-changelog-merge changelog_merge + +This will make merging ChangeLogs a lot smoother. It merges new +entries to the top of the file, rather than trying to fit them in +mid-way through. + 1) Get clean, up-to-date copies of the emacs-23 and trunk branches. Check for any uncommitted changes with bzr status. 2) M-x cd /path/to/trunk +The first time only, do this: +cd .bzr/branch +Add the following line to branch.conf: +changelog_merge_files = ChangeLog + 3) load admin/bzrmerge.el 4) M-x bzrmerge RET /path/to/emacs-23 RET @@ -119,3 +134,27 @@ right thing to do is merge everything else, resolve the conflict by choosing either the trunk or branch version, then run `make -C lisp autoloads' to update the md5sums to the correct trunk value before committing. + +* Re-adding a file that has been removed from the repository + +It's easy to get this wrong. Let's suppose you've done: + +bzr remove file; bzr commit + +and now, sometime later, you realize this was a mistake and file needs +to be brought back. DON'T just do: + +bzr add file; bzr commit + +This restores file, but without its history (`bzr log file' will be +very short). This is because file gets re-added with a new file-id +(use `bzr file-id file' to see the id). + +Insteading of adding the file, try: + +bzr revert -rN file; bzr commit + +where revision N+1 is the one where file was removed. + +You could also try `bzr add --file-ids-from', if you have a copy of +another branch where file still exists. diff --git a/admin/notes/copyright b/admin/notes/copyright index e4077caf77b..54d97adaf1c 100644 --- a/admin/notes/copyright +++ b/admin/notes/copyright @@ -557,7 +557,7 @@ Note: erring on the side of caution, I also added notices to some files I thought might be considered non-trivial (if one includes comment) in s/: aix4-1.h hpux10.h irix6-0.h irix6-5.h - ptx4.h sol2.h + ptx4.h sol2.h (everything with > 30 non-blank lines, which at least is _some_ kind of system) @@ -631,10 +631,7 @@ alone (may import them from Gnulib again). These are: warn-on-use.h lib/*.[ch] lib/gnulib.mk - src/getloadavg.c src/gmalloc.c - src/md5.c - src/md5.h src/termcap.c src/tparam.c diff --git a/config.bat b/config.bat index f87bcd13a5d..7ebfc74b801 100644 --- a/config.bat +++ b/config.bat @@ -2,7 +2,8 @@ rem ----------------------------------------------------------------------
rem Configuration script for MSDOS
rem Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2001, 2002, 2003
-rem 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+rem 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation,
+rem Inc.
rem This file is part of GNU Emacs.
@@ -273,6 +274,25 @@ Rem supports long file names but DJGPP does not for %%d in (emacs lispref lispintro lispintr misc) do sed -f ../msdos/sed6.inp < %%d\Makefile.in > %%d\Makefile
cd ..
rem ----------------------------------------------------------------------
+Echo Configuring the lib directory...
+If Exist c++defs.h update c++defs.h cxxdefs.h
+cd lib
+Rem Rename files like djtar on plain DOS filesystem would.
+If Exist c++defs.h update c++defs.h cxxdefs.h
+If Exist getopt.in.h update getopt.in.h getopt.in-h
+If Exist stddef.in.h update stddef.in.h stddef.in-h
+If Exist stdbool.in.h update stdbool.in.h stdbool.in-h
+If Exist stdlib.in.h update stdlib.in.h stdlib.in-h
+If Exist time.in.h update time.in.h time.in-h
+If Exist unistd.in.h update unistd.in.h unistd.in-h
+sed -f ../msdos/sedlibcf.inp < Makefile.in > makefile.tmp
+sed -f ../msdos/sedlibmk.inp < makefile.tmp > Makefile
+rm -f makefile.tmp
+If Not Exist deps\stamp mkdir deps
+If Not Exist deps\stamp for %%f in (*.c) do @call ..\msdos\depfiles.bat %%f
+If Not Exist deps\stamp echo deps-stamp > deps\stamp
+cd ..
+rem ----------------------------------------------------------------------
Echo Configuring the lisp directory...
cd lisp
If Exist gnus\.dir-locals.el update gnus/.dir-locals.el gnus/_dir-locals.el
diff --git a/configure b/configure index 50cd4b283f0..66a7ca44a80 100755 --- a/configure +++ b/configure @@ -591,7 +591,6 @@ ac_includes_default="\ # include <unistd.h> #endif" -ac_config_libobj_dir=src ac_header_list= gl_getopt_required=POSIX gl_getopt_required=POSIX @@ -603,6 +602,7 @@ gl_LIBOBJS am__EXEEXT_FALSE am__EXEEXT_TRUE LTLIBOBJS +LIBOBJS WINDOW_SUPPORT TOOLTIP_SUPPORT MOUSE_SUPPORT @@ -669,6 +669,66 @@ SYS_TIME_H_DEFINES_STRUCT_TIMESPEC TIME_H_DEFINES_STRUCT_TIMESPEC NEXT_AS_FIRST_DIRECTIVE_TIME_H NEXT_TIME_H +NEXT_AS_FIRST_DIRECTIVE_SYS_STAT_H +NEXT_SYS_STAT_H +REPLACE_UTIMENSAT +REPLACE_STAT +REPLACE_MKNOD +REPLACE_MKFIFO +REPLACE_MKDIR +REPLACE_LSTAT +REPLACE_FUTIMENS +REPLACE_FSTATAT +REPLACE_FSTAT +HAVE_UTIMENSAT +HAVE_MKNODAT +HAVE_MKNOD +HAVE_MKFIFOAT +HAVE_MKFIFO +HAVE_MKDIRAT +HAVE_LSTAT +HAVE_LCHMOD +HAVE_FUTIMENS +HAVE_FSTATAT +HAVE_FCHMODAT +GNULIB_UTIMENSAT +GNULIB_STAT +GNULIB_MKNODAT +GNULIB_MKNOD +GNULIB_MKFIFOAT +GNULIB_MKFIFO +GNULIB_MKDIRAT +GNULIB_LSTAT +GNULIB_LCHMOD +GNULIB_FUTIMENS +GNULIB_FSTATAT +GNULIB_FCHMODAT +NEXT_AS_FIRST_DIRECTIVE_STDLIB_H +NEXT_STDLIB_H +STDINT_H +WINT_T_SUFFIX +WCHAR_T_SUFFIX +SIG_ATOMIC_T_SUFFIX +SIZE_T_SUFFIX +PTRDIFF_T_SUFFIX +HAVE_SIGNED_WINT_T +HAVE_SIGNED_WCHAR_T +HAVE_SIGNED_SIG_ATOMIC_T +BITSIZEOF_WINT_T +BITSIZEOF_WCHAR_T +BITSIZEOF_SIG_ATOMIC_T +BITSIZEOF_SIZE_T +BITSIZEOF_PTRDIFF_T +HAVE_SYS_BITYPES_H +HAVE_SYS_INTTYPES_H +HAVE_STDINT_H +NEXT_AS_FIRST_DIRECTIVE_STDINT_H +NEXT_STDINT_H +HAVE_SYS_TYPES_H +HAVE_INTTYPES_H +HAVE_WCHAR_H +HAVE_UNSIGNED_LONG_LONG_INT +HAVE_LONG_LONG_INT NEXT_AS_FIRST_DIRECTIVE_STDDEF_H NEXT_STDDEF_H STDDEF_H @@ -805,12 +865,70 @@ GNULIB_DUP3 GNULIB_DUP2 GNULIB_CLOSE GNULIB_CHOWN +GETLOADAVG_LIBS +REPLACE_UNSETENV +REPLACE_STRTOD +REPLACE_SETENV +REPLACE_REALPATH +REPLACE_REALLOC +REPLACE_PUTENV +REPLACE_MKSTEMP +REPLACE_MALLOC +REPLACE_CANONICALIZE_FILE_NAME +REPLACE_CALLOC +HAVE_DECL_UNSETENV +HAVE_UNLOCKPT +HAVE_SYS_LOADAVG_H +HAVE_STRUCT_RANDOM_DATA +HAVE_STRTOULL +HAVE_STRTOLL +HAVE_STRTOD +HAVE_DECL_SETENV +HAVE_SETENV +HAVE_RPMATCH +HAVE_REALPATH +HAVE_RANDOM_R +HAVE_RANDOM_H +HAVE_PTSNAME +HAVE_MKSTEMPS +HAVE_MKSTEMP +HAVE_MKOSTEMPS +HAVE_MKOSTEMP +HAVE_MKDTEMP +HAVE_GRANTPT +HAVE_GETSUBOPT +HAVE_DECL_GETLOADAVG +HAVE_CANONICALIZE_FILE_NAME +HAVE_ATOLL +HAVE__EXIT +GNULIB_UNSETENV +GNULIB_UNLOCKPT +GNULIB_SYSTEM_POSIX +GNULIB_STRTOULL +GNULIB_STRTOLL +GNULIB_STRTOD +GNULIB_SETENV +GNULIB_RPMATCH +GNULIB_REALPATH +GNULIB_REALLOC_POSIX +GNULIB_RANDOM_R +GNULIB_PUTENV +GNULIB_PTSNAME +GNULIB_MKSTEMPS +GNULIB_MKSTEMP +GNULIB_MKOSTEMPS +GNULIB_MKOSTEMP +GNULIB_MKDTEMP +GNULIB_MALLOC_POSIX +GNULIB_GRANTPT +GNULIB_GETSUBOPT +GNULIB_GETLOADAVG +GNULIB_CANONICALIZE_FILE_NAME +GNULIB_CALLOC_POSIX +GNULIB_ATOLL +GNULIB__EXIT GL_COND_LIBTOOL_FALSE GL_COND_LIBTOOL_TRUE -GETLOADAVG_LIBS -KMEM_GROUP -NEED_SETGID -LIBOBJS BLESSMAIL_TARGET LIBS_MAIL liblockfile @@ -2360,6 +2478,184 @@ $as_echo "$ac_res" >&6; } eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} } # ac_fn_c_check_type + +# ac_fn_c_compute_int LINENO EXPR VAR INCLUDES +# -------------------------------------------- +# Tries to find the compile-time value of EXPR in a program that includes +# INCLUDES, setting VAR accordingly. Returns whether the value could be +# computed +ac_fn_c_compute_int () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if test "$cross_compiling" = yes; then + # Depending upon the size, compute the lo and hi bounds. +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) >= 0)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_lo=0 ac_mid=0 + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) <= $ac_mid)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_hi=$ac_mid; break +else + as_fn_arith $ac_mid + 1 && ac_lo=$as_val + if test $ac_lo -le $ac_mid; then + ac_lo= ac_hi= + break + fi + as_fn_arith 2 '*' $ac_mid + 1 && ac_mid=$as_val +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + done +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) < 0)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_hi=-1 ac_mid=-1 + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) >= $ac_mid)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_lo=$ac_mid; break +else + as_fn_arith '(' $ac_mid ')' - 1 && ac_hi=$as_val + if test $ac_mid -le $ac_hi; then + ac_lo= ac_hi= + break + fi + as_fn_arith 2 '*' $ac_mid && ac_mid=$as_val +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + done +else + ac_lo= ac_hi= +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +# Binary search between lo and hi bounds. +while test "x$ac_lo" != "x$ac_hi"; do + as_fn_arith '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo && ac_mid=$as_val + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) <= $ac_mid)]; +test_array [0] = 0 + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_hi=$ac_mid +else + as_fn_arith '(' $ac_mid ')' + 1 && ac_lo=$as_val +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +done +case $ac_lo in #(( +?*) eval "$3=\$ac_lo"; ac_retval=0 ;; +'') ac_retval=1 ;; +esac + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +static long int longval () { return $2; } +static unsigned long int ulongval () { return $2; } +#include <stdio.h> +#include <stdlib.h> +int +main () +{ + + FILE *f = fopen ("conftest.val", "w"); + if (! f) + return 1; + if (($2) < 0) + { + long int i = longval (); + if (i != ($2)) + return 1; + fprintf (f, "%ld", i); + } + else + { + unsigned long int i = ulongval (); + if (i != ($2)) + return 1; + fprintf (f, "%lu", i); + } + /* Do not output a trailing newline, as this causes \r\n confusion + on some platforms. */ + return ferror (f) || fclose (f) != 0; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + echo >>conftest.val; read $3 <conftest.val; ac_retval=0 +else + ac_retval=1 +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +rm -f conftest.val + + fi + eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + as_fn_set_status $ac_retval + +} # ac_fn_c_compute_int cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. @@ -2650,7 +2946,10 @@ as_fn_append ac_header_list " sys/param.h" gl_getopt_required=GNU as_fn_append ac_header_list " getopt.h" as_fn_append ac_func_list " alarm" +as_fn_append ac_header_list " wchar.h" +as_fn_append ac_header_list " stdint.h" as_fn_append ac_func_list " tzset" +as_fn_append ac_header_list " sys/stat.h" as_fn_append ac_header_list " sys/time.h" as_fn_append ac_func_list " localtime_r" # Check that the precious variables saved in the cache have kept the same @@ -5810,9 +6109,12 @@ $as_echo "$ac_cv_safe_to_define___extensions__" >&6; } # Code from module arg-nonnull: # Code from module c++defs: + # Code from module crypto/md5: # Code from module dtoastr: # Code from module extensions: + # Code from module filemode: + # Code from module getloadavg: # Code from module getopt-gnu: # Code from module getopt-posix: # Code from module gettext-h: @@ -5823,7 +6125,10 @@ $as_echo "$ac_cv_safe_to_define___extensions__" >&6; } # Code from module multiarch: # Code from module stdbool: # Code from module stddef: + # Code from module stdint: + # Code from module stdlib: # Code from module strftime: + # Code from module sys_stat: # Code from module time: # Code from module time_r: # Code from module unistd: @@ -5898,37 +6203,6 @@ else test "x$NON_GCC_TEST_OPTIONS" != x && CC="$CC $NON_GCC_TEST_OPTIONS" fi -### Use -Wno-pointer-sign if the compiler supports it -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether gcc understands -Wno-pointer-sign" >&5 -$as_echo_n "checking whether gcc understands -Wno-pointer-sign... " >&6; } -SAVE_CFLAGS="$CFLAGS" -CFLAGS="$CFLAGS -Wno-pointer-sign" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -int -main () -{ - - ; - return 0; -} -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - has_option=yes -else - has_option=no -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext -if test $has_option = yes; then - C_WARNINGS_SWITCH="-Wno-pointer-sign $C_WARNINGS_SWITCH" -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $has_option" >&5 -$as_echo "$has_option" >&6; } -CFLAGS="$SAVE_CFLAGS" -unset has_option -unset SAVE_CFLAGS - ### Use -Wdeclaration-after-statement if the compiler supports it { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether gcc understands -Wdeclaration-after-statement" >&5 $as_echo_n "checking whether gcc understands -Wdeclaration-after-statement... " >&6; } @@ -6695,7 +6969,7 @@ case "$opsys" in hpux*) LIBS_SYSTEM="-l:libdld.sl" ;; - sol2*) LIBS_SYSTEM="-lsocket -lnsl -lkstat" ;; + sol2*) LIBS_SYSTEM="-lsocket -lnsl" ;; ## Motif needs -lgen. unixware) LIBS_SYSTEM="-lsocket -lnsl -lelf -lgen" ;; @@ -6711,8 +6985,6 @@ else CPPFLAGS="$C_SWITCH_SYSTEM $C_SWITCH_MACHINE $CPPFLAGS" fi - - # Check whether --enable-largefile was given. if test "${enable_largefile+set}" = set; then : enableval=$enable_largefile; @@ -13001,615 +13273,390 @@ fi done -ac_have_func=no # yes means we've found a way to get the load average. - -# Make sure getloadavg.c is where it belongs, at configure-time. -test -f "$srcdir/$ac_config_libobj_dir/getloadavg.c" || - as_fn_error $? "$srcdir/$ac_config_libobj_dir/getloadavg.c is missing" "$LINENO" 5 - -ac_save_LIBS=$LIBS - -# Check for getloadavg, but be sure not to touch the cache variable. -(ac_fn_c_check_func "$LINENO" "getloadavg" "ac_cv_func_getloadavg" -if test "x$ac_cv_func_getloadavg" = x""yes; then : - exit 0 -else - exit 1 -fi -) && ac_have_func=yes - -# On HPUX9, an unprivileged user can get load averages through this function. -for ac_func in pstat_getdynamic -do : - ac_fn_c_check_func "$LINENO" "pstat_getdynamic" "ac_cv_func_pstat_getdynamic" -if test "x$ac_cv_func_pstat_getdynamic" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_PSTAT_GETDYNAMIC 1 -_ACEOF - -fi -done - - -# Solaris has libkstat which does not require root. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for kstat_open in -lkstat" >&5 -$as_echo_n "checking for kstat_open in -lkstat... " >&6; } -if test "${ac_cv_lib_kstat_kstat_open+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lkstat $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char kstat_open (); -int -main () -{ -return kstat_open (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_kstat_kstat_open=yes -else - ac_cv_lib_kstat_kstat_open=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_kstat_kstat_open" >&5 -$as_echo "$ac_cv_lib_kstat_kstat_open" >&6; } -if test "x$ac_cv_lib_kstat_kstat_open" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_LIBKSTAT 1 -_ACEOF - - LIBS="-lkstat $LIBS" - -fi - -test $ac_cv_lib_kstat_kstat_open = yes && ac_have_func=yes - -# Some systems with -lutil have (and need) -lkvm as well, some do not. -# On Solaris, -lkvm requires nlist from -lelf, so check that first -# to get the right answer into the cache. -# For kstat on solaris, we need libelf to force the definition of SVR4 below. -if test $ac_have_func = no; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for elf_begin in -lelf" >&5 -$as_echo_n "checking for elf_begin in -lelf... " >&6; } -if test "${ac_cv_lib_elf_elf_begin+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lelf $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char elf_begin (); -int -main () -{ -return elf_begin (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_elf_elf_begin=yes -else - ac_cv_lib_elf_elf_begin=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_elf_elf_begin" >&5 -$as_echo "$ac_cv_lib_elf_elf_begin" >&6; } -if test "x$ac_cv_lib_elf_elf_begin" = x""yes; then : - LIBS="-lelf $LIBS" -fi - -fi -if test $ac_have_func = no; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for kvm_open in -lkvm" >&5 -$as_echo_n "checking for kvm_open in -lkvm... " >&6; } -if test "${ac_cv_lib_kvm_kvm_open+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lkvm $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char kvm_open (); -int -main () -{ -return kvm_open (); - ; - return 0; -} -_ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_kvm_kvm_open=yes -else - ac_cv_lib_kvm_kvm_open=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_kvm_kvm_open" >&5 -$as_echo "$ac_cv_lib_kvm_kvm_open" >&6; } -if test "x$ac_cv_lib_kvm_kvm_open" = x""yes; then : - LIBS="-lkvm $LIBS" -fi - - # Check for the 4.4BSD definition of getloadavg. - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getloadavg in -lutil" >&5 -$as_echo_n "checking for getloadavg in -lutil... " >&6; } -if test "${ac_cv_lib_util_getloadavg+set}" = set; then : +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for _LARGEFILE_SOURCE value needed for large files" >&5 +$as_echo_n "checking for _LARGEFILE_SOURCE value needed for large files... " >&6; } +if test "${ac_cv_sys_largefile_source+set}" = set; then : $as_echo_n "(cached) " >&6 else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lutil $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char getloadavg (); +#include <sys/types.h> /* for off_t */ + #include <stdio.h> int main () { -return getloadavg (); +int (*fp) (FILE *, off_t, int) = fseeko; + return fseeko (stdin, 0, 0) && fp (stdin, 0, 0); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_util_getloadavg=yes -else - ac_cv_lib_util_getloadavg=no + ac_cv_sys_largefile_source=no; break fi rm -f core conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_util_getloadavg" >&5 -$as_echo "$ac_cv_lib_util_getloadavg" >&6; } -if test "x$ac_cv_lib_util_getloadavg" = x""yes; then : - LIBS="-lutil $LIBS" ac_have_func=yes ac_cv_func_getloadavg_setgid=yes -fi - -fi - -if test $ac_have_func = no; then - # There is a commonly available library for RS/6000 AIX. - # Since it is not a standard part of AIX, it might be installed locally. - ac_getloadavg_LIBS=$LIBS - LIBS="-L/usr/local/lib $LIBS" - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getloadavg in -lgetloadavg" >&5 -$as_echo_n "checking for getloadavg in -lgetloadavg... " >&6; } -if test "${ac_cv_lib_getloadavg_getloadavg+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_check_lib_save_LIBS=$LIBS -LIBS="-lgetloadavg $LIBS" -cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char getloadavg (); +#define _LARGEFILE_SOURCE 1 +#include <sys/types.h> /* for off_t */ + #include <stdio.h> int main () { -return getloadavg (); +int (*fp) (FILE *, off_t, int) = fseeko; + return fseeko (stdin, 0, 0) && fp (stdin, 0, 0); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_getloadavg_getloadavg=yes -else - ac_cv_lib_getloadavg_getloadavg=no + ac_cv_sys_largefile_source=1; break fi rm -f core conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_getloadavg_getloadavg" >&5 -$as_echo "$ac_cv_lib_getloadavg_getloadavg" >&6; } -if test "x$ac_cv_lib_getloadavg_getloadavg" = x""yes; then : - LIBS="-lgetloadavg $LIBS" -else - LIBS=$ac_getloadavg_LIBS -fi - + ac_cv_sys_largefile_source=unknown + break +done fi - -# Make sure it is really in the library, if we think we found it, -# otherwise set up the replacement function. -for ac_func in getloadavg -do : - ac_fn_c_check_func "$LINENO" "getloadavg" "ac_cv_func_getloadavg" -if test "x$ac_cv_func_getloadavg" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_GETLOADAVG 1 +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_largefile_source" >&5 +$as_echo "$ac_cv_sys_largefile_source" >&6; } +case $ac_cv_sys_largefile_source in #( + no | unknown) ;; + *) +cat >>confdefs.h <<_ACEOF +#define _LARGEFILE_SOURCE $ac_cv_sys_largefile_source _ACEOF - -else - case " $LIBOBJS " in - *" getloadavg.$ac_objext "* ) ;; - *) LIBOBJS="$LIBOBJS getloadavg.$ac_objext" - ;; +;; esac +rm -rf conftest* +# We used to try defining _XOPEN_SOURCE=500 too, to work around a bug +# in glibc 2.1.3, but that breaks too many other things. +# If you want fseeko and ftello with glibc, upgrade to a fixed glibc. +if test $ac_cv_sys_largefile_source != unknown; then -$as_echo "#define C_GETLOADAVG 1" >>confdefs.h +$as_echo "#define HAVE_FSEEKO 1" >>confdefs.h -# Figure out what our getloadavg.c needs. -ac_have_func=no -ac_fn_c_check_header_mongrel "$LINENO" "sys/dg_sys_info.h" "ac_cv_header_sys_dg_sys_info_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_dg_sys_info_h" = x""yes; then : - ac_have_func=yes +fi -$as_echo "#define DGUX 1" >>confdefs.h - { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dg_sys_info in -ldgc" >&5 -$as_echo_n "checking for dg_sys_info in -ldgc... " >&6; } -if test "${ac_cv_lib_dgc_dg_sys_info+set}" = set; then : +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether getpgrp requires zero arguments" >&5 +$as_echo_n "checking whether getpgrp requires zero arguments... " >&6; } +if test "${ac_cv_func_getpgrp_void+set}" = set; then : $as_echo_n "(cached) " >&6 else - ac_check_lib_save_LIBS=$LIBS -LIBS="-ldgc $LIBS" + # Use it with a single arg. cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ - -/* Override any GCC internal prototype to avoid an error. - Use char because int might match the return type of a GCC - builtin and then its argument prototype would still apply. */ -#ifdef __cplusplus -extern "C" -#endif -char dg_sys_info (); +$ac_includes_default int main () { -return dg_sys_info (); +getpgrp (0); ; return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_lib_dgc_dg_sys_info=yes +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_func_getpgrp_void=no else - ac_cv_lib_dgc_dg_sys_info=no -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext -LIBS=$ac_check_lib_save_LIBS -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dgc_dg_sys_info" >&5 -$as_echo "$ac_cv_lib_dgc_dg_sys_info" >&6; } -if test "x$ac_cv_lib_dgc_dg_sys_info" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_LIBDGC 1 -_ACEOF - - LIBS="-ldgc $LIBS" - -fi - + ac_cv_func_getpgrp_void=yes fi - - - -ac_fn_c_check_header_mongrel "$LINENO" "locale.h" "ac_cv_header_locale_h" "$ac_includes_default" -if test "x$ac_cv_header_locale_h" = x""yes; then : +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_getpgrp_void" >&5 +$as_echo "$ac_cv_func_getpgrp_void" >&6; } +if test $ac_cv_func_getpgrp_void = yes; then - -for ac_func in setlocale -do : - ac_fn_c_check_func "$LINENO" "setlocale" "ac_cv_func_setlocale" -if test "x$ac_cv_func_setlocale" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_SETLOCALE 1 -_ACEOF +$as_echo "#define GETPGRP_VOID 1" >>confdefs.h fi -done -# We cannot check for <dwarf.h>, because Solaris 2 does not use dwarf (it -# uses stabs), but it is still SVR4. We cannot check for <elf.h> because -# Irix 4.0.5F has the header but not the library. -if test $ac_have_func = no && test "$ac_cv_lib_elf_elf_begin" = yes; then - ac_have_func=yes +# Configure gnulib. -$as_echo "#define SVR4 1" >>confdefs.h -fi -if test $ac_have_func = no; then - ac_fn_c_check_header_mongrel "$LINENO" "inq_stats/cpustats.h" "ac_cv_header_inq_stats_cpustats_h" "$ac_includes_default" -if test "x$ac_cv_header_inq_stats_cpustats_h" = x""yes; then : - ac_have_func=yes -$as_echo "#define UMAX 1" >>confdefs.h -$as_echo "#define UMAX4_3 1" >>confdefs.h - -fi -fi -if test $ac_have_func = no; then - ac_fn_c_check_header_mongrel "$LINENO" "sys/cpustats.h" "ac_cv_header_sys_cpustats_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_cpustats_h" = x""yes; then : - ac_have_func=yes; $as_echo "#define UMAX 1" >>confdefs.h -fi + LIBC_FATAL_STDERR_=1 + export LIBC_FATAL_STDERR_ -fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5 +$as_echo_n "checking whether byte ordering is bigendian... " >&6; } +if test "${ac_cv_c_bigendian+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_c_bigendian=unknown + # See if we're dealing with a universal compiler. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifndef __APPLE_CC__ + not a universal capable compiler + #endif + typedef int dummy; -if test $ac_have_func = no; then - for ac_header in mach/mach.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "mach/mach.h" "ac_cv_header_mach_mach_h" "$ac_includes_default" -if test "x$ac_cv_header_mach_mach_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_MACH_MACH_H 1 _ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + # Check for potential -arch flags. It is not universal unless + # there are at least two -arch flags with different values. + ac_arch= + ac_prev= + for ac_word in $CC $CFLAGS $CPPFLAGS $LDFLAGS; do + if test -n "$ac_prev"; then + case $ac_word in + i?86 | x86_64 | ppc | ppc64) + if test -z "$ac_arch" || test "$ac_arch" = "$ac_word"; then + ac_arch=$ac_word + else + ac_cv_c_bigendian=universal + break + fi + ;; + esac + ac_prev= + elif test "x$ac_word" = "x-arch"; then + ac_prev=arch + fi + done fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + if test $ac_cv_c_bigendian = unknown; then + # See if sys/param.h defines the BYTE_ORDER macro. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/types.h> + #include <sys/param.h> -done - -fi - -for ac_header in nlist.h -do : - ac_fn_c_check_header_mongrel "$LINENO" "nlist.h" "ac_cv_header_nlist_h" "$ac_includes_default" -if test "x$ac_cv_header_nlist_h" = x""yes; then : - cat >>confdefs.h <<_ACEOF -#define HAVE_NLIST_H 1 -_ACEOF - ac_fn_c_check_member "$LINENO" "struct nlist" "n_un.n_name" "ac_cv_member_struct_nlist_n_un_n_name" "#include <nlist.h> -" -if test "x$ac_cv_member_struct_nlist_n_un_n_name" = x""yes; then : +int +main () +{ +#if ! (defined BYTE_ORDER && defined BIG_ENDIAN \ + && defined LITTLE_ENDIAN && BYTE_ORDER && BIG_ENDIAN \ + && LITTLE_ENDIAN) + bogus endian macros + #endif -cat >>confdefs.h <<_ACEOF -#define HAVE_STRUCT_NLIST_N_UN_N_NAME 1 + ; + return 0; +} _ACEOF - - -$as_echo "#define NLIST_NAME_UNION 1" >>confdefs.h - -fi - - -fi - -done - -fi -done - - -# Some definitions of getloadavg require that the program be installed setgid. -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether getloadavg requires setgid" >&5 -$as_echo_n "checking whether getloadavg requires setgid... " >&6; } -if test "${ac_cv_func_getloadavg_setgid+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +if ac_fn_c_try_compile "$LINENO"; then : + # It does; now see whether it defined to BIG_ENDIAN or not. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -#include "$srcdir/$ac_config_libobj_dir/getloadavg.c" -#ifdef LDAV_PRIVILEGED -Yowza Am I SETGID yet -#endif -_ACEOF -if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | - $EGREP "Yowza Am I SETGID yet" >/dev/null 2>&1; then : - ac_cv_func_getloadavg_setgid=yes -else - ac_cv_func_getloadavg_setgid=no -fi -rm -f conftest* - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_getloadavg_setgid" >&5 -$as_echo "$ac_cv_func_getloadavg_setgid" >&6; } -if test $ac_cv_func_getloadavg_setgid = yes; then - NEED_SETGID=true - -$as_echo "#define GETLOADAVG_PRIVILEGED 1" >>confdefs.h +#include <sys/types.h> + #include <sys/param.h> -else - NEED_SETGID=false -fi +int +main () +{ +#if BYTE_ORDER != BIG_ENDIAN + not big endian + #endif -if test $ac_cv_func_getloadavg_setgid = yes; then - { $as_echo "$as_me:${as_lineno-$LINENO}: checking group of /dev/kmem" >&5 -$as_echo_n "checking group of /dev/kmem... " >&6; } -if test "${ac_cv_group_kmem+set}" = set; then : - $as_echo_n "(cached) " >&6 + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_c_bigendian=yes else - # On Solaris, /dev/kmem is a symlink. Get info on the real file. - ac_ls_output=`ls -lgL /dev/kmem 2>/dev/null` - # If we got an error (system does not support symlinks), try without -L. - test -z "$ac_ls_output" && ac_ls_output=`ls -lg /dev/kmem` - ac_cv_group_kmem=`$as_echo "$ac_ls_output" \ - | sed -ne 's/[ ][ ]*/ /g; - s/^.[sSrwx-]* *[0-9]* *\([^0-9]*\) *.*/\1/; - / /s/.* //;p;'` - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_group_kmem" >&5 -$as_echo "$ac_cv_group_kmem" >&6; } - KMEM_GROUP=$ac_cv_group_kmem + ac_cv_c_bigendian=no fi -if test "x$ac_save_LIBS" = x; then - GETLOADAVG_LIBS=$LIBS -else - GETLOADAVG_LIBS=`$as_echo "$LIBS" | sed "s|$ac_save_LIBS||"` +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -LIBS=$ac_save_LIBS - - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for _LARGEFILE_SOURCE value needed for large files" >&5 -$as_echo_n "checking for _LARGEFILE_SOURCE value needed for large files... " >&6; } -if test "${ac_cv_sys_largefile_source+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - while :; do - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + if test $ac_cv_c_bigendian = unknown; then + # See if <limits.h> defines _LITTLE_ENDIAN or _BIG_ENDIAN (e.g., Solaris). + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -#include <sys/types.h> /* for off_t */ - #include <stdio.h> +#include <limits.h> + int main () { -int (*fp) (FILE *, off_t, int) = fseeko; - return fseeko (stdin, 0, 0) && fp (stdin, 0, 0); +#if ! (defined _LITTLE_ENDIAN || defined _BIG_ENDIAN) + bogus endian macros + #endif + ; return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_sys_largefile_source=no; break -fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - cat confdefs.h - <<_ACEOF >conftest.$ac_ext +if ac_fn_c_try_compile "$LINENO"; then : + # It does; now see whether it defined to _BIG_ENDIAN or not. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ -#define _LARGEFILE_SOURCE 1 -#include <sys/types.h> /* for off_t */ - #include <stdio.h> +#include <limits.h> + int main () { -int (*fp) (FILE *, off_t, int) = fseeko; - return fseeko (stdin, 0, 0) && fp (stdin, 0, 0); +#ifndef _BIG_ENDIAN + not big endian + #endif + ; return 0; } _ACEOF -if ac_fn_c_try_link "$LINENO"; then : - ac_cv_sys_largefile_source=1; break +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_c_bigendian=yes +else + ac_cv_c_bigendian=no fi -rm -f core conftest.err conftest.$ac_objext \ - conftest$ac_exeext conftest.$ac_ext - ac_cv_sys_largefile_source=unknown - break -done +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sys_largefile_source" >&5 -$as_echo "$ac_cv_sys_largefile_source" >&6; } -case $ac_cv_sys_largefile_source in #( - no | unknown) ;; - *) -cat >>confdefs.h <<_ACEOF -#define _LARGEFILE_SOURCE $ac_cv_sys_largefile_source -_ACEOF -;; -esac -rm -rf conftest* - -# We used to try defining _XOPEN_SOURCE=500 too, to work around a bug -# in glibc 2.1.3, but that breaks too many other things. -# If you want fseeko and ftello with glibc, upgrade to a fixed glibc. -if test $ac_cv_sys_largefile_source != unknown; then - -$as_echo "#define HAVE_FSEEKO 1" >>confdefs.h +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + fi + if test $ac_cv_c_bigendian = unknown; then + # Compile a test program. + if test "$cross_compiling" = yes; then : + # Try to guess by grepping values from an object file. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +short int ascii_mm[] = + { 0x4249, 0x4765, 0x6E44, 0x6961, 0x6E53, 0x7953, 0 }; + short int ascii_ii[] = + { 0x694C, 0x5454, 0x656C, 0x6E45, 0x6944, 0x6E61, 0 }; + int use_ascii (int i) { + return ascii_mm[i] + ascii_ii[i]; + } + short int ebcdic_ii[] = + { 0x89D3, 0xE3E3, 0x8593, 0x95C5, 0x89C4, 0x9581, 0 }; + short int ebcdic_mm[] = + { 0xC2C9, 0xC785, 0x95C4, 0x8981, 0x95E2, 0xA8E2, 0 }; + int use_ebcdic (int i) { + return ebcdic_mm[i] + ebcdic_ii[i]; + } + extern int foo; +int +main () +{ +return use_ascii (foo) == use_ebcdic (foo); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + if grep BIGenDianSyS conftest.$ac_objext >/dev/null; then + ac_cv_c_bigendian=yes + fi + if grep LiTTleEnDian conftest.$ac_objext >/dev/null ; then + if test "$ac_cv_c_bigendian" = unknown; then + ac_cv_c_bigendian=no + else + # finding both strings is unlikely to happen, but who knows? + ac_cv_c_bigendian=unknown + fi + fi fi - - -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether getpgrp requires zero arguments" >&5 -$as_echo_n "checking whether getpgrp requires zero arguments... " >&6; } -if test "${ac_cv_func_getpgrp_void+set}" = set; then : - $as_echo_n "(cached) " >&6 +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext else - # Use it with a single arg. -cat confdefs.h - <<_ACEOF >conftest.$ac_ext + cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ $ac_includes_default int main () { -getpgrp (0); + + /* Are we little or big endian? From Harbison&Steele. */ + union + { + long int l; + char c[sizeof (long int)]; + } u; + u.l = 1; + return u.c[sizeof (long int) - 1] == 1; + ; return 0; } _ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_func_getpgrp_void=no +if ac_fn_c_try_run "$LINENO"; then : + ac_cv_c_bigendian=no else - ac_cv_func_getpgrp_void=yes + ac_cv_c_bigendian=yes fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_getpgrp_void" >&5 -$as_echo "$ac_cv_func_getpgrp_void" >&6; } -if test $ac_cv_func_getpgrp_void = yes; then - -$as_echo "#define GETPGRP_VOID 1" >>confdefs.h + fi fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_bigendian" >&5 +$as_echo "$ac_cv_c_bigendian" >&6; } + case $ac_cv_c_bigendian in #( + yes) + $as_echo "#define WORDS_BIGENDIAN 1" >>confdefs.h +;; #( + no) + ;; #( + universal) +$as_echo "#define AC_APPLE_UNIVERSAL_BUILD 1" >>confdefs.h -# Configure gnulib. - - - - - + ;; #( + *) + as_fn_error $? "unknown endianness + presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;; + esac +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for inline" >&5 +$as_echo_n "checking for inline... " >&6; } +if test "${ac_cv_c_inline+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_c_inline=no +for ac_kw in inline __inline__ __inline; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifndef __cplusplus +typedef int foo_t; +static $ac_kw foo_t static_foo () {return 0; } +$ac_kw foo_t foo () {return 0; } +#endif +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_c_inline=$ac_kw +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + test "$ac_cv_c_inline" != no && break +done +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_inline" >&5 +$as_echo "$ac_cv_c_inline" >&6; } - LIBC_FATAL_STDERR_=1 - export LIBC_FATAL_STDERR_ +case $ac_cv_c_inline in + inline | yes) ;; + *) + case $ac_cv_c_inline in + no) ac_val=;; + *) ac_val=$ac_cv_c_inline;; + esac + cat >>confdefs.h <<_ACEOF +#ifndef __cplusplus +#define inline $ac_val +#endif +_ACEOF + ;; +esac { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether strtold conforms to C99" >&5 @@ -13655,6 +13702,115 @@ $as_echo "#define HAVE_C99_STRTOLD 1" >>confdefs.h fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for st_dm_mode in struct stat" >&5 +$as_echo_n "checking for st_dm_mode in struct stat... " >&6; } +if test "${ac_cv_struct_st_dm_mode+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +#include <sys/types.h> +#include <sys/stat.h> +int +main () +{ +struct stat s; s.st_dm_mode; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_struct_st_dm_mode=yes +else + ac_cv_struct_st_dm_mode=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_struct_st_dm_mode" >&5 +$as_echo "$ac_cv_struct_st_dm_mode" >&6; } + + if test $ac_cv_struct_st_dm_mode = yes; then + +$as_echo "#define HAVE_ST_DM_MODE 1" >>confdefs.h + + fi + + +ac_fn_c_check_decl "$LINENO" "strmode" "ac_cv_have_decl_strmode" "$ac_includes_default" +if test "x$ac_cv_have_decl_strmode" = x""yes; then : + ac_have_decl=1 +else + ac_have_decl=0 +fi + +cat >>confdefs.h <<_ACEOF +#define HAVE_DECL_STRMODE $ac_have_decl +_ACEOF + + + GNULIB__EXIT=0; + GNULIB_ATOLL=0; + GNULIB_CALLOC_POSIX=0; + GNULIB_CANONICALIZE_FILE_NAME=0; + GNULIB_GETLOADAVG=0; + GNULIB_GETSUBOPT=0; + GNULIB_GRANTPT=0; + GNULIB_MALLOC_POSIX=0; + GNULIB_MKDTEMP=0; + GNULIB_MKOSTEMP=0; + GNULIB_MKOSTEMPS=0; + GNULIB_MKSTEMP=0; + GNULIB_MKSTEMPS=0; + GNULIB_PTSNAME=0; + GNULIB_PUTENV=0; + GNULIB_RANDOM_R=0; + GNULIB_REALLOC_POSIX=0; + GNULIB_REALPATH=0; + GNULIB_RPMATCH=0; + GNULIB_SETENV=0; + GNULIB_STRTOD=0; + GNULIB_STRTOLL=0; + GNULIB_STRTOULL=0; + GNULIB_SYSTEM_POSIX=0; + GNULIB_UNLOCKPT=0; + GNULIB_UNSETENV=0; + HAVE__EXIT=1; + HAVE_ATOLL=1; + HAVE_CANONICALIZE_FILE_NAME=1; + HAVE_DECL_GETLOADAVG=1; + HAVE_GETSUBOPT=1; + HAVE_GRANTPT=1; + HAVE_MKDTEMP=1; + HAVE_MKOSTEMP=1; + HAVE_MKOSTEMPS=1; + HAVE_MKSTEMP=1; + HAVE_MKSTEMPS=1; + HAVE_PTSNAME=1; + HAVE_RANDOM_H=1; + HAVE_RANDOM_R=1; + HAVE_REALPATH=1; + HAVE_RPMATCH=1; + HAVE_SETENV=1; + HAVE_DECL_SETENV=1; + HAVE_STRTOD=1; + HAVE_STRTOLL=1; + HAVE_STRTOULL=1; + HAVE_STRUCT_RANDOM_DATA=1; + HAVE_SYS_LOADAVG_H=0; + HAVE_UNLOCKPT=1; + HAVE_DECL_UNSETENV=1; + REPLACE_CALLOC=0; + REPLACE_CANONICALIZE_FILE_NAME=0; + REPLACE_MALLOC=0; + REPLACE_MKSTEMP=0; + REPLACE_PUTENV=0; + REPLACE_REALLOC=0; + REPLACE_REALPATH=0; + REPLACE_SETENV=0; + REPLACE_STRTOD=0; + REPLACE_UNSETENV=0; + GNULIB_CHOWN=0; GNULIB_CLOSE=0; @@ -14312,48 +14468,6 @@ $as_echo "#define __GETOPT_PREFIX rpl_" >>confdefs.h fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for inline" >&5 -$as_echo_n "checking for inline... " >&6; } -if test "${ac_cv_c_inline+set}" = set; then : - $as_echo_n "(cached) " >&6 -else - ac_cv_c_inline=no -for ac_kw in inline __inline__ __inline; do - cat confdefs.h - <<_ACEOF >conftest.$ac_ext -/* end confdefs.h. */ -#ifndef __cplusplus -typedef int foo_t; -static $ac_kw foo_t static_foo () {return 0; } -$ac_kw foo_t foo () {return 0; } -#endif - -_ACEOF -if ac_fn_c_try_compile "$LINENO"; then : - ac_cv_c_inline=$ac_kw -fi -rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext - test "$ac_cv_c_inline" != no && break -done - -fi -{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_inline" >&5 -$as_echo "$ac_cv_c_inline" >&6; } - -case $ac_cv_c_inline in - inline | yes) ;; - *) - case $ac_cv_c_inline in - no) ac_val=;; - *) ac_val=$ac_cv_c_inline;; - esac - cat >>confdefs.h <<_ACEOF -#ifndef __cplusplus -#define inline $ac_val -#endif -_ACEOF - ;; -esac - GNULIB_MKTIME=0; GNULIB_NANOSLEEP=0; @@ -14554,6 +14668,127 @@ $as_echo "#define HAVE_WCHAR_T 1" >>confdefs.h fi + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for unsigned long long int" >&5 +$as_echo_n "checking for unsigned long long int... " >&6; } +if test "${ac_cv_type_unsigned_long_long_int+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_type_unsigned_long_long_int=yes + if test "x${ac_cv_prog_cc_c99-no}" = xno; then + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + /* For now, do not test the preprocessor; as of 2007 there are too many + implementations with broken preprocessors. Perhaps this can + be revisited in 2012. In the meantime, code should not expect + #if to work with literals wider than 32 bits. */ + /* Test literals. */ + long long int ll = 9223372036854775807ll; + long long int nll = -9223372036854775807LL; + unsigned long long int ull = 18446744073709551615ULL; + /* Test constant expressions. */ + typedef int a[((-9223372036854775807LL < 0 && 0 < 9223372036854775807ll) + ? 1 : -1)]; + typedef int b[(18446744073709551615ULL <= (unsigned long long int) -1 + ? 1 : -1)]; + int i = 63; +int +main () +{ +/* Test availability of runtime routines for shift and division. */ + long long int llmax = 9223372036854775807ll; + unsigned long long int ullmax = 18446744073709551615ull; + return ((ll << 63) | (ll >> 63) | (ll < i) | (ll > i) + | (llmax / ll) | (llmax % ll) + | (ull << 63) | (ull >> 63) | (ull << i) | (ull >> i) + | (ullmax / ull) | (ullmax % ull)); + ; + return 0; +} + +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + +else + ac_cv_type_unsigned_long_long_int=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_unsigned_long_long_int" >&5 +$as_echo "$ac_cv_type_unsigned_long_long_int" >&6; } + if test $ac_cv_type_unsigned_long_long_int = yes; then + +$as_echo "#define HAVE_UNSIGNED_LONG_LONG_INT 1" >>confdefs.h + + fi + + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for long long int" >&5 +$as_echo_n "checking for long long int... " >&6; } +if test "${ac_cv_type_long_long_int+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_type_long_long_int=yes + if test "x${ac_cv_prog_cc_c99-no}" = xno; then + ac_cv_type_long_long_int=$ac_cv_type_unsigned_long_long_int + if test $ac_cv_type_long_long_int = yes; then + if test "$cross_compiling" = yes; then : + : +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <limits.h> + #ifndef LLONG_MAX + # define HALF \ + (1LL << (sizeof (long long int) * CHAR_BIT - 2)) + # define LLONG_MAX (HALF - 1 + HALF) + #endif +int +main () +{ +long long int n = 1; + int i; + for (i = 0; ; i++) + { + long long int m = n << i; + if (m >> i != n) + return 1; + if (LLONG_MAX / 2 < m) + break; + } + return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + +else + ac_cv_type_long_long_int=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + fi + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_type_long_long_int" >&5 +$as_echo "$ac_cv_type_long_long_int" >&6; } + if test $ac_cv_type_long_long_int = yes; then + +$as_echo "#define HAVE_LONG_LONG_INT 1" >>confdefs.h + + fi + + + + + + ac_fn_c_check_member "$LINENO" "struct tm" "tm_gmtoff" "ac_cv_member_struct_tm_tm_gmtoff" "#include <time.h> " if test "x$ac_cv_member_struct_tm_tm_gmtoff" = x""yes; then : @@ -14565,6 +14800,84 @@ fi + + GNULIB_FCHMODAT=0; + GNULIB_FSTATAT=0; + GNULIB_FUTIMENS=0; + GNULIB_LCHMOD=0; + GNULIB_LSTAT=0; + GNULIB_MKDIRAT=0; + GNULIB_MKFIFO=0; + GNULIB_MKFIFOAT=0; + GNULIB_MKNOD=0; + GNULIB_MKNODAT=0; + GNULIB_STAT=0; + GNULIB_UTIMENSAT=0; + HAVE_FCHMODAT=1; + HAVE_FSTATAT=1; + HAVE_FUTIMENS=1; + HAVE_LCHMOD=1; + HAVE_LSTAT=1; + HAVE_MKDIRAT=1; + HAVE_MKFIFO=1; + HAVE_MKFIFOAT=1; + HAVE_MKNOD=1; + HAVE_MKNODAT=1; + HAVE_UTIMENSAT=1; + REPLACE_FSTAT=0; + REPLACE_FSTATAT=0; + REPLACE_FUTIMENS=0; + REPLACE_LSTAT=0; + REPLACE_MKDIR=0; + REPLACE_MKFIFO=0; + REPLACE_MKNOD=0; + REPLACE_STAT=0; + REPLACE_UTIMENSAT=0; + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stat file-mode macros are broken" >&5 +$as_echo_n "checking whether stat file-mode macros are broken... " >&6; } +if test "${ac_cv_header_stat_broken+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/types.h> +#include <sys/stat.h> + +#if defined S_ISBLK && defined S_IFDIR +extern char c1[S_ISBLK (S_IFDIR) ? -1 : 1]; +#endif + +#if defined S_ISBLK && defined S_IFCHR +extern char c2[S_ISBLK (S_IFCHR) ? -1 : 1]; +#endif + +#if defined S_ISLNK && defined S_IFREG +extern char c3[S_ISLNK (S_IFREG) ? -1 : 1]; +#endif + +#if defined S_ISSOCK && defined S_IFREG +extern char c4[S_ISSOCK (S_IFREG) ? -1 : 1]; +#endif + +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_header_stat_broken=no +else + ac_cv_header_stat_broken=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stat_broken" >&5 +$as_echo "$ac_cv_header_stat_broken" >&6; } +if test $ac_cv_header_stat_broken = yes; then + +$as_echo "#define STAT_MACROS_BROKEN 1" >>confdefs.h + +fi + + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for C/C++ restrict keyword" >&5 $as_echo_n "checking for C/C++ restrict keyword... " >&6; } if test "${ac_cv_c_restrict+set}" = set; then : @@ -14808,9 +15121,571 @@ fi gl_source_base='lib' # Code from module arg-nonnull: # Code from module c++defs: + # Code from module crypto/md5: + + + + + + + + + + gl_LIBOBJS="$gl_LIBOBJS md5.$ac_objext" + + + + + : + # Code from module dtoastr: # Code from module extensions: + # Code from module filemode: + + + + + + + + + + + gl_LIBOBJS="$gl_LIBOBJS filemode.$ac_objext" + + + + # Code from module getloadavg: + + +# Persuade glibc <stdlib.h> to declare getloadavg(). + + +# Make sure getloadavg.c is where it belongs, at configure-time. +test -f "$srcdir/$gl_source_base/getloadavg.c" || + as_fn_error $? "$srcdir/$gl_source_base/getloadavg.c is missing" "$LINENO" 5 + +gl_save_LIBS=$LIBS + +# getloadvg is present in libc on glibc >= 2.2, MacOS X, FreeBSD >= 2.0, +# NetBSD >= 0.9, OpenBSD >= 2.0, Solaris >= 7. +ac_fn_c_check_func "$LINENO" "getloadavg" "ac_cv_func_getloadavg" +if test "x$ac_cv_func_getloadavg" = x""yes; then : + +else + gl_have_func=no + + # Some systems with -lutil have (and need) -lkvm as well, some do not. + # On Solaris, -lkvm requires nlist from -lelf, so check that first + # to get the right answer into the cache. + # For kstat on solaris, we need to test for libelf and libkvm to force the + # definition of SVR4 below. + if test $gl_have_func = no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for elf_begin in -lelf" >&5 +$as_echo_n "checking for elf_begin in -lelf... " >&6; } +if test "${ac_cv_lib_elf_elf_begin+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lelf $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char elf_begin (); +int +main () +{ +return elf_begin (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_elf_elf_begin=yes +else + ac_cv_lib_elf_elf_begin=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_elf_elf_begin" >&5 +$as_echo "$ac_cv_lib_elf_elf_begin" >&6; } +if test "x$ac_cv_lib_elf_elf_begin" = x""yes; then : + LIBS="-lelf $LIBS" +fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for kvm_open in -lkvm" >&5 +$as_echo_n "checking for kvm_open in -lkvm... " >&6; } +if test "${ac_cv_lib_kvm_kvm_open+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lkvm $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char kvm_open (); +int +main () +{ +return kvm_open (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_kvm_kvm_open=yes +else + ac_cv_lib_kvm_kvm_open=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_kvm_kvm_open" >&5 +$as_echo "$ac_cv_lib_kvm_kvm_open" >&6; } +if test "x$ac_cv_lib_kvm_kvm_open" = x""yes; then : + LIBS="-lkvm $LIBS" +fi + + # Check for the 4.4BSD definition of getloadavg. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getloadavg in -lutil" >&5 +$as_echo_n "checking for getloadavg in -lutil... " >&6; } +if test "${ac_cv_lib_util_getloadavg+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lutil $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char getloadavg (); +int +main () +{ +return getloadavg (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_util_getloadavg=yes +else + ac_cv_lib_util_getloadavg=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_util_getloadavg" >&5 +$as_echo "$ac_cv_lib_util_getloadavg" >&6; } +if test "x$ac_cv_lib_util_getloadavg" = x""yes; then : + LIBS="-lutil $LIBS" gl_have_func=yes +fi + + fi + + if test $gl_have_func = no; then + # There is a commonly available library for RS/6000 AIX. + # Since it is not a standard part of AIX, it might be installed locally. + gl_getloadavg_LIBS=$LIBS + LIBS="-L/usr/local/lib $LIBS" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getloadavg in -lgetloadavg" >&5 +$as_echo_n "checking for getloadavg in -lgetloadavg... " >&6; } +if test "${ac_cv_lib_getloadavg_getloadavg+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lgetloadavg $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char getloadavg (); +int +main () +{ +return getloadavg (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_getloadavg_getloadavg=yes +else + ac_cv_lib_getloadavg_getloadavg=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_getloadavg_getloadavg" >&5 +$as_echo "$ac_cv_lib_getloadavg_getloadavg" >&6; } +if test "x$ac_cv_lib_getloadavg_getloadavg" = x""yes; then : + LIBS="-lgetloadavg $LIBS" gl_have_func=yes +else + LIBS=$gl_getloadavg_LIBS +fi + + fi + + # Set up the replacement function if necessary. + if test $gl_have_func = no; then + + + + + + + + + gl_LIBOBJS="$gl_LIBOBJS getloadavg.$ac_objext" + + +# Figure out what our getloadavg.c needs. + +# Solaris has libkstat which does not require root. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for kstat_open in -lkstat" >&5 +$as_echo_n "checking for kstat_open in -lkstat... " >&6; } +if test "${ac_cv_lib_kstat_kstat_open+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lkstat $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char kstat_open (); +int +main () +{ +return kstat_open (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_kstat_kstat_open=yes +else + ac_cv_lib_kstat_kstat_open=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_kstat_kstat_open" >&5 +$as_echo "$ac_cv_lib_kstat_kstat_open" >&6; } +if test "x$ac_cv_lib_kstat_kstat_open" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBKSTAT 1 +_ACEOF + + LIBS="-lkstat $LIBS" + +fi + +test $ac_cv_lib_kstat_kstat_open = yes && gl_have_func=yes + +# On HPUX9, an unprivileged user can get load averages this way. +if test $gl_have_func = no; then + for ac_func in pstat_getdynamic +do : + ac_fn_c_check_func "$LINENO" "pstat_getdynamic" "ac_cv_func_pstat_getdynamic" +if test "x$ac_cv_func_pstat_getdynamic" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_PSTAT_GETDYNAMIC 1 +_ACEOF + gl_have_func=yes +fi +done + +fi + +# AIX has libperfstat which does not require root +if test $gl_have_func = no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for perfstat_cpu_total in -lperfstat" >&5 +$as_echo_n "checking for perfstat_cpu_total in -lperfstat... " >&6; } +if test "${ac_cv_lib_perfstat_perfstat_cpu_total+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lperfstat $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char perfstat_cpu_total (); +int +main () +{ +return perfstat_cpu_total (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_perfstat_perfstat_cpu_total=yes +else + ac_cv_lib_perfstat_perfstat_cpu_total=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_perfstat_perfstat_cpu_total" >&5 +$as_echo "$ac_cv_lib_perfstat_perfstat_cpu_total" >&6; } +if test "x$ac_cv_lib_perfstat_perfstat_cpu_total" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBPERFSTAT 1 +_ACEOF + + LIBS="-lperfstat $LIBS" + +fi + + test $ac_cv_lib_perfstat_perfstat_cpu_total = yes && gl_have_func=yes +fi + +if test $gl_have_func = no; then + ac_fn_c_check_header_mongrel "$LINENO" "sys/dg_sys_info.h" "ac_cv_header_sys_dg_sys_info_h" "$ac_includes_default" +if test "x$ac_cv_header_sys_dg_sys_info_h" = x""yes; then : + gl_have_func=yes + +$as_echo "#define DGUX 1" >>confdefs.h + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dg_sys_info in -ldgc" >&5 +$as_echo_n "checking for dg_sys_info in -ldgc... " >&6; } +if test "${ac_cv_lib_dgc_dg_sys_info+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldgc $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dg_sys_info (); +int +main () +{ +return dg_sys_info (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dgc_dg_sys_info=yes +else + ac_cv_lib_dgc_dg_sys_info=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dgc_dg_sys_info" >&5 +$as_echo "$ac_cv_lib_dgc_dg_sys_info" >&6; } +if test "x$ac_cv_lib_dgc_dg_sys_info" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBDGC 1 +_ACEOF + + LIBS="-ldgc $LIBS" + +fi + +fi + + +fi + +# We cannot check for <dwarf.h>, because Solaris 2 does not use dwarf (it +# uses stabs), but it is still SVR4. We cannot check for <elf.h> because +# Irix 4.0.5F has the header but not the library. +if test $gl_have_func = no && test "$ac_cv_lib_elf_elf_begin" = yes \ + && test "$ac_cv_lib_kvm_kvm_open" = yes; then + gl_have_func=yes + +$as_echo "#define SVR4 1" >>confdefs.h + +fi + +if test $gl_have_func = no; then + ac_fn_c_check_header_mongrel "$LINENO" "inq_stats/cpustats.h" "ac_cv_header_inq_stats_cpustats_h" "$ac_includes_default" +if test "x$ac_cv_header_inq_stats_cpustats_h" = x""yes; then : + gl_have_func=yes + +$as_echo "#define UMAX 1" >>confdefs.h + + +$as_echo "#define UMAX4_3 1" >>confdefs.h + +fi + + +fi + +if test $gl_have_func = no; then + ac_fn_c_check_header_mongrel "$LINENO" "sys/cpustats.h" "ac_cv_header_sys_cpustats_h" "$ac_includes_default" +if test "x$ac_cv_header_sys_cpustats_h" = x""yes; then : + gl_have_func=yes; $as_echo "#define UMAX 1" >>confdefs.h + +fi + + +fi + +if test $gl_have_func = no; then + for ac_header in mach/mach.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "mach/mach.h" "ac_cv_header_mach_mach_h" "$ac_includes_default" +if test "x$ac_cv_header_mach_mach_h" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_MACH_MACH_H 1 +_ACEOF + +fi + +done + +fi + +for ac_header in nlist.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "nlist.h" "ac_cv_header_nlist_h" "$ac_includes_default" +if test "x$ac_cv_header_nlist_h" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_NLIST_H 1 +_ACEOF + ac_fn_c_check_member "$LINENO" "struct nlist" "n_un.n_name" "ac_cv_member_struct_nlist_n_un_n_name" "#include <nlist.h> +" +if test "x$ac_cv_member_struct_nlist_n_un_n_name" = x""yes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_STRUCT_NLIST_N_UN_N_NAME 1 +_ACEOF + + +fi + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <nlist.h> +int +main () +{ +struct nlist x; + #ifdef HAVE_STRUCT_NLIST_N_UN_N_NAME + x.n_un.n_name = ""; + #else + x.n_name = ""; + #endif + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + +$as_echo "#define N_NAME_POINTER 1" >>confdefs.h + +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + +fi + +done + + fi +fi + + +if test "x$gl_save_LIBS" = x; then + GETLOADAVG_LIBS=$LIBS +else + GETLOADAVG_LIBS=`echo "$LIBS" | sed "s!$gl_save_LIBS!!"` +fi +LIBS=$gl_save_LIBS + + +# Test whether the system declares getloadavg. Solaris has the function +# but declares it in <sys/loadavg.h>, not <stdlib.h>. +for ac_header in sys/loadavg.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "sys/loadavg.h" "ac_cv_header_sys_loadavg_h" "$ac_includes_default" +if test "x$ac_cv_header_sys_loadavg_h" = x""yes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_SYS_LOADAVG_H 1 +_ACEOF + +fi + +done + +if test $ac_cv_header_sys_loadavg_h = yes; then + HAVE_SYS_LOADAVG_H=1 +else + HAVE_SYS_LOADAVG_H=0 +fi +ac_fn_c_check_decl "$LINENO" "getloadavg" "ac_cv_have_decl_getloadavg" "#if HAVE_SYS_LOADAVG_H + # include <sys/loadavg.h> + #endif + #include <stdlib.h> +" +if test "x$ac_cv_have_decl_getloadavg" = x""yes; then : + +else + HAVE_DECL_GETLOADAVG=0 +fi + + + + + + GNULIB_GETLOADAVG=1 + + + # Code from module getopt-gnu: @@ -15242,6 +16117,769 @@ $as_echo "$gl_cv_next_stddef_h" >&6; } fi + # Code from module stdint: + + + + if test $ac_cv_type_long_long_int = yes; then + HAVE_LONG_LONG_INT=1 + else + HAVE_LONG_LONG_INT=0 + fi + + + if test $ac_cv_type_unsigned_long_long_int = yes; then + HAVE_UNSIGNED_LONG_LONG_INT=1 + else + HAVE_UNSIGNED_LONG_LONG_INT=0 + fi + + + + if test $ac_cv_header_wchar_h = yes; then + HAVE_WCHAR_H=1 + else + HAVE_WCHAR_H=0 + fi + + + if test $ac_cv_header_inttypes_h = yes; then + HAVE_INTTYPES_H=1 + else + HAVE_INTTYPES_H=0 + fi + + + if test $ac_cv_header_sys_types_h = yes; then + HAVE_SYS_TYPES_H=1 + else + HAVE_SYS_TYPES_H=0 + fi + + + + + + + + + + + + if test $gl_cv_have_include_next = yes; then + gl_cv_next_stdint_h='<'stdint.h'>' + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of <stdint.h>" >&5 +$as_echo_n "checking absolute name of <stdint.h>... " >&6; } +if test "${gl_cv_next_stdint_h+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + + if test $ac_cv_header_stdint_h = yes; then + + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdint.h> + +_ACEOF + case "$host_os" in + aix*) gl_absname_cpp="$ac_cpp -C" ;; + *) gl_absname_cpp="$ac_cpp" ;; + esac + gl_cv_next_stdint_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 | + sed -n '\#/stdint.h#{ + s#.*"\(.*/stdint.h\)".*#\1# + s#^/[^/]#//&# + p + q + }'`'"' + else + gl_cv_next_stdint_h='<'stdint.h'>' + fi + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_stdint_h" >&5 +$as_echo "$gl_cv_next_stdint_h" >&6; } + fi + NEXT_STDINT_H=$gl_cv_next_stdint_h + + if test $gl_cv_have_include_next = yes || test $gl_cv_have_include_next = buggy; then + # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include_next' + gl_next_as_first_directive='<'stdint.h'>' + else + # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include' + gl_next_as_first_directive=$gl_cv_next_stdint_h + fi + NEXT_AS_FIRST_DIRECTIVE_STDINT_H=$gl_next_as_first_directive + + + + + if test $ac_cv_header_stdint_h = yes; then + HAVE_STDINT_H=1 + else + HAVE_STDINT_H=0 + fi + + + if test $ac_cv_header_stdint_h = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stdint.h conforms to C99" >&5 +$as_echo_n "checking whether stdint.h conforms to C99... " >&6; } +if test "${gl_cv_header_working_stdint_h+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + gl_cv_header_working_stdint_h=no + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + +#define __STDC_LIMIT_MACROS 1 /* to make it work also in C++ mode */ +#define __STDC_CONSTANT_MACROS 1 /* to make it work also in C++ mode */ +#define _GL_JUST_INCLUDE_SYSTEM_STDINT_H 1 /* work if build isn't clean */ +#include <stdint.h> +/* Dragonfly defines WCHAR_MIN, WCHAR_MAX only in <wchar.h>. */ +#if !(defined WCHAR_MIN && defined WCHAR_MAX) +#error "WCHAR_MIN, WCHAR_MAX not defined in <stdint.h>" +#endif + + + /* BSD/OS 4.0.1 has a bug: <stddef.h>, <stdio.h> and <time.h> must be + included before <wchar.h>. */ + #include <stddef.h> + #include <signal.h> + #if HAVE_WCHAR_H + # include <stdio.h> + # include <time.h> + # include <wchar.h> + #endif + + +#ifdef INT8_MAX +int8_t a1 = INT8_MAX; +int8_t a1min = INT8_MIN; +#endif +#ifdef INT16_MAX +int16_t a2 = INT16_MAX; +int16_t a2min = INT16_MIN; +#endif +#ifdef INT32_MAX +int32_t a3 = INT32_MAX; +int32_t a3min = INT32_MIN; +#endif +#ifdef INT64_MAX +int64_t a4 = INT64_MAX; +int64_t a4min = INT64_MIN; +#endif +#ifdef UINT8_MAX +uint8_t b1 = UINT8_MAX; +#else +typedef int b1[(unsigned char) -1 != 255 ? 1 : -1]; +#endif +#ifdef UINT16_MAX +uint16_t b2 = UINT16_MAX; +#endif +#ifdef UINT32_MAX +uint32_t b3 = UINT32_MAX; +#endif +#ifdef UINT64_MAX +uint64_t b4 = UINT64_MAX; +#endif +int_least8_t c1 = INT8_C (0x7f); +int_least8_t c1max = INT_LEAST8_MAX; +int_least8_t c1min = INT_LEAST8_MIN; +int_least16_t c2 = INT16_C (0x7fff); +int_least16_t c2max = INT_LEAST16_MAX; +int_least16_t c2min = INT_LEAST16_MIN; +int_least32_t c3 = INT32_C (0x7fffffff); +int_least32_t c3max = INT_LEAST32_MAX; +int_least32_t c3min = INT_LEAST32_MIN; +int_least64_t c4 = INT64_C (0x7fffffffffffffff); +int_least64_t c4max = INT_LEAST64_MAX; +int_least64_t c4min = INT_LEAST64_MIN; +uint_least8_t d1 = UINT8_C (0xff); +uint_least8_t d1max = UINT_LEAST8_MAX; +uint_least16_t d2 = UINT16_C (0xffff); +uint_least16_t d2max = UINT_LEAST16_MAX; +uint_least32_t d3 = UINT32_C (0xffffffff); +uint_least32_t d3max = UINT_LEAST32_MAX; +uint_least64_t d4 = UINT64_C (0xffffffffffffffff); +uint_least64_t d4max = UINT_LEAST64_MAX; +int_fast8_t e1 = INT_FAST8_MAX; +int_fast8_t e1min = INT_FAST8_MIN; +int_fast16_t e2 = INT_FAST16_MAX; +int_fast16_t e2min = INT_FAST16_MIN; +int_fast32_t e3 = INT_FAST32_MAX; +int_fast32_t e3min = INT_FAST32_MIN; +int_fast64_t e4 = INT_FAST64_MAX; +int_fast64_t e4min = INT_FAST64_MIN; +uint_fast8_t f1 = UINT_FAST8_MAX; +uint_fast16_t f2 = UINT_FAST16_MAX; +uint_fast32_t f3 = UINT_FAST32_MAX; +uint_fast64_t f4 = UINT_FAST64_MAX; +#ifdef INTPTR_MAX +intptr_t g = INTPTR_MAX; +intptr_t gmin = INTPTR_MIN; +#endif +#ifdef UINTPTR_MAX +uintptr_t h = UINTPTR_MAX; +#endif +intmax_t i = INTMAX_MAX; +uintmax_t j = UINTMAX_MAX; + +#include <limits.h> /* for CHAR_BIT */ +#define TYPE_MINIMUM(t) \ + ((t) ((t) 0 < (t) -1 ? (t) 0 : ~ TYPE_MAXIMUM (t))) +#define TYPE_MAXIMUM(t) \ + ((t) ((t) 0 < (t) -1 \ + ? (t) -1 \ + : ((((t) 1 << (sizeof (t) * CHAR_BIT - 2)) - 1) * 2 + 1))) +struct s { + int check_PTRDIFF: + PTRDIFF_MIN == TYPE_MINIMUM (ptrdiff_t) + && PTRDIFF_MAX == TYPE_MAXIMUM (ptrdiff_t) + ? 1 : -1; + /* Detect bug in FreeBSD 6.0 / ia64. */ + int check_SIG_ATOMIC: + SIG_ATOMIC_MIN == TYPE_MINIMUM (sig_atomic_t) + && SIG_ATOMIC_MAX == TYPE_MAXIMUM (sig_atomic_t) + ? 1 : -1; + int check_SIZE: SIZE_MAX == TYPE_MAXIMUM (size_t) ? 1 : -1; + int check_WCHAR: + WCHAR_MIN == TYPE_MINIMUM (wchar_t) + && WCHAR_MAX == TYPE_MAXIMUM (wchar_t) + ? 1 : -1; + /* Detect bug in mingw. */ + int check_WINT: + WINT_MIN == TYPE_MINIMUM (wint_t) + && WINT_MAX == TYPE_MAXIMUM (wint_t) + ? 1 : -1; + + /* Detect bugs in glibc 2.4 and Solaris 10 stdint.h, among others. */ + int check_UINT8_C: + (-1 < UINT8_C (0)) == (-1 < (uint_least8_t) 0) ? 1 : -1; + int check_UINT16_C: + (-1 < UINT16_C (0)) == (-1 < (uint_least16_t) 0) ? 1 : -1; + + /* Detect bugs in OpenBSD 3.9 stdint.h. */ +#ifdef UINT8_MAX + int check_uint8: (uint8_t) -1 == UINT8_MAX ? 1 : -1; +#endif +#ifdef UINT16_MAX + int check_uint16: (uint16_t) -1 == UINT16_MAX ? 1 : -1; +#endif +#ifdef UINT32_MAX + int check_uint32: (uint32_t) -1 == UINT32_MAX ? 1 : -1; +#endif +#ifdef UINT64_MAX + int check_uint64: (uint64_t) -1 == UINT64_MAX ? 1 : -1; +#endif + int check_uint_least8: (uint_least8_t) -1 == UINT_LEAST8_MAX ? 1 : -1; + int check_uint_least16: (uint_least16_t) -1 == UINT_LEAST16_MAX ? 1 : -1; + int check_uint_least32: (uint_least32_t) -1 == UINT_LEAST32_MAX ? 1 : -1; + int check_uint_least64: (uint_least64_t) -1 == UINT_LEAST64_MAX ? 1 : -1; + int check_uint_fast8: (uint_fast8_t) -1 == UINT_FAST8_MAX ? 1 : -1; + int check_uint_fast16: (uint_fast16_t) -1 == UINT_FAST16_MAX ? 1 : -1; + int check_uint_fast32: (uint_fast32_t) -1 == UINT_FAST32_MAX ? 1 : -1; + int check_uint_fast64: (uint_fast64_t) -1 == UINT_FAST64_MAX ? 1 : -1; + int check_uintptr: (uintptr_t) -1 == UINTPTR_MAX ? 1 : -1; + int check_uintmax: (uintmax_t) -1 == UINTMAX_MAX ? 1 : -1; + int check_size: (size_t) -1 == SIZE_MAX ? 1 : -1; +}; + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + if test "$cross_compiling" = yes; then : + gl_cv_header_working_stdint_h=yes + +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + +#define __STDC_LIMIT_MACROS 1 /* to make it work also in C++ mode */ +#define __STDC_CONSTANT_MACROS 1 /* to make it work also in C++ mode */ +#define _GL_JUST_INCLUDE_SYSTEM_STDINT_H 1 /* work if build isn't clean */ +#include <stdint.h> + + + /* BSD/OS 4.0.1 has a bug: <stddef.h>, <stdio.h> and <time.h> must be + included before <wchar.h>. */ + #include <stddef.h> + #include <signal.h> + #if HAVE_WCHAR_H + # include <stdio.h> + # include <time.h> + # include <wchar.h> + #endif + + +#include <stdio.h> +#include <string.h> +#define MVAL(macro) MVAL1(macro) +#define MVAL1(expression) #expression +static const char *macro_values[] = + { +#ifdef INT8_MAX + MVAL (INT8_MAX), +#endif +#ifdef INT16_MAX + MVAL (INT16_MAX), +#endif +#ifdef INT32_MAX + MVAL (INT32_MAX), +#endif +#ifdef INT64_MAX + MVAL (INT64_MAX), +#endif +#ifdef UINT8_MAX + MVAL (UINT8_MAX), +#endif +#ifdef UINT16_MAX + MVAL (UINT16_MAX), +#endif +#ifdef UINT32_MAX + MVAL (UINT32_MAX), +#endif +#ifdef UINT64_MAX + MVAL (UINT64_MAX), +#endif + NULL + }; + +int +main () +{ + + const char **mv; + for (mv = macro_values; *mv != NULL; mv++) + { + const char *value = *mv; + /* Test whether it looks like a cast expression. */ + if (strncmp (value, "((unsigned int)"/*)*/, 15) == 0 + || strncmp (value, "((unsigned short)"/*)*/, 17) == 0 + || strncmp (value, "((unsigned char)"/*)*/, 16) == 0 + || strncmp (value, "((int)"/*)*/, 6) == 0 + || strncmp (value, "((signed short)"/*)*/, 15) == 0 + || strncmp (value, "((signed char)"/*)*/, 14) == 0) + return mv - macro_values + 1; + } + return 0; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + gl_cv_header_working_stdint_h=yes +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + + +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_header_working_stdint_h" >&5 +$as_echo "$gl_cv_header_working_stdint_h" >&6; } + fi + if test "$gl_cv_header_working_stdint_h" = yes; then + STDINT_H= + else + for ac_header in sys/inttypes.h sys/bitypes.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + if test $ac_cv_header_sys_inttypes_h = yes; then + HAVE_SYS_INTTYPES_H=1 + else + HAVE_SYS_INTTYPES_H=0 + fi + + if test $ac_cv_header_sys_bitypes_h = yes; then + HAVE_SYS_BITYPES_H=1 + else + HAVE_SYS_BITYPES_H=0 + fi + + + + + if test $APPLE_UNIVERSAL_BUILD = 0; then + + + for gltype in ptrdiff_t size_t ; do + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bit size of $gltype" >&5 +$as_echo_n "checking for bit size of $gltype... " >&6; } +if eval "test \"\${gl_cv_bitsizeof_${gltype}+set}\"" = set; then : + $as_echo_n "(cached) " >&6 +else + if ac_fn_c_compute_int "$LINENO" "sizeof ($gltype) * CHAR_BIT" "result" " + /* BSD/OS 4.0.1 has a bug: <stddef.h>, <stdio.h> and <time.h> must be + included before <wchar.h>. */ + #include <stddef.h> + #include <signal.h> + #if HAVE_WCHAR_H + # include <stdio.h> + # include <time.h> + # include <wchar.h> + #endif + +#include <limits.h>"; then : + +else + result=unknown +fi + + eval gl_cv_bitsizeof_${gltype}=\$result + +fi +eval ac_res=\$gl_cv_bitsizeof_${gltype} + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval result=\$gl_cv_bitsizeof_${gltype} + if test $result = unknown; then + result=0 + fi + GLTYPE=`echo "$gltype" | tr 'abcdefghijklmnopqrstuvwxyz ' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_'` + cat >>confdefs.h <<_ACEOF +#define BITSIZEOF_${GLTYPE} $result +_ACEOF + + eval BITSIZEOF_${GLTYPE}=\$result + done + + + fi + + + for gltype in sig_atomic_t wchar_t wint_t ; do + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bit size of $gltype" >&5 +$as_echo_n "checking for bit size of $gltype... " >&6; } +if eval "test \"\${gl_cv_bitsizeof_${gltype}+set}\"" = set; then : + $as_echo_n "(cached) " >&6 +else + if ac_fn_c_compute_int "$LINENO" "sizeof ($gltype) * CHAR_BIT" "result" " + /* BSD/OS 4.0.1 has a bug: <stddef.h>, <stdio.h> and <time.h> must be + included before <wchar.h>. */ + #include <stddef.h> + #include <signal.h> + #if HAVE_WCHAR_H + # include <stdio.h> + # include <time.h> + # include <wchar.h> + #endif + +#include <limits.h>"; then : + +else + result=unknown +fi + + eval gl_cv_bitsizeof_${gltype}=\$result + +fi +eval ac_res=\$gl_cv_bitsizeof_${gltype} + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval result=\$gl_cv_bitsizeof_${gltype} + if test $result = unknown; then + result=0 + fi + GLTYPE=`echo "$gltype" | tr 'abcdefghijklmnopqrstuvwxyz ' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_'` + cat >>confdefs.h <<_ACEOF +#define BITSIZEOF_${GLTYPE} $result +_ACEOF + + eval BITSIZEOF_${GLTYPE}=\$result + done + + + + + for gltype in sig_atomic_t wchar_t wint_t ; do + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $gltype is signed" >&5 +$as_echo_n "checking whether $gltype is signed... " >&6; } +if eval "test \"\${gl_cv_type_${gltype}_signed+set}\"" = set; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + /* BSD/OS 4.0.1 has a bug: <stddef.h>, <stdio.h> and <time.h> must be + included before <wchar.h>. */ + #include <stddef.h> + #include <signal.h> + #if HAVE_WCHAR_H + # include <stdio.h> + # include <time.h> + # include <wchar.h> + #endif + + int verify[2 * (($gltype) -1 < ($gltype) 0) - 1]; +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + result=yes +else + result=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + eval gl_cv_type_${gltype}_signed=\$result + +fi +eval ac_res=\$gl_cv_type_${gltype}_signed + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval result=\$gl_cv_type_${gltype}_signed + GLTYPE=`echo $gltype | tr 'abcdefghijklmnopqrstuvwxyz ' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_'` + if test "$result" = yes; then + cat >>confdefs.h <<_ACEOF +#define HAVE_SIGNED_${GLTYPE} 1 +_ACEOF + + eval HAVE_SIGNED_${GLTYPE}=1 + else + eval HAVE_SIGNED_${GLTYPE}=0 + fi + done + + + gl_cv_type_ptrdiff_t_signed=yes + gl_cv_type_size_t_signed=no + if test $APPLE_UNIVERSAL_BUILD = 0; then + + + for gltype in ptrdiff_t size_t ; do + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $gltype integer literal suffix" >&5 +$as_echo_n "checking for $gltype integer literal suffix... " >&6; } +if eval "test \"\${gl_cv_type_${gltype}_suffix+set}\"" = set; then : + $as_echo_n "(cached) " >&6 +else + eval gl_cv_type_${gltype}_suffix=no + eval result=\$gl_cv_type_${gltype}_signed + if test "$result" = yes; then + glsufu= + else + glsufu=u + fi + for glsuf in "$glsufu" ${glsufu}l ${glsufu}ll ${glsufu}i64; do + case $glsuf in + '') gltype1='int';; + l) gltype1='long int';; + ll) gltype1='long long int';; + i64) gltype1='__int64';; + u) gltype1='unsigned int';; + ul) gltype1='unsigned long int';; + ull) gltype1='unsigned long long int';; + ui64)gltype1='unsigned __int64';; + esac + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + /* BSD/OS 4.0.1 has a bug: <stddef.h>, <stdio.h> and <time.h> must be + included before <wchar.h>. */ + #include <stddef.h> + #include <signal.h> + #if HAVE_WCHAR_H + # include <stdio.h> + # include <time.h> + # include <wchar.h> + #endif + + extern $gltype foo; + extern $gltype1 foo; +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval gl_cv_type_${gltype}_suffix=\$glsuf +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + eval result=\$gl_cv_type_${gltype}_suffix + test "$result" != no && break + done +fi +eval ac_res=\$gl_cv_type_${gltype}_suffix + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + GLTYPE=`echo $gltype | tr 'abcdefghijklmnopqrstuvwxyz ' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_'` + eval result=\$gl_cv_type_${gltype}_suffix + test "$result" = no && result= + eval ${GLTYPE}_SUFFIX=\$result + cat >>confdefs.h <<_ACEOF +#define ${GLTYPE}_SUFFIX $result +_ACEOF + + done + + + fi + + + for gltype in sig_atomic_t wchar_t wint_t ; do + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $gltype integer literal suffix" >&5 +$as_echo_n "checking for $gltype integer literal suffix... " >&6; } +if eval "test \"\${gl_cv_type_${gltype}_suffix+set}\"" = set; then : + $as_echo_n "(cached) " >&6 +else + eval gl_cv_type_${gltype}_suffix=no + eval result=\$gl_cv_type_${gltype}_signed + if test "$result" = yes; then + glsufu= + else + glsufu=u + fi + for glsuf in "$glsufu" ${glsufu}l ${glsufu}ll ${glsufu}i64; do + case $glsuf in + '') gltype1='int';; + l) gltype1='long int';; + ll) gltype1='long long int';; + i64) gltype1='__int64';; + u) gltype1='unsigned int';; + ul) gltype1='unsigned long int';; + ull) gltype1='unsigned long long int';; + ui64)gltype1='unsigned __int64';; + esac + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + /* BSD/OS 4.0.1 has a bug: <stddef.h>, <stdio.h> and <time.h> must be + included before <wchar.h>. */ + #include <stddef.h> + #include <signal.h> + #if HAVE_WCHAR_H + # include <stdio.h> + # include <time.h> + # include <wchar.h> + #endif + + extern $gltype foo; + extern $gltype1 foo; +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval gl_cv_type_${gltype}_suffix=\$glsuf +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + eval result=\$gl_cv_type_${gltype}_suffix + test "$result" != no && break + done +fi +eval ac_res=\$gl_cv_type_${gltype}_suffix + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + GLTYPE=`echo $gltype | tr 'abcdefghijklmnopqrstuvwxyz ' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_'` + eval result=\$gl_cv_type_${gltype}_suffix + test "$result" = no && result= + eval ${GLTYPE}_SUFFIX=\$result + cat >>confdefs.h <<_ACEOF +#define ${GLTYPE}_SUFFIX $result +_ACEOF + + done + + + + STDINT_H=stdint.h + fi + + + # Code from module stdlib: + + + + + + + + + + + if test $gl_cv_have_include_next = yes; then + gl_cv_next_stdlib_h='<'stdlib.h'>' + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of <stdlib.h>" >&5 +$as_echo_n "checking absolute name of <stdlib.h>... " >&6; } +if test "${gl_cv_next_stdlib_h+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <stdlib.h> + +_ACEOF + case "$host_os" in + aix*) gl_absname_cpp="$ac_cpp -C" ;; + *) gl_absname_cpp="$ac_cpp" ;; + esac + gl_cv_next_stdlib_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 | + sed -n '\#/stdlib.h#{ + s#.*"\(.*/stdlib.h\)".*#\1# + s#^/[^/]#//&# + p + q + }'`'"' + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_stdlib_h" >&5 +$as_echo "$gl_cv_next_stdlib_h" >&6; } + fi + NEXT_STDLIB_H=$gl_cv_next_stdlib_h + + if test $gl_cv_have_include_next = yes || test $gl_cv_have_include_next = buggy; then + # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include_next' + gl_next_as_first_directive='<'stdlib.h'>' + else + # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include' + gl_next_as_first_directive=$gl_cv_next_stdlib_h + fi + NEXT_AS_FIRST_DIRECTIVE_STDLIB_H=$gl_next_as_first_directive + + + + + + + # Code from module strftime: @@ -15268,6 +16906,90 @@ $as_echo "#define my_strftime nstrftime" >>confdefs.h + # Code from module sys_stat: + + + + + + + + + + + + + + + + + if test $gl_cv_have_include_next = yes; then + gl_cv_next_sys_stat_h='<'sys/stat.h'>' + else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of <sys/stat.h>" >&5 +$as_echo_n "checking absolute name of <sys/stat.h>... " >&6; } +if test "${gl_cv_next_sys_stat_h+set}" = set; then : + $as_echo_n "(cached) " >&6 +else + + if test $ac_cv_header_sys_stat_h = yes; then + + + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <sys/stat.h> + +_ACEOF + case "$host_os" in + aix*) gl_absname_cpp="$ac_cpp -C" ;; + *) gl_absname_cpp="$ac_cpp" ;; + esac + gl_cv_next_sys_stat_h='"'`(eval "$gl_absname_cpp conftest.$ac_ext") 2>&5 | + sed -n '\#/sys/stat.h#{ + s#.*"\(.*/sys/stat.h\)".*#\1# + s#^/[^/]#//&# + p + q + }'`'"' + else + gl_cv_next_sys_stat_h='<'sys/stat.h'>' + fi + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $gl_cv_next_sys_stat_h" >&5 +$as_echo "$gl_cv_next_sys_stat_h" >&6; } + fi + NEXT_SYS_STAT_H=$gl_cv_next_sys_stat_h + + if test $gl_cv_have_include_next = yes || test $gl_cv_have_include_next = buggy; then + # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include_next' + gl_next_as_first_directive='<'sys/stat.h'>' + else + # INCLUDE_NEXT_AS_FIRST_DIRECTIVE='include' + gl_next_as_first_directive=$gl_cv_next_sys_stat_h + fi + NEXT_AS_FIRST_DIRECTIVE_SYS_STAT_H=$gl_next_as_first_directive + + + + + + ac_fn_c_check_type "$LINENO" "nlink_t" "ac_cv_type_nlink_t" "#include <sys/types.h> + #include <sys/stat.h> +" +if test "x$ac_cv_type_nlink_t" = x""yes; then : + +else + +$as_echo "#define nlink_t int" >>confdefs.h + +fi + + + + + # Code from module time: @@ -17059,7 +18781,6 @@ S_FILE="\$(srcdir)/${opsysfile}" - cat >>confdefs.h <<_ACEOF #define EMACS_CONFIGURATION "${canonical}" _ACEOF @@ -17610,6 +19331,7 @@ if test -z "${GL_COND_LIBTOOL_TRUE}" && test -z "${GL_COND_LIBTOOL_FALSE}"; then Usually this means the macro was only invoked conditionally." "$LINENO" 5 fi + gl_libobjs= gl_ltlibobjs= if test -n "$gl_LIBOBJS"; then diff --git a/configure.in b/configure.in index a3d643e682b..376c82c4ca4 100644 --- a/configure.in +++ b/configure.in @@ -699,19 +699,6 @@ else test "x$NON_GCC_TEST_OPTIONS" != x && CC="$CC $NON_GCC_TEST_OPTIONS" fi -### Use -Wno-pointer-sign if the compiler supports it -AC_MSG_CHECKING([whether gcc understands -Wno-pointer-sign]) -SAVE_CFLAGS="$CFLAGS" -CFLAGS="$CFLAGS -Wno-pointer-sign" -AC_TRY_COMPILE([], [], has_option=yes, has_option=no,) -if test $has_option = yes; then - C_WARNINGS_SWITCH="-Wno-pointer-sign $C_WARNINGS_SWITCH" -fi -AC_MSG_RESULT($has_option) -CFLAGS="$SAVE_CFLAGS" -unset has_option -unset SAVE_CFLAGS - ### Use -Wdeclaration-after-statement if the compiler supports it AC_MSG_CHECKING([whether gcc understands -Wdeclaration-after-statement]) SAVE_CFLAGS="$CFLAGS" @@ -984,7 +971,7 @@ case "$opsys" in hpux*) LIBS_SYSTEM="-l:libdld.sl" ;; - sol2*) LIBS_SYSTEM="-lsocket -lnsl -lkstat" ;; + sol2*) LIBS_SYSTEM="-lsocket -lnsl" ;; ## Motif needs -lgen. unixware) LIBS_SYSTEM="-lsocket -lnsl -lelf -lgen" ;; @@ -1000,9 +987,6 @@ else CPPFLAGS="$C_SWITCH_SYSTEM $C_SWITCH_MACHINE $CPPFLAGS" fi -dnl For AC_FUNC_GETLOADAVG, at least: -AC_CONFIG_LIBOBJ_DIR(src) - dnl Do this early because it can frob feature test macros for Unix-98 &c. AC_SYS_LARGEFILE @@ -2668,8 +2652,6 @@ fi AC_CHECK_HEADERS(sys/un.h) -AC_FUNC_GETLOADAVG - AC_FUNC_FSEEKO AC_FUNC_GETPGRP @@ -3118,7 +3100,6 @@ fi S_FILE="\$(srcdir)/${opsysfile}" AC_SUBST(M_FILE) AC_SUBST(S_FILE) -AC_SUBST(GETLOADAVG_LIBS) AC_SUBST(ns_appdir) AC_SUBST(ns_appbindir) AC_SUBST(ns_appresdir) diff --git a/doc/emacs/ChangeLog b/doc/emacs/ChangeLog index d04c0322862..f113a7987c1 100644 --- a/doc/emacs/ChangeLog +++ b/doc/emacs/ChangeLog @@ -1,3 +1,12 @@ +2011-02-19 Glenn Morris <rgm@gnu.org> + + * dired.texi (Dired): Dired-X version number was dropped. + +2011-02-14 Jan Djärv <jan.h.d@swipnet.se> + + * xresources.texi (X Resources): Remove *faceName and replace it with + *font for Lucid. + 2011-02-05 Chong Yidong <cyd@stupidchicken.com> * rmail.texi (Rmail Display): Document Rmail MIME support more diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 914c9984c14..2f274d7a324 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -23,7 +23,7 @@ files. You first mark certain files in order to operate on all of them with one command. The Dired-X package provides various extra features for Dired mode. -@xref{Top, Dired-X,,dired-x, Dired Extra Version 2 User's Manual}. +@xref{Top, Dired-X,,dired-x, Dired Extra User's Manual}. You can also view a list of files in a directory with @kbd{C-x C-d} (@code{list-directory}). Unlike Dired, this command does not allow diff --git a/doc/emacs/xresources.texi b/doc/emacs/xresources.texi index 1482bbd0469..41a09a5f713 100644 --- a/doc/emacs/xresources.texi +++ b/doc/emacs/xresources.texi @@ -428,29 +428,20 @@ and has its own resources. The resource specifications start with @end iftex @example -Emacs.pane.menubar.faceName: Courier-12 +Emacs.pane.menubar.font: Courier-12 @end example @noindent -To specify a font, use fontconfig font names as values to the @code{faceName} -resource. - -If Emacs is not built with the Xft library, Lucid menus and dialogs -can only display old style fonts. If Emacs is built with Xft and you -prefer the old fonts, you have to specify @samp{none} to -@code{faceName}: +To specify a font, use fontconfig font names as values to the @code{font} +resource, or old style names: @example -Emacs.pane.menubar.faceName: none -Emacs.pane.dialog.faceName: none +Emacs.pane.menubar.font: lucidasanstypewriter-10 @end example @noindent -To specify a non-Xft font, use @code{font}. For example: - -@example -Emacs.pane.menubar.font: lucidasanstypewriter-10 -@end example +Emacs first tries to open the font as an old style font, and if that fails +as an fontconfig font. In rare cases, Emacs might do the wrong thing. @noindent The Lucid menus can display multilingual text in your locale with old style @@ -480,7 +471,7 @@ Emacs.menu*.font: 8x16 For dialog boxes, use @samp{dialog*}: @example -Emacs.dialog*.faceName: Sans-12 +Emacs.dialog*.font: Sans-12 @end example @noindent @@ -495,8 +486,6 @@ approach should work on both kinds of systems. Here is a list of the specific resources for menu bars and pop-up menus: @table @code -@item faceName -Xft font for menu item text. @item font Font for menu item text. @item fontSet diff --git a/doc/lispintro/ChangeLog b/doc/lispintro/ChangeLog index a6897fc4ec9..d2e6954025a 100644 --- a/doc/lispintro/ChangeLog +++ b/doc/lispintro/ChangeLog @@ -1,3 +1,7 @@ +2011-02-19 Eli Zaretskii <eliz@gnu.org> + + * emacs-lisp-intro.texi: Sync @dircategory with ../../info/dir. + 2011-01-23 Werner Lemberg <wl@gnu.org> * Makefile.in (MAKEINFO): Now controlled by `configure'. diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 7b9ec75446b..11ceea19eef 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -216,7 +216,7 @@ @c ---------------------------------------------------- -@dircategory Emacs +@dircategory GNU Emacs Lisp @direntry * Emacs Lisp Intro: (eintr). A simple introduction to Emacs Lisp programming. diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 0f1f0425478..90eed004d39 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,23 @@ +2011-02-19 Eli Zaretskii <eliz@gnu.org> + + * elisp.texi: Sync @dircategory with ../../info/dir. + + * files.texi (Visiting Functions): Document find-file-literally, + both the command and the variable. + + * variables.texi (Creating Buffer-Local): Explain the meaning of + permanent local variables. + + * files.texi (Visiting Functions): Document find-file-literally, + both the command and the variable. + + * variables.texi (Creating Buffer-Local): Explain the meaning of + permanent local variables. + +2011-02-19 Glenn Morris <rgm@gnu.org> + + * keymaps.texi (Remapping Commands): Mention how to undo it. + 2011-02-09 Reuben Thomas <rrt@sc3d.org> * loading.texi (Hooks for Loading): Remove unnecessary advice diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 4e6447845fa..8e3498b8b6f 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -62,7 +62,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory GNU Emacs Lisp @direntry * Elisp: (elisp). The Emacs Lisp Reference Manual. @end direntry diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index 46ebced7a32..3697f18badd 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -113,6 +113,26 @@ When @code{find-file} is called interactively, it prompts for @var{filename} in the minibuffer. @end deffn +@deffn Command find-file-literally filename +This command visits @var{filename}, like @code{find-file} does, but it +does not perform any format conversions (@pxref{Format Conversion}), +character code conversions (@pxref{Coding Systems}), or end-of-line +conversions (@pxref{Coding System Basics, End of line conversion}). +The buffer visiting the file is made unibyte, and its major mode is +Fundamental mode, regardless of the file name. File local variable +specifications in the file (@pxref{File Local Variables}) are +ignored, and automatic decompression and adding a newline at the end +of the file due to @code{require-final-newline} (@pxref{Saving +Buffers, require-final-newline}) are also disabled. + +Note that if Emacs already has a buffer visiting the same file +non-literally, it will not visit the same file literally, but instead +just switch to the existing buffer. If you want to be sure of +accessing a file's contents literally, you should create a temporary +buffer and then read the file contents into it using +@code{insert-file-contents-literally} (@pxref{Reading from Files}). +@end deffn + @defun find-file-noselect filename &optional nowarn rawfile wildcards This function is the guts of all the file-visiting functions. It returns a buffer visiting the file @var{filename}. You may make the @@ -224,6 +244,16 @@ This is not a normal hook because the values of the functions are used, and in many cases only some of the functions are called. @end defvar +@defvar find-file-literally +This buffer-local variable, if set to a non-@code{nil} value, makes +@code{save-buffer} behave as if the buffer were visiting its file +literally, i.e. without conversions of any kind. The command +@code{find-file-literally} sets this variable's local value, but other +equivalent functions and commands can do that as well, e.g.@: to avoid +automatic addition of a newline at the end of the file. This variable +us permanent local, so it is unaffected by changes of major modes. +@end defvar + @node Subroutines of Visiting @comment node-name, next, previous, up @subsection Subroutines of Visiting diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 4a2964b9b6c..af24ff5aa43 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -1508,6 +1508,12 @@ does not have the effect of remapping @code{kill-line} into if an ordinary binding specifies @code{my-kill-line}, this keymap will remap it to @code{my-other-kill-line}. +To undo the remapping of a command, remap it to @code{nil}; e.g. + +@smallexample +(define-key my-mode-map [remap kill-line] nil) +@end smallexample + @defun command-remapping command &optional position keymaps This function returns the remapping for @var{command} (a symbol), given the current active keymaps. If @var{command} is not remapped diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 5b5f3365978..0cdcaa84d58 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1407,6 +1407,8 @@ subsequent major mode. @xref{Hooks}. @cindex permanent local variable A buffer-local variable is @dfn{permanent} if the variable name (a symbol) has a @code{permanent-local} property that is non-@code{nil}. +Such variables are unaffected by @code{kill-all-local-variables}, and +their local bindings are therefore not cleared by changing major modes. Permanent locals are appropriate for data pertaining to where the file came from or how to save it, rather than with how to edit the contents. diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog index 61e05aaf332..7d32b16790e 100644 --- a/doc/misc/ChangeLog +++ b/doc/misc/ChangeLog @@ -1,3 +1,128 @@ +2011-02-20 Lars Ingebrigtsen <larsi@gnus.org> + + * gnus.texi (Window Layout): Document layout names. + +2011-02-19 Eli Zaretskii <eliz@gnu.org> + + * ada-mode.texi: Sync @dircategory with ../../info/dir. + * auth.texi: Sync @dircategory with ../../info/dir. + * autotype.texi: Sync @dircategory with ../../info/dir. + * calc.texi: Sync @dircategory with ../../info/dir. + * cc-mode.texi: Sync @dircategory with ../../info/dir. + * cl.texi: Sync @dircategory with ../../info/dir. + * dbus.texi: Sync @dircategory with ../../info/dir. + * dired-x.texi: Sync @dircategory with ../../info/dir. + * ebrowse.texi: Sync @dircategory with ../../info/dir. + * ede.texi: Sync @dircategory with ../../info/dir. + * ediff.texi: Sync @dircategory with ../../info/dir. + * edt.texi: Sync @dircategory with ../../info/dir. + * eieio.texi: Sync @dircategory with ../../info/dir. + * emacs-mime.texi: Sync @dircategory with ../../info/dir. + * epa.texi: Sync @dircategory with ../../info/dir. + * erc.texi: Sync @dircategory with ../../info/dir. + * eshell.texi: Sync @dircategory with ../../info/dir. + * eudc.texi: Sync @dircategory with ../../info/dir. + * flymake.texi: Sync @dircategory with ../../info/dir. + * forms.texi: Sync @dircategory with ../../info/dir. + * gnus.texi: Sync @dircategory with ../../info/dir. + * idlwave.texi: Sync @dircategory with ../../info/dir. + * mairix-el.texi: Sync @dircategory with ../../info/dir. + * message.texi: Sync @dircategory with ../../info/dir. + * mh-e.texi: Sync @dircategory with ../../info/dir. + * newsticker.texi: Sync @dircategory with ../../info/dir. + * nxml-mode.texi: Sync @dircategory with ../../info/dir. + * org.texi: Sync @dircategory with ../../info/dir. + * pcl-cvs.texi: Sync @dircategory with ../../info/dir. + * pgg.texi: Sync @dircategory with ../../info/dir. + * rcirc.texi: Sync @dircategory with ../../info/dir. + * reftex.texi: Sync @dircategory with ../../info/dir. + * remember.texi: Sync @dircategory with ../../info/dir. + * sasl.texi: Sync @dircategory with ../../info/dir. + * sc.texi: Sync @dircategory with ../../info/dir. + * semantic.texi: Sync @dircategory with ../../info/dir. + * ses.texi: Sync @dircategory with ../../info/dir. + * sieve.texi: Sync @dircategory with ../../info/dir. + * smtpmail.texi: Sync @dircategory with ../../info/dir. + * speedbar.texi: Sync @dircategory with ../../info/dir. + * trampver.texi [emacs]: Set emacsname to "Emacs". + * tramp.texi: Sync @dircategory with ../../info/dir. + * url.texi: Sync @dircategory with ../../info/dir. + * vip.texi: Sync @dircategory with ../../info/dir. + * viper.texi: Sync @dircategory with ../../info/dir. + * widget.texi: Sync @dircategory with ../../info/dir. + * woman.texi: Sync @dircategory with ../../info/dir. + +2011-02-19 Glenn Morris <rgm@gnu.org> + + * dired-x.texi (Technical Details): No longer redefines dired-add-entry, + dired-initial-position, dired-clean-up-after-deletion, + dired-read-shell-command, or dired-find-buffer-nocreate. + +2011-02-18 Glenn Morris <rgm@gnu.org> + + * dired-x.texi (Optional Installation File At Point): Simplify. + +2011-02-17 Teodor Zlatanov <tzz@lifelogs.com> + + * auth.texi (Help for users): Use :port instead of :protocol for all + auth-source docs. + (GnuPG and EasyPG Assistant Configuration): Mention the default now is + to have two files in `auth-sources'. + +2011-02-16 Glenn Morris <rgm@gnu.org> + + * dired-x.texi: Use emacsver.texi to get Emacs version. + * Makefile.in ($(infodir)/dired-x, dired-x.dvi, dired-x.pdf): + Depend on emacsver.texi. + + * dired-x.texi: Drop meaningless version number. + (Introduction): Remove old info. + (Optional Installation Dired Jump): Autoload from dired-x. + Remove incorrect info about loaddefs.el. + (Bugs): Just refer to M-x report-emacs-bug. + + * dired-x.texi (Multiple Dired Directories): Update for rename of + default-directory-alist. + (Miscellaneous Commands): No longer mention very old VM version 4. + +2011-02-15 Paul Eggert <eggert@cs.ucla.edu> + + Merge from gnulib. + * texinfo.tex: Update to version 2011-02-14.11. + +2011-02-14 Teodor Zlatanov <tzz@lifelogs.com> + + * auth.texi (Help for users): + Login collection is "Login" and not "login". + +2011-02-13 Michael Albinus <michael.albinus@gmx.de> + + * tramp.texi (History): Remove IMAP support. + (External methods, Frequently Asked Questions): Remove `imap' and + `imaps' methods. + (Password handling): Remove IMAP entries for ~/.authinfo.gpg. + + * trampver.texi: Remove default value of `emacsimap'. + +2011-02-13 Glenn Morris <rgm@gnu.org> + + * ada-mode.texi, dired-x.texi, ebrowse.texi, ediff.texi, eudc.texi: + * idlwave.texi, reftex.texi, sc.texi, speedbar.texi: Add @top. + +2011-02-12 Glenn Morris <rgm@gnu.org> + + * sc.texi (Getting Connected): Remove old index entries. + +2011-02-12 Ulrich Mueller <ulm@gentoo.org> + + * url.texi: Remove duplicate @dircategory (Bug#7942). + +2011-02-11 Teodor Zlatanov <tzz@lifelogs.com> + + * auth.texi (Overview, Help for users, Help for developers): + Update docs. + (Help for users): Talk about spaces. + 2011-02-09 Paul Eggert <eggert@cs.ucla.edu> * texinfo.tex: Update to version 2011-02-07.16. diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in index 169d6c89b85..0a28d417c70 100644 --- a/doc/misc/Makefile.in +++ b/doc/misc/Makefile.in @@ -287,12 +287,12 @@ dbus.pdf: ${srcdir}/dbus.texi $(ENVADD) $(TEXI2PDF) $< dired-x : $(infodir)/dired-x -$(infodir)/dired-x: dired-x.texi +$(infodir)/dired-x: dired-x.texi $(emacsdir)/emacsver.texi $(mkinfodir) cd $(srcdir); $(MAKEINFO) $(MAKEINFO_OPTS) $< -dired-x.dvi: ${srcdir}/dired-x.texi +dired-x.dvi: ${srcdir}/dired-x.texi $(emacsdir)/emacsver.texi $(ENVADD) $(TEXI2DVI) $< -dired-x.pdf: ${srcdir}/dired-x.texi +dired-x.pdf: ${srcdir}/dired-x.texi $(emacsdir)/emacsver.texi $(ENVADD) $(TEXI2PDF) $< ebrowse : $(infodir)/ebrowse diff --git a/doc/misc/ada-mode.texi b/doc/misc/ada-mode.texi index 80949aefb33..66cdb200111 100644 --- a/doc/misc/ada-mode.texi +++ b/doc/misc/ada-mode.texi @@ -19,7 +19,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs editing modes @direntry * Ada mode: (ada-mode). Emacs mode for editing and compiling Ada code. @end direntry @@ -39,6 +39,7 @@ developing GNU and promoting software freedom.'' @contents @node Top, Overview, (dir), (dir) +@top Ada Mode @ifnottex @insertcopying diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index bad37dbe85a..27c6691dfa8 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -5,7 +5,7 @@ @setfilename ../../info/auth @settitle Emacs auth-source Library @value{VERSION} -@set VERSION 0.2 +@set VERSION 0.3 @copying This file describes the Emacs auth-source library. @@ -32,7 +32,7 @@ license to the document, as described in section 6 of the license. @end quotation @end copying -@dircategory Emacs +@dircategory Emacs lisp libraries @direntry * Auth-source: (auth). The Emacs auth-source library. @end direntry @@ -78,15 +78,19 @@ It is a way for multiple applications to share a single configuration @chapter Overview The auth-source library is simply a way for Emacs and Gnus, among -others, to answer the old burning question ``I have a server name and -a port, what are my user name and password?'' +others, to answer the old burning question ``What are my user name and +password?'' -The auth-source library actually supports more than just the user name -(known as the login) or the password, but only those two are in use -today in Emacs or Gnus. Similarly, the auth-source library supports -multiple storage formats, currently either the classic ``netrc'' -format, examples of which you can see later in this document, or the -Secret Service API. +(This is different from the old question about burning ``Where is the +fire extinguisher, please?''.) + +The auth-source library supports more than just the user name or the +password (known as the secret). + +Similarly, the auth-source library supports multiple storage backend, +currently either the classic ``netrc'' backend, examples of which you +can see later in this document, or the Secret Service API. This is +done with EIEIO-based backends and you can write your own if you want. @node Help for users @chapter Help for users @@ -96,25 +100,40 @@ Secret Service API. machine @var{mymachine} login @var{myloginname} password @var{mypassword} port @var{myport} @end example -The machine is the server (either a DNS name or an IP address). +The @code{machine} is the server (either a DNS name or an IP address). +It's known as @var{:host} in @code{auth-source-search} queries. You +can also use @code{host}. + +The @code{port} is the connection port or protocol. It's known as +@var{:port} in @code{auth-source-search} queries. + +The @code{user} is the user name. It's known as @var{:user} in +@code{auth-source-search} queries. You can also use @code{login} and +@code{account}. + +Spaces are always OK as far as auth-source is concerned (but other +programs may not like them). Just put the data in quotes, escaping +quotes as you'd expect with @code{\}. + +All these are optional. You could just say (but we don't recommend +it, we're just showing that it's possible) -The port is optional. If it's missing, auth-source will assume any -port is OK. Actually the port is a protocol name or a port number so -you can have separate entries for port @var{143} and for protocol -@var{imap} if you fancy that. Anyway, you can just omit the port if -you don't need it. +@example +password @var{mypassword} +@end example -The login and password are simply your login credentials to the server. +to use the same password everywhere. Again, @emph{DO NOT DO THIS} or +you will be pwned as the kids say. ``Netrc'' files are usually called @code{.authinfo} or @code{.netrc}; nowadays @code{.authinfo} seems to be more popular and the auth-source library encourages this confusion by making it the default, as you'll see later. -If you have problems with the port, set @code{auth-source-debug} to -@code{t} and see what port the library is checking in the -@code{*Messages*} buffer. Ditto for any other problems, your first -step is always to see what's being checked. The second step, of +If you have problems with the search, set @code{auth-source-debug} to +@code{t} and see what host, port, and user the library is checking in +the @code{*Messages*} buffer. Ditto for any other problems, your +first step is always to see what's being checked. The second step, of course, is to write a blog entry about it and wait for the answer in the comments. @@ -135,60 +154,40 @@ particular host and protocol. While you can get fancy, the default and simplest configuration is: @lisp -;;; old default: required :host and :protocol, not needed anymore -(setq auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t))) +;;; old default: required :host and :port, not needed anymore +(setq auth-sources '((:source "~/.authinfo.gpg" :host t :port t))) ;;; mostly equivalent (see below about fallbacks) but shorter: (setq auth-sources '((:source "~/.authinfo.gpg"))) +;;; even shorter and the @emph{default}: +(setq auth-sources '("~/.authinfo.gpg" "~/.authinfo")) +;;; use the Secrets API @var{Login} collection (@pxref{Secret Service API}) +(setq auth-sources '("secrets:Login")) @end lisp -This says ``for any host and any protocol, use just that one file.'' -Sweet simplicity. In fact, the latter is already the default, so -unless you want to move your netrc file, it will just work if you have -that file. Make sure it exists. - By adding multiple entries to @code{auth-sources} with a particular host or protocol, you can have specific netrc files for that host or protocol. Usually this is unnecessary but may make sense if you have shared netrc files or some other unusual setup (90% of Emacs users have unusual setups and the remaining 10% are @emph{really} unusual). -Here's an example that uses the Secret Service API for all lookups, -using the default collection: - -@lisp -(setq auth-sources '((:source (:secrets default)))) -@end lisp - -And here's a mixed example, using two sources: +Here's a mixed example using two sources: @lisp (setq auth-sources '((:source (:secrets default) :host "myserver" :user "joe") - (:source "~/.authinfo.gpg"))) + "~/.authinfo.gpg")) @end lisp -The best match is determined by order (starts from the bottom) only -for the first pass, where things are checked exactly. In the example -above, the first pass would find a single match for host -@code{myserver}. The netrc choice would fail because it matches any -host and protocol implicitly (as a @emph{fallback}). A specified -value of @code{:host t} in @code{auth-sources} is considered a match -on the first pass, unlike a missing @code{:host}. - -Now if you look for host @code{missing}, it won't match either source -explicitly. The second pass (the @emph{fallback} pass) will look at -all the implicit matches and collect them. They will be scored and -returned sorted by score. The score is based on the number of -explicit parameters that matched. See the @code{auth-pick} function -for details. - @end defvar If you don't customize @code{auth-sources}, you'll have to live with the defaults: any host and any port are looked up in the netrc file @code{~/.authinfo.gpg}, which is a GnuPG encrypted file -(@pxref{GnuPG and EasyPG Assistant Configuration}). +(@pxref{GnuPG and EasyPG Assistant Configuration}). + +If that fails, the unencrypted netrc file @code{~/.authinfo} will +be used. -The simplest working netrc line example is one without a port. +The typical netrc line example is without a port. @example machine YOURMACHINE login YOU password YOURPASSWORD @@ -233,42 +232,29 @@ TODO: how does it work generally, how does secrets.el work, some examples. @node Help for developers @chapter Help for developers -The auth-source library only has one function for external use. +The auth-source library only has a few functions for external use. -@defun auth-source-user-or-password mode host port &optional username +@defun auth-source-search SPEC -Retrieve appropriate authentication tokens, determined by @var{mode}, -for host @var{host} and @var{port}. If @var{username} is provided it -will also be checked. If @code{auth-source-debug} is t, debugging -messages will be printed. Set @code{auth-source-debug} to a function -to use that function for logging. The parameters passed will be the -same that the @code{message} function takes, that is, a string -formatting spec and optional parameters. +TODO: how to include docstring? -If @var{mode} is a list of strings, the function will return a list of -strings or @code{nil} objects (thus you can avoid parsing the netrc -file or checking the Secret Service API more than once). If it's a -string, the function will return a string or a @code{nil} object. -Currently only the modes ``login'' and ``password'' are recognized but -more may be added in the future. +@end defun -@var{host} is a string containing the host name. +@defun auth-source-delete SPEC -@var{port} contains the protocol name (e.g. ``imap'') or -a port number. It must be a string, corresponding to the port in the -users' netrc files. +TODO: how to include docstring? -@var{username} contains the user name (e.g. ``joe'') as a string. +@end defun -@example -;; IMAP example -(setq auth (auth-source-user-or-password - '("login" "password") - "anyhostnamehere" - "imap")) -(nth 0 auth) ; the login name -(nth 1 auth) ; the password -@end example +@defun auth-source-forget SPEC + +TODO: how to include docstring? + +@end defun + +@defun auth-source-forget+ SPEC + +TODO: how to include docstring? @end defun @@ -276,7 +262,9 @@ users' netrc files. @appendix GnuPG and EasyPG Assistant Configuration If you don't customize @code{auth-sources}, the auth-source library -reads @code{~/.authinfo.gpg}, which is a GnuPG encrypted file. +reads @code{~/.authinfo.gpg}, which is a GnuPG encrypted file. Then +it will check @code{~/.authinfo} but it's not recommended to use such +an unencrypted file. In Emacs 23 or later there is an option @code{auto-encryption-mode} to automatically decrypt @code{*.gpg} files. It is enabled by default. diff --git a/doc/misc/autotype.texi b/doc/misc/autotype.texi index bdf9ae7ab17..2e66c78a3cb 100644 --- a/doc/misc/autotype.texi +++ b/doc/misc/autotype.texi @@ -26,7 +26,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs misc features @direntry * Autotype: (autotype). Convenient features for text that you enter frequently in Emacs. diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index e98ea807f63..b9d4f8c4a23 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -111,7 +111,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs misc features @direntry * Calc: (calc). Advanced desk calculator and mathematical tool. @end direntry diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index d4a870346ce..9ae9abd5e1a 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -177,7 +177,7 @@ developing GNU and promoting software freedom.'' @comment Info directory entry for use by install-info. The indentation @comment here is by request from the FSF folks. -@dircategory Emacs +@dircategory Emacs editing modes @direntry * CC Mode: (ccmode). Emacs mode for editing C, C++, Objective-C, Java, Pike, AWK, and CORBA IDL code. diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index 13fe9b570e2..afe7c94f447 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -21,7 +21,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs lisp libraries @direntry * CL: (cl). Partial Common Lisp support for Emacs Lisp. @end direntry diff --git a/doc/misc/dbus.texi b/doc/misc/dbus.texi index 64d577f4387..ad202f963aa 100644 --- a/doc/misc/dbus.texi +++ b/doc/misc/dbus.texi @@ -25,7 +25,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs lisp libraries @direntry * D-Bus: (dbus). Using D-Bus in Emacs. @end direntry diff --git a/doc/misc/dired-x.texi b/doc/misc/dired-x.texi index 21f91c9125e..003046d5a7c 100644 --- a/doc/misc/dired-x.texi +++ b/doc/misc/dired-x.texi @@ -7,10 +7,11 @@ @c [Dodd's address no longer valid.] @comment %**start of header (This is for running Texinfo on a region.) -@c FOR GNU EMACS USE ../info/dired-x BELOW @setfilename ../../info/dired-x -@c dired-x.el REVISION NUMBER -@settitle Dired Extra Version 2 User's Manual +@settitle Dired Extra User's Manual + +@include emacsver.texi + @iftex @finalout @end iftex @@ -18,7 +19,8 @@ @comment %**end of header (This is for running Texinfo on a region.) @copying -Copyright @copyright{} 1994-1995, 1999, 2001-2011 Free Software Foundation, Inc. +Copyright @copyright{} 1994-1995, 1999, 2001-2011 +Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -34,7 +36,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs misc features @direntry * Dired-X: (dired-x). Dired Extra Features. @end direntry @@ -47,8 +49,7 @@ developing GNU and promoting software freedom.'' @titlepage @sp 6 -@c dired-x.el REVISION NUMBER -@center @titlefont{Dired Extra Version 2} +@center @titlefont{Dired Extra} @sp 2 @center @titlefont{For The GNU Emacs} @sp 1 @@ -69,10 +70,10 @@ developing GNU and promoting software freedom.'' @ifnottex @node Top -@comment node-name, next, previous, up +@top Dired Extra @noindent -This documents the ``extra'' features for Dired Mode for GNU Emacs that are +This documents the ``extra'' features for GNU Emacs's Dired Mode that are provided by the file @file{dired-x.el}. @itemize @bullet @@ -80,20 +81,8 @@ provided by the file @file{dired-x.el}. @item Based on @file{dired.texi} by Sebastian Kremer <sk@@thp.uni-koeln.de> -@c dired-x.el REVISION NUMBER @item -For @file{dired-x.el} revision 2 - -@c @item -@c Revision of this manual: 2.53 (2001/02/25 14:05:46) - -@c @item -@c Bugs to Lawrence R. Dodd <dodd@@roebling.poly.edu>. @emph{Please} type -@c @kbd{M-x dired-x-submit-report} to submit a bug report (@pxref{Bugs}). - -@c @item -@c You can obtain a copy of this package via anonymous ftp in -@c @t{/roebling.poly.edu:/pub/packages/dired-x.tar.gz} +For @file{dired-x.el} as distributed with GNU Emacs @value{EMACSVER}. @end itemize @@ -123,19 +112,11 @@ For @file{dired-x.el} revision 2 @end ifnottex @node Introduction, Installation, Top, Top -@comment node-name, next, previous, up @chapter Introduction -This documents the @emph{extra} features for Dired Mode for GNU Emacs. It -is derived from version 1.191 of Sebastian Kremer's @file{dired-x.el}. - -In adopting this @file{dired-x.el} to GNU Emacs v19 some material that has -been incorporated into @file{dired.el} and @file{dired-aux.el} of the GNU Emacs -19 distribution has been removed and some material was modified for agreement -with the functions in @file{dired.el} and @file{dired-aux.el}. For example, -the code using @code{gmhist} history functions was replaced with code using -the mini-buffer history now built into GNU Emacs. Finally, a few other -features have been added and a few more functions have been bound to keys. +This documents some @emph{extra} features for GNU Emacs's Dired Mode +that are provided by @file{dired-x.el} (derived from Sebastian Kremer's +original @file{dired-x.el}). @ifnottex @menu @@ -145,7 +126,6 @@ features have been added and a few more functions have been bound to keys. @end ifnottex @node Features, Technical Details, , Introduction -@comment node-name, next, previous, up @section Features @cindex Features @@ -193,35 +173,22 @@ C-f} and @kbd{C-x 4 C-f} to @code{dired-x-find-file} and Point}). @node Technical Details, , Features, Introduction -@comment node-name, next, previous, up @section Technical Details -@cindex Redefined functions +@cindex Modified functions @cindex @file{dired-aux.el} -When loaded this code @emph{redefines} the following functions of GNU Emacs -from @file{dired.el} - -@itemize @bullet -@item -@code{dired-clean-up-after-deletion} -@item -@code{dired-find-buffer-nocreate} -@item -@code{dired-initial-position} -@end itemize - -@noindent -and the following functions from @file{dired-aux.el} - -@itemize @bullet -@item -@code{dired-add-entry} -@item -@code{dired-read-shell-command} -@end itemize +When @file{dired-x.el} is loaded, some standard Dired functions from +@file{dired.el} and @file{dired-aux.el} offer additional features. +@code{dired-add-entry} obeys Dired Omit mode (@pxref{Omitting Files in +Dired}), if it is active. @code{dired-find-buffer-nocreate} and +@code{dired-initial-position} respect the value of +@code{dired-find-subdir} (@pxref{Miscellaneous Commands}). +@code{dired-clean-up-after-deletion} respects the value of +@code{dired-clean-up-buffers-too}. @code{dired-read-shell-command} uses +@code{dired-guess-shell-command} (@pxref{Shell Command Guessing}) to +offer a smarter default command. @node Installation, Omitting Files in Dired, Introduction, Top -@comment node-name, next, previous, up @chapter Installation @noindent @@ -230,8 +197,8 @@ This manual describes the Dired features provided by the file file and (optionally) set some variables. @noindent -In your @file{.emacs} file in your home directory, or in the system-wide -initialization file @file{default.el} in the @file{site-lisp} directory, put +In your @file{~/.emacs} file, or in the system-wide initialization file +@file{default.el} in the @file{site-lisp} directory, put @example (add-hook 'dired-load-hook @@ -260,69 +227,35 @@ when you first type @kbd{C-x d}). @end ifnottex @node Optional Installation Dired Jump, Optional Installation File At Point, , Installation -@comment node-name, next, previous, up @section Optional Installation Dired Jump @cindex Autoloading @code{dired-jump} and @code{dired-jump-other-window} In order to have @code{dired-jump} and @code{dired-jump-other-window} (@pxref{Miscellaneous Commands}) work @emph{before} @code{dired} and -@code{dired-x} have been properly loaded the user should set-up an autoload +@code{dired-x} have been properly loaded you should set-up an autoload for these functions. In your @file{.emacs} file put @example -;; Autoload `dired-jump' and `dired-jump-other-window'. -;; We autoload from FILE dired.el. This will then load dired-x.el -;; and hence define `dired-jump' and `dired-jump-other-window'. -(define-key global-map "\C-x\C-j" 'dired-jump) -(define-key global-map "\C-x4\C-j" 'dired-jump-other-window) - -(autoload (quote dired-jump) "dired" "\ -Jump to Dired buffer corresponding to current buffer. -If in a file, Dired the current directory and move to file's line. -If in Dired already, pop up a level and goto old directory's line. -In case the proper Dired file line cannot be found, refresh the Dired -buffer and try again." t nil) +(autoload 'dired-jump "dired-x" + "Jump to Dired buffer corresponding to current buffer." t) -(autoload (quote dired-jump-other-window) "dired" "\ -Like \\[dired-jump] (dired-jump) but in other window." t nil) -@end example - -Note that in recent releases of GNU Emacs 19 (i.e., 19.25 or later) the file -@file{../lisp/loaddefs.el} of the Emacs distribution already contains the -proper auto-loading for @code{dired-jump} so you need only put +(autoload 'dired-jump-other-window "dired-x" + "Like \\[dired-jump] (dired-jump) but in other window." t) -@example (define-key global-map "\C-x\C-j" 'dired-jump) +(define-key global-map "\C-x4\C-j" 'dired-jump-other-window) @end example -@noindent -in your @file{.emacs} file in order to have @kbd{C-x C-j} work -before @code{dired} is loaded. - @node Optional Installation File At Point, , Optional Installation Dired Jump, Installation -@comment node-name, next, previous, up @section Optional Installation File At Point @cindex Binding @code{dired-x-find-file} If you choose to have @file{dired-x.el} bind @code{dired-x-find-file} over @code{find-file} (@pxref{Find File At Point}), then you will need to set -@code{dired-x-hands-off-my-keys} and make a call to the function -@code{dired-x-bind-find-file} in the @code{dired-load-hook}: - -@example -(add-hook 'dired-load-hook - (lambda () - (load "dired-x") - ;; Bind dired-x-find-file. - (setq dired-x-hands-off-my-keys nil) - ;; Make sure our binding preference is invoked. - (dired-x-bind-find-file) - )) -@end example - -Alternatively, you can set the variable @emph{before} @file{dired-x.el} is -loaded +@code{dired-x-hands-off-my-keys}. To do this, either set it +@emph{before} @file{dired-x.el} is loaded, or use @kbd{M-x customize-variable}, +or call @code{dired-x-bind-find-file} after changing the value. @example (add-hook 'dired-load-hook @@ -334,7 +267,6 @@ loaded @end example @node Omitting Files in Dired, Local Variables, Installation, Top -@comment node-name, next, previous, up @chapter Omitting Files in Dired @cindex Omitting Files in Dired @@ -391,8 +323,6 @@ inside @code{dired-load-hook} (@pxref{Installation}) and then evaluate @end ifnottex @node Omitting Variables, Omitting Examples, , Omitting Files in Dired -@comment node-name, next, previous, up - @section Omitting Variables @cindex Customizing file omitting @@ -500,7 +430,6 @@ will show up again after reverting the buffer, unlike the others. @end table @node Omitting Examples, Omitting Technical, Omitting Variables, Omitting Files in Dired -@comment node-name, next, previous, up @section Examples of Omitting Various File Types @itemize @bullet @@ -554,7 +483,6 @@ in the @code{dired-load-hook} (@pxref{Installation}). @end itemize @node Omitting Technical, , Omitting Examples, Omitting Files in Dired -@comment node-name, next, previous, up @section Some Technical Details of Omitting Loading @file{dired-x.el} will install Dired Omit by putting @@ -562,8 +490,8 @@ Loading @file{dired-x.el} will install Dired Omit by putting call @code{dired-extra-startup}, which in turn calls @code{dired-omit-startup} in your @code{dired-mode-hook}. +@c FIXME does the standard dir-locals mechanism obsolete this? @node Local Variables, Shell Command Guessing, Omitting Files in Dired, Top -@comment node-name, next, previous, up @chapter Local Variables for Dired Directories @cindex Local Variables for Dired Directories @@ -632,7 +560,6 @@ Variables are hacked. @end table @node Shell Command Guessing, Virtual Dired, Local Variables, Top -@comment node-name, next, previous, up @chapter Shell Command Guessing @cindex Guessing shell commands for files. @@ -739,7 +666,6 @@ History list for commands that read dired-shell commands. @end table @node Virtual Dired, Advanced Mark Commands, Shell Command Guessing, Top -@comment node-name, next, previous, up @chapter Virtual Dired @cindex Virtual Dired @@ -781,7 +707,6 @@ The regexp is a bit more complicated than usual to exclude @file{.dired} local-variable files. @node Advanced Mark Commands, Multiple Dired Directories, Virtual Dired, Top -@comment node-name, next, previous, up @chapter Advanced Mark Commands @table @kbd @@ -828,8 +753,6 @@ Flag all files with a certain extension for deletion. A @samp{.} is @end ifnottex @node Advanced Cleaning Functions, Advanced Cleaning Variables, , Advanced Mark Commands -@comment node-name, next, previous, up - @section Advanced Cleaning Functions @table @code @@ -861,8 +784,6 @@ and @file{*.dvi} files for deletion. @end table @node Advanced Cleaning Variables, Special Marking Function, Advanced Cleaning Functions, Advanced Mark Commands -@comment node-name, next, previous, up - @section Advanced Cleaning Variables @noindent Variables used by the above cleaning commands (and in the default value for @@ -902,8 +823,6 @@ List of extensions of dispensable files created by Bib@TeX{}. @end table @node Special Marking Function, , Advanced Cleaning Variables, Advanced Mark Commands -@comment node-name, next, previous, up - @section Special Marking Function @table @kbd @@ -960,7 +879,6 @@ to mark all @file{.el} files without a corresponding @file{.elc} file. @end table @node Multiple Dired Directories, Find File At Point, Advanced Mark Commands, Top -@comment node-name, next, previous, up @chapter Multiple Dired Directories and Non-Dired Commands @cindex Multiple Dired directories @@ -977,8 +895,8 @@ A general mechanism is provided for special handling of the working directory in special major modes: @table @code -@item default-directory-alist -@vindex default-directory-alist +@item dired-default-directory-alist +@vindex dired-default-directory-alist Default: @code{((dired-mode . (dired-current-directory)))} Alist of major modes and their notion of @code{default-directory}, as a @@ -989,12 +907,10 @@ in favor of @code{default-directory}. @findex dired-default-directory Use this function like you would use the variable @code{default-directory}, except that @code{dired-default-directory} -also consults the variable @code{default-directory-alist}. +also consults the variable @code{dired-default-directory-alist}. @end table @node Find File At Point, Miscellaneous Commands, Multiple Dired Directories, Top -@comment node-name, next, previous, up - @section Find File At Point @cindex Visiting a file mentioned in a buffer @cindex Finding a file at point @@ -1071,7 +987,6 @@ that uses the value of @code{dired-x-hands-off-my-keys} to determine if @end table @node Miscellaneous Commands, Bugs, Find File At Point, Top -@comment node-name, next, previous, up @chapter Miscellaneous Commands Miscellaneous features not fitting anywhere else: @@ -1140,13 +1055,12 @@ file (assumed to be a UNIX mail folder). @vindex dired-vm-read-only-folders If you give this command a prefix argument, it will visit the folder -read-only. This only works in VM 5, not VM 4. +read-only. If the variable @code{dired-vm-read-only-folders} is @code{t}, -@code{dired-vm} will -visit all folders read-only. If it is neither @code{nil} nor @code{t}, e.g., -the symbol @code{if-file-read-only}, only files not writable by you are -visited read-only. This is the recommended value if you run VM 5. +@code{dired-vm} will visit all folders read-only. If it is neither +@code{nil} nor @code{t}, e.g., the symbol @code{if-file-read-only}, only +files not writable by you are visited read-only. @vindex dired-bind-vm If the variable @code{dired-bind-vm} is @code{t}, @code{dired-vm} will be bound @@ -1209,50 +1123,30 @@ info. @end table @node Bugs, GNU Free Documentation License, Miscellaneous Commands, Top -@comment node-name, next, previous, up @chapter Bugs @cindex Bugs -@findex dired-x-submit-report @noindent -If you encounter a bug in this package, wish to suggest an -enhancement, or want to make a smart remark, then type - -@example -@kbd{M-x dired-x-submit-report} -@end example - -@noindent -to set up an outgoing mail buffer, with the proper address to the -@file{dired-x.el} maintainer automatically inserted in the @samp{To:@:} field. -This command also inserts information that the Dired X maintainer can use to -recreate your exact setup, making it easier to verify your bug or social -maladjustment. - -Lawrence R. Dodd -@c <dodd@@roebling.poly.edu> +If you encounter a bug in this package, or wish to suggest an +enhancement, then please use @kbd{M-x report-emacs-bug} to report it. @node GNU Free Documentation License, Concept Index, Bugs, Top @appendix GNU Free Documentation License @include doclicense.texi @node Concept Index, Command Index, GNU Free Documentation License, Top -@comment node-name, next, previous, up @unnumbered Concept Index @printindex cp @node Command Index, Key Index, Concept Index, Top -@comment node-name, next, previous, up @unnumbered Function Index @printindex fn @node Key Index, Variable Index, Command Index, Top -@comment node-name, next, previous, up @unnumbered Key Index @printindex ky @node Variable Index, , Key Index, Top -@comment node-name, next, previous, up @unnumbered Variable Index @printindex vr diff --git a/doc/misc/ebrowse.texi b/doc/misc/ebrowse.texi index 66a5e38443d..19ee9705484 100644 --- a/doc/misc/ebrowse.texi +++ b/doc/misc/ebrowse.texi @@ -26,7 +26,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs misc features @direntry * Ebrowse: (ebrowse). A C++ class browser for Emacs. @end direntry @@ -46,6 +46,7 @@ developing GNU and promoting software freedom.'' @ifnottex @node Top, Overview, (dir), (dir) +@top Ebrowse You can browse C++ class hierarchies from within Emacs by using Ebrowse. diff --git a/doc/misc/ede.texi b/doc/misc/ede.texi index 86228a24d06..bc097a87150 100644 --- a/doc/misc/ede.texi +++ b/doc/misc/ede.texi @@ -21,9 +21,9 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs misc features @direntry -* ede: (ede). Project management for Emacs. +* EDE: (ede). The Emacs Development Environment. @end direntry @titlepage diff --git a/doc/misc/ediff.texi b/doc/misc/ediff.texi index 2a55541bbfd..3ba0796e636 100644 --- a/doc/misc/ediff.texi +++ b/doc/misc/ediff.texi @@ -41,7 +41,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs misc features @direntry * Ediff: (ediff). A visual interface for comparing and merging programs. @end direntry @@ -63,6 +63,7 @@ developing GNU and promoting software freedom.'' @contents @node Top, Introduction, (dir), (dir) +@top Ediff @insertcopying @@ -2540,4 +2541,3 @@ Eli Zaretskii (eliz at is.elta.co.il) @printindex cp @bye - diff --git a/doc/misc/edt.texi b/doc/misc/edt.texi index e3117d65699..377bb6ee8c5 100644 --- a/doc/misc/edt.texi +++ b/doc/misc/edt.texi @@ -22,7 +22,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs misc features @direntry * EDT: (edt). An Emacs emulation of the EDT editor. @end direntry diff --git a/doc/misc/eieio.texi b/doc/misc/eieio.texi index 1a22a15afba..8ee40288fe0 100644 --- a/doc/misc/eieio.texi +++ b/doc/misc/eieio.texi @@ -27,9 +27,9 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs misc features @direntry -* eieio: (eieio). Objects for Emacs. +* EIEIO: (eieio). An objects system for Emacs Lisp. @end direntry @titlepage diff --git a/doc/misc/emacs-mime.texi b/doc/misc/emacs-mime.texi index ef6db1c3606..a9d80d868b6 100644 --- a/doc/misc/emacs-mime.texi +++ b/doc/misc/emacs-mime.texi @@ -30,7 +30,7 @@ developing GNU and promoting software freedom.'' @c Node ``Interface Functions'' uses Latin-1 characters @documentencoding ISO-8859-1 -@dircategory Emacs +@dircategory Emacs lisp libraries @direntry * Emacs MIME: (emacs-mime). Emacs MIME de/composition library. @end direntry diff --git a/doc/misc/epa.texi b/doc/misc/epa.texi index ae194356c3f..b4137a7dac6 100644 --- a/doc/misc/epa.texi +++ b/doc/misc/epa.texi @@ -31,7 +31,7 @@ license to the document, as described in section 6 of the license. @end quotation @end copying -@dircategory Emacs +@dircategory Emacs misc features @direntry * EasyPG Assistant: (epa). An Emacs user interface to GNU Privacy Guard. @end direntry diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 1ce6e949da5..463a14f08d2 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -28,7 +28,7 @@ and modified without restriction. @end quotation @end copying -@dircategory Emacs +@dircategory Emacs network features @direntry * ERC: (erc). Powerful and extensible IRC client for Emacs. @end direntry diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 51031e219ff..0ae6a0e7fae 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -24,7 +24,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs misc features @direntry * Eshell: (eshell). A command shell implemented in Emacs Lisp. @end direntry diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi index b0652ab3f10..a68eda50025 100644 --- a/doc/misc/eudc.texi +++ b/doc/misc/eudc.texi @@ -28,7 +28,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs network features @direntry * EUDC: (eudc). Emacs client for directory servers (LDAP, PH). @end direntry @@ -50,6 +50,7 @@ developing GNU and promoting software freedom.'' @ifnottex @node Top, Overview, (dir), (dir) +@top Emacs Unified Directory Client @comment node-name, next, previous, up @insertcopying diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi index 7f0cd77de59..74cf3d630da 100644 --- a/doc/misc/flymake.texi +++ b/doc/misc/flymake.texi @@ -28,7 +28,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs misc features @direntry * Flymake: (flymake). A universal on-the-fly syntax checker. @end direntry diff --git a/doc/misc/forms.texi b/doc/misc/forms.texi index f58e8d8f969..17c1d7feaf0 100644 --- a/doc/misc/forms.texi +++ b/doc/misc/forms.texi @@ -34,7 +34,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs misc features @direntry * Forms: (forms). Emacs package for editing data bases by filling in forms. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 16273d21c46..d40522a44d5 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -321,7 +321,7 @@ developing GNU and promoting software freedom.'' @end iflatex @end iftex -@dircategory Emacs +@dircategory Emacs network features @direntry * Gnus: (gnus). The newsreader Gnus. @end direntry @@ -22823,6 +22823,81 @@ window is displayed vertically next to another window, you may also want to fiddle with @code{gnus-tree-minimize-window} to avoid having the windows resized. +@subsection Window Configuration Names + +Here's a list of most of the currently known window configurations, +and when they're used: + +@itemize @code +@item group +The group buffer. + +@item summary +Entering a group and showing only the summary. + +@item article +Selecting an article. + +@item server +The server buffer. + +@item browse +Browsing groups from the server buffer. + +@item message +Composing a (new) message. + +@item only-article +Showing only the article buffer. + +@item edit-article +Editing an article. + +@item edit-form +Editing group parameters and the like. + +@item edit-score +Editing a server definition. + +@item post +Composing a news message. + +@item reply +Replying or following up an article without yanking the text. + +@item forward +Forwarding a message. + +@item reply-yank +Replying or following up an article with yanking the text. + +@item mail-bound +Bouncing a message. + +@item pipe +Sending an article to an external process. + +@item bug +Sending a bug report. + +@item score-trace +Displaying the score trace. + +@item score-words +Displaying the score words. + +@item split-trace +Displaying the split trace. + +@item compose-bounce +Composing a bounce message. + +@item mml-preview +Previewing a @acronym{MIME} part. + +@end itemize + + @subsection Example Window Configurations @itemize @bullet diff --git a/doc/misc/idlwave.texi b/doc/misc/idlwave.texi index be518db6463..94aeb612df7 100644 --- a/doc/misc/idlwave.texi +++ b/doc/misc/idlwave.texi @@ -38,7 +38,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs editing modes @direntry * IDLWAVE: (idlwave). Major mode and shell for IDL files. @end direntry @@ -57,6 +57,7 @@ developing GNU and promoting software freedom.'' @ifnottex @node Top, Introduction, (dir), (dir) +@top IDLWAVE IDLWAVE is a package which supports editing source code written in the Interactive Data Language (IDL), and running IDL as an inferior shell. diff --git a/doc/misc/mairix-el.texi b/doc/misc/mairix-el.texi index 4235e825fb6..d64f316cb7b 100644 --- a/doc/misc/mairix-el.texi +++ b/doc/misc/mairix-el.texi @@ -22,7 +22,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs network features @direntry * Mairix: (mairix-el). Emacs interface to the Mairix mail indexer. @end direntry diff --git a/doc/misc/message.texi b/doc/misc/message.texi index 4f0c09f4117..b28639907ed 100644 --- a/doc/misc/message.texi +++ b/doc/misc/message.texi @@ -26,7 +26,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs network features @direntry * Message: (message). Mail and news composition mode that goes with Gnus. diff --git a/doc/misc/mh-e.texi b/doc/misc/mh-e.texi index 546f9e629fe..59da631c6ea 100644 --- a/doc/misc/mh-e.texi +++ b/doc/misc/mh-e.texi @@ -55,7 +55,7 @@ Public License.'' @end copying @c Info Directory Entry -@dircategory Emacs +@dircategory Emacs network features @direntry * MH-E: (mh-e). Emacs interface to the MH mail system. @end direntry diff --git a/doc/misc/newsticker.texi b/doc/misc/newsticker.texi index fadcf1ea17b..c7d82245973 100644 --- a/doc/misc/newsticker.texi +++ b/doc/misc/newsticker.texi @@ -30,7 +30,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs network features @direntry * Newsticker: (newsticker). A Newsticker for Emacs. @end direntry diff --git a/doc/misc/nxml-mode.texi b/doc/misc/nxml-mode.texi index b2003a139d0..27603440413 100644 --- a/doc/misc/nxml-mode.texi +++ b/doc/misc/nxml-mode.texi @@ -31,7 +31,7 @@ license to the document, as described in section 6 of the license. @end quotation @end copying -@dircategory Emacs +@dircategory Emacs editing modes @direntry * nXML Mode: (nxml-mode). XML editing mode with RELAX NG support. @end direntry diff --git a/doc/misc/org.texi b/doc/misc/org.texi index 7618bad1f73..a0ec20c4034 100644 --- a/doc/misc/org.texi +++ b/doc/misc/org.texi @@ -286,7 +286,7 @@ license to the document, as described in section 6 of the license. @end quotation @end copying -@dircategory Emacs +@dircategory Emacs editing modes @direntry * Org Mode: (org). Outline-based notes management and organizer @end direntry diff --git a/doc/misc/pcl-cvs.texi b/doc/misc/pcl-cvs.texi index 7301bf3747a..f12942da2d3 100644 --- a/doc/misc/pcl-cvs.texi +++ b/doc/misc/pcl-cvs.texi @@ -23,7 +23,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs misc features @direntry * PCL-CVS: (pcl-cvs). Emacs front-end to CVS. @end direntry diff --git a/doc/misc/pgg.texi b/doc/misc/pgg.texi index 6efa3e6bb72..9cb7a637a05 100644 --- a/doc/misc/pgg.texi +++ b/doc/misc/pgg.texi @@ -27,7 +27,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs network features @direntry * PGG: (pgg). Emacs interface to various PGP implementations. @end direntry diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi index 6402c91c57a..c2b6867c419 100644 --- a/doc/misc/rcirc.texi +++ b/doc/misc/rcirc.texi @@ -22,7 +22,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs network features @direntry * Rcirc: (rcirc). Internet Relay Chat (IRC) client. @end direntry diff --git a/doc/misc/reftex.texi b/doc/misc/reftex.texi index 880cfb988a3..3944b712338 100644 --- a/doc/misc/reftex.texi +++ b/doc/misc/reftex.texi @@ -43,7 +43,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs misc features @direntry * RefTeX: (reftex). Emacs support for LaTeX cross-references and citations. @@ -79,6 +79,7 @@ developing GNU and promoting software freedom.'' @ifnottex @node Top,,,(dir) +@top RefTeX @b{Ref@TeX{}} is a package for managing Labels, References, Citations and index entries with GNU Emacs. diff --git a/doc/misc/remember.texi b/doc/misc/remember.texi index cdb45140093..e67d6155bbe 100644 --- a/doc/misc/remember.texi +++ b/doc/misc/remember.texi @@ -25,7 +25,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs misc features @direntry * Remember: (remember). Simple information manager for Emacs. @end direntry diff --git a/doc/misc/sasl.texi b/doc/misc/sasl.texi index ec33f0525d3..a75b237519c 100644 --- a/doc/misc/sasl.texi +++ b/doc/misc/sasl.texi @@ -33,7 +33,7 @@ license to the document, as described in section 6 of the license. @end quotation @end copying -@dircategory Emacs +@dircategory Emacs network features @direntry * SASL: (sasl). The Emacs SASL library. @end direntry diff --git a/doc/misc/sc.texi b/doc/misc/sc.texi index 621d78b962f..8853192af04 100644 --- a/doc/misc/sc.texi +++ b/doc/misc/sc.texi @@ -32,7 +32,7 @@ developing GNU and promoting software freedom.'' @c @smallbook -@dircategory Emacs +@dircategory Emacs network features @direntry * SC: (sc). Supercite lets you cite parts of messages you're replying to, in flexible ways. @@ -53,6 +53,7 @@ developing GNU and promoting software freedom.'' @ifnottex @node Top, Introduction, (dir), (dir) +@top Supercite @comment node-name, next, previous, up @insertcopying @@ -751,8 +752,6 @@ interface specifications, or if you are writing or maintaining an MUA, @cindex .emacs file @findex sc-cite-original @findex cite-original (sc-) -@findex sc-submit-bug-report -@findex submit-bug-report (sc-) The first thing that everyone should do, regardless of the MUA you are using is to set up Emacs so it will load Supercite at the appropriate time. This happens automatically if Supercite is distributed with your diff --git a/doc/misc/semantic.texi b/doc/misc/semantic.texi index 89e83df5bc3..52434f4a6e4 100644 --- a/doc/misc/semantic.texi +++ b/doc/misc/semantic.texi @@ -40,7 +40,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs misc features @direntry * Semantic: (semantic). Source code parser library and utilities. @end direntry diff --git a/doc/misc/ses.texi b/doc/misc/ses.texi index 45e5e9efc0e..d9739b93925 100644 --- a/doc/misc/ses.texi +++ b/doc/misc/ses.texi @@ -27,7 +27,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs misc features @direntry * SES: (ses). Simple Emacs Spreadsheet. @end direntry diff --git a/doc/misc/sieve.texi b/doc/misc/sieve.texi index 754ee15fecc..64fd92f40ca 100644 --- a/doc/misc/sieve.texi +++ b/doc/misc/sieve.texi @@ -27,7 +27,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs network features @direntry * Sieve: (sieve). Managing Sieve scripts in Emacs. @end direntry diff --git a/doc/misc/smtpmail.texi b/doc/misc/smtpmail.texi index abd7d8974dc..1d4bbbff4ac 100644 --- a/doc/misc/smtpmail.texi +++ b/doc/misc/smtpmail.texi @@ -20,7 +20,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs lisp libraries @direntry * SMTP: (smtpmail). Emacs library for sending mail via SMTP. @end direntry diff --git a/doc/misc/speedbar.texi b/doc/misc/speedbar.texi index 980839cdec9..9dc47e4574c 100644 --- a/doc/misc/speedbar.texi +++ b/doc/misc/speedbar.texi @@ -20,7 +20,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs misc features @direntry * Speedbar: (speedbar). File/Tag summarizing utility. @end direntry @@ -40,6 +40,7 @@ developing GNU and promoting software freedom.'' @node Top, , , (dir)Top @comment node-name, next, previous, up +@top Speedbar Speedbar is a program for Emacs which can be used to summarize information related to the current buffer. Its original inspiration diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index 1fe8a1872f6..4467c1e860f 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,7 +3,7 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2011-02-07.16} +\def\texinfoversion{2011-02-14.11} % % Copyright 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995, % 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, @@ -158,6 +158,7 @@ \def\spaceisspace{\catcode`\ =\spacecat} % sometimes characters are active, so we need control sequences. +\chardef\ampChar = `\& \chardef\colonChar = `\: \chardef\commaChar = `\, \chardef\dashChar = `\- @@ -547,7 +548,7 @@ } \def\inenvironment#1{% \ifx#1\empty - out of any environment% + outside of any environment% \else in environment \expandafter\string#1% \fi @@ -2491,22 +2492,8 @@ end \codex } } -% Handle @url similarly to \code, but allows line breaks after .#?/ (only). -{ - \catcode`\.=\active \catcode`\#=\active - \catcode`\?=\active \catcode`\/=\active - % - \global\def\urefcode{\begingroup - \setupmarkupstyle{code}% - \catcode\dotChar=\active \catcode\hashChar=\active - \catcode\questChar=\active \catcode\slashChar=\active - \let.\urefcodedot - \let#\urefcodehash - \let?\urefcodequestion - \let/\urefcodeslash - \codex - } -} + +\def\codex #1{\tclose{#1}\endgroup} \def\realdash{-} \def\codedash{-\discretionary{}{}{}} @@ -2521,25 +2508,6 @@ end \discretionary{}{}{}}% {\_}% } -% we put a little stretch before and after the breakable chars, to help -% line breaking of long url's. The unequal skips make look better in -% cmtt at least, especially for dots. -\def\urefprestretch{\nobreak \hskip0pt plus.13em } -\def\urefpoststretch{\allowbreak \hskip0pt plus.1em } -\def\urefcodedot{\urefprestretch .\urefpoststretch} -\def\urefcodehash{\urefprestretch \#\urefpoststretch} -\def\urefcodequestion{\urefprestretch ?\urefpoststretch} -\def\urefcodeslash{\futurelet\next\urefcodeslashfinish} -{ - \catcode`\/=\active - \global\def\urefcodeslashfinish{% - \urefprestretch \slashChar - % Allow line break only after the final / in a sequence of - % slashes, to avoid line break between the slashes in http://. - \ifx\next/\else \urefpoststretch \fi - } -} -\def\codex #1{\tclose{#1}\endgroup} % An additional complication: the above will allow breaks after, e.g., % each of the four underscores in __typeof__. This is undesirable in @@ -2563,59 +2531,14 @@ end \fi\fi } -% @kbd is like @code, except that if the argument is just one @key command, -% then @kbd has no effect. -\def\kbd#1{{\setupmarkupstyle{kbd}\def\look{#1}\expandafter\kbdfoo\look??\par}} - -% @kbdinputstyle -- arg is `distinct' (@kbd uses slanted tty font always), -% `example' (@kbd uses ttsl only inside of @example and friends), -% or `code' (@kbd uses normal tty font always). -\parseargdef\kbdinputstyle{% - \def\txiarg{#1}% - \ifx\txiarg\worddistinct - \gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\ttsl}% - \else\ifx\txiarg\wordexample - \gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\tt}% - \else\ifx\txiarg\wordcode - \gdef\kbdexamplefont{\tt}\gdef\kbdfont{\tt}% - \else - \errhelp = \EMsimple - \errmessage{Unknown @kbdinputstyle option `\txiarg'}% - \fi\fi\fi -} -\def\worddistinct{distinct} -\def\wordexample{example} -\def\wordcode{code} - -% Default is `distinct'. -\kbdinputstyle distinct - -\def\xkey{\key} -\def\kbdfoo#1#2#3\par{\def\one{#1}\def\three{#3}\def\threex{??}% -\ifx\one\xkey\ifx\threex\three \key{#2}% -\else{\tclose{\kbdfont\setupmarkupstyle{kbd}\look}}\fi -\else{\tclose{\kbdfont\setupmarkupstyle{kbd}\look}}\fi} - -% For @indicateurl, @env, @command quotes seem unnecessary, so use \code. -\let\indicateurl=\code -\let\env=\code -\let\command=\code - -% @clicksequence{File @click{} Open ...} -\def\clicksequence#1{\begingroup #1\endgroup} - -% @clickstyle @arrow (by default) -\parseargdef\clickstyle{\def\click{#1}} -\def\click{\arrow} - % @uref (abbreviation for `urlref') takes an optional (comma-separated) % second argument specifying the text to display and an optional third % arg as text to display instead of (rather than in addition to) the url -% itself. First (mandatory) arg is the url. Perhaps eventually put in -% a hypertex \special here. -% -\def\uref#1{\douref #1,,,\finish} -\def\douref#1,#2,#3,#4\finish{\begingroup +% itself. First (mandatory) arg is the url. +% (This \urefnobreak definition isn't used now, leaving it for a while +% for comparison.) +\def\urefnobreak#1{\dourefnobreak #1,,,\finish} +\def\dourefnobreak#1,#2,#3,#4\finish{\begingroup \unsepspaces \pdfurl{#1}% \setbox0 = \hbox{\ignorespaces #3}% @@ -2636,7 +2559,11 @@ end \endlink \endgroup} -\def\nouref#1,#2,#3,#4\finish{\begingroup % doesn't work in @example +% This \urefbreak definition is the active one. +\def\urefbreak{\begingroup \urefcatcodes \dourefbreak} +\let\uref=\urefbreak +\def\dourefbreak#1{\urefbreakfinish #1,,,\finish} +\def\urefbreakfinish#1,#2,#3,#4\finish{% doesn't work in @example \unsepspaces \pdfurl{#1}% \setbox0 = \hbox{\ignorespaces #3}% @@ -2648,18 +2575,87 @@ end \ifpdf \unhbox0 % PDF: 2nd arg given, show only it \else - % \empty at the end of \scantokens arg gets rid of - % trailing newline (and ultimate spurious whitespace). - \unhbox0\ (\urefcode{\scantokens{#1\empty}})% DVI: 2nd arg given, - % show both it and url + \unhbox0\ (\urefcode{#1})% DVI: 2nd arg given, show both it and url \fi \else - \urefcode{\scantokens{#1\empty}}% only url given, so show it + \urefcode{#1}% only url given, so show it \fi \fi \endlink \endgroup} +% Allow line breaks around only a few characters (only). +\def\urefcatcodes{% + \catcode\ampChar=\active \catcode\dotChar=\active + \catcode\hashChar=\active \catcode\questChar=\active + \catcode\slashChar=\active +} +{ + \urefcatcodes + % + \global\def\urefcode{\begingroup + \setupmarkupstyle{code}% + \urefcatcodes + \let&\urefcodeamp + \let.\urefcodedot + \let#\urefcodehash + \let?\urefcodequest + \let/\urefcodeslash + \codex + } + % + % By default, they are just regular characters. + \global\def&{\normalamp} + \global\def.{\normaldot} + \global\def#{\normalhash} + \global\def?{\normalquest} + \global\def/{\normalslash} +} + +% we put a little stretch before and after the breakable chars, to help +% line breaking of long url's. The unequal skips make look better in +% cmtt at least, especially for dots. +\def\urefprestretch{\urefprebreak \hskip0pt plus.13em } +\def\urefpoststretch{\urefpostbreak \hskip0pt plus.1em } +% +\def\urefcodeamp{\urefprestretch \&\urefpoststretch} +\def\urefcodedot{\urefprestretch .\urefpoststretch} +\def\urefcodehash{\urefprestretch \#\urefpoststretch} +\def\urefcodequest{\urefprestretch ?\urefpoststretch} +\def\urefcodeslash{\futurelet\next\urefcodeslashfinish} +{ + \catcode`\/=\active + \global\def\urefcodeslashfinish{% + \urefprestretch \slashChar + % Allow line break only after the final / in a sequence of + % slashes, to avoid line break between the slashes in http://. + \ifx\next/\else \urefpoststretch \fi + } +} + +% One more complication: by default we'll break after the special +% characters, but some people like to break before the special chars, so +% allow that. Also allow no breaking at all, for manual control. +% +\parseargdef\urefbreakstyle{% + \def\txiarg{#1}% + \ifx\txiarg\wordnone + \def\urefprebreak{\nobreak}\def\urefpostbreak{\nobreak} + \else\ifx\txiarg\wordbefore + \def\urefprebreak{\allowbreak}\def\urefpostbreak{\nobreak} + \else\ifx\txiarg\wordafter + \def\urefprebreak{\nobreak}\def\urefpostbreak{\allowbreak} + \else + \errhelp = \EMsimple + \errmessage{Unknown @urefbreakstyle setting `\txiarg'}% + \fi\fi\fi +} +\def\wordafter{after} +\def\wordbefore{before} +\def\wordnone{none} + +\urefbreakstyle after + % @url synonym for @uref, since that's how everyone uses it. % \let\url=\uref @@ -2681,6 +2677,51 @@ end \let\email=\uref \fi +% @kbd is like @code, except that if the argument is just one @key command, +% then @kbd has no effect. +\def\kbd#1{{\setupmarkupstyle{kbd}\def\look{#1}\expandafter\kbdfoo\look??\par}} + +% @kbdinputstyle -- arg is `distinct' (@kbd uses slanted tty font always), +% `example' (@kbd uses ttsl only inside of @example and friends), +% or `code' (@kbd uses normal tty font always). +\parseargdef\kbdinputstyle{% + \def\txiarg{#1}% + \ifx\txiarg\worddistinct + \gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\ttsl}% + \else\ifx\txiarg\wordexample + \gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\tt}% + \else\ifx\txiarg\wordcode + \gdef\kbdexamplefont{\tt}\gdef\kbdfont{\tt}% + \else + \errhelp = \EMsimple + \errmessage{Unknown @kbdinputstyle setting `\txiarg'}% + \fi\fi\fi +} +\def\worddistinct{distinct} +\def\wordexample{example} +\def\wordcode{code} + +% Default is `distinct'. +\kbdinputstyle distinct + +\def\xkey{\key} +\def\kbdfoo#1#2#3\par{\def\one{#1}\def\three{#3}\def\threex{??}% +\ifx\one\xkey\ifx\threex\three \key{#2}% +\else{\tclose{\kbdfont\setupmarkupstyle{kbd}\look}}\fi +\else{\tclose{\kbdfont\setupmarkupstyle{kbd}\look}}\fi} + +% For @indicateurl, @env, @command quotes seem unnecessary, so use \code. +\let\indicateurl=\code +\let\env=\code +\let\command=\code + +% @clicksequence{File @click{} Open ...} +\def\clicksequence#1{\begingroup #1\endgroup} + +% @clickstyle @arrow (by default) +\parseargdef\clickstyle{\def\click{#1}} +\def\click{\arrow} + % Typeset a dimension, e.g., `in' or `pt'. The only reason for the % argument is to make the input look right: @dmn{pt} instead of @dmn{}pt. % @@ -5677,6 +5718,8 @@ end % \def\sectionheading#1#2#3#4{% {% + \checkenv{}% should not be in an environment. + % % Switch to the right set of fonts. \csname #2fonts\endcsname \rmisbold % @@ -9305,24 +9348,15 @@ directory should work if nowhere else does.} \catcode`\^^? = 14 % Define macros to output various characters with catcode for normal text. -\catcode`\"=\other -\catcode`\~=\other -\catcode`\^=\other -\catcode`\_=\other -\catcode`\|=\other -\catcode`\<=\other -\catcode`\>=\other -\catcode`\+=\other -\catcode`\$=\other -\def\normaldoublequote{"} -\def\normaltilde{~} -\def\normalcaret{^} -\def\normalunderscore{_} -\def\normalverticalbar{|} -\def\normalless{<} -\def\normalgreater{>} -\def\normalplus{+} -\def\normaldollar{$}%$ font-lock fix +\catcode`\"=\other \def\normaldoublequote{"} +\catcode`\$=\other \def\normaldollar{$}%$ font-lock fix +\catcode`\+=\other \def\normalplus{+} +\catcode`\<=\other \def\normalless{<} +\catcode`\>=\other \def\normalgreater{>} +\catcode`\^=\other \def\normalcaret{^} +\catcode`\_=\other \def\normalunderscore{_} +\catcode`\|=\other \def\normalverticalbar{|} +\catcode`\~=\other \def\normaltilde{~} % This macro is used to make a character print one way in \tt % (where it can probably be output as-is), and another way in other fonts, @@ -9415,16 +9449,16 @@ directory should work if nowhere else does.} % the literal character `\'. % @def@normalturnoffactive{% - @let\=@normalbackslash @let"=@normaldoublequote - @let~=@normaltilde + @let$=@normaldollar %$ font-lock fix + @let+=@normalplus + @let<=@normalless + @let>=@normalgreater + @let\=@normalbackslash @let^=@normalcaret @let_=@normalunderscore @let|=@normalverticalbar - @let<=@normalless - @let>=@normalgreater - @let+=@normalplus - @let$=@normaldollar %$ font-lock fix + @let~=@normaltilde @markupsetuplqdefault @markupsetuprqdefault @unsepspaces @@ -9456,10 +9490,16 @@ directory should work if nowhere else does.} % Say @foo, not \foo, in error messages. @escapechar = `@@ +% These (along with & and #) are made active for url-breaking, so need +% active definitions as the normal characters. +@def@normaldot{.} +@def@normalquest{?} +@def@normalslash{/} + % These look ok in all fonts, so just make them not special. -@catcode`@& = @other -@catcode`@# = @other -@catcode`@% = @other +@catcode`@& = @other @def@normalamp{&} +@catcode`@# = @other @def@normalhash{#} +@catcode`@% = @other @def@normalpercent{%} @c Finally, make ` and ' active, so that txicodequoteundirected and @c txicodequotebacktick work right in, e.g., @w{@code{`foo'}}. If we diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 6095d83d484..346354b3170 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -54,7 +54,7 @@ supports it in developing GNU and promoting software freedom.'' @end copying @c Entries for @command{install-info} to use -@dircategory @value{emacsname} +@dircategory @value{emacsname} network features @direntry * TRAMP: (tramp). Transparent Remote Access, Multiple Protocol @value{emacsname} remote file access via rsh and rcp. @@ -443,9 +443,6 @@ Support of gateways exists since April 2007. @ifset emacsgvfs GVFS integration started in February 2009. @end ifset -@ifset emacsimap -Storing files into IMAP mailboxes has been added in September 2009. -@end ifset In December 2001, @value{tramp} has been added to the XEmacs package repository. Being part of the GNU Emacs repository happened in June @@ -1012,29 +1009,6 @@ Windows, this method isn't available. Instead, you can use UNC file names like @file{//melancholia/daniel$$/.emacs}. The only disadvantage is that there's no possibility to specify another user name. - - -@ifset emacsimap -@item @option{imap} -@cindex method imap -@cindex method imaps -@cindex imap method -@cindex imaps method - -Accessing an IMAP mailbox is intended to save files there as encrypted -messages. It could be used in case there are no other remote file -storages available. - -@value{tramp} supports both @option{imap} and @option{imaps} methods. -The latter one accesses the IMAP server over ssl. - -Both methods support the port number specification. - -Note that special handling is needed for declaring a passphrase for -encryption / decryption of the messages (@pxref{Using an -authentication file}). - -@end ifset @end table @@ -1625,18 +1599,6 @@ The port can be any @value{tramp} method (@pxref{Inline methods}, @pxref{External methods}), to match only this method. When you omit the port, you match all @value{tramp} methods. -@ifset emacsimap -A special case are @option{imap}-like methods. Authentication with -the IMAP server is performed via @file{imap.el}, there is no special -need from @value{tramp} point of view. An additional passphrase, used -for symmetric encryption and decryption of the stored messages, should -be given with the special port indication @option{tramp-imap}: - -@example -machine melancholia port tramp-imap login daniel password ultrageheim -@end example -@end ifset - @anchor{Caching passwords} @subsection Caching passwords @@ -2782,9 +2744,9 @@ The package has been used successfully on GNU Emacs 22, GNU Emacs 23, XEmacs 21 (starting with 21.4), and SXEmacs 22. The package was intended to work on Unix, and it really expects a -Unix-like system on the remote end (except the @option{smb} and -@option{imap} methods), but some people seemed to have some success -getting it to work on MS Windows XP/Vista/7 @value{emacsname}. +Unix-like system on the remote end (except the @option{smb} method), +but some people seemed to have some success getting it to work on MS +Windows XP/Vista/7 @value{emacsname}. @item diff --git a/doc/misc/trampver.texi b/doc/misc/trampver.texi index c3e767bd228..ff5641fb4b4 100644 --- a/doc/misc/trampver.texi +++ b/doc/misc/trampver.texi @@ -28,11 +28,6 @@ @set emacsgw @end ifclear -@c Whether or not describe IMAP support. -@ifclear noemacsimap -@set emacsimap -@end ifclear - @c Some flags which make the text independent on the (X)Emacs flavor. @c "emacs" resp "xemacs" are set in the Makefile. Default is "emacs". @ifclear emacs @@ -43,7 +38,7 @@ @c Emacs values. @ifset emacs -@set emacsname GNU Emacs +@set emacsname Emacs @set emacsdir emacs @set ftppackagename Ange-FTP @set prefix / diff --git a/doc/misc/url.texi b/doc/misc/url.texi index 5bfa96ec673..2bde54a8dea 100644 --- a/doc/misc/url.texi +++ b/doc/misc/url.texi @@ -12,8 +12,7 @@ \overfullrule=0pt %\global\baselineskip 30pt % for printing in double space @end tex -@dircategory World Wide Web -@dircategory Emacs +@dircategory Emacs lisp libraries @direntry * URL: (url). URL loading package. @end direntry diff --git a/doc/misc/vip.texi b/doc/misc/vip.texi index fe1098c49ff..03ca65882e5 100644 --- a/doc/misc/vip.texi +++ b/doc/misc/vip.texi @@ -35,7 +35,7 @@ developing GNU and promoting software freedom.'' @finalout @contents -@dircategory Emacs +@dircategory Emacs misc features @direntry * VIP: (vip). An older VI-emulation for Emacs. @end direntry diff --git a/doc/misc/viper.texi b/doc/misc/viper.texi index 9e55e08242f..1f0dffee5b4 100644 --- a/doc/misc/viper.texi +++ b/doc/misc/viper.texi @@ -23,7 +23,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs misc features @direntry * VIPER: (viper). The newest Emacs VI-emulation mode. (also, A VI Plan for Emacs Rescue diff --git a/doc/misc/widget.texi b/doc/misc/widget.texi index 667dab55221..c4f5317e5a7 100644 --- a/doc/misc/widget.texi +++ b/doc/misc/widget.texi @@ -24,7 +24,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs lisp libraries @direntry * Widget: (widget). The "widget" package used by the Emacs Customization facility. diff --git a/doc/misc/woman.texi b/doc/misc/woman.texi index 9f77a077703..c869d1a46c7 100644 --- a/doc/misc/woman.texi +++ b/doc/misc/woman.texi @@ -34,7 +34,7 @@ developing GNU and promoting software freedom.'' @end quotation @end copying -@dircategory Emacs +@dircategory Emacs misc features @direntry * WoMan: (woman). Browse UN*X Manual Pages "W.O. (without) Man". @end direntry diff --git a/etc/ChangeLog b/etc/ChangeLog index 45dfb211bb0..74787c3de3b 100644 --- a/etc/ChangeLog +++ b/etc/ChangeLog @@ -1,3 +1,37 @@ +2011-02-21 Chong Yidong <cyd@stupidchicken.com> + + * themes/tango-dark-theme.el: Tweak background on low-color + terminals. + +2011-02-17 Ken Manheimer <ken.manheimer@gmail.com> + + * etc/images/icons/allout-widgets/dark-bg, + etc/images/icons/allout-widgets/light-bg, + encrypted-locked.{xpm,png}, unlocked-encrypted.{xpm,png}: + Reorganize icon directories and files to reconcile against windows + short-filename clashes. + +2011-02-16 Ken Manheimer <ken.manheimer@gmail.com> + + * etc/images/icons/allout-widgets-dark-bg, + etc/images/icons/allout-widgets-light-bg: Icons for new + allout-widgets.el. + + * etc/images/icons/README: Include coypright and GPL 3 license for + new icons. + +2011-02-16 Michael Albinus <michael.albinus@gmx.de> + + * NEWS: Add soap-client.el and soap-inspect.el. + +2011-02-13 Michael Albinus <michael.albinus@gmx.de> + + * NEWS: Tramp methods "imap" and "imaps" are discontinued. + +2011-02-12 Drew Adams <drew.adams@oracle.com> + + * themes/light-blue-theme.el: New file. + 2011-02-01 Paul Eggert <eggert@cs.ucla.edu> format-time-string now supports subsecond time stamp resolution @@ -382,7 +416,7 @@ * srecode/doc-default.srt (section-comment, function-comment) (variable-same-line-comment, group-comment-start, group-comment-end): * srecode/doc-java.srt (function-comment, variable-same-line-comment) - (group-comment-start, gropu-comment-end): + (group-comment-start, group-comment-end): Fix typos in template docstrings. 2010-01-14 Kenichi Handa <handa@m17n.org> @@ -137,9 +137,8 @@ theme when Emacs is built with GTK. off by customizing x-gtk-use-system-tooltips. ** Lucid menus and dialogs can display antialiased fonts if Emacs is built -with Xft. To change font, use X resource faceName, for example: -Emacs.pane.menubar.faceName: Courier-12 -Set faceName to none and use font to use the old X fonts. +with Xft. To change font, use the X resource font, for example: +Emacs.pane.menubar.font: Courier-12 +++ ** Enhanced support for characters that have no glyphs in available fonts @@ -588,7 +587,7 @@ on a D-Bus without simultaneously registering a property or a method. *** There exists a new inline access method "ksu" (kerberized su). *** The following access methods are discontinued: "ssh1_old", -"ssh2_old", "scp1_old", "scp2_old" and "fish". +"ssh2_old", "scp1_old", "scp2_old", "imap", "imaps" and "fish". ** VC and related modes @@ -606,7 +605,17 @@ The vc-merge command now runs a "merge" operation, if it is supported. This merges another branch into the current one. This command prompts the user for specifics, e.g. a merge source. -**** Currently supported by Bzr, Git, and Mercurial. +**** Currently supported for Bzr, Git, and Mercurial. + +*** Log entries in some Log View buffers can be toggled to display a +longer description by typing RET (log-view-toggle-entry-display). +In the Log View buffers made by `C-x v L' (vc-print-root-log), you can +use this to display the full log entry for the revision at point. + +**** Currently supported for Bzr, Git, and Mercurial. + +**** Packages using Log View mode can enable this functionality by +binding `log-view-expanded-log-entry-function' to a suitable function. ** Miscellaneous @@ -630,9 +639,17 @@ secrets. ** notifications.el provides an implementation of the Desktop Notifications API. It requires D-Bus for communication. +** soap-client.el supports access to SOAP web services from Emacs. +soap-inspect.el is an interactive inspector for SOAP WSDL structures. + * Incompatible Lisp Changes in Emacs 24.1 +** `copy-directory' now copies the source directory as a subdirectory +of the target directory, if the latter is an existing directory. The +new optional arg COPY-CONTENTS, if non-nil, makes the function copy +the contents directly into a pre-existing target directory. + ** `compose-mail' now accepts an optional 8th arg, RETURN-ACTION, and passes it to the mail user agent function. This argument specifies an action for returning to the caller after finishing with the mail. diff --git a/etc/images/icons/README b/etc/images/icons/README index 7855f401bb1..b11b88781e8 100644 --- a/etc/images/icons/README +++ b/etc/images/icons/README @@ -15,3 +15,52 @@ Files: hicolor/16x16/apps/emacs22.png hicolor/24x24/apps/emacs22.png Author: Andrew Zhilin <andrew_zhilin@yahoo.com> Copyright (C) 2005-2011 Free Software Foundation, Inc. License: GNU General Public License version 3 or later (see COPYING) + +Files: allout-widgets-dark-bg/closed.png + allout-widgets-dark-bg/closed.xpm + allout-widgets-dark-bg/empty.png + allout-widgets-dark-bg/empty.xpm + allout-widgets-dark-bg/encrypted-locked.png + allout-widgets-dark-bg/encrypted-locked.xpm + allout-widgets-dark-bg/encrypted-unlocked.png + allout-widgets-dark-bg/encrypted-unlocked.xpm + allout-widgets-dark-bg/end-connector.png + allout-widgets-dark-bg/end-connector.xpm + allout-widgets-dark-bg/extender-connector.png + allout-widgets-dark-bg/extender-connector.xpm + allout-widgets-dark-bg/leaf.png + allout-widgets-dark-bg/leaf.xpm + allout-widgets-dark-bg/mid-connector.png + allout-widgets-dark-bg/mid-connector.xpm + allout-widgets-dark-bg/opened.png + allout-widgets-dark-bg/opened.xpm + allout-widgets-dark-bg/skip-descender.png + allout-widgets-dark-bg/skip-descender.xpm + allout-widgets-dark-bg/through-descender.png + allout-widgets-dark-bg/through-descender.xpm + allout-widgets-light-bg/closed.png + allout-widgets-light-bg/closed.xpm + allout-widgets-light-bg/empty.png + allout-widgets-light-bg/empty.xpm + allout-widgets-light-bg/encrypted-locked.png + allout-widgets-light-bg/encrypted-locked.xpm + allout-widgets-light-bg/encrypted-unlocked.png + allout-widgets-light-bg/encrypted-unlocked.xpm + allout-widgets-light-bg/end-connector.png + allout-widgets-light-bg/end-connector.xpm + allout-widgets-light-bg/extender-connector.png + allout-widgets-light-bg/extender-connector.xpm + allout-widgets-light-bg/leaf.png + allout-widgets-light-bg/leaf.xpm + allout-widgets-light-bg/mid-connector.png + allout-widgets-light-bg/mid-connector.xpm + allout-widgets-light-bg/opened.png + allout-widgets-light-bg/opened.xpm + allout-widgets-light-bg/skip-descender.png + allout-widgets-light-bg/skip-descender.xpm + allout-widgets-light-bg/through-descender.png + allout-widgets-light-bg/through-descender.xpm + +Author: Ken Manheimer <ken.manheimer@gmail.com> +Copyright (C) 2011 Free Software Foundation, Inc. +License: GNU General Public License version 3 or later (see COPYING) diff --git a/etc/images/icons/allout-widgets/dark-bg/closed.png b/etc/images/icons/allout-widgets/dark-bg/closed.png Binary files differnew file mode 100644 index 00000000000..b49fd4ad6c9 --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/closed.png diff --git a/etc/images/icons/allout-widgets/dark-bg/closed.xpm b/etc/images/icons/allout-widgets/dark-bg/closed.xpm new file mode 100644 index 00000000000..4d7bbebe21c --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/closed.xpm @@ -0,0 +1,30 @@ +/* XPM */ +static char *dummy[]={ +"9 17 10 1", +". c None", +"# c #000080", +"h c #52a55a", +"g c #52ad52", +"e c #5ab54a", +"d c #5abd42", +"c c #63c639", +"b c #63ce31", +"f c #ada5c6", +"a c #ffff00", +".........", +".........", +".........", +"######...", +"aaaaaa#..", +".bbcdaa#.", +".###deaa#", +"..ff##gaa", +"fffff##ha", +"..ff##haa", +".###ghaa#", +".eeggaa#.", +"aaaaaa#..", +"######...", +".........", +".........", +"........."}; diff --git a/etc/images/icons/allout-widgets/dark-bg/empty.png b/etc/images/icons/allout-widgets/dark-bg/empty.png Binary files differnew file mode 100644 index 00000000000..b9675fdb9ba --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/empty.png diff --git a/etc/images/icons/allout-widgets/dark-bg/empty.xpm b/etc/images/icons/allout-widgets/dark-bg/empty.xpm new file mode 100644 index 00000000000..e0fc8e5701f --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/empty.xpm @@ -0,0 +1,29 @@ +/* XPM */ +static char *dummy[]={ +"10 17 9 1", +". c None", +"# c #000080", +"f c #52a55a", +"g c #52ad52", +"d c #5abd42", +"b c #63c639", +"c c #6bd629", +"e c #ada5c6", +"a c #ffff00", +"..........", +"..........", +"..........", +"...######.", +"..#aaaaaa.", +".#aabbbb..", +"#aabc###..", +"aad##ee...", +"adeeeee...", +"aad##ee...", +"#aafg###..", +".#aabbbb..", +"..#aaaaaa.", +"...######.", +"..........", +"..........", +".........."}; diff --git a/etc/images/icons/allout-widgets/dark-bg/end-connector.png b/etc/images/icons/allout-widgets/dark-bg/end-connector.png Binary files differnew file mode 100644 index 00000000000..696c17ea9a9 --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/end-connector.png diff --git a/etc/images/icons/allout-widgets/dark-bg/end-connector.xpm b/etc/images/icons/allout-widgets/dark-bg/end-connector.xpm new file mode 100644 index 00000000000..511d3a4015c --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/end-connector.xpm @@ -0,0 +1,22 @@ +/* XPM */ +static char *dummy[]={ +"11 17 2 1", +". c None", +"# c #ada5c6", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....##.....", +".....######", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"..........."}; diff --git a/etc/images/icons/allout-widgets/dark-bg/extender-connector.png b/etc/images/icons/allout-widgets/dark-bg/extender-connector.png Binary files differnew file mode 100644 index 00000000000..8559f4884d0 --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/extender-connector.png diff --git a/etc/images/icons/allout-widgets/dark-bg/extender-connector.xpm b/etc/images/icons/allout-widgets/dark-bg/extender-connector.xpm new file mode 100644 index 00000000000..cd9ecc4c5f2 --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/extender-connector.xpm @@ -0,0 +1,22 @@ +/* XPM */ +static char *dummy[]={ +"11 17 2 1", +". c None", +"# c #ada5c6", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"###########", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"..........."}; diff --git a/etc/images/icons/allout-widgets/dark-bg/leaf.png b/etc/images/icons/allout-widgets/dark-bg/leaf.png Binary files differnew file mode 100644 index 00000000000..e2d7b189e84 --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/leaf.png diff --git a/etc/images/icons/allout-widgets/dark-bg/leaf.xpm b/etc/images/icons/allout-widgets/dark-bg/leaf.xpm new file mode 100644 index 00000000000..f25bf40a258 --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/leaf.xpm @@ -0,0 +1,33 @@ +/* XPM */ +static char *dummy[]={ +"16 21 9 1", +". c None", +"a c #737373", +"b c #7b7b7b", +"# c #808080", +"c c #848484", +"d c #8c8c8c", +"e c #949494", +"f c #9c9c9c", +"g c #a5a5a5", +"................", +"................", +"................", +"................", +"................", +"................", +"...#####........", +"..#abbcc#.......", +".#abbccdd#......", +"#abbccddee#.....", +"#bbccddeef#.....", +"#bccddeefg#.....", +".#cddeefg#......", +"..#deefg#.......", +"...#####........", +"................", +"................", +"................", +"................", +"................", +"................"}; diff --git a/etc/images/icons/allout-widgets/dark-bg/locked-encrypted.png b/etc/images/icons/allout-widgets/dark-bg/locked-encrypted.png Binary files differnew file mode 100644 index 00000000000..a6bc3e99a7a --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/locked-encrypted.png diff --git a/etc/images/icons/allout-widgets/dark-bg/locked-encrypted.xpm b/etc/images/icons/allout-widgets/dark-bg/locked-encrypted.xpm new file mode 100644 index 00000000000..bf7556f2ed9 --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/locked-encrypted.xpm @@ -0,0 +1,26 @@ +/* XPM */ +static char *dummy[]={ +"10 17 6 1", +". c None", +"b c #333300", +"# c #666600", +"d c #808080", +"c c #999933", +"a c #999966", +"..........", +"..........", +"..........", +"..........", +"...##a#...", +"..aaaaaa..", +".aa....##.", +".ab....a#.", +".cb....#b.", +"caaaaaaacb", +"cddddddddb", +"adaddddddb", +"adaddddddb", +"caadddddab", +"addddddddb", +"bbbbbbbbbb", +".........."}; diff --git a/etc/images/icons/allout-widgets/dark-bg/mid-connector.png b/etc/images/icons/allout-widgets/dark-bg/mid-connector.png Binary files differnew file mode 100644 index 00000000000..5ad503ed54d --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/mid-connector.png diff --git a/etc/images/icons/allout-widgets/dark-bg/mid-connector.xpm b/etc/images/icons/allout-widgets/dark-bg/mid-connector.xpm new file mode 100644 index 00000000000..b583988a220 --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/mid-connector.xpm @@ -0,0 +1,22 @@ +/* XPM */ +static char *dummy[]={ +"11 17 2 1", +". c None", +"# c #ada5c6", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....##.....", +"....#.#####", +"....##.....", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......"}; diff --git a/etc/images/icons/allout-widgets/dark-bg/opened.png b/etc/images/icons/allout-widgets/dark-bg/opened.png Binary files differnew file mode 100644 index 00000000000..5d91d6e8d6d --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/opened.png diff --git a/etc/images/icons/allout-widgets/dark-bg/opened.xpm b/etc/images/icons/allout-widgets/dark-bg/opened.xpm new file mode 100644 index 00000000000..e86fd9ecf7e --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/opened.xpm @@ -0,0 +1,25 @@ +/* XPM */ +static char *dummy[]={ +"10 17 5 1", +". c None", +"a c #000080", +"b c #63c639", +"c c #ada5c6", +"# c #ffff00", +"..........", +"..........", +"..........", +"..........", +"#.......#a", +"#ba...ab#a", +"#ba...ab#a", +"#bccccab#a", +"#bacccab#a", +"#bbacabb#a", +"##bacab##a", +"a##bbb##a.", +".a#####a..", +"..a###a...", +"...a#a....", +"....c.....", +"....c....."}; diff --git a/etc/images/icons/allout-widgets/dark-bg/skip-descender.png b/etc/images/icons/allout-widgets/dark-bg/skip-descender.png Binary files differnew file mode 100644 index 00000000000..6e3cb00160f --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/skip-descender.png diff --git a/etc/images/icons/allout-widgets/dark-bg/skip-descender.xpm b/etc/images/icons/allout-widgets/dark-bg/skip-descender.xpm new file mode 100644 index 00000000000..26ae40d57d5 --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/skip-descender.xpm @@ -0,0 +1,21 @@ +/* XPM */ +static char *dummy[]={ +"11 17 1 1", +". c None", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"..........."}; diff --git a/etc/images/icons/allout-widgets/dark-bg/through-descender.png b/etc/images/icons/allout-widgets/dark-bg/through-descender.png Binary files differnew file mode 100644 index 00000000000..93410e03340 --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/through-descender.png diff --git a/etc/images/icons/allout-widgets/dark-bg/through-descender.xpm b/etc/images/icons/allout-widgets/dark-bg/through-descender.xpm new file mode 100644 index 00000000000..7f375b4fd6c --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/through-descender.xpm @@ -0,0 +1,22 @@ +/* XPM */ +static char *dummy[]={ +"11 17 2 1", +". c None", +"# c #ada5c6", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......"}; diff --git a/etc/images/icons/allout-widgets/dark-bg/unlocked-encrypted.png b/etc/images/icons/allout-widgets/dark-bg/unlocked-encrypted.png Binary files differnew file mode 100644 index 00000000000..e70d075690a --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/unlocked-encrypted.png diff --git a/etc/images/icons/allout-widgets/dark-bg/unlocked-encrypted.xpm b/etc/images/icons/allout-widgets/dark-bg/unlocked-encrypted.xpm new file mode 100644 index 00000000000..2baa1e81211 --- /dev/null +++ b/etc/images/icons/allout-widgets/dark-bg/unlocked-encrypted.xpm @@ -0,0 +1,26 @@ +/* XPM */ +static char *dummy[]={ +"10 17 6 1", +". c None", +"c c #333300", +"a c #666600", +"b c #999933", +"# c #999966", +"d c #ffff00", +"..........", +"..........", +"..........", +"...####...", +"..#a#a###.", +"..a#...##.", +".a#.....#.", +".##.......", +"..##......", +"b###c###bc", +"bddddddddc", +"#d#ddddddc", +"#d#ddddddc", +"b##ddddd#c", +"#ddddddddc", +"cccccccccc", +".........."}; diff --git a/etc/images/icons/allout-widgets/light-bg/closed.png b/etc/images/icons/allout-widgets/light-bg/closed.png Binary files differnew file mode 100644 index 00000000000..591a11adbb0 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/closed.png diff --git a/etc/images/icons/allout-widgets/light-bg/closed.xpm b/etc/images/icons/allout-widgets/light-bg/closed.xpm new file mode 100644 index 00000000000..20710b42822 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/closed.xpm @@ -0,0 +1,24 @@ +/* XPM */ +static char *dummy[]={ +"9 17 4 1", +". c None", +"# c #00ff00", +"b c #00ffff", +"a c #606060", +".........", +".........", +".........", +"######...", +"aaaaaa#..", +".bbbbaa#.", +"....bbaa#", +"..aa..baa", +"aaaaa..ba", +"..aa..baa", +"....bbaa#", +".bbbbaa#.", +"aaaaaa#..", +"######...", +".........", +".........", +"........."}; diff --git a/etc/images/icons/allout-widgets/light-bg/empty.png b/etc/images/icons/allout-widgets/light-bg/empty.png Binary files differnew file mode 100644 index 00000000000..1c02d26ea41 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/empty.png diff --git a/etc/images/icons/allout-widgets/light-bg/empty.xpm b/etc/images/icons/allout-widgets/light-bg/empty.xpm new file mode 100644 index 00000000000..0ed70256f3e --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/empty.xpm @@ -0,0 +1,24 @@ +/* XPM */ +static char *dummy[]={ +"10 17 4 1", +". c None", +"# c #00ff00", +"b c #00ffff", +"a c #606060", +"..........", +"..........", +"..........", +"...######.", +"..#aaaaaa.", +".#aabbbb..", +"#aabb.....", +"aab..aa...", +"abaaaaa...", +"aab..aa...", +"#aabb.....", +".#aabbbb..", +"..#aaaaaa.", +"...######.", +"..........", +"..........", +".........."}; diff --git a/etc/images/icons/allout-widgets/light-bg/end-connector.png b/etc/images/icons/allout-widgets/light-bg/end-connector.png Binary files differnew file mode 100644 index 00000000000..b865b40bfeb --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/end-connector.png diff --git a/etc/images/icons/allout-widgets/light-bg/end-connector.xpm b/etc/images/icons/allout-widgets/light-bg/end-connector.xpm new file mode 100644 index 00000000000..0c9c1c7820d --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/end-connector.xpm @@ -0,0 +1,22 @@ +/* XPM */ +static char *dummy[]={ +"11 17 2 1", +". c None", +"# c #606060", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....##.....", +".....######", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"..........."}; diff --git a/etc/images/icons/allout-widgets/light-bg/extender-connector.png b/etc/images/icons/allout-widgets/light-bg/extender-connector.png Binary files differnew file mode 100644 index 00000000000..4023a456776 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/extender-connector.png diff --git a/etc/images/icons/allout-widgets/light-bg/extender-connector.xpm b/etc/images/icons/allout-widgets/light-bg/extender-connector.xpm new file mode 100644 index 00000000000..36ea8f93093 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/extender-connector.xpm @@ -0,0 +1,22 @@ +/* XPM */ +static char *dummy[]={ +"11 17 2 1", +". c None", +"# c #606060", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"###########", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"..........."}; diff --git a/etc/images/icons/allout-widgets/light-bg/leaf.png b/etc/images/icons/allout-widgets/light-bg/leaf.png Binary files differnew file mode 100755 index 00000000000..e2d7b189e84 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/leaf.png diff --git a/etc/images/icons/allout-widgets/light-bg/leaf.xpm b/etc/images/icons/allout-widgets/light-bg/leaf.xpm new file mode 100755 index 00000000000..f25bf40a258 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/leaf.xpm @@ -0,0 +1,33 @@ +/* XPM */ +static char *dummy[]={ +"16 21 9 1", +". c None", +"a c #737373", +"b c #7b7b7b", +"# c #808080", +"c c #848484", +"d c #8c8c8c", +"e c #949494", +"f c #9c9c9c", +"g c #a5a5a5", +"................", +"................", +"................", +"................", +"................", +"................", +"...#####........", +"..#abbcc#.......", +".#abbccdd#......", +"#abbccddee#.....", +"#bbccddeef#.....", +"#bccddeefg#.....", +".#cddeefg#......", +"..#deefg#.......", +"...#####........", +"................", +"................", +"................", +"................", +"................", +"................"}; diff --git a/etc/images/icons/allout-widgets/light-bg/locked-encrypted.png b/etc/images/icons/allout-widgets/light-bg/locked-encrypted.png Binary files differnew file mode 100755 index 00000000000..a6bc3e99a7a --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/locked-encrypted.png diff --git a/etc/images/icons/allout-widgets/light-bg/locked-encrypted.xpm b/etc/images/icons/allout-widgets/light-bg/locked-encrypted.xpm new file mode 100644 index 00000000000..bf7556f2ed9 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/locked-encrypted.xpm @@ -0,0 +1,26 @@ +/* XPM */ +static char *dummy[]={ +"10 17 6 1", +". c None", +"b c #333300", +"# c #666600", +"d c #808080", +"c c #999933", +"a c #999966", +"..........", +"..........", +"..........", +"..........", +"...##a#...", +"..aaaaaa..", +".aa....##.", +".ab....a#.", +".cb....#b.", +"caaaaaaacb", +"cddddddddb", +"adaddddddb", +"adaddddddb", +"caadddddab", +"addddddddb", +"bbbbbbbbbb", +".........."}; diff --git a/etc/images/icons/allout-widgets/light-bg/mid-connector.png b/etc/images/icons/allout-widgets/light-bg/mid-connector.png Binary files differnew file mode 100644 index 00000000000..658f340ca80 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/mid-connector.png diff --git a/etc/images/icons/allout-widgets/light-bg/mid-connector.xpm b/etc/images/icons/allout-widgets/light-bg/mid-connector.xpm new file mode 100644 index 00000000000..d86f1645c03 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/mid-connector.xpm @@ -0,0 +1,22 @@ +/* XPM */ +static char *dummy[]={ +"11 17 2 1", +". c None", +"# c #606060", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....##.....", +"....#.#####", +"....##.....", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......"}; diff --git a/etc/images/icons/allout-widgets/light-bg/opened.png b/etc/images/icons/allout-widgets/light-bg/opened.png Binary files differnew file mode 100644 index 00000000000..2a77830c175 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/opened.png diff --git a/etc/images/icons/allout-widgets/light-bg/opened.xpm b/etc/images/icons/allout-widgets/light-bg/opened.xpm new file mode 100644 index 00000000000..ce3e98fea4b --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/opened.xpm @@ -0,0 +1,24 @@ +/* XPM */ +static char *dummy[]={ +"10 17 4 1", +". c None", +"a c #00ff00", +"b c #00ffff", +"# c #606060", +"..........", +"..........", +"..........", +"..........", +"#.......#a", +"#b.....b#a", +"#b.....b#a", +"#b####.b#a", +"#b.###.b#a", +"#bb.#.bb#a", +"##b.#.b##a", +"a##b#b##a.", +".a##b##a..", +"..a###a...", +"...a#a....", +"....#.....", +"....#....."}; diff --git a/etc/images/icons/allout-widgets/light-bg/skip-descender.png b/etc/images/icons/allout-widgets/light-bg/skip-descender.png Binary files differnew file mode 100644 index 00000000000..6e3cb00160f --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/skip-descender.png diff --git a/etc/images/icons/allout-widgets/light-bg/skip-descender.xpm b/etc/images/icons/allout-widgets/light-bg/skip-descender.xpm new file mode 100644 index 00000000000..26ae40d57d5 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/skip-descender.xpm @@ -0,0 +1,21 @@ +/* XPM */ +static char *dummy[]={ +"11 17 1 1", +". c None", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"...........", +"..........."}; diff --git a/etc/images/icons/allout-widgets/light-bg/through-descender.png b/etc/images/icons/allout-widgets/light-bg/through-descender.png Binary files differnew file mode 100644 index 00000000000..bdf08b80193 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/through-descender.png diff --git a/etc/images/icons/allout-widgets/light-bg/through-descender.xpm b/etc/images/icons/allout-widgets/light-bg/through-descender.xpm new file mode 100644 index 00000000000..d94c6f675c4 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/through-descender.xpm @@ -0,0 +1,22 @@ +/* XPM */ +static char *dummy[]={ +"11 17 2 1", +". c None", +"# c #606060", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......", +"....#......"}; diff --git a/etc/images/icons/allout-widgets/light-bg/unlocked-encrypted.png b/etc/images/icons/allout-widgets/light-bg/unlocked-encrypted.png Binary files differnew file mode 100755 index 00000000000..e70d075690a --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/unlocked-encrypted.png diff --git a/etc/images/icons/allout-widgets/light-bg/unlocked-encrypted.xpm b/etc/images/icons/allout-widgets/light-bg/unlocked-encrypted.xpm new file mode 100644 index 00000000000..2baa1e81211 --- /dev/null +++ b/etc/images/icons/allout-widgets/light-bg/unlocked-encrypted.xpm @@ -0,0 +1,26 @@ +/* XPM */ +static char *dummy[]={ +"10 17 6 1", +". c None", +"c c #333300", +"a c #666600", +"b c #999933", +"# c #999966", +"d c #ffff00", +"..........", +"..........", +"..........", +"...####...", +"..#a#a###.", +"..a#...##.", +".a#.....#.", +".##.......", +"..##......", +"b###c###bc", +"bddddddddc", +"#d#ddddddc", +"#d#ddddddc", +"b##ddddd#c", +"#ddddddddc", +"cccccccccc", +".........."}; diff --git a/etc/themes/light-blue-theme.el b/etc/themes/light-blue-theme.el new file mode 100644 index 00000000000..60f9fa8dc9d --- /dev/null +++ b/etc/themes/light-blue-theme.el @@ -0,0 +1,67 @@ +;;; light-blue-theme.el --- Custom theme for faces + +;; Copyright (C) 2011 Free Software Foundation, Inc. + +;; Author: Drew Adams <drew.adams@oracle.com> + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Extracted from the settings in oneonone.el by Drew Adams. + +;;; Code: + +(deftheme light-blue + "Theme with a light blue backgound.") + +(let ((class '((class color) (min-colors 89)))) + (custom-theme-set-faces + 'light-blue + `(default ((,class (:background "LightBlue" :foreground "black")))) + `(cursor ((,class (:background "red")))) + `(fringe ((,class (:background "gray85")))) + ;; Highlighting faces + `(highlight ((,class (:background "cyan")))) + `(region ((,class (:background "MediumAquamarine")))) + `(secondary-selection ((,class (:background "white" :foreground "black")))) + `(isearch ((,class (:background "green" :foreground "Black")))) + `(lazy-highlight ((,class (:background "dark turquoise")))) + `(query-replace ((,class (:inherit isearch :background "white" :foreground "black")))) + `(match ((,class (:background "SkyBlue")))) + ;; Mode line faces + `(mode-line ((,class (:background "PaleGoldenrod" :foreground "black" :box (:line-width -1 :style released-button))))) + `(mode-line-buffer-id ((,class (:overline "red" :underline "red")))) + `(mode-line-inactive ((,class (:inherit mode-line :background "LightGray" :foreground "grey20" :box (:line-width -1 :color "grey75") :weight light)))) + ;; Escape and prompt faces + `(escape-glyph ((,class (:background "gold" :foreground "blue" :box (:line-width 1 :color "blue" :style released-button))))) + ;; Font lock faces + `(font-lock-builtin-face ((,class (:foreground "#b35caf")))) + `(font-lock-constant-face ((,class (:foreground "#00006DE06DE0")))) + `(font-lock-function-name-face ((,class (:foreground "red")))) + `(font-lock-keyword-face ((,class (:foreground "Blue3")))) + `(font-lock-string-face ((,class (:foreground "Magenta4")))) + `(font-lock-warning-face ((,class (:foreground "orange red" :weight bold)))) + ;; Compilation faces + `(next-error ((,class (:inherit region :background "SkyBlue")))))) + +(provide-theme 'light-blue) + +;; Local Variables: +;; no-byte-compile: t +;; End: + +;;; light-blue-theme.el ends here diff --git a/etc/themes/tango-dark-theme.el b/etc/themes/tango-dark-theme.el index 613c98f505a..a5731ab7d7d 100644 --- a/etc/themes/tango-dark-theme.el +++ b/etc/themes/tango-dark-theme.el @@ -49,7 +49,13 @@ Semantic, and Ansi-Color faces are included.") (custom-theme-set-faces 'tango-dark - `(default ((,class (:foreground ,alum-1 :background ,alum-6)))) + ;; Ensure sufficient contrast on low-color terminals. + `(default ((((class color) (min-colors 4096)) + (:foreground ,alum-1 :background ,alum-6)) + (((class color) (min-colors 256)) + (:foreground ,alum-1 :background "#222")) + (,class + (:foreground ,alum-1 :background "black")))) `(cursor ((,class (:foreground ,alum-6 :background ,butter-1)))) ;; Highlighting faces `(fringe ((,class (:background ,alum-7)))) diff --git a/install-sh b/install-sh index 3f83ce9b555..a9244eb0786 100755 --- a/install-sh +++ b/install-sh @@ -1,7 +1,7 @@ #!/bin/sh # install - install a program, script, or datafile -scriptversion=2010-02-06.18; # UTC +scriptversion=2011-01-19.21; # UTC # This originates from X11R5 (mit/util/scripts/install.sh), which was # later released in X11R6 (xc/config/util/install.sh) with the @@ -156,6 +156,10 @@ while test $# -ne 0; do -s) stripcmd=$stripprog;; -t) dst_arg=$2 + # Protect names problematic for `test' and other utilities. + case $dst_arg in + -* | [=\(\)!]) dst_arg=./$dst_arg;; + esac shift;; -T) no_target_directory=true;; @@ -186,6 +190,10 @@ if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then fi shift # arg dst_arg=$arg + # Protect names problematic for `test' and other utilities. + case $dst_arg in + -* | [=\(\)!]) dst_arg=./$dst_arg;; + esac done fi @@ -232,9 +240,9 @@ fi for src do - # Protect names starting with `-'. + # Protect names problematic for `test' and other utilities. case $src in - -*) src=./$src;; + -* | [=\(\)!]) src=./$src;; esac if test -n "$dir_arg"; then @@ -256,12 +264,7 @@ do echo "$0: no destination specified." >&2 exit 1 fi - dst=$dst_arg - # Protect names starting with `-'. - case $dst in - -*) dst=./$dst;; - esac # If destination is a directory, append the input filename; won't work # if double slashes aren't ignored. @@ -389,7 +392,7 @@ do case $dstdir in /*) prefix='/';; - -*) prefix='./';; + [-=\(\)!]*) prefix='./';; *) prefix='';; esac @@ -407,7 +410,7 @@ do for d do - test -z "$d" && continue + test X"$d" = X && continue prefix=$prefix$d if test -d "$prefix"; then diff --git a/lib-src/.gitignore b/lib-src/.gitignore index e1693b13c5e..c931a15d7b6 100644 --- a/lib-src/.gitignore +++ b/lib-src/.gitignore @@ -1,6 +1,5 @@ DOC ctags.c -getopt.h stamp_BLD echolisp.tmp diff --git a/lib-src/ChangeLog b/lib-src/ChangeLog index 0f93941151e..01352adf4e3 100644 --- a/lib-src/ChangeLog +++ b/lib-src/ChangeLog @@ -1,3 +1,22 @@ +2011-02-21 Eli Zaretskii <eliz@gnu.org> + + * makefile.w32-in ($(BLD)/ctags.$(O), $(BLD)/emacsclient.$(O)) + ($(BLD)/etags.$(O), $(BLD)/movemail.$(O), $(BLD)/ntlib.$(O)): + Depend on $(EMACS_ROOT)/nt/inc/sys/stat.h. + +2011-02-21 Ben Key <bkey76@gmail.com> (tiny change) + + * make-docfile.c (scan_c_file): Adapt DEFVAR_PER_BUFFER case to + the new BVAR macro. + +2011-02-20 Juanma Barranquero <lekktu@gmail.com> + + * makefile.w32-in (obj): Remove md5.o. + +2011-02-18 Karl Chen <Karl.Chen@quarl.org> + + * emacsclient.c (main): Loop while `recv' return EINTR. + 2011-02-09 Paul Eggert <eggert@cs.ucla.edu> * make-docfile.c (EMACS_INTEGER): Rename from EMACS_INT. @@ -26,8 +45,8 @@ 2011-02-02 Eli Zaretskii <eliz@gnu.org> - * makefile.w32-in (ETAGS_CFLAGS, CTAGS_CFLAGS): Add - ``-DEMACS_NAME="\"GNU Emacs\""''. + * makefile.w32-in (ETAGS_CFLAGS, CTAGS_CFLAGS): + Add ``-DEMACS_NAME="\"GNU Emacs\""''. (obj): Remove strftime.o. 2011-01-31 Eli Zaretskii <eliz@gnu.org> @@ -232,8 +251,8 @@ * movemail.c (fatal, error, concat): Use const char *. - * make-docfile.c (error, fatal, scan_c_file, scan_lisp_file): 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) @@ -551,8 +570,8 @@ 2010-04-02 Dan Rosenberg <dan.j.rosenberg@gmail.com> (tiny change) - * movemail.c (main): Check return values of setuid. Avoid - possibility of symlink attack when movemail is setgid mail + * movemail.c (main): Check return values of setuid. + Avoid possibility of symlink attack when movemail is setgid mail (CVE-2010-0825). 2010-04-02 Dan Nicolaescu <dann@ics.uci.edu> @@ -2258,7 +2277,7 @@ (wchar.h): Include, maybe. (attribute_hidden): Define if not defined. (__getopt_initialized): Use attribute_hidden. - (__libc_argc, __libc_argv): Renamed from original_argc, etc. + (__libc_argc, __libc_argv): Rename from original_argc, etc. (__getopt_nonoption_flags, nonoption_flags_max_len) (nonoption_flags_len): Conditional on USE_NONOPTION_FLAGS. (SWAP_FLAGS): New definitions. @@ -2361,7 +2380,7 @@ 2002-08-29 Francesco Potortì <pot@gnu.org> * etags.c (C_entries): Correct a problem with const C++ funcs. - (ignoreindent): Renamed from noindentypedefs. + (ignoreindent): Rename from noindentypedefs. (cjava, cplpl): They are now macros instead of local vars. 2002-08-28 Francesco Potortì <pot@gnu.org> @@ -2377,7 +2396,7 @@ (strcaseeq): Make it into a macro. * etags.c (make_tag): Never generate null length tag names. - (linebuffer_init): Renamed from initbuffer. All callers changed. + (linebuffer_init): Rename from initbuffer. All callers changed. (pattern): Structure renamed to `regexp', member regex renamed to pattern. (node_st): Member pat renamed to regex. @@ -2534,8 +2553,8 @@ 2002-05-30 Richard M. Stallman <rms@gnu.org> - * Makefile.in (LIBS_MAIL): Renamed from LIB_MAIL. - (LIBS_MOVE): Renamed from MOVE_LIBS. + * Makefile.in (LIBS_MAIL): Rename from LIB_MAIL. + (LIBS_MOVE): Rename from MOVE_LIBS. 2002-05-26 Paul Eggert <eggert@twinsun.com> @@ -2816,21 +2835,21 @@ (get_tag): Return a pointer to the tag that is found. * etags.c (LOOKING_AT): Use !intoken instead of iswhite. - (F_takeprec): Renamed from takeprec. All callers changed. - (F_getit): Renamed from getit. All callers changed. - (nocase_tail): Renamed from tail. All callers changed. - (Ada_getit): Renamed from adagetit. All callers changed. + (F_takeprec): Rename from takeprec. All callers changed. + (F_getit): Rename from getit. All callers changed. + (nocase_tail): Rename from tail. All callers changed. + (Ada_getit): Rename from adagetit. All callers changed. (L_getit): Simplify by using get_tag. (Perl_functions, Postscript_functions, erlang_attribute): Use the modified LOOKING_AT. - (notinname): Removed '[' and added ')' to the recognised chars. + (notinname): Remove '[' and added ')' to the recognised chars. (LOOKING_AT, get_tag, PHP_functions): Use notinname. (Ada_getit, Ada_funcs, Python_functions, Scheme_functions): Clarified, using strneq or notinname. (L_isdef, L_isquote): Removed. (Lisp_functions, L_getit): Clarified. - * etags.c (P_): Renamed to __P for consistency with config.h. + * etags.c (P_): Rename to __P for consistency with config.h. [HAVE_CONFIG_H]: Let config.h deal with __P. [__STDC__] [!HAVE_CONFIG_H]: Define PTR as in config.h. [!__STDC__] [!HAVE_CONFIG_H]: Do not undefine static, because @@ -2889,7 +2908,7 @@ (Perl_functions, Python_functions, PHP_functions) (Scheme_functions, Texinfo_nodes): Use it. (Perl_functions): Use strneq. - (prolog_pred): Renamed to prolog_pr. + (prolog_pred): Rename to prolog_pr. (prolog_pr): Recognise Prolog rules in addition to predicates. [ETAGS_REGEXPS] [!HAVE_CONFIG_H] [__CYGWIN__]: Prevent unmodified compile, as Cygwin's regex.h is incompatible with us. @@ -2988,7 +3007,7 @@ 2001-10-13 Gerd Moellmann <gerd@gnu.org> - * make-docfile.c (read_c_string_or_comment): Renamed from + * make-docfile.c (read_c_string_or_comment): Rename from read_c_string. Add parameter COMMENT. Read C-style comments. (scan_c_file): Handle doc strings in C comments. @@ -3247,12 +3266,12 @@ 2001-01-25 Francesco Potortì <pot@gnu.org> - * etags.c (struct tok): Renamed from struct token. - (token): Renamed from tok. + * etags.c (struct tok): Rename from struct token. + (token): Rename from tok. (structtype): Make it a local variable. [DEBUG]: Use assert. (xrnew): Change the synopsis. - (typedefs_or_cplusplus): Renamed from typedefs_and_cplusplus. + (typedefs_or_cplusplus): Rename from typedefs_and_cplusplus. (grow_linebuffer): Don't call xrnew when not needed. (token): Buffer renamed to line. (C_entries): Three calls to inibuffer moved here from main. @@ -3281,16 +3300,16 @@ 2001-01-14 Francesco Potortì <pot@gnu.org> - * etags.c (get_language_from_langname): Renamed from + * etags.c (get_language_from_langname): Rename from get_language_from_name. - (get_language_from_filename): Renamed from get_language_from_suffix. + (get_language_from_filename): Rename from get_language_from_suffix. Now first looks for the complete file name. (language): New member char **filenames. (Makefile_filenames): List of possible filenames for makefiles. (lang_names): Add a NULL member for every entry, added an entry for makefiles. (Makefile_targets): New function. - (Texinfo_nodes): Renamed from Texinfo_fuctions and made + (Texinfo_nodes): Rename from Texinfo_fuctions and made it conformant to the style of the rest of the code. 2001-01-13 Gerd Moellmann <gerd@gnu.org> @@ -3429,7 +3448,7 @@ 2000-07-14 Gerd Moellmann <gerd@gnu.org> - * ebrowse.c (xrealloc, xmalloc): Renamed from yrealloc and ymalloc. + * ebrowse.c (xrealloc, xmalloc): Rename from yrealloc and ymalloc. * etags.c (xmalloc, xrealloc): Make externally visible, for use by alloca.o. @@ -3466,8 +3485,8 @@ 2000-06-06 Gerd Moellmann <gerd@gnu.org> - * ebrowse.c (ymalloc): Renamed from xmalloc. - (yrealloc): Renamed from xrealloc. + * ebrowse.c (ymalloc): Rename from xmalloc. + (yrealloc): Rename from xrealloc. 2000-05-21 Dave Love <fx@gnu.org> @@ -3690,7 +3709,7 @@ corrects a bug. All callers changed. (canonicalize_filename): New function. (process_file, etags_getcwd, absolute_dirname): Use it. - (relative_filename, absolute_filename): Removed var shadowing. + (relative_filename, absolute_filename): Remove var shadowing. (C_entries, Pascal_functions): Add fake initializations to keep compilers quiet. (TeX_functions, Prolog_functions, Erlang_functions): Cleanup. @@ -3980,8 +3999,8 @@ 1998-05-01 Andrew Innes <andrewi@harlequin.co.uk> - * movemail.c [WINDOWSNT]: Undefine DISABLE_DIRECT_ACCESS. Force - all file i/o to be in binary mode. Include ntlib.h. + * movemail.c [WINDOWSNT]: Undefine DISABLE_DIRECT_ACCESS. + Force all file i/o to be in binary mode. Include ntlib.h. 1998-04-27 Andreas Schwab <schwab@delysid.gnu.org> @@ -4013,8 +4032,8 @@ return types. Add forward declarations. * emacsclient.c: Include <stdlib.h> and <unistd.h> if available. Don't declare geteuid. - (print_help_and_exit): Change return type to void. Forward - declare it. + (print_help_and_exit): Change return type to void. + Forward declare it. * b2m.c: Include <stdlib.h> if available. (main): Explicitly declare return type. @@ -4026,7 +4045,7 @@ 1998-03-26 Richard Stallman <rms@psilocin.gnu.org> - * pop.c (pop_getline): Renamed from getline. + * pop.c (pop_getline): Rename from getline. 1998-03-05 Richard Stallman <rms@psilocin.gnu.org> @@ -4051,8 +4070,8 @@ with a '>' any lines starting with "From " read from the POP server, but leave the code in place, wrapped in #ifdef MOVEMAIL_QUOTE_POP_FROM_LINES, in case we have to restore it later - because it turns out that something is depending on it. Change - suggested by Paul Eggert <eggert@twinsun.com>. + because it turns out that something is depending on it. + Change suggested by Paul Eggert <eggert@twinsun.com>. Convert the character \037 (^_) at the beginning of a line into the character '^' followed by the character '_', because otherwise Emacs can't parse the resulting file as a valid BABYL file. @@ -4069,8 +4088,8 @@ quotes with a '>' any lines starting with "From " read from the POP server, but leave the code in place, wrapped in #ifdef MOVEMAIL_QUOTE_POP_FROM_LINES, in case we have to restore it later - because it turns out that something is depending on it. Change - suggested by Paul Eggert <eggert@twinsun.com>. + because it turns out that something is depending on it. + Change suggested by Paul Eggert <eggert@twinsun.com>. Convert the character \037 (^_) at the beginning of a line into the character '^' followed by the character '_', because otherwise @@ -4086,8 +4105,8 @@ 1997-10-31 Jonathan I. Kamens <jik@kamens.brookline.ma.us> - * pop.c (fullwrite): Get rid of an extra call to write. Problem - pointed out by Chiaki Ishikawa. + * pop.c (fullwrite): Get rid of an extra call to write. + Problem pointed out by Chiaki Ishikawa. 1997-10-16 Dave Love <d.love@dl.ac.uk> @@ -4227,8 +4246,8 @@ (C_entries): Initialise tok.named. (sym_type, C_stab_entry, consider_token): st_C_ignore is used to get rid of "import", "package" and "friend". - (fvdef): Renamed from funcdef. Also some constants renamed. All - users changed. + (fvdef): Rename from funcdef. Also some constants renamed. + All users changed. (C_entries): Make separate tags for variables separated by comma. (globals, members): New flags. (main, C_entries): Use them. @@ -4242,7 +4261,7 @@ (consider_token, C_entries): Set the len member of token_name. (prolog_pred): Cleanup according to GNU coding standards. (Cobol_suffixes, lang_names, Cobol_paragraphs): Cobol support. - (prolog_white, erlang_white): Renamed to eat_white, callers changed. + (prolog_white, erlang_white): Rename to eat_white, callers changed. 1997-05-15 Francesco Potortì <F.Potorti@cnuce.cnr.it> @@ -4445,7 +4464,7 @@ * etags.c (relative_filename): Bug corrected. (etags_getcwd): Avoid warning of unused variable. - (C_entries, consider_token): Added support for enum labels. + (C_entries, consider_token): Add support for enum labels. 1996-11-03 Paul Eggert <eggert@twinsun.com> @@ -4688,14 +4707,14 @@ 1996-04-29 Richard Stallman <rms@delasyd.gnu.ai.mit.edu> - * pop.c (SEND, RECV): Renamed from send, recv. + * pop.c (SEND, RECV): Rename from send, recv. (pop_open, pop_trash): Make the trash_started code unconditional. (socket_connection): Delete casts to void. 1996-04-28 Richard Stallman <rms@delasyd.gnu.ai.mit.edu> - * movemail.c (DIRECTORY_SEP, IS_DIRECTORY_SEP): Definitions - copied from lisp.h. + * movemail.c (DIRECTORY_SEP, IS_DIRECTORY_SEP): + Definitions copied from lisp.h. 1996-04-22 Andrew Innes <andrewi@harlequin.co.uk> @@ -4805,7 +4824,7 @@ (lang_names): Erlang entry added. (prolog_getit): Accepts headers spanning several lines. Always name tags. - (Prolog_functions): Removed incorrect compensation for + (Prolog_functions): Remove incorrect compensation for newline characters. (readline_internal): Zero-terminate last line. @@ -4870,7 +4889,7 @@ 1995-12-01 Richard Stallman <rms@whiz-bang.gnu.ai.mit.edu> - * Makefile.in (THIS_IS_MAKEFILE): Renamed from THIS_IS_YMAKEFILE. + * Makefile.in (THIS_IS_MAKEFILE): Rename from THIS_IS_YMAKEFILE. 1995-12-07 Francesco Potortì <pot@cnuce.cnr.it> @@ -4887,11 +4906,11 @@ 1995-12-06 Francesco Potortì <pot@cnuce.cnr.it> * etags.c (Cplusplus_suffixes): Add .M suffix for Objective C++. - (gperf): Added keywords for Objective C and GNU macros. - (sym_type): Added values to account for Objective C and GNU macros. + (gperf): Add keywords for Objective C and GNU macros. + (sym_type): Add values to account for Objective C and GNU macros. (begtk): The '@' character can start a token. (objdef, methodlen, objtag): New variables for Objective C. - (consider_token, C_entries): Added code for Objective C. + (consider_token, C_entries): Add code for Objective C. (plain_C_suffixes): Add .m and .lm for Objective C. (Yacc_suffixes): Add .ym for Objective yacc. (GROW_LINEBUFFER): New macro. @@ -4932,8 +4951,8 @@ 1995-11-06 Francesco Potortì (pot@cnuce.cnr.it) - * etags.c (get_lang_from_name, get_lang_from_interpreter, - get_lang_from_suffix): New functions. + * etags.c (get_lang_from_name, get_lang_from_interpreter) + (get_lang_from_suffix): New functions. (get_language): Function deleted. (lang_entry): Two members added to struct. (lang_names): Reflect the new layout of lang_entry. @@ -4948,12 +4967,12 @@ * etags.c (lowcase): Use the standard tolower function. (substitute): Remove some wrong and some useless code related with escape '\' character in regexp replacement string. - (TEX_defenv): Added part, appendix, entry, index. Removed typeout. + (TEX_defenv): Add part, appendix, entry, index. Remove typeout. (lang_suffixes): New suffixes: .hpp for C++; .f90 for Fortran; .bib, .ltx, .TeX for TeX (.bbl, .dtx removed); .ml for Lisp; .prolog for prolog (.pl removed). (massage_name, etags_getcwd): Use lowcase instead of tolower. - (C_entries, find_entries): Added comments about memory leakage. + (C_entries, find_entries): Add comments about memory leakage. (add_node): Dead code removed. 1995-10-29 Richard Stallman <rms@mole.gnu.ai.mit.edu> @@ -5195,7 +5214,7 @@ 1995-04-08 Richard Stallman <rms@mole.gnu.ai.mit.edu> - * Makefile.in.in (BASE_CFLAGS): Renamed from ALLOCA_CFLAGS. + * Makefile.in.in (BASE_CFLAGS): Rename from ALLOCA_CFLAGS. (alloca.o, regex.o): Use BASE_CFLAGS. 1995-04-06 Richard Stallman <rms@mole.gnu.ai.mit.edu> @@ -5205,7 +5224,7 @@ 1995-04-04 Karl Heuer <kwzh@gnu.ai.mit.edu> * Makefile.in.in (aixcc, aixcc.c): Targets deleted. - (SOURCES, distclean): Removed obsolete references to aixcc. + (SOURCES, distclean): Remove obsolete references to aixcc. 1995-04-02 Richard Stallman <rms@mole.gnu.ai.mit.edu> @@ -5248,7 +5267,7 @@ savetok.valid. Mark token as valid when it is initialised. (make_tag): Make token only if token is valid and reset validity. (CNL_SAVE_DEFINEDEF): Test for savetok.valid instead of token_saved. - (TOKEN): Added a new member: valid. + (TOKEN): Add a new member: valid. 1995-02-15 Francesco Potortì (pot@cnuce.cnr.it) @@ -5270,12 +5289,12 @@ 1995-02-07 Richard Stallman <rms@pogo.gnu.ai.mit.edu> - * Makefile.in.in (maintainer-clean): Renamed from realclean. + * Makefile.in.in (maintainer-clean): Rename from realclean. 1995-02-01 Francesco Potortì (pot@cnuce.cnr.it) * etags.c (pfnote): Initialise been_warned in the node. - (C_entries): Removed a speed hack for the sake of clarity. + (C_entries): Remove a speed hack for the sake of clarity. 1995-01-18 Francesco Potortì (pot@cnuce.cnr.it) @@ -5394,7 +5413,7 @@ (print_help): Help strings updated. Calls print_language_names. (argument_type, ARGUMENT): Typedefs for dealing with language and regex options intermixed with filenames. - (main): Changed the way of dealing with arguments on the command + (main): Change the way of dealing with arguments on the command line to deal with language and regex options intermixed with filenames. (get_language, default_C_entries, Cplusplus_entries, @@ -5483,8 +5502,8 @@ * pop.c: Don't include <string.h> and <strings.h>. - * pop.c: Include <des.h> before <krb.h>, rather than after. They - should be interchangeable, and indeed the inclusion is done in + * pop.c: Include <des.h> before <krb.h>, rather than after. + They should be interchangeable, and indeed the inclusion is done in both orders in various files in the Kerberos 4 library sources, but djm@va.pubnix.com (David J. MacKenzie) reports that BSDI requires that <des.h> be included first, and I don't see any harm @@ -5514,8 +5533,8 @@ 1994-10-17 Andreas Schwab <schwab@issan.informatik.uni-dortmund.de> - * emacsserver.c [SYSV_IPC] (main): Catch SIGHUP as well. Don't - call kill with pid 0. Handle EINTR when receiving messages. + * emacsserver.c [SYSV_IPC] (main): Catch SIGHUP as well. + Don't call kill with pid 0. Handle EINTR when receiving messages. 1994-10-17 Karl Heuer <kwzh@gnu.ai.mit.edu> @@ -5546,7 +5565,7 @@ * Makefile.in.in (clean): rm DOC* and *.tab.[ch]. (distclean): Not here. - * Makefile.in.in (libexecdir): Renamed from libdir. + * Makefile.in.in (libexecdir): Rename from libdir. 1994-10-11 Francesco Potortì (pot@cnuce.cnr.it) @@ -5776,7 +5795,7 @@ print advice to run it, if it has anything significant to do. And only if MOVEMAIL_NEEDS_BLESSING. (blessmail): Use emacs, not temacs. - (configuration): Renamed from configname. + (configuration): Rename from configname. 1994-04-30 Morten Welinder (terra@diku.dk) @@ -5860,15 +5879,15 @@ 1994-04-08 Francesco Potortì (pot@fly.cnuce.cnr.it) - * etags.c (outf, outfiledir): Renamed to tagf, tagfiledir. + * etags.c (outf, outfiledir): Rename to tagf, tagfiledir. (PF_funcs, Asm_funcs, L_funcs, PAS_funcs, TEX_funcs) - (Scheme_funcs, prolog_funcs): Renamed to Fortran_functions, + (Scheme_funcs, prolog_funcs): Rename to Fortran_functions, Asm_labels, Lisp_functions, Pascal_functions, Scheme_functions, TeX_functions, Prolog_functions. (inf): No more a global variable. (C_entries): Take 2nd parameter `inf' instead of using the global one. - (find_entries): Added the cp1 var for optimisation. - (find_entries): Added more suffixes for assembler files. + (find_entries): Add the cp1 var for optimisation. + (find_entries): Add more suffixes for assembler files. (Asm_funcs): Now finds labels even without an ending colon. 1994-03-30 Francesco Potortì (pot@fly.cnuce.cnr.it) @@ -5896,7 +5915,7 @@ (process_file): Filenames in tags file are relative to the directory where the tags file is (useful with the -o option). (main): Initialise the outfiledir var. - (TYPEDST): Added the `tignore' value. + (TYPEDST): Add the `tignore' value. (C_entries): Corrected various small bugs. 1994-03-19 Richard Stallman (rms@mole.gnu.ai.mit.edu) @@ -5912,7 +5931,7 @@ 1994-03-14 Francesco Potortì (pot@cnuce.cnr.it) - * etags.c (TYPEDST): Added the `tignore' value. + * etags.c (TYPEDST): Add the `tignore' value. (C_entries): Corrected various bugs, now correctly parses the `extern "C" {' construction (patch by Tom R.Hageman). @@ -5966,7 +5985,7 @@ 1994-02-14 Francesco Potortì (pot@fly) - * etags.c (absolute_pathnames, cwd): Added global vars. + * etags.c (absolute_pathnames, cwd): Add global vars. (longopts, print_help, main, process_file): Put absolute filenames in the tag file if the -A --absolute-pathnames option is used. (print_help): Alphabetically order the options. @@ -6003,7 +6022,7 @@ Use gperf generated hash table instead of linked list. (C_stab_entry, hash, in_word_set, get_C_stab, C_symtype): Added. Mostly code generated by gperf. - (consider_token): Removed unused parameter `lp'. + (consider_token): Remove unused parameter `lp'. (PF_funcs, getit): Allow subroutine and similar declarations to span multiple lines. (C_entries): Check for newline if inchar to avoid bus errors. @@ -6150,7 +6169,7 @@ 1993-11-02 Francesco Potortì (pot@cnuce.cnr.it) - * etags.c (consider_token): Removed unused variable firsttok. + * etags.c (consider_token): Remove unused variable firsttok. (prolog_getit): Call pfnote with the right number of arguments. 1993-10-19 Paul Eggert (eggert@twinsun.com) @@ -6180,13 +6199,13 @@ from current directory. Only chmod and chgrp files that we installed, which excludes ${INSTALLABLE_SCRIPTS}. They go in ${bindir}. - (INSTALLFLAGS): Deleted definition, since it is an unused variable + (INSTALLFLAGS): Delete definition, since it is an unused variable now. 1993-09-27 Brian J. Fox (bfox@ai.mit.edu) - * Makefile.in (INSTALL, INSTALL_PROGRAM, INSTALL_DATA): Let - configure figure out the correct values for these variables. + * Makefile.in (INSTALL, INSTALL_PROGRAM, INSTALL_DATA): + Let configure figure out the correct values for these variables. 1993-09-14 Brian J. Fox (bfox@ai.mit.edu) @@ -6271,7 +6290,7 @@ 1993-07-30 Francesco Potortì (pot@cnuce.cnr.it) - * etags.c (FINCST): Added the fignore status. Means we are + * etags.c (FINCST): Add the fignore status. Means we are after the parameter list and before the open curly brace. Allows correct parsing of C++ constructors. (C_entries, consider_token): Make use of fignore. @@ -6310,7 +6329,7 @@ 1993-07-08 Francesco Potortì (pot@cnuce.cnr.it) - * etags.c (alloca): Removed all references to it. + * etags.c (alloca): Remove all references to it. (main): Now calls xnew instead of alloca for portability. (../src/config.h): Included only if HAVE_CONFIG_H. (const): Void definition removed--config.h takes care of it. @@ -6322,7 +6341,7 @@ * etags.c (LEVEL_OK_FOR_FUNCDEF): Removed. (C_entries): Optimized the test that used LEVEL_OK_FOR_FUNCDEF. - (C_entries): Removed a piece of useless code. + (C_entries): Remove a piece of useless code. (C_entries): Making typedef tags is delayed until a semicolon is met. This handles "typedef int X, Y, Z;" correctly. @@ -6584,7 +6603,7 @@ 1993-04-09 Jim Blandy (jimb@totoro.cs.oberlin.edu) - * Makefile.in (DEFS): Renamed from CONFIG_CFLAGS. + * Makefile.in (DEFS): Rename from CONFIG_CFLAGS. 1993-04-07 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) @@ -6606,7 +6625,7 @@ (get_C_stab): c_ext becomes c_ext&C_PLPL. (C_entries): Logical cplpl means c_ext&C_PLPL. (C_entries): Logical yacc_rules means we are after the first %%. - (C_entries): Added logic for yacc files. + (C_entries): Add logic for yacc files. 1993-03-16 Francesco Potortì (pot@cnuce.cnr.it) @@ -6624,7 +6643,7 @@ (TOKEN): Member linestart removed. (linepos, prev_linepos, lb1): Deleted. (main): Call initbuffer on lbs array instead of lb1. - (init): Removed the initialisation of the logical _gd array. + (init): Remove the initialisation of the logical _gd array. (find_entries): A .sa suffix means assembler file. (C_create_stab): "auto", "void", "extern", "static" are st_C_typespec. All C state machines rewritten. @@ -6634,7 +6653,7 @@ 1993-03-01 Francesco Potortì (pot@fly.CNUCE.CNR.IT) - * etags.c (C_entries): Added the quotednl logical variable. + * etags.c (C_entries): Add the quotednl logical variable. Used for parsing of #define's spanning multiple lines. 1993-02-23 Francesco Potortì (pot@fly.CNUCE.CNR.IT) @@ -6644,7 +6663,7 @@ 1993-03-19 Eric S. Raymond (eric@geech.gnu.ai.mit.edu) - * Makefile.in (EXECUTABLES): Added rcs-checkin. + * Makefile.in (EXECUTABLES): Add rcs-checkin. * Makefile.in (unlock, relock): New productions. @@ -6705,7 +6724,7 @@ * Makefile.in (CFLAGS): #define HAVE_CONFIG_H, too. * Makefile.in (libdir): Default to ${prefix}/lib. - (archlibdir): Adjusted to match. + (archlibdir): Adjust to match. * Makefile.in (distclean): Don't delete backup or autosave files. (extraclean): Like realclean, but does delete backup and autosave @@ -6740,7 +6759,7 @@ 1992-11-05 Jim Blandy (jimb@totoro.cs.oberlin.edu) - * Makefile.in (getdate.o): Added explicit target for this, so we + * Makefile.in (getdate.o): Add explicit target for this, so we can indicate that it depends on ../src/config.h. 1992-11-04 Jim Blandy (jimb@totoro.cs.oberlin.edu) @@ -6808,7 +6827,7 @@ array. When an event fires, move the last event in the array into its spot. Use num_events to determine whether or not there are any pending events, not wait_for. - (getevent): Deleted unused variable `ep'. + (getevent): Delete unused variable `ep'. (sigcatch): It's now easier to find all the active events. (main): Initialize num_events. @@ -6821,7 +6840,7 @@ (process_file, find_entries, pfnote, TEX_funcs, TEX_decode_env, TEX_getit, substr): Use the etags_*index functions, rather than the native *index functions. - (rindex, index): Renamed to etags_rindex and tags_rindex, and + (rindex, index): Rename to etags_rindex and tags_rindex, and made them unconditionally defined, rather than having them depend on NEED_*INDEX. @@ -6908,7 +6927,7 @@ 1992-05-10 Roland McGrath (roland@albert.gnu.ai.mit.edu) - * etags.c (C_entries): Fixed reading of "..." strings. + * etags.c (C_entries): Fix reading of "..." strings. (consider_token): Recognize `SYSCALL' and `PSEUDO' macros, used in the C library source. @@ -6936,7 +6955,7 @@ 1992-04-17 Jim Blandy (jimb@pogo.cs.oberlin.edu) - * timer.c (getevent): Removed declaration of memcpy; since + * timer.c (getevent): Remove declaration of memcpy; since different systems have different return types, and we're not even using the return type anyway, it wasn't doing us any good. @@ -6971,7 +6990,7 @@ 1992-04-06 Jim Blandy (jimb@pogo.cs.oberlin.edu) - * etags.c (C_entries): Removed comment saying that \" in a string + * etags.c (C_entries): Remove comment saying that \" in a string isn't recognized as magic, because it is correctly handled. * getopt.c, getopt.h: New files, from GNU C library. @@ -6981,8 +7000,8 @@ optind. (main): Argument processing loop rewritten to call getopt to get next option. Options which take parameters (-o and -i) rewritten - to get parameter from optarg instead of argv[1]. Filename - preprocessing loop and update command changed similarly. + to get parameter from optarg instead of argv[1]. + Filename preprocessing loop and update command changed similarly. * Makefile (etags, ctags): Depend on and link with getopt.h, getopt.o, and getopt1.o. (getopt.o, getopt1.o): New targets for the GNU getopt routines. @@ -7123,8 +7142,8 @@ 1991-01-25 Jim Blandy (jimb@churchy.ai.mit.edu) * make-docfile: Find the arguments to a C function correctly, - by not ignoring the character that read_c_string returns. Don't - even try to find argument names for functions that take MANY + by not ignoring the character that read_c_string returns. + Don't even try to find argument names for functions that take MANY or UNEVALLED arguments, since they're a figment of the docstring's imagination. @@ -7512,8 +7531,8 @@ 1988-05-13 Chris Hanson (cph@kleph) - * emacsclient.c: Delete references to unused variable `out'. This - caused a bus error when used under hp-ux. + * emacsclient.c: Delete references to unused variable `out'. + This caused a bus error when used under hp-ux. 1988-05-06 Richard Stallman (rms@frosted-flakes.ai.mit.edu) diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index e5484b987e2..3670e68e3b3 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1708,10 +1708,21 @@ main (int argc, char **argv) fsync (1); /* Now, wait for an answer and print any messages. */ - while (exit_status == EXIT_SUCCESS - && (rl = recv (emacs_socket, string, BUFSIZ, 0)) > 0) + while (exit_status == EXIT_SUCCESS) { char *p; + do + { + errno = 0; + rl = recv (emacs_socket, string, BUFSIZ, 0); + } + /* If we receive a signal (e.g. SIGWINCH, which we pass + through to Emacs), on some OSes we get EINTR and must retry. */ + while (rl < 0 && errno == EINTR); + + if (rl <= 0) + break; + string[rl] = '\0'; p = string + strlen (string) - 1; diff --git a/lib-src/make-docfile.c b/lib-src/make-docfile.c index 93994c1ed3e..1f370555051 100644 --- a/lib-src/make-docfile.c +++ b/lib-src/make-docfile.c @@ -815,7 +815,7 @@ scan_c_file (char *filename, const char *mode) if (defunflag) commas = 5; else if (defvarperbufferflag) - commas = 2; + commas = 3; else if (defvarflag) commas = 1; else /* For DEFSIMPLE and DEFPRED */ diff --git a/lib-src/makefile.w32-in b/lib-src/makefile.w32-in index 52d1cb5680a..bc7b1b27baf 100644 --- a/lib-src/makefile.w32-in +++ b/lib-src/makefile.w32-in @@ -142,7 +142,7 @@ obj = dosfns.o msdos.o \ syntax.o bytecode.o \ process.o callproc.o unexw32.o \ region-cache.o sound.o atimer.o \ - doprnt.o intervals.o textprop.o composite.o md5.o + doprnt.o intervals.o textprop.o composite.o # # These are the lisp files that are loaded up in loadup.el @@ -374,6 +374,7 @@ $(BLD)/alloca.$(O) : \ $(BLD)/ctags.$(O) : \ $(SRC)/ctags.c \ $(EMACS_ROOT)/nt/inc/sys/param.h \ + $(EMACS_ROOT)/nt/inc/sys/stat.h \ $(EMACS_ROOT)/src/s/ms-w32.h \ $(EMACS_ROOT)/src/m/intel386.h \ $(EMACS_ROOT)/lib-src/../src/config.h \ @@ -382,6 +383,7 @@ $(BLD)/ctags.$(O) : \ $(BLD)/emacsclient.$(O) : \ $(SRC)/emacsclient.c \ + $(EMACS_ROOT)/nt/inc/sys/stat.h \ $(EMACS_ROOT)/src/s/ms-w32.h \ $(EMACS_ROOT)/src/m/intel386.h \ $(EMACS_ROOT)/lib-src/../src/config.h @@ -389,6 +391,7 @@ $(BLD)/emacsclient.$(O) : \ $(BLD)/etags.$(O) : \ $(SRC)/etags.c \ $(EMACS_ROOT)/nt/inc/sys/param.h \ + $(EMACS_ROOT)/nt/inc/sys/stat.h \ $(EMACS_ROOT)/src/s/ms-w32.h \ $(EMACS_ROOT)/src/m/intel386.h \ $(EMACS_ROOT)/lib-src/../src/config.h \ @@ -429,6 +432,7 @@ $(BLD)/movemail.$(O) : \ $(EMACS_ROOT)/src/m/intel386.h \ $(EMACS_ROOT)/lib-src/../src/config.h \ $(EMACS_ROOT)/nt/inc/sys/file.h \ + $(EMACS_ROOT)/nt/inc/sys/stat.h \ $(EMACS_ROOT)/lib-src/../src/syswait.h \ $(EMACS_ROOT)/nt/inc/pwd.h \ $(SRC)/ntlib.h @@ -437,6 +441,7 @@ $(BLD)/movemail.$(O) : \ $(BLD)/ntlib.$(O) : \ $(SRC)/ntlib.c \ $(SRC)/ntlib.h \ + $(EMACS_ROOT)/nt/inc/sys/stat.h \ $(EMACS_ROOT)/nt/inc/pwd.h $(BLD)/pop.$(O) : \ diff --git a/lib/Makefile.am b/lib/Makefile.am index 6a014f6057b..220ba713d4e 100644 --- a/lib/Makefile.am +++ b/lib/Makefile.am @@ -1,5 +1,6 @@ BUILT_SOURCES = EXTRA_DIST = +MOSTLYCLEANDIRS = MOSTLYCLEANFILES = noinst_LIBRARIES = diff --git a/lib/Makefile.in b/lib/Makefile.in index fa2de9192a2..b16587bbddc 100644 --- a/lib/Makefile.in +++ b/lib/Makefile.in @@ -24,7 +24,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --no-libtool --macro-prefix=gl --no-vc-files dtoastr getopt-gnu ignore-value mktime strftime +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --no-libtool --macro-prefix=gl --no-vc-files crypto/md5 dtoastr filemode getloadavg getopt-gnu ignore-value mktime strftime VPATH = @srcdir@ pkgdatadir = $(datadir)/@PACKAGE@ @@ -51,11 +51,15 @@ subdir = lib ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 am__aclocal_m4_deps = $(top_srcdir)/m4/00gnulib.m4 \ $(top_srcdir)/m4/c-strtod.m4 $(top_srcdir)/m4/extensions.m4 \ + $(top_srcdir)/m4/filemode.m4 $(top_srcdir)/m4/getloadavg.m4 \ $(top_srcdir)/m4/getopt.m4 $(top_srcdir)/m4/gl-comp.m4 \ $(top_srcdir)/m4/gnulib-common.m4 \ - $(top_srcdir)/m4/include_next.m4 $(top_srcdir)/m4/mktime.m4 \ - $(top_srcdir)/m4/multiarch.m4 $(top_srcdir)/m4/stdbool.m4 \ - $(top_srcdir)/m4/stddef_h.m4 $(top_srcdir)/m4/strftime.m4 \ + $(top_srcdir)/m4/include_next.m4 $(top_srcdir)/m4/longlong.m4 \ + $(top_srcdir)/m4/md5.m4 $(top_srcdir)/m4/mktime.m4 \ + $(top_srcdir)/m4/multiarch.m4 $(top_srcdir)/m4/st_dm_mode.m4 \ + $(top_srcdir)/m4/stdbool.m4 $(top_srcdir)/m4/stddef_h.m4 \ + $(top_srcdir)/m4/stdint.m4 $(top_srcdir)/m4/stdlib_h.m4 \ + $(top_srcdir)/m4/strftime.m4 $(top_srcdir)/m4/sys_stat_h.m4 \ $(top_srcdir)/m4/time_h.m4 $(top_srcdir)/m4/time_r.m4 \ $(top_srcdir)/m4/tm_gmtoff.m4 $(top_srcdir)/m4/unistd_h.m4 \ $(top_srcdir)/m4/wchar_t.m4 $(top_srcdir)/configure.in @@ -94,6 +98,11 @@ AUTOCONF = @AUTOCONF@ AUTOHEADER = @AUTOHEADER@ AUTOMAKE = @AUTOMAKE@ AWK = @AWK@ +BITSIZEOF_PTRDIFF_T = @BITSIZEOF_PTRDIFF_T@ +BITSIZEOF_SIG_ATOMIC_T = @BITSIZEOF_SIG_ATOMIC_T@ +BITSIZEOF_SIZE_T = @BITSIZEOF_SIZE_T@ +BITSIZEOF_WCHAR_T = @BITSIZEOF_WCHAR_T@ +BITSIZEOF_WINT_T = @BITSIZEOF_WINT_T@ BLESSMAIL_TARGET = @BLESSMAIL_TARGET@ CANNOT_DUMP = @CANNOT_DUMP@ CC = @CC@ @@ -134,6 +143,9 @@ GCONF_LIBS = @GCONF_LIBS@ GETLOADAVG_LIBS = @GETLOADAVG_LIBS@ GETOPT_H = @GETOPT_H@ GMALLOC_OBJ = @GMALLOC_OBJ@ +GNULIB_ATOLL = @GNULIB_ATOLL@ +GNULIB_CALLOC_POSIX = @GNULIB_CALLOC_POSIX@ +GNULIB_CANONICALIZE_FILE_NAME = @GNULIB_CANONICALIZE_FILE_NAME@ GNULIB_CHOWN = @GNULIB_CHOWN@ GNULIB_CLOSE = @GNULIB_CLOSE@ GNULIB_DUP2 = @GNULIB_DUP2@ @@ -142,35 +154,66 @@ GNULIB_ENVIRON = @GNULIB_ENVIRON@ GNULIB_EUIDACCESS = @GNULIB_EUIDACCESS@ GNULIB_FACCESSAT = @GNULIB_FACCESSAT@ GNULIB_FCHDIR = @GNULIB_FCHDIR@ +GNULIB_FCHMODAT = @GNULIB_FCHMODAT@ GNULIB_FCHOWNAT = @GNULIB_FCHOWNAT@ +GNULIB_FSTATAT = @GNULIB_FSTATAT@ GNULIB_FSYNC = @GNULIB_FSYNC@ GNULIB_FTRUNCATE = @GNULIB_FTRUNCATE@ +GNULIB_FUTIMENS = @GNULIB_FUTIMENS@ GNULIB_GETCWD = @GNULIB_GETCWD@ GNULIB_GETDOMAINNAME = @GNULIB_GETDOMAINNAME@ GNULIB_GETDTABLESIZE = @GNULIB_GETDTABLESIZE@ GNULIB_GETGROUPS = @GNULIB_GETGROUPS@ GNULIB_GETHOSTNAME = @GNULIB_GETHOSTNAME@ +GNULIB_GETLOADAVG = @GNULIB_GETLOADAVG@ GNULIB_GETLOGIN = @GNULIB_GETLOGIN@ GNULIB_GETLOGIN_R = @GNULIB_GETLOGIN_R@ GNULIB_GETPAGESIZE = @GNULIB_GETPAGESIZE@ +GNULIB_GETSUBOPT = @GNULIB_GETSUBOPT@ GNULIB_GETUSERSHELL = @GNULIB_GETUSERSHELL@ +GNULIB_GRANTPT = @GNULIB_GRANTPT@ +GNULIB_LCHMOD = @GNULIB_LCHMOD@ GNULIB_LCHOWN = @GNULIB_LCHOWN@ GNULIB_LINK = @GNULIB_LINK@ GNULIB_LINKAT = @GNULIB_LINKAT@ GNULIB_LSEEK = @GNULIB_LSEEK@ +GNULIB_LSTAT = @GNULIB_LSTAT@ +GNULIB_MALLOC_POSIX = @GNULIB_MALLOC_POSIX@ +GNULIB_MKDIRAT = @GNULIB_MKDIRAT@ +GNULIB_MKDTEMP = @GNULIB_MKDTEMP@ +GNULIB_MKFIFO = @GNULIB_MKFIFO@ +GNULIB_MKFIFOAT = @GNULIB_MKFIFOAT@ +GNULIB_MKNOD = @GNULIB_MKNOD@ +GNULIB_MKNODAT = @GNULIB_MKNODAT@ +GNULIB_MKOSTEMP = @GNULIB_MKOSTEMP@ +GNULIB_MKOSTEMPS = @GNULIB_MKOSTEMPS@ +GNULIB_MKSTEMP = @GNULIB_MKSTEMP@ +GNULIB_MKSTEMPS = @GNULIB_MKSTEMPS@ GNULIB_MKTIME = @GNULIB_MKTIME@ GNULIB_NANOSLEEP = @GNULIB_NANOSLEEP@ GNULIB_PIPE = @GNULIB_PIPE@ GNULIB_PIPE2 = @GNULIB_PIPE2@ GNULIB_PREAD = @GNULIB_PREAD@ +GNULIB_PTSNAME = @GNULIB_PTSNAME@ +GNULIB_PUTENV = @GNULIB_PUTENV@ GNULIB_PWRITE = @GNULIB_PWRITE@ +GNULIB_RANDOM_R = @GNULIB_RANDOM_R@ GNULIB_READLINK = @GNULIB_READLINK@ GNULIB_READLINKAT = @GNULIB_READLINKAT@ +GNULIB_REALLOC_POSIX = @GNULIB_REALLOC_POSIX@ +GNULIB_REALPATH = @GNULIB_REALPATH@ GNULIB_RMDIR = @GNULIB_RMDIR@ +GNULIB_RPMATCH = @GNULIB_RPMATCH@ +GNULIB_SETENV = @GNULIB_SETENV@ GNULIB_SLEEP = @GNULIB_SLEEP@ +GNULIB_STAT = @GNULIB_STAT@ GNULIB_STRPTIME = @GNULIB_STRPTIME@ +GNULIB_STRTOD = @GNULIB_STRTOD@ +GNULIB_STRTOLL = @GNULIB_STRTOLL@ +GNULIB_STRTOULL = @GNULIB_STRTOULL@ GNULIB_SYMLINK = @GNULIB_SYMLINK@ GNULIB_SYMLINKAT = @GNULIB_SYMLINKAT@ +GNULIB_SYSTEM_POSIX = @GNULIB_SYSTEM_POSIX@ GNULIB_TIMEGM = @GNULIB_TIMEGM@ GNULIB_TIME_R = @GNULIB_TIME_R@ GNULIB_TTYNAME_R = @GNULIB_TTYNAME_R@ @@ -178,8 +221,12 @@ GNULIB_UNISTD_H_GETOPT = @GNULIB_UNISTD_H_GETOPT@ GNULIB_UNISTD_H_SIGPIPE = @GNULIB_UNISTD_H_SIGPIPE@ GNULIB_UNLINK = @GNULIB_UNLINK@ GNULIB_UNLINKAT = @GNULIB_UNLINKAT@ +GNULIB_UNLOCKPT = @GNULIB_UNLOCKPT@ +GNULIB_UNSETENV = @GNULIB_UNSETENV@ GNULIB_USLEEP = @GNULIB_USLEEP@ +GNULIB_UTIMENSAT = @GNULIB_UTIMENSAT@ GNULIB_WRITE = @GNULIB_WRITE@ +GNULIB__EXIT = @GNULIB__EXIT@ GNU_OBJC_CFLAGS = @GNU_OBJC_CFLAGS@ GREP = @GREP@ GTK_CFLAGS = @GTK_CFLAGS@ @@ -187,53 +234,100 @@ GTK_LIBS = @GTK_LIBS@ GTK_OBJ = @GTK_OBJ@ GZIP_INFO = @GZIP_INFO@ GZIP_PROG = @GZIP_PROG@ +HAVE_ATOLL = @HAVE_ATOLL@ +HAVE_CANONICALIZE_FILE_NAME = @HAVE_CANONICALIZE_FILE_NAME@ HAVE_CHOWN = @HAVE_CHOWN@ HAVE_DECL_ENVIRON = @HAVE_DECL_ENVIRON@ HAVE_DECL_FCHDIR = @HAVE_DECL_FCHDIR@ HAVE_DECL_GETDOMAINNAME = @HAVE_DECL_GETDOMAINNAME@ +HAVE_DECL_GETLOADAVG = @HAVE_DECL_GETLOADAVG@ HAVE_DECL_GETLOGIN_R = @HAVE_DECL_GETLOGIN_R@ HAVE_DECL_GETPAGESIZE = @HAVE_DECL_GETPAGESIZE@ HAVE_DECL_GETUSERSHELL = @HAVE_DECL_GETUSERSHELL@ HAVE_DECL_LOCALTIME_R = @HAVE_DECL_LOCALTIME_R@ +HAVE_DECL_SETENV = @HAVE_DECL_SETENV@ HAVE_DECL_TTYNAME_R = @HAVE_DECL_TTYNAME_R@ +HAVE_DECL_UNSETENV = @HAVE_DECL_UNSETENV@ HAVE_DUP2 = @HAVE_DUP2@ HAVE_DUP3 = @HAVE_DUP3@ HAVE_EUIDACCESS = @HAVE_EUIDACCESS@ HAVE_FACCESSAT = @HAVE_FACCESSAT@ HAVE_FCHDIR = @HAVE_FCHDIR@ +HAVE_FCHMODAT = @HAVE_FCHMODAT@ HAVE_FCHOWNAT = @HAVE_FCHOWNAT@ +HAVE_FSTATAT = @HAVE_FSTATAT@ HAVE_FSYNC = @HAVE_FSYNC@ HAVE_FTRUNCATE = @HAVE_FTRUNCATE@ +HAVE_FUTIMENS = @HAVE_FUTIMENS@ HAVE_GETDTABLESIZE = @HAVE_GETDTABLESIZE@ HAVE_GETGROUPS = @HAVE_GETGROUPS@ HAVE_GETHOSTNAME = @HAVE_GETHOSTNAME@ HAVE_GETLOGIN = @HAVE_GETLOGIN@ HAVE_GETOPT_H = @HAVE_GETOPT_H@ HAVE_GETPAGESIZE = @HAVE_GETPAGESIZE@ +HAVE_GETSUBOPT = @HAVE_GETSUBOPT@ +HAVE_GRANTPT = @HAVE_GRANTPT@ +HAVE_INTTYPES_H = @HAVE_INTTYPES_H@ +HAVE_LCHMOD = @HAVE_LCHMOD@ HAVE_LCHOWN = @HAVE_LCHOWN@ HAVE_LINK = @HAVE_LINK@ HAVE_LINKAT = @HAVE_LINKAT@ +HAVE_LONG_LONG_INT = @HAVE_LONG_LONG_INT@ +HAVE_LSTAT = @HAVE_LSTAT@ HAVE_MAKEINFO = @HAVE_MAKEINFO@ +HAVE_MKDIRAT = @HAVE_MKDIRAT@ +HAVE_MKDTEMP = @HAVE_MKDTEMP@ +HAVE_MKFIFO = @HAVE_MKFIFO@ +HAVE_MKFIFOAT = @HAVE_MKFIFOAT@ +HAVE_MKNOD = @HAVE_MKNOD@ +HAVE_MKNODAT = @HAVE_MKNODAT@ +HAVE_MKOSTEMP = @HAVE_MKOSTEMP@ +HAVE_MKOSTEMPS = @HAVE_MKOSTEMPS@ +HAVE_MKSTEMP = @HAVE_MKSTEMP@ +HAVE_MKSTEMPS = @HAVE_MKSTEMPS@ HAVE_NANOSLEEP = @HAVE_NANOSLEEP@ HAVE_OS_H = @HAVE_OS_H@ HAVE_PIPE = @HAVE_PIPE@ HAVE_PIPE2 = @HAVE_PIPE2@ HAVE_PREAD = @HAVE_PREAD@ +HAVE_PTSNAME = @HAVE_PTSNAME@ HAVE_PWRITE = @HAVE_PWRITE@ +HAVE_RANDOM_H = @HAVE_RANDOM_H@ +HAVE_RANDOM_R = @HAVE_RANDOM_R@ HAVE_READLINK = @HAVE_READLINK@ HAVE_READLINKAT = @HAVE_READLINKAT@ +HAVE_REALPATH = @HAVE_REALPATH@ +HAVE_RPMATCH = @HAVE_RPMATCH@ +HAVE_SETENV = @HAVE_SETENV@ +HAVE_SIGNED_SIG_ATOMIC_T = @HAVE_SIGNED_SIG_ATOMIC_T@ +HAVE_SIGNED_WCHAR_T = @HAVE_SIGNED_WCHAR_T@ +HAVE_SIGNED_WINT_T = @HAVE_SIGNED_WINT_T@ HAVE_SLEEP = @HAVE_SLEEP@ +HAVE_STDINT_H = @HAVE_STDINT_H@ HAVE_STRPTIME = @HAVE_STRPTIME@ +HAVE_STRTOD = @HAVE_STRTOD@ +HAVE_STRTOLL = @HAVE_STRTOLL@ +HAVE_STRTOULL = @HAVE_STRTOULL@ +HAVE_STRUCT_RANDOM_DATA = @HAVE_STRUCT_RANDOM_DATA@ HAVE_SYMLINK = @HAVE_SYMLINK@ HAVE_SYMLINKAT = @HAVE_SYMLINKAT@ +HAVE_SYS_BITYPES_H = @HAVE_SYS_BITYPES_H@ +HAVE_SYS_INTTYPES_H = @HAVE_SYS_INTTYPES_H@ +HAVE_SYS_LOADAVG_H = @HAVE_SYS_LOADAVG_H@ HAVE_SYS_PARAM_H = @HAVE_SYS_PARAM_H@ +HAVE_SYS_TYPES_H = @HAVE_SYS_TYPES_H@ HAVE_TIMEGM = @HAVE_TIMEGM@ HAVE_UNISTD_H = @HAVE_UNISTD_H@ HAVE_UNLINKAT = @HAVE_UNLINKAT@ +HAVE_UNLOCKPT = @HAVE_UNLOCKPT@ +HAVE_UNSIGNED_LONG_LONG_INT = @HAVE_UNSIGNED_LONG_LONG_INT@ HAVE_USLEEP = @HAVE_USLEEP@ +HAVE_UTIMENSAT = @HAVE_UTIMENSAT@ +HAVE_WCHAR_H = @HAVE_WCHAR_H@ HAVE_WCHAR_T = @HAVE_WCHAR_T@ HAVE_XSERVER = @HAVE_XSERVER@ HAVE__BOOL = @HAVE__BOOL@ +HAVE__EXIT = @HAVE__EXIT@ IMAGEMAGICK_CFLAGS = @IMAGEMAGICK_CFLAGS@ IMAGEMAGICK_LIBS = @IMAGEMAGICK_LIBS@ INCLUDE_NEXT = @INCLUDE_NEXT@ @@ -244,7 +338,6 @@ INSTALL_INFO = @INSTALL_INFO@ INSTALL_PROGRAM = @INSTALL_PROGRAM@ INSTALL_SCRIPT = @INSTALL_SCRIPT@ INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ -KMEM_GROUP = @KMEM_GROUP@ KRB4LIB = @KRB4LIB@ KRB5LIB = @KRB5LIB@ LDFLAGS = @LDFLAGS@ @@ -297,13 +390,18 @@ MKDEPDIR = @MKDEPDIR@ MKDIR_P = @MKDIR_P@ MOUSE_SUPPORT = @MOUSE_SUPPORT@ M_FILE = @M_FILE@ -NEED_SETGID = @NEED_SETGID@ NEXT_AS_FIRST_DIRECTIVE_GETOPT_H = @NEXT_AS_FIRST_DIRECTIVE_GETOPT_H@ NEXT_AS_FIRST_DIRECTIVE_STDDEF_H = @NEXT_AS_FIRST_DIRECTIVE_STDDEF_H@ +NEXT_AS_FIRST_DIRECTIVE_STDINT_H = @NEXT_AS_FIRST_DIRECTIVE_STDINT_H@ +NEXT_AS_FIRST_DIRECTIVE_STDLIB_H = @NEXT_AS_FIRST_DIRECTIVE_STDLIB_H@ +NEXT_AS_FIRST_DIRECTIVE_SYS_STAT_H = @NEXT_AS_FIRST_DIRECTIVE_SYS_STAT_H@ NEXT_AS_FIRST_DIRECTIVE_TIME_H = @NEXT_AS_FIRST_DIRECTIVE_TIME_H@ NEXT_AS_FIRST_DIRECTIVE_UNISTD_H = @NEXT_AS_FIRST_DIRECTIVE_UNISTD_H@ NEXT_GETOPT_H = @NEXT_GETOPT_H@ NEXT_STDDEF_H = @NEXT_STDDEF_H@ +NEXT_STDINT_H = @NEXT_STDINT_H@ +NEXT_STDLIB_H = @NEXT_STDLIB_H@ +NEXT_SYS_STAT_H = @NEXT_SYS_STAT_H@ NEXT_TIME_H = @NEXT_TIME_H@ NEXT_UNISTD_H = @NEXT_UNISTD_H@ NS_OBJ = @NS_OBJ@ @@ -329,13 +427,19 @@ PRAGMA_SYSTEM_HEADER = @PRAGMA_SYSTEM_HEADER@ PRE_ALLOC_OBJ = @PRE_ALLOC_OBJ@ PROFILING_CFLAGS = @PROFILING_CFLAGS@ PTHREAD_H_DEFINES_STRUCT_TIMESPEC = @PTHREAD_H_DEFINES_STRUCT_TIMESPEC@ +PTRDIFF_T_SUFFIX = @PTRDIFF_T_SUFFIX@ RALLOC_OBJ = @RALLOC_OBJ@ RANLIB = @RANLIB@ +REPLACE_CALLOC = @REPLACE_CALLOC@ +REPLACE_CANONICALIZE_FILE_NAME = @REPLACE_CANONICALIZE_FILE_NAME@ REPLACE_CHOWN = @REPLACE_CHOWN@ REPLACE_CLOSE = @REPLACE_CLOSE@ REPLACE_DUP = @REPLACE_DUP@ REPLACE_DUP2 = @REPLACE_DUP2@ REPLACE_FCHOWNAT = @REPLACE_FCHOWNAT@ +REPLACE_FSTAT = @REPLACE_FSTAT@ +REPLACE_FSTATAT = @REPLACE_FSTATAT@ +REPLACE_FUTIMENS = @REPLACE_FUTIMENS@ REPLACE_GETCWD = @REPLACE_GETCWD@ REPLACE_GETDOMAINNAME = @REPLACE_GETDOMAINNAME@ REPLACE_GETGROUPS = @REPLACE_GETGROUPS@ @@ -346,28 +450,45 @@ REPLACE_LINK = @REPLACE_LINK@ REPLACE_LINKAT = @REPLACE_LINKAT@ REPLACE_LOCALTIME_R = @REPLACE_LOCALTIME_R@ REPLACE_LSEEK = @REPLACE_LSEEK@ +REPLACE_LSTAT = @REPLACE_LSTAT@ +REPLACE_MALLOC = @REPLACE_MALLOC@ +REPLACE_MKDIR = @REPLACE_MKDIR@ +REPLACE_MKFIFO = @REPLACE_MKFIFO@ +REPLACE_MKNOD = @REPLACE_MKNOD@ +REPLACE_MKSTEMP = @REPLACE_MKSTEMP@ REPLACE_MKTIME = @REPLACE_MKTIME@ REPLACE_NANOSLEEP = @REPLACE_NANOSLEEP@ REPLACE_NULL = @REPLACE_NULL@ REPLACE_PREAD = @REPLACE_PREAD@ +REPLACE_PUTENV = @REPLACE_PUTENV@ REPLACE_PWRITE = @REPLACE_PWRITE@ REPLACE_READLINK = @REPLACE_READLINK@ +REPLACE_REALLOC = @REPLACE_REALLOC@ +REPLACE_REALPATH = @REPLACE_REALPATH@ REPLACE_RMDIR = @REPLACE_RMDIR@ +REPLACE_SETENV = @REPLACE_SETENV@ REPLACE_SLEEP = @REPLACE_SLEEP@ +REPLACE_STAT = @REPLACE_STAT@ +REPLACE_STRTOD = @REPLACE_STRTOD@ REPLACE_SYMLINK = @REPLACE_SYMLINK@ REPLACE_TIMEGM = @REPLACE_TIMEGM@ REPLACE_TTYNAME_R = @REPLACE_TTYNAME_R@ REPLACE_UNLINK = @REPLACE_UNLINK@ REPLACE_UNLINKAT = @REPLACE_UNLINKAT@ +REPLACE_UNSETENV = @REPLACE_UNSETENV@ REPLACE_USLEEP = @REPLACE_USLEEP@ +REPLACE_UTIMENSAT = @REPLACE_UTIMENSAT@ REPLACE_WRITE = @REPLACE_WRITE@ RSVG_CFLAGS = @RSVG_CFLAGS@ RSVG_LIBS = @RSVG_LIBS@ SET_MAKE = @SET_MAKE@ SHELL = @SHELL@ +SIG_ATOMIC_T_SUFFIX = @SIG_ATOMIC_T_SUFFIX@ +SIZE_T_SUFFIX = @SIZE_T_SUFFIX@ START_FILES = @START_FILES@ STDBOOL_H = @STDBOOL_H@ STDDEF_H = @STDDEF_H@ +STDINT_H = @STDINT_H@ STRIP = @STRIP@ SYS_TIME_H_DEFINES_STRUCT_TIMESPEC = @SYS_TIME_H_DEFINES_STRUCT_TIMESPEC@ S_FILE = @S_FILE@ @@ -381,8 +502,10 @@ UNISTD_H_HAVE_WINSOCK2_H = @UNISTD_H_HAVE_WINSOCK2_H@ UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS = @UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS@ VERSION = @VERSION@ VMLIMIT_OBJ = @VMLIMIT_OBJ@ +WCHAR_T_SUFFIX = @WCHAR_T_SUFFIX@ WIDGET_OBJ = @WIDGET_OBJ@ WINDOW_SUPPORT = @WINDOW_SUPPORT@ +WINT_T_SUFFIX = @WINT_T_SUFFIX@ XFT_CFLAGS = @XFT_CFLAGS@ XFT_LIBS = @XFT_LIBS@ XMENU_OBJ = @XMENU_OBJ@ @@ -472,23 +595,27 @@ x_default_search_path = @x_default_search_path@ # present in all Makefile.am that need it. This is ensured by the applicability # 'all' defined above. BUILT_SOURCES = arg-nonnull.h c++defs.h $(GETOPT_H) $(STDBOOL_H) \ - $(STDDEF_H) time.h unistd.h warn-on-use.h + $(STDDEF_H) $(STDINT_H) stdlib.h sys/stat.h time.h unistd.h \ + warn-on-use.h EXTRA_DIST = $(top_srcdir)/./arg-nonnull.h $(top_srcdir)/./c++defs.h \ - ftoastr.c ftoastr.h getopt.c getopt.in.h getopt1.c \ - getopt_int.h intprops.h mktime-internal.h mktime.c \ - stdbool.in.h stddef.in.h strftime.c strftime.h time.in.h \ - time_r.c unistd.in.h $(top_srcdir)/./warn-on-use.h + md5.c md5.h ftoastr.c ftoastr.h filemode.c filemode.h \ + getloadavg.c getopt.c getopt.in.h getopt1.c getopt_int.h \ + intprops.h mktime-internal.h mktime.c stdbool.in.h stddef.in.h \ + stdint.in.h stdlib.in.h strftime.c strftime.h sys_stat.in.h \ + time.in.h time_r.c unistd.in.h $(top_srcdir)/./warn-on-use.h +MOSTLYCLEANDIRS = sys MOSTLYCLEANFILES = core *.stackdump arg-nonnull.h arg-nonnull.h-t \ c++defs.h c++defs.h-t getopt.h getopt.h-t stdbool.h \ - stdbool.h-t stddef.h stddef.h-t time.h time.h-t unistd.h \ + stdbool.h-t stddef.h stddef.h-t stdint.h stdint.h-t stdlib.h \ + stdlib.h-t sys/stat.h sys/stat.h-t time.h time.h-t unistd.h \ unistd.h-t warn-on-use.h warn-on-use.h-t noinst_LIBRARIES = libgnu.a DEFAULT_INCLUDES = -I. -I../src -I$(top_srcdir)/src libgnu_a_SOURCES = dtoastr.c gettext.h ignore-value.h libgnu_a_LIBADD = $(gl_LIBOBJS) libgnu_a_DEPENDENCIES = $(gl_LIBOBJS) -EXTRA_libgnu_a_SOURCES = ftoastr.c getopt.c getopt1.c mktime.c \ - strftime.c time_r.c +EXTRA_libgnu_a_SOURCES = md5.c ftoastr.c filemode.c getloadavg.c \ + getopt.c getopt1.c mktime.c strftime.c time_r.c ARG_NONNULL_H = arg-nonnull.h CXXDEFS_H = c++defs.h WARN_ON_USE_H = warn-on-use.h @@ -542,9 +669,12 @@ distclean-compile: -rm -f *.tab.c @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/dtoastr.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/filemode.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/ftoastr.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getloadavg.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getopt.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/getopt1.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/md5.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/mktime.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/strftime.Po@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/time_r.Po@am__quote@ @@ -819,6 +949,166 @@ stddef.h: stddef.in.h } > $@-t && \ mv $@-t $@ +# We need the following in order to create <stdint.h> when the system +# doesn't have one that works with the given compiler. +stdint.h: stdint.in.h + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ + sed -e 's/@''HAVE_STDINT_H''@/$(HAVE_STDINT_H)/g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ + -e 's|@''NEXT_STDINT_H''@|$(NEXT_STDINT_H)|g' \ + -e 's/@''HAVE_SYS_TYPES_H''@/$(HAVE_SYS_TYPES_H)/g' \ + -e 's/@''HAVE_INTTYPES_H''@/$(HAVE_INTTYPES_H)/g' \ + -e 's/@''HAVE_SYS_INTTYPES_H''@/$(HAVE_SYS_INTTYPES_H)/g' \ + -e 's/@''HAVE_SYS_BITYPES_H''@/$(HAVE_SYS_BITYPES_H)/g' \ + -e 's/@''HAVE_WCHAR_H''@/$(HAVE_WCHAR_H)/g' \ + -e 's/@''HAVE_LONG_LONG_INT''@/$(HAVE_LONG_LONG_INT)/g' \ + -e 's/@''HAVE_UNSIGNED_LONG_LONG_INT''@/$(HAVE_UNSIGNED_LONG_LONG_INT)/g' \ + -e 's/@''APPLE_UNIVERSAL_BUILD''@/$(APPLE_UNIVERSAL_BUILD)/g' \ + -e 's/@''BITSIZEOF_PTRDIFF_T''@/$(BITSIZEOF_PTRDIFF_T)/g' \ + -e 's/@''PTRDIFF_T_SUFFIX''@/$(PTRDIFF_T_SUFFIX)/g' \ + -e 's/@''BITSIZEOF_SIG_ATOMIC_T''@/$(BITSIZEOF_SIG_ATOMIC_T)/g' \ + -e 's/@''HAVE_SIGNED_SIG_ATOMIC_T''@/$(HAVE_SIGNED_SIG_ATOMIC_T)/g' \ + -e 's/@''SIG_ATOMIC_T_SUFFIX''@/$(SIG_ATOMIC_T_SUFFIX)/g' \ + -e 's/@''BITSIZEOF_SIZE_T''@/$(BITSIZEOF_SIZE_T)/g' \ + -e 's/@''SIZE_T_SUFFIX''@/$(SIZE_T_SUFFIX)/g' \ + -e 's/@''BITSIZEOF_WCHAR_T''@/$(BITSIZEOF_WCHAR_T)/g' \ + -e 's/@''HAVE_SIGNED_WCHAR_T''@/$(HAVE_SIGNED_WCHAR_T)/g' \ + -e 's/@''WCHAR_T_SUFFIX''@/$(WCHAR_T_SUFFIX)/g' \ + -e 's/@''BITSIZEOF_WINT_T''@/$(BITSIZEOF_WINT_T)/g' \ + -e 's/@''HAVE_SIGNED_WINT_T''@/$(HAVE_SIGNED_WINT_T)/g' \ + -e 's/@''WINT_T_SUFFIX''@/$(WINT_T_SUFFIX)/g' \ + < $(srcdir)/stdint.in.h; \ + } > $@-t && \ + mv $@-t $@ + +# We need the following in order to create <stdlib.h> when the system +# doesn't have one that works with the given compiler. +stdlib.h: stdlib.in.h $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ + sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ + -e 's|@''NEXT_STDLIB_H''@|$(NEXT_STDLIB_H)|g' \ + -e 's|@''GNULIB__EXIT''@|$(GNULIB__EXIT)|g' \ + -e 's|@''GNULIB_ATOLL''@|$(GNULIB_ATOLL)|g' \ + -e 's|@''GNULIB_CALLOC_POSIX''@|$(GNULIB_CALLOC_POSIX)|g' \ + -e 's|@''GNULIB_CANONICALIZE_FILE_NAME''@|$(GNULIB_CANONICALIZE_FILE_NAME)|g' \ + -e 's|@''GNULIB_GETLOADAVG''@|$(GNULIB_GETLOADAVG)|g' \ + -e 's|@''GNULIB_GETSUBOPT''@|$(GNULIB_GETSUBOPT)|g' \ + -e 's|@''GNULIB_GRANTPT''@|$(GNULIB_GRANTPT)|g' \ + -e 's|@''GNULIB_MALLOC_POSIX''@|$(GNULIB_MALLOC_POSIX)|g' \ + -e 's|@''GNULIB_MKDTEMP''@|$(GNULIB_MKDTEMP)|g' \ + -e 's|@''GNULIB_MKOSTEMP''@|$(GNULIB_MKOSTEMP)|g' \ + -e 's|@''GNULIB_MKOSTEMPS''@|$(GNULIB_MKOSTEMPS)|g' \ + -e 's|@''GNULIB_MKSTEMP''@|$(GNULIB_MKSTEMP)|g' \ + -e 's|@''GNULIB_MKSTEMPS''@|$(GNULIB_MKSTEMPS)|g' \ + -e 's|@''GNULIB_PTSNAME''@|$(GNULIB_PTSNAME)|g' \ + -e 's|@''GNULIB_PUTENV''@|$(GNULIB_PUTENV)|g' \ + -e 's|@''GNULIB_RANDOM_R''@|$(GNULIB_RANDOM_R)|g' \ + -e 's|@''GNULIB_REALLOC_POSIX''@|$(GNULIB_REALLOC_POSIX)|g' \ + -e 's|@''GNULIB_REALPATH''@|$(GNULIB_REALPATH)|g' \ + -e 's|@''GNULIB_RPMATCH''@|$(GNULIB_RPMATCH)|g' \ + -e 's|@''GNULIB_SETENV''@|$(GNULIB_SETENV)|g' \ + -e 's|@''GNULIB_STRTOD''@|$(GNULIB_STRTOD)|g' \ + -e 's|@''GNULIB_STRTOLL''@|$(GNULIB_STRTOLL)|g' \ + -e 's|@''GNULIB_STRTOULL''@|$(GNULIB_STRTOULL)|g' \ + -e 's|@''GNULIB_SYSTEM_POSIX''@|$(GNULIB_SYSTEM_POSIX)|g' \ + -e 's|@''GNULIB_UNLOCKPT''@|$(GNULIB_UNLOCKPT)|g' \ + -e 's|@''GNULIB_UNSETENV''@|$(GNULIB_UNSETENV)|g' \ + < $(srcdir)/stdlib.in.h | \ + sed -e 's|@''HAVE__EXIT''@|$(HAVE__EXIT)|g' \ + -e 's|@''HAVE_ATOLL''@|$(HAVE_ATOLL)|g' \ + -e 's|@''HAVE_CANONICALIZE_FILE_NAME''@|$(HAVE_CANONICALIZE_FILE_NAME)|g' \ + -e 's|@''HAVE_DECL_GETLOADAVG''@|$(HAVE_DECL_GETLOADAVG)|g' \ + -e 's|@''HAVE_GETSUBOPT''@|$(HAVE_GETSUBOPT)|g' \ + -e 's|@''HAVE_GRANTPT''@|$(HAVE_GRANTPT)|g' \ + -e 's|@''HAVE_MKDTEMP''@|$(HAVE_MKDTEMP)|g' \ + -e 's|@''HAVE_MKOSTEMP''@|$(HAVE_MKOSTEMP)|g' \ + -e 's|@''HAVE_MKOSTEMPS''@|$(HAVE_MKOSTEMPS)|g' \ + -e 's|@''HAVE_MKSTEMP''@|$(HAVE_MKSTEMP)|g' \ + -e 's|@''HAVE_MKSTEMPS''@|$(HAVE_MKSTEMPS)|g' \ + -e 's|@''HAVE_PTSNAME''@|$(HAVE_PTSNAME)|g' \ + -e 's|@''HAVE_RANDOM_H''@|$(HAVE_RANDOM_H)|g' \ + -e 's|@''HAVE_RANDOM_R''@|$(HAVE_RANDOM_R)|g' \ + -e 's|@''HAVE_REALPATH''@|$(HAVE_REALPATH)|g' \ + -e 's|@''HAVE_RPMATCH''@|$(HAVE_RPMATCH)|g' \ + -e 's|@''HAVE_DECL_SETENV''@|$(HAVE_DECL_SETENV)|g' \ + -e 's|@''HAVE_STRTOD''@|$(HAVE_STRTOD)|g' \ + -e 's|@''HAVE_STRTOLL''@|$(HAVE_STRTOLL)|g' \ + -e 's|@''HAVE_STRTOULL''@|$(HAVE_STRTOULL)|g' \ + -e 's|@''HAVE_STRUCT_RANDOM_DATA''@|$(HAVE_STRUCT_RANDOM_DATA)|g' \ + -e 's|@''HAVE_SYS_LOADAVG_H''@|$(HAVE_SYS_LOADAVG_H)|g' \ + -e 's|@''HAVE_UNLOCKPT''@|$(HAVE_UNLOCKPT)|g' \ + -e 's|@''HAVE_DECL_UNSETENV''@|$(HAVE_DECL_UNSETENV)|g' \ + -e 's|@''REPLACE_CALLOC''@|$(REPLACE_CALLOC)|g' \ + -e 's|@''REPLACE_CANONICALIZE_FILE_NAME''@|$(REPLACE_CANONICALIZE_FILE_NAME)|g' \ + -e 's|@''REPLACE_MALLOC''@|$(REPLACE_MALLOC)|g' \ + -e 's|@''REPLACE_MKSTEMP''@|$(REPLACE_MKSTEMP)|g' \ + -e 's|@''REPLACE_PUTENV''@|$(REPLACE_PUTENV)|g' \ + -e 's|@''REPLACE_REALLOC''@|$(REPLACE_REALLOC)|g' \ + -e 's|@''REPLACE_REALPATH''@|$(REPLACE_REALPATH)|g' \ + -e 's|@''REPLACE_SETENV''@|$(REPLACE_SETENV)|g' \ + -e 's|@''REPLACE_STRTOD''@|$(REPLACE_STRTOD)|g' \ + -e 's|@''REPLACE_UNSETENV''@|$(REPLACE_UNSETENV)|g' \ + -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \ + -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \ + -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)'; \ + } > $@-t && \ + mv $@-t $@ + +# We need the following in order to create <sys/stat.h> when the system +# has one that is incomplete. +sys/stat.h: sys_stat.in.h $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) + $(AM_V_at)$(MKDIR_P) sys + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ + sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ + -e 's|@''NEXT_SYS_STAT_H''@|$(NEXT_SYS_STAT_H)|g' \ + -e 's|@''GNULIB_FCHMODAT''@|$(GNULIB_FCHMODAT)|g' \ + -e 's|@''GNULIB_FSTATAT''@|$(GNULIB_FSTATAT)|g' \ + -e 's|@''GNULIB_FUTIMENS''@|$(GNULIB_FUTIMENS)|g' \ + -e 's|@''GNULIB_LCHMOD''@|$(GNULIB_LCHMOD)|g' \ + -e 's|@''GNULIB_LSTAT''@|$(GNULIB_LSTAT)|g' \ + -e 's|@''GNULIB_MKDIRAT''@|$(GNULIB_MKDIRAT)|g' \ + -e 's|@''GNULIB_MKFIFO''@|$(GNULIB_MKFIFO)|g' \ + -e 's|@''GNULIB_MKFIFOAT''@|$(GNULIB_MKFIFOAT)|g' \ + -e 's|@''GNULIB_MKNOD''@|$(GNULIB_MKNOD)|g' \ + -e 's|@''GNULIB_MKNODAT''@|$(GNULIB_MKNODAT)|g' \ + -e 's|@''GNULIB_STAT''@|$(GNULIB_STAT)|g' \ + -e 's|@''GNULIB_UTIMENSAT''@|$(GNULIB_UTIMENSAT)|g' \ + -e 's|@''HAVE_FCHMODAT''@|$(HAVE_FCHMODAT)|g' \ + -e 's|@''HAVE_FSTATAT''@|$(HAVE_FSTATAT)|g' \ + -e 's|@''HAVE_FUTIMENS''@|$(HAVE_FUTIMENS)|g' \ + -e 's|@''HAVE_LCHMOD''@|$(HAVE_LCHMOD)|g' \ + -e 's|@''HAVE_LSTAT''@|$(HAVE_LSTAT)|g' \ + -e 's|@''HAVE_MKDIRAT''@|$(HAVE_MKDIRAT)|g' \ + -e 's|@''HAVE_MKFIFO''@|$(HAVE_MKFIFO)|g' \ + -e 's|@''HAVE_MKFIFOAT''@|$(HAVE_MKFIFOAT)|g' \ + -e 's|@''HAVE_MKNOD''@|$(HAVE_MKNOD)|g' \ + -e 's|@''HAVE_MKNODAT''@|$(HAVE_MKNODAT)|g' \ + -e 's|@''HAVE_UTIMENSAT''@|$(HAVE_UTIMENSAT)|g' \ + -e 's|@''REPLACE_FSTAT''@|$(REPLACE_FSTAT)|g' \ + -e 's|@''REPLACE_FSTATAT''@|$(REPLACE_FSTATAT)|g' \ + -e 's|@''REPLACE_FUTIMENS''@|$(REPLACE_FUTIMENS)|g' \ + -e 's|@''REPLACE_LSTAT''@|$(REPLACE_LSTAT)|g' \ + -e 's|@''REPLACE_MKDIR''@|$(REPLACE_MKDIR)|g' \ + -e 's|@''REPLACE_MKFIFO''@|$(REPLACE_MKFIFO)|g' \ + -e 's|@''REPLACE_MKNOD''@|$(REPLACE_MKNOD)|g' \ + -e 's|@''REPLACE_STAT''@|$(REPLACE_STAT)|g' \ + -e 's|@''REPLACE_UTIMENSAT''@|$(REPLACE_UTIMENSAT)|g' \ + -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \ + -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \ + -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \ + < $(srcdir)/sys_stat.in.h; \ + } > $@-t && \ + mv $@-t $@ + # We need the following in order to create <time.h> when the system # doesn't have one that works with the given compiler. time.h: time.in.h $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) diff --git a/lib/filemode.c b/lib/filemode.c new file mode 100644 index 00000000000..0f6641ace6a --- /dev/null +++ b/lib/filemode.c @@ -0,0 +1,180 @@ +/* filemode.c -- make a string describing file modes + + Copyright (C) 1985, 1990, 1993, 1998-2000, 2004, 2006, 2009-2011 Free + Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see <http://www.gnu.org/licenses/>. */ + +#include <config.h> + +#include "filemode.h" + +/* The following is for Cray DMF (Data Migration Facility), which is a + HSM file system. A migrated file has a `st_dm_mode' that is + different from the normal `st_mode', so any tests for migrated + files should use the former. */ +#if HAVE_ST_DM_MODE +# define IS_MIGRATED_FILE(statp) \ + (S_ISOFD (statp->st_dm_mode) || S_ISOFL (statp->st_dm_mode)) +#else +# define IS_MIGRATED_FILE(statp) 0 +#endif + +#if ! HAVE_DECL_STRMODE + +/* Return a character indicating the type of file described by + file mode BITS: + '-' regular file + 'b' block special file + 'c' character special file + 'C' high performance ("contiguous data") file + 'd' directory + 'D' door + 'l' symbolic link + 'm' multiplexed file (7th edition Unix; obsolete) + 'n' network special file (HP-UX) + 'p' fifo (named pipe) + 'P' port + 's' socket + 'w' whiteout (4.4BSD) + '?' some other file type */ + +static char +ftypelet (mode_t bits) +{ + /* These are the most common, so test for them first. */ + if (S_ISREG (bits)) + return '-'; + if (S_ISDIR (bits)) + return 'd'; + + /* Other letters standardized by POSIX 1003.1-2004. */ + if (S_ISBLK (bits)) + return 'b'; + if (S_ISCHR (bits)) + return 'c'; + if (S_ISLNK (bits)) + return 'l'; + if (S_ISFIFO (bits)) + return 'p'; + + /* Other file types (though not letters) standardized by POSIX. */ + if (S_ISSOCK (bits)) + return 's'; + + /* Nonstandard file types. */ + if (S_ISCTG (bits)) + return 'C'; + if (S_ISDOOR (bits)) + return 'D'; + if (S_ISMPB (bits) || S_ISMPC (bits)) + return 'm'; + if (S_ISNWK (bits)) + return 'n'; + if (S_ISPORT (bits)) + return 'P'; + if (S_ISWHT (bits)) + return 'w'; + + return '?'; +} + +/* Like filemodestring, but rely only on MODE. */ + +void +strmode (mode_t mode, char *str) +{ + str[0] = ftypelet (mode); + str[1] = mode & S_IRUSR ? 'r' : '-'; + str[2] = mode & S_IWUSR ? 'w' : '-'; + str[3] = (mode & S_ISUID + ? (mode & S_IXUSR ? 's' : 'S') + : (mode & S_IXUSR ? 'x' : '-')); + str[4] = mode & S_IRGRP ? 'r' : '-'; + str[5] = mode & S_IWGRP ? 'w' : '-'; + str[6] = (mode & S_ISGID + ? (mode & S_IXGRP ? 's' : 'S') + : (mode & S_IXGRP ? 'x' : '-')); + str[7] = mode & S_IROTH ? 'r' : '-'; + str[8] = mode & S_IWOTH ? 'w' : '-'; + str[9] = (mode & S_ISVTX + ? (mode & S_IXOTH ? 't' : 'T') + : (mode & S_IXOTH ? 'x' : '-')); + str[10] = ' '; + str[11] = '\0'; +} + +#endif /* ! HAVE_DECL_STRMODE */ + +/* filemodestring - fill in string STR with an ls-style ASCII + representation of the st_mode field of file stats block STATP. + 12 characters are stored in STR. + The characters stored in STR are: + + 0 File type, as in ftypelet above, except that other letters are used + for files whose type cannot be determined solely from st_mode: + + 'F' semaphore + 'M' migrated file (Cray DMF) + 'Q' message queue + 'S' shared memory object + 'T' typed memory object + + 1 'r' if the owner may read, '-' otherwise. + + 2 'w' if the owner may write, '-' otherwise. + + 3 'x' if the owner may execute, 's' if the file is + set-user-id, '-' otherwise. + 'S' if the file is set-user-id, but the execute + bit isn't set. + + 4 'r' if group members may read, '-' otherwise. + + 5 'w' if group members may write, '-' otherwise. + + 6 'x' if group members may execute, 's' if the file is + set-group-id, '-' otherwise. + 'S' if it is set-group-id but not executable. + + 7 'r' if any user may read, '-' otherwise. + + 8 'w' if any user may write, '-' otherwise. + + 9 'x' if any user may execute, 't' if the file is "sticky" + (will be retained in swap space after execution), '-' + otherwise. + 'T' if the file is sticky but not executable. + + 10 ' ' for compatibility with 4.4BSD strmode, + since this interface does not support ACLs. + + 11 '\0'. */ + +void +filemodestring (struct stat const *statp, char *str) +{ + strmode (statp->st_mode, str); + + if (S_TYPEISSEM (statp)) + str[0] = 'F'; + else if (IS_MIGRATED_FILE (statp)) + str[0] = 'M'; + else if (S_TYPEISMQ (statp)) + str[0] = 'Q'; + else if (S_TYPEISSHM (statp)) + str[0] = 'S'; + else if (S_TYPEISTMO (statp)) + str[0] = 'T'; +} diff --git a/lib/filemode.h b/lib/filemode.h new file mode 100644 index 00000000000..1a50302704c --- /dev/null +++ b/lib/filemode.h @@ -0,0 +1,44 @@ +/* Make a string describing file modes. + + Copyright (C) 1998-1999, 2003, 2006, 2009-2011 Free Software Foundation, + Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see <http://www.gnu.org/licenses/>. */ + +#ifndef FILEMODE_H_ + +# include <sys/types.h> +# include <sys/stat.h> + +/* Get the declaration of strmode. */ +# if HAVE_DECL_STRMODE +# include <string.h> /* MacOS X, FreeBSD, OpenBSD */ +# include <unistd.h> /* NetBSD */ +# endif + +# ifdef __cplusplus +extern "C" { +# endif + +# if !HAVE_DECL_STRMODE +extern void strmode (mode_t mode, char *str); +# endif + +extern void filemodestring (struct stat const *statp, char *str); + +# ifdef __cplusplus +} +# endif + +#endif diff --git a/src/getloadavg.c b/lib/getloadavg.c index d9c24717b79..d324451ef15 100644 --- a/src/getloadavg.c +++ b/lib/getloadavg.c @@ -1,15 +1,15 @@ /* Get the system load averages. - Copyright (C) 1985, 1986, 1987, 1988, 1989, 1991, 1992, 1993, 1994, 1995, - 1997, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 - Free Software Foundation, Inc. + + Copyright (C) 1985-1989, 1991-1995, 1997, 1999-2000, 2003-2011 Free Software + Foundation, Inc. NOTE: The canonical source of this file is maintained with gnulib. Bugs can be reported to bug-gnulib@gnu.org. - This program is free software; you can redistribute it and/or modify + This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 2, or (at your option) - any later version. + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -17,62 +17,62 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, - USA. */ + along with this program. If not, see <http://www.gnu.org/licenses/>. */ /* Compile-time symbols that this file uses: - HAVE_PSTAT_GETDYNAMIC Define this if your system has the + HAVE_PSTAT_GETDYNAMIC Define this if your system has the pstat_getdynamic function. I think it - is unique to HPUX9. The best way to get the - definition is through the AC_FUNC_GETLOADAVG - macro that comes with autoconf 2.13 or newer. - If that isn't an option, then just put - AC_CHECK_FUNCS(pstat_getdynamic) in your - configure.in file. - FIXUP_KERNEL_SYMBOL_ADDR() Adjust address in returned struct nlist. - KERNEL_FILE Pathname of the kernel to nlist. - LDAV_CVT() Scale the load average from the kernel. - Returns a double. - LDAV_SYMBOL Name of kernel symbol giving load average. - LOAD_AVE_TYPE Type of the load average array in the kernel. - Must be defined unless one of - apollo, DGUX, NeXT, or UMAX is defined; + is unique to HPUX9. The best way to get the + definition is through the AC_FUNC_GETLOADAVG + macro that comes with autoconf 2.13 or newer. + If that isn't an option, then just put + AC_CHECK_FUNCS(pstat_getdynamic) in your + configure.in file. + HAVE_LIBPERFSTAT Define this if your system has the + perfstat_cpu_total function in libperfstat (AIX). + FIXUP_KERNEL_SYMBOL_ADDR() Adjust address in returned struct nlist. + KERNEL_FILE Name of the kernel file to nlist. + LDAV_CVT() Scale the load average from the kernel. + Returns a double. + LDAV_SYMBOL Name of kernel symbol giving load average. + LOAD_AVE_TYPE Type of the load average array in the kernel. + Must be defined unless one of + apollo, DGUX, NeXT, or UMAX is defined; or we have libkstat; - otherwise, no load average is available. + otherwise, no load average is available. HAVE_NLIST_H nlist.h is available. NLIST_STRUCT defaults to this. - NLIST_STRUCT Include nlist.h, not a.out.h, and - the nlist n_name element is a pointer, - not an array. + NLIST_STRUCT Include nlist.h, not a.out.h. + N_NAME_POINTER The nlist n_name element is a pointer, + not an array. HAVE_STRUCT_NLIST_N_UN_N_NAME `n_un.n_name' is member of `struct nlist'. - LINUX_LDAV_FILE [__linux__]: File containing load averages. - HAVE_LOCALE_H locale.h is available. - HAVE_SETLOCALE The `setlocale' function is available. + LINUX_LDAV_FILE [__linux__, __CYGWIN__]: File containing + load averages. Specific system predefines this file uses, aside from setting default values if not emacs: apollo - BSD Real BSD, not just BSD-like. + BSD Real BSD, not just BSD-like. convex DGUX - eunice UNIX emulator under VMS. + eunice UNIX emulator under VMS. hpux - __MSDOS__ No-op for MSDOS. + __MSDOS__ No-op for MSDOS. NeXT sgi - sequent Sequent Dynix 3.x.x (BSD) - _SEQUENT_ Sequent DYNIX/ptx 1.x.x (SYSV) + sequent Sequent Dynix 3.x.x (BSD) + _SEQUENT_ Sequent DYNIX/ptx 1.x.x (SYSV) sony_news NEWS-OS (works at least for 4.1C) UMAX UMAX4_3 VMS - WINDOWS32 No-op for Windows95/NT. - __linux__ Linux: assumes /proc filesystem mounted. - Support from Michael K. Johnson. - __NetBSD__ NetBSD: assumes /kern filesystem mounted. + WINDOWS32 No-op for Windows95/NT. + __linux__ Linux: assumes /proc file system mounted. + Support from Michael K. Johnson. + __CYGWIN__ Cygwin emulates linux /proc/loadavg. + __NetBSD__ NetBSD: assumes /kern file system mounted. In addition, to avoid nesting many #ifdefs, we internally set LDAV_DONE to indicate that the load average has been computed. @@ -80,41 +80,30 @@ We also #define LDAV_PRIVILEGED if a program will require special installation to be able to call getloadavg. */ -/* This should always be first. */ -#ifdef HAVE_CONFIG_H -# include <config.h> -#endif +/* "configure" defines CONFIGURING_GETLOADAVG to sidestep problems + with partially-configured source directories. */ -#include <sys/types.h> - -/* Both the Emacs and non-Emacs sections want this. Some - configuration files' definitions for the LOAD_AVE_CVT macro (like - sparc.h's) use macros like FSCALE, defined here. */ -#if defined (unix) || defined (__unix) -# include <sys/param.h> +#ifndef CONFIGURING_GETLOADAVG +# include <config.h> +# include <stdbool.h> #endif - -/* Exclude all the code except the test program at the end - if the system has its own `getloadavg' function. - - The declaration of `errno' is needed by the test program - as well as the function itself, so it comes first. */ +/* Specification. */ +#include <stdlib.h> #include <errno.h> +#include <stdio.h> -#ifndef errno -extern int errno; -#endif +# include <sys/types.h> -#ifdef HAVE_LOCALE_H -# include <locale.h> -#endif -#ifndef HAVE_SETLOCALE -# define setlocale(Category, Locale) /* empty */ -#endif +/* Both the Emacs and non-Emacs sections want this. Some + configuration files' definitions for the LOAD_AVE_CVT macro (like + sparc.h's) use macros like FSCALE, defined here. */ +# if defined (unix) || defined (__unix) +# include <sys/param.h> +# endif -#ifndef HAVE_GETLOADAVG +# include "intprops.h" /* The existing Emacs configuration files define a macro called LOAD_AVE_CVT, which accepts a value of type LOAD_AVE_TYPE, and @@ -126,7 +115,7 @@ extern int errno; LOAD_AVE_CVT, but future machine config files should just define LDAV_CVT directly. */ -# if !defined(LDAV_CVT) && defined(LOAD_AVE_CVT) +# if !defined (LDAV_CVT) && defined (LOAD_AVE_CVT) # define LDAV_CVT(n) (LOAD_AVE_CVT (n) / 100.0) # endif @@ -170,11 +159,11 @@ extern int errno; # define sun # endif -# if defined(hp300) && !defined(hpux) +# if defined (hp300) && !defined (hpux) # define MORE_BSD # endif -# if defined(ultrix) && defined(mips) +# if defined (ultrix) && defined (mips) # define decstation # endif @@ -182,7 +171,7 @@ extern int errno; # define SVR4 # endif -# if (defined(sun) && defined(SVR4)) || defined (SOLARIS2) +# if (defined (sun) && defined (SVR4)) || defined (SOLARIS2) # define SUNOS_5 # endif @@ -192,6 +181,8 @@ extern int errno; # include <sys/socket.h> # include <net/route.h> # include <sys/table.h> +/* Tru64 4.0D's table.h redefines sys */ +# undef sys # endif # if defined (__osf__) && (defined (mips) || defined (__mips__)) @@ -203,7 +194,7 @@ extern int errno; default, but _MACH_IND_SYS_TYPES is defined in <sys/types.h>. Combine that with a couple of other things and we'll have a unique match. */ # if !defined (tek4300) && defined (unix) && defined (m68k) && defined (mc68000) && defined (mc68020) && defined (_MACH_IND_SYS_TYPES) -# define tek4300 /* Define by emacs, but not by other users. */ +# define tek4300 /* Define by emacs, but not by other users. */ # endif @@ -254,11 +245,11 @@ extern int errno; # define LOAD_AVE_TYPE long # endif -# if defined(alliant) && defined(i860) /* Alliant FX/2800 */ +# if defined (alliant) && defined (i860) /* Alliant FX/2800 */ # define LOAD_AVE_TYPE long # endif -# ifdef _AIX +# if defined _AIX && ! defined HAVE_LIBPERFSTAT # define LOAD_AVE_TYPE long # endif @@ -278,7 +269,7 @@ extern int errno; # define FSCALE 1024.0 # endif -# if defined(alliant) && defined(i860) /* Alliant FX/2800 */ +# if defined (alliant) && defined (i860) /* Alliant FX/2800 */ /* <sys/param.h> defines an incorrect value for FSCALE on an Alliant FX/2800 Concentrix 2.2, according to ghazi@noc.rutgers.edu. */ # undef FSCALE @@ -286,7 +277,7 @@ extern int errno; # endif -# ifndef FSCALE +# ifndef FSCALE /* SunOS and some others define FSCALE in sys/param.h. */ @@ -294,7 +285,7 @@ extern int errno; # define FSCALE 2048.0 # endif -# if defined(MIPS) || defined(SVR4) || defined(decstation) +# if defined (MIPS) || defined (SVR4) || defined (decstation) # define FSCALE 256 # endif @@ -313,11 +304,11 @@ extern int errno; # define FSCALE 100.0 # endif -# ifdef _AIX +# if defined _AIX && !defined HAVE_LIBPERFSTAT # define FSCALE 65536.0 # endif -# endif /* Not FSCALE. */ +# endif /* Not FSCALE. */ # if !defined (LDAV_CVT) && defined (FSCALE) # define LDAV_CVT(n) (((double) (n)) / FSCALE) @@ -329,7 +320,7 @@ extern int errno; # endif # endif -# if defined(sgi) || (defined(mips) && !defined(BSD)) +# if defined (sgi) || (defined (mips) && !defined (BSD)) # define FIXUP_KERNEL_SYMBOL_ADDR(nl) ((nl)[0].n_value &= ~(1 << 31)) # endif @@ -342,7 +333,7 @@ extern int errno; # define KERNEL_FILE "/hp-ux" # endif -# if !defined(KERNEL_FILE) && (defined(_SEQUENT_) || defined(MIPS) || defined(SVR4) || defined(ISC) || defined (sgi) || (defined (ardent) && defined (titan))) +# if !defined (KERNEL_FILE) && (defined (_SEQUENT_) || defined (MIPS) || defined (SVR4) || defined (ISC) || defined (sgi) || (defined (ardent) && defined (titan))) # define KERNEL_FILE "/unix" # endif @@ -351,22 +342,21 @@ extern int errno; # define LDAV_SYMBOL "_Loadavg" # endif -# if !defined(LDAV_SYMBOL) && ((defined(hpux) && !defined(hp9000s300)) || defined(_SEQUENT_) || defined(SVR4) || defined(ISC) || defined(sgi) || (defined (ardent) && defined (titan)) || defined (_AIX)) +# if !defined (LDAV_SYMBOL) && ((defined (hpux) && !defined (hp9000s300)) || defined (_SEQUENT_) || defined (SVR4) || defined (ISC) || defined (sgi) || (defined (ardent) && defined (titan)) || (defined (_AIX) && !defined(HAVE_LIBPERFSTAT))) # define LDAV_SYMBOL "avenrun" # endif # include <unistd.h> -# include <stdio.h> /* LOAD_AVE_TYPE should only get defined if we're going to use the nlist method. */ -# if !defined(LOAD_AVE_TYPE) && (defined(BSD) || defined(LDAV_CVT) || defined(KERNEL_FILE) || defined(LDAV_SYMBOL)) +# if !defined (LOAD_AVE_TYPE) && (defined (BSD) || defined (LDAV_CVT) || defined (KERNEL_FILE) || defined (LDAV_SYMBOL)) # define LOAD_AVE_TYPE double # endif # ifdef LOAD_AVE_TYPE -# ifndef VMS +# ifndef __VMS # ifndef __linux__ # ifndef NLIST_STRUCT # include <a.out.h> @@ -375,7 +365,6 @@ extern int errno; # endif /* NLIST_STRUCT */ # ifdef SUNOS_5 -# include <fcntl.h> # include <kvm.h> # include <kstat.h> # endif @@ -393,7 +382,7 @@ extern int errno; # endif /* LDAV_SYMBOL */ # endif /* __linux__ */ -# else /* VMS */ +# else /* __VMS */ # ifndef eunice # include <iodef.h> @@ -401,7 +390,7 @@ extern int errno; # else /* eunice */ # include <vms/iodef.h> # endif /* eunice */ -# endif /* VMS */ +# endif /* __VMS */ # ifndef LDAV_CVT # define LDAV_CVT(n) ((double) (n)) @@ -409,7 +398,16 @@ extern int errno; # endif /* LOAD_AVE_TYPE */ -# if defined(__GNU__) && !defined (NeXT) +# if defined HAVE_LIBPERFSTAT +# include <sys/protosw.h> +# include <libperfstat.h> +# include <sys/proc.h> +# ifndef SBITS +# define SBITS 16 +# endif +# endif + +# if defined (__GNU__) && !defined (NeXT) /* Note that NeXT Openstep defines __GNU__ even though it should not. */ /* GNU system acts much like NeXT, for load average purposes, but not exactly. */ @@ -430,7 +428,6 @@ extern int errno; # endif /* sgi */ # ifdef UMAX -# include <stdio.h> # include <signal.h> # include <sys/time.h> # include <sys/wait.h> @@ -456,17 +453,16 @@ extern int errno; # include <sys/dg_sys_info.h> # endif -# if defined(HAVE_FCNTL_H) || defined(_POSIX_VERSION) +# if (defined __linux__ || defined __CYGWIN__ || defined SUNOS_5 \ + || (defined LOAD_AVE_TYPE && ! defined __VMS)) # include <fcntl.h> -# else -# include <sys/file.h> # endif /* Avoid static vars inside a function since in HPUX they dump as pure. */ # ifdef NeXT static processor_set_t default_set; -static int getloadavg_initialized; +static bool getloadavg_initialized; # endif /* NeXT */ # ifdef UMAX @@ -475,59 +471,56 @@ static unsigned int samples; # endif /* UMAX */ # ifdef DGUX -static struct dg_sys_info_load_info load_info; /* what-a-mouthful! */ +static struct dg_sys_info_load_info load_info; /* what-a-mouthful! */ # endif /* DGUX */ -#if !defined(HAVE_LIBKSTAT) && defined(LOAD_AVE_TYPE) +# if !defined (HAVE_LIBKSTAT) && defined (LOAD_AVE_TYPE) /* File descriptor open to /dev/kmem or VMS load ave driver. */ static int channel; -/* Nonzero if channel is valid. */ -static int getloadavg_initialized; +/* True if channel is valid. */ +static bool getloadavg_initialized; /* Offset in kmem to seek to read load average, or 0 means invalid. */ static long offset; -# if !defined(VMS) && !defined(sgi) && !defined(__linux__) +# if ! defined __VMS && ! defined sgi && ! defined __linux__ static struct nlist name_list[2]; -# endif /* Not VMS or sgi */ +# endif # ifdef SUNOS_5 static kvm_t *kd; # endif /* SUNOS_5 */ -#endif /* LOAD_AVE_TYPE && !HAVE_LIBKSTAT */ +# endif /* LOAD_AVE_TYPE && !HAVE_LIBKSTAT */ /* Put the 1 minute, 5 minute and 15 minute load averages into the first NELEM elements of LOADAVG. Return the number written (never more than 3, but may be less than NELEM), - or -1 if an error occurred. */ + or -1 (setting errno) if an error occurred. */ int -getloadavg (loadavg, nelem) - double loadavg[]; - int nelem; +getloadavg (double loadavg[], int nelem) { - int elem = 0; /* Return value. */ + int elem = 0; /* Return value. */ # ifdef NO_GET_LOAD_AVG # define LDAV_DONE - /* Set errno to zero to indicate that there was no particular error; - this function just can't work at all on this system. */ - errno = 0; + errno = ENOSYS; elem = -1; # endif -# if !defined (LDAV_DONE) && defined (HAVE_LIBKSTAT) +# if !defined (LDAV_DONE) && defined (HAVE_LIBKSTAT) /* Solaris <= 2.6 */ /* Use libkstat because we don't have to be root. */ # define LDAV_DONE kstat_ctl_t *kc; kstat_t *ksp; kstat_named_t *kn; + int saved_errno; kc = kstat_open (); if (kc == 0) return -1; ksp = kstat_lookup (kc, "unix", 0, "system_misc"); - if (ksp == 0 ) + if (ksp == 0) return -1; if (kstat_read (kc, ksp, 0) == -1) return -1; @@ -542,28 +535,31 @@ getloadavg (loadavg, nelem) } if (nelem >= 1) - loadavg[elem++] = (double) kn->value.ul/FSCALE; + loadavg[elem++] = (double) kn->value.ul / FSCALE; if (nelem >= 2) { kn = kstat_data_lookup (ksp, "avenrun_5min"); if (kn != 0) - { - loadavg[elem++] = (double) kn->value.ul/FSCALE; - - if (nelem >= 3) - { - kn = kstat_data_lookup (ksp, "avenrun_15min"); - if (kn != 0) - loadavg[elem++] = (double) kn->value.ul/FSCALE; - } - } + { + loadavg[elem++] = (double) kn->value.ul / FSCALE; + + if (nelem >= 3) + { + kn = kstat_data_lookup (ksp, "avenrun_15min"); + if (kn != 0) + loadavg[elem++] = (double) kn->value.ul / FSCALE; + } + } } + saved_errno = errno; kstat_close (kc); + errno = saved_errno; # endif /* HAVE_LIBKSTAT */ # if !defined (LDAV_DONE) && defined (hpux) && defined (HAVE_PSTAT_GETDYNAMIC) + /* HP-UX */ /* Use pstat_getdynamic() because we don't have to be root. */ # define LDAV_DONE # undef LOAD_AVE_TYPE @@ -580,7 +576,24 @@ getloadavg (loadavg, nelem) # endif /* hpux && HAVE_PSTAT_GETDYNAMIC */ -# if !defined (LDAV_DONE) && defined (__linux__) +# if ! defined LDAV_DONE && defined HAVE_LIBPERFSTAT /* AIX */ +# define LDAV_DONE +# undef LOAD_AVE_TYPE +/* Use perfstat_cpu_total because we don't have to be root. */ + { + perfstat_cpu_total_t cpu_stats; + int result = perfstat_cpu_total (NULL, &cpu_stats, sizeof cpu_stats, 1); + if (result == -1) + return result; + loadavg[0] = cpu_stats.loadavg[0] / (double)(1 << SBITS); + loadavg[1] = cpu_stats.loadavg[1] / (double)(1 << SBITS); + loadavg[2] = cpu_stats.loadavg[2] / (double)(1 << SBITS); + elem = 3; + } +# endif + +# if !defined (LDAV_DONE) && (defined (__linux__) || defined (__CYGWIN__)) + /* Linux without glibc, Cygwin */ # define LDAV_DONE # undef LOAD_AVE_TYPE @@ -588,34 +601,56 @@ getloadavg (loadavg, nelem) # define LINUX_LDAV_FILE "/proc/loadavg" # endif - char ldavgbuf[40]; - double load_ave[3]; - int fd, count; + char ldavgbuf[3 * (INT_STRLEN_BOUND (int) + sizeof ".00 ")]; + char const *ptr = ldavgbuf; + int fd, count, saved_errno; fd = open (LINUX_LDAV_FILE, O_RDONLY); if (fd == -1) return -1; - count = read (fd, ldavgbuf, 40); + count = read (fd, ldavgbuf, sizeof ldavgbuf - 1); + saved_errno = errno; (void) close (fd); + errno = saved_errno; if (count <= 0) return -1; + ldavgbuf[count] = '\0'; - /* The following sscanf must use the C locale. */ - setlocale (LC_NUMERIC, "C"); - count = sscanf (ldavgbuf, "%lf %lf %lf", - &load_ave[0], &load_ave[1], &load_ave[2]); - setlocale (LC_NUMERIC, ""); - if (count < 1) - return -1; + for (elem = 0; elem < nelem; elem++) + { + double numerator = 0; + double denominator = 1; + + while (*ptr == ' ') + ptr++; - for (elem = 0; elem < nelem && elem < count; elem++) - loadavg[elem] = load_ave[elem]; + /* Finish if this number is missing, and report an error if all + were missing. */ + if (! ('0' <= *ptr && *ptr <= '9')) + { + if (elem == 0) + { + errno = ENOTSUP; + return -1; + } + break; + } + + while ('0' <= *ptr && *ptr <= '9') + numerator = 10 * numerator + (*ptr++ - '0'); + + if (*ptr == '.') + for (ptr++; '0' <= *ptr && *ptr <= '9'; ptr++) + numerator = 10 * numerator + (*ptr - '0'), denominator *= 10; + + loadavg[elem++] = numerator / denominator; + } return elem; -# endif /* __linux__ */ +# endif /* __linux__ || __CYGWIN__ */ -# if !defined (LDAV_DONE) && defined (__NetBSD__) +# if !defined (LDAV_DONE) && defined (__NetBSD__) /* NetBSD < 0.9 */ # define LDAV_DONE # undef LOAD_AVE_TYPE @@ -631,11 +666,14 @@ getloadavg (loadavg, nelem) if (fp == NULL) return -1; count = fscanf (fp, "%lu %lu %lu %lu\n", - &load_ave[0], &load_ave[1], &load_ave[2], - &scale); + &load_ave[0], &load_ave[1], &load_ave[2], + &scale); (void) fclose (fp); if (count != 4) - return -1; + { + errno = ENOTSUP; + return -1; + } for (elem = 0; elem < nelem; elem++) loadavg[elem] = (double) load_ave[elem] / (double) scale; @@ -644,13 +682,13 @@ getloadavg (loadavg, nelem) # endif /* __NetBSD__ */ -# if !defined (LDAV_DONE) && defined (NeXT) +# if !defined (LDAV_DONE) && defined (NeXT) /* NeXTStep */ # define LDAV_DONE /* The NeXT code was adapted from iscreen 3.2. */ host_t host; struct processor_set_basic_info info; - unsigned info_count; + unsigned int info_count; /* We only know how to get the 1-minute average for this system, so even if the caller asks for more than 1, we only return 1. */ @@ -658,25 +696,28 @@ getloadavg (loadavg, nelem) if (!getloadavg_initialized) { if (processor_set_default (host_self (), &default_set) == KERN_SUCCESS) - getloadavg_initialized = 1; + getloadavg_initialized = true; } if (getloadavg_initialized) { info_count = PROCESSOR_SET_BASIC_INFO_COUNT; if (processor_set_info (default_set, PROCESSOR_SET_BASIC_INFO, &host, - (processor_set_info_t) &info, &info_count) - != KERN_SUCCESS) - getloadavg_initialized = 0; + (processor_set_info_t) &info, &info_count) + != KERN_SUCCESS) + getloadavg_initialized = false; else - { - if (nelem > 0) - loadavg[elem++] = (double) info.load_average / LOAD_SCALE; - } + { + if (nelem > 0) + loadavg[elem++] = (double) info.load_average / LOAD_SCALE; + } } if (!getloadavg_initialized) - return -1; + { + errno = ENOTSUP; + return -1; + } # endif /* NeXT */ # if !defined (LDAV_DONE) && defined (UMAX) @@ -704,24 +745,24 @@ getloadavg (loadavg, nelem) desc.sd_size = sizeof conf; if (inq_stats (1, &desc)) - return -1; + return -1; c = 0; for (i = 0; i < conf.config_maxclass; ++i) - { - struct class_stats stats; - memset (&stats, 0, sizeof stats); + { + struct class_stats stats; + memset (&stats, 0, sizeof stats); - desc.sd_type = CPUTYPE_CLASS; - desc.sd_objid = i; - desc.sd_addr = (char *) &stats; - desc.sd_size = sizeof stats; + desc.sd_type = CPUTYPE_CLASS; + desc.sd_objid = i; + desc.sd_addr = (char *) &stats; + desc.sd_size = sizeof stats; - if (inq_stats (1, &desc)) - return -1; + if (inq_stats (1, &desc)) + return -1; - c += stats.class_numcpus; - } + c += stats.class_numcpus; + } cpus = c; samples = cpus < 2 ? 3 : (2 * cpus / 3); } @@ -742,7 +783,7 @@ getloadavg (loadavg, nelem) { load += proc_sum_data.ps_nrun[j]; if (j++ == PS_NRUNSIZE) - j = 0; + j = 0; } if (nelem > 0) @@ -755,8 +796,8 @@ getloadavg (loadavg, nelem) it's not supposed to fail. The first argument is for no apparent reason of type `long int *'. */ dg_sys_info ((long int *) &load_info, - DG_SYS_INFO_LOAD_INFO_TYPE, - DG_SYS_INFO_LOAD_VERSION_0); + DG_SYS_INFO_LOAD_INFO_TYPE, + DG_SYS_INFO_LOAD_VERSION_0); if (nelem > 0) loadavg[elem++] = load_info.one_minute; @@ -800,9 +841,10 @@ getloadavg (loadavg, nelem) = (load_ave.tl_lscale == 0 ? load_ave.tl_avenrun.d[0] : (load_ave.tl_avenrun.l[0] / (double) load_ave.tl_lscale)); -# endif /* OSF_MIPS */ +# endif /* OSF_MIPS */ # if !defined (LDAV_DONE) && (defined (__MSDOS__) || defined (WINDOWS32)) + /* DJGPP */ # define LDAV_DONE /* A faithful emulation is going to have to be saved for a rainy day. */ @@ -812,7 +854,7 @@ getloadavg (loadavg, nelem) } # endif /* __MSDOS__ || WINDOWS32 */ -# if !defined (LDAV_DONE) && defined (OSF_ALPHA) +# if !defined (LDAV_DONE) && defined (OSF_ALPHA) /* OSF/1 */ # define LDAV_DONE struct tbl_loadavg load_ave; @@ -820,15 +862,15 @@ getloadavg (loadavg, nelem) for (elem = 0; elem < nelem; elem++) loadavg[elem] = (load_ave.tl_lscale == 0 - ? load_ave.tl_avenrun.d[elem] - : (load_ave.tl_avenrun.l[elem] / (double) load_ave.tl_lscale)); + ? load_ave.tl_avenrun.d[elem] + : (load_ave.tl_avenrun.l[elem] / (double) load_ave.tl_lscale)); # endif /* OSF_ALPHA */ -# if !defined (LDAV_DONE) && defined (VMS) +# if ! defined LDAV_DONE && defined __VMS /* VMS */ /* VMS specific code -- read from the Load Ave driver. */ LOAD_AVE_TYPE load_ave[3]; - static int getloadavg_initialized = 0; + static bool getloadavg_initialized; # ifdef eunice struct { @@ -848,27 +890,31 @@ getloadavg (loadavg, nelem) $DESCRIPTOR (descriptor, "LAV0:"); # endif if (sys$assign (&descriptor, &channel, 0, 0) & 1) - getloadavg_initialized = 1; + getloadavg_initialized = true; } /* Read the load average vector. */ if (getloadavg_initialized && !(sys$qiow (0, channel, IO$_READVBLK, 0, 0, 0, - load_ave, 12, 0, 0, 0, 0) & 1)) + load_ave, 12, 0, 0, 0, 0) & 1)) { sys$dassgn (channel); - getloadavg_initialized = 0; + getloadavg_initialized = false; } if (!getloadavg_initialized) - return -1; -# endif /* VMS */ + { + errno = ENOTSUP; + return -1; + } +# endif /* ! defined LDAV_DONE && defined __VMS */ -# if !defined (LDAV_DONE) && defined(LOAD_AVE_TYPE) && !defined(VMS) +# if ! defined LDAV_DONE && defined LOAD_AVE_TYPE && ! defined __VMS + /* IRIX, other old systems */ /* UNIX-specific code -- read the average from /dev/kmem. */ -# define LDAV_PRIVILEGED /* This code requires special installation. */ +# define LDAV_PRIVILEGED /* This code requires special installation. */ LOAD_AVE_TYPE load_ave[3]; @@ -876,7 +922,7 @@ getloadavg (loadavg, nelem) if (offset == 0) { # ifndef sgi -# ifndef NLIST_STRUCT +# if ! defined NLIST_STRUCT || ! defined N_NAME_POINTER strcpy (name_list[0].n_name, LDAV_SYMBOL); strcpy (name_list[1].n_name, ""); # else /* NLIST_STRUCT */ @@ -892,25 +938,23 @@ getloadavg (loadavg, nelem) # ifndef SUNOS_5 if ( # if !(defined (_AIX) && !defined (ps2)) - nlist (KERNEL_FILE, name_list) + nlist (KERNEL_FILE, name_list) # else /* _AIX */ - knlist (name_list, 1, sizeof (name_list[0])) + knlist (name_list, 1, sizeof (name_list[0])) # endif - >= 0) - /* Omit "&& name_list[0].n_type != 0 " -- it breaks on Sun386i. */ - { + >= 0) + /* Omit "&& name_list[0].n_type != 0 " -- it breaks on Sun386i. */ + { # ifdef FIXUP_KERNEL_SYMBOL_ADDR - FIXUP_KERNEL_SYMBOL_ADDR (name_list); + FIXUP_KERNEL_SYMBOL_ADDR (name_list); # endif - offset = name_list[0].n_value; - } + offset = name_list[0].n_value; + } # endif /* !SUNOS_5 */ # else /* sgi */ - int ldav_off; - - ldav_off = sysmp (MP_KERNADDR, MPKA_AVENRUN); + ptrdiff_t ldav_off = sysmp (MP_KERNADDR, MPKA_AVENRUN); if (ldav_off != -1) - offset = (long) ldav_off & 0x7fffffff; + offset = (long int) ldav_off & 0x7fffffff; # endif /* sgi */ } @@ -918,30 +962,39 @@ getloadavg (loadavg, nelem) if (!getloadavg_initialized) { # ifndef SUNOS_5 - channel = open ("/dev/kmem", 0); - if (channel >= 0) - { - /* Set the channel to close on exec, so it does not - litter any child's descriptor table. */ -# ifdef F_SETFD -# ifndef FD_CLOEXEC -# define FD_CLOEXEC 1 -# endif - (void) fcntl (channel, F_SETFD, FD_CLOEXEC); + /* Set the channel to close on exec, so it does not + litter any child's descriptor table. */ +# ifndef O_CLOEXEC +# define O_CLOEXEC 0 # endif - getloadavg_initialized = 1; - } + int fd = open ("/dev/kmem", O_RDONLY | O_CLOEXEC); + if (0 <= fd) + { +# if F_DUPFD_CLOEXEC + if (fd <= STDERR_FILENO) + { + int fd1 = fcntl (fd, F_DUPFD_CLOEXEC, STDERR_FILENO + 1); + close (fd); + fd = fd1; + } +# endif + if (0 <= fd) + { + channel = fd; + getloadavg_initialized = true; + } + } # else /* SUNOS_5 */ /* We pass 0 for the kernel, corefile, and swapfile names - to use the currently running kernel. */ + to use the currently running kernel. */ kd = kvm_open (0, 0, 0, O_RDONLY, 0); if (kd != 0) - { - /* nlist the currently running kernel. */ - kvm_nlist (kd, name_list); - offset = name_list[0].n_value; - getloadavg_initialized = 1; - } + { + /* nlist the currently running kernel. */ + kvm_nlist (kd, name_list); + offset = name_list[0].n_value; + getloadavg_initialized = true; + } # endif /* SUNOS_5 */ } @@ -951,25 +1004,28 @@ getloadavg (loadavg, nelem) /* Try to read the load. */ # ifndef SUNOS_5 if (lseek (channel, offset, 0) == -1L - || read (channel, (char *) load_ave, sizeof (load_ave)) - != sizeof (load_ave)) - { - close (channel); - getloadavg_initialized = 0; - } + || read (channel, (char *) load_ave, sizeof (load_ave)) + != sizeof (load_ave)) + { + close (channel); + getloadavg_initialized = false; + } # else /* SUNOS_5 */ if (kvm_read (kd, offset, (char *) load_ave, sizeof (load_ave)) - != sizeof (load_ave)) + != sizeof (load_ave)) { kvm_close (kd); - getloadavg_initialized = 0; - } + getloadavg_initialized = false; + } # endif /* SUNOS_5 */ } if (offset == 0 || !getloadavg_initialized) - return -1; -# endif /* LOAD_AVE_TYPE and not VMS */ + { + errno = ENOTSUP; + return -1; + } +# endif /* ! defined LDAV_DONE && defined LOAD_AVE_TYPE && ! defined __VMS */ # if !defined (LDAV_DONE) && defined (LOAD_AVE_TYPE) /* Including VMS. */ if (nelem > 0) @@ -982,56 +1038,9 @@ getloadavg (loadavg, nelem) # define LDAV_DONE # endif /* !LDAV_DONE && LOAD_AVE_TYPE */ -# ifdef LDAV_DONE - return elem; -# else - /* Set errno to zero to indicate that there was no particular error; - this function just can't work at all on this system. */ - errno = 0; - return -1; +# if !defined LDAV_DONE + errno = ENOSYS; + elem = -1; # endif + return elem; } - -#endif /* ! HAVE_GETLOADAVG */ - -#ifdef TEST -void -main (argc, argv) - int argc; - char **argv; -{ - int naptime = 0; - - if (argc > 1) - naptime = atoi (argv[1]); - - while (1) - { - double avg[3]; - int loads; - - errno = 0; /* Don't be misled if it doesn't set errno. */ - loads = getloadavg (avg, 3); - if (loads == -1) - { - perror ("Error getting load average"); - exit (1); - } - if (loads > 0) - printf ("1-minute: %f ", avg[0]); - if (loads > 1) - printf ("5-minute: %f ", avg[1]); - if (loads > 2) - printf ("15-minute: %f ", avg[2]); - if (loads > 0) - putchar ('\n'); - - if (naptime == 0) - break; - sleep (naptime); - } - - exit (0); -} -#endif /* TEST */ - diff --git a/lib/gettext.h b/lib/gettext.h index eb74aecb9a8..458e3322177 100644 --- a/lib/gettext.h +++ b/lib/gettext.h @@ -93,6 +93,12 @@ #endif +/* Prefer gnulib's setlocale override over libintl's setlocale override. */ +#ifdef GNULIB_defined_setlocale +# undef setlocale +# define setlocale rpl_setlocale +#endif + /* A pseudo function call that serves as a marker for the automated extraction of messages, but does not call gettext(). The run-time translation is done at a different place in the code. diff --git a/lib/gnulib.mk b/lib/gnulib.mk index ad4de074c58..bdba2e9c1bb 100644 --- a/lib/gnulib.mk +++ b/lib/gnulib.mk @@ -9,7 +9,7 @@ # the same distribution terms as the rest of that program. # # Generated by gnulib-tool. -# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --no-libtool --macro-prefix=gl --no-vc-files dtoastr getopt-gnu ignore-value mktime strftime +# Reproduce by: gnulib-tool --import --dir=. --lib=libgnu --source-base=lib --m4-base=m4 --doc-base=doc --tests-base=tests --aux-dir=. --makefile-name=gnulib.mk --no-libtool --macro-prefix=gl --no-vc-files crypto/md5 dtoastr filemode getloadavg getopt-gnu ignore-value mktime strftime MOSTLYCLEANFILES += core *.stackdump @@ -69,6 +69,15 @@ EXTRA_DIST += $(top_srcdir)/./c++defs.h ## end gnulib module c++defs +## begin gnulib module crypto/md5 + + +EXTRA_DIST += md5.c md5.h + +EXTRA_libgnu_a_SOURCES += md5.c + +## end gnulib module crypto/md5 + ## begin gnulib module dtoastr libgnu_a_SOURCES += dtoastr.c @@ -79,6 +88,24 @@ EXTRA_libgnu_a_SOURCES += ftoastr.c ## end gnulib module dtoastr +## begin gnulib module filemode + + +EXTRA_DIST += filemode.c filemode.h + +EXTRA_libgnu_a_SOURCES += filemode.c + +## end gnulib module filemode + +## begin gnulib module getloadavg + + +EXTRA_DIST += getloadavg.c + +EXTRA_libgnu_a_SOURCES += getloadavg.c + +## end gnulib module getloadavg + ## begin gnulib module getopt-posix BUILT_SOURCES += $(GETOPT_H) @@ -175,6 +202,135 @@ EXTRA_DIST += stddef.in.h ## end gnulib module stddef +## begin gnulib module stdint + +BUILT_SOURCES += $(STDINT_H) + +# We need the following in order to create <stdint.h> when the system +# doesn't have one that works with the given compiler. +stdint.h: stdint.in.h + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ + sed -e 's/@''HAVE_STDINT_H''@/$(HAVE_STDINT_H)/g' \ + -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ + -e 's|@''NEXT_STDINT_H''@|$(NEXT_STDINT_H)|g' \ + -e 's/@''HAVE_SYS_TYPES_H''@/$(HAVE_SYS_TYPES_H)/g' \ + -e 's/@''HAVE_INTTYPES_H''@/$(HAVE_INTTYPES_H)/g' \ + -e 's/@''HAVE_SYS_INTTYPES_H''@/$(HAVE_SYS_INTTYPES_H)/g' \ + -e 's/@''HAVE_SYS_BITYPES_H''@/$(HAVE_SYS_BITYPES_H)/g' \ + -e 's/@''HAVE_WCHAR_H''@/$(HAVE_WCHAR_H)/g' \ + -e 's/@''HAVE_LONG_LONG_INT''@/$(HAVE_LONG_LONG_INT)/g' \ + -e 's/@''HAVE_UNSIGNED_LONG_LONG_INT''@/$(HAVE_UNSIGNED_LONG_LONG_INT)/g' \ + -e 's/@''APPLE_UNIVERSAL_BUILD''@/$(APPLE_UNIVERSAL_BUILD)/g' \ + -e 's/@''BITSIZEOF_PTRDIFF_T''@/$(BITSIZEOF_PTRDIFF_T)/g' \ + -e 's/@''PTRDIFF_T_SUFFIX''@/$(PTRDIFF_T_SUFFIX)/g' \ + -e 's/@''BITSIZEOF_SIG_ATOMIC_T''@/$(BITSIZEOF_SIG_ATOMIC_T)/g' \ + -e 's/@''HAVE_SIGNED_SIG_ATOMIC_T''@/$(HAVE_SIGNED_SIG_ATOMIC_T)/g' \ + -e 's/@''SIG_ATOMIC_T_SUFFIX''@/$(SIG_ATOMIC_T_SUFFIX)/g' \ + -e 's/@''BITSIZEOF_SIZE_T''@/$(BITSIZEOF_SIZE_T)/g' \ + -e 's/@''SIZE_T_SUFFIX''@/$(SIZE_T_SUFFIX)/g' \ + -e 's/@''BITSIZEOF_WCHAR_T''@/$(BITSIZEOF_WCHAR_T)/g' \ + -e 's/@''HAVE_SIGNED_WCHAR_T''@/$(HAVE_SIGNED_WCHAR_T)/g' \ + -e 's/@''WCHAR_T_SUFFIX''@/$(WCHAR_T_SUFFIX)/g' \ + -e 's/@''BITSIZEOF_WINT_T''@/$(BITSIZEOF_WINT_T)/g' \ + -e 's/@''HAVE_SIGNED_WINT_T''@/$(HAVE_SIGNED_WINT_T)/g' \ + -e 's/@''WINT_T_SUFFIX''@/$(WINT_T_SUFFIX)/g' \ + < $(srcdir)/stdint.in.h; \ + } > $@-t && \ + mv $@-t $@ +MOSTLYCLEANFILES += stdint.h stdint.h-t + +EXTRA_DIST += stdint.in.h + +## end gnulib module stdint + +## begin gnulib module stdlib + +BUILT_SOURCES += stdlib.h + +# We need the following in order to create <stdlib.h> when the system +# doesn't have one that works with the given compiler. +stdlib.h: stdlib.in.h $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */' && \ + sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ + -e 's|@''NEXT_STDLIB_H''@|$(NEXT_STDLIB_H)|g' \ + -e 's|@''GNULIB__EXIT''@|$(GNULIB__EXIT)|g' \ + -e 's|@''GNULIB_ATOLL''@|$(GNULIB_ATOLL)|g' \ + -e 's|@''GNULIB_CALLOC_POSIX''@|$(GNULIB_CALLOC_POSIX)|g' \ + -e 's|@''GNULIB_CANONICALIZE_FILE_NAME''@|$(GNULIB_CANONICALIZE_FILE_NAME)|g' \ + -e 's|@''GNULIB_GETLOADAVG''@|$(GNULIB_GETLOADAVG)|g' \ + -e 's|@''GNULIB_GETSUBOPT''@|$(GNULIB_GETSUBOPT)|g' \ + -e 's|@''GNULIB_GRANTPT''@|$(GNULIB_GRANTPT)|g' \ + -e 's|@''GNULIB_MALLOC_POSIX''@|$(GNULIB_MALLOC_POSIX)|g' \ + -e 's|@''GNULIB_MKDTEMP''@|$(GNULIB_MKDTEMP)|g' \ + -e 's|@''GNULIB_MKOSTEMP''@|$(GNULIB_MKOSTEMP)|g' \ + -e 's|@''GNULIB_MKOSTEMPS''@|$(GNULIB_MKOSTEMPS)|g' \ + -e 's|@''GNULIB_MKSTEMP''@|$(GNULIB_MKSTEMP)|g' \ + -e 's|@''GNULIB_MKSTEMPS''@|$(GNULIB_MKSTEMPS)|g' \ + -e 's|@''GNULIB_PTSNAME''@|$(GNULIB_PTSNAME)|g' \ + -e 's|@''GNULIB_PUTENV''@|$(GNULIB_PUTENV)|g' \ + -e 's|@''GNULIB_RANDOM_R''@|$(GNULIB_RANDOM_R)|g' \ + -e 's|@''GNULIB_REALLOC_POSIX''@|$(GNULIB_REALLOC_POSIX)|g' \ + -e 's|@''GNULIB_REALPATH''@|$(GNULIB_REALPATH)|g' \ + -e 's|@''GNULIB_RPMATCH''@|$(GNULIB_RPMATCH)|g' \ + -e 's|@''GNULIB_SETENV''@|$(GNULIB_SETENV)|g' \ + -e 's|@''GNULIB_STRTOD''@|$(GNULIB_STRTOD)|g' \ + -e 's|@''GNULIB_STRTOLL''@|$(GNULIB_STRTOLL)|g' \ + -e 's|@''GNULIB_STRTOULL''@|$(GNULIB_STRTOULL)|g' \ + -e 's|@''GNULIB_SYSTEM_POSIX''@|$(GNULIB_SYSTEM_POSIX)|g' \ + -e 's|@''GNULIB_UNLOCKPT''@|$(GNULIB_UNLOCKPT)|g' \ + -e 's|@''GNULIB_UNSETENV''@|$(GNULIB_UNSETENV)|g' \ + < $(srcdir)/stdlib.in.h | \ + sed -e 's|@''HAVE__EXIT''@|$(HAVE__EXIT)|g' \ + -e 's|@''HAVE_ATOLL''@|$(HAVE_ATOLL)|g' \ + -e 's|@''HAVE_CANONICALIZE_FILE_NAME''@|$(HAVE_CANONICALIZE_FILE_NAME)|g' \ + -e 's|@''HAVE_DECL_GETLOADAVG''@|$(HAVE_DECL_GETLOADAVG)|g' \ + -e 's|@''HAVE_GETSUBOPT''@|$(HAVE_GETSUBOPT)|g' \ + -e 's|@''HAVE_GRANTPT''@|$(HAVE_GRANTPT)|g' \ + -e 's|@''HAVE_MKDTEMP''@|$(HAVE_MKDTEMP)|g' \ + -e 's|@''HAVE_MKOSTEMP''@|$(HAVE_MKOSTEMP)|g' \ + -e 's|@''HAVE_MKOSTEMPS''@|$(HAVE_MKOSTEMPS)|g' \ + -e 's|@''HAVE_MKSTEMP''@|$(HAVE_MKSTEMP)|g' \ + -e 's|@''HAVE_MKSTEMPS''@|$(HAVE_MKSTEMPS)|g' \ + -e 's|@''HAVE_PTSNAME''@|$(HAVE_PTSNAME)|g' \ + -e 's|@''HAVE_RANDOM_H''@|$(HAVE_RANDOM_H)|g' \ + -e 's|@''HAVE_RANDOM_R''@|$(HAVE_RANDOM_R)|g' \ + -e 's|@''HAVE_REALPATH''@|$(HAVE_REALPATH)|g' \ + -e 's|@''HAVE_RPMATCH''@|$(HAVE_RPMATCH)|g' \ + -e 's|@''HAVE_DECL_SETENV''@|$(HAVE_DECL_SETENV)|g' \ + -e 's|@''HAVE_STRTOD''@|$(HAVE_STRTOD)|g' \ + -e 's|@''HAVE_STRTOLL''@|$(HAVE_STRTOLL)|g' \ + -e 's|@''HAVE_STRTOULL''@|$(HAVE_STRTOULL)|g' \ + -e 's|@''HAVE_STRUCT_RANDOM_DATA''@|$(HAVE_STRUCT_RANDOM_DATA)|g' \ + -e 's|@''HAVE_SYS_LOADAVG_H''@|$(HAVE_SYS_LOADAVG_H)|g' \ + -e 's|@''HAVE_UNLOCKPT''@|$(HAVE_UNLOCKPT)|g' \ + -e 's|@''HAVE_DECL_UNSETENV''@|$(HAVE_DECL_UNSETENV)|g' \ + -e 's|@''REPLACE_CALLOC''@|$(REPLACE_CALLOC)|g' \ + -e 's|@''REPLACE_CANONICALIZE_FILE_NAME''@|$(REPLACE_CANONICALIZE_FILE_NAME)|g' \ + -e 's|@''REPLACE_MALLOC''@|$(REPLACE_MALLOC)|g' \ + -e 's|@''REPLACE_MKSTEMP''@|$(REPLACE_MKSTEMP)|g' \ + -e 's|@''REPLACE_PUTENV''@|$(REPLACE_PUTENV)|g' \ + -e 's|@''REPLACE_REALLOC''@|$(REPLACE_REALLOC)|g' \ + -e 's|@''REPLACE_REALPATH''@|$(REPLACE_REALPATH)|g' \ + -e 's|@''REPLACE_SETENV''@|$(REPLACE_SETENV)|g' \ + -e 's|@''REPLACE_STRTOD''@|$(REPLACE_STRTOD)|g' \ + -e 's|@''REPLACE_UNSETENV''@|$(REPLACE_UNSETENV)|g' \ + -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \ + -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \ + -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)'; \ + } > $@-t && \ + mv $@-t $@ +MOSTLYCLEANFILES += stdlib.h stdlib.h-t + +EXTRA_DIST += stdlib.in.h + +## end gnulib module stdlib + ## begin gnulib module strftime @@ -184,6 +340,65 @@ EXTRA_libgnu_a_SOURCES += strftime.c ## end gnulib module strftime +## begin gnulib module sys_stat + +BUILT_SOURCES += sys/stat.h + +# We need the following in order to create <sys/stat.h> when the system +# has one that is incomplete. +sys/stat.h: sys_stat.in.h $(CXXDEFS_H) $(ARG_NONNULL_H) $(WARN_ON_USE_H) + $(AM_V_at)$(MKDIR_P) sys + $(AM_V_GEN)rm -f $@-t $@ && \ + { echo '/* DO NOT EDIT! GENERATED AUTOMATICALLY! */'; \ + sed -e 's|@''INCLUDE_NEXT''@|$(INCLUDE_NEXT)|g' \ + -e 's|@''PRAGMA_SYSTEM_HEADER''@|@PRAGMA_SYSTEM_HEADER@|g' \ + -e 's|@''PRAGMA_COLUMNS''@|@PRAGMA_COLUMNS@|g' \ + -e 's|@''NEXT_SYS_STAT_H''@|$(NEXT_SYS_STAT_H)|g' \ + -e 's|@''GNULIB_FCHMODAT''@|$(GNULIB_FCHMODAT)|g' \ + -e 's|@''GNULIB_FSTATAT''@|$(GNULIB_FSTATAT)|g' \ + -e 's|@''GNULIB_FUTIMENS''@|$(GNULIB_FUTIMENS)|g' \ + -e 's|@''GNULIB_LCHMOD''@|$(GNULIB_LCHMOD)|g' \ + -e 's|@''GNULIB_LSTAT''@|$(GNULIB_LSTAT)|g' \ + -e 's|@''GNULIB_MKDIRAT''@|$(GNULIB_MKDIRAT)|g' \ + -e 's|@''GNULIB_MKFIFO''@|$(GNULIB_MKFIFO)|g' \ + -e 's|@''GNULIB_MKFIFOAT''@|$(GNULIB_MKFIFOAT)|g' \ + -e 's|@''GNULIB_MKNOD''@|$(GNULIB_MKNOD)|g' \ + -e 's|@''GNULIB_MKNODAT''@|$(GNULIB_MKNODAT)|g' \ + -e 's|@''GNULIB_STAT''@|$(GNULIB_STAT)|g' \ + -e 's|@''GNULIB_UTIMENSAT''@|$(GNULIB_UTIMENSAT)|g' \ + -e 's|@''HAVE_FCHMODAT''@|$(HAVE_FCHMODAT)|g' \ + -e 's|@''HAVE_FSTATAT''@|$(HAVE_FSTATAT)|g' \ + -e 's|@''HAVE_FUTIMENS''@|$(HAVE_FUTIMENS)|g' \ + -e 's|@''HAVE_LCHMOD''@|$(HAVE_LCHMOD)|g' \ + -e 's|@''HAVE_LSTAT''@|$(HAVE_LSTAT)|g' \ + -e 's|@''HAVE_MKDIRAT''@|$(HAVE_MKDIRAT)|g' \ + -e 's|@''HAVE_MKFIFO''@|$(HAVE_MKFIFO)|g' \ + -e 's|@''HAVE_MKFIFOAT''@|$(HAVE_MKFIFOAT)|g' \ + -e 's|@''HAVE_MKNOD''@|$(HAVE_MKNOD)|g' \ + -e 's|@''HAVE_MKNODAT''@|$(HAVE_MKNODAT)|g' \ + -e 's|@''HAVE_UTIMENSAT''@|$(HAVE_UTIMENSAT)|g' \ + -e 's|@''REPLACE_FSTAT''@|$(REPLACE_FSTAT)|g' \ + -e 's|@''REPLACE_FSTATAT''@|$(REPLACE_FSTATAT)|g' \ + -e 's|@''REPLACE_FUTIMENS''@|$(REPLACE_FUTIMENS)|g' \ + -e 's|@''REPLACE_LSTAT''@|$(REPLACE_LSTAT)|g' \ + -e 's|@''REPLACE_MKDIR''@|$(REPLACE_MKDIR)|g' \ + -e 's|@''REPLACE_MKFIFO''@|$(REPLACE_MKFIFO)|g' \ + -e 's|@''REPLACE_MKNOD''@|$(REPLACE_MKNOD)|g' \ + -e 's|@''REPLACE_STAT''@|$(REPLACE_STAT)|g' \ + -e 's|@''REPLACE_UTIMENSAT''@|$(REPLACE_UTIMENSAT)|g' \ + -e '/definitions of _GL_FUNCDECL_RPL/r $(CXXDEFS_H)' \ + -e '/definition of _GL_ARG_NONNULL/r $(ARG_NONNULL_H)' \ + -e '/definition of _GL_WARN_ON_USE/r $(WARN_ON_USE_H)' \ + < $(srcdir)/sys_stat.in.h; \ + } > $@-t && \ + mv $@-t $@ +MOSTLYCLEANFILES += sys/stat.h sys/stat.h-t +MOSTLYCLEANDIRS += sys + +EXTRA_DIST += sys_stat.in.h + +## end gnulib module sys_stat + ## begin gnulib module time BUILT_SOURCES += time.h diff --git a/lib/ignore-value.h b/lib/ignore-value.h index 5e683bbb533..f021a1ac8ea 100644 --- a/lib/ignore-value.h +++ b/lib/ignore-value.h @@ -35,13 +35,13 @@ #ifndef _GL_IGNORE_VALUE_H # define _GL_IGNORE_VALUE_H -# ifndef ATTRIBUTE_DEPRECATED +# ifndef _GL_ATTRIBUTE_DEPRECATED /* The __attribute__((__deprecated__)) feature is available in gcc versions 3.1 and newer. */ # if __GNUC__ < 3 || (__GNUC__ == 3 && __GNUC_MINOR__ < 1) -# define ATTRIBUTE_DEPRECATED /* empty */ +# define _GL_ATTRIBUTE_DEPRECATED /* empty */ # else -# define ATTRIBUTE_DEPRECATED __attribute__ ((__deprecated__)) +# define _GL_ATTRIBUTE_DEPRECATED __attribute__ ((__deprecated__)) # endif # endif @@ -56,7 +56,7 @@ /* ignore_value works for scalars, pointers and aggregates; deprecate ignore_ptr. */ -static inline void ATTRIBUTE_DEPRECATED +static inline void _GL_ATTRIBUTE_DEPRECATED ignore_ptr (void *p) { (void) p; } /* deprecated: use ignore_value */ #endif diff --git a/lib/makefile.w32-in b/lib/makefile.w32-in index cdf44f614b6..289f6bffdb9 100644 --- a/lib/makefile.w32-in +++ b/lib/makefile.w32-in @@ -27,7 +27,9 @@ GNULIBOBJS = $(BLD)/dtoastr.$(O) \ $(BLD)/getopt.$(O) \ $(BLD)/getopt1.$(O) \ $(BLD)/strftime.$(O) \ - $(BLD)/time_r.$(O) + $(BLD)/time_r.$(O) \ + $(BLD)/md5.$(O) \ + $(BLD)/filemode.$(O) # # Build the library @@ -93,11 +95,28 @@ $(BLD)/time_r.$(O) : \ $(EMACS_ROOT)/src/m/intel386.h \ $(EMACS_ROOT)/src/config.h +$(BLD)/md5.$(O) : \ + $(SRC)/md5.c \ + $(SRC)/md5.h \ + $(EMACS_ROOT)/nt/inc/stdint.h \ + $(EMACS_ROOT)/src/s/ms-w32.h \ + $(EMACS_ROOT)/src/m/intel386.h \ + $(EMACS_ROOT)/src/config.h + +$(BLD)/filemode.$(O) : \ + $(SRC)/filemode.c \ + $(SRC)/filemode.h \ + $(EMACS_ROOT)/nt/inc/sys/stat.h \ + $(EMACS_ROOT)/src/s/ms-w32.h \ + $(EMACS_ROOT)/src/m/intel386.h \ + $(EMACS_ROOT)/src/config.h + # The following dependencies are for supporting parallel builds, where # we must make sure $(BLD) exists before any compilation starts. # $(BLD)/dtoastr.$(O) $(BLD)/getopt.$(O) $(BLD)/getopt1.$(O): stamp_BLD -$(BLD)/strftime.$(O) $(BLD)/time_r.$(O): stamp_BLD +$(BLD)/strftime.$(O) $(BLD)/time_r.$(O) $(BLD)/md5.$(O): stamp_BLD +$(BLD)/filemode.$(O): stamp_BLD # # Headers we would preprocess if we could. diff --git a/lib/md5.c b/lib/md5.c new file mode 100644 index 00000000000..b7fad633364 --- /dev/null +++ b/lib/md5.c @@ -0,0 +1,462 @@ +/* Functions to compute MD5 message digest of files or memory blocks. + according to the definition of MD5 in RFC 1321 from April 1992. + Copyright (C) 1995-1997, 1999-2001, 2005-2006, 2008-2011 Free Software + Foundation, Inc. + This file is part of the GNU C Library. + + This program is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by the + Free Software Foundation; either version 3, or (at your option) any + later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +/* Written by Ulrich Drepper <drepper@gnu.ai.mit.edu>, 1995. */ + +#include <config.h> + +#include "md5.h" + +#include <stddef.h> +#include <stdlib.h> +#include <string.h> +#include <sys/types.h> + +#if USE_UNLOCKED_IO +# include "unlocked-io.h" +#endif + +#ifdef _LIBC +# include <endian.h> +# if __BYTE_ORDER == __BIG_ENDIAN +# define WORDS_BIGENDIAN 1 +# endif +/* We need to keep the namespace clean so define the MD5 function + protected using leading __ . */ +# define md5_init_ctx __md5_init_ctx +# define md5_process_block __md5_process_block +# define md5_process_bytes __md5_process_bytes +# define md5_finish_ctx __md5_finish_ctx +# define md5_read_ctx __md5_read_ctx +# define md5_stream __md5_stream +# define md5_buffer __md5_buffer +#endif + +#ifdef WORDS_BIGENDIAN +# define SWAP(n) \ + (((n) << 24) | (((n) & 0xff00) << 8) | (((n) >> 8) & 0xff00) | ((n) >> 24)) +#else +# define SWAP(n) (n) +#endif + +#define BLOCKSIZE 32768 +#if BLOCKSIZE % 64 != 0 +# error "invalid BLOCKSIZE" +#endif + +/* This array contains the bytes used to pad the buffer to the next + 64-byte boundary. (RFC 1321, 3.1: Step 1) */ +static const unsigned char fillbuf[64] = { 0x80, 0 /* , 0, 0, ... */ }; + + +/* Initialize structure containing state of computation. + (RFC 1321, 3.3: Step 3) */ +void +md5_init_ctx (struct md5_ctx *ctx) +{ + ctx->A = 0x67452301; + ctx->B = 0xefcdab89; + ctx->C = 0x98badcfe; + ctx->D = 0x10325476; + + ctx->total[0] = ctx->total[1] = 0; + ctx->buflen = 0; +} + +/* Copy the 4 byte value from v into the memory location pointed to by *cp, + If your architecture allows unaligned access this is equivalent to + * (uint32_t *) cp = v */ +static inline void +set_uint32 (char *cp, uint32_t v) +{ + memcpy (cp, &v, sizeof v); +} + +/* Put result from CTX in first 16 bytes following RESBUF. The result + must be in little endian byte order. */ +void * +md5_read_ctx (const struct md5_ctx *ctx, void *resbuf) +{ + char *r = resbuf; + set_uint32 (r + 0 * sizeof ctx->A, SWAP (ctx->A)); + set_uint32 (r + 1 * sizeof ctx->B, SWAP (ctx->B)); + set_uint32 (r + 2 * sizeof ctx->C, SWAP (ctx->C)); + set_uint32 (r + 3 * sizeof ctx->D, SWAP (ctx->D)); + + return resbuf; +} + +/* Process the remaining bytes in the internal buffer and the usual + prolog according to the standard and write the result to RESBUF. */ +void * +md5_finish_ctx (struct md5_ctx *ctx, void *resbuf) +{ + /* Take yet unprocessed bytes into account. */ + uint32_t bytes = ctx->buflen; + size_t size = (bytes < 56) ? 64 / 4 : 64 * 2 / 4; + + /* Now count remaining bytes. */ + ctx->total[0] += bytes; + if (ctx->total[0] < bytes) + ++ctx->total[1]; + + /* Put the 64-bit file length in *bits* at the end of the buffer. */ + ctx->buffer[size - 2] = SWAP (ctx->total[0] << 3); + ctx->buffer[size - 1] = SWAP ((ctx->total[1] << 3) | (ctx->total[0] >> 29)); + + memcpy (&((char *) ctx->buffer)[bytes], fillbuf, (size - 2) * 4 - bytes); + + /* Process last bytes. */ + md5_process_block (ctx->buffer, size * 4, ctx); + + return md5_read_ctx (ctx, resbuf); +} + +/* Compute MD5 message digest for bytes read from STREAM. The + resulting message digest number will be written into the 16 bytes + beginning at RESBLOCK. */ +int +md5_stream (FILE *stream, void *resblock) +{ + struct md5_ctx ctx; + size_t sum; + + char *buffer = malloc (BLOCKSIZE + 72); + if (!buffer) + return 1; + + /* Initialize the computation context. */ + md5_init_ctx (&ctx); + + /* Iterate over full file contents. */ + while (1) + { + /* We read the file in blocks of BLOCKSIZE bytes. One call of the + computation function processes the whole buffer so that with the + next round of the loop another block can be read. */ + size_t n; + sum = 0; + + /* Read block. Take care for partial reads. */ + while (1) + { + n = fread (buffer + sum, 1, BLOCKSIZE - sum, stream); + + sum += n; + + if (sum == BLOCKSIZE) + break; + + if (n == 0) + { + /* Check for the error flag IFF N == 0, so that we don't + exit the loop after a partial read due to e.g., EAGAIN + or EWOULDBLOCK. */ + if (ferror (stream)) + { + free (buffer); + return 1; + } + goto process_partial_block; + } + + /* We've read at least one byte, so ignore errors. But always + check for EOF, since feof may be true even though N > 0. + Otherwise, we could end up calling fread after EOF. */ + if (feof (stream)) + goto process_partial_block; + } + + /* Process buffer with BLOCKSIZE bytes. Note that + BLOCKSIZE % 64 == 0 + */ + md5_process_block (buffer, BLOCKSIZE, &ctx); + } + +process_partial_block: + + /* Process any remaining bytes. */ + if (sum > 0) + md5_process_bytes (buffer, sum, &ctx); + + /* Construct result in desired memory. */ + md5_finish_ctx (&ctx, resblock); + free (buffer); + return 0; +} + +/* Compute MD5 message digest for LEN bytes beginning at BUFFER. The + result is always in little endian byte order, so that a byte-wise + output yields to the wanted ASCII representation of the message + digest. */ +void * +md5_buffer (const char *buffer, size_t len, void *resblock) +{ + struct md5_ctx ctx; + + /* Initialize the computation context. */ + md5_init_ctx (&ctx); + + /* Process whole buffer but last len % 64 bytes. */ + md5_process_bytes (buffer, len, &ctx); + + /* Put result in desired memory area. */ + return md5_finish_ctx (&ctx, resblock); +} + + +void +md5_process_bytes (const void *buffer, size_t len, struct md5_ctx *ctx) +{ + /* When we already have some bits in our internal buffer concatenate + both inputs first. */ + if (ctx->buflen != 0) + { + size_t left_over = ctx->buflen; + size_t add = 128 - left_over > len ? len : 128 - left_over; + + memcpy (&((char *) ctx->buffer)[left_over], buffer, add); + ctx->buflen += add; + + if (ctx->buflen > 64) + { + md5_process_block (ctx->buffer, ctx->buflen & ~63, ctx); + + ctx->buflen &= 63; + /* The regions in the following copy operation cannot overlap. */ + memcpy (ctx->buffer, + &((char *) ctx->buffer)[(left_over + add) & ~63], + ctx->buflen); + } + + buffer = (const char *) buffer + add; + len -= add; + } + + /* Process available complete blocks. */ + if (len >= 64) + { +#if !_STRING_ARCH_unaligned +# define alignof(type) offsetof (struct { char c; type x; }, x) +# define UNALIGNED_P(p) (((size_t) p) % alignof (uint32_t) != 0) + if (UNALIGNED_P (buffer)) + while (len > 64) + { + md5_process_block (memcpy (ctx->buffer, buffer, 64), 64, ctx); + buffer = (const char *) buffer + 64; + len -= 64; + } + else +#endif + { + md5_process_block (buffer, len & ~63, ctx); + buffer = (const char *) buffer + (len & ~63); + len &= 63; + } + } + + /* Move remaining bytes in internal buffer. */ + if (len > 0) + { + size_t left_over = ctx->buflen; + + memcpy (&((char *) ctx->buffer)[left_over], buffer, len); + left_over += len; + if (left_over >= 64) + { + md5_process_block (ctx->buffer, 64, ctx); + left_over -= 64; + memcpy (ctx->buffer, &ctx->buffer[16], left_over); + } + ctx->buflen = left_over; + } +} + + +/* These are the four functions used in the four steps of the MD5 algorithm + and defined in the RFC 1321. The first function is a little bit optimized + (as found in Colin Plumbs public domain implementation). */ +/* #define FF(b, c, d) ((b & c) | (~b & d)) */ +#define FF(b, c, d) (d ^ (b & (c ^ d))) +#define FG(b, c, d) FF (d, b, c) +#define FH(b, c, d) (b ^ c ^ d) +#define FI(b, c, d) (c ^ (b | ~d)) + +/* Process LEN bytes of BUFFER, accumulating context into CTX. + It is assumed that LEN % 64 == 0. */ + +void +md5_process_block (const void *buffer, size_t len, struct md5_ctx *ctx) +{ + uint32_t correct_words[16]; + const uint32_t *words = buffer; + size_t nwords = len / sizeof (uint32_t); + const uint32_t *endp = words + nwords; + uint32_t A = ctx->A; + uint32_t B = ctx->B; + uint32_t C = ctx->C; + uint32_t D = ctx->D; + + /* First increment the byte count. RFC 1321 specifies the possible + length of the file up to 2^64 bits. Here we only compute the + number of bytes. Do a double word increment. */ + ctx->total[0] += len; + if (ctx->total[0] < len) + ++ctx->total[1]; + + /* Process all bytes in the buffer with 64 bytes in each round of + the loop. */ + while (words < endp) + { + uint32_t *cwp = correct_words; + uint32_t A_save = A; + uint32_t B_save = B; + uint32_t C_save = C; + uint32_t D_save = D; + + /* First round: using the given function, the context and a constant + the next context is computed. Because the algorithms processing + unit is a 32-bit word and it is determined to work on words in + little endian byte order we perhaps have to change the byte order + before the computation. To reduce the work for the next steps + we store the swapped words in the array CORRECT_WORDS. */ + +#define OP(a, b, c, d, s, T) \ + do \ + { \ + a += FF (b, c, d) + (*cwp++ = SWAP (*words)) + T; \ + ++words; \ + CYCLIC (a, s); \ + a += b; \ + } \ + while (0) + + /* It is unfortunate that C does not provide an operator for + cyclic rotation. Hope the C compiler is smart enough. */ +#define CYCLIC(w, s) (w = (w << s) | (w >> (32 - s))) + + /* Before we start, one word to the strange constants. + They are defined in RFC 1321 as + + T[i] = (int) (4294967296.0 * fabs (sin (i))), i=1..64 + + Here is an equivalent invocation using Perl: + + perl -e 'foreach(1..64){printf "0x%08x\n", int (4294967296 * abs (sin $_))}' + */ + + /* Round 1. */ + OP (A, B, C, D, 7, 0xd76aa478); + OP (D, A, B, C, 12, 0xe8c7b756); + OP (C, D, A, B, 17, 0x242070db); + OP (B, C, D, A, 22, 0xc1bdceee); + OP (A, B, C, D, 7, 0xf57c0faf); + OP (D, A, B, C, 12, 0x4787c62a); + OP (C, D, A, B, 17, 0xa8304613); + OP (B, C, D, A, 22, 0xfd469501); + OP (A, B, C, D, 7, 0x698098d8); + OP (D, A, B, C, 12, 0x8b44f7af); + OP (C, D, A, B, 17, 0xffff5bb1); + OP (B, C, D, A, 22, 0x895cd7be); + OP (A, B, C, D, 7, 0x6b901122); + OP (D, A, B, C, 12, 0xfd987193); + OP (C, D, A, B, 17, 0xa679438e); + OP (B, C, D, A, 22, 0x49b40821); + + /* For the second to fourth round we have the possibly swapped words + in CORRECT_WORDS. Redefine the macro to take an additional first + argument specifying the function to use. */ +#undef OP +#define OP(f, a, b, c, d, k, s, T) \ + do \ + { \ + a += f (b, c, d) + correct_words[k] + T; \ + CYCLIC (a, s); \ + a += b; \ + } \ + while (0) + + /* Round 2. */ + OP (FG, A, B, C, D, 1, 5, 0xf61e2562); + OP (FG, D, A, B, C, 6, 9, 0xc040b340); + OP (FG, C, D, A, B, 11, 14, 0x265e5a51); + OP (FG, B, C, D, A, 0, 20, 0xe9b6c7aa); + OP (FG, A, B, C, D, 5, 5, 0xd62f105d); + OP (FG, D, A, B, C, 10, 9, 0x02441453); + OP (FG, C, D, A, B, 15, 14, 0xd8a1e681); + OP (FG, B, C, D, A, 4, 20, 0xe7d3fbc8); + OP (FG, A, B, C, D, 9, 5, 0x21e1cde6); + OP (FG, D, A, B, C, 14, 9, 0xc33707d6); + OP (FG, C, D, A, B, 3, 14, 0xf4d50d87); + OP (FG, B, C, D, A, 8, 20, 0x455a14ed); + OP (FG, A, B, C, D, 13, 5, 0xa9e3e905); + OP (FG, D, A, B, C, 2, 9, 0xfcefa3f8); + OP (FG, C, D, A, B, 7, 14, 0x676f02d9); + OP (FG, B, C, D, A, 12, 20, 0x8d2a4c8a); + + /* Round 3. */ + OP (FH, A, B, C, D, 5, 4, 0xfffa3942); + OP (FH, D, A, B, C, 8, 11, 0x8771f681); + OP (FH, C, D, A, B, 11, 16, 0x6d9d6122); + OP (FH, B, C, D, A, 14, 23, 0xfde5380c); + OP (FH, A, B, C, D, 1, 4, 0xa4beea44); + OP (FH, D, A, B, C, 4, 11, 0x4bdecfa9); + OP (FH, C, D, A, B, 7, 16, 0xf6bb4b60); + OP (FH, B, C, D, A, 10, 23, 0xbebfbc70); + OP (FH, A, B, C, D, 13, 4, 0x289b7ec6); + OP (FH, D, A, B, C, 0, 11, 0xeaa127fa); + OP (FH, C, D, A, B, 3, 16, 0xd4ef3085); + OP (FH, B, C, D, A, 6, 23, 0x04881d05); + OP (FH, A, B, C, D, 9, 4, 0xd9d4d039); + OP (FH, D, A, B, C, 12, 11, 0xe6db99e5); + OP (FH, C, D, A, B, 15, 16, 0x1fa27cf8); + OP (FH, B, C, D, A, 2, 23, 0xc4ac5665); + + /* Round 4. */ + OP (FI, A, B, C, D, 0, 6, 0xf4292244); + OP (FI, D, A, B, C, 7, 10, 0x432aff97); + OP (FI, C, D, A, B, 14, 15, 0xab9423a7); + OP (FI, B, C, D, A, 5, 21, 0xfc93a039); + OP (FI, A, B, C, D, 12, 6, 0x655b59c3); + OP (FI, D, A, B, C, 3, 10, 0x8f0ccc92); + OP (FI, C, D, A, B, 10, 15, 0xffeff47d); + OP (FI, B, C, D, A, 1, 21, 0x85845dd1); + OP (FI, A, B, C, D, 8, 6, 0x6fa87e4f); + OP (FI, D, A, B, C, 15, 10, 0xfe2ce6e0); + OP (FI, C, D, A, B, 6, 15, 0xa3014314); + OP (FI, B, C, D, A, 13, 21, 0x4e0811a1); + OP (FI, A, B, C, D, 4, 6, 0xf7537e82); + OP (FI, D, A, B, C, 11, 10, 0xbd3af235); + OP (FI, C, D, A, B, 2, 15, 0x2ad7d2bb); + OP (FI, B, C, D, A, 9, 21, 0xeb86d391); + + /* Add the starting values of the context. */ + A += A_save; + B += B_save; + C += C_save; + D += D_save; + } + + /* Put checksum in context given as argument. */ + ctx->A = A; + ctx->B = B; + ctx->C = C; + ctx->D = D; +} diff --git a/lib/md5.h b/lib/md5.h new file mode 100644 index 00000000000..53e60480292 --- /dev/null +++ b/lib/md5.h @@ -0,0 +1,126 @@ +/* Declaration of functions and data types used for MD5 sum computing + library functions. + Copyright (C) 1995-1997, 1999-2001, 2004-2006, 2008-2011 Free Software + Foundation, Inc. + This file is part of the GNU C Library. + + This program is free software; you can redistribute it and/or modify it + under the terms of the GNU General Public License as published by the + Free Software Foundation; either version 3, or (at your option) any + later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +#ifndef _MD5_H +#define _MD5_H 1 + +#include <stdio.h> +#include <stdint.h> + +#define MD5_DIGEST_SIZE 16 +#define MD5_BLOCK_SIZE 64 + +#ifndef __GNUC_PREREQ +# if defined __GNUC__ && defined __GNUC_MINOR__ +# define __GNUC_PREREQ(maj, min) \ + ((__GNUC__ << 16) + __GNUC_MINOR__ >= ((maj) << 16) + (min)) +# else +# define __GNUC_PREREQ(maj, min) 0 +# endif +#endif + +#ifndef __THROW +# if defined __cplusplus && __GNUC_PREREQ (2,8) +# define __THROW throw () +# else +# define __THROW +# endif +#endif + +#ifndef _LIBC +# define __md5_buffer md5_buffer +# define __md5_finish_ctx md5_finish_ctx +# define __md5_init_ctx md5_init_ctx +# define __md5_process_block md5_process_block +# define __md5_process_bytes md5_process_bytes +# define __md5_read_ctx md5_read_ctx +# define __md5_stream md5_stream +#endif + +# ifdef __cplusplus +extern "C" { +# endif + +/* Structure to save state of computation between the single steps. */ +struct md5_ctx +{ + uint32_t A; + uint32_t B; + uint32_t C; + uint32_t D; + + uint32_t total[2]; + uint32_t buflen; + uint32_t buffer[32]; +}; + +/* + * The following three functions are build up the low level used in + * the functions `md5_stream' and `md5_buffer'. + */ + +/* Initialize structure containing state of computation. + (RFC 1321, 3.3: Step 3) */ +extern void __md5_init_ctx (struct md5_ctx *ctx) __THROW; + +/* Starting with the result of former calls of this function (or the + initialization function update the context for the next LEN bytes + starting at BUFFER. + It is necessary that LEN is a multiple of 64!!! */ +extern void __md5_process_block (const void *buffer, size_t len, + struct md5_ctx *ctx) __THROW; + +/* Starting with the result of former calls of this function (or the + initialization function update the context for the next LEN bytes + starting at BUFFER. + It is NOT required that LEN is a multiple of 64. */ +extern void __md5_process_bytes (const void *buffer, size_t len, + struct md5_ctx *ctx) __THROW; + +/* Process the remaining bytes in the buffer and put result from CTX + in first 16 bytes following RESBUF. The result is always in little + endian byte order, so that a byte-wise output yields to the wanted + ASCII representation of the message digest. */ +extern void *__md5_finish_ctx (struct md5_ctx *ctx, void *resbuf) __THROW; + + +/* Put result from CTX in first 16 bytes following RESBUF. The result is + always in little endian byte order, so that a byte-wise output yields + to the wanted ASCII representation of the message digest. */ +extern void *__md5_read_ctx (const struct md5_ctx *ctx, void *resbuf) __THROW; + + +/* Compute MD5 message digest for bytes read from STREAM. The + resulting message digest number will be written into the 16 bytes + beginning at RESBLOCK. */ +extern int __md5_stream (FILE *stream, void *resblock) __THROW; + +/* Compute MD5 message digest for LEN bytes beginning at BUFFER. The + result is always in little endian byte order, so that a byte-wise + output yields to the wanted ASCII representation of the message + digest. */ +extern void *__md5_buffer (const char *buffer, size_t len, + void *resblock) __THROW; + +# ifdef __cplusplus +} +# endif + +#endif /* md5.h */ diff --git a/lib/stdint.in.h b/lib/stdint.in.h new file mode 100644 index 00000000000..b32227bb04c --- /dev/null +++ b/lib/stdint.in.h @@ -0,0 +1,592 @@ +/* Copyright (C) 2001-2002, 2004-2011 Free Software Foundation, Inc. + Written by Paul Eggert, Bruno Haible, Sam Steingold, Peter Burwood. + This file is part of gnulib. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +/* + * ISO C 99 <stdint.h> for platforms that lack it. + * <http://www.opengroup.org/susv3xbd/stdint.h.html> + */ + +#ifndef _GL_STDINT_H + +#if __GNUC__ >= 3 +@PRAGMA_SYSTEM_HEADER@ +#endif +@PRAGMA_COLUMNS@ + +/* When including a system file that in turn includes <inttypes.h>, + use the system <inttypes.h>, not our substitute. This avoids + problems with (for example) VMS, whose <sys/bitypes.h> includes + <inttypes.h>. */ +#define _GL_JUST_INCLUDE_SYSTEM_INTTYPES_H + +/* Get those types that are already defined in other system include + files, so that we can "#define int8_t signed char" below without + worrying about a later system include file containing a "typedef + signed char int8_t;" that will get messed up by our macro. Our + macros should all be consistent with the system versions, except + for the "fast" types and macros, which we recommend against using + in public interfaces due to compiler differences. */ + +#if @HAVE_STDINT_H@ +# if defined __sgi && ! defined __c99 + /* Bypass IRIX's <stdint.h> if in C89 mode, since it merely annoys users + with "This header file is to be used only for c99 mode compilations" + diagnostics. */ +# define __STDINT_H__ +# endif + /* Other systems may have an incomplete or buggy <stdint.h>. + Include it before <inttypes.h>, since any "#include <stdint.h>" + in <inttypes.h> would reinclude us, skipping our contents because + _GL_STDINT_H is defined. + The include_next requires a split double-inclusion guard. */ +# @INCLUDE_NEXT@ @NEXT_STDINT_H@ +#endif + +#if ! defined _GL_STDINT_H && ! defined _GL_JUST_INCLUDE_SYSTEM_STDINT_H +#define _GL_STDINT_H + +/* <sys/types.h> defines some of the stdint.h types as well, on glibc, + IRIX 6.5, and OpenBSD 3.8 (via <machine/types.h>). + AIX 5.2 <sys/types.h> isn't needed and causes troubles. + MacOS X 10.4.6 <sys/types.h> includes <stdint.h> (which is us), but + relies on the system <stdint.h> definitions, so include + <sys/types.h> after @NEXT_STDINT_H@. */ +#if @HAVE_SYS_TYPES_H@ && ! defined _AIX +# include <sys/types.h> +#endif + +/* Get LONG_MIN, LONG_MAX, ULONG_MAX. */ +#include <limits.h> + +#if @HAVE_INTTYPES_H@ + /* In OpenBSD 3.8, <inttypes.h> includes <machine/types.h>, which defines + int{8,16,32,64}_t, uint{8,16,32,64}_t and __BIT_TYPES_DEFINED__. + <inttypes.h> also defines intptr_t and uintptr_t. */ +# include <inttypes.h> +#elif @HAVE_SYS_INTTYPES_H@ + /* Solaris 7 <sys/inttypes.h> has the types except the *_fast*_t types, and + the macros except for *_FAST*_*, INTPTR_MIN, PTRDIFF_MIN, PTRDIFF_MAX. */ +# include <sys/inttypes.h> +#endif + +#if @HAVE_SYS_BITYPES_H@ && ! defined __BIT_TYPES_DEFINED__ + /* Linux libc4 >= 4.6.7 and libc5 have a <sys/bitypes.h> that defines + int{8,16,32,64}_t and __BIT_TYPES_DEFINED__. In libc5 >= 5.2.2 it is + included by <sys/types.h>. */ +# include <sys/bitypes.h> +#endif + +#undef _GL_JUST_INCLUDE_SYSTEM_INTTYPES_H + +/* Minimum and maximum values for a integer type under the usual assumption. + Return an unspecified value if BITS == 0, adding a check to pacify + picky compilers. */ + +#define _STDINT_MIN(signed, bits, zero) \ + ((signed) ? (- ((zero) + 1) << ((bits) ? (bits) - 1 : 0)) : (zero)) + +#define _STDINT_MAX(signed, bits, zero) \ + ((signed) \ + ? ~ _STDINT_MIN (signed, bits, zero) \ + : /* The expression for the unsigned case. The subtraction of (signed) \ + is a nop in the unsigned case and avoids "signed integer overflow" \ + warnings in the signed case. */ \ + ((((zero) + 1) << ((bits) ? (bits) - 1 - (signed) : 0)) - 1) * 2 + 1) + +#if !GNULIB_defined_stdint_types + +/* 7.18.1.1. Exact-width integer types */ + +/* Here we assume a standard architecture where the hardware integer + types have 8, 16, 32, optionally 64 bits. */ + +#undef int8_t +#undef uint8_t +typedef signed char gl_int8_t; +typedef unsigned char gl_uint8_t; +#define int8_t gl_int8_t +#define uint8_t gl_uint8_t + +#undef int16_t +#undef uint16_t +typedef short int gl_int16_t; +typedef unsigned short int gl_uint16_t; +#define int16_t gl_int16_t +#define uint16_t gl_uint16_t + +#undef int32_t +#undef uint32_t +typedef int gl_int32_t; +typedef unsigned int gl_uint32_t; +#define int32_t gl_int32_t +#define uint32_t gl_uint32_t + +/* If the system defines INT64_MAX, assume int64_t works. That way, + if the underlying platform defines int64_t to be a 64-bit long long + int, the code below won't mistakenly define it to be a 64-bit long + int, which would mess up C++ name mangling. We must use #ifdef + rather than #if, to avoid an error with HP-UX 10.20 cc. */ + +#ifdef INT64_MAX +# define GL_INT64_T +#else +/* Do not undefine int64_t if gnulib is not being used with 64-bit + types, since otherwise it breaks platforms like Tandem/NSK. */ +# if LONG_MAX >> 31 >> 31 == 1 +# undef int64_t +typedef long int gl_int64_t; +# define int64_t gl_int64_t +# define GL_INT64_T +# elif defined _MSC_VER +# undef int64_t +typedef __int64 gl_int64_t; +# define int64_t gl_int64_t +# define GL_INT64_T +# elif @HAVE_LONG_LONG_INT@ +# undef int64_t +typedef long long int gl_int64_t; +# define int64_t gl_int64_t +# define GL_INT64_T +# endif +#endif + +#ifdef UINT64_MAX +# define GL_UINT64_T +#else +# if ULONG_MAX >> 31 >> 31 >> 1 == 1 +# undef uint64_t +typedef unsigned long int gl_uint64_t; +# define uint64_t gl_uint64_t +# define GL_UINT64_T +# elif defined _MSC_VER +# undef uint64_t +typedef unsigned __int64 gl_uint64_t; +# define uint64_t gl_uint64_t +# define GL_UINT64_T +# elif @HAVE_UNSIGNED_LONG_LONG_INT@ +# undef uint64_t +typedef unsigned long long int gl_uint64_t; +# define uint64_t gl_uint64_t +# define GL_UINT64_T +# endif +#endif + +/* Avoid collision with Solaris 2.5.1 <pthread.h> etc. */ +#define _UINT8_T +#define _UINT32_T +#define _UINT64_T + + +/* 7.18.1.2. Minimum-width integer types */ + +/* Here we assume a standard architecture where the hardware integer + types have 8, 16, 32, optionally 64 bits. Therefore the leastN_t types + are the same as the corresponding N_t types. */ + +#undef int_least8_t +#undef uint_least8_t +#undef int_least16_t +#undef uint_least16_t +#undef int_least32_t +#undef uint_least32_t +#undef int_least64_t +#undef uint_least64_t +#define int_least8_t int8_t +#define uint_least8_t uint8_t +#define int_least16_t int16_t +#define uint_least16_t uint16_t +#define int_least32_t int32_t +#define uint_least32_t uint32_t +#ifdef GL_INT64_T +# define int_least64_t int64_t +#endif +#ifdef GL_UINT64_T +# define uint_least64_t uint64_t +#endif + +/* 7.18.1.3. Fastest minimum-width integer types */ + +/* Note: Other <stdint.h> substitutes may define these types differently. + It is not recommended to use these types in public header files. */ + +/* Here we assume a standard architecture where the hardware integer + types have 8, 16, 32, optionally 64 bits. Therefore the fastN_t types + are taken from the same list of types. Assume that 'long int' + is fast enough for all narrower integers. */ + +#undef int_fast8_t +#undef uint_fast8_t +#undef int_fast16_t +#undef uint_fast16_t +#undef int_fast32_t +#undef uint_fast32_t +#undef int_fast64_t +#undef uint_fast64_t +typedef long int gl_int_fast8_t; +typedef unsigned long int gl_uint_fast8_t; +typedef long int gl_int_fast16_t; +typedef unsigned long int gl_uint_fast16_t; +typedef long int gl_int_fast32_t; +typedef unsigned long int gl_uint_fast32_t; +#define int_fast8_t gl_int_fast8_t +#define uint_fast8_t gl_uint_fast8_t +#define int_fast16_t gl_int_fast16_t +#define uint_fast16_t gl_uint_fast16_t +#define int_fast32_t gl_int_fast32_t +#define uint_fast32_t gl_uint_fast32_t +#ifdef GL_INT64_T +# define int_fast64_t int64_t +#endif +#ifdef GL_UINT64_T +# define uint_fast64_t uint64_t +#endif + +/* 7.18.1.4. Integer types capable of holding object pointers */ + +#undef intptr_t +#undef uintptr_t +typedef long int gl_intptr_t; +typedef unsigned long int gl_uintptr_t; +#define intptr_t gl_intptr_t +#define uintptr_t gl_uintptr_t + +/* 7.18.1.5. Greatest-width integer types */ + +/* Note: These types are compiler dependent. It may be unwise to use them in + public header files. */ + +#undef intmax_t +#if @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1 +typedef long long int gl_intmax_t; +# define intmax_t gl_intmax_t +#elif defined GL_INT64_T +# define intmax_t int64_t +#else +typedef long int gl_intmax_t; +# define intmax_t gl_intmax_t +#endif + +#undef uintmax_t +#if @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1 +typedef unsigned long long int gl_uintmax_t; +# define uintmax_t gl_uintmax_t +#elif defined GL_UINT64_T +# define uintmax_t uint64_t +#else +typedef unsigned long int gl_uintmax_t; +# define uintmax_t gl_uintmax_t +#endif + +/* Verify that intmax_t and uintmax_t have the same size. Too much code + breaks if this is not the case. If this check fails, the reason is likely + to be found in the autoconf macros. */ +typedef int _verify_intmax_size[sizeof (intmax_t) == sizeof (uintmax_t) + ? 1 : -1]; + +#define GNULIB_defined_stdint_types 1 +#endif /* !GNULIB_defined_stdint_types */ + +/* 7.18.2. Limits of specified-width integer types */ + +#if ! defined __cplusplus || defined __STDC_LIMIT_MACROS + +/* 7.18.2.1. Limits of exact-width integer types */ + +/* Here we assume a standard architecture where the hardware integer + types have 8, 16, 32, optionally 64 bits. */ + +#undef INT8_MIN +#undef INT8_MAX +#undef UINT8_MAX +#define INT8_MIN (~ INT8_MAX) +#define INT8_MAX 127 +#define UINT8_MAX 255 + +#undef INT16_MIN +#undef INT16_MAX +#undef UINT16_MAX +#define INT16_MIN (~ INT16_MAX) +#define INT16_MAX 32767 +#define UINT16_MAX 65535 + +#undef INT32_MIN +#undef INT32_MAX +#undef UINT32_MAX +#define INT32_MIN (~ INT32_MAX) +#define INT32_MAX 2147483647 +#define UINT32_MAX 4294967295U + +#if defined GL_INT64_T && ! defined INT64_MAX +/* Prefer (- INTMAX_C (1) << 63) over (~ INT64_MAX) because SunPRO C 5.0 + evaluates the latter incorrectly in preprocessor expressions. */ +# define INT64_MIN (- INTMAX_C (1) << 63) +# define INT64_MAX INTMAX_C (9223372036854775807) +#endif + +#if defined GL_UINT64_T && ! defined UINT64_MAX +# define UINT64_MAX UINTMAX_C (18446744073709551615) +#endif + +/* 7.18.2.2. Limits of minimum-width integer types */ + +/* Here we assume a standard architecture where the hardware integer + types have 8, 16, 32, optionally 64 bits. Therefore the leastN_t types + are the same as the corresponding N_t types. */ + +#undef INT_LEAST8_MIN +#undef INT_LEAST8_MAX +#undef UINT_LEAST8_MAX +#define INT_LEAST8_MIN INT8_MIN +#define INT_LEAST8_MAX INT8_MAX +#define UINT_LEAST8_MAX UINT8_MAX + +#undef INT_LEAST16_MIN +#undef INT_LEAST16_MAX +#undef UINT_LEAST16_MAX +#define INT_LEAST16_MIN INT16_MIN +#define INT_LEAST16_MAX INT16_MAX +#define UINT_LEAST16_MAX UINT16_MAX + +#undef INT_LEAST32_MIN +#undef INT_LEAST32_MAX +#undef UINT_LEAST32_MAX +#define INT_LEAST32_MIN INT32_MIN +#define INT_LEAST32_MAX INT32_MAX +#define UINT_LEAST32_MAX UINT32_MAX + +#undef INT_LEAST64_MIN +#undef INT_LEAST64_MAX +#ifdef GL_INT64_T +# define INT_LEAST64_MIN INT64_MIN +# define INT_LEAST64_MAX INT64_MAX +#endif + +#undef UINT_LEAST64_MAX +#ifdef GL_UINT64_T +# define UINT_LEAST64_MAX UINT64_MAX +#endif + +/* 7.18.2.3. Limits of fastest minimum-width integer types */ + +/* Here we assume a standard architecture where the hardware integer + types have 8, 16, 32, optionally 64 bits. Therefore the fastN_t types + are taken from the same list of types. */ + +#undef INT_FAST8_MIN +#undef INT_FAST8_MAX +#undef UINT_FAST8_MAX +#define INT_FAST8_MIN LONG_MIN +#define INT_FAST8_MAX LONG_MAX +#define UINT_FAST8_MAX ULONG_MAX + +#undef INT_FAST16_MIN +#undef INT_FAST16_MAX +#undef UINT_FAST16_MAX +#define INT_FAST16_MIN LONG_MIN +#define INT_FAST16_MAX LONG_MAX +#define UINT_FAST16_MAX ULONG_MAX + +#undef INT_FAST32_MIN +#undef INT_FAST32_MAX +#undef UINT_FAST32_MAX +#define INT_FAST32_MIN LONG_MIN +#define INT_FAST32_MAX LONG_MAX +#define UINT_FAST32_MAX ULONG_MAX + +#undef INT_FAST64_MIN +#undef INT_FAST64_MAX +#ifdef GL_INT64_T +# define INT_FAST64_MIN INT64_MIN +# define INT_FAST64_MAX INT64_MAX +#endif + +#undef UINT_FAST64_MAX +#ifdef GL_UINT64_T +# define UINT_FAST64_MAX UINT64_MAX +#endif + +/* 7.18.2.4. Limits of integer types capable of holding object pointers */ + +#undef INTPTR_MIN +#undef INTPTR_MAX +#undef UINTPTR_MAX +#define INTPTR_MIN LONG_MIN +#define INTPTR_MAX LONG_MAX +#define UINTPTR_MAX ULONG_MAX + +/* 7.18.2.5. Limits of greatest-width integer types */ + +#undef INTMAX_MIN +#undef INTMAX_MAX +#ifdef INT64_MAX +# define INTMAX_MIN INT64_MIN +# define INTMAX_MAX INT64_MAX +#else +# define INTMAX_MIN INT32_MIN +# define INTMAX_MAX INT32_MAX +#endif + +#undef UINTMAX_MAX +#ifdef UINT64_MAX +# define UINTMAX_MAX UINT64_MAX +#else +# define UINTMAX_MAX UINT32_MAX +#endif + +/* 7.18.3. Limits of other integer types */ + +/* ptrdiff_t limits */ +#undef PTRDIFF_MIN +#undef PTRDIFF_MAX +#if @APPLE_UNIVERSAL_BUILD@ +# ifdef _LP64 +# define PTRDIFF_MIN _STDINT_MIN (1, 64, 0l) +# define PTRDIFF_MAX _STDINT_MAX (1, 64, 0l) +# else +# define PTRDIFF_MIN _STDINT_MIN (1, 32, 0) +# define PTRDIFF_MAX _STDINT_MAX (1, 32, 0) +# endif +#else +# define PTRDIFF_MIN \ + _STDINT_MIN (1, @BITSIZEOF_PTRDIFF_T@, 0@PTRDIFF_T_SUFFIX@) +# define PTRDIFF_MAX \ + _STDINT_MAX (1, @BITSIZEOF_PTRDIFF_T@, 0@PTRDIFF_T_SUFFIX@) +#endif + +/* sig_atomic_t limits */ +#undef SIG_ATOMIC_MIN +#undef SIG_ATOMIC_MAX +#define SIG_ATOMIC_MIN \ + _STDINT_MIN (@HAVE_SIGNED_SIG_ATOMIC_T@, @BITSIZEOF_SIG_ATOMIC_T@, \ + 0@SIG_ATOMIC_T_SUFFIX@) +#define SIG_ATOMIC_MAX \ + _STDINT_MAX (@HAVE_SIGNED_SIG_ATOMIC_T@, @BITSIZEOF_SIG_ATOMIC_T@, \ + 0@SIG_ATOMIC_T_SUFFIX@) + + +/* size_t limit */ +#undef SIZE_MAX +#if @APPLE_UNIVERSAL_BUILD@ +# ifdef _LP64 +# define SIZE_MAX _STDINT_MAX (0, 64, 0ul) +# else +# define SIZE_MAX _STDINT_MAX (0, 32, 0ul) +# endif +#else +# define SIZE_MAX _STDINT_MAX (0, @BITSIZEOF_SIZE_T@, 0@SIZE_T_SUFFIX@) +#endif + +/* wchar_t limits */ +/* Get WCHAR_MIN, WCHAR_MAX. + This include is not on the top, above, because on OSF/1 4.0 we have a + sequence of nested includes + <wchar.h> -> <stdio.h> -> <getopt.h> -> <stdlib.h>, and the latter includes + <stdint.h> and assumes its types are already defined. */ +#if @HAVE_WCHAR_H@ && ! (defined WCHAR_MIN && defined WCHAR_MAX) + /* BSD/OS 4.0.1 has a bug: <stddef.h>, <stdio.h> and <time.h> must be + included before <wchar.h>. */ +# include <stddef.h> +# include <stdio.h> +# include <time.h> +# define _GL_JUST_INCLUDE_SYSTEM_WCHAR_H +# include <wchar.h> +# undef _GL_JUST_INCLUDE_SYSTEM_WCHAR_H +#endif +#undef WCHAR_MIN +#undef WCHAR_MAX +#define WCHAR_MIN \ + _STDINT_MIN (@HAVE_SIGNED_WCHAR_T@, @BITSIZEOF_WCHAR_T@, 0@WCHAR_T_SUFFIX@) +#define WCHAR_MAX \ + _STDINT_MAX (@HAVE_SIGNED_WCHAR_T@, @BITSIZEOF_WCHAR_T@, 0@WCHAR_T_SUFFIX@) + +/* wint_t limits */ +#undef WINT_MIN +#undef WINT_MAX +#define WINT_MIN \ + _STDINT_MIN (@HAVE_SIGNED_WINT_T@, @BITSIZEOF_WINT_T@, 0@WINT_T_SUFFIX@) +#define WINT_MAX \ + _STDINT_MAX (@HAVE_SIGNED_WINT_T@, @BITSIZEOF_WINT_T@, 0@WINT_T_SUFFIX@) + +#endif /* !defined __cplusplus || defined __STDC_LIMIT_MACROS */ + +/* 7.18.4. Macros for integer constants */ + +#if ! defined __cplusplus || defined __STDC_CONSTANT_MACROS + +/* 7.18.4.1. Macros for minimum-width integer constants */ +/* According to ISO C 99 Technical Corrigendum 1 */ + +/* Here we assume a standard architecture where the hardware integer + types have 8, 16, 32, optionally 64 bits, and int is 32 bits. */ + +#undef INT8_C +#undef UINT8_C +#define INT8_C(x) x +#define UINT8_C(x) x + +#undef INT16_C +#undef UINT16_C +#define INT16_C(x) x +#define UINT16_C(x) x + +#undef INT32_C +#undef UINT32_C +#define INT32_C(x) x +#define UINT32_C(x) x ## U + +#undef INT64_C +#undef UINT64_C +#if LONG_MAX >> 31 >> 31 == 1 +# define INT64_C(x) x##L +#elif defined _MSC_VER +# define INT64_C(x) x##i64 +#elif @HAVE_LONG_LONG_INT@ +# define INT64_C(x) x##LL +#endif +#if ULONG_MAX >> 31 >> 31 >> 1 == 1 +# define UINT64_C(x) x##UL +#elif defined _MSC_VER +# define UINT64_C(x) x##ui64 +#elif @HAVE_UNSIGNED_LONG_LONG_INT@ +# define UINT64_C(x) x##ULL +#endif + +/* 7.18.4.2. Macros for greatest-width integer constants */ + +#undef INTMAX_C +#if @HAVE_LONG_LONG_INT@ && LONG_MAX >> 30 == 1 +# define INTMAX_C(x) x##LL +#elif defined GL_INT64_T +# define INTMAX_C(x) INT64_C(x) +#else +# define INTMAX_C(x) x##L +#endif + +#undef UINTMAX_C +#if @HAVE_UNSIGNED_LONG_LONG_INT@ && ULONG_MAX >> 31 == 1 +# define UINTMAX_C(x) x##ULL +#elif defined GL_UINT64_T +# define UINTMAX_C(x) UINT64_C(x) +#else +# define UINTMAX_C(x) x##UL +#endif + +#endif /* !defined __cplusplus || defined __STDC_CONSTANT_MACROS */ + +#endif /* _GL_STDINT_H */ +#endif /* !defined _GL_STDINT_H && !defined _GL_JUST_INCLUDE_SYSTEM_STDINT_H */ diff --git a/lib/stdlib.in.h b/lib/stdlib.in.h new file mode 100644 index 00000000000..62d18c62811 --- /dev/null +++ b/lib/stdlib.in.h @@ -0,0 +1,729 @@ +/* A GNU-like <stdlib.h>. + + Copyright (C) 1995, 2001-2004, 2006-2011 Free Software Foundation, Inc. + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see <http://www.gnu.org/licenses/>. */ + +#if __GNUC__ >= 3 +@PRAGMA_SYSTEM_HEADER@ +#endif +@PRAGMA_COLUMNS@ + +#if defined __need_malloc_and_calloc +/* Special invocation convention inside glibc header files. */ + +#@INCLUDE_NEXT@ @NEXT_STDLIB_H@ + +#else +/* Normal invocation convention. */ + +#ifndef _GL_STDLIB_H + +/* The include_next requires a split double-inclusion guard. */ +#@INCLUDE_NEXT@ @NEXT_STDLIB_H@ + +#ifndef _GL_STDLIB_H +#define _GL_STDLIB_H + +/* NetBSD 5.0 mis-defines NULL. */ +#include <stddef.h> + +/* MirBSD 10 defines WEXITSTATUS in <sys/wait.h>, not in <stdlib.h>. */ +#if @GNULIB_SYSTEM_POSIX@ && !defined WEXITSTATUS +# include <sys/wait.h> +#endif + +/* Solaris declares getloadavg() in <sys/loadavg.h>. */ +#if (@GNULIB_GETLOADAVG@ || defined GNULIB_POSIXCHECK) && @HAVE_SYS_LOADAVG_H@ +# include <sys/loadavg.h> +#endif + +#if @GNULIB_RANDOM_R@ + +/* OSF/1 5.1 declares 'struct random_data' in <random.h>, which is included + from <stdlib.h> if _REENTRANT is defined. Include it whenever we need + 'struct random_data'. */ +# if @HAVE_RANDOM_H@ +# include <random.h> +# endif + +# if !@HAVE_STRUCT_RANDOM_DATA@ || !@HAVE_RANDOM_R@ +# include <stdint.h> +# endif + +# if !@HAVE_STRUCT_RANDOM_DATA@ +/* Define 'struct random_data'. + But allow multiple gnulib generated <stdlib.h> replacements to coexist. */ +# if !GNULIB_defined_struct_random_data +struct random_data +{ + int32_t *fptr; /* Front pointer. */ + int32_t *rptr; /* Rear pointer. */ + int32_t *state; /* Array of state values. */ + int rand_type; /* Type of random number generator. */ + int rand_deg; /* Degree of random number generator. */ + int rand_sep; /* Distance between front and rear. */ + int32_t *end_ptr; /* Pointer behind state table. */ +}; +# define GNULIB_defined_struct_random_data 1 +# endif +# endif +#endif + +#if (@GNULIB_MKSTEMP@ || @GNULIB_GETSUBOPT@ || defined GNULIB_POSIXCHECK) && ! defined __GLIBC__ && !((defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__) +/* On MacOS X 10.3, only <unistd.h> declares mkstemp. */ +/* On Cygwin 1.7.1, only <unistd.h> declares getsubopt. */ +/* But avoid namespace pollution on glibc systems and native Windows. */ +# include <unistd.h> +#endif + +#if 3 <= __GNUC__ || __GNUC__ == 2 && 8 <= __GNUC_MINOR__ +# define _GL_ATTRIBUTE_NORETURN __attribute__ ((__noreturn__)) +#else +# define _GL_ATTRIBUTE_NORETURN +#endif + +/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */ + +/* The definition of _GL_ARG_NONNULL is copied here. */ + +/* The definition of _GL_WARN_ON_USE is copied here. */ + + +/* Some systems do not define EXIT_*, despite otherwise supporting C89. */ +#ifndef EXIT_SUCCESS +# define EXIT_SUCCESS 0 +#endif +/* Tandem/NSK and other platforms that define EXIT_FAILURE as -1 interfere + with proper operation of xargs. */ +#ifndef EXIT_FAILURE +# define EXIT_FAILURE 1 +#elif EXIT_FAILURE != 1 +# undef EXIT_FAILURE +# define EXIT_FAILURE 1 +#endif + + +#if @GNULIB__EXIT@ +/* Terminate the current process with the given return code, without running + the 'atexit' handlers. */ +# if !@HAVE__EXIT@ +_GL_FUNCDECL_SYS (_Exit, void, (int status) _GL_ATTRIBUTE_NORETURN); +# endif +_GL_CXXALIAS_SYS (_Exit, void, (int status)); +_GL_CXXALIASWARN (_Exit); +#elif defined GNULIB_POSIXCHECK +# undef _Exit +# if HAVE_RAW_DECL__EXIT +_GL_WARN_ON_USE (_Exit, "_Exit is unportable - " + "use gnulib module _Exit for portability"); +# endif +#endif + + +#if @GNULIB_ATOLL@ +/* Parse a signed decimal integer. + Returns the value of the integer. Errors are not detected. */ +# if !@HAVE_ATOLL@ +_GL_FUNCDECL_SYS (atoll, long long, (const char *string) _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (atoll, long long, (const char *string)); +_GL_CXXALIASWARN (atoll); +#elif defined GNULIB_POSIXCHECK +# undef atoll +# if HAVE_RAW_DECL_ATOLL +_GL_WARN_ON_USE (atoll, "atoll is unportable - " + "use gnulib module atoll for portability"); +# endif +#endif + +#if @GNULIB_CALLOC_POSIX@ +# if @REPLACE_CALLOC@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef calloc +# define calloc rpl_calloc +# endif +_GL_FUNCDECL_RPL (calloc, void *, (size_t nmemb, size_t size)); +_GL_CXXALIAS_RPL (calloc, void *, (size_t nmemb, size_t size)); +# else +_GL_CXXALIAS_SYS (calloc, void *, (size_t nmemb, size_t size)); +# endif +_GL_CXXALIASWARN (calloc); +#elif defined GNULIB_POSIXCHECK +# undef calloc +/* Assume calloc is always declared. */ +_GL_WARN_ON_USE (calloc, "calloc is not POSIX compliant everywhere - " + "use gnulib module calloc-posix for portability"); +#endif + +#if @GNULIB_CANONICALIZE_FILE_NAME@ +# if @REPLACE_CANONICALIZE_FILE_NAME@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# define canonicalize_file_name rpl_canonicalize_file_name +# endif +_GL_FUNCDECL_RPL (canonicalize_file_name, char *, (const char *name) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (canonicalize_file_name, char *, (const char *name)); +# else +# if !@HAVE_CANONICALIZE_FILE_NAME@ +_GL_FUNCDECL_SYS (canonicalize_file_name, char *, (const char *name) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (canonicalize_file_name, char *, (const char *name)); +# endif +_GL_CXXALIASWARN (canonicalize_file_name); +#elif defined GNULIB_POSIXCHECK +# undef canonicalize_file_name +# if HAVE_RAW_DECL_CANONICALIZE_FILE_NAME +_GL_WARN_ON_USE (canonicalize_file_name, + "canonicalize_file_name is unportable - " + "use gnulib module canonicalize-lgpl for portability"); +# endif +#endif + +#if @GNULIB_GETLOADAVG@ +/* Store max(NELEM,3) load average numbers in LOADAVG[]. + The three numbers are the load average of the last 1 minute, the last 5 + minutes, and the last 15 minutes, respectively. + LOADAVG is an array of NELEM numbers. */ +# if !@HAVE_DECL_GETLOADAVG@ +_GL_FUNCDECL_SYS (getloadavg, int, (double loadavg[], int nelem) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (getloadavg, int, (double loadavg[], int nelem)); +_GL_CXXALIASWARN (getloadavg); +#elif defined GNULIB_POSIXCHECK +# undef getloadavg +# if HAVE_RAW_DECL_GETLOADAVG +_GL_WARN_ON_USE (getloadavg, "getloadavg is not portable - " + "use gnulib module getloadavg for portability"); +# endif +#endif + +#if @GNULIB_GETSUBOPT@ +/* Assuming *OPTIONP is a comma separated list of elements of the form + "token" or "token=value", getsubopt parses the first of these elements. + If the first element refers to a "token" that is member of the given + NULL-terminated array of tokens: + - It replaces the comma with a NUL byte, updates *OPTIONP to point past + the first option and the comma, sets *VALUEP to the value of the + element (or NULL if it doesn't contain an "=" sign), + - It returns the index of the "token" in the given array of tokens. + Otherwise it returns -1, and *OPTIONP and *VALUEP are undefined. + For more details see the POSIX:2001 specification. + http://www.opengroup.org/susv3xsh/getsubopt.html */ +# if !@HAVE_GETSUBOPT@ +_GL_FUNCDECL_SYS (getsubopt, int, + (char **optionp, char *const *tokens, char **valuep) + _GL_ARG_NONNULL ((1, 2, 3))); +# endif +_GL_CXXALIAS_SYS (getsubopt, int, + (char **optionp, char *const *tokens, char **valuep)); +_GL_CXXALIASWARN (getsubopt); +#elif defined GNULIB_POSIXCHECK +# undef getsubopt +# if HAVE_RAW_DECL_GETSUBOPT +_GL_WARN_ON_USE (getsubopt, "getsubopt is unportable - " + "use gnulib module getsubopt for portability"); +# endif +#endif + +#if @GNULIB_GRANTPT@ +/* Change the ownership and access permission of the slave side of the + pseudo-terminal whose master side is specified by FD. */ +# if !@HAVE_GRANTPT@ +_GL_FUNCDECL_SYS (grantpt, int, (int fd)); +# endif +_GL_CXXALIAS_SYS (grantpt, int, (int fd)); +_GL_CXXALIASWARN (grantpt); +#elif defined GNULIB_POSIXCHECK +# undef grantpt +# if HAVE_RAW_DECL_GRANTPT +_GL_WARN_ON_USE (ptsname, "grantpt is not portable - " + "use gnulib module grantpt for portability"); +# endif +#endif + +#if @GNULIB_MALLOC_POSIX@ +# if @REPLACE_MALLOC@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef malloc +# define malloc rpl_malloc +# endif +_GL_FUNCDECL_RPL (malloc, void *, (size_t size)); +_GL_CXXALIAS_RPL (malloc, void *, (size_t size)); +# else +_GL_CXXALIAS_SYS (malloc, void *, (size_t size)); +# endif +_GL_CXXALIASWARN (malloc); +#elif defined GNULIB_POSIXCHECK +# undef malloc +/* Assume malloc is always declared. */ +_GL_WARN_ON_USE (malloc, "malloc is not POSIX compliant everywhere - " + "use gnulib module malloc-posix for portability"); +#endif + +#if @GNULIB_MKDTEMP@ +/* Create a unique temporary directory from TEMPLATE. + The last six characters of TEMPLATE must be "XXXXXX"; + they are replaced with a string that makes the directory name unique. + Returns TEMPLATE, or a null pointer if it cannot get a unique name. + The directory is created mode 700. */ +# if !@HAVE_MKDTEMP@ +_GL_FUNCDECL_SYS (mkdtemp, char *, (char * /*template*/) _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (mkdtemp, char *, (char * /*template*/)); +_GL_CXXALIASWARN (mkdtemp); +#elif defined GNULIB_POSIXCHECK +# undef mkdtemp +# if HAVE_RAW_DECL_MKDTEMP +_GL_WARN_ON_USE (mkdtemp, "mkdtemp is unportable - " + "use gnulib module mkdtemp for portability"); +# endif +#endif + +#if @GNULIB_MKOSTEMP@ +/* Create a unique temporary file from TEMPLATE. + The last six characters of TEMPLATE must be "XXXXXX"; + they are replaced with a string that makes the file name unique. + The flags are a bitmask, possibly including O_CLOEXEC (defined in <fcntl.h>) + and O_TEXT, O_BINARY (defined in "binary-io.h"). + The file is then created, with the specified flags, ensuring it didn't exist + before. + The file is created read-write (mask at least 0600 & ~umask), but it may be + world-readable and world-writable (mask 0666 & ~umask), depending on the + implementation. + Returns the open file descriptor if successful, otherwise -1 and errno + set. */ +# if !@HAVE_MKOSTEMP@ +_GL_FUNCDECL_SYS (mkostemp, int, (char * /*template*/, int /*flags*/) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (mkostemp, int, (char * /*template*/, int /*flags*/)); +_GL_CXXALIASWARN (mkostemp); +#elif defined GNULIB_POSIXCHECK +# undef mkostemp +# if HAVE_RAW_DECL_MKOSTEMP +_GL_WARN_ON_USE (mkostemp, "mkostemp is unportable - " + "use gnulib module mkostemp for portability"); +# endif +#endif + +#if @GNULIB_MKOSTEMPS@ +/* Create a unique temporary file from TEMPLATE. + The last six characters of TEMPLATE before a suffix of length + SUFFIXLEN must be "XXXXXX"; + they are replaced with a string that makes the file name unique. + The flags are a bitmask, possibly including O_CLOEXEC (defined in <fcntl.h>) + and O_TEXT, O_BINARY (defined in "binary-io.h"). + The file is then created, with the specified flags, ensuring it didn't exist + before. + The file is created read-write (mask at least 0600 & ~umask), but it may be + world-readable and world-writable (mask 0666 & ~umask), depending on the + implementation. + Returns the open file descriptor if successful, otherwise -1 and errno + set. */ +# if !@HAVE_MKOSTEMPS@ +_GL_FUNCDECL_SYS (mkostemps, int, + (char * /*template*/, int /*suffixlen*/, int /*flags*/) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (mkostemps, int, + (char * /*template*/, int /*suffixlen*/, int /*flags*/)); +_GL_CXXALIASWARN (mkostemps); +#elif defined GNULIB_POSIXCHECK +# undef mkostemps +# if HAVE_RAW_DECL_MKOSTEMPS +_GL_WARN_ON_USE (mkostemps, "mkostemps is unportable - " + "use gnulib module mkostemps for portability"); +# endif +#endif + +#if @GNULIB_MKSTEMP@ +/* Create a unique temporary file from TEMPLATE. + The last six characters of TEMPLATE must be "XXXXXX"; + they are replaced with a string that makes the file name unique. + The file is then created, ensuring it didn't exist before. + The file is created read-write (mask at least 0600 & ~umask), but it may be + world-readable and world-writable (mask 0666 & ~umask), depending on the + implementation. + Returns the open file descriptor if successful, otherwise -1 and errno + set. */ +# if @REPLACE_MKSTEMP@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# define mkstemp rpl_mkstemp +# endif +_GL_FUNCDECL_RPL (mkstemp, int, (char * /*template*/) _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (mkstemp, int, (char * /*template*/)); +# else +# if ! @HAVE_MKSTEMP@ +_GL_FUNCDECL_SYS (mkstemp, int, (char * /*template*/) _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (mkstemp, int, (char * /*template*/)); +# endif +_GL_CXXALIASWARN (mkstemp); +#elif defined GNULIB_POSIXCHECK +# undef mkstemp +# if HAVE_RAW_DECL_MKSTEMP +_GL_WARN_ON_USE (mkstemp, "mkstemp is unportable - " + "use gnulib module mkstemp for portability"); +# endif +#endif + +#if @GNULIB_MKSTEMPS@ +/* Create a unique temporary file from TEMPLATE. + The last six characters of TEMPLATE prior to a suffix of length + SUFFIXLEN must be "XXXXXX"; + they are replaced with a string that makes the file name unique. + The file is then created, ensuring it didn't exist before. + The file is created read-write (mask at least 0600 & ~umask), but it may be + world-readable and world-writable (mask 0666 & ~umask), depending on the + implementation. + Returns the open file descriptor if successful, otherwise -1 and errno + set. */ +# if !@HAVE_MKSTEMPS@ +_GL_FUNCDECL_SYS (mkstemps, int, (char * /*template*/, int /*suffixlen*/) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (mkstemps, int, (char * /*template*/, int /*suffixlen*/)); +_GL_CXXALIASWARN (mkstemps); +#elif defined GNULIB_POSIXCHECK +# undef mkstemps +# if HAVE_RAW_DECL_MKSTEMPS +_GL_WARN_ON_USE (mkstemps, "mkstemps is unportable - " + "use gnulib module mkstemps for portability"); +# endif +#endif + +#if @GNULIB_PTSNAME@ +/* Return the pathname of the pseudo-terminal slave associated with + the master FD is open on, or NULL on errors. */ +# if !@HAVE_PTSNAME@ +_GL_FUNCDECL_SYS (ptsname, char *, (int fd)); +# endif +_GL_CXXALIAS_SYS (ptsname, char *, (int fd)); +_GL_CXXALIASWARN (ptsname); +#elif defined GNULIB_POSIXCHECK +# undef ptsname +# if HAVE_RAW_DECL_PTSNAME +_GL_WARN_ON_USE (ptsname, "ptsname is not portable - " + "use gnulib module ptsname for portability"); +# endif +#endif + +#if @GNULIB_PUTENV@ +# if @REPLACE_PUTENV@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef putenv +# define putenv rpl_putenv +# endif +_GL_FUNCDECL_RPL (putenv, int, (char *string) _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (putenv, int, (char *string)); +# else +_GL_CXXALIAS_SYS (putenv, int, (char *string)); +# endif +_GL_CXXALIASWARN (putenv); +#endif + + +#if @GNULIB_RANDOM_R@ +# if !@HAVE_RANDOM_R@ +# ifndef RAND_MAX +# define RAND_MAX 2147483647 +# endif +# endif +#endif + +#if @GNULIB_RANDOM_R@ +# if !@HAVE_RANDOM_R@ +_GL_FUNCDECL_SYS (random_r, int, (struct random_data *buf, int32_t *result) + _GL_ARG_NONNULL ((1, 2))); +# endif +_GL_CXXALIAS_SYS (random_r, int, (struct random_data *buf, int32_t *result)); +_GL_CXXALIASWARN (random_r); +#elif defined GNULIB_POSIXCHECK +# undef random_r +# if HAVE_RAW_DECL_RANDOM_R +_GL_WARN_ON_USE (random_r, "random_r is unportable - " + "use gnulib module random_r for portability"); +# endif +#endif + +#if @GNULIB_RANDOM_R@ +# if !@HAVE_RANDOM_R@ +_GL_FUNCDECL_SYS (srandom_r, int, + (unsigned int seed, struct random_data *rand_state) + _GL_ARG_NONNULL ((2))); +# endif +_GL_CXXALIAS_SYS (srandom_r, int, + (unsigned int seed, struct random_data *rand_state)); +_GL_CXXALIASWARN (srandom_r); +#elif defined GNULIB_POSIXCHECK +# undef srandom_r +# if HAVE_RAW_DECL_SRANDOM_R +_GL_WARN_ON_USE (srandom_r, "srandom_r is unportable - " + "use gnulib module random_r for portability"); +# endif +#endif + +#if @GNULIB_RANDOM_R@ +# if !@HAVE_RANDOM_R@ +_GL_FUNCDECL_SYS (initstate_r, int, + (unsigned int seed, char *buf, size_t buf_size, + struct random_data *rand_state) + _GL_ARG_NONNULL ((2, 4))); +# endif +_GL_CXXALIAS_SYS (initstate_r, int, + (unsigned int seed, char *buf, size_t buf_size, + struct random_data *rand_state)); +_GL_CXXALIASWARN (initstate_r); +#elif defined GNULIB_POSIXCHECK +# undef initstate_r +# if HAVE_RAW_DECL_INITSTATE_R +_GL_WARN_ON_USE (initstate_r, "initstate_r is unportable - " + "use gnulib module random_r for portability"); +# endif +#endif + +#if @GNULIB_RANDOM_R@ +# if !@HAVE_RANDOM_R@ +_GL_FUNCDECL_SYS (setstate_r, int, + (char *arg_state, struct random_data *rand_state) + _GL_ARG_NONNULL ((1, 2))); +# endif +_GL_CXXALIAS_SYS (setstate_r, int, + (char *arg_state, struct random_data *rand_state)); +_GL_CXXALIASWARN (setstate_r); +#elif defined GNULIB_POSIXCHECK +# undef setstate_r +# if HAVE_RAW_DECL_SETSTATE_R +_GL_WARN_ON_USE (setstate_r, "setstate_r is unportable - " + "use gnulib module random_r for portability"); +# endif +#endif + + +#if @GNULIB_REALLOC_POSIX@ +# if @REPLACE_REALLOC@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef realloc +# define realloc rpl_realloc +# endif +_GL_FUNCDECL_RPL (realloc, void *, (void *ptr, size_t size)); +_GL_CXXALIAS_RPL (realloc, void *, (void *ptr, size_t size)); +# else +_GL_CXXALIAS_SYS (realloc, void *, (void *ptr, size_t size)); +# endif +_GL_CXXALIASWARN (realloc); +#elif defined GNULIB_POSIXCHECK +# undef realloc +/* Assume realloc is always declared. */ +_GL_WARN_ON_USE (realloc, "realloc is not POSIX compliant everywhere - " + "use gnulib module realloc-posix for portability"); +#endif + +#if @GNULIB_REALPATH@ +# if @REPLACE_REALPATH@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# define realpath rpl_realpath +# endif +_GL_FUNCDECL_RPL (realpath, char *, (const char *name, char *resolved) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (realpath, char *, (const char *name, char *resolved)); +# else +# if !@HAVE_REALPATH@ +_GL_FUNCDECL_SYS (realpath, char *, (const char *name, char *resolved) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (realpath, char *, (const char *name, char *resolved)); +# endif +_GL_CXXALIASWARN (realpath); +#elif defined GNULIB_POSIXCHECK +# undef realpath +# if HAVE_RAW_DECL_REALPATH +_GL_WARN_ON_USE (realpath, "realpath is unportable - use gnulib module " + "canonicalize or canonicalize-lgpl for portability"); +# endif +#endif + +#if @GNULIB_RPMATCH@ +/* Test a user response to a question. + Return 1 if it is affirmative, 0 if it is negative, or -1 if not clear. */ +# if !@HAVE_RPMATCH@ +_GL_FUNCDECL_SYS (rpmatch, int, (const char *response) _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (rpmatch, int, (const char *response)); +_GL_CXXALIASWARN (rpmatch); +#elif defined GNULIB_POSIXCHECK +# undef rpmatch +# if HAVE_RAW_DECL_RPMATCH +_GL_WARN_ON_USE (rpmatch, "rpmatch is unportable - " + "use gnulib module rpmatch for portability"); +# endif +#endif + +#if @GNULIB_SETENV@ +/* Set NAME to VALUE in the environment. + If REPLACE is nonzero, overwrite an existing value. */ +# if @REPLACE_SETENV@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef setenv +# define setenv rpl_setenv +# endif +_GL_FUNCDECL_RPL (setenv, int, + (const char *name, const char *value, int replace) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (setenv, int, + (const char *name, const char *value, int replace)); +# else +# if !@HAVE_DECL_SETENV@ +_GL_FUNCDECL_SYS (setenv, int, + (const char *name, const char *value, int replace) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (setenv, int, + (const char *name, const char *value, int replace)); +# endif +# if !(@REPLACE_SETENV@ && !@HAVE_DECL_SETENV@) +_GL_CXXALIASWARN (setenv); +# endif +#elif defined GNULIB_POSIXCHECK +# undef setenv +# if HAVE_RAW_DECL_SETENV +_GL_WARN_ON_USE (setenv, "setenv is unportable - " + "use gnulib module setenv for portability"); +# endif +#endif + +#if @GNULIB_STRTOD@ + /* Parse a double from STRING, updating ENDP if appropriate. */ +# if @REPLACE_STRTOD@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# define strtod rpl_strtod +# endif +_GL_FUNCDECL_RPL (strtod, double, (const char *str, char **endp) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (strtod, double, (const char *str, char **endp)); +# else +# if !@HAVE_STRTOD@ +_GL_FUNCDECL_SYS (strtod, double, (const char *str, char **endp) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (strtod, double, (const char *str, char **endp)); +# endif +_GL_CXXALIASWARN (strtod); +#elif defined GNULIB_POSIXCHECK +# undef strtod +# if HAVE_RAW_DECL_STRTOD +_GL_WARN_ON_USE (strtod, "strtod is unportable - " + "use gnulib module strtod for portability"); +# endif +#endif + +#if @GNULIB_STRTOLL@ +/* Parse a signed integer whose textual representation starts at STRING. + The integer is expected to be in base BASE (2 <= BASE <= 36); if BASE == 0, + it may be decimal or octal (with prefix "0") or hexadecimal (with prefix + "0x"). + If ENDPTR is not NULL, the address of the first byte after the integer is + stored in *ENDPTR. + Upon overflow, the return value is LLONG_MAX or LLONG_MIN, and errno is set + to ERANGE. */ +# if !@HAVE_STRTOLL@ +_GL_FUNCDECL_SYS (strtoll, long long, + (const char *string, char **endptr, int base) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (strtoll, long long, + (const char *string, char **endptr, int base)); +_GL_CXXALIASWARN (strtoll); +#elif defined GNULIB_POSIXCHECK +# undef strtoll +# if HAVE_RAW_DECL_STRTOLL +_GL_WARN_ON_USE (strtoll, "strtoll is unportable - " + "use gnulib module strtoll for portability"); +# endif +#endif + +#if @GNULIB_STRTOULL@ +/* Parse an unsigned integer whose textual representation starts at STRING. + The integer is expected to be in base BASE (2 <= BASE <= 36); if BASE == 0, + it may be decimal or octal (with prefix "0") or hexadecimal (with prefix + "0x"). + If ENDPTR is not NULL, the address of the first byte after the integer is + stored in *ENDPTR. + Upon overflow, the return value is ULLONG_MAX, and errno is set to + ERANGE. */ +# if !@HAVE_STRTOULL@ +_GL_FUNCDECL_SYS (strtoull, unsigned long long, + (const char *string, char **endptr, int base) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (strtoull, unsigned long long, + (const char *string, char **endptr, int base)); +_GL_CXXALIASWARN (strtoull); +#elif defined GNULIB_POSIXCHECK +# undef strtoull +# if HAVE_RAW_DECL_STRTOULL +_GL_WARN_ON_USE (strtoull, "strtoull is unportable - " + "use gnulib module strtoull for portability"); +# endif +#endif + +#if @GNULIB_UNLOCKPT@ +/* Unlock the slave side of the pseudo-terminal whose master side is specified + by FD, so that it can be opened. */ +# if !@HAVE_UNLOCKPT@ +_GL_FUNCDECL_SYS (unlockpt, int, (int fd)); +# endif +_GL_CXXALIAS_SYS (unlockpt, int, (int fd)); +_GL_CXXALIASWARN (unlockpt); +#elif defined GNULIB_POSIXCHECK +# undef unlockpt +# if HAVE_RAW_DECL_UNLOCKPT +_GL_WARN_ON_USE (unlockpt, "unlockpt is not portable - " + "use gnulib module unlockpt for portability"); +# endif +#endif + +#if @GNULIB_UNSETENV@ +/* Remove the variable NAME from the environment. */ +# if @REPLACE_UNSETENV@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef unsetenv +# define unsetenv rpl_unsetenv +# endif +_GL_FUNCDECL_RPL (unsetenv, int, (const char *name) _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (unsetenv, int, (const char *name)); +# else +# if !@HAVE_DECL_UNSETENV@ +_GL_FUNCDECL_SYS (unsetenv, int, (const char *name) _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (unsetenv, int, (const char *name)); +# endif +# if !(@REPLACE_UNSETENV@ && !@HAVE_DECL_UNSETENV@) +_GL_CXXALIASWARN (unsetenv); +# endif +#elif defined GNULIB_POSIXCHECK +# undef unsetenv +# if HAVE_RAW_DECL_UNSETENV +_GL_WARN_ON_USE (unsetenv, "unsetenv is unportable - " + "use gnulib module unsetenv for portability"); +# endif +#endif + + +#endif /* _GL_STDLIB_H */ +#endif /* _GL_STDLIB_H */ +#endif diff --git a/lib/sys_stat.in.h b/lib/sys_stat.in.h new file mode 100644 index 00000000000..61cdcc53928 --- /dev/null +++ b/lib/sys_stat.in.h @@ -0,0 +1,646 @@ +/* Provide a more complete sys/stat header file. + Copyright (C) 2005-2011 Free Software Foundation, Inc. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 3, or (at your option) + any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software Foundation, + Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. */ + +/* Written by Eric Blake, Paul Eggert, and Jim Meyering. */ + +/* This file is supposed to be used on platforms where <sys/stat.h> is + incomplete. It is intended to provide definitions and prototypes + needed by an application. Start with what the system provides. */ + +#if __GNUC__ >= 3 +@PRAGMA_SYSTEM_HEADER@ +#endif +@PRAGMA_COLUMNS@ + +#if defined __need_system_sys_stat_h +/* Special invocation convention. */ + +#@INCLUDE_NEXT@ @NEXT_SYS_STAT_H@ + +#else +/* Normal invocation convention. */ + +#ifndef _GL_SYS_STAT_H + +/* Get nlink_t. */ +#include <sys/types.h> + +/* Get struct timespec. */ +#include <time.h> + +/* The include_next requires a split double-inclusion guard. */ +#@INCLUDE_NEXT@ @NEXT_SYS_STAT_H@ + +#ifndef _GL_SYS_STAT_H +#define _GL_SYS_STAT_H + +/* The definitions of _GL_FUNCDECL_RPL etc. are copied here. */ + +/* The definition of _GL_ARG_NONNULL is copied here. */ + +/* The definition of _GL_WARN_ON_USE is copied here. */ + +/* Before doing "#define mkdir rpl_mkdir" below, we need to include all + headers that may declare mkdir(). */ +#if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__ +# include <io.h> /* mingw32, mingw64 */ +# include <direct.h> /* mingw64 */ +#endif + +#ifndef S_IFMT +# define S_IFMT 0170000 +#endif + +#if STAT_MACROS_BROKEN +# undef S_ISBLK +# undef S_ISCHR +# undef S_ISDIR +# undef S_ISFIFO +# undef S_ISLNK +# undef S_ISNAM +# undef S_ISMPB +# undef S_ISMPC +# undef S_ISNWK +# undef S_ISREG +# undef S_ISSOCK +#endif + +#ifndef S_ISBLK +# ifdef S_IFBLK +# define S_ISBLK(m) (((m) & S_IFMT) == S_IFBLK) +# else +# define S_ISBLK(m) 0 +# endif +#endif + +#ifndef S_ISCHR +# ifdef S_IFCHR +# define S_ISCHR(m) (((m) & S_IFMT) == S_IFCHR) +# else +# define S_ISCHR(m) 0 +# endif +#endif + +#ifndef S_ISDIR +# ifdef S_IFDIR +# define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR) +# else +# define S_ISDIR(m) 0 +# endif +#endif + +#ifndef S_ISDOOR /* Solaris 2.5 and up */ +# define S_ISDOOR(m) 0 +#endif + +#ifndef S_ISFIFO +# ifdef S_IFIFO +# define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO) +# else +# define S_ISFIFO(m) 0 +# endif +#endif + +#ifndef S_ISLNK +# ifdef S_IFLNK +# define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK) +# else +# define S_ISLNK(m) 0 +# endif +#endif + +#ifndef S_ISMPB /* V7 */ +# ifdef S_IFMPB +# define S_ISMPB(m) (((m) & S_IFMT) == S_IFMPB) +# define S_ISMPC(m) (((m) & S_IFMT) == S_IFMPC) +# else +# define S_ISMPB(m) 0 +# define S_ISMPC(m) 0 +# endif +#endif + +#ifndef S_ISNAM /* Xenix */ +# ifdef S_IFNAM +# define S_ISNAM(m) (((m) & S_IFMT) == S_IFNAM) +# else +# define S_ISNAM(m) 0 +# endif +#endif + +#ifndef S_ISNWK /* HP/UX */ +# ifdef S_IFNWK +# define S_ISNWK(m) (((m) & S_IFMT) == S_IFNWK) +# else +# define S_ISNWK(m) 0 +# endif +#endif + +#ifndef S_ISPORT /* Solaris 10 and up */ +# define S_ISPORT(m) 0 +#endif + +#ifndef S_ISREG +# ifdef S_IFREG +# define S_ISREG(m) (((m) & S_IFMT) == S_IFREG) +# else +# define S_ISREG(m) 0 +# endif +#endif + +#ifndef S_ISSOCK +# ifdef S_IFSOCK +# define S_ISSOCK(m) (((m) & S_IFMT) == S_IFSOCK) +# else +# define S_ISSOCK(m) 0 +# endif +#endif + + +#ifndef S_TYPEISMQ +# define S_TYPEISMQ(p) 0 +#endif + +#ifndef S_TYPEISTMO +# define S_TYPEISTMO(p) 0 +#endif + + +#ifndef S_TYPEISSEM +# ifdef S_INSEM +# define S_TYPEISSEM(p) (S_ISNAM ((p)->st_mode) && (p)->st_rdev == S_INSEM) +# else +# define S_TYPEISSEM(p) 0 +# endif +#endif + +#ifndef S_TYPEISSHM +# ifdef S_INSHD +# define S_TYPEISSHM(p) (S_ISNAM ((p)->st_mode) && (p)->st_rdev == S_INSHD) +# else +# define S_TYPEISSHM(p) 0 +# endif +#endif + +/* high performance ("contiguous data") */ +#ifndef S_ISCTG +# define S_ISCTG(p) 0 +#endif + +/* Cray DMF (data migration facility): off line, with data */ +#ifndef S_ISOFD +# define S_ISOFD(p) 0 +#endif + +/* Cray DMF (data migration facility): off line, with no data */ +#ifndef S_ISOFL +# define S_ISOFL(p) 0 +#endif + +/* 4.4BSD whiteout */ +#ifndef S_ISWHT +# define S_ISWHT(m) 0 +#endif + +/* If any of the following are undefined, + define them to their de facto standard values. */ +#if !S_ISUID +# define S_ISUID 04000 +#endif +#if !S_ISGID +# define S_ISGID 02000 +#endif + +/* S_ISVTX is a common extension to POSIX. */ +#ifndef S_ISVTX +# define S_ISVTX 01000 +#endif + +#if !S_IRUSR && S_IREAD +# define S_IRUSR S_IREAD +#endif +#if !S_IRUSR +# define S_IRUSR 00400 +#endif +#if !S_IRGRP +# define S_IRGRP (S_IRUSR >> 3) +#endif +#if !S_IROTH +# define S_IROTH (S_IRUSR >> 6) +#endif + +#if !S_IWUSR && S_IWRITE +# define S_IWUSR S_IWRITE +#endif +#if !S_IWUSR +# define S_IWUSR 00200 +#endif +#if !S_IWGRP +# define S_IWGRP (S_IWUSR >> 3) +#endif +#if !S_IWOTH +# define S_IWOTH (S_IWUSR >> 6) +#endif + +#if !S_IXUSR && S_IEXEC +# define S_IXUSR S_IEXEC +#endif +#if !S_IXUSR +# define S_IXUSR 00100 +#endif +#if !S_IXGRP +# define S_IXGRP (S_IXUSR >> 3) +#endif +#if !S_IXOTH +# define S_IXOTH (S_IXUSR >> 6) +#endif + +#if !S_IRWXU +# define S_IRWXU (S_IRUSR | S_IWUSR | S_IXUSR) +#endif +#if !S_IRWXG +# define S_IRWXG (S_IRGRP | S_IWGRP | S_IXGRP) +#endif +#if !S_IRWXO +# define S_IRWXO (S_IROTH | S_IWOTH | S_IXOTH) +#endif + +/* S_IXUGO is a common extension to POSIX. */ +#if !S_IXUGO +# define S_IXUGO (S_IXUSR | S_IXGRP | S_IXOTH) +#endif + +#ifndef S_IRWXUGO +# define S_IRWXUGO (S_IRWXU | S_IRWXG | S_IRWXO) +#endif + +/* Macros for futimens and utimensat. */ +#ifndef UTIME_NOW +# define UTIME_NOW (-1) +# define UTIME_OMIT (-2) +#endif + + +#if @GNULIB_FCHMODAT@ +# if !@HAVE_FCHMODAT@ +_GL_FUNCDECL_SYS (fchmodat, int, + (int fd, char const *file, mode_t mode, int flag) + _GL_ARG_NONNULL ((2))); +# endif +_GL_CXXALIAS_SYS (fchmodat, int, + (int fd, char const *file, mode_t mode, int flag)); +_GL_CXXALIASWARN (fchmodat); +#elif defined GNULIB_POSIXCHECK +# undef fchmodat +# if HAVE_RAW_DECL_FCHMODAT +_GL_WARN_ON_USE (fchmodat, "fchmodat is not portable - " + "use gnulib module openat for portability"); +# endif +#endif + + +#if @REPLACE_FSTAT@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# define fstat rpl_fstat +# endif +_GL_FUNCDECL_RPL (fstat, int, (int fd, struct stat *buf) _GL_ARG_NONNULL ((2))); +_GL_CXXALIAS_RPL (fstat, int, (int fd, struct stat *buf)); +#else +_GL_CXXALIAS_SYS (fstat, int, (int fd, struct stat *buf)); +#endif +_GL_CXXALIASWARN (fstat); + + +#if @GNULIB_FSTATAT@ +# if @REPLACE_FSTATAT@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef fstatat +# define fstatat rpl_fstatat +# endif +_GL_FUNCDECL_RPL (fstatat, int, + (int fd, char const *name, struct stat *st, int flags) + _GL_ARG_NONNULL ((2, 3))); +_GL_CXXALIAS_RPL (fstatat, int, + (int fd, char const *name, struct stat *st, int flags)); +# else +# if !@HAVE_FSTATAT@ +_GL_FUNCDECL_SYS (fstatat, int, + (int fd, char const *name, struct stat *st, int flags) + _GL_ARG_NONNULL ((2, 3))); +# endif +_GL_CXXALIAS_SYS (fstatat, int, + (int fd, char const *name, struct stat *st, int flags)); +# endif +_GL_CXXALIASWARN (fstatat); +#elif defined GNULIB_POSIXCHECK +# undef fstatat +# if HAVE_RAW_DECL_FSTATAT +_GL_WARN_ON_USE (fstatat, "fstatat is not portable - " + "use gnulib module openat for portability"); +# endif +#endif + + +#if @GNULIB_FUTIMENS@ +# if @REPLACE_FUTIMENS@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef futimens +# define futimens rpl_futimens +# endif +_GL_FUNCDECL_RPL (futimens, int, (int fd, struct timespec const times[2])); +_GL_CXXALIAS_RPL (futimens, int, (int fd, struct timespec const times[2])); +# else +# if !@HAVE_FUTIMENS@ +_GL_FUNCDECL_SYS (futimens, int, (int fd, struct timespec const times[2])); +# endif +_GL_CXXALIAS_SYS (futimens, int, (int fd, struct timespec const times[2])); +# endif +_GL_CXXALIASWARN (futimens); +#elif defined GNULIB_POSIXCHECK +# undef futimens +# if HAVE_RAW_DECL_FUTIMENS +_GL_WARN_ON_USE (futimens, "futimens is not portable - " + "use gnulib module futimens for portability"); +# endif +#endif + + +#if @GNULIB_LCHMOD@ +/* Change the mode of FILENAME to MODE, without dereferencing it if FILENAME + denotes a symbolic link. */ +# if !@HAVE_LCHMOD@ +/* The lchmod replacement follows symbolic links. Callers should take + this into account; lchmod should be applied only to arguments that + are known to not be symbolic links. On hosts that lack lchmod, + this can lead to race conditions between the check and the + invocation of lchmod, but we know of no workarounds that are + reliable in general. You might try requesting support for lchmod + from your operating system supplier. */ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# define lchmod chmod +# endif +/* Need to cast, because on mingw, the second parameter of chmod is + int mode. */ +_GL_CXXALIAS_RPL_CAST_1 (lchmod, chmod, int, + (const char *filename, mode_t mode)); +# else +# if 0 /* assume already declared */ +_GL_FUNCDECL_SYS (lchmod, int, (const char *filename, mode_t mode) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (lchmod, int, (const char *filename, mode_t mode)); +# endif +# if @HAVE_LCHMOD@ +_GL_CXXALIASWARN (lchmod); +# endif +#elif defined GNULIB_POSIXCHECK +# undef lchmod +# if HAVE_RAW_DECL_LCHMOD +_GL_WARN_ON_USE (lchmod, "lchmod is unportable - " + "use gnulib module lchmod for portability"); +# endif +#endif + + +#if @GNULIB_LSTAT@ +# if ! @HAVE_LSTAT@ +/* mingw does not support symlinks, therefore it does not have lstat. But + without links, stat does just fine. */ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# define lstat stat +# endif +_GL_CXXALIAS_RPL_1 (lstat, stat, int, (const char *name, struct stat *buf)); +# elif @REPLACE_LSTAT@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef lstat +# define lstat rpl_lstat +# endif +_GL_FUNCDECL_RPL (lstat, int, (const char *name, struct stat *buf) + _GL_ARG_NONNULL ((1, 2))); +_GL_CXXALIAS_RPL (lstat, int, (const char *name, struct stat *buf)); +# else +_GL_CXXALIAS_SYS (lstat, int, (const char *name, struct stat *buf)); +# endif +# if @HAVE_LSTAT@ +_GL_CXXALIASWARN (lstat); +# endif +#elif defined GNULIB_POSIXCHECK +# undef lstat +# if HAVE_RAW_DECL_LSTAT +_GL_WARN_ON_USE (lstat, "lstat is unportable - " + "use gnulib module lstat for portability"); +# endif +#endif + + +#if @REPLACE_MKDIR@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef mkdir +# define mkdir rpl_mkdir +# endif +_GL_FUNCDECL_RPL (mkdir, int, (char const *name, mode_t mode) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (mkdir, int, (char const *name, mode_t mode)); +#else +/* mingw's _mkdir() function has 1 argument, but we pass 2 arguments. + Additionally, it declares _mkdir (and depending on compile flags, an + alias mkdir), only in the nonstandard includes <direct.h> and <io.h>, + which are included above. */ +# if (defined _WIN32 || defined __WIN32__) && ! defined __CYGWIN__ + +# if !GNULIB_defined_rpl_mkdir +static inline int +rpl_mkdir (char const *name, mode_t mode) +{ + return _mkdir (name); +} +# define GNULIB_defined_rpl_mkdir 1 +# endif + +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# define mkdir rpl_mkdir +# endif +_GL_CXXALIAS_RPL (mkdir, int, (char const *name, mode_t mode)); +# else +_GL_CXXALIAS_SYS (mkdir, int, (char const *name, mode_t mode)); +# endif +#endif +_GL_CXXALIASWARN (mkdir); + + +#if @GNULIB_MKDIRAT@ +# if !@HAVE_MKDIRAT@ +_GL_FUNCDECL_SYS (mkdirat, int, (int fd, char const *file, mode_t mode) + _GL_ARG_NONNULL ((2))); +# endif +_GL_CXXALIAS_SYS (mkdirat, int, (int fd, char const *file, mode_t mode)); +_GL_CXXALIASWARN (mkdirat); +#elif defined GNULIB_POSIXCHECK +# undef mkdirat +# if HAVE_RAW_DECL_MKDIRAT +_GL_WARN_ON_USE (mkdirat, "mkdirat is not portable - " + "use gnulib module openat for portability"); +# endif +#endif + + +#if @GNULIB_MKFIFO@ +# if @REPLACE_MKFIFO@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef mkfifo +# define mkfifo rpl_mkfifo +# endif +_GL_FUNCDECL_RPL (mkfifo, int, (char const *file, mode_t mode) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (mkfifo, int, (char const *file, mode_t mode)); +# else +# if !@HAVE_MKFIFO@ +_GL_FUNCDECL_SYS (mkfifo, int, (char const *file, mode_t mode) + _GL_ARG_NONNULL ((1))); +# endif +_GL_CXXALIAS_SYS (mkfifo, int, (char const *file, mode_t mode)); +# endif +_GL_CXXALIASWARN (mkfifo); +#elif defined GNULIB_POSIXCHECK +# undef mkfifo +# if HAVE_RAW_DECL_MKFIFO +_GL_WARN_ON_USE (mkfifo, "mkfifo is not portable - " + "use gnulib module mkfifo for portability"); +# endif +#endif + + +#if @GNULIB_MKFIFOAT@ +# if !@HAVE_MKFIFOAT@ +_GL_FUNCDECL_SYS (mkfifoat, int, (int fd, char const *file, mode_t mode) + _GL_ARG_NONNULL ((2))); +# endif +_GL_CXXALIAS_SYS (mkfifoat, int, (int fd, char const *file, mode_t mode)); +_GL_CXXALIASWARN (mkfifoat); +#elif defined GNULIB_POSIXCHECK +# undef mkfifoat +# if HAVE_RAW_DECL_MKFIFOAT +_GL_WARN_ON_USE (mkfifoat, "mkfifoat is not portable - " + "use gnulib module mkfifoat for portability"); +# endif +#endif + + +#if @GNULIB_MKNOD@ +# if @REPLACE_MKNOD@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef mknod +# define mknod rpl_mknod +# endif +_GL_FUNCDECL_RPL (mknod, int, (char const *file, mode_t mode, dev_t dev) + _GL_ARG_NONNULL ((1))); +_GL_CXXALIAS_RPL (mknod, int, (char const *file, mode_t mode, dev_t dev)); +# else +# if !@HAVE_MKNOD@ +_GL_FUNCDECL_SYS (mknod, int, (char const *file, mode_t mode, dev_t dev) + _GL_ARG_NONNULL ((1))); +# endif +/* Need to cast, because on OSF/1 5.1, the third parameter is '...'. */ +_GL_CXXALIAS_SYS_CAST (mknod, int, (char const *file, mode_t mode, dev_t dev)); +# endif +_GL_CXXALIASWARN (mknod); +#elif defined GNULIB_POSIXCHECK +# undef mknod +# if HAVE_RAW_DECL_MKNOD +_GL_WARN_ON_USE (mknod, "mknod is not portable - " + "use gnulib module mknod for portability"); +# endif +#endif + + +#if @GNULIB_MKNODAT@ +# if !@HAVE_MKNODAT@ +_GL_FUNCDECL_SYS (mknodat, int, + (int fd, char const *file, mode_t mode, dev_t dev) + _GL_ARG_NONNULL ((2))); +# endif +_GL_CXXALIAS_SYS (mknodat, int, + (int fd, char const *file, mode_t mode, dev_t dev)); +_GL_CXXALIASWARN (mknodat); +#elif defined GNULIB_POSIXCHECK +# undef mknodat +# if HAVE_RAW_DECL_MKNODAT +_GL_WARN_ON_USE (mknodat, "mknodat is not portable - " + "use gnulib module mkfifoat for portability"); +# endif +#endif + + +#if @GNULIB_STAT@ +# if @REPLACE_STAT@ +/* We can't use the object-like #define stat rpl_stat, because of + struct stat. This means that rpl_stat will not be used if the user + does (stat)(a,b). Oh well. */ +# undef stat +# ifdef _LARGE_FILES + /* With _LARGE_FILES defined, AIX (only) defines stat to stat64, + so we have to replace stat64() instead of stat(). */ +# define stat stat64 +# undef stat64 +# define stat64(name, st) rpl_stat (name, st) +# else /* !_LARGE_FILES */ +# define stat(name, st) rpl_stat (name, st) +# endif /* !_LARGE_FILES */ +_GL_EXTERN_C int stat (const char *name, struct stat *buf) + _GL_ARG_NONNULL ((1, 2)); +# endif +#elif defined GNULIB_POSIXCHECK +# undef stat +# if HAVE_RAW_DECL_STAT +_GL_WARN_ON_USE (stat, "stat is unportable - " + "use gnulib module stat for portability"); +# endif +#endif + + +#if @GNULIB_UTIMENSAT@ +# if @REPLACE_UTIMENSAT@ +# if !(defined __cplusplus && defined GNULIB_NAMESPACE) +# undef utimensat +# define utimensat rpl_utimensat +# endif +_GL_FUNCDECL_RPL (utimensat, int, (int fd, char const *name, + struct timespec const times[2], int flag) + _GL_ARG_NONNULL ((2))); +_GL_CXXALIAS_RPL (utimensat, int, (int fd, char const *name, + struct timespec const times[2], int flag)); +# else +# if !@HAVE_UTIMENSAT@ +_GL_FUNCDECL_SYS (utimensat, int, (int fd, char const *name, + struct timespec const times[2], int flag) + _GL_ARG_NONNULL ((2))); +# endif +_GL_CXXALIAS_SYS (utimensat, int, (int fd, char const *name, + struct timespec const times[2], int flag)); +# endif +_GL_CXXALIASWARN (utimensat); +#elif defined GNULIB_POSIXCHECK +# undef utimensat +# if HAVE_RAW_DECL_UTIMENSAT +_GL_WARN_ON_USE (utimensat, "utimensat is not portable - " + "use gnulib module utimensat for portability"); +# endif +#endif + + +#endif /* _GL_SYS_STAT_H */ +#endif /* _GL_SYS_STAT_H */ +#endif diff --git a/lisp/.gitignore b/lisp/.gitignore index d8ab5055b4a..6d5166e1349 100644 --- a/lisp/.gitignore +++ b/lisp/.gitignore @@ -4,5 +4,3 @@ loaddefs.el subdirs.el finder-inf.el cus-load.el - -# arch-tag: ab6e8f91-fb95-4efe-9c1b-68e21561e68a diff --git a/lisp/ChangeLog.trunk b/lisp/ChangeLog.trunk index b3735e37289..05c765e0881 100644 --- a/lisp/ChangeLog.trunk +++ b/lisp/ChangeLog.trunk @@ -1,3 +1,502 @@ +2011-02-21 Michael Albinus <michael.albinus@gmx.de> + + * net/tramp.el (tramp-rfn-eshadow-setup-minibuffer): Do not use + `field' property of `rfn-eshadow-overlay'. + +2011-02-21 Lars Ingebrigtsen <larsi@gnus.org> + + * net/netrc.el (netrc-parse): Comment fix. + +2011-02-21 Chong Yidong <cyd@stupidchicken.com> + + * color.el (color-name-to-rgb): Rename from color-rgb->normalize. + Autoload. Add optional arg FRAME, and pass it to color-values. + (color-complement): Caller changed. Doc fix. + (color-gradient): Rewrite for better clarity and efficiency. + + * faces.el (color-values): Use cond for clarity. Doc fix. + + * facemenu.el (color-rgb-to-hsv): Deleted; use the version in + color.el instead. + (list-colors-sort-key, list-colors-print): Use + color-normalized-values. + +2011-02-20 Drew Adams <drew.adams@oracle.com> + + * color.el: First part of merge from hexrgb.el. + (color-rgb-to-hex): Rename from color-rgb->hex. + (color-rgb-to-hsv): Rename from color-rgb->hsv. Force hue and + saturation to zero if the value is too small. + (color-rgb-to-hsl): Rename from color-rgb->hsl. + (color-srgb-to-xyz): Rename from color-srgb->xyz. Doc fix. + (color-xyz-to-srgb): Rename from color-xyz->srgb. Doc fix. + (color-xyz-to-lab): Rename from color-xyz->lab. Doc fix. + (color-lab-to-xyz): Rename from color-lab->xyz. Doc fix. + (color-lab-to-srgb): Rename from color-lab->srgb. Doc fix. + (color-cie-de2000): Doc fix. + +2011-02-20 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-cmds.el (c-beginning-of-statement): Avoid loop in + locating the beginning of a macro. (Bug#7595) + +2011-02-20 Glenn Morris <rgm@gnu.org> + + * edmacro.el (edmacro-eight-bits): Make it a defcustom. + Don't autoload it. + + * autorevert.el (auto-revert-mode, auto-revert-tail-mode) + (global-auto-revert-ignore-buffer): Remove leading "*" from docs. + +2011-02-19 Dmitry Bolshakov <dmitry.bolshakov@bridge-quest.com> + Dima Kogan <dkogan@cds.caltech.edu> (tiny change) + + * progmodes/hideshow.el (hs-find-block-beginning) + (hs-hide-level-recursive): Ignore comments when parsing braces + (Bug#8036). + +2011-02-19 Chong Yidong <cyd@stupidchicken.com> + + * vc/vc-bzr.el (vc-bzr-bound-branch-p): New function. + (vc-bzr-pull): Use it. + +2011-02-19 Chong Yidong <cyd@stupidchicken.com> + + * vc/vc-bzr.el (vc-bzr--branch-conf): Function deleted. + (vc-bzr-branch-conf): New function, similar to vc-bzr--branch-conf + but returning an alist. Ignore comments in bzr conffile. + (vc-bzr-pull, vc-bzr-merge-branch): Use vc-bzr-branch-conf. + (vc-bzr-error-regex-alist): New var. + (vc-bzr-merge-branch): Use it to highlight the pull/merge buffer. + + * vc/vc-dispatcher.el (vc-do-async-command): Bind + inhibit-read-only to t. + + * progmodes/compile.el (compilation--flush-directory-cache): + Handle the case where cdr of compilation--flush-directory-cache + points to no buffer, which can occur if we previously switched to + compilation-mode in a pregenerated buffer. + +2011-02-19 Kenichi Handa <handa@m17n.org> + + * mail/rmailmm.el (rmail-mime-find-header-encoding): Be sure to + get the header copy into the temporary buffer. + (rmail-mime-insert-decoded-text): Ignore us-ascii. + (rmail-show-mime): When rmail-mime-coding-system is nil, set + buffer-file-coding-system to undecided. + +2011-02-19 Eli Zaretskii <eliz@gnu.org> + + * international/mule-cmds.el (read-char-by-name, ucs-insert): + Document completion with asterisk and a substring. + +2011-02-19 Glenn Morris <rgm@gnu.org> + + * files.el (find-file-literally): Doc fix. + + * simple.el (rfc822-goto-eoh): Give it a doc-string. + + * log-edit.el (log-edit-insert-changelog): + Fix `log-edit-strip-single-file-name' functionality. (Bug#8057) + +2011-02-19 Glenn Morris <rgm@gnu.org> + + * dired-x.el: Don't require dired-aux. + (dired-do-create-files, dired-mark-read-regexp) + (dired-do-create-files-regexp): Autoload from dired-aux. + + * dired-x.el (dired-find-buffer-nocreate): Merge into dired.el. + * dired.el (dired-find-buffer-nocreate): Merge dired-x version. + + * dired-x.el (dired-read-shell-command): Merge into dired-aux's version. + * dired-aux.el (dired-read-shell-command): Merge dired-x's version. + + * dired-x.el (dired-clean-up-after-deletion): Merge into dired.el. + * dired.el (dired-clean-up-after-deletion): Merge dired-x's version. + (dired-clean-up-buffers-too): Declare. + + * dired-x.el (dired-initial-position): Merge into dired.el's version. + * dired.el (dired-initial-position): Merge dired-x's version here. + (dired-find-subdir): Declare. + + * dired-x.el (dired-omit-new-add-entry): Merge into dired-add-entry. + * dired-aux.el (dired-add-entry): Give it a doc-string. + Merge dired-x's dired-omit handling here. + (dired-omit-mode, dired-omit-regexp, dired-omit-localp): Declare. + + * international/mule-diag.el (list-input-methods-1): + Indent all lines of multi-line doc-strings. (Bug#8066) + +2011-02-18 Chong Yidong <cyd@stupidchicken.com> + + Fix 2011-02-02 changes. + + * apropos.el (apropos-print): Call apropos-mode before setting up + buffer variables. Use inhibit-read-only. + + * emacs-lisp/package.el (package--list-packages): Call + package-menu-mode before setting up buffer variables. + + * play/solitaire.el (solitaire): Call solitaire-mode before + setting up buffer variables. Use inhibit-read-only. + +2011-02-18 Lawrence Mitchell <wence@gmx.li> + + * progmodes/sh-script.el (sh-syntax-propertize-here-doc): (bug#8053) + Bind case-fold-search to nil when looking for end of here-doc. + +2011-02-18 Eli Zaretskii <eliz@gnu.org> + + * image-mode.el (image-toggle-display-image): + Set find-file-literally non-nil in buffers visiting binary image + files. (Bug#8047) + +2011-02-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * files.el (cd): Make completion obey cd-path (bug#7924). + +2011-02-18 Glenn Morris <rgm@gnu.org> + + * progmodes/prolog.el: Don't require compile when compiling. + (compilation-shell-minor-mode, compilation-error-regexp-alist) + (compilation-forget-errors, compilation-fake-loc) + (compilation-parse-errors-function, compilation-error-list): Declare. + (prolog-inferior-mode): Require 'compile. + + * emulation/cua-base.el (pc-selection-mode): Declare. + + * emacs-lisp/eieio-custom.el: Set generated-autoload-file. + (customize-object): Add autoload cookie. + * emacs-lisp/eieio-opt.el: Set generated-autoload-file. + (eieio-browse, describe-class, eieio-describe-class) + (eieio-describe-constructor, describe-generic, eieio-describe-generic) + (eieio-help-mode-augmentation-maybee): Add autoload cookies. + * emacs-lisp/eieio.el: Regenerate with automatic autoloads. + * Makefile.in (autoloads): Make eieio.el writable. + + * dired-x.el (dired-clean-up-after-deletion, dired-do-relsymlink) + (dired-do-relsymlink-regexp, dired-find-buffer-nocreate): Use #'. + (dired-hack-local-variables): Use inhibit-read-only. + (dired-guess-default): Simplify. + (dired-make-relative-symlink): Use dotimes. + (dired-simultaneous-find-file): Use dolist. + (dired-mark-sexp): Remove unneeded `if'. Use line-end-position. + (dired-x-hands-off-my-keys): Doc fix. + (dired-x-bind-find-file): Doc fix. Use remapping. + (after-init-hook): No need to add dired-x-bind-find-file. + (dired-x-find-file, dired-x-find-file-other-window): Doc fixes. + No need to call expand-file-name. + (dired-filename-at-point): Remove unused locals `end', `filename'. + +2011-02-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/pcase.el (pcase--u1): Understand non-linear patterns. + +2011-02-18 Christian Ohler <ohler@gnu.org> + + * emacs-lisp/ert.el (ert--setup-results-buffer) + (ert-results-pop-to-backtrace-for-test-at-point) + (ert-results-pop-to-messages-for-test-at-point) + (ert-results-pop-to-should-forms-for-test-at-point) + (ert-results-pop-to-timings): Revert parts of change 2011-02-02T17:59:44Z!sds@gnu.org that + were incorrect and unnecessary. This should make `make check' + pass again. + +2011-02-17 Ken Manheimer <ken.manheimer@gmail.com> + + * lisp/allout-widgets.el: (allout-widgets-icons-light-subdir) + (allout-widgets-icons-dark-subdir): Track relocations of icons + * lisp/allout.el: Remove commentary about remove encryption + passphrase mnemonic support and verification. + (allout-encrypt-string): (allout-encrypt-string): Recognize epg + failure to decrypt gpg2 armored text using gpg1, and indicate that + the gpg version *might* be the problem in the error message. + +2011-02-17 Deniz Dogan <deniz.a.m.dogan@gmail.com> + + * net/rcirc.el (rcirc-float-time): New function. + (rcirc-keepalive, rcirc-handler-ctcp-KEEPALIVE) + (rcirc-ctcp-sender-PING): Use it. + +2011-02-17 Glenn Morris <rgm@gnu.org> + + * speedbar.el (speedbar-ignored-modes, speedbar-file-unshown-regexp) + (speedbar-update-flag, speedbar-fetch-etags-command) + (speedbar-fetch-etags-arguments): + * term.el (term-buffer-maximum-size, term-input-chunk-size) + (term-completion-autolist, term-completion-addsuffix) + (term-completion-recexact, term-completion-fignore): + * term/sup-mouse.el (sup-mouse-fast-select-window): + * term/x-win.el (x-select-request-type): + Convert some defvars with "*" to defcustoms. + + * shell.el (shell-delimiter-argument-list): Set it to nil. (Bug#8027) + + * vc/vc.el (vc-default-previous-version): + Remove alias that points nowhere. (Bug#4496) + + * dired-x.el (dired-clean-up-after-deletion): + kill-buffer does not need save-excursion. + (dired-do-run-mail): Doc fix. + (dired-filename-at-point): Doc fix. + Use looking-at, and skip-chars rather than re search. + + * dired-x.el (dired-filename-at-point): Fix 8-year old typo. + +2011-02-16 Ken Manheimer <ken.manheimer@gmail.com> + + * allout-widgets.el: New allout extension that shows allout + outline structure with graphical widgets. 'allout-widgets' + customize group is an 'allout' subgroup, for easy discovery. + + * allout.el: Include PGP and GnuPG in Keywords, and other + commentary refinements. + (allout-abbreviate-flattened-numbering): Rename to + allout-flattened-numbering-abbreviation, and + define-obsolete-variable-alias the old name. + (allout-flattened-numbering-abbreviation): Rename from + allout-abbreviate-flattened-numbering. + (allout-mode-p): Include among autoloads, for use by other modes + with impunity. + (allout-listify-exposed): + Use allout-flattened-numbering-abbreviation. + (allout-encrypt-string): Use set-buffer-multibyte directly. + (allout-set-buffer-multibyte): Remove. + +2011-02-16 Deniz Dogan <deniz.a.m.dogan@gmail.com> + + * simple.el (just-one-space): Remove useless `or' call. + +2011-02-16 Alex Harsanyi <AlexHarsanyi@gmail.com> + + * net/soap-client.el (soap-well-known-xmlns, soap-local-xmlns) + (soap-default-xmlns, soap-target-xmlns, soap-multi-refs) + (soap-decoded-multi-refs, soap-current-wsdl) + (soap-encoded-namespaces): Rename CL-style *...* variables. + +2011-02-16 Michael Albinus <michael.albinus@gmx.de> + + * net/soap-client.el: Add "comm" and "hypermedia" to the + keywords. Reflow too long lines. + + * net/soap-inspect.el: Ditto. Require 'cl. + +2011-02-16 Bastien Guerry <bzg@altern.org> + + * play/doctor.el (doctor-mode): Bugfix: escape the "," character + in a `doctor-type' argument. + +2011-02-16 Alex Harsanyi <AlexHarsanyi@gmail.com> + + * net/soap-client.el: + * net/soap-inspect.el: New files. + +2011-02-16 Leo <sdl.web@gmail.com> + + * dired-x.el (dired-mode-map, dired-extra-startup): + Remove dired-copy-filename-as-kill since it's already in dired.el. + +2011-02-16 Glenn Morris <rgm@gnu.org> + + * dired-x.el (dired-bind-jump, dired-bind-man, dired-bind-info): + Doc fixes. Add :set property, replacing top-level calls. + (dired-vm-read-only-folders, dired-vm): Doc fix (drop v. old VM 4). + (dired-guess-shell-gnutar): Test tar version rather than system-type. + (dired-extra-startup, dired-man, dired-info): Doc fixes. + (dired-clean-up-after-deletion): Use when and dolist. + (dired-jump): Use unless and when. + (dired-virtual): Use line-end-position. + (dired-default-directory-alist): Rename from default-directory-alist. + (dired-default-directory): Update for above name change. + (dired-vm): Drop VM < 5 and simplify. + (dired-buffer-more-recently-used-p): Rewrite. + (dired-filename-at-point): Use when and or. + (dired-x-read-filename-at-point): Rename from read-filename-at-point. + Update callers. + +2011-02-15 Glenn Morris <rgm@gnu.org> + + * dired-x.el: Use easymenu for menu items. Fix item capitalization. + +2011-02-14 Chong Yidong <cyd@stupidchicken.com> + + * vc/vc-git.el (vc-git-root-log-format): New option for + customizing log format. + (vc-git-print-log, vc-git-log-outgoing, vc-git-log-incoming) + (vc-git-log-view-mode): Use it. + (vc-git-expanded-log-entry): New function. + (vc-git-log-view-mode): Use it. Truncate lines in root log. + + * vc/vc-hg.el (vc-hg-root-log-template): New option for + customizing log format. + (vc-hg-print-log): Use it. + (vc-hg-expanded-log-entry): New function. + (vc-hg-log-view-mode): Use vc-hg-root-log-template and + vc-hg-expanded-log-entry. Truncate lines in root log. + + * vc/vc-bzr.el (vc-bzr-log-view-mode): Truncate lines in root log. + + * vc/log-view.el (log-view-mode-menu): + Add log-view-toggle-entry-display. + +2011-02-14 Glenn Morris <rgm@gnu.org> + + * dired-x.el: Don't require man when compiling. + (dired-omit-extensions, dired-local-variables-file) + (dired-x-hands-off-my-keys): Make them defcustoms. + (Man-support-local-filenames, Man-getpage-in-background): Declare. + (vm-visit-folder): Declare rather than defining. + (dired-x-help-address, dired-x-variable-list): Remove. + (dired-x-submit-report): Make it an obsolete alias. + +2011-02-14 Juanma Barranquero <lekktu@gmail.com> + + * makefile.w32-in (TRAMP_SRC): Remove tramp-imap.el. + +2011-02-13 Teodor Zlatanov <tzz@lifelogs.com> + + * net/imap.el: Bring it back. + +2011-02-13 Alan Mackenzie <acm@muc.de> + + * progmodes/cc-fonts.el (c-font-lock-declarations): Remove a + narrow-to-region call that cuts context off the end (Bug#7722). + + * progmodes/cc-engine.el (c-forward-<>-arglist-recur): + Refactor nested if-forms with a simple cond. + (c-forward-<>-arglist): Revert 2011-01-31 change. + +2011-02-13 Chong Yidong <cyd@stupidchicken.com> + + * vc/log-view.el: New command log-view-toggle-entry-display for + toggling log entries between concise and detailed forms. + (log-view-toggle-entry-display): New command. + (log-view-mode-map): Bind RET to it. + (log-view-expanded-log-entry-function): New variable. + (log-view-current-entry, log-view-inside-comment-p) + (log-view-current-tag): New functions. + (log-view-toggle-mark-entry): Use log-view-current-entry and + log-view-end-of-defun instead of searching directly with + log-view-message-re. + (log-view-end-of-defun): Likewise. Add optional ARG for + compatibility with end-of-defun. + (log-view-end-of-defun): Ignore comments and VC buttons. + + * vc/vc-bzr.el (vc-bzr-expanded-log-entry): New function. + (vc-bzr-log-view-mode): Use log-view-expanded-log-entry-function. + +2011-02-13 Teodor Zlatanov <tzz@lifelogs.com> + + * net/imap.el: Remove file. All the functionality is in nnimap.el. + + * net/imap-hash.el: Remove file. + +2011-02-13 Michael Albinus <michael.albinus@gmx.de> + + * Makefile.in (TRAMP_SRC): Remove tramp-imap.el. + + * net/tramp.el (tramp-read-passwd): Simplify `auth-source-search' + call. + + * net/tramp-imap.el: Remove file. + +2011-02-13 Chong Yidong <cyd@stupidchicken.com> + + * vc/vc.el (vc-print-log-setup-buttons): Instead of using the + widget library for buttons, just use button.el. + + * vc/log-view.el (log-view-mode-map): Don't inherit from + widget-keymap. + +2011-02-12 Glenn Morris <rgm@gnu.org> + + * emacs-lisp/cl-seq.el (union, nunion, intersection) + (nintersection, set-difference, nset-difference) + (set-exclusive-or, nset-exclusive-or): Doc fix. + + * ediff-ptch.el (ediff-fixup-patch-map): Doc fix. + + * faces.el (face-attr-match-p): Handle the obsolete :bold and + :italic props, so that frame-set-background-mode works. (Bug#7966) + + * simple.el (next-error): Doc fix. + +2011-02-12 Thierry Volpiatto <thierry.volpiatto@gmail.com> + + * dired-aux.el (dired-create-files): Adapt destination name to + match the new behavior of copy-directory. + +2011-02-12 Chong Yidong <cyd@stupidchicken.com> + + * mail/mail-utils.el (mail-dont-reply-to-names): New variable, + from rmail-dont-reply-to-names. Callers changed. + (mail-dont-reply-to): Rename from mail-dont-reply-to. + (rmail-dont-reply-to): Make it an obsolete alias. + + * mail/rmail.el (rmail-default-dont-reply-to-names): Default to + nil, and make obsolete (Bug#7888). + (rmail-dont-reply-to-names): Alias to mail-dont-reply-to-names. + + * mail/rmailsum.el (rmail-summary-sort-by-correspondent): Doc fix. + + * mail/rmailsort.el (rmail-sort-by-correspondent) + (rmail-select-correspondent): Doc fix. Use mail-dont-reply-to. + + * mail/rmail.el (rmail-reply): Use mail-dont-reply-to. + +2011-02-12 Thierry Volpiatto <thierry.volpiatto@gmail.com> + + * files.el (copy-directory): New argument COPY-CONTENTS for + copying directory contents into another existing directory. + +2011-02-12 Tassilo Horn <tassilo@member.fsf.org> + + * minibuffer.el (completion-table-case-fold): New function for + creating a case-insensitive completion table. + +2011-02-12 Teodor Zlatanov <tzz@lifelogs.com> + + * net/tramp.el (tramp-default-method): Also check if + `auth-source-search' is bound. + (tramp-read-passwd): Use `auth-source-search' instead of + `auto-source-user-or-password'. + + * net/tramp-imap.el: Autoload `auto-source-search' instead of + `auto-source-user-or-password. + (tramp-imap-passphrase-callback-function): Use it. + + * net/imap-hash.el: Autoload `auto-source-search' instead of + `auto-source-user-or-password. + (imap-hash-open-connection): Use it. + + * mail/smtpmail.el: Autoload `auto-source-search' instead of + `auto-source-user-or-password. + (smtpmail-try-auth-methods): Use it. + +2011-02-12 Phil Hagelberg <phil@hagelb.org> + + * emacs-lisp/package.el: Allow packages to be reinstalled. + (package--write-file-no-coding): Remove EXCL arg. + (package-unpack-single): Don't use it. + +2011-02-12 Karl Pflästerer <k@rl.pflaesterer.de> (tiny change) + + * vc/vc-svn.el: Adapt to Subversion change, with no .svn directory + in each sub directory. + (vc-svn-registered): Use vc-svn-root. + (vc-svn-root): New function. Make vc-svn-responsible-p an alias. + (vc-svn-repository-hostname): Use "svn info". + +2011-02-11 Deniz Dogan <deniz.a.m.dogan@gmail.com> + + * simple.el (delete-trailing-whitespace): New optional buffer + bound parameters. + +2011-02-11 Bastien Guerry <bzg@altern.org> + + * files.el (basic-save-buffer): save unmodified buffers when + the file pointed by buffer-file-name doesn't exist. + 2011-02-11 Deniz Dogan <deniz.a.m.dogan@gmail.com> * net/rcirc.el (defun-rcirc-join): Accept multiple channels. @@ -98,6 +597,11 @@ (allout-after-copy-or-kill-hook): No arguments - hook implementers should concentrate on the kill ring. +2011-02-09 Teodor Zlatanov <tzz@lifelogs.com> + + * password-cache.el (password-cache-remove): Accept secrets that are + not strings. + 2011-02-09 Stefan Monnier <monnier@iro.umontreal.ca> * progmodes/sh-script.el (sh-font-lock-open-heredoc): Fix case @@ -374,7 +878,7 @@ * progmodes/cc-cmds.el (c-forward-over-illiterals): Continue parsing if we encounter a naked # (Bug#7595). (c-beginning-of-statement): Avoid loop in locating the beginning - of a macro. + of a macro. (Not actually committed until 2011-02-20, see above). 2011-01-31 Chong Yidong <cyd@stupidchicken.com> @@ -436,7 +940,7 @@ 2011-01-31 Deniz Dogan <deniz.a.m.dogan@gmail.com> - * net/rcirc.el: New customizable nick completion format. (Bug#6314) + * net/rcirc.el: New customizable nick completion format. (Bug#6314) (rcirc-nick-completion-format): New defcustom. (rcirc-complete): Use it. @@ -741,7 +1245,7 @@ * calc/calc.el (calc-default-power-reference-level) (calc-default-field-reference-level): New variables. - * calc/calc-units.el (math-standard-units): Add dB and Np. + * calc/calc-units.el (math-standard-units): Add dB and Np. (math-logunits): New variable. (math-extract-logunits, math-logcombine, calcFunc-luplus) (calcFunc-luminus, calc-luplus, calc-luminus, math-logunit-level) @@ -751,7 +1255,7 @@ * calc/calc-help.el (calc-u-prefix-help): Add logarithmic help. (calc-ul-prefix-help): New function. * calc/calc-ext.el (calc-init-extensions): Autoload new units - functions. Add keybindings for new units functions. + functions. Add keybindings for new units functions. 2011-01-22 Giorgos Keramidas <keramida@ceid.upatras.gr> (tiny change) @@ -857,7 +1361,7 @@ 2011-01-20 Ken Manheimer <ken.manheimer@gmail.com> - * allout.el: (allout-institute-keymap): Use fset instead of + * allout.el (allout-institute-keymap): Use fset instead of reapplying defalias. (allout-hotspot-key-handler): Check for non-control-modified @@ -985,7 +1489,7 @@ (info-xref-output-heading): Rename from info-xref-filename-heading. (info-xref-good, info-xref-bad, info-xref-xfile-alist) (info-xref-filename-heading): Move to output managing section. - (info-xref-docstrings): New command checking "Info node `(foo)Bar'" + (info-xref-docstrings): New command checking "Info node `(foo)Bar'" (info-xref-lock-file-p, info-xref-with-file): New helpers for it. (info-xref-subfile-p): Move to generic section with those two. (info-xref-check-node): New function split from @@ -995,7 +1499,7 @@ (info-xref-check-node): Use it. (info-xref-with-output): Show count of unavailables at end of output. (info-xref-all-info-files): Exclude ".*" dotfiles. Ignore broken - symlinks. Exclude .texi files. Exclude Emacs backup files. + symlinks. Exclude .texi files. Exclude Emacs backup files. (info-xref-check-all-custom): Fix quietening viper-mode and gnus-registry-install -- use setq not let so as not to unbind after load. @@ -1575,7 +2079,7 @@ (rmail-mime-insert-text): Call rmail-mime-insert-decoded-text. (rmail-mime-insert-image): Argument changed. Caller changed. (rmail-mime-image): Call rmail-mime-toggle-hidden. - (rmail-mime-set-bulk-data): New funciton. + (rmail-mime-set-bulk-data): New function. (rmail-mime-insert-bulk): Argument changed. (rmail-mime-multipart-handler): Return t. (rmail-mime-process-multipart): Argument changed. @@ -1840,7 +2344,7 @@ (allout-toggle-subtree-encryption): Adjust docstrings to reflect defaulting policy and other changes. Change fetch-pass to keymode-cue, for simpler universal argument interpretation. - (allout-toggle-subtree-encryption): Adjust docstring to describe + (allout-toggle-subtree-encryption): Adjust docstring to describe changed encryption provisions. Change fetch-pass to keymode-cue, for simpler universal argument interpretation. Remove provisions for handling key type and identity - they'll all be within @@ -2456,8 +2960,8 @@ and "psftp". Exchange "%k" marker with options. (tramp-do-copy-or-rename-file, tramp-sh-handle-file-local-copy): Compute size of link target. - (tramp-do-copy-or-rename-file-out-of-band). Move setting of - `tramp-current-*' up due to gateway methods. Optimze computing of + (tramp-do-copy-or-rename-file-out-of-band): Move setting of + `tramp-current-*' up due to gateway methods. Optimize computing of copy arguments. Use `tramp-get-connection-name' and `tramp-get-connection-buffer'. Improve debug messages. (tramp-compute-multi-hops): Remove port determination. @@ -3709,7 +4213,7 @@ * international/characters.el (char-acronym-table): New variable. (glyphless-char-control): New variable. - (update-glyphless-char-display): New funciton. + (update-glyphless-char-display): New function. * faces.el (glyphless-char): New face. @@ -3780,7 +4284,7 @@ 2010-10-31 Jan Djärv <jan.h.d@swipnet.se> * term/x-win.el (x-get-selection-value): New function that gets - PRIMARY with type as specified in x-select-request-type. (Bug#6802). + PRIMARY with type as specified in x-select-request-type. (Bug#6802) 2010-10-31 Michael Albinus <michael.albinus@gmx.de> @@ -4069,7 +4573,7 @@ is indented differently if it is after a begin..end clock. (verilog-in-attribute-p, verilog-skip-backward-comments) (verilog-skip-forward-comment-p): Support proper treatment of - attributes by indent code. Reported by Jeff Steele. + attributes by indent code. Reported by Jeff Steele. (verilog-in-directive-p): Fix comment to correctly describe function. (verilog-backward-up-list, verilog-in-struct-region-p) (verilog-backward-token, verilog-in-struct-p) @@ -4080,9 +4584,9 @@ (verilog-property-re, verilog-endcomment-reason-re) (verilog-beg-of-statement, verilog-set-auto-endcomments) (verilog-calc-1 ): Fix for assert a; else b; indentation (new form - of if). Reported by Max Bjurling and + of if). Reported by Max Bjurling and (verilog-calc-1): Fix for clocking block in modport - declaration. Reported by Brian Hunter. + declaration. Reported by Brian Hunter. 2010-10-24 Wilson Snyder <wsnyder@wsnyder.org> @@ -4098,7 +4602,7 @@ (verilog-read-always-signals-recurse, verilog-read-decls): Fix not treating `elsif similar to `endif inside AUTOSENSE. (verilog-do-indent): Implement correct automatic or static task or - function end comment highlight. Reported by Steve Pearlmutter. + function end comment highlight. Reported by Steve Pearlmutter. (verilog-font-lock-keywords-2): Fix highlighting of single character pins, bug264. Reported by Michael Laajanen. (verilog-auto-inst, verilog-read-decls, verilog-read-sub-decls) @@ -4109,7 +4613,7 @@ Reported by Mark Johnson. (verilog-auto-tieoff, verilog-auto-tieoff-ignore-regexp): Add 'verilog-auto-tieoff-ignore-regexp' for AUTOTIEOFF, - bug269. Suggested by Gary Delp. + bug269. Suggested by Gary Delp. (verilog-mode-map, verilog-preprocess, verilog-preprocess-history) (verilog-preprocessor, verilog-set-compile-command): Create verilog-preprocess and verilog-preprocessor to show @@ -4117,7 +4621,7 @@ (verilog-get-beg-of-line, verilog-get-end-of-line) (verilog-modi-file-or-buffer, verilog-modi-name) (verilog-modi-point, verilog-within-string): Move defmacro's - before first use to avoid warning. Reported by Steve Pearlmutter. + before first use to avoid warning. Reported by Steve Pearlmutter. (verilog-colorize-buffer, verilog-colorize-include-files-buffer) (verilog-colorize-region, verilog-highlight-buffer) (verilog-highlight-includes, verilog-highlight-modules) @@ -4149,7 +4653,7 @@ (verilog-alw-get-temps, verilog-auto-reset) (verilog-auto-sense-sigs, verilog-read-always-signals) (verilog-read-always-signals-recurse): Fix loop indexes being - AUTORESET. AUTORESET now assumes any variables in the + AUTORESET. AUTORESET now assumes any variables in the initialization section of a for() should be ignored. Reported by Dan Dever. (verilog-error-font-lock-keywords) @@ -5562,7 +6066,7 @@ (sql-postgres-login-params): Add user and database defaults. (sql-buffer-live-p): Bug fix. (sql-product-history): New variable. - (sql-read-product): New function. Use it. + (sql-read-product): New function. Use it. (sql-set-product, sql-product-interactive): Use it. (sql-connection-history): New variable. (sql-read-connection): New function. Use it. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 374358e4aa3..6e28c3f9df8 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -155,7 +155,8 @@ finder-data: doit autoloads: $(LOADDEFS) doit chmod +w $(lisp)/ps-print.el $(lisp)/emulation/tpu-edt.el \ $(lisp)/emacs-lisp/cl-loaddefs.el $(lisp)/mail/rmail.el \ - $(lisp)/dired.el $(lisp)/ibuffer.el $(lisp)/htmlfontify.el + $(lisp)/dired.el $(lisp)/ibuffer.el $(lisp)/htmlfontify.el \ + $(lisp)/emacs-lisp/eieio.el cd $(lisp); $(setwins_almost); \ echo Directories: $$wins; \ $(emacs) -l autoload --eval '(setq generated-autoload-file "$(lisp)/loaddefs.el")' -f batch-update-autoloads $$wins @@ -340,16 +341,16 @@ $(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 +# Update TRAMP internal autoloads. Maybe we could move tramp*.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-ftp.el $(TRAMP_DIR)/tramp-gvfs.el \ - $(TRAMP_DIR)/tramp-gw.el $(TRAMP_DIR)/tramp-imap.el \ - $(TRAMP_DIR)/tramp-sh.el $(TRAMP_DIR)/tramp-smb.el \ - $(TRAMP_DIR)/tramp-uu.el $(TRAMP_DIR)/trampver.el + $(TRAMP_DIR)/tramp-gw.el $(TRAMP_DIR)/tramp-sh.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 \ diff --git a/lisp/allout-widgets.el b/lisp/allout-widgets.el new file mode 100644 index 00000000000..75e1e5882f6 --- /dev/null +++ b/lisp/allout-widgets.el @@ -0,0 +1,2365 @@ +;; allout-widgets.el --- Show allout outline structure with graphical widgets. + +;; Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 2011 Ken Manheimer + +;; Author: Ken Manheimer <ken dot manheimer at gmail dot com> +;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com> +;; Version: 1.0 +;; Created: Dec 2005 +;; Version: 1.0 +;; Keywords: outlines +;; Website: http://myriadicity.net/Sundry/EmacsAllout + +;;; Commentary: + +;; This is an allout outline-mode add-on that highlights outline structure +;; with graphical widgets. +;; +;; To activate, customize `allout-widgets-auto-activation'. You can also +;; invoke allout-widgets-mode in a particular allout buffer. When +;; auto-enabled, you can inhibit widget operation in particular allout +;; buffers by setting the variable `allout-widgets-mode-inhibit' non-nil in +;; that file's buffer. Use emacs *file local variables* to generally +;; inhibit for a file. +;; +;; See the `allout-widgets-mode' docstring for more details. +;; +;; Info about allout and allout-widgets development are available at +;; http://myriadicity.net/Sundry/EmacsAllout +;; +;; The graphics include: +;; +;; - icons for item bullets, varying to distinguish whether the item either +;; lacks any subitems, the subitems are currently collapsed within the +;; item, or the item is currently expanded. +;; +;; - guide lines connecting item bullet-icons with those of their subitems. +;; +;; - cue area between the bullet-icon and the start of the body headline, +;; for item numbering, encryption indicator, and distinctive bullets. +;; +;; The bullet-icon and guide line graphics provide keybindings and mouse +;; bindings for easy outline navigation and exposure control, extending +;; outline hot-spot navigation (see `allout-mode' docstring for details). +;; +;; Developers note: Our use of emacs widgets is unconventional. We +;; decorate existing text rather than substituting for it, to +;; piggy-back on existing allout operation. This employs the C-coded +;; efficiencies of widget-apply, widget-get, and widget-put, along +;; with the basic object-oriented organization of widget-create, to +;; systematically couple overlays, graphics, and other features with +;; allout-governed text. + +;;;_: Code (structured with comments that delinieate an allout outline) + +;;;_ : General Environment +(require 'allout) +(require 'widget) +(require 'wid-edit) + +(eval-when-compile + (progn + (require 'overlay) + (require 'cl) + )) + +;;;_ : internal variables needed before user-customization variables +;;; In order to enable activation of allout-widgets-mode via customization, +;;; allout-widgets-auto-activation uses a setting function. That function +;;; is invoked when the customization variable definition is evaluated, +;;; during file load, so the involved code must reside above that +;;; definition in the file. +;;;_ = allout-widgets-mode +(defvar allout-widgets-mode nil + "Allout mode enhanced with graphical widgets.") +(make-variable-buffer-local 'allout-widgets-mode) + +;;;_ : USER CUSTOMIZATION VARIABLES and incidental functions: +;;;_ > defgroup allout-widgets +;;;###autoload +(defgroup allout-widgets nil + "Allout extension that highlights outline structure graphically. + +Customize `allout-widgets-auto-activation' to activate allout-widgets +with allout-mode." + :group 'allout) +;;;_ > defgroup allout-widgets-developer +(defgroup allout-widgets-developer nil + "Settings for development of allout widgets extension." + :group 'allout-widgets) +;;;_ ; some functions a bit early, for allout-auto-activation dependency: +;;;_ > allout-widgets-mode-enable +(defun allout-widgets-mode-enable () + "Enable allout-widgets-mode in allout-mode buffers. + +See `allout-widgets-mode-inhibit' for per-file/per-buffer +inhibition of allout-widgets-mode." + (add-hook 'allout-mode-off-hook 'allout-widgets-mode-off) + (add-hook 'allout-mode-on-hook 'allout-widgets-mode-on) + t) +;;;_ > allout-widgets-mode-disable +(defun allout-widgets-mode-disable () + "Disable allout-widgets-mode in allout-mode buffers. + +See `allout-widgets-mode-inhibit' for per-file/per-buffer +inhibition of allout-widgets-mode." + (remove-hook 'allout-mode-off-hook 'allout-widgets-mode-off) + (remove-hook 'allout-mode-on-hook 'allout-widgets-mode-on) + t) +;;;_ > allout-widgets-setup (varname value) +;;;###autoload +(defun allout-widgets-setup (varname value) + "Commission or decommision allout-widgets-mode along with allout-mode. + +Meant to be used by customization of `allout-widgets-auto-activation'." + (set-default varname value) + (if allout-widgets-auto-activation + (allout-widgets-mode-enable) + (allout-widgets-mode-disable))) +;;;_ = allout-widgets-auto-activation +;;;###autoload +(defcustom allout-widgets-auto-activation nil + "Activate to enable allout icon graphics wherever allout mode is active. + +Also enable `allout-auto-activation' for this to take effect upon +visiting an outline. + +When this is set you can disable allout widgets in select files +by setting `allout-widgets-mode-inhibit' + +Instead of setting `allout-widgets-auto-activation' you can +explicitly invoke `allout-widgets-mode' in allout buffers where +you want allout widgets operation. + +See `allout-widgets-mode' for allout widgets mode features." + :type 'boolean + :group 'allout-widgets + :set 'allout-widgets-setup + ) +;; ;;;_ = allout-widgets-allow-unruly-edits +;; (defcustom allout-widgets-allow-unruly-edits nil +;; "*Control whether manual edits are restricted to maintain outline integrity. + +;; When nil, manual edits must either be within an item's body or encompass +;; one or more items completely - eg, killing topics as entities, rather than +;; deleting from the middle of one to the middle of another. + +;; If you only occasionally need to make unrestricted change, you can set this +;; variable in the specific buffer using set-variable, or just deactivate +;; `allout-mode' temporarily. You can customize this to always allow unruly +;; edits, but you will be able to create outlines that are unnavigable in +;; principle, and not just for allout's navigation and exposure mechanisms." +;; :type 'boolean +;; :group allout-widgets) +;; (make-variable-buffer-local 'allout-widgets-allow-unruly-edits) +;;;_ = allout-widgets-auto-activation - below, for eval-order dependencies +;;;_ = allout-widgets-icons-dark-subdir +(defcustom allout-widgets-icons-dark-subdir "icons/allout-widgets/dark-bg/" + "Directory on `image-load-path' holding allout icons for dark backgrounds." + :type 'string + :group 'allout-widgets) +;;;_ = allout-widgets-icons-light-subdir +(defcustom allout-widgets-icons-light-subdir "icons/allout-widgets/light-bg/" + "Directory on `image-load-path' holding allout icons for light backgrounds." + :type 'string + :group 'allout-widgets) +;;;_ = allout-widgets-icon-types +(defcustom allout-widgets-icon-types '(xpm png) + "File extensions for the icon graphic format types, in order of preference." + :type '(repeat symbol) + :group 'allout-widgets) + +;;;_ . Decoration format +;;;_ = allout-widgets-theme-dark-background +(defcustom allout-widgets-theme-dark-background "allout-dark-bg" + "Identify the outline's icon theme to use with a dark background." + :type '(string) + :group 'allout-widgets) +;;;_ = allout-widgets-theme-light-background +(defcustom allout-widgets-theme-light-background "allout-light-bg" + "Identify the outline's icon theme to use with a light background." + :type '(string) + :group 'allout-widgets) +;;;_ = allout-widgets-item-image-properties-emacs +(defcustom allout-widgets-item-image-properties-emacs + '(:ascent center :mask (heuristic t)) + "*Default properties item widget images in mainline Emacs." + :type 'plist + :group 'allout-widgets) +;;;_ = allout-widgets-item-image-properties-xemacs +(defcustom allout-widgets-item-image-properties-xemacs + nil + "*Default properties item widget images in XEmacs." + :type 'plist + :group 'allout-widgets) +;;;_ . Developer +;;;_ = allout-widgets-run-unit-tests-on-load +(defcustom allout-widgets-run-unit-tests-on-load nil + "*When non-nil, unit tests will be run at end of loading allout-widgets. + +Generally, allout widgets code developers are the only ones who'll want to +set this. + +\(If set, this makes it an even better practice to exercise changes by +doing byte-compilation with a repeat count, so the file is loaded after +compilation.) + +See `allout-widgets-run-unit-tests' to see what's run." + :type 'boolean + :group 'allout-widgets-developer) +;;;_ = allout-widgets-time-decoration-activity +(defcustom allout-widgets-time-decoration-activity nil + "*Retain timing info of the last cooperative redecoration. + +The details are retained as the value of +`allout-widgets-last-decoration-timing'. + +Generally, allout widgets code developers are the only ones who'll want to +set this." + :type 'boolean + :group 'allout-widgets-developer) +;;;_ = allout-widgets-hook-error-post-time 0 +(defcustom allout-widgets-hook-error-post-time 0 + "*Amount of time to sit showing hook error messages. + +0 is minimal, or nil to not post to the message area. + +This is for debugging purposes." + :type 'integer + :group 'allout-widgets-developer) +;;;_ = allout-widgets-maintain-tally nil +(defcustom allout-widgets-maintain-tally nil + "*If non-nil, maintain a collection of widgets, `allout-widgets-tally'. + +This is for debugging purposes. + +The tally shows the total number of item widgets in the current +buffer, and tracking increases as new widgets are added and +decreases as obsolete widgets are garbage collected." + :type 'boolean + :group 'allout-widgets-developer) +(defvar allout-widgets-tally nil + "Hash-table of existing allout widgets, for debugging. + +Table is maintained iff `allout-widgets-maintain-tally' is non-nil. + +The table contents will be out of sync if any widgets are created +or deleted while this variable is nil.") +(make-variable-buffer-local 'allout-widgets-tally) +;;;_ > allout-widgets-tally-string +(defun allout-widgets-tally-string () + "Return a string giving the number of tracked widgets, or empty string if not tracking. + +The string is formed for appending to the allout-mode mode-line lighter. + +An empty string is also returned if tracking is inhibited or +widgets are locally inhibited. + +The number varies according to the evanescence of objects on a + hash table with weak keys, so tracking of widget erasures is often delayed." + (when (and allout-widgets-maintain-tally (not allout-widgets-mode-inhibit)) + (format ":%s" (hash-table-count allout-widgets-tally)))) +;;;_ = allout-widgets-track-decoration nil +(defcustom allout-widgets-track-decoration nil + "*If non-nil, show cursor position of each item decoration. + +This is for debugging purposes, and generally set at need in a +buffer rather than as a prevailing configuration \(but it's handy +to publicize it by making it a customization variable\)." + :type 'boolean + :group 'allout-widgets-developer) +(make-variable-buffer-local 'allout-widgets-track-decoration) + +;;;_ : Mode context - variables, hookup, and hooks +;;;_ . internal mode variables +;;;_ , Mode activation and environment +;;;_ = allout-widgets-version +(defvar allout-widgets-version "1.0" + "Version of currently loaded allout-widgets extension.") +;;;_ > allout-widgets-version +(defun allout-widgets-version (&optional here) + "Return string describing the loaded outline version." + (interactive "P") + (let ((msg (concat "Allout Outline Widgets Extension v " + allout-widgets-version))) + (if here (insert msg)) + (message "%s" msg) + msg)) +;;;_ = allout-widgets-mode-inhibit +(defvar allout-widgets-mode-inhibit nil + "Inhibit `allout-widgets-mode' from activating widgets. + +This also inhibits automatic adjustment of widgets to track allout outline +changes. + +You can use this as a file local variable setting to disable +allout widgets enhancements in selected buffers while generally +enabling widgets by customizing `allout-widgets-auto-activation'. + +In addition, you can invoked `allout-widgets-mode' allout-mode +buffers where this is set to enable and disable widget +enhancements, directly.") +;;;###autoload +(put 'allout-widgets-mode-inhibit 'safe-local-variable + (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil))))) +(make-variable-buffer-local 'allout-widgets-mode-inhibit) +;;;_ = allout-inhibit-body-modification-hook +(defvar allout-inhibit-body-modification-hook nil + "Override de-escaping of text-prefixes in item bodies during specific changes. + +This is used by `allout-buffer-modification-handler' to signal such changes +to `allout-body-modification-handler', and is always reset by +`allout-post-command-business'.") +(make-variable-buffer-local 'allout-inhibit-body-modification-hook) +;;;_ = allout-widgets-icons-cache +(defvar allout-widgets-icons-cache nil + "Cache allout icon images, as an association list. + +`allout-fetch-icon-image' uses this cache transparently, keying +images with lists containing the name of the icon directory \(as +found on the `load-path') and the icon name. + +Set this variable to `nil' to empty the cache, and have it replenish from the +filesystem.") +;;;_ = allout-widgets-unset-inhibit-read-only +(defvar allout-widgets-unset-inhibit-read-only nil + "Tell `allout-widgets-post-command-business' to unset `inhibit-read-only'. + +Used by `allout-graphics-modification-handler'") +;;;_ = allout-widgets-reenable-before-change-handler +(defvar allout-widgets-reenable-before-change-handler nil + "Tell `allout-widgets-post-command-business' to reequip the handler. + +Necessary because the handler sometimes deliberately raises an +error, causing it to be disabled.") +;;;_ , State for hooks +;;;_ = allout-unresolved-body-mod-workroster +(defvar allout-unresolved-body-mod-workroster (make-hash-table :size 16) + "List of body-overlays that did before-change business but not after-change. + +See `allout-post-command-business' and `allout-body-modification-handler'.") +;;;_ = allout-structure-unruly-deletion-message +(defvar allout-structure-unruly-deletion-message + "Unruly edit prevented -- +To change the bullet character: \\[allout-rebullet-current-heading] +To promote this item: \\[allout-shift-out] +To demote it: \\[allout-shift-in] +To delete it and offspring: \\[allout-kill-topic] +See \\[describe-mode] for many more options." + "Informative message presented on improper editing of outline structure. + +The structure includes the guides lines, bullet, and bullet cue.") +;;;_ = allout-widgets-changes-record +(defvar allout-widgets-changes-record nil + "Record outline changes for processing by post-command hook. + +Entries on the list are lists whose first element is a symbol indicating +the change type and subsequent elements are data specific to that change +type. Specifically: + + 'exposure `allout-exposure-from' `allout-exposure-to' `allout-exposure-flag' + +The changes are recorded in reverse order, with new values pushed +onto the front.") +(make-variable-buffer-local 'allout-widgets-changes-record) +;;;_ = allout-widgets-undo-exposure-record +(defvar allout-widgets-undo-exposure-record nil + "Record outline undo traces for processing by post-command hook. + +The changes are recorded in reverse order, with new values pushed +onto the front.") +(make-variable-buffer-local 'allout-widgets-undo-exposure-record) +;;;_ = allout-widgets-last-hook-error +(defvar allout-widgets-last-hook-error nil + "String holding last error string, for debugging purposes.") +;;;_ = allout-widgets-adjust-message-length-threshold 100 +(defvar allout-widgets-adjust-message-length-threshold 100 + "Display \"Adjusting widgets\" message above this number of pending changes." + ) +;;;_ = allout-widgets-adjust-message-size-threshold 10000 +(defvar allout-widgets-adjust-message-size-threshold 10000 + "Display \"Adjusting widgets\" message above this size of pending changes." + ) +;;;_ = allout-doing-exposure-undo-processor nil +(defvar allout-undo-exposure-in-progress nil + "Maintained true during `allout-widgets-exposure-undo-processor'") +;;;_ , Widget-specific outline text format +;;;_ = allout-escaped-prefix-regexp +(defvar allout-escaped-prefix-regexp "" + "*Regular expression for body text that would look like an item prefix if +not altered with an escape sequence.") +(make-variable-buffer-local 'allout-escaped-prefix-regexp) +;;;_ , Widget element formatting +;;;_ = allout-item-icon-keymap +(defvar allout-item-icon-keymap + (let ((km (make-sparse-keymap))) + (dolist (digit '("0" "1" "2" "3" + "4" "5" "6" "7" "8" "9")) + (define-key km digit 'digit-argument)) + (define-key km "-" 'negative-argument) +;; (define-key km [(return)] 'allout-tree-expand-command) +;; (define-key km [(meta return)] 'allout-toggle-torso-command) +;; (define-key km [(down-mouse-1)] 'allout-item-button-click) +;; (define-key km [(down-mouse-2)] 'allout-toggle-torso-event-command) + ;; Override underlying mouse-1 and mouse-2 bindings in icon territory: + (define-key km [(mouse-1)] (lambda () (interactive) nil)) + (define-key km [(mouse-2)] (lambda () (interactive) nil)) + + ;; Catchall, handles actual keybindings, dynamically doing keymap lookups: + (define-key km [t] 'allout-item-icon-key-handler) + + km) + "General tree-node key bindings.") +;;;_ = allout-item-body-keymap +(defvar allout-item-body-keymap + (let ((km (make-sparse-keymap)) + (local-map (current-local-map))) +;; (define-key km [(control return)] 'allout-tree-expand-command) +;; (define-key km [(meta return)] 'allout-toggle-torso-command) + ;; XXX We need to reset this per buffer's mode; we do so in + ;; allout-widgets-mode. + (if local-map + (set-keymap-parent km local-map)) + + km) + "General key bindings for the text content of outline items.") +(make-variable-buffer-local 'allout-item-body-keymap) +;;;_ = allout-body-span-category +(defvar allout-body-span-category nil + "Symbol carrying allout body-text overlay properties.") +;;;_ = allout-cue-span-keymap +(defvar allout-cue-span-keymap + (let ((km (make-sparse-keymap))) + (set-keymap-parent km allout-item-icon-keymap) + km) + "Keymap used in the item cue area - the space between the icon and headline.") +;;;_ = allout-escapes-category +(defvar allout-escapes-category nil + "Symbol for category of text property used to hide escapes of prefix-like +text in allout item bodies.") +;;;_ = allout-guides-category +(defvar allout-guides-category nil + "Symbol carrying allout icon-guides overlay properties.") +;;;_ = allout-guides-span-category +(defvar allout-guides-span-category nil + "Symbol carrying allout icon and guide lines overlay properties.") +;;;_ = allout-icon-span-category +(defvar allout-icon-span-category nil + "Symbol carrying allout icon and guide lines overlay properties.") +;;;_ = allout-cue-span-category +(defvar allout-cue-span-category nil + "Symbol carrying common properties of the space following the outline icon. + +\(That space is used to convey selected cues indicating body qualities, +including things like: + - encryption '~' + - numbering '#' + - indirect reference '@' + - distinctive bullets - see `allout-distinctive-bullets-string'.\)") +;;;_ = allout-span-to-category +(defvar allout-span-to-category + '((:guides-span . allout-guides-span-category) + (:cue-span . allout-cue-span-category) + (:icon-span . allout-icon-span-category) + (:body-span . allout-body-span-category)) + "Association list mapping span identifier to category identifier.") +;;;_ = allout-trailing-category +(defvar allout-trailing-category nil + "Symbol carrying common properties of an overlay's trailing newline.") +;;;_ , Developer +(defvar allout-widgets-last-decoration-timing nil + "Timing details for the last cooperative decoration action. + +This is maintained when `allout-widgets-time-decoration-activity' is set. + +The value is a list containing two elements: + - the elapsed time as a number of seconds + - the list of changes processed, a la `allout-widgets-changes-record'. + +When active, the value is revised each time automatic decoration activity +happens in the buffer.") +(make-variable-buffer-local 'allout-widgets-last-decoration-timing) +;;;_ . mode hookup +;;;_ > define-minor-mode allout-widgets-mode (arg) +;;;###autoload +(define-minor-mode allout-widgets-mode + "Allout-mode extension, providing graphical decoration of outline structure. + +This is meant to operate along with allout-mode, via `allout-mode-hook'. + +If optional argument ARG is greater than 0, enable. +If optional argument ARG is less than 0, disable. +Anything else, toggle between active and inactive. + +The graphics include: + +- guide lines connecting item bullet-icons with those of their subitems. + +- icons for item bullets, varying to indicate whether or not the item + has subitems, and if so, whether or not the item is expanded. + +- cue area between the bullet-icon and the start of the body headline, + for item numbering, encryption indicator, and distinctive bullets. + +The bullet-icon and guide line graphics provide keybindings and mouse +bindings for easy outline navigation and exposure control, extending +outline hot-spot navigation \(see `allout-mode')." + + :lighter nil + :keymap nil + + ;; define-minor-mode handles any provided argument according to emacs + ;; minor-mode conventions - '(elisp) Minor Mode Conventions' - and sets + ;; allout-widgets-mode accordingly *before* running the body code, so we + ;; cue on that. + (if allout-widgets-mode + ;; Activating: + (progn + (allout-add-resumptions + ;; XXX user may need say in line-truncation/hscrolling - an option + ;; that abstracts mode. + ;; truncate text lines to keep guide lines intact: + '(truncate-lines t) + ;; and enable autoscrolling to ease view of text + '(auto-hscroll-mode t) + '(line-move-ignore-fields t) + '(widget-push-button-prefix "") + '(widget-push-button-suffix "") + ;; allout-escaped-prefix-regexp depends on allout-regexp: + (list 'allout-escaped-prefix-regexp (concat "\\(\\\\\\)" + "\\(" allout-regexp "\\)"))) + (allout-add-resumptions + (list 'allout-widgets-tally allout-widgets-tally) + (list 'allout-widgets-escapes-sanitization-regexp-pair + (list (concat "\\(\n\\|\\`\\)" + allout-escaped-prefix-regexp + ) + ;; Include everything but the escape symbol. + "\\1\\3")) + ) + + (add-hook 'after-change-functions 'allout-widgets-after-change-handler + nil t) + + (allout-setup-text-properties) + (add-to-invisibility-spec '(allout-torso . t)) + (add-to-invisibility-spec 'allout-escapes) + + (if (current-local-map) + (set-keymap-parent allout-item-body-keymap (current-local-map))) + + (add-hook 'allout-exposure-change-hook + 'allout-widgets-exposure-change-recorder nil 'local) + (add-hook 'allout-structure-added-hook + 'allout-widgets-additions-recorder nil 'local) + (add-hook 'allout-structure-deleted-hook + 'allout-widgets-deletions-recorder nil 'local) + (add-hook 'allout-structure-shifted-hook + 'allout-widgets-shifts-recorder nil 'local) + (add-hook 'allout-after-copy-or-kill-hook + 'allout-widgets-after-copy-or-kill-function nil 'local) + + (add-hook 'before-change-functions 'allout-widgets-before-change-handler + nil 'local) + (add-hook 'post-command-hook 'allout-widgets-post-command-business + nil 'local) + (add-hook 'pre-command-hook 'allout-widgets-pre-command-business + nil 'local) + + ;; init the widgets tally for debugging: + (if (not allout-widgets-tally) + (setq allout-widgets-tally (make-hash-table + :test 'eq :weakness 'key))) + ;; add tally count display on minor-mode-alist just after + ;; allout-mode entry. + ;; (we use ternary condition form to keep condition simple for deletion.) + (let* ((mode-line-entry '(allout-widgets-mode-inhibit "" + (:eval (allout-widgets-tally-string)))) + (associated (assoc (car mode-line-entry) minor-mode-alist)) + ;; need location for it only if not already present: + (after (and (not associated) + (memq (assq 'allout-mode minor-mode-alist) minor-mode-alist)))) + (if after + (rplacd after (cons mode-line-entry (cdr after))))) + (allout-widgets-prepopulate-buffer) + t) + ;; Deactivating: + (let ((inhibit-read-only t) + (was-modified (buffer-modified-p))) + + (allout-widgets-undecorate-region (point-min)(point-max)) + (remove-from-invisibility-spec '(allout-torso . t)) + (remove-from-invisibility-spec 'allout-escapes) + + (remove-hook 'after-change-functions + 'allout-widgets-after-change-handler 'local) + (remove-hook 'allout-exposure-change-hook + 'allout-widgets-exposure-change-recorder 'local) + (remove-hook 'allout-structure-added-hook + 'allout-widgets-additions-recorder 'local) + (remove-hook 'allout-structure-deleted-hook + 'allout-widgets-deletions-recorder 'local) + (remove-hook 'allout-structure-shifted-hook + 'allout-widgets-shifts-recorder 'local) + (remove-hook 'allout-after-copy-or-kill-hook + 'allout-widgets-after-copy-or-kill-function 'local) + (remove-hook 'before-change-functions + 'allout-widgets-before-change-handler 'local) + (remove-hook 'post-command-hook + 'allout-widgets-post-command-business 'local) + (remove-hook 'pre-command-hook + 'allout-widgets-pre-command-business 'local) + (assq-delete-all 'allout-widgets-mode-inhibit minor-mode-alist) + (set-buffer-modified-p was-modified)))) +;;;_ > allout-widgets-mode-off +(defun allout-widgets-mode-off () + "Explicitly disable allout-widgets-mode." + (allout-widgets-mode -1)) +;;;_ > allout-widgets-mode-off +(defun allout-widgets-mode-on () + "Explicitly disable allout-widgets-mode." + (allout-widgets-mode 1)) +;;;_ > allout-setup-text-properties () +(defun allout-setup-text-properties () + "Configure category and literal text properties." + + ;; XXX body - before-change, entry, keymap + + (setplist 'allout-guides-span-category nil) + (put 'allout-guides-span-category + 'modification-hooks '(allout-graphics-modification-handler)) + (put 'allout-guides-span-category 'local-map allout-item-icon-keymap) + (put 'allout-guides-span-category 'mouse-face widget-button-face) + (put 'allout-guides-span-category 'field 'structure) +;; (put 'allout-guides-span-category 'face 'widget-button) + + (setplist 'allout-icon-span-category + (allout-widgets-copy-list (symbol-plist + 'allout-guides-span-category))) + (put 'allout-icon-span-category 'field 'structure) + + ;; XXX for body text we're instead going to use the buffer-wide + ;; resources, like before/after-change-functions hooks and the + ;; buffer's key map. that way we won't have to do painful provisions + ;; to fixup things after edits, catch outlier interstitial + ;; characters, like newline and empty lines after hidden subitems, + ;; etc. + (setplist 'allout-body-span-category nil) + (put 'allout-body-span-category 'evaporate t) + (put 'allout-body-span-category 'local-map allout-item-body-keymap) + ;;(put 'allout-body-span-category + ;; 'modification-hooks '(allout-body-modification-handler)) + ;;(put 'allout-body-span-category 'field 'body) + + (setplist 'allout-cue-span-category nil) + (put 'allout-cue-span-category 'evaporate t) + (put 'allout-cue-span-category + 'modification-hooks '(allout-body-modification-handler)) + (put 'allout-cue-span-category 'local-map allout-cue-span-keymap) + (put 'allout-cue-span-category 'mouse-face widget-button-face) + (put 'allout-cue-span-category 'pointer 'arrow) + (put 'allout-cue-span-category 'field 'structure) + + (setplist 'allout-trailing-category nil) + (put 'allout-trailing-category 'evaporate t) + (put 'allout-trailing-category 'local-map allout-item-body-keymap) + + (setplist 'allout-escapes-category nil) + (put 'allout-escapes-category 'invisible 'allout-escapes) + (put 'allout-escapes-category 'evaporate t)) +;;;_ > allout-widgets-prepopulate-buffer () +(defun allout-widgets-prepopulate-buffer () + "Step over the current buffers exposed items to do initial widgetizing." + (if (not allout-widgets-mode-inhibit) + (save-excursion + (goto-char (point-min)) + (while (allout-next-visible-heading 1) + (when (not (widget-at (point))) + (allout-get-or-create-item-widget)))))) +;;;_ . settings context +;;;_ = allout-container-item +(defvar allout-container-item-widget nil + "A widget for the current outline's overarching container as an item. + +The item has settings \(of the file/connection\) and maybe a body, but no +icon/bullet.") +(make-variable-buffer-local 'allout-container-item-widget) +;;;_ . Hooks and hook helpers +;;;_ , major command-loop business: +;;;_ > allout-widgets-pre-command-business (&optional recursing) +(defun allout-widgets-pre-command-business (&optional recursing) + "Handle actions pending before allout-mode activity." +) +;;;_ > allout-widgets-post-command-business (&optional recursing) +(defun allout-widgets-post-command-business (&optional recursing) + "Handle actions pending after any allout-mode commands. + +Optional RECURSING is for internal use, to limit recursion." + ;; - check changed text for nesting discontinuities and escape anything + ;; that's: (1) asterisks at bol or (2) excessively nested. + (condition-case failure + + (when (and (boundp 'allout-mode) allout-mode) + + (if allout-widgets-unset-inhibit-read-only + (setq inhibit-read-only nil + allout-widgets-unset-inhibit-read-only nil)) + + (when allout-widgets-reenable-before-change-handler + (add-hook 'before-change-functions + 'allout-widgets-before-change-handler + nil 'local) + (setq allout-widgets-reenable-before-change-handler nil)) + + (when (or allout-widgets-undo-exposure-record + allout-widgets-changes-record) + (let* ((debug-on-signal t) + (debug-on-error t) + ;; inhibit recording new undo records when processing + ;; effects of undo-exposure: + (debugger 'allout-widgets-hook-error-handler) + (adjusting-message " Adjusting widgets...") + (replaced-message (allout-widgets-adjusting-message + adjusting-message)) + (start-time (current-time))) + + (if allout-widgets-undo-exposure-record + ;; inhibit undo recording iff undoing exposure stuff. + ;; XXX we might need to inhibit per respective + ;; change-record, rather than assuming that some undo + ;; activity during a command is all undo activity. + (let ((buffer-undo-list t)) + (allout-widgets-exposure-undo-processor) + (allout-widgets-changes-dispatcher)) + (allout-widgets-exposure-undo-processor) + (allout-widgets-changes-dispatcher)) + + (if allout-widgets-time-decoration-activity + (setq allout-widgets-last-decoration-timing + (list (allout-elapsed-time-seconds (current-time) + start-time) + allout-widgets-changes-record))) + + (setq allout-widgets-changes-record nil) + + (if replaced-message + (if (stringp replaced-message) + (message replaced-message) + (message ""))))) + + ;; Detect undecorated items, eg during isearch into previously + ;; unexposed topics, and decorate "economically". Some + ;; undecorated stuff is often exposed, to reduce lag, but the + ;; item containing the cursor is decorated. We constrain + ;; recursion to avoid being trapped by unexpectedly undecoratable + ;; items. + (when (and (not recursing) + (not (allout-current-decorated-p)) + (or (not (equal (allout-depth) 0)) + (not allout-container-item-widget))) + (let ((buffer-undo-list t)) + (allout-widgets-exposure-change-recorder + allout-recent-prefix-beginning allout-recent-prefix-end nil) + (allout-widgets-post-command-business 'recursing))) + + ;; Detect and rectify fouled outline structure - decorated item + ;; not at beginning of line. + (let ((this-widget (or (widget-at (point)) + ;; XXX we really should be checking across + ;; edited span, not just point and point+1 + (and (not (eq (point) (point-max))) + (widget-at (1+ (point)))))) + inserted-at) + (save-excursion + (if (and this-widget + (goto-char (widget-get this-widget :from)) + (not (bolp))) + (if (not + (condition-case err + (yes-or-no-p + (concat "Misplaced item won't be recognizable " + " as part of outline - rectify? ")) + (quit nil))) + (progn + (if (allout-hidden-p (max (1- (point)) 1)) + (save-excursion + (goto-char (max (1- (point)) 1)) + (allout-show-to-offshoot))) + (allout-widgets-undecorate-item this-widget)) + ;; expose any hidden intervening items, so resulting + ;; position is clear: + (setq inserted-at (point)) + (allout-unprotected (insert-before-markers "\n")) + (forward-char -1) + ;; ensure the inserted newline is visible: + (allout-flag-region inserted-at (1+ inserted-at) nil) + (allout-widgets-post-command-business 'recursing) + (message (concat "outline structure corrected - item" + " moved to beginning of new line")) + ;; preserve cursor position in some cases: + (if (and inserted-at + (> (point) inserted-at)) + (forward-char -1))))))) + + (error + ;; zero work list so we don't get stuck futily retrying. + ;; error recording done by allout-widgets-hook-error-handler. + (setq allout-widgets-changes-record nil)))) +;;;_ , major change handlers: +;;;_ > allout-widgets-before-change-handler +(defun allout-widgets-before-change-handler (beg end) + "Business to be done before changes in a widgetized allout outline." + ;; protect against unruly edits to structure: + (cond + (undo-in-progress (when (eq (get-text-property beg 'category) + 'allout-icon-span-category) + (save-excursion + (goto-char beg) + (let* ((item-widget (allout-get-item-widget))) + (if item-widget + (allout-widgets-exposure-undo-recorder + item-widget)))))) + (inhibit-read-only t) + ((not (and (boundp 'allout-mode) allout-mode)) t) + ((equal this-command 'quoted-insert) t) + ((not (text-property-any beg (if (equal end beg) + (min (1+ beg) (point-max)) + end) + 'field 'structure)) + t) + ((yes-or-no-p "Unruly edit of outline structure - allow? ") + (setq allout-widgets-unset-inhibit-read-only (not inhibit-read-only) + inhibit-read-only t)) + (t + ;; tell the allout-widgets-post-command-business to reestablish the hook: + (setq allout-widgets-reenable-before-change-handler t) + ;; and raise an error to prevent the edit (and disable the hook): + (error + (substitute-command-keys allout-structure-unruly-deletion-message))))) +;;;_ > allout-widgets-after-change-handler +(defun allout-widgets-after-change-handler (beg end prelength) + "Reconcile what needs to be reconciled for allout widgets after edits." + ) +;;;_ > allout-current-decorated-p () +(defun allout-current-decorated-p () + "True if the current item is not decorated" + (save-excursion + (if (allout-back-to-current-heading) + (if (> allout-recent-depth 0) + (and (allout-get-item-widget) t) + allout-container-item-widget)))) + +;;;_ > allout-widgets-hook-error-handler +(defun allout-widgets-hook-error-handler (mode args) + "Process errors which occurred in the course of command hook operation. + +We store a backtrace of the error information in the variable, +`allout-widgets-last-hook-error', unset the error handlers, and +reraise the error, so that processing continues to the +encompassing condition-case." + ;; first deconstruct special error environment so errors here propagate + ;; to encompassing condition-case: + (setq debugger 'debug + debug-on-error nil + debug-on-signal nil) + (let* ((bt (with-output-to-string (backtrace))) + (this "allout-widgets-hook-error-handler") + (header + (format "allout-widgets-last-hook-error stored, %s/%s %s %s" + this mode args + (format-time-string "%e-%b-%Y %r" (current-time))))) + ;; post to *Messages* then immediately replace with more compact notice: + (message "%s" (setq allout-widgets-last-hook-error + (format "%s:\n%s" header bt))) + (message header) (sit-for allout-widgets-hook-error-post-time) + ;; reraise the error, or one concerning this function if unexpected: + (if (equal mode 'error) + (apply 'signal args) + (error "%s: unexpected mode, %s %s" this mode args)))) +;;;_ > allout-widgets-changes-exceed-threshold-p () +(defun allout-widgets-adjusting-message (message) + "Post MESSAGE when pending are likely to make a big enough delay. + +If posting of the MESSAGE is warranted and there already is a +`current-message' in the minibuffer, the MESSAGE is appended to +the current one, and the previously pending `current-message' is +returned for later posting on completion. + +If posting of the MESSAGE is warranted, but no `current-message' +is pending, then t is returned to indicate that case. + +If posting of the MESSAGE is not warranted, then nil is returned. + +See `allout-widgets-adjust-message-length-threshold', +`allout-widgets-adjust-message-size-threshold' for message +posting threshold criteria." + (if (or (> (length allout-widgets-changes-record) + allout-widgets-adjust-message-length-threshold) + ;; for size, use distance from start of first to end of last: + (let ((min (point-max)) + (max 0) + first second) + (mapc (function (lambda (entry) + (if (eq :undone-exposure (car entry)) + nil + (setq first (cadr entry) + second (caddr entry)) + (if (< (min first second) min) + (setq min (min first second))) + (if (> (max first second) max) + (setq max (max first second)))))) + allout-widgets-changes-record) + (> (- max min) allout-widgets-adjust-message-size-threshold))) + (let ((prior (current-message))) + (message (if prior (concat prior " - " message) message)) + (or prior t)))) +;;;_ > allout-widgets-changes-dispatcher () +(defun allout-widgets-changes-dispatcher () + "Dispatch CHANGES-RECORD items to respective widgets change processors." + + (if (not allout-widgets-mode-inhibit) + (let* ((changes-record allout-widgets-changes-record) + (changes-pending (and changes-record t)) + entry + exposures + additions + deletions + shifts) + + (when changes-pending + (while changes-record + (setq entry (pop changes-record)) + (case (car entry) + (:exposed (push entry exposures)) + (:added (push entry additions)) + (:deleted (push entry deletions)) + (:shifted (push entry shifts)))) + + (if exposures + (allout-widgets-exposure-change-processor exposures)) + (if additions + (allout-widgets-additions-processor additions)) + (if deletions + (allout-widgets-deletions-processor deletions)) + (if shifts + (allout-widgets-shifts-processor shifts)))) + (when (not (equal allout-widgets-mode-inhibit 'undecorated)) + (allout-widgets-undecorate-region (point-min)(point-max)) + (setq allout-widgets-mode-inhibit 'undecorated)))) +;;;_ > allout-widgets-exposure-change-recorder (from to flag) +(defun allout-widgets-exposure-change-recorder (from to flag) + "Record allout exposure changes for tracking during post-command processing. + +Records changes in `allout-widgets-changes-record'." + (push (list :exposed from to flag) allout-widgets-changes-record)) +;;;_ > allout-widgets-exposure-change-processor (changes) +(defun allout-widgets-exposure-change-processor (changes) + "Widgetize and adjust item widgets tracking allout outline exposure changes. + +Generally invoked via `allout-exposure-change-hook'." + + (let ((changes (sort changes (function (lambda (this next) + (< (cadr this) (cadr next)))))) + ;; have to distinguish between concealing and exposing so that, eg, + ;; `allout-expose-topic's mix is handled properly. + handled-expose + handled-conceal + covered + deactivate-mark) + + (dolist (change changes) + (let (handling + (from (cadr change)) + bucket got + (to (caddr change)) + (flag (cadddr change)) + parent) + + ;; swap from and to: + (if (< to from) (setq bucket to + to from + from bucket)) + + ;; have we already handled exposure changes in this region? + (setq handling (if flag 'handled-conceal 'handled-expose) + got (allout-range-overlaps from to (symbol-value handling)) + covered (car got)) + (set handling (cadr got)) + + (when (not covered) + (save-excursion + (goto-char from) + (cond + + ;; collapsing: + (flag + (allout-widgets-undecorate-region from to) + (allout-beginning-of-current-line) + (let ((widget (allout-get-item-widget))) + (if (not widget) + (allout-get-or-create-item-widget) + (widget-apply widget :redecorate)))) + + ;; expanding: + (t + (while (< (point) to) + (allout-beginning-of-current-line) + (setq parent (allout-get-item-widget)) + (if (not parent) + (setq parent (allout-get-or-create-item-widget)) + (widget-apply parent :redecorate)) + (allout-next-visible-heading 1) + (if (widget-get parent :has-subitems) + (allout-redecorate-visible-subtree parent)) + (if (> (point) to) + ;; subtree may be well beyond to - incorporate in ranges: + (setq handled-expose + (allout-range-overlaps from (point) handled-expose) + covered (car handled-expose) + handled-expose (cadr handled-expose))) + (allout-next-visible-heading 1)))))))))) + +;;;_ > allout-widgets-additions-recorder (from to) +(defun allout-widgets-additions-recorder (from to) + "Record allout item additions for tracking during post-command processing. + +Intended for use on `allout-structure-added-hook'. + +FROM point at the start of the first new item and TO is point at the start +of the last one. + +Records changes in `allout-widgets-changes-record'." + (push (list :added from to) allout-widgets-changes-record)) +;;;_ > allout-widgets-additions-processor (changes) +(defun allout-widgets-additions-processor (changes) + "Widgetize and adjust items tracking allout outline structure additions. + +Dispatched by `allout-widgets-post-command-business' in response to +:added entries recorded by `allout-widgets-additions-recorder'." + (save-excursion + (let (handled + covered) + (dolist (change changes) + (let ((from (cadr change)) + bucket + (to (caddr change))) + (if (< to from) (setq bucket to to from from bucket)) + ;; have we already handled exposure changes in this region? + (setq handled (allout-range-overlaps from to handled) + covered (car handled) + handled (cadr handled)) + (when (not covered) + (goto-char from) + ;; Prior sibling and parent can both be affected. + (if (allout-ascend) + (allout-redecorate-visible-subtree + (allout-get-or-create-item-widget 'redecorate))) + (if (< (point) from) + (goto-char from)) + (while (and (< (point) to) (not (eobp))) + (allout-beginning-of-current-line) + (allout-redecorate-visible-subtree + (allout-get-or-create-item-widget)) + (allout-next-visible-heading 1)) + (if (> (point) to) + ;; subtree may be well beyond to - incorporate in ranges: + (setq handled (allout-range-overlaps from (point) handled) + covered (car handled) + handled (cadr handled))))))))) + +;;;_ > allout-widgets-deletions-recorder (depth from) +(defun allout-widgets-deletions-recorder (depth from) + "Record allout item deletions for tracking during post-command processing. + +Intended for use on `allout-structure-deleted-hook'. + +DEPTH is the depth of the deleted subtree, and FROM is the point from which +the subtree was deleted. + +Records changes in `allout-widgets-changes-record'." + (push (list :deleted depth from) allout-widgets-changes-record)) +;;;_ > allout-widgets-deletions-processor (changes) +(defun allout-widgets-deletions-processor (changes) + "Adjust items tracking allout outline structure deletions. + +Dispatched by `allout-widgets-post-command-business' in response to +:deleted entries recorded by `allout-widgets-deletions-recorder'." + (save-excursion + (dolist (change changes) + (let ((depth (cadr change)) + (from (caddr change))) + (goto-char from) + (when (allout-previous-visible-heading 1) + (if (> depth 1) + (allout-ascend-to-depth (1- depth))) + (allout-redecorate-visible-subtree + (allout-get-or-create-item-widget 'redecorate))))))) + +;;;_ > allout-widgets-shifts-recorder (shifted-amount at) +(defun allout-widgets-shifts-recorder (shifted-amount at) + "Record outline subtree shifts for tracking during post-command processing. + +Intended for use on `allout-structure-shifted-hook'. + +SHIFTED-AMOUNT is the depth change and AT is the point at the start of the +subtree that's been shifted. + +Records changes in `allout-widgets-changes-record'." + (push (list :shifted shifted-amount at) allout-widgets-changes-record)) +;;;_ > allout-widgets-shifts-processor (changes) +(defun allout-widgets-shifts-processor (changes) + "Widgetize and adjust items tracking allout outline structure additions. + +Dispatched by `allout-widgets-post-command-business' in response to +:shifted entries recorded by `allout-widgets-shifts-recorder'." + (save-excursion + (dolist (change changes) + (goto-char (caddr change)) + (allout-ascend) + (allout-redecorate-visible-subtree)))) +;;;_ > allout-widgets-after-copy-or-kill-function () +(defun allout-widgets-after-copy-or-kill-function () + "Do allout-widgets processing of text just placed in the kill ring. + +Intended for use on allout-after-copy-or-kill-hook." + (if (car kill-ring) + (setcar kill-ring (allout-widgets-undecorate-text (car kill-ring))))) + +;;;_ > allout-widgets-exposure-undo-recorder (widget from-state) +(defun allout-widgets-exposure-undo-recorder (widget) + "Record outline exposure undo for tracking during post-command processing. + +Intended for use by `allout-graphics-modification-handler'. + +WIDGET is the widget being changed. + +Records changes in `allout-widgets-changes-record'." + ;; disregard the events if we're currently processing them. + (if (not allout-undo-exposure-in-progress) + (push widget allout-widgets-undo-exposure-record))) +;;;_ > allout-widgets-exposure-undo-processor () +(defun allout-widgets-exposure-undo-processor () + "Adjust items tracking undo of allout outline structure exposure. + +Dispatched by `allout-widgets-post-command-business' in response to +:undone-exposure entries recorded by `allout-widgets-exposure-undo-recorder'." + (let* ((allout-undo-exposure-in-progress t) + ;; inhibit undo recording while twiddling exposure to track undo: + (widgets allout-widgets-undo-exposure-record) + widget widget-start-marker widget-end-marker + from-state icon-start-point to-state + handled covered) + (setq allout-widgets-undo-exposure-record nil) + (save-excursion + (dolist (widget widgets) + (setq widget-start-marker (widget-get widget :from) + widget-end-marker (widget-get widget :to) + from-state (widget-get widget :icon-state) + icon-start-point (widget-apply widget :actual-position + :icon-start) + to-state (get-text-property icon-start-point + :icon-state)) + (setq handled (allout-range-overlaps widget-start-marker + widget-end-marker + handled) + covered (car handled) + handled (cadr handled)) + (when (not covered) + (goto-char (widget-get widget :from)) + (when (not (allout-hidden-p)) + ;; adjust actual exposure to that of to-state viz from-state + (cond ((and (eq to-state 'closed) (eq from-state 'opened)) + (allout-hide-current-subtree) + (allout-decorate-item-and-context widget)) + ((and (eq to-state 'opened) (eq from-state 'closed)) + (save-excursion + (dolist + (expose-to (allout-chart-exposure-contour-by-icon)) + (goto-char expose-to) + (allout-show-to-offshoot))))))))))) +;;;_ > allout-chart-exposure-contour-by-icon (&optional from-depth) +(defun allout-chart-exposure-contour-by-icon (&optional from-depth) + "Return points of subtree items to which exposure should be extended. + +The qualifying items are ones with a widget icon that is in the closed or +empty state, or items with undecorated subitems. + +The resulting list of points is in reverse order. + +Optional FROM-DEPTH is for internal use." + ;; During internal recursion, we return a pair: (at-end . result) + ;; Otherwise we just return the result. + (let ((from-depth from-depth) + start-point + at-end level-depth + this-widget + got subgot) + (if from-depth + (setq level-depth (allout-depth)) + ;; at containing item: + (setq start-point (point)) + (setq from-depth (allout-depth)) + (setq at-end (not (allout-next-heading)) + level-depth allout-recent-depth)) + + ;; traverse the level, recursing on deeper levels: + (while (and (not at-end) + (> allout-recent-depth from-depth) + (setq this-widget (allout-get-item-widget))) + (if (< level-depth allout-recent-depth) + ;; recurse: + (progn + (setq subgot (allout-chart-exposure-contour-by-icon level-depth) + at-end (car subgot) + subgot (cdr subgot)) + (if subgot (setq got (append subgot got)))) + ;; progress at this level: + (when (memq (widget-get this-widget :icon-state) '(closed empty)) + (push (point) got) + (allout-end-of-subtree)) + (setq at-end (not (allout-next-heading))))) + + ;; tailor result depending on whether or not we're a recursion: + (if (not start-point) + (cons at-end got) + (goto-char start-point) + got))) +;;;_ > allout-range-overlaps (from to ranges) +(defun allout-range-overlaps (from to ranges) + "Return a pair indicating overlap of FROM and TO subtree range in RANGES. + +First element of result indicates whether candadate range FROM, TO +overlapped any of the existing ranges. + +Second element of result is a new version of RANGES incorporating the +candidate range with overlaps consolidated. + +FROM and TO must be in increasing order, as must be the pairs in RANGES." + ;; to append to the end: (rplacd next-to-last-cdr (list 'f)) + (let (new-ranges + entry + ;; the start of the range that includes the candidate from: + included-from + ;; the end of the range that includes the candidate to: + included-to + ;; the candidates were inserted: + done) + (while (and ranges (not done)) + (setq entry (car ranges) + ranges (cdr ranges)) + + (cond + + (included-from + ;; some entry included the candidate from. + (cond ((> (car entry) to) + ;; current entry exceeds end of candidate range - done. + (push (list included-from to) new-ranges) + (push entry new-ranges) + (setq included-to to + done t)) + ((>= (cadr entry) to) + ;; current entry includes end of candidate range - done. + (push (list included-from (cadr entry)) new-ranges) + (setq included-to (cadr entry) + done t)) + ;; current entry contained in candidate range - ditch, continue: + (t nil))) + + ((> (car entry) to) + ;; current entry start exceeds candidate end - done, placed as new entry + (push (list from to) new-ranges) + (push entry new-ranges) + (setq included-to to + done t)) + + ((>= (car entry) from) + ;; current entry start is above candidate start, but not above + ;; candidate end (by prior case). + (setq included-from from) + ;; now we have to check on whether this entry contains to, or continue: + (when (>= (cadr entry) to) + ;; current entry contains only candidate end - done: + (push (list included-from (cadr entry)) new-ranges) + (setq included-to (cadr entry) + done t)) + ;; otherwise, we will continue to look for placement of candidate end. + ) + + ((>= (cadr entry) to) + ;; current entry properly contains candidate range. + (push entry new-ranges) + (setq included-from (car entry) + included-to (cadr entry) + done t)) + + ((>= (cadr entry) from) + ;; current entry contains start of candidate range. + (setq included-from (car entry))) + + (t + ;; current entry is below the candidate range. + (push entry new-ranges)))) + + (cond ((and included-from included-to) + ;; candidates placed. + nil) + ((not (or included-from included-to)) + ;; candidates found no place, must be at the end: + (push (list from to) new-ranges)) + (included-from + ;; candidate start placed but end not: + (push (list included-from to) new-ranges)) + ;; might be included-to and not included-from, indicating new entry. + ) + (setq new-ranges (nreverse new-ranges)) + (if ranges (setq new-ranges (append new-ranges ranges))) + (list (if included-from t) new-ranges))) +;;;_ > allout-test-range-overlaps () +(defun allout-test-range-overlaps () + "allout-range-overlaps unit tests." + (let* (ranges + got + (try (lambda (from to) + (setq got (allout-range-overlaps from to ranges)) + (setq ranges (cadr got)) + got))) +;; ;; biggie: +;; (setq ranges nil) +;; ;; ~ .02 to .1 seconds for just repeated listing args instead of funcall +;; ;; ~ 13 seconds for doing repeated funcall +;; (message "time-trial: %s, resulting size %s" +;; (time-trial +;; '(let ((size 10000) +;; doing) +;; (random t) +;; (dotimes (count size) +;; (setq doing (random size)) +;; (funcall try doing (+ doing (random 5))) +;; ;;(list doing (+ doing (random 5))) +;; ))) +;; (length ranges)) +;; (sit-for 2) + + ;; fresh: + (setq ranges nil) + (assert (equal (funcall try 3 5) '(nil ((3 5))))) + ;; add range at end: + (assert (equal (funcall try 10 12) '(nil ((3 5) (10 12))))) + ;; add range at beginning: + (assert (equal (funcall try 1 2) '(nil ((1 2) (3 5) (10 12))))) + ;; insert range somewhere in the middle: + (assert (equal (funcall try 7 9) '(nil ((1 2) (3 5) (7 9) (10 12))))) + ;; consolidate some: + (assert (equal (funcall try 5 8) '(t ((1 2) (3 9) (10 12))))) + ;; add more: + (assert (equal (funcall try 15 17) '(nil ((1 2) (3 9) (10 12) (15 17))))) + ;; add more: + (assert (equal (funcall try 20 22) + '(nil ((1 2) (3 9) (10 12) (15 17) (20 22))))) + ;; encompass more: + (assert (equal (funcall try 4 11) '(t ((1 2) (3 12) (15 17) (20 22))))) + ;; encompass all: + (assert (equal (funcall try 2 25) '(t ((1 25))))) + + ;; fresh slate: + (setq ranges nil) + (assert (equal (funcall try 20 25) '(nil ((20 25))))) + (assert (equal (funcall try 30 35) '(nil ((20 25) (30 35))))) + (assert (equal (funcall try 26 28) '(nil ((20 25) (26 28) (30 35))))) + (assert (equal (funcall try 15 20) '(t ((15 25) (26 28) (30 35))))) + (assert (equal (funcall try 10 30) '(t ((10 35))))) + (assert (equal (funcall try 5 6) '(nil ((5 6) (10 35))))) + (assert (equal (funcall try 2 100) '(t ((2 100))))) + + (setq ranges nil) + )) +;;;_ > allout-widgetize-buffer (&optional doing) +(defun allout-widgetize-buffer (&optional doing) + "EXAMPLE FUNCTION. Widgetize items in buffer using allout-chart-subtree. + +We economize by just focusing on the first of local-maximum depth siblings. + +Optional DOING is for internal use - a chart of the current level, for +recursive operation." + + (interactive) + (if (not doing) + + (save-excursion + (goto-char (point-min)) + ;; Construct the chart by scanning the siblings: + (dolist (top-level-sibling (allout-chart-siblings)) + (goto-char top-level-sibling) + (let ((subchart (allout-chart-subtree))) + (if subchart + (allout-widgetize-buffer subchart))))) + + ;; save-excursion was done on recursion entry, not necessary here. + (let (have-sublists) + (dolist (sibling doing) + (when (listp sibling) + (setq have-sublists t) + (allout-widgetize-buffer sibling))) + (when (and (not have-sublists) (not (widget-at (car doing)))) + (goto-char (car doing)) + (allout-get-or-create-item-widget))))) + +;;;_ : Item widget and constructors + +;;;_ $ allout-item-widget +(define-widget 'allout-item-widget 'default + "A widget presenting an allout outline item." + + 'button nil + ;; widget-field-at respects this to get item if 'field is unused. + ;; we don't use field to avoid collision with end-of-line, etc, on which + ;; allout depends. + 'real-field nil + + ;; data fields: + + + ;; tailor the widget for a specific item + :create 'allout-decorate-item-and-context + :value-delete 'allout-widgets-undecorate-item + ;; Not Yet Converted (from original, tree-widget stab) + :expander 'allout-tree-event-dispatcher ; get children when nil :args + :expander-p 'identity ; always engage the :expander + :action 'allout-tree-widget-action + ;; :notify "when item changes" + + ;; force decoration of item but not context, unless already done this tick: + :redecorate 'allout-redecorate-item + :last-decorated-tick nil + ;; recognize the actual situation of the item's text: + :parse-item 'allout-parse-item-at-point + ;; decorate the entirety of the item, sans offspring: + :decorate-item-span 'allout-decorate-item-span + ;; decorate the various item elements: + :decorate-guides 'allout-decorate-item-guides + :decorate-icon 'allout-decorate-item-icon + :decorate-cue 'allout-decorate-item-cue + :decorate-body 'allout-decorate-item-body + :actual-position 'allout-item-actual-position + + ;; Layout parameters: + :is-container nil ; is this actually the encompassing file/connection? + + :from nil ; item beginning - marker + :to nil ; item end - marker + :span-overlay nil ; overlay by which actual postion is determined + + ;; also serves as guide-end: + :icon-start nil + :icon-end nil + :distinctive-start nil + ;; also serves as cue-start: + :distinctive-end nil + ;; also serves as cue-end: + :body-start nil + :body-end nil + :depth nil + :has-subitems nil + :was-has-subitems 'init + :expanded nil + :was-expanded 'init + :brief nil + :was-brief 'init + + :does-encrypt nil ; pending encryption when :is-encrypted false. + :is-encrypted nil + + ;; the actual location of the item text: + :location 'allout-item-location + + :button-keymap allout-item-icon-keymap ; XEmacs + :keymap allout-item-icon-keymap ; Emacs + + ;; Element regions: + :guides-span nil + :icon-span nil + :cue-span nil + :bullet nil + :was-bullet nil + :body-span nil + + :body-brevity-p 'allout-body-brevity-p + + ;; :guide-column-flags indicate (in reverse order) whether or not the + ;; item's ancestor at the depth corresponding to the column has a + ;; subsequent sibling - ie, whether or not the corresponding column needs + ;; a descender line to connect that ancestor with its sibling. + :guide-column-flags nil + :was-guide-column-flags 'init + + ;; ie, has subitems: + :populous-p 'allout-item-populous-p + :help-echo 'allout-tree-widget-help-echo + ) +;;;_ > allout-new-item-widget () +(defsubst allout-new-item-widget () + "create a new item widget, not yet situated anywhere." + (if allout-widgets-maintain-tally + ;; all the extra overhead is incurred only when doing the + ;; maintenance, except the condition, which can't be avoided. + (let ((widget (widget-convert 'allout-item-widget))) + (puthash widget nil allout-widgets-tally) + widget) + (widget-convert 'allout-item-widget))) +;;;_ : Item decoration +;;;_ > allout-decorate-item-and-context (item-widget &optional redecorate +;;; blank-container parent) +(defun allout-decorate-item-and-context (item-widget &optional redecorate + blank-container parent) + "Create or adjust widget decorations for ITEM-WIDGET and neighbors at point. + +The neighbors include its siblings and parent. + +ITEM-WIDGET can be a created or converted allout-item-widget. + +If you're only trying to get or create a widget for an item, use +`allout-get-or-create-item-widget'. If you have the item-widget, applying +:redecorate will do the right thing. + +Optional BLANK-CONTAINER is for internal use. It is used to fabricate a +container widget for an empty-bodied container, in the course of decorating +a proper \(non-container\) item which starts at the beginning of the file. + +Optional REDECORATE causes redecoration of the item-widget and +its siblings, even if already decorated in this cycle of the command loop. + +Optional PARENT, when provided, bypasses some navigation and computation +necessary to obtain the parent of the items being processed. + +We return the item-widget corresponding to the item at point." + + (when (or redecorate + (not (equal (widget-get item-widget :last-decorated-tick) + allout-command-counter))) + (let* ((allout-inhibit-body-modification-hook t) + (was-modified (buffer-modified-p)) + (was-point (point)) + prefix-start + (is-container (or blank-container + (not (setq prefix-start (allout-goto-prefix))) + (< was-point prefix-start))) + ;; steady-point (set in two steps) is reliable across parent + ;; widget-creation. + (steady-point (progn (if is-container (goto-char 1)) + (point-marker))) + (steady-point (progn (set-marker-insertion-type steady-point t) + steady-point)) + (parent (and (not is-container) + (allout-get-or-create-parent-widget))) + parent-flags parent-depth + successor-sibling + body + doing-item + sub-item-widget + depth + reverse-siblings-chart + (buffer-undo-list t)) + + ;; At this point the parent is decorated and parent-flags indicate + ;; its guide lines. We will iterate over the siblings according to a + ;; chart we create at the start, and going from last to first so we + ;; don't have to worry about text displacement caused by widgetizing. + + (if is-container + (progn (widget-put item-widget :is-container t) + (setq reverse-siblings-chart (list 1))) + (goto-char (widget-apply parent :actual-position :from)) + (if (widget-get parent :is-container) + ;; `allout-goto-prefix' will go to first non-container item: + (allout-goto-prefix) + (allout-next-heading)) + (setq depth (allout-recent-depth)) + (setq reverse-siblings-chart (list allout-recent-prefix-beginning)) + (while (allout-next-sibling) + (push allout-recent-prefix-beginning reverse-siblings-chart))) + + (dolist (doing-at reverse-siblings-chart) + (goto-char doing-at) + (when allout-widgets-track-decoration + (sit-for 0)) + + (setq doing-item (if (= doing-at steady-point) + item-widget + (or (allout-get-item-widget) + (allout-new-item-widget)))) + + (when (or redecorate (not (equal (widget-get doing-item + :last-decorated-tick) + allout-command-counter))) + (widget-apply doing-item :parse-item t blank-container) + (widget-apply doing-item :decorate-item-span) + + (widget-apply doing-item :decorate-guides + parent (and successor-sibling t)) + (widget-apply doing-item :decorate-icon) + (widget-apply doing-item :decorate-cue) + (widget-apply doing-item :decorate-body) + + (widget-put doing-item :last-decorated-tick allout-command-counter)) + + (setq successor-sibling doing-at)) + + (set-buffer-modified-p was-modified) + (goto-char steady-point) + ;; must null the marker or the buffer gets clogged with impedence: + (set-marker steady-point nil) + + item-widget))) +;;;_ > allout-redecorate-item (item) +(defun allout-redecorate-item (item-widget) + "Resituate ITEM-WIDGET decorations, disregarding context. + +Use this to redecorate only the item, when you know that it's +situation with respect to siblings, parent, and offspring is +unchanged from its last decoration. Use +`allout-decorate-item-and-context' instead to reassess and adjust +relevent context, when suitable." + (if (not (equal (widget-get item-widget :last-decorated-tick) + allout-command-counter)) + (let ((was-modified (buffer-modified-p)) + (buffer-undo-list t)) + (widget-apply item-widget :parse-item) + (widget-apply item-widget :decorate-guides) + (widget-apply item-widget :decorate-icon) + (widget-apply item-widget :decorate-cue) + (widget-apply item-widget :decorate-body) + (set-buffer-modified-p was-modified)))) +;;;_ > allout-redecorate-visible-subtree (&optional parent-widget +;;; depth chart) +(defun allout-redecorate-visible-subtree (&optional parent-widget depth chart) + "Redecorate all visible items in subtree at point. + +Optional PARENT-WIDGET is for optimization, when the parent +widget is already available. + +Optional DEPTH restricts the excursion depth of covered. + +Optional CHART is for internal recursion, to carry a chart of the +target items. + +Point is left at the last sibling in the visible subtree." + ;; using a treatment that takes care of all the siblings on a level, we + ;; only need apply it to the first sibling on the level, and we can + ;; collect and pass the parent of the lower levels to recursive calls as + ;; we go. + (let ((parent-widget + (if (and parent-widget (widget-apply parent-widget + :actual-position :from)) + (progn (goto-char (widget-apply parent-widget + :actual-position :from)) + parent-widget) + (let ((got (allout-get-item-widget))) + (if got + (allout-decorate-item-and-context got 'redecorate) + (allout-get-or-create-item-widget 'redecorate))))) + (pending-chart (or chart (allout-chart-subtree nil 'visible))) + item-widget + previous-sibling-point + previous-sibling + recent-sibling-point) + (setq pending-chart (nreverse pending-chart)) + (dolist (sibling-point pending-chart) + (cond ((integerp sibling-point) + (when (not previous-sibling-point) + (goto-char sibling-point) + (if (setq item-widget (allout-get-item-widget nil)) + (allout-decorate-item-and-context item-widget 'redecorate + nil parent-widget) + (allout-get-or-create-item-widget))) + (setq previous-sibling-point sibling-point + recent-sibling-point sibling-point)) + ((listp sibling-point) + (if (or (not depth) + (> depth 1)) + (allout-redecorate-visible-subtree + (if (not previous-sibling-point) + ;; containment discontinuity - sigh + parent-widget + (allout-get-or-create-item-widget 'redecorate)) + (if depth (1- depth)) + sibling-point))))) + (if (and recent-sibling-point (< (point) recent-sibling-point)) + (goto-char recent-sibling-point)))) +;;;_ > allout-parse-item-at-point (item-widget &optional at-beginning +;;; blank-container) +(defun allout-parse-item-at-point (item-widget &optional at-beginning + blank-container) + "Set widget ITEM-WIDGET layout parameters per item-at-point's actual layout. + +If optional AT-BEGINNING is t, then point is assumed to be at the start of +the item prefix. + +If optional BLANK-CONTAINER is true, then the parameters of a container +which has an empty body are set. \(Though the body is blank, the object +may have subitems.\)" + + ;; Uncomment this sit-for to notice where decoration is happening: +;; (sit-for .1) + (let* ((depth (allout-depth)) + (depth (if blank-container 0 depth)) + (is-container (or blank-container (zerop depth))) + + (does-encrypt (and (not is-container) + (allout-encrypted-type-prefix))) + (is-encrypted (and does-encrypt (allout-encrypted-topic-p))) + (icon-end allout-recent-prefix-end) + (icon-start (1- icon-end)) + body-start + body-end + bullet + has-subitems + (contents-depth (1+ depth)) + ) + (widget-put item-widget :depth depth) + (if is-container + + (progn + (widget-put item-widget :from (allout-set-boundary-marker + :from (point-min) + (widget-get item-widget :from))) + (widget-put item-widget :icon-end nil) + (widget-put item-widget :icon-start nil) + (setq body-start (widget-put item-widget :body-start 1))) + + ;; not container: + + (widget-put item-widget :from (allout-set-boundary-marker + :from (if at-beginning + (point) + allout-recent-prefix-beginning) + (widget-get item-widget :from))) + (widget-put item-widget :icon-start icon-start) + (widget-put item-widget :icon-end icon-end) + (when does-encrypt + (widget-put item-widget :does-encrypt t) + (widget-put item-widget :is-encrypted is-encrypted)) + + ;; cue area: + (setq body-start icon-end) + (widget-put item-widget :bullet (setq bullet (allout-get-bullet))) + (if (equal (char-after body-start) ? ) + (setq body-start (1+ body-start))) + (widget-put item-widget :body-start body-start) + ) + + ;; Both container and regular items: + + ;; :body-end (doesn't include a trailing blank line, if any) - + (widget-put item-widget :body-end (setq body-end + (if blank-container + 1 + (allout-end-of-entry)))) + + (widget-put item-widget :to (allout-set-boundary-marker + :to (if blank-container + (point-min) + (or (allout-pre-next-prefix) + (goto-char (point-max)))) + (widget-get item-widget :to))) + (widget-put item-widget :has-subitems + (setq has-subitems + (and + ;; has a subsequent item: + (not (= body-end (point-max))) + ;; subsequent item is deeper: + (< depth (setq contents-depth (allout-recent-depth)))))) + ;; note :expanded - true if widget item's content is currently visible? + (widget-put item-widget :expanded + (and has-subitems + ;; subsequent item is or isn't visible: + (save-excursion + (goto-char allout-recent-prefix-beginning) + (not (allout-hidden-p))))))) +;;;_ > allout-set-boundary-marker (boundary position &optional current-marker) +(defun allout-set-boundary-marker (boundary position &optional current-marker) + "Set or create item widget BOUNDARY type marker at POSITION. + +Optional CURRENT-MARKER is the marker currently being used for +the boundary, if any. + +BOUNDARY type is either :from or :to, determining the marker insertion type." + (if (not position) (setq position (point))) + (if current-marker + (set-marker current-marker position) + (let ((marker (make-marker))) + ;; XXX dang - would like for :from boundary to advance after inserted + ;; text, but that would omit new header prefixes when allout + ;; relevels, etc. this competes with ad-hoc edits, which would + ;; better be omitted + (set-marker-insertion-type marker nil) + (set-marker marker position)))) +;;;_ > allout-decorate-item-span (item-widget) +(defun allout-decorate-item-span (item-widget) + "Equip the item with a span, as an entirety. + +This span is implemented so it can be used to detect displacement +of the widget in absolute terms, and provides an offset bias for +the various element spans." + + (if (and (widget-get item-widget :is-container) + ;; the only case where the span could be empty. + (eq (widget-get item-widget :from) + (widget-get item-widget :to))) + nil + (allout-item-span item-widget + (widget-get item-widget :from) + (widget-get item-widget :to)))) +;;;_ > allout-decorate-item-guides (item-widget +;;; &optional parent-widget has-successor) +(defun allout-decorate-item-guides (item-widget + &optional parent-widget has-successor) + "Add ITEM-WIDGET guide icon-prefix descender and connector text properties. + +Optional arguments provide context for deriving the guides. In +their absence, the current guide column flags are used. + +Optional PARENT-WIDGET is the widget for the item's parent item. + +Optional HAS-SUCCESSOR is true iff the item is followed by a sibling. + +We also hide the header-prefix string. + +Guides are established according to the item-widget's :guide-column-flags, +when different than :was-guide-column-flags. Changing that property and +reapplying this method will rectify the glyphs." + + (when (not (widget-get item-widget :is-container)) + (let* ((depth (widget-get item-widget :depth)) + (parent-depth (and parent-widget + (widget-get parent-widget :depth))) + (parent-flags (and parent-widget + (widget-get parent-widget :guide-column-flags))) + (parent-flags-depth (length parent-flags)) + (extender-length (- depth (+ parent-flags-depth 2))) + (flags (or (and (> depth 1) + parent-widget + (widget-put item-widget :guide-column-flags + (append (list has-successor) + (if (< 0 extender-length) + (make-list extender-length + '-)) + parent-flags))) + (widget-get item-widget :guide-column-flags))) + (was-flags (widget-get item-widget :was-guide-column-flags)) + (guides-start (widget-get item-widget :from)) + (guides-end (widget-get item-widget :icon-start)) + (position guides-start) + (increment (length allout-header-prefix)) + reverse-flags + guide-name + extenders paint-extenders + (inhibit-read-only t)) + + (when (not (equal was-flags flags)) + + (setq reverse-flags (reverse flags)) + (while reverse-flags + (setq guide-name + (cond ((null (cdr reverse-flags)) + (if (car reverse-flags) + 'mid-connector + 'end-connector)) + ((eq (car reverse-flags) '-) + ;; accumulate extenders tally, to be painted on next + ;; non-extender flag, according to the flag type. + (setq extenders (1+ (or extenders 0))) + nil) + ((car reverse-flags) + 'through-descender) + (t 'skip-descender))) + (when guide-name + (put-text-property position (setq position (+ position increment)) + 'display (allout-fetch-icon-image guide-name)) + (if (> increment 1) (setq increment 1)) + (when extenders + ;; paint extenders after a connector, else leave spaces. + (dotimes (i extenders) + (put-text-property + position (setq position (1+ position)) + 'display (allout-fetch-icon-image + (if (memq guide-name '(mid-connector end-connector)) + 'extender-connector + 'skip-descender)))) + (setq extenders nil))) + (setq reverse-flags (cdr reverse-flags))) + (widget-put item-widget :was-guide-column-flags flags)) + + (allout-item-element-span-is item-widget :guides-span + guides-start guides-end)))) +;;;_ > allout-decorate-item-icon (item-widget) +(defun allout-decorate-item-icon (item-widget) + "Add item icon glyph and distinctive bullet text properties to ITEM-WIDGET." + + (when (not (widget-get item-widget :is-container)) + (let* ((icon-start (widget-get item-widget :icon-start)) + (icon-end (widget-get item-widget :icon-end)) + (bullet (widget-get item-widget :bullet)) + (use-bullet bullet) + (was-bullet (widget-get item-widget :was-bullet)) + (distinctive (allout-distinctive-bullet bullet)) + (distinctive-start (widget-get item-widget :distinctive-start)) + (distinctive-end (widget-get item-widget :distinctive-end)) + (does-encrypt (widget-get item-widget :does-encrypt)) + (is-encrypted (and does-encrypt (widget-get item-widget + :is-encrypted))) + (expanded (widget-get item-widget :expanded)) + (has-subitems (widget-get item-widget :has-subitems)) + (inhibit-read-only t) + icon-state) + + (when (not (and (equal (widget-get item-widget :was-expanded) expanded) + (equal (widget-get item-widget :was-has-subitems) + has-subitems) + (equal (widget-get item-widget :was-does-encrypt) + does-encrypt) + (equal (widget-get item-widget :was-is-encrypted) + is-encrypted))) + + (setq icon-state + (cond (does-encrypt (if is-encrypted + 'locked-encrypted + 'unlocked-encrypted)) + (expanded 'opened) + (has-subitems 'closed) + (t 'empty))) + (put-text-property icon-start (1+ icon-start) + 'display (allout-fetch-icon-image icon-state)) + (widget-put item-widget :was-expanded expanded) + (widget-put item-widget :was-has-subitems has-subitems) + (widget-put item-widget :was-does-encrypt does-encrypt) + (widget-put item-widget :was-is-encrypted is-encrypted) + ;; preserve as a widget property to track last known: + (widget-put item-widget :icon-state icon-state) + ;; preserve as a text property to track undo: + (put-text-property icon-start icon-end :icon-state icon-state)) + (allout-item-element-span-is item-widget :icon-span + icon-start icon-end) + (when (not (string= was-bullet bullet)) + (cond ((not distinctive) + ;; XXX we strip the prior properties without even checking if + ;; the prior bullet was distinctive, because the widget + ;; provisions to convey that info is disappearing, sigh. + (remove-text-properties icon-end (1+ icon-end) '(display)) + (setq distinctive-start icon-end distinctive-end icon-end) + (widget-put item-widget :distinctive-start distinctive-start) + (widget-put item-widget :distinctive-end distinctive-end)) + + ((not (string= bullet allout-numbered-bullet)) + (setq distinctive-start icon-end distinctive-end (+ icon-end 1))) + + (does-encrypt + (setq distinctive-start icon-end distinctive-end (+ icon-end 1))) + + (t + (goto-char icon-end) + (looking-at "[0-9]+") + (setq use-bullet (buffer-substring icon-end (match-end 0))) + (setq distinctive-start icon-end + distinctive-end (match-end 0)))) + (put-text-property distinctive-start distinctive-end 'display + use-bullet) + (widget-put item-widget :was-bullet bullet) + (widget-put item-widget :distinctive-start distinctive-start) + (widget-put item-widget :distinctive-end distinctive-end))))) +;;;_ > allout-decorate-item-cue (item-widget) +(defun allout-decorate-item-cue (item-widget) + "Incorporate space between bullet icon and body to the ITEM-WIDGET." + ;; NOTE: most of the cue-area + + (when (not (widget-get item-widget :is-container)) + (let* ((cue-start (or (widget-get item-widget :distinctive-end) + (widget-get item-widget :icon-end))) + (body-start (widget-get item-widget :body-start)) + (expanded (widget-get item-widget :expanded)) + (has-subitems (widget-get item-widget :has-subitems)) + (inhibit-read-only t)) + + (allout-item-element-span-is item-widget :cue-span cue-start body-start) + (put-text-property (1- body-start) body-start 'rear-nonsticky t)))) +;;;_ > allout-decorate-item-body (item-widget &optional force) +(defun allout-decorate-item-body (item-widget &optional force) + "Incorporate item body text as part the ITEM-WIDGET. + +Optional FORCE means force reassignment of the region property." + + (let* ((allout-inhibit-body-modification-hook t) + (body-start (widget-get item-widget :body-start)) + (body-end (widget-get item-widget :body-end)) + (body-text-end body-end) + (inhibit-read-only t)) + + (allout-item-element-span-is item-widget :body-span + body-start (min (1+ body-end) (point-max)) + force))) +;;;_ > allout-item-actual-position (item-widget field) +(defun allout-item-actual-position (item-widget field) + "Return ITEM-WIDGET FIELD position taking item displacement into account." + + ;; The item's sub-element positions (:icon-end, :body-start, etc) are + ;; accurate when the item is parsed, but some offsets from the start + ;; drift with text added in the body. + ;; + ;; Rather than reparse an item with every change (inefficient), or derive + ;; every position from a distinct field marker/overlay (prohibitive as + ;; the number of items grows), we use the displacement tracking of the + ;; :span-overlay's markers, against the registered :from or :body-end + ;; (depending on whether the requested field value is before or after the + ;; item body), to bias the registered values. + ;; + ;; This is not necessary/useful when the item is being decorated, because + ;; that always must be preceeded by a fresh item parse. + + (if (not (eq field :body-end)) + (widget-get item-widget :from) + + (let* ((span-overlay (widget-get item-widget :span-overlay)) + (body-end-position (widget-get item-widget :body-end)) + (ref-marker-position (and span-overlay + (overlay-end span-overlay))) + (offset (and body-end-position span-overlay + (- (or ref-marker-position 0) + body-end-position)))) + (+ (widget-get item-widget field) (or offset 0))))) +;;;_ : Item undecoration +;;;_ > allout-widgets-undecorate-region (start end) +(defun allout-widgets-undecorate-region (start end) + "Eliminate widgets and decorations for all items in region from START to END." + (let ((next start) + widget) + (save-excursion + (goto-char start) + (while (< (setq next (next-single-char-property-change next + 'display + (current-buffer) + end)) + end) + (goto-char next) + (when (setq widget (allout-get-item-widget)) + ;; if the next-property/overly progression got us to a widget: + (allout-widgets-undecorate-item widget t)))))) +;;;_ > allout-widgets-undecorate-text (text) +(defun allout-widgets-undecorate-text (text) + "Eliminate widgets and decorations for all items in TEXT." + (remove-text-properties 0 (length text) + '(display nil :icon-state nil rear-nonsticky nil + category nil button nil field nil) + text) + text) +;;;_ > allout-widgets-undecorate-item (item-widget &optional no-expose) +(defun allout-widgets-undecorate-item (item-widget &optional no-expose) + "Remove widget decorations from ITEM-WIDGET. + +Any concealed content head lines and item body is exposed, unless +optional NO-EXPOSE is non-nil." + (let ((from (widget-get item-widget :from)) + (to (widget-get item-widget :to)) + (text-properties-to-remove '(display nil + :icon-state nil + rear-nonsticky nil + category nil + button nil + field nil)) + (span-overlay (widget-get item-widget :span-overlay)) + (button-overlay (widget-get item-widget :button)) + (was-modified (buffer-modified-p)) + (buffer-undo-list t) + (inhibit-read-only t)) + (if (not no-expose) + (allout-flag-region from to nil)) + (allout-unprotected + (remove-text-properties from to text-properties-to-remove)) + (when span-overlay + (delete-overlay span-overlay) (widget-put item-widget :span-overlay nil)) + (when button-overlay + (delete-overlay button-overlay) (widget-put item-widget :button nil)) + (set-marker from nil) + (set-marker to nil) + (if (not was-modified) + (set-buffer-modified-p nil)))) + +;;;_ : Item decoration support +;;;_ > allout-item-span (item-widget &optional start end) +(defun allout-item-span (item-widget &optional start end) + "Return or register the location of an ITEM-WIDGET's actual START and END. + +If START and END are not passed in, return either a dotted pair +of the current span, if established, or nil if not yet set. + +When the START and END are passed, return the distance that the +start of the item moved. We return 0 if the span was not +previously established or is not moved." + (let ((overlay (widget-get item-widget :span-overlay)) + was-start was-end + changed) + (cond ((not overlay) (when start + (setq overlay (make-overlay start end nil t nil)) + (overlay-put overlay 'button item-widget) + (widget-put item-widget :span-overlay overlay) + t)) + ;; report: + ((not start) (cons (overlay-start overlay) (overlay-end overlay))) + ;; move: + ((or (not (equal (overlay-start overlay) start)) + (not (equal (overlay-end overlay) end))) + (move-overlay overlay start end) + t) + ;; specified span already set: + (t nil)))) +;;;_ > allout-item-element-span-is (item-widget element +;;; &optional start end force) +(defun allout-item-element-span-is (item-widget element + &optional start end force) + "Return or register the location of the indicated ITEM-WIDGET ELEMENT. + +ELEMENT is one of :guides-span, :icon-span, :cue-span, or :body-span. + +When optional START is specified, optional END must also be. + +START and END are the actual bounds of the region, if provided. + +If START and END are not passed in, we return either a dotted +pair of the current span, if established, or nil if not yet set. + +When the START and END are passed, we return t if the region +changed or nil if not. + +Optional FORCE means force assignment of the region's text +property, even if it's already set." + (let ((span (widget-get item-widget element))) + (cond ((or (not span) force) + (when start + (widget-put item-widget element (cons start end)) + (put-text-property start end 'category + (cdr (assoc element + allout-span-to-category))) + t)) + ;; report: + ((not start) span) + ;; move if necessary: + ((not (and (eq (car span) start) + (eq (cdr span) end))) + (widget-put item-widget element span) + t) + ;; specified span already set: + (t nil)))) +;;;_ : Item widget retrieval (/ high-level creation): +;;;_ > allout-get-item-widget (&optional container) +(defun allout-get-item-widget (&optional container) + "Return the widget for the item at point, or nil if no widget yet exists. + +Point must be situated *before* the start of the target item's +body, so we don't get an existing containing item when we're in +the process of creating an item in the middle of another. + +Optional CONTAINER is used to obtain the container item." + (if (or container (zerop (allout-depth))) + allout-container-item-widget + ;; allout-recent-* are calibrated by (allout-depth) if we got here. + (let ((got (widget-at allout-recent-prefix-beginning))) + (if (and got (listp got)) + (if (marker-position (widget-get got :from)) + (and + (>= (point) (widget-apply got :actual-position :from)) + (<= (point) (widget-apply got :actual-position :body-start)) + got) + ;; a wacky residual item - undecorate and disregard: + (allout-widgets-undecorate-item got) + nil))))) +;;;_ > allout-get-or-create-item-widget (&optional redecorate blank-container) +(defun allout-get-or-create-item-widget (&optional redecorate blank-container) + "Return a widget for the item at point, creating the widget if necessary. + +When creating a widget, we assume there has been a context change +and decorate its siblings and parent, as well. + +Optional BLANK-CONTAINER is for internal use, to fabricate a +meta-container item with an empty body when the first proper +\(non-container\) item starts at the beginning of the file. + +Optional REDECORATE, if non-nil, means to redecorate the widget +if it already exists." + (let ((widget (allout-get-item-widget blank-container)) + (buffer-undo-list t)) + (cond (widget (if redecorate + (allout-redecorate-item widget)) + widget) + ((or blank-container (zerop (allout-depth))) + (or allout-container-item-widget + (setq allout-container-item-widget + (allout-decorate-item-and-context + (widget-convert 'allout-item-widget) + nil blank-container)))) + ;; create a widget for a regular/non-container item: + (t (allout-decorate-item-and-context (widget-convert + 'allout-item-widget)))))) +;;;_ > allout-get-or-create-parent-widget (&optional redecorate) +(defun allout-get-or-create-parent-widget (&optional redecorate) + "Return widget for parent of item at point, decorating it if necessary. + +We return the container widget if we're above the first proper item in the +file. + +Optional REDECORATE, if non-nil, means to redecorate the widget if it +already exists. + +Point will wind up positioned on the beginning of the parent or beginning +of the buffer." + ;; use existing widget, if there, else establish it + (if (or (bobp) (and (not (allout-ascend)) + (looking-at allout-regexp))) + (allout-get-or-create-item-widget redecorate 'blank-container) + (allout-get-or-create-item-widget redecorate))) +;;;_ : X- Item ancillaries +;;;_ >X allout-body-modification-handler (beg end) +(defun allout-body-modification-handler (beg end) + "Do routine processing of body text before and after modification. + +Operation is inhibited by `allout-inhibit-body-modification-handler'." + +;; The primary duties are: +;; +;; - marking of escaped prefix-like text for delayed cleanup of escapes +;; - removal and replacement of the settings +;; - maintenance of beginning-of-line guide lines +;; +;; ?? Escapes removal \(before changes\) is not done when edits span multiple +;; items, recognizing that item structure is being preserved, including +;; escaping of item-prefix-like text within bodies. See +;; `allout-before-modification-handler' and +;; `allout-inhibit-body-modification-handler'. +;; +;; Adds the overlay to the `allout-unresolved-body-mod-workhash' during +;; before-change operation, and removes from that list during after-change +;; operation. + (cond (allout-inhibit-body-modification-hook nil))) +;;;_ >X allout-graphics-modification-handler (beg end) +(defun allout-graphics-modification-handler (beg end) + "Protect against incoherent deletion of decoration graphics. + +Deletes allowed only when inhibit-read-only is t." + (cond + (undo-in-progress (when (eq (get-text-property beg 'category) + 'allout-icon-span-category) + (save-excursion + (goto-char beg) + (let* ((item-widget (allout-get-item-widget))) + (if item-widget + (allout-widgets-exposure-undo-recorder + item-widget)))))) + (inhibit-read-only t) + ((not (and (boundp 'allout-mode) allout-mode)) t) + ((equal this-command 'quoted-insert) t) + ((yes-or-no-p "Unruly edit of outline structure - allow? ") + (setq allout-widgets-unset-inhibit-read-only (not inhibit-read-only) + inhibit-read-only t)) + (t (error + (substitute-command-keys allout-structure-unruly-deletion-message))))) +;;;_ > allout-item-icon-key-handler () +(defun allout-item-icon-key-handler () + "Catchall handling of key bindings in item icon/cue hot-spots. + +Applies `allout-hotspot-key-handler' and calls the result, if any, as an +interactive command." + + (interactive) + (let* ((mapped-binding (allout-hotspot-key-handler))) + (when mapped-binding + (call-interactively mapped-binding)))) + +;;;_ : Status +;;;_ . allout-item-location (item-widget) +(defun allout-item-location (item-widget) + "Location of the start of the item's text." + (overlay-start (widget-get item-widget :span-overlay))) + +;;;_ : Icon management +;;;_ > allout-fetch-icon-image (name) +(defun allout-fetch-icon-image (name) + "Fetch allout icon for symbol NAME. + +We use a caching strategy, so the caller doesn't need to do so." + (let* ((types allout-widgets-icon-types) + (use-dir (if (equal (allout-frame-property nil 'background-mode) + 'light) + allout-widgets-icons-light-subdir + allout-widgets-icons-dark-subdir)) + (key (list name use-dir)) + (got (assoc key allout-widgets-icons-cache))) + (if got + ;; display system shows only first of subsequent adjacent + ;; `eq'-identical repeats - use copies to avoid this problem. + (allout-widgets-copy-list (cadr got)) + (while (and types (not got)) + (setq got + (allout-find-image + (list (append (list :type (car types) + :file (concat use-dir + (symbol-name name) + "." (symbol-name + (car types)))) + (if (featurep 'xemacs) + allout-widgets-item-image-properties-xemacs + allout-widgets-item-image-properties-emacs) + )))) + (setq types (cdr types))) + (if got + (push (list key got) allout-widgets-icons-cache)) + got))) + +;;;_ : Miscellaneous +;;;_ > allout-elapsed-time-seconds (triple) +(defun allout-elapsed-time-seconds (end start) + "Return seconds between `current-time' style time START/END triples." + (let ((elapsed (time-subtract end start))) + (+ (* (car elapsed) (expt 2.0 16)) + (cadr elapsed) + (/ (caddr elapsed) (expt 10.0 6))))) +;;;_ > allout-frame-property (frame property) +(defalias 'allout-frame-property + (cond ((fboundp 'frame-parameter) + 'frame-parameter) + ((fboundp 'frame-property) + 'frame-property) + (t nil))) +;;;_ > allout-find-image (specs) +(defalias 'allout-find-image + (if (fboundp 'find-image) + 'find-image + nil) ; aka, not-yet-implemented for xemacs. +) +;;;_ > allout-widgets-copy-list (list) +(defun allout-widgets-copy-list (list) + ;; duplicated from cl.el 'copy-list' as of 2008-08-17 + "Return a copy of LIST, which may be a dotted list. +The elements of LIST are not copied, just the list structure itself." + (if (consp list) + (let ((res nil)) + (while (consp list) (push (pop list) res)) + (prog1 (nreverse res) (setcdr res list))) + (car list))) + +;;;_ : Run unit tests: +(defun allout-widgets-run-unit-tests () + (message "Running allout-widget tests...") + + (allout-test-range-overlaps) + + (message "Running allout-widget tests... Done.") + (sit-for .5)) + +(when allout-widgets-run-unit-tests-on-load + (allout-widgets-run-unit-tests)) + +;;;_ : provide +(provide 'allout-widgets) + +;;;_. Local emacs vars. +;;;_ , Local variables: +;;;_ , allout-layout: (-1 : 0) +;;;_ , End: diff --git a/lisp/allout.el b/lisp/allout.el index 5d87415a57f..1a7d8cb1593 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -6,7 +6,7 @@ ;; Maintainer: Ken Manheimer <ken dot manheimer at gmail dot com> ;; Created: Dec 1991 -- first release to usenet ;; Version: 2.3 -;; Keywords: outlines wp languages +;; Keywords: outlines, wp, languages, PGP, GnuPG ;; Website: http://myriadicity.net/Sundry/EmacsAllout ;; This file is part of GNU Emacs. @@ -39,11 +39,9 @@ ;; emacs local file variables need to be enabled when the ;; file was visited -- see `enable-local-variables'.) ;; - Configurable per-file initial exposure settings -;; - Symmetric-key and key-pair topic encryption, plus symmetric passphrase -;; mnemonic support, with verification against an established passphrase -;; (using a stashed encrypted dummy string) and user-supplied hint -;; maintenance. Encryption is via the Emacs 'epg' library. See -;; allout-toggle-current-subtree-encryption docstring. +;; - Symmetric-key and key-pair topic encryption. Encryption is via the +;; Emacs 'epg' library. See allout-toggle-current-subtree-encryption +;; docstring. ;; - Automatic topic-number maintenance ;; - "Hot-spot" operation, for single-keystroke maneuvering and ;; exposure control (see the allout-mode docstring) @@ -59,8 +57,8 @@ ;; See the `allout-mode' function's docstring for an introduction to the ;; mode. ;; -;; The latest development version and helpful notes are available at -;; http://myriadicity.net/Sundry/EmacsAllout . +;; Directions to the latest development version and helpful notes are +;; available at http://myriadicity.net/Sundry/EmacsAllout . ;; ;; The outline menubar additions provide quick reference to many of the ;; features. See the docstring of the variables `allout-layout' and @@ -76,7 +74,7 @@ ;;; Code: -;;;_* Dependency autoloads +;;;_* Dependency loads (require 'overlay) (eval-when-compile ;; Most of the requires here are for stuff covered by autoloads, which @@ -94,7 +92,9 @@ ;;;_ > defgroup allout, allout-keybindings (defgroup allout nil - "Extensive outline mode for use alone and with other modes." + "Extensive outline minor-mode, for use stand-alone and with other modes. + +See Allout Auto Activation for automatic activation." :prefix "allout-" :group 'outlines) (defgroup allout-keybindings nil @@ -308,9 +308,7 @@ performing auto-layout is asked of the user each time. With value \"activate\", only auto-mode-activation is enabled. Auto-layout is not. -With value nil, neither auto-mode-activation nor auto-layout are -enabled, and allout auto-activation processing is removed from -file visiting activities." +With value nil, inhibit any automatic allout-mode activation." :set 'allout-auto-activation-helper :type '(choice (const :tag "On" t) (const :tag "Ask about layout" "ask") @@ -752,8 +750,10 @@ Set this var to the bullet you want to use for file cross-references." ;;;###autoload (put 'allout-presentation-padding 'safe-local-variable 'integerp) -;;;_ = allout-abbreviate-flattened-numbering -(defcustom allout-abbreviate-flattened-numbering nil +;;;_ = allout-flattened-numbering-abbreviation +(define-obsolete-variable-alias 'allout-abbreviate-flattened-numbering + 'allout-flattened-numbering-abbreviation "24.0") +(defcustom allout-flattened-numbering-abbreviation nil "If non-nil, `allout-flatten-exposed-to-buffer' abbreviates topic numbers to minimal amount with some context. Otherwise, entire numbers are always used." @@ -1553,6 +1553,7 @@ See `allout-encryption-ciphertext-rejection-regexps' for rejection reasons.") ;;;_ > allout-mode-p () ;; Must define this macro above any uses, or byte compilation will lack ;; proper def, if file isn't loaded -- eg, during emacs build! +;;;###autoload (defmacro allout-mode-p () "Return t if `allout-mode' is active in current buffer." 'allout-mode) @@ -5410,7 +5411,7 @@ header and body. The elements of that list are: bullet))) (cond ((listp format) (list depth - (if allout-abbreviate-flattened-numbering + (if allout-flattened-numbering-abbreviation (allout-stringify-flat-index format gone-out) (allout-stringify-flat-index-plain @@ -6054,7 +6055,7 @@ signal." (with-temp-buffer (insert text) ;; convey the text characteristics of the original buffer: - (allout-set-buffer-multibyte multibyte) + (set-buffer-multibyte multibyte) (when encoding (set-buffer-file-coding-system encoding) (if (not decrypt) @@ -6085,9 +6086,14 @@ signal." (setq result-text (if decrypt - (epg-decrypt-string epg-context - (encode-coding-string massaged-text - (or encoding 'utf-8))) + (condition-case err + (epg-decrypt-string epg-context + (encode-coding-string massaged-text + (or encoding 'utf-8))) + (epg-error + (signal 'egp-error + (cons (concat (cadr err) " - gpg version problem?") + (cddr err))))) (replace-regexp-in-string "\n$" "" (epg-encrypt-string epg-context (encode-coding-string massaged-text @@ -6673,14 +6679,6 @@ To ignore intangibility, bind `inhibit-point-motion-hooks' to t." 'previous-single-property-change) ;; No docstring because xemacs defalias doesn't support it. ) -;;;_ > allout-set-buffer-multibyte -(if (fboundp 'set-buffer-multibyte) - (defalias 'allout-set-buffer-multibyte 'set-buffer-multibyte) - (with-no-warnings - ;; this definition is used only in older or alternative emacs, where - ;; the setting is our only recourse. - (defun allout-set-buffer-multibyte (is-multibyte) - (set enable-multibyte-characters is-multibyte)))) ;;;_ > allout-select-safe-coding-system (defalias 'allout-select-safe-coding-system (if (fboundp 'select-safe-coding-system) diff --git a/lisp/apropos.el b/lisp/apropos.el index 70ce860e1d7..734b2fb2f6b 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -972,8 +972,10 @@ If non-nil TEXT is a string that will be printed as a heading." (with-output-to-temp-buffer "*Apropos*" (let ((p apropos-accumulator) (old-buffer (current-buffer)) + (inhibit-read-only t) symbol item) (set-buffer standard-output) + (apropos-mode) (if (display-mouse-p) (insert "If moving the mouse over text changes the text's color, " @@ -1064,8 +1066,7 @@ If non-nil TEXT is a string that will be printed as a heading." (apropos-print-doc 5 'apropos-widget t) (apropos-print-doc 4 'apropos-plist nil)) (set (make-local-variable 'truncate-partial-width-windows) t) - (set (make-local-variable 'truncate-lines) t) - (apropos-mode)))) + (set (make-local-variable 'truncate-lines) t)))) (prog1 apropos-accumulator (setq apropos-accumulator ()))) ; permit gc diff --git a/lisp/autorevert.el b/lisp/autorevert.el index 0000e29f458..2bc7310d7e5 100644 --- a/lisp/autorevert.el +++ b/lisp/autorevert.el @@ -116,12 +116,12 @@ Global Auto-Revert Mode applies to all buffers." ;;; What's this?: ;; Autoload for the benefit of `make-mode-line-mouse-sensitive'. ;;; What's this?: ;;;###autoload (defvar auto-revert-mode nil - "*Non-nil when Auto-Revert Mode is active. + "Non-nil when Auto-Revert Mode is active. Never set this variable directly, use the command `auto-revert-mode' instead.") (put 'auto-revert-mode 'permanent-local t) (defvar auto-revert-tail-mode nil - "*Non-nil when Auto-Revert Tail Mode is active. + "Non-nil when Auto-Revert Tail Mode is active. Never set this variable directly, use the command `auto-revert-tail-mode' instead.") (put 'auto-revert-tail-mode 'permanent-local t) @@ -254,8 +254,7 @@ buffers. CPU usage depends on the version control system." :version "22.1") (defvar global-auto-revert-ignore-buffer nil - "*When non-nil, Global Auto-Revert Mode will not revert this buffer. - + "When non-nil, Global Auto-Revert Mode will not revert this buffer. This variable becomes buffer local when set in any fashion.") (make-variable-buffer-local 'global-auto-revert-ignore-buffer) diff --git a/lisp/bs.el b/lisp/bs.el index 2436bab2597..1f90304f1da 100644 --- a/lisp/bs.el +++ b/lisp/bs.el @@ -42,14 +42,10 @@ ;;; Quick Installation und Customization: -;; Use +;; To display the bs menu, do ;; M-x bs-show -;; for buffer selection or optional bind a key to main function `bs-show' -;; (global-set-key "\C-x\C-b" 'bs-show) ;; or another key -;; -;; For customization use -;; M-x bs-customize - +;; To customize its behavior, do +;; M-x bs-customize ;;; More Commentary: diff --git a/lisp/color.el b/lisp/color.el index 3874e33bfbb..5b67eb58a63 100644 --- a/lisp/color.el +++ b/lisp/color.el @@ -1,9 +1,10 @@ -;;; color.el --- Color manipulation laboratory routines -*- coding: utf-8; -*- +;;; color.el --- Color manipulation library -*- coding: utf-8; -*- ;; Copyright (C) 2010-2011 Free Software Foundation, Inc. -;; Author: Julien Danjou <julien@danjou.info> -;; Keywords: html +;; Authors: Julien Danjou <julien@danjou.info> +;; Drew Adams <drew.adams@oracle.com> +;; Keywords: lisp, faces, color, hex, rgb, hsv, hsl, cie-lab, background ;; This file is part of GNU Emacs. @@ -22,7 +23,13 @@ ;;; Commentary: -;; This package provides color manipulation functions. +;; This package provides functions for manipulating colors, including +;; converting between color representations, computing color +;; complements, and computing CIEDE2000 color distances. +;; +;; Supported color representations include RGB (red, green, blue), HSV +;; (hue, saturation, value), HSL (hue, saturation, luminence), sRGB, +;; CIE XYZ, and CIE L*a*b* color components. ;;; Code: @@ -34,15 +41,31 @@ (unless (boundp 'float-pi) (defconst float-pi (* 4 (atan 1)) "The value of Pi (3.1415926...)."))) -(defun color-rgb->hex (red green blue) - "Return hexadecimal notation for RED GREEN BLUE color. -RED GREEN BLUE must be values between 0 and 1 inclusively." +;;;###autoload +(defun color-name-to-rgb (color &optional frame) + "Convert COLOR string to a list of normalized RGB components. +COLOR should be a color name (e.g. \"white\") or an RGB triplet +string (e.g. \"#ff12ec\"). + +Normally the return value is a list of three floating-point +numbers, (RED GREEN BLUE), each between 0.0 and 1.0 inclusive. + +Optional arg FRAME specifies the frame where the color is to be +displayed. If FRAME is omitted or nil, use the selected frame. +If FRAME cannot display COLOR, return nil." + (mapcar (lambda (x) (/ x 65535.0)) (color-values color frame))) + +(defun color-rgb-to-hex (red green blue) + "Return hexadecimal notation for the color RED GREEN BLUE. +RED GREEN BLUE must be numbers between 0.0 and 1.0 inclusive." (format "#%02x%02x%02x" (* red 255) (* green 255) (* blue 255))) -(defun color-complement (color) - "Return the color that is the complement of COLOR." - (let ((color (color-rgb->normalize color))) +(defun color-complement (color-name) + "Return the color that is the complement of COLOR-NAME. +COLOR-NAME should be a string naming a color (e.g. \"white\"), or +a string specifying a color's RGB components (e.g. \"#ff12ec\")." + (let ((color (color-name-to-rgb color-name))) (list (- 1.0 (car color)) (- 1.0 (cadr color)) (- 1.0 (caddr color))))) @@ -52,50 +75,62 @@ RED GREEN BLUE must be values between 0 and 1 inclusively." The color list builds a color gradient starting at color START to color STOP. It does not include the START and STOP color in the resulting list." - (loop for i from 1 to step-number - with red-step = (/ (- (car stop) (car start)) (1+ step-number)) - with green-step = (/ (- (cadr stop) (cadr start)) (1+ step-number)) - with blue-step = (/ (- (caddr stop) (caddr start)) (1+ step-number)) - collect (list - (+ (car start) (* i red-step)) - (+ (cadr start) (* i green-step)) - (+ (caddr start) (* i blue-step))))) + (let* ((r (nth 0 start)) + (g (nth 1 start)) + (b (nth 2 start)) + (r-step (/ (- (nth 0 stop) r) (1+ step-number))) + (g-step (/ (- (nth 1 stop) g) (1+ step-number))) + (b-step (/ (- (nth 2 stop) b) (1+ step-number))) + result) + (dotimes (n step-number) + (push (list (setq r (+ r r-step)) + (setq g (+ g g-step)) + (setq b (+ b b-step))) + result)) + (nreverse result))) (defun color-complement-hex (color) "Return the color that is the complement of COLOR, in hexadecimal format." - (apply 'color-rgb->hex (color-complement color))) + (apply 'color-rgb-to-hex (color-complement color))) -(defun color-rgb->hsv (red green blue) - "Convert RED GREEN BLUE values to HSV representation. -Hue is in radians. Saturation and values are between 0 and 1 -inclusively." - (let* ((r (float red)) +(defun color-rgb-to-hsv (red green blue) + "Convert RED, GREEN, and BLUE color components to HSV. +RED, GREEN, and BLUE should each be numbers between 0.0 and 1.0, +inclusive. Return a list (HUE, SATURATION, VALUE), where HUE is +in radians and both SATURATION and VALUE are between 0.0 and 1.0, +inclusive." + (let* ((r (float red)) (g (float green)) (b (float blue)) (max (max r g b)) (min (min r g b))) - (list - (/ (* 2 float-pi - (cond ((and (= r g) (= g b)) 0) - ((and (= r max) - (>= g b)) - (* 60 (/ (- g b) (- max min)))) - ((and (= r max) - (< g b)) - (+ 360 (* 60 (/ (- g b) (- max min))))) - ((= max g) - (+ 120 (* 60 (/ (- b r) (- max min))))) - ((= max b) - (+ 240 (* 60 (/ (- r g) (- max min))))))) - 360) - (if (= max 0) - 0 - (- 1 (/ min max))) - (/ max 255.0)))) - -(defun color-rgb->hsl (red green blue) + (if (< (- max min) 1e-8) + (list 0.0 0.0 0.0) + (list + (/ (* 2 float-pi + (cond ((and (= r g) (= g b)) 0) + ((and (= r max) + (>= g b)) + (* 60 (/ (- g b) (- max min)))) + ((and (= r max) + (< g b)) + (+ 360 (* 60 (/ (- g b) (- max min))))) + ((= max g) + (+ 120 (* 60 (/ (- b r) (- max min))))) + ((= max b) + (+ 240 (* 60 (/ (- r g) (- max min))))))) + 360) + (if (= max 0) 0 (- 1 (/ min max))) + (/ max 255.0))))) + +(defun color-rgb-to-hsl (red green blue) "Convert RED GREEN BLUE colors to their HSL representation. -RED, GREEN and BLUE must be between 0 and 1 inclusively." +RED, GREEN, and BLUE should each be numbers between 0.0 and 1.0, +inclusive. + +Return a list (HUE, SATURATION, LUMINENCE), where HUE is in radians +and both SATURATION and LUMINENCE are between 0.0 and 1.0, +inclusive." (let* ((r red) (g green) (b blue) @@ -104,13 +139,13 @@ RED, GREEN and BLUE must be between 0 and 1 inclusively." (delta (- max min)) (l (/ (+ max min) 2.0))) (list - (if (= max min) + (if (< (- max min) 1e-8) 0 (* 2 float-pi (/ (cond ((= max r) (+ (/ (- g b) delta) (if (< g b) 6 0))) ((= max g) - (+ (/ (- b r) delta) 2)) + (+ (/ (- b r) delta) 2)) (t (+ (/ (- r g) delta) 4))) 6))) @@ -121,9 +156,9 @@ RED, GREEN and BLUE must be between 0 and 1 inclusively." (/ delta (+ max min)))) l))) -(defun color-srgb->xyz (red green blue) - "Converts RED GREEN BLUE colors from the sRGB color space to CIE XYZ. -RED, BLUE and GREEN must be between 0 and 1 inclusively." +(defun color-srgb-to-xyz (red green blue) + "Convert RED GREEN BLUE colors from the sRGB color space to CIE XYZ. +RED, BLUE and GREEN must be between 0 and 1, inclusive." (let ((r (if (<= red 0.04045) (/ red 12.95) (expt (/ (+ red 0.055) 1.055) 2.4))) @@ -137,8 +172,8 @@ RED, BLUE and GREEN must be between 0 and 1 inclusively." (+ (* 0.21266729 r) (* 0.7151522 g) (* 0.0721750 b)) (+ (* 0.0193339 r) (* 0.1191920 g) (* 0.9503041 b))))) -(defun color-xyz->srgb (X Y Z) - "Converts CIE X Y Z colors to sRGB color space." +(defun color-xyz-to-srgb (X Y Z) + "Convert CIE X Y Z colors to sRGB color space." (let ((r (+ (* 3.2404542 X) (* -1.5371385 Y) (* -0.4985314 Z))) (g (+ (* -0.9692660 X) (* 1.8760108 Y) (* 0.0415560 Z))) (b (+ (* 0.0556434 X) (* -0.2040259 Y) (* 1.0572252 Z)))) @@ -158,10 +193,10 @@ RED, BLUE and GREEN must be between 0 and 1 inclusively." (defconst color-cie-ε (/ 216 24389.0)) (defconst color-cie-κ (/ 24389 27.0)) -(defun color-xyz->lab (X Y Z &optional white-point) - "Converts CIE XYZ to CIE L*a*b*. -WHITE-POINT can be specified as (X Y Z) white point to use. If -none is set, `color-d65-xyz' is used." +(defun color-xyz-to-lab (X Y Z &optional white-point) + "Convert CIE XYZ to CIE L*a*b*. +WHITE-POINT specifies the (X Y Z) white point for the +conversion. If omitted or nil, use `color-d65-xyz'." (destructuring-bind (Xr Yr Zr) (or white-point color-d65-xyz) (let* ((xr (/ X Xr)) (yr (/ Y Yr)) @@ -180,10 +215,10 @@ none is set, `color-d65-xyz' is used." (* 500 (- fx fy)) ; a (* 200 (- fy fz)))))) ; b -(defun color-lab->xyz (L a b &optional white-point) - "Converts CIE L*a*b* to CIE XYZ. -WHITE-POINT can be specified as (X Y Z) white point to use. If -none is set, `color-d65-xyz' is used." +(defun color-lab-to-xyz (L a b &optional white-point) + "Convert CIE L*a*b* to CIE XYZ. +WHITE-POINT specifies the (X Y Z) white point for the +conversion. If omitted or nil, use `color-d65-xyz'." (destructuring-bind (Xr Yr Zr) (or white-point color-d65-xyz) (let* ((fy (/ (+ L 16) 116.0)) (fz (- fy (/ b 200.0))) @@ -201,21 +236,18 @@ none is set, `color-d65-xyz' is used." (* yr Yr) ; Y (* zr Zr))))) ; Z -(defun color-srgb->lab (red green blue) - "Converts RGB to CIE L*a*b*." - (apply 'color-xyz->lab (color-srgb->xyz red green blue))) - -(defun color-rgb->normalize (color) - "Normalize a RGB color to values between 0 and 1 inclusively." - (mapcar (lambda (x) (/ x 65535.0)) (x-color-values color))) +(defun color-srgb-to-lab (red green blue) + "Convert RGB to CIE L*a*b*." + (apply 'color-xyz-to-lab (color-srgb-to-xyz red green blue))) -(defun color-lab->srgb (L a b) - "Converts CIE L*a*b* to RGB." - (apply 'color-xyz->srgb (color-lab->xyz L a b))) +(defun color-lab-to-srgb (L a b) + "Convert CIE L*a*b* to RGB." + (apply 'color-xyz-to-srgb (color-lab-to-xyz L a b))) (defun color-cie-de2000 (color1 color2 &optional kL kC kH) - "Computes the CIEDE2000 color distance between COLOR1 and COLOR2. -Colors must be in CIE L*a*b* format." + "Return the CIEDE2000 color distance between COLOR1 and COLOR2. +Both COLOR1 and COLOR2 should be in CIE L*a*b* format, as +returned by `color-srgb-to-lab' or `color-xyz-to-lab'." (destructuring-bind (Lâ‚ aâ‚ bâ‚) color1 (destructuring-bind (Lâ‚‚ aâ‚‚ bâ‚‚) color2 (let* ((kL (or kL 1)) diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index 6f33831eb38..986c9edfd2d 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -509,18 +509,22 @@ to the end of the list of defaults just after the default value." ;; This is an extra function so that you can redefine it, e.g., to use gmhist. (defun dired-read-shell-command (prompt arg files) - "Read a dired shell command prompting with PROMPT (using `read-shell-command'). -ARG is the prefix arg and may be used to indicate in the prompt which -FILES are affected." + "Read a dired shell command prompting with PROMPT. +Passes the prefix argument ARG to `dired-mark-prompt', so that it +can be used in the prompt to indicate which FILES are affected. +Normally reads the command with `read-shell-command', but if the +`dired-x' packages is loaded, uses `dired-guess-shell-command' to offer +a smarter default choice of shell command." (minibuffer-with-setup-hook (lambda () (set (make-local-variable 'minibuffer-default-add-function) 'minibuffer-default-add-dired-shell-commands)) - (dired-mark-pop-up - nil 'shell files - #'read-shell-command - (format prompt (dired-mark-prompt arg files)) - nil nil))) + (setq prompt (format prompt (dired-mark-prompt arg files))) + (if (featurep 'dired-x) + (dired-mark-pop-up nil 'shell files + #'dired-guess-shell-command prompt files) + (dired-mark-pop-up nil 'shell files + #'read-shell-command prompt nil nil)))) ;;;###autoload (defun dired-do-async-shell-command (command &optional arg file-list) @@ -1039,92 +1043,124 @@ See Info node `(emacs)Subdir switches' for more details." (file-name-directory filename) (file-name-nondirectory filename) (function dired-add-entry) filename marker-char)) +(defvar dired-omit-mode) +(declare-function dired-omit-regexp "dired-x" ()) +(defvar dired-omit-localp) + (defun dired-add-entry (filename &optional marker-char relative) - ;; Add a new entry for FILENAME, optionally marking it - ;; with MARKER-CHAR (a character, else dired-marker-char is used). - ;; Note that this adds the entry `out of order' if files sorted by - ;; time, etc. - ;; At least this version inserts in the right subdirectory (if present). - ;; And it skips "." or ".." (see `dired-trivial-filenames'). - ;; Hidden subdirs are exposed if a file is added there. - (setq filename (directory-file-name filename)) - ;; Entry is always for files, even if they happen to also be directories - (let* ((opoint (point)) - (cur-dir (dired-current-directory)) - (orig-file-name filename) - (directory (if relative cur-dir (file-name-directory filename))) - reason) - (setq filename - (if relative - (file-relative-name filename directory) - (file-name-nondirectory filename)) - reason - (catch 'not-found - (if (string= directory cur-dir) - (progn - (skip-chars-forward "^\r\n") - (if (eq (following-char) ?\r) - (dired-unhide-subdir)) - ;; We are already where we should be, except when - ;; point is before the subdir line or its total line. - (let ((p (dired-after-subdir-garbage cur-dir))) - (if (< (point) p) - (goto-char p)))) - ;; else try to find correct place to insert - (if (dired-goto-subdir directory) - (progn ;; unhide if necessary - (if (looking-at "\r") ;; point is at end of subdir line - (dired-unhide-subdir)) - ;; found - skip subdir and `total' line - ;; and uninteresting files like . and .. - ;; This better not moves into the next subdir! - (dired-goto-next-nontrivial-file)) - ;; not found - (throw 'not-found "Subdir not found"))) - (let (buffer-read-only opoint) - (beginning-of-line) - (setq opoint (point)) - ;; Don't expand `.'. Show just the file name within directory. - (let ((default-directory directory)) - (dired-insert-directory directory - (concat dired-actual-switches " -d") - (list filename))) - (goto-char opoint) - ;; Put in desired marker char. - (when marker-char - (let ((dired-marker-char - (if (integerp marker-char) marker-char dired-marker-char))) - (dired-mark nil))) - ;; Compensate for a bug in ange-ftp. - ;; It inserts the file's absolute name, rather than - ;; the relative one. That may be hard to fix since it - ;; is probably controlled by something in ftp. - (goto-char opoint) - (let ((inserted-name (dired-get-filename 'verbatim))) - (if (file-name-directory inserted-name) - (let (props) - (end-of-line) - (forward-char (- (length inserted-name))) - (setq props (text-properties-at (point))) - (delete-char (length inserted-name)) - (let ((pt (point))) - (insert filename) - (set-text-properties pt (point) props)) - (forward-char 1)) - (forward-line 1))) - (forward-line -1) - (if dired-after-readin-hook ;; the subdir-alist is not affected... - (save-excursion ;; ...so we can run it right now: - (save-restriction - (beginning-of-line) - (narrow-to-region (point) (line-beginning-position 2)) - (run-hooks 'dired-after-readin-hook)))) - (dired-move-to-filename)) - ;; return nil if all went well - nil)) - (if reason ; don't move away on failure - (goto-char opoint)) - (not reason))) ; return t on success, nil else + "Add a new dired entry for FILENAME. +Optionally mark it with MARKER-CHAR (a character, else uses +`dired-marker-char'). Note that this adds the entry `out of order' +if files are sorted by time, etc. +Skips files that match `dired-trivial-filenames'. +Exposes hidden subdirectories if a file is added there. + +If `dired-x' is loaded and `dired-omit-mode' is enabled, skips +files matching `dired-omit-regexp'." + (if (or (not (featurep 'dired-x)) + (not dired-omit-mode) + ;; Avoid calling ls for files that are going to be omitted anyway. + (let ((omit-re (dired-omit-regexp))) + (or (string= omit-re "") + (not (string-match omit-re + (cond + ((eq 'no-dir dired-omit-localp) + filename) + ((eq t dired-omit-localp) + (dired-make-relative filename)) + (t + (dired-make-absolute + filename + (file-name-directory filename))))))))) + ;; Do it! + (progn + (setq filename (directory-file-name filename)) + ;; Entry is always for files, even if they happen to also be directories + (let* ((opoint (point)) + (cur-dir (dired-current-directory)) + (orig-file-name filename) + (directory (if relative cur-dir (file-name-directory filename))) + reason) + (setq filename + (if relative + (file-relative-name filename directory) + (file-name-nondirectory filename)) + reason + (catch 'not-found + (if (string= directory cur-dir) + (progn + (skip-chars-forward "^\r\n") + (if (eq (following-char) ?\r) + (dired-unhide-subdir)) + ;; We are already where we should be, except when + ;; point is before the subdir line or its total line. + (let ((p (dired-after-subdir-garbage cur-dir))) + (if (< (point) p) + (goto-char p)))) + ;; else try to find correct place to insert + (if (dired-goto-subdir directory) + (progn ;; unhide if necessary + (if (looking-at "\r") + ;; Point is at end of subdir line. + (dired-unhide-subdir)) + ;; found - skip subdir and `total' line + ;; and uninteresting files like . and .. + ;; This better not move into the next subdir! + (dired-goto-next-nontrivial-file)) + ;; not found + (throw 'not-found "Subdir not found"))) + (let (buffer-read-only opoint) + (beginning-of-line) + (setq opoint (point)) + ;; Don't expand `.'. + ;; Show just the file name within directory. + (let ((default-directory directory)) + (dired-insert-directory + directory + (concat dired-actual-switches " -d") + (list filename))) + (goto-char opoint) + ;; Put in desired marker char. + (when marker-char + (let ((dired-marker-char + (if (integerp marker-char) marker-char + dired-marker-char))) + (dired-mark nil))) + ;; Compensate for a bug in ange-ftp. + ;; It inserts the file's absolute name, rather than + ;; the relative one. That may be hard to fix since it + ;; is probably controlled by something in ftp. + (goto-char opoint) + (let ((inserted-name (dired-get-filename 'verbatim))) + (if (file-name-directory inserted-name) + (let (props) + (end-of-line) + (forward-char (- (length inserted-name))) + (setq props (text-properties-at (point))) + (delete-char (length inserted-name)) + (let ((pt (point))) + (insert filename) + (set-text-properties pt (point) props)) + (forward-char 1)) + (forward-line 1))) + (forward-line -1) + (if dired-after-readin-hook + ;; The subdir-alist is not affected... + (save-excursion ; ...so we can run it right now: + (save-restriction + (beginning-of-line) + (narrow-to-region (point) + (line-beginning-position 2)) + (run-hooks 'dired-after-readin-hook)))) + (dired-move-to-filename)) + ;; return nil if all went well + nil)) + (if reason ; don't move away on failure + (goto-char opoint)) + (not reason))) ; return t on success, nil else + ;; Don't do it (dired-omit-mode). + ;; Return t for success (perhaps we should return file-exists-p). + t)) (defun dired-after-subdir-garbage (dir) ;; Return pos of first file line of DIR, skipping header and total @@ -1383,6 +1419,10 @@ ESC or `q' to not overwrite any of the remaining files, (cond ((integerp marker-char) marker-char) (marker-char (dired-file-marker from)) ; slow (t nil)))) + (when (and (file-directory-p from) + (file-directory-p to) + (eq file-creator 'dired-copy-file)) + (setq to (file-name-directory to))) (condition-case err (progn (funcall file-creator from to dired-overwrite-confirmed) diff --git a/lisp/dired-x.el b/lisp/dired-x.el index e0caae059b4..8b1dbb1ef83 100644 --- a/lisp/dired-x.el +++ b/lisp/dired-x.el @@ -25,91 +25,38 @@ ;;; Commentary: -;; This is Sebastian Kremer's excellent dired-x.el (Dired Extra), version -;; 1.191, hacked up for GNU Emacs. Redundant or conflicting material has -;; been removed or renamed in order to work properly with dired of GNU -;; Emacs. All suggestions or comments are most welcomed. +;; This is based on Sebastian Kremer's excellent dired-x.el (Dired Extra), +;; version 1.191, adapted for GNU Emacs. See the `dired-x' info pages. -;; -;; Please, PLEASE, *PLEASE* see the info pages. -;; - -;; BUGS: Type M-x dired-x-submit-report and a report will be generated. - -;; INSTALLATION: In your ~/.emacs, +;; USAGE: In your ~/.emacs, ;; ;; (add-hook 'dired-load-hook -;; (function (lambda () +;; (lambda () ;; (load "dired-x") ;; ;; Set global variables here. For example: ;; ;; (setq dired-guess-shell-gnutar "gtar") -;; ))) +;; )) ;; (add-hook 'dired-mode-hook -;; (function (lambda () +;; (lambda () ;; ;; Set buffer-local variables here. For example: ;; ;; (dired-omit-mode 1) -;; ))) +;; )) ;; -;; At load time dired-x.el will install itself, redefine some functions, and -;; bind some dired keys. *Please* see the info pages for more details. +;; At load time dired-x.el will install itself and bind some dired keys. +;; Some dired.el and dired-aux.el functions have extra features if +;; dired-x is loaded. -;; *Please* see the info pages for more details. +;; User customization: M-x customize-group RET dired-x RET. -;; User defined variables: -;; -;; dired-bind-vm -;; dired-vm-read-only-folders -;; dired-bind-jump -;; dired-bind-info -;; dired-bind-man -;; dired-x-hands-off-my-keys -;; dired-find-subdir -;; dired-enable-local-variables -;; dired-local-variables-file -;; dired-guess-shell-gnutar -;; dired-guess-shell-gzip-quiet -;; dired-guess-shell-znew-switches -;; dired-guess-shell-alist-user -;; dired-clean-up-buffers-too -;; dired-omit-mode -;; dired-omit-files -;; dired-omit-extensions -;; dired-omit-size-limit -;; -;; To find out more about these variables, load this file, put your cursor at -;; the end of any of the variable names, and hit C-h v [RET]. *Please* see -;; the info pages for more details. - -;; When loaded this code redefines the following functions of GNU Emacs -;; -;; Function Found in this file of GNU Emacs -;; -------- ------------------------------- -;; dired-clean-up-after-deletion ../lisp/dired.el -;; dired-find-buffer-nocreate ../lisp/dired.el -;; dired-initial-position ../lisp/dired.el -;; -;; dired-add-entry ../lisp/dired-aux.el -;; dired-read-shell-command ../lisp/dired-aux.el +;; *Please* see the `dired-x' info pages for more details. ;;; Code: -;; LOAD. - -;; This is a no-op if dired-x is being loaded via `dired-load-hook'. It is -;; here in case the user has autoloaded dired-x via the dired-jump key binding -;; (instead of autoloading to dired as is suggested in the info-pages). - +;; This is a no-op if dired-x is being loaded via `dired-load-hook', +;; but maybe not if a dired-x function is being autoloaded. (require 'dired) -;; We will redefine some functions and also need some macros so we need to -;; load dired stuff of GNU Emacs. - -(require 'dired-aux) - -(defvar vm-folder-directory) -(eval-when-compile (require 'man)) - ;;; User-defined variables. (defgroup dired-x nil @@ -123,7 +70,6 @@ (defcustom dired-bind-vm nil "Non-nil means \"V\" runs `dired-vm', otherwise \"V\" runs `dired-rmail'. - RMAIL files in the old Babyl format (used before before Emacs 23.1) contain \"-*- rmail -*-\" at the top, so `dired-find-file' will run `rmail' on these files. New RMAIL files use the standard @@ -132,26 +78,49 @@ mbox format, and so cannot be distinguished in this way." :group 'dired-keys) (defcustom dired-bind-jump t - "Non-nil means bind `dired-jump' to C-x C-j, otherwise do not." + "Non-nil means bind `dired-jump' to C-x C-j, otherwise do not. +Setting this variable directly after dired-x is loaded has no effect - +use \\[customize]." :type 'boolean + :set (lambda (sym val) + (if (set sym val) + (progn + (define-key global-map "\C-x\C-j" 'dired-jump) + (define-key global-map "\C-x4\C-j" 'dired-jump-other-window)) + (if (eq 'dired-jump (lookup-key global-map "\C-x\C-j")) + (define-key global-map "\C-x\C-j" nil)) + (if (eq 'dired-jump-other-window (lookup-key global-map "\C-x4\C-j")) + (define-key global-map "\C-x4\C-j" nil)))) :group 'dired-keys) (defcustom dired-bind-man t - "Non-nil means bind `dired-man' to \"N\" in dired-mode, otherwise do not." + "Non-nil means bind `dired-man' to \"N\" in dired-mode, otherwise do not. +Setting this variable directly after dired-x is loaded has no effect - +use \\[customize]." :type 'boolean + :set (lambda (sym val) + (if (set sym val) + (define-key dired-mode-map "N" 'dired-man) + (if (eq 'dired-man (lookup-key dired-mode-map "N")) + (define-key dired-mode-map "N" nil)))) :group 'dired-keys) (defcustom dired-bind-info t - "Non-nil means bind `dired-info' to \"I\" in dired-mode, otherwise do not." + "Non-nil means bind `dired-info' to \"I\" in dired-mode, otherwise do not. +Setting this variable directly after dired-x is loaded has no effect - +use \\[customize]." :type 'boolean + :set (lambda (sym val) + (if (set sym val) + (define-key dired-mode-map "I" 'dired-info) + (if (eq 'dired-info (lookup-key dired-mode-map "I")) + (define-key dired-mode-map "I" nil)))) :group 'dired-keys) (defcustom dired-vm-read-only-folders nil "If non-nil, \\[dired-vm] will visit all folders read-only. If neither nil nor t, e.g. the symbol `if-file-read-only', only -files not writable by you are visited read-only. - -Read-only folders only work in VM 5, not in VM 4." +files not writable by you are visited read-only." :type '(choice (const :tag "off" nil) (const :tag "on" t) (other :tag "non-writable only" if-file-read-only)) @@ -225,13 +194,20 @@ listing a directory. See also `dired-local-variables-file'." :type 'boolean :group 'dired-x) -(defcustom dired-guess-shell-gnutar (when (or (eq system-type 'gnu) - (eq system-type 'gnu/linux)) - "tar") +(defcustom dired-guess-shell-gnutar + (catch 'found + (dolist (exe '("tar" "gtar")) + (if (with-temp-buffer + (ignore-errors (call-process exe nil t nil "--version")) + (and (re-search-backward "GNU tar" nil t) t)) + (throw 'found exe)))) "If non-nil, name of GNU tar executable. \(E.g., \"tar\" or \"gtar\"). The `z' switch will be used with it for compressed or gzip'ed tar files. If you don't have GNU tar, set this to nil: a pipe using `zcat' or `gunzip -c' will be used." + ;; Changed from system-type test to testing --version output. + ;; Maybe test --help for -z instead? + :version "24.1" :type '(choice (const :tag "Not GNU tar" nil) (string :tag "Command name")) :group 'dired-x) @@ -260,90 +236,52 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used." (define-key dired-mode-map "*(" 'dired-mark-sexp) (define-key dired-mode-map "*." 'dired-mark-extension) (define-key dired-mode-map "\M-!" 'dired-smart-shell-command) -(define-key dired-mode-map "w" 'dired-copy-filename-as-kill) (define-key dired-mode-map "\M-G" 'dired-goto-subdir) (define-key dired-mode-map "F" 'dired-do-find-marked-files) (define-key dired-mode-map "Y" 'dired-do-relsymlink) (define-key dired-mode-map "%Y" 'dired-do-relsymlink-regexp) (define-key dired-mode-map "V" 'dired-do-run-mail) -(if dired-bind-man - (define-key dired-mode-map "N" 'dired-man)) - -(if dired-bind-info - (define-key dired-mode-map "I" 'dired-info)) - ;;; MENU BINDINGS -(let ((menu-bar (lookup-key dired-mode-map [menu-bar]))) - (let ((menu (lookup-key menu-bar [operate]))) - (define-key-after - menu - [find-files] - '(menu-item - "Find files" - dired-do-find-marked-files - :help "Find current or marked files") - 'delete) - (define-key-after - menu - [relsymlink] - '(menu-item - "Relative symlink to..." - dired-do-relsymlink - :visible (fboundp 'make-symbolic-link) - :help "Make relative symbolic links for current or marked files") - 'symlink)) - (let ((menu (lookup-key menu-bar [mark]))) - (define-key-after - menu - [flag-extension] - '(menu-item - "Flag extension..." - dired-flag-extension - :help "Flag files with a certain extension for deletion") - 'garbage-files) - (define-key-after - menu - [mark-extension] - '(menu-item - "Mark extension..." - dired-mark-extension - :help "Mark files with a certain extension") - 'symlinks) - (define-key-after - menu - [mark-omitted] - '(menu-item - "Mark omitted" - dired-mark-omitted - :help "Mark files matching `dired-omit-files' and `dired-omit-extensions'") - 'mark-extension)) - (let ((menu (lookup-key menu-bar [regexp]))) - (define-key-after - menu - [relsymlink-regexp] - '(menu-item - "Relative symlink..." - dired-do-relsymlink-regexp - :visible (fboundp 'make-symbolic-link) - :help "Make relative symbolic links for files matching regexp") - 'symlink)) - (let ((menu (lookup-key menu-bar [immediate]))) - (define-key-after - menu - [omit-mode] - '(menu-item - "Omit mode" dired-omit-mode - :button (:toggle . dired-omit-mode) - :help "Enable or disable omitting \"uninteresting\" files") - 'dashes))) - -;;; GLOBAL BINDING. -(if dired-bind-jump - (progn - (define-key global-map "\C-x\C-j" 'dired-jump) - (define-key global-map "\C-x4\C-j" 'dired-jump-other-window))) +(require 'easymenu) + +(let ((menu (lookup-key dired-mode-map [menu-bar]))) + (easy-menu-add-item menu '("Operate") + ["Find Files" dired-do-find-marked-files + :help "Find current or marked files"] + "Shell Command...") + (easy-menu-add-item menu '("Operate") + ["Relative Symlink to..." dired-do-relsymlink + :visible (fboundp 'make-symbolic-link) + :help "Make relative symbolic links for current or \ +marked files"] + "Hardlink to...") + (easy-menu-add-item menu '("Mark") + ["Flag Extension..." dired-flag-extension + :help "Flag files with a certain extension for deletion"] + "Mark Executables") + (easy-menu-add-item menu '("Mark") + ["Mark Extension..." dired-mark-extension + :help "Mark files with a certain extension"] + "Unmark All") + (easy-menu-add-item menu '("Mark") + ["Mark Omitted" dired-mark-omitted + :help "Mark files matching `dired-omit-files' \ +and `dired-omit-extensions'"] + "Unmark All") + (easy-menu-add-item menu '("Regexp") + ["Relative Symlink..." dired-do-relsymlink-regexp + :visible (fboundp 'make-symbolic-link) + :help "Make relative symbolic links for files \ +matching regexp"] + "Hardlink...") + (easy-menu-add-item menu '("Immediate") + ["Omit Mode" dired-omit-mode + :style toggle :selected dired-omit-mode + :help "Enable or disable omitting \"uninteresting\" \ +files"] + "Refresh")) ;; Install into appropriate hooks. @@ -360,31 +298,9 @@ to nil: a pipe using `zcat' or `gunzip -c' will be used." \\[dired-do-find-marked-files]\t-- visit all marked files simultaneously \\[dired-omit-mode]\t-- toggle omitting of files \\[dired-mark-sexp]\t-- mark by Lisp expression - \\[dired-copy-filename-as-kill]\t-- copy the file or subdir names into the kill ring; - \t you can feed it to other commands using \\[yank] - -For more features, see variables - - `dired-bind-vm' - `dired-bind-jump' - `dired-bind-info' - `dired-bind-man' - `dired-vm-read-only-folders' - `dired-omit-mode' - `dired-omit-files' - `dired-omit-extensions' - `dired-omit-size-limit' - `dired-find-subdir' - `dired-enable-local-variables' - `dired-local-variables-file' - `dired-guess-shell-gnutar' - `dired-guess-shell-gzip-quiet' - `dired-guess-shell-znew-switches' - `dired-guess-shell-alist-user' - `dired-clean-up-buffers-too' - -See also functions +To see the options you can set, use M-x customize-group RET dired-x RET. +See also the functions: `dired-flag-extension' `dired-virtual' `dired-jump' @@ -394,45 +310,11 @@ See also functions `dired-info' `dired-do-find-marked-files'" (interactive) - ;; These must be done in each new dired buffer. (dired-hack-local-variables) (dired-omit-startup)) -;;; BUFFER CLEANING. - -;; REDEFINE. -(defun dired-clean-up-after-deletion (fn) - "Clean up after a deleted file or directory FN. -Remove expanded subdir of deleted dir, if any." - (save-excursion (and (cdr dired-subdir-alist) - (dired-goto-subdir fn) - (dired-kill-subdir))) - - ;; Offer to kill buffer of deleted file FN. - (if dired-clean-up-buffers-too - (progn - (let ((buf (get-file-buffer fn))) - (and buf - (funcall (function y-or-n-p) - (format "Kill buffer of %s, too? " - (file-name-nondirectory fn))) - (save-excursion ; you never know where kill-buffer leaves you - (kill-buffer buf)))) - (let ((buf-list (dired-buffers-for-dir (expand-file-name fn))) - (buf nil)) - (and buf-list - (y-or-n-p (format "Kill dired buffer%s of %s, too? " - (dired-plural-s (length buf-list)) - (file-name-nondirectory fn))) - (while buf-list - (save-excursion (kill-buffer (car buf-list))) - (setq buf-list (cdr buf-list))))))) - ;; Anything else? - ) - - ;;; EXTENSION MARKING FUNCTIONS. ;; Mark files with some extension. @@ -530,11 +412,10 @@ move to its line in dired." (progn (setq dir (dired-current-directory)) (dired-up-directory other-window) - (or (dired-goto-file dir) + (unless (dired-goto-file dir) ;; refresh and try again - (progn - (dired-insert-subdir (file-name-directory dir)) - (dired-goto-file dir)))) + (dired-insert-subdir (file-name-directory dir)) + (dired-goto-file dir))) (if other-window (dired-other-window dir) (dired dir)) @@ -545,10 +426,9 @@ move to its line in dired." (dired-insert-subdir (file-name-directory file)) (dired-goto-file file)) ;; Toggle omitting, if it is on, and try again. - (if dired-omit-mode - (progn - (dired-omit-mode) - (dired-goto-file file)))))))) + (when dired-omit-mode + (dired-omit-mode) + (dired-goto-file file))))))) (defun dired-jump-other-window (&optional file-name) "Like \\[dired-jump] (`dired-jump') but in other window." @@ -589,7 +469,7 @@ Should never be used as marker by the user or other packages.") (let ((dired-omit-mode nil)) (revert-buffer)) ;; Show omitted files (dired-mark-unmarked-files (dired-omit-regexp) nil nil dired-omit-localp)) -(defvar dired-omit-extensions +(defcustom dired-omit-extensions (append completion-ignored-extensions dired-latex-unclean-extensions dired-bibtex-unclean-extensions @@ -600,7 +480,9 @@ Defaults to elements of `completion-ignored-extensions', `dired-texinfo-unclean-extensions'. See interactive function `dired-omit-mode' \(\\[dired-omit-mode]\) and -variables `dired-omit-mode' and `dired-omit-files'.") +variables `dired-omit-mode' and `dired-omit-files'." + :type '(repeat string) + :group 'dired-x) (defun dired-omit-expunge (&optional regexp) "Erases all unmarked files matching REGEXP. @@ -672,45 +554,6 @@ Optional fourth argument LOCALP is as in `dired-get-filename'." (and fn (string-match regexp fn)))) msg))) -;; Compiler does not get fset. -(declare-function dired-omit-old-add-entry "dired-x") - -;; REDEFINE. -;; Redefine dired-aux.el's version of `dired-add-entry' -;; Save old defun if not already done: -(or (fboundp 'dired-omit-old-add-entry) - (fset 'dired-omit-old-add-entry (symbol-function 'dired-add-entry))) - -;; REDEFINE. -(defun dired-omit-new-add-entry (filename &optional marker-char relative) - ;; This redefines dired-aux.el's dired-add-entry to avoid calling ls for - ;; files that are going to be omitted anyway. - (if dired-omit-mode - ;; perhaps return t without calling ls - (let ((omit-re (dired-omit-regexp))) - (if (or (string= omit-re "") - (not - (string-match omit-re - (cond - ((eq 'no-dir dired-omit-localp) - filename) - ((eq t dired-omit-localp) - (dired-make-relative filename)) - (t - (dired-make-absolute - filename - (file-name-directory filename))))))) - ;; if it didn't match, go ahead and add the entry - (dired-omit-old-add-entry filename marker-char relative) - ;; dired-add-entry returns t for success, perhaps we should - ;; return file-exists-p - t)) - ;; omitting is not turned on at all - (dired-omit-old-add-entry filename marker-char relative))) - -;; Redefine it. -(fset 'dired-add-entry 'dired-omit-new-add-entry) - ;;; VIRTUAL DIRED MODE. @@ -763,7 +606,7 @@ you can relist single subdirs using \\[dired-do-redisplay]." (forward-line 1) (and (looking-at "^ wildcard ") (buffer-substring (match-end 0) - (progn (end-of-line) (point))))))) + (line-end-position)))))) (if wildcard (setq dirname (expand-file-name wildcard default-directory)))) ;; If raw ls listing (not a saved old dired buffer), give it a @@ -845,9 +688,12 @@ Also useful for `auto-mode-alist' like this: ;; mechanism is provided for special handling of the working directory in ;; special major modes. +(define-obsolete-variable-alias 'default-directory-alist + 'dired-default-directory-alist "24.1") + ;; It's easier to add to this alist than redefine function ;; default-directory while keeping the old information. -(defconst default-directory-alist +(defconst dired-default-directory-alist '((dired-mode . (if (fboundp 'dired-current-directory) (dired-current-directory) default-directory))) @@ -857,8 +703,8 @@ nil is ignored in favor of `default-directory'.") (defun dired-default-directory () "Usage like variable `default-directory'. -Knows about the special cases in variable `default-directory-alist'." - (or (eval (cdr (assq major-mode default-directory-alist))) +Knows about the special cases in variable `dired-default-directory-alist'." + (or (eval (cdr (assq major-mode dired-default-directory-alist))) default-directory)) (defun dired-smart-shell-command (command &optional output-buffer error-buffer) @@ -896,35 +742,37 @@ Knows about the special cases in variable `default-directory-alist'." ;;; `dired-enable-local-variables' and run `hack-local-variables' on the ;;; Dired Buffer. -(defvar dired-local-variables-file (convert-standard-filename ".dired") +;; FIXME do standard dir-locals obsolete this? +(defcustom dired-local-variables-file (convert-standard-filename ".dired") "Filename, as string, containing local dired buffer variables to be hacked. If this file found in current directory, then it will be inserted into dired buffer and `hack-local-variables' will be run. See Info node `(emacs)File Variables' for more information on local variables. -See also `dired-enable-local-variables'.") +See also `dired-enable-local-variables'." + :type 'file + :group 'dired) (defun dired-hack-local-variables () "Evaluate local variables in `dired-local-variables-file' for dired buffer." - (if (and dired-local-variables-file - (stringp dired-local-variables-file) - (file-exists-p dired-local-variables-file)) - (let ((opoint (point-max)) - buffer-read-only - ;; In case user has `enable-local-variables' set to nil we - ;; override it locally with dired's variable. - (enable-local-variables dired-enable-local-variables)) - ;; Insert 'em. - (save-excursion - (goto-char opoint) - (insert "\^L\n") - (insert-file-contents dired-local-variables-file)) - ;; Hack 'em. - (let ((buffer-file-name dired-local-variables-file)) - (hack-local-variables)) - ;; Make sure that the modeline shows the proper information. - (dired-sort-set-modeline) - ;; Delete this stuff: `eobp' is used to find last subdir by dired.el. - (delete-region opoint (point-max))))) + (and (stringp dired-local-variables-file) + (file-exists-p dired-local-variables-file) + (let ((opoint (point-max)) + (inhibit-read-only t) + ;; In case user has `enable-local-variables' set to nil we + ;; override it locally with dired's variable. + (enable-local-variables dired-enable-local-variables)) + ;; Insert 'em. + (save-excursion + (goto-char opoint) + (insert "\^L\n") + (insert-file-contents dired-local-variables-file)) + ;; Hack 'em. + (let ((buffer-file-name dired-local-variables-file)) + (hack-local-variables)) + ;; Make sure that the modeline shows the proper information. + (dired-sort-set-modeline) + ;; Delete this stuff: `eobp' is used to find last subdir by dired.el. + (delete-region opoint (point-max))))) (defun dired-omit-here-always () "Create `dired-local-variables-file' for omitting and reverts directory. @@ -933,14 +781,12 @@ dired." (interactive) (if (file-exists-p dired-local-variables-file) (message "File `./%s' already exists." dired-local-variables-file) - ;; Create `dired-local-variables-file'. (with-current-buffer (get-buffer-create " *dot-dired*") (erase-buffer) (insert "Local Variables:\ndired-omit-mode: t\nEnd:\n") (write-file dired-local-variables-file) - (kill-buffer (current-buffer))) - + (kill-buffer)) ;; Run extra-hooks and revert directory. (dired-extra-startup) (dired-revert))) @@ -950,10 +796,10 @@ dired." ;; Brief Description: ;;; -;; `dired-do-shell-command' is bound to `!' by dired.el. +;; * `dired-do-shell-command' is bound to `!' by dired.el. ;;; -;; * Redefine `dired-read-shell-command' so it calls -;;; `dired-guess-shell-command'. +;; * `dired-guess-shell-command' provides smarter defaults for +;;; dired-aux.el's `dired-read-shell-command'. ;;; ;; * `dired-guess-shell-command' calls `dired-guess-default' with list of ;;; marked files. @@ -980,6 +826,8 @@ dired." ;; NOTE: Use `gunzip -c' instead of `zcat' on `.gz' files. Some do not ;; install GNU zip's version of zcat. +(declare-function Man-support-local-filenames "man" ()) + (defvar dired-guess-shell-alist-default (list (list "\\.tar$" @@ -1209,10 +1057,9 @@ See `dired-guess-shell-alist-user'." ;; Return commands or nil if flist is still non-nil. ;; Evaluate the commands in order that any logical testing will be done. - (cond ((not (cdr cmds)) - (eval (car cmds))) ; single command - (t - (mapcar (function eval) cmds))))) + (if (cdr cmds) + (mapcar #'eval cmds) + (eval (car cmds))))) ; single command (defun dired-guess-shell-command (prompt files) "Ask user with PROMPT for a shell command, guessing a default from FILES." @@ -1239,23 +1086,6 @@ See `dired-guess-shell-alist-user'." ;; If we got a return, then return default. (if (equal val "") default val)))) -;; REDEFINE. -;; Redefine dired-aux.el's version: -(defun dired-read-shell-command (prompt arg files) - "Read a dired shell command prompting with PROMPT (using `read-shell-command'). -ARG is the prefix arg and may be used to indicate in the prompt which -FILES are affected. -This is an extra function so that you can redefine it." - (minibuffer-with-setup-hook - (lambda () - (set (make-local-variable 'minibuffer-default-add-function) - 'minibuffer-default-add-dired-shell-commands)) - (dired-mark-pop-up - nil 'shell files - 'dired-guess-shell-command - (format prompt (dired-mark-prompt arg files)) ; PROMPT - files))) ; FILES - ;;; RELATIVE SYMBOLIC LINKS. @@ -1282,8 +1112,7 @@ results in ;; Find common initial file name components: (let (next) (while (and (setq next (string-match "/" file1 index)) - (setq next (1+ next)) - (< next (min len1 len2)) + (< (setq next (1+ next)) (min len1 len2)) ;; For the comparison, both substrings must end in ;; `/', so NEXT is *one plus* the result of the ;; string-match. @@ -1308,14 +1137,15 @@ results in (setq count (1+ count) start (1+ start))) ;; ... and prepend a "../" for each slash found: - (while (> count 0) - (setq count (1- count) - name1 (concat "../" name1))))) + (dotimes (n count) + (setq name1 (concat "../" name1))))) (make-symbolic-link (directory-file-name name1) ; must not link to foo/ ; (trailing slash!) name2 ok-if-already-exists))) +(autoload 'dired-do-create-files "dired-aux") + ;;;###autoload (defun dired-do-relsymlink (&optional arg) "Relative symlink all marked (or next ARG) files into a directory. @@ -1330,16 +1160,19 @@ not absolute ones like For absolute symlinks, use \\[dired-do-symlink]." (interactive "P") - (dired-do-create-files 'relsymlink (function dired-make-relative-symlink) + (dired-do-create-files 'relsymlink #'dired-make-relative-symlink "RelSymLink" arg dired-keep-marker-relsymlink)) +(autoload 'dired-mark-read-regexp "dired-aux") +(autoload 'dired-do-create-files-regexp "dired-aux") + (defun dired-do-relsymlink-regexp (regexp newname &optional arg whole-name) "RelSymlink all marked files containing REGEXP to NEWNAME. See functions `dired-do-rename-regexp' and `dired-do-relsymlink' for more info." (interactive (dired-mark-read-regexp "RelSymLink")) (dired-do-create-files-regexp - (function dired-make-relative-symlink) + #'dired-make-relative-symlink "RelSymLink" arg regexp newname whole-name dired-keep-marker-relsymlink)) @@ -1379,59 +1212,48 @@ displayed this way is restricted by the height of the current window and To keep dired buffer displayed, type \\[split-window-vertically] first. To display just marked files, type \\[delete-other-windows] first." - (interactive "P") (dired-simultaneous-find-file (dired-get-marked-files) noselect)) (defun dired-simultaneous-find-file (file-list noselect) - "Visit all files in FILE-LIST and display them simultaneously. The current window is split across all files in FILE-LIST, as evenly as possible. Remaining lines go to the bottom-most window. The number of files that can be displayed this way is restricted by the height of the current window and the variable `window-min-height'. With non-nil NOSELECT the files are merely found but not selected." - ;; We don't make this function interactive because it is usually too clumsy ;; to specify FILE-LIST interactively unless via dired. - (let (size) - (if noselect ;; Do not select the buffer. (find-file-noselect (car file-list)) - ;; We will have to select the buffer. Calculate and check window size. (setq size (/ (window-height) (length file-list))) (or (<= window-min-height size) (error "Too many files to visit simultaneously. Try C-u prefix")) (find-file (car file-list))) - ;; Decrement. - (setq file-list (cdr file-list)) - - (while file-list - + (dolist (file (cdr file-list)) (if noselect ;; Do not select the buffer. - (find-file-noselect (car file-list)) - + (find-file-noselect file) ;; Vertically split off a window of desired size. Upper window will ;; have SIZE lines. Select lower (larger) window. We split it again. (select-window (split-window nil size)) - (find-file (car file-list))) - - ;; Decrement. - (setq file-list (cdr file-list))))) + (find-file file))))) ;;; MISCELLANEOUS COMMANDS. ;; Run man on files. +(declare-function Man-getpage-in-background "man" (topic)) + (defun dired-man () - "Run man on this file. Display old buffer if buffer name matches filename. -Uses `man.el' of \\[manual-entry] fame." + "Run `man' on this file." +;; Used also to say: "Display old buffer if buffer name matches filename." +;; but I have no idea what that means. (interactive) (require 'man) (let* ((file (dired-get-filename)) @@ -1443,31 +1265,27 @@ Uses `man.el' of \\[manual-entry] fame." ;; Run Info on files. (defun dired-info () - "Run info on this file." + "Run `info' on this file." (interactive) (info (dired-get-filename))) ;; Run mail on mail folders. -;; Avoid compiler warning. -(eval-when-compile - (when (not (fboundp 'vm-visit-folder)) - (defun vm-visit-folder (file &optional arg) - nil))) +(declare-function vm-visit-folder "ext:vm" (folder &optional read-only)) +(defvar vm-folder-directory) (defun dired-vm (&optional read-only) "Run VM on this file. -With prefix arg, visit folder read-only (this requires at least VM 5). -See also variable `dired-vm-read-only-folders'." +With optional prefix argument, visits the folder read-only. +Otherwise obeys the value of `dired-vm-read-only-folders'." (interactive "P") (let ((dir (dired-current-directory)) (fil (dired-get-filename))) - ;; take care to supply 2nd arg only if requested - may still run VM 4! - (cond (read-only (vm-visit-folder fil t)) - ((eq t dired-vm-read-only-folders) (vm-visit-folder fil t)) - ((null dired-vm-read-only-folders) (vm-visit-folder fil)) - (t (vm-visit-folder fil (not (file-writable-p fil))))) - ;; so that pressing `v' inside VM does prompt within current directory: + (vm-visit-folder fil (or read-only + (eq t dired-vm-read-only-folders) + (and dired-vm-read-only-folders + (not (file-writable-p fil))))) + ;; So that pressing `v' inside VM does prompt within current directory: (set (make-local-variable 'vm-folder-directory) dir))) (defun dired-rmail () @@ -1476,7 +1294,7 @@ See also variable `dired-vm-read-only-folders'." (rmail (dired-get-filename))) (defun dired-do-run-mail () - "If `dired-bind-vm' is t, then function `dired-vm', otherwise `dired-rmail'." + "If `dired-bind-vm' is non-nil, call `dired-vm', else call `dired-rmail'." (interactive) (if dired-bind-vm ;; Read mail folder using vm. @@ -1487,43 +1305,13 @@ See also variable `dired-vm-read-only-folders'." ;;; MISCELLANEOUS INTERNAL FUNCTIONS. -(declare-function dired-old-find-buffer-nocreate "dired-x") - -(or (fboundp 'dired-old-find-buffer-nocreate) - (fset 'dired-old-find-buffer-nocreate - (symbol-function 'dired-find-buffer-nocreate))) - -;; REDEFINE. -;; Redefines dired.el's version of `dired-find-buffer-nocreate' -(defun dired-find-buffer-nocreate (dirname &optional mode) - (if (and dired-find-subdir - ;; don't try to find a wildcard as a subdirectory - (string-equal dirname (file-name-directory dirname))) - (let* ((cur-buf (current-buffer)) - (buffers (nreverse - (dired-buffers-for-dir (expand-file-name dirname)))) - (cur-buf-matches (and (memq cur-buf buffers) - ;; wildcards must match, too: - (equal dired-directory dirname)))) - ;; We don't want to switch to the same buffer--- - (setq buffers (delq cur-buf buffers));;need setq with delq - (or (car (sort buffers (function dired-buffer-more-recently-used-p))) - ;; ---unless it's the only possibility: - (and cur-buf-matches cur-buf))) - (dired-old-find-buffer-nocreate dirname mode))) - ;; This should be a builtin (defun dired-buffer-more-recently-used-p (buffer1 buffer2) - "Return t if BUFFER1 is more recently used than BUFFER2." - (if (equal buffer1 buffer2) - nil - (let ((more-recent nil) - (list (buffer-list))) - (while (and list - (not (setq more-recent (equal buffer1 (car list)))) - (not (equal buffer2 (car list)))) - (setq list (cdr list))) - more-recent))) + "Return t if BUFFER1 is more recently used than BUFFER2. +Considers buffers closer to the car of `buffer-list' to be more recent." + (and (not (equal buffer1 buffer2)) + (memq buffer1 (buffer-list)) + (not (memq buffer1 (memq buffer2 (buffer-list)))))) ;; Same thing as `dired-buffers-for-dir' of dired.el? - lrd 11/23/93 ;; (defun dired-buffers-for-dir-exact (dir) @@ -1548,16 +1336,6 @@ See also variable `dired-vm-read-only-folders'." ;; (setq dired-buffers (delq elt dired-buffers))))) ;; result)) -;; REDEFINE. -;; Redefines dired.el's version of `dired-initial-position' -(defun dired-initial-position (dirname) - "Where point should go in a new listing of DIRNAME. -Point assumed at beginning of new subdir line. -You may redefine this function as you wish, e.g. like in `dired-x.el'." - (end-of-line) - (if dired-find-subdir (dired-goto-subdir dirname)) ; new - (if dired-trivial-filenames (dired-goto-next-nontrivial-file))) - ;; Does anyone use this? - lrd 6/29/93. ;; Apparently people do use it. - lrd 12/22/97. @@ -1603,168 +1381,140 @@ to mark all zero length files." ;; there is no file line. Upon success, all variables are set, either ;; to nil or the appropriate value, so they need not be initialized. ;; Moves point within the current line. - (if (dired-move-to-filename) - (let (pos - (mode-len 10) ; length of mode string - ;; like in dired.el, but with subexpressions \1=inode, \2=s: - (dired-re-inode-size "\\s *\\([0-9]*\\)\\s *\\([0-9]*\\) ?")) - (beginning-of-line) - (forward-char 2) - (if (looking-at dired-re-inode-size) - (progn - (goto-char (match-end 0)) - (setq inode (string-to-number (buffer-substring (match-beginning 1) - (match-end 1))) - s (string-to-number (buffer-substring (match-beginning 2) - (match-end 2))))) - (setq inode nil - s nil)) - (setq mode (buffer-substring (point) (+ mode-len (point)))) - (forward-char mode-len) - (setq nlink (read (current-buffer))) - ;; Karsten Wenger <kw@cis.uni-muenchen.de> fixed uid. - (setq uid (buffer-substring (+ (point) 1) - (progn (forward-word 1) (point)))) - (re-search-forward directory-listing-before-filename-regexp) - (goto-char (match-beginning 1)) - (forward-char -1) - (setq size (string-to-number (buffer-substring (save-excursion - (backward-word 1) - (setq pos (point))) - (point)))) - (goto-char pos) - (backward-word 1) - ;; if no gid is displayed, gid will be set to uid - ;; but user will then not reference it anyway in PREDICATE. - (setq gid (buffer-substring (save-excursion - (forward-word 1) (point)) - (point)) - time (buffer-substring (match-beginning 1) - (1- (dired-move-to-filename))) - name (buffer-substring (point) - (or - (dired-move-to-end-of-filename t) - (point))) - sym (progn - (if (looking-at " -> ") - (buffer-substring - (progn (forward-char 4) (point)) - (progn (end-of-line) (point))) - ""))) - t) - nil) - (eval predicate))) + (dired-move-to-filename) + (let (pos + (mode-len 10) ; length of mode string + ;; like in dired.el, but with subexpressions \1=inode, \2=s: + (dired-re-inode-size "\\s *\\([0-9]*\\)\\s *\\([0-9]*\\) ?")) + (beginning-of-line) + (forward-char 2) + (if (looking-at dired-re-inode-size) + (progn + (goto-char (match-end 0)) + (setq inode (string-to-number + (buffer-substring (match-beginning 1) + (match-end 1))) + s (string-to-number + (buffer-substring (match-beginning 2) + (match-end 2))))) + (setq inode nil + s nil)) + (setq mode (buffer-substring (point) (+ mode-len (point)))) + (forward-char mode-len) + (setq nlink (read (current-buffer))) + ;; Karsten Wenger <kw@cis.uni-muenchen.de> fixed uid. + (setq uid (buffer-substring (1+ (point)) + (progn (forward-word 1) (point)))) + (re-search-forward directory-listing-before-filename-regexp) + (goto-char (match-beginning 1)) + (forward-char -1) + (setq size (string-to-number + (buffer-substring (save-excursion + (backward-word 1) + (setq pos (point))) + (point)))) + (goto-char pos) + (backward-word 1) + ;; if no gid is displayed, gid will be set to uid + ;; but user will then not reference it anyway in PREDICATE. + (setq gid (buffer-substring (save-excursion + (forward-word 1) (point)) + (point)) + time (buffer-substring (match-beginning 1) + (1- (dired-move-to-filename))) + name (buffer-substring (point) + (or + (dired-move-to-end-of-filename t) + (point))) + sym (if (looking-at " -> ") + (buffer-substring (progn (forward-char 4) (point)) + (line-end-position)) + "")) + t) + (eval predicate))) (format "'%s file" predicate)))) ;;; FIND FILE AT POINT. -(defvar dired-x-hands-off-my-keys t - "*Non-nil means don't bind `dired-x-find-file' over `find-file' on keyboard. -Similarly for `dired-x-find-file-other-window' over `find-file-other-window'. -If you change this variable after `dired-x.el' is loaded then do -\\[dired-x-bind-find-file].") +(defcustom dired-x-hands-off-my-keys t + "Non-nil means don't remap `find-file' to `dired-x-find-file'. +Similarly for `find-file-other-window' and `dired-x-find-file-other-window'. +If you change this variable without using \\[customize] after `dired-x.el' +is loaded then call \\[dired-x-bind-find-file]." + :type 'boolean + :initialize 'custom-initialize-default + :set (lambda (sym val) + (set sym val) + (dired-x-bind-find-file)) + :group 'dired-x) -;; Bind `dired-x-find-file{-other-window}' over wherever -;; `find-file{-other-window}' is bound? (defun dired-x-bind-find-file () - "Bind `dired-x-find-file' in place of `find-file' \(or reverse\). + "Bind `dired-x-find-file' in place of `find-file' (or vice-versa). Similarly for `dired-x-find-file-other-window' and `find-file-other-window'. -Binding direction based on `dired-x-hands-off-my-keys'. -This function is part of `after-init-hook'." +Binding direction based on `dired-x-hands-off-my-keys'." (interactive) (if (called-interactively-p 'interactive) (setq dired-x-hands-off-my-keys (not (y-or-n-p "Bind dired-x-find-file over find-file? ")))) - (cond ((not dired-x-hands-off-my-keys) - (substitute-key-definition 'find-file - 'dired-x-find-file - (current-global-map)) - (substitute-key-definition 'find-file-other-window - 'dired-x-find-file-other-window - (current-global-map))) - (t - (substitute-key-definition 'dired-x-find-file - 'find-file - (current-global-map)) - (substitute-key-definition 'dired-x-find-file-other-window - 'find-file-other-window - (current-global-map)))) - ;; Clear mini-buffer. - (message nil)) - -;; Now call it so binding is correct and put on `after-init-hook' in case -;; user changes binding. + (define-key (current-global-map) [remap find-file] + (if (not dired-x-hands-off-my-keys) 'dired-x-find-file)) + (define-key (current-global-map) [remap find-file-other-window] + (if (not dired-x-hands-off-my-keys) 'dired-x-find-file-other-window))) + +;; Now call it so binding is correct. This could go in the :initialize +;; slot, but then dired-x-bind-find-file has to be defined before the +;; defcustom, and we get free variable warnings. (dired-x-bind-find-file) -(add-hook 'after-init-hook 'dired-x-bind-find-file) (defun dired-x-find-file (filename) "Edit file FILENAME. -May create a new window, or reuse an existing one. -See the function `display-buffer'. - -Identical to `find-file' except when called interactively, with a prefix arg -\(e.g., \\[universal-argument]\), in which case it guesses filename near point. -Useful for editing file mentioned in buffer you are viewing, -or to test if that file exists. Use minibuffer after snatching filename." - (interactive (list (read-filename-at-point "Find file: "))) - (find-file (expand-file-name filename))) +Like `find-file', except that when called interactively with a +prefix argument, it offers the filename near point as a default." + (interactive (list (dired-x-read-filename-at-point "Find file: "))) + (find-file filename)) (defun dired-x-find-file-other-window (filename) "Edit file FILENAME, in another window. -May create a new window, or reuse an existing one. -See the function `display-buffer'. - -Identical to `find-file-other-window' except when called interactively, with -a prefix arg \(e.g., \\[universal-argument]\), in which case it guesses filename near point. -Useful for editing file mentioned in buffer you are viewing, -or to test if that file exists. Use minibuffer after snatching filename." - (interactive (list (read-filename-at-point "Find file: "))) - (find-file-other-window (expand-file-name filename))) +Like `find-file-other-window', except that when called interactively with +a prefix argument, when it offers the filename near point as a default." + (interactive (list (dired-x-read-filename-at-point "Find file: "))) + (find-file-other-window filename)) ;;; Internal functions. ;; Fixme: This should probably use `thing-at-point'. -- fx (defun dired-filename-at-point () - "Get the filename closest to point, but do not change position. -Has a preference for looking backward when not directly on a symbol. -Not perfect - point must be in middle of or end of filename." - - (let ((filename-chars "-.[:alnum:]_/:$+@") - start end filename prefix) - - (save-excursion - ;; First see if just past a filename. - (if (not (eobp)) - (if (looking-at "[] \t\n[{}()]") ; whitespace or some parens - (progn - (skip-chars-backward " \n\t\r({[]})") - (if (not (bobp)) - (backward-char 1))))) - - (if (string-match (concat "[" filename-chars "]") - (char-to-string (following-char))) + "Return the filename closest to point, expanded. +Point should be in or after a filename." + (save-excursion + ;; First see if just past a filename. + (or (eobp) ; why? + (when (looking-at "[] \t\n[{}()]") ; whitespace or some parens + (skip-chars-backward " \n\t\r({[]})") + (or (bobp) (backward-char 1)))) + (let ((filename-chars "-.[:alnum:]_/:$+@") + start prefix) + (if (looking-at (format "[%s]" filename-chars)) (progn - (if (re-search-backward (concat "[^" filename-chars "]") nil t) - (forward-char) - (goto-char (point-min))) - (setq start (point)) - (setq prefix + (skip-chars-backward filename-chars) + (setq start (point) + prefix + ;; This is something to do with ange-ftp filenames. + ;; It convert foo@bar to /foo@bar. + ;; But when does the former occur in dired buffers? (and (string-match "^\\w+@" - (buffer-substring start (line-beginning-position))) + (buffer-substring start (line-end-position))) "/")) - (goto-char start) (if (string-match "[/~]" (char-to-string (preceding-char))) (setq start (1- start))) - (re-search-forward (concat "\\=[" filename-chars "]*") nil t)) - + (skip-chars-forward filename-chars)) (error "No file found around point!")) - ;; Return string. (expand-file-name (concat prefix (buffer-substring start (point))))))) -(defun read-filename-at-point (prompt) +(defun dired-x-read-filename-at-point (prompt) "Return filename prompting with PROMPT with completion. If `current-prefix-arg' is non-nil, uses name at point as guess." (if current-prefix-arg @@ -1774,51 +1524,13 @@ If `current-prefix-arg' is non-nil, uses name at point as guess." guess nil (file-name-nondirectory guess))) (read-file-name prompt default-directory))) + +(define-obsolete-function-alias 'read-filename-at-point + 'dired-x-read-filename-at-point "24.1") ; is this even needed? ;;; BUG REPORTS -;; Fixme: get rid of this later. - -;; This section is provided for reports. It uses Barry A. Warsaw's -;; reporter.el which is bundled with GNU Emacs v19. - -(defconst dired-x-help-address "bug-gnu-emacs@gnu.org" - "Address(es) accepting submission of reports on dired-x.el.") - -(defconst dired-x-variable-list - (list - 'dired-bind-vm - 'dired-vm-read-only-folders - 'dired-bind-jump - 'dired-bind-info - 'dired-bind-man - 'dired-find-subdir - 'dired-enable-local-variables - 'dired-local-variables-file - 'dired-guess-shell-gnutar - 'dired-guess-shell-gzip-quiet - 'dired-guess-shell-znew-switches - 'dired-guess-shell-alist-user - 'dired-clean-up-buffers-too - 'dired-omit-mode - 'dired-omit-files - 'dired-omit-extensions - ) - "List of variables to be appended to reports sent by `dired-x-submit-report'.") - -(defun dired-x-submit-report () - "Submit via `reporter.el' a bug report on program. -Send report on `dired-x-file' version `dired-x-version', to -`dired-x-maintainer' at address `dired-x-help-address' listing -variables `dired-x-variable-list' in the message." - (interactive) - - (reporter-submit-bug-report - dired-x-help-address ; address - "dired-x" ; pkgname - dired-x-variable-list ; varlist - nil nil ; pre-/post-hooks - "")) +(define-obsolete-function-alias 'dired-x-submit-report 'report-emacs-bug "24.1") ;; As Barry Warsaw would say: "This might be useful..." diff --git a/lisp/dired.el b/lisp/dired.el index c4b45a3aa89..4a17b443cfa 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -847,28 +847,47 @@ periodically reverts at specified time intervals." ;; killed buffer, it is removed from this list. "Alist of expanded directories and their associated dired buffers.") +(defvar dired-find-subdir) + +;; FIXME add a doc-string, and document dired-x extensions. (defun dired-find-buffer-nocreate (dirname &optional mode) ;; This differs from dired-buffers-for-dir in that it does not consider ;; subdirs of default-directory and searches for the first match only. ;; Also, the major mode must be MODE. - (setq dirname (expand-file-name dirname)) - (let (found (blist dired-buffers)) ; was (buffer-list) - (or mode (setq mode 'dired-mode)) - (while blist - (if (null (buffer-name (cdr (car blist)))) - (setq blist (cdr blist)) - (with-current-buffer (cdr (car blist)) - (if (and (eq major-mode mode) - dired-directory ;; nil during find-alternate-file - (equal dirname - (expand-file-name - (if (consp dired-directory) - (car dired-directory) - dired-directory)))) - (setq found (cdr (car blist)) - blist nil) - (setq blist (cdr blist)))))) - found)) + (if (and (featurep 'dired-x) + dired-find-subdir + ;; Don't try to find a wildcard as a subdirectory. + (string-equal dirname (file-name-directory dirname))) + (let* ((cur-buf (current-buffer)) + (buffers (nreverse + (dired-buffers-for-dir (expand-file-name dirname)))) + (cur-buf-matches (and (memq cur-buf buffers) + ;; Wildcards must match, too: + (equal dired-directory dirname)))) + ;; We don't want to switch to the same buffer--- + (setq buffers (delq cur-buf buffers)) + (or (car (sort buffers #'dired-buffer-more-recently-used-p)) + ;; ---unless it's the only possibility: + (and cur-buf-matches cur-buf))) + ;; No dired-x, or dired-find-subdir nil. + (setq dirname (expand-file-name dirname)) + (let (found (blist dired-buffers)) ; was (buffer-list) + (or mode (setq mode 'dired-mode)) + (while blist + (if (null (buffer-name (cdr (car blist)))) + (setq blist (cdr blist)) + (with-current-buffer (cdr (car blist)) + (if (and (eq major-mode mode) + dired-directory ;; nil during find-alternate-file + (equal dirname + (expand-file-name + (if (consp dired-directory) + (car dired-directory) + dired-directory)))) + (setq found (cdr (car blist)) + blist nil) + (setq blist (cdr blist)))))) + found))) ;; Read in a new dired buffer @@ -2544,11 +2563,15 @@ instead of `dired-actual-switches'." ;; return value of point (i.e., FOUND): (goto-char found)))) +(defvar dired-find-subdir) + +;; FIXME document whatever dired-x is doing. (defun dired-initial-position (dirname) - ;; Where point should go in a new listing of DIRNAME. - ;; Point assumed at beginning of new subdir line. - ;; You may redefine this function as you wish, e.g. like in dired-x.el. + "Where point should go in a new listing of DIRNAME. +Point assumed at beginning of new subdir line." (end-of-line) + (and (featurep 'dired-x) dired-find-subdir + (dired-goto-subdir dirname)) (if dired-trivial-filenames (dired-goto-next-nontrivial-file))) ;; These are hooks which make tree dired work. @@ -2745,12 +2768,32 @@ non-empty directories is allowed." (save-excursion (forward-line 1) (point)))))) (dired-clean-up-after-deletion file)) -;; This is a separate function for the sake of dired-x.el. +(defvar dired-clean-up-buffers-too) + (defun dired-clean-up-after-deletion (fn) - ;; Clean up after a deleted file or directory FN. + "Clean up after a deleted file or directory FN. +Removes any expanded subdirectory of deleted directory. +If `dired-x' is loaded and `dired-clean-up-buffers-too' is non-nil, +also offers to kill buffers visiting deleted files and directories." (save-excursion (and (cdr dired-subdir-alist) (dired-goto-subdir fn) - (dired-kill-subdir)))) + (dired-kill-subdir))) + ;; Offer to kill buffer of deleted file FN. + (when (and (featurep 'dired-x) dired-clean-up-buffers-too) + (let ((buf (get-file-buffer fn))) + (and buf + (funcall #'y-or-n-p + (format "Kill buffer of %s, too? " + (file-name-nondirectory fn))) + (kill-buffer buf))) + (let ((buf-list (dired-buffers-for-dir (expand-file-name fn)))) + (and buf-list + (y-or-n-p (format "Kill dired buffer%s of %s, too? " + (dired-plural-s (length buf-list)) + (file-name-nondirectory fn))) + (dolist (buf buf-list) + (kill-buffer buf)))))) + ;; Confirmation @@ -3570,7 +3613,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" "9f5fc434fa6c2607b6e66060862c9caf") +;;;;;; dired-diff) "dired-aux" "dired-aux.el" "9d6333fab9c0f1b49e0bf2a536b8f245") ;;; Generated autoloads from dired-aux.el (autoload 'dired-diff "dired-aux" "\ @@ -4029,7 +4072,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" -;;;;;; "fbac6ae123aaa2b2e9df8bb2cde61ceb") +;;;;;; "86d436093caa9ae80f7b73915c6a4b4c") ;;; Generated autoloads from dired-x.el (autoload 'dired-jump "dired-x" "\ diff --git a/lisp/edmacro.el b/lisp/edmacro.el index 769d7fceb90..ac0a7f47e55 100644 --- a/lisp/edmacro.el +++ b/lisp/edmacro.el @@ -61,11 +61,6 @@ ;; With a prefix argument, `edit-kbd-macro' will format the ;; macro in a more concise way that omits the comments. -;; This package requires GNU Emacs 19 or later, and daveg's CL -;; package 2.02 or later. (CL 2.02 comes standard starting with -;; Emacs 19.18.) This package does not work with Emacs 18 or -;; Lucid Emacs. - ;;; Code: (eval-when-compile @@ -75,10 +70,11 @@ ;;; The user-level commands for editing macros. -;;;###autoload -(defvar edmacro-eight-bits nil - "*Non-nil if `edit-kbd-macro' should leave 8-bit characters intact. -Default nil means to write characters above \\177 in octal notation.") +(defcustom edmacro-eight-bits nil + "Non-nil if `edit-kbd-macro' should leave 8-bit characters intact. +Default nil means to write characters above \\177 in octal notation." + :type 'boolean + :group 'kmacro) (defvar edmacro-mode-map (let ((map (make-sparse-keymap))) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index b08fc3d708a..c9cc4618967 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1307,17 +1307,17 @@ (defconst byte-constref-ops '(byte-constant byte-constant2 byte-varref byte-varset byte-varbind)) +;; Used and set dynamically in byte-decompile-bytecode-1. +(defvar bytedecomp-op) +(defvar bytedecomp-ptr) +(defvar bytedecomp-bytes) + ;; This function extracts the bitfields from variable-length opcodes. ;; Originally defined in disass.el (which no longer uses it.) - (defun disassemble-offset () "Don't call this!" ;; fetch and return the offset for the current opcode. ;; return nil if this opcode has no offset - ;; Used and set dynamically in byte-decompile-bytecode-1. - (defvar bytedecomp-op) - (defvar bytedecomp-ptr) - (defvar bytedecomp-bytes) (cond ((< bytedecomp-op byte-nth) (let ((tem (logand bytedecomp-op 7))) (setq bytedecomp-op (logand bytedecomp-op 248)) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 2d3b228cbd4..9880e2918b0 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -1797,7 +1797,7 @@ Replace with \"%s\"? " original replace) (let ((found nil) (start (point)) (msg nil) (ms nil)) (while (and (not msg) (re-search-forward - ;; Ignore manual page refereces like + ;; Ignore manual page references like ;; git-config(1). "[^-([`':a-zA-Z]\\(\\w+[:-]\\(\\w\\|\\s_\\)+\\)[^](']" e t)) diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 4f2d5df1f54..bd50c75bcc3 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -754,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" "43e0c1183e738e1e1038cdd84fde8366") +;;;;;; replace fill reduce) "cl-seq" "cl-seq.el" "df375ddc313f0c1c262cacab5cffd3e4") ;;; Generated autoloads from cl-seq.el (autoload 'reduce "cl-seq" "\ @@ -1080,7 +1080,7 @@ Keywords supported: :key (autoload 'union "cl-seq" "\ Combine LIST1 and LIST2 using a set-union operation. -The result list contains all items that appear in either LIST1 or LIST2. +The resulting list contains all items that appear in either LIST1 or LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. @@ -1090,7 +1090,7 @@ Keywords supported: :test :test-not :key (autoload 'nunion "cl-seq" "\ Combine LIST1 and LIST2 using a set-union operation. -The result list contains all items that appear in either LIST1 or LIST2. +The resulting list contains all items that appear in either LIST1 or LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. @@ -1100,7 +1100,7 @@ Keywords supported: :test :test-not :key (autoload 'intersection "cl-seq" "\ Combine LIST1 and LIST2 using a set-intersection operation. -The result list contains all items that appear in both LIST1 and LIST2. +The resulting list contains all items that appear in both LIST1 and LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. @@ -1110,7 +1110,7 @@ Keywords supported: :test :test-not :key (autoload 'nintersection "cl-seq" "\ Combine LIST1 and LIST2 using a set-intersection operation. -The result list contains all items that appear in both LIST1 and LIST2. +The resulting list contains all items that appear in both LIST1 and LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. @@ -1120,7 +1120,7 @@ Keywords supported: :test :test-not :key (autoload 'set-difference "cl-seq" "\ Combine LIST1 and LIST2 using a set-difference operation. -The result list contains all items that appear in LIST1 but not LIST2. +The resulting list contains all items that appear in LIST1 but not LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. @@ -1130,7 +1130,7 @@ Keywords supported: :test :test-not :key (autoload 'nset-difference "cl-seq" "\ Combine LIST1 and LIST2 using a set-difference operation. -The result list contains all items that appear in LIST1 but not LIST2. +The resulting list contains all items that appear in LIST1 but not LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. @@ -1140,7 +1140,7 @@ Keywords supported: :test :test-not :key (autoload 'set-exclusive-or "cl-seq" "\ Combine LIST1 and LIST2 using a set-exclusive-or operation. -The result list contains all items that appear in exactly one of LIST1, LIST2. +The resulting list contains all items appearing in exactly one of LIST1, LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. @@ -1150,7 +1150,7 @@ Keywords supported: :test :test-not :key (autoload 'nset-exclusive-or "cl-seq" "\ Combine LIST1 and LIST2 using a set-exclusive-or operation. -The result list contains all items that appear in exactly one of LIST1, LIST2. +The resulting list contains all items appearing in exactly one of LIST1, LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index fcd21b73de7..1c578556835 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el @@ -770,7 +770,7 @@ Return the sublist of LIST whose car matches. ;;;###autoload (defun union (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-union operation. -The result list contains all items that appear in either LIST1 or LIST2. +The resulting list contains all items that appear in either LIST1 or LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. \nKeywords supported: :test :test-not :key @@ -791,7 +791,7 @@ to avoid corrupting the original LIST1 and LIST2. ;;;###autoload (defun nunion (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-union operation. -The result list contains all items that appear in either LIST1 or LIST2. +The resulting list contains all items that appear in either LIST1 or LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. \nKeywords supported: :test :test-not :key @@ -802,7 +802,7 @@ whenever possible. ;;;###autoload (defun intersection (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-intersection operation. -The result list contains all items that appear in both LIST1 and LIST2. +The resulting list contains all items that appear in both LIST1 and LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. \nKeywords supported: :test :test-not :key @@ -825,7 +825,7 @@ to avoid corrupting the original LIST1 and LIST2. ;;;###autoload (defun nintersection (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-intersection operation. -The result list contains all items that appear in both LIST1 and LIST2. +The resulting list contains all items that appear in both LIST1 and LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. \nKeywords supported: :test :test-not :key @@ -835,7 +835,7 @@ whenever possible. ;;;###autoload (defun set-difference (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-difference operation. -The result list contains all items that appear in LIST1 but not LIST2. +The resulting list contains all items that appear in LIST1 but not LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. \nKeywords supported: :test :test-not :key @@ -855,7 +855,7 @@ to avoid corrupting the original LIST1 and LIST2. ;;;###autoload (defun nset-difference (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-difference operation. -The result list contains all items that appear in LIST1 but not LIST2. +The resulting list contains all items that appear in LIST1 but not LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. \nKeywords supported: :test :test-not :key @@ -866,7 +866,7 @@ whenever possible. ;;;###autoload (defun set-exclusive-or (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-exclusive-or operation. -The result list contains all items that appear in exactly one of LIST1, LIST2. +The resulting list contains all items appearing in exactly one of LIST1, LIST2. This is a non-destructive function; it makes a copy of the data if necessary to avoid corrupting the original LIST1 and LIST2. \nKeywords supported: :test :test-not :key @@ -879,7 +879,7 @@ to avoid corrupting the original LIST1 and LIST2. ;;;###autoload (defun nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys) "Combine LIST1 and LIST2 using a set-exclusive-or operation. -The result list contains all items that appear in exactly one of LIST1, LIST2. +The resulting list contains all items appearing in exactly one of LIST1, LIST2. This is a destructive function; it reuses the storage of LIST1 and LIST2 whenever possible. \nKeywords supported: :test :test-not :key diff --git a/lisp/emacs-lisp/eieio-custom.el b/lisp/emacs-lisp/eieio-custom.el index 6fe63fcb754..e8d7bea50fa 100644 --- a/lisp/emacs-lisp/eieio-custom.el +++ b/lisp/emacs-lisp/eieio-custom.el @@ -326,6 +326,7 @@ User made commands should also call this method when applying changes. Argument OBJ is the object that has been customized." nil) +;;;###autoload (defun customize-object (obj &optional group) "Customize OBJ in a custom buffer. Optional argument GROUP is the sub-group of slots to display." @@ -460,4 +461,8 @@ Return the symbol for the group, or nil" (provide 'eieio-custom) +;; Local variables: +;; generated-autoload-file: "eieio.el" +;; End: + ;;; eieio-custom.el ends here diff --git a/lisp/emacs-lisp/eieio-opt.el b/lisp/emacs-lisp/eieio-opt.el index ddc6616ba28..1b101cef875 100644 --- a/lisp/emacs-lisp/eieio-opt.el +++ b/lisp/emacs-lisp/eieio-opt.el @@ -32,6 +32,7 @@ (require 'eieio) ;;; Code: +;;;###autoload (defun eieio-browse (&optional root-class) "Create an object browser window to show all objects. If optional ROOT-CLASS, then start with that, otherwise start with @@ -71,8 +72,10 @@ Argument CH-PREFIX is another character prefix to display." ;;; CLASS COMPLETION / DOCUMENTATION +;;;###autoload (defalias 'describe-class 'eieio-describe-class) +;;;###autoload (defun eieio-describe-class (class &optional headerfcn) "Describe a CLASS defined by a string or symbol. If CLASS is actually an object, then also display current values of that object. @@ -238,6 +241,7 @@ Outputs to the standard output." prot (cdr prot) i (1+ i))))) +;;;###autoload (defun eieio-describe-constructor (fcn) "Describe the constructor function FCN. Uses `eieio-describe-class' to describe the class being constructed." @@ -301,9 +305,11 @@ are not abstract." ;;; METHOD COMPLETION / DOC (defalias 'describe-method 'eieio-describe-generic) +;;;###autoload (defalias 'describe-generic 'eieio-describe-generic) (defalias 'eieio-describe-method 'eieio-describe-generic) +;;;###autoload (defun eieio-describe-generic (generic) "Describe the generic function GENERIC. Also extracts information about all methods specific to this generic." @@ -550,6 +556,7 @@ Optional argument HISTORYVAR is the variable to use as history." ;;; HELP AUGMENTATION ;; +;;;###autoload (defun eieio-help-mode-augmentation-maybee (&rest unused) "For buffers thrown into help mode, augment for EIEIO. Arguments UNUSED are not used." @@ -693,4 +700,8 @@ INDENT is the current indentation level." (provide 'eieio-opt) +;; Local variables: +;; generated-autoload-file: "eieio.el" +;; End: + ;;; eieio-opt.el ends here diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 82c0e1319fe..bd768dbdb9f 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -2940,15 +2940,65 @@ Optional argument NOESCAPE is passed to `prin1-to-string' when appropriate." ;;; Autoloading some external symbols, and hooking into the help system ;; -(autoload 'eieio-help-mode-augmentation-maybee "eieio-opt" "For buffers thrown into help mode, augment for EIEIO.") -(autoload 'eieio-browse "eieio-opt" "Create an object browser window." t) -(autoload 'eieio-describe-class "eieio-opt" "Describe CLASS defined by a string or symbol" t) -(autoload 'eieio-describe-constructor "eieio-opt" "Describe the constructor function FCN." t) -(autoload 'describe-class "eieio-opt" "Describe CLASS defined by a string or symbol." t) -(autoload 'eieio-describe-generic "eieio-opt" "Describe GENERIC defined by a string or symbol." t) -(autoload 'describe-generic "eieio-opt" "Describe GENERIC defined by a string or symbol." t) - -(autoload 'customize-object "eieio-custom" "Create a custom buffer editing OBJ.") + +;;; Start of automatically extracted autoloads. + +;;;### (autoloads (customize-object) "eieio-custom" "eieio-custom.el" +;;;;;; "cf1bd64c76a6e6406545e8c5a5530d43") +;;; Generated autoloads from eieio-custom.el + +(autoload 'customize-object "eieio-custom" "\ +Customize OBJ in a custom buffer. +Optional argument GROUP is the sub-group of slots to display. + +\(fn OBJ &optional GROUP)" nil nil) + +;;;*** + +;;;### (autoloads (eieio-help-mode-augmentation-maybee eieio-describe-generic +;;;;;; eieio-describe-constructor eieio-describe-class eieio-browse) +;;;;;; "eieio-opt" "eieio-opt.el" "1bed0a56310f402683419139ebc18d7f") +;;; Generated autoloads from eieio-opt.el + +(autoload 'eieio-browse "eieio-opt" "\ +Create an object browser window to show all objects. +If optional ROOT-CLASS, then start with that, otherwise start with +variable `eieio-default-superclass'. + +\(fn &optional ROOT-CLASS)" t nil) + +(defalias 'describe-class 'eieio-describe-class) + +(autoload 'eieio-describe-class "eieio-opt" "\ +Describe a CLASS defined by a string or symbol. +If CLASS is actually an object, then also display current values of that object. +Optional HEADERFCN should be called to insert a few bits of info first. + +\(fn CLASS &optional HEADERFCN)" t nil) + +(autoload 'eieio-describe-constructor "eieio-opt" "\ +Describe the constructor function FCN. +Uses `eieio-describe-class' to describe the class being constructed. + +\(fn FCN)" t nil) + +(defalias 'describe-generic 'eieio-describe-generic) + +(autoload 'eieio-describe-generic "eieio-opt" "\ +Describe the generic function GENERIC. +Also extracts information about all methods specific to this generic. + +\(fn GENERIC)" t nil) + +(autoload 'eieio-help-mode-augmentation-maybee "eieio-opt" "\ +For buffers thrown into help mode, augment for EIEIO. +Arguments UNUSED are not used. + +\(fn &rest UNUSED)" nil nil) + +;;;*** + +;;; End of automatically extracted autoloads. (provide 'eieio) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 695dc1e2db6..b3c95fcc78f 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1877,6 +1877,7 @@ BUFFER-NAME, if non-nil, is the buffer name to use." (let ((inhibit-read-only t)) (buffer-disable-undo) (erase-buffer) + (ert-results-mode) ;; Erase buffer again in case switching out of the previous ;; mode inserted anything. (This happens e.g. when switching ;; from ert-results-mode to ert-results-mode when @@ -1895,9 +1896,8 @@ BUFFER-NAME, if non-nil, is the buffer name to use." (ewoc-enter-last ewoc (make-ert--ewoc-entry :test test :hidden-p t))) (ert--results-update-ewoc-hf ert--results-ewoc ert--results-stats) - (goto-char (1- (point-max))))) - (ert-results-mode) - buffer))) + (goto-char (1- (point-max))) + buffer))))) (defvar ert--selector-history nil @@ -2343,6 +2343,7 @@ To be used in the ERT results buffer." (let ((inhibit-read-only t)) (buffer-disable-undo) (erase-buffer) + (ert-simple-view-mode) ;; Use unibyte because `debugger-setup-buffer' also does so. (set-buffer-multibyte nil) (setq truncate-lines t) @@ -2351,8 +2352,7 @@ To be used in the ERT results buffer." (goto-char (point-min)) (insert "Backtrace for test `") (ert-insert-test-name-button (ert-test-name test)) - (insert "':\n") - (ert-simple-view-mode))))))) + (insert "':\n"))))))) (defun ert-results-pop-to-messages-for-test-at-point () "Display the part of the *Messages* buffer generated during the test at point. @@ -2368,12 +2368,12 @@ To be used in the ERT results buffer." (let ((inhibit-read-only t)) (buffer-disable-undo) (erase-buffer) + (ert-simple-view-mode) (insert (ert-test-result-messages result)) (goto-char (point-min)) (insert "Messages for test `") (ert-insert-test-name-button (ert-test-name test)) - (insert "':\n") - (ert-simple-view-mode))))) + (insert "':\n"))))) (defun ert-results-pop-to-should-forms-for-test-at-point () "Display the list of `should' forms executed during the test at point. @@ -2389,6 +2389,7 @@ To be used in the ERT results buffer." (let ((inhibit-read-only t)) (buffer-disable-undo) (erase-buffer) + (ert-simple-view-mode) (if (null (ert-test-result-should-forms result)) (insert "\n(No should forms during this test.)\n") (loop for form-description in (ert-test-result-should-forms result) @@ -2406,8 +2407,7 @@ To be used in the ERT results buffer." (insert (concat "(Values are shallow copies and may have " "looked different during the test if they\n" "have been modified destructively.)\n")) - (forward-line 1) - (ert-simple-view-mode))))) + (forward-line 1))))) (defun ert-results-toggle-printer-limits-for-test-at-point () "Toggle how much of the condition to print for the test at point. @@ -2442,6 +2442,7 @@ To be used in the ERT results buffer." (let ((inhibit-read-only t)) (buffer-disable-undo) (erase-buffer) + (ert-simple-view-mode) (if (null data) (insert "(No data)\n") (insert (format "%-3s %8s %8s\n" "" "time" "cumul")) @@ -2454,8 +2455,7 @@ To be used in the ERT results buffer." (insert "\n")))) (goto-char (point-min)) (insert "Tests by run time (seconds):\n\n") - (forward-line 1) - (ert-simple-view-mode)))) + (forward-line 1)))) ;;;###autoload (defun ert-describe-test (test-or-test-name) diff --git a/lisp/emacs-lisp/find-gc.el b/lisp/emacs-lisp/find-gc.el index 773b8f11408..1de38625243 100644 --- a/lisp/emacs-lisp/find-gc.el +++ b/lisp/emacs-lisp/find-gc.el @@ -55,7 +55,7 @@ Each entry has the form (FUNCTION . FUNCTIONS-IT-CALLS).") "term.c" "cm.c" "emacs.c" "keyboard.c" "macros.c" "keymap.c" "sysdep.c" "buffer.c" "filelock.c" "insdel.c" "marker.c" "minibuf.c" "fileio.c" - "dired.c" "filemode.c" "cmds.c" "casefiddle.c" + "dired.c" "cmds.c" "casefiddle.c" "indent.c" "search.c" "regex.c" "undo.c" "alloc.c" "data.c" "doc.c" "editfns.c" "callint.c" "eval.c" "fns.c" "print.c" "lread.c" diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index af97bb1bd21..ab5ba1bea56 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -577,23 +577,22 @@ Otherwise it uses an external `tar' program. (let ((load-path (cons pkg-dir load-path))) (byte-recompile-directory pkg-dir 0 t))))) -(defun package--write-file-no-coding (file-name excl) +(defun package--write-file-no-coding (file-name) (let ((buffer-file-coding-system 'no-conversion)) - (write-region (point-min) (point-max) file-name nil nil nil excl))) + (write-region (point-min) (point-max) file-name))) (defun package-unpack-single (file-name version desc requires) "Install the contents of the current buffer as a package." ;; Special case "package". (if (string= file-name "package") (package--write-file-no-coding - (expand-file-name (concat file-name ".el") package-user-dir) - nil) + (expand-file-name (concat file-name ".el") package-user-dir)) (let* ((pkg-dir (expand-file-name (concat file-name "-" version) package-user-dir)) (el-file (expand-file-name (concat file-name ".el") pkg-dir)) (pkg-file (expand-file-name (concat file-name "-pkg.el") pkg-dir))) (make-directory pkg-dir t) - (package--write-file-no-coding el-file 'excl) + (package--write-file-no-coding el-file) (let ((print-level nil) (print-length nil)) (write-region @@ -1658,10 +1657,10 @@ list; the default is to display everything in `package-alist'." (require 'finder-inf nil t) (let ((buf (get-buffer-create "*Packages*"))) (with-current-buffer buf + (package-menu-mode) (set (make-local-variable 'package-menu-package-list) packages) (set (make-local-variable 'package-menu-sort-key) nil) - (package--generate-package-list) - (package-menu-mode)) + (package--generate-package-list)) ;; The package menu buffer has keybindings. If the user types ;; `M-x list-packages', that suggests it should become current. (switch-to-buffer buf))) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index c8a07738fe5..d795dbd390c 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -59,6 +59,8 @@ UPatterns can take the following forms: `QPAT matches if the QPattern QPAT matches. (pred PRED) matches if PRED applied to the object returns non-nil. (guard BOOLEXP) matches if BOOLEXP evaluates to non-nil. +If a SYMBOL is used twice in the same pattern (i.e. the pattern is +\"non-linear\"), then the second occurrence is turned into an `eq'uality test. QPatterns can take the following forms: (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr. @@ -465,7 +467,12 @@ and otherwise defers to REST which is a list of branches of the form (pcase--u1 matches code vars then-rest) (pcase--u else-rest)))) ((symbolp upat) - (pcase--u1 matches code (cons (cons upat sym) vars) rest)) + (if (not (assq upat vars)) + (pcase--u1 matches code (cons (cons upat sym) vars) rest) + ;; Non-linear pattern. Turn it into an `eq' test. + (pcase--u1 (cons `(match ,sym . (pred (eq ,(cdr (assq upat vars))))) + matches) + code vars rest))) ((eq (car-safe upat) '\`) (pcase--q1 sym (cadr upat) matches code vars rest)) ((eq (car-safe upat) 'or) diff --git a/lisp/emulation/cua-base.el b/lisp/emulation/cua-base.el index 3bdd9565fb5..0df9e7b16aa 100644 --- a/lisp/emulation/cua-base.el +++ b/lisp/emulation/cua-base.el @@ -246,7 +246,7 @@ ;; [C-d] Moves (i.e. deletes and inserts) a single character to the ;; global mark. ;; [backspace] deletes the character before the global mark, while -;; [delete] deltes the character after the global mark. +;; [delete] deletes the character after the global mark. ;; [S-C-space] Jumps to and cancels the global mark. ;; [C-u S-C-space] Cancels the global mark (stays in current buffer). @@ -1518,6 +1518,9 @@ If ARG is the atom `-', scroll upward by nearly full screen." c-beginning-of-statement c-end-of-statement)) (put cmd 'CUA 'move)) +;; Only called if pc-selection-mode is t, which means pc-select is loaded. +(declare-function pc-selection-mode "pc-select" (&optional arg)) + ;; State prior to enabling cua-mode ;; Value is a list with the following elements: ;; transient-mark-mode diff --git a/lisp/facemenu.el b/lisp/facemenu.el index e76e920a9f0..360383aa32b 100644 --- a/lisp/facemenu.el +++ b/lisp/facemenu.el @@ -463,25 +463,6 @@ These special properties include `invisible', `intangible' and `read-only'." (defalias 'facemenu-read-color 'read-color) -(defun color-rgb-to-hsv (r g b) - "For R, G, B color components return a list of hue, saturation, value. -R, G, B input values should be in [0..65535] range. -Output values for hue are integers in [0..360] range. -Output values for saturation and value are integers in [0..100] range." - (let* ((r (/ r 65535.0)) - (g (/ g 65535.0)) - (b (/ b 65535.0)) - (max (max r g b)) - (min (min r g b)) - (h (cond ((= max min) 0) - ((= max r) (mod (+ (* 60 (/ (- g b) (- max min))) 360) 360)) - ((= max g) (+ (* 60 (/ (- b r) (- max min))) 120)) - ((= max b) (+ (* 60 (/ (- r g) (- max min))) 240)))) - (s (cond ((= max 0) 0) - (t (- 1 (/ min max))))) - (v max)) - (list (round h) (round s 0.01) (round v 0.01)))) - (defcustom list-colors-sort nil "Color sort order for `list-colors-display'. `nil' means default implementation-dependent order (defined in `x-colors'). @@ -508,6 +489,7 @@ and excludes grayscale colors." "Return a list of keys for sorting colors depending on `list-colors-sort'. COLOR is the name of the color. When return value is nil, filter out the color from the output." + (require 'color) (cond ((null list-colors-sort) color) ((eq list-colors-sort 'name) @@ -517,12 +499,12 @@ filter out the color from the output." ((eq (car-safe list-colors-sort) 'rgb-dist) (color-distance color (cdr list-colors-sort))) ((eq list-colors-sort 'hsv) - (apply 'color-rgb-to-hsv (color-values color))) + (apply 'color-rgb-to-hsv (color-name-to-rgb color))) ((eq (car-safe list-colors-sort) 'hsv-dist) - (let* ((c-rgb (color-values color)) + (let* ((c-rgb (color-name-to-rgb color)) (c-hsv (apply 'color-rgb-to-hsv c-rgb)) (o-hsv (apply 'color-rgb-to-hsv - (color-values (cdr list-colors-sort))))) + (color-name-to-rgb (cdr list-colors-sort))))) (unless (and (eq (nth 0 c-rgb) (nth 1 c-rgb)) ; exclude grayscale (eq (nth 1 c-rgb) (nth 2 c-rgb))) ;; 3D Euclidean distance (sqrt is not needed for sorting) @@ -638,7 +620,7 @@ You can change the color sort order by customizing `list-colors-sort'." 'mouse-face 'highlight 'help-echo (let ((hsv (apply 'color-rgb-to-hsv - (color-values (car color))))) + (color-name-to-rgb (car color))))) (format "H:%d S:%d V:%d" (nth 0 hsv) (nth 1 hsv) (nth 2 hsv))))) (when callback diff --git a/lisp/faces.el b/lisp/faces.el index 2a0badab370..b49cdc777be 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -1577,13 +1577,25 @@ Optional parameter FRAME is the frame whose definition of FACE is used. If nil or omitted, use the selected frame." (unless frame (setq frame (selected-frame))) - (let ((list face-attribute-name-alist) - (match t)) + (let* ((list face-attribute-name-alist) + (match t) + (bold (and (plist-member attrs :bold) + (not (plist-member attrs :weight)))) + (italic (and (plist-member attrs :italic) + (not (plist-member attrs :slant)))) + (plist (if (or bold italic) + (copy-sequence attrs) + attrs))) + ;; Handle the Emacs 20 :bold and :italic properties. + (if bold + (plist-put plist :weight (if bold 'bold 'normal))) + (if italic + (plist-put plist :slant (if italic 'italic 'normal))) (while (and match list) (let* ((attr (caar list)) (specified-value - (if (plist-member attrs attr) - (plist-get attrs attr) + (if (plist-member plist attr) + (plist-get plist attr) 'unspecified)) (value-now (face-attribute face attr frame))) (setq match (equal specified-value value-now)) @@ -1641,18 +1653,28 @@ If COLOR is the symbol `unspecified' or one of the strings (defun color-values (color &optional frame) "Return a description of the color named COLOR on frame FRAME. -The value is a list of integer RGB values--(RED GREEN BLUE). -These values appear to range from 0 to 65280 or 65535, depending -on the system; white is \(65280 65280 65280\) or \(65535 65535 65535\). +COLOR should be a string naming a color (e.g. \"white\"), or a +string specifying a color's RGB components (e.g. \"#ff12ec\"). + +Return a list of three integers, (RED GREEN BLUE), each between 0 +and either 65280 or 65535 (the maximum depends on the system). +Use `color-name-to-rgb' if you want RGB floating-point values +normalized to 1.0. + If FRAME is omitted or nil, use the selected frame. If FRAME cannot display COLOR, the value is nil. -If COLOR is the symbol `unspecified' or one of the strings -\"unspecified-fg\" or \"unspecified-bg\", the value is nil." - (if (member color '(unspecified "unspecified-fg" "unspecified-bg")) - nil - (if (memq (framep (or frame (selected-frame))) '(x w32 ns)) - (xw-color-values color frame) - (tty-color-values color frame)))) + +COLOR can also be the symbol `unspecified' or one of the strings +\"unspecified-fg\" or \"unspecified-bg\", in which case the +return value is nil." + (cond + ((member color '(unspecified "unspecified-fg" "unspecified-bg")) + nil) + ((memq (framep (or frame (selected-frame))) '(x w32 ns)) + (xw-color-values color frame)) + (t + (tty-color-values color frame)))) + (defalias 'x-color-values 'color-values) (declare-function xw-display-color-p "xfns.c" (&optional terminal)) diff --git a/lisp/files.el b/lisp/files.el index e7dd96ca2ff..42f09f8b6da 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -681,26 +681,37 @@ that list of directories (separated by occurrences of `path-separator') when resolving a relative directory name. The path separator is colon in GNU and GNU-like systems." (interactive - (list (read-directory-name "Change default directory: " - default-directory default-directory - (and (member cd-path '(nil ("./"))) - (null (getenv "CDPATH")))))) - (if (file-name-absolute-p dir) - (cd-absolute (expand-file-name dir)) - (if (null cd-path) - (let ((trypath (parse-colon-path (getenv "CDPATH")))) - (setq cd-path (or trypath (list "./"))))) - (if (not (catch 'found - (mapc - (function (lambda (x) - (let ((f (expand-file-name (concat x dir)))) - (if (file-directory-p f) - (progn - (cd-absolute f) - (throw 'found t)))))) - cd-path) - nil)) - (error "No such directory found via CDPATH environment variable")))) + (list + ;; FIXME: There's a subtle bug in the completion below. Seems linked + ;; to a fundamental difficulty of implementing `predicate' correctly. + ;; The manifestation is that TAB may list non-directories in the case where + ;; those files also correspond to valid directories (if your cd-path is (A/ + ;; B/) and you have A/a a file and B/a a directory, then both `a' and `a/' + ;; will be listed as valid completions). + ;; This is because `a' (listed because of A/a) is indeed a valid choice + ;; (which will lead to the use of B/a). + (minibuffer-with-setup-hook + (lambda () + (setq minibuffer-completion-table + (apply-partially #'locate-file-completion-table + cd-path nil)) + (setq minibuffer-completion-predicate + (lambda (dir) + (locate-file dir cd-path nil + (lambda (f) (and (file-directory-p f) 'dir-ok)))))) + (unless cd-path + (setq cd-path (or (parse-colon-path (getenv "CDPATH")) + (list "./")))) + (read-directory-name "Change default directory: " + default-directory default-directory + t)))) + (unless cd-path + (setq cd-path (or (parse-colon-path (getenv "CDPATH")) + (list "./")))) + (cd-absolute + (or (locate-file dir cd-path nil + (lambda (f) (and (file-directory-p f) 'dir-ok))) + (error "No such directory found via CDPATH environment variable")))) (defun load-file (file) "Load the Lisp file named FILE." @@ -720,9 +731,12 @@ If SUFFIXES is non-nil, it should be a list of suffixes to append to file name when searching. If SUFFIXES is nil, it is equivalent to '(\"\"). Use '(\"/\") to disable PATH search, but still try the suffixes in SUFFIXES. If non-nil, PREDICATE is used instead of `file-readable-p'. + +This function will normally skip directories, so if you want it to find +directories, make sure the PREDICATE function returns `dir-ok' for them. + PREDICATE can also be an integer to pass to the `access' system call, in which case file-name handlers are ignored. This usage is deprecated. - For compatibility, PREDICATE can also be one of the symbols `executable', `readable', `writable', or `exists', or a list of one or more of those symbols." @@ -2058,7 +2072,8 @@ Don't call it from programs! Use `insert-file-contents-literally' instead. (defvar find-file-literally nil "Non-nil if this buffer was made by `find-file-literally' or equivalent. -This is a permanent local.") +This has the `permanent-local' property, which takes effect if you +make the variable buffer-local.") (put 'find-file-literally 'permanent-local t) (defun find-file-literally (filename) @@ -4310,7 +4325,11 @@ Before and after saving the buffer, this function runs ;; In an indirect buffer, save its base buffer instead. (if (buffer-base-buffer) (set-buffer (buffer-base-buffer))) - (if (buffer-modified-p) + (if (or (buffer-modified-p) + ;; handle the case when no modification has been made but + ;; the file disappeared since visited + (and buffer-file-name + (not (file-exists-p buffer-file-name)))) (let ((recent-save (recent-auto-save-p)) setmodes) ;; If buffer has no file name, ask user for one. @@ -4823,10 +4842,8 @@ given. With a prefix argument, TRASH is nil." directory 'full directory-files-no-dot-files-regexp))) (delete-directory-internal directory))))) -(defun copy-directory (directory newname &optional keep-time parents) +(defun copy-directory (directory newname &optional keep-time parents copy-contents) "Copy DIRECTORY to NEWNAME. Both args must be strings. -If NEWNAME names an existing directory, copy DIRECTORY as subdirectory there. - This function always sets the file modes of the output files to match the corresponding input file. @@ -4837,7 +4854,12 @@ A prefix arg makes KEEP-TIME non-nil. Noninteractively, the last argument PARENTS says whether to create parent directories if they don't exist. Interactively, -this happens by default." +this happens by default. + +If NEWNAME names an existing directory, copy DIRECTORY as a +subdirectory there. However, if called from Lisp with a non-nil +optional argument COPY-CONTENTS, copy the contents of DIRECTORY +directly into NEWNAME instead." (interactive (let ((dir (read-directory-name "Copy directory: " default-directory default-directory t nil))) @@ -4845,7 +4867,7 @@ this happens by default." (read-file-name (format "Copy directory %s to: " dir) default-directory default-directory nil nil) - current-prefix-arg t))) + current-prefix-arg t nil))) ;; If default-directory is a remote directory, make sure we find its ;; copy-directory handler. (let ((handler (or (find-file-name-handler directory 'copy-directory) @@ -4857,21 +4879,22 @@ this happens by default." (setq directory (directory-file-name (expand-file-name directory)) newname (directory-file-name (expand-file-name newname))) - (if (not (file-directory-p newname)) - ;; If NEWNAME is not an existing directory, create it; that - ;; is where we will copy the files of DIRECTORY. - (make-directory newname parents) - ;; If NEWNAME is an existing directory, we will copy into - ;; NEWNAME/[DIRECTORY-BASENAME]. - (setq newname (expand-file-name - (file-name-nondirectory - (directory-file-name directory)) - newname)) - (and (file-exists-p newname) - (not (file-directory-p newname)) - (error "Cannot overwrite non-directory %s with a directory" - newname)) - (make-directory newname t)) + (cond ((not (file-directory-p newname)) + ;; If NEWNAME is not an existing directory, create it; + ;; that is where we will copy the files of DIRECTORY. + (make-directory newname parents)) + ;; If NEWNAME is an existing directory and COPY-CONTENTS + ;; is nil, copy into NEWNAME/[DIRECTORY-BASENAME]. + ((not copy-contents) + (setq newname (expand-file-name + (file-name-nondirectory + (directory-file-name directory)) + newname)) + (and (file-exists-p newname) + (not (file-directory-p newname)) + (error "Cannot overwrite non-directory %s with a directory" + newname)) + (make-directory newname t))) ;; Copy recursively. (dolist (file diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 8781ab3c0ec..ff48920e69c 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,224 @@ +2011-02-20 Chong Yidong <cyd@stupidchicken.com> + + * shr-color.el (shr-color->hexadecimal): Use renamed function names + color-rgb-to-hex, color-name-to-rgb, color-srgb-to-lab, and + color-lab-to-srgb. + +2011-02-21 Lars Ingebrigtsen <larsi@gnus.org> + + * nntp.el (nntp-finish-retrieve-group-infos): Add a kludge to use the + given method as in the group name if we're using an extended method. + (nntp-finish-retrieve-group-infos): Wait for the end of the LIST ACTIVE + command, if we're using that, instead of waiting for the beginning. + + * gnus-start.el (gnus-get-unread-articles): Extend the methods so that + we're sure to get unique server names, and we don't output two async + commands in the same buffer. This fixes an NNTP hang for some users. + +2011-02-21 Lars Ingebrigtsen <larsi@gnus.org> + + * gnus-sum.el (gnus-summary-next-article): Add a kludge to reselect the + summary buffer before reading going to the next buffer. This avoids + putting the point in the group buffer if you `C-g' the command. + + * auth-source.el (auth-source-netrc-parse): Add an in-memory netrc + cache (for now) to make ~/.authinfo.gpg files usable. + + * nnfolder.el (copyright-update): Define for the compiler. + + * auth-source.el (auth-source-search): Fix unbound variable. + +2011-02-19 Glenn Morris <rgm@gnu.org> + + * gnus.el (gnus-meta): Doc fix. + +2011-02-19 Chong Yidong <cyd@stupidchicken.com> + + * nnfolder.el (nnfolder-save-buffer): Don't let-bind copyright-update, + in case it's not yet loaded. + +2011-02-20 Lars Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-wait-for-response): Ensure that we get the entire + line we're waiting for. + +2011-02-19 Darren Hoo <darren.hoo@gmail.com> (tiny change) + + * gnus-art.el (gnus-article-next-page-1): Because customized mode-line + face with line-width greater than zero will cause RET in gnus summary + buffer to scroll down article page-wise because auto vscroll happens, + it should be temporalily disabled when doing a scroll-up. + +2011-02-19 Lars Ingebrigtsen <larsi@gnus.org> + + * nnimap.el (nnimap-parse-copied-articles): Allow for "<foo> OK" + outputs from the server. + +2011-02-18 Antoine Levitt <antoine.levitt@gmail.com> (tiny change) + + * gnus-art.el (gnus-article-prepare): Run gnus-article-prepare-hook + later so that bbdb can hook in easier. + +2011-02-18 Lars Ingebrigtsen <larsi@gnus.org> + + * auth-source.el (auth-source-search): Don't try to create credentials + if the caller doesn't want that. + (auth-source-search): If we don't find a match, don't bug out on + non-bound variables. + (auth-source-search): Only ask a single backend to create the + credentials. + + * nnimap.el (nnimap-log-command): Add a newline to the inhibited + logging. + (nnimap-credentials): Protect against auth-source-search returning nil. + (nnimap-request-list): Protect against not being able to open the + server. + +2011-02-17 Lars Ingebrigtsen <larsi@gnus.org> + + * auth-source.el (auth-source-search): Do a two-phase search, one with + no :create to get the responses from all backends. + + * nnimap.el (nnimap-open-connection-1): Delete duplicate server names + when getting credentials. + + * gnus-util.el (gnus-delete-duplicates): New function. + +2011-02-17 Teodor Zlatanov <tzz@lifelogs.com> + + * nnimap.el (nnimap-credentials): Instead of picking the first port as + a creation default, pass the whole port list down. It will be + completed. + + * auth-source.el (auth-source-search): Updated docs to talk about + multiple creation choices. + (auth-source-netrc-create): Accept a list as a value (from the search + parameters) and do completion on that list. Keep a separate netrc line + with the password obscured for showing the user. + + * nnimap.el (nnimap-open-connection-1): Make the `nnimap-address' the + first choice to `auth-source-search' so it will be used for entry + creation instead of the server's Gnus-specific name. + (nnimap-credentials): Rely on the auth-source library to select which + port is actually wanted in the new netrc entry, so don't override + `auth-source-creation-defaults'. + + * auth-source.el (auth-source-netrc-parse): Use :port instead of + :protocol and accept a missing user, host, or port as a wildcard match. + (auth-source-debug): Default to off. + + (auth-source-netrc-search, auth-source-netrc-create) + (auth-source-secrets-search, auth-source-secrets-create) + (auth-source-user-or-password, auth-source-backend, auth-sources) + (auth-source-backend-parse-parameters, auth-source-search): Use :port + instead of :protocol. + + * nnimap.el (nnimap-credentials): Pass a port default to + `auth-source-search' in case an entry needs to be created. + (nnimap-open-connection-1): Use :port instead of :protocol. + +2011-02-17 Katsumi Yamaoka <yamaoka@jpl.org> + + * auth-source.el (auth-source-secrets-search): Use mm-delete-duplicates + instead of delete-dups that is not available in XEmacs 21.4. + +2011-02-16 Lars Ingebrigtsen <larsi@gnus.org> + + * gnus-sum.el (gnus-propagate-marks): Change default to t again, since + nil means that nnimap doesn't get updated. + +2011-02-16 Teodor Zlatanov <tzz@lifelogs.com> + + * auth-source.el (auth-source-netrc-create): Return a synthetic search + result when the user doesn't want to write to the file. + (auth-source-netrc-search): Expect a synthetic result and proceed + accordingly. + (auth-source-cache-expiry): New variable to override + `password-cache-expiry'. + (auth-source-remember): Use it. + + * nnimap.el (nnimap-credentials): Remove the `inhibit-create' + parameter. Create entry if necessary by using :create t. + (nnimap-open-connection-1): Don't pass `inhibit-create'. + +2011-02-15 Teodor Zlatanov <tzz@lifelogs.com> + + * auth-source.el (auth-source-debug): Enable by default and don't + mention the obsolete `auth-source-hide-passwords'. + (auth-source-do-warn): New function to debug unconditionally. + (auth-source-do-debug): Use it. + (auth-source-backend-parse): Use it for invalid `auth-sources' entries + and for Secrets API entries when the secrets.el library is not + available. + +2011-02-14 Lars Ingebrigtsen <larsi@gnus.org> + + * gnus-sum.el (gnus-propagate-marks): Default to nil. + (gnus-summary-exit): Kill the correct article buffer on exit from a + `C-d' group. + + * gnus-start.el (gnus-use-backend-marks): Removed, since it duplicates + gnus-propagate-marks. + + * gnus-sum.el (gnus-summary-exit-no-update): Restore the group conf + before killing the buffers so that a non-full window conf gets handled + correctly. + (gnus-summary-exit): Ditto. + (gnus-summary-read-group-1): Ditto. + + * nntp.el (nntp-retrieve-group-data-early): Reinstate the two-part + async code again so that we can debug it properly. + + * message.el (message-reply): Take an optional switch-buffer parameter + so that Gnus window confs are respected better. + +2011-02-14 Teodor Zlatanov <tzz@lifelogs.com> + + * auth-source.el (auth-source-backend-parse-parameters): Don't rely on + `plist-get' to accept non-list parameters (XEmacs issue). Fix + docstring. + (auth-source-secrets-search): Use `delete-dups', `append mapcar', and + `butlast' instead of `remove-duplicates', `mapcan', and `subseq'. + (auth-sources, auth-source-backend-parse, auth-source-secrets-search): + Login collection is "Login" and not "login". + +2011-02-14 Lars Ingebrigtsen <larsi@gnus.org> + + * gnus-art.el (article-update-date-lapsed): Don't bug out when updating + multiple headers. + + * nnimap.el (nnimap-inhibit-logging): New variable. + (nnimap-log-command): Don't log login commands. + + * auth-source.el (auth-source-netrc-search): The asserts seem to want + to have more parameters. + + * nnimap.el (nnimap-send-command): Mark the command time for each + command, so that we don't get NOOPs stepping on our toes. + + * gnus-art.el (article-date-ut): Get the date from the Date header on + `t'. + +2011-02-14 Katsumi Yamaoka <yamaoka@jpl.org> + + * auth-source.el (auth-source-search): Use copy-sequence instead of + the cl.el copy-list. + +2011-02-13 Adam Sjøgren <asjo@koldfront.dk> + + * gnus-delay.el (gnus-delay-article) Fix number of seconds per day. + Improve prompt. + +2011-02-13 Lars Ingebrigtsen <larsi@gnus.org> + + * gnus-art.el (gnus-article-mode-line-format): Remove the article + washing status from the default format. It isn't very informative. + +2011-02-13 Tassilo Horn <tassilo@member.fsf.org> (tiny change) + + * nnimap.el (nnimap-request-accept-article, nnimap-process-quirk): Fix + Gcc processing on imap. + 2011-02-10 Stefan Monnier <monnier@iro.umontreal.ca> * message.el (message-bury): Don't pop up a new window when selected @@ -7,6 +228,30 @@ * gnus-sum.el (gnus-summary-save-parts): Use read-directory-name. +2011-02-10 Teodor Zlatanov <tzz@lifelogs.com> + + * sieve-manage.el: Autoload `auth-source-search'. + (sieve-sasl-auth): Use it. + +2011-02-09 Teodor Zlatanov <tzz@lifelogs.com> + + * nnimap.el: Autoload `auth-source-forget+'. + (nnimap-open-connection-1): Use it if the connection fails. + + * auth-source.el: Require `password-cache'. + (auth-source-hide-passwords, auth-source-cache): Remove and mark + obsolete. + (auth-source-magic): Marker for `password-cache' keys. + (auth-source-do-cache): Update docstring. + (auth-source-search): Use and check cache. + (auth-source-forget-all-cached, auth-source-remember) + (auth-source-recall, auth-source-forget, auth-source-forget+) + (auth-source-specmatchp): Caching support functions. + (auth-source-forget-user-or-password, auth-source-forget-all-cached): + Remove and obsolete. + (auth-source-user-or-password): Remove caching to further discourage + using it. Always hide passwords. + 2011-02-09 Lars Ingebrigtsen <larsi@gnus.org> * nntp.el (nntp-retrieve-group-data-early-disabled): Disable the async @@ -17,6 +262,22 @@ * message.el (message-options): Make message-options really buffer local. +2011-02-08 Teodor Zlatanov <tzz@lifelogs.com> + + * mail-source.el: Autoload `auth-source-search'. + (mail-source-keyword-map): Note order matters. + (mail-source-set-1): Get all the mail-source source values and + defaults and search auth-source on those if needed. This can all + probably be simplified. + + * nnimap.el: Autoload `auth-source-search'. + (nnimap-credentials): Use it. + (nnimap-open-connection-1): Ask for the virtual server and physical + address in one shot. + + * nntp.el: Autoload `auth-source-search'. + (nntp-send-authinfo): Use it. Note TODO. + 2011-02-08 Julien Danjou <julien@danjou.info> * shr.el (shr-tag-body): Add support for text attribute in body @@ -24,6 +285,13 @@ * message.el (message-options): Make message-options a local variable. +2011-02-07 Teodor Zlatanov <tzz@lifelogs.com> + + * auth-source.el (auth-source-secrets-search) + (auth-source-user-or-password): Use `append' instead of `nconc'. + (auth-source-user-or-password): Build return list better and protect + against nil :secret. + 2011-02-07 Lars Ingebrigtsen <larsi@gnus.org> * nnimap.el (nnimap-update-info): Refactor slightly. @@ -35,6 +303,13 @@ (nnimap-update-info): Fix macrology bug-out. (nnimap-update-info): Simplify split history test. +2011-02-06 Michael Albinus <michael.albinus@gmx.de> + + * auth-source.el (top): Require 'eieio unconditionally. Autoload + `secrets-get-attributes' instead of `secrets-get-attribute'. + (auth-source-secrets-search): Limit search when `max' is greater than + number of results. + 2011-02-06 Lars Ingebrigtsen <larsi@gnus.org> * nntp.el (nntp-finish-retrieve-group-infos): Protect against the first @@ -42,11 +317,58 @@ * proto-stream.el (open-protocol-stream): Document the return value. +2011-02-06 Teodor Zlatanov <tzz@lifelogs.com> + + * auth-source.el (auth-source-secrets-search): Add examples. + 2011-02-06 Julien Danjou <julien@danjou.info> * message.el (message-setup-1): Handle message-generate-headers-first set to t. +2011-02-06 Teodor Zlatanov <tzz@lifelogs.com> + + * auth-source.el (auth-sources): Allow for simpler defaults for Secrets + API with a string "secrets:collection-name" and with 'default. + (auth-source-backend-parse): Parse "secrets:collection-name" and + 'default. Recurse on parses instead of repeating code. Use the + Secrets API is the source is not nil and 'ignore otherwise. Emit a + message when ignoring a source. + (auth-source-search): List ignored search keys at the top level. + (auth-source-netrc-create): Use `case' instead of `cond'. + (auth-source-secrets-search): Created with TODOs. + (auth-source-secrets-create): Created with TODOs. + (auth-source-retrieve, auth-source-create, auth-source-delete) + (auth-source-protocol-defaults, auth-source-user-or-password-imap) + (auth-source-user-or-password-pop3, auth-source-user-or-password-ssh) + (auth-source-user-or-password-sftp) + (auth-source-user-or-password-smtp): Removed. + (auth-source-user-or-password): Deprecated and modified to be a wrapper + around `auth-source-search'. Not tested thoroughly. + +2011-02-04 Teodor Zlatanov <tzz@lifelogs.com> + + * auth-source.el: Bring in assoc and eioeio libraries. + (secrets-enabled): New variable to track the status of the Secrets API. + (auth-source-backend): New EIOEIO class to represent a backend. + (auth-source-creation-defaults): New variable to set prompt defaults + during token creation (see the `auth-source-search' docstring for + details). + (auth-sources): Simplify to allow a simple string as a netrc backend + spec. + (auth-source-backend-parse): Parse a backend from an `auth-sources' spec. + (auth-source-backend-parse-parameters): Fill in the backend parameters. + (auth-source-search): Main auth-source API entry point. + (auth-source-delete): Wrapper around `auth-source-search' for deletion. + (auth-source-search-collection): Helper function for searching. + (auth-source-netrc-parse, auth-source-netrc-normalize) + (auth-source-netrc-search, auth-source-netrc-create): Netrc backend. + Supports search, create, and delete. + (auth-source-secrets-search, auth-source-secrets-create): Secrets API + backend stubs. + (auth-source-user-or-password): Call `auth-source-search' but it's not + ready yet. + 2011-02-04 Lars Ingebrigtsen <larsi@gnus.org> * message.el (message-setup-1): Remove the read-only stuff, since it diff --git a/lisp/gnus/ChangeLog.2 b/lisp/gnus/ChangeLog.2 index 381ae544b24..4882032f284 100644 --- a/lisp/gnus/ChangeLog.2 +++ b/lisp/gnus/ChangeLog.2 @@ -6088,7 +6088,7 @@ (nntp-retrieve-groups): Ditto for groups. (nntp-retrieve-articles): Ditto for articles. (*): Replaced nntp-possibly-change-group calls to - nntp-with-open-group forms in all, but one, occurrance. + nntp-with-open-group forms in all, but one, occurrence. (nntp-accept-process-output): Bug fix. Detect when called with null process. diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index e94cfb137b0..e033b01ae97 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el @@ -39,23 +39,77 @@ ;;; Code: +(require 'password-cache) +(require 'mm-util) (require 'gnus-util) (require 'netrc) - +(require 'assoc) (eval-when-compile (require 'cl)) +(require 'eieio) + (autoload 'secrets-create-item "secrets") (autoload 'secrets-delete-item "secrets") (autoload 'secrets-get-alias "secrets") -(autoload 'secrets-get-attribute "secrets") +(autoload 'secrets-get-attributes "secrets") (autoload 'secrets-get-secret "secrets") (autoload 'secrets-list-collections "secrets") (autoload 'secrets-search-items "secrets") +(defvar secrets-enabled) + (defgroup auth-source nil "Authentication sources." :version "23.1" ;; No Gnus :group 'gnus) +;;;###autoload +(defcustom auth-source-cache-expiry 7200 + "How many seconds passwords are cached, or nil to disable +expiring. Overrides `password-cache-expiry' through a +let-binding." + :group 'auth-source + :type '(choice (const :tag "Never" nil) + (const :tag "All Day" 86400) + (const :tag "2 Hours" 7200) + (const :tag "30 Minutes" 1800) + (integer :tag "Seconds"))) + +(defclass auth-source-backend () + ((type :initarg :type + :initform 'netrc + :type symbol + :custom symbol + :documentation "The backend type.") + (source :initarg :source + :type string + :custom string + :documentation "The backend source.") + (host :initarg :host + :initform t + :type t + :custom string + :documentation "The backend host.") + (user :initarg :user + :initform t + :type t + :custom string + :documentation "The backend user.") + (port :initarg :port + :initform t + :type t + :custom string + :documentation "The backend protocol.") + (create-function :initarg :create-function + :initform ignore + :type function + :custom function + :documentation "The create function.") + (search-function :initarg :search-function + :initform ignore + :type function + :custom function + :documentation "The search function."))) + (defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993") (pop3 "pop3" "pop" "pop3s" "110" "995") (ssh "ssh" "22") @@ -81,23 +135,28 @@ p))) auth-source-protocols)) -(defvar auth-source-cache (make-hash-table :test 'equal) - "Cache for auth-source data") +(defvar auth-source-creation-defaults nil + "Defaults for creating token values. Usually let-bound.") + +(make-obsolete 'auth-source-hide-passwords nil "Emacs 24.1") + +(defvar auth-source-magic "auth-source-magic ") (defcustom auth-source-do-cache t - "Whether auth-source should cache information." + "Whether auth-source should cache information with `password-cache'." :group 'auth-source :version "23.2" ;; No Gnus :type `boolean) (defcustom auth-source-debug nil "Whether auth-source should log debug messages. -Also see `auth-source-hide-passwords'. If the value is nil, debug messages are not logged. -If the value is t, debug messages are logged with `message'. - In that case, your authentication data will be in the - clear (except for passwords, which are always stripped out). + +If the value is t, debug messages are logged with `message'. In +that case, your authentication data will be in the clear (except +for passwords). + If the value is a function, debug messages are logged by calling that function using the same arguments as `message'." :group 'auth-source @@ -108,65 +167,71 @@ If the value is a function, debug messages are logged by calling (function :tag "Function that takes arguments like `message'") (const :tag "Don't log anything" nil))) -(defcustom auth-source-hide-passwords t - "Whether auth-source should hide passwords in log messages. -Only relevant if `auth-source-debug' is not nil." - :group 'auth-source - :version "23.2" ;; No Gnus - :type `boolean) - -(defcustom auth-sources '((:source "~/.authinfo.gpg") - (:source "~/.authinfo")) +(defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo") "List of authentication sources. -The default will get login and password information from a .gpg -file, which you should set up with the EPA/EPG packages to be -encrypted. See the auth.info manual for details. +The default will get login and password information from +\"~/.authinfo.gpg\", which you should set up with the EPA/EPG +packages to be encrypted. If that file doesn't exist, it will +try the unencrypted version \"~/.authinfo\". + +See the auth.info manual for details. Each entry is the authentication type with optional properties. It's best to customize this with `M-x customize-variable' because the choices can get pretty complex." :group 'auth-source - :version "23.2" ;; No Gnus + :version "24.1" ;; No Gnus :type `(repeat :tag "Authentication Sources" - (list :tag "Source definition" - (const :format "" :value :source) - (choice :tag "Authentication backend choice" - (string :tag "Authentication Source (file)") - (list :tag "secrets.el (Secret Service API/KWallet/GNOME Keyring)" - (const :format "" :value :secrets) - (choice :tag "Collection to use" - (string :tag "Collection name") - (const :tag "Default" 'default) - (const :tag "Login" "login") - (const :tag "Temporary" "session")))) - (repeat :tag "Extra Parameters" :inline t - (choice :tag "Extra parameter" - (list :tag "Host (omit to match as a fallback)" - (const :format "" :value :host) - (choice :tag "Host (machine) choice" - (const :tag "Any" t) - (regexp :tag "Host (machine) regular expression"))) - (list :tag "Protocol (omit to match as a fallback)" - (const :format "" :value :protocol) - (choice :tag "Protocol" - (const :tag "Any" t) - ,@auth-source-protocols-customize)) - (list :tag "User (omit to match as a fallback)" :inline t - (const :format "" :value :user) - (choice :tag "Personality or username" - (const :tag "Any" t) - (string :tag "Specific user name")))))))) + (choice + (string :tag "Just a file") + (const :tag "Default Secrets API Collection" 'default) + (const :tag "Login Secrets API Collection" "secrets:Login") + (const :tag "Temp Secrets API Collection" "secrets:session") + (list :tag "Source definition" + (const :format "" :value :source) + (choice :tag "Authentication backend choice" + (string :tag "Authentication Source (file)") + (list + :tag "Secret Service API/KWallet/GNOME Keyring" + (const :format "" :value :secrets) + (choice :tag "Collection to use" + (string :tag "Collection name") + (const :tag "Default" 'default) + (const :tag "Login" "Login") + (const + :tag "Temporary" "session")))) + (repeat :tag "Extra Parameters" :inline t + (choice :tag "Extra parameter" + (list + :tag "Host" + (const :format "" :value :host) + (choice :tag "Host (machine) choice" + (const :tag "Any" t) + (regexp + :tag "Regular expression"))) + (list + :tag "Protocol" + (const :format "" :value :port) + (choice + :tag "Protocol" + (const :tag "Any" t) + ,@auth-source-protocols-customize)) + (list :tag "User" :inline t + (const :format "" :value :user) + (choice :tag "Personality/Username" + (const :tag "Any" t) + (string :tag "Name"))))))))) (defcustom auth-source-gpg-encrypt-to t "List of recipient keys that `authinfo.gpg' encrypted to. If the value is not a list, symmetric encryption will be used." :group 'auth-source - :version "23.2" ;; No Gnus + :version "24.1" ;; No Gnus :type '(choice (const :tag "Symmetric encryption" t) - (repeat :tag "Recipient public keys" - (string :tag "Recipient public key")))) + (repeat :tag "Recipient public keys" + (string :tag "Recipient public key")))) ;; temp for debugging ;; (unintern 'auth-source-protocols) @@ -184,255 +249,919 @@ If the value is not a list, symmetric encryption will be used." ;; (auth-source-user-or-password-imap "password" "imap.myhost.com") ;; (auth-source-protocol-defaults 'imap) -;; (let ((auth-source-debug 'debug)) (auth-source-debug "hello")) -;; (let ((auth-source-debug t)) (auth-source-debug "hello")) -;; (let ((auth-source-debug nil)) (auth-source-debug "hello")) +;; (let ((auth-source-debug 'debug)) (auth-source-do-debug "hello")) +;; (let ((auth-source-debug t)) (auth-source-do-debug "hello")) +;; (let ((auth-source-debug nil)) (auth-source-do-debug "hello")) (defun auth-source-do-debug (&rest msg) - ;; set logger to either the function in auth-source-debug or 'message - ;; note that it will be 'message if auth-source-debug is nil, so - ;; we also check the value (when auth-source-debug - (let ((logger (if (functionp auth-source-debug) - auth-source-debug - 'message))) - (apply logger msg)))) - -;; (auth-source-pick nil :host "any" :protocol 'imap :user "joe") -;; (auth-source-pick t :host "any" :protocol 'imap :user "joe") -;; (setq auth-sources '((:source (:secrets default) :host t :protocol t :user "joe") -;; (:source (:secrets "session") :host t :protocol t :user "joe") -;; (:source (:secrets "login") :host t :protocol t) -;; (:source "~/.authinfo.gpg" :host t :protocol t))) - -;; (setq auth-sources '((:source (:secrets default) :host t :protocol t :user "joe") -;; (:source (:secrets "session") :host t :protocol t :user "joe") -;; (:source (:secrets "login") :host t :protocol t) + (apply 'auth-source-do-warn msg))) + +(defun auth-source-do-warn (&rest msg) + (apply + ;; set logger to either the function in auth-source-debug or 'message + ;; note that it will be 'message if auth-source-debug is nil + (if (functionp auth-source-debug) + auth-source-debug + 'message) + msg)) + + +;; (auth-source-pick nil :host "any" :port 'imap :user "joe") +;; (auth-source-pick t :host "any" :port 'imap :user "joe") +;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe") +;; (:source (:secrets "session") :host t :port t :user "joe") +;; (:source (:secrets "Login") :host t :port t) +;; (:source "~/.authinfo.gpg" :host t :port t))) + +;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe") +;; (:source (:secrets "session") :host t :port t :user "joe") +;; (:source (:secrets "Login") :host t :port t) ;; )) -;; (setq auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t))) - -(defun auth-get-source (entry) - "Return the source string of ENTRY, which is one entry in `auth-sources'. -If it is a Secret Service API, return the collection name, otherwise -the file name." - (let ((source (plist-get entry :source))) - (if (stringp source) - source - ;; Secret Service API. - (setq source (plist-get source :secrets)) - (when (eq source 'default) - (setq source (or (secrets-get-alias "default") "login"))) - (or source "session")))) - -(defun auth-source-pick (&rest spec) - "Parse `auth-sources' for matches of the SPEC plist. - -Common keys are :host, :protocol, and :user. A value of t in -SPEC means to always succeed in the match. A string value is -matched as a regex." - (let ((keys (loop for i below (length spec) by 2 collect (nth i spec))) - choices) - (dolist (choice (copy-tree auth-sources) choices) - (let ((source (plist-get choice :source)) - (match t)) - (when - (and - ;; Check existence of source. - (if (consp source) - ;; Secret Service API. - (member (auth-get-source choice) (secrets-list-collections)) - ;; authinfo file. - (file-exists-p source)) - - ;; Check keywords. - (dolist (k keys match) - (let* ((v (plist-get spec k)) - (choicev (if (plist-member choice k) - (plist-get choice k) t))) - (setq match - (and match - (or - ;; source always matches spec key - (eq t choicev) - ;; source key gives regex to match against spec - (and (stringp choicev) (string-match choicev v)) - ;; source key gives symbol to match against spec - (and (symbolp choicev) (eq choicev v)))))))) - - (add-to-list 'choices choice 'append)))))) - -(defun auth-source-retrieve (mode entry &rest spec) - "Retrieve MODE credentials according to SPEC from ENTRY." - (catch 'no-password - (let ((host (plist-get spec :host)) - (user (plist-get spec :user)) - (prot (plist-get spec :protocol)) - (source (plist-get entry :source)) - result) - (cond - ;; Secret Service API. - ((consp source) - (let ((coll (auth-get-source entry)) - item) - ;; Loop over candidates with a matching host attribute. - (dolist (elt (secrets-search-items coll :host host) item) - (when (and (or (not user) - (string-equal - user (secrets-get-attribute coll elt :user))) - (or (not prot) - (string-equal - prot (secrets-get-attribute coll elt :protocol)))) - (setq item elt) - (return elt))) - ;; Compose result. - (when item - (setq result - (mapcar (lambda (m) - (if (string-equal "password" m) - (or (secrets-get-secret coll item) - ;; When we do not find a password, - ;; we return nil anyway. - (throw 'no-password nil)) - (or (secrets-get-attribute coll item :user) - user))) - (if (consp mode) mode (list mode))))) - (if (consp mode) result (car result)))) - ;; Anything else is netrc. - (t - (let ((search (list source (list host) (list (format "%s" prot)) - (auth-source-protocol-defaults prot)))) - (setq result - (mapcar (lambda (m) - (if (string-equal "password" m) - (or (apply - 'netrc-machine-user-or-password m search) - ;; When we do not find a password, we - ;; return nil anyway. - (throw 'no-password nil)) - (or (apply - 'netrc-machine-user-or-password m search) - user))) - (if (consp mode) mode (list mode))))) - (if (consp mode) result (car result))))))) - -(defun auth-source-create (mode entry &rest spec) - "Create interactively credentials according to SPEC in ENTRY. -Return structure as specified by MODE." - (let* ((host (plist-get spec :host)) - (user (plist-get spec :user)) - (prot (plist-get spec :protocol)) - (source (plist-get entry :source)) - (name (concat (if user (format "%s@" user)) - host - (if prot (format ":%s" prot)))) - result) - (setq result - (mapcar - (lambda (m) - (cons - m - (cond - ((equal "password" m) - (let ((passwd (read-passwd - (format "Password for %s on %s: " prot host)))) - (cond - ;; Secret Service API. - ((consp source) - (apply - 'secrets-create-item - (auth-get-source entry) name passwd spec)) - (t)) ;; netrc not implemented yes. - passwd)) - ((equal "login" m) - (or user - (read-string - (format "User name for %s on %s (default %s): " prot host - (user-login-name)) - nil nil (user-login-name)))) - (t - "unknownuser")))) - (if (consp mode) mode (list mode)))) - ;; Allow the source to save the data. - (cond - ((consp source) - ;; Secret Service API -- not implemented. - ) - (t - ;; netrc interface. - (when (y-or-n-p (format "Do you want to save this password in %s? " - source)) - ;; the code below is almost same as `netrc-store-data' except - ;; the `epa-file-encrypt-to' hack (see bug#7487). - (with-temp-buffer - (when (file-exists-p source) - (insert-file-contents source)) - (when auth-source-gpg-encrypt-to - ;; making `epa-file-encrypt-to' local to this buffer lets - ;; epa-file skip the key selection query (see the - ;; `local-variable-p' check in `epa-file-write-region'). - (unless (local-variable-p 'epa-file-encrypt-to (current-buffer)) - (make-local-variable 'epa-file-encrypt-to)) - (if (listp auth-source-gpg-encrypt-to) - (setq epa-file-encrypt-to auth-source-gpg-encrypt-to))) - (goto-char (point-max)) - (unless (bolp) - (insert "\n")) - (insert (format "machine %s login %s password %s port %s\n" - host - (or user (cdr (assoc "login" result))) - (cdr (assoc "password" result)) - prot)) - (write-region (point-min) (point-max) source nil 'silent))))) - (if (consp mode) - (mapcar #'cdr result) - (cdar result)))) - -(defun auth-source-delete (entry &rest spec) - "Delete credentials according to SPEC in ENTRY." - (let ((host (plist-get spec :host)) - (user (plist-get spec :user)) - (prot (plist-get spec :protocol)) - (source (plist-get entry :source))) - (cond - ;; Secret Service API. - ((consp source) - (let ((coll (auth-get-source entry))) - ;; Loop over candidates with a matching host attribute. - (dolist (elt (secrets-search-items coll :host host)) - (when (and (or (not user) - (string-equal - user (secrets-get-attribute coll elt :user))) - (or (not prot) - (string-equal - prot (secrets-get-attribute coll elt :protocol)))) - (secrets-delete-item coll elt))))) - (t)))) ;; netrc not implemented yes. - -(defun auth-source-forget-user-or-password - (mode host protocol &optional username) - "Remove cached authentication token." - (interactive "slogin/password: \nsHost: \nsProtocol: \n") ;for testing - (remhash - (if username - (format "%s %s:%s %s" mode host protocol username) - (format "%s %s:%s" mode host protocol)) - auth-source-cache)) +;; (setq auth-sources '((:source "~/.authinfo.gpg" :host t :port t))) + +;; (auth-source-backend-parse "myfile.gpg") +;; (auth-source-backend-parse 'default) +;; (auth-source-backend-parse "secrets:Login") + +(defun auth-source-backend-parse (entry) + "Creates an auth-source-backend from an ENTRY in `auth-sources'." + (auth-source-backend-parse-parameters + entry + (cond + ;; take 'default and recurse to get it as a Secrets API default collection + ;; matching any user, host, and protocol + ((eq entry 'default) + (auth-source-backend-parse '(:source (:secrets default)))) + ;; take secrets:XYZ and recurse to get it as Secrets API collection "XYZ" + ;; matching any user, host, and protocol + ((and (stringp entry) (string-match "^secrets:\\(.+\\)" entry)) + (auth-source-backend-parse `(:source (:secrets ,(match-string 1 entry))))) + ;; take just a file name and recurse to get it as a netrc file + ;; matching any user, host, and protocol + ((stringp entry) + (auth-source-backend-parse `(:source ,entry))) + + ;; a file name with parameters + ((stringp (plist-get entry :source)) + (auth-source-backend + (plist-get entry :source) + :source (plist-get entry :source) + :type 'netrc + :search-function 'auth-source-netrc-search + :create-function 'auth-source-netrc-create)) + + ;; the Secrets API. We require the package, in order to have a + ;; defined value for `secrets-enabled'. + ((and + (not (null (plist-get entry :source))) ; the source must not be nil + (listp (plist-get entry :source)) ; and it must be a list + (require 'secrets nil t) ; and we must load the Secrets API + secrets-enabled) ; and that API must be enabled + + ;; the source is either the :secrets key in ENTRY or + ;; if that's missing or nil, it's "session" + (let ((source (or (plist-get (plist-get entry :source) :secrets) + "session"))) + + ;; if the source is a symbol, we look for the alias named so, + ;; and if that alias is missing, we use "Login" + (when (symbolp source) + (setq source (or (secrets-get-alias (symbol-name source)) + "Login"))) + + (if (featurep 'secrets) + (auth-source-backend + (format "Secrets API (%s)" source) + :source source + :type 'secrets + :search-function 'auth-source-secrets-search + :create-function 'auth-source-secrets-create) + (auth-source-do-warn + "auth-source-backend-parse: no Secrets API, ignoring spec: %S" entry) + (auth-source-backend + (format "Ignored Secrets API (%s)" source) + :source "" + :type 'ignore)))) + + ;; none of them + (t + (auth-source-do-warn + "auth-source-backend-parse: invalid backend spec: %S" entry) + (auth-source-backend + "Empty" + :source "" + :type 'ignore))))) + +(defun auth-source-backend-parse-parameters (entry backend) + "Fills in the extra auth-source-backend parameters of ENTRY. +Using the plist ENTRY, get the :host, :port, and :user search +parameters." + (let ((entry (if (stringp entry) + nil + entry)) + val) + (when (setq val (plist-get entry :host)) + (oset backend host val)) + (when (setq val (plist-get entry :user)) + (oset backend user val)) + (when (setq val (plist-get entry :port)) + (oset backend port val))) + backend) + +;; (mapcar 'auth-source-backend-parse auth-sources) + +(defun* auth-source-search (&rest spec + &key type max host user port secret + create delete + &allow-other-keys) + "Search or modify authentication backends according to SPEC. + +This function parses `auth-sources' for matches of the SPEC +plist. It can optionally create or update an authentication +token if requested. A token is just a standard Emacs property +list with a :secret property that can be a function; all the +other properties will always hold scalar values. + +Typically the :secret property, if present, contains a password. + +Common search keys are :max, :host, :port, and :user. In +addition, :create specifies how tokens will be or created. +Finally, :type can specify which backend types you want to check. + +A string value is always matched literally. A symbol is matched +as its string value, literally. All the SPEC values can be +single values (symbol or string) or lists thereof (in which case +any of the search terms matches). + +:create t means to create a token if possible. + +A new token will be created if no matching tokens were found. +The new token will have only the keys the backend requires. For +the netrc backend, for instance, that's the user, host, and +port keys. + +Here's an example: + +\(let ((auth-source-creation-defaults '((user . \"defaultUser\") + (A . \"default A\")))) + (auth-source-search :host \"mine\" :type 'netrc :max 1 + :P \"pppp\" :Q \"qqqq\" + :create t)) + +which says: + +\"Search for any entry matching host 'mine' in backends of type + 'netrc', maximum one result. + + Create a new entry if you found none. The netrc backend will + automatically require host, user, and port. The host will be + 'mine'. We prompt for the user with default 'defaultUser' and + for the port without a default. We will not prompt for A, Q, + or P. The resulting token will only have keys user, host, and + port.\" + +:create '(A B C) also means to create a token if possible. + +The behavior is like :create t but if the list contains any +parameter, that parameter will be required in the resulting +token. The value for that parameter will be obtained from the +search parameters or from user input. If any queries are needed, +the alist `auth-source-creation-defaults' will be checked for the +default prompt. + +Here's an example: + +\(let ((auth-source-creation-defaults '((user . \"defaultUser\") + (A . \"default A\")))) + (auth-source-search :host '(\"nonesuch\" \"twosuch\") :type 'netrc :max 1 + :P \"pppp\" :Q \"qqqq\" + :create '(A B Q))) + +which says: + +\"Search for any entry matching host 'nonesuch' + or 'twosuch' in backends of type 'netrc', maximum one result. + + Create a new entry if you found none. The netrc backend will + automatically require host, user, and port. The host will be + 'nonesuch' and Q will be 'qqqq'. We prompt for A with default + 'default A', for B and port with default nil, and for the + user with default 'defaultUser'. We will not prompt for Q. The + resulting token will have keys user, host, port, A, B, and Q. + It will not have P with any value, even though P is used in the + search to find only entries that have P set to 'pppp'.\" + +When multiple values are specified in the search parameter, the +user is prompted for which one. So :host (X Y Z) would ask the +user to choose between X, Y, and Z. + +This creation can fail if the search was not specific enough to +create a new token (it's up to the backend to decide that). You +should `catch' the backend-specific error as usual. Some +backends (netrc, at least) will prompt the user rather than throw +an error. + +:delete t means to delete any found entries. nil by default. +Use `auth-source-delete' in ELisp code instead of calling +`auth-source-search' directly with this parameter. + +:type (X Y Z) will check only those backend types. 'netrc and +'secrets are the only ones supported right now. + +:max N means to try to return at most N items (defaults to 1). +When 0 the function will return just t or nil to indicate if any +matches were found. More than N items may be returned, depending +on the search and the backend. + +:host (X Y Z) means to match only hosts X, Y, or Z according to +the match rules above. Defaults to t. + +:user (X Y Z) means to match only users X, Y, or Z according to +the match rules above. Defaults to t. + +:port (P Q R) means to match only protocols P, Q, or R. +Defaults to t. + +:K (V1 V2 V3) for any other key K will match values V1, V2, or +V3 (note the match rules above). + +The return value is a list with at most :max tokens. Each token +is a plist with keys :backend :host :port :user, plus any other +keys provided by the backend (notably :secret). But note the +exception for :max 0, which see above. + +The token's :secret key can hold a function. In that case you +must call it to obtain the actual value." + (let* ((backends (mapcar 'auth-source-backend-parse auth-sources)) + (max (or max 1)) + (ignored-keys '(:create :delete :max)) + (keys (loop for i below (length spec) by 2 + unless (memq (nth i spec) ignored-keys) + collect (nth i spec))) + (found (auth-source-recall spec)) + filtered-backends accessor-key found-here goal matches backend) + + (if (and found auth-source-do-cache) + (auth-source-do-debug + "auth-source-search: found %d CACHED results matching %S" + (length found) spec) + + (assert + (or (eq t create) (listp create)) t + "Invalid auth-source :create parameter (must be nil, t, or a list): %s %s") + + (setq filtered-backends (copy-sequence backends)) + (dolist (backend backends) + (dolist (key keys) + ;; ignore invalid slots + (condition-case signal + (unless (eval `(auth-source-search-collection + (plist-get spec key) + (oref backend ,key))) + (setq filtered-backends (delq backend filtered-backends)) + (return)) + (invalid-slot-name)))) + + (auth-source-do-debug + "auth-source-search: found %d backends matching %S" + (length filtered-backends) spec) + + ;; (debug spec "filtered" filtered-backends) + (setq goal max) + ;; First go through all the backends without :create, so we can + ;; query them all. + (let ((uspec (copy-sequence spec))) + (plist-put uspec :create nil) + (dolist (backend filtered-backends) + (let ((match (apply + (slot-value backend 'search-function) + :backend backend + uspec))) + (when match + (push (list backend match) matches))))) + ;; If we didn't find anything, then we allow the backend(s) to + ;; create the entries. + (when (and create + (not matches)) + (dolist (backend filtered-backends) + (unless matches + (let ((match (apply + (slot-value backend 'search-function) + :backend backend + :create create + :delete delete + spec))) + (when match + (push (list backend match) matches)))))) + + (setq backend (caar matches) + found-here (cadar matches)) + + (block nil + ;; if max is 0, as soon as we find something, return it + (when (and (zerop max) (> 0 (length found-here))) + (return t)) + + ;; decrement the goal by the number of new results + (decf goal (length found-here)) + ;; and append the new results to the full list + (setq found (append found found-here)) + + (auth-source-do-debug + "auth-source-search: found %d results (max %d/%d) in %S matching %S" + (length found-here) max goal backend spec) + + ;; return full list if the goal is 0 or negative + (when (zerop (max 0 goal)) + (return found)) + + ;; change the :max parameter in the spec to the goal + (setq spec (plist-put spec :max goal)) + + (when (and found auth-source-do-cache) + (auth-source-remember spec found)))) + + found)) + +;;; (auth-source-search :max 1) +;;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret)) +;;; (auth-source-search :host "nonesuch" :type 'netrc :K 1) +;;; (auth-source-search :host "nonesuch" :type 'secrets) + +(defun* auth-source-delete (&rest spec + &key delete + &allow-other-keys) + "Delete entries from the authentication backends according to SPEC. +Calls `auth-source-search' with the :delete property in SPEC set to t. +The backend may not actually delete the entries. + +Returns the deleted entries." + (auth-source-search (plist-put spec :delete t))) + +(defun auth-source-search-collection (collection value) + "Returns t is VALUE is t or COLLECTION is t or contains VALUE." + (when (and (atom collection) (not (eq t collection))) + (setq collection (list collection))) + + ;; (debug :collection collection :value value) + (or (eq collection t) + (eq value t) + (equal collection value) + (member value collection))) (defun auth-source-forget-all-cached () - "Forget all cached auth-source authentication tokens." + "Forget all cached auth-source data." (interactive) - (setq auth-source-cache (make-hash-table :test 'equal))) + (loop for sym being the symbols of password-data + ;; when the symbol name starts with auth-source-magic + when (string-match (concat "^" auth-source-magic) + (symbol-name sym)) + ;; remove that key + do (password-cache-remove (symbol-name sym)))) + +(defun auth-source-remember (spec found) + "Remember FOUND search results for SPEC." + (let ((password-cache-expiry auth-source-cache-expiry)) + (password-cache-add + (concat auth-source-magic (format "%S" spec)) found))) + +(defun auth-source-recall (spec) + "Recall FOUND search results for SPEC." + (password-read-from-cache + (concat auth-source-magic (format "%S" spec)))) + +(defun auth-source-forget (spec) + "Forget any cached data matching SPEC exactly. + +This is the same SPEC you passed to `auth-source-search'. +Returns t or nil for forgotten or not found." + (password-cache-remove (concat auth-source-magic (format "%S" spec)))) + +;;; (loop for sym being the symbols of password-data when (string-match (concat "^" auth-source-magic) (symbol-name sym)) collect (symbol-name sym)) + +;;; (auth-source-remember '(:host "wedd") '(4 5 6)) +;;; (auth-source-remember '(:host "xedd") '(1 2 3)) +;;; (auth-source-recall '(:host "xedd")) +;;; (auth-source-recall '(:host t)) +;;; (auth-source-forget+ :host t) + +(defun* auth-source-forget+ (&rest spec &allow-other-keys) + "Forget any cached data matching SPEC. Returns forgotten count. + +This is not a full `auth-source-search' spec but works similarly. +For instance, \(:host \"myhost\" \"yourhost\") would find all the +cached data that was found with a search for those two hosts, +while \(:host t) would find all host entries." + (let ((count 0) + sname) + (loop for sym being the symbols of password-data + ;; when the symbol name matches with auth-source-magic + when (and (setq sname (symbol-name sym)) + (string-match (concat "^" auth-source-magic "\\(.+\\)") + sname) + ;; and the spec matches what was stored in the cache + (auth-source-specmatchp spec (read (match-string 1 sname)))) + ;; remove that key + do (progn + (password-cache-remove sname) + (incf count))) + count)) + +(defun auth-source-specmatchp (spec stored) + (let ((keys (loop for i below (length spec) by 2 + collect (nth i spec)))) + (not (eq + (dolist (key keys) + (unless (auth-source-search-collection (plist-get stored key) + (plist-get spec key)) + (return 'no))) + 'no)))) + +;;; Backend specific parsing: netrc/authinfo backend + +(defvar auth-source-netrc-cache nil) + +;;; (auth-source-netrc-parse "~/.authinfo.gpg") +(defun* auth-source-netrc-parse (&rest + spec + &key file max host user port delete + &allow-other-keys) + "Parse FILE and return a list of all entries in the file. +Note that the MAX parameter is used so we can exit the parse early." + (if (listp file) + ;; We got already parsed contents; just return it. + file + (when (file-exists-p file) + (with-temp-buffer + (let ((tokens '("machine" "host" "default" "login" "user" + "password" "account" "macdef" "force" + "port" "protocol")) + (max (or max 5000)) ; sanity check: default to stop at 5K + (modified 0) + alist elem result pair) + (if (and auth-source-netrc-cache + (equal (car auth-source-netrc-cache) + (nth 5 (file-attributes file)))) + (insert (base64-decode-string + (rot13-string (cdr auth-source-netrc-cache)))) + (insert-file-contents file) + (when (string-match "\\.gpg\\'" file) + ;; Store the contents of the file heavily encrypted in memory. + (setq auth-source-netrc-cache + (cons (nth 5 (file-attributes file)) + (rot13-string + (base64-encode-string + (buffer-string))))))) + (goto-char (point-min)) + ;; Go through the file, line by line. + (while (and (not (eobp)) + (> max 0)) + + (narrow-to-region (point) (point-at-eol)) + ;; For each line, get the tokens and values. + (while (not (eobp)) + (skip-chars-forward "\t ") + ;; Skip lines that begin with a "#". + (if (eq (char-after) ?#) + (goto-char (point-max)) + (unless (eobp) + (setq elem + (if (= (following-char) ?\") + (read (current-buffer)) + (buffer-substring + (point) (progn (skip-chars-forward "^\t ") + (point))))) + (cond + ((equal elem "macdef") + ;; We skip past the macro definition. + (widen) + (while (and (zerop (forward-line 1)) + (looking-at "$"))) + (narrow-to-region (point) (point))) + ((member elem tokens) + ;; Tokens that don't have a following value are ignored, + ;; except "default". + (when (and pair (or (cdr pair) + (equal (car pair) "default"))) + (push pair alist)) + (setq pair (list elem))) + (t + ;; Values that haven't got a preceding token are ignored. + (when pair + (setcdr pair elem) + (push pair alist) + (setq pair nil))))))) + + (when (and alist + (> max 0) + (auth-source-search-collection + host + (or + (aget alist "machine") + (aget alist "host") + t)) + (auth-source-search-collection + user + (or + (aget alist "login") + (aget alist "account") + (aget alist "user") + t)) + (auth-source-search-collection + port + (or + (aget alist "port") + (aget alist "protocol") + t))) + (decf max) + (push (nreverse alist) result) + ;; to delete a line, we just comment it out + (when delete + (goto-char (point-min)) + (insert "#") + (incf modified))) + (setq alist nil + pair nil) + (widen) + (forward-line 1)) + + (when (< 0 modified) + (when auth-source-gpg-encrypt-to + ;; (see bug#7487) making `epa-file-encrypt-to' local to + ;; this buffer lets epa-file skip the key selection query + ;; (see the `local-variable-p' check in + ;; `epa-file-write-region'). + (unless (local-variable-p 'epa-file-encrypt-to (current-buffer)) + (make-local-variable 'epa-file-encrypt-to)) + (if (listp auth-source-gpg-encrypt-to) + (setq epa-file-encrypt-to auth-source-gpg-encrypt-to))) + + ;; ask AFTER we've successfully opened the file + (when (y-or-n-p (format "Save file %s? (%d modifications)" + file modified)) + (write-region (point-min) (point-max) file nil 'silent) + (auth-source-do-debug + "auth-source-netrc-parse: modified %d lines in %s" + modified file))) + + (nreverse result)))))) + +(defun auth-source-netrc-normalize (alist) + (mapcar (lambda (entry) + (let (ret item) + (while (setq item (pop entry)) + (let ((k (car item)) + (v (cdr item))) + + ;; apply key aliases + (setq k (cond ((member k '("machine")) "host") + ((member k '("login" "account")) "user") + ((member k '("protocol")) "port") + ((member k '("password")) "secret") + (t k))) + + ;; send back the secret in a function (lexical binding) + (when (equal k "secret") + (setq v (lexical-let ((v v)) + (lambda () v)))) + + (setq ret (plist-put ret + (intern (concat ":" k)) + v)) + )) + ret)) + alist)) + +;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret)) +;;; (funcall secret) + +(defun* auth-source-netrc-search (&rest + spec + &key backend create delete + type max host user port + &allow-other-keys) +"Given a property list SPEC, return search matches from the :backend. +See `auth-source-search' for details on SPEC." + ;; just in case, check that the type is correct (null or same as the backend) + (assert (or (null type) (eq type (oref backend type))) + t "Invalid netrc search: %s %s") + + (let ((results (auth-source-netrc-normalize + (auth-source-netrc-parse + :max max + :delete delete + :file (oref backend source) + :host (or host t) + :user (or user t) + :port (or port t))))) + + ;; if we need to create an entry AND none were found to match + (when (and create + (= 0 (length results))) + + ;; create based on the spec and record the value + (setq results (or + ;; if the user did not want to create the entry + ;; in the file, it will be returned + (apply (slot-value backend 'create-function) spec) + ;; if not, we do the search again without :create + ;; to get the updated data. + + ;; the result will be returned, even if the search fails + (apply 'auth-source-netrc-search + (plist-put spec :create nil))))) + results)) + +;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t) +;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t :create-extra-keys '((A "default A") (B))) + +(defun* auth-source-netrc-create (&rest spec + &key backend + secret host user port create + &allow-other-keys) + (let* ((base-required '(host user port secret)) + ;; we know (because of an assertion in auth-source-search) that the + ;; :create parameter is either t or a list (which includes nil) + (create-extra (if (eq t create) nil create)) + (required (append base-required create-extra)) + (file (oref backend source)) + (add "") + (show "") + ;; `valist' is an alist + valist + ;; `artificial' will be returned if no creation is needed + artificial) -;; (progn -;; (auth-source-forget-all-cached) -;; (list -;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other") -;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other" "tzz") -;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other" "joe"))) + ;; only for base required elements (defined as function parameters): + ;; fill in the valist with whatever data we may have from the search + ;; we complete the first value if it's a list and use the value otherwise + (dolist (br base-required) + (when (symbol-value br) + (let ((br-choice (cond + ;; all-accepting choice (predicate is t) + ((eq t (symbol-value br)) nil) + ;; just the value otherwise + (t (symbol-value br))))) + (when br-choice + (aput 'valist br br-choice))))) + + ;; for extra required elements, see if the spec includes a value for them + (dolist (er create-extra) + (let ((name (concat ":" (symbol-name er))) + (keys (loop for i below (length spec) by 2 + collect (nth i spec)))) + (dolist (k keys) + (when (equal (symbol-name k) name) + (aput 'valist er (plist-get spec k)))))) + + ;; for each required element + (dolist (r required) + (let* ((data (aget valist r)) + (given-default (aget auth-source-creation-defaults r)) + ;; the defaults are simple + (default (cond + ((and (not given-default) (eq r 'user)) + (user-login-name)) + ;; note we need this empty string + ((and (not given-default) (eq r 'port)) + "") + (t given-default))) + ;; the prompt's default string depends on the data so far + (default-string (if (and default (< 0 (length default))) + (format " (default %s)" default) + " (no default)")) + ;; the prompt should also show what's entered so far + (user-value (aget valist 'user)) + (host-value (aget valist 'host)) + (port-value (aget valist 'port)) + ;; note this handles lists by just printing them + ;; later we allow the user to use completing-read to pick + (info-so-far (concat (if user-value + (format "%s@" user-value) + "[USER?]") + (if host-value + (format "%s" host-value) + "[HOST?]") + (if port-value + ;; this distinguishes protocol between + (if (zerop (length port-value)) + "" ; 'entered as "no default"' vs. + (format ":%s" port-value)) ; given + ;; and this is when the protocol is unknown + "[PORT?]")))) + + ;; now prompt if the search SPEC did not include a required key; + ;; take the result and put it in `data' AND store it in `valist' + (aput 'valist r + (setq data + (cond + ((and (null data) (eq r 'secret)) + ;; special case prompt for passwords + (read-passwd (format "Password for %s: " info-so-far))) + ((null data) + (read-string + (format "Enter %s for %s%s: " + r info-so-far default-string) + nil nil default)) + ((listp data) + (completing-read + (format "Enter %s for %s (TAB to see the choices): " + r info-so-far) + data + nil ; no predicate + t ; require a match + ;; note the default is nil, but if the user + ;; hits RET we'll get "", which is handled OK later + nil)) + (t data)))) + + (when data + (setq artificial (plist-put artificial + (intern (concat ":" (symbol-name r))) + (if (eq r 'secret) + (lexical-let ((data data)) + (lambda () data)) + data)))) + + ;; when r is not an empty string... + (when (and (stringp data) + (< 0 (length data))) + (let ((printer (lambda (hide) + ;; append the key (the symbol name of r) + ;; and the value in r + (format "%s%s %S" + ;; prepend a space + (if (zerop (length add)) "" " ") + ;; remap auth-source tokens to netrc + (case r + ('user "login") + ('host "machine") + ('secret "password") + ('port "port") ; redundant but clearer + (t (symbol-name r))) + ;; the value will be printed in %S format + (if (and hide (eq r 'secret)) + "HIDDEN_SECRET" + data))))) + (setq add (concat add (funcall printer nil))) + (setq show (concat show (funcall printer t))))))) + + (with-temp-buffer + (when (file-exists-p file) + (insert-file-contents file)) + (when auth-source-gpg-encrypt-to + ;; (see bug#7487) making `epa-file-encrypt-to' local to + ;; this buffer lets epa-file skip the key selection query + ;; (see the `local-variable-p' check in + ;; `epa-file-write-region'). + (unless (local-variable-p 'epa-file-encrypt-to (current-buffer)) + (make-local-variable 'epa-file-encrypt-to)) + (if (listp auth-source-gpg-encrypt-to) + (setq epa-file-encrypt-to auth-source-gpg-encrypt-to))) + (goto-char (point-max)) + + ;; ask AFTER we've successfully opened the file + (if (y-or-n-p (format "Add to file %s: line [%s]" file show)) + (progn + (unless (bolp) + (insert "\n")) + (insert add "\n") + (write-region (point-min) (point-max) file nil 'silent) + (auth-source-do-debug + "auth-source-netrc-create: wrote 1 new line to %s" + file) + nil) + (list artificial))))) + +;;; Backend specific parsing: Secrets API backend + +;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :create t)) +;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :delete t)) +;;; (let ((auth-sources '(default))) (auth-source-search :max 1)) +;;; (let ((auth-sources '(default))) (auth-source-search)) +;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1)) +;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1 :signon_realm "https://git.gnus.org/Git")) + +(defun* auth-source-secrets-search (&rest + spec + &key backend create delete label + type max host user port + &allow-other-keys) + "Search the Secrets API; spec is like `auth-source'. + +The :label key specifies the item's label. It is the only key +that can specify a substring. Any :label value besides a string +will allow any label. + +All other search keys must match exactly. If you need substring +matching, do a wider search and narrow it down yourself. + +You'll get back all the properties of the token as a plist. + +Here's an example that looks for the first item in the 'Login' +Secrets collection: + + \(let ((auth-sources '(\"secrets:Login\"))) + (auth-source-search :max 1) + +Here's another that looks for the first item in the 'Login' +Secrets collection whose label contains 'gnus': + + \(let ((auth-sources '(\"secrets:Login\"))) + (auth-source-search :max 1 :label \"gnus\") + +And this one looks for the first item in the 'Login' Secrets +collection that's a Google Chrome entry for the git.gnus.org site +authentication tokens: + + \(let ((auth-sources '(\"secrets:Login\"))) + (auth-source-search :max 1 :signon_realm \"https://git.gnus.org/Git\")) +" + + ;; TODO + (assert (not create) nil + "The Secrets API auth-source backend doesn't support creation yet") + ;; TODO + ;; (secrets-delete-item coll elt) + (assert (not delete) nil + "The Secrets API auth-source backend doesn't support deletion yet") + + (let* ((coll (oref backend source)) + (max (or max 5000)) ; sanity check: default to stop at 5K + (ignored-keys '(:create :delete :max :backend :label)) + (search-keys (loop for i below (length spec) by 2 + unless (memq (nth i spec) ignored-keys) + collect (nth i spec))) + ;; build a search spec without the ignored keys + ;; if a search key is nil or t (match anything), we skip it + (search-spec (apply 'append (mapcar + (lambda (k) + (if (or (null (plist-get spec k)) + (eq t (plist-get spec k))) + nil + (list k (plist-get spec k)))) + search-keys))) + ;; needed keys (always including host, login, port, and secret) + (returned-keys (mm-delete-duplicates (append + '(:host :login :port :secret) + search-keys))) + (items (loop for item in (apply 'secrets-search-items coll search-spec) + unless (and (stringp label) + (not (string-match label item))) + collect item)) + ;; TODO: respect max in `secrets-search-items', not after the fact + (items (butlast items (- (length items) max))) + ;; convert the item name to a full plist + (items (mapcar (lambda (item) + (append + ;; make an entry for the secret (password) element + (list + :secret + (lexical-let ((v (secrets-get-secret coll item))) + (lambda () v))) + ;; rewrite the entry from ((k1 v1) (k2 v2)) to plist + (apply 'append + (mapcar (lambda (entry) + (list (car entry) (cdr entry))) + (secrets-get-attributes coll item))))) + items)) + ;; ensure each item has each key in `returned-keys' + (items (mapcar (lambda (plist) + (append + (apply 'append + (mapcar (lambda (req) + (if (plist-get plist req) + nil + (list req nil))) + returned-keys)) + plist)) + items))) + items)) + +(defun* auth-source-secrets-create (&rest + spec + &key backend type max host user port + &allow-other-keys) + ;; TODO + ;; (apply 'secrets-create-item (auth-get-source entry) name passwd spec) + (debug spec)) + +;;; older API + +;;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz") + +;; deprecate the old interface +(make-obsolete 'auth-source-user-or-password + 'auth-source-search "Emacs 24.1") +(make-obsolete 'auth-source-forget-user-or-password + 'auth-source-forget "Emacs 24.1") (defun auth-source-user-or-password - (mode host protocol &optional username create-missing delete-existing) - "Find MODE (string or list of strings) matching HOST and PROTOCOL. + (mode host port &optional username create-missing delete-existing) + "Find MODE (string or list of strings) matching HOST and PORT. + +DEPRECATED in favor of `auth-source-search'! USERNAME is optional and will be used as \"login\" in a search across the Secret Service API (see secrets.el) if the resulting @@ -452,79 +1181,54 @@ stored in the password database which matches best (see MODE can be \"login\" or \"password\"." (auth-source-do-debug - "auth-source-user-or-password: get %s for %s (%s) + user=%s" - mode host protocol username) + "auth-source-user-or-password: DEPRECATED get %s for %s (%s) + user=%s" + mode host port username) + (let* ((listy (listp mode)) (mode (if listy mode (list mode))) (cname (if username - (format "%s %s:%s %s" mode host protocol username) - (format "%s %s:%s" mode host protocol))) - (search (list :host host :protocol protocol)) + (format "%s %s:%s %s" mode host port username) + (format "%s %s:%s" mode host port))) + (search (list :host host :port port)) (search (if username (append search (list :user username)) search)) - (found (if (not delete-existing) - (gethash cname auth-source-cache) - (remhash cname auth-source-cache) - nil))) + (search (if create-missing + (append search (list :create t)) + search)) + (search (if delete-existing + (append search (list :delete t)) + search)) + ;; (found (if (not delete-existing) + ;; (gethash cname auth-source-cache) + ;; (remhash cname auth-source-cache) + ;; nil))) + (found nil)) (if found (progn (auth-source-do-debug - "auth-source-user-or-password: cached %s=%s for %s (%s) + %s" + "auth-source-user-or-password: DEPRECATED cached %s=%s for %s (%s) + %s" mode ;; don't show the password - (if (and (member "password" mode) auth-source-hide-passwords) + (if (and (member "password" mode) t) "SECRET" found) - host protocol username) + host port username) found) ; return the found data - ;; else, if not found - (let ((choices (apply 'auth-source-pick search))) - (dolist (choice choices) - (if delete-existing - (apply 'auth-source-delete choice search) - (setq found (apply 'auth-source-retrieve mode choice search))) - (and found (return found))) - - ;; We haven't found something, so we will create it interactively. - (when (and (not found) create-missing) - (setq found (apply 'auth-source-create - mode (if choices - (car choices) - (car auth-sources)) - search))) - - ;; Cache the result. - (when found - (auth-source-do-debug - "auth-source-user-or-password: found %s=%s for %s (%s) + %s" - mode - ;; don't show the password - (if (and (member "password" mode) auth-source-hide-passwords) - "SECRET" found) - host protocol username) - (setq found (if listy found (car-safe found))) - (when auth-source-do-cache - (puthash cname found auth-source-cache))) - - found)))) - -(defun auth-source-protocol-defaults (protocol) - "Return a list of default ports and names for PROTOCOL." - (cdr-safe (assoc protocol auth-source-protocols))) - -(defun auth-source-user-or-password-imap (mode host) - (auth-source-user-or-password mode host 'imap)) - -(defun auth-source-user-or-password-pop3 (mode host) - (auth-source-user-or-password mode host 'pop3)) - -(defun auth-source-user-or-password-ssh (mode host) - (auth-source-user-or-password mode host 'ssh)) - -(defun auth-source-user-or-password-sftp (mode host) - (auth-source-user-or-password mode host 'sftp)) + ;; else, if not found, search with a max of 1 + (let ((choice (nth 0 (apply 'auth-source-search + (append '(:max 1) search))))) + (when choice + (dolist (m mode) + (cond + ((equal "password" m) + (push (if (plist-get choice :secret) + (funcall (plist-get choice :secret)) + nil) found)) + ((equal "login" m) + (push (plist-get choice :user) found))))) + (setq found (nreverse found)) + (setq found (if listy found (car-safe found))))) -(defun auth-source-user-or-password-smtp (mode host) - (auth-source-user-or-password mode host 'smtp)) + found)) (provide 'auth-source) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 54797b2a518..19eee78ab17 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -683,7 +683,7 @@ beginning of a line." :type 'regexp :group 'gnus-article-various) -(defcustom gnus-article-mode-line-format "Gnus: %g [%w] %S%m" +(defcustom gnus-article-mode-line-format "Gnus: %g %S%m" "*The format specification for the article mode line. See `gnus-summary-mode-line-format' for a closer description. @@ -691,6 +691,7 @@ The following additional specs are available: %w The article washing status. %m The number of MIME parts in the article." + :version "24.1" :type 'string :group 'gnus-article-various) @@ -3403,6 +3404,7 @@ possible values." (inhibit-read-only t) (inhibit-point-motion-hooks t) (first t) + (visible-date (mail-fetch-field "Date")) pos date bface eface) (save-excursion (save-restriction @@ -3426,6 +3428,9 @@ possible values." (delete-region (point-at-bol) (progn (gnus-article-forward-header) (point)))) + (when (and (not date) + visible-date) + (setq date visible-date)) (when date (article-transform-date date type bface eface))))))) @@ -3636,10 +3641,11 @@ function and want to see what the date was before converting." (let ((type (get-text-property (match-beginning 0) 'gnus-date-type))) (when (memq type '(lapsed combined-lapsed user-format)) - (unless (= window-start - (save-excursion - (forward-line 1) - (point))) + (when (and window-start + (not (= window-start + (save-excursion + (forward-line 1) + (point))))) (setq window-start nil)) (save-excursion (article-date-ut type t (match-beginning 0))) @@ -4631,6 +4637,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." (forward-line -1)) (set-window-point (get-buffer-window (current-buffer)) (point)) (gnus-configure-windows 'article) + (gnus-run-hooks 'gnus-article-prepare-hook) t)))))) ;;;###autoload @@ -4648,8 +4655,7 @@ If ALL-HEADERS is non-nil, no headers are hidden." gnus-article-image-alist nil) (gnus-run-hooks 'gnus-tmp-internal-hook) (when gnus-display-mime-function - (funcall gnus-display-mime-function)) - (gnus-run-hooks 'gnus-article-prepare-hook))) + (funcall gnus-display-mime-function)))) ;;; ;;; Gnus Sticky Article Mode @@ -6316,7 +6322,8 @@ specifies." (defun gnus-article-next-page-1 (lines) (condition-case () - (let ((scroll-in-place nil)) + (let ((scroll-in-place nil) + (auto-window-vscroll nil)) (scroll-up lines)) (end-of-buffer ;; Long lines may cause an end-of-buffer error. diff --git a/lisp/gnus/gnus-delay.el b/lisp/gnus/gnus-delay.el index a06a510ecdd..bfd17055ea5 100644 --- a/lisp/gnus/gnus-delay.el +++ b/lisp/gnus/gnus-delay.el @@ -78,7 +78,7 @@ DELAY is a string, giving the length of the time. Possible values are: time, then the deadline is tomorrow, else today." (interactive (list (read-string - "Target date (YYYY-MM-DD) or length of delay (units in [mhdwMY]): " + "Target date (YYYY-MM-DD), time (hh:mm), or length of delay (units in [mhdwMY]): " gnus-delay-default-delay))) (let (num unit days year month day hour minute deadline) (cond ((string-match @@ -105,7 +105,7 @@ DELAY is a string, giving the length of the time. Possible values are: (append deadline nil)))) ;; If this time has passed already, add a day. (when (< deadline (gnus-float-time)) - (setq deadline (+ 3600 deadline))) ;3600 secs/day + (setq deadline (+ 86400 deadline))) ; 86400 secs/day ;; Convert seconds to date header. (setq deadline (message-make-date (seconds-to-time deadline)))) diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index 08fef2327ad..b199dcc572c 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1081,14 +1081,14 @@ If VERY-WIDE, make a very wide reply." (gnus-summary-work-articles 1)))) ;; Allow user to require confirmation before replying by mail to the ;; author of a news article (or mail message). - (when (or - (not (or (gnus-news-group-p gnus-newsgroup-name) + (when (or (not (or (gnus-news-group-p gnus-newsgroup-name) gnus-confirm-treat-mail-like-news)) (not (cond ((stringp gnus-confirm-mail-reply-to-news) (string-match gnus-confirm-mail-reply-to-news gnus-newsgroup-name)) ((functionp gnus-confirm-mail-reply-to-news) - (funcall gnus-confirm-mail-reply-to-news gnus-newsgroup-name)) + (funcall gnus-confirm-mail-reply-to-news + gnus-newsgroup-name)) (t gnus-confirm-mail-reply-to-news))) (if (or wide very-wide) t ;; Ignore gnus-confirm-mail-reply-to-news for wide and very @@ -1123,7 +1123,7 @@ If VERY-WIDE, make a very wide reply." (insert headers)) (goto-char (point-max))) (mml-quote-region (point) (point-max)) - (message-reply nil wide) + (message-reply nil wide 'switch-to-buffer) (when yank (gnus-inews-yank-articles yank)) (gnus-summary-handle-replysign))))) diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index b8a6be8702e..e5e2468058c 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -380,13 +380,6 @@ disc." :group 'gnus-newsrc :type 'boolean) -(defcustom gnus-use-backend-marks nil - "If non-nil, Gnus will store and retrieve marks from the backends. -This means that marks will be stored both in .newsrc.eld and in -the backend, and will slow operation down somewhat." - :group 'gnus-newsrc - :type 'boolean) - (defcustom gnus-check-bogus-groups-hook nil "A hook run after removing bogus groups." :group 'gnus-start-server @@ -1509,7 +1502,7 @@ If SCAN, request a scan of that group as well." (gnus-activate-group (gnus-info-group info) nil t)) ;; Allow backends to update marks, - (when gnus-use-backend-marks + (when gnus-propagate-marks (let ((method (inline (gnus-find-method-for-group (gnus-info-group info))))) (when (gnus-check-backend-function 'request-marks (car method)) @@ -1682,7 +1675,20 @@ If SCAN, request a scan of that group as well." (lambda (c1 c2) (< (gnus-method-rank (cadr c1) (car c1)) (gnus-method-rank (cadr c2) (car c2)))))) - + ;; Go through the list of servers and possibly extend methods that + ;; aren't equal (and that need extension; i.e., they are async). + (let ((methods nil)) + (dolist (elem type-cache) + (destructuring-bind (method method-type infos dummy) elem + (let ((gnus-opened-servers methods)) + (when (and (gnus-similar-server-opened method) + (gnus-check-backend-function + 'retrieve-group-data-early (car method))) + (setq method (gnus-server-extend-method + (gnus-info-group (car infos)) + method)) + (setcar elem method)) + (push (list method 'ok) methods))))) ;; Start early async retrieval of data. (dolist (elem type-cache) (destructuring-bind (method method-type infos dummy) elem diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 8fac5021df3..789308c4ab9 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -1235,8 +1235,9 @@ For example: ((1 . cn-gb-2312) (2 . big5))." :group 'gnus-summary-marks) (defcustom gnus-propagate-marks t - "If non-nil, do not propagate marks to the backends." - :version "23.1" ;; No Gnus + "If non-nil, Gnus will store and retrieve marks from the backends. +This means that marks will be stored both in .newsrc.eld and in +the backend, and will slow operation down somewhat." :type 'boolean :group 'gnus-summary-marks) @@ -4067,6 +4068,7 @@ If NO-DISPLAY, don't generate a summary buffer." ;; gnus-summary-prepare-hook since kill processing may not ;; work with hidden articles. (gnus-summary-maybe-hide-threads) + (gnus-configure-windows 'summary) (when kill-buffer (gnus-kill-or-deaden-summary kill-buffer)) (gnus-summary-auto-select-subject) @@ -4076,7 +4078,6 @@ If NO-DISPLAY, don't generate a summary buffer." gnus-newsgroup-unreads gnus-auto-select-first) (progn - (gnus-configure-windows 'summary) (let ((art (gnus-summary-article-number))) (unless (and (not gnus-plugged) (or (memq art gnus-newsgroup-undownloaded) @@ -7168,6 +7169,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (let* ((group gnus-newsgroup-name) (quit-config (gnus-group-quit-config gnus-newsgroup-name)) (gnus-group-is-exiting-p t) + (article-buffer gnus-article-buffer) (mode major-mode) (group-point nil) (buf (current-buffer))) @@ -7220,16 +7222,6 @@ If FORCE (the prefix), also save the .newsrc file(s)." (when (eq mode 'gnus-summary-mode) (gnus-kill-buffer buf))) - ;; If we have several article buffers, we kill them at exit. - (unless gnus-single-article-buffer - (when (gnus-buffer-live-p gnus-article-buffer) - (with-current-buffer gnus-article-buffer - ;; Don't kill sticky article buffers - (unless (eq major-mode 'gnus-sticky-article-mode) - (gnus-kill-buffer gnus-article-buffer) - (setq gnus-article-current nil)))) - (gnus-kill-buffer gnus-original-article-buffer)) - (setq gnus-current-select-method gnus-select-method) (set-buffer gnus-group-buffer) (if quit-config @@ -7241,6 +7233,17 @@ If FORCE (the prefix), also save the .newsrc file(s)." (if win (set-window-point win (point)))) (unless leave-hidden (gnus-configure-windows 'group 'force))) + + ;; If we have several article buffers, we kill them at exit. + (unless gnus-single-article-buffer + (when (gnus-buffer-live-p article-buffer) + (with-current-buffer article-buffer + ;; Don't kill sticky article buffers + (unless (eq major-mode 'gnus-sticky-article-mode) + (gnus-kill-buffer article-buffer) + (setq gnus-article-current nil)))) + (gnus-kill-buffer gnus-original-article-buffer)) + ;; Clear the current group name. (unless quit-config (setq gnus-newsgroup-name nil))))) @@ -7269,6 +7272,8 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-kill-buffer gnus-article-buffer) (gnus-kill-buffer gnus-original-article-buffer) (setq gnus-article-current nil)) + ;; Return to the group buffer. + (gnus-configure-windows 'group 'force) (if (not gnus-kill-summary-on-exit) (gnus-deaden-summary) (gnus-close-group group) @@ -7280,8 +7285,6 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-async-prefetch-remove-group group) (when (get-buffer gnus-article-buffer) (bury-buffer gnus-article-buffer)) - ;; Return to the group buffer. - (gnus-configure-windows 'group 'force) ;; Clear the current group name. (setq gnus-newsgroup-name nil) (unless (gnus-ephemeral-group-p group) @@ -7731,6 +7734,7 @@ If BACKWARD, the previous article is selected instead of the next." (point (with-current-buffer gnus-group-buffer (point))) + (current-summary (current-buffer)) (group (if (eq gnus-keep-same-level 'best) (gnus-summary-best-group gnus-newsgroup-name) @@ -7755,6 +7759,10 @@ If BACKWARD, the previous article is selected instead of the next." (gnus-summary-next-group nil group backward))) (t (when (gnus-key-press-event-p last-input-event) + ;; Somehow or other, we may now have selected a different + ;; window. Make point go back to the summary buffer. + (when (eq current-summary (current-buffer)) + (select-window (get-buffer-window current-summary))) (gnus-summary-walk-group-buffer gnus-newsgroup-name cmd unread backward point)))))))) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 67c49096b92..42dbd5948cf 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -871,6 +871,15 @@ Bind `print-quoted' and `print-readably' to t, and `print-length' and (when (file-exists-p file) (delete-file file))) +(defun gnus-delete-duplicates (list) + "Remove duplicate entries from LIST." + (let ((result nil)) + (while list + (unless (member (car list) result) + (push (car list) result)) + (pop list)) + (nreverse result))) + (defun gnus-delete-directory (directory) "Delete files in DIRECTORY. Subdirectories remain. If there's no subdirectory, delete DIRECTORY as well." diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 4cbdee53ab4..42acb65ff9f 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -275,7 +275,7 @@ (defgroup gnus-meta nil "Meta variables controlling major portions of Gnus. -In general, modifying these variables does not take affect until Gnus +In general, modifying these variables does not take effect until Gnus is restarted, and sometimes reloaded." :group 'gnus) diff --git a/lisp/gnus/mail-source.el b/lisp/gnus/mail-source.el index f98c195eada..6e6ef76c0c1 100644 --- a/lisp/gnus/mail-source.el +++ b/lisp/gnus/mail-source.el @@ -32,7 +32,7 @@ (eval-when-compile (require 'cl) (require 'imap)) -(autoload 'auth-source-user-or-password "auth-source") +(autoload 'auth-source-search "auth-source") (autoload 'pop3-movemail "pop3") (autoload 'pop3-get-message-count "pop3") (autoload 'nnheader-cancel-timer "nnheader") @@ -332,6 +332,7 @@ Common keywords should be listed here.") (:prescript) (:prescript-delay) (:postscript) + ;; note server and port need to come before user and password (:server (getenv "MAILHOST")) (:port 110) (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER"))) @@ -345,6 +346,7 @@ Common keywords should be listed here.") (:subdirs ("cur" "new")) (:function)) (imap + ;; note server and port need to come before user and password (:server (getenv "MAILHOST")) (:port) (:stream) @@ -417,42 +419,66 @@ the `mail-source-keyword-map' variable." (put 'mail-source-bind 'lisp-indent-function 1) (put 'mail-source-bind 'edebug-form-spec '(sexp body)) -;; TODO: use the list format for auth-source-user-or-password modes (defun mail-source-set-1 (source) (let* ((type (pop source)) - (defaults (cdr (assq type mail-source-keyword-map))) - default value keyword auth-info user-auth pass-auth) + (defaults (cdr (assq type mail-source-keyword-map))) + (search '(:max 1)) + found default value keyword auth-info user-auth pass-auth) + + ;; append to the search the useful info from the source and the defaults: + ;; user, host, and port + + ;; the msname is the mail-source parameter + (dolist (msname '(:server :user :port)) + ;; the asname is the auth-source parameter + (let* ((asname (case msname + (:server :host) ; auth-source uses :host + (t msname))) + ;; this is the mail-source default + (msdef1 (or (plist-get source msname) + (nth 1 (assoc msname defaults)))) + ;; ...evaluated + (msdef (mail-source-value msdef1))) + (setq search (append (list asname + (if msdef msdef t)) + search)))) + ;; if the port is unknown yet, get it from the mail-source type + (unless (plist-get search :port) + (setq search (append (list :port (symbol-name type))))) + (while (setq default (pop defaults)) ;; for each default :SYMBOL, set SYMBOL to the plist value for :SYMBOL ;; using `mail-source-value' to evaluate the plist value (set (mail-source-strip-keyword (setq keyword (car default))) - ;; note the following reasons for this structure: - ;; 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 - ((and - (eq keyword :user) - (setq user-auth - (nth 0 (auth-source-user-or-password - '("login" "password") - ;; this is "host" in auth-sources - (if (boundp 'server) (symbol-value 'server) "") - type)))) - user-auth) - ((and - (eq keyword :password) - (setq pass-auth - (nth 1 - (auth-source-user-or-password - '("login" "password") - ;; this is "host" in auth-sources - (if (boundp 'server) (symbol-value 'server) "") - type)))) - pass-auth) - (t (if (setq value (plist-get source keyword)) - (mail-source-value value) - (mail-source-value (cadr default))))))))) + ;; note the following reasons for this structure: + ;; 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 + ((and + (eq keyword :user) + (setq user-auth (plist-get + ;; cache the search result in `found' + (or found + (setq found (nth 0 (apply 'auth-source-search + search)))) + :user))) + user-auth) + ((and + (eq keyword :password) + (setq pass-auth (plist-get + ;; cache the search result in `found' + (or found + (setq found (nth 0 (apply 'auth-source-search + search)))) + :secret))) + ;; maybe set the password to the return of the :secret function + (if (functionp pass-auth) + (setq pass-auth (funcall pass-auth)) + pass-auth)) + (t (if (setq value (plist-get source keyword)) + (mail-source-value value) + (mail-source-value (cadr default))))))))) (eval-and-compile (defun mail-source-bind-common-1 () diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 42b61950986..58daf1baf94 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -6779,7 +6779,7 @@ Useful functions to put in this list include: subject) ;;;###autoload -(defun message-reply (&optional to-address wide) +(defun message-reply (&optional to-address wide switch-function) "Start editing a reply to the article in the current buffer." (interactive) (require 'gnus-sum) ; for gnus-list-identifiers @@ -6822,7 +6822,8 @@ Useful functions to put in this list include: (message-pop-to-buffer (message-buffer-name (if wide "wide reply" "reply") from - (if wide to-address nil)))) + (if wide to-address nil)) + switch-function)) (setq message-reply-headers (vector 0 subject from date message-id references 0 0 "")) diff --git a/lisp/gnus/mml2015.el b/lisp/gnus/mml2015.el index 1271168fffc..df106bb6de8 100644 --- a/lisp/gnus/mml2015.el +++ b/lisp/gnus/mml2015.el @@ -116,7 +116,7 @@ Whether the passphrase is cached at all is controlled by :type 'integer) (defcustom mml2015-signers nil - "A list of your own key ID which will be used to sign a message. + "A list of your own key ID(s) which will be used to sign a message. If set, it overrides the setting of `mml2015-sign-with-sender'." :group 'mime-security :type '(repeat (string :tag "Key ID"))) diff --git a/lisp/gnus/nnfolder.el b/lisp/gnus/nnfolder.el index dd11ff71dd3..3ec30410473 100644 --- a/lisp/gnus/nnfolder.el +++ b/lisp/gnus/nnfolder.el @@ -1083,6 +1083,8 @@ This command does not work if you use short group names." (or nnfolder-nov-directory nnfolder-directory))) (concat (nnfolder-group-pathname group) nnfolder-nov-file-suffix))) +(defvar copyright-update) + (defun nnfolder-save-buffer () "Save the buffer." (when (buffer-modified-p) @@ -1090,8 +1092,8 @@ This command does not work if you use short group names." (gnus-make-directory (file-name-directory (buffer-file-name))) (let ((coding-system-for-write (or nnfolder-file-coding-system-for-write - nnfolder-file-coding-system)) - (copyright-update nil)) + nnfolder-file-coding-system))) + (set (make-local-variable 'copyright-update) nil) (save-buffer))) (unless (or gnus-nov-is-evil nnfolder-nov-is-evil) (nnfolder-save-nov))) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index a6fe6b1489b..83b8c416283 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -47,8 +47,8 @@ (require 'nnmail) (require 'proto-stream) -(autoload 'auth-source-forget-user-or-password "auth-source") -(autoload 'auth-source-user-or-password "auth-source") +(autoload 'auth-source-forget+ "auth-source") +(autoload 'auth-source-search "auth-source") (nnoo-declare nnimap) @@ -142,6 +142,8 @@ textual parts.") (defvar nnimap-quirks '(("QRESYNC" "Zimbra" "QRESYNC "))) +(defvar nnimap-inhibit-logging nil) + (defun nnimap-buffer () (nnimap-find-process-buffer nntp-server-buffer)) @@ -274,19 +276,18 @@ textual parts.") (push (current-buffer) nnimap-process-buffers) (current-buffer))) -(defun nnimap-credentials (address ports &optional inhibit-create) - (let (port credentials) - ;; Request the credentials from all ports, but only query on the - ;; last port if all the previous ones have failed. - (while (and (null credentials) - (setq port (pop ports))) - (setq credentials - (auth-source-user-or-password - '("login" "password") address port nil - (if inhibit-create - nil - (null ports))))) - credentials)) +(defun nnimap-credentials (address ports) + (let ((found (nth 0 (auth-source-search :max 1 + :host address + :port ports + :create t)))) + (if found + (list (plist-get found :user) + (let ((secret (plist-get found :secret))) + (if (functionp secret) + (funcall secret) + secret))) + nil))) (defun nnimap-keepalive () (let ((now (current-time))) @@ -381,26 +382,25 @@ textual parts.") (if (eq nnimap-authenticator 'anonymous) (list "anonymous" (message-make-address)) - (or - ;; First look for the credentials based - ;; on the virtual server name. - (nnimap-credentials - (nnoo-current-server 'nnimap) ports t) - ;; Then look them up based on the - ;; physical address. - (nnimap-credentials nnimap-address ports))))) + ;; Look for the credentials based on + ;; the virtual server name and the address + (nnimap-credentials + (gnus-delete-duplicates + (list + nnimap-address + (nnoo-current-server 'nnimap))) + ports)))) (setq nnimap-object nil) - (setq login-result - (nnimap-login (car credentials) (cadr credentials))) + (let ((nnimap-inhibit-logging t)) + (setq login-result + (nnimap-login (car credentials) (cadr credentials)))) (unless (car login-result) ;; If the login failed, then forget the credentials ;; that are now possibly cached. (dolist (host (list (nnoo-current-server 'nnimap) nnimap-address)) (dolist (port ports) - (dolist (element '("login" "password")) - (auth-source-forget-user-or-password - element host port)))) + (auth-source-forget+ :host host :port port))) (delete-process (nnimap-process nnimap-object)) (setq nnimap-object nil)))) (when nnimap-object @@ -969,7 +969,8 @@ textual parts.") (nnimap-add-cr) (setq message (buffer-substring-no-properties (point-min) (point-max))) (with-current-buffer (nnimap-buffer) - (when (setq message (nnimap-process-quirk "OK Gimap " 'append message)) + (when (setq message (or (nnimap-process-quirk "OK Gimap " 'append message) + message)) ;; If we have this group open read-only, then unselect it ;; before appending to it. (when (equal (nnimap-examined nnimap-object) group) @@ -997,7 +998,7 @@ textual parts.") (defun nnimap-process-quirk (greeting-match type data) (when (and (nnimap-greeting nnimap-object) - (string-match "OK Gimap " (nnimap-greeting nnimap-object)) + (string-match greeting-match (nnimap-greeting nnimap-object)) (eq type 'append) (string-match "\000" data)) (let ((choice (gnus-multiple-choice @@ -1074,60 +1075,62 @@ textual parts.") (nreverse groups))) (deffoo nnimap-request-list (&optional server) - (nnimap-possibly-change-group nil server) - (with-current-buffer nntp-server-buffer - (erase-buffer) - (let ((groups - (with-current-buffer (nnimap-buffer) - (nnimap-get-groups))) - sequences responses) - (when groups - (with-current-buffer (nnimap-buffer) - (setf (nnimap-group nnimap-object) nil) - (dolist (group groups) - (setf (nnimap-examined nnimap-object) group) - (push (list (nnimap-send-command "EXAMINE %S" (utf7-encode group t)) - group) - sequences)) - (nnimap-wait-for-response (caar sequences)) - (setq responses - (nnimap-get-responses (mapcar #'car sequences)))) - (dolist (response responses) - (let* ((sequence (car response)) - (response (cadr response)) - (group (cadr (assoc sequence sequences)))) - (when (and group - (equal (caar response) "OK")) - (let ((uidnext (nnimap-find-parameter "UIDNEXT" response)) - highest exists) - (dolist (elem response) - (when (equal (cadr elem) "EXISTS") - (setq exists (string-to-number (car elem))))) - (when uidnext - (setq highest (1- (string-to-number (car uidnext))))) - (cond - ((null highest) - (insert (format "%S 0 1 y\n" (utf7-decode group t)))) - ((zerop exists) - ;; Empty group. - (insert (format "%S %d %d y\n" - (utf7-decode group t) highest (1+ highest)))) - (t - ;; Return the widest possible range. - (insert (format "%S %d 1 y\n" (utf7-decode group t) - (or highest exists))))))))) - t)))) + (when (nnimap-possibly-change-group nil server) + (with-current-buffer nntp-server-buffer + (erase-buffer) + (let ((groups + (with-current-buffer (nnimap-buffer) + (nnimap-get-groups))) + sequences responses) + (when groups + (with-current-buffer (nnimap-buffer) + (setf (nnimap-group nnimap-object) nil) + (dolist (group groups) + (setf (nnimap-examined nnimap-object) group) + (push (list (nnimap-send-command "EXAMINE %S" + (utf7-encode group t)) + group) + sequences)) + (nnimap-wait-for-response (caar sequences)) + (setq responses + (nnimap-get-responses (mapcar #'car sequences)))) + (dolist (response responses) + (let* ((sequence (car response)) + (response (cadr response)) + (group (cadr (assoc sequence sequences)))) + (when (and group + (equal (caar response) "OK")) + (let ((uidnext (nnimap-find-parameter "UIDNEXT" response)) + highest exists) + (dolist (elem response) + (when (equal (cadr elem) "EXISTS") + (setq exists (string-to-number (car elem))))) + (when uidnext + (setq highest (1- (string-to-number (car uidnext))))) + (cond + ((null highest) + (insert (format "%S 0 1 y\n" (utf7-decode group t)))) + ((zerop exists) + ;; Empty group. + (insert (format "%S %d %d y\n" + (utf7-decode group t) + highest (1+ highest)))) + (t + ;; Return the widest possible range. + (insert (format "%S %d 1 y\n" (utf7-decode group t) + (or highest exists))))))))) + t))))) (deffoo nnimap-request-newgroups (date &optional server) - (nnimap-possibly-change-group nil server) - (with-current-buffer nntp-server-buffer - (erase-buffer) - (dolist (group (with-current-buffer (nnimap-buffer) - (nnimap-get-groups))) - (unless (assoc group nnimap-current-infos) - ;; Insert dummy numbers here -- they don't matter. - (insert (format "%S 0 1 y\n" group)))) - t)) + (when (nnimap-possibly-change-group nil server) + (with-current-buffer nntp-server-buffer + (erase-buffer) + (dolist (group (with-current-buffer (nnimap-buffer) + (nnimap-get-groups))) + (unless (assoc group nnimap-current-infos) + ;; Insert dummy numbers here -- they don't matter. + (insert (format "%S 0 1 y\n" group)))) + t))) (deffoo nnimap-retrieve-group-data-early (server infos) (when (nnimap-possibly-change-group nil server) @@ -1567,6 +1570,7 @@ textual parts.") (defvar nnimap-sequence 0) (defun nnimap-send-command (&rest args) + (setf (nnimap-last-command-time nnimap-object) (current-time)) (process-send-string (get-buffer-process (current-buffer)) (nnimap-log-command @@ -1585,12 +1589,14 @@ textual parts.") (defun nnimap-log-command (command) (with-current-buffer (get-buffer-create "*imap log*") (goto-char (point-max)) - (insert (format-time-string "%H:%M:%S") " " command)) + (insert (format-time-string "%H:%M:%S") " " + (if nnimap-inhibit-logging + "(inhibited)\n" + command))) command) (defun nnimap-command (&rest args) (erase-buffer) - (setf (nnimap-last-command-time nnimap-object) (current-time)) (let* ((sequence (apply #'nnimap-send-command args)) (response (nnimap-get-response sequence))) (if (equal (caar response) "OK") @@ -1635,7 +1641,7 @@ textual parts.") (progn (forward-line -1) (looking-at "\\*")))) - (not (looking-at (format "%d " sequence))))) + (not (looking-at (format "%d .*\n" sequence))))) (when messagep (nnheader-message 7 "nnimap read %dk" (/ (buffer-size) 1000))) (nnheader-accept-process-output process) @@ -1817,7 +1823,7 @@ textual parts.") (defun nnimap-parse-copied-articles (sequences) (let (sequence copied range) (goto-char (point-min)) - (while (re-search-forward "^\\([0-9]+\\) OK " nil t) + (while (re-search-forward "^\\([0-9]+\\) OK\\b" nil t) (setq sequence (string-to-number (match-string 1))) (when (setq range (cadr (assq sequence sequences))) (push (gnus-uncompress-range range) copied))) diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index eb2dd004638..09ecfb8f6b7 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -40,7 +40,7 @@ (eval-when-compile (require 'cl)) -(autoload 'auth-source-user-or-password "auth-source") +(autoload 'auth-source-search "auth-source") (defgroup nntp nil "NNTP access for Gnus." @@ -774,7 +774,7 @@ command whose response triggered the error." (nntp-copy-to-buffer nntp-server-buffer (point-min) (point-max)) 'headers))))) -(deffoo nntp-retrieve-group-data-early-disabled (server infos) +(deffoo nntp-retrieve-group-data-early (server infos) "Retrieve group info on INFOS." (nntp-with-open-group nil server (when (nntp-find-connection-buffer nntp-server-buffer) @@ -793,7 +793,7 @@ command whose response triggered the error." nil command (gnus-group-real-name (gnus-info-group info))))) (length infos))))) -(deffoo nntp-finish-retrieve-group-infos-disabled (server infos count) +(deffoo nntp-finish-retrieve-group-infos (server infos count) (nntp-with-open-group nil server (let ((buf (nntp-find-connection-buffer nntp-server-buffer)) (method (gnus-find-method-for-group @@ -808,16 +808,17 @@ command whose response triggered the error." (progn (goto-char last-point) ;; Count replies. - (while (re-search-forward "^[0-9]" nil t) + (while (re-search-forward + (if nntp-server-list-active-group + "^[.]" + "^[0-9]") + nil t) (incf received)) (setq last-point (point)) (< received count))) (nntp-accept-response)) ;; We now have all the entries. Remove CRs. - (goto-char (point-min)) - (while (search-forward "\r" nil t) - (replace-match "" t t)) - + (nnheader-strip-cr) (if (not nntp-server-list-active-group) (progn (nntp-copy-to-buffer nntp-server-buffer @@ -830,7 +831,14 @@ command whose response triggered the error." (delete-region (match-beginning 0) (progn (forward-line 1) (point)))) (nntp-copy-to-buffer nntp-server-buffer (point-min) (point-max)) - (gnus-active-to-gnus-format method gnus-active-hashtb nil t))))))) + (with-current-buffer nntp-server-buffer + (gnus-active-to-gnus-format + ;; Kludge to use the extended method name if you have + ;; an extended one. + (if (consp (gnus-info-method (car infos))) + (gnus-info-method (car infos)) + method) + gnus-active-hashtb nil t)))))))) (deffoo nntp-retrieve-groups (groups &optional server) "Retrieve group info on GROUPS." @@ -1231,10 +1239,16 @@ If SEND-IF-FORCE, only send authinfo to the server if the (let* ((list (netrc-parse nntp-authinfo-file)) (alist (netrc-machine list nntp-address "nntp")) (force (or (netrc-get alist "force") nntp-authinfo-force)) - (auth-info - (auth-source-user-or-password '("login" "password") nntp-address "nntp")) - (auth-user (nth 0 auth-info)) - (auth-passwd (nth 1 auth-info)) + (auth-info + (nth 0 (auth-source-search :max 1 + ;; TODO: allow the virtual server name too + :host nntp-address + :port '("119" "nntp")))) + (auth-user (plist-get auth-info :user)) + (auth-passwd (plist-get auth-info :secret)) + (auth-passwd (if (functionp auth-passwd) + (funcall auth-passwd) + auth-passwd)) (user (or ;; this is preferred to netrc-* auth-user diff --git a/lisp/gnus/shr-color.el b/lisp/gnus/shr-color.el index 4b885d9dbf8..36dd65f4a2d 100644 --- a/lisp/gnus/shr-color.el +++ b/lisp/gnus/shr-color.el @@ -259,7 +259,7 @@ Like rgb() or hsl()." (l (/ (string-to-number (match-string-no-properties 3 color)) 100.0))) (destructuring-bind (r g b) (shr-color-hsl-to-rgb-fractions h s l) - (color-rgb->hex r g b)))) + (color-rgb-to-hex r g b)))) ;; Color names ((cdr (assoc-string color shr-color-html-colors-alist t))) ;; Unrecognized color :( @@ -325,13 +325,13 @@ If FIXED-BACKGROUND is set, and if the color are not visible, a new background color will not be computed. Only the foreground color will be adapted to be visible on BG." ;; Convert fg and bg to CIE Lab - (let ((fg-norm (color-rgb->normalize fg)) - (bg-norm (color-rgb->normalize bg))) + (let ((fg-norm (color-name-to-rgb fg)) + (bg-norm (color-name-to-rgb bg))) (if (or (null fg-norm) (null bg-norm)) (list bg fg) - (let* ((fg-lab (apply 'color-srgb->lab fg-norm)) - (bg-lab (apply 'color-srgb->lab bg-norm)) + (let* ((fg-lab (apply 'color-srgb-to-lab fg-norm)) + (bg-lab (apply 'color-srgb-to-lab bg-norm)) ;; Compute color distance using CIE DE 2000 (fg-bg-distance (color-cie-de2000 fg-lab bg-lab)) ;; Compute luminance distance (substract L component) @@ -351,10 +351,10 @@ color will be adapted to be visible on BG." bg (apply 'format "#%02x%02x%02x" (mapcar (lambda (x) (* (max (min 1 x) 0) 255)) - (apply 'color-lab->srgb bg-lab)))) + (apply 'color-lab-to-srgb bg-lab)))) (apply 'format "#%02x%02x%02x" (mapcar (lambda (x) (* (max (min 1 x) 0) 255)) - (apply 'color-lab->srgb fg-lab)))))))))) + (apply 'color-lab-to-srgb fg-lab)))))))))) (provide 'shr-color) diff --git a/lisp/gnus/sieve-manage.el b/lisp/gnus/sieve-manage.el index d115f40528b..c9a0df20590 100644 --- a/lisp/gnus/sieve-manage.el +++ b/lisp/gnus/sieve-manage.el @@ -83,7 +83,7 @@ (require 'starttls)) (autoload 'sasl-find-mechanism "sasl") (autoload 'starttls-open-stream "starttls") -(autoload 'auth-source-user-or-password "auth-source") +(autoload 'auth-source-search "auth-source") ;; User customizable variables: @@ -273,16 +273,20 @@ Valid states are `closed', `initial', `nonauth', and `auth'.") "Login to server using the SASL MECH method." (message "sieve: Authenticating using %s..." mech) (with-current-buffer buffer - (let* ((user-password (auth-source-user-or-password - '("login" "password") - sieve-manage-server - "sieve" nil t)) + (let* ((auth-info (auth-source-search :host sieve-manage-server + :port "sieve" + :max 1)) + (user-name (plist-get (nth 0 auth-info) :user)) + (user-password (plist-get (nth 0 auth-info) :secret)) + (user-password (if (functionp user-password) + (funcall user-password) + user-password)) (client (sasl-make-client (sasl-find-mechanism (list mech)) - (car user-password) "sieve" sieve-manage-server)) + user-name "sieve" sieve-manage-server)) (sasl-read-passphrase ;; We *need* to copy the password, because sasl will modify it ;; somehow. - `(lambda (prompt) ,(copy-sequence (cadr user-password)))) + `(lambda (prompt) ,(copy-sequence user-password))) (step (sasl-next-step client nil)) (tag (sieve-manage-send (concat diff --git a/lisp/image-mode.el b/lisp/image-mode.el index 190ca08722b..64dcf9076ae 100644 --- a/lisp/image-mode.el +++ b/lisp/image-mode.el @@ -505,6 +505,11 @@ was inserted." ;; This just makes the arrow displayed in the right fringe ;; area look correct when the image is wider than the window. (setq truncate-lines t) + ;; Disable adding a newline at the end of the image file when it + ;; is written with, e.g., C-x C-w. + (if (coding-system-equal (coding-system-base buffer-file-coding-system) + 'no-conversion) + (set (make-local-variable 'find-file-literally) t)) ;; Allow navigation of large images (set (make-local-variable 'auto-hscroll-mode) nil) (setq image-type type) diff --git a/lisp/international/mule-cmds.el b/lisp/international/mule-cmds.el index d610da0aab6..8672fca3a85 100644 --- a/lisp/international/mule-cmds.el +++ b/lisp/international/mule-cmds.el @@ -2938,11 +2938,19 @@ on encoding." (defun read-char-by-name (prompt) "Read a character by its Unicode name or hex number string. Display PROMPT and read a string that represents a character by its -Unicode property `name' or `old-name'. You can type a few of first -letters of the Unicode name and use completion. This function also -accepts a hexadecimal number of Unicode code point or a number in -hash notation, e.g. #o21430 for octal, #x2318 for hex, or #10r8984 -for decimal. Returns a character as a number." +Unicode property `name' or `old-name'. + +This function returns the character as a number. + +You can type a few of the first letters of the Unicode name and +use completion. If you type a substring of the Unicode name +preceded by an asterisk `*' and use completion, it will show all +the characters whose names include that substring, not necessarily +at the beginning of the name. + +This function also accepts a hexadecimal number of Unicode code +point or a number in hash notation, e.g. #o21430 for octal, +#x2318 for hex, or #10r8984 for decimal." (let* ((completion-ignore-case t) (input (completing-read prompt ucs-completions))) (cond @@ -2957,6 +2965,13 @@ for decimal. Returns a character as a number." "Insert COUNT copies of CHARACTER of the given Unicode code point. Interactively, prompts for a Unicode character name or a hex number using `read-char-by-name'. + +You can type a few of the first letters of the Unicode name and +use completion. If you type a substring of the Unicode name +preceded by an asterisk `*' and use completion, it will show all +the characters whose names include that substring, not necessarily +at the beginning of the name. + The optional third arg INHERIT (non-nil when called interactively), says to inherit text properties from adjoining text, if those properties are sticky." diff --git a/lisp/international/mule-diag.el b/lisp/international/mule-diag.el index 349430f0cd9..d9ac587231e 100644 --- a/lisp/international/mule-diag.el +++ b/lisp/international/mule-diag.el @@ -1056,7 +1056,10 @@ installed LEIM (Libraries of Emacs Input Methods).") (if (and (consp title) (stringp (car title))) (car title) title)) - (nth 4 elt))))))) + ;; If the doc is multi-line, indent all + ;; non-blank lines. (Bug#8066) + (replace-regexp-in-string "\n\\(.\\)" "\n \\1" + (or (nth 4 elt) "")))))))) ;;; DIAGNOSIS diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el index cb9ee7e0317..328a5d50d34 100644 --- a/lisp/mail/mail-utils.el +++ b/lisp/mail/mail-utils.el @@ -35,6 +35,17 @@ often correct parser." :type 'boolean :group 'mail) +;;;###autoload +(defcustom mail-dont-reply-to-names nil + "Regexp specifying addresses to prune from a reply message. +If this is nil, it is set the first time you compose a reply, to +a value which excludes your own email address. + +Matching addresses are excluded from the CC field in replies, and +also the To field, unless this would leave an empty To field." + :type '(choice regexp (const :tag "Your Name" nil)) + :group 'mail) + ;; Returns t if file FILE is an Rmail file. ;;;###autoload (defun mail-file-babyl-p (file) @@ -213,36 +224,31 @@ Return a modified address list." nil 'literal address 2))) address)))) -;; The following piece of ugliness is legacy code. The name was an -;; unfortunate choice --- a flagrant violation of the Emacs Lisp -;; coding conventions. `mail-dont-reply-to' would have been -;; infinitely better. Also, `rmail-dont-reply-to-names' might have -;; been better named `mail-dont-reply-to-names' and sourced from this -;; file instead of in rmail.el. Yuck. -pmr -(defun rmail-dont-reply-to (destinations) +(defun mail-dont-reply-to (destinations) "Prune addresses from DESTINATIONS, a list of recipient addresses. -All addresses matching `rmail-dont-reply-to-names' are removed from -the comma-separated list. The pruned list is returned." +Remove all addresses matching `mail-dont-reply-to-names' from the +comma-separated list, and return the pruned list." ;; FIXME this (setting a user option the first time a command is used) ;; is somewhat strange. Normally one would never set the option, ;; but instead fall back to the default so long as it was nil. ;; Or just set the default directly in the defcustom. - (if (null rmail-dont-reply-to-names) - (setq rmail-dont-reply-to-names - (concat (if rmail-default-dont-reply-to-names - (concat rmail-default-dont-reply-to-names "\\|") - "") - (if (and user-mail-address - (not (equal user-mail-address user-login-name))) - ;; Anchor the login name and email address so - ;; that we don't match substrings: if the - ;; login name is "foo", we shouldn't match - ;; "barfoo@baz.com". - (concat "\\`" - (regexp-quote user-mail-address) - "\\'\\|") - "") - (concat "\\`" (regexp-quote user-login-name) "@")))) + (if (null mail-dont-reply-to-names) + (setq mail-dont-reply-to-names + (concat + ;; `rmail-default-dont-reply-to-names' is obsolete. + (if rmail-default-dont-reply-to-names + (concat rmail-default-dont-reply-to-names "\\|") + "") + (if (and user-mail-address + (not (equal user-mail-address user-login-name))) + ;; Anchor the login name and email address so that we + ;; don't match substrings: if the login name is + ;; "foo", we shouldn't match "barfoo@baz.com". + (concat "\\`" + (regexp-quote user-mail-address) + "\\'\\|") + "") + (concat "\\`" (regexp-quote user-login-name) "@")))) ;; Split up DESTINATIONS and match each element separately. (let ((start-pos 0) (cur-pos 0) (case-fold-search t)) @@ -262,7 +268,7 @@ the comma-separated list. The pruned list is returned." (setq cur-pos start-pos))) (let* ((address (substring destinations start-pos cur-pos)) (naked-address (mail-strip-quoted-names address))) - (if (string-match rmail-dont-reply-to-names naked-address) + (if (string-match mail-dont-reply-to-names naked-address) (setq destinations (concat (substring destinations 0 start-pos) (and cur-pos (substring destinations (1+ cur-pos)))) @@ -278,6 +284,9 @@ the comma-separated list. The pruned list is returned." (substring destinations (match-end 0)) destinations)) +;; Legacy name +(define-obsolete-function-alias 'rmail-dont-reply-to 'mail-dont-reply-to "24.1") + ;;;###autoload (defun mail-fetch-field (field-name &optional last all list) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 7e44ae22e1e..06867f6d92a 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -191,7 +191,7 @@ please report it with \\[report-emacs-bug].") :group 'rmail-retrieve :type '(repeat (directory))) -(declare-function rmail-dont-reply-to "mail-utils" (destinations)) +(declare-function mail-dont-reply-to "mail-utils" (destinations)) (declare-function rmail-update-summary "rmailsum" (&rest ignore)) (defun rmail-probe (prog) @@ -283,26 +283,16 @@ Setting this variable has an effect only before reading a mail." :version "21.1") ;;;###autoload -(defcustom rmail-dont-reply-to-names nil - "A regexp specifying addresses to prune from a reply message. -If this is nil, it is set the first time you compose a reply, to -a value which excludes your own email address, plus whatever is -specified by `rmail-default-dont-reply-to-names'. - -Matching addresses are excluded from the CC field in replies, and -also the To field, unless this would leave an empty To field." - :type '(choice regexp (const :tag "Your Name" nil)) - :group 'rmail-reply) +(defvaralias 'rmail-dont-reply-to-names 'mail-dont-reply-to-names) ;;;###autoload -(defvar rmail-default-dont-reply-to-names (purecopy "\\`info-") - "Regexp specifying part of the default value of `rmail-dont-reply-to-names'. -This is used when the user does not set `rmail-dont-reply-to-names' -explicitly. (The other part of the default value is the user's -email address and name.) It is useful to set this variable in -the site customization file. The default value is conventionally -used for large mailing lists to broadcast announcements.") -;; Is it really useful to set this site-wide? +(defvar rmail-default-dont-reply-to-names nil + "Regexp specifying part of the default value of `mail-dont-reply-to-names'. +This is used when the user does not set `mail-dont-reply-to-names' +explicitly.") +;;;###autoload +(make-obsolete-variable 'rmail-default-dont-reply-to-names + 'mail-dont-reply-to-names "24.1") ;;;###autoload (defcustom rmail-ignored-headers @@ -3578,15 +3568,14 @@ use \\[mail-yank-original] to yank the original message into it." ;; Remove unwanted names from reply-to, since Mail-Followup-To ;; header causes all the names in it to wind up in reply-to, not ;; in cc. But if what's left is an empty list, use the original. - (let* ((reply-to-list (rmail-dont-reply-to reply-to))) + (let* ((reply-to-list (mail-dont-reply-to reply-to))) (if (string= reply-to-list "") reply-to reply-to-list)) subject (rmail-make-in-reply-to-field from date message-id) (if just-sender nil - ;; mail-strip-quoted-names is NOT necessary for rmail-dont-reply-to - ;; to do its job. - (let* ((cc-list (rmail-dont-reply-to + ;; `mail-dont-reply-to' doesn't need `mail-strip-quoted-names'. + (let* ((cc-list (mail-dont-reply-to (mail-strip-quoted-names (if (null cc) to (concat to ", " cc)))))) (if (string= cc-list "") nil cc-list))) @@ -4317,7 +4306,7 @@ With prefix argument N moves forward N messages with these labels. ;;;*** -;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "3e235bdf4c2e54da06abcdd72e7f7649") +;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "04902da045706fb7f2b0915529ed161b") ;;; Generated autoloads from rmailmm.el (autoload 'rmail-mime "rmailmm" "\ @@ -4359,7 +4348,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" "f297fd33c8f7fa74baf16d2da99acb35") +;;;;;; rmail-sort-by-date) "rmailsort" "rmailsort.el" "ad1c98fe868c0e5804cf945d6c980d0b") ;;; Generated autoloads from rmailsort.el (autoload 'rmail-sort-by-date "rmailsort" "\ @@ -4393,7 +4382,7 @@ If prefix argument REVERSE is non-nil, sorts in reverse order. Sort messages of current Rmail buffer by other correspondent. This uses either the \"From\", \"Sender\", \"To\", or \"Apparently-To\" header, downcased. Uses the first header not -excluded by `rmail-dont-reply-to-names'. If prefix argument +excluded by `mail-dont-reply-to-names'. If prefix argument REVERSE is non-nil, sorts in reverse order. \(fn REVERSE)" t nil) @@ -4418,7 +4407,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" "adad96c9eb13cae4bae0769f731d8784") +;;;;;; rmail-summary) "rmailsum" "rmailsum.el" "3817e21639db697abe5832d3223ecfc2") ;;; Generated autoloads from rmailsum.el (autoload 'rmail-summary "rmailsum" "\ diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el index 127fd8ac350..0bfeb121ca4 100644 --- a/lisp/mail/rmailmm.el +++ b/lisp/mail/rmailmm.el @@ -472,10 +472,11 @@ See `rmail-mime-entity' for the detail." HEADER is a header component of a MIME-entity object (see `rmail-mime-entity')." (with-temp-buffer - (let ((last-coding-system-used nil)) + (let ((buf (current-buffer))) (with-current-buffer rmail-mime-mbox-buffer - (let ((rmail-buffer rmail-mime-mbox-buffer) - (rmail-view-buffer rmail-mime-view-buffer)) + (let ((last-coding-system-used nil) + (rmail-buffer rmail-mime-mbox-buffer) + (rmail-view-buffer buf)) (save-excursion (goto-char (aref header 0)) (rmail-copy-headers (point) (aref header 1))))) @@ -514,7 +515,9 @@ HEADER is a header component of a MIME-entity object (see ((string= transfer-encoding "quoted-printable") (quoted-printable-decode-region pos (point)))))) (decode-coding-region pos (point) coding-system) - (if (or (not rmail-mime-coding-system) (consp rmail-mime-coding-system)) + (if (and + (or (not rmail-mime-coding-system) (consp rmail-mime-coding-system)) + (not (eq (coding-system-base coding-system) 'us-ascii))) (setq rmail-mime-coding-system coding-system)) (or (bolp) (insert "\n")))) @@ -1302,7 +1305,10 @@ attachments as specfied by `rmail-mime-attachment-dirs-alist'." (rmail-mime-find-header-encoding (rmail-mime-entity-header entity))))) (set-buffer-file-coding-system - (coding-system-base rmail-mime-coding-system) t t)) + (if rmail-mime-coding-system + (coding-system-base rmail-mime-coding-system) + 'undecided) + t t)) ;; Decoding failed. ENTITY is an error message. Insert the ;; original message body as is, and show warning. (let ((region (with-current-buffer rmail-mime-mbox-buffer diff --git a/lisp/mail/rmailsort.el b/lisp/mail/rmailsort.el index c9942f9c2f9..d8b85ad688a 100644 --- a/lisp/mail/rmailsort.el +++ b/lisp/mail/rmailsort.el @@ -87,7 +87,7 @@ If prefix argument REVERSE is non-nil, sorts in reverse order." "Sort messages of current Rmail buffer by other correspondent. This uses either the \"From\", \"Sender\", \"To\", or \"Apparently-To\" header, downcased. Uses the first header not -excluded by `rmail-dont-reply-to-names'. If prefix argument +excluded by `mail-dont-reply-to-names'. If prefix argument REVERSE is non-nil, sorts in reverse order." (interactive "P") (rmail-sort-messages reverse @@ -98,13 +98,12 @@ REVERSE is non-nil, sorts in reverse order." '("From" "Sender" "To" "Apparently-To")))))) (defun rmail-select-correspondent (msg fields) - "Find the first header not excluded by `rmail-dont-reply-to-names'. + "Find the first header not excluded by `mail-dont-reply-to-names'. MSG is a message number. FIELDS is a list of header names." (let ((ans "")) (while (and fields (string= ans "")) (setq ans - ;; NB despite the name, this lives in mail-utils.el. - (rmail-dont-reply-to + (mail-dont-reply-to (mail-strip-quoted-names (or (rmail-get-header (car fields) msg) "")))) (setq fields (cdr fields))) diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index 1d5e062fe27..8e28201e31f 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -1796,7 +1796,7 @@ If prefix argument REVERSE is non-nil, sorts in reverse order." "Sort messages of current Rmail summary by other correspondent. This uses either the \"From\", \"Sender\", \"To\", or \"Apparently-To\" header, downcased. Uses the first header not -excluded by `rmail-dont-reply-to-names'. If prefix argument +excluded by `mail-dont-reply-to-names'. If prefix argument REVERSE is non-nil, sorts in reverse order." (interactive "P") (rmail-sort-from-summary (function rmail-sort-by-correspondent) reverse)) diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index f726304704b..427d9d17746 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -77,7 +77,7 @@ (autoload 'netrc-machine "netrc") (autoload 'netrc-get "netrc") (autoload 'password-read "password-cache") -(autoload 'auth-source-user-or-password "auth-source") +(autoload 'auth-source-search "auth-source") ;;; (defgroup smtpmail nil @@ -538,10 +538,14 @@ The list is in preference order.") (defun smtpmail-try-auth-methods (process supported-extensions host port) (let* ((mechs (cdr-safe (assoc 'auth supported-extensions))) (mech (car (smtpmail-intersection mechs smtpmail-auth-supported))) - (auth-user (auth-source-user-or-password - "login" host (or port "smtp"))) - (auth-pass (auth-source-user-or-password - "password" host (or port "smtp"))) + (auth-info (auth-source-search :max 1 + :host host + :port (or port "smtp"))) + (auth-user (plist-get (nth 0 auth-info) :user)) + (auth-pass (plist-get (nth 0 auth-info) :secret)) + (auth-pass (if (functionp auth-pass) + (funcall auth-pass) + auth-pass)) (cred (if (and auth-user auth-pass) ; try user-auth-* before netrc-* (list host port auth-user auth-pass) ;; else, if auth-source didn't return them... diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in index eb65bb7a60f..0e3d54408fd 100644 --- a/lisp/makefile.w32-in +++ b/lisp/makefile.w32-in @@ -443,9 +443,9 @@ $(lisp)/mh-e/mh-loaddefs.el: $(MH_E_SRC) TRAMP_SRC = $(lisp)/net/tramp.el $(lisp)/net/tramp-cache.el \ $(lisp)/net/tramp-cmds.el $(lisp)/net/tramp-compat.el \ $(lisp)/net/tramp-ftp.el $(lisp)/net/tramp-gvfs.el \ - $(lisp)/net/tramp-gw.el $(lisp)/net/tramp-imap.el \ - $(lisp)/net/tramp-sh.el $(lisp)/net/tramp-smb.el \ - $(lisp)/net/tramp-uu.el $(lisp)/net/trampver.el + $(lisp)/net/tramp-gw.el $(lisp)/net/tramp-sh.el \ + $(lisp)/net/tramp-smb.el $(lisp)/net/tramp-uu.el \ + $(lisp)/net/trampver.el $(lisp)/net/tramp-loaddefs.el: $(TRAMP_SRC) "$(EMACS)" $(EMACSOPT) \ diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1 index 2abfea9ac6b..69ca927d5e7 100644 --- a/lisp/mh-e/ChangeLog.1 +++ b/lisp/mh-e/ChangeLog.1 @@ -3499,7 +3499,7 @@ 2003-05-08 Satyaki Das <satyakid@stanford.edu> - * mh-seq.el (mh-translate-range): Take into account differnt + * mh-seq.el (mh-translate-range): Take into account different semantics of split-string in Emacs and XEmacs. (mh-read-pick-regexp, mh-narrow-to-from, mh-narrow-to-cc) (mh-narrow-to-to, mh-narrow-to-header-field) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 94ba46069d5..392ec2d3dad 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -195,6 +195,10 @@ You should give VAR a non-nil `risky-local-variable' property." (setq ,var (,fun))) ,var)))) +(defun completion-table-case-fold (table string pred action) + (let ((completion-ignore-case t)) + (complete-with-action action table string pred))) + (defun completion-table-with-context (prefix table string pred action) ;; TODO: add `suffix' maybe? ;; Notice that `pred' may not be a function in some abusive cases. diff --git a/lisp/net/imap-hash.el b/lisp/net/imap-hash.el deleted file mode 100644 index d21b714d950..00000000000 --- a/lisp/net/imap-hash.el +++ /dev/null @@ -1,373 +0,0 @@ -;;; imap-hash.el --- Hashtable-like interface to an IMAP mailbox - -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. - -;; Author: Teodor Zlatanov <tzz@lifelogs.com> -;; Keywords: mail - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This module provides hashtable-like functions on top of imap.el -;; functionality. All the authentication is handled by auth-source so -;; there are no authentication options here, only the server and -;; mailbox names are needed. - -;; Create a IHT (imap-hash table) object with `imap-hash-make'. Then -;; use it with `imap-hash-map' to map a function across all the -;; messages. Use `imap-hash-get' and `imap-hash-rem' to operate on -;; individual messages. See the tramp-imap.el library in Tramp if you -;; need to see practical examples. - -;; This only works with IMAP4r1. Sorry to everyone without it, but -;; the compatibility code is too annoying and it's 2009. - -;; TODO: Use SEARCH instead of FETCH when a test is specified. List -;; available mailboxes. Don't select an invalid mailbox. - -;;; Code: - -(require 'assoc) -(require 'imap) -(require 'sendmail) ; for mail-header-separator -(require 'message) -(autoload 'auth-source-user-or-password "auth-source") - -;; retrieve these headers -(defvar imap-hash-headers - (append '(Subject From Date Message-Id References In-Reply-To Xref))) - -;; from nnheader.el -(defsubst imap-hash-remove-cr-followed-by-lf () - (goto-char (point-max)) - (while (search-backward "\r\n" nil t) - (delete-char 1))) - -;; from nnheader.el -(defun imap-hash-ms-strip-cr (&optional string) - "Strip ^M from the end of all lines in current buffer or STRING." - (if string - (with-temp-buffer - (insert string) - (imap-hash-remove-cr-followed-by-lf) - (buffer-string)) - (save-excursion - (imap-hash-remove-cr-followed-by-lf)))) - -(defun imap-hash-make (server port mailbox &optional user password ssl) - "Make a new imap-hash object using SERVER, PORT, and MAILBOX. -USER, PASSWORD and SSL are optional. -The test is set to t, meaning all messages are considered." - (when (and server port mailbox) - (list :server server :port port :mailbox mailbox - :ssl ssl :user user :password password - :test t))) - -(defun imap-hash-p (iht) - "Check whether IHT is a valid imap-hash." - (and - (imap-hash-server iht) - (imap-hash-port iht) - (imap-hash-mailbox iht) - (imap-hash-test iht))) - -(defmacro imap-hash-gather (uid) - `(imap-message-get ,uid 'BODYDETAIL)) - -(defmacro imap-hash-data-body (details) - `(nth 2 (nth 1 ,details))) - -(defmacro imap-hash-data-headers (details) - `(nth 2 (nth 0 ,details))) - -(defun imap-hash-get (key iht &optional refetch) - "Get the value for KEY in the imap-hash IHT. -Requires either `imap-hash-fetch' to be called beforehand -\(e.g. by `imap-hash-map'), or REFETCH to be t. -Returns a list of the headers (an alist, see `imap-hash-map') and -the body of the message as a string. -Also see `imap-hash-test'." - (with-current-buffer (imap-hash-get-buffer iht) - (when refetch - (imap-hash-fetch iht nil key)) - (let ((details (imap-hash-gather key))) - (list - (imap-hash-get-headers - (imap-hash-data-headers details)) - (imap-hash-get-body - (imap-hash-data-body details)))))) - -(defun imap-hash-put (value iht &optional key) - "Put VALUE in the imap-hash IHT. Return the new key. -If KEY is given, removes it. -VALUE can be a list of the headers (an alist, see `imap-hash-map') -and the body of the message as a string. It can also be a uid, -in which case `imap-hash-get' will be called to get the value. -Also see `imap-hash-test'." - (let ((server-buffer (imap-hash-get-buffer iht)) - (value (if (listp value) value (imap-hash-get value iht))) - newuid) - (when value - (with-temp-buffer - (funcall 'imap-hash-make-message - (nth 0 value) - (nth 1 value) - nil) - (setq newuid (nth 1 (imap-message-append - (imap-hash-mailbox iht) - (current-buffer) nil nil server-buffer))) - (when key (imap-hash-rem key iht)))) - newuid)) - -(defun imap-hash-make-message (headers body &optional overrides) - "Make a message with HEADERS and BODY suitable for `imap-append', -using `message-setup'. -Look in the alist OVERRIDES for header overrides as per `imap-hash-headers'." - ;; don't insert a signature no matter what - (let (message-signature) - (message-setup - (append overrides headers)) - (message-generate-headers message-required-mail-headers) - (message-remove-header "X-Draft-From") - (message-goto-body) - (insert (or (aget overrides 'body) - body - "")) - (goto-char (point-min)) - ;; TODO: make this search better - (if (search-forward mail-header-separator nil t) - (delete-region (line-beginning-position) (line-end-position)) - (error "Could not find the body separator in the encoded message!")))) - -(defun imap-hash-rem (key iht) - "Remove KEY in the imap-hash IHT. -Also see `imap-hash-test'. Requires `imap-hash-fetch' to have -been called and the imap-hash server buffer to be current, -so it's best to use it inside `imap-hash-map'. -The key will not be found on the next `imap-hash-map' call." - (with-current-buffer (imap-hash-get-buffer iht) - (imap-message-flags-add - (imap-range-to-message-set (list key)) - "\\Deleted" 'silent) - (imap-mailbox-expunge t))) - -(defun imap-hash-clear (iht) - "Remove all keys in the imap-hash IHT. -Also see `imap-hash-test'." - (imap-hash-map (lambda (uid b c) (imap-hash-rem uid iht)) iht)) - -(defun imap-hash-get-headers (text-headers) - (with-temp-buffer - (insert (or text-headers "")) - (imap-hash-remove-cr-followed-by-lf) - (mapcar (lambda (header) - (cons header - (message-fetch-field (format "%s" header)))) - imap-hash-headers))) - -(defun imap-hash-get-body (text) - (with-temp-buffer - (insert (or text "")) - (imap-hash-remove-cr-followed-by-lf) - (buffer-string))) - -(defun imap-hash-map (function iht &optional headers-only &rest messages) - "Call FUNCTION for all entries in IHT and pass it the message uid, -the headers (an alist, see `imap-hash-headers'), and the body -contents as a string. If HEADERS-ONLY is not nil, the body will be nil. -Returns results of evaluating, as would `mapcar'. -If MESSAGES are given, iterate only over those UIDs. -Also see `imap-hash-test'." - (imap-hash-fetch iht headers-only) - (let ((test (imap-hash-test iht))) - (with-current-buffer (imap-hash-get-buffer iht) - (delq nil - (imap-message-map (lambda (message ignored-parameter) - (let* ((details (imap-hash-gather message)) - (headers (imap-hash-data-headers details)) - (hlist (imap-hash-get-headers headers)) - (runit (cond - ((stringp test) - (string-match - test - (format "%s" (aget hlist 'Subject)))) - ((functionp test) - (funcall test hlist)) - ;; otherwise, return test itself - (t test)))) - ;;(debug message headers) - (when runit - (funcall function - message - (imap-hash-get-headers - headers) - (imap-hash-get-body - (imap-hash-data-body details)))))) - "UID"))))) - -(defun imap-hash-count (iht) - "Count the number of messages in the imap-hash IHT. -Also see `imap-hash-test'. It uses `imap-hash-map' so just use that -function if you want to do more than count the elements." - (length (imap-hash-map (lambda (a b c)) iht t))) - -(defalias 'imap-hash-size 'imap-hash-count) - -(defun imap-hash-test (iht) - "Return the test used by `imap-hash-map' for IHT. -When the test is t, any key will be a candidate. -When the test is a string, messages will be filtered on that string as a -regexp against the subject. -When the test is a function, messages will be filtered with it. -The function is passed the message headers (see `imap-hash-get-headers')." - (plist-get iht :test)) - -(defun imap-hash-server (iht) - "Return the server used by the imap-hash IHT." - (plist-get iht :server)) - -(defun imap-hash-port (iht) - "Return the port used by the imap-hash IHT." - (plist-get iht :port)) - -(defun imap-hash-ssl (iht) - "Return the SSL need for the imap-hash IHT." - (plist-get iht :ssl)) - -(defun imap-hash-mailbox (iht) - "Return the mailbox used by the imap-hash IHT." - (plist-get iht :mailbox)) - -(defun imap-hash-user (iht) - "Return the username used by the imap-hash IHT." - (plist-get iht :user)) - -(defun imap-hash-password (iht) - "Return the password used by the imap-hash IHT." - (plist-get iht :password)) - -(defun imap-hash-open-connection (iht) - "Open the connection used for IMAP interactions with the imap-hash IHT." - (let* ((server (imap-hash-server iht)) - (port (imap-hash-port iht)) - (ssl-need (imap-hash-ssl iht)) - (auth-need (not (and (imap-hash-user iht) - (imap-hash-password iht)))) - ;; this will not be needed if auth-need is t - (auth-info (when auth-need - (auth-source-user-or-password - '("login" "password") - server port))) - (auth-user (or (imap-hash-user iht) - (nth 0 auth-info))) - (auth-passwd (or (imap-hash-password iht) - (nth 1 auth-info))) - (imap-logout-timeout nil)) - - ;; (debug "opening server: opened+state" (imap-opened) imap-state) - ;; this is the only place where IMAP vs IMAPS matters - (if (imap-open server port (if ssl-need 'ssl nil) nil (current-buffer)) - (progn - ;; (debug "after opening server: opened+state" (imap-opened (current-buffer)) imap-state) - ;; (debug "authenticating" auth-user auth-passwd) - (if (not (imap-capability 'IMAP4rev1)) - (error "IMAP server does not support IMAP4r1, it won't work, sorry") - (imap-authenticate auth-user auth-passwd) - (imap-id) - ;; (debug "after authenticating: opened+state" (imap-opened (current-buffer)) imap-state) - (imap-opened (current-buffer)))) - (error "Could not open the IMAP buffer")))) - -(defun imap-hash-get-buffer (iht) - "Get or create the connection buffer to be used for the imap-hash IHT." - (let* ((name (imap-hash-buffer-name iht)) - (buffer (get-buffer name))) - (if (and buffer (imap-opened buffer)) - buffer - (when buffer (kill-buffer buffer)) - (with-current-buffer (get-buffer-create name) - (setq buffer-undo-list t) - (when (imap-hash-open-connection iht) - (current-buffer)))))) - -(defun imap-hash-buffer-name (iht) - "Get the connection buffer to be used for the imap-hash IHT." - (when (imap-hash-p iht) - (let ((server (imap-hash-server iht)) - (port (imap-hash-port iht)) - (ssl-text (if (imap-hash-ssl iht) "SSL" "NoSSL"))) - (format "*imap-hash/%s:%s:%s*" server port ssl-text)))) - -(defun imap-hash-fetch (iht &optional headers-only &rest messages) - "Fetch all the messages for imap-hash IHT. -Get only the headers if HEADERS-ONLY is not nil." - (with-current-buffer (imap-hash-get-buffer iht) - (let ((range (if messages - (list - (imap-range-to-message-set messages) - (imap-range-to-message-set messages)) - '("1:*" . "1,*:*")))) - - ;; (with-current-buffer "*imap-debug*" - ;; (erase-buffer)) - (imap-mailbox-unselect) - (imap-mailbox-select (imap-hash-mailbox iht)) - ;; (debug "after selecting mailbox: opened+state" (imap-opened) imap-state) - ;; (setq imap-message-data (make-vector imap-message-prime 0) - (imap-fetch-safe range - (concat (format "(UID RFC822.SIZE BODY %s " - (if headers-only "" "BODY.PEEK[TEXT]")) - (format "BODY.PEEK[HEADER.FIELDS %s])" - imap-hash-headers)))))) - -(provide 'imap-hash) -;;; imap-hash.el ends here - -;; ignore, for testing only - -;;; (setq iht (imap-hash-make "yourhosthere.com" "imap" "INBOX.test")) -;;; (setq iht (imap-hash-make "yourhosthere.com" "imap" "test")) -;;; (imap-hash-make "server1" "INBOX.mailbox2") -;;; (imap-hash-p iht) -;;; (imap-hash-get 35 iht) -;;; (imap-hash-get 38 iht) -;;; (imap-hash-get 37 iht t) -;;; (mapc (lambda (buffer) (with-current-buffer buffer (erase-buffer))) '("*imap-debug*" "*imap-log*")) -;;; (imap-hash-put (imap-hash-get 5 iht) iht) -;;; (with-current-buffer (imap-hash-get-buffer iht) (let ((uid (imap-hash-put (imap-hash-get 5 iht) iht))) (imap-hash-put uid iht uid))) -;;; (imap-hash-put (imap-hash-get 35 iht) iht) -;;; (imap-hash-make-message '((Subject . "normal")) "normal body") -;;; (imap-hash-make-message '((Subject . "old")) "old body" '((Subject . "new"))) -;;; (imap-hash-make-message '((Subject . "old")) "old body" '((body . "new body")) (lambda (subject) (concat "overwrite-" subject))) -;;; (imap-hash-make-message '((Subject . "old")) "old body" '((Subject . "change this")) (lambda (subject) (concat "overwrite-" subject))) -;;; (imap-hash-make-message '((Subject . "Twelcome")) "body here" nil) -;; (with-current-buffer (imap-hash-get-buffer iht) (imap-hash-rem (imap-hash-put (imap-hash-get 5 iht) iht) iht)) -;;; (kill-buffer (imap-hash-buffer-name iht)) -;;; (imap-hash-map 'debug iht) -;;; (imap-hash-map 'debug iht t) -;;;(tramp-imap-handle-file-inode "/imap:yourhosthere.com:/test/welcome") -;;;(imap-hash-count iht) -;;; (mapc (lambda (buffer) (with-current-buffer buffer (erase-buffer))) '("*imap-debug*" "*imap-log*")) -;;; (kill-buffer (imap-hash-buffer-name iht)) -;;; this should always return t if the server is up, automatically reopening if needed -;;; (imap-opened (imap-hash-get-buffer iht)) -;;; (imap-hash-buffer-name iht) -;;; (with-current-buffer (imap-hash-get-buffer iht) (debug "mailbox data, auth and state" imap-mailbox-data imap-auth imap-state)) -;;;(tramp-imap-handle-file-inode "/imap:yourhosthere.com:/test/welcome") -;;; (imap-hash-fetch iht nil) -;;; (imap-hash-fetch iht t) -;;; (imap-hash-fetch iht nil 1 2 3) -;;; (imap-hash-fetch iht t 1 2 3) - diff --git a/lisp/net/netrc.el b/lisp/net/netrc.el index 59e9eab5fc3..b04863b5fc0 100644 --- a/lisp/net/netrc.el +++ b/lisp/net/netrc.el @@ -63,10 +63,10 @@ alist elem result pair) (if (and netrc-cache (equal (car netrc-cache) (nth 5 (file-attributes file)))) - ;; Store the contents of the file heavily encrypted in memory. (insert (base64-decode-string (rot13-string (cdr netrc-cache)))) (insert-file-contents file) (when (string-match "\\.gpg\\'" file) + ;; Store the contents of the file heavily encrypted in memory. (setq netrc-cache (cons (nth 5 (file-attributes file)) (rot13-string (base64-encode-string diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 8657dc58bf4..1d419dbfa18 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -556,6 +556,11 @@ If ARG is non-nil, instead prompt for connection parameters." `(with-current-buffer rcirc-server-buffer ,@body)) +(defun rcirc-float-time () + (if (featurep 'xemacs) + (time-to-seconds (current-time)) + (float-time))) + (defun rcirc-keepalive () "Send keep alive pings to active rcirc processes. Kill processes that have not received a server message since the @@ -567,10 +572,7 @@ last ping." (rcirc-send-ctcp process rcirc-nick (format "KEEPALIVE %f" - (if (featurep 'xemacs) - (time-to-seconds - (current-time)) - (float-time))))))) + (rcirc-float-time)))))) (rcirc-process-list)) ;; no processes, clean up timer (cancel-timer rcirc-keepalive-timer) @@ -578,10 +580,7 @@ last ping." (defun rcirc-handler-ctcp-KEEPALIVE (process target sender message) (with-rcirc-process-buffer process - (setq header-line-format (format "%f" (- (if (featurep 'xemacs) - (time-to-seconds - (current-time)) - (float-time)) + (setq header-line-format (format "%f" (- (rcirc-float-time) (string-to-number message)))))) (defvar rcirc-debug-buffer " *rcirc debug*") @@ -2209,7 +2208,7 @@ With a prefix arg, prompt for new topic." (defun rcirc-ctcp-sender-PING (process target request) "Send a CTCP PING message to TARGET." - (let ((timestamp (format "%.0f" (float-time)))) + (let ((timestamp (format "%.0f" (rcirc-float-time)))) (rcirc-send-ctcp process target "PING" timestamp))) (defun rcirc-cmd-me (args &optional process target) diff --git a/lisp/net/soap-client.el b/lisp/net/soap-client.el new file mode 100644 index 00000000000..b4307223ba8 --- /dev/null +++ b/lisp/net/soap-client.el @@ -0,0 +1,1741 @@ +;;;; soap-client.el -- Access SOAP web services from Emacs + +;; Copyright (C) 2009-2011 Free Software Foundation, Inc. + +;; Author: Alexandru Harsanyi (AlexHarsanyi@gmail.com) +;; Created: December, 2009 +;; Keywords: soap, web-services, comm, hypermedia +;; Homepage: http://code.google.com/p/emacs-soap-client + +;; 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: +;; +;; To use the SOAP client, you first need to load the WSDL document for the +;; service you want to access, using `soap-load-wsdl-from-url'. A WSDL +;; document describes the available operations of the SOAP service, how their +;; parameters and responses are encoded. To invoke operations, you use the +;; `soap-invoke' method passing it the WSDL, the service name, the operation +;; you wish to invoke and any required parameters. +;; +;; Idealy, the service you want to access will have some documentation about +;; the operations it supports. If it does not, you can try using +;; `soap-inspect' to browse the WSDL document and see the available operations +;; and their parameters. +;; + +;;; Code: + +(eval-when-compile (require 'cl)) + +(require 'xml) +(require 'warnings) +(require 'url) +(require 'url-http) +(require 'url-util) +(require 'mm-decode) + +(defsubst soap-warning (message &rest args) + "Display a warning MESSAGE with ARGS, using the 'soap-client warning type." + (display-warning 'soap-client (apply 'format message args) :warning)) + +(defgroup soap-client nil + "Access SOAP web services from Emacs." + :group 'tools) + +;;;; Support for parsing XML documents with namespaces + +;; XML documents with namespaces are difficult to parse because the names of +;; the nodes depend on what "xmlns" aliases have been defined in the document. +;; To work with such documents, we introduce a translation layer between a +;; "well known" namespace tag and the local namespace tag in the document +;; being parsed. + +(defconst soap-well-known-xmlns + '(("apachesoap" . "http://xml.apache.org/xml-soap") + ("soapenc" . "http://schemas.xmlsoap.org/soap/encoding/") + ("wsdl" . "http://schemas.xmlsoap.org/wsdl/") + ("wsdlsoap" . "http://schemas.xmlsoap.org/wsdl/soap/") + ("xsd" . "http://www.w3.org/2001/XMLSchema") + ("xsi" . "http://www.w3.org/2001/XMLSchema-instance") + ("soap" . "http://schemas.xmlsoap.org/soap/envelope/") + ("soap12" . "http://schemas.xmlsoap.org/wsdl/soap12/") + ("http" . "http://schemas.xmlsoap.org/wsdl/http/") + ("mime" . "http://schemas.xmlsoap.org/wsdl/mime/")) + "A list of well known xml namespaces and their aliases.") + +(defvar soap-local-xmlns nil + "A list of local namespace aliases. +This is a dynamically bound variable, controlled by +`soap-with-local-xmlns'.") + +(defvar soap-default-xmlns nil + "The default XML namespaces. +Names in this namespace will be unqualified. This is a +dynamically bound variable, controlled by +`soap-with-local-xmlns'") + +(defvar soap-target-xmlns nil + "The target XML namespace. +New XSD elements will be defined in this namespace, unless they +are fully qualified for a different namespace. This is a +dynamically bound variable, controlled by +`soap-with-local-xmlns'") + +(defun soap-wk2l (well-known-name) + "Return local variant of WELL-KNOWN-NAME. +This is done by looking up the namespace in the +`soap-well-known-xmlns' table and resolving the namespace to +the local name based on the current local translation table +`soap-local-xmlns'. See also `soap-with-local-xmlns'." + (let ((wk-name-1 (if (symbolp well-known-name) + (symbol-name well-known-name) + well-known-name))) + (cond + ((string-match "^\\(.*\\):\\(.*\\)$" wk-name-1) + (let ((ns (match-string 1 wk-name-1)) + (name (match-string 2 wk-name-1))) + (let ((namespace (cdr (assoc ns soap-well-known-xmlns)))) + (cond ((equal namespace soap-default-xmlns) + ;; Name is unqualified in the default namespace + (if (symbolp well-known-name) + (intern name) + name)) + (t + (let* ((local-ns (car (rassoc namespace soap-local-xmlns))) + (local-name (concat local-ns ":" name))) + (if (symbolp well-known-name) + (intern local-name) + local-name))))))) + (t well-known-name)))) + +(defun soap-l2wk (local-name) + "Convert LOCAL-NAME into a well known name. +The namespace of LOCAL-NAME is looked up in the +`soap-well-known-xmlns' table and a well known namespace tag is +used in the name. + +nil is returned if there is no well-known namespace for the +namespace of LOCAL-NAME." + (let ((l-name-1 (if (symbolp local-name) + (symbol-name local-name) + local-name)) + namespace name) + (cond + ((string-match "^\\(.*\\):\\(.*\\)$" l-name-1) + (setq name (match-string 2 l-name-1)) + (let ((ns (match-string 1 l-name-1))) + (setq namespace (cdr (assoc ns soap-local-xmlns))) + (unless namespace + (error "Soap-l2wk(%s): no namespace for alias %s" local-name ns)))) + (t + (setq name l-name-1) + (setq namespace soap-default-xmlns))) + + (if namespace + (let ((well-known-ns (car (rassoc namespace soap-well-known-xmlns)))) + (if well-known-ns + (let ((well-known-name (concat well-known-ns ":" name))) + (if (symbol-name local-name) + (intern well-known-name) + well-known-name)) + (progn + ;; (soap-warning "soap-l2wk(%s): namespace %s has no well-known tag" + ;; local-name namespace) + nil))) + ;; if no namespace is defined, just return the unqualified name + name))) + + +(defun soap-l2fq (local-name &optional use-tns) + "Convert LOCAL-NAME into a fully qualified name. +A fully qualified name is a cons of the namespace name and the +name of the element itself. For example \"xsd:string\" is +converted to \(\"http://www.w3.org/2001/XMLSchema\" . \"string\"\). + +The USE-TNS argument specifies what to do when LOCAL-NAME has no +namespace tag. If USE-TNS is non-nil, the `soap-target-xmlns' +will be used as the element's namespace, otherwise +`soap-default-xmlns' will be used. + +This is needed because different parts of a WSDL document can use +different namespace aliases for the same element." + (let ((local-name-1 (if (symbolp local-name) + (symbol-name local-name) + local-name))) + (cond ((string-match "^\\(.*\\):\\(.*\\)$" local-name-1) + (let ((ns (match-string 1 local-name-1)) + (name (match-string 2 local-name-1))) + (let ((namespace (cdr (assoc ns soap-local-xmlns)))) + (if namespace + (cons namespace name) + (error "Soap-l2fq(%s): unknown alias %s" local-name ns))))) + (t + (cons (if use-tns + soap-target-xmlns + soap-default-xmlns) + local-name))))) + +(defun soap-extract-xmlns (node &optional xmlns-table) + "Return a namespace alias table for NODE by extending XMLNS-TABLE." + (let (xmlns default-ns target-ns) + (dolist (a (xml-node-attributes node)) + (let ((name (symbol-name (car a))) + (value (cdr a))) + (cond ((string= name "targetNamespace") + (setq target-ns value)) + ((string= name "xmlns") + (setq default-ns value)) + ((string-match "^xmlns:\\(.*\\)$" name) + (push (cons (match-string 1 name) value) xmlns))))) + + (let ((tns (assoc "tns" xmlns))) + (cond ((and tns target-ns) + ;; If a tns alias is defined for this node, it must match + ;; the target namespace. + (unless (equal target-ns (cdr tns)) + (soap-warning + "soap-extract-xmlns(%s): tns alias and targetNamespace mismatch" + (xml-node-name node)))) + ((and tns (not target-ns)) + (setq target-ns (cdr tns))) + ((and (not tns) target-ns) + ;; a tns alias was not defined in this node. See if the node has + ;; a "targetNamespace" attribute and add an alias to this. Note + ;; that we might override an existing tns alias in XMLNS-TABLE, + ;; but that is intended. + (push (cons "tns" target-ns) xmlns)))) + + (list default-ns target-ns (append xmlns xmlns-table)))) + +(defmacro soap-with-local-xmlns (node &rest body) + "Install a local alias table from NODE and execute BODY." + (declare (debug (form &rest form)) (indent 1)) + (let ((xmlns (make-symbol "xmlns"))) + `(let ((,xmlns (soap-extract-xmlns ,node soap-local-xmlns))) + (let ((soap-default-xmlns (or (nth 0 ,xmlns) soap-default-xmlns)) + (soap-target-xmlns (or (nth 1 ,xmlns) soap-target-xmlns)) + (soap-local-xmlns (nth 2 ,xmlns))) + ,@body)))) + +(defun soap-get-target-namespace (node) + "Return the target namespace of NODE. +This is the namespace in which new elements will be defined." + (or (xml-get-attribute-or-nil node 'targetNamespace) + (cdr (assoc "tns" soap-local-xmlns)) + soap-target-xmlns)) + +(defun soap-xml-get-children1 (node child-name) + "Return the children of NODE named CHILD-NAME. +This is the same as `xml-get-children', but CHILD-NAME can have +namespace tag." + (let (result) + (dolist (c (xml-node-children node)) + (when (and (consp c) + (soap-with-local-xmlns c + ;; We use `ignore-errors' here because we want to silently + ;; skip nodes for which we cannot convert them to a + ;; well-known name. + (eq (ignore-errors (soap-l2wk (xml-node-name c))) + child-name))) + (push c result))) + (nreverse result))) + +(defun soap-xml-get-attribute-or-nil1 (node attribute) + "Return the NODE's ATTRIBUTE, or nil if it does not exist. +This is the same as `xml-get-attribute-or-nil', but ATTRIBUTE can +be tagged with a namespace tag." + (catch 'found + (soap-with-local-xmlns node + (dolist (a (xml-node-attributes node)) + ;; We use `ignore-errors' here because we want to silently skip + ;; attributes for which we cannot convert them to a well-known name. + (when (eq (ignore-errors (soap-l2wk (car a))) attribute) + (throw 'found (cdr a))))))) + + +;;;; XML namespaces + +;; An element in an XML namespace, "things" stored in soap-xml-namespaces will +;; be derived from this object. + +(defstruct soap-element + name + ;; The "well-known" namespace tag for the element. For example, while + ;; parsing XML documents, we can have different tags for the XMLSchema + ;; namespace, but internally all our XMLSchema elements will have the "xsd" + ;; tag. + namespace-tag) + +(defun soap-element-fq-name (element) + "Return a fully qualified name for ELEMENT. +A fq name is the concatenation of the namespace tag and the +element name." + (concat (soap-element-namespace-tag element) + ":" (soap-element-name element))) + +;; a namespace link stores an alias for an object in once namespace to a +;; "target" object possibly in a different namespace + +(defstruct (soap-namespace-link (:include soap-element)) + target) + +;; A namespace is a collection of soap-element objects under a name (the name +;; of the namespace). + +(defstruct soap-namespace + (name nil :read-only t) ; e.g "http://xml.apache.org/xml-soap" + (elements (make-hash-table :test 'equal) :read-only t)) + +(defun soap-namespace-put (element ns) + "Store ELEMENT in NS. +Multiple elements with the same name can be stored in a +namespace. When retrieving the element you can specify a +discriminant predicate to `soap-namespace-get'" + (let ((name (soap-element-name element))) + (push element (gethash name (soap-namespace-elements ns))))) + +(defun soap-namespace-put-link (name target ns &optional replace) + "Store a link from NAME to TARGET in NS. +An error will be signaled if an element by the same name is +already present in NS, unless REPLACE is non nil. + +TARGET can be either a SOAP-ELEMENT or a string denoting an +element name into another namespace. + +If NAME is nil, an element with the same name as TARGET will be +added to the namespace." + + (unless (and name (not (equal name ""))) + ;; if name is nil, use TARGET as a name... + (cond ((soap-element-p target) + (setq name (soap-element-name target))) + ((stringp target) + (cond ((string-match "^\\(.*\\):\\(.*\\)$" target) + (setq name (match-string 2 target))) + (t + (setq name target)))))) + + (assert name) ; by now, name should be valid + (push (make-soap-namespace-link :name name :target target) + (gethash name (soap-namespace-elements ns)))) + +(defun soap-namespace-get (name ns &optional discriminant-predicate) + "Retrieve an element with NAME from the namespace NS. +If multiple elements with the same name exist, +DISCRIMINANT-PREDICATE is used to pick one of them. This allows +storing elements of different types (like a message type and a +binding) but the same name." + (assert (stringp name)) + (let ((elements (gethash name (soap-namespace-elements ns)))) + (cond (discriminant-predicate + (catch 'found + (dolist (e elements) + (when (funcall discriminant-predicate e) + (throw 'found e))))) + ((= (length elements) 1) (car elements)) + ((> (length elements) 1) + (error + "Soap-namespace-get(%s): multiple elements, discriminant needed" + name)) + (t + nil)))) + + +;;;; WSDL documents +;;;;; WSDL document elements + +(defstruct (soap-basic-type (:include soap-element)) + kind ; a symbol of: string, dateTime, long, int + ) + +(defstruct soap-sequence-element + name type nillable? multiple?) + +(defstruct (soap-sequence-type (:include soap-element)) + parent ; OPTIONAL WSDL-TYPE name + elements ; LIST of SOAP-SEQUCENCE-ELEMENT + ) + +(defstruct (soap-array-type (:include soap-element)) + element-type ; WSDL-TYPE of the array elements + ) + +(defstruct (soap-message (:include soap-element)) + parts ; ALIST of NAME => WSDL-TYPE name + ) + +(defstruct (soap-operation (:include soap-element)) + parameter-order + input ; (NAME . MESSAGE) + output ; (NAME . MESSAGE) + faults) ; a list of (NAME . MESSAGE) + +(defstruct (soap-port-type (:include soap-element)) + operations) ; a namespace of operations + +;; A bound operation is an operation which has a soap action and a use +;; method attached -- these are attached as part of a binding and we +;; can have different bindings for the same operations. +(defstruct soap-bound-operation + operation ; SOAP-OPERATION + soap-action ; value for SOAPAction HTTP header + use ; 'literal or 'encoded, see + ; http://www.w3.org/TR/wsdl#_soap:body + ) + +(defstruct (soap-binding (:include soap-element)) + port-type + (operations (make-hash-table :test 'equal) :readonly t)) + +(defstruct (soap-port (:include soap-element)) + service-url + binding) + +(defun soap-default-xsd-types () + "Return a namespace containing some of the XMLSchema types." + (let ((ns (make-soap-namespace :name "http://www.w3.org/2001/XMLSchema"))) + (dolist (type '("string" "dateTime" "boolean" "long" "int" "float" + "base64Binary" "anyType" "Array" "byte[]")) + (soap-namespace-put + (make-soap-basic-type :name type :kind (intern type)) + ns)) + ns)) + +(defun soap-default-soapenc-types () + "Return a namespace containing some of the SOAPEnc types." + (let ((ns (make-soap-namespace + :name "http://schemas.xmlsoap.org/soap/encoding/"))) + (dolist (type '("string" "dateTime" "boolean" "long" "int" "float" + "base64Binary" "anyType" "Array" "byte[]")) + (soap-namespace-put + (make-soap-basic-type :name type :kind (intern type)) + ns)) + ns)) + +(defun soap-type-p (element) + "Return t if ELEMENT is a SOAP data type (basic or complex)." + (or (soap-basic-type-p element) + (soap-sequence-type-p element) + (soap-array-type-p element))) + + +;;;;; The WSDL document + +;; The WSDL data structure used for encoding/decoding SOAP messages +(defstruct soap-wsdl + origin ; file or URL from which this wsdl was loaded + ports ; a list of SOAP-PORT instances + alias-table ; a list of namespace aliases + namespaces ; a list of namespaces + ) + +(defun soap-wsdl-add-alias (alias name wsdl) + "Add a namespace ALIAS for NAME to the WSDL document." + (push (cons alias name) (soap-wsdl-alias-table wsdl))) + +(defun soap-wsdl-find-namespace (name wsdl) + "Find a namespace by NAME in the WSDL document." + (catch 'found + (dolist (ns (soap-wsdl-namespaces wsdl)) + (when (equal name (soap-namespace-name ns)) + (throw 'found ns))))) + +(defun soap-wsdl-add-namespace (ns wsdl) + "Add the namespace NS to the WSDL document. +If a namespace by this name already exists in WSDL, individual +elements will be added to it." + (let ((existing (soap-wsdl-find-namespace (soap-namespace-name ns) wsdl))) + (if existing + ;; Add elements from NS to EXISTING, replacing existing values. + (maphash (lambda (key value) + (dolist (v value) + (soap-namespace-put v existing))) + (soap-namespace-elements ns)) + (push ns (soap-wsdl-namespaces wsdl))))) + +(defun soap-wsdl-get (name wsdl &optional predicate use-local-alias-table) + "Retrieve element NAME from the WSDL document. + +PREDICATE is used to differentiate between elements when NAME +refers to multiple elements. A typical value for this would be a +structure predicate for the type of element you want to retrieve. +For example, to retrieve a message named \"foo\" when other +elements named \"foo\" exist in the WSDL you could use: + + (soap-wsdl-get \"foo\" WSDL 'soap-message-p) + +If USE-LOCAL-ALIAS-TABLE is not nil, `soap-local-xmlns` will be +used to resolve the namespace alias." + (let ((alias-table (soap-wsdl-alias-table wsdl)) + namespace element-name element) + + (when (symbolp name) + (setq name (symbol-name name))) + + (when use-local-alias-table + (setq alias-table (append soap-local-xmlns alias-table))) + + (cond ((consp name) ; a fully qualified name, as returned by `soap-l2fq' + (setq element-name (cdr name)) + (when (symbolp element-name) + (setq element-name (symbol-name element-name))) + (setq namespace (soap-wsdl-find-namespace (car name) wsdl)) + (unless namespace + (error "Soap-wsdl-get(%s): unknown namespace: %s" name namespace))) + + ((string-match "^\\(.*\\):\\(.*\\)$" name) + (setq element-name (match-string 2 name)) + + (let* ((ns-alias (match-string 1 name)) + (ns-name (cdr (assoc ns-alias alias-table)))) + (unless ns-name + (error "Soap-wsdl-get(%s): cannot find namespace alias %s" + name ns-alias)) + + (setq namespace (soap-wsdl-find-namespace ns-name wsdl)) + (unless namespace + (error + "Soap-wsdl-get(%s): unknown namespace %s, referenced by alias %s" + name ns-name ns-alias)))) + (t + (error "Soap-wsdl-get(%s): bad name" name))) + + (setq element (soap-namespace-get + element-name namespace + (if predicate + (lambda (e) + (or (funcall 'soap-namespace-link-p e) + (funcall predicate e))) + nil))) + + (unless element + (error "Soap-wsdl-get(%s): cannot find element" name)) + + (if (soap-namespace-link-p element) + ;; NOTE: don't use the local alias table here + (soap-wsdl-get (soap-namespace-link-target element) wsdl predicate) + element))) + +;;;;; Resolving references for wsdl types + +;; See `soap-wsdl-resolve-references', which is the main entry point for +;; resolving references + +(defun soap-resolve-references-for-element (element wsdl) + "Resolve references in ELEMENT using the WSDL document. +This is a generic function which invokes a specific function +depending on the element type. + +If ELEMENT has no resolver function, it is silently ignored. + +All references are resolved in-place, that is the ELEMENT is +updated." + (let ((resolver (get (aref element 0) 'soap-resolve-references))) + (when resolver + (funcall resolver element wsdl)))) + +(defun soap-resolve-references-for-sequence-type (type wsdl) + "Resolve references for a sequence TYPE using WSDL document. +See also `soap-resolve-references-for-element' and +`soap-wsdl-resolve-references'" + (let ((parent (soap-sequence-type-parent type))) + (when (or (consp parent) (stringp parent)) + (setf (soap-sequence-type-parent type) + (soap-wsdl-get parent wsdl 'soap-type-p)))) + (dolist (element (soap-sequence-type-elements type)) + (let ((element-type (soap-sequence-element-type element))) + (cond ((or (consp element-type) (stringp element-type)) + (setf (soap-sequence-element-type element) + (soap-wsdl-get element-type wsdl 'soap-type-p))) + ((soap-element-p element-type) + ;; since the element already has a child element, it + ;; could be an inline structure. we must resolve + ;; references in it, because it might not be reached by + ;; scanning the wsdl names. + (soap-resolve-references-for-element element-type wsdl)))))) + +(defun soap-resolve-references-for-array-type (type wsdl) + "Resolve references for an array TYPE using WSDL. +See also `soap-resolve-references-for-element' and +`soap-wsdl-resolve-references'" + (let ((element-type (soap-array-type-element-type type))) + (when (or (consp element-type) (stringp element-type)) + (setf (soap-array-type-element-type type) + (soap-wsdl-get element-type wsdl 'soap-type-p))))) + +(defun soap-resolve-references-for-message (message wsdl) + "Resolve references for a MESSAGE type using the WSDL document. +See also `soap-resolve-references-for-element' and +`soap-wsdl-resolve-references'" + (let (resolved-parts) + (dolist (part (soap-message-parts message)) + (let ((name (car part)) + (type (cdr part))) + (when (stringp name) + (setq name (intern name))) + (when (or (consp type) (stringp type)) + (setq type (soap-wsdl-get type wsdl 'soap-type-p))) + (push (cons name type) resolved-parts))) + (setf (soap-message-parts message) (nreverse resolved-parts)))) + +(defun soap-resolve-references-for-operation (operation wsdl) + "Resolve references for an OPERATION type using the WSDL document. +See also `soap-resolve-references-for-element' and +`soap-wsdl-resolve-references'" + (let ((input (soap-operation-input operation)) + (counter 0)) + (let ((name (car input)) + (message (cdr input))) + ;; Name this part if it was not named + (when (or (null name) (equal name "")) + (setq name (format "in%d" (incf counter)))) + (when (or (consp message) (stringp message)) + (setf (soap-operation-input operation) + (cons (intern name) + (soap-wsdl-get message wsdl 'soap-message-p)))))) + + (let ((output (soap-operation-output operation)) + (counter 0)) + (let ((name (car output)) + (message (cdr output))) + (when (or (null name) (equal name "")) + (setq name (format "out%d" (incf counter)))) + (when (or (consp message) (stringp message)) + (setf (soap-operation-output operation) + (cons (intern name) + (soap-wsdl-get message wsdl 'soap-message-p)))))) + + (let ((resolved-faults nil) + (counter 0)) + (dolist (fault (soap-operation-faults operation)) + (let ((name (car fault)) + (message (cdr fault))) + (when (or (null name) (equal name "")) + (setq name (format "fault%d" (incf counter)))) + (if (or (consp message) (stringp message)) + (push (cons (intern name) + (soap-wsdl-get message wsdl 'soap-message-p)) + resolved-faults) + (push fault resolved-faults)))) + (setf (soap-operation-faults operation) resolved-faults)) + + (when (= (length (soap-operation-parameter-order operation)) 0) + (setf (soap-operation-parameter-order operation) + (mapcar 'car (soap-message-parts + (cdr (soap-operation-input operation)))))) + + (setf (soap-operation-parameter-order operation) + (mapcar (lambda (p) + (if (stringp p) + (intern p) + p)) + (soap-operation-parameter-order operation)))) + +(defun soap-resolve-references-for-binding (binding wsdl) + "Resolve references for a BINDING type using the WSDL document. +See also `soap-resolve-references-for-element' and +`soap-wsdl-resolve-references'" + (when (or (consp (soap-binding-port-type binding)) + (stringp (soap-binding-port-type binding))) + (setf (soap-binding-port-type binding) + (soap-wsdl-get (soap-binding-port-type binding) + wsdl 'soap-port-type-p))) + + (let ((port-ops (soap-port-type-operations (soap-binding-port-type binding)))) + (maphash (lambda (k v) + (setf (soap-bound-operation-operation v) + (soap-namespace-get k port-ops 'soap-operation-p))) + (soap-binding-operations binding)))) + +(defun soap-resolve-references-for-port (port wsdl) + "Resolve references for a PORT type using the WSDL document. +See also `soap-resolve-references-for-element' and +`soap-wsdl-resolve-references'" + (when (or (consp (soap-port-binding port)) + (stringp (soap-port-binding port))) + (setf (soap-port-binding port) + (soap-wsdl-get (soap-port-binding port) wsdl 'soap-binding-p)))) + +;; Install resolvers for our types +(progn + (put (aref (make-soap-sequence-type) 0) 'soap-resolve-references + 'soap-resolve-references-for-sequence-type) + (put (aref (make-soap-array-type) 0) 'soap-resolve-references + 'soap-resolve-references-for-array-type) + (put (aref (make-soap-message) 0) 'soap-resolve-references + 'soap-resolve-references-for-message) + (put (aref (make-soap-operation) 0) 'soap-resolve-references + 'soap-resolve-references-for-operation) + (put (aref (make-soap-binding) 0) 'soap-resolve-references + 'soap-resolve-references-for-binding) + (put (aref (make-soap-port) 0) 'soap-resolve-references + 'soap-resolve-references-for-port)) + +(defun soap-wsdl-resolve-references (wsdl) + "Resolve all references inside the WSDL structure. + +When the WSDL elements are created from the XML document, they +refer to each other by name. For example, the ELEMENT-TYPE slot +of an SOAP-ARRAY-TYPE will contain the name of the element and +the user would have to call `soap-wsdl-get' to obtain the actual +element. + +After the entire document is loaded, we resolve all these +references to the actual elements they refer to so that at +runtime, we don't have to call `soap-wsdl-get' each time we +traverse an element tree." + (let ((nprocessed 0) + (nstag-id 0) + (alias-table (soap-wsdl-alias-table wsdl))) + (dolist (ns (soap-wsdl-namespaces wsdl)) + (let ((nstag (car-safe (rassoc (soap-namespace-name ns) alias-table)))) + (unless nstag + ;; If this namespace does not have an alias, create one for it. + (catch 'done + (while t + (setq nstag (format "ns%d" (incf nstag-id))) + (unless (assoc nstag alias-table) + (soap-wsdl-add-alias nstag (soap-namespace-name ns) wsdl) + (throw 'done t))))) + + (maphash (lambda (name element) + (cond ((soap-element-p element) ; skip links + (incf nprocessed) + (soap-resolve-references-for-element element wsdl) + (setf (soap-element-namespace-tag element) nstag)) + ((listp element) + (dolist (e element) + (when (soap-element-p e) + (incf nprocessed) + (soap-resolve-references-for-element e wsdl) + (setf (soap-element-namespace-tag e) nstag)))))) + (soap-namespace-elements ns)))) + + (message "Processed %d" nprocessed)) + wsdl) + +;;;;; Loading WSDL from XML documents + +(defun soap-load-wsdl-from-url (url) + "Load a WSDL document from URL and return it. +The returned WSDL document needs to be used for `soap-invoke' +calls." + (let ((url-request-method "GET") + (url-package-name "soap-client.el") + (url-package-version "1.0") + (url-mime-charset-string "utf-8;q=1, iso-8859-1;q=0.5") + (url-request-coding-system 'utf-8) + (url-http-attempt-keepalives nil)) + (let ((buffer (url-retrieve-synchronously url))) + (with-current-buffer buffer + (declare (special url-http-response-status)) + (if (> url-http-response-status 299) + (error "Error retrieving WSDL: %s" url-http-response-status)) + (let ((mime-part (mm-dissect-buffer t t))) + (unless mime-part + (error "Failed to decode response from server")) + (unless (equal (car (mm-handle-type mime-part)) "text/xml") + (error "Server response is not an XML document")) + (with-temp-buffer + (mm-insert-part mime-part) + (let ((wsdl-xml (car (xml-parse-region (point-min) (point-max))))) + (prog1 + (let ((wsdl (soap-parse-wsdl wsdl-xml))) + (setf (soap-wsdl-origin wsdl) url) + wsdl) + (kill-buffer buffer))))))))) + +(defun soap-load-wsdl (file) + "Load a WSDL document from FILE and return it." + (with-temp-buffer + (insert-file-contents file) + (let ((xml (car (xml-parse-region (point-min) (point-max))))) + (let ((wsdl (soap-parse-wsdl xml))) + (setf (soap-wsdl-origin wsdl) file) + wsdl)))) + +(defun soap-parse-wsdl (node) + "Construct a WSDL structure from NODE, which is an XML document." + (soap-with-local-xmlns node + + (assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:definitions) + nil + "soap-parse-wsdl: expecting wsdl:definitions node, got %s" + (soap-l2wk (xml-node-name node))) + + (let ((wsdl (make-soap-wsdl))) + + ;; Add the local alias table to the wsdl document -- it will be used for + ;; all types in this document even after we finish parsing it. + (setf (soap-wsdl-alias-table wsdl) soap-local-xmlns) + + ;; Add the XSD types to the wsdl document + (let ((ns (soap-default-xsd-types))) + (soap-wsdl-add-namespace ns wsdl) + (soap-wsdl-add-alias "xsd" (soap-namespace-name ns) wsdl)) + + ;; Add the soapenc types to the wsdl document + (let ((ns (soap-default-soapenc-types))) + (soap-wsdl-add-namespace ns wsdl) + (soap-wsdl-add-alias "soapenc" (soap-namespace-name ns) wsdl)) + + ;; Find all the 'xsd:schema nodes which are children of wsdl:types nodes + ;; and build our type-library + + (let ((types (car (soap-xml-get-children1 node 'wsdl:types)))) + (dolist (node (xml-node-children types)) + ;; We cannot use (xml-get-children node (soap-wk2l 'xsd:schema)) + ;; because each node can install its own alias type so the schema + ;; nodes might have a different prefix. + (when (consp node) + (soap-with-local-xmlns node + (when (eq (soap-l2wk (xml-node-name node)) 'xsd:schema) + (soap-wsdl-add-namespace (soap-parse-schema node) wsdl)))))) + + (let ((ns (make-soap-namespace :name (soap-get-target-namespace node)))) + (dolist (node (soap-xml-get-children1 node 'wsdl:message)) + (soap-namespace-put (soap-parse-message node) ns)) + + (dolist (node (soap-xml-get-children1 node 'wsdl:portType)) + (let ((port-type (soap-parse-port-type node))) + (soap-namespace-put port-type ns) + (soap-wsdl-add-namespace + (soap-port-type-operations port-type) wsdl))) + + (dolist (node (soap-xml-get-children1 node 'wsdl:binding)) + (soap-namespace-put (soap-parse-binding node) ns)) + + (dolist (node (soap-xml-get-children1 node 'wsdl:service)) + (dolist (node (soap-xml-get-children1 node 'wsdl:port)) + (let ((name (xml-get-attribute node 'name)) + (binding (xml-get-attribute node 'binding)) + (url (let ((n (car (soap-xml-get-children1 + node 'wsdlsoap:address)))) + (xml-get-attribute n 'location)))) + (let ((port (make-soap-port + :name name :binding (soap-l2fq binding 'tns) + :service-url url))) + (soap-namespace-put port ns) + (push port (soap-wsdl-ports wsdl)))))) + + (soap-wsdl-add-namespace ns wsdl)) + + (soap-wsdl-resolve-references wsdl) + + wsdl))) + +(defun soap-parse-schema (node) + "Parse a schema NODE. +Return a SOAP-NAMESPACE containing the elements." + (soap-with-local-xmlns node + (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:schema) + nil + "soap-parse-schema: expecting an xsd:schema node, got %s" + (soap-l2wk (xml-node-name node))) + (let ((ns (make-soap-namespace :name (soap-get-target-namespace node)))) + ;; NOTE: we only extract the complexTypes from the schema, we wouldn't + ;; know how to handle basic types beyond the built in ones anyway. + (dolist (node (soap-xml-get-children1 node 'xsd:complexType)) + (soap-namespace-put (soap-parse-complex-type node) ns)) + + (dolist (node (soap-xml-get-children1 node 'xsd:element)) + (soap-namespace-put (soap-parse-schema-element node) ns)) + + ns))) + +(defun soap-parse-schema-element (node) + "Parse NODE and construct a schema element from it." + (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:element) + nil + "soap-parse-schema-element: expecting xsd:element node, got %s" + (soap-l2wk (xml-node-name node))) + (let ((name (xml-get-attribute-or-nil node 'name)) + type) + ;; A schema element that contains an inline complex type -- + ;; construct the actual complex type for it. + (let ((type-node (soap-xml-get-children1 node 'xsd:complexType))) + (when (> (length type-node) 0) + (assert (= (length type-node) 1)) ; only one complex type + ; definition per element + (setq type (soap-parse-complex-type (car type-node))))) + (setf (soap-element-name type) name) + type)) + +(defun soap-parse-complex-type (node) + "Parse NODE and construct a complex type from it." + (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:complexType) + nil + "soap-parse-complex-type: expecting xsd:complexType node, got %s" + (soap-l2wk (xml-node-name node))) + (let ((name (xml-get-attribute-or-nil node 'name)) + ;; Use a dummy type for the complex type, it will be replaced + ;; with the real type below, except when the complex type node + ;; is empty... + (type (make-soap-sequence-type :elements nil))) + (dolist (c (xml-node-children node)) + (when (consp c) ; skip string nodes, which are whitespace + (let ((node-name (soap-l2wk (xml-node-name c)))) + (cond + ((eq node-name 'xsd:sequence) + (setq type (soap-parse-complex-type-sequence c))) + ((eq node-name 'xsd:complexContent) + (setq type (soap-parse-complex-type-complex-content c))) + ((eq node-name 'xsd:attribute) + ;; The name of this node comes from an attribute tag + (let ((n (xml-get-attribute-or-nil c 'name))) + (setq name n))) + (t + (error "Unknown node type %s" node-name)))))) + (setf (soap-element-name type) name) + type)) + +(defun soap-parse-sequence (node) + "Parse NODE and a list of sequence elements that it defines. +NODE is assumed to be an xsd:sequence node. In that case, each +of its children is assumed to be a sequence element. Each +sequence element is parsed constructing the corresponding type. +A list of these types is returned." + (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:sequence) + nil + "soap-parse-sequence: expecting xsd:sequence node, got %s" + (soap-l2wk (xml-node-name node))) + (let (elements) + (dolist (e (soap-xml-get-children1 node 'xsd:element)) + (let ((name (xml-get-attribute-or-nil e 'name)) + (type (xml-get-attribute-or-nil e 'type)) + (nillable? (or (equal (xml-get-attribute-or-nil e 'nillable) "true") + (let ((e (xml-get-attribute-or-nil e 'minOccurs))) + (and e (equal e "0"))))) + (multiple? (let ((e (xml-get-attribute-or-nil e 'maxOccurs))) + (and e (not (equal e "1")))))) + (if type + (setq type (soap-l2fq type 'tns)) + + ;; The node does not have a type, maybe it has a complexType + ;; defined inline... + (let ((type-node (soap-xml-get-children1 e 'xsd:complexType))) + (when (> (length type-node) 0) + (assert (= (length type-node) 1) + nil + "only one complex type definition per element supported") + (setq type (soap-parse-complex-type (car type-node)))))) + + (push (make-soap-sequence-element + :name (intern name) :type type :nillable? nillable? + :multiple? multiple?) + elements))) + (nreverse elements))) + +(defun soap-parse-complex-type-sequence (node) + "Parse NODE as a sequence type." + (let ((elements (soap-parse-sequence node))) + (make-soap-sequence-type :elements elements))) + +(defun soap-parse-complex-type-complex-content (node) + "Parse NODE as a xsd:complexContent node. +A sequence or an array type is returned depending on the actual +contents." + (assert (eq (soap-l2wk (xml-node-name node)) 'xsd:complexContent) + nil + "soap-parse-complex-type-complex-content: expecting xsd:complexContent node, got %s" + (soap-l2wk (xml-node-name node))) + (let (array? parent elements) + (let ((extension (car-safe (soap-xml-get-children1 node 'xsd:extension))) + (restriction (car-safe + (soap-xml-get-children1 node 'xsd:restriction)))) + ;; a complex content node is either an extension or a restriction + (cond (extension + (setq parent (xml-get-attribute-or-nil extension 'base)) + (setq elements (soap-parse-sequence + (car (soap-xml-get-children1 + extension 'xsd:sequence))))) + (restriction + (let ((base (xml-get-attribute-or-nil restriction 'base))) + (assert (equal base "soapenc:Array") + nil + "restrictions supported only for soapenc:Array types, this is a %s" + base)) + (setq array? t) + (let ((attribute (car (soap-xml-get-children1 + restriction 'xsd:attribute)))) + (let ((array-type (soap-xml-get-attribute-or-nil1 + attribute 'wsdl:arrayType))) + (when (string-match "^\\(.*\\)\\[\\]$" array-type) + (setq parent (match-string 1 array-type)))))) + + (t + (error "Unknown complex type")))) + + (if parent + (setq parent (soap-l2fq parent 'tns))) + + (if array? + (make-soap-array-type :element-type parent) + (make-soap-sequence-type :parent parent :elements elements)))) + +(defun soap-parse-message (node) + "Parse NODE as a wsdl:message and return the corresponding type." + (assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:message) + nil + "soap-parse-message: expecting wsdl:message node, got %s" + (soap-l2wk (xml-node-name node))) + (let ((name (xml-get-attribute-or-nil node 'name)) + parts) + (dolist (p (soap-xml-get-children1 node 'wsdl:part)) + (let ((name (xml-get-attribute-or-nil p 'name)) + (type (xml-get-attribute-or-nil p 'type)) + (element (xml-get-attribute-or-nil p 'element))) + + (when type + (setq type (soap-l2fq type 'tns))) + + (when element + (setq element (soap-l2fq element 'tns))) + + (push (cons name (or type element)) parts))) + (make-soap-message :name name :parts (nreverse parts)))) + +(defun soap-parse-port-type (node) + "Parse NODE as a wsdl:portType and return the corresponding port." + (assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:portType) + nil + "soap-parse-port-type: expecting wsdl:portType node got %s" + (soap-l2wk (xml-node-name node))) + (let ((ns (make-soap-namespace + :name (concat "urn:" (xml-get-attribute node 'name))))) + (dolist (node (soap-xml-get-children1 node 'wsdl:operation)) + (let ((o (soap-parse-operation node))) + + (let ((other-operation (soap-namespace-get + (soap-element-name o) ns 'soap-operation-p))) + (if other-operation + ;; Unfortunately, the Confluence WSDL defines two operations + ;; named "search" which differ only in parameter names... + (soap-warning "Discarding duplicate operation: %s" + (soap-element-name o)) + + (progn + (soap-namespace-put o ns) + + ;; link all messages from this namespace, as this namespace + ;; will be used for decoding the response. + (destructuring-bind (name . message) (soap-operation-input o) + (soap-namespace-put-link name message ns)) + + (destructuring-bind (name . message) (soap-operation-output o) + (soap-namespace-put-link name message ns)) + + (dolist (fault (soap-operation-faults o)) + (destructuring-bind (name . message) fault + (soap-namespace-put-link name message ns 'replace))) + + ))))) + + (make-soap-port-type :name (xml-get-attribute node 'name) + :operations ns))) + +(defun soap-parse-operation (node) + "Parse NODE as a wsdl:operation and return the corresponding type." + (assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:operation) + nil + "soap-parse-operation: expecting wsdl:operation node, got %s" + (soap-l2wk (xml-node-name node))) + (let ((name (xml-get-attribute node 'name)) + (parameter-order (split-string + (xml-get-attribute node 'parameterOrder))) + input output faults) + (dolist (n (xml-node-children node)) + (when (consp n) ; skip string nodes which are whitespace + (let ((node-name (soap-l2wk (xml-node-name n)))) + (cond + ((eq node-name 'wsdl:input) + (let ((message (xml-get-attribute n 'message)) + (name (xml-get-attribute n 'name))) + (setq input (cons name (soap-l2fq message 'tns))))) + ((eq node-name 'wsdl:output) + (let ((message (xml-get-attribute n 'message)) + (name (xml-get-attribute n 'name))) + (setq output (cons name (soap-l2fq message 'tns))))) + ((eq node-name 'wsdl:fault) + (let ((message (xml-get-attribute n 'message)) + (name (xml-get-attribute n 'name))) + (push (cons name (soap-l2fq message 'tns)) faults))))))) + (make-soap-operation + :name name + :parameter-order parameter-order + :input input + :output output + :faults (nreverse faults)))) + +(defun soap-parse-binding (node) + "Parse NODE as a wsdl:binding and return the corresponding type." + (assert (eq (soap-l2wk (xml-node-name node)) 'wsdl:binding) + nil + "soap-parse-binding: expecting wsdl:binding node, got %s" + (soap-l2wk (xml-node-name node))) + (let ((name (xml-get-attribute node 'name)) + (type (xml-get-attribute node 'type))) + (let ((binding (make-soap-binding :name name + :port-type (soap-l2fq type 'tns)))) + (dolist (wo (soap-xml-get-children1 node 'wsdl:operation)) + (let ((name (xml-get-attribute wo 'name)) + soap-action + use) + (dolist (so (soap-xml-get-children1 wo 'wsdlsoap:operation)) + (setq soap-action (xml-get-attribute-or-nil so 'soapAction))) + + ;; Search a wsdlsoap:body node and find a "use" tag. The + ;; same use tag is assumed to be present for both input and + ;; output types (although the WDSL spec allows separate + ;; "use"-s for each of them... + + (dolist (i (soap-xml-get-children1 wo 'wsdl:input)) + (dolist (b (soap-xml-get-children1 i 'wsdlsoap:body)) + (setq use (or use + (xml-get-attribute-or-nil b 'use))))) + + (unless use + (dolist (i (soap-xml-get-children1 wo 'wsdl:output)) + (dolist (b (soap-xml-get-children1 i 'wsdlsoap:body)) + (setq use (or use + (xml-get-attribute-or-nil b 'use)))))) + + (puthash name (make-soap-bound-operation :operation name + :soap-action soap-action + :use (and use (intern use))) + (soap-binding-operations binding)))) + binding))) + +;;;; SOAP type decoding + +(defvar soap-multi-refs nil + "The list of multi-ref nodes in the current SOAP response. +This is a dynamically bound variable used during decoding the +SOAP response.") + +(defvar soap-decoded-multi-refs nil + "List of decoded multi-ref nodes in the current SOAP response. +This is a dynamically bound variable used during decoding the +SOAP response.") + +(defvar soap-current-wsdl nil + "The current WSDL document used when decoding the SOAP response. +This is a dynamically bound variable.") + +(defun soap-decode-type (type node) + "Use TYPE (an xsd type) to decode the contents of NODE. + +NODE is an XML node, representing some SOAP encoded value or a +reference to another XML node (a multiRef). This function will +resolve the multiRef reference, if any, than call a TYPE specific +decode function to perform the actual decoding." + (let ((href (xml-get-attribute-or-nil node 'href))) + (cond (href + (catch 'done + ;; NODE is actually a HREF, find the target and decode that. + ;; Check first if we already decoded this multiref. + + (let ((decoded (cdr (assoc href soap-decoded-multi-refs)))) + (when decoded + (throw 'done decoded))) + + (string-match "^#\\(.*\\)$" href) ; TODO: check that it matched + + (let ((id (match-string 1 href))) + (dolist (mr soap-multi-refs) + (let ((mrid (xml-get-attribute mr 'id))) + (when (equal id mrid) + ;; recurse here, in case there are multiple HREF's + (let ((decoded (soap-decode-type type mr))) + (push (cons href decoded) soap-decoded-multi-refs) + (throw 'done decoded))))) + (error "Cannot find href %s" href)))) + (t + (soap-with-local-xmlns node + (if (equal (soap-xml-get-attribute-or-nil1 node 'xsi:nil) "true") + nil + (let ((decoder (get (aref type 0) 'soap-decoder))) + (assert decoder nil "no soap-decoder for %s type" + (aref type 0)) + (funcall decoder type node)))))))) + +(defun soap-decode-any-type (node) + "Decode NODE using type information inside it." + ;; If the NODE has type information, we use that... + (let ((type (soap-xml-get-attribute-or-nil1 node 'xsi:type))) + (if type + (let ((wtype (soap-wsdl-get type soap-current-wsdl 'soap-type-p))) + (if wtype + (soap-decode-type wtype node) + ;; The node has type info encoded in it, but we don't know how + ;; to decode it... + (error "Soap-decode-any-type: node has unknown type: %s" type))) + + ;; No type info in the node... + + (let ((contents (xml-node-children node))) + (if (and (= (length contents) 1) (stringp (car contents))) + ;; contents is just a string + (car contents) + + ;; we assume the NODE is a sequence with every element a + ;; structure name + (let (result) + (dolist (element contents) + (let ((key (xml-node-name element)) + (value (soap-decode-any-type element))) + (push (cons key value) result))) + (nreverse result))))))) + +(defun soap-decode-array (node) + "Decode NODE as an Array using type information inside it." + (let ((type (soap-xml-get-attribute-or-nil1 node 'soapenc:arrayType)) + (wtype nil) + (contents (xml-node-children node)) + result) + (when type + ;; Type is in the format "someType[NUM]" where NUM is the number of + ;; elements in the array. We discard the [NUM] part. + (setq type (replace-regexp-in-string "\\[[0-9]+\\]\\'" "" type)) + (setq wtype (soap-wsdl-get type soap-current-wsdl 'soap-type-p)) + (unless wtype + ;; The node has type info encoded in it, but we don't know how to + ;; decode it... + (error "Soap-decode-array: node has unknown type: %s" type))) + (dolist (e contents) + (when (consp e) + (push (if wtype + (soap-decode-type wtype e) + (soap-decode-any-type e)) + result))) + (nreverse result))) + +(defun soap-decode-basic-type (type node) + "Use TYPE to decode the contents of NODE. +TYPE is a `soap-basic-type' struct, and NODE is an XML document. +A LISP value is returned based on the contents of NODE and the +type-info stored in TYPE." + (let ((contents (xml-node-children node)) + (type-kind (soap-basic-type-kind type))) + + (if (null contents) + nil + (ecase type-kind + (string (car contents)) + (dateTime (car contents)) ; TODO: convert to a date time + ((long int float) (string-to-number (car contents))) + (boolean (string= (downcase (car contents)) "true")) + (base64Binary (base64-decode-string (car contents))) + (anyType (soap-decode-any-type node)) + (Array (soap-decode-array node)))))) + +(defun soap-decode-sequence-type (type node) + "Use TYPE to decode the contents of NODE. +TYPE is assumed to be a sequence type and an ALIST with the +contents of the NODE is returned." + (let ((result nil) + (parent (soap-sequence-type-parent type))) + (when parent + (setq result (nreverse (soap-decode-type parent node)))) + (dolist (element (soap-sequence-type-elements type)) + (let ((instance-count 0) + (e-name (soap-sequence-element-name element)) + (e-type (soap-sequence-element-type element))) + (dolist (node (xml-get-children node e-name)) + (incf instance-count) + (push (cons e-name (soap-decode-type e-type node)) result)) + ;; Do some sanity checking + (cond ((and (= instance-count 0) + (not (soap-sequence-element-nillable? element))) + (soap-warning "While decoding %s: missing non-nillable slot %s" + (soap-element-name type) e-name)) + ((and (> instance-count 1) + (not (soap-sequence-element-multiple? element))) + (soap-warning "While decoding %s: multiple slots named %s" + (soap-element-name type) e-name))))) + (nreverse result))) + +(defun soap-decode-array-type (type node) + "Use TYPE to decode the contents of NODE. +TYPE is assumed to be an array type. Arrays are decoded as lists. +This is because it is easier to work with list results in LISP." + (let ((result nil) + (element-type (soap-array-type-element-type type))) + (dolist (node (xml-node-children node)) + (when (consp node) + (push (soap-decode-type element-type node) result))) + (nreverse result))) + +(progn + (put (aref (make-soap-basic-type) 0) + 'soap-decoder 'soap-decode-basic-type) + (put (aref (make-soap-sequence-type) 0) + 'soap-decoder 'soap-decode-sequence-type) + (put (aref (make-soap-array-type) 0) + 'soap-decoder 'soap-decode-array-type)) + +;;;; Soap Envelope parsing + +(put 'soap-error + 'error-conditions + '(error soap-error)) +(put 'soap-error 'error-message "SOAP error") + +(defun soap-parse-envelope (node operation wsdl) + "Parse the SOAP envelope in NODE and return the response. +OPERATION is the WSDL operation for which we expect the response, +WSDL is used to decode the NODE" + (soap-with-local-xmlns node + (assert (eq (soap-l2wk (xml-node-name node)) 'soap:Envelope) + nil + "soap-parse-envelope: expecting soap:Envelope node, got %s" + (soap-l2wk (xml-node-name node))) + (let ((body (car (soap-xml-get-children1 node 'soap:Body)))) + + (let ((fault (car (soap-xml-get-children1 body 'soap:Fault)))) + (when fault + (let ((fault-code (let ((n (car (xml-get-children + fault 'faultcode)))) + (car-safe (xml-node-children n)))) + (fault-string (let ((n (car (xml-get-children + fault 'faultstring)))) + (car-safe (xml-node-children n))))) + (while t + (signal 'soap-error (list fault-code fault-string)))))) + + ;; First (non string) element of the body is the root node of he + ;; response + (let ((response (if (eq (soap-bound-operation-use operation) 'literal) + ;; For 'literal uses, the response is the actual body + body + ;; ...otherwise the first non string element + ;; of the body is the response + (catch 'found + (dolist (n (xml-node-children body)) + (when (consp n) + (throw 'found n))))))) + (soap-parse-response response operation wsdl body))))) + +(defun soap-parse-response (response-node operation wsdl soap-body) + "Parse RESPONSE-NODE and return the result as a LISP value. +OPERATION is the WSDL operation for which we expect the response, +WSDL is used to decode the NODE. + +SOAP-BODY is the body of the SOAP envelope (of which +RESPONSE-NODE is a sub-node). It is used in case RESPONSE-NODE +reference multiRef parts which are external to RESPONSE-NODE." + (let* ((soap-current-wsdl wsdl) + (op (soap-bound-operation-operation operation)) + (use (soap-bound-operation-use operation)) + (message (cdr (soap-operation-output op)))) + + (soap-with-local-xmlns response-node + + (when (eq use 'encoded) + (let* ((received-message-name (soap-l2fq (xml-node-name response-node))) + (received-message (soap-wsdl-get + received-message-name wsdl 'soap-message-p))) + (unless (eq received-message message) + (error "Unexpected message: got %s, expecting %s" + received-message-name + (soap-element-name message))))) + + (let ((decoded-parts nil) + (soap-multi-refs (xml-get-children soap-body 'multiRef)) + (soap-decoded-multi-refs nil)) + + (dolist (part (soap-message-parts message)) + (let ((tag (car part)) + (type (cdr part)) + node) + + (setq node + (cond + ((eq use 'encoded) + (car (xml-get-children response-node tag))) + + ((eq use 'literal) + (catch 'found + (let* ((ns-aliases (soap-wsdl-alias-table wsdl)) + (ns-name (cdr (assoc + (soap-element-namespace-tag type) + ns-aliases))) + (fqname (cons ns-name (soap-element-name type)))) + (dolist (c (xml-node-children response-node)) + (when (consp c) + (soap-with-local-xmlns c + (when (equal (soap-l2fq (xml-node-name c)) + fqname) + (throw 'found c)))))))))) + + (unless node + (error "Soap-parse-response(%s): cannot find message part %s" + (soap-element-name op) tag)) + (push (soap-decode-type type node) decoded-parts))) + + decoded-parts)))) + +;;;; SOAP type encoding + +(defvar soap-encoded-namespaces nil + "A list of namespace tags used during encoding a message. +This list is populated by `soap-encode-value' and used by +`soap-create-envelope' to add aliases for these namespace to the +XML request. + +This variable is dynamically bound in `soap-create-envelope'.") + +(defun soap-encode-value (xml-tag value type) + "Encode inside an XML-TAG the VALUE using TYPE. +The resulting XML data is inserted in the current buffer +at (point)/ + +TYPE is one of the soap-*-type structures which defines how VALUE +is to be encoded. This is a generic function which finds an +encoder function based on TYPE and calls that encoder to do the +work." + (let ((encoder (get (aref type 0) 'soap-encoder))) + (assert encoder nil "no soap-encoder for %s type" (aref type 0)) + ;; XML-TAG can be a string or a symbol, but we pass only string's to the + ;; encoders + (when (symbolp xml-tag) + (setq xml-tag (symbol-name xml-tag))) + (funcall encoder xml-tag value type)) + (add-to-list 'soap-encoded-namespaces (soap-element-namespace-tag type))) + +(defun soap-encode-basic-type (xml-tag value type) + "Encode inside XML-TAG the LISP VALUE according to TYPE. +Do not call this function directly, use `soap-encode-value' +instead." + (let ((xsi-type (soap-element-fq-name type)) + (basic-type (soap-basic-type-kind type))) + + ;; try to classify the type based on the value type and use that type when + ;; encoding + (when (eq basic-type 'anyType) + (cond ((stringp value) + (setq xsi-type "xsd:string" basic-type 'string)) + ((integerp value) + (setq xsi-type "xsd:int" basic-type 'int)) + ((memq value '(t nil)) + (setq xsi-type "xsd:boolean" basic-type 'boolean)) + (t + (error + "Soap-encode-basic-type(%s, %s, %s): cannot classify anyType value" + xml-tag value xsi-type)))) + + (insert "<" xml-tag " xsi:type=\"" xsi-type "\"") + + ;; We have some ambiguity here, as a nil value represents "false" when the + ;; type is boolean, we will never have a "nil" boolean type... + + (if (or value (eq basic-type 'boolean)) + (progn + (insert ">") + (case basic-type + (string + (unless (stringp value) + (error "Soap-encode-basic-type(%s, %s, %s): not a string value" + xml-tag value xsi-type)) + (insert (url-insert-entities-in-string value))) + + (dateTime + (cond ((and (consp value) ; is there a time-value-p ? + (>= (length value) 2) + (numberp (nth 0 value)) + (numberp (nth 1 value))) + ;; Value is a (current-time) style value, convert + ;; to a string + (insert (format-time-string "%Y-%m-%dT%H:%M:%S" value))) + ((stringp value) + (insert (url-insert-entities-in-string value))) + (t + (error + "Soap-encode-basic-type(%s, %s, %s): not a dateTime value" + xml-tag value xsi-type)))) + + (boolean + (unless (memq value '(t nil)) + (error "Soap-encode-basic-type(%s, %s, %s): not a boolean value" + xml-tag value xsi-type)) + (insert (if value "true" "false"))) + + ((long int) + (unless (integerp value) + (error "Soap-encode-basic-type(%s, %s, %s): not an integer value" + xml-tag value xsi-type)) + (insert (number-to-string value))) + + (base64Binary + (unless (stringp value) + (error "Soap-encode-basic-type(%s, %s, %s): not a string value" + xml-tag value xsi-type)) + (insert (base64-encode-string value))) + + (otherwise + (error + "Soap-encode-basic-type(%s, %s, %s): don't know how to encode" + xml-tag value xsi-type)))) + + (insert " xsi:nil=\"true\">")) + (insert "</" xml-tag ">\n"))) + +(defun soap-encode-sequence-type (xml-tag value type) + "Encode inside XML-TAG the LISP VALUE according to TYPE. +Do not call this function directly, use `soap-encode-value' +instead." + (let ((xsi-type (soap-element-fq-name type))) + (insert "<" xml-tag " xsi:type=\"" xsi-type "\"") + (if value + (progn + (insert ">\n") + (let ((parents (list type)) + (parent (soap-sequence-type-parent type))) + + (while parent + (push parent parents) + (setq parent (soap-sequence-type-parent parent))) + + (dolist (type parents) + (dolist (element (soap-sequence-type-elements type)) + (let ((instance-count 0) + (e-name (soap-sequence-element-name element)) + (e-type (soap-sequence-element-type element))) + (dolist (v value) + (when (equal (car v) e-name) + (incf instance-count) + (soap-encode-value e-name (cdr v) e-type))) + + ;; Do some sanity checking + (cond ((and (= instance-count 0) + (not (soap-sequence-element-nillable? element))) + (soap-warning + "While encoding %s: missing non-nillable slot %s" + (soap-element-name type) e-name)) + ((and (> instance-count 1) + (not (soap-sequence-element-multiple? element))) + (soap-warning + "While encoding %s: multiple slots named %s" + (soap-element-name type) e-name)))))))) + (insert " xsi:nil=\"true\">")) + (insert "</" xml-tag ">\n"))) + +(defun soap-encode-array-type (xml-tag value type) + "Encode inside XML-TAG the LISP VALUE according to TYPE. +Do not call this function directly, use `soap-encode-value' +instead." + (unless (vectorp value) + (error "Soap-encode: %s(%s) expects a vector, got: %s" + xml-tag (soap-element-fq-name type) value)) + (let* ((element-type (soap-array-type-element-type type)) + (array-type (concat (soap-element-fq-name element-type) + "[" (format "%s" (length value)) "]"))) + (insert "<" xml-tag + " soapenc:arrayType=\"" array-type "\" " + " xsi:type=\"soapenc:Array\">\n") + (loop for i below (length value) + do (soap-encode-value xml-tag (aref value i) element-type)) + (insert "</" xml-tag ">\n"))) + +(progn + (put (aref (make-soap-basic-type) 0) + 'soap-encoder 'soap-encode-basic-type) + (put (aref (make-soap-sequence-type) 0) + 'soap-encoder 'soap-encode-sequence-type) + (put (aref (make-soap-array-type) 0) + 'soap-encoder 'soap-encode-array-type)) + +(defun soap-encode-body (operation parameters wsdl) + "Create the body of a SOAP request for OPERATION in the current buffer. +PARAMETERS is a list of parameters supplied to the OPERATION. + +The OPERATION and PARAMETERS are encoded according to the WSDL +document." + (let* ((op (soap-bound-operation-operation operation)) + (use (soap-bound-operation-use operation)) + (message (cdr (soap-operation-input op))) + (parameter-order (soap-operation-parameter-order op))) + + (unless (= (length parameter-order) (length parameters)) + (error "Wrong number of parameters for %s: expected %d, got %s" + (soap-element-name op) + (length parameter-order) + (length parameters))) + + (insert "<soap:Body>\n") + (when (eq use 'encoded) + (add-to-list 'soap-encoded-namespaces (soap-element-namespace-tag op)) + (insert "<" (soap-element-fq-name op) ">\n")) + + (let ((param-table (loop for formal in parameter-order + for value in parameters + collect (cons formal value)))) + (dolist (part (soap-message-parts message)) + (let* ((param-name (car part)) + (type (cdr part)) + (tag-name (if (eq use 'encoded) + param-name + (soap-element-name type))) + (value (cdr (assoc param-name param-table))) + (start-pos (point))) + (soap-encode-value tag-name value type) + (when (eq use 'literal) + ;; hack: add the xmlns attribute to the tag, the only way + ;; ASP.NET web services recognize the namespace of the + ;; element itself... + (save-excursion + (goto-char start-pos) + (when (re-search-forward " ") + (let* ((ns (soap-element-namespace-tag type)) + (namespace (cdr (assoc ns + (soap-wsdl-alias-table wsdl))))) + (when namespace + (insert "xmlns=\"" namespace "\" "))))))))) + + (when (eq use 'encoded) + (insert "</" (soap-element-fq-name op) ">\n")) + (insert "</soap:Body>\n"))) + +(defun soap-create-envelope (operation parameters wsdl) + "Create a SOAP request envelope for OPERATION using PARAMETERS. +WSDL is the wsdl document used to encode the PARAMETERS." + (with-temp-buffer + (let ((soap-encoded-namespaces '("xsi" "soap" "soapenc")) + (use (soap-bound-operation-use operation))) + + ;; Create the request body + (soap-encode-body operation parameters wsdl) + + ;; Put the envelope around the body + (goto-char (point-min)) + (insert "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n<soap:Envelope\n") + (when (eq use 'encoded) + (insert " soapenc:encodingStyle=\"http://schemas.xmlsoap.org/soap/encoding/\"\n")) + (dolist (nstag soap-encoded-namespaces) + (insert " xmlns:" nstag "=\"") + (let ((nsname (cdr (assoc nstag soap-well-known-xmlns)))) + (unless nsname + (setq nsname (cdr (assoc nstag (soap-wsdl-alias-table wsdl))))) + (insert nsname) + (insert "\"\n"))) + (insert ">\n") + (goto-char (point-max)) + (insert "</soap:Envelope>\n")) + + (buffer-string))) + +;;;; invoking soap methods + +(defcustom soap-debug nil + "When t, enable some debugging facilities." + :type 'boolean + :group 'soap-client) + +(defun soap-invoke (wsdl service operation-name &rest parameters) + "Invoke a SOAP operation and return the result. + +WSDL is used for encoding the request and decoding the response. +It also contains information about the WEB server address that +will service the request. + +SERVICE is the SOAP service to invoke. + +OPERATION-NAME is the operation to invoke. + +PARAMETERS -- the remaining parameters are used as parameters for +the SOAP request. + +NOTE: The SOAP service provider should document the available +operations and their parameters for the service. You can also +use the `soap-inspect' function to browse the available +operations in a WSDL document." + (let ((port (catch 'found + (dolist (p (soap-wsdl-ports wsdl)) + (when (equal service (soap-element-name p)) + (throw 'found p)))))) + (unless port + (error "Unknown SOAP service: %s" service)) + + (let* ((binding (soap-port-binding port)) + (operation (gethash operation-name + (soap-binding-operations binding)))) + (unless operation + (error "No operation %s for SOAP service %s" operation-name service)) + + (let ((url-request-method "POST") + (url-package-name "soap-client.el") + (url-package-version "1.0") + (url-http-version "1.0") + (url-request-data (soap-create-envelope operation parameters wsdl)) + (url-mime-charset-string "utf-8;q=1, iso-8859-1;q=0.5") + (url-request-coding-system 'utf-8) + (url-http-attempt-keepalives t) + (url-request-extra-headers (list + (cons "SOAPAction" + (soap-bound-operation-soap-action + operation)) + (cons "Content-Type" + "text/xml; charset=utf-8")))) + (let ((buffer (url-retrieve-synchronously + (soap-port-service-url port)))) + (condition-case err + (with-current-buffer buffer + (declare (special url-http-response-status)) + (if (null url-http-response-status) + (error "No HTTP response from server")) + (if (and soap-debug (> url-http-response-status 299)) + ;; This is a warning because some SOAP errors come + ;; back with a HTTP response 500 (internal server + ;; error) + (warn "Error in SOAP response: HTTP code %s" + url-http-response-status)) + (when (> (buffer-size) 1000000) + (soap-warning + "Received large message: %s bytes" + (buffer-size))) + (let ((mime-part (mm-dissect-buffer t t))) + (unless mime-part + (error "Failed to decode response from server")) + (unless (equal (car (mm-handle-type mime-part)) "text/xml") + (error "Server response is not an XML document")) + (with-temp-buffer + (mm-insert-part mime-part) + (let ((response (car (xml-parse-region + (point-min) (point-max))))) + (prog1 + (soap-parse-envelope response operation wsdl) + (kill-buffer buffer) + (mm-destroy-part mime-part)))))) + (soap-error + ;; Propagate soap-errors -- they are error replies of the + ;; SOAP protocol and don't indicate a communication + ;; problem or a bug in this code. + (signal (car err) (cdr err))) + (error + (when soap-debug + (pop-to-buffer buffer)) + (error (error-message-string err))))))))) + +(provide 'soap-client) + + +;;; Local Variables: +;;; mode: outline-minor +;;; outline-regexp: ";;;;+" +;;; End: + +;;; soap-client.el ends here diff --git a/lisp/net/soap-inspect.el b/lisp/net/soap-inspect.el new file mode 100644 index 00000000000..7cce9844d76 --- /dev/null +++ b/lisp/net/soap-inspect.el @@ -0,0 +1,357 @@ +;;;; soap-inspect.el -- Interactive inspector for soap WSDL structures + +;; Copyright (C) 2010-2011 Free Software Foundation, Inc. + +;; Author: Alexandru Harsanyi (AlexHarsanyi@gmail.com) +;; Created: October 2010 +;; Keywords: soap, web-services, comm, hypermedia +;; Homepage: http://code.google.com/p/emacs-soap-client + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; This package provides an inspector for a WSDL document loaded with +;; `soap-load-wsdl' or `soap-load-wsdl-from-url'. To use it, evaluate: +;; +;; (soap-inspect *wsdl*) +;; +;; This will pop-up the inspector buffer. You can click on ports, operations +;; and types to explore the structure of the wsdl document. +;; + + +;;; Code: + +(eval-when-compile (require 'cl)) + +(require 'soap-client) + +;;; sample-value + +(defun soap-sample-value (type) + "Provide a sample value for TYPE, a WSDL type. +A sample value is a LISP value which soap-client.el will accept +for encoding it using TYPE when making SOAP requests. + +This is a generic function, depending on TYPE a specific function +will be called." + (let ((sample-value (get (aref type 0) 'soap-sample-value))) + (if sample-value + (funcall sample-value type) + (error "Cannot provide sample value for type %s" (aref type 0))))) + +(defun soap-sample-value-for-basic-type (type) + "Provide a sample value for TYPE which is a basic type. +This is a specific function which should not be called directly, +use `soap-sample-value' instead." + (case (soap-basic-type-kind type) + (string "a string value") + (boolean t) ; could be nil as well + ((long int) (random 4200)) + ;; TODO: we need better sample values for more types. + (t (format "%s" (soap-basic-type-kind type))))) + +(defun soap-sample-value-for-seqence-type (type) + "Provide a sample value for TYPE which is a sequence type. +Values for sequence types are ALISTS of (slot-name . VALUE) for +each sequence element. + +This is a specific function which should not be called directly, +use `soap-sample-value' instead." + (let ((sample-value nil)) + (dolist (element (soap-sequence-type-elements type)) + (push (cons (soap-sequence-element-name element) + (soap-sample-value (soap-sequence-element-type element))) + sample-value)) + (when (soap-sequence-type-parent type) + (setq sample-value + (append (soap-sample-value (soap-sequence-type-parent type)) + sample-value))) + sample-value)) + +(defun soap-sample-value-for-array-type (type) + "Provide a sample value for TYPE which is an array type. +Values for array types are LISP vectors of values which are +array's element type. + +This is a specific function which should not be called directly, +use `soap-sample-value' instead." + (let* ((element-type (soap-array-type-element-type type)) + (sample1 (soap-sample-value element-type)) + (sample2 (soap-sample-value element-type))) + ;; Our sample value is a vector of two elements, but any number of + ;; elements are permissible + (vector sample1 sample2 '&etc))) + +(defun soap-sample-value-for-message (message) + "Provide a sample value for a WSDL MESSAGE. +This is a specific function which should not be called directly, +use `soap-sample-value' instead." + ;; NOTE: parameter order is not considered. + (let (sample-value) + (dolist (part (soap-message-parts message)) + (push (cons (car part) + (soap-sample-value (cdr part))) + sample-value)) + (nreverse sample-value))) + +(progn + ;; Install soap-sample-value methods for our types + (put (aref (make-soap-basic-type) 0) 'soap-sample-value + 'soap-sample-value-for-basic-type) + + (put (aref (make-soap-sequence-type) 0) 'soap-sample-value + 'soap-sample-value-for-seqence-type) + + (put (aref (make-soap-array-type) 0) 'soap-sample-value + 'soap-sample-value-for-array-type) + + (put (aref (make-soap-message) 0) 'soap-sample-value + 'soap-sample-value-for-message) ) + + + +;;; soap-inspect + +(defvar soap-inspect-previous-items nil + "A stack of previously inspected items in the *soap-inspect* buffer. +Used to implement the BACK button.") + +(defvar soap-inspect-current-item nil + "The current item being inspected in the *soap-inspect* buffer.") + +(progn + (make-variable-buffer-local 'soap-inspect-previous-items) + (make-variable-buffer-local 'soap-inspect-current-item)) + +(defun soap-inspect (element) + "Inspect a SOAP ELEMENT in the *soap-inspect* buffer. +The buffer is populated with information about ELEMENT with links +to its sub elements. If ELEMENT is the WSDL document itself, the +entire WSDL can be inspected." + (let ((inspect (get (aref element 0) 'soap-inspect))) + (unless inspect + (error "Soap-inspect: no inspector for element")) + + (with-current-buffer (get-buffer-create "*soap-inspect*") + (setq buffer-read-only t) + (let ((inhibit-read-only t)) + (erase-buffer) + + (when soap-inspect-current-item + (push soap-inspect-current-item + soap-inspect-previous-items)) + (setq soap-inspect-current-item element) + + (funcall inspect element) + + (unless (null soap-inspect-previous-items) + (insert "\n\n") + (insert-text-button + "[back]" + 'type 'soap-client-describe-back-link + 'item element) + (insert "\n")) + (goto-char (point-min)) + (pop-to-buffer (current-buffer)))))) + + +(define-button-type 'soap-client-describe-link + 'face 'italic + 'help-echo "mouse-2, RET: describe item" + 'follow-link t + 'action (lambda (button) + (let ((item (button-get button 'item))) + (soap-inspect item))) + 'skip t) + +(define-button-type 'soap-client-describe-back-link + 'face 'italic + 'help-echo "mouse-2, RET: browse the previous item" + 'follow-link t + 'action (lambda (button) + (let ((item (pop soap-inspect-previous-items))) + (when item + (setq soap-inspect-current-item nil) + (soap-inspect item)))) + 'skip t) + +(defun soap-insert-describe-button (element) + "Insert a button to inspect ELEMENT when pressed." + (insert-text-button + (soap-element-fq-name element) + 'type 'soap-client-describe-link + 'item element)) + +(defun soap-inspect-basic-type (basic-type) + "Insert information about BASIC-TYPE into the current buffer." + (insert "Basic type: " (soap-element-fq-name basic-type)) + (insert "\nSample value\n") + (pp (soap-sample-value basic-type) (current-buffer))) + +(defun soap-inspect-sequence-type (sequence) + "Insert information about SEQUENCE into the current buffer." + (insert "Sequence type: " (soap-element-fq-name sequence) "\n") + (when (soap-sequence-type-parent sequence) + (insert "Parent: ") + (soap-insert-describe-button + (soap-sequence-type-parent sequence)) + (insert "\n")) + (insert "Elements: \n") + (dolist (element (soap-sequence-type-elements sequence)) + (insert "\t" (symbol-name (soap-sequence-element-name element)) + "\t") + (soap-insert-describe-button + (soap-sequence-element-type element)) + (when (soap-sequence-element-multiple? element) + (insert " multiple")) + (when (soap-sequence-element-nillable? element) + (insert " optional")) + (insert "\n")) + (insert "Sample value:\n") + (pp (soap-sample-value sequence) (current-buffer))) + +(defun soap-inspect-array-type (array) + "Insert information about the ARRAY into the current buffer." + (insert "Array name: " (soap-element-fq-name array) "\n") + (insert "Element type: ") + (soap-insert-describe-button + (soap-array-type-element-type array)) + (insert "\nSample value:\n") + (pp (soap-sample-value array) (current-buffer))) + +(defun soap-inspect-message (message) + "Insert information about MESSAGE into the current buffer." + (insert "Message name: " (soap-element-fq-name message) "\n") + (insert "Parts:\n") + (dolist (part (soap-message-parts message)) + (insert "\t" (symbol-name (car part)) + " type: ") + (soap-insert-describe-button (cdr part)) + (insert "\n"))) + +(defun soap-inspect-operation (operation) + "Insert information about OPERATION into the current buffer." + (insert "Operation name: " (soap-element-fq-name operation) "\n") + (let ((input (soap-operation-input operation))) + (insert "\tInput: " (symbol-name (car input)) " (" ) + (soap-insert-describe-button (cdr input)) + (insert ")\n")) + (let ((output (soap-operation-output operation))) + (insert "\tOutput: " (symbol-name (car output)) " (") + (soap-insert-describe-button (cdr output)) + (insert ")\n")) + + (insert "\n\nSample invocation:\n") + (let ((sample-message-value + (soap-sample-value (cdr (soap-operation-input operation)))) + (funcall (list 'soap-invoke '*WSDL* "SomeService" (soap-element-name operation)))) + (let ((sample-invocation + (append funcall (mapcar 'cdr sample-message-value)))) + (pp sample-invocation (current-buffer))))) + +(defun soap-inspect-port-type (port-type) + "Insert information about PORT-TYPE into the current buffer." + (insert "Port-type name: " (soap-element-fq-name port-type) "\n") + (insert "Operations:\n") + (loop for o being the hash-values of + (soap-namespace-elements (soap-port-type-operations port-type)) + do (progn + (insert "\t") + (soap-insert-describe-button (car o))))) + +(defun soap-inspect-binding (binding) + "Insert information about BINDING into the current buffer." + (insert "Binding: " (soap-element-fq-name binding) "\n") + (insert "\n") + (insert "Bound operations:\n") + (let* ((ophash (soap-binding-operations binding)) + (operations (loop for o being the hash-keys of ophash + collect o)) + op-name-width) + + (setq operations (sort operations 'string<)) + + (setq op-name-width (loop for o in operations maximizing (length o))) + + (dolist (op operations) + (let* ((bound-op (gethash op ophash)) + (soap-action (soap-bound-operation-soap-action bound-op)) + (use (soap-bound-operation-use bound-op))) + (unless soap-action + (setq soap-action "")) + (insert "\t") + (soap-insert-describe-button (soap-bound-operation-operation bound-op)) + (when (or use (not (equal soap-action ""))) + (insert (make-string (- op-name-width (length op)) ?\s)) + (insert " (") + (insert soap-action) + (when use + (insert " " (symbol-name use))) + (insert ")")) + (insert "\n"))))) + +(defun soap-inspect-port (port) + "Insert information about PORT into the current buffer." + (insert "Port name: " (soap-element-name port) "\n" + "Service URL: " (soap-port-service-url port) "\n" + "Binding: ") + (soap-insert-describe-button (soap-port-binding port))) + +(defun soap-inspect-wsdl (wsdl) + "Insert information about WSDL into the current buffer." + (insert "WSDL Origin: " (soap-wsdl-origin wsdl) "\n") + (insert "Ports:") + (dolist (p (soap-wsdl-ports wsdl)) + (insert "\n--------------------\n") + ;; (soap-insert-describe-button p) + (soap-inspect-port p)) + (insert "\n--------------------\nNamespace alias table:\n") + (dolist (a (soap-wsdl-alias-table wsdl)) + (insert "\t" (car a) " => " (cdr a) "\n"))) + +(progn + ;; Install the soap-inspect methods for our types + + (put (aref (make-soap-basic-type) 0) 'soap-inspect + 'soap-inspect-basic-type) + + (put (aref (make-soap-sequence-type) 0) 'soap-inspect + 'soap-inspect-sequence-type) + + (put (aref (make-soap-array-type) 0) 'soap-inspect + 'soap-inspect-array-type) + + (put (aref (make-soap-message) 0) 'soap-inspect + 'soap-inspect-message) + (put (aref (make-soap-operation) 0) 'soap-inspect + 'soap-inspect-operation) + + (put (aref (make-soap-port-type) 0) 'soap-inspect + 'soap-inspect-port-type) + + (put (aref (make-soap-binding) 0) 'soap-inspect + 'soap-inspect-binding) + + (put (aref (make-soap-port) 0) 'soap-inspect + 'soap-inspect-port) + + (put (aref (make-soap-wsdl) 0) 'soap-inspect + 'soap-inspect-wsdl)) + +(provide 'soap-inspect) +;;; soap-inspect.el ends here diff --git a/lisp/net/tramp-imap.el b/lisp/net/tramp-imap.el deleted file mode 100644 index 3a536103c3d..00000000000 --- a/lisp/net/tramp-imap.el +++ /dev/null @@ -1,844 +0,0 @@ -;;; tramp-imap.el --- Tramp interface to IMAP through imap.el - -;; Copyright (C) 2009-2011 Free Software Foundation, Inc. - -;; Author: Teodor Zlatanov <tzz@lifelogs.com> -;; Keywords: mail, comm -;; Package: tramp - -;; 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: - -;; Package to provide Tramp over IMAP - -;;; Setup: - -;; just load and open files, e.g. -;; /imaps:user@yourhosthere.com:/INBOX.test/1 -;; or -;; /imap:user@yourhosthere.com:/INBOX.test/1 - -;; where `imap' goes over IMAP, while `imaps' goes over IMAP+SSL - -;; This module will use imap-hash.el to access the IMAP mailbox. - -;; This module will use auth-source.el to authenticate against the -;; IMAP server, PLUS it will use auth-source.el to get your passphrase -;; for the symmetrically encrypted messages. For the former, use the -;; usual IMAP ports. For the latter, use the port "tramp-imap". - -;; example .authinfo / .netrc file: - -;; machine yourhosthere.com port tramp-imap login USER password SYMMETRIC-PASSPHRASE - -;; note above is the symmetric encryption passphrase for GPG -;; below is the regular password for IMAP itself and other things on that host - -;; machine yourhosthere.com login USER password NORMAL-PASSWORD - - -;;; Code: - -(require 'assoc) -(require 'tramp) - -(autoload 'auth-source-user-or-password "auth-source") -(autoload 'epg-context-operation "epg") -(autoload 'epg-context-set-armor "epg") -(autoload 'epg-context-set-passphrase-callback "epg") -(autoload 'epg-context-set-progress-callback "epg") -(autoload 'epg-decrypt-string "epg") -(autoload 'epg-encrypt-string "epg") -(autoload 'epg-make-context "epg") -(autoload 'imap-hash-get "imap-hash") -(autoload 'imap-hash-make "imap-hash") -(autoload 'imap-hash-map "imap-hash") -(autoload 'imap-hash-put "imap-hash") -(autoload 'imap-hash-rem "imap-hash") - -;; We use the additional header "X-Size" for encoding the size of a file. -(eval-after-load "imap-hash" - '(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.") - -;;;###tramp-autoload -(when (and (locate-library "epa") (locate-library "imap-hash")) - (add-to-list 'tramp-methods - (list tramp-imap-method '(tramp-default-port 143)))) - -;; 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. -;;;###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. -;;;###tramp-autoload -(add-to-list - 'tramp-default-user-alist - (list (concat "\\`" - (regexp-opt (list tramp-imap-method tramp-imaps-method)) - "\\'") - nil (user-login-name))) - -;; Add completion function for IMAP method. -;; (tramp-set-completion-function -;; tramp-imap-method tramp-completion-function-alist-ssh) ; TODO: test this -;; tramp-imaps-method tramp-completion-function-alist-ssh) ; TODO: test this - -;; New handlers should be added here. -(defconst tramp-imap-file-name-handler-alist - '( - ;; `access-file' performed by default handler - (add-name-to-file . ignore) - ;; `byte-compiler-base-file-name' performed by default handler - ;; `copy-directory' performed by default handler - (copy-file . tramp-imap-handle-copy-file) - (delete-directory . ignore) ;; tramp-imap-handle-delete-directory) - (delete-file . tramp-imap-handle-delete-file) - ;; `diff-latest-backup-file' performed by default handler - (directory-file-name . tramp-handle-directory-file-name) - (directory-files . tramp-handle-directory-files) - (directory-files-and-attributes - . tramp-handle-directory-files-and-attributes) - (dired-call-process . ignore) - ;; `dired-compress-file' performed by default handler - ;; `dired-uncache' performed by default handler - (expand-file-name . tramp-imap-handle-expand-file-name) - ;; `file-accessible-directory-p' performed by default handler - (file-attributes . tramp-imap-handle-file-attributes) - (file-directory-p . tramp-imap-handle-file-directory-p) - (file-executable-p . ignore) - (file-exists-p . tramp-handle-file-exists-p) - (file-local-copy . tramp-imap-handle-file-local-copy) - (file-modes . tramp-handle-file-modes) - (file-name-all-completions . tramp-imap-handle-file-name-all-completions) - (file-name-as-directory . tramp-handle-file-name-as-directory) - (file-name-completion . tramp-handle-file-name-completion) - (file-name-directory . tramp-handle-file-name-directory) - (file-name-nondirectory . tramp-handle-file-name-nondirectory) - ;; `file-name-sans-versions' performed by default handler - (file-newer-than-file-p . tramp-handle-file-newer-than-file-p) - (file-ownership-preserved-p . ignore) - (file-readable-p . tramp-handle-file-exists-p) - (file-regular-p . tramp-handle-file-regular-p) - (file-remote-p . tramp-handle-file-remote-p) - ;; `file-selinux-context' performed by default handler. - (file-symlink-p . tramp-handle-file-symlink-p) - ;; `file-truename' performed by default handler - (file-writable-p . tramp-imap-handle-file-writable-p) - (find-backup-file-name . tramp-handle-find-backup-file-name) - ;; `find-file-noselect' performed by default handler - ;; `get-file-buffer' performed by default handler - (insert-directory . tramp-imap-handle-insert-directory) - (insert-file-contents . tramp-imap-handle-insert-file-contents) - (load . tramp-handle-load) - (make-directory . ignore) ;; tramp-imap-handle-make-directory) - (make-directory-internal . ignore) ;; tramp-imap-handle-make-directory-internal) - (make-symbolic-link . ignore) - (rename-file . tramp-imap-handle-rename-file) - (set-file-modes . ignore) - ;; `set-file-selinux-context' performed by default handler. - (set-file-times . ignore) ;; tramp-imap-handle-set-file-times) - (set-visited-file-modtime . ignore) - (shell-command . ignore) - (substitute-in-file-name . tramp-handle-substitute-in-file-name) - (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) - (vc-registered . ignore) - (verify-visited-file-modtime . ignore) - (write-region . tramp-imap-handle-write-region) - (executable-find . ignore) - (start-file-process . ignore) - (process-file . ignore) -) - "Alist of handler functions for Tramp IMAP method. -Operations not mentioned here will be handled by the default Emacs primitives.") - -(defgroup tramp-imap nil - "Tramp over IMAP configuration." - :version "23.2" - :group 'tramp) - -(defcustom tramp-imap-subject-marker "tramp-imap-subject-marker" - "The subject marker that Tramp-IMAP will use." - :type 'string - :version "23.2" - :group 'tramp-imap) - -;; TODO: these will be defcustoms later. -(defvar tramp-imap-passphrase-cache nil) ;; can be t or 'never -(defvar tramp-imap-passphrase nil) - -;;;###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 -pass to the OPERATION." - (let ((fn (assoc operation tramp-imap-file-name-handler-alist))) - (if fn - (save-match-data (apply (cdr fn) args)) - (tramp-run-real-handler operation args)))) - -;;;###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 - preserve-uid-gid preserve-selinux-context) - "Like `copy-file' for Tramp files." - (tramp-imap-do-copy-or-rename-file - 'copy filename newname ok-if-already-exists keep-date preserve-uid-gid)) - -(defun tramp-imap-handle-rename-file - (filename newname &optional ok-if-already-exists) - "Like `rename-file' for Tramp files." - (tramp-imap-do-copy-or-rename-file - 'rename filename newname ok-if-already-exists t t)) - -(defun tramp-imap-do-copy-or-rename-file - (op filename newname &optional ok-if-already-exists keep-date preserve-uid-gid) - "Copy or rename a remote file. -OP must be `copy' or `rename' and indicates the operation to perform. -FILENAME specifies the file to copy or rename, NEWNAME is the name of -the new file (for copy) or the new name of the file (for rename). -OK-IF-ALREADY-EXISTS means don't barf if NEWNAME exists already. -KEEP-DATE means to make sure that NEWNAME has the same timestamp -as FILENAME. PRESERVE-UID-GID, when non-nil, instructs to keep -the uid and gid if both files are on the same host. - -This function is invoked by `tramp-imap-handle-copy-file' and -`tramp-imap-handle-rename-file'. It is an error if OP is neither -of `copy' and `rename'." - (unless (memq op '(copy rename)) - (error "Unknown operation `%s', must be `copy' or `rename'" op)) - (setq filename (expand-file-name filename)) - (setq newname (expand-file-name newname)) - (when (file-directory-p newname) - (setq newname (expand-file-name (file-name-nondirectory filename) newname))) - - (let ((t1 (and (tramp-tramp-file-p filename) - (tramp-imap-file-name-p filename))) - (t2 (and (tramp-tramp-file-p newname) - (tramp-imap-file-name-p newname)))) - - (with-parsed-tramp-file-name (if t1 filename newname) nil - (when (and (not ok-if-already-exists) (file-exists-p newname)) - (tramp-error - v 'file-already-exists "File %s already exists" newname)) - - (with-progress-reporter - v 0 (format "%s %s to %s" - (if (eq op 'copy) "Copying" "Renaming") - filename newname) - - ;; We just make a local copy of FILENAME, and write it then to - ;; NEWNAME. This must be optimized when both files are - ;; located on the same IMAP server. - (with-temp-buffer - (if (and t1 t2) - ;; We don't encrypt. - (with-parsed-tramp-file-name newname v1 - (insert (tramp-imap-get-file filename nil)) - (tramp-imap-put-file - v1 (current-buffer) - (tramp-imap-file-name-name v1) - nil nil (nth 7 (file-attributes filename)))) - ;; One of them is not located on a IMAP mailbox. - (insert-file-contents filename) - (write-region (point-min) (point-max) newname))))) - - (when (eq op 'rename) (delete-file filename)))) - -;; TODO: revise this much -(defun tramp-imap-handle-expand-file-name (name &optional dir) - "Like `expand-file-name' for Tramp files." - ;; If DIR is not given, use DEFAULT-DIRECTORY or "/". - (setq dir (or dir default-directory "/")) - ;; Unless NAME is absolute, concat DIR and NAME. - (unless (file-name-absolute-p name) - (setq name (concat (file-name-as-directory dir) name))) - ;; If NAME is not a Tramp file, run the real handler. - (if (or (tramp-completion-mode-p) (not (tramp-tramp-file-p name))) - (tramp-drop-volume-letter - (tramp-run-real-handler 'expand-file-name (list name nil))) - ;; Dissect NAME. - (with-parsed-tramp-file-name name nil - (unless (tramp-run-real-handler 'file-name-absolute-p (list localname)) - (setq localname (concat "/" localname))) - ;; There might be a double slash, for example when "~/" - ;; expands to "/". Remove this. - (while (string-match "//" localname) - (setq localname (replace-match "/" t t localname))) - ;; Do normal `expand-file-name' (this does "/./" and "/../"). - ;; We bind `directory-sep-char' here for XEmacs on Windows, - ;; which would otherwise use backslash. `default-directory' is - ;; bound, because on Windows there would be problems with UNC - ;; shares or Cygwin mounts. - (let ((default-directory (tramp-compat-temporary-file-directory))) - (tramp-make-tramp-file-name - method user host - (tramp-drop-volume-letter - (tramp-run-real-handler - 'expand-file-name (list localname)))))))) - -;; This function should return "foo/" for directories and "bar" for -;; files. -(defun tramp-imap-handle-file-name-all-completions (filename directory) - "Like `file-name-all-completions' for Tramp files." - (all-completions - filename - (with-parsed-tramp-file-name (expand-file-name directory) nil - (save-match-data - (let ((entries - (tramp-imap-get-file-entries v localname))) - (mapcar - (lambda (x) - (list - (if (string-match "d" (nth 9 x)) - (file-name-as-directory (nth 0 x)) - (nth 0 x)))) - entries)))))) - -(defun tramp-imap-get-file-entries (vec localname &optional exact) - "Read entries returned by IMAP server. EXACT limits to exact matches. -Result is a list of (LOCALNAME LINK COUNT UID GID ATIME MTIME CTIME -SIZE MODE WEIRD INODE DEVICE)." - (tramp-message vec 5 "working on %s" localname) - (let* ((name (tramp-imap-file-name-name vec)) - (search-name (or name "")) - (search-name (if exact (concat search-name "$") search-name)) - (iht (tramp-imap-make-iht vec search-name))) -;; TODO: catch errors - ;; (tramp-error vec 'none "bad name %s or mailbox %s" name mbox)) - (imap-hash-map (lambda (uid headers body) - (let ((subject (substring - (aget headers 'Subject "") - (length tramp-imap-subject-marker))) - (from (aget headers 'From "")) - (date (date-to-time (aget headers 'Date ""))) - (size (string-to-number - (or (aget headers 'X-Size "0") "0")))) - (setq from - (if (string-match "<\\([^@]+\\)@" from) - (match-string 1 from) - "nobody")) - (list - subject - nil - -1 - from - "nogroup" - date - date - date - size - "-rw-rw-rw-" - nil - uid - (tramp-get-device vec)))) - iht t))) - -(defun tramp-imap-handle-write-region (start end filename &optional append visit lockname confirm) - "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename)) - (with-parsed-tramp-file-name filename nil - ;; XEmacs takes a coding system as the seventh argument, not `confirm'. - (when (and (not (featurep 'xemacs)) - confirm (file-exists-p filename)) - (unless (y-or-n-p (format "File %s exists; overwrite anyway? " - filename)) - (tramp-error v 'file-error "File not overwritten"))) - (tramp-flush-file-property v localname) - (let* ((old-buffer (current-buffer)) - (inode (tramp-imap-get-file-inode filename)) - (min 1) - (max (point-max)) - ;; Make sure we have good start and end values. - (start (or start min)) - (end (or end max)) - temp-buffer) - (with-temp-buffer - (setq temp-buffer (if (and (eq start min) (eq end max)) - old-buffer - ;; If this is a region write, insert the substring. - (insert - (with-current-buffer old-buffer - (buffer-substring-no-properties start end))) - (current-buffer))) - (tramp-imap-put-file v - temp-buffer - (tramp-imap-file-name-name v) - inode - t))) - (when (eq visit t) - (set-visited-file-modtime)))) - -(defun tramp-imap-handle-insert-directory - (filename switches &optional wildcard full-directory-p) - "Like `insert-directory' for Tramp files." - (setq filename (expand-file-name filename)) - (if full-directory-p - ;; Called from `dired-add-entry'. - (setq filename (file-name-as-directory filename)) - (setq filename (directory-file-name filename))) - (with-parsed-tramp-file-name filename nil - (save-match-data - (let ((base (file-name-nondirectory localname)) - (entries (copy-sequence - (tramp-imap-get-file-entries - v (file-name-directory localname))))) - - (when wildcard - (when (string-match "\\." base) - (setq base (replace-match "\\\\." nil nil base))) - (when (string-match "\\*" base) - (setq base (replace-match ".*" nil nil base))) - (when (string-match "\\?" base) - (setq base (replace-match ".?" nil nil base)))) - - ;; Filter entries. - (setq entries - (delq - nil - (if (or wildcard (zerop (length base))) - ;; Check for matching entries. - (mapcar - (lambda (x) - (when (string-match - (format "^%s" base) (nth 0 x)) - x)) - entries) - ;; We just need the only and only entry FILENAME. - (list (assoc base entries))))) - - ;; Sort entries. - (setq entries - (sort - entries - (lambda (x y) - (if (string-match "t" switches) - ;; Sort by date. - (tramp-time-less-p (nth 6 y) (nth 6 x)) - ;; Sort by name. - (string-lessp (nth 0 x) (nth 0 y)))))) - - ;; Handle "-F" switch. - (when (string-match "F" switches) - (mapc - (lambda (x) - (when (not (zerop (length (car x)))) - (cond - ((char-equal ?d (string-to-char (nth 9 x))) - (setcar x (concat (car x) "/"))) - ((char-equal ?x (string-to-char (nth 9 x))) - (setcar x (concat (car x) "*")))))) - entries)) - - ;; Print entries. - (mapcar - (lambda (x) - (when (not (zerop (length (nth 0 x)))) - (insert - (format - "%10s %3d %-8s %-8s %8s %s " - (nth 9 x) ; mode - (nth 11 x) ; inode - (nth 3 x) ; uid - (nth 4 x) ; gid - (nth 8 x) ; size - (format-time-string - (if (tramp-time-less-p - (tramp-time-subtract (current-time) (nth 6 x)) - tramp-half-a-year) - "%b %e %R" - "%b %e %Y") - (nth 6 x)))) ; date - ;; For the file name, we set the `dired-filename' - ;; property. This allows to handle file names with - ;; leading or trailing spaces as well. The inserted name - ;; could be from somewhere else, so we use the relative - ;; file name of `default-directory'. - (let ((pos (point))) - (insert - (format - "%s\n" - (file-relative-name - (expand-file-name (nth 0 x) (file-name-directory filename))))) - (put-text-property pos (1- (point)) 'dired-filename t)) - (forward-line) - (beginning-of-line))) - entries))))) - -(defun tramp-imap-handle-insert-file-contents - (filename &optional visit beg end replace) - "Like `insert-file-contents' for Tramp files." - (barf-if-buffer-read-only) - (when visit - (setq buffer-file-name (expand-file-name filename)) - (set-visited-file-modtime) - (set-buffer-modified-p nil)) - (with-parsed-tramp-file-name filename nil - (if (not (file-exists-p filename)) - (tramp-error - v 'file-error "File `%s' not found on remote host" filename) - (let ((point (point)) - size data) - (with-progress-reporter v 3 (format "Fetching file %s" filename) - (insert (tramp-imap-get-file filename t)) - (setq size (- (point) point)) -;;; TODO: handle ranges. -;;; (let ((beg (or beg (point-min))) -;;; (end (min (or end (point-max)) (point-max)))) -;;; (setq size (- end beg)) -;;; (buffer-substring beg end)) - (goto-char point) - (list (expand-file-name filename) size)))))) - -(defun tramp-imap-handle-file-directory-p (filename) - "Like `file-directory-p' for Tramp-IMAP files." - ;; We allow only mailboxes to be a directory. - (with-parsed-tramp-file-name (expand-file-name filename default-directory) nil - (and (string-match "^/[^/]*$" (directory-file-name localname)) t))) - -(defun tramp-imap-handle-file-attributes (filename &optional id-format) - "Like `file-attributes' for Tramp-IMAP FILENAME." - (with-parsed-tramp-file-name (expand-file-name filename) nil - (let ((res (cdr-safe (nth 0 (tramp-imap-get-file-entries v localname))))) - (unless (or (null res) (eq id-format 'string)) - (setcar (nthcdr 2 res) 1) - (setcar (nthcdr 3 res) 1)) - res))) - -(defun tramp-imap-get-file-inode (filename &optional id-format) - "Get inode equivalent \(actually the UID) for Tramp-IMAP FILENAME." - (nth 10 (tramp-compat-file-attributes filename id-format))) - -(defun tramp-imap-handle-file-writable-p (filename) - "Like `file-writable-p' for Tramp files. True for IMAP." - ;; `file-exists-p' does not work yet for directories. - ;; (file-exists-p (file-name-directory filename))) - (file-directory-p (file-name-directory filename))) - -(defun tramp-imap-handle-delete-file (filename &optional trash) - "Like `delete-file' for Tramp files." - (cond - ((not (file-exists-p filename)) nil) - (t (with-parsed-tramp-file-name (expand-file-name filename) nil - (let ((iht (tramp-imap-make-iht v))) - (imap-hash-rem (tramp-imap-get-file-inode filename) iht)))))) - -(defun tramp-imap-handle-file-local-copy (filename) - "Like `file-local-copy' for Tramp files." - (with-parsed-tramp-file-name (expand-file-name filename) nil - (unless (file-exists-p filename) - (tramp-error - v 'file-error - "Cannot make local copy of non-existing file `%s'" filename)) - (let ((tmpfile (tramp-compat-make-temp-file filename))) - (with-progress-reporter - v 3 (format "Fetching %s to tmp file %s" filename tmpfile) - (with-temp-buffer - (insert-file-contents filename) - (write-region (point-min) (point-max) tmpfile) - tmpfile))))) - -(defun tramp-imap-put-file - (vec filename-or-buffer &optional subject inode encode size) - "Write contents of FILENAME-OR-BUFFER to Tramp-IMAP file VEC with name SUBJECT. -When INODE is given, delete that old remote file after writing the new one -\(normally this is the old file with the same name). A non-nil ENCODE -forces the encoding of the buffer or file. SIZE, when available, indicates -the file size; this is needed, if the file or buffer is already encoded." - ;; `tramp-current-host' is used in `tramp-imap-passphrase-callback-function'. - (let ((tramp-current-host (tramp-file-name-real-host vec)) - (iht (tramp-imap-make-iht vec))) - (imap-hash-put (list - (list (cons - 'Subject - (format - "%s%s" - tramp-imap-subject-marker - (or subject "no subject"))) - (cons - 'X-Size - (number-to-string - (cond - ((numberp size) size) - ((bufferp filename-or-buffer) - (buffer-size filename-or-buffer)) - ((stringp filename-or-buffer) - (nth 7 (file-attributes filename-or-buffer))) - ;; We don't know the size. - (t -1))))) - (cond ((bufferp filename-or-buffer) - (with-current-buffer filename-or-buffer - (if encode - (tramp-imap-encode-buffer) - (buffer-string)))) - ;; TODO: allow file names. - (t "No body available"))) - iht - inode))) - -(defun tramp-imap-get-file (filename &optional decode) - ;; (debug (tramp-imap-get-file-inode filename)) - (with-parsed-tramp-file-name (expand-file-name filename) nil - (condition-case () - ;; `tramp-current-host' is used in - ;; `tramp-imap-passphrase-callback-function'. - (let* ((tramp-current-host (tramp-file-name-real-host v)) - (iht (tramp-imap-make-iht v)) - (inode (tramp-imap-get-file-inode filename)) - (data (imap-hash-get inode iht t))) - (if decode - (with-temp-buffer - (insert (nth 1 data)) - ;;(debug inode (buffer-string)) - (tramp-imap-decode-buffer)) - (nth 1 data))) - (error (tramp-error - v 'file-error "File `%s' could not be read" filename))))) - -(defun tramp-imap-passphrase-callback-function (context key-id handback) - "Called by EPG to get a passphrase for Tramp-IMAP. -CONTEXT is the encryption/decryption EPG context. -HANDBACK is just carried through. -KEY-ID can be 'SYM or 'PIN among others." - (let* ((server tramp-current-host) - (port "tramp-imap") ; this is NOT the server password! - (auth-passwd - (auth-source-user-or-password "password" server port))) - (or - (copy-sequence auth-passwd) - ;; If we cache the passphrase and we have one. - (if (and (eq tramp-imap-passphrase-cache t) - tramp-imap-passphrase) - ;; Do we reuse it? - (if (y-or-n-p "Reuse the passphrase? ") - (copy-sequence tramp-imap-passphrase) - ;; Don't reuse: revert caching behavior to nil, erase passphrase, - ;; call ourselves again. - (setq tramp-imap-passphrase-cache nil) - (setq tramp-imap-passphrase nil) - (tramp-imap-passphrase-callback-function context key-id handback)) - (let ((p (if (eq key-id 'SYM) - (read-passwd - "Tramp-IMAP passphrase for symmetric encryption: " - (eq (epg-context-operation context) 'encrypt) - tramp-imap-passphrase) - (read-passwd - (if (eq key-id 'PIN) - "Tramp-IMAP passphrase for PIN: " - (let ((entry (assoc key-id - (symbol-value 'epg-user-id-alist)))) - (if entry - (format "Tramp-IMAP passphrase for %s %s: " - key-id (cdr entry)) - (format "Tramp-IMAP passphrase for %s: " key-id)))) - nil - tramp-imap-passphrase)))) - - ;; If we have an answer, the passphrase has changed, - ;; the user hasn't declined keeping the passphrase, - ;; and they answer yes to keep it now... - (when (and - p - (not (equal tramp-imap-passphrase p)) - (not (eq tramp-imap-passphrase-cache 'never)) - (y-or-n-p "Keep the passphrase? ")) - (setq tramp-imap-passphrase (copy-sequence p)) - (setq tramp-imap-passphrase-cache t)) - - ;; If we still don't have a passphrase, the user didn't want - ;; to keep it. - (when (and - p - (not tramp-imap-passphrase)) - (setq tramp-imap-passphrase-cache 'never)) - - p))))) - -(defun tramp-imap-encode-buffer () - (let ((context (epg-make-context 'OpenPGP)) - cipher) - (epg-context-set-armor context t) - (epg-context-set-passphrase-callback context - #'tramp-imap-passphrase-callback-function) - (epg-context-set-progress-callback context - (cons #'epa-progress-callback-function - "Encrypting...")) - (message "Encrypting...") - (setq cipher (epg-encrypt-string - context - (encode-coding-string (buffer-string) 'utf-8) - nil)) - (message "Encrypting...done") - cipher)) - -(defun tramp-imap-decode-buffer () - (let ((context (epg-make-context 'OpenPGP)) - plain) - (epg-context-set-passphrase-callback context - #'tramp-imap-passphrase-callback-function) - (epg-context-set-progress-callback context - (cons #'epa-progress-callback-function - "Decrypting...")) - (message "Decrypting...") - (setq plain (decode-coding-string - (epg-decrypt-string context (buffer-string)) - 'utf-8)) - (message "Decrypting...done") - plain)) - -(defun tramp-imap-file-name-mailbox (vec) - (nth 0 (tramp-imap-file-name-parse vec))) - -(defun tramp-imap-file-name-name (vec) - (nth 1 (tramp-imap-file-name-parse vec))) - -(defun tramp-imap-file-name-localname (vec) - (nth 1 (tramp-imap-file-name-parse vec))) - -(defun tramp-imap-file-name-parse (vec) - (let ((name (substring-no-properties (tramp-file-name-localname vec)))) - (if (string-match "^/\\([^/]+\\)/?\\(.*\\)$" name) - (list (match-string 1 name) - (match-string 2 name)) - nil))) - -(defun tramp-imap-make-iht (vec &optional needed-subject) - "Translate the Tramp vector VEC to the imap-hash structure. -With NEEDED-SUBJECT, alters the imap-hash test accordingly." - (let* ((mbox (tramp-imap-file-name-mailbox vec)) - (server (tramp-file-name-real-host vec)) - (method (tramp-file-name-method vec)) - (user (tramp-file-name-user vec)) - (ssl (string-equal method tramp-imaps-method)) - (port (tramp-file-name-port vec)) - (result (imap-hash-make server port mbox user nil ssl))) - ;; Return the IHT with a test override to look for the subject - ;; marker. - (plist-put - result - :test (format "^%s%s" - 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', -;; `tramp-imap-handle-make-directory', -;; `tramp-imap-handle-make-directory-internal', -;; `tramp-imap-handle-set-file-times'. - -;; * Encode the subject. If the filename has trailing spaces (like -;; "test "), those characters get lost, for example in dired listings. - -;; * When opening a dired buffer, like "/imap::INBOX.test", there are -;; several error messages: -;; "Buffer has a running process; kill it? (yes or no) " -;; "error in process filter: Internal error, tag 6 status BAD code nil text No mailbox selected." -;; Afterwards, everything seems to be fine. - -;; * imaps works for local IMAP servers. Accessing -;; "/imaps:imap.gmail.com:/INBOX.test/" results in error -;; "error in process filter: Internal error, tag 5 status BAD code nil text UNSELECT not allowed now." - -;; * Improve `tramp-imap-handle-file-attributes' for directories. - -;; * Saving a file creates a second one, instead of overwriting. - -;; * Backup files: just *one* is kept. - -;; * Password requests shall have a descriptive prompt. - -;; * Exiting Emacs, there are running IMAP processes. Make them quiet -;; by `set-process-query-on-exit-flag'. - -(provide 'tramp-imap) -;;; tramp-imap.el ends here - -;; Ignore, for testing only. - -;;; (setq tramp-imap-subject-marker "T") -;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/4") t) -;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/") t) -;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/test/4") t) -;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/test/") t) -;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen") t) -;;; (tramp-imap-get-file-entries (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen") t t) -;;;(tramp-imap-get-file-inode "/imap:yourhosthere.com:/test/welcome") -;;; (dired-copy-file "/etc/fstab" "/imap:yourhosthere.com:/test/welcome" t) -;;; (write-region 1 100 "/imap:yourhosthere.com:/test/welcome") -;;; (tramp-imap-get-file "/imap:yourhosthere.com:/test/welcome" t) -;;(with-temp-buffer (insert "hello") (write-file "/imap:yourhosthere.com:/test/welcome")) -;;(with-temp-buffer (insert "hello") (write-file "/imap:yourhosthere.com:/test/welcome2")) -;;(file-writable-p "/imap:yourhosthere.com:/test/welcome2") -;;(file-name-directory "/imap:yourhosthere.com:/test/welcome2") -;;(with-temp-buffer (insert "hello") (delete-file "/tmp/hellotest") (write-file "/tmp/hellotest") (write-file "/imap:yourhosthere.com:/test/welcome2")) -;;;(file-exists-p "/imap:yourhosthere.com:/INBOX.test/4") -;;;(file-attributes "/imap:yourhosthere.com:/INBOX.test/4") -;;;(setq vec (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/4")) -;;;(tramp-imap-handle-file-attributes "/imap:yourhosthere.com:/INBOX.test/4") -;;; (tramp-imap-handle-insert-file-contents "/imap:user@yourhosthere.com:/INBOX.test/4" nil nil nil nil) -;;;(insert-file-contents "/imap:yourhosthere.com:/INBOX.test/4") -;;;(file-attributes "/imap:yourhosthere.com:/test/welcommen") -;;;(insert-file-contents "/imap:yourhosthere.com:/test/welcome") -;;;(file-exists-p "/imap:yourhosthere.com:/test/welcome2") -;;;(tramp-imap-handle-file-attributes "/imap:yourhosthere.com:/test/welcome") -;;;(tramp-imap-get-file-inode "/imap:yourhosthere.com:/test/welcommen") -;;;(tramp-imap-get-file-inode "/imap:yourhosthere.com:/test/welcome") -;;;(file-writable-p "/imap:yourhosthere.com:/test/welcome2") -;;; (delete-file "/imap:yourhosthere.com:/test/welcome") -;;; (tramp-imap-get-file "/imap:yourhosthere.com:/test/welcommen" t) -;;; (tramp-imap-get-file "/imap:yourhosthere.com:/test/welcome" t) -;;;(tramp-imap-file-name-mailbox (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test")) -;;;(tramp-imap-file-name-mailbox (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new/old")) -;;;(tramp-imap-file-name-mailbox (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new")) -;;;(tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new/two")) -;;;(tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new/one")) -;;;(tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test")) -;;; (tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/test/4")) -;;; (tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/test/")) -;;; (tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen")) -;;; (tramp-imap-file-name-parse (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen")) -;;; (tramp-imap-make-iht (tramp-dissect-file-name "/imap:yourhosthere.com:/test/welcommen")) -;;; (tramp-imap-make-iht (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/4")) -;;; (tramp-imap-make-iht (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/4") "extra") diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 8584d4ddc92..fc167d6e62e 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -297,6 +297,7 @@ shouldn't return t when it isn't." (executable-find "pscp")) (if (or (fboundp 'password-read) (fboundp 'auth-source-user-or-password) + (fboundp 'auth-source-search) ;; Pageant is running. (tramp-compat-process-running-p "Pageant")) "pscp" @@ -307,6 +308,7 @@ shouldn't return t when it isn't." ((tramp-detect-ssh-controlmaster) "scpc") ((or (fboundp 'password-read) (fboundp 'auth-source-user-or-password) + (fboundp 'auth-source-search) ;; ssh-agent is running. (getenv "SSH_AUTH_SOCK") (getenv "SSH_AGENT_PID")) @@ -1572,8 +1574,12 @@ special handling of `substitute-in-file-name'." (let ((props (tramp-compat-funcall 'overlay-properties (symbol-value 'rfn-eshadow-overlay)))) (while props - (tramp-compat-funcall - 'overlay-put tramp-rfn-eshadow-overlay (pop props) (pop props)))))) + ;; The `field' property prevents correct minibuffer + ;; completion; we exclude it. + (if (not (eq (car props) 'field)) + (tramp-compat-funcall + 'overlay-put tramp-rfn-eshadow-overlay (pop props) (pop props)) + (pop props) (pop props)))))) (when (boundp 'rfn-eshadow-setup-minibuffer-hook) (add-hook 'rfn-eshadow-setup-minibuffer-hook @@ -3519,17 +3525,32 @@ Invokes `password-read' if available, `read-passwd' else." (or prompt (with-current-buffer (process-buffer proc) (tramp-check-for-regexp proc tramp-password-prompt-regexp) - (format "%s for %s " (capitalize (match-string 1)) key))))) + (format "%s for %s " (capitalize (match-string 1)) key)))) + auth-info auth-passwd) (with-parsed-tramp-file-name key nil (prog1 (or - ;; See if auth-sources contains something useful, if it's bound. + ;; See if auth-sources contains something useful, if it's + ;; bound. `auth-source-user-or-password' is an obsoleted + ;; function, it has been replaced by `auth-source-search'. (and (boundp 'auth-sources) (tramp-get-connection-property v "first-password-request" nil) ;; Try with Tramp's current method. - (tramp-compat-funcall - 'auth-source-user-or-password - "password" tramp-current-host tramp-current-method)) + (if (fboundp 'auth-source-search) + (setq auth-info + (tramp-compat-funcall + 'auth-source-search + :max 1 + :user (or tramp-current-user t) + :host tramp-current-host + :port tramp-current-method) + auth-passwd (plist-get (nth 0 auth-info) :secret) + auth-passwd (if (functionp auth-passwd) + (funcall auth-passwd) + auth-passwd)) + (tramp-compat-funcall + 'auth-source-user-or-password + "password" tramp-current-host tramp-current-method))) ;; Try the password cache. (when (functionp 'password-read) (unless (tramp-get-connection-property diff --git a/lisp/password-cache.el b/lisp/password-cache.el index fcae55ad597..8738aa65a9f 100644 --- a/lisp/password-cache.el +++ b/lisp/password-cache.el @@ -111,9 +111,10 @@ that a password is invalid, so that `password-read' query the user again." (let ((password (symbol-value (intern-soft key password-data)))) (when password - (if (fboundp 'clear-string) - (clear-string password) - (fillarray password ?_)) + (when (stringp password) + (if (fboundp 'clear-string) + (clear-string password) + (fillarray password ?_))) (unintern key password-data)))) (defun password-cache-add (key password) diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el index 5b3b4aba0fe..c60472e9386 100644 --- a/lisp/play/doctor.el +++ b/lisp/play/doctor.el @@ -141,7 +141,7 @@ reads the sentence before point, and prints the Doctor's answer." (turn-on-auto-fill) (doctor-type '(i am the psychotherapist \. (doc$ doctor--please) (doc$ doctor--describe) your (doc$ doctor--problems) \. - each time you are finished talking, type \R\E\T twice \.)) + each time you are finished talking\, type \R\E\T twice \.)) (insert "\n")) (defun make-doctor-variables () diff --git a/lisp/play/solitaire.el b/lisp/play/solitaire.el index 9d6a0ef52b1..2fe62ed0e60 100644 --- a/lisp/play/solitaire.el +++ b/lisp/play/solitaire.el @@ -196,14 +196,15 @@ Pick your favourite shortcuts: (interactive "P") (switch-to-buffer "*Solitaire*") - (setq buffer-read-only t) - (setq solitaire-stones 32) - (solitaire-insert-board) - (solitaire-build-modeline) - (goto-char (point-max)) - (setq solitaire-center (search-backward ".")) - (setq buffer-undo-list (list (point))) - (solitaire-mode)) + (let ((inhibit-read-only t)) + (solitaire-mode) + (setq buffer-read-only t) + (setq solitaire-stones 32) + (solitaire-insert-board) + (solitaire-build-modeline) + (goto-char (point-max)) + (setq solitaire-center (search-backward ".")) + (setq buffer-undo-list (list (point))))) (defun solitaire-build-modeline () (setq mode-line-format diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index ec913e05c7e..5ac30bc28ce 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -2654,14 +2654,19 @@ sentence motion in or near comments and multiline strings." ;; Are we about to move forward into or out of a ;; preprocessor command? (when (eq (cdr res) 'macro-boundary) - (save-excursion - (end-of-line) - (setq macro-fence - (and (not (eobp)) - (progn (c-skip-ws-forward) - (c-beginning-of-macro)) - (progn (c-end-of-macro) - (point)))))) + (setq macro-fence + (save-excursion + (if macro-fence + (progn + (end-of-line) + (and (not (eobp)) + (progn (c-skip-ws-forward) + (c-beginning-of-macro)) + (progn (c-end-of-macro) + (point)))) + (and (not (eobp)) + (c-beginning-of-macro) + (progn (c-end-of-macro) (point))))))) ;; Are we about to move forward into a literal? (when (memq (cdr res) '(macro-boundary literal)) (setq range (c-ascertain-following-literal))) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index f90d29bf009..de1debd6456 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -5371,8 +5371,6 @@ comment at the start of cc-engine.el for more info." ;; cc-mode requires cc-fonts. (declare-function c-fontify-recorded-types-and-refs "cc-fonts" ()) -(defvar c-forward-<>-arglist-recur-depth) - (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 @@ -5398,8 +5396,7 @@ comment at the start of cc-engine.el for more info." ;; If `c-record-type-identifiers' is set then activate ;; recording of any found types that constitute an argument in ;; the arglist. - (c-record-found-types (if c-record-type-identifiers t)) - (c-forward-<>-arglist-recur--depth 0)) + (c-record-found-types (if c-record-type-identifiers t))) (if (catch 'angle-bracket-arglist-escape (setq c-record-found-types (c-forward-<>-arglist-recur all-types))) @@ -5416,14 +5413,6 @@ comment at the start of cc-engine.el for more info." nil))) (defun c-forward-<>-arglist-recur (all-types) - - ;; Temporary workaround for Bug#7722. - (when (boundp 'c-forward-<>-arglist-recur--depth) - (if (> c-forward-<>-arglist-recur--depth 200) - (error "Max recursion depth reached in <> arglist") - (setq c-forward-<>-arglist-recur--depth - (1+ c-forward-<>-arglist-recur--depth)))) - ;; Recursive part of `c-forward-<>-arglist'. ;; ;; This function might do hidden buffer changes. @@ -5455,9 +5444,11 @@ comment at the start of cc-engine.el for more info." (goto-char start) nil)) - (forward-char) + (forward-char) ; Forward over the opening '<'. (unless (looking-at c-<-op-cont-regexp) + ;; go forward one non-alphanumeric character (group) per iteration of + ;; this loop. (while (and (progn (c-forward-syntactic-ws) @@ -5486,7 +5477,7 @@ comment at the start of cc-engine.el for more info." (c-forward-type) (c-forward-syntactic-ws)))))) - (setq pos (point)) + (setq pos (point)) ; e.g. first token inside the '<' ;; Note: These regexps exploit the match order in \| so ;; that "<>" is matched by "<" rather than "[^>:-]>". @@ -5522,37 +5513,35 @@ comment at the start of cc-engine.el for more info." ;; Either an operator starting with '<' or a nested arglist. (setq pos (point)) (let (id-start id-end subres keyword-match) - (if (if (looking-at c-<-op-cont-regexp) - (setq tmp (match-end 0)) - (setq tmp pos) - (backward-char) - (not - (and - - (save-excursion - ;; There's always an identifier before an angle - ;; bracket arglist, or a keyword in - ;; `c-<>-type-kwds' or `c-<>-arglist-kwds'. - (c-backward-syntactic-ws) - (setq id-end (point)) - (c-simple-skip-symbol-backward) - (when (or (setq keyword-match - (looking-at c-opt-<>-sexp-key)) - (not (looking-at c-keywords-regexp))) - (setq id-start (point)))) - - (setq subres - (let ((c-promote-possible-types t) - (c-record-found-types t)) - (c-forward-<>-arglist-recur - (and keyword-match - (c-keyword-member - (c-keyword-sym (match-string 1)) - 'c-<>-type-kwds))))) - ))) - - ;; It was not an angle bracket arglist. - (goto-char tmp) + (cond + ;; The '<' begins a multi-char operator. + ((looking-at c-<-op-cont-regexp) + (setq tmp (match-end 0)) + (goto-char (match-end 0))) + ;; We're at a nested <.....> + ((progn + (setq tmp pos) + (backward-char) ; to the '<' + (and + (save-excursion + ;; There's always an identifier before an angle + ;; bracket arglist, or a keyword in `c-<>-type-kwds' + ;; or `c-<>-arglist-kwds'. + (c-backward-syntactic-ws) + (setq id-end (point)) + (c-simple-skip-symbol-backward) + (when (or (setq keyword-match + (looking-at c-opt-<>-sexp-key)) + (not (looking-at c-keywords-regexp))) + (setq id-start (point)))) + (setq subres + (let ((c-promote-possible-types t) + (c-record-found-types t)) + (c-forward-<>-arglist-recur + (and keyword-match + (c-keyword-member + (c-keyword-sym (match-string 1)) + 'c-<>-type-kwds))))))) ;; It was an angle bracket arglist. (setq c-record-found-types subres) @@ -5567,8 +5556,13 @@ comment at the start of cc-engine.el for more info." (c-forward-syntactic-ws) (looking-at c-opt-identifier-concat-key))) (c-record-ref-id (cons id-start id-end)) - (c-record-type-id (cons id-start id-end)))))) - t) + (c-record-type-id (cons id-start id-end))))) + + ;; At a "less than" operator. + (t + (forward-char) + ))) + t) ; carry on looping. ((and (not c-restricted-<>-arglists) (or (and (eq (char-before) ?&) diff --git a/lisp/progmodes/cc-fonts.el b/lisp/progmodes/cc-fonts.el index 0d738700cc7..c7bb93f73e7 100644 --- a/lisp/progmodes/cc-fonts.el +++ b/lisp/progmodes/cc-fonts.el @@ -1082,7 +1082,7 @@ casts and declarations are fontified. Used on level 2 and higher." (boundp 'parse-sexp-lookup-properties)))) ;; Below we fontify a whole declaration even when it crosses the limit, - ;; to avoid gaps when lazy-lock fontifies the file a screenful at a + ;; to avoid gaps when jit/lazy-lock fontifies the file a block at a ;; time. That is however annoying during editing, e.g. the following is ;; a common situation while the first line is being written: ;; @@ -1094,9 +1094,9 @@ casts and declarations are fontified. Used on level 2 and higher." ;; "some_other_variable" as an identifier, and the latter will not ;; correct itself until the second line is changed. To avoid that we ;; narrow to the limit if the region to fontify is a single line. - (narrow-to-region - (point-min) - (if (<= limit (c-point 'bonl)) + (if (<= limit (c-point 'bonl)) + (narrow-to-region + (point-min) (save-excursion ;; Narrow after any operator chars following the limit though, ;; since those characters can be useful in recognizing a @@ -1104,8 +1104,7 @@ casts and declarations are fontified. Used on level 2 and higher." ;; after the header). (goto-char limit) (skip-chars-forward c-nonsymbol-chars) - (point)) - limit)) + (point)))) (c-find-decl-spots limit diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index b41eb82e27d..88f418f934a 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -838,6 +838,7 @@ POS and RES.") ((or (not compilation--previous-directory-cache) (<= (car compilation--previous-directory-cache) start))) ((or (not (cdr compilation--previous-directory-cache)) + (null (marker-buffer (cdr compilation--previous-directory-cache))) (<= (cdr compilation--previous-directory-cache) start)) (set-marker (car compilation--previous-directory-cache) start)) (t (setq compilation--previous-directory-cache nil)))) diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 15a94d68735..9468d7b463e 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -689,6 +689,8 @@ Return point, or nil if original point was not in a block." (point) ;; look backward for the start of a block that contains the cursor (while (and (re-search-backward hs-block-start-regexp nil t) + (save-match-data + (not (nth 4 (syntax-ppss)))) ; not inside comments (not (setq done (< here (save-excursion (hs-forward-sexp (match-data t) 1) @@ -711,10 +713,12 @@ Return point, or nil if original point was not in a block." (forward-comment (buffer-size)) (and (< (point) maxp) (re-search-forward hs-block-start-regexp maxp t))) - (if (> arg 1) - (hs-hide-level-recursive (1- arg) minp maxp) - (goto-char (match-beginning hs-block-start-mdata-select)) - (hs-hide-block-at-point t))) + (when (save-match-data + (not (nth 4 (syntax-ppss)))) ; not inside comments + (if (> arg 1) + (hs-hide-level-recursive (1- arg) minp maxp) + (goto-char (match-beginning hs-block-start-mdata-select)) + (hs-hide-block-at-point t)))) (goto-char maxp)) (defmacro hs-life-goes-on (&rest body) diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el index fd79cfd2399..45d967e92d9 100644 --- a/lisp/progmodes/prolog.el +++ b/lisp/progmodes/prolog.el @@ -5,8 +5,9 @@ ;; Authors: Emil Åström <emil_astrom(at)hotmail(dot)com> ;; Milan Zamazal <pdm(at)freesoft(dot)cz> -;; Stefan Bruda <stefan(at)bruda(dot)ca> (current maintainer) +;; Stefan Bruda <stefan(at)bruda(dot)ca> ;; * See below for more details +;; Maintainer: Stefan Bruda <stefan(at)bruda(dot)ca> ;; Keywords: prolog major mode sicstus swi mercury (defvar prolog-mode-version "1.22" @@ -279,7 +280,6 @@ ;;; Code: (eval-when-compile - (require 'compile) (require 'font-lock) ;; We need imenu everywhere because of the predicate index! (require 'imenu) @@ -1125,6 +1125,8 @@ Actually this is just customized `prolog-mode'." (comint-send-string proc (string last-command-event)) (call-interactively 'self-insert-command)))) +(declare-function 'compilation-shell-minor-mode "compile" (&optional arg)) +(defvar compilation-error-regexp-alist) (define-derived-mode prolog-inferior-mode comint-mode "Inferior Prolog" "Major mode for interacting with an inferior Prolog process. @@ -1155,6 +1157,7 @@ imitating normal Unix input editing. To find out what version of Prolog mode you are running, enter `\\[prolog-mode-version]'." + (require 'compile) (setq comint-input-filter 'prolog-input-filter) (setq mode-line-process '(": %s")) (prolog-mode-variables) @@ -1278,6 +1281,10 @@ the variable `prolog-prompt-regexp'." ;; Old consulting and compiling functions ;;------------------------------------------------------------ +(declare-function compilation-forget-errors "compile" ()) +(declare-function compilation-fake-loc "compile" + (marker file &optional line col)) + (defun prolog-old-process-region (compilep start end) "Process the region limited by START and END positions. If COMPILEP is non-nil then use compilation, otherwise consulting." @@ -1479,6 +1486,8 @@ Used for temporary files.") (defvar prolog-consult-compile-real-file nil "The file name of the buffer to compile/consult.") +(defvar compilation-parse-errors-function) + (defun prolog-consult-compile (compilep file &optional first-line) "Consult/compile FILE. If COMPILEP is non-nil, perform compilation, otherwise perform CONSULTING. @@ -1540,6 +1549,8 @@ This function must be called from the source code buffer." "\nConsulted.\n")) (set-process-filter process old-filter)))) +(defvar compilation-error-list) + (defun prolog-parse-sicstus-compilation-errors (limit) "Parse the prolog compilation buffer for errors. Argument LIMIT is a buffer position limiting searching. diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 900072fe356..7b84cc89d08 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -969,7 +969,8 @@ Point is at the beginning of the next line." (defun sh-syntax-propertize-here-doc (end) (let ((ppss (syntax-ppss))) (when (eq t (nth 3 ppss)) - (let ((key (get-text-property (nth 8 ppss) 'sh-here-doc-marker))) + (let ((key (get-text-property (nth 8 ppss) 'sh-here-doc-marker)) + (case-fold-search nil)) (when (re-search-forward (concat "^\\([ \t]*\\)" (regexp-quote key) "\\(\n\\)") end 'move) diff --git a/lisp/shell.el b/lisp/shell.el index fcffc2317d5..ea89ce765c3 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -151,12 +151,14 @@ This is a fine thing to set in your `.emacs' file." :type '(repeat (string :tag "Suffix")) :group 'shell) -(defvar shell-delimiter-argument-list '(?\| ?& ?< ?> ?\( ?\) ?\;) +(defcustom shell-delimiter-argument-list nil ; '(?\| ?& ?< ?> ?\( ?\) ?\;) "List of characters to recognize as separate arguments. This variable is used to initialize `comint-delimiter-argument-list' in the -shell buffer. The value may depend on the operating system or shell. - -This is a fine thing to set in your `.emacs' file.") +shell buffer. The value may depend on the operating system or shell." + :type '(choice (const nil) + (repeat :tag "List of characters" character)) + :version "24.1" ; changed to nil (bug#8027) + :group 'shell) (defvar shell-file-name-chars (if (memq system-type '(ms-dos windows-nt cygwin)) diff --git a/lisp/simple.el b/lisp/simple.el index 4776cf37931..4549a0bb336 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -304,8 +304,8 @@ runs `next-error-hook' with `run-hooks', and stays with that buffer until you use it in some other buffer which uses Compilation mode or Compilation Minor mode. -See variables `compilation-parse-errors-function' and -\`compilation-error-regexp-alist' for customization ideas." +To control which errors are matched, customize the variable +`compilation-error-regexp-alist'." (interactive "P") (if (consp arg) (setq reset t arg nil)) (when (setq next-error-last-buffer (next-error-find-buffer)) @@ -614,22 +614,30 @@ On nonblank line, delete any immediately following blank lines." (if (looking-at "^[ \t]*\n\\'") (delete-region (point) (point-max))))) -(defun delete-trailing-whitespace () +(defun delete-trailing-whitespace (&optional start end) "Delete all the trailing whitespace across the current buffer. All whitespace after the last non-whitespace character in a line is deleted. This respects narrowing, created by \\[narrow-to-region] and friends. -A formfeed is not considered whitespace by this function." - (interactive "*") +A formfeed is not considered whitespace by this function. +If the region is active, only delete whitespace within the region." + (interactive (progn + (barf-if-buffer-read-only) + (if (use-region-p) + (list (region-beginning) (region-end)) + (list nil nil)))) (save-match-data (save-excursion - (goto-char (point-min)) - (while (re-search-forward "\\s-$" nil t) - (skip-syntax-backward "-" (save-excursion (forward-line 0) (point))) - ;; Don't delete formfeeds, even if they are considered whitespace. - (save-match-data - (if (looking-at ".*\f") - (goto-char (match-end 0)))) - (delete-region (point) (match-end 0)))))) + (let ((end-marker (copy-marker (or end (point-max)))) + (start (or start (point-min)))) + (goto-char start) + (while (re-search-forward "\\s-$" end-marker t) + (skip-syntax-backward "-" (save-excursion (forward-line 0) (point))) + ;; Don't delete formfeeds, even if they are considered whitespace. + (save-match-data + (if (looking-at ".*\f") + (goto-char (match-end 0)))) + (delete-region (point) (match-end 0))) + (set-marker end-marker nil))))) (defun newline-and-indent () "Insert a newline, then indent according to major mode. @@ -770,7 +778,7 @@ If N is negative, delete newlines as well." (n (abs n))) (skip-chars-backward skip-characters) (constrain-to-field nil orig-pos) - (dotimes (i (or n 1)) + (dotimes (i n) (if (= (following-char) ?\s) (forward-char 1) (insert ?\s))) @@ -5715,7 +5723,10 @@ appears to have customizations applying to the old default, :group 'mail) (defun rfc822-goto-eoh () - ;; Go to header delimiter line in a mail message, following RFC822 rules + "If the buffer starts with a mail header, move point to the header's end. +Otherwise, moves to `point-min'. +The end of the header is the start of the next line, if there is one, +else the end of the last line. This function obeys RFC822." (goto-char (point-min)) (when (re-search-forward "^\\([:\n]\\|[^: \t\n]+[ \t\n]\\)" nil 'move) diff --git a/lisp/speedbar.el b/lisp/speedbar.el index b84afd797d1..dad2a4c82ac 100644 --- a/lisp/speedbar.el +++ b/lisp/speedbar.el @@ -614,8 +614,11 @@ state data." :group 'speedbar :type 'hook) -(defvar speedbar-ignored-modes '(fundamental-mode) - "*List of major modes which speedbar will not switch directories for.") +(defcustom speedbar-ignored-modes '(fundamental-mode) + "List of major modes which speedbar will not switch directories for." + :group 'speedbar + :type '(choice (const nil) + (repeat :tag "List of modes" (symbol :tag "Major mode")))) (defun speedbar-extension-list-to-regex (extlist) "Takes EXTLIST, a list of extensions and transforms it into regexp. @@ -669,7 +672,7 @@ directories here; see `vc-directory-exclusion-list'." :group 'speedbar :type 'string) -(defvar speedbar-file-unshown-regexp +(defcustom speedbar-file-unshown-regexp (let ((nstr "") (noext completion-ignored-extensions)) (while noext (setq nstr (concat nstr (regexp-quote (car noext)) "\\'" @@ -677,8 +680,10 @@ directories here; see `vc-directory-exclusion-list'." noext (cdr noext))) ;; backup refdir lockfile (concat nstr "\\|#[^#]+#$\\|\\.\\.?\\'\\|\\.#")) - "*Regexp matching files we don't want displayed in a speedbar buffer. -It is generated from the variable `completion-ignored-extensions'.") + "Regexp matching files we don't want displayed in a speedbar buffer. +It is generated from the variable `completion-ignored-extensions'." + :group 'speedbar + :type 'string) (defvar speedbar-file-regexp nil "Regular expression matching files we know how to expand. @@ -755,14 +760,17 @@ DIRECTORY-EXPRESSION to `speedbar-ignored-directory-expressions'." speedbar-ignored-directory-regexp (speedbar-extension-list-to-regex speedbar-ignored-directory-expressions))) -(defvar speedbar-update-flag dframe-have-timer-flag - "*Non-nil means to automatically update the display. +(defcustom speedbar-update-flag dframe-have-timer-flag + "Non-nil means to automatically update the display. When this is nil then speedbar will not follow the attached frame's directory. -When speedbar is active, use: - -\\<speedbar-key-map> `\\[speedbar-toggle-updates]' - -to toggle this value.") +If you want to change this while speedbar is active, either use +\\[customize] or call \\<speedbar-key-map> `\\[speedbar-toggle-updates]'." + :group 'speedbar + :initialize 'custom-initialize-default + :set (lambda (sym val) + (set sym val) + (speedbar-toggle-updates)) + :type 'boolean) (defvar speedbar-update-flag-disable nil "Permanently disable changing of the update flag.") @@ -3643,17 +3651,20 @@ to be at the beginning of a line in the etags buffer. This variable is ignored if `speedbar-use-imenu-flag' is non-nil.") -(defvar speedbar-fetch-etags-command "etags" - "*Command used to create an etags file. - -This variable is ignored if `speedbar-use-imenu-flag' is t.") +(defcustom speedbar-fetch-etags-command "etags" + "Command used to create an etags file. +This variable is ignored if `speedbar-use-imenu-flag' is t." + :group 'speedbar + :type 'string) -(defvar speedbar-fetch-etags-arguments '("-D" "-I" "-o" "-") - "*List of arguments to use with `speedbar-fetch-etags-command'. +(defcustom speedbar-fetch-etags-arguments '("-D" "-I" "-o" "-") + "List of arguments to use with `speedbar-fetch-etags-command'. This creates an etags output buffer. Use `speedbar-toggle-etags' to modify this list conveniently. - -This variable is ignored if `speedbar-use-imenu-flag' is t.") +This variable is ignored if `speedbar-use-imenu-flag' is t." + :group 'speedbar + :type '(choice (const nil) + (repeat :tag "List of arguments" string))) (defun speedbar-toggle-etags (flag) "Toggle FLAG in `speedbar-fetch-etags-arguments'. diff --git a/lisp/term.el b/lisp/term.el index ea419234e0f..df95ca830ab 100644 --- a/lisp/term.el +++ b/lisp/term.el @@ -762,11 +762,13 @@ Buffer local variable.") "magenta3" "cyan3" "white"]) ;; Inspiration came from comint.el -mm -(defvar term-buffer-maximum-size 2048 - "*The maximum size in lines for term buffers. +(defcustom term-buffer-maximum-size 2048 + "The maximum size in lines for term buffers. Term buffers are truncated from the top to be no greater than this number. Notice that a setting of 0 means \"don't truncate anything\". This variable -is buffer-local.") +is buffer-local." + :group 'term + :type 'integer) (when (featurep 'xemacs) (defvar term-terminal-menu @@ -2209,9 +2211,11 @@ Security bug: your string can still be temporarily recovered with ;;; Low-level process communication -(defvar term-input-chunk-size 512 - "*Long inputs send to term processes are broken up into chunks of this size. -If your process is choking on big inputs, try lowering the value.") +(defcustom term-input-chunk-size 512 + "Long inputs send to term processes are broken up into chunks of this size. +If your process is choking on big inputs, try lowering the value." + :group 'term + :type 'integer) (defun term-send-string (proc str) "Send to PROC the contents of STR as input. @@ -3909,27 +3913,38 @@ This is a good place to put keybindings.") ;; Commands like this are fine things to put in load hooks if you ;; want them present in specific modes. -(defvar term-completion-autolist nil - "*If non-nil, automatically list possibilities on partial completion. -This mirrors the optional behavior of tcsh.") +(defcustom term-completion-autolist nil + "If non-nil, automatically list possibilities on partial completion. +This mirrors the optional behavior of tcsh." + :group 'term + :type 'boolean) -(defvar term-completion-addsuffix t - "*If non-nil, add a `/' to completed directories, ` ' to file names. +(defcustom term-completion-addsuffix t + "If non-nil, add a `/' to completed directories, ` ' to file names. If a cons pair, it should be of the form (DIRSUFFIX . FILESUFFIX) where DIRSUFFIX and FILESUFFIX are strings added on unambiguous or exact -completion. This mirrors the optional behavior of tcsh.") +completion. This mirrors the optional behavior of tcsh." + :group 'term + :type '(choice (const :tag "No suffix" nil) + (cons (string :tag "dirsuffix") (string :tag "filesuffix")) + (other :tag "Suffix" t))) -(defvar term-completion-recexact nil - "*If non-nil, use shortest completion if characters cannot be added. +(defcustom term-completion-recexact nil + "If non-nil, use shortest completion if characters cannot be added. This mirrors the optional behavior of tcsh. -A non-nil value is useful if `term-completion-autolist' is non-nil too.") +A non-nil value is useful if `term-completion-autolist' is non-nil too." + :group 'term + :type 'boolean) -(defvar term-completion-fignore nil - "*List of suffixes to be disregarded during file completion. +(defcustom term-completion-fignore nil + "List of suffixes to be disregarded during file completion. This mirrors the optional behavior of bash and tcsh. -Note that this applies to `term-dynamic-complete-filename' only.") +Note that this applies to `term-dynamic-complete-filename' only." + :group 'term + :type '(choice (const nil) + (repeat :tag "List of suffixes" string))) (defvar term-file-name-prefix "" "Prefix prepended to absolute file names taken from process input. diff --git a/lisp/term/sup-mouse.el b/lisp/term/sup-mouse.el index a8b78bb3e38..6d77241008c 100644 --- a/lisp/term/sup-mouse.el +++ b/lisp/term/sup-mouse.el @@ -30,8 +30,11 @@ ;;; User customization option: -(defvar sup-mouse-fast-select-window nil - "*Non-nil for mouse hits to select new window, then execute; else just select.") +(defcustom sup-mouse-fast-select-window nil + "Non-nil means mouse hits select new window, then execute. +Otherwise just select." + :type 'boolean + :group 'mouse) (defconst mouse-left 0) (defconst mouse-center 1) diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 1ec80d5c277..e3c42626a3f 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -1167,20 +1167,28 @@ pasted text.") :group 'killing :version "24.1") -(defvar x-select-request-type nil - "*Data type request for X selection. +(defcustom x-select-request-type nil + "Data type request for X selection. The value is one of the following data types, a list of them, or nil: `COMPOUND_TEXT', `UTF8_STRING', `STRING', `TEXT' -If the value is one of the above symbols, try only the specified -type. +If the value is one of the above symbols, try only the specified type. If the value is a list of them, try each of them in the specified order until succeed. -The value nil is the same as this list: - \(UTF8_STRING COMPOUND_TEXT STRING) -") +The value nil is the same as the list (UTF8_STRING COMPOUND_TEXT STRING)." + :type '(choice (const :tag "Default" nil) + (const COMPOUND_TEXT) + (const UTF8_STRING) + (const STRING) + (const TEXT) + (set :tag "List of values" + (const COMPOUND_TEXT) + (const UTF8_STRING) + (const STRING) + (const TEXT))) + :group 'killing) ;; Get a selection value of type TYPE by calling x-get-selection with ;; an appropriate DATA-TYPE argument decided by `x-select-request-type'. diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index f75d8b57909..79df6135806 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -1957,7 +1957,7 @@ both ends." ((equal char ?\C-g) (keyboard-quit)) ((member char '(?o ?O)) - ;; Select a differnt macro + ;; Select a different macro (let* ((nc (reftex-index-select-phrases-macro 2)) (macro-data (cdr (assoc nc reftex-index-phrases-macro-data))) diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog index 742a3cfb9b5..3c7b8b6abe7 100644 --- a/lisp/url/ChangeLog +++ b/lisp/url/ChangeLog @@ -1,3 +1,13 @@ +2011-02-12 Teodor Zlatanov <tzz@lifelogs.com> + + * url-parse.el (url-bit-for-url, url-user-for-url) + (url-password-for-url): Use `auto-source-search' instead of + `auto-source-user-or-password'. + + * url-auth.el: Autoload `auto-source-search' instead of + `auto-source-user-or-password'. + (url-basic-auth, url-digest-auth, url-do-auth-source-search): Use it. + 2011-02-03 Lars Ingebrigtsen <larsi@gnus.org> * url-http.el (url-http-wait-for-headers-change-function): Don't diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el index 842e2a3be8d..5261302a15c 100644 --- a/lisp/url/url-auth.el +++ b/lisp/url/url-auth.el @@ -24,7 +24,7 @@ (require 'url-vars) (require 'url-parse) (autoload 'url-warn "url") -(autoload 'auth-source-user-or-password "auth-source") +(autoload 'auth-source-search "auth-source") (defsubst url-auth-user-prompt (url realm) "String to usefully prompt for a username." @@ -81,11 +81,11 @@ instead of the filename inheritance method." (cond ((and prompt (not byserv)) (setq user (or - (auth-source-user-or-password "login" server type) + (url-do-auth-source-search server type :user) (read-string (url-auth-user-prompt url realm) (or user (user-real-login-name)))) pass (or - (auth-source-user-or-password "password" server type) + (url-do-auth-source-search server type :secret) (read-passwd "Password: " nil (or pass "")))) (set url-basic-auth-storage (cons (list server @@ -110,11 +110,11 @@ instead of the filename inheritance method." (if (or (and (not retval) prompt) overwrite) (progn (setq user (or - (auth-source-user-or-password "login" server type) + (url-do-auth-source-search server type :user) (read-string (url-auth-user-prompt url realm) (user-real-login-name))) pass (or - (auth-source-user-or-password "password" server type) + (url-do-auth-source-search server type :secret) (read-passwd "Password: ")) retval (base64-encode-string (format "%s:%s" user pass)) byserv (assoc server (symbol-value url-basic-auth-storage))) @@ -173,11 +173,11 @@ instead of hostname:portnum." (cond ((and prompt (not byserv)) (setq user (or - (auth-source-user-or-password "login" server type) + (url-do-auth-source-search server type :user) (read-string (url-auth-user-prompt url realm) (user-real-login-name))) pass (or - (auth-source-user-or-password "password" server type) + (url-do-auth-source-search server type :secret) (read-passwd "Password: ")) url-digest-auth-storage (cons (list server @@ -204,11 +204,11 @@ instead of hostname:portnum." (if overwrite (if (and (not retval) prompt) (setq user (or - (auth-source-user-or-password "login" server type) + (url-do-auth-source-search server type :user) (read-string (url-auth-user-prompt url realm) (user-real-login-name))) pass (or - (auth-source-user-or-password "password" server type) + (url-do-auth-source-search server type :secret) (read-passwd "Password: ")) retval (setq retval (cons user @@ -244,6 +244,13 @@ instead of hostname:portnum." "A list of the registered authorization schemes and various and sundry information associated with them.") +(defun url-do-auth-source-search (server type parameter) + (let* ((auth-info (auth-source-search :max 1 :host server :port type)) + (auth-info (nth 0 auth-info)) + (token (plist-get auth-info parameter)) + (token (if (functionp token) (funcall token) token))) + token)) + ;;;###autoload (defun url-get-authentication (url realm type prompt &optional args) "Return an authorization string suitable for use in the WWW-Authenticate diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el index 950f666e9c7..71c03bf1edd 100644 --- a/lisp/url/url-parse.el +++ b/lisp/url/url-parse.el @@ -178,20 +178,25 @@ TYPE USER PASSWORD HOST PORTSPEC FILENAME TARGET ATTRIBUTES FULLNESS." `(let* ((urlobj (url-generic-parse-url url)) (bit (funcall ,method urlobj)) (methods (list 'url-recreate-url - 'url-host))) + 'url-host)) + auth-info) (while (and (not bit) (> (length methods) 0)) - (setq bit - (auth-source-user-or-password - ,lookfor (funcall (pop methods) urlobj) (url-type urlobj)))) + (setq auth-info (auth-source-search + :max 1 + :host (funcall (pop methods) urlobj) + :port (url-type urlobj))) + (setq bit (plist-get (nth 0 auth-info) ,lookfor)) + (when (functionp bit) + (setq bit (funcall bit)))) bit)) (defun url-user-for-url (url) "Attempt to use .authinfo to find a user for this URL." - (url-bit-for-url 'url-user "login" url)) + (url-bit-for-url 'url-user :user url)) (defun url-password-for-url (url) "Attempt to use .authinfo to find a password for this URL." - (url-bit-for-url 'url-password "password" url)) + (url-bit-for-url 'url-password :secret url)) (provide 'url-parse) diff --git a/lisp/vc/ediff-mult.el b/lisp/vc/ediff-mult.el index 2aea75aa427..cadcdec29b4 100644 --- a/lisp/vc/ediff-mult.el +++ b/lisp/vc/ediff-mult.el @@ -306,7 +306,7 @@ buffers." (nth 3 elt)) (defsubst ediff-get-session-objC (elt) (nth 4 elt)) -;; Take the "name" component of the object into acount. ObjA/C/B is of the form +;; Take the "name" component of the object into account. ObjA/C/B is of the form ;; (name . equality-indicator) (defsubst ediff-get-session-objA-name (elt) (car (nth 2 elt))) diff --git a/lisp/vc/ediff-ptch.el b/lisp/vc/ediff-ptch.el index 468d12057ab..d930a1bec69 100644 --- a/lisp/vc/ediff-ptch.el +++ b/lisp/vc/ediff-ptch.el @@ -417,7 +417,7 @@ Ediff has inferred that are two possible targets for applying the patch. Both files seem to be plausible alternatives. -Please advice: +Please advise: Type `y' to use %s as the target; Type `n' to use %s as the target. " diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 9ec3e970b5e..192ab1f78d2 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -621,14 +621,18 @@ regardless of user name or time." (delete-region start end) (rfc822-goto-eoh) (insert "Fixes: " fixes "\n" (if (looking-at "\n") "" "\n"))))) - (goto-char (point-min)) - (when (and log-edit-strip-single-file-name (looking-at "\\*\\s-+")) - (forward-line 1) - (when (not (re-search-forward "^\\*\\s-+" nil t)) - (goto-char (point-min)) - (skip-chars-forward "^():") - (skip-chars-forward ": ") - (delete-region (point-min) (point)))))) + (and log-edit-strip-single-file-name + (progn (rfc822-goto-eoh) + (if (looking-at "\n") (forward-char 1)) + (looking-at "\\*\\s-+")) + (let ((start (point))) + (forward-line 1) + (when (not (re-search-forward "^\\*\\s-+" nil t)) + (goto-char start) + (skip-chars-forward "^():") + (skip-chars-forward ": ") + (delete-region start (point))))) + (goto-char (point-min)))) ;;;; ;;;; functions for getting commit message from ChangeLog a file... diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index 11ffc9a5e36..fa731e77a6e 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -130,6 +130,7 @@ ("z" . kill-this-buffer) ("q" . quit-window) ("g" . revert-buffer) + ("\C-m" . log-view-toggle-entry-display) ("m" . log-view-toggle-mark-entry) ("e" . log-view-modify-change-comment) @@ -147,7 +148,6 @@ ("\M-n" . log-view-file-next) ("\M-p" . log-view-file-prev)) "Log-View's keymap." - :inherit widget-keymap :group 'log-view) (easy-menu-define log-view-mode-menu log-view-mode-map @@ -168,6 +168,8 @@ :help "Annotate the version at point"] ["Modify Log Comment" log-view-modify-change-comment :help "Edit the change comment displayed at point"] + ["Toggle Details at Point" log-view-toggle-entry-display + :active log-view-expanded-log-entry-function] "-----" ["Next Log Entry" log-view-msg-next :help "Go to the next count'th log message"] @@ -181,6 +183,12 @@ (defvar log-view-mode-hook nil "Hook run at the end of `log-view-mode'.") +(defvar log-view-expanded-log-entry-function nil + "Function returning the detailed description of a Log View entry. +It is called by the command `log-view-toggle-entry-display' with +one arg, the revision tag (a string), and should return a string. +If it is nil, `log-view-toggle-entry-display' does nothing.") + (defface log-view-file '((((class color) (background light)) (:background "grey70" :weight bold)) @@ -300,15 +308,36 @@ The match group number 1 should match the revision number itself.") (when cvsdir (setq dir (expand-file-name cvsdir dir)))) (expand-file-name file dir)))) -(defun log-view-current-tag (&optional where) - (save-excursion - (when where (goto-char where)) - (forward-line 1) - (let ((pt (point))) - (when (re-search-backward log-view-message-re nil t) - (let ((rev (match-string-no-properties 1))) - (unless (re-search-forward log-view-file-re pt t) - rev)))))) +(defun log-view-current-entry (&optional pos move) + "Return the position and revision tag of the Log View entry at POS. +This is a list (BEG TAG), where BEG is a buffer position and TAG +is a string. If POS is nil or omitted, it defaults to point. +If there is no entry at POS, return nil. + +If optional arg MOVE is non-nil, move point to BEG if found. +Otherwise, don't move point." + (let ((looping t) + result) + (save-excursion + (when pos (goto-char pos)) + (forward-line 1) + (while looping + (setq pos (re-search-backward log-view-message-re nil 'move) + looping (and pos (log-view-inside-comment-p (point))))) + (when pos + (setq result + (list pos (match-string-no-properties 1))))) + (and move result (goto-char pos)) + result)) + +(defun log-view-inside-comment-p (pos) + "Return non-nil if POS lies inside an expanded log entry." + (eq (get-text-property pos 'log-view-comment) t)) + +(defun log-view-current-tag (&optional pos) + "Return the revision tag (a string) of the Log View entry at POS. +if POS is omitted or nil, it defaults to point." + (cadr (log-view-current-entry pos))) (defun log-view-toggle-mark-entry () "Toggle the marked state for the log entry at point. @@ -318,29 +347,24 @@ entries are denoted by changing their background color. log entries." (interactive) (save-excursion - (forward-line 1) - (let ((pt (point))) - (when (re-search-backward log-view-message-re nil t) - (let ((beg (match-beginning 0)) - end ov ovlist found tag) - (unless (re-search-forward log-view-file-re pt t) - ;; Look to see if the current entry is marked. - (setq found (get-char-property (point) 'log-view-self)) - (if found - (delete-overlay found) - ;; Create an overlay that covers this entry and change - ;; its color. - (setq tag (log-view-current-tag (point))) - (forward-line 1) - (setq end - (if (re-search-forward log-view-message-re nil t) - (match-beginning 0) - (point-max))) - (setq ov (make-overlay beg end)) - (overlay-put ov 'face 'log-view-file) - ;; This is used to check if the overlay is present. - (overlay-put ov 'log-view-self ov) - (overlay-put ov 'log-view-marked tag)))))))) + (let* ((entry (log-view-current-entry nil t)) + (beg (car entry)) + found) + (when entry + ;; Look to see if the current entry is marked. + (setq found (get-char-property beg 'log-view-self)) + (if found + (delete-overlay found) + ;; Create an overlay covering this entry and change its color. + (let* ((end (if (get-text-property beg 'log-view-entry-expanded) + (next-single-property-change beg 'log-view-comment) + (log-view-end-of-defun) + (point))) + (ov (make-overlay beg end))) + (overlay-put ov 'face 'log-view-file) + ;; This is used to check if the overlay is present. + (overlay-put ov 'log-view-self ov) + (overlay-put ov 'log-view-marked (nth 1 entry)))))))) (defun log-view-get-marked () "Return the list of tags for the marked log entries." @@ -353,50 +377,74 @@ log entries." (setq pos (overlay-end ov)))) marked-list))) -(defun log-view-beginning-of-defun () - ;; This assumes that a log entry starts with a line matching - ;; `log-view-message-re'. Modes that derive from `log-view-mode' - ;; for which this assumption is not valid will have to provide - ;; another implementation of this function. `log-view-msg-prev' - ;; does a similar job to this function, we can't use it here - ;; directly because it prints messages that are not appropriate in - ;; this context and it does not move to the beginning of the buffer - ;; when the point is before the first log entry. - - ;; `log-view-beginning-of-defun' and `log-view-end-of-defun' have - ;; been checked to work with logs produced by RCS, CVS, git, - ;; mercurial and subversion. - - (re-search-backward log-view-message-re nil 'move)) +(defun log-view-toggle-entry-display () + (interactive) + ;; Don't do anything unless `log-view-expanded-log-entry-function' + ;; is defined in this mode. + (when (functionp log-view-expanded-log-entry-function) + (let* ((opoint (point)) + (entry (log-view-current-entry nil t)) + (beg (car entry)) + (buffer-read-only nil)) + (when entry + (if (get-text-property beg 'log-view-entry-expanded) + ;; If the entry is expanded, collapse it. + (let ((pos (next-single-property-change beg 'log-view-comment))) + (unless (and pos (log-view-inside-comment-p pos)) + (error "Broken markup in `log-view-toggle-entry-display'")) + (delete-region pos + (next-single-property-change pos 'log-view-comment)) + (put-text-property beg (1+ beg) 'log-view-entry-expanded nil) + (if (< opoint pos) + (goto-char opoint))) + ;; Otherwise, expand the entry. + (let ((long-entry (funcall log-view-expanded-log-entry-function + (nth 1 entry)))) + (when long-entry + (put-text-property beg (1+ beg) 'log-view-entry-expanded t) + (log-view-end-of-defun) + (setq beg (point)) + (insert long-entry "\n") + (add-text-properties + beg (point) + '(font-lock-face font-lock-comment-face log-view-comment t)) + (goto-char opoint)))))))) + +(defun log-view-beginning-of-defun (&optional arg) + "Move backward to the beginning of a Log View entry. +With ARG, do it that many times. Negative ARG means move forward +to the beginning of the ARGth following entry. + +This is Log View mode's default `beginning-of-defun-function'. +It assumes that a log entry starts with a line matching +`log-view-message-re'." + (if (or (null arg) (zerop arg)) + (setq arg 1)) + (if (< arg 0) + (dotimes (n (- arg)) + (log-view-end-of-defun)) + (catch 'beginning-of-buffer + (dotimes (n arg) + (or (log-view-current-entry nil t) + (throw 'beginning-of-buffer nil))) + (point)))) (defun log-view-end-of-defun () - ;; The idea in this function is to search for the beginning of the - ;; next log entry using `log-view-message-re' and then go back one - ;; line when finding it. Modes that derive from `log-view-mode' for - ;; which this assumption is not valid will have to provide another - ;; implementation of this function. - - ;; Look back and if there is no entry there it means we are before - ;; the first log entry, so go forward until finding one. - (unless (save-excursion (re-search-backward log-view-message-re nil t)) - (re-search-forward log-view-message-re nil t)) - - ;; In case we are at the end of log entry going forward a line will - ;; make us find the next entry when searching. If we are inside of - ;; an entry going forward a line will still keep the point inside - ;; the same entry. - (forward-line 1) - - ;; In case we are at the beginning of an entry, move past it. - (when (looking-at log-view-message-re) - (goto-char (match-end 0)) - (forward-line 1)) - - ;; Search for the start of the next log entry. Go to the end of the - ;; buffer if we could not find a next entry. - (when (re-search-forward log-view-message-re nil 'move) - (goto-char (match-beginning 0)) - (forward-line -1))) + "Move forward to the next Log View entry." + (let ((looping t)) + (if (looking-at log-view-message-re) + (goto-char (match-end 0))) + (while looping + (cond + ((re-search-forward log-view-message-re nil 'move) + (unless (log-view-inside-comment-p (point)) + (setq looping nil) + (goto-char (match-beginning 0)))) + ;; Don't advance past the end buttons inserted by + ;; `vc-print-log-setup-buttons'. + ((looking-back "Show 2X entries Show unlimited entries") + (setq looping nil) + (forward-line -1)))))) (defvar cvs-minor-current-files) (defvar cvs-branch-prefix) diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 9f86a28a575..5e6e054924c 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -141,12 +141,20 @@ Use the current Bzr root directory as the ROOT argument to (let ((root (vc-find-root file vc-bzr-admin-checkout-format-file))) (when root (vc-file-setprop file 'bzr-root root))))) -(defun vc-bzr--branch-conf (file) - "Return the Bzr branch config for file FILE, as a string." - (with-temp-buffer - (insert-file-contents - (expand-file-name vc-bzr-admin-branchconf (vc-bzr-root file))) - (buffer-string))) +(defun vc-bzr-branch-conf (file) + "Return the Bazaar branch settings for file FILE, as an alist. +Each element of the returned alist has the form (NAME . VALUE), +which are the name and value of a Bazaar setting, as strings. + +The settings are read from the file \".bzr/branch/branch.conf\" +in the repository root directory of FILE." + (let (settings) + (with-temp-buffer + (insert-file-contents + (expand-file-name vc-bzr-admin-branchconf (vc-bzr-root file))) + (while (re-search-forward "^\\([^#=][^=]*?\\) *= *\\(.*\\)$" nil t) + (push (cons (match-string 1) (match-string 2)) settings))) + settings)) (require 'sha1) ;For sha1-program @@ -276,6 +284,13 @@ Use the current Bzr root directory as the ROOT argument to (when rootdir (file-relative-name filename* rootdir)))) +(defvar vc-bzr-error-regex-alist + '(("^\\( M[* ]\\|+N \\|-D \\|\\| \\*\\|R[M ] \\) \\(.+\\)" 2 nil nil 1) + ("^C \\(.+\\)" 2) + ("^Text conflict in \\(.+\\)" 1 nil nil 2) + ("^Using saved parent location: \\(.+\\)" 1 nil nil 0)) + "Value of `compilation-error-regexp-alist' in *vc-bzr* buffers.") + (defun vc-bzr-pull (prompt) "Pull changes into the current Bzr branch. Normally, this runs \"bzr pull\". However, if the branch is a @@ -283,19 +298,18 @@ bound branch, run \"bzr update\" instead. If there is no default location from which to pull or update, or if PROMPT is non-nil, prompt for the Bzr command to run." (let* ((vc-bzr-program vc-bzr-program) - (branch-conf (vc-bzr--branch-conf default-directory)) + (branch-conf (vc-bzr-branch-conf default-directory)) ;; Check whether the branch is bound. - (bound (string-match "^bound\\s-*=\\s-*True" branch-conf)) + (bound (assoc "bound" branch-conf)) + (bound (and bound (equal "true" (downcase (cdr bound))))) ;; If we need to do a "bzr pull", check for a parent. If it ;; does not exist, bzr will need a pull location. - (parent (unless bound - (string-match - "^parent_location\\s-*=\\s-*[^\n[:space:]]+" - branch-conf))) + (has-parent (unless bound + (assoc "parent_location" branch-conf))) (command (if bound "update" "pull")) args) ;; If necessary, prompt for the exact command. - (when (or prompt (not (or bound parent))) + (when (or prompt (not (or bound has-parent))) (setq args (split-string (read-shell-command "Bzr pull command: " @@ -305,28 +319,33 @@ prompt for the Bzr command to run." (setq vc-bzr-program (car args) command (cadr args) args (cddr args))) - (vc-set-async-update - (apply 'vc-bzr-async-command command args)))) + (let ((buf (apply 'vc-bzr-async-command command args))) + (with-current-buffer buf + (vc-exec-after + `(progn + (let ((compilation-error-regexp-alist + vc-bzr-error-regex-alist)) + (compilation-mode)) + (set (make-local-variable 'compilation-error-regexp-alist) + vc-bzr-error-regex-alist)))) + (vc-set-async-update buf)))) (defun vc-bzr-merge-branch () "Merge another Bzr branch into the current one. Prompt for the Bzr command to run, providing a pre-defined merge source (an upstream branch or a previous merge source) as a default if it is available." - (let* ((branch-conf (vc-bzr--branch-conf default-directory)) + (let* ((branch-conf (vc-bzr-branch-conf default-directory)) ;; "bzr merge" without an argument defaults to submit_branch, ;; then parent_location. Extract the specific location and ;; add it explicitly to the command line. + (setting nil) (location (cond - ((string-match - "^submit_branch\\s-*=\\s-*\\(?:file://\\)?\\([^\n[:space:]]+\\)$" - branch-conf) - (match-string 1 branch-conf)) - ((string-match - "^parent_location\\s-*=\\s-*\\(?:file://\\)?\\([^\n[:space:]]+\\)$" - branch-conf) - (match-string 1 branch-conf)))) + ((setq setting (assoc "submit_branch" branch-conf)) + (cdr setting)) + ((setq setting (assoc "parent_location" branch-conf)) + (cdr setting)))) (cmd (split-string (read-shell-command @@ -338,8 +357,16 @@ default if it is available." (vc-bzr-program (car cmd)) (command (cadr cmd)) (args (cddr cmd))) - (vc-set-async-update - (apply 'vc-bzr-async-command command args)))) + (let ((buf (apply 'vc-bzr-async-command command args))) + (with-current-buffer buf + (vc-exec-after + `(progn + (let ((compilation-error-regexp-alist + vc-bzr-error-regex-alist)) + (compilation-mode)) + (set (make-local-variable 'compilation-error-regexp-alist) + vc-bzr-error-regex-alist)))) + (vc-set-async-update buf)))) (defun vc-bzr-status (file) "Return FILE status according to Bzr. @@ -590,6 +617,7 @@ REV non-nil gets an error." (defvar log-view-font-lock-keywords) (defvar log-view-current-tag-function) (defvar log-view-per-file-logs) +(defvar log-view-expanded-log-entry-function) (define-derived-mode vc-bzr-log-view-mode log-view-mode "Bzr-Log-View" (remove-hook 'log-view-mode-hook 'vc-bzr-log-view-mode) ;Deactivate the hack. @@ -600,6 +628,11 @@ REV non-nil gets an error." (if (eq vc-log-view-type 'short) "^ *\\([0-9.]+\\): \\(.*?\\)[ \t]+\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)\\( \\[merge\\]\\)?" "^ *\\(?:revno: \\([0-9.]+\\)\\|merged: .+\\)")) + ;; Allow expanding short log entries + (when (eq vc-log-view-type 'short) + (setq truncate-lines t) + (set (make-local-variable 'log-view-expanded-log-entry-function) + 'vc-bzr-expanded-log-entry)) (set (make-local-variable 'log-view-font-lock-keywords) ;; log-view-font-lock-keywords is careful to use the buffer-local ;; value of log-view-message-re only since Emacs-23. @@ -637,6 +670,16 @@ REV non-nil gets an error." (list vc-bzr-log-switches) vc-bzr-log-switches))))) +(defun vc-bzr-expanded-log-entry (revision) + (with-temp-buffer + (apply 'vc-bzr-command "log" t nil nil + (list (format "-r%s" revision))) + (goto-char (point-min)) + (when (looking-at "^-+\n") + ;; Indent the expanded log entry. + (indent-region (match-end 0) (point-max) 2) + (buffer-substring (match-end 0) (point-max))))) + (defun vc-bzr-log-incoming (buffer remote-location) (apply 'vc-bzr-command "missing" buffer 'async nil (list "--theirs-only" (unless (string= remote-location "") remote-location)))) diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el index c4e0dbfadac..388d4c94a08 100644 --- a/lisp/vc/vc-dispatcher.el +++ b/lisp/vc/vc-dispatcher.el @@ -363,6 +363,7 @@ of a buffer, which is created. ROOT should be the directory in which the command should be run. Display the buffer in some window, but don't select it." (let* ((dir default-directory) + (inhibit-read-only t) window new-window-start) (setq buffer (get-buffer-create buffer)) (if (get-buffer-process buffer) diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index de729c969ae..3b4d0e5f421 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -119,6 +119,27 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." :version "23.1" :group 'vc) +(defcustom vc-git-root-log-format + '("%d%h..: %an %ad %s" + ;; The first shy group matches the characters drawn by --graph. + ;; We use numbered groups because `log-view-message-re' wants the + ;; revision number to be group 1. + "^\\(?:[*/\\| ]+ \\)?\\(?2: ([^)]+)\\)?\\(?1:[0-9a-z]+\\)..: \ +\\(?3:.*?\\)[ \t]+\\(?4:[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)" + ((1 'log-view-message-face) + (2 'change-log-list nil lax) + (3 'change-log-name) + (4 'change-log-date))) + "Git log format for `vc-print-root-log'. +This should be a list (FORMAT REGEXP KEYWORDS), where FORMAT is a +format string (which is passed to \"git log\" via the argument +\"--pretty=tformat:FORMAT\"), REGEXP is a regular expression +matching the resulting Git log output, and KEYWORDS is a list of +`font-lock-keywords' for highlighting the Log View buffer." + :type '(list string string (repeat sexp)) + :group 'vc + :version "24.1") + (defvar vc-git-commits-coding-system 'utf-8 "Default coding system for git commits.") @@ -666,8 +687,10 @@ for the --graph option." (append '("log" "--no-color") (when shortlog - '("--graph" "--decorate" "--date=short" - "--pretty=tformat:%d%h %ad %s" "--abbrev-commit")) + `("--graph" "--decorate" "--date=short" + ,(format "--pretty=tformat:%s" + (car vc-git-root-log-format)) + "--abbrev-commit")) (when limit (list "-n" (format "%s" limit))) (when start-revision (list start-revision)) '("--"))))))) @@ -678,7 +701,8 @@ for the --graph option." buffer 0 nil "log" "--no-color" "--graph" "--decorate" "--date=short" - "--pretty=tformat:%d%h %ad %s" "--abbrev-commit" + (format "--pretty=tformat:%s" (car vc-git-root-log-format)) + "--abbrev-commit" (concat (if (string= remote-location "") "@{upstream}" remote-location) @@ -689,9 +713,10 @@ for the --graph option." (vc-git-command nil 0 nil "fetch") (vc-git-command buffer 0 nil - "log" + "log" "--no-color" "--graph" "--decorate" "--date=short" - "--pretty=tformat:%d%h %ad %s" "--abbrev-commit" + (format "--pretty=tformat:%s" (car vc-git-root-log-format)) + "--abbrev-commit" (concat "HEAD.." (if (string= remote-location "") "@{upstream}" remote-location)))) @@ -700,6 +725,7 @@ for the --graph option." (defvar log-view-file-re) (defvar log-view-font-lock-keywords) (defvar log-view-per-file-logs) +(defvar log-view-expanded-log-entry-function) (define-derived-mode vc-git-log-view-mode log-view-mode "Git-Log-View" (require 'add-log) ;; We need the faces add-log. @@ -708,37 +734,37 @@ for the --graph option." (set (make-local-variable 'log-view-per-file-logs) nil) (set (make-local-variable 'log-view-message-re) (if (not (eq vc-log-view-type 'long)) - "^\\(?:[*/\\| ]+ \\)?\\(?: ([^)]+)\\)?\\([0-9a-z]+\\) \\([-a-z0-9]+\\) \\(.*\\)" + (cadr vc-git-root-log-format) "^commit *\\([0-9a-z]+\\)")) + ;; Allow expanding short log entries + (when (eq vc-log-view-type 'short) + (setq truncate-lines t) + (set (make-local-variable 'log-view-expanded-log-entry-function) + 'vc-git-expanded-log-entry)) (set (make-local-variable 'log-view-font-lock-keywords) (if (not (eq vc-log-view-type 'long)) - '( - ;; Same as log-view-message-re, except that we don't - ;; want the shy group for the tag name. - ("^\\(?:[*/\\| ]+ \\)?\\( ([^)]+)\\)?\\([0-9a-z]+\\) \\([-a-z0-9]+\\) \\(.*\\)" - (1 'highlight nil lax) - (2 'change-log-acknowledgement) - (3 'change-log-date))) - (append - `((,log-view-message-re (1 'change-log-acknowledgement))) - ;; Handle the case: - ;; user: foo@bar - '(("^Author:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)" - (1 'change-log-email)) - ;; Handle the case: - ;; user: FirstName LastName <foo@bar> - ("^Author:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" - (1 'change-log-name) - (2 'change-log-email)) - ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)" - (1 'change-log-name)) - ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" - (1 'change-log-name) - (2 'change-log-email)) - ("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)" - (1 'change-log-acknowledgement) - (2 'change-log-acknowledgement)) - ("^Date: \\(.+\\)" (1 'change-log-date)) + (list (cons (nth 1 vc-git-root-log-format) + (nth 2 vc-git-root-log-format))) + (append + `((,log-view-message-re (1 'change-log-acknowledgement))) + ;; Handle the case: + ;; user: foo@bar + '(("^Author:[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)" + (1 'change-log-email)) + ;; Handle the case: + ;; user: FirstName LastName <foo@bar> + ("^Author:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" + (1 'change-log-name) + (2 'change-log-email)) + ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)" + (1 'change-log-name)) + ("^ +\\(?:\\(?:[Aa]cked\\|[Ss]igned-[Oo]ff\\)-[Bb]y:\\)[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" + (1 'change-log-name) + (2 'change-log-email)) + ("^Merge: \\([0-9a-z]+\\) \\([0-9a-z]+\\)" + (1 'change-log-acknowledgement) + (2 'change-log-acknowledgement)) + ("^Date: \\(.+\\)" (1 'change-log-date)) ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))) @@ -758,6 +784,15 @@ or BRANCH^ (where \"^\" can be repeated)." (t nil)))) (beginning-of-line))) +(defun vc-git-expanded-log-entry (revision) + (with-temp-buffer + (apply 'vc-git-command t nil nil (list "log" revision "-1")) + (goto-char (point-min)) + (unless (eobp) + ;; Indent the expanded log entry. + (indent-region (point-min) (point-max) 2) + (buffer-string)))) + (defun vc-git-diff (files &optional rev1 rev2 buffer) "Get a difference report using Git between two revisions of FILES." (let (process-file-side-effects) diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el index 10348544357..d283c39362a 100644 --- a/lisp/vc/vc-hg.el +++ b/lisp/vc/vc-hg.el @@ -138,6 +138,24 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." "Name of the Mercurial executable (excluding any arguments)." :type 'string :group 'vc) + +(defcustom vc-hg-root-log-format + '("{rev}:{tags}: {author|person} {date|shortdate} {desc|firstline}\\n" + "^\\([0-9]+\\):\\([^:]*\\): \\(.*?\\)[ \t]+\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)" + ((1 'log-view-message-face) + (2 'change-log-list) + (3 'change-log-name) + (4 'change-log-date))) + "Mercurial log template for `vc-print-root-log'. +This should be a list (TEMPLATE REGEXP KEYWORDS), where TEMPLATE +is the \"--template\" argument string to pass to Mercurial, +REGEXP is a regular expression matching the resulting Mercurial +output, and KEYWORDS is a list of `font-lock-keywords' for +highlighting the Log View buffer." + :type '(list string string (repeat sexp)) + :group 'vc + :version "24.1") + ;;; Properties of the backend @@ -266,13 +284,14 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (nconc (when start-revision (list (format "-r%s:" start-revision))) (when limit (list "-l" (format "%s" limit))) - (when shortlog (list "--style" "compact")) + (when shortlog (list "--template" (car vc-hg-root-log-format))) vc-hg-log-switches))))) (defvar log-view-message-re) (defvar log-view-file-re) (defvar log-view-font-lock-keywords) (defvar log-view-per-file-logs) +(defvar log-view-expanded-log-entry-function) (define-derived-mode vc-hg-log-view-mode log-view-mode "Hg-Log-View" (require 'add-log) ;; we need the add-log faces @@ -280,33 +299,34 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (set (make-local-variable 'log-view-per-file-logs) nil) (set (make-local-variable 'log-view-message-re) (if (eq vc-log-view-type 'short) - "^\\([0-9]+\\)\\(\\[.*\\]\\)? +\\([0-9a-z]\\{12\\}\\) +\\(\\(?:[0-9]+\\)-\\(?:[0-9]+\\)-\\(?:[0-9]+\\) \\(?:[0-9]+\\):\\(?:[0-9]+\\) \\(?:[-+0-9]+\\)\\) +\\(.*\\)$" + (cadr vc-hg-root-log-format) "^changeset:[ \t]*\\([0-9]+\\):\\(.+\\)")) + ;; Allow expanding short log entries + (when (eq vc-log-view-type 'short) + (setq truncate-lines t) + (set (make-local-variable 'log-view-expanded-log-entry-function) + 'vc-hg-expanded-log-entry)) (set (make-local-variable 'log-view-font-lock-keywords) (if (eq vc-log-view-type 'short) - (append `((,log-view-message-re - (1 'log-view-message-face) - (2 'highlight nil lax) - (3 'log-view-message-face) - (4 'change-log-date) - (5 'change-log-name)))) - (append - log-view-font-lock-keywords - '( - ;; Handle the case: - ;; user: FirstName LastName <foo@bar> - ("^user:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" - (1 'change-log-name) - (2 'change-log-email)) - ;; Handle the cases: - ;; user: foo@bar - ;; and - ;; user: foo - ("^user:[ \t]+\\([A-Za-z0-9_.+-]+\\(?:@[A-Za-z0-9_.-]+\\)?\\)" - (1 'change-log-email)) - ("^date: \\(.+\\)" (1 'change-log-date)) - ("^tag: +\\([^ ]+\\)$" (1 'highlight)) - ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))) + (list (cons (nth 1 vc-hg-root-log-format) + (nth 2 vc-hg-root-log-format))) + (append + log-view-font-lock-keywords + '( + ;; Handle the case: + ;; user: FirstName LastName <foo@bar> + ("^user:[ \t]+\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.+-]+@[A-Za-z0-9_.-]+\\)[>)]" + (1 'change-log-name) + (2 'change-log-email)) + ;; Handle the cases: + ;; user: foo@bar + ;; and + ;; user: foo + ("^user:[ \t]+\\([A-Za-z0-9_.+-]+\\(?:@[A-Za-z0-9_.-]+\\)?\\)" + (1 'change-log-email)) + ("^date: \\(.+\\)" (1 'change-log-date)) + ("^tag: +\\([^ ]+\\)$" (1 'highlight)) + ("^summary:[ \t]+\\(.+\\)" (1 'log-view-message))))))) (defun vc-hg-diff (files &optional oldvers newvers buffer) "Get a difference report using hg between two revisions of FILES." @@ -324,6 +344,16 @@ If nil, use the value of `vc-diff-switches'. If t, use no switches." (list "-r" oldvers "-r" newvers) (list "-r" oldvers))))))) +(defun vc-hg-expanded-log-entry (revision) + (with-temp-buffer + (vc-hg-command t nil nil "log" "-r" revision) + (goto-char (point-min)) + (unless (eobp) + ;; Indent the expanded log entry. + (indent-region (point-min) (point-max) 2) + (goto-char (point-max)) + (buffer-string)))) + (defun vc-hg-revision-table (files) (let ((default-directory (file-name-directory (car files)))) (with-temp-buffer diff --git a/lisp/vc/vc-svn.el b/lisp/vc/vc-svn.el index aefef50cf79..20c7689f401 100644 --- a/lisp/vc/vc-svn.el +++ b/lisp/vc/vc-svn.el @@ -117,17 +117,13 @@ If you want to force an empty list of arguments, use t." ;;;###autoload (getenv "SVN_ASP_DOT_NET_HACK")) ;;;###autoload "_svn") ;;;###autoload (t ".svn")))) -;;;###autoload (when (file-readable-p (expand-file-name -;;;###autoload (concat admin-dir "/entries") -;;;###autoload (file-name-directory f))) +;;;###autoload (when (vc-find-root f admin-dir) ;;;###autoload (load "vc-svn") ;;;###autoload (vc-svn-registered f)))) (defun vc-svn-registered (file) "Check if FILE is SVN registered." - (when (file-readable-p (expand-file-name (concat vc-svn-admin-directory - "/entries") - (file-name-directory file))) + (when (vc-svn-root file) (with-temp-buffer (cd (file-name-directory file)) (let* (process-file-side-effects @@ -275,14 +271,12 @@ Passes either `vc-svn-register-switches' or `vc-register-switches' to the SVN command." (apply 'vc-svn-command nil 0 files "add" (vc-switches 'SVN 'register))) -(defun vc-svn-responsible-p (file) - "Return non-nil if SVN thinks it is responsible for FILE." - (file-directory-p (expand-file-name vc-svn-admin-directory - (if (file-directory-p file) - file - (file-name-directory file))))) +(defun vc-svn-root (file) + (vc-find-root file vc-svn-admin-directory)) -(defalias 'vc-svn-could-register 'vc-svn-responsible-p +(defalias 'vc-svn-responsible-p 'vc-svn-root) + +(defalias 'vc-svn-could-register 'vc-svn-root "Return non-nil if FILE could be registered in SVN. This is only possible if SVN is responsible for FILE's directory.") @@ -594,20 +588,10 @@ and that it passes `vc-svn-global-switches' to it before FLAGS." (defun vc-svn-repository-hostname (dirname) (with-temp-buffer - (let ((coding-system-for-read - (or file-name-coding-system - default-file-name-coding-system))) - (vc-insert-file (expand-file-name (concat vc-svn-admin-directory - "/entries") - dirname))) + (let (process-file-side-effects) + (vc-svn-command t t dirname "info" "--xml")) (goto-char (point-min)) - (when (re-search-forward - ;; Old `svn' used name="svn:this_dir", newer use just name="". - (concat "name=\"\\(?:svn:this_dir\\)?\"[\n\t ]*" - "\\(?:[-a-z]+=\"[^\"]*\"[\n\t ]*\\)*?" - "url=\"\\(?1:[^\"]+\\)\"" - ;; Yet newer ones don't use XML any more. - "\\|^\ndir\n[0-9]+\n\\(?1:.*\\)") nil t) + (when (re-search-forward "<url>\\(.*\\)</url>" nil t) ;; This is not a hostname but a URL. This may actually be considered ;; as a feature since it allows vc-svn-stay-local to specify different ;; behavior for different modules on the same server. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index be0f568d304..02743847800 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -2014,22 +2014,20 @@ Not all VC backends support short logs!") (goto-char (point-max)) (lexical-let ((working-revision working-revision) (limit limit)) - (widget-create 'push-button - :notify (lambda (&rest ignore) - (vc-print-log-internal - log-view-vc-backend log-view-vc-fileset - working-revision nil (* 2 limit))) - :help-echo "Show the log again, and double the number of log entries shown" - "Show 2X entries") - (widget-insert " ") - (widget-create 'push-button - :notify (lambda (&rest ignore) - (vc-print-log-internal - log-view-vc-backend log-view-vc-fileset - working-revision nil nil)) - :help-echo "Show the log again, showing all entries" - "Show unlimited entries")) - (widget-setup))) + (insert "\n") + (insert-text-button "Show 2X entries" + 'action (lambda (&rest ignore) + (vc-print-log-internal + log-view-vc-backend log-view-vc-fileset + working-revision nil (* 2 limit))) + 'help-echo "Show the log again, and double the number of log entries shown") + (insert " ") + (insert-text-button "Show unlimited entries" + 'action (lambda (&rest ignore) + (vc-print-log-internal + log-view-vc-backend log-view-vc-fileset + working-revision nil nil)) + 'help-echo "Show the log again, including all entries")))) (defun vc-print-log-internal (backend files working-revision &optional is-start-revision limit) @@ -2616,9 +2614,6 @@ log entries should be gathered." (when index (substring rev 0 index)))) -(define-obsolete-function-alias - 'vc-default-previous-version 'vc-default-previous-revision "23.1") - (defun vc-default-responsible-p (backend file) "Indicate whether BACKEND is reponsible for FILE. The default is to return nil always." diff --git a/lwlib/ChangeLog b/lwlib/ChangeLog index 60defac0b18..9a9c1fd3369 100644 --- a/lwlib/ChangeLog +++ b/lwlib/ChangeLog @@ -1,3 +1,36 @@ +2011-02-14 Jan Djärv <jan.h.d@swipnet.se> + + * xlwmenu.h: Remove Xt[CN]faceName and Xt[NC]defaultFace. + + * xlwmenuP.h (_XlwMenu_part): Remove faceName. Add fontName. + + * xlwmenu.c (xlwmenu_default_font): Remove, does not work for + multi-display. + (xlwMenuResources): Remove XtNfaceName and XtNdefaultFace. + Make XtNFont a String resource. + (make_windows_if_needed): Call XFlush so later changes are seen by the + X server. + (remap_menubar): Use XtMoveWidget and then + XtResizeWidget/XtResizeWindow after XtPopup. Works better with + Compiz. + (make_drawing_gcs): Check if mw->menu.font is set. + (getDefaultXftFont): New function. + (openXftFont): faceName is now fontName. Try XLoadQueryFont first + and then XftFontOpenName. + (XlwMenuInitialize): Initialize mw->menu.font with XLoadQueryFont. + (XlwMenuClassInitialize): Remove initialization of + xlwmenu_default_font. + (fontname_changed): Renamed from facename_changed. + (XlwMenuSetValues): Use facename_changed. + + * lwlib-Xaw.c (make_dialog): Use *font even for Xft fonts. Try + XLoadQueryFont first and then Xft fonts. + +2011-02-13 Glenn Morris <rgm@gnu.org> + + * lwlib-utils.c (index, rindex): Don't undef (neither used in lwlib/, + nor set in config.h). + 2011-02-11 Glenn Morris <rgm@gnu.org> * Makefile.in (USE_X_TOOLKIT, RM, TOOLKIT_DEFINES): Remove. diff --git a/lwlib/lwlib-Xaw.c b/lwlib/lwlib-Xaw.c index 19c2440989d..9c9a007bc15 100644 --- a/lwlib/lwlib-Xaw.c +++ b/lwlib/lwlib-Xaw.c @@ -577,13 +577,20 @@ make_dialog (char* name, if (w) { XtResource rec[] = - { { "faceName", "FaceName", XtRString, sizeof(String), 0, XtRString, - (XtPointer)"Sans-14" }}; - char *faceName; - XtVaGetSubresources (dialog, &faceName, "Dialog", "dialog", + { { "font", "Font", XtRString, sizeof(String), 0, XtRString, + (XtPointer)"Sans-10" }}; + char *fontName = NULL; + XtVaGetSubresources (dialog, &fontName, "Dialog", "dialog", rec, 1, (String)NULL); - if (strcmp ("none", faceName) != 0) - xft_font = openFont (dialog, faceName); + if (fontName) + { + XFontStruct *xfn = XLoadQueryFont (XtDisplay (dialog), fontName); + if (!xfn) + xft_font = openFont (dialog, fontName); + else + XFreeFont (XtDisplay (dialog), xfn); + } + if (xft_font) { instance->nr_xft_data = left_buttons + right_buttons + 1; diff --git a/lwlib/lwlib-utils.c b/lwlib/lwlib-utils.c index 7c9a56d2aeb..a3e1cb3b432 100644 --- a/lwlib/lwlib-utils.c +++ b/lwlib/lwlib-utils.c @@ -24,13 +24,6 @@ Boston, MA 02110-1301, USA. */ #include <config.h> #endif -/* Definitions of these in config.h can cause - declaration conflicts later on between declarations for index - and declarations for strchr. This file doesn't use - index and rindex, so cancel them. */ -#undef index -#undef rindex - #include <setjmp.h> #include <lisp.h> diff --git a/lwlib/xlwmenu.c b/lwlib/xlwmenu.c index 065d81e1fde..5b97f2bf999 100644 --- a/lwlib/xlwmenu.c +++ b/lwlib/xlwmenu.c @@ -71,8 +71,6 @@ extern char *gray_bitmap_bits; static int pointer_grabbed; static XEvent menu_post_event; -static XFontStruct *xlwmenu_default_font; - static char xlwMenuTranslations [] = "<BtnDown>: start()\n\ @@ -131,14 +129,12 @@ xlwMenuResources[] = offset(menu.fontSet), XtRFontSet, NULL}, #endif #ifdef HAVE_XFT -#define DEFAULT_FACENAME "Sans-10" - {XtNfaceName, XtCFaceName, XtRString, sizeof(String), - offset(menu.faceName), XtRString, DEFAULT_FACENAME}, - {XtNdefaultFace, XtCDefaultFace, XtRInt, sizeof(int), - offset(menu.default_face), XtRImmediate, (XtPointer)1}, +#define DEFAULT_FONTNAME "Sans-10" +#else +#define DEFAULT_FONTNAME "XtDefaultFont" #endif - {XtNfont, XtCFont, XtRFontStruct, sizeof(XFontStruct *), - offset(menu.font), XtRString, "XtDefaultFont"}, + {XtNfont, XtCFont, XtRString, sizeof(String), + offset(menu.fontName), XtRString, DEFAULT_FONTNAME }, {XtNforeground, XtCForeground, XtRPixel, sizeof(Pixel), offset(menu.foreground), XtRString, "XtDefaultForeground"}, {XtNdisabledForeground, XtCDisabledForeground, XtRPixel, sizeof(Pixel), @@ -1352,6 +1348,7 @@ make_windows_if_needed (XlwMenuWidget mw, int n) #endif set_window_type (windows [i].w, mw); } + XFlush (XtDisplay (mw)); } /* Value is non-zero if WINDOW is part of menu bar widget W. */ @@ -1534,10 +1531,12 @@ remap_menubar (XlwMenuWidget mw) fit_to_screen (mw, ws, previous_ws, mw->menu.horizontal && i == 1); - XtVaSetValues (ws->w, XtNwidth, ws->width, XtNheight, ws->height, - XtNx, ws->x, XtNy, ws->y, NULL); create_pixmap_for_menu (ws, mw); + XtMoveWidget (ws->w, ws->x, ws->y); XtPopup (ws->w, XtGrabNone); + XtResizeWidget (ws->w, ws->width, ws->height, + mw->core.border_width); + XtResizeWindow (ws->w); display_menu (mw, i, False, &selection_position, NULL, NULL); } @@ -1613,14 +1612,17 @@ make_drawing_gcs (XlwMenuWidget mw) XtGCMask mask = GCForeground | GCBackground; #ifdef HAVE_X_I18N - if (!mw->menu.fontSet) + if (!mw->menu.fontSet && mw->menu.font) { xgcv.font = mw->menu.font->fid; mask |= GCFont; } #else - xgcv.font = mw->menu.font->fid; - mask |= GCFont; + if (mw->menu.font) + { + xgcv.font = mw->menu.font->fid; + mask |= GCFont; + } #endif xgcv.foreground = mw->menu.foreground; xgcv.background = mw->core.background_pixel; @@ -1847,13 +1849,20 @@ release_shadow_gcs (XlwMenuWidget mw) } #ifdef HAVE_XFT +static XftFont * +getDefaultXftFont (XlwMenuWidget mw) +{ + int screen = XScreenNumberOfScreen (mw->core.screen); + return XftFontOpenName (XtDisplay (mw), screen, DEFAULT_FONTNAME); +} + static int openXftFont (XlwMenuWidget mw) { - char *fname = mw->menu.faceName; + char *fname = mw->menu.fontName; mw->menu.xft_font = 0; - mw->menu.default_face = fname && strcmp (fname, DEFAULT_FACENAME) == 0; + mw->menu.default_face = fname && strcmp (fname, DEFAULT_FONTNAME) == 0; if (fname && strcmp (fname, "none") != 0) { @@ -1864,20 +1873,23 @@ openXftFont (XlwMenuWidget mw) --i; if (fname[i] == ' ') { - fname = xstrdup (mw->menu.faceName); + fname = xstrdup (mw->menu.fontName); fname[i] = '-'; } - mw->menu.xft_font = XftFontOpenName (XtDisplay (mw), screen, fname); - if (!mw->menu.xft_font) + mw->menu.font = XLoadQueryFont (XtDisplay (mw), fname); + if (!mw->menu.font) { - fprintf (stderr, "Can't find font '%s'\n", fname); - mw->menu.xft_font = XftFontOpenName (XtDisplay (mw), screen, - DEFAULT_FACENAME); + mw->menu.xft_font = XftFontOpenName (XtDisplay (mw), screen, fname); + if (!mw->menu.xft_font) + { + fprintf (stderr, "Can't find font '%s'\n", fname); + mw->menu.xft_font = getDefaultXftFont (mw); + } } } - if (fname != mw->menu.faceName) free (fname); + if (fname != mw->menu.fontName) free (fname); return mw->menu.xft_font != 0; } @@ -1913,19 +1925,19 @@ XlwMenuInitialize (Widget request, Widget w, ArgList args, Cardinal *num_args) ; else #endif - - if (!mw->menu.font) { - if (!xlwmenu_default_font) - xlwmenu_default_font = XLoadQueryFont (display, "fixed"); - mw->menu.font = xlwmenu_default_font; - if (!mw->menu.font) + mw->menu.font = XLoadQueryFont (display, mw->menu.fontName); + if (!mw->menu.font) { - fprintf (stderr, "Menu font fixed not found, can't continue.\n"); - abort (); + mw->menu.font = XLoadQueryFont (display, "fixed"); + if (!mw->menu.font) + { + fprintf (stderr, "Menu font fixed not found, can't continue.\n"); + abort (); + } } } - + #ifdef HAVE_X_I18N if (mw->menu.fontSet) mw->menu.font_extents = XExtentsOfFontSet (mw->menu.fontSet); @@ -1966,7 +1978,6 @@ XlwMenuInitialize (Widget request, Widget w, ArgList args, Cardinal *num_args) static void XlwMenuClassInitialize (void) { - xlwmenu_default_font = 0; } static void @@ -2126,13 +2137,13 @@ XlwMenuDestroy (Widget w) #ifdef HAVE_XFT static int -facename_changed (XlwMenuWidget newmw, +fontname_changed (XlwMenuWidget newmw, XlwMenuWidget oldmw) { - /* This will fore a new XftFont even if the same string is set. + /* This will force a new XftFont even if the same string is set. This is good, as rendering parameters may have changed and we just want to do a redisplay. */ - return newmw->menu.faceName != oldmw->menu.faceName; + return newmw->menu.fontName != oldmw->menu.fontName; } #endif @@ -2158,7 +2169,7 @@ XlwMenuSetValues (Widget current, Widget request, Widget new, if (newmw->core.background_pixel != oldmw->core.background_pixel || newmw->menu.foreground != oldmw->menu.foreground #ifdef HAVE_XFT - || facename_changed (newmw, oldmw) + || fontname_changed (newmw, oldmw) #endif #ifdef HAVE_X_I18N || newmw->menu.fontSet != oldmw->menu.fontSet @@ -2193,7 +2204,7 @@ XlwMenuSetValues (Widget current, Widget request, Widget new, } #ifdef HAVE_XFT - if (facename_changed (newmw, oldmw)) + if (fontname_changed (newmw, oldmw)) { int i; int screen = XScreenNumberOfScreen (newmw->core.screen); diff --git a/lwlib/xlwmenu.h b/lwlib/xlwmenu.h index 1f0f973d7b9..fad2aafb3d7 100644 --- a/lwlib/xlwmenu.h +++ b/lwlib/xlwmenu.h @@ -58,10 +58,6 @@ Boston, MA 02110-1301, USA. */ #define XtCResizeToPreferred "ResizeToPreferred" #define XtNallowResize "allowResize" #define XtCAllowResize "AllowResize" -#define XtNfaceName "faceName" -#define XtCFaceName "FaceName" -#define XtNdefaultFace "defaultFace" -#define XtCDefaultFace "DefaultFace" /* Motif-compatible resource names */ #define XmNshadowThickness "shadowThickness" diff --git a/lwlib/xlwmenuP.h b/lwlib/xlwmenuP.h index b7ea9de54f7..0aca2f8ea89 100644 --- a/lwlib/xlwmenuP.h +++ b/lwlib/xlwmenuP.h @@ -59,11 +59,11 @@ typedef struct _XlwMenu_part XFontSetExtents *font_extents; #endif #ifdef HAVE_XFT - String faceName; int default_face; XftFont* xft_font; XftColor xft_fg, xft_bg, xft_disabled_fg; #endif + String fontName; XFontStruct* font; Pixel foreground; Pixel disabled_foreground; diff --git a/m4/filemode.m4 b/m4/filemode.m4 new file mode 100644 index 00000000000..4147fd01e28 --- /dev/null +++ b/m4/filemode.m4 @@ -0,0 +1,12 @@ +# filemode.m4 serial 7 +dnl Copyright (C) 2002, 2005-2006, 2009-2011 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_FILEMODE], +[ + AC_REQUIRE([AC_STRUCT_ST_DM_MODE]) + AC_LIBOBJ([filemode]) + AC_CHECK_DECLS_ONCE([strmode]) +]) diff --git a/m4/getloadavg.m4 b/m4/getloadavg.m4 new file mode 100644 index 00000000000..e58d29b238f --- /dev/null +++ b/m4/getloadavg.m4 @@ -0,0 +1,158 @@ +# Check for getloadavg. + +# Copyright (C) 1992-1996, 1999-2000, 2002-2003, 2006, 2008-2011 Free Software +# Foundation, Inc. + +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +#serial 2 + +# Autoconf defines AC_FUNC_GETLOADAVG, but that is obsolescent. +# New applications should use gl_GETLOADAVG instead. + +# gl_GETLOADAVG(LIBOBJDIR) +# ------------------------ +AC_DEFUN([gl_GETLOADAVG], +[AC_REQUIRE([gl_STDLIB_H_DEFAULTS]) + +# Persuade glibc <stdlib.h> to declare getloadavg(). +AC_REQUIRE([AC_USE_SYSTEM_EXTENSIONS]) + +# Make sure getloadavg.c is where it belongs, at configure-time. +test -f "$srcdir/$1/getloadavg.c" || + AC_MSG_ERROR([$srcdir/$1/getloadavg.c is missing]) + +gl_save_LIBS=$LIBS + +# getloadvg is present in libc on glibc >= 2.2, MacOS X, FreeBSD >= 2.0, +# NetBSD >= 0.9, OpenBSD >= 2.0, Solaris >= 7. +AC_CHECK_FUNC([getloadavg], [], + [gl_have_func=no + + # Some systems with -lutil have (and need) -lkvm as well, some do not. + # On Solaris, -lkvm requires nlist from -lelf, so check that first + # to get the right answer into the cache. + # For kstat on solaris, we need to test for libelf and libkvm to force the + # definition of SVR4 below. + if test $gl_have_func = no; then + AC_CHECK_LIB([elf], [elf_begin], [LIBS="-lelf $LIBS"]) + AC_CHECK_LIB([kvm], [kvm_open], [LIBS="-lkvm $LIBS"]) + # Check for the 4.4BSD definition of getloadavg. + AC_CHECK_LIB([util], [getloadavg], + [LIBS="-lutil $LIBS" gl_have_func=yes]) + fi + + if test $gl_have_func = no; then + # There is a commonly available library for RS/6000 AIX. + # Since it is not a standard part of AIX, it might be installed locally. + gl_getloadavg_LIBS=$LIBS + LIBS="-L/usr/local/lib $LIBS" + AC_CHECK_LIB([getloadavg], [getloadavg], + [LIBS="-lgetloadavg $LIBS" gl_have_func=yes], + [LIBS=$gl_getloadavg_LIBS]) + fi + + # Set up the replacement function if necessary. + if test $gl_have_func = no; then + AC_LIBOBJ([getloadavg]) + gl_PREREQ_GETLOADAVG + fi]) + +if test "x$gl_save_LIBS" = x; then + GETLOADAVG_LIBS=$LIBS +else + GETLOADAVG_LIBS=`echo "$LIBS" | sed "s!$gl_save_LIBS!!"` +fi +LIBS=$gl_save_LIBS + +AC_SUBST([GETLOADAVG_LIBS])dnl + +# Test whether the system declares getloadavg. Solaris has the function +# but declares it in <sys/loadavg.h>, not <stdlib.h>. +AC_CHECK_HEADERS([sys/loadavg.h]) +if test $ac_cv_header_sys_loadavg_h = yes; then + HAVE_SYS_LOADAVG_H=1 +else + HAVE_SYS_LOADAVG_H=0 +fi +AC_CHECK_DECL([getloadavg], [], [HAVE_DECL_GETLOADAVG=0], + [#if HAVE_SYS_LOADAVG_H + # include <sys/loadavg.h> + #endif + #include <stdlib.h>]) +])# gl_GETLOADAVG + + +# gl_PREREQ_GETLOADAVG +# -------------------- +# Set up the AC_LIBOBJ replacement of `getloadavg'. +AC_DEFUN([gl_PREREQ_GETLOADAVG], +[ +# Figure out what our getloadavg.c needs. + +# Solaris has libkstat which does not require root. +AC_CHECK_LIB([kstat], [kstat_open]) +test $ac_cv_lib_kstat_kstat_open = yes && gl_have_func=yes + +# On HPUX9, an unprivileged user can get load averages this way. +if test $gl_have_func = no; then + AC_CHECK_FUNCS([pstat_getdynamic], [gl_have_func=yes]) +fi + +# AIX has libperfstat which does not require root +if test $gl_have_func = no; then + AC_CHECK_LIB([perfstat], [perfstat_cpu_total]) + test $ac_cv_lib_perfstat_perfstat_cpu_total = yes && gl_have_func=yes +fi + +if test $gl_have_func = no; then + AC_CHECK_HEADER([sys/dg_sys_info.h], + [gl_have_func=yes + AC_DEFINE([DGUX], [1], [Define to 1 for DGUX with <sys/dg_sys_info.h>.]) + AC_CHECK_LIB([dgc], [dg_sys_info])]) +fi + +# We cannot check for <dwarf.h>, because Solaris 2 does not use dwarf (it +# uses stabs), but it is still SVR4. We cannot check for <elf.h> because +# Irix 4.0.5F has the header but not the library. +if test $gl_have_func = no && test "$ac_cv_lib_elf_elf_begin" = yes \ + && test "$ac_cv_lib_kvm_kvm_open" = yes; then + gl_have_func=yes + AC_DEFINE([SVR4], [1], [Define to 1 on System V Release 4.]) +fi + +if test $gl_have_func = no; then + AC_CHECK_HEADER([inq_stats/cpustats.h], + [gl_have_func=yes + AC_DEFINE([UMAX], [1], [Define to 1 for Encore UMAX.]) + AC_DEFINE([UMAX4_3], [1], + [Define to 1 for Encore UMAX 4.3 that has <inq_status/cpustats.h> + instead of <sys/cpustats.h>.])]) +fi + +if test $gl_have_func = no; then + AC_CHECK_HEADER([sys/cpustats.h], + [gl_have_func=yes; AC_DEFINE([UMAX])]) +fi + +if test $gl_have_func = no; then + AC_CHECK_HEADERS([mach/mach.h]) +fi + +AC_CHECK_HEADERS([nlist.h], +[AC_CHECK_MEMBERS([struct nlist.n_un.n_name], + [], [], + [@%:@include <nlist.h>]) + AC_LINK_IFELSE([AC_LANG_PROGRAM([[#include <nlist.h>]], + [[struct nlist x; + #ifdef HAVE_STRUCT_NLIST_N_UN_N_NAME + x.n_un.n_name = ""; + #else + x.n_name = ""; + #endif]])], + [AC_DEFINE([N_NAME_POINTER], [1], + [Define to 1 if the nlist n_name member is a pointer])]) +])dnl +])# gl_PREREQ_GETLOADAVG diff --git a/m4/gl-comp.m4 b/m4/gl-comp.m4 index 4bd213cdbd5..10ec34da386 100644 --- a/m4/gl-comp.m4 +++ b/m4/gl-comp.m4 @@ -28,9 +28,12 @@ AC_DEFUN([gl_EARLY], AC_REQUIRE([AC_PROG_RANLIB]) # Code from module arg-nonnull: # Code from module c++defs: + # Code from module crypto/md5: # Code from module dtoastr: # Code from module extensions: AC_REQUIRE([gl_USE_SYSTEM_EXTENSIONS]) + # Code from module filemode: + # Code from module getloadavg: # Code from module getopt-gnu: # Code from module getopt-posix: # Code from module gettext-h: @@ -41,7 +44,10 @@ AC_DEFUN([gl_EARLY], # Code from module multiarch: # Code from module stdbool: # Code from module stddef: + # Code from module stdint: + # Code from module stdlib: # Code from module strftime: + # Code from module sys_stat: # Code from module time: # Code from module time_r: # Code from module unistd: @@ -66,9 +72,16 @@ AC_DEFUN([gl_INIT], gl_source_base='lib' # Code from module arg-nonnull: # Code from module c++defs: + # Code from module crypto/md5: + gl_MD5 # Code from module dtoastr: AC_REQUIRE([gl_C99_STRTOLD]) # Code from module extensions: + # Code from module filemode: + gl_FILEMODE + # Code from module getloadavg: + gl_GETLOADAVG([$gl_source_base]) + gl_STDLIB_MODULE_INDICATOR([getloadavg]) # Code from module getopt-gnu: gl_FUNC_GETOPT_GNU gl_MODULE_INDICATOR_FOR_TESTS([getopt-gnu]) @@ -90,8 +103,15 @@ AC_DEFUN([gl_INIT], AM_STDBOOL_H # Code from module stddef: gl_STDDEF_H + # Code from module stdint: + gl_STDINT_H + # Code from module stdlib: + gl_STDLIB_H # Code from module strftime: gl_FUNC_GNU_STRFTIME + # Code from module sys_stat: + gl_HEADER_SYS_STAT_H + AC_PROG_MKDIR_P # Code from module time: gl_HEADER_TIME_H # Code from module time_r: @@ -244,8 +264,11 @@ AC_DEFUN([gl_FILE_LIST], [ build-aux/c++defs.h build-aux/warn-on-use.h lib/dtoastr.c + lib/filemode.c + lib/filemode.h lib/ftoastr.c lib/ftoastr.h + lib/getloadavg.c lib/getopt.c lib/getopt.in.h lib/getopt1.c @@ -253,26 +276,39 @@ AC_DEFUN([gl_FILE_LIST], [ lib/gettext.h lib/ignore-value.h lib/intprops.h + lib/md5.c + lib/md5.h lib/mktime-internal.h lib/mktime.c lib/stdbool.in.h lib/stddef.in.h + lib/stdint.in.h + lib/stdlib.in.h lib/strftime.c lib/strftime.h + lib/sys_stat.in.h lib/time.in.h lib/time_r.c lib/unistd.in.h m4/00gnulib.m4 m4/c-strtod.m4 m4/extensions.m4 + m4/filemode.m4 + m4/getloadavg.m4 m4/getopt.m4 m4/gnulib-common.m4 m4/include_next.m4 + m4/longlong.m4 + m4/md5.m4 m4/mktime.m4 m4/multiarch.m4 + m4/st_dm_mode.m4 m4/stdbool.m4 m4/stddef_h.m4 + m4/stdint.m4 + m4/stdlib_h.m4 m4/strftime.m4 + m4/sys_stat_h.m4 m4/time_h.m4 m4/time_r.m4 m4/tm_gmtoff.m4 diff --git a/m4/longlong.m4 b/m4/longlong.m4 new file mode 100644 index 00000000000..aed816cfa5e --- /dev/null +++ b/m4/longlong.m4 @@ -0,0 +1,113 @@ +# longlong.m4 serial 16 +dnl Copyright (C) 1999-2007, 2009-2011 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +dnl From Paul Eggert. + +# Define HAVE_LONG_LONG_INT if 'long long int' works. +# This fixes a bug in Autoconf 2.61, and can be faster +# than what's in Autoconf 2.62 through 2.68. + +# Note: If the type 'long long int' exists but is only 32 bits large +# (as on some very old compilers), HAVE_LONG_LONG_INT will not be +# defined. In this case you can treat 'long long int' like 'long int'. + +AC_DEFUN([AC_TYPE_LONG_LONG_INT], +[ + AC_REQUIRE([AC_TYPE_UNSIGNED_LONG_LONG_INT]) + AC_CACHE_CHECK([for long long int], [ac_cv_type_long_long_int], + [ac_cv_type_long_long_int=yes + if test "x${ac_cv_prog_cc_c99-no}" = xno; then + ac_cv_type_long_long_int=$ac_cv_type_unsigned_long_long_int + if test $ac_cv_type_long_long_int = yes; then + dnl Catch a bug in Tandem NonStop Kernel (OSS) cc -O circa 2004. + dnl If cross compiling, assume the bug is not important, since + dnl nobody cross compiles for this platform as far as we know. + AC_RUN_IFELSE( + [AC_LANG_PROGRAM( + [[@%:@include <limits.h> + @%:@ifndef LLONG_MAX + @%:@ define HALF \ + (1LL << (sizeof (long long int) * CHAR_BIT - 2)) + @%:@ define LLONG_MAX (HALF - 1 + HALF) + @%:@endif]], + [[long long int n = 1; + int i; + for (i = 0; ; i++) + { + long long int m = n << i; + if (m >> i != n) + return 1; + if (LLONG_MAX / 2 < m) + break; + } + return 0;]])], + [], + [ac_cv_type_long_long_int=no], + [:]) + fi + fi]) + if test $ac_cv_type_long_long_int = yes; then + AC_DEFINE([HAVE_LONG_LONG_INT], [1], + [Define to 1 if the system has the type `long long int'.]) + fi +]) + +# Define HAVE_UNSIGNED_LONG_LONG_INT if 'unsigned long long int' works. +# This fixes a bug in Autoconf 2.61, and can be faster +# than what's in Autoconf 2.62 through 2.68. + +# Note: If the type 'unsigned long long int' exists but is only 32 bits +# large (as on some very old compilers), AC_TYPE_UNSIGNED_LONG_LONG_INT +# will not be defined. In this case you can treat 'unsigned long long int' +# like 'unsigned long int'. + +AC_DEFUN([AC_TYPE_UNSIGNED_LONG_LONG_INT], +[ + AC_CACHE_CHECK([for unsigned long long int], + [ac_cv_type_unsigned_long_long_int], + [ac_cv_type_unsigned_long_long_int=yes + if test "x${ac_cv_prog_cc_c99-no}" = xno; then + AC_LINK_IFELSE( + [_AC_TYPE_LONG_LONG_SNIPPET], + [], + [ac_cv_type_unsigned_long_long_int=no]) + fi]) + if test $ac_cv_type_unsigned_long_long_int = yes; then + AC_DEFINE([HAVE_UNSIGNED_LONG_LONG_INT], [1], + [Define to 1 if the system has the type `unsigned long long int'.]) + fi +]) + +# Expands to a C program that can be used to test for simultaneous support +# of 'long long' and 'unsigned long long'. We don't want to say that +# 'long long' is available if 'unsigned long long' is not, or vice versa, +# because too many programs rely on the symmetry between signed and unsigned +# integer types (excluding 'bool'). +AC_DEFUN([_AC_TYPE_LONG_LONG_SNIPPET], +[ + AC_LANG_PROGRAM( + [[/* For now, do not test the preprocessor; as of 2007 there are too many + implementations with broken preprocessors. Perhaps this can + be revisited in 2012. In the meantime, code should not expect + #if to work with literals wider than 32 bits. */ + /* Test literals. */ + long long int ll = 9223372036854775807ll; + long long int nll = -9223372036854775807LL; + unsigned long long int ull = 18446744073709551615ULL; + /* Test constant expressions. */ + typedef int a[((-9223372036854775807LL < 0 && 0 < 9223372036854775807ll) + ? 1 : -1)]; + typedef int b[(18446744073709551615ULL <= (unsigned long long int) -1 + ? 1 : -1)]; + int i = 63;]], + [[/* Test availability of runtime routines for shift and division. */ + long long int llmax = 9223372036854775807ll; + unsigned long long int ullmax = 18446744073709551615ull; + return ((ll << 63) | (ll >> 63) | (ll < i) | (ll > i) + | (llmax / ll) | (llmax % ll) + | (ull << 63) | (ull >> 63) | (ull << i) | (ull >> i) + | (ullmax / ull) | (ullmax % ull));]]) +]) diff --git a/m4/md5.m4 b/m4/md5.m4 new file mode 100644 index 00000000000..ce7671d6cea --- /dev/null +++ b/m4/md5.m4 @@ -0,0 +1,15 @@ +# md5.m4 serial 11 +dnl Copyright (C) 2002-2006, 2008-2011 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_MD5], +[ + AC_LIBOBJ([md5]) + + dnl Prerequisites of lib/md5.c. + AC_REQUIRE([gl_BIGENDIAN]) + AC_REQUIRE([AC_C_INLINE]) + : +]) diff --git a/m4/st_dm_mode.m4 b/m4/st_dm_mode.m4 new file mode 100644 index 00000000000..84f74638f12 --- /dev/null +++ b/m4/st_dm_mode.m4 @@ -0,0 +1,23 @@ +# serial 6 + +# Copyright (C) 1998-1999, 2001, 2009-2011 Free Software Foundation, Inc. +# This file is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# Define HAVE_ST_DM_MODE if struct stat has an st_dm_mode member. + +AC_DEFUN([AC_STRUCT_ST_DM_MODE], + [AC_CACHE_CHECK([for st_dm_mode in struct stat], [ac_cv_struct_st_dm_mode], + [AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[ +#include <sys/types.h> +#include <sys/stat.h>]], [[struct stat s; s.st_dm_mode;]])], + [ac_cv_struct_st_dm_mode=yes], + [ac_cv_struct_st_dm_mode=no])]) + + if test $ac_cv_struct_st_dm_mode = yes; then + AC_DEFINE([HAVE_ST_DM_MODE], [1], + [Define if struct stat has an st_dm_mode member. ]) + fi + ] +) diff --git a/m4/stdint.m4 b/m4/stdint.m4 new file mode 100644 index 00000000000..e7d0d0765a2 --- /dev/null +++ b/m4/stdint.m4 @@ -0,0 +1,479 @@ +# stdint.m4 serial 39 +dnl Copyright (C) 2001-2011 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +dnl From Paul Eggert and Bruno Haible. +dnl Test whether <stdint.h> is supported or must be substituted. + +AC_DEFUN([gl_STDINT_H], +[ + AC_PREREQ([2.59])dnl + + dnl Check for long long int and unsigned long long int. + AC_REQUIRE([AC_TYPE_LONG_LONG_INT]) + if test $ac_cv_type_long_long_int = yes; then + HAVE_LONG_LONG_INT=1 + else + HAVE_LONG_LONG_INT=0 + fi + AC_SUBST([HAVE_LONG_LONG_INT]) + AC_REQUIRE([AC_TYPE_UNSIGNED_LONG_LONG_INT]) + if test $ac_cv_type_unsigned_long_long_int = yes; then + HAVE_UNSIGNED_LONG_LONG_INT=1 + else + HAVE_UNSIGNED_LONG_LONG_INT=0 + fi + AC_SUBST([HAVE_UNSIGNED_LONG_LONG_INT]) + + dnl Check for <wchar.h>, in the same way as gl_WCHAR_H does. + AC_CHECK_HEADERS_ONCE([wchar.h]) + if test $ac_cv_header_wchar_h = yes; then + HAVE_WCHAR_H=1 + else + HAVE_WCHAR_H=0 + fi + AC_SUBST([HAVE_WCHAR_H]) + + dnl Check for <inttypes.h>. + dnl AC_INCLUDES_DEFAULT defines $ac_cv_header_inttypes_h. + if test $ac_cv_header_inttypes_h = yes; then + HAVE_INTTYPES_H=1 + else + HAVE_INTTYPES_H=0 + fi + AC_SUBST([HAVE_INTTYPES_H]) + + dnl Check for <sys/types.h>. + dnl AC_INCLUDES_DEFAULT defines $ac_cv_header_sys_types_h. + if test $ac_cv_header_sys_types_h = yes; then + HAVE_SYS_TYPES_H=1 + else + HAVE_SYS_TYPES_H=0 + fi + AC_SUBST([HAVE_SYS_TYPES_H]) + + gl_CHECK_NEXT_HEADERS([stdint.h]) + if test $ac_cv_header_stdint_h = yes; then + HAVE_STDINT_H=1 + else + HAVE_STDINT_H=0 + fi + AC_SUBST([HAVE_STDINT_H]) + + dnl Now see whether we need a substitute <stdint.h>. + if test $ac_cv_header_stdint_h = yes; then + AC_CACHE_CHECK([whether stdint.h conforms to C99], + [gl_cv_header_working_stdint_h], + [gl_cv_header_working_stdint_h=no + AC_COMPILE_IFELSE([ + AC_LANG_PROGRAM([[ +#define __STDC_LIMIT_MACROS 1 /* to make it work also in C++ mode */ +#define __STDC_CONSTANT_MACROS 1 /* to make it work also in C++ mode */ +#define _GL_JUST_INCLUDE_SYSTEM_STDINT_H 1 /* work if build isn't clean */ +#include <stdint.h> +/* Dragonfly defines WCHAR_MIN, WCHAR_MAX only in <wchar.h>. */ +#if !(defined WCHAR_MIN && defined WCHAR_MAX) +#error "WCHAR_MIN, WCHAR_MAX not defined in <stdint.h>" +#endif +] +gl_STDINT_INCLUDES +[ +#ifdef INT8_MAX +int8_t a1 = INT8_MAX; +int8_t a1min = INT8_MIN; +#endif +#ifdef INT16_MAX +int16_t a2 = INT16_MAX; +int16_t a2min = INT16_MIN; +#endif +#ifdef INT32_MAX +int32_t a3 = INT32_MAX; +int32_t a3min = INT32_MIN; +#endif +#ifdef INT64_MAX +int64_t a4 = INT64_MAX; +int64_t a4min = INT64_MIN; +#endif +#ifdef UINT8_MAX +uint8_t b1 = UINT8_MAX; +#else +typedef int b1[(unsigned char) -1 != 255 ? 1 : -1]; +#endif +#ifdef UINT16_MAX +uint16_t b2 = UINT16_MAX; +#endif +#ifdef UINT32_MAX +uint32_t b3 = UINT32_MAX; +#endif +#ifdef UINT64_MAX +uint64_t b4 = UINT64_MAX; +#endif +int_least8_t c1 = INT8_C (0x7f); +int_least8_t c1max = INT_LEAST8_MAX; +int_least8_t c1min = INT_LEAST8_MIN; +int_least16_t c2 = INT16_C (0x7fff); +int_least16_t c2max = INT_LEAST16_MAX; +int_least16_t c2min = INT_LEAST16_MIN; +int_least32_t c3 = INT32_C (0x7fffffff); +int_least32_t c3max = INT_LEAST32_MAX; +int_least32_t c3min = INT_LEAST32_MIN; +int_least64_t c4 = INT64_C (0x7fffffffffffffff); +int_least64_t c4max = INT_LEAST64_MAX; +int_least64_t c4min = INT_LEAST64_MIN; +uint_least8_t d1 = UINT8_C (0xff); +uint_least8_t d1max = UINT_LEAST8_MAX; +uint_least16_t d2 = UINT16_C (0xffff); +uint_least16_t d2max = UINT_LEAST16_MAX; +uint_least32_t d3 = UINT32_C (0xffffffff); +uint_least32_t d3max = UINT_LEAST32_MAX; +uint_least64_t d4 = UINT64_C (0xffffffffffffffff); +uint_least64_t d4max = UINT_LEAST64_MAX; +int_fast8_t e1 = INT_FAST8_MAX; +int_fast8_t e1min = INT_FAST8_MIN; +int_fast16_t e2 = INT_FAST16_MAX; +int_fast16_t e2min = INT_FAST16_MIN; +int_fast32_t e3 = INT_FAST32_MAX; +int_fast32_t e3min = INT_FAST32_MIN; +int_fast64_t e4 = INT_FAST64_MAX; +int_fast64_t e4min = INT_FAST64_MIN; +uint_fast8_t f1 = UINT_FAST8_MAX; +uint_fast16_t f2 = UINT_FAST16_MAX; +uint_fast32_t f3 = UINT_FAST32_MAX; +uint_fast64_t f4 = UINT_FAST64_MAX; +#ifdef INTPTR_MAX +intptr_t g = INTPTR_MAX; +intptr_t gmin = INTPTR_MIN; +#endif +#ifdef UINTPTR_MAX +uintptr_t h = UINTPTR_MAX; +#endif +intmax_t i = INTMAX_MAX; +uintmax_t j = UINTMAX_MAX; + +#include <limits.h> /* for CHAR_BIT */ +#define TYPE_MINIMUM(t) \ + ((t) ((t) 0 < (t) -1 ? (t) 0 : ~ TYPE_MAXIMUM (t))) +#define TYPE_MAXIMUM(t) \ + ((t) ((t) 0 < (t) -1 \ + ? (t) -1 \ + : ((((t) 1 << (sizeof (t) * CHAR_BIT - 2)) - 1) * 2 + 1))) +struct s { + int check_PTRDIFF: + PTRDIFF_MIN == TYPE_MINIMUM (ptrdiff_t) + && PTRDIFF_MAX == TYPE_MAXIMUM (ptrdiff_t) + ? 1 : -1; + /* Detect bug in FreeBSD 6.0 / ia64. */ + int check_SIG_ATOMIC: + SIG_ATOMIC_MIN == TYPE_MINIMUM (sig_atomic_t) + && SIG_ATOMIC_MAX == TYPE_MAXIMUM (sig_atomic_t) + ? 1 : -1; + int check_SIZE: SIZE_MAX == TYPE_MAXIMUM (size_t) ? 1 : -1; + int check_WCHAR: + WCHAR_MIN == TYPE_MINIMUM (wchar_t) + && WCHAR_MAX == TYPE_MAXIMUM (wchar_t) + ? 1 : -1; + /* Detect bug in mingw. */ + int check_WINT: + WINT_MIN == TYPE_MINIMUM (wint_t) + && WINT_MAX == TYPE_MAXIMUM (wint_t) + ? 1 : -1; + + /* Detect bugs in glibc 2.4 and Solaris 10 stdint.h, among others. */ + int check_UINT8_C: + (-1 < UINT8_C (0)) == (-1 < (uint_least8_t) 0) ? 1 : -1; + int check_UINT16_C: + (-1 < UINT16_C (0)) == (-1 < (uint_least16_t) 0) ? 1 : -1; + + /* Detect bugs in OpenBSD 3.9 stdint.h. */ +#ifdef UINT8_MAX + int check_uint8: (uint8_t) -1 == UINT8_MAX ? 1 : -1; +#endif +#ifdef UINT16_MAX + int check_uint16: (uint16_t) -1 == UINT16_MAX ? 1 : -1; +#endif +#ifdef UINT32_MAX + int check_uint32: (uint32_t) -1 == UINT32_MAX ? 1 : -1; +#endif +#ifdef UINT64_MAX + int check_uint64: (uint64_t) -1 == UINT64_MAX ? 1 : -1; +#endif + int check_uint_least8: (uint_least8_t) -1 == UINT_LEAST8_MAX ? 1 : -1; + int check_uint_least16: (uint_least16_t) -1 == UINT_LEAST16_MAX ? 1 : -1; + int check_uint_least32: (uint_least32_t) -1 == UINT_LEAST32_MAX ? 1 : -1; + int check_uint_least64: (uint_least64_t) -1 == UINT_LEAST64_MAX ? 1 : -1; + int check_uint_fast8: (uint_fast8_t) -1 == UINT_FAST8_MAX ? 1 : -1; + int check_uint_fast16: (uint_fast16_t) -1 == UINT_FAST16_MAX ? 1 : -1; + int check_uint_fast32: (uint_fast32_t) -1 == UINT_FAST32_MAX ? 1 : -1; + int check_uint_fast64: (uint_fast64_t) -1 == UINT_FAST64_MAX ? 1 : -1; + int check_uintptr: (uintptr_t) -1 == UINTPTR_MAX ? 1 : -1; + int check_uintmax: (uintmax_t) -1 == UINTMAX_MAX ? 1 : -1; + int check_size: (size_t) -1 == SIZE_MAX ? 1 : -1; +}; + ]])], + [dnl Determine whether the various *_MIN, *_MAX macros are usable + dnl in preprocessor expression. We could do it by compiling a test + dnl program for each of these macros. It is faster to run a program + dnl that inspects the macro expansion. + dnl This detects a bug on HP-UX 11.23/ia64. + AC_RUN_IFELSE([ + AC_LANG_PROGRAM([[ +#define __STDC_LIMIT_MACROS 1 /* to make it work also in C++ mode */ +#define __STDC_CONSTANT_MACROS 1 /* to make it work also in C++ mode */ +#define _GL_JUST_INCLUDE_SYSTEM_STDINT_H 1 /* work if build isn't clean */ +#include <stdint.h> +] +gl_STDINT_INCLUDES +[ +#include <stdio.h> +#include <string.h> +#define MVAL(macro) MVAL1(macro) +#define MVAL1(expression) #expression +static const char *macro_values[] = + { +#ifdef INT8_MAX + MVAL (INT8_MAX), +#endif +#ifdef INT16_MAX + MVAL (INT16_MAX), +#endif +#ifdef INT32_MAX + MVAL (INT32_MAX), +#endif +#ifdef INT64_MAX + MVAL (INT64_MAX), +#endif +#ifdef UINT8_MAX + MVAL (UINT8_MAX), +#endif +#ifdef UINT16_MAX + MVAL (UINT16_MAX), +#endif +#ifdef UINT32_MAX + MVAL (UINT32_MAX), +#endif +#ifdef UINT64_MAX + MVAL (UINT64_MAX), +#endif + NULL + }; +]], [[ + const char **mv; + for (mv = macro_values; *mv != NULL; mv++) + { + const char *value = *mv; + /* Test whether it looks like a cast expression. */ + if (strncmp (value, "((unsigned int)"/*)*/, 15) == 0 + || strncmp (value, "((unsigned short)"/*)*/, 17) == 0 + || strncmp (value, "((unsigned char)"/*)*/, 16) == 0 + || strncmp (value, "((int)"/*)*/, 6) == 0 + || strncmp (value, "((signed short)"/*)*/, 15) == 0 + || strncmp (value, "((signed char)"/*)*/, 14) == 0) + return mv - macro_values + 1; + } + return 0; +]])], + [gl_cv_header_working_stdint_h=yes], + [], + [dnl When cross-compiling, assume it works. + gl_cv_header_working_stdint_h=yes + ]) + ]) + ]) + fi + if test "$gl_cv_header_working_stdint_h" = yes; then + STDINT_H= + else + dnl Check for <sys/inttypes.h>, and for + dnl <sys/bitypes.h> (used in Linux libc4 >= 4.6.7 and libc5). + AC_CHECK_HEADERS([sys/inttypes.h sys/bitypes.h]) + if test $ac_cv_header_sys_inttypes_h = yes; then + HAVE_SYS_INTTYPES_H=1 + else + HAVE_SYS_INTTYPES_H=0 + fi + AC_SUBST([HAVE_SYS_INTTYPES_H]) + if test $ac_cv_header_sys_bitypes_h = yes; then + HAVE_SYS_BITYPES_H=1 + else + HAVE_SYS_BITYPES_H=0 + fi + AC_SUBST([HAVE_SYS_BITYPES_H]) + + gl_STDINT_TYPE_PROPERTIES + STDINT_H=stdint.h + fi + AC_SUBST([STDINT_H]) +]) + +dnl gl_STDINT_BITSIZEOF(TYPES, INCLUDES) +dnl Determine the size of each of the given types in bits. +AC_DEFUN([gl_STDINT_BITSIZEOF], +[ + dnl Use a shell loop, to avoid bloating configure, and + dnl - extra AH_TEMPLATE calls, so that autoheader knows what to put into + dnl config.h.in, + dnl - extra AC_SUBST calls, so that the right substitutions are made. + m4_foreach_w([gltype], [$1], + [AH_TEMPLATE([BITSIZEOF_]m4_translit(gltype,[abcdefghijklmnopqrstuvwxyz ],[ABCDEFGHIJKLMNOPQRSTUVWXYZ_]), + [Define to the number of bits in type ']gltype['.])]) + for gltype in $1 ; do + AC_CACHE_CHECK([for bit size of $gltype], [gl_cv_bitsizeof_${gltype}], + [AC_COMPUTE_INT([result], [sizeof ($gltype) * CHAR_BIT], + [$2 +#include <limits.h>], [result=unknown]) + eval gl_cv_bitsizeof_${gltype}=\$result + ]) + eval result=\$gl_cv_bitsizeof_${gltype} + if test $result = unknown; then + dnl Use a nonempty default, because some compilers, such as IRIX 5 cc, + dnl do a syntax check even on unused #if conditions and give an error + dnl on valid C code like this: + dnl #if 0 + dnl # if > 32 + dnl # endif + dnl #endif + result=0 + fi + GLTYPE=`echo "$gltype" | tr 'abcdefghijklmnopqrstuvwxyz ' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_'` + AC_DEFINE_UNQUOTED([BITSIZEOF_${GLTYPE}], [$result]) + eval BITSIZEOF_${GLTYPE}=\$result + done + m4_foreach_w([gltype], [$1], + [AC_SUBST([BITSIZEOF_]m4_translit(gltype,[abcdefghijklmnopqrstuvwxyz ],[ABCDEFGHIJKLMNOPQRSTUVWXYZ_]))]) +]) + +dnl gl_CHECK_TYPES_SIGNED(TYPES, INCLUDES) +dnl Determine the signedness of each of the given types. +dnl Define HAVE_SIGNED_TYPE if type is signed. +AC_DEFUN([gl_CHECK_TYPES_SIGNED], +[ + dnl Use a shell loop, to avoid bloating configure, and + dnl - extra AH_TEMPLATE calls, so that autoheader knows what to put into + dnl config.h.in, + dnl - extra AC_SUBST calls, so that the right substitutions are made. + m4_foreach_w([gltype], [$1], + [AH_TEMPLATE([HAVE_SIGNED_]m4_translit(gltype,[abcdefghijklmnopqrstuvwxyz ],[ABCDEFGHIJKLMNOPQRSTUVWXYZ_]), + [Define to 1 if ']gltype[' is a signed integer type.])]) + for gltype in $1 ; do + AC_CACHE_CHECK([whether $gltype is signed], [gl_cv_type_${gltype}_signed], + [AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([$2[ + int verify[2 * (($gltype) -1 < ($gltype) 0) - 1];]])], + result=yes, result=no) + eval gl_cv_type_${gltype}_signed=\$result + ]) + eval result=\$gl_cv_type_${gltype}_signed + GLTYPE=`echo $gltype | tr 'abcdefghijklmnopqrstuvwxyz ' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_'` + if test "$result" = yes; then + AC_DEFINE_UNQUOTED([HAVE_SIGNED_${GLTYPE}], [1]) + eval HAVE_SIGNED_${GLTYPE}=1 + else + eval HAVE_SIGNED_${GLTYPE}=0 + fi + done + m4_foreach_w([gltype], [$1], + [AC_SUBST([HAVE_SIGNED_]m4_translit(gltype,[abcdefghijklmnopqrstuvwxyz ],[ABCDEFGHIJKLMNOPQRSTUVWXYZ_]))]) +]) + +dnl gl_INTEGER_TYPE_SUFFIX(TYPES, INCLUDES) +dnl Determine the suffix to use for integer constants of the given types. +dnl Define t_SUFFIX for each such type. +AC_DEFUN([gl_INTEGER_TYPE_SUFFIX], +[ + dnl Use a shell loop, to avoid bloating configure, and + dnl - extra AH_TEMPLATE calls, so that autoheader knows what to put into + dnl config.h.in, + dnl - extra AC_SUBST calls, so that the right substitutions are made. + m4_foreach_w([gltype], [$1], + [AH_TEMPLATE(m4_translit(gltype,[abcdefghijklmnopqrstuvwxyz ],[ABCDEFGHIJKLMNOPQRSTUVWXYZ_])[_SUFFIX], + [Define to l, ll, u, ul, ull, etc., as suitable for + constants of type ']gltype['.])]) + for gltype in $1 ; do + AC_CACHE_CHECK([for $gltype integer literal suffix], + [gl_cv_type_${gltype}_suffix], + [eval gl_cv_type_${gltype}_suffix=no + eval result=\$gl_cv_type_${gltype}_signed + if test "$result" = yes; then + glsufu= + else + glsufu=u + fi + for glsuf in "$glsufu" ${glsufu}l ${glsufu}ll ${glsufu}i64; do + case $glsuf in + '') gltype1='int';; + l) gltype1='long int';; + ll) gltype1='long long int';; + i64) gltype1='__int64';; + u) gltype1='unsigned int';; + ul) gltype1='unsigned long int';; + ull) gltype1='unsigned long long int';; + ui64)gltype1='unsigned __int64';; + esac + AC_COMPILE_IFELSE( + [AC_LANG_PROGRAM([$2[ + extern $gltype foo; + extern $gltype1 foo;]])], + [eval gl_cv_type_${gltype}_suffix=\$glsuf]) + eval result=\$gl_cv_type_${gltype}_suffix + test "$result" != no && break + done]) + GLTYPE=`echo $gltype | tr 'abcdefghijklmnopqrstuvwxyz ' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_'` + eval result=\$gl_cv_type_${gltype}_suffix + test "$result" = no && result= + eval ${GLTYPE}_SUFFIX=\$result + AC_DEFINE_UNQUOTED([${GLTYPE}_SUFFIX], [$result]) + done + m4_foreach_w([gltype], [$1], + [AC_SUBST(m4_translit(gltype,[abcdefghijklmnopqrstuvwxyz ],[ABCDEFGHIJKLMNOPQRSTUVWXYZ_])[_SUFFIX])]) +]) + +dnl gl_STDINT_INCLUDES +AC_DEFUN([gl_STDINT_INCLUDES], +[[ + /* BSD/OS 4.0.1 has a bug: <stddef.h>, <stdio.h> and <time.h> must be + included before <wchar.h>. */ + #include <stddef.h> + #include <signal.h> + #if HAVE_WCHAR_H + # include <stdio.h> + # include <time.h> + # include <wchar.h> + #endif +]]) + +dnl gl_STDINT_TYPE_PROPERTIES +dnl Compute HAVE_SIGNED_t, BITSIZEOF_t and t_SUFFIX, for all the types t +dnl of interest to stdint.in.h. +AC_DEFUN([gl_STDINT_TYPE_PROPERTIES], +[ + AC_REQUIRE([gl_MULTIARCH]) + if test $APPLE_UNIVERSAL_BUILD = 0; then + gl_STDINT_BITSIZEOF([ptrdiff_t size_t], + [gl_STDINT_INCLUDES]) + fi + gl_STDINT_BITSIZEOF([sig_atomic_t wchar_t wint_t], + [gl_STDINT_INCLUDES]) + gl_CHECK_TYPES_SIGNED([sig_atomic_t wchar_t wint_t], + [gl_STDINT_INCLUDES]) + gl_cv_type_ptrdiff_t_signed=yes + gl_cv_type_size_t_signed=no + if test $APPLE_UNIVERSAL_BUILD = 0; then + gl_INTEGER_TYPE_SUFFIX([ptrdiff_t size_t], + [gl_STDINT_INCLUDES]) + fi + gl_INTEGER_TYPE_SUFFIX([sig_atomic_t wchar_t wint_t], + [gl_STDINT_INCLUDES]) +]) + +dnl Autoconf >= 2.61 has AC_COMPUTE_INT built-in. +dnl Remove this when we can assume autoconf >= 2.61. +m4_ifdef([AC_COMPUTE_INT], [], [ + AC_DEFUN([AC_COMPUTE_INT], [_AC_COMPUTE_INT([$2],[$1],[$3],[$4])]) +]) + +# Hey Emacs! +# Local Variables: +# indent-tabs-mode: nil +# End: diff --git a/m4/stdlib_h.m4 b/m4/stdlib_h.m4 new file mode 100644 index 00000000000..d28b552e905 --- /dev/null +++ b/m4/stdlib_h.m4 @@ -0,0 +1,101 @@ +# stdlib_h.m4 serial 36 +dnl Copyright (C) 2007-2011 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +AC_DEFUN([gl_STDLIB_H], +[ + AC_REQUIRE([gl_STDLIB_H_DEFAULTS]) + gl_NEXT_HEADERS([stdlib.h]) + + dnl Check for declarations of anything we want to poison if the + dnl corresponding gnulib module is not in use, and which is not + dnl guaranteed by C89. + gl_WARN_ON_USE_PREPARE([[#include <stdlib.h> +#if HAVE_SYS_LOADAVG_H +# include <sys/loadavg.h> +#endif +#if HAVE_RANDOM_H +# include <random.h> +#endif + ]], [_Exit atoll canonicalize_file_name getloadavg getsubopt grantpt mkdtemp + mkostemp mkostemps mkstemp mkstemps ptsname random_r initstat_r srandom_r + setstate_r realpath rpmatch setenv strtod strtoll strtoull unlockpt + unsetenv]) +]) + +AC_DEFUN([gl_STDLIB_MODULE_INDICATOR], +[ + dnl Use AC_REQUIRE here, so that the default settings are expanded once only. + AC_REQUIRE([gl_STDLIB_H_DEFAULTS]) + gl_MODULE_INDICATOR_SET_VARIABLE([$1]) + dnl Define it also as a C macro, for the benefit of the unit tests. + gl_MODULE_INDICATOR_FOR_TESTS([$1]) +]) + +AC_DEFUN([gl_STDLIB_H_DEFAULTS], +[ + GNULIB__EXIT=0; AC_SUBST([GNULIB__EXIT]) + GNULIB_ATOLL=0; AC_SUBST([GNULIB_ATOLL]) + GNULIB_CALLOC_POSIX=0; AC_SUBST([GNULIB_CALLOC_POSIX]) + GNULIB_CANONICALIZE_FILE_NAME=0; AC_SUBST([GNULIB_CANONICALIZE_FILE_NAME]) + GNULIB_GETLOADAVG=0; AC_SUBST([GNULIB_GETLOADAVG]) + GNULIB_GETSUBOPT=0; AC_SUBST([GNULIB_GETSUBOPT]) + GNULIB_GRANTPT=0; AC_SUBST([GNULIB_GRANTPT]) + GNULIB_MALLOC_POSIX=0; AC_SUBST([GNULIB_MALLOC_POSIX]) + GNULIB_MKDTEMP=0; AC_SUBST([GNULIB_MKDTEMP]) + GNULIB_MKOSTEMP=0; AC_SUBST([GNULIB_MKOSTEMP]) + GNULIB_MKOSTEMPS=0; AC_SUBST([GNULIB_MKOSTEMPS]) + GNULIB_MKSTEMP=0; AC_SUBST([GNULIB_MKSTEMP]) + GNULIB_MKSTEMPS=0; AC_SUBST([GNULIB_MKSTEMPS]) + GNULIB_PTSNAME=0; AC_SUBST([GNULIB_PTSNAME]) + GNULIB_PUTENV=0; AC_SUBST([GNULIB_PUTENV]) + GNULIB_RANDOM_R=0; AC_SUBST([GNULIB_RANDOM_R]) + GNULIB_REALLOC_POSIX=0; AC_SUBST([GNULIB_REALLOC_POSIX]) + GNULIB_REALPATH=0; AC_SUBST([GNULIB_REALPATH]) + GNULIB_RPMATCH=0; AC_SUBST([GNULIB_RPMATCH]) + GNULIB_SETENV=0; AC_SUBST([GNULIB_SETENV]) + GNULIB_STRTOD=0; AC_SUBST([GNULIB_STRTOD]) + GNULIB_STRTOLL=0; AC_SUBST([GNULIB_STRTOLL]) + GNULIB_STRTOULL=0; AC_SUBST([GNULIB_STRTOULL]) + GNULIB_SYSTEM_POSIX=0; AC_SUBST([GNULIB_SYSTEM_POSIX]) + GNULIB_UNLOCKPT=0; AC_SUBST([GNULIB_UNLOCKPT]) + GNULIB_UNSETENV=0; AC_SUBST([GNULIB_UNSETENV]) + dnl Assume proper GNU behavior unless another module says otherwise. + HAVE__EXIT=1; AC_SUBST([HAVE__EXIT]) + HAVE_ATOLL=1; AC_SUBST([HAVE_ATOLL]) + HAVE_CANONICALIZE_FILE_NAME=1; AC_SUBST([HAVE_CANONICALIZE_FILE_NAME]) + HAVE_DECL_GETLOADAVG=1; AC_SUBST([HAVE_DECL_GETLOADAVG]) + HAVE_GETSUBOPT=1; AC_SUBST([HAVE_GETSUBOPT]) + HAVE_GRANTPT=1; AC_SUBST([HAVE_GRANTPT]) + HAVE_MKDTEMP=1; AC_SUBST([HAVE_MKDTEMP]) + HAVE_MKOSTEMP=1; AC_SUBST([HAVE_MKOSTEMP]) + HAVE_MKOSTEMPS=1; AC_SUBST([HAVE_MKOSTEMPS]) + HAVE_MKSTEMP=1; AC_SUBST([HAVE_MKSTEMP]) + HAVE_MKSTEMPS=1; AC_SUBST([HAVE_MKSTEMPS]) + HAVE_PTSNAME=1; AC_SUBST([HAVE_PTSNAME]) + HAVE_RANDOM_H=1; AC_SUBST([HAVE_RANDOM_H]) + HAVE_RANDOM_R=1; AC_SUBST([HAVE_RANDOM_R]) + HAVE_REALPATH=1; AC_SUBST([HAVE_REALPATH]) + HAVE_RPMATCH=1; AC_SUBST([HAVE_RPMATCH]) + HAVE_SETENV=1; AC_SUBST([HAVE_SETENV]) + HAVE_DECL_SETENV=1; AC_SUBST([HAVE_DECL_SETENV]) + HAVE_STRTOD=1; AC_SUBST([HAVE_STRTOD]) + HAVE_STRTOLL=1; AC_SUBST([HAVE_STRTOLL]) + HAVE_STRTOULL=1; AC_SUBST([HAVE_STRTOULL]) + HAVE_STRUCT_RANDOM_DATA=1; AC_SUBST([HAVE_STRUCT_RANDOM_DATA]) + HAVE_SYS_LOADAVG_H=0; AC_SUBST([HAVE_SYS_LOADAVG_H]) + HAVE_UNLOCKPT=1; AC_SUBST([HAVE_UNLOCKPT]) + HAVE_DECL_UNSETENV=1; AC_SUBST([HAVE_DECL_UNSETENV]) + REPLACE_CALLOC=0; AC_SUBST([REPLACE_CALLOC]) + REPLACE_CANONICALIZE_FILE_NAME=0; AC_SUBST([REPLACE_CANONICALIZE_FILE_NAME]) + REPLACE_MALLOC=0; AC_SUBST([REPLACE_MALLOC]) + REPLACE_MKSTEMP=0; AC_SUBST([REPLACE_MKSTEMP]) + REPLACE_PUTENV=0; AC_SUBST([REPLACE_PUTENV]) + REPLACE_REALLOC=0; AC_SUBST([REPLACE_REALLOC]) + REPLACE_REALPATH=0; AC_SUBST([REPLACE_REALPATH]) + REPLACE_SETENV=0; AC_SUBST([REPLACE_SETENV]) + REPLACE_STRTOD=0; AC_SUBST([REPLACE_STRTOD]) + REPLACE_UNSETENV=0; AC_SUBST([REPLACE_UNSETENV]) +]) diff --git a/m4/sys_stat_h.m4 b/m4/sys_stat_h.m4 new file mode 100644 index 00000000000..fc419129e98 --- /dev/null +++ b/m4/sys_stat_h.m4 @@ -0,0 +1,82 @@ +# sys_stat_h.m4 serial 24 -*- Autoconf -*- +dnl Copyright (C) 2006-2011 Free Software Foundation, Inc. +dnl This file is free software; the Free Software Foundation +dnl gives unlimited permission to copy and/or distribute it, +dnl with or without modifications, as long as this notice is preserved. + +dnl From Eric Blake. +dnl Provide a GNU-like <sys/stat.h>. + +AC_DEFUN([gl_HEADER_SYS_STAT_H], +[ + AC_REQUIRE([gl_SYS_STAT_H_DEFAULTS]) + + dnl For the mkdir substitute. + AC_REQUIRE([AC_C_INLINE]) + + dnl Check for broken stat macros. + AC_REQUIRE([AC_HEADER_STAT]) + + gl_CHECK_NEXT_HEADERS([sys/stat.h]) + + dnl Define types that are supposed to be defined in <sys/types.h> or + dnl <sys/stat.h>. + AC_CHECK_TYPE([nlink_t], [], + [AC_DEFINE([nlink_t], [int], + [Define to the type of st_nlink in struct stat, or a supertype.])], + [#include <sys/types.h> + #include <sys/stat.h>]) + + dnl Check for declarations of anything we want to poison if the + dnl corresponding gnulib module is not in use. + gl_WARN_ON_USE_PREPARE([[#include <sys/stat.h> + ]], [fchmodat fstatat futimens lchmod lstat mkdirat mkfifo mkfifoat + mknod mknodat stat utimensat]) +]) # gl_HEADER_SYS_STAT_H + +AC_DEFUN([gl_SYS_STAT_MODULE_INDICATOR], +[ + dnl Use AC_REQUIRE here, so that the default settings are expanded once only. + AC_REQUIRE([gl_SYS_STAT_H_DEFAULTS]) + gl_MODULE_INDICATOR_SET_VARIABLE([$1]) + dnl Define it also as a C macro, for the benefit of the unit tests. + gl_MODULE_INDICATOR_FOR_TESTS([$1]) +]) + +AC_DEFUN([gl_SYS_STAT_H_DEFAULTS], +[ + AC_REQUIRE([gl_UNISTD_H_DEFAULTS]) dnl for REPLACE_FCHDIR + GNULIB_FCHMODAT=0; AC_SUBST([GNULIB_FCHMODAT]) + GNULIB_FSTATAT=0; AC_SUBST([GNULIB_FSTATAT]) + GNULIB_FUTIMENS=0; AC_SUBST([GNULIB_FUTIMENS]) + GNULIB_LCHMOD=0; AC_SUBST([GNULIB_LCHMOD]) + GNULIB_LSTAT=0; AC_SUBST([GNULIB_LSTAT]) + GNULIB_MKDIRAT=0; AC_SUBST([GNULIB_MKDIRAT]) + GNULIB_MKFIFO=0; AC_SUBST([GNULIB_MKFIFO]) + GNULIB_MKFIFOAT=0; AC_SUBST([GNULIB_MKFIFOAT]) + GNULIB_MKNOD=0; AC_SUBST([GNULIB_MKNOD]) + GNULIB_MKNODAT=0; AC_SUBST([GNULIB_MKNODAT]) + GNULIB_STAT=0; AC_SUBST([GNULIB_STAT]) + GNULIB_UTIMENSAT=0; AC_SUBST([GNULIB_UTIMENSAT]) + dnl Assume proper GNU behavior unless another module says otherwise. + HAVE_FCHMODAT=1; AC_SUBST([HAVE_FCHMODAT]) + HAVE_FSTATAT=1; AC_SUBST([HAVE_FSTATAT]) + HAVE_FUTIMENS=1; AC_SUBST([HAVE_FUTIMENS]) + HAVE_LCHMOD=1; AC_SUBST([HAVE_LCHMOD]) + HAVE_LSTAT=1; AC_SUBST([HAVE_LSTAT]) + HAVE_MKDIRAT=1; AC_SUBST([HAVE_MKDIRAT]) + HAVE_MKFIFO=1; AC_SUBST([HAVE_MKFIFO]) + HAVE_MKFIFOAT=1; AC_SUBST([HAVE_MKFIFOAT]) + HAVE_MKNOD=1; AC_SUBST([HAVE_MKNOD]) + HAVE_MKNODAT=1; AC_SUBST([HAVE_MKNODAT]) + HAVE_UTIMENSAT=1; AC_SUBST([HAVE_UTIMENSAT]) + REPLACE_FSTAT=0; AC_SUBST([REPLACE_FSTAT]) + REPLACE_FSTATAT=0; AC_SUBST([REPLACE_FSTATAT]) + REPLACE_FUTIMENS=0; AC_SUBST([REPLACE_FUTIMENS]) + REPLACE_LSTAT=0; AC_SUBST([REPLACE_LSTAT]) + REPLACE_MKDIR=0; AC_SUBST([REPLACE_MKDIR]) + REPLACE_MKFIFO=0; AC_SUBST([REPLACE_MKFIFO]) + REPLACE_MKNOD=0; AC_SUBST([REPLACE_MKNOD]) + REPLACE_STAT=0; AC_SUBST([REPLACE_STAT]) + REPLACE_UTIMENSAT=0; AC_SUBST([REPLACE_UTIMENSAT]) +]) diff --git a/make-dist b/make-dist index 37e0fb3e641..ee0efb04c3a 100755 --- a/make-dist +++ b/make-dist @@ -359,7 +359,7 @@ echo "Making links to \`src'" ln makefile.w32-in ../${tempdir}/src ln .gdbinit .dbxinit ../${tempdir}/src cd ../${tempdir}/src - rm -f config.h epaths.h Makefile buildobj.h) + rm -f globals.h config.h epaths.h Makefile buildobj.h) echo "Making links to \`src/bitmaps'" (cd src/bitmaps diff --git a/msdos/ChangeLog b/msdos/ChangeLog index b9b829c4554..f1cdf510a06 100644 --- a/msdos/ChangeLog +++ b/msdos/ChangeLog @@ -1,3 +1,50 @@ +2011-02-19 Eli Zaretskii <eliz@gnu.org> + + * depfiles.bat: New file. + + * sedlibmk.inp: New file. + + * sedlibcf.inp: New file. + + * sedleim.inp (RUN_EMACS): Rename from RUN-EMACS. + (BUILT_EMACS): Rename from BUILT-EMACS. + + * sed6.inp (MAKEINFO): Edit to "makeinfo". + (ENVADD): Adjust to MAKEINFO_OPTS. + (texinputdir): Don't edit. + + * sed3v2.inp (-DVERSION): Edit out. + (LOADLIBES): Don't edit to empty. + + * sed2v2.inp: Remove workaround for the "#if ! HAVE_MKTIME || + BROKEN_MKTIME" stuff -- it's no longer in src/config.in. + (HAVE_ATTRIBUTE_ALIGNED, HAVE_C99_STRTOLD, HAVE_DECL_GETENV) + (HAVE__BOOL): Edit to 1. + (VERSION, inline, restrict): Edit for DJGPP. + (my_strftime): Edit to nstrftime. + + * sed1v2.inp (NS_OBJC_OBJ): Edit to empty. + (@true): Edit to "@rem". + (move-if-change): Edit to "update". + (echo): Edit to "djecho". + (cd $(lib) && ...): Edit to "$(MAKE) -C ...". + (LIBOBJS): Edit to empty. + ($(libsrc)/make-docfile): Two new edits, one each for every + invocation of make-docfile. + (move-if-change): Fix edit. + Remove some unused switches from $(ALL_CFLAGS), to make the GCC + command line shorter. + + * mainmake.v2 (version): Remove, no longer needed (config.in + defines VERSION). + (all): Add lib. + (lib): New target and recipe. + (lib-src): Depend on lib. + (src): Depend on lib and lib-src. + (clean, mostlyclean, distclean, maintainer-clean, extraclean) + (bootstrap-clean): Recurse into lib. + (lib, lib-src, src): Specify "all" as an explicit target. + 2011-01-08 Glenn Morris <rgm@gnu.org> * sedleim.inp (RUN-EMACS): -batch implies --no-init-file. diff --git a/msdos/depfiles.bat b/msdos/depfiles.bat new file mode 100644 index 00000000000..22fcfc3dcd6 --- /dev/null +++ b/msdos/depfiles.bat @@ -0,0 +1,25 @@ +@echo off
+rem ----------------------------------------------------------------------
+rem Auxiliary script for MSDOS, run by ../config.bat
+rem Copyright (C) 2011 Free Software Foundation, Inc.
+
+rem This file is part of GNU Emacs.
+
+rem GNU Emacs is free software: you can redistribute it and/or modify
+rem it under the terms of the GNU General Public License as published by
+rem the Free Software Foundation, either version 3 of the License, or
+rem (at your option) any later version.
+
+rem GNU Emacs is distributed in the hope that it will be useful,
+rem but WITHOUT ANY WARRANTY; without even the implied warranty of
+rem MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+rem GNU General Public License for more details.
+
+rem You should have received a copy of the GNU General Public License
+rem along with GNU Emacs. If not, see http://www.gnu.org/licenses/.
+
+rem ----------------------------------------------------------------------
+
+echo %1 | sed -e "s,^,@echo # dummy > deps\\," -e "s,\.c,.Po," > tdepfile.bat
+call tdepfile
+del tdepfile.bat
diff --git a/msdos/mainmake.v2 b/msdos/mainmake.v2 index 2e389b15bc9..1aea06d2a4d 100644 --- a/msdos/mainmake.v2 +++ b/msdos/mainmake.v2 @@ -63,9 +63,6 @@ MAKESHELL=/xyzzy/command # Generate a full pathname of the top-level installation directory top_srcdir := $(subst \,/,$(shell cd)) -# Find out which version of Emacs this is. -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 # a VCS-checkout (not a release) and src/b-emacs.exe does not exist. @@ -82,11 +79,16 @@ endif # compiled lisp files are part of the distribution. (If we are # bootstrapping, the src target will run Make in `lisp' as well.) # leim is not included because it is part of the src target. -all: lib-src src emacs misc lispref lispintro +all: lib lib-src src emacs misc lispref lispintro + +lib: FRC + cd lib + $(MAKE) top_srcdir=${top_srcdir} all + cd .. -lib-src: FRC +lib-src: lib FRC cd lib-src - $(MAKE) top_srcdir=${top_srcdir} version=${version} + $(MAKE) top_srcdir=${top_srcdir} all cd .. # Pass to src/Makefile.in an additional BOOTSTRAPEMACS variable which @@ -98,9 +100,9 @@ lib-src: FRC # file src/foo.c forces dumping a new bootstrap-emacs, then re-byte-compiling # all preloaded elisp files, and only then dump the actual src/emacs, which # is not wrong, but is overkill in 99.99% of the cases. -src: FRC +src: lib lib-src FRC cd src - $(MAKE) top_srcdir=${top_srcdir} BOOTSTRAPEMACS="${boot}" + $(MAKE) top_srcdir=${top_srcdir} BOOTSTRAPEMACS="${boot}" all djecho -s '/-geometry/s,^.*,set environment HOME $(top_srcdir),' \ '/environment *TERM/s/^.*/set environment TERM internal/' \ >gdb.sed @@ -168,6 +170,9 @@ check: @echo "We don't have any tests for GNU Emacs yet." clean mostlyclean: + cd lib + $(MAKE) $(MFLAGS) $@ + cd .. cd lib-src $(MAKE) $(MFLAGS) $@ cd .. @@ -199,6 +204,9 @@ distclean maintainer-clean: FRC $(MAKE) $(MFLAGS) $@ if exist bootlisp rm -f bootlisp cd .. + cd lib + $(MAKE) $(MFLAGS) $@ + cd .. cd lib-src $(MAKE) $(MFLAGS) $@ cd .. @@ -228,6 +236,9 @@ extraclean: cd src $(MAKE) $(MFLAGS) $@ cd .. + cd lib + $(MAKE) $(MFLAGS) $@ + cd .. cd lib-src $(MAKE) $(MFLAGS) $@ cd .. @@ -257,6 +268,9 @@ extraclean: .PHONY: bootstrap bootstrap-clean: FRC + cd lib + $(MAKE) $(MFLAGS) $@ + cd .. cd src $(MAKE) $(MFLAGS) $@ cd .. diff --git a/msdos/sed1v2.inp b/msdos/sed1v2.inp index 1cfd4f803c2..2afce070e30 100644 --- a/msdos/sed1v2.inp +++ b/msdos/sed1v2.inp @@ -35,7 +35,7 @@ s/\.h\.in/.h-in/ /^LIBES *=/,/^ *$/ { s/@[^@\n]*@//g } -/^LIBOBJS *=/s/@[^@\n]*@/getloadavg.o/ +/^LIBOBJS *=/s/@[^@\n]*@// /^C_SWITCH_MACHINE *=/s/@C_SWITCH_MACHINE@// /^C_SWITCH_SYSTEM *=/s/@C_SWITCH_SYSTEM@// /^C_SWITCH_X_SYSTEM *=/s/@C_SWITCH_X_SYSTEM@// @@ -98,6 +98,7 @@ s/\.h\.in/.h-in/ /^ns_appbindir *=/s/@ns_appbindir@// /^ns_appsrc *=/s/@ns_appsrc@// /^NS_OBJ *=/s/@NS_OBJ@// +/^NS_OBJC_OBJ *=/s/@NS_OBJC_OBJ@// /^NS_SUPPORT *=/s/@NS_SUPPORT@// /^GNU_OBJC_CFLAGS*=/s/@GNU_OBJC_CFLAGS@// /^LIBRESOLV *=/s/@LIBRESOLV@// @@ -130,7 +131,8 @@ s/\.h\.in/.h-in/ /^M_FILE *=/s!@M_FILE@!$(srcdir)/m/intel386.h! /^S_FILE *=/s!@S_FILE@!$(srcdir)/s/msdos.h! /^@SET_MAKE@$/s/@SET_MAKE@// -/^.\$(libsrc)\/make-docfile.*>/s!make-docfile!make-docfile -o ../etc/DOC! +/^.\$(libsrc)\/make-docfile.*>.*\/DOC/s!make-docfile!make-docfile -o ../etc/DOC! +/^.\$(libsrc)\/make-docfile.*>.*gl-tmp/s!make-docfile!make-docfile -o gl-tmp! /^.\$(libsrc)\/make-doc/s!>.*$!! /^[ ]*$/d /^ if test -f/,/^ fi$/c\ @@ -145,6 +147,13 @@ s/\.h\.in/.h-in/ stubedit emacs.exe minstack=2048k s/ || exit 1\; \\$// s/ || true\; \\$// +s/ @true *$/ @rem/ +s/^ [^ ]*move-if-change / update / +/^ echo[ ][ ]*timestamp/s/echo /djecho / +/^ .*djecho timestamp/a\ + @rm -f gl-tmp +/^ cd \$(lib) && \$(MAKE)/c\ + $(MAKE) $(MFLAGS) -C $(lib) libgnu.a /^RUN_TEMACS *=/s|`/bin/pwd`|.| /^ *@\$(MKDEPDIR) *$/d /^ mv \.\/\.gdbinit/d @@ -176,4 +185,11 @@ s/echo.*buildobj.lst/dj&/ /^ @\{0,1\}cd ..\/lisp;.*[^\]$/s|$|\; cd ../src| /^ *THEFILE=/s|$|\; cd ../src| /^ echo.* buildobj.h/s|echo |djecho | - +# Make the GCC command line fit one screen line +/^[ ][ ]*\$(C_SWITCH_X_SYSTEM)/d +/^[ ][ ]*\$(GCONF_CFLAGS)/d +/^[ ][ ]*\$(LIBGNUTLS_CFLAGS)/d +s/\$(LIBOTF_CFLAGS) \$(M17N_FLT_CFLAGS) \$(DEPFLAGS) // +s/ \$(C_SWITCH_X_SITE)// +s/ \$(DBUS_CFLAGS)// +s| -I\$(srcdir)/../lib|| diff --git a/msdos/sed2v2.inp b/msdos/sed2v2.inp index 98e398053e3..470c1bf60a6 100644 --- a/msdos/sed2v2.inp +++ b/msdos/sed2v2.inp @@ -34,6 +34,8 @@ /^#undef HAVE_FREXP *$/s/^.*$/#define HAVE_FREXP 1/ /^#undef HAVE_FMOD *$/s/^.*$/#define HAVE_FMOD 1/ /^#undef HAVE_RINT *$/s/^.*$/#define HAVE_RINT 1/ +/^#undef HAVE_ATTRIBUTE_ALIGNED *$/s/^.*$/#define HAVE_ATTRIBUTE_ALIGNED 1/ +/^#undef HAVE_C99_STRTOLD *$/s/^.*$/#define HAVE_C99_STRTOLD 1/ /^#undef HAVE_CBRT *$/s/^.*$/#define HAVE_CBRT 1/ /^#undef HAVE_DIFFTIME *$/s/^.*$/#define HAVE_DIFFTIME 1/ /^#undef HAVE_FPATHCONF *$/s/^.*$/#define HAVE_FPATHCONF 1/ @@ -56,8 +58,14 @@ /^#undef PACKAGE_STRING/s/^.*$/#define PACKAGE_STRING ""/ /^#undef PACKAGE_TARNAME/s/^.*$/#define PACKAGE_TARNAME ""/ /^#undef PACKAGE_VERSION/s/^.*$/#define PACKAGE_VERSION ""/ +/^#undef VERSION/s/^.*$/#define VERSION "24.0.50"/ +/^#undef HAVE_DECL_GETENV/s/^.*$/#define HAVE_DECL_GETENV 1/ /^#undef SYS_SIGLIST_DECLARED/s/^.*$/#define SYS_SIGLIST_DECLARED 1/ /^#undef HAVE_DIRENT_H/s/^.*$/#define HAVE_DIRENT_H 1/ +/^#undef HAVE__BOOL/s/^.*$/#define HAVE__BOOL 1/ +/^#undef inline/s/^.*$/#define inline __inline__/ +/^#undef my_strftime/s/^.*$/#define my_strftime nstrftime/ +/^#undef restrict/s/^.*$/#define restrict __restrict/ /^#undef GNU_MALLOC *$/s/^.*$/#define GNU_MALLOC 1/ /^#undef REL_ALLOC *$/s/^.*$/#define REL_ALLOC 1/ @@ -69,15 +77,6 @@ s!^#undef config_opsysfile *$!#define config_opsysfile "s/msdos.h"! s!^#undef config_machfile *$!#define config_machfile "m/intel386.h"! s/^#undef PROTOTYPES *$/#define PROTOTYPES 1/ s/^#undef POINTER_TYPE *$/#define POINTER_TYPE void/ -# ------------------------------------------------------------ -# Without this ifndef, gcc -E -traditional barfs with GCC 3.0 -# on the line which says if ! HAVE_MKTIME... -# ------------------------------------------------------------ -/^#if ! HAVE_MKTIME || BROKEN_MKTIME/i\ -#ifndef __DJGPP__ -/^#define mktime emacs_mktime/a\ -#endif - /^#undef HAVE_STDINT_H/c\ #if __DJGPP__ > 2 || __DJGPP_MINOR__ > 3\ #define HAVE_STDINT_H 1\ diff --git a/msdos/sed3v2.inp b/msdos/sed3v2.inp index 3a9d14a35af..346f4e07e77 100644 --- a/msdos/sed3v2.inp +++ b/msdos/sed3v2.inp @@ -18,7 +18,7 @@ /^# DIST: /d /^SHELL *=/s/^/# / /^CC *=/s/=.*$/=gcc/ -/-DVERSION=/s/@version@/\${version}/ +s/-DVERSION[^ ]* // /^configname *=/s/=.*$/=msdos/ /^archlibdir *=/s!=.*$!=/emacs/bin! /^bindir *=/s!=.*$!=/emacs/bin! @@ -40,7 +40,6 @@ /^C_SWITCH_MACHINE *=/s/@C_SWITCH_MACHINE@// /^C_WARNINGS_SWITCH *=/s/@C_WARNINGS_SWITCH@// /^PROFILING_CFLAGS *=/s/@PROFILING_CFLAGS@// -/^LOADLIBES *=/s!=.*$!=! /^ALLOCA *=/s!@ALLOCA@!! /^EXEEXT *=/s!@EXEEXT@!! /^GETOPT_H *=/s!@GETOPT_H@!getopt.h! diff --git a/msdos/sed6.inp b/msdos/sed6.inp index 2c5f0273608..888b680a6ca 100644 --- a/msdos/sed6.inp +++ b/msdos/sed6.inp @@ -18,13 +18,11 @@ # ---------------------------------------------------------------------- /^srcdir *=/s/@[^@\n]*@/./ /^VPATH *=/s/@[^@\n]*@/./ -/^ENVADD/c\ +/^MAKEINFO *=/s/@[^@\n]*@/makeinfo/ +/^ENVADD/,/^$/c\ ENVADD =\ export TEXINPUTS := $(srcdir)";"$(TEXINPUTS)\ -export MAKEINFO := $(MAKEINFO) -I$(srcdir) -/^texinputdir/c\ -texinputdir =\ -export texinputdir := $(srcdir)";"$(TEXINPUTS) +export MAKEINFO := $(MAKEINFO) $(MAKEINFO_OPTS) /^SHELL *=/s/^/# / /^elisp.dvi:/,/^$/ { /^ *if \[ *\a${permuted_index}/,/^ *fi *$/c\ diff --git a/msdos/sedleim.inp b/msdos/sedleim.inp index c2f7d845422..2d70695ebe6 100644 --- a/msdos/sedleim.inp +++ b/msdos/sedleim.inp @@ -31,9 +31,9 @@ INSTALLDIR=. s|\([ ]\)echo|\1djecho|g /^ @true *$/d -/RUN-EMACS *=/,/^$/c\ +/RUN_EMACS *=/,/^$/c\ export EMACSLOADPATH=${buildlisppath}\ -RUN-EMACS = ${BUILT-EMACS} -batch --no-site-file +RUN_EMACS = ${BUILT_EMACS} -batch --no-site-file /^ cd ../c\ ${MAKE} -C ../src ${MFLAGS} emacs diff --git a/msdos/sedlibcf.inp b/msdos/sedlibcf.inp new file mode 100644 index 00000000000..17584a796f7 --- /dev/null +++ b/msdos/sedlibcf.inp @@ -0,0 +1,22 @@ +# -sedlibcf.inp----------------------------------------------------------- +# Configuration script for lib/Makefile.in under DJGPP v2.x +# +# This script is run by config.bat to account for renaming of +# files whose names are invalid on DOS 8+3 filesystems. +# ---------------------------------------------------------------------- +# +# Copyright (C) 2011 Free Software Foundation, Inc. +# +# This file is part of GNU Emacs. +# +# This file is free software; as a special exception, the author gives +# unlimited permission to copy and/or distribute it, with or without +# modifications, as long as this notice is preserved. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +# +# ---------------------------------------------------------------------- +s/c++defs/cxxdefs/g +s/\([a-zA-Z0-9_]*\)\.in\.h/\1.in-h/g diff --git a/msdos/sedlibmk.inp b/msdos/sedlibmk.inp new file mode 100644 index 00000000000..b85b20f1491 --- /dev/null +++ b/msdos/sedlibmk.inp @@ -0,0 +1,312 @@ +# -sedlibmk.inp----------------------------------------------------------- +# Configuration script for lib/Makefile under DJGPP v2.x +# ---------------------------------------------------------------------- +# +# Copyright (C) 2011 Free Software Foundation, Inc. +# +# This file is part of GNU Emacs. +# +# This file is free software; as a special exception, the author gives +# unlimited permission to copy and/or distribute it, with or without +# modifications, as long as this notice is preserved. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +# +# ---------------------------------------------------------------------- +# +# Replace @..@ constants. +/^\# @configure_input@/s!@configure_input@!lib/Makefile. Generated from Makefile.in by config.bat! +/^@SET_MAKE@$/s/@SET_MAKE@// +/^VPATH *=/s/@[^@\n]*@/./ +s/@PACKAGE@/emacs/ +/^am__cd *=/c\ +am__cd = cd +/^ALLOCA *=/s/@[^@\n]*@// +/^ALSA_CFLAGS *=/s/@[^@\n]*@// +/^ALSA_LIBS *=/s/@[^@\n]*@// +/^AWK *=/s/@[^@\n]*@/gawk/ +/^CANNOT_DUMP *=/s/@[^@\n]*@/no/ +/^CC *=/s/@[^@\n]*@/gcc/ +/^CPP *=/s/@[^@\n]*@/gcc -e/ +/^CPPFLAGS *=/s/@[^@\n]*@// +/^CCDEPMODE *=/s/@[^@\n]*@/depmode=gcc3/ +/^CFLAGS *=/s/@[^@\n]*@/-g -O2/ +/^CYGPATH_W *=/s/@[^@\n]*@// +/^CYGWIN_OBJ *=/s/@[^@\n]*@// +/^C_SWITCH_MACHINE *=/s/@C_SWITCH_MACHINE@// +/^C_SWITCH_SYSTEM *=/s/@C_SWITCH_SYSTEM@// +/^C_SWITCH_X_SYSTEM *=/s/@C_SWITCH_X_SYSTEM@// +/^C_SWITCH_X_SITE *=/s/@C_SWITCH_X_SITE@// +/^C_WARNINGS_SWITCH *=/s/@C_WARNINGS_SWITCH@// +/^DEFS *=/s/@[^@\n]*@/-DHAVE_CONFIG_H/ +/^DEPDIR *=/s/@[^@\n]*@/deps/ +/^DEPFLAGS *=/s/@[^@\n]*@/-MMD -MF ${DEPDIR}\/$*.d/ +/^ECHO_N *=/s/@[^@\n]*@/-n/ +/^EXEEXT *=/s/@[^@\n]*@/.exe/ +/^GETOPT_H *=/s/@[^@\n]*@/getopt.h/ +# +# Some GNULIB_* are replaced with zero even though DJGPP does not have +# these features. That's because the gnulib replacements cannot +# possibly work for DJGPP, so we prefer to fail the link than have a +# subtly botched executable. +/^GNULIB_ATOLL *=/s/@GNULIB_ATOLL@/1/ +/^GNULIB_CALLOC_POSIX *=/s/@GNULIB_CALLOC_POSIX@/0/ +/^GNULIB_CANONICALIZE_FILE_NAME *=/s/@GNULIB_CANONICALIZE_FILE_NAME@/0/ +/^GNULIB_CHOWN *=/s/@GNULIB_CHOWN@/0/ +/^GNULIB_CLOSE *=/s/@GNULIB_CLOSE@/0/ +/^GNULIB_DUP2 *=/s/@GNULIB_DUP2@/0/ +/^GNULIB_DUP3 *=/s/@GNULIB_DUP3@/1/ +/^GNULIB_ENVIRON *=/s/@GNULIB_ENVIRON@/0/ +/^GNULIB_EUIDACCESS *=/s/@GNULIB_EUIDACCESS@/0/ +/^GNULIB_FACCESSAT *=/s/@GNULIB_FACCESSAT@/0/ +/^GNULIB_FCHDIR *=/s/@GNULIB_FCHDIR@/0/ +/^GNULIB_FCHOWNAT *=/s/@GNULIB_FCHOWNAT@/0/ +/^GNULIB_FSYNC *=/s/@GNULIB_FSYNC@/0/ +/^GNULIB_FTRUNCATE *=/s/@GNULIB_FTRUNCATE@/0/ +/^GNULIB_GETCWD *=/s/@GNULIB_GETCWD@/0/ +/^GNULIB_GETDOMAINNAME *=/s/@GNULIB_GETDOMAINNAME@/0/ +/^GNULIB_GETDTABLESIZE *=/s/@GNULIB_GETDTABLESIZE@/0/ +/^GNULIB_GETGROUPS *=/s/@GNULIB_GETGROUPS@/0/ +/^GNULIB_GETHOSTNAME *=/s/@GNULIB_GETHOSTNAME@/0/ +/^GNULIB_GETLOADAVG *=/s/@GNULIB_GETLOADAVG@/1/ +/^GNULIB_GETLOGIN *=/s/@GNULIB_GETLOGIN@/0/ +/^GNULIB_GETLOGIN_R *=/s/@GNULIB_GETLOGIN_R@/0/ +/^GNULIB_GETPAGESIZE *=/s/@GNULIB_GETPAGESIZE@/0/ +/^GNULIB_GETSUBOPT *=/s/@GNULIB_GETSUBOPT@/0/ +/^GNULIB_GETUSERSHELL *=/s/@GNULIB_GETUSERSHELL@/0/ +/^GNULIB_GRANTPT *=/s/@GNULIB_GRANTPT@/0/ +/^GNULIB_LCHOWN *=/s/@GNULIB_LCHOWN@/0/ +/^GNULIB_LINK *=/s/@GNULIB_LINK@/0/ +/^GNULIB_LINKAT *=/s/@GNULIB_LINKAT@/0/ +/^GNULIB_LSEEK *=/s/@GNULIB_LSEEK@/0/ +/^GNULIB_MALLOC_POSIX *=/s/@GNULIB_MALLOC_POSIX@/0/ +/^GNULIB_MKDTEMP *=/s/@GNULIB_MKDTEMP@/0/ +/^GNULIB_MKOSTEMP *=/s/@GNULIB_MKOSTEMP@/0/ +/^GNULIB_MKOSTEMPS *=/s/@GNULIB_MKOSTEMPS@/0/ +/^GNULIB_MKSTEMP *=/s/@GNULIB_MKSTEMP@/0/ +/^GNULIB_MKSTEMPS *=/s/@GNULIB_MKSTEMPS@/0/ +/^GNULIB_MKTIME *=/s/@GNULIB_MKTIME@/0/ +/^GNULIB_NANOSLEEP *=/s/@GNULIB_NANOSLEEP@/0/ +/^GNULIB_PIPE *=/s/@GNULIB_PIPE@/0/ +/^GNULIB_PIPE2 *=/s/@GNULIB_PIPE2@/0/ +/^GNULIB_PREAD *=/s/@GNULIB_PREAD@/0/ +/^GNULIB_PTSNAME *=/s/@GNULIB_PTSNAME@/0/ +/^GNULIB_PUTENV *=/s/@GNULIB_PUTENV@/0/ +/^GNULIB_PWRITE *=/s/@GNULIB_PWRITE@/0/ +/^GNULIB_RANDOM_R *=/s/@GNULIB_RANDOM_R@/0/ +/^GNULIB_READLINK *=/s/@GNULIB_READLINK@/0/ +/^GNULIB_READLINKAT *=/s/@GNULIB_READLINKAT@/0/ +/^GNULIB_REALLOC_POSIX *=/s/@GNULIB_REALLOC_POSIX@/0/ +/^GNULIB_REALPATH *=/s/@GNULIB_REALPATH@/0/ +/^GNULIB_RMDIR *=/s/@GNULIB_RMDIR@/0/ +/^GNULIB_RPMATCH *=/s/@GNULIB_RPMATCH@/0/ +/^GNULIB_SETENV *=/s/@GNULIB_SETENV@/0/ +/^GNULIB_SLEEP *=/s/@GNULIB_SLEEP@/0/ +/^GNULIB_STRPTIME *=/s/@GNULIB_STRPTIME@/0/ +/^GNULIB_STRTOD *=/s/@GNULIB_STRTOD@/0/ +/^GNULIB_STRTOLL *=/s/@GNULIB_STRTOLL@/0/ +/^GNULIB_STRTOULL *=/s/@GNULIB_STRTOULL@/0/ +/^GNULIB_SYMLINK *=/s/@GNULIB_SYMLINK@/0/ +/^GNULIB_SYMLINKAT *=/s/@GNULIB_SYMLINKAT@/0/ +/^GNULIB_SYSTEM_POSIX *=/s/@GNULIB_SYSTEM_POSIX@/0/ +/^GNULIB_TIMEGM *=/s/@GNULIB_TIMEGM@/0/ +/^GNULIB_TIME_R *=/s/@GNULIB_TIME_R@/1/ +/^GNULIB_TTYNAME_R *=/s/@GNULIB_TTYNAME_R@/0/ +/^GNULIB_UNISTD_H_GETOPT *=/s/@GNULIB_UNISTD_H_GETOPT@/1/ +/^GNULIB_UNISTD_H_SIGPIPE *=/s/@GNULIB_UNISTD_H_SIGPIPE@/0/ +/^GNULIB_UNLINK *=/s/@GNULIB_UNLINK@/0/ +/^GNULIB_UNLINKAT *=/s/@GNULIB_UNLINKAT@/0/ +/^GNULIB_UNLOCKPT *=/s/@GNULIB_UNLOCKPT@/0/ +/^GNULIB_UNSETENV *=/s/@GNULIB_UNSETENV@/1/ +/^GNULIB_USLEEP *=/s/@GNULIB_USLEEP@/0/ +/^GNULIB_WRITE *=/s/@GNULIB_WRITE@/0/ +/^GNULIB__EXIT *=/s/@GNULIB__EXIT@/0/ +/^HAVE_ATOLL *=/s/@HAVE_ATOLL@/0/ +/^HAVE_CANONICALIZE_FILE_NAME *=/s/@HAVE_CANONICALIZE_FILE_NAME@/0/ +/^HAVE_CHOWN *=/s/@HAVE_CHOWN@/1/ +/^HAVE_DECL_ENVIRON *=/s/@HAVE_DECL_ENVIRON@/1/ +/^HAVE_DECL_FCHDIR *=/s/@HAVE_DECL_FCHDIR@/0/ +/^HAVE_DECL_GETDOMAINNAME *=/s/@HAVE_DECL_GETDOMAINNAME@/0/ +/^HAVE_DECL_GETLOADAVG *=/s/@HAVE_DECL_GETLOADAVG@/0/ +/^HAVE_DECL_GETLOGIN_R *=/s/@HAVE_DECL_GETLOGIN_R@/0/ +/^HAVE_DECL_GETPAGESIZE *=/s/@HAVE_DECL_GETPAGESIZE@/1/ +/^HAVE_DECL_GETUSERSHELL *=/s/@HAVE_DECL_GETUSERSHELL@/0/ +/^HAVE_DECL_LOCALTIME_R *=/s/@HAVE_DECL_LOCALTIME_R@/0/ +/^HAVE_DECL_SETENV *=/s/@HAVE_DECL_SETENV@/1/ +/^HAVE_DECL_TTYNAME_R *=/s/@HAVE_DECL_TTYNAME_R@/0/ +/^HAVE_DECL_UNSETENV *=/s/@HAVE_DECL_UNSETENV@/0/ +/^HAVE_DUP2 *=/s/@HAVE_DUP2@/1/ +/^HAVE_DUP3 *=/s/@HAVE_DUP3@/0/ +/^HAVE_EUIDACCESS *=/s/@HAVE_EUIDACCESS@/0/ +/^HAVE_FACCESSAT *=/s/@HAVE_FACCESSAT@/0/ +/^HAVE_FCHDIR *=/s/@HAVE_FCHDIR@/0/ +/^HAVE_FCHOWNAT *=/s/@HAVE_FCHOWNAT@/0/ +/^HAVE_FSYNC *=/s/@HAVE_FSYNC@/1/ +/^HAVE_FTRUNCATE *=/s/@HAVE_FTRUNCATE@/1/ +/^HAVE_GETDTABLESIZE *=/s/@HAVE_GETDTABLESIZE@/0/ +/^HAVE_GETGROUPS *=/s/@HAVE_GETGROUPS@/0/ +/^HAVE_GETHOSTNAME *=/s/@HAVE_GETHOSTNAME@/1/ +/^HAVE_GETLOGIN *=/s/@HAVE_GETLOGIN@/1/ +/^HAVE_GETOPT_H *=/s/@HAVE_GETOPT_H@/0/ +/^HAVE_GETPAGESIZE *=/s/@HAVE_GETPAGESIZE@/1/ +/^HAVE_GETSUBOPT *=/s/@HAVE_GETSUBOPT@/0/ +/^HAVE_GRANTPT *=/s/@HAVE_GRANTPT@/0/ +/^HAVE_LCHOWN *=/s/@HAVE_LCHOWN@/0/ +/^HAVE_LINK *=/s/@HAVE_LINK@/1/ +/^HAVE_LINKAT *=/s/@HAVE_LINKAT@/0/ +/^HAVE_MAKEINFO *=/s/@HAVE_MAKEINFO@/yes/ +/^HAVE_MKDTEMP *=/s/@HAVE_MKDTEMP@/0/ +/^HAVE_MKOSTEMP *=/s/@HAVE_MKOSTEMP@/0/ +/^HAVE_MKOSTEMPS *=/s/@HAVE_MKOSTEMPS@/0/ +/^HAVE_MKSTEMP *=/s/@HAVE_MKSTEMP@/1/ +/^HAVE_MKSTEMPS *=/s/@HAVE_MKSTEMPS@/0/ +/^HAVE_NANOSLEEP *=/s/@HAVE_NANOSLEEP@/0/ +/^HAVE_OS_H *=/s/@HAVE_OS_H@/0/ +/^HAVE_PIPE *=/s/@HAVE_PIPE@/0/ +/^HAVE_PIPE2 *=/s/@HAVE_PIPE2@/0/ +/^HAVE_PREAD *=/s/@HAVE_PREAD@/0/ +/^HAVE_PTSNAME *=/s/@HAVE_PTSNAME@/0/ +/^HAVE_PWRITE *=/s/@HAVE_PWRITE@/0/ +/^HAVE_RANDOM_H *=/s/@HAVE_RANDOM_H@/1/ +/^HAVE_RANDOM_R *=/s/@HAVE_RANDOM_R@/0/ +/^HAVE_READLINK *=/s/@HAVE_READLINK@/0/ +/^HAVE_READLINKAT *=/s/@HAVE_READLINKAT@/0/ +/^HAVE_REALPATH *=/s/@HAVE_REALPATH@/0/ +/^HAVE_RPMATCH *=/s/@HAVE_RPMATCH@/0/ +/^HAVE_SETENV *=/s/@HAVE_SETENV@/1/ +/^HAVE_SLEEP *=/s/@HAVE_SLEEP@/1/ +/^HAVE_STRPTIME *=/s/@HAVE_STRPTIME@/0/ +/^HAVE_STRTOD *=/s/@HAVE_STRTOD@/1/ +/^HAVE_STRTOLL *=/s/@HAVE_STRTOLL@/1/ +/^HAVE_STRTOULL *=/s/@HAVE_STRTOULL@/1/ +/^HAVE_STRUCT_RANDOM_DATA *=/s/@HAVE_STRUCT_RANDOM_DATA@/0/ +/^HAVE_SYMLINK *=/s/@HAVE_SYMLINK@/1/ +/^HAVE_SYMLINKAT *=/s/@HAVE_SYMLINKAT@/0/ +/^HAVE_SYS_LOADAVG_H *=/s/@HAVE_SYS_LOADAVG_H@/0/ +/^HAVE_SYS_PARAM_H *=/s/@HAVE_SYS_PARAM_H@/1/ +/^HAVE_TIMEGM *=/s/@HAVE_TIMEGM@/0/ +/^HAVE_UNISTD_H *=/s/@HAVE_UNISTD_H@/1/ +/^HAVE_UNLINKAT *=/s/@HAVE_UNLINKAT@/0/ +/^HAVE_UNLOCKPT *=/s/@HAVE_UNLOCKPT@/0/ +/^HAVE_USLEEP *=/s/@HAVE_USLEEP@/1/ +/^HAVE_WCHAR_T *=/s/@HAVE_WCHAR_T@/1/ +/^HAVE_XSERVER *=/s/@HAVE_XSERVER@/0/ +/^HAVE__BOOL *=/s/@HAVE__BOOL@/1/ +/^HAVE__EXIT *=/s/@HAVE__EXIT@/1/ +/^INCLUDE_NEXT *=/s/@INCLUDE_NEXT@/include_next/ +/^INCLUDE_NEXT_AS_FIRST_DIRECTIVE *=/s/@[^@\n]*@/include_next/ +/^LDFLAGS *=/s/@[^@\n]*@// +/^LD_FIRSTFLAG *=/s/@[^@\n]*@// +/^LIBS *=/s/@[^@\n]*@// +/^MAKEINFO *=/s/@MAKEINFO@/makeinfo/ +/^NEXT_AS_FIRST_DIRECTIVE_GETOPT_H *=/s/@[^@\n]*@/<getopt.h>/ +/^NEXT_AS_FIRST_DIRECTIVE_STDDEF_H *=/s/@[^@\n]*@// +/^NEXT_AS_FIRST_DIRECTIVE_STDLIB_H *=/s/@[^@\n]*@/<stdlib.h>/ +/^NEXT_AS_FIRST_DIRECTIVE_TIME_H *=/s/@[^@\n]*@/<time.h>/ +/^NEXT_AS_FIRST_DIRECTIVE_UNISTD_H *=/s/@[^@\n]*@/<unistd.h>/ +/^NEXT_GETOPT_H *=/s/@[^@\n]*@/<getopt.h>/ +/^NEXT_STDDEF_H *=/s/@[^@\n]*@// +/^NEXT_STDLIB_H *=/s/@[^@\n]*@/<stdlib.h>/ +/^NEXT_TIME_H *=/s/@[^@\n]*@/<time.h>/ +/^NEXT_UNISTD_H *=/s/@[^@\n]*@/<unistd.h>/ +/^OBJEXT *=/s/@[^@\n]*@/o/ +/^PRAGMA_COLUMNS *=/s/@[^@\n]*@// +/^PRAGMA_SYSTEM_HEADER *=/s/@[^@\n]*@/\\\#pragma GCC system_header/ +/^PTHREAD_H_DEFINES_STRUCT_TIMESPEC *=/s/@[^@\n]*@/0/ +/^RANLIB *=/s/@[^@\n]*@/ranlib/ +/^REPLACE_CALLOC *=/s/@REPLACE_CALLOC@/0/ +/^REPLACE_CANONICALIZE_FILE_NAME *=/s/@REPLACE_CANONICALIZE_FILE_NAME@/0/ +/^REPLACE_CHOWN *=/s/@REPLACE_CHOWN@/0/ +/^REPLACE_CLOSE *=/s/@REPLACE_CLOSE@/0/ +/^REPLACE_DUP *=/s/@REPLACE_DUP@/0/ +/^REPLACE_DUP2 *=/s/@REPLACE_DUP2@/0/ +/^REPLACE_FCHOWNAT *=/s/@REPLACE_FCHOWNAT@/0/ +/^REPLACE_GETCWD *=/s/@REPLACE_GETCWD@/0/ +/^REPLACE_GETDOMAINNAME *=/s/@REPLACE_GETDOMAINNAME@/0/ +/^REPLACE_GETGROUPS *=/s/@REPLACE_GETGROUPS@/0/ +/^REPLACE_GETLOGIN_R *=/s/@REPLACE_GETLOGIN_R@/0/ +/^REPLACE_GETPAGESIZE *=/s/@REPLACE_GETPAGESIZE@/0/ +/^REPLACE_LCHOWN *=/s/@REPLACE_LCHOWN@/0/ +/^REPLACE_LINK *=/s/@REPLACE_LINK@/0/ +/^REPLACE_LINKAT *=/s/@REPLACE_LINKAT@/0/ +/^REPLACE_LOCALTIME_R *=/s/@REPLACE_LOCALTIME_R@/0/ +/^REPLACE_LSEEK *=/s/@REPLACE_LSEEK@/0/ +/^REPLACE_MALLOC *=/s/@REPLACE_MALLOC@/0/ +/^REPLACE_MKSTEMP *=/s/@REPLACE_MKSTEMP@/0/ +/^REPLACE_MKTIME *=/s/@REPLACE_MKTIME@/0/ +/^REPLACE_NANOSLEEP *=/s/@REPLACE_NANOSLEEP@/0/ +/^REPLACE_NULL *=/s/@REPLACE_NULL@/0/ +/^REPLACE_PREAD *=/s/@REPLACE_PREAD@/0/ +/^REPLACE_PUTENV *=/s/@REPLACE_PUTENV@/0/ +/^REPLACE_PWRITE *=/s/@REPLACE_PWRITE@/0/ +/^REPLACE_READLINK *=/s/@REPLACE_READLINK@/0/ +/^REPLACE_REALLOC *=/s/@REPLACE_REALLOC@/0/ +/^REPLACE_REALPATH *=/s/@REPLACE_REALPATH@/0/ +/^REPLACE_RMDIR *=/s/@REPLACE_RMDIR@/0/ +/^REPLACE_SETENV *=/s/@REPLACE_SETENV@/0/ +/^REPLACE_SLEEP *=/s/@REPLACE_SLEEP@/0/ +/^REPLACE_STRTOD *=/s/@REPLACE_STRTOD@/0/ +/^REPLACE_SYMLINK *=/s/@REPLACE_SYMLINK@/0/ +/^REPLACE_TIMEGM *=/s/@REPLACE_TIMEGM@/0/ +/^REPLACE_TTYNAME_R *=/s/@REPLACE_TTYNAME_R@/0/ +/^REPLACE_UNLINK *=/s/@REPLACE_UNLINK@/0/ +/^REPLACE_UNLINKAT *=/s/@REPLACE_UNLINKAT@/0/ +/^REPLACE_UNSETENV *=/s/@REPLACE_UNSETENV@/0/ +/^REPLACE_USLEEP *=/s/@REPLACE_USLEEP@/0/ +/^REPLACE_WRITE *=/s/@REPLACE_WRITE@/0/ +/^STDBOOL_H *=/s/@[^@\n]*@// +/^STDDEF_H *=/s/@[^@\n]*@// +/^SYS_TIME_H_DEFINES_STRUCT_TIMESPEC *=/s/@[^@\n]*@/0/ +/^TIME_H_DEFINES_STRUCT_TIMESPEC *=/s/@[^@\n]*@/0/ +/^UNISTD_H_HAVE_WINSOCK2_H *=/s/@[^@\n]*@/0/ +/^UNISTD_H_HAVE_WINSOCK2_H_AND_USE_SOCKETS *=/s/@[^@\n]*@/0/ +/^gl_LIBOBJS *=/s/@[^@\n]*@/getopt.o getopt1.o strftime.o time_r.o getloadavg.o/ +/^srcdir *=/s/@[^@\n]*@/./ +/^top_srcdir *=/s/@[^@\n]*@/../ +/^top_builddir *=/s/@[^@\n]*@/../ +s/@PRAGMA_SYSTEM_HEADER@/\#pragma GCC system_header/ +s/@PRAGMA_COLUMNS@// +# +# Delete the recipes we don't want to get in our way. +/^\$(srcdir)\/Makefile\.in:/,/^[ ][ ]*\$(AUTOMAKE)/d +/^Makefile:/,/^[ ][ ]*esac/d +/^\$(top_srcdir)\/configure:/,/^\$(ACLOCAL_M4)/d +# +# Fix the include-dependency lines +s/^@AMDEP_TRUE@// +s/^@AMDEP_FALSE@/\#/ +s/@am__include@/include/ +s/@am__quote@//g +s/^@am__fastdepCC_TRUE@// +s/^@am__fastdepCC_FALSE/\#/ +# +# Fix the *-clean rules, to not use a Unixy `test' command. Empty +# lists are replaced with a dummy file, to avoid an error message from +# "rm -f" with no arguments. +/^CONFIG_CLEAN_FILES *= *$/c\ +CONFIG_CLEAN_FILES = xyzzy +/^CONFIG_CLEAN_VPATH_FILES *= *$/c\ +CONFIG_CLEAN_VPATH_FILES = xyzzy +s/^ -*test -z.*|| rm/ -rm/ +s/@echo /@djecho/ +# +# Fix the recipes for header files +/^arg-nonnull\.h:/,/^[ ][ ]*mv /c\ +arg-nonnull.h: $(top_srcdir)/./arg-nonnull.h\ + sed -n -e '/GL_ARG_NONNULL/,$$p' < $(top_srcdir)/./arg-nonnull.h > $@ +/^cxxdefs\.h:/,/^[ ][ ]*mv /c\ +cxxdefs.h: $(top_srcdir)/./cxxdefs.h\ + sed -n -e '/_GL_CXXDEFS/,$$p' < $(top_srcdir)/./cxxdefs.h > $@ +s/^ [ ]*{ echo \(.*\); \\/ djecho \1 > $@-t/ +s/^ [ ]*{ echo \(.*\) && \\/ djecho \1 > $@-t/ +s/ \&\& \\ *$// +s/\.in-h\; *\\$/.in-h >> $@-t/ +/^ [ ]*} /d +/^stdlib\.h:/,/^ [ ]*mv /{ + s/'\; \\ *$/' >> $@-t/ +} +/^unistd\.h:/,/^ [ ]*mv /{ + s/'\; \\ *$/' >> $@-t/ +} diff --git a/nt/ChangeLog b/nt/ChangeLog index 41273114429..f20fbd1d31a 100644 --- a/nt/ChangeLog +++ b/nt/ChangeLog @@ -1,3 +1,16 @@ +2011-02-21 Christoph Scholtes <cschol2112@gmail.com> + + * inc/stdint.h: New file, to support compilation with tool chains + that do not have stdint.h (e.g. MSVC). + +2011-02-21 Eli Zaretskii <eliz@gnu.org> + + * inc/sys/stat.h (S_ISUID, S_ISGID, S_ISVTX, S_IRGRP, S_IROTH) + (S_IWGRP, S_IWOTH, S_IXGRP, S_IXOTH, S_ISSOCK, S_ISLNK, S_ISCTG) + (S_ISDOOR, S_ISMPB, S_ISMPC, S_ISNWK, S_ISPORT, S_ISWHT) + (S_TYPEISMQ, S_TYPEISSEM, S_TYPEISSHM, S_TYPEISTMO): Define. + (lstat): Define to stat. + 2011-02-09 Eli Zaretskii <eliz@gnu.org> * makefile.w32-in (bootstrap-nmake, bootstrap-gmake): Make the diff --git a/nt/inc/stdint.h b/nt/inc/stdint.h new file mode 100644 index 00000000000..ed4e26a6867 --- /dev/null +++ b/nt/inc/stdint.h @@ -0,0 +1,34 @@ +/* Replacement stdint.h file for building GNU Emacs on Windows. + +Copyright (C) 2011 Free Software Foundation, Inc. + +This file is part of GNU Emacs. + +GNU Emacs is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +GNU Emacs is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ + +#ifndef _NT_STDINT_H_ +#define _NT_STDINT_H_ + +#ifdef __GNUC__ +# include_next <stdint.h> /* use stdint.h if available */ +#else /* !__GNUC__ */ + +/* Minimum definitions to allow compilation with tool chains where + stdint.h is not available, e.g. Microsoft Visual Studio. */ + +typedef unsigned int uint32_t; + +#endif /* !__GNUC__ */ + +#endif /* _NT_STDINT_H_ */ diff --git a/nt/inc/sys/stat.h b/nt/inc/sys/stat.h index a217dea9d47..7f0bbeccb17 100644 --- a/nt/inc/sys/stat.h +++ b/nt/inc/sys/stat.h @@ -56,6 +56,31 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #define S_ISCHR(m) (((m) & S_IFMT) == S_IFCHR) #define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO) +/* These don't exist on Windows, but lib/filemode.c wants them. */ +#define S_ISUID 0 +#define S_ISGID 0 +#define S_ISVTX 0 +#define S_IRGRP (S_IRUSR >> 3) +#define S_IROTH (S_IRUSR >> 6) +#define S_IWGRP (S_IWUSR >> 3) +#define S_IWOTH (S_IWUSR >> 6) +#define S_IXGRP (S_IXUSR >> 3) +#define S_IXOTH (S_IXUSR >> 6) + +#define S_ISSOCK(m) 0 +#define S_ISLNK(m) 0 +#define S_ISCTG(p) 0 +#define S_ISDOOR(m) 0 +#define S_ISMPB(m) 0 +#define S_ISMPC(m) 0 +#define S_ISNWK(m) 0 +#define S_ISPORT(m) 0 +#define S_ISWHT(m) 0 +#define S_TYPEISMQ(p) 0 +#define S_TYPEISSEM(p) 0 +#define S_TYPEISSHM(p) 0 +#define S_TYPEISTMO(p) 0 + struct stat { unsigned __int64 st_ino; /* ino_t in sys/types.h is too narrow */ dev_t st_dev; @@ -76,5 +101,8 @@ _CRTIMP int __cdecl __MINGW_NOTHROW fstat (int, struct stat*); _CRTIMP int __cdecl __MINGW_NOTHROW chmod (const char*, int); _CRTIMP int __cdecl __MINGW_NOTHROW stat (const char*, struct stat*); +/* fileio.c and dired.c want lstat. */ +#define lstat stat + #endif /* INC_SYS_STAT_H_ */ diff --git a/src/ChangeLog.trunk b/src/ChangeLog.trunk index 68a12d4f55a..9713a4a6ed5 100644 --- a/src/ChangeLog.trunk +++ b/src/ChangeLog.trunk @@ -1,3 +1,574 @@ +2011-02-21 Eli Zaretskii <eliz@gnu.org> + + * makefile.w32-in ($(BLD)/filemode.$(O)): Move recipe to + lib/makefilw.w32-in. + ($(BLD)/dired.$(O)): Depend on $(EMACS_ROOT)/lib/filemode.h. + (GLOBAL_SOURCES): Remove filemode.c. + (OBJ1): Remove $(BLD)/filemode.$(O). + +2011-02-21 Paul Eggert <eggert@cs.ucla.edu> + + Import filemode module from gnulib. + * Makefile.in (base_obj): Remove filemode.o, as it's now in ../lib. + * deps.mk (dired.o): Depend on ../lib/filemode.h, too. + (filemode.o): Remove; this is now in ../lib. + * dired.c: Include <filemode.h>. + (filemodestring): Remove now-redundant decl. + * config.in: Regenerate. + +2011-02-20 Eli Zaretskii <eliz@gnu.org> + + * makefile.w32-in ($(BLD)/fns.$(O)): Depend on + $(EMACS_ROOT)/lib/md5.h and on stamp_BLD. + +2011-02-20 Christoph Scholtes <cschol2112@gmail.com> + + * makefile.w32-in: Remove md5.$(O). + ($(BLD)/md5.$(O)): Remove prerequisites, moved to + lib/makefile.w32-in. + +2011-02-20 Paul Eggert <eggert@cs.ucla.edu> + + Import crypto/md5 and stdint modules from gnulib. + * Makefile.in (base_obj): Remove md5.o, since this file + is in lib now. + * config.in: Regenerate. + * md5.h, md5.h: Move to ../lib. + * deps.mk (md5.o): Remove. + (fns.o): Depend on ../lib/md5.h, not md5.h. + +2011-02-19 Eli Zaretskii <eliz@gnu.org> + + * termcap.c (tputs): Don't declare baud_rate. + + * s/msdos.h (strtold): Define to _strtold. + +2011-02-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * process.c (Fstart_process, Fmake_serial_process) + (Fmake_network_process, server_accept_connection): + Use empty_unibyte_string. + + * alloc.c (make_unibyte_string): Don't SET_UNIBYTE redundantly. + + * lread.c (Qdir_ok): New constant. + (syms_of_lread): Initialize it. + (openp): Don't ignore directories if the predicate returns dir-ok. + +2011-02-18 Eli Zaretskii <eliz@gnu.org> + + * xdisp.c (display_line): Fix the change made for bug#7939. + + * terminal.c (create_terminal): Use default-keyboard-coding-system + and default-terminal-coding-system to initialize coding systems of + the new terminal. (Bug#7840) + +2011-02-18 Stefan Monnier <monnier@iro.umontreal.ca> + + * lisp.h (BYTE_MARK_STACK): New macro. + (mark_byte_stack): Only declare if BYTE_MARK_STACK is set. + + * bytecode.c (BYTE_MAINTAIN_TOP): New macros. + (struct byte_stack): Only define `top' and `bottom' if used. + (mark_byte_stack): Only define if used. + (BEFORE_POTENTIAL_GC, AFTER_POTENTIAL_GC): Nullify if BYTE_MAINTAIN_TOP + is not set. + (Fbyte_code): Don't set `bottom' unless BYTE_MAINTAIN_TOP is set. + + * term.c (OUTPUT_IF): Use OUTPUT. + + * alloc.c (Fgarbage_collect): When using stack scanning, don't + redundantly scan byte-code stacks, catchlist, and handlerlist. + +2011-02-17 Jan Djärv <jan.h.d@swipnet.se> + + * nsfns.m (Fx_create_frame, ns_set_name_as_filename) + (Fns_read_file_name): Replace B_ with BVAR. + + * nsterm.m (ns_term_init): Use KVAR. + +2011-02-16 Eli Zaretskii <eliz@gnu.org> + + * msdos.c (internal_terminal_init): Use KVAR. + + * w32fns.c (Fx_create_frame): Use KVAR. + + * w32term.c (w32_create_terminal): Use KVAR. + + * s/ms-w32.h (MODE_LINE_BINARY_TEXT): Remove. + (getloadavg): Declare prototype which was removed from lisp.h. + + * xdisp.c (decode_mode_spec): Don't use MODE_LINE_BINARY_TEXT. + + * fileio.c (Finsert_file_contents, Fwrite_region): + Remove references to buffer_file_type. + (syms_of_fileio): Don't intern and staticpro + find-buffer-file-type. + + * callproc.c (syms_of_callproc): Remove references to + buffer_file_type. + + * buffer.c (reset_buffer_local_variables): Don't set + buffer_file_type. + (init_buffer_once): Likewise. + (syms_of_buffer): Don't define buffer-file-type. + + * buffer.h (struct buffer): Remove buffer_file_type. + +2011-02-16 Tom Tromey <tromey@parfait> + + * callint.c (Fcall_interactively): Update for change to field names. + * doc.c (Fsubstitute_command_keys): Update for change to field names. + * cmds.c (Fself_insert_command): Update for change to field names. + * keymap.c (Fcurrent_active_maps, Fkey_binding) + (Fdescribe_buffer_bindings): Update for change to field names. + * macros.c (Fstart_kbd_macro, end_kbd_macro, Fend_kbd_macro) + (store_kbd_macro_char, Fcall_last_kbd_macro, Fexecute_kbd_macro): + Update for change to field names. + * keyboard.c (echo_char, echo_dash, echo_now, cancel_echoing) + (echo_length, echo_truncate, cmd_error, command_loop_1) + (read_char, kbd_buffer_store_event_hold, make_lispy_event) + (menu_bar_items, tool_bar_items, read_char_minibuf_menu_prompt) + (read_key_sequence, Fcommand_execute, Fexecute_extended_command) + (Fdiscard_input, init_kboard, init_keyboard, mark_kboards): + Update for change to field names. + * xfns.c (Fx_create_frame): Update for change to field names. + * xterm.c (x_connection_closed, x_term_init): Update for change to + field names. + * term.c (term_get_fkeys_1, CONDITIONAL_REASSIGN, init_tty): + Update for change to field names. + * window.c (window_scroll_pixel_based, window_scroll_line_based): + Update for change to field names. + * frame.c (make_frame_without_minibuffer, Fhandle_switch_frame) + (delete_frame): Update for change to field names. + * lisp.h (DEFVAR_KBOARD): Update for change to field names. + * keyboard.h (struct kboard): Rename all Lisp_Object fields. + (KBOARD_INTERNAL_FIELD, KVAR): New macros. + +2011-02-16 Tom Tromey <tromey@redhat.com> + + * lisp.h (DEFVAR_BUFFER_DEFAULTS): Use BVAR. + +2011-02-16 Tom Tromey <tromey@parfait> + + * xfns.c (x_create_tip_frame, Fx_show_tip): Replace B_ with BVAR. + * xfaces.c (compute_char_face): Replace B_ with BVAR. + * xdisp.c (pos_visible_p, init_iterator, reseat_1) + (message_dolog, update_echo_area, ensure_echo_area_buffers) + (with_echo_area_buffer, setup_echo_area_for_printing) + (set_message_1, update_menu_bar, update_tool_bar) + (text_outside_line_unchanged_p, redisplay_internal) + (try_scrolling, try_cursor_movement, redisplay_window) + (try_window_reusing_current_matrix, row_containing_pos) + (try_window_id, get_overlay_arrow_glyph_row, display_line) + (Fcurrent_bidi_paragraph_direction, display_mode_lines) + (decode_mode_spec_coding, decode_mode_spec, display_count_lines) + (get_window_cursor_type, note_mouse_highlight): Replace B_ with + BVAR. + * window.c (window_display_table, unshow_buffer, window_loop) + (window_min_size_2, set_window_buffer, Fset_window_buffer) + (select_window, Fforce_window_update, temp_output_buffer_show) + (Fset_window_configuration, save_window_save): Replace B_ with + BVAR. + * w32fns.c (x_create_tip_frame, Fx_show_tip, Fw32_shell_execute): + Replace B_ with BVAR. + * undo.c (record_point, record_insert, record_delete) + (record_marker_adjustment, record_first_change) + (record_property_change, Fundo_boundary, truncate_undo_list) + (Fprimitive_undo): Replace B_ with BVAR. + * syntax.h (Vstandard_syntax_table, CURRENT_SYNTAX_TABLE) + (SETUP_BUFFER_SYNTAX_TABLE): Replace B_ with BVAR. + * syntax.c (update_syntax_table, dec_bytepos, Fsyntax_table) + (Fset_syntax_table, Fmodify_syntax_entry, skip_chars) + (skip_syntaxes, scan_lists): Replace B_ with BVAR. + * search.c (compile_pattern_1, compile_pattern, looking_at_1) + (string_match_1, fast_looking_at, newline_cache_on_off) + (search_command, search_buffer, simple_search, boyer_moore) + (Freplace_match): Replace B_ with BVAR. + * process.c (get_process, list_processes_1, Fstart_process) + (Fmake_serial_process, Fmake_network_process) + (read_process_output, send_process, exec_sentinel) + (status_notify, setup_process_coding_systems): Replace B_ with + BVAR. + * print.c (PRINTDECLARE, PRINTPREPARE, PRINTFINISH, printchar) + (strout, print_string, temp_output_buffer_setup, print_object): + Replace B_ with BVAR. + * msdos.c (IT_frame_up_to_date): Replace B_ with BVAR. + * minibuf.c (read_minibuf, get_minibuffer, Fread_buffer): + Replace B_ with BVAR. + * marker.c (Fmarker_buffer, Fset_marker, set_marker_restricted) + (set_marker_both, set_marker_restricted_both, unchain_marker): + Replace B_ with BVAR. + * lread.c (readchar, unreadchar, openp, readevalloop) + (Feval_buffer, Feval_region): Replace B_ with BVAR. + * lisp.h (DOWNCASE_TABLE, UPCASE_TABLE): Replace B_ with BVAR. + * keymap.c (Flocal_key_binding, Fuse_local_map) + (Fcurrent_local_map, push_key_description) + (Fdescribe_buffer_bindings): Replace B_ with BVAR. + * keyboard.c (command_loop_1, read_char_minibuf_menu_prompt) + (read_key_sequence): Replace B_ with BVAR. + * intervals.h (TEXT_PROP_MEANS_INVISIBLE): Replace B_ with BVAR. + * intervals.c (set_point_both, get_local_map): Replace B_ with + BVAR. + * insdel.c (check_markers, insert_char, insert_1_both) + (insert_from_string_1, insert_from_gap, insert_from_buffer_1) + (adjust_after_replace, replace_range, del_range_2) + (modify_region, prepare_to_modify_buffer) + (Fcombine_after_change_execute): Replace B_ with BVAR. + * indent.c (buffer_display_table, recompute_width_table) + (width_run_cache_on_off, current_column, scan_for_column) + (Findent_to, position_indentation, compute_motion, vmotion): + Replace B_ with BVAR. + * fringe.c (get_logical_cursor_bitmap) + (get_logical_fringe_bitmap, update_window_fringes): Replace B_ + with BVAR. + * frame.c (make_frame_visible_1): Replace B_ with BVAR. + * font.c (font_at): Replace B_ with BVAR. + * fns.c (Fbase64_encode_region, Fbase64_decode_region, Fmd5): + Replace B_ with BVAR. + * filelock.c (unlock_all_files, Flock_buffer, Funlock_buffer) + (unlock_buffer): Replace B_ with BVAR. + * fileio.c (Fexpand_file_name, Ffile_directory_p) + (Ffile_regular_p, Ffile_selinux_context) + (Fset_file_selinux_context, Ffile_modes, Fset_file_modes) + (Fset_file_times, Ffile_newer_than_file_p, decide_coding_unwind) + (Finsert_file_contents, choose_write_coding_system) + (Fwrite_region, build_annotations, Fverify_visited_file_modtime) + (Fset_visited_file_modtime, auto_save_error, auto_save_1) + (Fdo_auto_save, Fset_buffer_auto_saved): Replace B_ with BVAR. + * editfns.c (region_limit, Fmark_marker, save_excursion_save) + (save_excursion_restore, Fprevious_char, Fchar_before) + (general_insert_function, Finsert_char, Finsert_byte) + (make_buffer_string_both, Finsert_buffer_substring) + (Fcompare_buffer_substrings, subst_char_in_region_unwind) + (subst_char_in_region_unwind_1, Fsubst_char_in_region) + (Ftranslate_region_internal, save_restriction_restore) + (Fchar_equal): Replace B_ with BVAR. + * dispnew.c (Fframe_or_buffer_changed_p): Replace B_ with BVAR. + * dispextern.h (WINDOW_WANTS_MODELINE_P) + (WINDOW_WANTS_HEADER_LINE_P): Replace B_ with BVAR. + * dired.c (directory_files_internal): Replace B_ with BVAR. + * data.c (swap_in_symval_forwarding, set_internal) + (Fmake_local_variable, Fkill_local_variable, Flocal_variable_p): + Replace B_ with BVAR. + * composite.c (fill_gstring_header) + (composition_compute_stop_pos, composition_adjust_point) + (Ffind_composition_internal): Replace B_ with BVAR. + * coding.c (decode_coding, encode_coding) + (make_conversion_work_buffer, decode_coding_gap) + (decode_coding_object, encode_coding_object) + (Fdetect_coding_region, Ffind_coding_systems_region_internal) + (Funencodable_char_position, Fcheck_coding_systems_region): + Replace B_ with BVAR. + * cmds.c (Fself_insert_command, internal_self_insert): Replace B_ + with BVAR. + * charset.c (Ffind_charset_region): Replace B_ with BVAR. + * character.h (FETCH_CHAR_ADVANCE, INC_BOTH, DEC_BOTH) + (ASCII_CHAR_WIDTH): Replace B_ with BVAR. + * character.c (chars_in_text, Fget_byte): Replace B_ with BVAR. + * category.h (Vstandard_category_table): Replace B_ with BVAR. + * category.c (check_category_table, Fcategory_table) + (Fset_category_table, char_category_set): Replace B_ with BVAR. + * casetab.c (Fcurrent_case_table, set_case_table): Replace B_ with + BVAR. + * casefiddle.c (casify_object, casify_region): Replace B_ with + BVAR. + * callproc.c (Fcall_process, Fcall_process_region): Replace B_ + with BVAR. + * callint.c (check_mark, Fcall_interactively): Replace B_ with + BVAR. + * bytecode.c (Fbyte_code): Replace B_ with BVAR. + * buffer.h (FETCH_CHAR, FETCH_CHAR_AS_MULTIBYTE, BVAR): Replace B_ + with BVAR. + * buffer.c (Fbuffer_live_p, Fget_file_buffer) + (get_truename_buffer, Fget_buffer_create) + (clone_per_buffer_values, Fmake_indirect_buffer, reset_buffer) + (reset_buffer_local_variables, Fbuffer_name, Fbuffer_file_name) + (Fbuffer_local_value, buffer_lisp_local_variables) + (Fset_buffer_modified_p, Frestore_buffer_modified_p) + (Frename_buffer, Fother_buffer, Fbuffer_enable_undo) + (Fkill_buffer, Fset_buffer_major_mode, set_buffer_internal_1) + (set_buffer_temp, Fset_buffer, set_buffer_if_live) + (Fbarf_if_buffer_read_only, Fbury_buffer, Ferase_buffer) + (Fbuffer_swap_text, swapfield_, Fbuffer_swap_text) + (Fset_buffer_multibyte, swap_out_buffer_local_variables) + (record_overlay_string, overlay_strings, init_buffer_once) + (init_buffer, syms_of_buffer): Replace B_ with BVAR. + +2011-02-16 Eli Zaretskii <eliz@gnu.org> + + * xdisp.c (redisplay_internal): Resynchronize `w' if the selected + window is changed inside calls to do_pending_window_change. + (Bug#8020) + +2011-02-16 Paul Eggert <eggert@cs.ucla.edu> + + Remove no-longer needed getloadavg symbols. + * m/alpha.h (LOAD_AVE_TYPE, LOAD_AVE_CVT): Remove. + * m/amdx86-64.h (LOAD_AVE_TYPE, LOAD_AVE_CVT): Remove. + * m/ia64.h (LOAD_AVE_TYPE, LOAD_AVE_CVT): Remove. + * m/ibms390.h (LOAD_AVE_TYPE, LOAD_AVE_CVT): Remove. + * m/macppc.h (LOAD_AVE_TYPE, LOAD_AVE_CVT): Remove. + * m/sparc.h (LOAD_AVE_TYPE, LOAD_AVE_CVT): Remove. + * m/template.h (LOAD_AVE_TYPE, LOAD_AVE_CVT): Remove. + * m/vax.h (LOAD_AVE_TYPE, LOAD_AVE_CVT): Remove. + * s/aix4-2.h (KERNEL_FILE, LDAV_SYMBOL): Remove. + * s/bsd-common.h (KERNEL_FILE, LDAV_SYMBOL): Remove #undef. + * s/hpux10-20.h (KERNEL_FILE, LOAD_AVE_TYPE, LOAD_AVE_CVT): + (LDAV_SYMBOL): Remove. + * s/unixware.h (LOAD_AVE_TYPE, LOAD_AVE_CVT, FSCALE): Remove. + * s/usg5-4-common.h (KERNEL_FILE, LDAV_SYMBOL): Remove. + + Import getloadavg module from gnulib. + * deps.mk (getloadavg.o): Remove; gnulib now does this. + * lisp.h (getloadavg) [!defined HAVE_GETLOADAVG]: Remove; gnulib + now does this. + * src/s/freebsd.h (HAVE_GETLOADAVG): Remove; gnulib now does this. + * src/s/netbsd.h (HAVE_GETLOADAVG): Likewise. + * config.in: Regenerate. + +2011-02-15 Eli Zaretskii <eliz@gnu.org> + + * nsfns.m (ns_set_name_as_filename, Fns_read_file_name): Use B_. + +2011-02-14 Michael Welsh Duggan <md5i@md5i.com> + + * print.c (float_to_string): Ensure that a decimal point is + printed if using dtoastr (Bug#8033). + +2011-02-14 Eli Zaretskii <eliz@gnu.org> + + * msdos.c (IT_frame_up_to_date): + * s/msdos.h (MODE_LINE_BINARY_TEXT): Use B_ for the MS-DOS build. + + * dired.c (directory_files_internal): + * fileio.c (Finsert_file_contents): + * insdel.c (prepare_to_modify_buffer): + * xdisp.c (pos_visible_p): + * s/ms-w32.h (MODE_LINE_BINARY_TEXT): + * w32fns.c (Fw32_shell_execute, Fx_show_tip, x_create_tip_frame): + Use B_ for the MS-Windows build. + +2011-02-14 Jan Djärv <jan.h.d@swipnet.se> + + * xrdb.c (x_load_resources): For LUCID and XFT, don't put a + resource that specifies helvetica for menus and dialogs. + + * xmenu.c (apply_systemfont_to_dialog): Apply to *dialog.font. + (apply_systemfont_to_menu): Set resources *menubar*font and + *popup*font. Remove defflt. + (set_frame_menubar, create_and_show_popup_menu): + Call apply_systemfont_to_menu before lw_create_widget. + +2011-02-14 Tom Tromey <tromey@redhat.com> + + * buffer.c (init_buffer_once, syms_of_buffer): Use B_ in DOS_NT case. + + * keyboard.h: Remove obsolete comment. + +2011-02-14 Tom Tromey <tromey@parfait> + + * composite.c (fill_gstring_header) + (composition_compute_stop_pos, composition_adjust_point) + (Ffind_composition_internal): Use B_. + * intervals.c (set_point_both, get_local_map): Use B_. + * callproc.c (Fcall_process, Fcall_process_region): Use B_. + * process.c (get_process, list_processes_1, Fstart_process) + (Fmake_serial_process, Fmake_network_process) + (read_process_output, send_process, exec_sentinel) + (status_notify, setup_process_coding_systems): Use B_. + * bytecode.c (Fbyte_code): Use B_. + * syntax.c (update_syntax_table, dec_bytepos, Fsyntax_table) + (Fset_syntax_table, Fmodify_syntax_entry, skip_chars) + (skip_syntaxes, scan_lists): Use B_. + * lread.c (readchar, unreadchar, openp, readevalloop) + (Feval_buffer, Feval_region): Use B_. + * print.c (printchar, strout, print_string, PRINTDECLARE) + (PRINTPREPARE, PRINTFINISH, temp_output_buffer_setup) + (print_object): Use B_. + * font.c (font_at): Use B_. + * fns.c (Fbase64_encode_region, Fbase64_decode_region, Fmd5): + Use B_. + * callint.c (check_mark, Fcall_interactively): Use B_. + * editfns.c (region_limit, Fmark_marker, save_excursion_save) + (save_excursion_restore, Fprevious_char, Fchar_before) + (general_insert_function, Finsert_char, Finsert_byte) + (make_buffer_string_both, Finsert_buffer_substring) + (Fcompare_buffer_substrings, subst_char_in_region_unwind) + (subst_char_in_region_unwind_1, Fsubst_char_in_region) + (Ftranslate_region_internal, save_restriction_restore) + (Fchar_equal): Use B_. + * data.c (swap_in_symval_forwarding, set_internal) + (Fmake_local_variable, Fkill_local_variable, Flocal_variable_p): + Use B_. + * undo.c (record_point, record_insert, record_delete) + (record_marker_adjustment, record_first_change) + (record_property_change, Fundo_boundary, truncate_undo_list) + (Fprimitive_undo): Use B_. + * search.c (compile_pattern_1, compile_pattern, looking_at_1) + (string_match_1, fast_looking_at, newline_cache_on_off) + (search_command, search_buffer, simple_search, boyer_moore) + (Freplace_match): Use B_. + * indent.c (buffer_display_table, recompute_width_table) + (width_run_cache_on_off, current_column, scan_for_column) + (Findent_to, position_indentation, compute_motion, vmotion): + Use B_. + * casefiddle.c (casify_object, casify_region): Use B_. + * casetab.c (Fcurrent_case_table, set_case_table): Use B_. + * cmds.c (Fself_insert_command, internal_self_insert): Use B_. + * fileio.c (Fexpand_file_name, Ffile_directory_p) + (Ffile_regular_p, Ffile_selinux_context) + (Fset_file_selinux_context, Ffile_modes, Fset_file_modes) + (Fset_file_times, Ffile_newer_than_file_p, decide_coding_unwind) + (Finsert_file_contents, choose_write_coding_system) + (Fwrite_region, build_annotations, Fverify_visited_file_modtime) + (Fset_visited_file_modtime, auto_save_error, auto_save_1) + (Fdo_auto_save, Fset_buffer_auto_saved): Use B_. + * minibuf.c (read_minibuf, get_minibuffer, Fread_buffer): Use B_. + * marker.c (Fmarker_buffer, Fset_marker, set_marker_restricted) + (set_marker_both, set_marker_restricted_both, unchain_marker): + Use B_. + * insdel.c (check_markers, insert_char, insert_1_both) + (insert_from_string_1, insert_from_gap, insert_from_buffer_1) + (adjust_after_replace, replace_range, del_range_2) + (modify_region, prepare_to_modify_buffer) + (Fcombine_after_change_execute): Use B_. + * filelock.c (unlock_all_files, Flock_buffer, Funlock_buffer) + (unlock_buffer): Use B_. + * keymap.c (Flocal_key_binding, Fuse_local_map) + (Fcurrent_local_map, push_key_description) + (Fdescribe_buffer_bindings): Use B_. + * keyboard.c (command_loop_1, read_char_minibuf_menu_prompt) + (read_key_sequence): Use B_. + * fringe.c (get_logical_cursor_bitmap) + (get_logical_fringe_bitmap, update_window_fringes): Use B_. + * xfns.c (x_create_tip_frame, Fx_show_tip): Use B_. + * xfaces.c (compute_char_face): Use B_. + * character.c (chars_in_text, Fget_byte): Use B_. + * category.c (check_category_table, Fcategory_table) + (Fset_category_table, char_category_set): Use B_. + * coding.c (decode_coding, encode_coding) + (make_conversion_work_buffer, decode_coding_gap) + (decode_coding_object, encode_coding_object) + (Fdetect_coding_region, Ffind_coding_systems_region_internal) + (Funencodable_char_position, Fcheck_coding_systems_region): + Use B_. + * charset.c (Ffind_charset_region): Use B_. + * window.c (window_display_table, unshow_buffer, window_loop) + (window_min_size_2, set_window_buffer, Fset_window_buffer) + (select_window, Fforce_window_update, temp_output_buffer_show) + (Fset_window_configuration, save_window_save): Use B_. + * xdisp.c (pos_visible_p, init_iterator, reseat_1) + (message_dolog, update_echo_area, ensure_echo_area_buffers) + (with_echo_area_buffer, setup_echo_area_for_printing) + (set_message_1, update_menu_bar, update_tool_bar) + (text_outside_line_unchanged_p, redisplay_internal) + (try_scrolling, try_cursor_movement, redisplay_window) + (try_window_reusing_current_matrix, row_containing_pos) + (try_window_id, get_overlay_arrow_glyph_row, display_line) + (Fcurrent_bidi_paragraph_direction, display_mode_lines) + (decode_mode_spec_coding, decode_mode_spec, display_count_lines) + (get_window_cursor_type, note_mouse_highlight): Use B_. + * frame.c (make_frame_visible_1): Use B_. + * dispnew.c (Fframe_or_buffer_changed_p): Use B_. + * dispextern.h (WINDOW_WANTS_HEADER_LINE_P) + (WINDOW_WANTS_MODELINE_P): Use B_. + * syntax.h (Vstandard_syntax_table): Update. + (CURRENT_SYNTAX_TABLE, SETUP_BUFFER_SYNTAX_TABLE): Use B_. + * intervals.h (TEXT_PROP_MEANS_INVISIBLE): Update. + (TEXT_PROP_MEANS_INVISIBLE): Use B_. + * character.h (FETCH_CHAR_ADVANCE): Update. + (INC_BOTH, ASCII_CHAR_WIDTH, DEC_BOTH): Use B_. + * category.h (Vstandard_category_table): Update. + * lisp.h (DEFVAR_BUFFER_DEFAULTS): Update for change to field + names. + (DOWNCASE_TABLE, UPCASE_TABLE): Use B_. + * buffer.c (swapfield_): New macro. + (Fbuffer_swap_text): Use swapfield_ where appropriate. + (Fbuffer_live_p, Fget_file_buffer, get_truename_buffer) + (Fget_buffer_create, clone_per_buffer_values) + (Fmake_indirect_buffer, reset_buffer) + (reset_buffer_local_variables, Fbuffer_name, Fbuffer_file_name) + (Fbuffer_local_value, buffer_lisp_local_variables) + (Fset_buffer_modified_p, Frestore_buffer_modified_p) + (Frename_buffer, Fother_buffer, Fbuffer_enable_undo) + (Fkill_buffer, Fset_buffer_major_mode, set_buffer_internal_1) + (set_buffer_temp, Fset_buffer, set_buffer_if_live) + (Fbarf_if_buffer_read_only, Fbury_buffer, Ferase_buffer) + (Fbuffer_swap_text, Fset_buffer_multibyte) + (swap_out_buffer_local_variables, record_overlay_string) + (overlay_strings, init_buffer_once, init_buffer, syms_of_buffer): + Use B_. + * buffer.h (struct buffer): Rename all Lisp_Object fields. + (BUFFER_INTERNAL_FIELD, B_): New macro. + (FETCH_CHAR, FETCH_CHAR_AS_MULTIBYTE): Use B_. + +2011-02-14 Jan Djärv <jan.h.d@swipnet.se> + + * gtkutil.c (xg_tool_bar_menu_proxy): Handle case when tool bar label + is null. + +2011-02-13 Jan Djärv <jan.h.d@swipnet.se> + + * callproc.c (Fcall_process): + * process.c (create_process): Replace Gtk with GConf in SIGPIPE + comment. + +2011-02-12 Martin Rudalics <rudalics@gmx.at> + + * window.c (select_window): Check inhibit_point_swap argument when + deciding whether to return immediately. + +2011-02-12 Jan Djärv <jan.h.d@swipnet.se> + + * nsterm.m (setFrame, initFrame): Make sure pixel_height doesn't become + zero (Bug#7348). + +2011-02-12 Chong Yidong <cyd@stupidchicken.com> + + * config.in (TERMINFO): New definition. + + * s/netbsd.h: Use it to choose between terminfo and termcap + (Bug#7642). + +2011-02-12 Paul Eggert <eggert@cs.ucla.edu> + + * md5.c (md5_process_bytes): Use sizeof, not __alignof__. + The difference doesn't matter here, in practice, and sizeof is + more portable to non-GCC compilers. Also, this makes the code + match the already-existing comment. + +2011-02-12 Andreas Schwab <schwab@linux-m68k.org> + + * process.c (create_process): Reset SIGPIPE handler in the child. + * callproc.c (Fcall_process): Likewise. (Bug#5238) + +2011-02-12 Eli Zaretskii <eliz@gnu.org> + + * xdisp.c <this_line_min_pos>: New variable. + (move_it_in_display_line_to): Record in this_line_min_pos the + smallest position iterated across. + (display_line): Use this_line_min_pos to record the smallest + position in the line even if it is not displayed due to + hscrolling. (Bug#7939) + +2011-02-12 Paul Eggert <eggert@cs.ucla.edu> + + Port to Sun C 5.11, which has __attribute__ ((__aligned (N))). + * md5.h (ATTRIBUTE_ALIGNED): New macro. + (struct md5_ctx): Use it. + + Port to Solaris 10, which doesn't support FC_HINT_STYLE. + * xftfont.c (FC_HINT_STYLE): #define to "hintstyle" if not + defined. + * xsettings.c (parse_settings, apply_xft_settings): Don't assume + FC_HINT_STYLE is supported. + +2011-02-11 Jan Djärv <jan.h.d@swipnet.se> + + * xterm.c (x_set_frame_alpha): Access data before it is free:d. + Make sure we don't do x_catch_errors twice. + 2011-02-10 Glenn Morris <rgm@gnu.org> * Makefile.in (really-lwlib): Depend on globals.h, for parallel builds. @@ -112,8 +683,8 @@ callers changed. * editfns.c (general_insert_function): Change signature to match changes to insert functions' signatures. - * keymap.c (map_keymap_char_table_item, map_keymap_internal): Use - explicit cast when converting between void * and function pointer + * keymap.c (map_keymap_char_table_item, map_keymap_internal): + Use explicit cast when converting between void * and function pointer types, as C89 requires this. 2011-02-05 Paul Eggert <eggert@cs.ucla.edu> @@ -233,7 +804,7 @@ 2011-02-01 Paul Eggert <eggert@cs.ucla.edu> format-time-string now supports subsecond time stamp resolution - * editfns.c (emacs_nmemftime): Renamed from emacs_memftimeu, + * editfns.c (emacs_nmemftime): Rename from emacs_memftimeu, for consistency with its new argument and with gnulib nstrftime. All callers changed. New argument NS. (Fformat_time_string): Check that the time argument's microseconds @@ -563,11 +1134,11 @@ (history_delete_duplicates, inhibit_x_resources) (last_nonmenu_event, load_in_progress, max_specpdl_size) (minibuffer_auto_raise, print_escape_newlines, scroll_margin) - (use_dialog_box, use_file_dialog): Remove declaration. Include - globals.h. + (use_dialog_box, use_file_dialog): Remove declaration. + Include globals.h. * keymap.h (Voverriding_local_map) - (Voverriding_local_map_menu_flag, meta_prefix_char): Remove - declaration. + (Voverriding_local_map_menu_flag, meta_prefix_char): + Remove declaration. * keyboard.h (Vdouble_click_time, Vfunction_key_map) (Vinput_method_function, Vkey_translation_map) (Vlucid_menu_bar_dirty_flag, Vthis_original_command) @@ -585,16 +1156,16 @@ (focus_follows_mouse): Remove declaration. * fontset.h (Valternate_fontname_alist, Vfontset_alias_alist) (Vignore_relative_composition, Votf_script_alist) - (Vuse_default_ascent, Vvertical_centering_font_regexp): Remove - declaration. + (Vuse_default_ascent, Vvertical_centering_font_regexp): + Remove declaration. * font.h (Vfont_log): Remove declaration. * dosfns.h (Vdos_display_scancodes, Vdos_version) (Vdos_windows_version, dos_codepage, dos_country_code) (dos_decimal_point, dos_hyper_key, dos_keyboard_layout) - (dos_keypad_mode, dos_super_key, dos_timezone_offset): Remove - declaration. - * disptab.h (Vglyph_table, Vstandard_display_table): Remove - declaration. + (dos_keypad_mode, dos_super_key, dos_timezone_offset): + Remove declaration. + * disptab.h (Vglyph_table, Vstandard_display_table): + Remove declaration. * dispextern.h (Vface_remapping_alist, Vglyphless_char_display) (Vmouse_autoselect_window, Voverflow_newline_into_fringe) (Vshow_trailing_whitespace, Vtool_bar_button_margin) @@ -622,10 +1193,10 @@ (Vselect_safe_coding_system_function) (Vtranslation_table_for_input, coding_system_require_warning) (eol_mnemonic_dos, eol_mnemonic_mac, eol_mnemonic_undecided) - (eol_mnemonic_unix, inherit_process_coding_system): Remove - declaration. - * charset.h (Vcharset_list, Vcurrent_iso639_language): Remove - declaration. + (eol_mnemonic_unix, inherit_process_coding_system): + Remove declaration. + * charset.h (Vcharset_list, Vcurrent_iso639_language): + Remove declaration. * character.h (Vauto_fill_chars, Vchar_direction_table) (Vchar_script_table, Vchar_width_table, Vprintable_chars) (Vscript_representative_chars, Vtranslation_table_vector) @@ -740,8 +1311,8 @@ (w32_strict_fontnames, w32_strict_painting): Remove. (Vhourglass_delay, Vmenu_bar_mode, Vtool_bar_mode) (Vw32_recognize_altgr, Vwindow_system_version) - (w32_num_mouse_buttons, w32_use_visible_system_caret): Remove - declaration. + (w32_num_mouse_buttons, w32_use_visible_system_caret): + Remove declaration. * w32console.c (syms_of_ntterm): Update. (w32_use_full_screen_buffer): Remove. (Vtty_defined_color_alist): Remove declaration. @@ -1572,7 +2143,7 @@ * gtkutil.c (menubar_map_cb): New function (Bug#7425). (xg_update_frame_menubar): Connect signal map to menubar_map_cb. - Use 23 as menubar height if 0. (Bug#7425). + Use 23 as menubar height if 0. (Bug#7425). 2010-11-26 Eli Zaretskii <eliz@gnu.org> @@ -2579,7 +3150,7 @@ is more portable. * keyboard.c (gobble_input): Move call of xd_read_queued_messages ... - (kbd_buffer_get_event): ... here. This is needed for cygwin, which + (kbd_buffer_get_event): ... here. This is needed for cygwin, which has not defined SIGIO. 2010-10-08 Chong Yidong <cyd@stupidchicken.com> diff --git a/src/Makefile.in b/src/Makefile.in index fda65be7084..e1195968f7f 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -347,14 +347,14 @@ base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ cm.o term.o terminal.o xfaces.o $(XOBJ) $(GTK_OBJ) $(DBUS_OBJ) \ emacs.o keyboard.o macros.o keymap.o sysdep.o \ buffer.o filelock.o insdel.o marker.o \ - minibuf.o fileio.o dired.o filemode.o \ + minibuf.o fileio.o dired.o \ cmds.o casetab.o casefiddle.o indent.o search.o regex.o undo.o \ alloc.o data.o doc.o editfns.o callint.o \ eval.o floatfns.o fns.o font.o print.o lread.o \ syntax.o $(UNEXEC_OBJ) bytecode.o \ process.o gnutls.o callproc.o \ region-cache.o sound.o atimer.o \ - doprnt.o intervals.o textprop.o composite.o md5.o xml.o \ + doprnt.o intervals.o textprop.o composite.o xml.o \ $(MSDOS_OBJ) $(MSDOS_X_OBJ) $(NS_OBJ) $(CYGWIN_OBJ) $(FONT_OBJ) obj = $(base_obj) $(NS_OBJC_OBJ) diff --git a/src/alloc.c b/src/alloc.c index 4c29ce0b4ec..81a17b5c13b 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2301,7 +2301,6 @@ make_unibyte_string (const char *contents, EMACS_INT length) register Lisp_Object val; val = make_uninit_string (length); memcpy (SDATA (val), contents, length); - STRING_SET_UNIBYTE (val); return val; } @@ -3943,7 +3942,7 @@ live_buffer_p (struct mem_node *m, void *p) must not have been killed. */ return (m->type == MEM_TYPE_BUFFER && p == m->start - && !NILP (((struct buffer *) p)->name)); + && !NILP (((struct buffer *) p)->BUFFER_INTERNAL_FIELD (name))); } #endif /* GC_MARK_STACK || defined GC_MALLOC_CHECK */ @@ -4899,8 +4898,6 @@ returns nil, because real GC can't be done. */) (void) { register struct specbinding *bind; - struct catchtag *catch; - struct handler *handler; char stack_top_variable; register int i; int message_p; @@ -4929,11 +4926,11 @@ returns nil, because real GC can't be done. */) turned off in that buffer. Calling truncate_undo_list on Qt tends to return NULL, which effectively turns undo back on. So don't call truncate_undo_list if undo_list is Qt. */ - if (! NILP (nextb->name) && ! EQ (nextb->undo_list, Qt)) + if (! NILP (nextb->BUFFER_INTERNAL_FIELD (name)) && ! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt)) truncate_undo_list (nextb); /* Shrink buffer gaps, but skip indirect and dead buffers. */ - if (nextb->base_buffer == 0 && !NILP (nextb->name) + if (nextb->base_buffer == 0 && !NILP (nextb->BUFFER_INTERNAL_FIELD (name)) && ! nextb->text->inhibit_shrinking) { /* If a buffer's gap size is more than 10% of the buffer @@ -5030,7 +5027,9 @@ returns nil, because real GC can't be done. */) mark_object (tail->var[i]); } mark_byte_stack (); -#endif + { + struct catchtag *catch; + struct handler *handler; for (catch = catchlist; catch; catch = catch->next) { @@ -5042,7 +5041,9 @@ returns nil, because real GC can't be done. */) mark_object (handler->handler); mark_object (handler->var); } + } mark_backtrace (); +#endif #ifdef HAVE_WINDOW_SYSTEM mark_fringe_data (); @@ -5066,10 +5067,10 @@ returns nil, because real GC can't be done. */) turned off in that buffer. Calling truncate_undo_list on Qt tends to return NULL, which effectively turns undo back on. So don't call truncate_undo_list if undo_list is Qt. */ - if (! EQ (nextb->undo_list, Qt)) + if (! EQ (nextb->BUFFER_INTERNAL_FIELD (undo_list), Qt)) { Lisp_Object tail, prev; - tail = nextb->undo_list; + tail = nextb->BUFFER_INTERNAL_FIELD (undo_list); prev = Qnil; while (CONSP (tail)) { @@ -5078,7 +5079,7 @@ returns nil, because real GC can't be done. */) && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit) { if (NILP (prev)) - nextb->undo_list = tail = XCDR (tail); + nextb->BUFFER_INTERNAL_FIELD (undo_list) = tail = XCDR (tail); else { tail = XCDR (tail); @@ -5094,7 +5095,7 @@ returns nil, because real GC can't be done. */) } /* Now that we have stripped the elements that need not be in the undo_list any more, we can finally mark the list. */ - mark_object (nextb->undo_list); + mark_object (nextb->BUFFER_INTERNAL_FIELD (undo_list)); nextb = nextb->next; } @@ -5652,7 +5653,7 @@ mark_buffer (Lisp_Object buf) /* buffer-local Lisp variables start at `undo_list', tho only the ones from `name' on are GC'd normally. */ - for (ptr = &buffer->name; + for (ptr = &buffer->BUFFER_INTERNAL_FIELD (name); (char *)ptr < (char *)buffer + sizeof (struct buffer); ptr++) mark_object (*ptr); diff --git a/src/buffer.c b/src/buffer.c index 5229f899e65..1b413ccb8b0 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -162,7 +162,7 @@ DEFUN ("buffer-live-p", Fbuffer_live_p, Sbuffer_live_p, 1, 1, 0, Value is nil if OBJECT is not a buffer or if it has been killed. */) (Lisp_Object object) { - return ((BUFFERP (object) && ! NILP (XBUFFER (object)->name)) + return ((BUFFERP (object) && ! NILP (BVAR (XBUFFER (object), name))) ? Qt : Qnil); } @@ -266,8 +266,8 @@ See also `find-buffer-visiting'. */) { buf = Fcdr (XCAR (tail)); if (!BUFFERP (buf)) continue; - if (!STRINGP (XBUFFER (buf)->filename)) continue; - tem = Fstring_equal (XBUFFER (buf)->filename, filename); + if (!STRINGP (BVAR (XBUFFER (buf), filename))) continue; + tem = Fstring_equal (BVAR (XBUFFER (buf), filename), filename); if (!NILP (tem)) return buf; } @@ -283,8 +283,8 @@ get_truename_buffer (register Lisp_Object filename) { buf = Fcdr (XCAR (tail)); if (!BUFFERP (buf)) continue; - if (!STRINGP (XBUFFER (buf)->file_truename)) continue; - tem = Fstring_equal (XBUFFER (buf)->file_truename, filename); + if (!STRINGP (BVAR (XBUFFER (buf), file_truename))) continue; + tem = Fstring_equal (BVAR (XBUFFER (buf), file_truename), filename); if (!NILP (tem)) return buf; } @@ -353,7 +353,7 @@ even if it is dead. The return value is never nil. */) b->newline_cache = 0; b->width_run_cache = 0; - b->width_table = Qnil; + BVAR (b, width_table) = Qnil; b->prevent_redisplay_optimizations_p = 1; /* Put this on the chain of all buffers including killed ones. */ @@ -362,22 +362,22 @@ even if it is dead. The return value is never nil. */) /* An ordinary buffer normally doesn't need markers to handle BEGV and ZV. */ - b->pt_marker = Qnil; - b->begv_marker = Qnil; - b->zv_marker = Qnil; + BVAR (b, pt_marker) = Qnil; + BVAR (b, begv_marker) = Qnil; + BVAR (b, zv_marker) = Qnil; name = Fcopy_sequence (buffer_or_name); STRING_SET_INTERVALS (name, NULL_INTERVAL); - b->name = name; + BVAR (b, name) = name; - b->undo_list = (SREF (name, 0) != ' ') ? Qnil : Qt; + BVAR (b, undo_list) = (SREF (name, 0) != ' ') ? Qnil : Qt; reset_buffer (b); reset_buffer_local_variables (b, 1); - b->mark = Fmake_marker (); + BVAR (b, mark) = Fmake_marker (); BUF_MARKERS (b) = NULL; - b->name = name; + BVAR (b, name) = name; /* Put this in the alist of all live buffers. */ XSETBUFFER (buffer, b); @@ -486,7 +486,7 @@ clone_per_buffer_values (struct buffer *from, struct buffer *to) /* Get (a copy of) the alist of Lisp-level local variables of FROM and install that in TO. */ - to->local_var_alist = buffer_lisp_local_variables (from); + BVAR (to, local_var_alist) = buffer_lisp_local_variables (from); } DEFUN ("make-indirect-buffer", Fmake_indirect_buffer, Smake_indirect_buffer, @@ -512,7 +512,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */) base_buffer = Fget_buffer (base_buffer); if (NILP (base_buffer)) error ("No such buffer: `%s'", SDATA (tem)); - if (NILP (XBUFFER (base_buffer)->name)) + if (NILP (BVAR (XBUFFER (base_buffer), name))) error ("Base buffer has been killed"); if (SCHARS (name) == 0) @@ -536,7 +536,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */) b->newline_cache = 0; b->width_run_cache = 0; - b->width_table = Qnil; + BVAR (b, width_table) = Qnil; /* Put this on the chain of all buffers including killed ones. */ b->next = all_buffers; @@ -544,7 +544,7 @@ CLONE nil means the indirect buffer's state is reset to default values. */) name = Fcopy_sequence (name); STRING_SET_INTERVALS (name, NULL_INTERVAL); - b->name = name; + BVAR (b, name) = name; reset_buffer (b); reset_buffer_local_variables (b, 1); @@ -553,57 +553,57 @@ CLONE nil means the indirect buffer's state is reset to default values. */) XSETBUFFER (buf, b); Vbuffer_alist = nconc2 (Vbuffer_alist, Fcons (Fcons (name, buf), Qnil)); - b->mark = Fmake_marker (); - b->name = name; + BVAR (b, mark) = Fmake_marker (); + BVAR (b, name) = name; /* The multibyte status belongs to the base buffer. */ - b->enable_multibyte_characters = b->base_buffer->enable_multibyte_characters; + BVAR (b, enable_multibyte_characters) = BVAR (b->base_buffer, enable_multibyte_characters); /* Make sure the base buffer has markers for its narrowing. */ - if (NILP (b->base_buffer->pt_marker)) + if (NILP (BVAR (b->base_buffer, pt_marker))) { - b->base_buffer->pt_marker = Fmake_marker (); - set_marker_both (b->base_buffer->pt_marker, base_buffer, + BVAR (b->base_buffer, pt_marker) = Fmake_marker (); + set_marker_both (BVAR (b->base_buffer, pt_marker), base_buffer, BUF_PT (b->base_buffer), BUF_PT_BYTE (b->base_buffer)); } - if (NILP (b->base_buffer->begv_marker)) + if (NILP (BVAR (b->base_buffer, begv_marker))) { - b->base_buffer->begv_marker = Fmake_marker (); - set_marker_both (b->base_buffer->begv_marker, base_buffer, + BVAR (b->base_buffer, begv_marker) = Fmake_marker (); + set_marker_both (BVAR (b->base_buffer, begv_marker), base_buffer, BUF_BEGV (b->base_buffer), BUF_BEGV_BYTE (b->base_buffer)); } - if (NILP (b->base_buffer->zv_marker)) + if (NILP (BVAR (b->base_buffer, zv_marker))) { - b->base_buffer->zv_marker = Fmake_marker (); - set_marker_both (b->base_buffer->zv_marker, base_buffer, + BVAR (b->base_buffer, zv_marker) = Fmake_marker (); + set_marker_both (BVAR (b->base_buffer, zv_marker), base_buffer, BUF_ZV (b->base_buffer), BUF_ZV_BYTE (b->base_buffer)); - XMARKER (b->base_buffer->zv_marker)->insertion_type = 1; + XMARKER (BVAR (b->base_buffer, zv_marker))->insertion_type = 1; } if (NILP (clone)) { /* Give the indirect buffer markers for its narrowing. */ - b->pt_marker = Fmake_marker (); - set_marker_both (b->pt_marker, buf, BUF_PT (b), BUF_PT_BYTE (b)); - b->begv_marker = Fmake_marker (); - set_marker_both (b->begv_marker, buf, BUF_BEGV (b), BUF_BEGV_BYTE (b)); - b->zv_marker = Fmake_marker (); - set_marker_both (b->zv_marker, buf, BUF_ZV (b), BUF_ZV_BYTE (b)); - XMARKER (b->zv_marker)->insertion_type = 1; + BVAR (b, pt_marker) = Fmake_marker (); + set_marker_both (BVAR (b, pt_marker), buf, BUF_PT (b), BUF_PT_BYTE (b)); + BVAR (b, begv_marker) = Fmake_marker (); + set_marker_both (BVAR (b, begv_marker), buf, BUF_BEGV (b), BUF_BEGV_BYTE (b)); + BVAR (b, zv_marker) = Fmake_marker (); + set_marker_both (BVAR (b, zv_marker), buf, BUF_ZV (b), BUF_ZV_BYTE (b)); + XMARKER (BVAR (b, zv_marker))->insertion_type = 1; } else { struct buffer *old_b = current_buffer; clone_per_buffer_values (b->base_buffer, b); - b->filename = Qnil; - b->file_truename = Qnil; - b->display_count = make_number (0); - b->backed_up = Qnil; - b->auto_save_file_name = Qnil; + BVAR (b, filename) = Qnil; + BVAR (b, file_truename) = Qnil; + BVAR (b, display_count) = make_number (0); + BVAR (b, backed_up) = Qnil; + BVAR (b, auto_save_file_name) = Qnil; set_buffer_internal_1 (b); Fset (intern ("buffer-save-without-query"), Qnil); Fset (intern ("buffer-file-number"), Qnil); @@ -647,34 +647,34 @@ delete_all_overlays (struct buffer *b) void reset_buffer (register struct buffer *b) { - b->filename = Qnil; - b->file_truename = Qnil; - b->directory = (current_buffer) ? current_buffer->directory : Qnil; + BVAR (b, filename) = Qnil; + BVAR (b, file_truename) = Qnil; + BVAR (b, directory) = (current_buffer) ? BVAR (current_buffer, directory) : Qnil; b->modtime = 0; b->modtime_size = -1; - XSETFASTINT (b->save_length, 0); + XSETFASTINT (BVAR (b, save_length), 0); b->last_window_start = 1; /* It is more conservative to start out "changed" than "unchanged". */ b->clip_changed = 0; b->prevent_redisplay_optimizations_p = 1; - b->backed_up = Qnil; + BVAR (b, backed_up) = Qnil; BUF_AUTOSAVE_MODIFF (b) = 0; b->auto_save_failure_time = -1; - b->auto_save_file_name = Qnil; - b->read_only = Qnil; + BVAR (b, auto_save_file_name) = Qnil; + BVAR (b, read_only) = Qnil; b->overlays_before = NULL; b->overlays_after = NULL; b->overlay_center = BEG; - b->mark_active = Qnil; - b->point_before_scroll = Qnil; - b->file_format = Qnil; - b->auto_save_file_format = Qt; - b->last_selected_window = Qnil; - XSETINT (b->display_count, 0); - b->display_time = Qnil; - b->enable_multibyte_characters = buffer_defaults.enable_multibyte_characters; - b->cursor_type = buffer_defaults.cursor_type; - b->extra_line_spacing = buffer_defaults.extra_line_spacing; + BVAR (b, mark_active) = Qnil; + BVAR (b, point_before_scroll) = Qnil; + BVAR (b, file_format) = Qnil; + BVAR (b, auto_save_file_format) = Qt; + BVAR (b, last_selected_window) = Qnil; + XSETINT (BVAR (b, display_count), 0); + BVAR (b, display_time) = Qnil; + BVAR (b, enable_multibyte_characters) = BVAR (&buffer_defaults, enable_multibyte_characters); + BVAR (b, cursor_type) = BVAR (&buffer_defaults, cursor_type); + BVAR (b, extra_line_spacing) = BVAR (&buffer_defaults, extra_line_spacing); b->display_error_modiff = 0; } @@ -698,10 +698,10 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too) things that depend on the major mode. default-major-mode is handled at a higher level. We ignore it here. */ - b->major_mode = Qfundamental_mode; - b->keymap = Qnil; - b->mode_name = QSFundamental; - b->minor_modes = Qnil; + BVAR (b, major_mode) = Qfundamental_mode; + BVAR (b, keymap) = Qnil; + BVAR (b, mode_name) = QSFundamental; + BVAR (b, minor_modes) = Qnil; /* If the standard case table has been altered and invalidated, fix up its insides first. */ @@ -710,22 +710,19 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too) && CHAR_TABLE_P (XCHAR_TABLE (Vascii_downcase_table)->extras[2]))) Fset_standard_case_table (Vascii_downcase_table); - b->downcase_table = Vascii_downcase_table; - b->upcase_table = XCHAR_TABLE (Vascii_downcase_table)->extras[0]; - b->case_canon_table = XCHAR_TABLE (Vascii_downcase_table)->extras[1]; - b->case_eqv_table = XCHAR_TABLE (Vascii_downcase_table)->extras[2]; - b->invisibility_spec = Qt; -#ifndef DOS_NT - b->buffer_file_type = Qnil; -#endif + BVAR (b, downcase_table) = Vascii_downcase_table; + BVAR (b, upcase_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[0]; + BVAR (b, case_canon_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[1]; + BVAR (b, case_eqv_table) = XCHAR_TABLE (Vascii_downcase_table)->extras[2]; + BVAR (b, invisibility_spec) = Qt; /* Reset all (or most) per-buffer variables to their defaults. */ if (permanent_too) - b->local_var_alist = Qnil; + BVAR (b, local_var_alist) = Qnil; else { Lisp_Object tmp, prop, last = Qnil; - for (tmp = b->local_var_alist; CONSP (tmp); tmp = XCDR (tmp)) + for (tmp = BVAR (b, local_var_alist); CONSP (tmp); tmp = XCDR (tmp)) if (!NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local))) { /* If permanent-local, keep it. */ @@ -755,7 +752,7 @@ reset_buffer_local_variables (register struct buffer *b, int permanent_too) } /* Delete this local variable. */ else if (NILP (last)) - b->local_var_alist = XCDR (tmp); + BVAR (b, local_var_alist) = XCDR (tmp); else XSETCDR (last, XCDR (tmp)); } @@ -830,9 +827,9 @@ Return nil if BUFFER has been killed. */) (register Lisp_Object buffer) { if (NILP (buffer)) - return current_buffer->name; + return BVAR (current_buffer, name); CHECK_BUFFER (buffer); - return XBUFFER (buffer)->name; + return BVAR (XBUFFER (buffer), name); } DEFUN ("buffer-file-name", Fbuffer_file_name, Sbuffer_file_name, 0, 1, 0, @@ -841,9 +838,9 @@ No argument or nil as argument means use the current buffer. */) (register Lisp_Object buffer) { if (NILP (buffer)) - return current_buffer->filename; + return BVAR (current_buffer, filename); CHECK_BUFFER (buffer); - return XBUFFER (buffer)->filename; + return BVAR (XBUFFER (buffer), filename); } DEFUN ("buffer-base-buffer", Fbuffer_base_buffer, Sbuffer_base_buffer, @@ -895,7 +892,7 @@ is the default binding of the variable. */) { /* Look in local_var_alist. */ struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym); XSETSYMBOL (variable, sym); /* Update In case of aliasing. */ - result = Fassoc (variable, buf->local_var_alist); + result = Fassoc (variable, BVAR (buf, local_var_alist)); if (!NILP (result)) { if (blv->fwd) @@ -944,7 +941,7 @@ buffer_lisp_local_variables (struct buffer *buf) { Lisp_Object result = Qnil; register Lisp_Object tail; - for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail)) + for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail)) { Lisp_Object val, elt; @@ -1043,9 +1040,9 @@ A non-nil FLAG means mark the buffer modified. */) /* If buffer becoming modified, lock the file. If buffer becoming unmodified, unlock the file. */ - fn = current_buffer->file_truename; + fn = BVAR (current_buffer, file_truename); /* Test buffer-file-name so that binding it to nil is effective. */ - if (!NILP (fn) && ! NILP (current_buffer->filename)) + if (!NILP (fn) && ! NILP (BVAR (current_buffer, filename))) { already = SAVE_MODIFF < MODIFF; if (!already && !NILP (flag)) @@ -1110,9 +1107,9 @@ state of the current buffer. Use with care. */) /* If buffer becoming modified, lock the file. If buffer becoming unmodified, unlock the file. */ - fn = current_buffer->file_truename; + fn = BVAR (current_buffer, file_truename); /* Test buffer-file-name so that binding it to nil is effective. */ - if (!NILP (fn) && ! NILP (current_buffer->filename)) + if (!NILP (fn) && ! NILP (BVAR (current_buffer, filename))) { int already = SAVE_MODIFF < MODIFF; if (!already && !NILP (flag)) @@ -1199,14 +1196,14 @@ This does not change the name of the visited file (if any). */) with the original name. It makes UNIQUE equivalent to (rename-buffer (generate-new-buffer-name NEWNAME)). */ if (NILP (unique) && XBUFFER (tem) == current_buffer) - return current_buffer->name; + return BVAR (current_buffer, name); if (!NILP (unique)) - newname = Fgenerate_new_buffer_name (newname, current_buffer->name); + newname = Fgenerate_new_buffer_name (newname, BVAR (current_buffer, name)); else error ("Buffer name `%s' is in use", SDATA (newname)); } - current_buffer->name = newname; + BVAR (current_buffer, name) = newname; /* Catch redisplay's attention. Unless we do this, the mode lines for any windows displaying current_buffer will stay unchanged. */ @@ -1214,11 +1211,11 @@ This does not change the name of the visited file (if any). */) XSETBUFFER (buf, current_buffer); Fsetcar (Frassq (buf, Vbuffer_alist), newname); - if (NILP (current_buffer->filename) - && !NILP (current_buffer->auto_save_file_name)) + if (NILP (BVAR (current_buffer, filename)) + && !NILP (BVAR (current_buffer, auto_save_file_name))) call0 (intern ("rename-auto-save-file")); /* Refetch since that last call may have done GC. */ - return current_buffer->name; + return BVAR (current_buffer, name); } DEFUN ("other-buffer", Fother_buffer, Sother_buffer, 0, 3, 0, @@ -1263,9 +1260,9 @@ If BUFFER is omitted or nil, some interesting buffer is returned. */) continue; if (NILP (buf)) continue; - if (NILP (XBUFFER (buf)->name)) + if (NILP (BVAR (XBUFFER (buf), name))) continue; - if (SREF (XBUFFER (buf)->name, 0) == ' ') + if (SREF (BVAR (XBUFFER (buf), name), 0) == ' ') continue; /* If the selected frame has a buffer_predicate, disregard buffers that don't fit the predicate. */ @@ -1313,8 +1310,8 @@ No argument or nil as argument means do this for the current buffer. */) nsberror (buffer); } - if (EQ (XBUFFER (real_buffer)->undo_list, Qt)) - XBUFFER (real_buffer)->undo_list = Qnil; + if (EQ (BVAR (XBUFFER (real_buffer), undo_list), Qt)) + BVAR (XBUFFER (real_buffer), undo_list) = Qnil; return Qnil; } @@ -1359,16 +1356,16 @@ with SIGHUP. */) b = XBUFFER (buffer); /* Avoid trouble for buffer already dead. */ - if (NILP (b->name)) + if (NILP (BVAR (b, name))) return Qnil; /* Query if the buffer is still modified. */ - if (INTERACTIVE && !NILP (b->filename) + if (INTERACTIVE && !NILP (BVAR (b, filename)) && BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) { GCPRO1 (buffer); tem = do_yes_or_no_p (format2 ("Buffer %s modified; kill anyway? ", - b->name, make_number (0))); + BVAR (b, name), make_number (0))); UNGCPRO; if (NILP (tem)) return Qnil; @@ -1402,7 +1399,7 @@ with SIGHUP. */) if (EQ (buffer, XWINDOW (minibuf_window)->buffer)) return Qnil; - if (NILP (b->name)) + if (NILP (BVAR (b, name))) return Qnil; /* When we kill a base buffer, kill all its indirect buffers. @@ -1417,7 +1414,7 @@ with SIGHUP. */) for (other = all_buffers; other; other = other->next) /* all_buffers contains dead buffers too; don't re-kill them. */ - if (other->base_buffer == b && !NILP (other->name)) + if (other->base_buffer == b && !NILP (BVAR (other, name))) { Lisp_Object buffer; XSETBUFFER (buffer, other); @@ -1462,7 +1459,7 @@ with SIGHUP. */) /* Killing buffer processes may run sentinels which may have called kill-buffer. */ - if (NILP (b->name)) + if (NILP (BVAR (b, name))) return Qnil; clear_charpos_cache (b); @@ -1476,7 +1473,7 @@ with SIGHUP. */) /* Delete any auto-save file, if we saved it in this session. But not if the buffer is modified. */ - if (STRINGP (b->auto_save_file_name) + if (STRINGP (BVAR (b, auto_save_file_name)) && BUF_AUTOSAVE_MODIFF (b) != 0 && BUF_SAVE_MODIFF (b) < BUF_AUTOSAVE_MODIFF (b) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b) @@ -1485,7 +1482,7 @@ with SIGHUP. */) Lisp_Object tem; tem = Fsymbol_value (intern ("delete-auto-save-files")); if (! NILP (tem)) - internal_delete_file (b->auto_save_file_name); + internal_delete_file (BVAR (b, auto_save_file_name)); } if (b->base_buffer) @@ -1525,7 +1522,7 @@ with SIGHUP. */) swap_out_buffer_local_variables (b); reset_buffer_local_variables (b, 1); - b->name = Qnil; + BVAR (b, name) = Qnil; BLOCK_INPUT; if (! b->base_buffer) @@ -1541,9 +1538,9 @@ with SIGHUP. */) free_region_cache (b->width_run_cache); b->width_run_cache = 0; } - b->width_table = Qnil; + BVAR (b, width_table) = Qnil; UNBLOCK_INPUT; - b->undo_list = Qnil; + BVAR (b, undo_list) = Qnil; return Qt; } @@ -1637,15 +1634,15 @@ the current buffer's major mode. */) CHECK_BUFFER (buffer); - if (STRINGP (XBUFFER (buffer)->name) - && strcmp (SSDATA (XBUFFER (buffer)->name), "*scratch*") == 0) + if (STRINGP (BVAR (XBUFFER (buffer), name)) + && strcmp (SSDATA (BVAR (XBUFFER (buffer), name)), "*scratch*") == 0) function = find_symbol_value (intern ("initial-major-mode")); else { - function = buffer_defaults.major_mode; + function = BVAR (&buffer_defaults, major_mode); if (NILP (function) - && NILP (Fget (current_buffer->major_mode, Qmode_class))) - function = current_buffer->major_mode; + && NILP (Fget (BVAR (current_buffer, major_mode), Qmode_class))) + function = BVAR (current_buffer, major_mode); } if (NILP (function) || EQ (function, Qfundamental_mode)) @@ -1795,29 +1792,29 @@ set_buffer_internal_1 (register struct buffer *b) /* Put the undo list back in the base buffer, so that it appears that an indirect buffer shares the undo list of its base. */ if (old_buf->base_buffer) - old_buf->base_buffer->undo_list = old_buf->undo_list; + BVAR (old_buf->base_buffer, undo_list) = BVAR (old_buf, undo_list); /* If the old current buffer has markers to record PT, BEGV and ZV when it is not current, update them now. */ - if (! NILP (old_buf->pt_marker)) + if (! NILP (BVAR (old_buf, pt_marker))) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); - set_marker_both (old_buf->pt_marker, obuf, + set_marker_both (BVAR (old_buf, pt_marker), obuf, BUF_PT (old_buf), BUF_PT_BYTE (old_buf)); } - if (! NILP (old_buf->begv_marker)) + if (! NILP (BVAR (old_buf, begv_marker))) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); - set_marker_both (old_buf->begv_marker, obuf, + set_marker_both (BVAR (old_buf, begv_marker), obuf, BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf)); } - if (! NILP (old_buf->zv_marker)) + if (! NILP (BVAR (old_buf, zv_marker))) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); - set_marker_both (old_buf->zv_marker, obuf, + set_marker_both (BVAR (old_buf, zv_marker), obuf, BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf)); } } @@ -1825,24 +1822,24 @@ set_buffer_internal_1 (register struct buffer *b) /* Get the undo list from the base buffer, so that it appears that an indirect buffer shares the undo list of its base. */ if (b->base_buffer) - b->undo_list = b->base_buffer->undo_list; + BVAR (b, undo_list) = BVAR (b->base_buffer, undo_list); /* If the new current buffer has markers to record PT, BEGV and ZV when it is not current, fetch them now. */ - if (! NILP (b->pt_marker)) + if (! NILP (BVAR (b, pt_marker))) { - BUF_PT (b) = marker_position (b->pt_marker); - BUF_PT_BYTE (b) = marker_byte_position (b->pt_marker); + BUF_PT (b) = marker_position (BVAR (b, pt_marker)); + BUF_PT_BYTE (b) = marker_byte_position (BVAR (b, pt_marker)); } - if (! NILP (b->begv_marker)) + if (! NILP (BVAR (b, begv_marker))) { - BUF_BEGV (b) = marker_position (b->begv_marker); - BUF_BEGV_BYTE (b) = marker_byte_position (b->begv_marker); + BUF_BEGV (b) = marker_position (BVAR (b, begv_marker)); + BUF_BEGV_BYTE (b) = marker_byte_position (BVAR (b, begv_marker)); } - if (! NILP (b->zv_marker)) + if (! NILP (BVAR (b, zv_marker))) { - BUF_ZV (b) = marker_position (b->zv_marker); - BUF_ZV_BYTE (b) = marker_byte_position (b->zv_marker); + BUF_ZV (b) = marker_position (BVAR (b, zv_marker)); + BUF_ZV_BYTE (b) = marker_byte_position (BVAR (b, zv_marker)); } /* Look down buffer's list of local Lisp variables @@ -1850,7 +1847,7 @@ set_buffer_internal_1 (register struct buffer *b) do { - for (tail = b->local_var_alist; CONSP (tail); tail = XCDR (tail)) + for (tail = BVAR (b, local_var_alist); CONSP (tail); tail = XCDR (tail)) { Lisp_Object var = XCAR (XCAR (tail)); struct Lisp_Symbol *sym = XSYMBOL (var); @@ -1883,45 +1880,45 @@ set_buffer_temp (struct buffer *b) { /* If the old current buffer has markers to record PT, BEGV and ZV when it is not current, update them now. */ - if (! NILP (old_buf->pt_marker)) + if (! NILP (BVAR (old_buf, pt_marker))) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); - set_marker_both (old_buf->pt_marker, obuf, + set_marker_both (BVAR (old_buf, pt_marker), obuf, BUF_PT (old_buf), BUF_PT_BYTE (old_buf)); } - if (! NILP (old_buf->begv_marker)) + if (! NILP (BVAR (old_buf, begv_marker))) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); - set_marker_both (old_buf->begv_marker, obuf, + set_marker_both (BVAR (old_buf, begv_marker), obuf, BUF_BEGV (old_buf), BUF_BEGV_BYTE (old_buf)); } - if (! NILP (old_buf->zv_marker)) + if (! NILP (BVAR (old_buf, zv_marker))) { Lisp_Object obuf; XSETBUFFER (obuf, old_buf); - set_marker_both (old_buf->zv_marker, obuf, + set_marker_both (BVAR (old_buf, zv_marker), obuf, BUF_ZV (old_buf), BUF_ZV_BYTE (old_buf)); } } /* If the new current buffer has markers to record PT, BEGV and ZV when it is not current, fetch them now. */ - if (! NILP (b->pt_marker)) + if (! NILP (BVAR (b, pt_marker))) { - BUF_PT (b) = marker_position (b->pt_marker); - BUF_PT_BYTE (b) = marker_byte_position (b->pt_marker); + BUF_PT (b) = marker_position (BVAR (b, pt_marker)); + BUF_PT_BYTE (b) = marker_byte_position (BVAR (b, pt_marker)); } - if (! NILP (b->begv_marker)) + if (! NILP (BVAR (b, begv_marker))) { - BUF_BEGV (b) = marker_position (b->begv_marker); - BUF_BEGV_BYTE (b) = marker_byte_position (b->begv_marker); + BUF_BEGV (b) = marker_position (BVAR (b, begv_marker)); + BUF_BEGV_BYTE (b) = marker_byte_position (BVAR (b, begv_marker)); } - if (! NILP (b->zv_marker)) + if (! NILP (BVAR (b, zv_marker))) { - BUF_ZV (b) = marker_position (b->zv_marker); - BUF_ZV_BYTE (b) = marker_byte_position (b->zv_marker); + BUF_ZV (b) = marker_position (BVAR (b, zv_marker)); + BUF_ZV_BYTE (b) = marker_byte_position (BVAR (b, zv_marker)); } } @@ -1938,7 +1935,7 @@ ends when the current command terminates. Use `switch-to-buffer' or buffer = Fget_buffer (buffer_or_name); if (NILP (buffer)) nsberror (buffer_or_name); - if (NILP (XBUFFER (buffer)->name)) + if (NILP (BVAR (XBUFFER (buffer), name))) error ("Selecting deleted buffer"); set_buffer_internal (XBUFFER (buffer)); return buffer; @@ -1949,7 +1946,7 @@ ends when the current command terminates. Use `switch-to-buffer' or Lisp_Object set_buffer_if_live (Lisp_Object buffer) { - if (! NILP (XBUFFER (buffer)->name)) + if (! NILP (BVAR (XBUFFER (buffer), name))) Fset_buffer (buffer); return Qnil; } @@ -1959,7 +1956,7 @@ DEFUN ("barf-if-buffer-read-only", Fbarf_if_buffer_read_only, doc: /* Signal a `buffer-read-only' error if the current buffer is read-only. */) (void) { - if (!NILP (current_buffer->read_only) + if (!NILP (BVAR (current_buffer, read_only)) && NILP (Vinhibit_read_only)) xsignal1 (Qbuffer_read_only, Fcurrent_buffer ()); return Qnil; @@ -2008,7 +2005,7 @@ its frame, iconify that frame. */) /* Move buffer to the end of the buffer list. Do nothing if the buffer is killed. */ - if (!NILP (XBUFFER (buffer)->name)) + if (!NILP (BVAR (XBUFFER (buffer), name))) { Lisp_Object aelt, link; @@ -2041,7 +2038,7 @@ so the buffer is truly empty after this. */) /* Prevent warnings, or suspension of auto saving, that would happen if future size is less than past size. Use of erase-buffer implies that the future text is not really related to the past text. */ - XSETFASTINT (current_buffer->save_length, 0); + XSETFASTINT (BVAR (current_buffer, save_length), 0); return Qnil; } @@ -2111,7 +2108,7 @@ DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text, CHECK_BUFFER (buffer); other_buffer = XBUFFER (buffer); - if (NILP (other_buffer->name)) + if (NILP (BVAR (other_buffer, name))) error ("Cannot swap a dead buffer's text"); /* Actually, it probably works just fine. @@ -2138,6 +2135,12 @@ DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text, other_buffer->field = current_buffer->field; \ current_buffer->field = tmp##field; \ } while (0) +#define swapfield_(field, type) \ + do { \ + type tmp##field = BVAR (other_buffer, field); \ + BVAR (other_buffer, field) = BVAR (current_buffer, field); \ + BVAR (current_buffer, field) = tmp##field; \ + } while (0) swapfield (own_text, struct buffer_text); eassert (current_buffer->text == ¤t_buffer->own_text); @@ -2165,18 +2168,18 @@ DEFUN ("buffer-swap-text", Fbuffer_swap_text, Sbuffer_swap_text, swapfield (overlays_before, struct Lisp_Overlay *); swapfield (overlays_after, struct Lisp_Overlay *); swapfield (overlay_center, EMACS_INT); - swapfield (undo_list, Lisp_Object); - swapfield (mark, Lisp_Object); - swapfield (enable_multibyte_characters, Lisp_Object); - swapfield (bidi_display_reordering, Lisp_Object); - swapfield (bidi_paragraph_direction, Lisp_Object); + swapfield_ (undo_list, Lisp_Object); + swapfield_ (mark, Lisp_Object); + swapfield_ (enable_multibyte_characters, Lisp_Object); + swapfield_ (bidi_display_reordering, Lisp_Object); + swapfield_ (bidi_paragraph_direction, Lisp_Object); /* FIXME: Not sure what we should do with these *_marker fields. Hopefully they're just nil anyway. */ - swapfield (pt_marker, Lisp_Object); - swapfield (begv_marker, Lisp_Object); - swapfield (zv_marker, Lisp_Object); - current_buffer->point_before_scroll = Qnil; - other_buffer->point_before_scroll = Qnil; + swapfield_ (pt_marker, Lisp_Object); + swapfield_ (begv_marker, Lisp_Object); + swapfield_ (zv_marker, Lisp_Object); + BVAR (current_buffer, point_before_scroll) = Qnil; + BVAR (other_buffer, point_before_scroll) = Qnil; current_buffer->text->modiff++; other_buffer->text->modiff++; current_buffer->text->chars_modiff++; other_buffer->text->chars_modiff++; @@ -2250,21 +2253,21 @@ current buffer is cleared. */) EMACS_INT begv, zv; int narrowed = (BEG != BEGV || Z != ZV); int modified_p = !NILP (Fbuffer_modified_p (Qnil)); - Lisp_Object old_undo = current_buffer->undo_list; + Lisp_Object old_undo = BVAR (current_buffer, undo_list); struct gcpro gcpro1; if (current_buffer->base_buffer) error ("Cannot do `set-buffer-multibyte' on an indirect buffer"); /* Do nothing if nothing actually changes. */ - if (NILP (flag) == NILP (current_buffer->enable_multibyte_characters)) + if (NILP (flag) == NILP (BVAR (current_buffer, enable_multibyte_characters))) return flag; GCPRO1 (old_undo); /* Don't record these buffer changes. We will put a special undo entry instead. */ - current_buffer->undo_list = Qt; + BVAR (current_buffer, undo_list) = Qt; /* If the cached position is for this buffer, clear it out. */ clear_charpos_cache (current_buffer); @@ -2286,7 +2289,7 @@ current buffer is cleared. */) to calculate the old correspondences. */ set_intervals_multibyte (0); - current_buffer->enable_multibyte_characters = Qnil; + BVAR (current_buffer, enable_multibyte_characters) = Qnil; Z = Z_BYTE; BEGV = BEGV_BYTE; @@ -2424,7 +2427,7 @@ current buffer is cleared. */) /* Do this first, so that chars_in_text asks the right question. set_intervals_multibyte needs it too. */ - current_buffer->enable_multibyte_characters = Qt; + BVAR (current_buffer, enable_multibyte_characters) = Qt; GPT_BYTE = advance_to_char_boundary (GPT_BYTE); GPT = chars_in_text (BEG_ADDR, GPT_BYTE - BEG_BYTE) + BEG; @@ -2482,7 +2485,7 @@ current buffer is cleared. */) if (!EQ (old_undo, Qt)) { /* Represent all the above changes by a special undo entry. */ - current_buffer->undo_list = Fcons (list3 (Qapply, + BVAR (current_buffer, undo_list) = Fcons (list3 (Qapply, intern ("set-buffer-multibyte"), NILP (flag) ? Qt : Qnil), old_undo); @@ -2498,10 +2501,10 @@ current buffer is cleared. */) /* Copy this buffer's new multibyte status into all of its indirect buffers. */ for (other = all_buffers; other; other = other->next) - if (other->base_buffer == current_buffer && !NILP (other->name)) + if (other->base_buffer == current_buffer && !NILP (BVAR (other, name))) { - other->enable_multibyte_characters - = current_buffer->enable_multibyte_characters; + BVAR (other, enable_multibyte_characters) + = BVAR (current_buffer, enable_multibyte_characters); other->prevent_redisplay_optimizations_p = 1; } @@ -2568,7 +2571,7 @@ swap_out_buffer_local_variables (struct buffer *b) Lisp_Object oalist, alist, buffer; XSETBUFFER (buffer, b); - oalist = b->local_var_alist; + oalist = BVAR (b, local_var_alist); for (alist = oalist; CONSP (alist); alist = XCDR (alist)) { @@ -3072,7 +3075,7 @@ record_overlay_string (struct sortstrlist *ssl, Lisp_Object str, Lisp_Object str ssl->buf[ssl->used].priority = (INTEGERP (pri) ? XINT (pri) : 0); ssl->used++; - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) nbytes = SCHARS (str); else if (! STRING_MULTIBYTE (str)) nbytes = count_size_as_multibyte (SDATA (str), @@ -3084,7 +3087,7 @@ record_overlay_string (struct sortstrlist *ssl, Lisp_Object str, Lisp_Object str if (STRINGP (str2)) { - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) nbytes = SCHARS (str2); else if (! STRING_MULTIBYTE (str2)) nbytes = count_size_as_multibyte (SDATA (str2), @@ -3114,7 +3117,7 @@ overlay_strings (EMACS_INT pos, struct window *w, unsigned char **pstr) Lisp_Object overlay, window, str; struct Lisp_Overlay *ov; EMACS_INT startpos, endpos; - int multibyte = ! NILP (current_buffer->enable_multibyte_characters); + int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); overlay_heads.used = overlay_heads.bytes = 0; overlay_tails.used = overlay_tails.bytes = 0; @@ -4985,9 +4988,9 @@ init_buffer_once (void) /* Make sure all markable slots in buffer_defaults are initialized reasonably, so mark_buffer won't choke. */ reset_buffer (&buffer_defaults); - eassert (EQ (buffer_defaults.name, make_number (0))); + eassert (EQ (BVAR (&buffer_defaults, name), make_number (0))); reset_buffer_local_variables (&buffer_defaults, 1); - eassert (EQ (buffer_local_symbols.name, make_number (0))); + eassert (EQ (BVAR (&buffer_local_symbols, name), make_number (0))); reset_buffer (&buffer_local_symbols); reset_buffer_local_variables (&buffer_local_symbols, 1); /* Prevent GC from getting confused. */ @@ -5004,60 +5007,57 @@ init_buffer_once (void) /* Must do these before making the first buffer! */ /* real setup is done in bindings.el */ - buffer_defaults.mode_line_format = make_pure_c_string ("%-"); - buffer_defaults.header_line_format = Qnil; - buffer_defaults.abbrev_mode = Qnil; - buffer_defaults.overwrite_mode = Qnil; - buffer_defaults.case_fold_search = Qt; - buffer_defaults.auto_fill_function = Qnil; - buffer_defaults.selective_display = Qnil; + BVAR (&buffer_defaults, mode_line_format) = make_pure_c_string ("%-"); + BVAR (&buffer_defaults, header_line_format) = Qnil; + BVAR (&buffer_defaults, abbrev_mode) = Qnil; + BVAR (&buffer_defaults, overwrite_mode) = Qnil; + BVAR (&buffer_defaults, case_fold_search) = Qt; + BVAR (&buffer_defaults, auto_fill_function) = Qnil; + BVAR (&buffer_defaults, selective_display) = Qnil; #ifndef old - buffer_defaults.selective_display_ellipses = Qt; + BVAR (&buffer_defaults, selective_display_ellipses) = Qt; #endif - buffer_defaults.abbrev_table = Qnil; - buffer_defaults.display_table = Qnil; - buffer_defaults.undo_list = Qnil; - buffer_defaults.mark_active = Qnil; - buffer_defaults.file_format = Qnil; - buffer_defaults.auto_save_file_format = Qt; + BVAR (&buffer_defaults, abbrev_table) = Qnil; + BVAR (&buffer_defaults, display_table) = Qnil; + BVAR (&buffer_defaults, undo_list) = Qnil; + BVAR (&buffer_defaults, mark_active) = Qnil; + BVAR (&buffer_defaults, file_format) = Qnil; + BVAR (&buffer_defaults, auto_save_file_format) = Qt; buffer_defaults.overlays_before = NULL; buffer_defaults.overlays_after = NULL; buffer_defaults.overlay_center = BEG; - XSETFASTINT (buffer_defaults.tab_width, 8); - buffer_defaults.truncate_lines = Qnil; - buffer_defaults.word_wrap = Qnil; - buffer_defaults.ctl_arrow = Qt; - buffer_defaults.bidi_display_reordering = Qnil; - buffer_defaults.bidi_paragraph_direction = Qnil; - buffer_defaults.cursor_type = Qt; - buffer_defaults.extra_line_spacing = Qnil; - buffer_defaults.cursor_in_non_selected_windows = Qt; - -#ifdef DOS_NT - buffer_defaults.buffer_file_type = Qnil; /* TEXT */ -#endif - buffer_defaults.enable_multibyte_characters = Qt; - buffer_defaults.buffer_file_coding_system = Qnil; - XSETFASTINT (buffer_defaults.fill_column, 70); - XSETFASTINT (buffer_defaults.left_margin, 0); - buffer_defaults.cache_long_line_scans = Qnil; - buffer_defaults.file_truename = Qnil; - XSETFASTINT (buffer_defaults.display_count, 0); - XSETFASTINT (buffer_defaults.left_margin_cols, 0); - XSETFASTINT (buffer_defaults.right_margin_cols, 0); - buffer_defaults.left_fringe_width = Qnil; - buffer_defaults.right_fringe_width = Qnil; - buffer_defaults.fringes_outside_margins = Qnil; - buffer_defaults.scroll_bar_width = Qnil; - buffer_defaults.vertical_scroll_bar_type = Qt; - buffer_defaults.indicate_empty_lines = Qnil; - buffer_defaults.indicate_buffer_boundaries = Qnil; - buffer_defaults.fringe_indicator_alist = Qnil; - buffer_defaults.fringe_cursor_alist = Qnil; - buffer_defaults.scroll_up_aggressively = Qnil; - buffer_defaults.scroll_down_aggressively = Qnil; - buffer_defaults.display_time = Qnil; + XSETFASTINT (BVAR (&buffer_defaults, tab_width), 8); + BVAR (&buffer_defaults, truncate_lines) = Qnil; + BVAR (&buffer_defaults, word_wrap) = Qnil; + BVAR (&buffer_defaults, ctl_arrow) = Qt; + BVAR (&buffer_defaults, bidi_display_reordering) = Qnil; + BVAR (&buffer_defaults, bidi_paragraph_direction) = Qnil; + BVAR (&buffer_defaults, cursor_type) = Qt; + BVAR (&buffer_defaults, extra_line_spacing) = Qnil; + BVAR (&buffer_defaults, cursor_in_non_selected_windows) = Qt; + + BVAR (&buffer_defaults, enable_multibyte_characters) = Qt; + BVAR (&buffer_defaults, buffer_file_coding_system) = Qnil; + XSETFASTINT (BVAR (&buffer_defaults, fill_column), 70); + XSETFASTINT (BVAR (&buffer_defaults, left_margin), 0); + BVAR (&buffer_defaults, cache_long_line_scans) = Qnil; + BVAR (&buffer_defaults, file_truename) = Qnil; + XSETFASTINT (BVAR (&buffer_defaults, display_count), 0); + XSETFASTINT (BVAR (&buffer_defaults, left_margin_cols), 0); + XSETFASTINT (BVAR (&buffer_defaults, right_margin_cols), 0); + BVAR (&buffer_defaults, left_fringe_width) = Qnil; + BVAR (&buffer_defaults, right_fringe_width) = Qnil; + BVAR (&buffer_defaults, fringes_outside_margins) = Qnil; + BVAR (&buffer_defaults, scroll_bar_width) = Qnil; + BVAR (&buffer_defaults, vertical_scroll_bar_type) = Qt; + BVAR (&buffer_defaults, indicate_empty_lines) = Qnil; + BVAR (&buffer_defaults, indicate_buffer_boundaries) = Qnil; + BVAR (&buffer_defaults, fringe_indicator_alist) = Qnil; + BVAR (&buffer_defaults, fringe_cursor_alist) = Qnil; + BVAR (&buffer_defaults, scroll_up_aggressively) = Qnil; + BVAR (&buffer_defaults, scroll_down_aggressively) = Qnil; + BVAR (&buffer_defaults, display_time) = Qnil; /* Assign the local-flags to the slots that have default values. The local flag is a bit that is used in the buffer @@ -5069,73 +5069,68 @@ init_buffer_once (void) /* 0 means not a lisp var, -1 means always local, else mask */ memset (&buffer_local_flags, 0, sizeof buffer_local_flags); - XSETINT (buffer_local_flags.filename, -1); - XSETINT (buffer_local_flags.directory, -1); - XSETINT (buffer_local_flags.backed_up, -1); - XSETINT (buffer_local_flags.save_length, -1); - XSETINT (buffer_local_flags.auto_save_file_name, -1); - XSETINT (buffer_local_flags.read_only, -1); - XSETINT (buffer_local_flags.major_mode, -1); - XSETINT (buffer_local_flags.mode_name, -1); - XSETINT (buffer_local_flags.undo_list, -1); - XSETINT (buffer_local_flags.mark_active, -1); - XSETINT (buffer_local_flags.point_before_scroll, -1); - XSETINT (buffer_local_flags.file_truename, -1); - XSETINT (buffer_local_flags.invisibility_spec, -1); - XSETINT (buffer_local_flags.file_format, -1); - XSETINT (buffer_local_flags.auto_save_file_format, -1); - XSETINT (buffer_local_flags.display_count, -1); - XSETINT (buffer_local_flags.display_time, -1); - XSETINT (buffer_local_flags.enable_multibyte_characters, -1); + XSETINT (BVAR (&buffer_local_flags, filename), -1); + XSETINT (BVAR (&buffer_local_flags, directory), -1); + XSETINT (BVAR (&buffer_local_flags, backed_up), -1); + XSETINT (BVAR (&buffer_local_flags, save_length), -1); + XSETINT (BVAR (&buffer_local_flags, auto_save_file_name), -1); + XSETINT (BVAR (&buffer_local_flags, read_only), -1); + XSETINT (BVAR (&buffer_local_flags, major_mode), -1); + XSETINT (BVAR (&buffer_local_flags, mode_name), -1); + XSETINT (BVAR (&buffer_local_flags, undo_list), -1); + XSETINT (BVAR (&buffer_local_flags, mark_active), -1); + XSETINT (BVAR (&buffer_local_flags, point_before_scroll), -1); + XSETINT (BVAR (&buffer_local_flags, file_truename), -1); + XSETINT (BVAR (&buffer_local_flags, invisibility_spec), -1); + XSETINT (BVAR (&buffer_local_flags, file_format), -1); + XSETINT (BVAR (&buffer_local_flags, auto_save_file_format), -1); + XSETINT (BVAR (&buffer_local_flags, display_count), -1); + XSETINT (BVAR (&buffer_local_flags, display_time), -1); + XSETINT (BVAR (&buffer_local_flags, enable_multibyte_characters), -1); idx = 1; - XSETFASTINT (buffer_local_flags.mode_line_format, idx); ++idx; - XSETFASTINT (buffer_local_flags.abbrev_mode, idx); ++idx; - XSETFASTINT (buffer_local_flags.overwrite_mode, idx); ++idx; - XSETFASTINT (buffer_local_flags.case_fold_search, idx); ++idx; - XSETFASTINT (buffer_local_flags.auto_fill_function, idx); ++idx; - XSETFASTINT (buffer_local_flags.selective_display, idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, mode_line_format), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, abbrev_mode), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, overwrite_mode), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, case_fold_search), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, auto_fill_function), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, selective_display), idx); ++idx; #ifndef old - XSETFASTINT (buffer_local_flags.selective_display_ellipses, idx); ++idx; -#endif - XSETFASTINT (buffer_local_flags.tab_width, idx); ++idx; - XSETFASTINT (buffer_local_flags.truncate_lines, idx); ++idx; - XSETFASTINT (buffer_local_flags.word_wrap, idx); ++idx; - XSETFASTINT (buffer_local_flags.ctl_arrow, idx); ++idx; - XSETFASTINT (buffer_local_flags.fill_column, idx); ++idx; - XSETFASTINT (buffer_local_flags.left_margin, idx); ++idx; - XSETFASTINT (buffer_local_flags.abbrev_table, idx); ++idx; - XSETFASTINT (buffer_local_flags.display_table, idx); ++idx; -#ifdef DOS_NT - XSETFASTINT (buffer_local_flags.buffer_file_type, idx); - /* Make this one a permanent local. */ - buffer_permanent_local_flags[idx++] = 1; + XSETFASTINT (BVAR (&buffer_local_flags, selective_display_ellipses), idx); ++idx; #endif - XSETFASTINT (buffer_local_flags.syntax_table, idx); ++idx; - XSETFASTINT (buffer_local_flags.cache_long_line_scans, idx); ++idx; - XSETFASTINT (buffer_local_flags.category_table, idx); ++idx; - XSETFASTINT (buffer_local_flags.bidi_display_reordering, idx); ++idx; - XSETFASTINT (buffer_local_flags.bidi_paragraph_direction, idx); ++idx; - XSETFASTINT (buffer_local_flags.buffer_file_coding_system, idx); + XSETFASTINT (BVAR (&buffer_local_flags, tab_width), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, truncate_lines), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, word_wrap), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, ctl_arrow), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, fill_column), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, left_margin), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, abbrev_table), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, display_table), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, syntax_table), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, cache_long_line_scans), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, category_table), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, bidi_display_reordering), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, bidi_paragraph_direction), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, buffer_file_coding_system), idx); /* Make this one a permanent local. */ buffer_permanent_local_flags[idx++] = 1; - XSETFASTINT (buffer_local_flags.left_margin_cols, idx); ++idx; - XSETFASTINT (buffer_local_flags.right_margin_cols, idx); ++idx; - XSETFASTINT (buffer_local_flags.left_fringe_width, idx); ++idx; - XSETFASTINT (buffer_local_flags.right_fringe_width, idx); ++idx; - XSETFASTINT (buffer_local_flags.fringes_outside_margins, idx); ++idx; - XSETFASTINT (buffer_local_flags.scroll_bar_width, idx); ++idx; - XSETFASTINT (buffer_local_flags.vertical_scroll_bar_type, idx); ++idx; - XSETFASTINT (buffer_local_flags.indicate_empty_lines, idx); ++idx; - XSETFASTINT (buffer_local_flags.indicate_buffer_boundaries, idx); ++idx; - XSETFASTINT (buffer_local_flags.fringe_indicator_alist, idx); ++idx; - XSETFASTINT (buffer_local_flags.fringe_cursor_alist, idx); ++idx; - XSETFASTINT (buffer_local_flags.scroll_up_aggressively, idx); ++idx; - XSETFASTINT (buffer_local_flags.scroll_down_aggressively, idx); ++idx; - XSETFASTINT (buffer_local_flags.header_line_format, idx); ++idx; - XSETFASTINT (buffer_local_flags.cursor_type, idx); ++idx; - XSETFASTINT (buffer_local_flags.extra_line_spacing, idx); ++idx; - XSETFASTINT (buffer_local_flags.cursor_in_non_selected_windows, idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, left_margin_cols), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, right_margin_cols), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, left_fringe_width), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, right_fringe_width), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, fringes_outside_margins), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, scroll_bar_width), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, vertical_scroll_bar_type), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, indicate_empty_lines), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, indicate_buffer_boundaries), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, fringe_indicator_alist), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, fringe_cursor_alist), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, scroll_up_aggressively), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, scroll_down_aggressively), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, header_line_format), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, cursor_type), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, extra_line_spacing), idx); ++idx; + XSETFASTINT (BVAR (&buffer_local_flags, cursor_in_non_selected_windows), idx); ++idx; /* Need more room? */ if (idx >= MAX_PER_BUFFER_VARS) @@ -5149,7 +5144,7 @@ init_buffer_once (void) QSFundamental = make_pure_c_string ("Fundamental"); Qfundamental_mode = intern_c_string ("fundamental-mode"); - buffer_defaults.major_mode = Qfundamental_mode; + BVAR (&buffer_defaults, major_mode) = Qfundamental_mode; Qmode_class = intern_c_string ("mode-class"); @@ -5192,7 +5187,7 @@ init_buffer (void) #endif /* USE_MMAP_FOR_BUFFERS */ Fset_buffer (Fget_buffer_create (build_string ("*scratch*"))); - if (NILP (buffer_defaults.enable_multibyte_characters)) + if (NILP (BVAR (&buffer_defaults, enable_multibyte_characters))) Fset_buffer_multibyte (Qnil); pwd = get_current_dir_name (); @@ -5213,28 +5208,28 @@ init_buffer (void) pwd[len + 1] = '\0'; } - current_buffer->directory = make_unibyte_string (pwd, strlen (pwd)); - if (! NILP (buffer_defaults.enable_multibyte_characters)) + BVAR (current_buffer, directory) = make_unibyte_string (pwd, strlen (pwd)); + if (! NILP (BVAR (&buffer_defaults, enable_multibyte_characters))) /* At this moment, we still don't know how to decode the directory name. So, we keep the bytes in multibyte form so that ENCODE_FILE correctly gets the original bytes. */ - current_buffer->directory - = string_to_multibyte (current_buffer->directory); + BVAR (current_buffer, directory) + = string_to_multibyte (BVAR (current_buffer, directory)); /* Add /: to the front of the name if it would otherwise be treated as magic. */ - temp = Ffind_file_name_handler (current_buffer->directory, Qt); + temp = Ffind_file_name_handler (BVAR (current_buffer, directory), Qt); if (! NILP (temp) /* If the default dir is just /, TEMP is non-nil because of the ange-ftp completion handler. However, it is not necessary to turn / into /:/. So avoid doing that. */ - && strcmp ("/", SSDATA (current_buffer->directory))) - current_buffer->directory - = concat2 (build_string ("/:"), current_buffer->directory); + && strcmp ("/", SSDATA (BVAR (current_buffer, directory)))) + BVAR (current_buffer, directory) + = concat2 (build_string ("/:"), BVAR (current_buffer, directory)); temp = get_minibuffer (0); - XBUFFER (temp)->directory = current_buffer->directory; + BVAR (XBUFFER (temp), directory) = BVAR (current_buffer, directory); free (pwd); } @@ -5410,14 +5405,6 @@ This is the same as (default-value 'tab-width). */); doc: /* Default value of `case-fold-search' for buffers that don't override it. This is the same as (default-value 'case-fold-search). */); -#ifdef DOS_NT - DEFVAR_BUFFER_DEFAULTS ("default-buffer-file-type", - buffer_file_type, - doc: /* Default file type for buffers that do not override it. -This is the same as (default-value 'buffer-file-type). -The file type is nil for text, t for binary. */); -#endif - DEFVAR_BUFFER_DEFAULTS ("default-left-margin-width", left_margin_cols, doc: /* Default value of `left-margin-width' for buffers that don't override it. @@ -5486,13 +5473,13 @@ This value applies in buffers that don't have their own local values. This is the same as (default-value 'scroll-down-aggressively). */); DEFVAR_PER_BUFFER ("header-line-format", - ¤t_buffer->header_line_format, + &BVAR (current_buffer, header_line_format), Qnil, doc: /* Analogous to `mode-line-format', but controls the header line. The header line appears, optionally, at the top of a window; the mode line appears at the bottom. */); - DEFVAR_PER_BUFFER ("mode-line-format", ¤t_buffer->mode_line_format, + DEFVAR_PER_BUFFER ("mode-line-format", &BVAR (current_buffer, mode_line_format), Qnil, doc: /* Template for displaying mode line for current buffer. Each buffer has its own value of this variable. @@ -5549,7 +5536,7 @@ Decimal digits after the % specify field width to which to pad. */); DEFVAR_BUFFER_DEFAULTS ("default-major-mode", major_mode, doc: /* *Value of `major-mode' for new buffers. */); - DEFVAR_PER_BUFFER ("major-mode", ¤t_buffer->major_mode, + DEFVAR_PER_BUFFER ("major-mode", &BVAR (current_buffer, major_mode), make_number (Lisp_Symbol), doc: /* Symbol for current buffer's major mode. The default value (normally `fundamental-mode') affects new buffers. @@ -5562,46 +5549,46 @@ the buffer. Thus, the mode and its hooks should not expect certain variables such as `buffer-read-only' and `buffer-file-coding-system' to be set up. */); - DEFVAR_PER_BUFFER ("mode-name", ¤t_buffer->mode_name, + DEFVAR_PER_BUFFER ("mode-name", &BVAR (current_buffer, mode_name), Qnil, doc: /* Pretty name of current buffer's major mode. Usually a string, but can use any of the constructs for `mode-line-format', which see. Format with `format-mode-line' to produce a string value. */); - DEFVAR_PER_BUFFER ("local-abbrev-table", ¤t_buffer->abbrev_table, Qnil, + DEFVAR_PER_BUFFER ("local-abbrev-table", &BVAR (current_buffer, abbrev_table), Qnil, doc: /* Local (mode-specific) abbrev table of current buffer. */); - DEFVAR_PER_BUFFER ("abbrev-mode", ¤t_buffer->abbrev_mode, Qnil, + DEFVAR_PER_BUFFER ("abbrev-mode", &BVAR (current_buffer, abbrev_mode), Qnil, doc: /* Non-nil if Abbrev mode is enabled. Use the command `abbrev-mode' to change this variable. */); - DEFVAR_PER_BUFFER ("case-fold-search", ¤t_buffer->case_fold_search, + DEFVAR_PER_BUFFER ("case-fold-search", &BVAR (current_buffer, case_fold_search), Qnil, doc: /* *Non-nil if searches and matches should ignore case. */); - DEFVAR_PER_BUFFER ("fill-column", ¤t_buffer->fill_column, + DEFVAR_PER_BUFFER ("fill-column", &BVAR (current_buffer, fill_column), make_number (LISP_INT_TAG), doc: /* *Column beyond which automatic line-wrapping should happen. Interactively, you can set the buffer local value using \\[set-fill-column]. */); - DEFVAR_PER_BUFFER ("left-margin", ¤t_buffer->left_margin, + DEFVAR_PER_BUFFER ("left-margin", &BVAR (current_buffer, left_margin), make_number (LISP_INT_TAG), doc: /* *Column for the default `indent-line-function' to indent to. Linefeed indents to this column in Fundamental mode. */); - DEFVAR_PER_BUFFER ("tab-width", ¤t_buffer->tab_width, + DEFVAR_PER_BUFFER ("tab-width", &BVAR (current_buffer, tab_width), make_number (LISP_INT_TAG), doc: /* *Distance between tab stops (for display of tab characters), in columns. */); - DEFVAR_PER_BUFFER ("ctl-arrow", ¤t_buffer->ctl_arrow, Qnil, + DEFVAR_PER_BUFFER ("ctl-arrow", &BVAR (current_buffer, ctl_arrow), Qnil, doc: /* *Non-nil means display control chars with uparrow. A value of nil means use backslash and octal digits. This variable does not apply to characters whose display is specified in the current display table (if there is one). */); DEFVAR_PER_BUFFER ("enable-multibyte-characters", - ¤t_buffer->enable_multibyte_characters, + &BVAR (current_buffer, enable_multibyte_characters), Qnil, doc: /* Non-nil means the buffer contents are regarded as multi-byte characters. Otherwise they are regarded as unibyte. This affects the display, @@ -5615,7 +5602,7 @@ See also variable `default-enable-multibyte-characters' and Info node XSYMBOL (intern_c_string ("enable-multibyte-characters"))->constant = 1; DEFVAR_PER_BUFFER ("buffer-file-coding-system", - ¤t_buffer->buffer_file_coding_system, Qnil, + &BVAR (current_buffer, buffer_file_coding_system), Qnil, doc: /* Coding system to be used for encoding the buffer contents on saving. This variable applies to saving the buffer, and also to `write-region' and other functions that use `write-region'. @@ -5633,11 +5620,11 @@ The variable `coding-system-for-write', if non-nil, overrides this variable. This variable is never applied to a way of decoding a file while reading it. */); DEFVAR_PER_BUFFER ("bidi-display-reordering", - ¤t_buffer->bidi_display_reordering, Qnil, + &BVAR (current_buffer, bidi_display_reordering), Qnil, doc: /* Non-nil means reorder bidirectional text for display in the visual order. */); DEFVAR_PER_BUFFER ("bidi-paragraph-direction", - ¤t_buffer->bidi_paragraph_direction, Qnil, + &BVAR (current_buffer, bidi_paragraph_direction), Qnil, doc: /* *If non-nil, forces directionality of text paragraphs in the buffer. If this is nil (the default), the direction of each paragraph is @@ -5648,7 +5635,7 @@ Any other value is treated as nil. This variable has no effect unless the buffer's value of \`bidi-display-reordering' is non-nil. */); - DEFVAR_PER_BUFFER ("truncate-lines", ¤t_buffer->truncate_lines, Qnil, + DEFVAR_PER_BUFFER ("truncate-lines", &BVAR (current_buffer, truncate_lines), Qnil, doc: /* *Non-nil means do not display continuation lines. Instead, give each line of text just one screen line. @@ -5656,7 +5643,7 @@ Note that this is overridden by the variable `truncate-partial-width-windows' if that variable is non-nil and this buffer is not full-frame width. */); - DEFVAR_PER_BUFFER ("word-wrap", ¤t_buffer->word_wrap, Qnil, + DEFVAR_PER_BUFFER ("word-wrap", &BVAR (current_buffer, word_wrap), Qnil, doc: /* *Non-nil means to use word-wrapping for continuation lines. When word-wrapping is on, continuation lines are wrapped at the space or tab character nearest to the right window edge. @@ -5668,21 +5655,12 @@ word-wrapping, you might want to reduce the value of `truncate-partial-width-windows', since wrapping can make text readable in narrower windows. */); -#ifdef DOS_NT - DEFVAR_PER_BUFFER ("buffer-file-type", ¤t_buffer->buffer_file_type, - Qnil, - doc: /* Non-nil if the visited file is a binary file. -This variable is meaningful on MS-DOG and Windows NT. -On those systems, it is automatically local in every buffer. -On other systems, this variable is normally always nil. */); -#endif - - DEFVAR_PER_BUFFER ("default-directory", ¤t_buffer->directory, + DEFVAR_PER_BUFFER ("default-directory", &BVAR (current_buffer, directory), make_number (Lisp_String), doc: /* Name of default directory of current buffer. Should end with slash. To interactively change the default directory, use command `cd'. */); - DEFVAR_PER_BUFFER ("auto-fill-function", ¤t_buffer->auto_fill_function, + DEFVAR_PER_BUFFER ("auto-fill-function", &BVAR (current_buffer, auto_fill_function), Qnil, doc: /* Function called (if non-nil) to perform auto-fill. It is called after self-inserting any character specified in @@ -5690,30 +5668,30 @@ the `auto-fill-chars' table. NOTE: This variable is not a hook; its value may not be a list of functions. */); - DEFVAR_PER_BUFFER ("buffer-file-name", ¤t_buffer->filename, + DEFVAR_PER_BUFFER ("buffer-file-name", &BVAR (current_buffer, filename), make_number (Lisp_String), doc: /* Name of file visited in current buffer, or nil if not visiting a file. */); - DEFVAR_PER_BUFFER ("buffer-file-truename", ¤t_buffer->file_truename, + DEFVAR_PER_BUFFER ("buffer-file-truename", &BVAR (current_buffer, file_truename), make_number (Lisp_String), doc: /* Abbreviated truename of file visited in current buffer, or nil if none. The truename of a file is calculated by `file-truename' and then abbreviated with `abbreviate-file-name'. */); DEFVAR_PER_BUFFER ("buffer-auto-save-file-name", - ¤t_buffer->auto_save_file_name, + &BVAR (current_buffer, auto_save_file_name), make_number (Lisp_String), doc: /* Name of file for auto-saving current buffer. If it is nil, that means don't auto-save this buffer. */); - DEFVAR_PER_BUFFER ("buffer-read-only", ¤t_buffer->read_only, Qnil, + DEFVAR_PER_BUFFER ("buffer-read-only", &BVAR (current_buffer, read_only), Qnil, doc: /* Non-nil if this buffer is read-only. */); - DEFVAR_PER_BUFFER ("buffer-backed-up", ¤t_buffer->backed_up, Qnil, + DEFVAR_PER_BUFFER ("buffer-backed-up", &BVAR (current_buffer, backed_up), Qnil, doc: /* Non-nil if this buffer's file has been backed up. Backing up is done before the first time the file is saved. */); - DEFVAR_PER_BUFFER ("buffer-saved-size", ¤t_buffer->save_length, + DEFVAR_PER_BUFFER ("buffer-saved-size", &BVAR (current_buffer, save_length), make_number (LISP_INT_TAG), doc: /* Length of current buffer when last read in, saved or auto-saved. 0 initially. @@ -5723,7 +5701,7 @@ If you set this to -2, that means don't turn off auto-saving in this buffer if its text size shrinks. If you use `buffer-swap-text' on a buffer, you probably should set this to -2 in that buffer. */); - DEFVAR_PER_BUFFER ("selective-display", ¤t_buffer->selective_display, + DEFVAR_PER_BUFFER ("selective-display", &BVAR (current_buffer, selective_display), Qnil, doc: /* Non-nil enables selective display. An integer N as value means display only lines @@ -5734,12 +5712,12 @@ in a file, save the ^M as a newline. */); #ifndef old DEFVAR_PER_BUFFER ("selective-display-ellipses", - ¤t_buffer->selective_display_ellipses, + &BVAR (current_buffer, selective_display_ellipses), Qnil, doc: /* Non-nil means display ... on previous line when a line is invisible. */); #endif - DEFVAR_PER_BUFFER ("overwrite-mode", ¤t_buffer->overwrite_mode, Qnil, + DEFVAR_PER_BUFFER ("overwrite-mode", &BVAR (current_buffer, overwrite_mode), Qnil, doc: /* Non-nil if self-insertion should replace existing text. The value should be one of `overwrite-mode-textual', `overwrite-mode-binary', or nil. @@ -5748,7 +5726,7 @@ inserts at the end of a line, and inserts when point is before a tab, until the tab is filled in. If `overwrite-mode-binary', self-insertion replaces newlines and tabs too. */); - DEFVAR_PER_BUFFER ("buffer-display-table", ¤t_buffer->display_table, + DEFVAR_PER_BUFFER ("buffer-display-table", &BVAR (current_buffer, display_table), Qnil, doc: /* Display table that controls display of the contents of current buffer. @@ -5785,39 +5763,39 @@ In addition, a char-table has six extra slots to control the display of: See also the functions `display-table-slot' and `set-display-table-slot'. */); - DEFVAR_PER_BUFFER ("left-margin-width", ¤t_buffer->left_margin_cols, + DEFVAR_PER_BUFFER ("left-margin-width", &BVAR (current_buffer, left_margin_cols), Qnil, doc: /* *Width of left marginal area for display of a buffer. A value of nil means no marginal area. */); - DEFVAR_PER_BUFFER ("right-margin-width", ¤t_buffer->right_margin_cols, + DEFVAR_PER_BUFFER ("right-margin-width", &BVAR (current_buffer, right_margin_cols), Qnil, doc: /* *Width of right marginal area for display of a buffer. A value of nil means no marginal area. */); - DEFVAR_PER_BUFFER ("left-fringe-width", ¤t_buffer->left_fringe_width, + DEFVAR_PER_BUFFER ("left-fringe-width", &BVAR (current_buffer, left_fringe_width), Qnil, doc: /* *Width of this buffer's left fringe (in pixels). A value of 0 means no left fringe is shown in this buffer's window. A value of nil means to use the left fringe width from the window's frame. */); - DEFVAR_PER_BUFFER ("right-fringe-width", ¤t_buffer->right_fringe_width, + DEFVAR_PER_BUFFER ("right-fringe-width", &BVAR (current_buffer, right_fringe_width), Qnil, doc: /* *Width of this buffer's right fringe (in pixels). A value of 0 means no right fringe is shown in this buffer's window. A value of nil means to use the right fringe width from the window's frame. */); - DEFVAR_PER_BUFFER ("fringes-outside-margins", ¤t_buffer->fringes_outside_margins, + DEFVAR_PER_BUFFER ("fringes-outside-margins", &BVAR (current_buffer, fringes_outside_margins), Qnil, doc: /* *Non-nil means to display fringes outside display margins. A value of nil means to display fringes between margins and buffer text. */); - DEFVAR_PER_BUFFER ("scroll-bar-width", ¤t_buffer->scroll_bar_width, + DEFVAR_PER_BUFFER ("scroll-bar-width", &BVAR (current_buffer, scroll_bar_width), Qnil, doc: /* *Width of this buffer's scroll bars in pixels. A value of nil means to use the scroll bar width from the window's frame. */); - DEFVAR_PER_BUFFER ("vertical-scroll-bar", ¤t_buffer->vertical_scroll_bar_type, + DEFVAR_PER_BUFFER ("vertical-scroll-bar", &BVAR (current_buffer, vertical_scroll_bar_type), Qnil, doc: /* *Position of this buffer's vertical scroll bar. The value takes effect whenever you tell a window to display this buffer; @@ -5828,13 +5806,13 @@ of the window; a value of nil means don't show any vertical scroll bars. A value of t (the default) means do whatever the window's frame specifies. */); DEFVAR_PER_BUFFER ("indicate-empty-lines", - ¤t_buffer->indicate_empty_lines, Qnil, + &BVAR (current_buffer, indicate_empty_lines), Qnil, doc: /* *Visually indicate empty lines after the buffer end. If non-nil, a bitmap is displayed in the left fringe of a window on window-systems. */); DEFVAR_PER_BUFFER ("indicate-buffer-boundaries", - ¤t_buffer->indicate_buffer_boundaries, Qnil, + &BVAR (current_buffer, indicate_buffer_boundaries), Qnil, doc: /* *Visually indicate buffer boundaries and scrolling. If non-nil, the first and last line of the buffer are marked in the fringe of a window on window-systems with angle bitmaps, or if the window can be @@ -5859,7 +5837,7 @@ bitmaps in right fringe. To show just the angle bitmaps in the left fringe, but no arrow bitmaps, use ((top . left) (bottom . left)). */); DEFVAR_PER_BUFFER ("fringe-indicator-alist", - ¤t_buffer->fringe_indicator_alist, Qnil, + &BVAR (current_buffer, fringe_indicator_alist), Qnil, doc: /* *Mapping from logical to physical fringe indicator bitmaps. The value is an alist where each element (INDICATOR . BITMAPS) specifies the fringe bitmaps used to display a specific logical @@ -5878,7 +5856,7 @@ last (only) line has no final newline. BITMAPS may also be a single symbol which is used in both left and right fringes. */); DEFVAR_PER_BUFFER ("fringe-cursor-alist", - ¤t_buffer->fringe_cursor_alist, Qnil, + &BVAR (current_buffer, fringe_cursor_alist), Qnil, doc: /* *Mapping from logical to physical fringe cursor bitmaps. The value is an alist where each element (CURSOR . BITMAP) specifies the fringe bitmaps used to display a specific logical @@ -5893,7 +5871,7 @@ BITMAP is the corresponding fringe bitmap shown for the logical cursor type. */); DEFVAR_PER_BUFFER ("scroll-up-aggressively", - ¤t_buffer->scroll_up_aggressively, Qnil, + &BVAR (current_buffer, scroll_up_aggressively), Qnil, doc: /* How far to scroll windows upward. If you move point off the bottom, the window scrolls automatically. This variable controls how far it scrolls. The value nil, the default, @@ -5906,7 +5884,7 @@ window scrolls by a full window height. Meaningful values are between 0.0 and 1.0, inclusive. */); DEFVAR_PER_BUFFER ("scroll-down-aggressively", - ¤t_buffer->scroll_down_aggressively, Qnil, + &BVAR (current_buffer, scroll_down_aggressively), Qnil, doc: /* How far to scroll windows downward. If you move point off the top, the window scrolls automatically. This variable controls how far it scrolls. The value nil, the default, @@ -5961,7 +5939,7 @@ from happening repeatedly and making Emacs nonfunctional. */); The functions are run using the `run-hooks' function. */); Vfirst_change_hook = Qnil; - DEFVAR_PER_BUFFER ("buffer-undo-list", ¤t_buffer->undo_list, Qnil, + DEFVAR_PER_BUFFER ("buffer-undo-list", &BVAR (current_buffer, undo_list), Qnil, doc: /* List of undo entries in current buffer. Recent changes come first; older changes follow newer. @@ -6002,10 +5980,10 @@ the changes between two undo boundaries as a single step to be undone. If the value of the variable is t, undo information is not recorded. */); - DEFVAR_PER_BUFFER ("mark-active", ¤t_buffer->mark_active, Qnil, + DEFVAR_PER_BUFFER ("mark-active", &BVAR (current_buffer, mark_active), Qnil, doc: /* Non-nil means the mark and region are currently active in this buffer. */); - DEFVAR_PER_BUFFER ("cache-long-line-scans", ¤t_buffer->cache_long_line_scans, Qnil, + DEFVAR_PER_BUFFER ("cache-long-line-scans", &BVAR (current_buffer, cache_long_line_scans), Qnil, doc: /* Non-nil means that Emacs should use caches to handle long lines more quickly. Normally, the line-motion functions work by scanning the buffer for @@ -6033,23 +6011,23 @@ maintained internally by the Emacs primitives. Enabling or disabling the cache should not affect the behavior of any of the motion functions; it should only affect their performance. */); - DEFVAR_PER_BUFFER ("point-before-scroll", ¤t_buffer->point_before_scroll, Qnil, + DEFVAR_PER_BUFFER ("point-before-scroll", &BVAR (current_buffer, point_before_scroll), Qnil, doc: /* Value of point before the last series of scroll operations, or nil. */); - DEFVAR_PER_BUFFER ("buffer-file-format", ¤t_buffer->file_format, Qnil, + DEFVAR_PER_BUFFER ("buffer-file-format", &BVAR (current_buffer, file_format), Qnil, doc: /* List of formats to use when saving this buffer. Formats are defined by `format-alist'. This variable is set when a file is visited. */); DEFVAR_PER_BUFFER ("buffer-auto-save-file-format", - ¤t_buffer->auto_save_file_format, Qnil, + &BVAR (current_buffer, auto_save_file_format), Qnil, doc: /* *Format in which to write auto-save files. Should be a list of symbols naming formats that are defined in `format-alist'. If it is t, which is the default, auto-save files are written in the same format as a regular save would use. */); DEFVAR_PER_BUFFER ("buffer-invisibility-spec", - ¤t_buffer->invisibility_spec, Qnil, + &BVAR (current_buffer, invisibility_spec), Qnil, doc: /* Invisibility spec of this buffer. The default is t, which means that text is invisible if it has a non-nil `invisible' property. @@ -6060,12 +6038,12 @@ then characters with property value PROP are invisible, and they have an ellipsis as well if ELLIPSIS is non-nil. */); DEFVAR_PER_BUFFER ("buffer-display-count", - ¤t_buffer->display_count, Qnil, + &BVAR (current_buffer, display_count), Qnil, doc: /* A number incremented each time this buffer is displayed in a window. The function `set-window-buffer' increments it. */); DEFVAR_PER_BUFFER ("buffer-display-time", - ¤t_buffer->display_time, Qnil, + &BVAR (current_buffer, display_time), Qnil, doc: /* Time stamp updated each time this buffer is displayed in a window. The function `set-window-buffer' updates this variable to the value obtained by calling `current-time'. @@ -6100,7 +6078,7 @@ and disregard a `read-only' text property if the property value is a member of the list. */); Vinhibit_read_only = Qnil; - DEFVAR_PER_BUFFER ("cursor-type", ¤t_buffer->cursor_type, Qnil, + DEFVAR_PER_BUFFER ("cursor-type", &BVAR (current_buffer, cursor_type), Qnil, doc: /* Cursor to use when this buffer is in the selected window. Values are interpreted as follows: @@ -6119,7 +6097,7 @@ cursor's appearance is instead controlled by the variable `cursor-in-non-selected-windows'. */); DEFVAR_PER_BUFFER ("line-spacing", - ¤t_buffer->extra_line_spacing, Qnil, + &BVAR (current_buffer, extra_line_spacing), Qnil, doc: /* Additional space to put between lines when displaying a buffer. The space is measured in pixels, and put below lines on graphic displays, see `display-graphic-p'. @@ -6127,7 +6105,7 @@ If value is a floating point number, it specifies the spacing relative to the default frame line height. A value of nil means add no extra space. */); DEFVAR_PER_BUFFER ("cursor-in-non-selected-windows", - ¤t_buffer->cursor_in_non_selected_windows, Qnil, + &BVAR (current_buffer, cursor_in_non_selected_windows), Qnil, doc: /* *Non-nil means show a cursor in non-selected windows. If nil, only shows a cursor in the selected window. If t, displays a cursor related to the usual cursor type diff --git a/src/buffer.h b/src/buffer.h index 31f96040b2d..65c7168d60a 100644 --- a/src/buffer.h +++ b/src/buffer.h @@ -321,7 +321,7 @@ while (0) /* Return character at byte position POS. */ #define FETCH_CHAR(pos) \ - (!NILP (current_buffer->enable_multibyte_characters) \ + (!NILP (BVAR (current_buffer, enable_multibyte_characters)) \ ? FETCH_MULTIBYTE_CHAR ((pos)) \ : FETCH_BYTE ((pos))) @@ -346,7 +346,7 @@ extern unsigned char *_fetch_multibyte_char_p; multibyte. */ #define FETCH_CHAR_AS_MULTIBYTE(pos) \ - (!NILP (current_buffer->enable_multibyte_characters) \ + (!NILP (BVAR (current_buffer, enable_multibyte_characters)) \ ? FETCH_MULTIBYTE_CHAR ((pos)) \ : UNIBYTE_TO_CHAR (FETCH_BYTE ((pos)))) @@ -464,6 +464,15 @@ struct buffer_text int inhibit_shrinking; }; +/* Lisp fields in struct buffer are hidden from most code and accessed + via the BVAR macro, below. Only select pieces of code, like the GC, + are allowed to use BUFFER_INTERNAL_FIELD. */ +#define BUFFER_INTERNAL_FIELD(field) field ## _ + +/* Most code should use this macro to access Lisp fields in struct + buffer. */ +#define BVAR(buf, field) ((buf)->BUFFER_INTERNAL_FIELD (field)) + /* This is the structure that the buffer Lisp object points to. */ struct buffer @@ -587,138 +596,132 @@ struct buffer because local variables have to be right in the struct buffer. So we copy it around in set_buffer_internal. This comes before `name' because it is marked in a special way. */ - Lisp_Object undo_list; + Lisp_Object BUFFER_INTERNAL_FIELD (undo_list); /* The name of this buffer. */ - Lisp_Object name; + Lisp_Object BUFFER_INTERNAL_FIELD (name); /* The name of the file visited in this buffer, or nil. */ - Lisp_Object filename; + Lisp_Object BUFFER_INTERNAL_FIELD (filename); /* Dir for expanding relative file names. */ - Lisp_Object directory; + Lisp_Object BUFFER_INTERNAL_FIELD (directory); /* True if this buffer has been backed up (if you write to the visited file and it hasn't been backed up, then a backup will be made). */ /* This isn't really used by the C code, so could be deleted. */ - Lisp_Object backed_up; + Lisp_Object BUFFER_INTERNAL_FIELD (backed_up); /* Length of file when last read or saved. -1 means auto saving turned off because buffer shrank a lot. -2 means don't turn off auto saving if buffer shrinks. (That value is used with buffer-swap-text.) This is not in the struct buffer_text because it's not used in indirect buffers at all. */ - Lisp_Object save_length; + Lisp_Object BUFFER_INTERNAL_FIELD (save_length); /* File name used for auto-saving this buffer. This is not in the struct buffer_text because it's not used in indirect buffers at all. */ - Lisp_Object auto_save_file_name; + Lisp_Object BUFFER_INTERNAL_FIELD (auto_save_file_name); /* Non-nil if buffer read-only. */ - Lisp_Object read_only; + Lisp_Object BUFFER_INTERNAL_FIELD (read_only); /* "The mark". This is a marker which may point into this buffer or may point nowhere. */ - Lisp_Object mark; + Lisp_Object BUFFER_INTERNAL_FIELD (mark); /* Alist of elements (SYMBOL . VALUE-IN-THIS-BUFFER) for all per-buffer variables of this buffer. For locally unbound symbols, just the symbol appears as the element. */ - Lisp_Object local_var_alist; + Lisp_Object BUFFER_INTERNAL_FIELD (local_var_alist); /* Symbol naming major mode (eg, lisp-mode). */ - Lisp_Object major_mode; + Lisp_Object BUFFER_INTERNAL_FIELD (major_mode); /* Pretty name of major mode (eg, "Lisp"). */ - Lisp_Object mode_name; + Lisp_Object BUFFER_INTERNAL_FIELD (mode_name); /* Mode line element that controls format of mode line. */ - Lisp_Object mode_line_format; + Lisp_Object BUFFER_INTERNAL_FIELD (mode_line_format); /* Analogous to mode_line_format for the line displayed at the top of windows. Nil means don't display that line. */ - Lisp_Object header_line_format; + Lisp_Object BUFFER_INTERNAL_FIELD (header_line_format); /* Keys that are bound local to this buffer. */ - Lisp_Object keymap; + Lisp_Object BUFFER_INTERNAL_FIELD (keymap); /* This buffer's local abbrev table. */ - Lisp_Object abbrev_table; + Lisp_Object BUFFER_INTERNAL_FIELD (abbrev_table); /* This buffer's syntax table. */ - Lisp_Object syntax_table; + Lisp_Object BUFFER_INTERNAL_FIELD (syntax_table); /* This buffer's category table. */ - Lisp_Object category_table; + Lisp_Object BUFFER_INTERNAL_FIELD (category_table); /* Values of several buffer-local variables. */ /* tab-width is buffer-local so that redisplay can find it in buffers that are not current. */ - Lisp_Object case_fold_search; - Lisp_Object tab_width; - Lisp_Object fill_column; - Lisp_Object left_margin; + Lisp_Object BUFFER_INTERNAL_FIELD (case_fold_search); + Lisp_Object BUFFER_INTERNAL_FIELD (tab_width); + Lisp_Object BUFFER_INTERNAL_FIELD (fill_column); + Lisp_Object BUFFER_INTERNAL_FIELD (left_margin); /* Function to call when insert space past fill column. */ - Lisp_Object auto_fill_function; - /* nil: text, t: binary. - This value is meaningful only on certain operating systems. */ - /* Actually, we don't need this flag any more because end-of-line - is handled correctly according to the buffer-file-coding-system - of the buffer. Just keeping it for backward compatibility. */ - Lisp_Object buffer_file_type; + Lisp_Object BUFFER_INTERNAL_FIELD (auto_fill_function); /* Case table for case-conversion in this buffer. This char-table maps each char into its lower-case version. */ - Lisp_Object downcase_table; + Lisp_Object BUFFER_INTERNAL_FIELD (downcase_table); /* Char-table mapping each char to its upper-case version. */ - Lisp_Object upcase_table; + Lisp_Object BUFFER_INTERNAL_FIELD (upcase_table); /* Char-table for conversion for case-folding search. */ - Lisp_Object case_canon_table; + Lisp_Object BUFFER_INTERNAL_FIELD (case_canon_table); /* Char-table of equivalences for case-folding search. */ - Lisp_Object case_eqv_table; + Lisp_Object BUFFER_INTERNAL_FIELD (case_eqv_table); /* Non-nil means do not display continuation lines. */ - Lisp_Object truncate_lines; + Lisp_Object BUFFER_INTERNAL_FIELD (truncate_lines); /* Non-nil means to use word wrapping when displaying continuation lines. */ - Lisp_Object word_wrap; + Lisp_Object BUFFER_INTERNAL_FIELD (word_wrap); /* Non-nil means display ctl chars with uparrow. */ - Lisp_Object ctl_arrow; + Lisp_Object BUFFER_INTERNAL_FIELD (ctl_arrow); /* Non-nil means reorder bidirectional text for display in the visual order. */ - Lisp_Object bidi_display_reordering; + Lisp_Object BUFFER_INTERNAL_FIELD (bidi_display_reordering); /* If non-nil, specifies which direction of text to force in all the paragraphs of the buffer. Nil means determine paragraph direction dynamically for each paragraph. */ - Lisp_Object bidi_paragraph_direction; + Lisp_Object BUFFER_INTERNAL_FIELD (bidi_paragraph_direction); /* Non-nil means do selective display; see doc string in syms_of_buffer (buffer.c) for details. */ - Lisp_Object selective_display; + Lisp_Object BUFFER_INTERNAL_FIELD (selective_display); #ifndef old /* Non-nil means show ... at end of line followed by invisible lines. */ - Lisp_Object selective_display_ellipses; + Lisp_Object BUFFER_INTERNAL_FIELD (selective_display_ellipses); #endif /* Alist of (FUNCTION . STRING) for each minor mode enabled in buffer. */ - Lisp_Object minor_modes; + Lisp_Object BUFFER_INTERNAL_FIELD (minor_modes); /* t if "self-insertion" should overwrite; `binary' if it should also overwrite newlines and tabs - for editing executables and the like. */ - Lisp_Object overwrite_mode; + Lisp_Object BUFFER_INTERNAL_FIELD (overwrite_mode); /* non-nil means abbrev mode is on. Expand abbrevs automatically. */ - Lisp_Object abbrev_mode; + Lisp_Object BUFFER_INTERNAL_FIELD (abbrev_mode); /* Display table to use for text in this buffer. */ - Lisp_Object display_table; + Lisp_Object BUFFER_INTERNAL_FIELD (display_table); /* t means the mark and region are currently active. */ - Lisp_Object mark_active; + Lisp_Object BUFFER_INTERNAL_FIELD (mark_active); /* Non-nil means the buffer contents are regarded as multi-byte form of characters, not a binary code. */ - Lisp_Object enable_multibyte_characters; + Lisp_Object BUFFER_INTERNAL_FIELD (enable_multibyte_characters); /* Coding system to be used for encoding the buffer contents on saving. */ - Lisp_Object buffer_file_coding_system; + Lisp_Object BUFFER_INTERNAL_FIELD (buffer_file_coding_system); /* List of symbols naming the file format used for visited file. */ - Lisp_Object file_format; + Lisp_Object BUFFER_INTERNAL_FIELD (file_format); /* List of symbols naming the file format used for auto-save file. */ - Lisp_Object auto_save_file_format; + Lisp_Object BUFFER_INTERNAL_FIELD (auto_save_file_format); /* True if the newline position cache and width run cache are enabled. See search.c and indent.c. */ - Lisp_Object cache_long_line_scans; + Lisp_Object BUFFER_INTERNAL_FIELD (cache_long_line_scans); /* If the width run cache is enabled, this table contains the character widths width_run_cache (see above) assumes. When we @@ -726,99 +729,99 @@ struct buffer current display table to see whether the display table has affected the widths of any characters. If it has, we invalidate the width run cache, and re-initialize width_table. */ - Lisp_Object width_table; + Lisp_Object BUFFER_INTERNAL_FIELD (width_table); /* In an indirect buffer, or a buffer that is the base of an indirect buffer, this holds a marker that records PT for this buffer when the buffer is not current. */ - Lisp_Object pt_marker; + Lisp_Object BUFFER_INTERNAL_FIELD (pt_marker); /* In an indirect buffer, or a buffer that is the base of an indirect buffer, this holds a marker that records BEGV for this buffer when the buffer is not current. */ - Lisp_Object begv_marker; + Lisp_Object BUFFER_INTERNAL_FIELD (begv_marker); /* In an indirect buffer, or a buffer that is the base of an indirect buffer, this holds a marker that records ZV for this buffer when the buffer is not current. */ - Lisp_Object zv_marker; + Lisp_Object BUFFER_INTERNAL_FIELD (zv_marker); /* This holds the point value before the last scroll operation. Explicitly setting point sets this to nil. */ - Lisp_Object point_before_scroll; + Lisp_Object BUFFER_INTERNAL_FIELD (point_before_scroll); /* Truename of the visited file, or nil. */ - Lisp_Object file_truename; + Lisp_Object BUFFER_INTERNAL_FIELD (file_truename); /* Invisibility spec of this buffer. t => any non-nil `invisible' property means invisible. A list => `invisible' property means invisible if it is memq in that list. */ - Lisp_Object invisibility_spec; + Lisp_Object BUFFER_INTERNAL_FIELD (invisibility_spec); /* This is the last window that was selected with this buffer in it, or nil if that window no longer displays this buffer. */ - Lisp_Object last_selected_window; + Lisp_Object BUFFER_INTERNAL_FIELD (last_selected_window); /* Incremented each time the buffer is displayed in a window. */ - Lisp_Object display_count; + Lisp_Object BUFFER_INTERNAL_FIELD (display_count); /* Widths of left and right marginal areas for windows displaying this buffer. */ - Lisp_Object left_margin_cols, right_margin_cols; + Lisp_Object BUFFER_INTERNAL_FIELD (left_margin_cols), BUFFER_INTERNAL_FIELD (right_margin_cols); /* Widths of left and right fringe areas for windows displaying this buffer. */ - Lisp_Object left_fringe_width, right_fringe_width; + Lisp_Object BUFFER_INTERNAL_FIELD (left_fringe_width), BUFFER_INTERNAL_FIELD (right_fringe_width); /* Non-nil means fringes are drawn outside display margins; othersize draw them between margin areas and text. */ - Lisp_Object fringes_outside_margins; + Lisp_Object BUFFER_INTERNAL_FIELD (fringes_outside_margins); /* Width and type of scroll bar areas for windows displaying this buffer. */ - Lisp_Object scroll_bar_width, vertical_scroll_bar_type; + Lisp_Object BUFFER_INTERNAL_FIELD (scroll_bar_width), BUFFER_INTERNAL_FIELD (vertical_scroll_bar_type); /* Non-nil means indicate lines not displaying text (in a style like vi). */ - Lisp_Object indicate_empty_lines; + Lisp_Object BUFFER_INTERNAL_FIELD (indicate_empty_lines); /* Non-nil means indicate buffer boundaries and scrolling. */ - Lisp_Object indicate_buffer_boundaries; + Lisp_Object BUFFER_INTERNAL_FIELD (indicate_buffer_boundaries); /* Logical to physical fringe bitmap mappings. */ - Lisp_Object fringe_indicator_alist; + Lisp_Object BUFFER_INTERNAL_FIELD (fringe_indicator_alist); /* Logical to physical cursor bitmap mappings. */ - Lisp_Object fringe_cursor_alist; + Lisp_Object BUFFER_INTERNAL_FIELD (fringe_cursor_alist); /* Time stamp updated each time this buffer is displayed in a window. */ - Lisp_Object display_time; + Lisp_Object BUFFER_INTERNAL_FIELD (display_time); /* If scrolling the display because point is below the bottom of a window showing this buffer, try to choose a window start so that point ends up this number of lines from the top of the window. Nil means that scrolling method isn't used. */ - Lisp_Object scroll_up_aggressively; + Lisp_Object BUFFER_INTERNAL_FIELD (scroll_up_aggressively); /* If scrolling the display because point is above the top of a window showing this buffer, try to choose a window start so that point ends up this number of lines from the bottom of the window. Nil means that scrolling method isn't used. */ - Lisp_Object scroll_down_aggressively; + Lisp_Object BUFFER_INTERNAL_FIELD (scroll_down_aggressively); /* Desired cursor type in this buffer. See the doc string of per-buffer variable `cursor-type'. */ - Lisp_Object cursor_type; + Lisp_Object BUFFER_INTERNAL_FIELD (cursor_type); /* An integer > 0 means put that number of pixels below text lines in the display of this buffer. */ - Lisp_Object extra_line_spacing; + Lisp_Object BUFFER_INTERNAL_FIELD (extra_line_spacing); /* *Cursor type to display in non-selected windows. t means to use hollow box cursor. See `cursor-type' for other values. */ - Lisp_Object cursor_in_non_selected_windows; + Lisp_Object BUFFER_INTERNAL_FIELD (cursor_in_non_selected_windows); }; @@ -942,7 +945,7 @@ extern int last_per_buffer_idx; from the start of a buffer structure. */ #define PER_BUFFER_VAR_OFFSET(VAR) \ - offsetof (struct buffer, VAR) + offsetof (struct buffer, BUFFER_INTERNAL_FIELD (VAR)) /* Return the index of buffer-local variable VAR. Each per-buffer variable has an index > 0 associated with it, except when it always diff --git a/src/bytecode.c b/src/bytecode.c index b2e9e3c5b56..639c543dbf9 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -51,7 +51,7 @@ by Hallvard: * * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. */ -#define BYTE_CODE_SAFE +/* #define BYTE_CODE_SAFE 1 */ /* #define BYTE_CODE_METER */ @@ -236,6 +236,8 @@ extern Lisp_Object Qand_optional, Qand_rest; #define Bconstant 0300 #define CONSTANTLIM 0100 +/* Whether to maintain a `top' and `bottom' field in the stack frame. */ +#define BYTE_MAINTAIN_TOP (BYTE_CODE_SAFE || BYTE_MARK_STACK) /* Structure describing a value stack used during byte-code execution in Fbyte_code. */ @@ -248,7 +250,9 @@ struct byte_stack /* Top and bottom of stack. The bottom points to an area of memory allocated with alloca in Fbyte_code. */ +#if BYTE_MAINTAIN_TOP Lisp_Object *top, *bottom; +#endif /* The string containing the byte-code, and its current address. Storing this here protects it from GC because mark_byte_stack @@ -275,6 +279,7 @@ struct byte_stack *byte_stack_list; /* Mark objects on byte_stack_list. Called during GC. */ +#if BYTE_MARK_STACK void mark_byte_stack (void) { @@ -299,7 +304,7 @@ mark_byte_stack (void) mark_object (stack->constants); } } - +#endif /* Unmark objects in the stacks on byte_stack_list. Relocate program counters. Called when GC has completed. */ @@ -353,8 +358,13 @@ unmark_byte_stack (void) /* Actions that must be performed before and after calling a function that might GC. */ +#if !BYTE_MAINTAIN_TOP +#define BEFORE_POTENTIAL_GC() ((void)0) +#define AFTER_POTENTIAL_GC() ((void)0) +#else #define BEFORE_POTENTIAL_GC() stack.top = top #define AFTER_POTENTIAL_GC() stack.top = NULL +#endif /* Garbage collect if we have consed enough since the last time. We do this at every branch, to avoid loops that never GC. */ @@ -478,10 +488,13 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, stack.byte_string = bytestr; stack.pc = stack.byte_string_start = SDATA (bytestr); stack.constants = vector; - stack.bottom = (Lisp_Object *) alloca (XFASTINT (maxdepth) + top = (Lisp_Object *) alloca (XFASTINT (maxdepth) * sizeof (Lisp_Object)); - top = stack.bottom - 1; +#if BYTE_MAINTAIN_TOP + stack.bottom = top; stack.top = NULL; +#endif + top -= 1; stack.next = byte_stack_list; byte_stack_list = &stack; @@ -1468,7 +1481,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, CHECK_CHARACTER (TOP); AFTER_POTENTIAL_GC (); c = XFASTINT (TOP); - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) MAKE_CHAR_MULTIBYTE (c); XSETFASTINT (TOP, syntax_code_spec[(int) SYNTAX (c)]); } diff --git a/src/callint.c b/src/callint.c index 36d295d750c..253f2b9dd09 100644 --- a/src/callint.c +++ b/src/callint.c @@ -149,12 +149,12 @@ static void check_mark (int for_region) { Lisp_Object tem; - tem = Fmarker_buffer (current_buffer->mark); + tem = Fmarker_buffer (BVAR (current_buffer, mark)); if (NILP (tem) || (XBUFFER (tem) != current_buffer)) error (for_region ? "The mark is not set now, so there is no region" : "The mark is not set now"); if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive) - && NILP (current_buffer->mark_active)) + && NILP (BVAR (current_buffer, mark_active))) xsignal0 (Qmark_inactive); } @@ -280,7 +280,7 @@ invoke it. If KEYS is omitted or nil, the return value of save_this_command = Vthis_command; save_this_original_command = Vthis_original_command; save_real_this_command = real_this_command; - save_last_command = current_kboard->Vlast_command; + save_last_command = KVAR (current_kboard, Vlast_command); if (NILP (keys)) keys = this_command_keys, key_count = this_command_key_count; @@ -363,7 +363,7 @@ invoke it. If KEYS is omitted or nil, the return value of Vthis_command = save_this_command; Vthis_original_command = save_this_original_command; real_this_command= save_real_this_command; - current_kboard->Vlast_command = save_last_command; + KVAR (current_kboard, Vlast_command) = save_last_command; temporarily_switch_to_single_kboard (NULL); return unbind_to (speccount, apply1 (function, specs)); @@ -385,7 +385,7 @@ invoke it. If KEYS is omitted or nil, the return value of else if (*string == '*') { string++; - if (!NILP (current_buffer->read_only)) + if (!NILP (BVAR (current_buffer, read_only))) { if (!NILP (record_flag)) { @@ -543,7 +543,7 @@ invoke it. If KEYS is omitted or nil, the return value of case 'D': /* Directory name. */ args[i] = Fread_file_name (callint_message, Qnil, - current_buffer->directory, Qlambda, Qnil, + BVAR (current_buffer, directory), Qlambda, Qnil, Qfile_directory_p); break; @@ -661,7 +661,7 @@ invoke it. If KEYS is omitted or nil, the return value of case 'm': /* Value of mark. Does not do I/O. */ check_mark (0); /* visargs[i] = Qnil; */ - args[i] = current_buffer->mark; + args[i] = BVAR (current_buffer, mark); varies[i] = 2; break; @@ -717,11 +717,11 @@ invoke it. If KEYS is omitted or nil, the return value of check_mark (1); set_marker_both (point_marker, Qnil, PT, PT_BYTE); /* visargs[i+1] = Qnil; */ - foo = marker_position (current_buffer->mark); + foo = marker_position (BVAR (current_buffer, mark)); /* visargs[i] = Qnil; */ - args[i] = PT < foo ? point_marker : current_buffer->mark; + args[i] = PT < foo ? point_marker : BVAR (current_buffer, mark); varies[i] = 3; - args[++i] = PT > foo ? point_marker : current_buffer->mark; + args[++i] = PT > foo ? point_marker : BVAR (current_buffer, mark); varies[i] = 4; break; @@ -832,7 +832,7 @@ invoke it. If KEYS is omitted or nil, the return value of Vthis_command = save_this_command; Vthis_original_command = save_this_original_command; real_this_command= save_real_this_command; - current_kboard->Vlast_command = save_last_command; + KVAR (current_kboard, Vlast_command) = save_last_command; { Lisp_Object val; diff --git a/src/callproc.c b/src/callproc.c index 925eefb4b02..c53a92bbaf8 100644 --- a/src/callproc.c +++ b/src/callproc.c @@ -74,10 +74,6 @@ extern char **environ; /* Pattern used by call-process-region to make temp files. */ static Lisp_Object Vtemp_file_name_pattern; -#ifdef DOS_NT -Lisp_Object Qbuffer_file_type; -#endif /* DOS_NT */ - /* True if we are about to fork off a synchronous process or if we are waiting for it. */ int synch_process_alive; @@ -265,7 +261,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) if (nargs >= 2 && ! NILP (args[1])) { - infile = Fexpand_file_name (args[1], current_buffer->directory); + infile = Fexpand_file_name (args[1], BVAR (current_buffer, directory)); CHECK_STRING (infile); } else @@ -322,7 +318,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) { struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; - current_dir = current_buffer->directory; + current_dir = BVAR (current_buffer, directory); GCPRO4 (infile, buffer, current_dir, error_file); @@ -336,7 +332,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) if (NILP (Ffile_accessible_directory_p (current_dir))) report_file_error ("Setting current directory", - Fcons (current_buffer->directory, Qnil)); + Fcons (BVAR (current_buffer, directory), Qnil)); if (STRING_MULTIBYTE (infile)) infile = ENCODE_FILE (infile); @@ -445,6 +441,11 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) register char **save_environ = environ; register int fd1 = fd[1]; int fd_error = fd1; +#ifdef HAVE_WORKING_VFORK + sigset_t procmask; + sigset_t blocked; + struct sigaction sigpipe_action; +#endif #if 0 /* Some systems don't have sigblock. */ mask = sigblock (sigmask (SIGCHLD)); @@ -525,6 +526,18 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) pid = child_setup (filefd, fd1, fd_error, (char **) new_argv, 0, current_dir); #else /* not WINDOWSNT */ + +#ifdef HAVE_WORKING_VFORK + /* On many hosts (e.g. Solaris 2.4), if a vforked child calls `signal', + this sets the parent's signal handlers as well as the child's. + So delay all interrupts whose handlers the child might munge, + and record the current handlers so they can be restored later. */ + sigemptyset (&blocked); + sigaddset (&blocked, SIGPIPE); + sigaction (SIGPIPE, 0, &sigpipe_action); + sigprocmask (SIG_BLOCK, &blocked, &procmask); +#endif + BLOCK_INPUT; pid = vfork (); @@ -541,11 +554,26 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) #else setpgrp (pid, pid); #endif /* USG */ + + /* GConf causes us to ignore SIGPIPE, make sure it is restored + in the child. */ + //signal (SIGPIPE, SIG_DFL); +#ifdef HAVE_WORKING_VFORK + sigprocmask (SIG_SETMASK, &procmask, 0); +#endif + child_setup (filefd, fd1, fd_error, (char **) new_argv, 0, current_dir); } UNBLOCK_INPUT; + +#ifdef HAVE_WORKING_VFORK + /* Restore the signal state. */ + sigaction (SIGPIPE, &sigpipe_action, 0); + sigprocmask (SIG_SETMASK, &procmask, 0); +#endif + #endif /* not WINDOWSNT */ /* The MSDOS case did this already. */ @@ -631,7 +659,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) /* In unibyte mode, character code conversion should not take place but EOL conversion should. So, setup raw-text or one of the subsidiary according to the information just setup. */ - if (NILP (current_buffer->enable_multibyte_characters) + if (NILP (BVAR (current_buffer, enable_multibyte_characters)) && !NILP (val)) val = raw_text_coding_system (val); setup_coding_system (val, &process_coding); @@ -681,7 +709,7 @@ usage: (call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS) */) if (!NILP (buffer)) { - if (NILP (current_buffer->enable_multibyte_characters) + if (NILP (BVAR (current_buffer, enable_multibyte_characters)) && ! CODING_MAY_REQUIRE_DECODING (&process_coding)) insert_1_both (buf, nread, nread, 0, 1, 0); else @@ -894,7 +922,7 @@ usage: (call-process-region START END PROGRAM &optional DELETE BUFFER DISPLAY &r /* Decide coding-system of the contents of the temporary file. */ if (!NILP (Vcoding_system_for_write)) val = Vcoding_system_for_write; - else if (NILP (current_buffer->enable_multibyte_characters)) + else if (NILP (BVAR (current_buffer, enable_multibyte_characters))) val = Qraw_text; else { @@ -1503,11 +1531,6 @@ set_initial_environment (void) void syms_of_callproc (void) { -#ifdef DOS_NT - Qbuffer_file_type = intern_c_string ("buffer-file-type"); - staticpro (&Qbuffer_file_type); -#endif /* DOS_NT */ - #ifndef DOS_NT Vtemp_file_name_pattern = build_string ("emacsXXXXXX"); #elif defined (WINDOWSNT) diff --git a/src/casefiddle.c b/src/casefiddle.c index 62d261278ab..26fa0db2d77 100644 --- a/src/casefiddle.c +++ b/src/casefiddle.c @@ -39,15 +39,15 @@ casify_object (enum case_action flag, Lisp_Object obj) register int inword = flag == CASE_DOWN; /* If the case table is flagged as modified, rescan it. */ - if (NILP (XCHAR_TABLE (current_buffer->downcase_table)->extras[1])) - Fset_case_table (current_buffer->downcase_table); + if (NILP (XCHAR_TABLE (BVAR (current_buffer, downcase_table))->extras[1])) + Fset_case_table (BVAR (current_buffer, downcase_table)); if (INTEGERP (obj)) { int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER | CHAR_SHIFT | CHAR_CTL | CHAR_META); int flags = XINT (obj) & flagbits; - int multibyte = ! NILP (current_buffer->enable_multibyte_characters); + int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); /* If the character has higher bits set above the flags, return it unchanged. @@ -198,7 +198,7 @@ casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e) { register int c; register int inword = flag == CASE_DOWN; - register int multibyte = !NILP (current_buffer->enable_multibyte_characters); + register int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); EMACS_INT start, end; EMACS_INT start_byte, end_byte; EMACS_INT first = -1, last; /* Position of first and last changes. */ @@ -210,8 +210,8 @@ casify_region (enum case_action flag, Lisp_Object b, Lisp_Object e) return; /* If the case table is flagged as modified, rescan it. */ - if (NILP (XCHAR_TABLE (current_buffer->downcase_table)->extras[1])) - Fset_case_table (current_buffer->downcase_table); + if (NILP (XCHAR_TABLE (BVAR (current_buffer, downcase_table))->extras[1])) + Fset_case_table (BVAR (current_buffer, downcase_table)); validate_region (&b, &e); start = XFASTINT (b); diff --git a/src/casetab.c b/src/casetab.c index 0db9d63f7a6..5207e5315ae 100644 --- a/src/casetab.c +++ b/src/casetab.c @@ -71,7 +71,7 @@ DEFUN ("current-case-table", Fcurrent_case_table, Scurrent_case_table, 0, 0, 0, doc: /* Return the case table of the current buffer. */) (void) { - return current_buffer->downcase_table; + return BVAR (current_buffer, downcase_table); } DEFUN ("standard-case-table", Fstandard_case_table, Sstandard_case_table, 0, 0, 0, @@ -160,10 +160,10 @@ set_case_table (Lisp_Object table, int standard) } else { - current_buffer->downcase_table = table; - current_buffer->upcase_table = up; - current_buffer->case_canon_table = canon; - current_buffer->case_eqv_table = eqv; + BVAR (current_buffer, downcase_table) = table; + BVAR (current_buffer, upcase_table) = up; + BVAR (current_buffer, case_canon_table) = canon; + BVAR (current_buffer, case_eqv_table) = eqv; } return table; diff --git a/src/category.c b/src/category.c index 06046959b6f..bcd73d3a487 100644 --- a/src/category.c +++ b/src/category.c @@ -190,7 +190,7 @@ Lisp_Object check_category_table (Lisp_Object table) { if (NILP (table)) - return current_buffer->category_table; + return BVAR (current_buffer, category_table); CHECK_TYPE (!NILP (Fcategory_table_p (table)), Qcategory_table_p, table); return table; } @@ -200,7 +200,7 @@ DEFUN ("category-table", Fcategory_table, Scategory_table, 0, 0, 0, This is the one specified by the current buffer. */) (void) { - return current_buffer->category_table; + return BVAR (current_buffer, category_table); } DEFUN ("standard-category-table", Fstandard_category_table, @@ -281,7 +281,7 @@ Return TABLE. */) { int idx; table = check_category_table (table); - current_buffer->category_table = table; + BVAR (current_buffer, category_table) = table; /* Indicate that this buffer now has a specified category table. */ idx = PER_BUFFER_VAR_IDX (category_table); SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1); @@ -292,7 +292,7 @@ Return TABLE. */) Lisp_Object char_category_set (int c) { - return CHAR_TABLE_REF (current_buffer->category_table, c); + return CHAR_TABLE_REF (BVAR (current_buffer, category_table), c); } DEFUN ("char-category-set", Fchar_category_set, Schar_category_set, 1, 1, 0, diff --git a/src/category.h b/src/category.h index 561b06b6f60..b279f3d9c59 100644 --- a/src/category.h +++ b/src/category.h @@ -91,7 +91,7 @@ extern Lisp_Object _temp_category_set; /* The standard category table is stored where it will automatically be used in all new buffers. */ -#define Vstandard_category_table buffer_defaults.category_table +#define Vstandard_category_table BVAR (&buffer_defaults, category_table) /* Return the category set of character C in the current category table. */ #define CATEGORY_SET(c) char_category_set (c) diff --git a/src/character.c b/src/character.c index 397481e5b39..f12c4f28d31 100644 --- a/src/character.c +++ b/src/character.c @@ -521,7 +521,7 @@ chars_in_text (const unsigned char *ptr, EMACS_INT nbytes) { /* current_buffer is null at early stages of Emacs initialization. */ if (current_buffer == 0 - || NILP (current_buffer->enable_multibyte_characters)) + || NILP (BVAR (current_buffer, enable_multibyte_characters))) return nbytes; return multibyte_chars_in_text (ptr, nbytes); @@ -987,7 +987,7 @@ character is not ASCII nor 8-bit character, an error is signalled. */) pos = XFASTINT (position); p = CHAR_POS_ADDR (pos); } - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) return make_number (*p); } else diff --git a/src/character.h b/src/character.h index f2ccb28bb37..fb29ced66b7 100644 --- a/src/character.h +++ b/src/character.h @@ -417,7 +417,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ do \ { \ CHARIDX++; \ - if (!NILP (current_buffer->enable_multibyte_characters)) \ + if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) \ { \ unsigned char *ptr = BYTE_POS_ADDR (BYTEIDX); \ int len; \ @@ -484,7 +484,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ do \ { \ (charpos)++; \ - if (NILP (current_buffer->enable_multibyte_characters)) \ + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) \ (bytepos)++; \ else \ INC_POS ((bytepos)); \ @@ -498,7 +498,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ do \ { \ (charpos)--; \ - if (NILP (current_buffer->enable_multibyte_characters)) \ + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) \ (bytepos)--; \ else \ DEC_POS ((bytepos)); \ @@ -561,11 +561,11 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #define ASCII_CHAR_WIDTH(c) \ (c < 0x20 \ ? (c == '\t' \ - ? XFASTINT (current_buffer->tab_width) \ - : (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2))) \ + ? XFASTINT (BVAR (current_buffer, tab_width)) \ + : (c == '\n' ? 0 : (NILP (BVAR (current_buffer, ctl_arrow)) ? 4 : 2))) \ : (c < 0x7f \ ? 1 \ - : ((NILP (current_buffer->ctl_arrow) ? 4 : 2)))) + : ((NILP (BVAR (current_buffer, ctl_arrow)) ? 4 : 2)))) /* Return the width of character C. The width is measured by how many columns C will occupy on the screen when displayed in the current diff --git a/src/charset.c b/src/charset.c index 229f2c2cdae..3624e740acb 100644 --- a/src/charset.c +++ b/src/charset.c @@ -1554,7 +1554,7 @@ only `ascii', `eight-bit-control', and `eight-bit-graphic'. */) EMACS_INT from, from_byte, to, stop, stop_byte; int i; Lisp_Object val; - int multibyte = ! NILP (current_buffer->enable_multibyte_characters); + int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); validate_region (&beg, &end); from = XFASTINT (beg); diff --git a/src/cmds.c b/src/cmds.c index 93b7e2b7651..336bf1154f9 100644 --- a/src/cmds.c +++ b/src/cmds.c @@ -277,7 +277,7 @@ After insertion, the value of `auto-fill-function' is called if the int remove_boundary = 1; CHECK_NATNUM (n); - if (!EQ (Vthis_command, current_kboard->Vlast_command)) + if (!EQ (Vthis_command, KVAR (current_kboard, Vlast_command))) nonundocount = 0; if (NILP (Vexecuting_kbd_macro) @@ -292,10 +292,10 @@ After insertion, the value of `auto-fill-function' is called if the } if (remove_boundary - && CONSP (current_buffer->undo_list) - && NILP (XCAR (current_buffer->undo_list))) + && CONSP (BVAR (current_buffer, undo_list)) + && NILP (XCAR (BVAR (current_buffer, undo_list)))) /* Remove the undo_boundary that was just pushed. */ - current_buffer->undo_list = XCDR (current_buffer->undo_list); + BVAR (current_buffer, undo_list) = XCDR (BVAR (current_buffer, undo_list)); /* Barf if the key that invoked this was not a character. */ if (!CHARACTERP (last_command_event)) @@ -335,12 +335,12 @@ internal_self_insert (int c, EMACS_INT n) EMACS_INT chars_to_delete = 0; EMACS_INT spaces_to_insert = 0; - overwrite = current_buffer->overwrite_mode; + overwrite = BVAR (current_buffer, overwrite_mode); if (!NILP (Vbefore_change_functions) || !NILP (Vafter_change_functions)) hairy = 1; /* At first, get multi-byte form of C in STR. */ - if (!NILP (current_buffer->enable_multibyte_characters)) + if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) { len = CHAR_STRING (c, str); if (len == 1) @@ -416,11 +416,11 @@ internal_self_insert (int c, EMACS_INT n) synt = SYNTAX (c); - if (!NILP (current_buffer->abbrev_mode) + if (!NILP (BVAR (current_buffer, abbrev_mode)) && synt != Sword - && NILP (current_buffer->read_only) + && NILP (BVAR (current_buffer, read_only)) && PT > BEGV - && (SYNTAX (!NILP (current_buffer->enable_multibyte_characters) + && (SYNTAX (!NILP (BVAR (current_buffer, enable_multibyte_characters)) ? XFASTINT (Fprevious_char ()) : UNIBYTE_TO_CHAR (XFASTINT (Fprevious_char ()))) == Sword)) @@ -448,7 +448,7 @@ internal_self_insert (int c, EMACS_INT n) if (chars_to_delete) { - int mc = ((NILP (current_buffer->enable_multibyte_characters) + int mc = ((NILP (BVAR (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)); @@ -479,7 +479,7 @@ internal_self_insert (int c, EMACS_INT n) if ((CHAR_TABLE_P (Vauto_fill_chars) ? !NILP (CHAR_TABLE_REF (Vauto_fill_chars, c)) : (c == ' ' || c == '\n')) - && !NILP (current_buffer->auto_fill_function)) + && !NILP (BVAR (current_buffer, auto_fill_function))) { Lisp_Object tem; @@ -488,7 +488,7 @@ internal_self_insert (int c, EMACS_INT n) that. Must have the newline in place already so filling and justification, if any, know where the end is going to be. */ SET_PT_BOTH (PT - 1, PT_BYTE - 1); - tem = call0 (current_buffer->auto_fill_function); + tem = call0 (BVAR (current_buffer, auto_fill_function)); /* Test PT < ZV in case the auto-fill-function is strange. */ if (c == '\n' && PT < ZV) SET_PT_BOTH (PT + 1, PT_BYTE + 1); diff --git a/src/coding.c b/src/coding.c index a9f16de56f3..f6310369ad3 100644 --- a/src/coding.c +++ b/src/coding.c @@ -7038,8 +7038,8 @@ decode_coding (struct coding_system *coding) set_buffer_internal (XBUFFER (coding->dst_object)); if (GPT != PT) move_gap_both (PT, PT_BYTE); - undo_list = current_buffer->undo_list; - current_buffer->undo_list = Qt; + undo_list = BVAR (current_buffer, undo_list); + BVAR (current_buffer, undo_list) = Qt; } coding->consumed = coding->consumed_char = 0; @@ -7136,7 +7136,7 @@ decode_coding (struct coding_system *coding) decode_eol (coding); if (BUFFERP (coding->dst_object)) { - current_buffer->undo_list = undo_list; + BVAR (current_buffer, undo_list) = undo_list; record_insert (coding->dst_pos, coding->produced_char); } return coding->result; @@ -7433,7 +7433,7 @@ encode_coding (struct coding_system *coding) { set_buffer_internal (XBUFFER (coding->dst_object)); coding->dst_multibyte - = ! NILP (current_buffer->enable_multibyte_characters); + = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); } coding->consumed = coding->consumed_char = 0; @@ -7504,8 +7504,8 @@ make_conversion_work_buffer (int multibyte) doesn't compile new regexps. */ Fset (Fmake_local_variable (Qinhibit_modification_hooks), Qt); Ferase_buffer (); - current_buffer->undo_list = Qt; - current_buffer->enable_multibyte_characters = multibyte ? Qt : Qnil; + BVAR (current_buffer, undo_list) = Qt; + BVAR (current_buffer, enable_multibyte_characters) = multibyte ? Qt : Qnil; set_buffer_internal (current); return workbuf; } @@ -7562,7 +7562,7 @@ decode_coding_gap (struct coding_system *coding, coding->dst_object = coding->src_object; coding->dst_pos = PT; coding->dst_pos_byte = PT_BYTE; - coding->dst_multibyte = ! NILP (current_buffer->enable_multibyte_characters); + coding->dst_multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); if (CODING_REQUIRE_DETECTION (coding)) detect_coding (coding); @@ -7728,7 +7728,7 @@ decode_coding_object (struct coding_system *coding, coding->dst_pos = BUF_PT (XBUFFER (dst_object)); coding->dst_pos_byte = BUF_PT_BYTE (XBUFFER (dst_object)); coding->dst_multibyte - = ! NILP (XBUFFER (dst_object)->enable_multibyte_characters); + = ! NILP (BVAR (XBUFFER (dst_object), enable_multibyte_characters)); } else { @@ -7798,7 +7798,7 @@ decode_coding_object (struct coding_system *coding, TEMP_SET_PT_BOTH (saved_pt, saved_pt_byte); else if (saved_pt < from + chars) TEMP_SET_PT_BOTH (from, from_byte); - else if (! NILP (current_buffer->enable_multibyte_characters)) + else if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) TEMP_SET_PT_BOTH (saved_pt + (coding->produced_char - chars), saved_pt_byte + (coding->produced - bytes)); else @@ -7822,7 +7822,7 @@ decode_coding_object (struct coding_system *coding, { tail->bytepos = from_byte + coding->produced; tail->charpos - = (NILP (current_buffer->enable_multibyte_characters) + = (NILP (BVAR (current_buffer, enable_multibyte_characters)) ? tail->bytepos : from + coding->produced_char); } } @@ -7960,7 +7960,7 @@ encode_coding_object (struct coding_system *coding, set_buffer_temp (current); } coding->dst_multibyte - = ! NILP (XBUFFER (dst_object)->enable_multibyte_characters); + = ! NILP (BVAR (XBUFFER (dst_object), enable_multibyte_characters)); } else if (EQ (dst_object, Qt)) { @@ -8003,7 +8003,7 @@ encode_coding_object (struct coding_system *coding, TEMP_SET_PT_BOTH (saved_pt, saved_pt_byte); else if (saved_pt < from + chars) TEMP_SET_PT_BOTH (from, from_byte); - else if (! NILP (current_buffer->enable_multibyte_characters)) + else if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) TEMP_SET_PT_BOTH (saved_pt + (coding->produced_char - chars), saved_pt_byte + (coding->produced - bytes)); else @@ -8027,7 +8027,7 @@ encode_coding_object (struct coding_system *coding, { tail->bytepos = from_byte + coding->produced; tail->charpos - = (NILP (current_buffer->enable_multibyte_characters) + = (NILP (BVAR (current_buffer, enable_multibyte_characters)) ? tail->bytepos : from + coding->produced_char); } } @@ -8481,8 +8481,8 @@ highest priority. */) return detect_coding_system (BYTE_POS_ADDR (from_byte), to - from, to_byte - from_byte, !NILP (highest), - !NILP (current_buffer - ->enable_multibyte_characters), + !NILP (BVAR (current_buffer + , enable_multibyte_characters)), Qnil); } @@ -8564,7 +8564,7 @@ DEFUN ("find-coding-systems-region-internal", CHECK_NUMBER_COERCE_MARKER (end); if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end)) args_out_of_range (start, end); - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) return Qt; start_byte = CHAR_TO_BYTE (XINT (start)); end_byte = CHAR_TO_BYTE (XINT (end)); @@ -8698,7 +8698,7 @@ to the string. */) validate_region (&start, &end); from = XINT (start); to = XINT (end); - if (NILP (current_buffer->enable_multibyte_characters) + if (NILP (BVAR (current_buffer, enable_multibyte_characters)) || (ascii_compatible && (to - from) == (CHAR_TO_BYTE (to) - (CHAR_TO_BYTE (from))))) return Qnil; @@ -8814,7 +8814,7 @@ is nil. */) CHECK_NUMBER_COERCE_MARKER (end); if (XINT (start) < BEG || XINT (end) > Z || XINT (start) > XINT (end)) args_out_of_range (start, end); - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) return Qnil; start_byte = CHAR_TO_BYTE (XINT (start)); end_byte = CHAR_TO_BYTE (XINT (end)); diff --git a/src/composite.c b/src/composite.c index 58bc68597cc..0b0602bf283 100644 --- a/src/composite.c +++ b/src/composite.c @@ -796,7 +796,7 @@ fill_gstring_header (Lisp_Object header, Lisp_Object start, Lisp_Object end, Lis if (NILP (string)) { - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) error ("Attempt to shape unibyte text"); validate_region (&start, &end); from = XFASTINT (start); @@ -1028,7 +1028,7 @@ composition_compute_stop_pos (struct composition_it *cmp_it, EMACS_INT charpos, cmp_it->stop_pos = endpos = start; cmp_it->ch = -1; } - if (NILP (current_buffer->enable_multibyte_characters) + if (NILP (BVAR (current_buffer, enable_multibyte_characters)) || NILP (Vauto_composition_mode)) return; if (bytepos < 0) @@ -1674,7 +1674,7 @@ composition_adjust_point (EMACS_INT last_pt, EMACS_INT new_pt) return new_pt; } - if (NILP (current_buffer->enable_multibyte_characters) + if (NILP (BVAR (current_buffer, enable_multibyte_characters)) || NILP (Vauto_composition_mode)) return new_pt; @@ -1851,7 +1851,7 @@ See `find-composition' for more details. */) if (!find_composition (from, to, &start, &end, &prop, string)) { - if (!NILP (current_buffer->enable_multibyte_characters) + if (!NILP (BVAR (current_buffer, enable_multibyte_characters)) && ! NILP (Vauto_composition_mode) && find_automatic_composition (from, to, &start, &end, &gstring, string)) diff --git a/src/config.in b/src/config.in index df492bf8f87..1fd1f89ede3 100644 --- a/src/config.in +++ b/src/config.in @@ -31,6 +31,21 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define if building universal (internal helper macro) */ #undef AC_APPLE_UNIVERSAL_BUILD +/* Define to the number of bits in type 'ptrdiff_t'. */ +#undef BITSIZEOF_PTRDIFF_T + +/* Define to the number of bits in type 'sig_atomic_t'. */ +#undef BITSIZEOF_SIG_ATOMIC_T + +/* Define to the number of bits in type 'size_t'. */ +#undef BITSIZEOF_SIZE_T + +/* Define to the number of bits in type 'wchar_t'. */ +#undef BITSIZEOF_WCHAR_T + +/* Define to the number of bits in type 'wint_t'. */ +#undef BITSIZEOF_WINT_T + /* Define if Emacs cannot be dumped on your system. */ #undef CANNOT_DUMP @@ -42,9 +57,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to 1 if using `alloca.c'. */ #undef C_ALLOCA -/* Define to 1 if using `getloadavg.c'. */ -#undef C_GETLOADAVG - /* Define to 1 for DGUX with <sys/dg_sys_info.h>. */ #undef DGUX @@ -74,10 +86,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define this to check for short string overrun. */ #undef GC_CHECK_STRING_OVERRUN -/* Define to 1 if the `getloadavg' function needs to be run setuid or setgid. - */ -#undef GETLOADAVG_PRIVILEGED - /* Define to 1 if the `getpgrp' function requires zero arguments. */ #undef GETPGRP_VOID @@ -144,6 +152,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ don't. */ #undef HAVE_DECL_LOCALTIME_R +/* Define to 1 if you have the declaration of `strmode', and to 0 if you + don't. */ +#undef HAVE_DECL_STRMODE + /* Define to 1 if you have the declaration of `sys_siglist', and to 0 if you don't. */ #undef HAVE_DECL_SYS_SIGLIST @@ -225,9 +237,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to 1 if you have the `getline' function. */ #undef HAVE_GETLINE -/* Define to 1 if you have the `getloadavg' function. */ -#undef HAVE_GETLOADAVG - /* Define to 1 if you have the <getopt.h> header file. */ #undef HAVE_GETOPT_H @@ -408,6 +417,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to 1 if using libotf. */ #undef HAVE_LIBOTF +/* Define to 1 if you have the `perfstat' library (-lperfstat). */ +#undef HAVE_LIBPERFSTAT + /* Define to 1 if you have the <libpng/png.h> header file. */ #undef HAVE_LIBPNG_PNG_H @@ -447,6 +459,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to 1 if you support file names longer than 14 characters. */ #undef HAVE_LONG_FILE_NAMES +/* Define to 1 if the system has the type `long long int'. */ +#undef HAVE_LONG_LONG_INT + /* Define to 1 if you have the `lrand48' function. */ #undef HAVE_LRAND48 @@ -603,6 +618,15 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to 1 if you have the `shutdown' function. */ #undef HAVE_SHUTDOWN +/* Define to 1 if 'sig_atomic_t' is a signed integer type. */ +#undef HAVE_SIGNED_SIG_ATOMIC_T + +/* Define to 1 if 'wchar_t' is a signed integer type. */ +#undef HAVE_SIGNED_WCHAR_T + +/* Define to 1 if 'wint_t' is a signed integer type. */ +#undef HAVE_SIGNED_WINT_T + /* Define to 1 if the system has the type `size_t'. */ #undef HAVE_SIZE_T @@ -666,12 +690,24 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to 1 if `struct utimbuf' is declared by <utime.h>. */ #undef HAVE_STRUCT_UTIMBUF +/* Define if struct stat has an st_dm_mode member. */ +#undef HAVE_ST_DM_MODE + /* Define to 1 if you have the `sync' function. */ #undef HAVE_SYNC /* Define to 1 if you have the `sysinfo' function. */ #undef HAVE_SYSINFO +/* Define to 1 if you have the <sys/bitypes.h> header file. */ +#undef HAVE_SYS_BITYPES_H + +/* Define to 1 if you have the <sys/inttypes.h> header file. */ +#undef HAVE_SYS_INTTYPES_H + +/* Define to 1 if you have the <sys/loadavg.h> header file. */ +#undef HAVE_SYS_LOADAVG_H + /* Define to 1 if you have the <sys/mman.h> header file. */ #undef HAVE_SYS_MMAN_H @@ -749,6 +785,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to 1 if you have the <unistd.h> header file. */ #undef HAVE_UNISTD_H +/* Define to 1 if the system has the type `unsigned long long int'. */ +#undef HAVE_UNSIGNED_LONG_LONG_INT + /* Define to 1 if you have the <util.h> header file. */ #undef HAVE_UTIL_H @@ -767,6 +806,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to 1 if you have the <vfork.h> header file. */ #undef HAVE_VFORK_H +/* Define to 1 if you have the <wchar.h> header file. */ +#undef HAVE_WCHAR_H + /* Define if you have the 'wchar_t' type. */ #undef HAVE_WCHAR_T @@ -870,10 +912,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to support POP mail retrieval. */ #undef MAIL_USE_POP -/* Define to 1 if your `struct nlist' has an `n_un' member. Obsolete, depend - on `HAVE_STRUCT_NLIST_N_UN_N_NAME */ -#undef NLIST_NAME_UNION - /* Define to 1 if you don't have struct exception in math.h. */ #undef NO_MATHERR @@ -889,6 +927,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to 1 if you are using NS windowing under GNUstep. */ #undef NS_IMPL_GNUSTEP +/* Define to 1 if the nlist n_name member is a pointer */ +#undef N_NAME_POINTER + /* Define if the C compiler is the linker. */ #undef ORDINARY_LINK @@ -920,6 +961,10 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to 1 if the C compiler supports function prototypes. */ #undef PROTOTYPES +/* Define to l, ll, u, ul, ull, etc., as suitable for constants of type + 'ptrdiff_t'. */ +#undef PTRDIFF_T_SUFFIX + /* Define REL_ALLOC if you want to use the relocating allocator for buffer space. */ #undef REL_ALLOC @@ -927,6 +972,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define as the return type of signal handlers (`int' or `void'). */ #undef RETSIGTYPE +/* Define to l, ll, u, ul, ull, etc., as suitable for constants of type + 'sig_atomic_t'. */ +#undef SIG_ATOMIC_T_SUFFIX + +/* Define to l, ll, u, ul, ull, etc., as suitable for constants of type + 'size_t'. */ +#undef SIZE_T_SUFFIX + /* If using the C implementation of alloca, define if you know the direction of stack growth for your system; otherwise it will be automatically deduced at runtime. @@ -935,6 +988,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ STACK_DIRECTION = 0 => direction of growth unknown */ #undef STACK_DIRECTION +/* Define to 1 if the `S_IS*' macros in <sys/stat.h> do not work properly. */ +#undef STAT_MACROS_BROKEN + /* Define to 1 if you have the ANSI C header files. */ #undef STDC_HEADERS @@ -990,6 +1046,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Version number of package */ #undef VERSION +/* Define to l, ll, u, ul, ull, etc., as suitable for constants of type + 'wchar_t'. */ +#undef WCHAR_T_SUFFIX + +/* Define to l, ll, u, ul, ull, etc., as suitable for constants of type + 'wint_t'. */ +#undef WINT_T_SUFFIX + /* Define WORDS_BIGENDIAN to 1 if your processor stores words with the most significant byte first (like Motorola and SPARC, unlike Intel). */ #if defined AC_APPLE_UNIVERSAL_BUILD @@ -1095,6 +1159,9 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define to the name of the strftime replacement function. */ #undef my_strftime +/* Define to the type of st_nlink in struct stat, or a supertype. */ +#undef nlink_t + /* Define to `int' if <sys/types.h> does not define. */ #undef pid_t diff --git a/src/data.c b/src/data.c index 2f17edd3fdc..ecedba24101 100644 --- a/src/data.c +++ b/src/data.c @@ -1021,7 +1021,7 @@ swap_in_symval_forwarding (struct Lisp_Symbol *symbol, struct Lisp_Buffer_Local_ } else { - tem1 = assq_no_quit (var, current_buffer->local_var_alist); + tem1 = assq_no_quit (var, BVAR (current_buffer, local_var_alist)); XSETBUFFER (blv->where, current_buffer); } } @@ -1190,7 +1190,7 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register tem1 = Fassq (symbol, (blv->frame_local ? XFRAME (where)->param_alist - : XBUFFER (where)->local_var_alist)); + : BVAR (XBUFFER (where), local_var_alist))); blv->where = where; blv->found = 1; @@ -1221,8 +1221,8 @@ set_internal (register Lisp_Object symbol, register Lisp_Object newval, register bindings, not for frame-local bindings. */ eassert (!blv->frame_local); tem1 = Fcons (symbol, XCDR (blv->defcell)); - XBUFFER (where)->local_var_alist - = Fcons (tem1, XBUFFER (where)->local_var_alist); + BVAR (XBUFFER (where), local_var_alist) + = Fcons (tem1, BVAR (XBUFFER (where), local_var_alist)); } } @@ -1644,13 +1644,13 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) if (let_shadows_global_binding_p (symbol)) message ("Making %s local to %s while let-bound!", SDATA (SYMBOL_NAME (variable)), - SDATA (current_buffer->name)); + SDATA (BVAR (current_buffer, name))); } } /* Make sure this buffer has its own value of symbol. */ XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ - tem = Fassq (variable, current_buffer->local_var_alist); + tem = Fassq (variable, BVAR (current_buffer, local_var_alist)); if (NILP (tem)) { if (let_shadows_buffer_binding_p (sym)) @@ -1662,9 +1662,9 @@ Instead, use `add-hook' and specify t for the LOCAL argument. */) default value. */ find_symbol_value (variable); - current_buffer->local_var_alist + BVAR (current_buffer, local_var_alist) = Fcons (Fcons (variable, XCDR (blv->defcell)), - current_buffer->local_var_alist); + BVAR (current_buffer, local_var_alist)); /* Make sure symbol does not think it is set up for this buffer; force it to look once again for this buffer's value. */ @@ -1730,10 +1730,10 @@ From now on the default value will apply in this buffer. Return VARIABLE. */) /* Get rid of this buffer's alist element, if any. */ XSETSYMBOL (variable, sym); /* Propagate variable indirection. */ - tem = Fassq (variable, current_buffer->local_var_alist); + tem = Fassq (variable, BVAR (current_buffer, local_var_alist)); if (!NILP (tem)) - current_buffer->local_var_alist - = Fdelq (tem, current_buffer->local_var_alist); + BVAR (current_buffer, local_var_alist) + = Fdelq (tem, BVAR (current_buffer, local_var_alist)); /* If the symbol is set up with the current buffer's binding loaded, recompute its value. We have to do it now, or else @@ -1860,7 +1860,7 @@ BUFFER defaults to the current buffer. */) XSETBUFFER (tmp, buf); XSETSYMBOL (variable, sym); /* Update in case of aliasing. */ - for (tail = buf->local_var_alist; CONSP (tail); tail = XCDR (tail)) + for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail)) { elt = XCAR (tail); if (EQ (variable, XCAR (elt))) diff --git a/src/deps.mk b/src/deps.mk index e8ff3dd592e..77994bcaadb 100644 --- a/src/deps.mk +++ b/src/deps.mk @@ -9,17 +9,17 @@ ## 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 inserted in src/Makefile if AUTO_DEPEND=no. ## It defines static dependencies between the various source files. @@ -73,7 +73,7 @@ pre-crt0.o: pre-crt0.c dbusbind.o: dbusbind.c termhooks.h frame.h keyboard.h lisp.h $(config_h) dired.o: dired.c commands.h buffer.h lisp.h $(config_h) character.h charset.h \ coding.h regex.h systime.h blockinput.h atimer.h composite.h \ - ../lib/unistd.h globals.h + ../lib/filemode.h ../lib/unistd.h globals.h dispnew.o: dispnew.c systime.h commands.h process.h frame.h coding.h \ window.h buffer.h termchar.h termopts.h termhooks.h cm.h \ disptab.h indent.h $(INTERVALS_H) nsgui.h ../lib/unistd.h \ @@ -98,7 +98,6 @@ fileio.o: fileio.c window.h buffer.h systime.h $(INTERVALS_H) character.h \ commands.h globals.h ../lib/unistd.h filelock.o: filelock.c buffer.h character.h coding.h systime.h composite.h \ ../lib/unistd.h lisp.h globals.h $(config_h) -filemode.o: filemode.c $(config_h) font.o: font.c dispextern.h frame.h window.h ccl.h character.h charset.h \ font.h lisp.h globals.h $(config_h) buffer.h composite.h fontset.h \ xterm.h nsgui.h msdos.h @@ -115,7 +114,6 @@ fringe.o: fringe.c dispextern.h nsgui.h frame.h window.h buffer.h termhooks.h \ ftfont.o: ftfont.c dispextern.h frame.h character.h charset.h composite.h \ font.h lisp.h $(config_h) blockinput.h atimer.h systime.h coding.h \ fontset.h ccl.h ftfont.h globals.h -getloadavg.o: getloadavg.c $(config_h) gnutls.o: gnutls.c gnutls.h process.h ../lib/unistd.h \ lisp.h globals.h $(config_h) gtkutil.o: gtkutil.c gtkutil.h xterm.h lisp.h frame.h lisp.h $(config_h) \ @@ -145,7 +143,6 @@ gmalloc.o: gmalloc.c $(config_h) ralloc.o: ralloc.c lisp.h $(config_h) vm-limit.o: vm-limit.c mem-limits.h lisp.h globals.h $(config_h) marker.o: marker.c buffer.h character.h lisp.h globals.h $(config_h) -md5.o: md5.c md5.h $(config_h) minibuf.o: minibuf.c syntax.h frame.h window.h keyboard.h systime.h \ buffer.h commands.h character.h msdos.h $(INTERVALS_H) keymap.h \ termhooks.h lisp.h globals.h $(config_h) coding.h @@ -284,7 +281,7 @@ eval.o: eval.c commands.h keyboard.h blockinput.h atimer.h systime.h frame.h \ msdos.h floatfns.o: floatfns.c syssignal.h lisp.h globals.h $(config_h) fns.o: fns.c commands.h lisp.h $(config_h) frame.h buffer.h character.h \ - keyboard.h keymap.h window.h $(INTERVALS_H) coding.h md5.h \ + keyboard.h keymap.h window.h $(INTERVALS_H) coding.h ../lib/md5.h \ blockinput.h atimer.h systime.h xterm.h ../lib/unistd.h globals.h print.o: print.c process.h frame.h window.h buffer.h keyboard.h character.h \ lisp.h globals.h $(config_h) termchar.h $(INTERVALS_H) msdos.h termhooks.h \ diff --git a/src/dired.c b/src/dired.c index e37055258d6..b01ce8d4d8f 100644 --- a/src/dired.c +++ b/src/dired.c @@ -61,6 +61,8 @@ extern struct direct *readdir (DIR *); #endif /* HAVE_DIRENT_H */ +#include <filemode.h> + #ifdef MSDOS #define DIRENTRY_NONEMPTY(p) ((p)->d_name[0] != 0) #else @@ -82,9 +84,6 @@ extern struct re_pattern_buffer *compile_pattern (Lisp_Object, struct re_registers *, Lisp_Object, int, int); -/* From filemode.c. Can't go in Lisp.h because of `stat'. */ -extern void filemodestring (struct stat *, char *); - /* if system does not have symbolic links, it does not have lstat. In that case, use ordinary stat instead. */ @@ -158,7 +157,7 @@ directory_files_internal (Lisp_Object directory, Lisp_Object full, Lisp_Object m # ifdef WINDOWSNT /* Windows users want case-insensitive wildcards. */ bufp = compile_pattern (match, 0, - buffer_defaults.case_canon_table, 0, 1); + BVAR (&buffer_defaults, case_canon_table), 0, 1); # else /* !WINDOWSNT */ bufp = compile_pattern (match, 0, Qnil, 0, 1); # endif /* !WINDOWSNT */ diff --git a/src/dispextern.h b/src/dispextern.h index 6d54ebefd84..6bb0c3a6aae 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -1416,7 +1416,7 @@ struct glyph_string && !(W)->pseudo_window_p \ && FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME ((W)))) \ && BUFFERP ((W)->buffer) \ - && !NILP (XBUFFER ((W)->buffer)->mode_line_format) \ + && !NILP (BVAR (XBUFFER ((W)->buffer), mode_line_format)) \ && WINDOW_TOTAL_LINES (W) > 1) /* Value is non-zero if window W wants a header line. */ @@ -1426,8 +1426,8 @@ struct glyph_string && !(W)->pseudo_window_p \ && FRAME_WANTS_MODELINE_P (XFRAME (WINDOW_FRAME ((W)))) \ && BUFFERP ((W)->buffer) \ - && !NILP (XBUFFER ((W)->buffer)->header_line_format) \ - && WINDOW_TOTAL_LINES (W) > 1 + !NILP (XBUFFER ((W)->buffer)->mode_line_format)) + && !NILP (BVAR (XBUFFER ((W)->buffer), header_line_format)) \ + && WINDOW_TOTAL_LINES (W) > 1 + !NILP (BVAR (XBUFFER ((W)->buffer), mode_line_format))) /* Return proper value to be used as baseline offset of font that has diff --git a/src/dispnew.c b/src/dispnew.c index 1aef70f1a5d..4e068bde536 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -6129,7 +6129,7 @@ pass nil for VARIABLE. */) { buf = XCDR (XCAR (tail)); /* Ignore buffers that aren't included in buffer lists. */ - if (SREF (XBUFFER (buf)->name, 0) == ' ') + if (SREF (BVAR (XBUFFER (buf), name), 0) == ' ') continue; if (vecp == end) goto changed; @@ -6137,7 +6137,7 @@ pass nil for VARIABLE. */) goto changed; if (vecp == end) goto changed; - if (!EQ (*vecp++, XBUFFER (buf)->read_only)) + if (!EQ (*vecp++, BVAR (XBUFFER (buf), read_only))) goto changed; if (vecp == end) goto changed; @@ -6184,10 +6184,10 @@ pass nil for VARIABLE. */) { buf = XCDR (XCAR (tail)); /* Ignore buffers that aren't included in buffer lists. */ - if (SREF (XBUFFER (buf)->name, 0) == ' ') + if (SREF (BVAR (XBUFFER (buf), name), 0) == ' ') continue; *vecp++ = buf; - *vecp++ = XBUFFER (buf)->read_only; + *vecp++ = BVAR (XBUFFER (buf), read_only); *vecp++ = Fbuffer_modified_p (buf); } /* Fill up the vector with lambdas (always at least one). */ diff --git a/src/doc.c b/src/doc.c index c56f0b6c9df..834321108b5 100644 --- a/src/doc.c +++ b/src/doc.c @@ -729,7 +729,7 @@ a new string, without any text properties, is returned. */) or a specified local map (which means search just that and the global map). If non-nil, it might come from Voverriding_local_map, or from a \\<mapname> construct in STRING itself.. */ - keymap = current_kboard->Voverriding_terminal_local_map; + keymap = KVAR (current_kboard, Voverriding_terminal_local_map); if (NILP (keymap)) keymap = Voverriding_local_map; diff --git a/src/editfns.c b/src/editfns.c index 30acc36f025..5d6189f2a3c 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -306,10 +306,10 @@ region_limit (int beginningp) if (!NILP (Vtransient_mark_mode) && NILP (Vmark_even_if_inactive) - && NILP (current_buffer->mark_active)) + && NILP (BVAR (current_buffer, mark_active))) xsignal0 (Qmark_inactive); - m = Fmarker_position (current_buffer->mark); + m = Fmarker_position (BVAR (current_buffer, mark)); if (NILP (m)) error ("The mark is not set now, so there is no region"); @@ -338,7 +338,7 @@ Watch out! Moving this marker changes the mark position. If you set the marker not to point anywhere, the buffer will have no mark. */) (void) { - return current_buffer->mark; + return BVAR (current_buffer, mark); } @@ -866,9 +866,9 @@ save_excursion_save (void) == current_buffer); return Fcons (Fpoint_marker (), - Fcons (Fcopy_marker (current_buffer->mark, Qnil), + Fcons (Fcopy_marker (BVAR (current_buffer, mark), Qnil), Fcons (visible ? Qt : Qnil, - Fcons (current_buffer->mark_active, + Fcons (BVAR (current_buffer, mark_active), selected_window)))); } @@ -900,8 +900,8 @@ save_excursion_restore (Lisp_Object info) /* Mark marker. */ info = XCDR (info); tem = XCAR (info); - omark = Fmarker_position (current_buffer->mark); - Fset_marker (current_buffer->mark, tem, Fcurrent_buffer ()); + omark = Fmarker_position (BVAR (current_buffer, mark)); + Fset_marker (BVAR (current_buffer, mark), tem, Fcurrent_buffer ()); nmark = Fmarker_position (tem); unchain_marker (XMARKER (tem)); @@ -922,14 +922,14 @@ save_excursion_restore (Lisp_Object info) /* Mark active */ info = XCDR (info); tem = XCAR (info); - tem1 = current_buffer->mark_active; - current_buffer->mark_active = tem; + tem1 = BVAR (current_buffer, mark_active); + BVAR (current_buffer, mark_active) = tem; if (!NILP (Vrun_hooks)) { /* If mark is active now, and either was not active or was at a different place, run the activate hook. */ - if (! NILP (current_buffer->mark_active)) + if (! NILP (BVAR (current_buffer, mark_active))) { if (! EQ (omark, nmark)) call1 (Vrun_hooks, intern ("activate-mark-hook")); @@ -1114,7 +1114,7 @@ At the beginning of the buffer or accessible region, return 0. */) Lisp_Object temp; if (PT <= BEGV) XSETFASTINT (temp, 0); - else if (!NILP (current_buffer->enable_multibyte_characters)) + else if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) { EMACS_INT pos = PT_BYTE; DEC_POS (pos); @@ -1228,7 +1228,7 @@ If POS is out of range, the value is nil. */) pos_byte = CHAR_TO_BYTE (XINT (pos)); } - if (!NILP (current_buffer->enable_multibyte_characters)) + if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) { DEC_POS (pos_byte); XSETFASTINT (val, FETCH_CHAR (pos_byte)); @@ -2135,7 +2135,7 @@ general_insert_function (void (*insert_func) unsigned char str[MAX_MULTIBYTE_LENGTH]; int len; - if (!NILP (current_buffer->enable_multibyte_characters)) + if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) len = CHAR_STRING (XFASTINT (val), str); else { @@ -2267,7 +2267,7 @@ from adjoining text, if those properties are sticky. */) CHECK_NUMBER (character); CHECK_NUMBER (count); - if (!NILP (current_buffer->enable_multibyte_characters)) + if (!NILP (BVAR (current_buffer, enable_multibyte_characters))) len = CHAR_STRING (XFASTINT (character), str); else str[0] = XFASTINT (character), len = 1; @@ -2316,7 +2316,7 @@ from adjoining text, if those properties are sticky. */) if (XINT (byte) < 0 || XINT (byte) > 255) args_out_of_range_3 (byte, make_number (0), make_number (255)); if (XINT (byte) >= 128 - && ! NILP (current_buffer->enable_multibyte_characters)) + && ! NILP (BVAR (current_buffer, enable_multibyte_characters))) XSETFASTINT (byte, BYTE8_TO_CHAR (XINT (byte))); return Finsert_char (byte, count, inherit); } @@ -2370,7 +2370,7 @@ make_buffer_string_both (EMACS_INT start, EMACS_INT start_byte, if (start < GPT && GPT < end) move_gap (start); - if (! NILP (current_buffer->enable_multibyte_characters)) + if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) result = make_uninit_multibyte_string (end - start, end_byte - start_byte); else result = make_uninit_string (end - start); @@ -2485,7 +2485,7 @@ They default to the values of (point-min) and (point-max) in BUFFER. */) if (NILP (buf)) nsberror (buffer); bp = XBUFFER (buf); - if (NILP (bp->name)) + if (NILP (BVAR (bp, name))) error ("Selecting deleted buffer"); if (NILP (start)) @@ -2533,8 +2533,8 @@ determines whether case is significant or ignored. */) register EMACS_INT begp1, endp1, begp2, endp2, temp; register struct buffer *bp1, *bp2; register Lisp_Object trt - = (!NILP (current_buffer->case_fold_search) - ? current_buffer->case_canon_table : Qnil); + = (!NILP (BVAR (current_buffer, case_fold_search)) + ? BVAR (current_buffer, case_canon_table) : Qnil); EMACS_INT chars = 0; EMACS_INT i1, i2, i1_byte, i2_byte; @@ -2549,7 +2549,7 @@ determines whether case is significant or ignored. */) if (NILP (buf1)) nsberror (buffer1); bp1 = XBUFFER (buf1); - if (NILP (bp1->name)) + if (NILP (BVAR (bp1, name))) error ("Selecting deleted buffer"); } @@ -2587,7 +2587,7 @@ determines whether case is significant or ignored. */) if (NILP (buf2)) nsberror (buffer2); bp2 = XBUFFER (buf2); - if (NILP (bp2->name)) + if (NILP (BVAR (bp2, name))) error ("Selecting deleted buffer"); } @@ -2627,7 +2627,7 @@ determines whether case is significant or ignored. */) QUIT; - if (! NILP (bp1->enable_multibyte_characters)) + if (! NILP (BVAR (bp1, enable_multibyte_characters))) { c1 = BUF_FETCH_MULTIBYTE_CHAR (bp1, i1_byte); BUF_INC_POS (bp1, i1_byte); @@ -2640,7 +2640,7 @@ determines whether case is significant or ignored. */) i1++; } - if (! NILP (bp2->enable_multibyte_characters)) + if (! NILP (BVAR (bp2, enable_multibyte_characters))) { c2 = BUF_FETCH_MULTIBYTE_CHAR (bp2, i2_byte); BUF_INC_POS (bp2, i2_byte); @@ -2680,13 +2680,13 @@ determines whether case is significant or ignored. */) static Lisp_Object subst_char_in_region_unwind (Lisp_Object arg) { - return current_buffer->undo_list = arg; + return BVAR (current_buffer, undo_list) = arg; } static Lisp_Object subst_char_in_region_unwind_1 (Lisp_Object arg) { - return current_buffer->filename = arg; + return BVAR (current_buffer, filename) = arg; } DEFUN ("subst-char-in-region", Fsubst_char_in_region, @@ -2712,7 +2712,7 @@ Both characters must have the same length of multi-byte form. */) #define COMBINING_BOTH (COMBINING_BEFORE | COMBINING_AFTER) int maybe_byte_combining = COMBINING_NO; EMACS_INT last_changed = 0; - int multibyte_p = !NILP (current_buffer->enable_multibyte_characters); + int multibyte_p = !NILP (BVAR (current_buffer, enable_multibyte_characters)); restart: @@ -2756,12 +2756,12 @@ Both characters must have the same length of multi-byte form. */) if (!changed && !NILP (noundo)) { record_unwind_protect (subst_char_in_region_unwind, - current_buffer->undo_list); - current_buffer->undo_list = Qt; + BVAR (current_buffer, undo_list)); + BVAR (current_buffer, undo_list) = Qt; /* Don't do file-locking. */ record_unwind_protect (subst_char_in_region_unwind_1, - current_buffer->filename); - current_buffer->filename = Qnil; + BVAR (current_buffer, filename)); + BVAR (current_buffer, filename) = Qnil; } if (pos_byte < GPT_BYTE) @@ -2824,7 +2824,7 @@ Both characters must have the same length of multi-byte form. */) struct gcpro gcpro1; - tem = current_buffer->undo_list; + tem = BVAR (current_buffer, undo_list); GCPRO1 (tem); /* Make a multibyte string containing this single character. */ @@ -2843,7 +2843,7 @@ Both characters must have the same length of multi-byte form. */) INC_POS (pos_byte_next); if (! NILP (noundo)) - current_buffer->undo_list = tem; + BVAR (current_buffer, undo_list) = tem; UNGCPRO; } @@ -2945,7 +2945,7 @@ It returns the number of characters changed. */) int cnt; /* Number of changes made. */ EMACS_INT size; /* Size of translate table. */ EMACS_INT pos, pos_byte, end_pos; - int multibyte = !NILP (current_buffer->enable_multibyte_characters); + int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); int string_multibyte; Lisp_Object val; @@ -3206,7 +3206,7 @@ save_restriction_restore (Lisp_Object data) ? XMARKER (XCAR (data))->buffer : XBUFFER (data)); - if (buf && buf != current_buffer && !NILP (buf->pt_marker)) + if (buf && buf != current_buffer && !NILP (BVAR (buf, pt_marker))) { /* If `buf' uses markers to keep track of PT, BEGV, and ZV (as is the case if it is or has an indirect buffer), then make sure it is current before we update BEGV, so @@ -4136,20 +4136,20 @@ Case is ignored if `case-fold-search' is non-nil in the current buffer. */) if (XINT (c1) == XINT (c2)) return Qt; - if (NILP (current_buffer->case_fold_search)) + if (NILP (BVAR (current_buffer, case_fold_search))) return Qnil; /* Do these in separate statements, then compare the variables. because of the way DOWNCASE uses temp variables. */ i1 = XFASTINT (c1); - if (NILP (current_buffer->enable_multibyte_characters) + if (NILP (BVAR (current_buffer, enable_multibyte_characters)) && ! ASCII_CHAR_P (i1)) { MAKE_CHAR_MULTIBYTE (i1); } i2 = XFASTINT (c2); - if (NILP (current_buffer->enable_multibyte_characters) + if (NILP (BVAR (current_buffer, enable_multibyte_characters)) && ! ASCII_CHAR_P (i2)) { MAKE_CHAR_MULTIBYTE (i2); diff --git a/src/fileio.c b/src/fileio.c index 429fce9f5a0..2ccad83f668 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -770,7 +770,7 @@ filesystem tree, not (expand-file-name ".." dirname). */) /* Use the buffer's default-directory if DEFAULT_DIRECTORY is omitted. */ if (NILP (default_directory)) - default_directory = current_buffer->directory; + default_directory = BVAR (current_buffer, directory); if (! STRINGP (default_directory)) { #ifdef DOS_NT @@ -2669,7 +2669,7 @@ See `file-symlink-p' to distinguish symlinks. */) struct stat st; Lisp_Object handler; - absname = expand_and_dir_to_file (filename, current_buffer->directory); + absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory)); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -2722,7 +2722,7 @@ See `file-symlink-p' to distinguish symlinks. */) struct stat st; Lisp_Object handler; - absname = expand_and_dir_to_file (filename, current_buffer->directory); + absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory)); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -2769,7 +2769,7 @@ if file does not exist, is not accessible, or SELinux is disabled */) context_t context; #endif - absname = expand_and_dir_to_file (filename, current_buffer->directory); + absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory)); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -2827,7 +2827,7 @@ is disabled. */) context_t parsed_con; #endif - absname = Fexpand_file_name (filename, current_buffer->directory); + absname = Fexpand_file_name (filename, BVAR (current_buffer, directory)); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -2894,7 +2894,7 @@ Return nil, if file does not exist or is not accessible. */) struct stat st; Lisp_Object handler; - absname = expand_and_dir_to_file (filename, current_buffer->directory); + absname = expand_and_dir_to_file (filename, BVAR (current_buffer, directory)); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -2923,7 +2923,7 @@ symbolic notation, like the `chmod' command from GNU Coreutils. */) Lisp_Object absname, encoded_absname; Lisp_Object handler; - absname = Fexpand_file_name (filename, current_buffer->directory); + absname = Fexpand_file_name (filename, BVAR (current_buffer, directory)); CHECK_NUMBER (mode); /* If the file name has special constructs in it, @@ -2985,7 +2985,7 @@ Use the current time if TIME is nil. TIME is in the format of if (! lisp_time_argument (time, &sec, &usec)) error ("Invalid time specification"); - absname = Fexpand_file_name (filename, current_buffer->directory); + absname = Fexpand_file_name (filename, BVAR (current_buffer, directory)); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -3047,8 +3047,8 @@ otherwise, if FILE2 does not exist, the answer is t. */) absname1 = Qnil; GCPRO2 (absname1, file2); - absname1 = expand_and_dir_to_file (file1, current_buffer->directory); - absname2 = expand_and_dir_to_file (file2, current_buffer->directory); + absname1 = expand_and_dir_to_file (file1, BVAR (current_buffer, directory)); + absname2 = expand_and_dir_to_file (file2, BVAR (current_buffer, directory)); UNGCPRO; /* If the file name has special constructs in it, @@ -3075,10 +3075,6 @@ otherwise, if FILE2 does not exist, the answer is t. */) return (mtime1 > st.st_mtime) ? Qt : Qnil; } -#ifdef DOS_NT -Lisp_Object Qfind_buffer_file_type; -#endif /* DOS_NT */ - #ifndef READ_BUF_SIZE #define READ_BUF_SIZE (64 << 10) #endif @@ -3116,8 +3112,8 @@ decide_coding_unwind (Lisp_Object unwind_data) TEMP_SET_PT_BOTH (BEG, BEG_BYTE); /* Now we are safe to change the buffer's multibyteness directly. */ - current_buffer->enable_multibyte_characters = multibyte; - current_buffer->undo_list = undo_list; + BVAR (current_buffer, enable_multibyte_characters) = multibyte; + BVAR (current_buffer, undo_list) = undo_list; return Qnil; } @@ -3212,7 +3208,7 @@ variable `last-coding-system-used' to the coding system actually used. */) if (current_buffer->base_buffer && ! NILP (visit)) error ("Cannot do file visiting in an indirect buffer"); - if (!NILP (current_buffer->read_only)) + if (!NILP (BVAR (current_buffer, read_only))) Fbarf_if_buffer_read_only (); val = Qnil; @@ -3403,16 +3399,16 @@ variable `last-coding-system-used' to the coding system actually used. */) buf = XBUFFER (buffer); delete_all_overlays (buf); - buf->directory = current_buffer->directory; - buf->read_only = Qnil; - buf->filename = Qnil; - buf->undo_list = Qt; + BVAR (buf, directory) = BVAR (current_buffer, directory); + BVAR (buf, read_only) = Qnil; + BVAR (buf, filename) = Qnil; + BVAR (buf, undo_list) = Qt; eassert (buf->overlays_before == NULL); eassert (buf->overlays_after == NULL); set_buffer_internal (buf); Ferase_buffer (); - buf->enable_multibyte_characters = Qnil; + BVAR (buf, enable_multibyte_characters) = Qnil; insert_1_both ((char *) read_buf, nread, nread, 0, 0, 0); TEMP_SET_PT_BOTH (BEG, BEG_BYTE); @@ -3450,7 +3446,7 @@ variable `last-coding-system-used' to the coding system actually used. */) else CHECK_CODING_SYSTEM (coding_system); - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) /* We must suppress all character code conversion except for end-of-line conversion. */ coding_system = raw_text_coding_system (coding_system); @@ -3598,7 +3594,7 @@ variable `last-coding-system-used' to the coding system actually used. */) we cannot use this method; giveup and try the other. */ if (same_at_end > same_at_start && FETCH_BYTE (same_at_end - 1) >= 0200 - && ! NILP (current_buffer->enable_multibyte_characters) + && ! NILP (BVAR (current_buffer, enable_multibyte_characters)) && (CODING_MAY_REQUIRE_DECODING (&coding))) giveup_match_end = 1; break; @@ -3617,14 +3613,14 @@ variable `last-coding-system-used' to the coding system actually used. */) /* Extend the start of non-matching text area to multibyte character boundary. */ - if (! NILP (current_buffer->enable_multibyte_characters)) + if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) while (same_at_start > BEGV_BYTE && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start))) same_at_start--; /* Extend the end of non-matching text area to multibyte character boundary. */ - if (! NILP (current_buffer->enable_multibyte_characters)) + if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) while (same_at_end < ZV_BYTE && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end))) same_at_end++; @@ -3673,7 +3669,7 @@ variable `last-coding-system-used' to the coding system actually used. */) unsigned char *decoded; EMACS_INT temp; int this_count = SPECPDL_INDEX (); - int multibyte = ! NILP (current_buffer->enable_multibyte_characters); + int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); Lisp_Object conversion_buffer; conversion_buffer = code_conversion_save (1, multibyte); @@ -3778,7 +3774,7 @@ variable `last-coding-system-used' to the coding system actually used. */) /* Extend the start of non-matching text area to the previous multibyte character boundary. */ - if (! NILP (current_buffer->enable_multibyte_characters)) + if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) while (same_at_start > BEGV_BYTE && ! CHAR_HEAD_P (FETCH_BYTE (same_at_start))) same_at_start--; @@ -3795,7 +3791,7 @@ variable `last-coding-system-used' to the coding system actually used. */) /* Extend the end of non-matching text area to the next multibyte character boundary. */ - if (! NILP (current_buffer->enable_multibyte_characters)) + if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) while (same_at_end < ZV_BYTE && ! CHAR_HEAD_P (FETCH_BYTE (same_at_end))) same_at_end++; @@ -3870,9 +3866,9 @@ variable `last-coding-system-used' to the coding system actually used. */) if (NILP (visit) && inserted > 0) { #ifdef CLASH_DETECTION - if (!NILP (current_buffer->file_truename) + if (!NILP (BVAR (current_buffer, file_truename)) /* Make binding buffer-file-name to nil effective. */ - && !NILP (current_buffer->filename) + && !NILP (BVAR (current_buffer, filename)) && SAVE_MODIFF >= MODIFF) we_locked_file = 1; #endif /* CLASH_DETECTION */ @@ -3977,7 +3973,7 @@ variable `last-coding-system-used' to the coding system actually used. */) { #ifdef CLASH_DETECTION if (we_locked_file) - unlock_file (current_buffer->file_truename); + unlock_file (BVAR (current_buffer, file_truename)); #endif Vdeactivate_mark = old_Vdeactivate_mark; } @@ -4028,11 +4024,11 @@ variable `last-coding-system-used' to the coding system actually used. */) Lisp_Object unwind_data; int count = SPECPDL_INDEX (); - unwind_data = Fcons (current_buffer->enable_multibyte_characters, - Fcons (current_buffer->undo_list, + unwind_data = Fcons (BVAR (current_buffer, enable_multibyte_characters), + Fcons (BVAR (current_buffer, undo_list), Fcurrent_buffer ())); - current_buffer->enable_multibyte_characters = Qnil; - current_buffer->undo_list = Qt; + BVAR (current_buffer, enable_multibyte_characters) = Qnil; + BVAR (current_buffer, undo_list) = Qt; record_unwind_protect (decide_coding_unwind, unwind_data); if (inserted > 0 && ! NILP (Vset_auto_coding_function)) @@ -4062,7 +4058,7 @@ variable `last-coding-system-used' to the coding system actually used. */) else CHECK_CODING_SYSTEM (coding_system); - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) /* We must suppress all character code conversion except for end-of-line conversion. */ coding_system = raw_text_coding_system (coding_system); @@ -4080,10 +4076,10 @@ variable `last-coding-system-used' to the coding system actually used. */) && NILP (replace)) /* Visiting a file with these coding system makes the buffer unibyte. */ - current_buffer->enable_multibyte_characters = Qnil; + BVAR (current_buffer, enable_multibyte_characters) = Qnil; } - coding.dst_multibyte = ! NILP (current_buffer->enable_multibyte_characters); + coding.dst_multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); if (CODING_MAY_REQUIRE_DECODING (&coding) && (inserted > 0 || CODING_REQUIRE_FLUSHING (&coding))) { @@ -4103,18 +4099,6 @@ variable `last-coding-system-used' to the coding system actually used. */) /* Now INSERTED is measured in characters. */ -#ifdef DOS_NT - /* Use the conversion type to determine buffer-file-type - (find-buffer-file-type is now used to help determine the - conversion). */ - if ((VECTORP (CODING_ID_EOL_TYPE (coding.id)) - || EQ (CODING_ID_EOL_TYPE (coding.id), Qunix)) - && ! CODING_REQUIRE_DECODING (&coding)) - current_buffer->buffer_file_type = Qt; - else - current_buffer->buffer_file_type = Qnil; -#endif - handled: if (deferred_remove_unwind_protect) @@ -4124,24 +4108,24 @@ variable `last-coding-system-used' to the coding system actually used. */) if (!NILP (visit)) { - if (!EQ (current_buffer->undo_list, Qt) && !nochange) - current_buffer->undo_list = Qnil; + if (!EQ (BVAR (current_buffer, undo_list), Qt) && !nochange) + BVAR (current_buffer, undo_list) = Qnil; if (NILP (handler)) { current_buffer->modtime = st.st_mtime; current_buffer->modtime_size = st.st_size; - current_buffer->filename = orig_filename; + BVAR (current_buffer, filename) = orig_filename; } SAVE_MODIFF = MODIFF; BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF; - XSETFASTINT (current_buffer->save_length, Z - BEG); + XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG); #ifdef CLASH_DETECTION if (NILP (handler)) { - if (!NILP (current_buffer->file_truename)) - unlock_file (current_buffer->file_truename); + if (!NILP (BVAR (current_buffer, file_truename))) + unlock_file (BVAR (current_buffer, file_truename)); unlock_file (filename); } #endif /* CLASH_DETECTION */ @@ -4174,8 +4158,8 @@ variable `last-coding-system-used' to the coding system actually used. */) specbind (Qinhibit_modification_hooks, Qt); /* Save old undo list and don't record undo for decoding. */ - old_undo = current_buffer->undo_list; - current_buffer->undo_list = Qt; + old_undo = BVAR (current_buffer, undo_list); + BVAR (current_buffer, undo_list) = Qt; if (NILP (replace)) { @@ -4263,7 +4247,7 @@ variable `last-coding-system-used' to the coding system actually used. */) if (NILP (visit)) { - current_buffer->undo_list = old_undo; + BVAR (current_buffer, undo_list) = old_undo; if (CONSP (old_undo) && inserted != old_inserted) { /* Adjust the last undo record for the size change during @@ -4278,7 +4262,7 @@ variable `last-coding-system-used' to the coding system actually used. */) else /* If undo_list was Qt before, keep it that way. Otherwise start with an empty undo_list. */ - current_buffer->undo_list = EQ (old_undo, Qt) ? Qt : Qnil; + BVAR (current_buffer, undo_list) = EQ (old_undo, Qt) ? Qt : Qnil; unbind_to (count, Qnil); } @@ -4332,8 +4316,8 @@ choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object file Lisp_Object eol_parent = Qnil; if (auto_saving - && NILP (Fstring_equal (current_buffer->filename, - current_buffer->auto_save_file_name))) + && NILP (Fstring_equal (BVAR (current_buffer, filename), + BVAR (current_buffer, auto_save_file_name)))) { val = Qutf_8_emacs; eol_parent = Qunix; @@ -4362,12 +4346,12 @@ choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object file int using_default_coding = 0; int force_raw_text = 0; - val = current_buffer->buffer_file_coding_system; + val = BVAR (current_buffer, buffer_file_coding_system); if (NILP (val) || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil))) { val = Qnil; - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) force_raw_text = 1; } @@ -4388,7 +4372,7 @@ choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object file { /* If we still have not decided a coding system, use the default value of buffer-file-coding-system. */ - val = current_buffer->buffer_file_coding_system; + val = BVAR (current_buffer, buffer_file_coding_system); using_default_coding = 1; } @@ -4412,9 +4396,9 @@ choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object file format, we use that of `default-buffer-file-coding-system'. */ if (! using_default_coding - && ! NILP (buffer_defaults.buffer_file_coding_system)) + && ! NILP (BVAR (&buffer_defaults, buffer_file_coding_system))) val = (coding_inherit_eol_type - (val, buffer_defaults.buffer_file_coding_system)); + (val, BVAR (&buffer_defaults, buffer_file_coding_system))); /* If we decide not to encode text, use `raw-text' or one of its subsidiaries. */ @@ -4425,7 +4409,7 @@ choose_write_coding_system (Lisp_Object start, Lisp_Object end, Lisp_Object file val = coding_inherit_eol_type (val, eol_parent); setup_coding_system (val, coding); - if (!STRINGP (start) && !NILP (current_buffer->selective_display)) + if (!STRINGP (start) && !NILP (BVAR (current_buffer, selective_display))) coding->mode |= CODING_MODE_SELECTIVE_DISPLAY; return val; } @@ -4484,9 +4468,6 @@ This calls `write-region-annotate-functions' at the start, and int quietly = !NILP (visit); struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; struct buffer *given_buffer; -#ifdef DOS_NT - int buffer_file_type = O_BINARY; -#endif /* DOS_NT */ struct coding_system coding; if (current_buffer->base_buffer && visiting) @@ -4529,8 +4510,8 @@ This calls `write-region-annotate-functions' at the start, and if (visiting) { SAVE_MODIFF = MODIFF; - XSETFASTINT (current_buffer->save_length, Z - BEG); - current_buffer->filename = visit_file; + XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG); + BVAR (current_buffer, filename) = visit_file; } UNGCPRO; return val; @@ -4596,7 +4577,7 @@ This calls `write-region-annotate-functions' at the start, and desc = -1; if (!NILP (append)) #ifdef DOS_NT - desc = emacs_open (fn, O_WRONLY | buffer_file_type, 0); + desc = emacs_open (fn, O_WRONLY | O_BINARY, 0); #else /* not DOS_NT */ desc = emacs_open (fn, O_WRONLY, 0); #endif /* not DOS_NT */ @@ -4604,7 +4585,7 @@ This calls `write-region-annotate-functions' at the start, and if (desc < 0 && (NILP (append) || errno == ENOENT)) #ifdef DOS_NT desc = emacs_open (fn, - O_WRONLY | O_CREAT | buffer_file_type + O_WRONLY | O_CREAT | O_BINARY | (EQ (mustbenew, Qexcl) ? O_EXCL : O_TRUNC), S_IREAD | S_IWRITE); #else /* not DOS_NT */ @@ -4743,15 +4724,15 @@ This calls `write-region-annotate-functions' at the start, and if (visiting) { SAVE_MODIFF = MODIFF; - XSETFASTINT (current_buffer->save_length, Z - BEG); - current_buffer->filename = visit_file; + XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG); + BVAR (current_buffer, filename) = visit_file; update_mode_lines++; } else if (quietly) { if (auto_saving - && ! NILP (Fstring_equal (current_buffer->filename, - current_buffer->auto_save_file_name))) + && ! NILP (Fstring_equal (BVAR (current_buffer, filename), + BVAR (current_buffer, auto_save_file_name)))) SAVE_MODIFF = MODIFF; return Qnil; @@ -4833,10 +4814,10 @@ build_annotations (Lisp_Object start, Lisp_Object end) } /* Now do the same for annotation functions implied by the file-format */ - if (auto_saving && (!EQ (current_buffer->auto_save_file_format, Qt))) - p = current_buffer->auto_save_file_format; + if (auto_saving && (!EQ (BVAR (current_buffer, auto_save_file_format), Qt))) + p = BVAR (current_buffer, auto_save_file_format); else - p = current_buffer->file_format; + p = BVAR (current_buffer, file_format); for (i = 0; CONSP (p); p = XCDR (p), ++i) { struct buffer *given_buffer = current_buffer; @@ -5015,17 +4996,17 @@ See Info node `(elisp)Modification Time' for more details. */) b = XBUFFER (buf); } - if (!STRINGP (b->filename)) return Qt; + if (!STRINGP (BVAR (b, filename))) return Qt; if (b->modtime == 0) return Qt; /* If the file name has special constructs in it, call the corresponding file handler. */ - handler = Ffind_file_name_handler (b->filename, + handler = Ffind_file_name_handler (BVAR (b, filename), Qverify_visited_file_modtime); if (!NILP (handler)) return call2 (handler, Qverify_visited_file_modtime, buf); - filename = ENCODE_FILE (b->filename); + filename = ENCODE_FILE (BVAR (b, filename)); if (stat (SSDATA (filename), &st) < 0) { @@ -5093,7 +5074,7 @@ An argument specifies the modification time value to use struct stat st; Lisp_Object handler; - filename = Fexpand_file_name (current_buffer->filename, Qnil); + filename = Fexpand_file_name (BVAR (current_buffer, filename), Qnil); /* If the file name has special constructs in it, call the corresponding file handler. */ @@ -5128,7 +5109,7 @@ auto_save_error (Lisp_Object error) ring_bell (XFRAME (selected_frame)); args[0] = build_string ("Auto-saving %s: %s"); - args[1] = current_buffer->name; + args[1] = BVAR (current_buffer, name); args[2] = Ferror_message_string (error); msg = Fformat (3, args); GCPRO1 (msg); @@ -5159,19 +5140,19 @@ auto_save_1 (void) auto_save_mode_bits = 0666; /* Get visited file's mode to become the auto save file's mode. */ - if (! NILP (current_buffer->filename)) + if (! NILP (BVAR (current_buffer, filename))) { - if (stat (SSDATA (current_buffer->filename), &st) >= 0) + if (stat (SSDATA (BVAR (current_buffer, filename)), &st) >= 0) /* But make sure we can overwrite it later! */ auto_save_mode_bits = st.st_mode | 0600; - else if ((modes = Ffile_modes (current_buffer->filename), + else if ((modes = Ffile_modes (BVAR (current_buffer, filename)), INTEGERP (modes))) /* Remote files don't cooperate with stat. */ auto_save_mode_bits = XINT (modes) | 0600; } return - Fwrite_region (Qnil, Qnil, current_buffer->auto_save_file_name, Qnil, + Fwrite_region (Qnil, Qnil, BVAR (current_buffer, auto_save_file_name), Qnil, NILP (Vauto_save_visited_file_name) ? Qlambda : Qt, Qnil, Qnil); } @@ -5312,18 +5293,18 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) /* Record all the buffers that have auto save mode in the special file that lists them. For each of these buffers, Record visited name (if any) and auto save name. */ - if (STRINGP (b->auto_save_file_name) + if (STRINGP (BVAR (b, auto_save_file_name)) && stream != NULL && do_handled_files == 0) { BLOCK_INPUT; - if (!NILP (b->filename)) + if (!NILP (BVAR (b, filename))) { - fwrite (SDATA (b->filename), 1, - SBYTES (b->filename), stream); + fwrite (SDATA (BVAR (b, filename)), 1, + SBYTES (BVAR (b, filename)), stream); } putc ('\n', stream); - fwrite (SDATA (b->auto_save_file_name), 1, - SBYTES (b->auto_save_file_name), stream); + fwrite (SDATA (BVAR (b, auto_save_file_name)), 1, + SBYTES (BVAR (b, auto_save_file_name)), stream); putc ('\n', stream); UNBLOCK_INPUT; } @@ -5340,13 +5321,13 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) /* Check for auto save enabled and file changed since last auto save and file changed since last real save. */ - if (STRINGP (b->auto_save_file_name) + if (STRINGP (BVAR (b, auto_save_file_name)) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b) && BUF_AUTOSAVE_MODIFF (b) < BUF_MODIFF (b) /* -1 means we've turned off autosaving for a while--see below. */ - && XINT (b->save_length) >= 0 + && XINT (BVAR (b, save_length)) >= 0 && (do_handled_files - || NILP (Ffind_file_name_handler (b->auto_save_file_name, + || NILP (Ffind_file_name_handler (BVAR (b, auto_save_file_name), Qwrite_region)))) { EMACS_TIME before_time, after_time; @@ -5360,23 +5341,23 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) set_buffer_internal (b); if (NILP (Vauto_save_include_big_deletions) - && (XFASTINT (b->save_length) * 10 + && (XFASTINT (BVAR (b, save_length)) * 10 > (BUF_Z (b) - BUF_BEG (b)) * 13) /* A short file is likely to change a large fraction; spare the user annoying messages. */ - && XFASTINT (b->save_length) > 5000 + && XFASTINT (BVAR (b, save_length)) > 5000 /* These messages are frequent and annoying for `*mail*'. */ - && !EQ (b->filename, Qnil) + && !EQ (BVAR (b, filename), Qnil) && NILP (no_message)) { /* It has shrunk too much; turn off auto-saving here. */ minibuffer_auto_raise = orig_minibuffer_auto_raise; message_with_string ("Buffer %s has shrunk a lot; auto save disabled in that buffer until next real save", - b->name, 1); + BVAR (b, name), 1); minibuffer_auto_raise = 0; /* Turn off auto-saving until there's a real save, and prevent any more warnings. */ - XSETINT (b->save_length, -1); + XSETINT (BVAR (b, save_length), -1); Fsleep_for (make_number (1), Qnil); continue; } @@ -5385,7 +5366,7 @@ A non-nil CURRENT-ONLY argument means save only current buffer. */) internal_condition_case (auto_save_1, Qt, auto_save_error); auto_saved++; BUF_AUTOSAVE_MODIFF (b) = BUF_MODIFF (b); - XSETFASTINT (current_buffer->save_length, Z - BEG); + XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG); set_buffer_internal (old); EMACS_GET_TIME (after_time); @@ -5432,7 +5413,7 @@ No auto-save file will be written until the buffer changes again. */) /* FIXME: This should not be called in indirect buffers, since they're not autosaved. */ BUF_AUTOSAVE_MODIFF (current_buffer) = MODIFF; - XSETFASTINT (current_buffer->save_length, Z - BEG); + XSETFASTINT (BVAR (current_buffer, save_length), Z - BEG); current_buffer->auto_save_failure_time = -1; return Qnil; } @@ -5586,11 +5567,6 @@ syms_of_fileio (void) Qexcl = intern_c_string ("excl"); staticpro (&Qexcl); -#ifdef DOS_NT - Qfind_buffer_file_type = intern_c_string ("find-buffer-file-type"); - staticpro (&Qfind_buffer_file_type); -#endif /* DOS_NT */ - DEFVAR_LISP ("file-name-coding-system", Vfile_name_coding_system, doc: /* *Coding system for encoding file names. If it is nil, `default-file-name-coding-system' (which see) is used. */); diff --git a/src/filelock.c b/src/filelock.c index 8fa871f56ef..8e18bb7b650 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -637,9 +637,9 @@ unlock_all_files (void) for (tail = Vbuffer_alist; CONSP (tail); tail = XCDR (tail)) { b = XBUFFER (XCDR (XCAR (tail))); - if (STRINGP (b->file_truename) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)) + if (STRINGP (BVAR (b, file_truename)) && BUF_SAVE_MODIFF (b) < BUF_MODIFF (b)) { - unlock_file(b->file_truename); + unlock_file(BVAR (b, file_truename)); } } } @@ -652,7 +652,7 @@ or else nothing is done if current buffer isn't visiting a file. */) (Lisp_Object file) { if (NILP (file)) - file = current_buffer->file_truename; + file = BVAR (current_buffer, file_truename); else CHECK_STRING (file); if (SAVE_MODIFF < MODIFF @@ -669,8 +669,8 @@ should not be locked in that case. */) (void) { if (SAVE_MODIFF < MODIFF - && STRINGP (current_buffer->file_truename)) - unlock_file (current_buffer->file_truename); + && STRINGP (BVAR (current_buffer, file_truename))) + unlock_file (BVAR (current_buffer, file_truename)); return Qnil; } @@ -680,8 +680,8 @@ void unlock_buffer (struct buffer *buffer) { if (BUF_SAVE_MODIFF (buffer) < BUF_MODIFF (buffer) - && STRINGP (buffer->file_truename)) - unlock_file (buffer->file_truename); + && STRINGP (BVAR (buffer, file_truename))) + unlock_file (BVAR (buffer, file_truename)); } DEFUN ("file-locked-p", Ffile_locked_p, Sfile_locked_p, 1, 1, 0, diff --git a/src/filemode.c b/src/filemode.c deleted file mode 100644 index d41cd56c569..00000000000 --- a/src/filemode.c +++ /dev/null @@ -1,245 +0,0 @@ -/* filemode.c -- make a string describing file modes - Copyright (C) 1985, 1990, 1993, 2001-2011 Free Software Foundation, Inc. - - This program is free software; you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation; either version 3, or (at your option) - any later version. - - This program is distributed in the hope that it will be useful, - but WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - GNU General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, - USA. */ - -#include <config.h> -#include <sys/types.h> -#include <sys/stat.h> - -#if !S_IRUSR -# if S_IREAD -# define S_IRUSR S_IREAD -# else -# define S_IRUSR 00400 -# endif -#endif - -#if !S_IWUSR -# if S_IWRITE -# define S_IWUSR S_IWRITE -# else -# define S_IWUSR 00200 -# endif -#endif - -#if !S_IXUSR -# if S_IEXEC -# define S_IXUSR S_IEXEC -# else -# define S_IXUSR 00100 -# endif -#endif - -#ifdef STAT_MACROS_BROKEN -#undef S_ISBLK -#undef S_ISCHR -#undef S_ISDIR -#undef S_ISFIFO -#undef S_ISLNK -#undef S_ISMPB -#undef S_ISMPC -#undef S_ISNWK -#undef S_ISREG -#undef S_ISSOCK -#endif /* STAT_MACROS_BROKEN. */ - -#if !defined(S_ISBLK) && defined(S_IFBLK) -#define S_ISBLK(m) (((m) & S_IFMT) == S_IFBLK) -#endif -#if !defined(S_ISCHR) && defined(S_IFCHR) -#define S_ISCHR(m) (((m) & S_IFMT) == S_IFCHR) -#endif -#if !defined(S_ISDIR) && defined(S_IFDIR) -#define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR) -#endif -#if !defined(S_ISREG) && defined(S_IFREG) -#define S_ISREG(m) (((m) & S_IFMT) == S_IFREG) -#endif -#if !defined(S_ISFIFO) && defined(S_IFIFO) -#define S_ISFIFO(m) (((m) & S_IFMT) == S_IFIFO) -#endif -#if !defined(S_ISLNK) && defined(S_IFLNK) -#define S_ISLNK(m) (((m) & S_IFMT) == S_IFLNK) -#endif -#if !defined(S_ISSOCK) && defined(S_IFSOCK) -#define S_ISSOCK(m) (((m) & S_IFMT) == S_IFSOCK) -#endif -#if !defined(S_ISMPB) && defined(S_IFMPB) /* V7 */ -#define S_ISMPB(m) (((m) & S_IFMT) == S_IFMPB) -#define S_ISMPC(m) (((m) & S_IFMT) == S_IFMPC) -#endif -#if !defined(S_ISNWK) && defined(S_IFNWK) /* HP/UX */ -#define S_ISNWK(m) (((m) & S_IFMT) == S_IFNWK) -#endif - -void mode_string (short unsigned int mode, char *str); -static char ftypelet (long int bits); -static void rwx (short unsigned int bits, char *chars); -static void setst (short unsigned int bits, char *chars); - -/* filemodestring - fill in string STR with an ls-style ASCII - representation of the st_mode field of file stats block STATP. - 10 characters are stored in STR; no terminating null is added. - The characters stored in STR are: - - 0 File type. 'd' for directory, 'c' for character - special, 'b' for block special, 'm' for multiplex, - 'l' for symbolic link, 's' for socket, 'p' for fifo, - '-' for regular, '?' for any other file type - - 1 'r' if the owner may read, '-' otherwise. - - 2 'w' if the owner may write, '-' otherwise. - - 3 'x' if the owner may execute, 's' if the file is - set-user-id, '-' otherwise. - 'S' if the file is set-user-id, but the execute - bit isn't set. - - 4 'r' if group members may read, '-' otherwise. - - 5 'w' if group members may write, '-' otherwise. - - 6 'x' if group members may execute, 's' if the file is - set-group-id, '-' otherwise. - 'S' if it is set-group-id but not executable. - - 7 'r' if any user may read, '-' otherwise. - - 8 'w' if any user may write, '-' otherwise. - - 9 'x' if any user may execute, 't' if the file is "sticky" - (will be retained in swap space after execution), '-' - otherwise. - 'T' if the file is sticky but not executable. */ - -void -filemodestring (struct stat *statp, char *str) -{ - mode_string (statp->st_mode, str); -} - -/* Like filemodestring, but only the relevant part of the `struct stat' - is given as an argument. */ - -void -mode_string (short unsigned int mode, char *str) -{ - str[0] = ftypelet ((long) mode); - rwx ((mode & 0700) << 0, &str[1]); - rwx ((mode & 0070) << 3, &str[4]); - rwx ((mode & 0007) << 6, &str[7]); - setst (mode, str); -} - -/* Return a character indicating the type of file described by - file mode BITS: - 'd' for directories - 'b' for block special files - 'c' for character special files - 'm' for multiplexor files - 'l' for symbolic links - 's' for sockets - 'p' for fifos - '-' for regular files - '?' for any other file type. */ - -static char -ftypelet (long int bits) -{ -#ifdef S_ISBLK - if (S_ISBLK (bits)) - return 'b'; -#endif - if (S_ISCHR (bits)) - return 'c'; - if (S_ISDIR (bits)) - return 'd'; - if (S_ISREG (bits)) - return '-'; -#ifdef S_ISFIFO - if (S_ISFIFO (bits)) - return 'p'; -#endif -#ifdef S_ISLNK - if (S_ISLNK (bits)) - return 'l'; -#endif -#ifdef S_ISSOCK - if (S_ISSOCK (bits)) - return 's'; -#endif -#ifdef S_ISMPC - if (S_ISMPC (bits)) - return 'm'; -#endif -#ifdef S_ISNWK - if (S_ISNWK (bits)) - return 'n'; -#endif - return '?'; -} - -/* Look at read, write, and execute bits in BITS and set - flags in CHARS accordingly. */ - -static void -rwx (short unsigned int bits, char *chars) -{ - chars[0] = (bits & S_IRUSR) ? 'r' : '-'; - chars[1] = (bits & S_IWUSR) ? 'w' : '-'; - chars[2] = (bits & S_IXUSR) ? 'x' : '-'; -} - -/* Set the 's' and 't' flags in file attributes string CHARS, - according to the file mode BITS. */ - -static void -setst (short unsigned int bits, char *chars) -{ -#ifdef S_ISUID - if (bits & S_ISUID) - { - if (chars[3] != 'x') - /* Set-uid, but not executable by owner. */ - chars[3] = 'S'; - else - chars[3] = 's'; - } -#endif -#ifdef S_ISGID - if (bits & S_ISGID) - { - if (chars[6] != 'x') - /* Set-gid, but not executable by group. */ - chars[6] = 'S'; - else - chars[6] = 's'; - } -#endif -#ifdef S_ISVTX - if (bits & S_ISVTX) - { - if (chars[9] != 'x') - /* Sticky, but not executable by others. */ - chars[9] = 'T'; - else - chars[9] = 't'; - } -#endif -} - diff --git a/src/fns.c b/src/fns.c index 326f210f84f..5748c3d6e02 100644 --- a/src/fns.c +++ b/src/fns.c @@ -2987,7 +2987,7 @@ into shorter lines. */) SAFE_ALLOCA (encoded, char *, allength); encoded_length = base64_encode_1 ((char *) BYTE_POS_ADDR (ibeg), encoded, length, NILP (no_line_break), - !NILP (current_buffer->enable_multibyte_characters)); + !NILP (BVAR (current_buffer, enable_multibyte_characters))); if (encoded_length > allength) abort (); @@ -3169,7 +3169,7 @@ If the region can't be decoded, signal an error and don't modify the buffer. */ EMACS_INT old_pos = PT; EMACS_INT decoded_length; EMACS_INT inserted_chars; - int multibyte = !NILP (current_buffer->enable_multibyte_characters); + int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); USE_SAFE_ALLOCA; validate_region (&beg, &end); @@ -4687,12 +4687,12 @@ guesswork fails. Normally, an error is signaled in such case. */) { int force_raw_text = 0; - coding_system = XBUFFER (object)->buffer_file_coding_system; + coding_system = BVAR (XBUFFER (object), buffer_file_coding_system); if (NILP (coding_system) || NILP (Flocal_variable_p (Qbuffer_file_coding_system, Qnil))) { coding_system = Qnil; - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) force_raw_text = 1; } @@ -4709,11 +4709,11 @@ guesswork fails. Normally, an error is signaled in such case. */) } if (NILP (coding_system) - && !NILP (XBUFFER (object)->buffer_file_coding_system)) + && !NILP (BVAR (XBUFFER (object), buffer_file_coding_system))) { /* If we still have not decided a coding system, use the default value of buffer-file-coding-system. */ - coding_system = XBUFFER (object)->buffer_file_coding_system; + coding_system = BVAR (XBUFFER (object), buffer_file_coding_system); } if (!force_raw_text diff --git a/src/font.c b/src/font.c index 841125a0587..d77eafb6ad2 100644 --- a/src/font.c +++ b/src/font.c @@ -3637,7 +3637,7 @@ font_at (int c, EMACS_INT pos, struct face *face, struct window *w, Lisp_Object font_object; multibyte = (NILP (string) - ? ! NILP (current_buffer->enable_multibyte_characters) + ? ! NILP (BVAR (current_buffer, enable_multibyte_characters)) : STRING_MULTIBYTE (string)); if (c < 0) { diff --git a/src/frame.c b/src/frame.c index 20bad4cb8c5..56e0e7ec919 100644 --- a/src/frame.c +++ b/src/frame.c @@ -428,20 +428,20 @@ make_frame_without_minibuffer (register Lisp_Object mini_window, KBOARD *kb, Lis if (NILP (mini_window)) { /* Use default-minibuffer-frame if possible. */ - if (!FRAMEP (kb->Vdefault_minibuffer_frame) - || ! FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame))) + if (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame)) + || ! FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame)))) { Lisp_Object frame_dummy; XSETFRAME (frame_dummy, f); GCPRO1 (frame_dummy); /* If there's no minibuffer frame to use, create one. */ - kb->Vdefault_minibuffer_frame = + KVAR (kb, Vdefault_minibuffer_frame) = call1 (intern ("make-initial-minibuffer-frame"), display); UNGCPRO; } - mini_window = XFRAME (kb->Vdefault_minibuffer_frame)->minibuffer_window; + mini_window = XFRAME (KVAR (kb, Vdefault_minibuffer_frame))->minibuffer_window; } f->minibuffer_window = mini_window; @@ -889,7 +889,7 @@ to that frame. */) (Lisp_Object event) { /* Preserve prefix arg that the command loop just cleared. */ - current_kboard->Vprefix_arg = Vcurrent_prefix_arg; + KVAR (current_kboard, Vprefix_arg) = Vcurrent_prefix_arg; call1 (Vrun_hooks, Qmouse_leave_buffer_hook); return do_switch_frame (event, 0, 0, Qnil); } @@ -1526,7 +1526,7 @@ delete_frame (Lisp_Object frame, Lisp_Object force) /* If we've deleted this keyboard's default_minibuffer_frame, try to find another one. Prefer minibuffer-only frames, but also notice frames with other windows. */ - if (kb != NULL && EQ (frame, kb->Vdefault_minibuffer_frame)) + if (kb != NULL && EQ (frame, KVAR (kb, Vdefault_minibuffer_frame))) { Lisp_Object frames; @@ -1575,11 +1575,11 @@ delete_frame (Lisp_Object frame, Lisp_Object force) if (NILP (frame_with_minibuf)) abort (); - kb->Vdefault_minibuffer_frame = frame_with_minibuf; + KVAR (kb, Vdefault_minibuffer_frame) = frame_with_minibuf; } else /* No frames left on this kboard--say no minibuffer either. */ - kb->Vdefault_minibuffer_frame = Qnil; + KVAR (kb, Vdefault_minibuffer_frame) = Qnil; } /* Cause frame titles to update--necessary if we now have just one frame. */ @@ -1817,7 +1817,7 @@ make_frame_visible_1 (Lisp_Object window) w = XWINDOW (window); if (!NILP (w->buffer)) - XBUFFER (w->buffer)->display_time = Fcurrent_time (); + BVAR (XBUFFER (w->buffer), display_time) = Fcurrent_time (); if (!NILP (w->vchild)) make_frame_visible_1 (w->vchild); diff --git a/src/fringe.c b/src/fringe.c index 5c9088a924c..d42d6467f31 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -660,7 +660,7 @@ get_logical_cursor_bitmap (struct window *w, Lisp_Object cursor) { Lisp_Object cmap, bm = Qnil; - if ((cmap = XBUFFER (w->buffer)->fringe_cursor_alist), !NILP (cmap)) + if ((cmap = BVAR (XBUFFER (w->buffer), fringe_cursor_alist)), !NILP (cmap)) { bm = Fassq (cursor, cmap); if (CONSP (bm)) @@ -670,9 +670,9 @@ get_logical_cursor_bitmap (struct window *w, Lisp_Object cursor) return lookup_fringe_bitmap (bm); } } - if (EQ (cmap, buffer_defaults.fringe_cursor_alist)) + if (EQ (cmap, BVAR (&buffer_defaults, fringe_cursor_alist))) return NO_FRINGE_BITMAP; - bm = Fassq (cursor, buffer_defaults.fringe_cursor_alist); + bm = Fassq (cursor, BVAR (&buffer_defaults, fringe_cursor_alist)); if (!CONSP (bm) || ((bm = XCDR (bm)), NILP (bm))) return NO_FRINGE_BITMAP; return lookup_fringe_bitmap (bm); @@ -697,7 +697,7 @@ get_logical_fringe_bitmap (struct window *w, Lisp_Object bitmap, int right_p, in If partial, lookup partial bitmap in default value if not found here. If not partial, or no partial spec is present, use non-partial bitmap. */ - if ((cmap = XBUFFER (w->buffer)->fringe_indicator_alist), !NILP (cmap)) + if ((cmap = BVAR (XBUFFER (w->buffer), fringe_indicator_alist)), !NILP (cmap)) { bm1 = Fassq (bitmap, cmap); if (CONSP (bm1)) @@ -731,10 +731,10 @@ get_logical_fringe_bitmap (struct window *w, Lisp_Object bitmap, int right_p, in } } - if (!EQ (cmap, buffer_defaults.fringe_indicator_alist) - && !NILP (buffer_defaults.fringe_indicator_alist)) + if (!EQ (cmap, BVAR (&buffer_defaults, fringe_indicator_alist)) + && !NILP (BVAR (&buffer_defaults, fringe_indicator_alist))) { - bm2 = Fassq (bitmap, buffer_defaults.fringe_indicator_alist); + bm2 = Fassq (bitmap, BVAR (&buffer_defaults, fringe_indicator_alist)); if (CONSP (bm2)) { if ((bm2 = XCDR (bm2)), !NILP (bm2)) @@ -919,7 +919,7 @@ update_window_fringes (struct window *w, int keep_current_p) return 0; if (!MINI_WINDOW_P (w) - && (ind = XBUFFER (w->buffer)->indicate_buffer_boundaries, !NILP (ind))) + && (ind = BVAR (XBUFFER (w->buffer), indicate_buffer_boundaries), !NILP (ind))) { if (EQ (ind, Qleft) || EQ (ind, Qright)) boundary_top = boundary_bot = arrow_top = arrow_bot = ind; @@ -988,7 +988,7 @@ update_window_fringes (struct window *w, int keep_current_p) } } - empty_pos = XBUFFER (w->buffer)->indicate_empty_lines; + empty_pos = BVAR (XBUFFER (w->buffer), indicate_empty_lines); if (!NILP (empty_pos) && !EQ (empty_pos, Qright)) empty_pos = WINDOW_LEFT_FRINGE_WIDTH (w) == 0 ? Qright : Qleft; diff --git a/src/gtkutil.c b/src/gtkutil.c index 6367949a649..6ecd5d624af 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -3677,7 +3677,7 @@ xg_tool_bar_menu_proxy (GtkToolItem *toolitem, gpointer user_data) GtkLabel *wlbl = GTK_LABEL (xg_get_tool_bar_widgets (vb, &c1)); GtkImage *wimage = GTK_IMAGE (c1); GtkWidget *wmenuitem = gtk_image_menu_item_new_with_label - (gtk_label_get_text (wlbl)); + (wlbl ? gtk_label_get_text (wlbl) : ""); GtkWidget *wmenuimage; diff --git a/src/indent.c b/src/indent.c index 84ce140c5ba..85d26520cfb 100644 --- a/src/indent.c +++ b/src/indent.c @@ -70,7 +70,7 @@ buffer_display_table (void) { Lisp_Object thisbuf; - thisbuf = current_buffer->display_table; + thisbuf = BVAR (current_buffer, display_table); if (DISP_TABLE_P (thisbuf)) return XCHAR_TABLE (thisbuf); if (DISP_TABLE_P (Vstandard_display_table)) @@ -140,9 +140,9 @@ recompute_width_table (struct buffer *buf, struct Lisp_Char_Table *disptab) int i; struct Lisp_Vector *widthtab; - if (!VECTORP (buf->width_table)) - buf->width_table = Fmake_vector (make_number (256), make_number (0)); - widthtab = XVECTOR (buf->width_table); + if (!VECTORP (BVAR (buf, width_table))) + BVAR (buf, width_table) = Fmake_vector (make_number (256), make_number (0)); + widthtab = XVECTOR (BVAR (buf, width_table)); if (widthtab->size != 256) abort (); @@ -156,17 +156,17 @@ recompute_width_table (struct buffer *buf, struct Lisp_Char_Table *disptab) static void width_run_cache_on_off (void) { - if (NILP (current_buffer->cache_long_line_scans) + if (NILP (BVAR (current_buffer, cache_long_line_scans)) /* And, for the moment, this feature doesn't work on multibyte characters. */ - || !NILP (current_buffer->enable_multibyte_characters)) + || !NILP (BVAR (current_buffer, enable_multibyte_characters))) { /* It should be off. */ if (current_buffer->width_run_cache) { free_region_cache (current_buffer->width_run_cache); current_buffer->width_run_cache = 0; - current_buffer->width_table = Qnil; + BVAR (current_buffer, width_table) = Qnil; } } else @@ -329,8 +329,8 @@ current_column (void) register int tab_seen; int post_tab; register int c; - register int tab_width = XINT (current_buffer->tab_width); - int ctl_arrow = !NILP (current_buffer->ctl_arrow); + register int tab_width = XINT (BVAR (current_buffer, tab_width)); + int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow)); register struct Lisp_Char_Table *dp = buffer_display_table (); if (PT == last_known_column_point @@ -417,7 +417,7 @@ current_column (void) col++; else if (c == '\n' || (c == '\r' - && EQ (current_buffer->selective_display, Qt))) + && EQ (BVAR (current_buffer, selective_display), Qt))) { ptr++; goto start_of_line_found; @@ -512,10 +512,10 @@ check_display_width (EMACS_INT pos, EMACS_INT col, EMACS_INT *endpos) static void scan_for_column (EMACS_INT *endpos, EMACS_INT *goalcol, EMACS_INT *prevcol) { - register EMACS_INT tab_width = XINT (current_buffer->tab_width); - register int ctl_arrow = !NILP (current_buffer->ctl_arrow); + register EMACS_INT tab_width = XINT (BVAR (current_buffer, tab_width)); + register int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow)); register struct Lisp_Char_Table *dp = buffer_display_table (); - int multibyte = !NILP (current_buffer->enable_multibyte_characters); + int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); struct composition_it cmp_it; Lisp_Object window; struct window *w; @@ -637,7 +637,7 @@ scan_for_column (EMACS_INT *endpos, EMACS_INT *goalcol, EMACS_INT *prevcol) if (c == '\n') goto endloop; - if (c == '\r' && EQ (current_buffer->selective_display, Qt)) + if (c == '\r' && EQ (BVAR (current_buffer, selective_display), Qt)) goto endloop; if (c == '\t') { @@ -655,7 +655,7 @@ scan_for_column (EMACS_INT *endpos, EMACS_INT *goalcol, EMACS_INT *prevcol) if (c == '\n') goto endloop; - if (c == '\r' && EQ (current_buffer->selective_display, Qt)) + if (c == '\r' && EQ (BVAR (current_buffer, selective_display), Qt)) goto endloop; if (c == '\t') { @@ -809,7 +809,7 @@ The return value is COLUMN. */) { int mincol; register int fromcol; - register int tab_width = XINT (current_buffer->tab_width); + register int tab_width = XINT (BVAR (current_buffer, tab_width)); CHECK_NUMBER (column); if (NILP (minimum)) @@ -872,7 +872,7 @@ static double position_indentation (register int pos_byte) { register EMACS_INT column = 0; - register EMACS_INT tab_width = XINT (current_buffer->tab_width); + register EMACS_INT tab_width = XINT (BVAR (current_buffer, tab_width)); register unsigned char *p; register unsigned char *stop; unsigned char *start; @@ -924,7 +924,7 @@ position_indentation (register int pos_byte) switch (*p++) { case 0240: - if (! NILP (current_buffer->enable_multibyte_characters)) + if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) return column; case ' ': column++; @@ -934,7 +934,7 @@ position_indentation (register int pos_byte) break; default: if (ASCII_BYTE_P (p[-1]) - || NILP (current_buffer->enable_multibyte_characters)) + || NILP (BVAR (current_buffer, enable_multibyte_characters))) return column; { int c; @@ -1123,13 +1123,13 @@ compute_motion (EMACS_INT from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_ register EMACS_INT pos; EMACS_INT pos_byte; register int c = 0; - register EMACS_INT tab_width = XFASTINT (current_buffer->tab_width); - register int ctl_arrow = !NILP (current_buffer->ctl_arrow); + register EMACS_INT tab_width = XFASTINT (BVAR (current_buffer, tab_width)); + register int ctl_arrow = !NILP (BVAR (current_buffer, ctl_arrow)); register struct Lisp_Char_Table *dp = window_display_table (win); int selective - = (INTEGERP (current_buffer->selective_display) - ? XINT (current_buffer->selective_display) - : !NILP (current_buffer->selective_display) ? -1 : 0); + = (INTEGERP (BVAR (current_buffer, selective_display)) + ? XINT (BVAR (current_buffer, selective_display)) + : !NILP (BVAR (current_buffer, selective_display)) ? -1 : 0); int selective_rlen = (selective && dp && VECTORP (DISP_INVIS_VECTOR (dp)) ? XVECTOR (DISP_INVIS_VECTOR (dp))->size : 0); @@ -1151,7 +1151,7 @@ compute_motion (EMACS_INT from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_ EMACS_INT next_width_run = from; Lisp_Object window; - int multibyte = !NILP (current_buffer->enable_multibyte_characters); + int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); /* If previous char scanned was a wide character, this is the column where it ended. Otherwise, this is 0. */ EMACS_INT wide_column_end_hpos = 0; @@ -1170,8 +1170,8 @@ compute_motion (EMACS_INT from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_ width_run_cache_on_off (); if (dp == buffer_display_table ()) - width_table = (VECTORP (current_buffer->width_table) - ? XVECTOR (current_buffer->width_table)->contents + width_table = (VECTORP (BVAR (current_buffer, width_table)) + ? XVECTOR (BVAR (current_buffer, width_table))->contents : 0); else /* If the window has its own display table, we can't use the width @@ -1337,7 +1337,7 @@ compute_motion (EMACS_INT from, EMACS_INT fromvpos, EMACS_INT fromhpos, int did_ } if (hscroll || truncate - || !NILP (current_buffer->truncate_lines)) + || !NILP (BVAR (current_buffer, truncate_lines))) { /* Truncating: skip to newline, unless we are already past TO (we need to go back below). */ @@ -1838,9 +1838,9 @@ vmotion (register EMACS_INT from, register EMACS_INT vtarget, struct window *w) EMACS_INT from_byte; EMACS_INT lmargin = hscroll > 0 ? 1 - hscroll : 0; int selective - = (INTEGERP (current_buffer->selective_display) - ? XINT (current_buffer->selective_display) - : !NILP (current_buffer->selective_display) ? -1 : 0); + = (INTEGERP (BVAR (current_buffer, selective_display)) + ? XINT (BVAR (current_buffer, selective_display)) + : !NILP (BVAR (current_buffer, selective_display)) ? -1 : 0); Lisp_Object window; EMACS_INT start_hpos = 0; int did_motion; diff --git a/src/insdel.c b/src/insdel.c index db76f770dad..7fcf9522a33 100644 --- a/src/insdel.c +++ b/src/insdel.c @@ -78,7 +78,7 @@ void check_markers (void) { register struct Lisp_Marker *tail; - int multibyte = ! NILP (current_buffer->enable_multibyte_characters); + int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); for (tail = BUF_MARKERS (current_buffer); tail; tail = tail->next) { @@ -703,7 +703,7 @@ insert_char (int c) unsigned char str[MAX_MULTIBYTE_LENGTH]; int len; - if (! NILP (current_buffer->enable_multibyte_characters)) + if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) len = CHAR_STRING (c, str); else { @@ -891,7 +891,7 @@ insert_1_both (const char *string, if (nchars == 0) return; - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) nchars = nbytes; if (prepare) @@ -1011,7 +1011,7 @@ insert_from_string_1 (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte, /* Make OUTGOING_NBYTES describe the text as it will be inserted in this buffer. */ - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) outgoing_nbytes = nchars; else if (! STRING_MULTIBYTE (string)) outgoing_nbytes @@ -1034,7 +1034,7 @@ insert_from_string_1 (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte, between single-byte and multibyte. */ copy_text (SDATA (string) + pos_byte, GPT_ADDR, nbytes, STRING_MULTIBYTE (string), - ! NILP (current_buffer->enable_multibyte_characters)); + ! NILP (BVAR (current_buffer, enable_multibyte_characters))); #ifdef BYTE_COMBINING_DEBUG /* We have copied text into the gap, but we have not altered @@ -1094,7 +1094,7 @@ insert_from_string_1 (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte, void insert_from_gap (EMACS_INT nchars, EMACS_INT nbytes) { - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) nchars = nbytes; record_insert (GPT, nchars); @@ -1162,9 +1162,9 @@ insert_from_buffer_1 (struct buffer *buf, /* Make OUTGOING_NBYTES describe the text as it will be inserted in this buffer. */ - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) outgoing_nbytes = nchars; - else if (NILP (buf->enable_multibyte_characters)) + else if (NILP (BVAR (buf, enable_multibyte_characters))) { EMACS_INT outgoing_before_gap = 0; EMACS_INT outgoing_after_gap = 0; @@ -1215,8 +1215,8 @@ insert_from_buffer_1 (struct buffer *buf, chunk_expanded = copy_text (BUF_BYTE_ADDRESS (buf, from_byte), GPT_ADDR, chunk, - ! NILP (buf->enable_multibyte_characters), - ! NILP (current_buffer->enable_multibyte_characters)); + ! NILP (BVAR (buf, enable_multibyte_characters)), + ! NILP (BVAR (current_buffer, enable_multibyte_characters))); } else chunk_expanded = chunk = 0; @@ -1224,8 +1224,8 @@ insert_from_buffer_1 (struct buffer *buf, if (chunk < incoming_nbytes) copy_text (BUF_BYTE_ADDRESS (buf, from_byte + chunk), GPT_ADDR + chunk_expanded, incoming_nbytes - chunk, - ! NILP (buf->enable_multibyte_characters), - ! NILP (current_buffer->enable_multibyte_characters)); + ! NILP (BVAR (buf, enable_multibyte_characters)), + ! NILP (BVAR (current_buffer, enable_multibyte_characters))); #ifdef BYTE_COMBINING_DEBUG /* We have copied text into the gap, but we have not altered @@ -1320,7 +1320,7 @@ adjust_after_replace (EMACS_INT from, EMACS_INT from_byte, adjust_markers_for_insert (from, from_byte, from + len, from_byte + len_byte, 0); - if (! EQ (current_buffer->undo_list, Qt)) + if (! EQ (BVAR (current_buffer, undo_list), Qt)) { if (nchars_del > 0) record_delete (from, prev_text); @@ -1481,7 +1481,7 @@ replace_range (EMACS_INT from, EMACS_INT to, Lisp_Object new, /* Make OUTGOING_INSBYTES describe the text as it will be inserted in this buffer. */ - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) outgoing_insbytes = inschars; else if (! STRING_MULTIBYTE (new)) outgoing_insbytes @@ -1503,7 +1503,7 @@ replace_range (EMACS_INT from, EMACS_INT to, Lisp_Object new, /* Even if we don't record for undo, we must keep the original text because we may have to recover it because of inappropriate byte combining. */ - if (! EQ (current_buffer->undo_list, Qt)) + if (! EQ (BVAR (current_buffer, undo_list), Qt)) deletion = make_buffer_string_both (from, from_byte, to, to_byte, 1); GAP_SIZE += nbytes_del; @@ -1530,7 +1530,7 @@ replace_range (EMACS_INT from, EMACS_INT to, Lisp_Object new, between single-byte and multibyte. */ copy_text (SDATA (new), GPT_ADDR, insbytes, STRING_MULTIBYTE (new), - ! NILP (current_buffer->enable_multibyte_characters)); + ! NILP (BVAR (current_buffer, enable_multibyte_characters))); #ifdef BYTE_COMBINING_DEBUG /* We have copied text into the gap, but we have not marked @@ -1543,7 +1543,7 @@ replace_range (EMACS_INT from, EMACS_INT to, Lisp_Object new, abort (); #endif - if (! EQ (current_buffer->undo_list, Qt)) + if (! EQ (BVAR (current_buffer, undo_list), Qt)) { /* Record the insertion first, so that when we undo, the deletion will be undone first. Thus, undo @@ -1886,7 +1886,7 @@ del_range_2 (EMACS_INT from, EMACS_INT from_byte, abort (); #endif - if (ret_string || ! EQ (current_buffer->undo_list, Qt)) + if (ret_string || ! EQ (BVAR (current_buffer, undo_list), Qt)) deletion = make_buffer_string_both (from, from_byte, to, to_byte, 1); else deletion = Qnil; @@ -1897,7 +1897,7 @@ del_range_2 (EMACS_INT from, EMACS_INT from_byte, so that undo handles this after reinserting the text. */ adjust_markers_for_delete (from, from_byte, to, to_byte); - if (! EQ (current_buffer->undo_list, Qt)) + if (! EQ (BVAR (current_buffer, undo_list), Qt)) record_delete (from, deletion); MODIFF++; CHARS_MODIFF = MODIFF; @@ -1968,7 +1968,7 @@ modify_region (struct buffer *buffer, EMACS_INT start, EMACS_INT end, if (! preserve_chars_modiff) CHARS_MODIFF = MODIFF; - buffer->point_before_scroll = Qnil; + BVAR (buffer, point_before_scroll) = Qnil; if (buffer != old_buffer) set_buffer_internal (old_buffer); @@ -1990,7 +1990,7 @@ prepare_to_modify_buffer (EMACS_INT start, EMACS_INT end, { struct buffer *base_buffer; - if (!NILP (current_buffer->read_only)) + if (!NILP (BVAR (current_buffer, read_only))) Fbarf_if_buffer_read_only (); /* Let redisplay consider other windows than selected_window @@ -2022,32 +2022,32 @@ prepare_to_modify_buffer (EMACS_INT start, EMACS_INT end, base_buffer = current_buffer; #ifdef CLASH_DETECTION - if (!NILP (base_buffer->file_truename) + if (!NILP (BVAR (base_buffer, file_truename)) /* Make binding buffer-file-name to nil effective. */ - && !NILP (base_buffer->filename) + && !NILP (BVAR (base_buffer, filename)) && SAVE_MODIFF >= MODIFF) - lock_file (base_buffer->file_truename); + lock_file (BVAR (base_buffer, file_truename)); #else /* At least warn if this file has changed on disk since it was visited. */ - if (!NILP (base_buffer->filename) + if (!NILP (BVAR (base_buffer, filename)) && SAVE_MODIFF >= MODIFF && NILP (Fverify_visited_file_modtime (Fcurrent_buffer ())) - && !NILP (Ffile_exists_p (base_buffer->filename))) + && !NILP (Ffile_exists_p (BVAR (base_buffer, filename)))) call1 (intern ("ask-user-about-supersession-threat"), - base_buffer->filename); + BVAR (base_buffer,filename)); #endif /* not CLASH_DETECTION */ /* If `select-active-regions' is non-nil, save the region text. */ - if (!NILP (current_buffer->mark_active) + if (!NILP (BVAR (current_buffer, mark_active)) && !inhibit_modification_hooks - && XMARKER (current_buffer->mark)->buffer + && XMARKER (BVAR (current_buffer, mark))->buffer && NILP (Vsaved_region_selection) && (EQ (Vselect_active_regions, Qonly) ? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly) : (!NILP (Vselect_active_regions) && !NILP (Vtransient_mark_mode)))) { - EMACS_INT b = XMARKER (current_buffer->mark)->charpos; + EMACS_INT b = XMARKER (BVAR (current_buffer, mark))->charpos; EMACS_INT e = PT; if (b < e) Vsaved_region_selection = make_buffer_string (b, e, 0); @@ -2290,7 +2290,7 @@ DEFUN ("combine-after-change-execute", Fcombine_after_change_execute, non-nil, and insertion calls a file handler (e.g. through lock_file) which scribbles into a temp file -- cyd */ if (!BUFFERP (combine_after_change_buffer) - || NILP (XBUFFER (combine_after_change_buffer)->name)) + || NILP (BVAR (XBUFFER (combine_after_change_buffer), name))) { combine_after_change_list = Qnil; return Qnil; diff --git a/src/intervals.c b/src/intervals.c index ad46c17d588..6aee6e9d7fa 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -1978,7 +1978,7 @@ set_point_both (EMACS_INT charpos, EMACS_INT bytepos) int have_overlays; EMACS_INT original_position; - current_buffer->point_before_scroll = Qnil; + BVAR (current_buffer, point_before_scroll) = Qnil; if (charpos == PT) return; @@ -2342,7 +2342,7 @@ get_local_map (register EMACS_INT position, register struct buffer *buffer, if (EQ (type, Qkeymap)) return Qnil; else - return buffer->keymap; + return BVAR (buffer, keymap); } /* Produce an interval tree reflecting the intervals in diff --git a/src/intervals.h b/src/intervals.h index 0762c9d8dc3..f6c1c002ce0 100644 --- a/src/intervals.h +++ b/src/intervals.h @@ -236,9 +236,9 @@ struct interval and 2 if it is invisible but with an ellipsis. */ #define TEXT_PROP_MEANS_INVISIBLE(prop) \ - (EQ (current_buffer->invisibility_spec, Qt) \ + (EQ (BVAR (current_buffer, invisibility_spec), Qt) \ ? !NILP (prop) \ - : invisible_p (prop, current_buffer->invisibility_spec)) + : invisible_p (prop, BVAR (current_buffer, invisibility_spec))) /* Declared in alloc.c */ diff --git a/src/keyboard.c b/src/keyboard.c index eb586183f08..1f14af78844 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -461,7 +461,7 @@ echo_char (Lisp_Object c) char *ptr = buffer; Lisp_Object echo_string; - echo_string = current_kboard->echo_string; + echo_string = KVAR (current_kboard, echo_string); /* If someone has passed us a composite event, use its head symbol. */ c = EVENT_HEAD (c); @@ -528,7 +528,7 @@ echo_char (Lisp_Object c) else if (STRINGP (echo_string)) echo_string = concat2 (echo_string, build_string (" ")); - current_kboard->echo_string + KVAR (current_kboard, echo_string) = concat2 (echo_string, make_string (buffer, ptr - buffer)); echo_now (); @@ -542,31 +542,31 @@ void echo_dash (void) { /* Do nothing if not echoing at all. */ - if (NILP (current_kboard->echo_string)) + if (NILP (KVAR (current_kboard, echo_string))) return; if (this_command_key_count == 0) return; if (!current_kboard->immediate_echo - && SCHARS (current_kboard->echo_string) == 0) + && SCHARS (KVAR (current_kboard, echo_string)) == 0) return; /* Do nothing if we just printed a prompt. */ if (current_kboard->echo_after_prompt - == SCHARS (current_kboard->echo_string)) + == SCHARS (KVAR (current_kboard, echo_string))) return; /* Do nothing if we have already put a dash at the end. */ - if (SCHARS (current_kboard->echo_string) > 1) + if (SCHARS (KVAR (current_kboard, echo_string)) > 1) { Lisp_Object last_char, prev_char, idx; - idx = make_number (SCHARS (current_kboard->echo_string) - 2); - prev_char = Faref (current_kboard->echo_string, idx); + idx = make_number (SCHARS (KVAR (current_kboard, echo_string)) - 2); + prev_char = Faref (KVAR (current_kboard, echo_string), idx); - idx = make_number (SCHARS (current_kboard->echo_string) - 1); - last_char = Faref (current_kboard->echo_string, idx); + idx = make_number (SCHARS (KVAR (current_kboard, echo_string)) - 1); + last_char = Faref (KVAR (current_kboard, echo_string), idx); if (XINT (last_char) == '-' && XINT (prev_char) != ' ') return; @@ -574,7 +574,7 @@ echo_dash (void) /* Put a dash at the end of the buffer temporarily, but make it go away when the next character is added. */ - current_kboard->echo_string = concat2 (current_kboard->echo_string, + KVAR (current_kboard, echo_string) = concat2 (KVAR (current_kboard, echo_string), build_string ("-")); echo_now (); } @@ -617,9 +617,9 @@ echo_now (void) } echoing = 1; - message3_nolog (current_kboard->echo_string, - SBYTES (current_kboard->echo_string), - STRING_MULTIBYTE (current_kboard->echo_string)); + message3_nolog (KVAR (current_kboard, echo_string), + SBYTES (KVAR (current_kboard, echo_string)), + STRING_MULTIBYTE (KVAR (current_kboard, echo_string))); echoing = 0; /* Record in what buffer we echoed, and from which kboard. */ @@ -637,7 +637,7 @@ cancel_echoing (void) { current_kboard->immediate_echo = 0; current_kboard->echo_after_prompt = -1; - current_kboard->echo_string = Qnil; + KVAR (current_kboard, echo_string) = Qnil; ok_to_echo_at_next_pause = NULL; echo_kboard = NULL; echo_message_buffer = Qnil; @@ -648,8 +648,8 @@ cancel_echoing (void) static int echo_length (void) { - return (STRINGP (current_kboard->echo_string) - ? SCHARS (current_kboard->echo_string) + return (STRINGP (KVAR (current_kboard, echo_string)) + ? SCHARS (KVAR (current_kboard, echo_string)) : 0); } @@ -660,9 +660,9 @@ echo_length (void) static void echo_truncate (EMACS_INT nchars) { - if (STRINGP (current_kboard->echo_string)) - current_kboard->echo_string - = Fsubstring (current_kboard->echo_string, + if (STRINGP (KVAR (current_kboard, echo_string))) + KVAR (current_kboard, echo_string) + = Fsubstring (KVAR (current_kboard, echo_string), make_number (0), make_number (nchars)); truncate_echo_area (nchars); } @@ -993,8 +993,8 @@ cmd_error (Lisp_Object data) Vstandard_input = Qt; Vexecuting_kbd_macro = Qnil; executing_kbd_macro = Qnil; - current_kboard->Vprefix_arg = Qnil; - current_kboard->Vlast_prefix_arg = Qnil; + KVAR (current_kboard, Vprefix_arg) = Qnil; + KVAR (current_kboard, Vlast_prefix_arg) = Qnil; cancel_echoing (); /* Avoid unquittable loop if data contains a circular list. */ @@ -1302,8 +1302,8 @@ command_loop_1 (void) #endif int already_adjusted = 0; - current_kboard->Vprefix_arg = Qnil; - current_kboard->Vlast_prefix_arg = Qnil; + KVAR (current_kboard, Vprefix_arg) = Qnil; + KVAR (current_kboard, Vlast_prefix_arg) = Qnil; Vdeactivate_mark = Qnil; waiting_for_input = 0; cancel_echoing (); @@ -1331,10 +1331,10 @@ command_loop_1 (void) } /* Do this after running Vpost_command_hook, for consistency. */ - current_kboard->Vlast_command = Vthis_command; - current_kboard->Vreal_last_command = real_this_command; + KVAR (current_kboard, Vlast_command) = Vthis_command; + KVAR (current_kboard, Vreal_last_command) = real_this_command; if (!CONSP (last_command_event)) - current_kboard->Vlast_repeatable_command = real_this_command; + KVAR (current_kboard, Vlast_repeatable_command) = real_this_command; while (1) { @@ -1504,9 +1504,9 @@ command_loop_1 (void) keys = Fkey_description (keys, Qnil); bitch_at_user (); message_with_string ("%s is undefined", keys, 0); - current_kboard->defining_kbd_macro = Qnil; + KVAR (current_kboard, defining_kbd_macro) = Qnil; update_mode_lines = 1; - current_kboard->Vprefix_arg = Qnil; + KVAR (current_kboard, Vprefix_arg) = Qnil; } else { @@ -1523,7 +1523,7 @@ command_loop_1 (void) } #endif - if (NILP (current_kboard->Vprefix_arg)) /* FIXME: Why? --Stef */ + if (NILP (KVAR (current_kboard, Vprefix_arg))) /* FIXME: Why? --Stef */ Fundo_boundary (); Fcommand_execute (Vthis_command, Qnil, Qnil, Qnil); @@ -1537,7 +1537,7 @@ command_loop_1 (void) unbind_to (scount, Qnil); #endif } - current_kboard->Vlast_prefix_arg = Vcurrent_prefix_arg; + KVAR (current_kboard, Vlast_prefix_arg) = Vcurrent_prefix_arg; /* Note that the value cell will never directly contain nil if the symbol is a local variable. */ @@ -1565,19 +1565,19 @@ command_loop_1 (void) If the command didn't actually create a prefix arg, but is merely a frame event that is transparent to prefix args, then the above doesn't apply. */ - if (NILP (current_kboard->Vprefix_arg) || CONSP (last_command_event)) + if (NILP (KVAR (current_kboard, Vprefix_arg)) || CONSP (last_command_event)) { - current_kboard->Vlast_command = Vthis_command; - current_kboard->Vreal_last_command = real_this_command; + KVAR (current_kboard, Vlast_command) = Vthis_command; + KVAR (current_kboard, Vreal_last_command) = real_this_command; if (!CONSP (last_command_event)) - current_kboard->Vlast_repeatable_command = real_this_command; + KVAR (current_kboard, Vlast_repeatable_command) = real_this_command; cancel_echoing (); this_command_key_count = 0; this_command_key_count_reset = 0; this_single_command_key_start = 0; } - if (!NILP (current_buffer->mark_active) + if (!NILP (BVAR (current_buffer, mark_active)) && !NILP (Vrun_hooks)) { /* In Emacs 22, setting transient-mark-mode to `only' was a @@ -1599,7 +1599,7 @@ command_loop_1 (void) if (!NILP (Fwindow_system (Qnil)) /* Even if mark_active is non-nil, the actual buffer marker may not have been set yet (Bug#7044). */ - && XMARKER (current_buffer->mark)->buffer + && XMARKER (BVAR (current_buffer, mark))->buffer && (EQ (Vselect_active_regions, Qonly) ? EQ (CAR_SAFE (Vtransient_mark_mode), Qonly) : (!NILP (Vselect_active_regions) @@ -1607,7 +1607,7 @@ command_loop_1 (void) && !EQ (Vthis_command, Qhandle_switch_frame)) { EMACS_INT beg = - XINT (Fmarker_position (current_buffer->mark)); + XINT (Fmarker_position (BVAR (current_buffer, mark))); EMACS_INT end = PT; if (beg < end) call2 (Qx_set_selection, QPRIMARY, @@ -1649,8 +1649,8 @@ command_loop_1 (void) /* Install chars successfully executed in kbd macro. */ - if (!NILP (current_kboard->defining_kbd_macro) - && NILP (current_kboard->Vprefix_arg)) + if (!NILP (KVAR (current_kboard, defining_kbd_macro)) + && NILP (KVAR (current_kboard, Vprefix_arg))) finalize_kbd_macro_chars (); #if 0 /* This shouldn't be necessary anymore. --lorentey */ if (!was_locked) @@ -2461,7 +2461,7 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event KBOARD *kb = FRAME_KBOARD (XFRAME (selected_frame)); if (kb != current_kboard) { - Lisp_Object link = kb->kbd_queue; + Lisp_Object link = KVAR (kb, kbd_queue); /* We shouldn't get here if we were in single-kboard mode! */ if (single_kboard) abort (); @@ -2473,7 +2473,7 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event abort (); } if (!CONSP (link)) - kb->kbd_queue = Fcons (c, Qnil); + KVAR (kb, kbd_queue) = Fcons (c, Qnil); else XSETCDR (link, Fcons (c, Qnil)); kb->kbd_queue_has_data = 1; @@ -2645,12 +2645,12 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event { if (current_kboard->kbd_queue_has_data) { - if (!CONSP (current_kboard->kbd_queue)) + if (!CONSP (KVAR (current_kboard, kbd_queue))) abort (); - c = XCAR (current_kboard->kbd_queue); - current_kboard->kbd_queue - = XCDR (current_kboard->kbd_queue); - if (NILP (current_kboard->kbd_queue)) + c = XCAR (KVAR (current_kboard, kbd_queue)); + KVAR (current_kboard, kbd_queue) + = XCDR (KVAR (current_kboard, kbd_queue)); + if (NILP (KVAR (current_kboard, kbd_queue))) current_kboard->kbd_queue_has_data = 0; input_pending = readable_events (0); if (EVENT_HAS_PARAMETERS (c) @@ -2712,7 +2712,7 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event if (! NILP (c) && (kb != current_kboard)) { - Lisp_Object link = kb->kbd_queue; + Lisp_Object link = KVAR (kb, kbd_queue); if (CONSP (link)) { while (CONSP (XCDR (link))) @@ -2721,7 +2721,7 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event abort (); } if (!CONSP (link)) - kb->kbd_queue = Fcons (c, Qnil); + KVAR (kb, kbd_queue) = Fcons (c, Qnil); else XSETCDR (link, Fcons (c, Qnil)); kb->kbd_queue_has_data = 1; @@ -2829,15 +2829,15 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event if (XINT (c) == -1) goto exit; - if ((STRINGP (current_kboard->Vkeyboard_translate_table) - && SCHARS (current_kboard->Vkeyboard_translate_table) > (unsigned) XFASTINT (c)) - || (VECTORP (current_kboard->Vkeyboard_translate_table) - && XVECTOR (current_kboard->Vkeyboard_translate_table)->size > (unsigned) XFASTINT (c)) - || (CHAR_TABLE_P (current_kboard->Vkeyboard_translate_table) + if ((STRINGP (KVAR (current_kboard, Vkeyboard_translate_table)) + && SCHARS (KVAR (current_kboard, Vkeyboard_translate_table)) > (unsigned) XFASTINT (c)) + || (VECTORP (KVAR (current_kboard, Vkeyboard_translate_table)) + && XVECTOR (KVAR (current_kboard, Vkeyboard_translate_table))->size > (unsigned) XFASTINT (c)) + || (CHAR_TABLE_P (KVAR (current_kboard, Vkeyboard_translate_table)) && CHARACTERP (c))) { Lisp_Object d; - d = Faref (current_kboard->Vkeyboard_translate_table, c); + d = Faref (KVAR (current_kboard, Vkeyboard_translate_table), c); /* nil in keyboard-translate-table means no translation. */ if (!NILP (d)) c = d; @@ -2918,7 +2918,7 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event /* Save the echo status. */ int saved_immediate_echo = current_kboard->immediate_echo; struct kboard *saved_ok_to_echo = ok_to_echo_at_next_pause; - Lisp_Object saved_echo_string = current_kboard->echo_string; + Lisp_Object saved_echo_string = KVAR (current_kboard, echo_string); int saved_echo_after_prompt = current_kboard->echo_after_prompt; #if 0 @@ -2973,7 +2973,7 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event cancel_echoing (); ok_to_echo_at_next_pause = saved_ok_to_echo; - current_kboard->echo_string = saved_echo_string; + KVAR (current_kboard, echo_string) = saved_echo_string; current_kboard->echo_after_prompt = saved_echo_after_prompt; if (saved_immediate_echo) echo_now (); @@ -3459,7 +3459,7 @@ kbd_buffer_store_event_hold (register struct input_event *event, if (single_kboard && kb != current_kboard) { - kb->kbd_queue + KVAR (kb, kbd_queue) = Fcons (make_lispy_switch_frame (event->frame_or_window), Fcons (make_number (c), Qnil)); kb->kbd_queue_has_data = 1; @@ -5322,13 +5322,13 @@ make_lispy_event (struct input_event *event) { /* We need to use an alist rather than a vector as the cache since we can't make a vector long enuf. */ - if (NILP (current_kboard->system_key_syms)) - current_kboard->system_key_syms = Fcons (Qnil, Qnil); + if (NILP (KVAR (current_kboard, system_key_syms))) + KVAR (current_kboard, system_key_syms) = Fcons (Qnil, Qnil); return modify_event_symbol (event->code, event->modifiers, Qfunction_key, - current_kboard->Vsystem_key_alist, - 0, ¤t_kboard->system_key_syms, + KVAR (current_kboard, Vsystem_key_alist), + 0, &KVAR (current_kboard, system_key_syms), (unsigned) -1); } @@ -7360,8 +7360,8 @@ menu_bar_items (Lisp_Object old) /* Yes, use them (if non-nil) as well as the global map. */ maps = (Lisp_Object *) alloca (3 * sizeof (maps[0])); nmaps = 0; - if (!NILP (current_kboard->Voverriding_terminal_local_map)) - maps[nmaps++] = current_kboard->Voverriding_terminal_local_map; + if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) + maps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map); if (!NILP (Voverriding_local_map)) maps[nmaps++] = Voverriding_local_map; } @@ -7903,8 +7903,8 @@ tool_bar_items (Lisp_Object reuse, int *nitems) /* Yes, use them (if non-nil) as well as the global map. */ maps = (Lisp_Object *) alloca (3 * sizeof (maps[0])); nmaps = 0; - if (!NILP (current_kboard->Voverriding_terminal_local_map)) - maps[nmaps++] = current_kboard->Voverriding_terminal_local_map; + if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) + maps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map); if (!NILP (Voverriding_local_map)) maps[nmaps++] = Voverriding_local_map; } @@ -8614,18 +8614,18 @@ read_char_minibuf_menu_prompt (int commandflag, int nmaps, Lisp_Object *maps) /* Prompt with that and read response. */ message2_nolog (menu, strlen (menu), - ! NILP (current_buffer->enable_multibyte_characters)); + ! NILP (BVAR (current_buffer, enable_multibyte_characters))); /* Make believe its not a keyboard macro in case the help char is pressed. Help characters are not recorded because menu prompting is not used on replay. */ - orig_defn_macro = current_kboard->defining_kbd_macro; - current_kboard->defining_kbd_macro = Qnil; + orig_defn_macro = KVAR (current_kboard, defining_kbd_macro); + KVAR (current_kboard, defining_kbd_macro) = Qnil; do obj = read_char (commandflag, 0, 0, Qt, 0, NULL); while (BUFFERP (obj)); - current_kboard->defining_kbd_macro = orig_defn_macro; + KVAR (current_kboard, defining_kbd_macro) = orig_defn_macro; if (!INTEGERP (obj)) return obj; @@ -8638,7 +8638,7 @@ read_char_minibuf_menu_prompt (int commandflag, int nmaps, Lisp_Object *maps) && (!INTEGERP (menu_prompt_more_char) || ! EQ (obj, make_number (Ctl (XINT (menu_prompt_more_char)))))) { - if (!NILP (current_kboard->defining_kbd_macro)) + if (!NILP (KVAR (current_kboard, defining_kbd_macro))) store_kbd_macro_char (obj); return obj; } @@ -8980,7 +8980,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, /* Install the string STR as the beginning of the string of echoing, so that it serves as a prompt for the next character. */ - current_kboard->echo_string = prompt; + KVAR (current_kboard, echo_string) = prompt; current_kboard->echo_after_prompt = SCHARS (prompt); echo_now (); } @@ -9018,8 +9018,8 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, happens if we switch keyboards between rescans. */ replay_entire_sequence: - indec.map = indec.parent = current_kboard->Vinput_decode_map; - fkey.map = fkey.parent = current_kboard->Vlocal_function_key_map; + indec.map = indec.parent = KVAR (current_kboard, Vinput_decode_map); + fkey.map = fkey.parent = KVAR (current_kboard, Vlocal_function_key_map); keytran.map = keytran.parent = Vkey_translation_map; indec.start = indec.end = 0; fkey.start = fkey.end = 0; @@ -9040,7 +9040,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, the initial keymaps from the current buffer. */ nmaps = 0; - if (!NILP (current_kboard->Voverriding_terminal_local_map)) + if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) { if (2 > nmaps_allocated) { @@ -9048,7 +9048,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, defs = (Lisp_Object *) alloca (2 * sizeof (defs[0])); nmaps_allocated = 2; } - submaps[nmaps++] = current_kboard->Voverriding_terminal_local_map; + submaps[nmaps++] = KVAR (current_kboard, Voverriding_terminal_local_map); } else if (!NILP (Voverriding_local_map)) { @@ -9224,29 +9224,29 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, if (!NILP (delayed_switch_frame)) { - interrupted_kboard->kbd_queue + KVAR (interrupted_kboard, kbd_queue) = Fcons (delayed_switch_frame, - interrupted_kboard->kbd_queue); + KVAR (interrupted_kboard, kbd_queue)); delayed_switch_frame = Qnil; } while (t > 0) - interrupted_kboard->kbd_queue - = Fcons (keybuf[--t], interrupted_kboard->kbd_queue); + KVAR (interrupted_kboard, kbd_queue) + = Fcons (keybuf[--t], KVAR (interrupted_kboard, kbd_queue)); /* If the side queue is non-empty, ensure it begins with a switch-frame, so we'll replay it in the right context. */ - if (CONSP (interrupted_kboard->kbd_queue) - && (key = XCAR (interrupted_kboard->kbd_queue), + if (CONSP (KVAR (interrupted_kboard, kbd_queue)) + && (key = XCAR (KVAR (interrupted_kboard, kbd_queue)), !(EVENT_HAS_PARAMETERS (key) && EQ (EVENT_HEAD_KIND (EVENT_HEAD (key)), Qswitch_frame)))) { Lisp_Object frame; XSETFRAME (frame, interrupted_frame); - interrupted_kboard->kbd_queue + KVAR (interrupted_kboard, kbd_queue) = Fcons (make_lispy_switch_frame (frame), - interrupted_kboard->kbd_queue); + KVAR (interrupted_kboard, kbd_queue)); } mock_input = 0; orig_local_map = get_local_map (PT, current_buffer, Qlocal_map); @@ -9876,7 +9876,7 @@ read_key_sequence (Lisp_Object *keybuf, int bufsize, Lisp_Object prompt, /* Treat uppercase keys as shifted. */ || (INTEGERP (key) && (KEY_TO_CHAR (key) - < XCHAR_TABLE (current_buffer->downcase_table)->size) + < XCHAR_TABLE (BVAR (current_buffer, downcase_table))->size) && UPPERCASEP (KEY_TO_CHAR (key)))) { Lisp_Object new_key @@ -10121,9 +10121,9 @@ a special event, so ignore the prefix argument and don't clear it. */) if (NILP (special)) { - prefixarg = current_kboard->Vprefix_arg; + prefixarg = KVAR (current_kboard, Vprefix_arg); Vcurrent_prefix_arg = prefixarg; - current_kboard->Vprefix_arg = Qnil; + KVAR (current_kboard, Vprefix_arg) = Qnil; } else prefixarg = Qnil; @@ -10257,7 +10257,7 @@ give to the command you invoke, if it asks for an argument. */) UNGCPRO; function = Fintern (function, Qnil); - current_kboard->Vprefix_arg = prefixarg; + KVAR (current_kboard, Vprefix_arg) = prefixarg; Vthis_command = function; real_this_command = function; @@ -10580,7 +10580,7 @@ DEFUN ("discard-input", Fdiscard_input, Sdiscard_input, 0, 0, 0, Also end any kbd macro being defined. */) (void) { - if (!NILP (current_kboard->defining_kbd_macro)) + if (!NILP (KVAR (current_kboard, defining_kbd_macro))) { /* Discard the last command from the macro. */ Fcancel_kbd_macro_events (); @@ -11230,30 +11230,30 @@ The `posn-' functions access elements of such lists. */) void init_kboard (KBOARD *kb) { - kb->Voverriding_terminal_local_map = Qnil; - kb->Vlast_command = Qnil; - kb->Vreal_last_command = Qnil; - kb->Vkeyboard_translate_table = Qnil; - kb->Vlast_repeatable_command = Qnil; - kb->Vprefix_arg = Qnil; - kb->Vlast_prefix_arg = Qnil; - kb->kbd_queue = Qnil; + KVAR (kb, Voverriding_terminal_local_map) = Qnil; + KVAR (kb, Vlast_command) = Qnil; + KVAR (kb, Vreal_last_command) = Qnil; + KVAR (kb, Vkeyboard_translate_table) = Qnil; + KVAR (kb, Vlast_repeatable_command) = Qnil; + KVAR (kb, Vprefix_arg) = Qnil; + KVAR (kb, Vlast_prefix_arg) = Qnil; + KVAR (kb, kbd_queue) = Qnil; kb->kbd_queue_has_data = 0; kb->immediate_echo = 0; - kb->echo_string = Qnil; + KVAR (kb, echo_string) = Qnil; kb->echo_after_prompt = -1; kb->kbd_macro_buffer = 0; kb->kbd_macro_bufsize = 0; - kb->defining_kbd_macro = Qnil; - kb->Vlast_kbd_macro = Qnil; + KVAR (kb, defining_kbd_macro) = Qnil; + KVAR (kb, Vlast_kbd_macro) = Qnil; kb->reference_count = 0; - kb->Vsystem_key_alist = Qnil; - kb->system_key_syms = Qnil; - kb->Vwindow_system = Qt; /* Unset. */ - kb->Vinput_decode_map = Fmake_sparse_keymap (Qnil); - kb->Vlocal_function_key_map = Fmake_sparse_keymap (Qnil); - Fset_keymap_parent (kb->Vlocal_function_key_map, Vfunction_key_map); - kb->Vdefault_minibuffer_frame = Qnil; + KVAR (kb, Vsystem_key_alist) = Qnil; + KVAR (kb, system_key_syms) = Qnil; + KVAR (kb, Vwindow_system) = Qt; /* Unset. */ + KVAR (kb, Vinput_decode_map) = Fmake_sparse_keymap (Qnil); + KVAR (kb, Vlocal_function_key_map) = Fmake_sparse_keymap (Qnil); + Fset_keymap_parent (KVAR (kb, Vlocal_function_key_map), Vfunction_key_map); + KVAR (kb, Vdefault_minibuffer_frame) = Qnil; } /* @@ -11329,7 +11329,7 @@ init_keyboard (void) init_kboard (current_kboard); /* A value of nil for Vwindow_system normally means a tty, but we also use it for the initial terminal since there is no window system there. */ - current_kboard->Vwindow_system = Qnil; + KVAR (current_kboard, Vwindow_system) = Qnil; if (!noninteractive) { @@ -12272,23 +12272,23 @@ mark_kboards (void) if (kb->kbd_macro_buffer) for (p = kb->kbd_macro_buffer; p < kb->kbd_macro_ptr; p++) mark_object (*p); - mark_object (kb->Voverriding_terminal_local_map); - mark_object (kb->Vlast_command); - mark_object (kb->Vreal_last_command); - mark_object (kb->Vkeyboard_translate_table); - mark_object (kb->Vlast_repeatable_command); - mark_object (kb->Vprefix_arg); - mark_object (kb->Vlast_prefix_arg); - mark_object (kb->kbd_queue); - mark_object (kb->defining_kbd_macro); - mark_object (kb->Vlast_kbd_macro); - mark_object (kb->Vsystem_key_alist); - mark_object (kb->system_key_syms); - mark_object (kb->Vwindow_system); - mark_object (kb->Vinput_decode_map); - mark_object (kb->Vlocal_function_key_map); - mark_object (kb->Vdefault_minibuffer_frame); - mark_object (kb->echo_string); + mark_object (KVAR (kb, Voverriding_terminal_local_map)); + mark_object (KVAR (kb, Vlast_command)); + mark_object (KVAR (kb, Vreal_last_command)); + mark_object (KVAR (kb, Vkeyboard_translate_table)); + mark_object (KVAR (kb, Vlast_repeatable_command)); + mark_object (KVAR (kb, Vprefix_arg)); + mark_object (KVAR (kb, Vlast_prefix_arg)); + mark_object (KVAR (kb, kbd_queue)); + mark_object (KVAR (kb, defining_kbd_macro)); + mark_object (KVAR (kb, Vlast_kbd_macro)); + mark_object (KVAR (kb, Vsystem_key_alist)); + mark_object (KVAR (kb, system_key_syms)); + mark_object (KVAR (kb, Vwindow_system)); + mark_object (KVAR (kb, Vinput_decode_map)); + mark_object (KVAR (kb, Vlocal_function_key_map)); + mark_object (KVAR (kb, Vdefault_minibuffer_frame)); + mark_object (KVAR (kb, echo_string)); } { struct input_event *event; diff --git a/src/keyboard.h b/src/keyboard.h index 166b3c0e9d4..10bf16d5c5c 100644 --- a/src/keyboard.h +++ b/src/keyboard.h @@ -19,7 +19,14 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #include "systime.h" /* for EMACS_TIME */ #include "coding.h" /* for ENCODE_UTF_8 and ENCODE_SYSTEM */ -/* Length of echobuf field in each KBOARD. */ +/* Lisp fields in struct keyboard are hidden from most code and accessed + via the KVAR macro, below. Only select pieces of code, like the GC, + are allowed to use KBOARD_INTERNAL_FIELD. */ +#define KBOARD_INTERNAL_FIELD(field) field ## _ + +/* Most code should use this macro to access Lisp fields in struct + kboard. */ +#define KVAR(kboard, field) ((kboard)->KBOARD_INTERNAL_FIELD (field)) /* Each KBOARD represents one logical input stream from which Emacs gets input. If we are using ordinary terminals, it has one KBOARD @@ -72,32 +79,32 @@ struct kboard can effectively wait for input in the any-kboard state, and hence avoid blocking out the other KBOARDs. See universal-argument in lisp/simple.el for an example. */ - Lisp_Object Voverriding_terminal_local_map; + Lisp_Object KBOARD_INTERNAL_FIELD (Voverriding_terminal_local_map); /* Last command executed by the editor command loop, not counting commands that set the prefix argument. */ - Lisp_Object Vlast_command; + Lisp_Object KBOARD_INTERNAL_FIELD (Vlast_command); /* Normally same as last-command, but never modified by other commands. */ - Lisp_Object Vreal_last_command; + Lisp_Object KBOARD_INTERNAL_FIELD (Vreal_last_command); /* User-supplied table to translate input characters through. */ - Lisp_Object Vkeyboard_translate_table; + Lisp_Object KBOARD_INTERNAL_FIELD (Vkeyboard_translate_table); /* Last command that may be repeated by `repeat'. */ - Lisp_Object Vlast_repeatable_command; + Lisp_Object KBOARD_INTERNAL_FIELD (Vlast_repeatable_command); /* The prefix argument for the next command, in raw form. */ - Lisp_Object Vprefix_arg; + Lisp_Object KBOARD_INTERNAL_FIELD (Vprefix_arg); /* Saved prefix argument for the last command, in raw form. */ - Lisp_Object Vlast_prefix_arg; + Lisp_Object KBOARD_INTERNAL_FIELD (Vlast_prefix_arg); /* Unread events specific to this kboard. */ - Lisp_Object kbd_queue; + Lisp_Object KBOARD_INTERNAL_FIELD (kbd_queue); /* Non-nil while a kbd macro is being defined. */ - Lisp_Object defining_kbd_macro; + Lisp_Object KBOARD_INTERNAL_FIELD (defining_kbd_macro); /* The start of storage for the current keyboard macro. */ Lisp_Object *kbd_macro_buffer; @@ -119,28 +126,28 @@ struct kboard int kbd_macro_bufsize; /* Last anonymous kbd macro defined. */ - Lisp_Object Vlast_kbd_macro; + Lisp_Object KBOARD_INTERNAL_FIELD (Vlast_kbd_macro); /* Alist of system-specific X windows key symbols. */ - Lisp_Object Vsystem_key_alist; + Lisp_Object KBOARD_INTERNAL_FIELD (Vsystem_key_alist); /* Cache for modify_event_symbol. */ - Lisp_Object system_key_syms; + Lisp_Object KBOARD_INTERNAL_FIELD (system_key_syms); /* The kind of display: x, w32, ... */ - Lisp_Object Vwindow_system; + Lisp_Object KBOARD_INTERNAL_FIELD (Vwindow_system); /* Keymap mapping keys to alternative preferred forms. See the DEFVAR for more documentation. */ - Lisp_Object Vlocal_function_key_map; + Lisp_Object KBOARD_INTERNAL_FIELD (Vlocal_function_key_map); /* Keymap mapping ASCII function key sequences onto their preferred forms. Initialized by the terminal-specific lisp files. See the DEFVAR for more documentation. */ - Lisp_Object Vinput_decode_map; + Lisp_Object KBOARD_INTERNAL_FIELD (Vinput_decode_map); /* Minibufferless frames on this display use this frame's minibuffer. */ - Lisp_Object Vdefault_minibuffer_frame; + Lisp_Object KBOARD_INTERNAL_FIELD (Vdefault_minibuffer_frame); /* Number of displays using this KBOARD. Normally 1, but can be larger when you have multiple screens on a single X display. */ @@ -148,7 +155,7 @@ struct kboard /* The text we're echoing in the modeline - partial key sequences, usually. This is nil when not echoing. */ - Lisp_Object echo_string; + Lisp_Object KBOARD_INTERNAL_FIELD (echo_string); /* This flag indicates that events were put into kbd_queue while Emacs was running for some other KBOARD. diff --git a/src/keymap.c b/src/keymap.c index 8ee4f41bd6f..0e4715e4b8b 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -1565,8 +1565,8 @@ like in the respective argument of `key-binding'. */) if (!NILP (olp)) { - if (!NILP (current_kboard->Voverriding_terminal_local_map)) - keymaps = Fcons (current_kboard->Voverriding_terminal_local_map, keymaps); + if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) + keymaps = Fcons (KVAR (current_kboard, Voverriding_terminal_local_map), keymaps); /* The doc said that overriding-terminal-local-map should override overriding-local-map. The code used them both, but it seems clearer to use just one. rms, jan 2005. */ @@ -1745,9 +1745,9 @@ specified buffer position instead of point are used. } } - if (! NILP (current_kboard->Voverriding_terminal_local_map)) + if (! NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) { - value = Flookup_key (current_kboard->Voverriding_terminal_local_map, + value = Flookup_key (KVAR (current_kboard, Voverriding_terminal_local_map), key, accept_default); if (! NILP (value) && !INTEGERP (value)) goto done; @@ -1883,7 +1883,7 @@ bindings; see the description of `lookup-key' for more details about this. */) (Lisp_Object keys, Lisp_Object accept_default) { register Lisp_Object map; - map = current_buffer->keymap; + map = BVAR (current_buffer, keymap); if (NILP (map)) return Qnil; return Flookup_key (map, keys, accept_default); @@ -1988,7 +1988,7 @@ If KEYMAP is nil, that means no local keymap. */) if (!NILP (keymap)) keymap = get_keymap (keymap, 1, 1); - current_buffer->keymap = keymap; + BVAR (current_buffer, keymap) = keymap; return Qnil; } @@ -1998,7 +1998,7 @@ DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0, Normally the local keymap is set by the major mode with `use-local-map'. */) (void) { - return current_buffer->keymap; + return BVAR (current_buffer, keymap); } DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0, @@ -2379,7 +2379,7 @@ push_key_description (register unsigned int c, register char *p, int force_multi *p++ = 'C'; } else if (c < 128 - || (NILP (current_buffer->enable_multibyte_characters) + || (NILP (BVAR (current_buffer, enable_multibyte_characters)) && SINGLE_BYTE_CHAR_P (c) && !force_multibyte)) { @@ -2388,7 +2388,7 @@ push_key_description (register unsigned int c, register char *p, int force_multi else { /* Now we are sure that C is a valid character code. */ - if (NILP (current_buffer->enable_multibyte_characters) + if (NILP (BVAR (current_buffer, enable_multibyte_characters)) && ! force_multibyte) *p++ = multibyte_char_to_unibyte (c, Qnil); else @@ -2941,11 +2941,11 @@ You type Translation\n\ outbuf = Fcurrent_buffer (); /* Report on alternates for keys. */ - if (STRINGP (current_kboard->Vkeyboard_translate_table) && !NILP (prefix)) + if (STRINGP (KVAR (current_kboard, Vkeyboard_translate_table)) && !NILP (prefix)) { int c; - const unsigned char *translate = SDATA (current_kboard->Vkeyboard_translate_table); - int translate_len = SCHARS (current_kboard->Vkeyboard_translate_table); + const unsigned char *translate = SDATA (KVAR (current_kboard, Vkeyboard_translate_table)); + int translate_len = SCHARS (KVAR (current_kboard, Vkeyboard_translate_table)); for (c = 0; c < translate_len; c++) if (translate[c] != c) @@ -2968,7 +2968,7 @@ You type Translation\n\ insert ("\n", 1); /* Insert calls signal_after_change which may GC. */ - translate = SDATA (current_kboard->Vkeyboard_translate_table); + translate = SDATA (KVAR (current_kboard, Vkeyboard_translate_table)); } insert ("\n", 1); @@ -2981,8 +2981,8 @@ You type Translation\n\ /* Print the (major mode) local map. */ start1 = Qnil; - if (!NILP (current_kboard->Voverriding_terminal_local_map)) - start1 = current_kboard->Voverriding_terminal_local_map; + if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map))) + start1 = KVAR (current_kboard, Voverriding_terminal_local_map); else if (!NILP (Voverriding_local_map)) start1 = Voverriding_local_map; @@ -3048,7 +3048,7 @@ You type Translation\n\ XBUFFER (buffer), Qlocal_map); if (!NILP (start1)) { - if (EQ (start1, XBUFFER (buffer)->keymap)) + if (EQ (start1, BVAR (XBUFFER (buffer), keymap))) describe_map_tree (start1, 1, shadow, prefix, "\f\nMajor Mode Bindings", nomenu, 0, 0, 0); else @@ -3064,13 +3064,13 @@ You type Translation\n\ "\f\nGlobal Bindings", nomenu, 0, 1, 0); /* Print the function-key-map translations under this prefix. */ - if (!NILP (current_kboard->Vlocal_function_key_map)) - describe_map_tree (current_kboard->Vlocal_function_key_map, 0, Qnil, prefix, + if (!NILP (KVAR (current_kboard, Vlocal_function_key_map))) + describe_map_tree (KVAR (current_kboard, Vlocal_function_key_map), 0, Qnil, prefix, "\f\nFunction key map translations", nomenu, 1, 0, 0); /* Print the input-decode-map translations under this prefix. */ - if (!NILP (current_kboard->Vinput_decode_map)) - describe_map_tree (current_kboard->Vinput_decode_map, 0, Qnil, prefix, + if (!NILP (KVAR (current_kboard, Vinput_decode_map))) + describe_map_tree (KVAR (current_kboard, Vinput_decode_map), 0, Qnil, prefix, "\f\nInput decoding map translations", nomenu, 1, 0, 0); UNGCPRO; diff --git a/src/lisp.h b/src/lisp.h index 0e7eeebc9da..badeb4258fb 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1908,7 +1908,7 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int); #define DEFVAR_BUFFER_DEFAULTS(lname, vname, doc) \ do { \ static struct Lisp_Objfwd o_fwd; \ - defvar_lisp_nopro (&o_fwd, lname, &buffer_defaults.vname); \ + defvar_lisp_nopro (&o_fwd, lname, &BVAR (&buffer_defaults, vname)); \ } while (0) #define DEFVAR_KBOARD(lname, vname, doc) \ @@ -1916,7 +1916,7 @@ extern void defvar_kboard (struct Lisp_Kboard_Objfwd *, const char *, int); static struct Lisp_Kboard_Objfwd ko_fwd; \ defvar_kboard (&ko_fwd, \ lname, \ - (int)((char *)(¤t_kboard->vname) \ + (int)((char *)(¤t_kboard->vname ## _) \ - (char *)current_kboard)); \ } while (0) @@ -2073,11 +2073,11 @@ extern Lisp_Object case_temp2; /* Current buffer's map from characters to lower-case characters. */ -#define DOWNCASE_TABLE current_buffer->downcase_table +#define DOWNCASE_TABLE BVAR (current_buffer, downcase_table) /* Current buffer's map from characters to upper-case characters. */ -#define UPCASE_TABLE current_buffer->upcase_table +#define UPCASE_TABLE BVAR (current_buffer, upcase_table) /* Downcase a character, or make no change if that cannot be done. */ @@ -2171,6 +2171,11 @@ struct gcpro #define GC_MARK_STACK GC_USE_GCPROS_AS_BEFORE #endif +/* Whether we do the stack marking manually. */ +#define BYTE_MARK_STACK !(GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \ + || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS) + + #if GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS /* Do something silly with gcproN vars just so gcc shuts up. */ @@ -3282,7 +3287,9 @@ extern Lisp_Object Qbytecode; EXFUN (Fbyte_code, MANY); extern void syms_of_bytecode (void); extern struct byte_stack *byte_stack_list; +#ifdef BYTE_MARK_STACK extern void mark_byte_stack (void); +#endif extern void unmark_byte_stack (void); extern Lisp_Object exec_byte_code (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, int, Lisp_Object *); @@ -3438,11 +3445,6 @@ EXFUN (Fclear_face_cache, 1); EXFUN (Fx_load_color_file, 1); extern void syms_of_xfaces (void); -#ifndef HAVE_GETLOADAVG -/* Defined in getloadavg.c */ -extern int getloadavg (double *, int); -#endif - #ifdef HAVE_X_WINDOWS /* Defined in xfns.c */ extern void syms_of_xfns (void); diff --git a/src/lread.c b/src/lread.c index 02b2fa39075..b30a75b67c3 100644 --- a/src/lread.c +++ b/src/lread.c @@ -212,7 +212,7 @@ readchar (Lisp_Object readcharfun, int *multibyte) if (pt_byte >= BUF_ZV_BYTE (inbuffer)) return -1; - if (! NILP (inbuffer->enable_multibyte_characters)) + if (! NILP (BVAR (inbuffer, enable_multibyte_characters))) { /* Fetch the character code from the buffer. */ unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte); @@ -241,7 +241,7 @@ readchar (Lisp_Object readcharfun, int *multibyte) if (bytepos >= BUF_ZV_BYTE (inbuffer)) return -1; - if (! NILP (inbuffer->enable_multibyte_characters)) + if (! NILP (BVAR (inbuffer, enable_multibyte_characters))) { /* Fetch the character code from the buffer. */ unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos); @@ -373,7 +373,7 @@ unreadchar (Lisp_Object readcharfun, int c) EMACS_INT bytepos = BUF_PT_BYTE (b); BUF_PT (b)--; - if (! NILP (b->enable_multibyte_characters)) + if (! NILP (BVAR (b, enable_multibyte_characters))) BUF_DEC_POS (b, bytepos); else bytepos--; @@ -386,7 +386,7 @@ unreadchar (Lisp_Object readcharfun, int c) EMACS_INT bytepos = XMARKER (readcharfun)->bytepos; XMARKER (readcharfun)->charpos--; - if (! NILP (b->enable_multibyte_characters)) + if (! NILP (BVAR (b, enable_multibyte_characters))) BUF_DEC_POS (b, bytepos); else bytepos--; @@ -1375,7 +1375,9 @@ If SUFFIXES is non-nil, it should be a list of suffixes to append to file name when searching. If non-nil, PREDICATE is used instead of `file-readable-p'. PREDICATE can also be an integer to pass to the access(2) function, -in which case file-name-handlers are ignored. */) +in which case file-name-handlers are ignored. +This function will normally skip directories, so if you want it to find +directories, make sure the PREDICATE function returns `dir-ok' for them. */) (Lisp_Object filename, Lisp_Object path, Lisp_Object suffixes, Lisp_Object predicate) { Lisp_Object file; @@ -1385,6 +1387,7 @@ in which case file-name-handlers are ignored. */) return file; } +static Lisp_Object Qdir_ok; /* Search for a file whose name is STR, looking in directories in the Lisp list PATH, and trying suffixes from SUFFIX. @@ -1447,7 +1450,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto /* Of course, this could conceivably lose if luser sets default-directory to be something non-absolute... */ { - filename = Fexpand_file_name (filename, current_buffer->directory); + filename = Fexpand_file_name (filename, BVAR (current_buffer, directory)); if (!complete_filename_p (filename)) /* Give up on this path element! */ continue; @@ -1502,9 +1505,12 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto if (NILP (predicate)) exists = !NILP (Ffile_readable_p (string)); else - exists = !NILP (call1 (predicate, string)); - if (exists && !NILP (Ffile_directory_p (string))) - exists = 0; + { + Lisp_Object tmp = call1 (predicate, string); + exists = !NILP (tmp) + && (EQ (tmp, Qdir_ok) + || !NILP (Ffile_directory_p (string))); + } if (exists) { @@ -1714,7 +1720,7 @@ readevalloop (Lisp_Object readcharfun, { int count1 = SPECPDL_INDEX (); - if (b != 0 && NILP (b->name)) + if (b != 0 && NILP (BVAR (b, name))) error ("Reading from killed buffer"); if (!NILP (start)) @@ -1854,7 +1860,7 @@ This function preserves the position of point. */) tem = printflag; if (NILP (filename)) - filename = XBUFFER (buf)->filename; + filename = BVAR (XBUFFER (buf), filename); specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list)); specbind (Qstandard_output, tem); @@ -1897,7 +1903,7 @@ This function does not move point. */) specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list)); /* readevalloop calls functions which check the type of start and end. */ - readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, + readevalloop (cbuf, 0, BVAR (XBUFFER (cbuf), filename), !NILP (printflag), Qnil, read_function, start, end); @@ -4542,6 +4548,9 @@ This variable is automatically set from the file variables of an interpreted Qfile_truename = intern_c_string ("file-truename"); staticpro (&Qfile_truename) ; + Qdir_ok = intern_c_string ("dir-ok"); + staticpro (&Qdir_ok); + Qdo_after_load_evaluation = intern_c_string ("do-after-load-evaluation"); staticpro (&Qdo_after_load_evaluation) ; diff --git a/src/m/alpha.h b/src/m/alpha.h index 9ae089bfc5b..3a27cfd65d9 100644 --- a/src/m/alpha.h +++ b/src/m/alpha.h @@ -29,12 +29,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* __alpha defined automatically */ -/* Data type of load average, as read out of kmem. */ -#define LOAD_AVE_TYPE long - -/* Convert that into an integer that is 100 for a load average of 1.0 */ -#define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) - #ifdef __ELF__ #if !defined(GNU_LINUX) && !defined(__NetBSD__) @@ -57,4 +51,3 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ Define DBL_MIN_REPLACEMENT to be the next value larger than DBL_MIN: this avoids the assembler bug. */ #define DBL_MIN_REPLACEMENT 2.2250738585072019e-308 - diff --git a/src/m/amdx86-64.h b/src/m/amdx86-64.h index 2ae5d07390f..441f41b4444 100644 --- a/src/m/amdx86-64.h +++ b/src/m/amdx86-64.h @@ -30,12 +30,5 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #define EMACS_INT long #define EMACS_UINT unsigned long -/* Data type of load average, as read out of kmem. */ -#define LOAD_AVE_TYPE long - -/* Convert that into an integer that is 100 for a load average of 1.0 */ -#define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) - /* Define XPNTR to avoid or'ing with DATA_SEG_BITS */ #undef DATA_SEG_BITS - diff --git a/src/m/ia64.h b/src/m/ia64.h index 48ba3005cd6..101d56e648b 100644 --- a/src/m/ia64.h +++ b/src/m/ia64.h @@ -30,12 +30,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #define EMACS_INT long #define EMACS_UINT unsigned long -/* Data type of load average, as read out of kmem. */ -#define LOAD_AVE_TYPE long - -/* Convert that into an integer that is 100 for a load average of 1.0 */ -#define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) - #ifdef REL_ALLOC #ifndef _MALLOC_INTERNAL /* "char *" because ralloc.c defines it that way. gmalloc.c thinks it @@ -45,4 +39,3 @@ extern char *r_alloc (), *r_re_alloc (); extern void r_alloc_free (); #endif /* not _MALLOC_INTERNAL */ #endif /* REL_ALLOC */ - diff --git a/src/m/ibms390.h b/src/m/ibms390.h index f2aef1ba513..c309035dc5c 100644 --- a/src/m/ibms390.h +++ b/src/m/ibms390.h @@ -18,12 +18,6 @@ You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ -/* Data type of load average, as read out of kmem. */ -#define LOAD_AVE_TYPE long - -/* Convert that into an integer that is 100 for a load average of 1.0 */ -#define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) - /* Define VIRT_ADDR_VARIES if the virtual addresses of pure and impure space as loaded can vary, and even their relative order cannot be relied on. @@ -31,4 +25,3 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ Otherwise Emacs assumes that text space precedes data space, numerically. */ #define VIRT_ADDR_VARIES - diff --git a/src/m/macppc.h b/src/m/macppc.h index 5d78e39bdba..aef781e2c39 100644 --- a/src/m/macppc.h +++ b/src/m/macppc.h @@ -17,15 +17,8 @@ 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/>. */ -/* Data type of load average, as read out of kmem. */ -#define LOAD_AVE_TYPE long - -/* Convert that into an integer that is 100 for a load average of 1.0 */ -#define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) - #ifdef _ARCH_PPC64 #ifndef _LP64 #define _LP64 #endif #endif - diff --git a/src/m/sparc.h b/src/m/sparc.h index 50e56f0f3dc..99668043f30 100644 --- a/src/m/sparc.h +++ b/src/m/sparc.h @@ -19,12 +19,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* __sparc__ is defined by the compiler by default. */ -/* Data type of load average, as read out of kmem. */ -#define LOAD_AVE_TYPE long - -/* Convert that into an integer that is 100 for a load average of 1.0 */ -#define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) - #ifdef __arch64__ /* GCC, 64-bit ABI. */ #define BITS_PER_LONG 64 @@ -34,4 +28,3 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #endif #endif /* __arch64__ */ - diff --git a/src/m/template.h b/src/m/template.h index f06f62b6cda..54fb0da9521 100644 --- a/src/m/template.h +++ b/src/m/template.h @@ -21,12 +21,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ does not define it automatically. Ones defined so far include m68k and many others */ -/* Data type of load average, as read out of kmem. */ -#define LOAD_AVE_TYPE long - -/* Convert that into an integer that is 100 for a load average of 1.0 */ -#define LOAD_AVE_CVT(x) (int) (((double) (x)) * 100.0 / FSCALE) - /* Define VIRT_ADDR_VARIES if the virtual addresses of pure and impure space as loaded can vary, and even their relative order cannot be relied on. @@ -46,4 +40,3 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ If you've just fixed a problem in an existing configuration file, you should also check `etc/MACHINES' to make sure its descriptions of known problems in that configuration should be updated. */ - diff --git a/src/m/vax.h b/src/m/vax.h index 2fecf17ca84..a375600cead 100644 --- a/src/m/vax.h +++ b/src/m/vax.h @@ -20,14 +20,4 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* #define vax -- appears to be done automatically */ -/* USG systems I know of running on Vaxes do not actually - support the load average, so disable it for them. */ - -/* Data type of load average, as read out of kmem. */ -#define LOAD_AVE_TYPE double - -/* Convert that into an integer that is 100 for a load average of 1.0 */ -#define LOAD_AVE_CVT(x) ((int) ((x) * 100.0)) - #define HAVE_FTIME - diff --git a/src/macros.c b/src/macros.c index 34ac08c3284..d90b31b503f 100644 --- a/src/macros.c +++ b/src/macros.c @@ -56,7 +56,7 @@ If optional second arg, NO-EXEC, is non-nil, do not re-execute last macro before appending to it. */) (Lisp_Object append, Lisp_Object no_exec) { - if (!NILP (current_kboard->defining_kbd_macro)) + if (!NILP (KVAR (current_kboard, defining_kbd_macro))) error ("Already defining kbd macro"); if (!current_kboard->kbd_macro_buffer) @@ -85,9 +85,9 @@ macro before appending to it. */) int cvt; /* Check the type of last-kbd-macro in case Lisp code changed it. */ - CHECK_VECTOR_OR_STRING (current_kboard->Vlast_kbd_macro); + CHECK_VECTOR_OR_STRING (KVAR (current_kboard, Vlast_kbd_macro)); - len = XINT (Flength (current_kboard->Vlast_kbd_macro)); + len = XINT (Flength (KVAR (current_kboard, Vlast_kbd_macro))); /* Copy last-kbd-macro into the buffer, in case the Lisp code has put another macro there. */ @@ -100,11 +100,11 @@ macro before appending to it. */) } /* Must convert meta modifier when copying string to vector. */ - cvt = STRINGP (current_kboard->Vlast_kbd_macro); + cvt = STRINGP (KVAR (current_kboard, Vlast_kbd_macro)); for (i = 0; i < len; i++) { Lisp_Object c; - c = Faref (current_kboard->Vlast_kbd_macro, make_number (i)); + c = Faref (KVAR (current_kboard, Vlast_kbd_macro), make_number (i)); if (cvt && NATNUMP (c) && (XFASTINT (c) & 0x80)) XSETFASTINT (c, CHAR_META | (XFASTINT (c) & ~0x80)); current_kboard->kbd_macro_buffer[i] = c; @@ -116,12 +116,12 @@ macro before appending to it. */) /* Re-execute the macro we are appending to, for consistency of behavior. */ if (NILP (no_exec)) - Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, + Fexecute_kbd_macro (KVAR (current_kboard, Vlast_kbd_macro), make_number (1), Qnil); message ("Appending to kbd macro..."); } - current_kboard->defining_kbd_macro = Qt; + KVAR (current_kboard, defining_kbd_macro) = Qt; return Qnil; } @@ -131,9 +131,9 @@ macro before appending to it. */) void end_kbd_macro (void) { - current_kboard->defining_kbd_macro = Qnil; + KVAR (current_kboard, defining_kbd_macro) = Qnil; update_mode_lines++; - current_kboard->Vlast_kbd_macro + KVAR (current_kboard, Vlast_kbd_macro) = make_event_array ((current_kboard->kbd_macro_end - current_kboard->kbd_macro_buffer), current_kboard->kbd_macro_buffer); @@ -154,7 +154,7 @@ In Lisp, optional second arg LOOPFUNC may be a function that is called prior to each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */) (Lisp_Object repeat, Lisp_Object loopfunc) { - if (NILP (current_kboard->defining_kbd_macro)) + if (NILP (KVAR (current_kboard, defining_kbd_macro))) error ("Not defining kbd macro"); if (NILP (repeat)) @@ -162,19 +162,19 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */) else CHECK_NUMBER (repeat); - if (!NILP (current_kboard->defining_kbd_macro)) + if (!NILP (KVAR (current_kboard, defining_kbd_macro))) { end_kbd_macro (); message ("Keyboard macro defined"); } if (XFASTINT (repeat) == 0) - Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, repeat, loopfunc); + Fexecute_kbd_macro (KVAR (current_kboard, Vlast_kbd_macro), repeat, loopfunc); else { XSETINT (repeat, XINT (repeat)-1); if (XINT (repeat) > 0) - Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, repeat, loopfunc); + Fexecute_kbd_macro (KVAR (current_kboard, Vlast_kbd_macro), repeat, loopfunc); } return Qnil; } @@ -186,7 +186,7 @@ store_kbd_macro_char (Lisp_Object c) { struct kboard *kb = current_kboard; - if (!NILP (kb->defining_kbd_macro)) + if (!NILP (KVAR (kb, defining_kbd_macro))) { if (kb->kbd_macro_ptr - kb->kbd_macro_buffer == kb->kbd_macro_bufsize) { @@ -248,21 +248,21 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */) { /* Don't interfere with recognition of the previous command from before this macro started. */ - Vthis_command = current_kboard->Vlast_command; + Vthis_command = KVAR (current_kboard, Vlast_command); /* C-x z after the macro should repeat the macro. */ - real_this_command = current_kboard->Vlast_kbd_macro; + real_this_command = KVAR (current_kboard, Vlast_kbd_macro); - if (! NILP (current_kboard->defining_kbd_macro)) + if (! NILP (KVAR (current_kboard, defining_kbd_macro))) error ("Can't execute anonymous macro while defining one"); - else if (NILP (current_kboard->Vlast_kbd_macro)) + else if (NILP (KVAR (current_kboard, Vlast_kbd_macro))) error ("No kbd macro has been defined"); else - Fexecute_kbd_macro (current_kboard->Vlast_kbd_macro, prefix, loopfunc); + Fexecute_kbd_macro (KVAR (current_kboard, Vlast_kbd_macro), prefix, loopfunc); /* command_loop_1 sets this to nil before it returns; get back the last command within the macro so that it can be last, again, after we return. */ - Vthis_command = current_kboard->Vlast_command; + Vthis_command = KVAR (current_kboard, Vlast_command); return Qnil; } @@ -322,7 +322,7 @@ each iteration of the macro. Iteration stops if LOOPFUNC returns nil. */) executing_kbd_macro = final; executing_kbd_macro_index = 0; - current_kboard->Vprefix_arg = Qnil; + KVAR (current_kboard, Vprefix_arg) = Qnil; if (!NILP (loopfunc)) { diff --git a/src/makefile.w32-in b/src/makefile.w32-in index ce4b9f35de8..7a702fd45bf 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -72,7 +72,6 @@ OBJ1 = $(BLD)/alloc.$(O) \ $(BLD)/eval.$(O) \ $(BLD)/fileio.$(O) \ $(BLD)/filelock.$(O) \ - $(BLD)/filemode.$(O) \ $(BLD)/fns.$(O) \ $(BLD)/indent.$(O) \ $(BLD)/insdel.$(O) \ @@ -81,7 +80,6 @@ OBJ1 = $(BLD)/alloc.$(O) \ $(BLD)/lread.$(O) \ $(BLD)/macros.$(O) \ $(BLD)/marker.$(O) \ - $(BLD)/md5.$(O) \ $(BLD)/minibuf.$(O) \ $(BLD)/w32.$(O) \ $(BLD)/w32heap.$(O) \ @@ -214,14 +212,14 @@ GLOBAL_SOURCES = dosfns.c msdos.c \ cm.c term.c terminal.c xfaces.c \ emacs.c keyboard.c macros.c keymap.c sysdep.c \ buffer.c filelock.c insdel.c marker.c \ - minibuf.c fileio.c dired.c filemode.c \ + minibuf.c fileio.c dired.c \ cmds.c casetab.c casefiddle.c indent.c search.c regex.c undo.c \ alloc.c data.c doc.c editfns.c callint.c \ eval.c floatfns.c fns.c print.c lread.c \ syntax.c bytecode.c \ process.c callproc.c unexw32.c \ region-cache.c sound.c atimer.c \ - doprnt.c intervals.c textprop.c composite.c md5.c + doprnt.c intervals.c textprop.c composite.c SOME_MACHINE_OBJECTS = dosfns.o msdos.o \ xterm.o xfns.o xmenu.o xselect.o xrdb.o xsmfns.o dbusbind.o obj = $(GLOBAL_SOURCES:.c=.o) @@ -664,6 +662,7 @@ $(BLD)/dired.$(O) : \ $(SRC)/coding.h \ $(SRC)/commands.h \ $(SRC)/composite.h \ + $(EMACS_ROOT)/lib/filemode.h \ $(SRC)/ndir.h \ $(SRC)/regex.h \ $(SRC)/systime.h @@ -822,10 +821,6 @@ $(BLD)/filelock.$(O) : \ $(SRC)/composite.h \ $(SRC)/systime.h -$(BLD)/filemode.$(O) : \ - $(SRC)/filemode.c \ - $(CONFIG_H) - $(BLD)/firstfile.$(O) : \ $(SRC)/firstfile.c \ $(CONFIG_H) @@ -843,6 +838,7 @@ $(BLD)/fns.$(O) : \ $(EMACS_ROOT)/nt/inc/nl_types.h \ $(EMACS_ROOT)/nt/inc/unistd.h \ $(EMACS_ROOT)/nt/inc/sys/time.h \ + $(EMACS_ROOT)/lib/md5.h \ $(LISP_H) \ $(SRC)/atimer.h \ $(SRC)/blockinput.h \ @@ -856,7 +852,6 @@ $(BLD)/fns.$(O) : \ $(SRC)/intervals.h \ $(SRC)/keyboard.h \ $(SRC)/keymap.h \ - $(SRC)/md5.h \ $(SRC)/systime.h \ $(SRC)/w32gui.h \ $(SRC)/window.h @@ -1135,11 +1130,6 @@ $(BLD)/marker.$(O) : \ $(SRC)/buffer.h \ $(SRC)/character.h -$(BLD)/md5.$(O) : \ - $(SRC)/md5.c \ - $(CONFIG_H) \ - $(SRC)/md5.h - $(BLD)/menu.$(O) : \ $(SRC)/menu.c \ $(CONFIG_H) \ diff --git a/src/marker.c b/src/marker.c index 1e0e1404fdb..72c564f420f 100644 --- a/src/marker.c +++ b/src/marker.c @@ -439,7 +439,7 @@ Returns nil if MARKER points into a dead buffer. */) does not preserve the buffer from being GC'd (it's weak), so markers have to be unlinked from their buffer as soon as the buffer is killed. */ - eassert (!NILP (XBUFFER (buf)->name)); + eassert (!NILP (BVAR (XBUFFER (buf), name))); return buf; } return Qnil; @@ -488,7 +488,7 @@ Returns MARKER. */) CHECK_BUFFER (buffer); b = XBUFFER (buffer); /* If buffer is dead, set marker to point nowhere. */ - if (EQ (b->name, Qnil)) + if (EQ (BVAR (b, name), Qnil)) { unchain_marker (m); return marker; @@ -563,7 +563,7 @@ set_marker_restricted (Lisp_Object marker, Lisp_Object pos, Lisp_Object buffer) CHECK_BUFFER (buffer); b = XBUFFER (buffer); /* If buffer is dead, set marker to point nowhere. */ - if (EQ (b->name, Qnil)) + if (EQ (BVAR (b, name), Qnil)) { unchain_marker (m); return marker; @@ -628,7 +628,7 @@ set_marker_both (Lisp_Object marker, Lisp_Object buffer, EMACS_INT charpos, EMAC CHECK_BUFFER (buffer); b = XBUFFER (buffer); /* If buffer is dead, set marker to point nowhere. */ - if (EQ (b->name, Qnil)) + if (EQ (BVAR (b, name), Qnil)) { unchain_marker (m); return marker; @@ -676,7 +676,7 @@ set_marker_restricted_both (Lisp_Object marker, Lisp_Object buffer, EMACS_INT ch CHECK_BUFFER (buffer); b = XBUFFER (buffer); /* If buffer is dead, set marker to point nowhere. */ - if (EQ (b->name, Qnil)) + if (EQ (BVAR (b, name), Qnil)) { unchain_marker (m); return marker; @@ -731,7 +731,7 @@ unchain_marker (register struct Lisp_Marker *marker) if (b == 0) return; - if (EQ (b->name, Qnil)) + if (EQ (BVAR (b, name), Qnil)) abort (); marker->buffer = 0; diff --git a/src/md5.c b/src/md5.c deleted file mode 100644 index 9d9d7d8f14f..00000000000 --- a/src/md5.c +++ /dev/null @@ -1,430 +0,0 @@ -/* Functions to compute MD5 message digest of files or memory blocks. - according to the definition of MD5 in RFC 1321 from April 1992. - Copyright (C) 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004, - 2005, 2006, 2007, 2010 Free Software Foundation, Inc. - - This file is part of the GNU C Library. - - The GNU C Library is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License as - published by the Free Software Foundation; either version 2 of the - License, or (at your option) any later version. - - The GNU C Library 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 the GNU C Library; see the file COPYING. If not, write to the - Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - Boston, MA 02110-1301, USA. */ - -/* Written by Ulrich Drepper <drepper@gnu.ai.mit.edu>, 1995. */ - -#ifdef HAVE_CONFIG_H -# include <config.h> -#endif - -#include <sys/types.h> - -#if STDC_HEADERS || defined _LIBC -# include <stdlib.h> -# include <string.h> -#else -# ifndef HAVE_MEMCPY -# define memcpy(d, s, n) bcopy ((s), (d), (n)) -# endif -#endif - -#ifdef _LIBC -# include <endian.h> -# if __BYTE_ORDER == __BIG_ENDIAN -# define WORDS_BIGENDIAN 1 -# endif -/* We need to keep the namespace clean so define the MD5 function - protected using leading __ . */ -# define md5_init_ctx __md5_init_ctx -# define md5_process_block __md5_process_block -# define md5_process_bytes __md5_process_bytes -# define md5_finish_ctx __md5_finish_ctx -# define md5_read_ctx __md5_read_ctx -# define md5_stream __md5_stream -# define md5_buffer __md5_buffer -#endif - -#include "md5.h" - -#ifdef WORDS_BIGENDIAN -# define SWAP(n) \ - (((n) << 24) | (((n) & 0xff00) << 8) | (((n) >> 8) & 0xff00) | ((n) >> 24)) -#else -# define SWAP(n) (n) -#endif - - -/* This array contains the bytes used to pad the buffer to the next - 64-byte boundary. (RFC 1321, 3.1: Step 1) */ -static const unsigned char fillbuf[64] = { 0x80, 0 /* , 0, 0, ... */ }; - - -/* Initialize structure containing state of computation. - (RFC 1321, 3.3: Step 3) */ -void -md5_init_ctx (struct md5_ctx *ctx) -{ - ctx->A = 0x67452301; - ctx->B = 0xefcdab89; - ctx->C = 0x98badcfe; - ctx->D = 0x10325476; - - ctx->total[0] = ctx->total[1] = 0; - ctx->buflen = 0; -} - -/* Put result from CTX in first 16 bytes following RESBUF. The result - must be in little endian byte order. - - IMPORTANT: On some systems it is required that RESBUF is correctly - aligned for a 32 bits value. */ -void * -md5_read_ctx (const struct md5_ctx *ctx, void *resbuf) -{ - ((md5_uint32 *) resbuf)[0] = SWAP (ctx->A); - ((md5_uint32 *) resbuf)[1] = SWAP (ctx->B); - ((md5_uint32 *) resbuf)[2] = SWAP (ctx->C); - ((md5_uint32 *) resbuf)[3] = SWAP (ctx->D); - - return resbuf; -} - -/* Process the remaining bytes in the internal buffer and the usual - prolog according to the standard and write the result to RESBUF. - - IMPORTANT: On some systems it is required that RESBUF is correctly - aligned for a 32 bits value. */ -void * -md5_finish_ctx (struct md5_ctx *ctx, void *resbuf) -{ - /* Take yet unprocessed bytes into account. */ - md5_uint32 bytes = ctx->buflen; - size_t pad; - - /* Now count remaining bytes. */ - ctx->total[0] += bytes; - if (ctx->total[0] < bytes) - ++ctx->total[1]; - - pad = bytes >= 56 ? 64 + 56 - bytes : 56 - bytes; - memcpy (&ctx->buffer[bytes], fillbuf, pad); - - /* Put the 64-bit file length in *bits* at the end of the buffer. */ - *(md5_uint32 *) &ctx->buffer[bytes + pad] = SWAP (ctx->total[0] << 3); - *(md5_uint32 *) &ctx->buffer[bytes + pad + 4] = SWAP ((ctx->total[1] << 3) | - (ctx->total[0] >> 29)); - - /* Process last bytes. */ - md5_process_block (ctx->buffer, bytes + pad + 8, ctx); - - return md5_read_ctx (ctx, resbuf); -} - -/* Compute MD5 message digest for bytes read from STREAM. The - resulting message digest number will be written into the 16 bytes - beginning at RESBLOCK. */ -int -md5_stream (FILE *stream, void *resblock) -{ - /* Important: BLOCKSIZE must be a multiple of 64. */ -#define BLOCKSIZE 4096 - struct md5_ctx ctx; - char buffer[BLOCKSIZE + 72]; - size_t sum; - - /* Initialize the computation context. */ - md5_init_ctx (&ctx); - - /* Iterate over full file contents. */ - while (1) - { - /* We read the file in blocks of BLOCKSIZE bytes. One call of the - computation function processes the whole buffer so that with the - next round of the loop another block can be read. */ - size_t n; - sum = 0; - - /* Read block. Take care for partial reads. */ - do - { - n = fread (buffer + sum, 1, BLOCKSIZE - sum, stream); - - sum += n; - } - while (sum < BLOCKSIZE && n != 0); - if (n == 0 && ferror (stream)) - return 1; - - /* If end of file is reached, end the loop. */ - if (n == 0) - break; - - /* Process buffer with BLOCKSIZE bytes. Note that - BLOCKSIZE % 64 == 0 - */ - md5_process_block (buffer, BLOCKSIZE, &ctx); - } - - /* Add the last bytes if necessary. */ - if (sum > 0) - md5_process_bytes (buffer, sum, &ctx); - - /* Construct result in desired memory. */ - md5_finish_ctx (&ctx, resblock); - return 0; -} - -/* Compute MD5 message digest for LEN bytes beginning at BUFFER. The - result is always in little endian byte order, so that a byte-wise - output yields to the wanted ASCII representation of the message - digest. */ -void * -md5_buffer (const char *buffer, size_t len, void *resblock) -{ - struct md5_ctx ctx; - - /* Initialize the computation context. */ - md5_init_ctx (&ctx); - - /* Process whole buffer but last len % 64 bytes. */ - md5_process_bytes (buffer, len, &ctx); - - /* Put result in desired memory area. */ - return md5_finish_ctx (&ctx, resblock); -} - - -void -md5_process_bytes (const void *buffer, size_t len, struct md5_ctx *ctx) -{ - /* const void aligned_buffer = buffer; */ - - /* When we already have some bits in our internal buffer concatenate - both inputs first. */ - if (ctx->buflen != 0) - { - size_t left_over = ctx->buflen; - size_t add = 128 - left_over > len ? len : 128 - left_over; - - /* Only put full words in the buffer. */ - add -= add % __alignof__ (md5_uint32); - - memcpy (&ctx->buffer[left_over], buffer, add); - ctx->buflen += add; - - if (ctx->buflen > 64) - { - md5_process_block (ctx->buffer, ctx->buflen & ~63, ctx); - - ctx->buflen &= 63; - /* The regions in the following copy operation cannot overlap. */ - memcpy (ctx->buffer, &ctx->buffer[(left_over + add) & ~63], - ctx->buflen); - } - - buffer = (const char *) buffer + add; - len -= add; - } - - /* Process available complete blocks. */ - if (len > 64) - { - md5_process_block (buffer, len & ~63, ctx); - buffer = (const char *) buffer + (len & ~63); - len &= 63; - } - - /* Move remaining bytes in internal buffer. */ - if (len > 0) - { - size_t left_over = ctx->buflen; - - memcpy (&ctx->buffer[left_over], buffer, len); - left_over += len; - if (left_over >= 64) - { - md5_process_block (ctx->buffer, 64, ctx); - left_over -= 64; - memcpy (ctx->buffer, &ctx->buffer[64], left_over); - } - ctx->buflen = left_over; - } -} - - -/* These are the four functions used in the four steps of the MD5 algorithm - and defined in the RFC 1321. The first function is a little bit optimized - (as found in Colin Plumbs public domain implementation). */ -/* #define FF(b, c, d) ((b & c) | (~b & d)) */ -#define FF(b, c, d) (d ^ (b & (c ^ d))) -#define FG(b, c, d) FF (d, b, c) -#define FH(b, c, d) (b ^ c ^ d) -#define FI(b, c, d) (c ^ (b | ~d)) - -/* Process LEN bytes of BUFFER, accumulating context into CTX. - It is assumed that LEN % 64 == 0. */ - -void -md5_process_block (const void *buffer, size_t len, struct md5_ctx *ctx) -{ - md5_uint32 correct_words[16]; - const md5_uint32 *words = buffer; - size_t nwords = len / sizeof (md5_uint32); - const md5_uint32 *endp = words + nwords; - md5_uint32 A = ctx->A; - md5_uint32 B = ctx->B; - md5_uint32 C = ctx->C; - md5_uint32 D = ctx->D; - - /* First increment the byte count. RFC 1321 specifies the possible - length of the file up to 2^64 bits. Here we only compute the - number of bytes. Do a double word increment. */ - ctx->total[0] += len; - if (ctx->total[0] < len) - ++ctx->total[1]; - - /* Process all bytes in the buffer with 64 bytes in each round of - the loop. */ - while (words < endp) - { - md5_uint32 *cwp = correct_words; - md5_uint32 A_save = A; - md5_uint32 B_save = B; - md5_uint32 C_save = C; - md5_uint32 D_save = D; - - /* First round: using the given function, the context and a constant - the next context is computed. Because the algorithms processing - unit is a 32-bit word and it is determined to work on words in - little endian byte order we perhaps have to change the byte order - before the computation. To reduce the work for the next steps - we store the swapped words in the array CORRECT_WORDS. */ - -#define OP(a, b, c, d, s, T) \ - do \ - { \ - a += FF (b, c, d) + (*cwp++ = SWAP (*words)) + T; \ - ++words; \ - CYCLIC (a, s); \ - a += b; \ - } \ - while (0) - - /* It is unfortunate that C does not provide an operator for - cyclic rotation. Hope the C compiler is smart enough. */ -#define CYCLIC(w, s) (w = (w << s) | (w >> (32 - s))) - - /* Before we start, one word to the strange constants. - They are defined in RFC 1321 as - - T[i] = (int) (4294967296.0 * fabs (sin (i))), i=1..64 - */ - - /* Round 1. */ - OP (A, B, C, D, 7, 0xd76aa478); - OP (D, A, B, C, 12, 0xe8c7b756); - OP (C, D, A, B, 17, 0x242070db); - OP (B, C, D, A, 22, 0xc1bdceee); - OP (A, B, C, D, 7, 0xf57c0faf); - OP (D, A, B, C, 12, 0x4787c62a); - OP (C, D, A, B, 17, 0xa8304613); - OP (B, C, D, A, 22, 0xfd469501); - OP (A, B, C, D, 7, 0x698098d8); - OP (D, A, B, C, 12, 0x8b44f7af); - OP (C, D, A, B, 17, 0xffff5bb1); - OP (B, C, D, A, 22, 0x895cd7be); - OP (A, B, C, D, 7, 0x6b901122); - OP (D, A, B, C, 12, 0xfd987193); - OP (C, D, A, B, 17, 0xa679438e); - OP (B, C, D, A, 22, 0x49b40821); - - /* For the second to fourth round we have the possibly swapped words - in CORRECT_WORDS. Redefine the macro to take an additional first - argument specifying the function to use. */ -#undef OP -#define OP(f, a, b, c, d, k, s, T) \ - do \ - { \ - a += f (b, c, d) + correct_words[k] + T; \ - CYCLIC (a, s); \ - a += b; \ - } \ - while (0) - - /* Round 2. */ - OP (FG, A, B, C, D, 1, 5, 0xf61e2562); - OP (FG, D, A, B, C, 6, 9, 0xc040b340); - OP (FG, C, D, A, B, 11, 14, 0x265e5a51); - OP (FG, B, C, D, A, 0, 20, 0xe9b6c7aa); - OP (FG, A, B, C, D, 5, 5, 0xd62f105d); - OP (FG, D, A, B, C, 10, 9, 0x02441453); - OP (FG, C, D, A, B, 15, 14, 0xd8a1e681); - OP (FG, B, C, D, A, 4, 20, 0xe7d3fbc8); - OP (FG, A, B, C, D, 9, 5, 0x21e1cde6); - OP (FG, D, A, B, C, 14, 9, 0xc33707d6); - OP (FG, C, D, A, B, 3, 14, 0xf4d50d87); - OP (FG, B, C, D, A, 8, 20, 0x455a14ed); - OP (FG, A, B, C, D, 13, 5, 0xa9e3e905); - OP (FG, D, A, B, C, 2, 9, 0xfcefa3f8); - OP (FG, C, D, A, B, 7, 14, 0x676f02d9); - OP (FG, B, C, D, A, 12, 20, 0x8d2a4c8a); - - /* Round 3. */ - OP (FH, A, B, C, D, 5, 4, 0xfffa3942); - OP (FH, D, A, B, C, 8, 11, 0x8771f681); - OP (FH, C, D, A, B, 11, 16, 0x6d9d6122); - OP (FH, B, C, D, A, 14, 23, 0xfde5380c); - OP (FH, A, B, C, D, 1, 4, 0xa4beea44); - OP (FH, D, A, B, C, 4, 11, 0x4bdecfa9); - OP (FH, C, D, A, B, 7, 16, 0xf6bb4b60); - OP (FH, B, C, D, A, 10, 23, 0xbebfbc70); - OP (FH, A, B, C, D, 13, 4, 0x289b7ec6); - OP (FH, D, A, B, C, 0, 11, 0xeaa127fa); - OP (FH, C, D, A, B, 3, 16, 0xd4ef3085); - OP (FH, B, C, D, A, 6, 23, 0x04881d05); - OP (FH, A, B, C, D, 9, 4, 0xd9d4d039); - OP (FH, D, A, B, C, 12, 11, 0xe6db99e5); - OP (FH, C, D, A, B, 15, 16, 0x1fa27cf8); - OP (FH, B, C, D, A, 2, 23, 0xc4ac5665); - - /* Round 4. */ - OP (FI, A, B, C, D, 0, 6, 0xf4292244); - OP (FI, D, A, B, C, 7, 10, 0x432aff97); - OP (FI, C, D, A, B, 14, 15, 0xab9423a7); - OP (FI, B, C, D, A, 5, 21, 0xfc93a039); - OP (FI, A, B, C, D, 12, 6, 0x655b59c3); - OP (FI, D, A, B, C, 3, 10, 0x8f0ccc92); - OP (FI, C, D, A, B, 10, 15, 0xffeff47d); - OP (FI, B, C, D, A, 1, 21, 0x85845dd1); - OP (FI, A, B, C, D, 8, 6, 0x6fa87e4f); - OP (FI, D, A, B, C, 15, 10, 0xfe2ce6e0); - OP (FI, C, D, A, B, 6, 15, 0xa3014314); - OP (FI, B, C, D, A, 13, 21, 0x4e0811a1); - OP (FI, A, B, C, D, 4, 6, 0xf7537e82); - OP (FI, D, A, B, C, 11, 10, 0xbd3af235); - OP (FI, C, D, A, B, 2, 15, 0x2ad7d2bb); - OP (FI, B, C, D, A, 9, 21, 0xeb86d391); - - /* Add the starting values of the context. */ - A += A_save; - B += B_save; - C += C_save; - D += D_save; - } - - /* Put checksum in context given as argument. */ - ctx->A = A; - ctx->B = B; - ctx->C = C; - ctx->D = D; -} - diff --git a/src/md5.h b/src/md5.h deleted file mode 100644 index 8ab73050379..00000000000 --- a/src/md5.h +++ /dev/null @@ -1,148 +0,0 @@ -/* Declaration of functions and data types used for MD5 sum computing - library functions. - Copyright (C) 1995, 1996, 1997, 1999, 2000, 2001, 2002, 2003, 2004, - 2005, 2006, 2007 Free Software Foundation, Inc. - This file is part of GNU Emacs. - - The GNU C Library is free software; you can redistribute it and/or - modify it under the terms of the GNU General Public License as - published by the Free Software Foundation; either version 2 of the - License, or (at your option) any later version. - - The GNU C Library 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 the GNU C Library; see the file COPYING. If not, - write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - Boston, MA 02110-1301, USA. */ - -#ifndef _MD5_H -#define _MD5_H 1 - -#include <stdio.h> - -#if defined HAVE_LIMITS_H || _LIBC -# include <limits.h> -#endif - -/* The following contortions are an attempt to use the C preprocessor - to determine an unsigned integral type that is 32 bits wide. An - alternative approach is to use autoconf's AC_CHECK_SIZEOF macro, but - doing that would require that the configure script compile and *run* - the resulting executable. Locally running cross-compiled executables - is usually not possible. */ - -#ifdef _LIBC -# include <sys/types.h> -typedef u_int32_t md5_uint32; -#else -# if defined __STDC__ && __STDC__ -# define UINT_MAX_32_BITS 4294967295U -# else -# define UINT_MAX_32_BITS 0xFFFFFFFF -# endif - -/* If UINT_MAX isn't defined, assume it's a 32-bit type. - This should be valid for all systems GNU cares about because - that doesn't include 16-bit systems, and only modern systems - (that certainly have <limits.h>) have 64+-bit integral types. */ - -# ifndef UINT_MAX -# define UINT_MAX UINT_MAX_32_BITS -# endif - -# if UINT_MAX == UINT_MAX_32_BITS - typedef unsigned int md5_uint32; -# else -# if USHRT_MAX == UINT_MAX_32_BITS - typedef unsigned short md5_uint32; -# else -# if ULONG_MAX == UINT_MAX_32_BITS - typedef unsigned long md5_uint32; -# else - /* The following line is intended to evoke an error. - Using #error is not portable enough. */ - "Cannot determine unsigned 32-bit data type." -# endif -# endif -# endif -#endif - - -#ifndef __GNUC__ -#define __attribute__(X) -#define __alignof__(X) 1 -#endif - -/* Structure to save state of computation between the single steps. */ -struct md5_ctx -{ - md5_uint32 A; - md5_uint32 B; - md5_uint32 C; - md5_uint32 D; - - md5_uint32 total[2]; - md5_uint32 buflen; - char buffer[128] __attribute__ ((__aligned__ (__alignof__ (md5_uint32)))); -}; - -/* - * The following three functions are build up the low level used in - * the functions `md5_stream' and `md5_buffer'. - */ - -/* Initialize structure containing state of computation. - (RFC 1321, 3.3: Step 3) */ -extern void md5_init_ctx (struct md5_ctx *ctx); - -/* Starting with the result of former calls of this function (or the - initialization function update the context for the next LEN bytes - starting at BUFFER. - It is necessary that LEN is a multiple of 64!!! */ -extern void md5_process_block (const void *buffer, size_t len, - struct md5_ctx *ctx); - -/* Starting with the result of former calls of this function (or the - initialization function update the context for the next LEN bytes - starting at BUFFER. - It is NOT required that LEN is a multiple of 64. */ -extern void md5_process_bytes (const void *buffer, size_t len, - struct md5_ctx *ctx); - -/* Process the remaining bytes in the buffer and put result from CTX - in first 16 bytes following RESBUF. The result is always in little - endian byte order, so that a byte-wise output yields to the wanted - ASCII representation of the message digest. - - IMPORTANT: On some systems it is required that RESBUF is correctly - aligned for a 32 bits value. */ -extern void *md5_finish_ctx (struct md5_ctx *ctx, void *resbuf); - - -/* Put result from CTX in first 16 bytes following RESBUF. The result is - always in little endian byte order, so that a byte-wise output yields - to the wanted ASCII representation of the message digest. - - IMPORTANT: On some systems it is required that RESBUF is correctly - aligned for a 32 bits value. */ -extern void *md5_read_ctx (const struct md5_ctx *ctx, void *resbuf); - - -/* Compute MD5 message digest for bytes read from STREAM. The - resulting message digest number will be written into the 16 bytes - beginning at RESBLOCK. */ -extern int md5_stream (FILE *stream, void *resblock); - -/* Compute MD5 message digest for LEN bytes beginning at BUFFER. The - result is always in little endian byte order, so that a byte-wise - output yields to the wanted ASCII representation of the message - digest. */ -extern void *md5_buffer (const char *buffer, size_t len, - void *resblock); - -#endif /* md5.h */ - diff --git a/src/minibuf.c b/src/minibuf.c index 67b4e824561..9852900b60b 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -415,7 +415,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, CHECK_STRING (initial); } val = Qnil; - ambient_dir = current_buffer->directory; + ambient_dir = BVAR (current_buffer, directory); input_method = Qnil; enable_multibyte = Qnil; @@ -525,7 +525,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, /* `current-input-method' is buffer local. So, remember it in INPUT_METHOD before changing the current buffer. */ input_method = Fsymbol_value (Qcurrent_input_method); - enable_multibyte = current_buffer->enable_multibyte_characters; + enable_multibyte = BVAR (current_buffer, enable_multibyte_characters); } /* Switch to the minibuffer. */ @@ -535,7 +535,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, /* If appropriate, copy enable-multibyte-characters into the minibuffer. */ if (inherit_input_method) - current_buffer->enable_multibyte_characters = enable_multibyte; + BVAR (current_buffer, enable_multibyte_characters) = enable_multibyte; /* The current buffer's default directory is usually the right thing for our minibuffer here. However, if you're typing a command at @@ -546,7 +546,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, you think of something better to do? Find another buffer with a better directory, and use that one instead. */ if (STRINGP (ambient_dir)) - current_buffer->directory = ambient_dir; + BVAR (current_buffer, directory) = ambient_dir; else { Lisp_Object buf_list; @@ -558,9 +558,9 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, Lisp_Object other_buf; other_buf = XCDR (XCAR (buf_list)); - if (STRINGP (XBUFFER (other_buf)->directory)) + if (STRINGP (BVAR (XBUFFER (other_buf), directory))) { - current_buffer->directory = XBUFFER (other_buf)->directory; + BVAR (current_buffer, directory) = BVAR (XBUFFER (other_buf), directory); break; } } @@ -603,7 +603,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, specbind (Qinhibit_modification_hooks, Qt); Ferase_buffer (); - if (!NILP (current_buffer->enable_multibyte_characters) + if (!NILP (BVAR (current_buffer, enable_multibyte_characters)) && ! STRING_MULTIBYTE (minibuf_prompt)) minibuf_prompt = Fstring_make_multibyte (minibuf_prompt); @@ -633,7 +633,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, } clear_message (1, 1); - current_buffer->keymap = map; + BVAR (current_buffer, keymap) = map; /* Turn on an input method stored in INPUT_METHOD if any. */ if (STRINGP (input_method) && !NILP (Ffboundp (Qactivate_input_method))) @@ -647,7 +647,7 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, call1 (Vrun_hooks, Qminibuffer_setup_hook); /* Don't allow the user to undo past this point. */ - current_buffer->undo_list = Qnil; + BVAR (current_buffer, undo_list) = Qnil; recursive_edit_1 (); @@ -764,7 +764,7 @@ get_minibuffer (int depth) Vminibuffer_list = nconc2 (Vminibuffer_list, tail); } buf = Fcar (tail); - if (NILP (buf) || NILP (XBUFFER (buf)->name)) + if (NILP (buf) || NILP (BVAR (XBUFFER (buf), name))) { sprintf (name, " *Minibuf-%d*", depth); buf = Fget_buffer_create (build_string (name)); @@ -1097,7 +1097,7 @@ function, instead of the usual behavior. */) int count = SPECPDL_INDEX (); if (BUFFERP (def)) - def = XBUFFER (def)->name; + def = BVAR (XBUFFER (def), name); specbind (Qcompletion_ignore_case, read_buffer_completion_ignore_case ? Qt : Qnil); diff --git a/src/msdos.c b/src/msdos.c index eb73f54838d..8f0f6776aaa 100644 --- a/src/msdos.c +++ b/src/msdos.c @@ -1317,12 +1317,12 @@ IT_frame_up_to_date (struct frame *f) { struct buffer *b = XBUFFER (sw->buffer); - if (EQ (b->cursor_type, Qt)) + if (EQ (BVAR (b,cursor_type), Qt)) new_cursor = frame_desired_cursor; - else if (NILP (b->cursor_type)) /* nil means no cursor */ + else if (NILP (BVAR (b, cursor_type))) /* nil means no cursor */ new_cursor = Fcons (Qbar, make_number (0)); else - new_cursor = b->cursor_type; + new_cursor = BVAR (b, cursor_type); } IT_set_cursor_type (f, new_cursor); @@ -1793,7 +1793,7 @@ internal_terminal_init (void) } tty = FRAME_TTY (sf); - current_kboard->Vwindow_system = Qpc; + KVAR (current_kboard, Vwindow_system) = Qpc; sf->output_method = output_msdos_raw; if (init_needed) { diff --git a/src/nsfns.m b/src/nsfns.m index f1bf8b65727..6a5adbd7bf3 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -605,8 +605,8 @@ ns_set_name_as_filename (struct frame *f) BLOCK_INPUT; pool = [[NSAutoreleasePool alloc] init]; - filename = XBUFFER (buf)->filename; - name = XBUFFER (buf)->name; + filename = BVAR (XBUFFER (buf), filename); + name = BVAR (XBUFFER (buf), name); if (NILP (name)) { @@ -1329,9 +1329,9 @@ be shared by the new frame. */) } if (FRAME_HAS_MINIBUF_P (f) - && (!FRAMEP (kb->Vdefault_minibuffer_frame) - || !FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame)))) - kb->Vdefault_minibuffer_frame = frame; + && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame)) + || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))) + KVAR (kb, Vdefault_minibuffer_frame) = frame; /* All remaining specified parameters, which have not been "used" by x_get_arg and friends, now go in the misc. alist of the frame. */ @@ -1428,7 +1428,7 @@ Optional arg INIT, if non-nil, provides a default file name to use. */) NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil : [NSString stringWithUTF8String: SDATA (prompt)]; NSString *dirS = NILP (dir) || !STRINGP (dir) ? - [NSString stringWithUTF8String: SDATA (current_buffer->directory)] : + [NSString stringWithUTF8String: SDATA (BVAR (current_buffer, directory))] : [NSString stringWithUTF8String: SDATA (dir)]; NSString *initS = NILP (init) || !STRINGP (init) ? nil : [NSString stringWithUTF8String: SDATA (init)]; diff --git a/src/nsterm.m b/src/nsterm.m index e83b14748df..a09c95c7d01 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -3762,7 +3762,7 @@ ns_term_init (Lisp_Object display_name) terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD)); init_kboard (terminal->kboard); - terminal->kboard->Vwindow_system = Qns; + KVAR (terminal->kboard, Vwindow_system) = Qns; terminal->kboard->next_kboard = all_kboards; all_kboards = terminal->kboard; /* Don't let the initial kboard remain current longer than necessary. @@ -5783,6 +5783,7 @@ ns_term_shutdown (int sig) win = nwin; condemned = NO; pixel_height = NSHeight (r); + if (pixel_height == 0) pixel_height = 1; min_portion = 20 / pixel_height; frame = XFRAME (XWINDOW (win)->frame); @@ -5812,6 +5813,7 @@ ns_term_shutdown (int sig) NSTRACE (EmacsScroller_setFrame); /* BLOCK_INPUT; */ pixel_height = NSHeight (newRect); + if (pixel_height == 0) pixel_height = 1; min_portion = 20 / pixel_height; [super setFrame: newRect]; [self display]; diff --git a/src/print.c b/src/print.c index f48b618775d..11bce153ffc 100644 --- a/src/print.c +++ b/src/print.c @@ -111,7 +111,7 @@ int print_output_debug_flag EXTERNALLY_VISIBLE = 1; EMACS_INT old_point_byte = -1, start_point_byte = -1; \ int specpdl_count = SPECPDL_INDEX (); \ int free_print_buffer = 0; \ - int multibyte = !NILP (current_buffer->enable_multibyte_characters); \ + int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); \ Lisp_Object original #define PRINTPREPARE \ @@ -144,10 +144,10 @@ int print_output_debug_flag EXTERNALLY_VISIBLE = 1; if (NILP (printcharfun)) \ { \ Lisp_Object string; \ - if (NILP (current_buffer->enable_multibyte_characters) \ + if (NILP (BVAR (current_buffer, enable_multibyte_characters)) \ && ! print_escape_multibyte) \ specbind (Qprint_escape_multibyte, Qt); \ - if (! NILP (current_buffer->enable_multibyte_characters) \ + if (! NILP (BVAR (current_buffer, enable_multibyte_characters)) \ && ! print_escape_nonascii) \ specbind (Qprint_escape_nonascii, Qt); \ if (print_buffer != 0) \ @@ -173,7 +173,7 @@ int print_output_debug_flag EXTERNALLY_VISIBLE = 1; if (NILP (printcharfun)) \ { \ if (print_buffer_pos != print_buffer_pos_byte \ - && NILP (current_buffer->enable_multibyte_characters)) \ + && NILP (BVAR (current_buffer, enable_multibyte_characters))) \ { \ unsigned char *temp \ = (unsigned char *) alloca (print_buffer_pos + 1); \ @@ -250,7 +250,7 @@ printchar (unsigned int ch, Lisp_Object fun) else { int multibyte_p - = !NILP (current_buffer->enable_multibyte_characters); + = !NILP (BVAR (current_buffer, enable_multibyte_characters)); setup_echo_area_for_printing (multibyte_p); insert_char (ch); @@ -302,7 +302,7 @@ strout (const char *ptr, EMACS_INT size, EMACS_INT size_byte, job. */ int i; int multibyte_p - = !NILP (current_buffer->enable_multibyte_characters); + = !NILP (BVAR (current_buffer, enable_multibyte_characters)); setup_echo_area_for_printing (multibyte_p); message_dolog (ptr, size_byte, 0, multibyte_p); @@ -371,8 +371,8 @@ print_string (Lisp_Object string, Lisp_Object printcharfun) chars = SCHARS (string); else if (! print_escape_nonascii && (EQ (printcharfun, Qt) - ? ! NILP (buffer_defaults.enable_multibyte_characters) - : ! NILP (current_buffer->enable_multibyte_characters))) + ? ! NILP (BVAR (&buffer_defaults, enable_multibyte_characters)) + : ! NILP (BVAR (current_buffer, enable_multibyte_characters)))) { /* If unibyte string STRING contains 8-bit codes, we must convert STRING to a multibyte string containing the same @@ -504,14 +504,14 @@ temp_output_buffer_setup (const char *bufname) Fkill_all_local_variables (); delete_all_overlays (current_buffer); - current_buffer->directory = old->directory; - current_buffer->read_only = Qnil; - current_buffer->filename = Qnil; - current_buffer->undo_list = Qt; + BVAR (current_buffer, directory) = BVAR (old, directory); + BVAR (current_buffer, read_only) = Qnil; + BVAR (current_buffer, filename) = Qnil; + BVAR (current_buffer, undo_list) = Qt; eassert (current_buffer->overlays_before == NULL); eassert (current_buffer->overlays_after == NULL); - current_buffer->enable_multibyte_characters - = buffer_defaults.enable_multibyte_characters; + BVAR (current_buffer, enable_multibyte_characters) + = BVAR (&buffer_defaults, enable_multibyte_characters); specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); Ferase_buffer (); @@ -1009,7 +1009,10 @@ float_to_string (char *buf, double data) { /* Generate the fewest number of digits that represent the floating point value without losing information. */ - dtoastr (buf, FLOAT_TO_STRING_BUFSIZE, 0, 0, data); + dtoastr (buf, FLOAT_TO_STRING_BUFSIZE - 2, 0, 0, data); + /* The decimal point must be printed, or the byte compiler can + get confused (Bug#8033). */ + width = 1; } else /* oink oink */ { @@ -1064,8 +1067,7 @@ float_to_string (char *buf, double data) cp[1] = '0'; cp[2] = 0; } - - if (*cp == 0) + else if (*cp == 0) { *cp++ = '.'; *cp++ = '0'; @@ -1801,7 +1803,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag if (!NILP (XWINDOW (obj)->buffer)) { strout (" on ", -1, -1, printcharfun, 0); - print_string (XBUFFER (XWINDOW (obj)->buffer)->name, printcharfun); + print_string (BVAR (XBUFFER (XWINDOW (obj)->buffer), name), printcharfun); } PRINTCHAR ('>'); } @@ -1902,16 +1904,16 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag } else if (BUFFERP (obj)) { - if (NILP (XBUFFER (obj)->name)) + if (NILP (BVAR (XBUFFER (obj), name))) strout ("#<killed buffer>", -1, -1, printcharfun, 0); else if (escapeflag) { strout ("#<buffer ", -1, -1, printcharfun, 0); - print_string (XBUFFER (obj)->name, printcharfun); + print_string (BVAR (XBUFFER (obj), name), printcharfun); PRINTCHAR ('>'); } else - print_string (XBUFFER (obj)->name, printcharfun); + print_string (BVAR (XBUFFER (obj), name), printcharfun); } else if (WINDOW_CONFIGURATIONP (obj)) { @@ -2023,7 +2025,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag sprintf (buf, "at %ld", (long)marker_position (obj)); strout (buf, -1, -1, printcharfun, 0); strout (" in ", -1, -1, printcharfun, 0); - print_string (XMARKER (obj)->buffer->name, printcharfun); + print_string (BVAR (XMARKER (obj)->buffer, name), printcharfun); } PRINTCHAR ('>'); break; @@ -2038,7 +2040,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag (long)marker_position (OVERLAY_START (obj)), (long)marker_position (OVERLAY_END (obj))); strout (buf, -1, -1, printcharfun, 0); - print_string (XMARKER (OVERLAY_START (obj))->buffer->name, + print_string (BVAR (XMARKER (OVERLAY_START (obj))->buffer, name), printcharfun); } PRINTCHAR ('>'); diff --git a/src/process.c b/src/process.c index 80e70e49f8e..210287a85f1 100644 --- a/src/process.c +++ b/src/process.c @@ -719,7 +719,7 @@ get_process (register Lisp_Object name) { proc = Fget_buffer_process (obj); if (NILP (proc)) - error ("Buffer %s has no process", SDATA (XBUFFER (obj)->name)); + error ("Buffer %s has no process", SDATA (BVAR (XBUFFER (obj), name))); } else { @@ -1283,12 +1283,12 @@ list_processes_1 (Lisp_Object query_only) w_proc = i; if (!NILP (p->buffer)) { - if (NILP (XBUFFER (p->buffer)->name)) + if (NILP (BVAR (XBUFFER (p->buffer), name))) { if (w_buffer < 8) w_buffer = 8; /* (Killed) */ } - else if ((i = SCHARS (XBUFFER (p->buffer)->name), (i > w_buffer))) + else if ((i = SCHARS (BVAR (XBUFFER (p->buffer), name)), (i > w_buffer))) w_buffer = i; } if (STRINGP (p->tty_name) @@ -1312,9 +1312,9 @@ list_processes_1 (Lisp_Object query_only) XSETFASTINT (minspace, 1); set_buffer_internal (XBUFFER (Vstandard_output)); - current_buffer->undo_list = Qt; + BVAR (current_buffer, undo_list) = Qt; - current_buffer->truncate_lines = Qt; + BVAR (current_buffer, truncate_lines) = Qt; write_string ("Proc", -1); Findent_to (i_status, minspace); write_string ("Status", -1); @@ -1397,10 +1397,10 @@ list_processes_1 (Lisp_Object query_only) Findent_to (i_buffer, minspace); if (NILP (p->buffer)) insert_string ("(none)"); - else if (NILP (XBUFFER (p->buffer)->name)) + else if (NILP (BVAR (XBUFFER (p->buffer), name))) insert_string ("(Killed)"); else - Finsert (1, &XBUFFER (p->buffer)->name); + Finsert (1, &BVAR (XBUFFER (p->buffer), name)); if (!NILP (i_tty)) { @@ -1548,7 +1548,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) { struct gcpro gcpro1, gcpro2; - current_dir = current_buffer->directory; + current_dir = BVAR (current_buffer, directory); GCPRO2 (buffer, current_dir); @@ -1560,7 +1560,7 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) current_dir = expand_and_dir_to_file (current_dir, Qnil); if (NILP (Ffile_accessible_directory_p (current_dir))) report_file_error ("Setting current directory", - Fcons (current_buffer->directory, Qnil)); + Fcons (BVAR (current_buffer, directory), Qnil)); UNGCPRO; } @@ -1660,9 +1660,9 @@ usage: (start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS) */) } - XPROCESS (proc)->decoding_buf = make_uninit_string (0); + XPROCESS (proc)->decoding_buf = empty_unibyte_string; XPROCESS (proc)->decoding_carryover = 0; - XPROCESS (proc)->encoding_buf = make_uninit_string (0); + XPROCESS (proc)->encoding_buf = empty_unibyte_string; XPROCESS (proc)->inherit_coding_system_flag = !(NILP (buffer) || !inherit_process_coding_system); @@ -1786,6 +1786,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) sigset_t blocked; struct sigaction sigint_action; struct sigaction sigquit_action; + struct sigaction sigpipe_action; #ifdef AIX struct sigaction sighup_action; #endif @@ -1898,6 +1899,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) and record the current handlers so they can be restored later. */ sigaddset (&blocked, SIGINT ); sigaction (SIGINT , 0, &sigint_action ); sigaddset (&blocked, SIGQUIT); sigaction (SIGQUIT, 0, &sigquit_action); + sigaddset (&blocked, SIGPIPE); sigaction (SIGPIPE, 0, &sigpipe_action); #ifdef AIX sigaddset (&blocked, SIGHUP ); sigaction (SIGHUP , 0, &sighup_action ); #endif @@ -2054,6 +2056,9 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) signal (SIGINT, SIG_DFL); signal (SIGQUIT, SIG_DFL); + /* GConf causes us to ignore SIGPIPE, make sure it is restored + in the child. */ + signal (SIGPIPE, SIG_DFL); /* Stop blocking signals in the child. */ sigprocmask (SIG_SETMASK, &procmask, 0); @@ -2142,6 +2147,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) /* Restore the parent's signal handlers. */ sigaction (SIGINT, &sigint_action, 0); sigaction (SIGQUIT, &sigquit_action, 0); + sigaction (SIGPIPE, &sigpipe_action, 0); #ifdef AIX sigaction (SIGHUP, &sighup_action, 0); #endif @@ -2892,8 +2898,8 @@ usage: (make-serial-process &rest ARGS) */) } else if (!NILP (Vcoding_system_for_read)) val = Vcoding_system_for_read; - else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters)) - || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters))) + else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters))) + || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))) val = Qnil; p->decode_coding_system = val; @@ -2906,15 +2912,15 @@ usage: (make-serial-process &rest ARGS) */) } else if (!NILP (Vcoding_system_for_write)) val = Vcoding_system_for_write; - else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters)) - || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters))) + else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters))) + || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))) val = Qnil; p->encode_coding_system = val; setup_process_coding_systems (proc); - p->decoding_buf = make_uninit_string (0); + p->decoding_buf = empty_unibyte_string; p->decoding_carryover = 0; - p->encoding_buf = make_uninit_string (0); + p->encoding_buf = empty_unibyte_string; p->inherit_coding_system_flag = !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system); @@ -3717,8 +3723,8 @@ usage: (make-network-process &rest ARGS) */) } else if (!NILP (Vcoding_system_for_read)) val = Vcoding_system_for_read; - else if ((!NILP (buffer) && NILP (XBUFFER (buffer)->enable_multibyte_characters)) - || (NILP (buffer) && NILP (buffer_defaults.enable_multibyte_characters))) + else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters))) + || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))) /* We dare not decode end-of-line format by setting VAL to Qraw_text, because the existing Emacs Lisp libraries assume that they receive bare code including a sequene of @@ -3753,7 +3759,7 @@ usage: (make-network-process &rest ARGS) */) } else if (!NILP (Vcoding_system_for_write)) val = Vcoding_system_for_write; - else if (NILP (current_buffer->enable_multibyte_characters)) + else if (NILP (BVAR (current_buffer, enable_multibyte_characters))) val = Qnil; else { @@ -3781,9 +3787,9 @@ usage: (make-network-process &rest ARGS) */) } setup_process_coding_systems (proc); - p->decoding_buf = make_uninit_string (0); + p->decoding_buf = empty_unibyte_string; p->decoding_carryover = 0; - p->encoding_buf = make_uninit_string (0); + p->encoding_buf = empty_unibyte_string; p->inherit_coding_system_flag = !(!NILP (tem) || NILP (buffer) || !inherit_process_coding_system); @@ -4358,9 +4364,9 @@ server_accept_connection (Lisp_Object server, int channel) p->encode_coding_system = ps->encode_coding_system; setup_process_coding_systems (proc); - p->decoding_buf = make_uninit_string (0); + p->decoding_buf = empty_unibyte_string; p->decoding_carryover = 0; - p->encoding_buf = make_uninit_string (0); + p->encoding_buf = empty_unibyte_string; p->inherit_coding_system_flag = (NILP (buffer) ? 0 : ps->inherit_coding_system_flag); @@ -5262,7 +5268,7 @@ read_process_output (Lisp_Object proc, register int channel) /* No need to gcpro these, because all we do with them later is test them for EQness, and none of them should be a string. */ XSETBUFFER (obuffer, current_buffer); - okeymap = current_buffer->keymap; + okeymap = BVAR (current_buffer, keymap); /* We inhibit quit here instead of just catching it so that hitting ^G when a filter happens to be running won't screw @@ -5353,7 +5359,7 @@ read_process_output (Lisp_Object proc, register int channel) } /* If no filter, write into buffer if it isn't dead. */ - else if (!NILP (p->buffer) && !NILP (XBUFFER (p->buffer)->name)) + else if (!NILP (p->buffer) && !NILP (BVAR (XBUFFER (p->buffer), name))) { Lisp_Object old_read_only; EMACS_INT old_begv, old_zv; @@ -5366,13 +5372,13 @@ read_process_output (Lisp_Object proc, register int channel) Fset_buffer (p->buffer); opoint = PT; opoint_byte = PT_BYTE; - old_read_only = current_buffer->read_only; + old_read_only = BVAR (current_buffer, read_only); old_begv = BEGV; old_zv = ZV; old_begv_byte = BEGV_BYTE; old_zv_byte = ZV_BYTE; - current_buffer->read_only = Qnil; + BVAR (current_buffer, read_only) = Qnil; /* Insert new output into buffer at the current end-of-output marker, @@ -5417,7 +5423,7 @@ read_process_output (Lisp_Object proc, register int channel) p->decoding_carryover = coding->carryover_bytes; } /* Adjust the multibyteness of TEXT to that of the buffer. */ - if (NILP (current_buffer->enable_multibyte_characters) + if (NILP (BVAR (current_buffer, enable_multibyte_characters)) != ! STRING_MULTIBYTE (text)) text = (STRING_MULTIBYTE (text) ? Fstring_as_unibyte (text) @@ -5461,7 +5467,7 @@ read_process_output (Lisp_Object proc, register int channel) Fnarrow_to_region (make_number (old_begv), make_number (old_zv)); - current_buffer->read_only = old_read_only; + BVAR (current_buffer, read_only) = old_read_only; SET_PT_BOTH (opoint, opoint_byte); } /* Handling the process output should not deactivate the mark. */ @@ -5519,7 +5525,7 @@ send_process (volatile Lisp_Object proc, const char *volatile buf, if ((STRINGP (object) && STRING_MULTIBYTE (object)) || (BUFFERP (object) - && !NILP (XBUFFER (object)->enable_multibyte_characters)) + && !NILP (BVAR (XBUFFER (object), enable_multibyte_characters))) || EQ (object, Qt)) { p->encode_coding_system @@ -6558,7 +6564,7 @@ exec_sentinel (Lisp_Object proc, Lisp_Object reason) is test them for EQness, and none of them should be a string. */ odeactivate = Vdeactivate_mark; XSETBUFFER (obuffer, current_buffer); - okeymap = current_buffer->keymap; + okeymap = BVAR (current_buffer, keymap); /* There's no good reason to let sentinels change the current buffer, and many callers of accept-process-output, sit-for, and @@ -6708,7 +6714,7 @@ status_notify (struct Lisp_Process *deleting_process) /* Avoid error if buffer is deleted (probably that's why the process is dead, too) */ - if (NILP (XBUFFER (buffer)->name)) + if (NILP (BVAR (XBUFFER (buffer), name))) continue; Fset_buffer (buffer); @@ -6725,13 +6731,13 @@ status_notify (struct Lisp_Process *deleting_process) before = PT; before_byte = PT_BYTE; - tem = current_buffer->read_only; - current_buffer->read_only = Qnil; + tem = BVAR (current_buffer, read_only); + BVAR (current_buffer, read_only) = Qnil; insert_string ("\nProcess "); Finsert (1, &p->name); insert_string (" "); Finsert (1, &msg); - current_buffer->read_only = tem; + BVAR (current_buffer, read_only) = tem; set_marker_both (p->mark, p->buffer, PT, PT_BYTE); if (opoint >= before) @@ -7130,7 +7136,7 @@ setup_process_coding_systems (Lisp_Object process) ; else if (BUFFERP (p->buffer)) { - if (NILP (XBUFFER (p->buffer)->enable_multibyte_characters)) + if (NILP (BVAR (XBUFFER (p->buffer), enable_multibyte_characters))) coding_system = raw_text_coding_system (coding_system); } setup_coding_system (coding_system, proc_decode_coding_system[inch]); diff --git a/src/s/aix4-2.h b/src/s/aix4-2.h index c62aee249c5..443fc034570 100644 --- a/src/s/aix4-2.h +++ b/src/s/aix4-2.h @@ -41,12 +41,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Define HAVE_SOCKETS if system supports 4.2-compatible sockets. */ #define HAVE_SOCKETS - -/* The file containing the kernel's symbol table is called /unix. */ -#define KERNEL_FILE "/unix" - -/* The kernel symbol where the load average is found is named avenrun. */ -#define LDAV_SYMBOL "avenrun" /* Special items needed to make Emacs run on this system. */ @@ -86,4 +80,3 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ Emacs currently calls xrealloc on the results of get_current_dir name, to avoid a crash just use the Emacs implementation for that function. */ #define BROKEN_GET_CURRENT_DIR_NAME 1 - diff --git a/src/s/bsd-common.h b/src/s/bsd-common.h index 7d472c83ed1..0cca005b423 100644 --- a/src/s/bsd-common.h +++ b/src/s/bsd-common.h @@ -37,10 +37,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #define TABDLY OXTABS #define TAB3 OXTABS -/* These aren't needed, since we have getloadavg. */ -#undef KERNEL_FILE -#undef LDAV_SYMBOL - #define NO_TERMIO /* If the system's imake configuration file defines `NeedWidePrototypes' @@ -72,12 +68,5 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ a file that someone else has modified in his Emacs. */ #define CLASH_DETECTION -/* The file containing the kernel's symbol table is called /vmunix. */ -#define KERNEL_FILE "/vmunix" - -/* The kernel symbol where the load average is found is named _avenrun. */ -#define LDAV_SYMBOL "_avenrun" - /* Send signals to subprocesses by "typing" special chars at them. */ #define SIGNALS_VIA_CHARACTERS - diff --git a/src/s/freebsd.h b/src/s/freebsd.h index 222ebc91c4a..24b34e02f69 100644 --- a/src/s/freebsd.h +++ b/src/s/freebsd.h @@ -25,8 +25,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base) -#define HAVE_GETLOADAVG 1 - /* This silences a few compilation warnings. */ #undef BSD_SYSTEM #if __FreeBSD__ == 1 diff --git a/src/s/hpux10-20.h b/src/s/hpux10-20.h index d745f8d09c4..1cd91a41b55 100644 --- a/src/s/hpux10-20.h +++ b/src/s/hpux10-20.h @@ -47,9 +47,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ a file that someone else has modified in his Emacs. */ #define CLASH_DETECTION -/* The symbol in the kernel where the load average is found - depends on the cpu type, so we let the m- files define LDAV_SYMBOL. */ - /* Special hacks needed to make Emacs run on this system. */ /* In hpux, the symbol SIGIO is defined, but the feature @@ -91,9 +88,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #undef random #undef HAVE_RANDOM -/* AlainF 20-Jul-1996 says this is right. */ -#define KERNEL_FILE "/stand/vmunix" - /* Rainer Malzbender <rainer@displaytech.com> says definining HAVE_XRMSETDATABASE allows Emacs to compile on HP-UX 10.20 using GCC. */ @@ -119,18 +113,3 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ #define DATA_SEG_BITS 0x40000000 #define DATA_START 0x40000000 - -/* Data type of load average, as read out of kmem. */ -#define LOAD_AVE_TYPE double - -/* Convert that into an integer that is 100 for a load average of 1.0 */ -#define LOAD_AVE_CVT(x) ((int) (x * 100.0)) - -/* The kernel symbol where the load average is found is named _avenrun. - At this time there are two major flavors of hp-ux (there is the s800 - and s300 (s200) flavors). The differences are thusly moved to the - corresponding machine description file. */ - -/* No underscore please. */ -#define LDAV_SYMBOL "avenrun" - diff --git a/src/s/ms-w32.h b/src/s/ms-w32.h index 4c3b84dfe4c..8b189baea46 100644 --- a/src/s/ms-w32.h +++ b/src/s/ms-w32.h @@ -181,8 +181,6 @@ struct sigaction { #define HAVE_MENUS 1 #endif -#define MODE_LINE_BINARY_TEXT(_b_) (NILP ((_b_)->buffer_file_type) ? "T" : "B") - /* Get some redefinitions in place. */ #ifdef emacs @@ -348,6 +346,8 @@ extern char *get_emacs_configuration_options (void); #endif #include <string.h> +extern int getloadavg (double *, int); + /* We need a little extra space, see ../../lisp/loadup.el. */ #define SYSTEM_PURESIZE_EXTRA 50000 diff --git a/src/s/msdos.h b/src/s/msdos.h index 88afaa83455..8debd28dccb 100644 --- a/src/s/msdos.h +++ b/src/s/msdos.h @@ -73,6 +73,15 @@ You lose; /* Emacs for DOS must be compiled with DJGPP */ #define HAVE_INVERSE_HYPERBOLIC #define FLOAT_CHECK_DOMAIN +/* Start of gnulib-related stuff */ + +/* lib/ftoastr.c wants strtold, but DJGPP only has _strtold. DJGPP > + 2.03 has it, but it also has _strtold as a stub that jumps to + strtold, so use _strtold in all versions. */ +#define strtold _strtold + +/* End of gnulib-related stuff. */ + /* When $TERM is "internal" then this is substituted: */ #define INTERNAL_TERMINAL "pc|bios|IBM PC with color display:\ :co#80:li#25:Co#16:pa#256:km:ms:cm=<CM>:cl=<CL>:ce=<CE>:\ @@ -92,7 +101,7 @@ You lose; /* Emacs for DOS must be compiled with DJGPP */ /* Mode line description of a buffer's type. */ -#define MODE_LINE_BINARY_TEXT(buf) (NILP(buf->buffer_file_type) ? "T" : "B") +#define MODE_LINE_BINARY_TEXT(buf) (NILP(B_(buf,buffer_file_type)) ? "T" : "B") /* We have (the code to control) a mouse. */ #define HAVE_MOUSE diff --git a/src/s/netbsd.h b/src/s/netbsd.h index 8a639b93c84..52cda717a2d 100644 --- a/src/s/netbsd.h +++ b/src/s/netbsd.h @@ -21,8 +21,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Get most of the stuff from bsd-common. */ #include "bsd-common.h" -#define HAVE_GETLOADAVG 1 - #define PENDING_OUTPUT_COUNT(FILE) ((FILE)->_p - (FILE)->_bf._base) #define DEFAULT_SOUND_DEVICE "/dev/audio" @@ -43,4 +41,3 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* Use the GC_MAKE_GCPROS_NOOPS (see lisp.h) method. */ #define GC_MARK_STACK GC_MAKE_GCPROS_NOOPS - diff --git a/src/s/unixware.h b/src/s/unixware.h index c6130669a9a..407282ff78c 100644 --- a/src/s/unixware.h +++ b/src/s/unixware.h @@ -49,14 +49,4 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ pty_name[sizeof(pty_name) - 1] = 0; \ } -/* Data type of load average, as read out of kmem. */ -#define LOAD_AVE_TYPE long - -/* Convert that into an integer that is 100 for a load average of 1.0 */ -/* This is totally uncalibrated. */ -#define LOAD_AVE_CVT(x) ((int) (((double) (x)) * 100.0 / FSCALE)) -#define FSCALE 256.0 - - #define PENDING_OUTPUT_COUNT(FILE) ((FILE)->__ptr - (FILE)->__base) - diff --git a/src/s/usg5-4-common.h b/src/s/usg5-4-common.h index 12f73c1b3b5..aeedd7f4b15 100644 --- a/src/s/usg5-4-common.h +++ b/src/s/usg5-4-common.h @@ -30,12 +30,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ It sets the Lisp variable system-type. */ #define SYSTEM_TYPE "usg-unix-v" -/* The file containing the kernel's symbol table is called /unix. */ -#define KERNEL_FILE "/unix" - -/* The kernel symbol where the load average is found is named avenrun. */ -#define LDAV_SYMBOL "avenrun" - /* setjmp and longjmp can safely replace _setjmp and _longjmp, but they will run slower. */ #define _setjmp setjmp @@ -105,4 +99,3 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ /* This definition was suggested for next release. So give it a try. */ #define HAVE_SOCKETS - diff --git a/src/search.c b/src/search.c index 09dae0ed0f5..1e2036f6dc2 100644 --- a/src/search.c +++ b/src/search.c @@ -157,7 +157,7 @@ compile_pattern_1 (struct regexp_cache *cp, Lisp_Object pattern, Lisp_Object tra /* If the compiled pattern hard codes some of the contents of the syntax-table, it can only be reused with *this* syntax table. */ - cp->syntax_table = cp->buf.used_syntax ? current_buffer->syntax_table : Qt; + cp->syntax_table = cp->buf.used_syntax ? BVAR (current_buffer, syntax_table) : Qt; re_set_whitespace_regexp (NULL); @@ -236,7 +236,7 @@ compile_pattern (Lisp_Object pattern, struct re_registers *regp, Lisp_Object tra && EQ (cp->buf.translate, (! NILP (translate) ? translate : make_number (0))) && cp->posix == posix && (EQ (cp->syntax_table, Qt) - || EQ (cp->syntax_table, current_buffer->syntax_table)) + || EQ (cp->syntax_table, BVAR (current_buffer, syntax_table))) && !NILP (Fequal (cp->whitespace_regexp, Vsearch_spaces_regexp)) && cp->buf.charset_unibyte == charset_unibyte) break; @@ -285,17 +285,17 @@ looking_at_1 (Lisp_Object string, int posix) save_search_regs (); /* This is so set_image_of_range_1 in regex.c can find the EQV table. */ - XCHAR_TABLE (current_buffer->case_canon_table)->extras[2] - = current_buffer->case_eqv_table; + XCHAR_TABLE (BVAR (current_buffer, case_canon_table))->extras[2] + = BVAR (current_buffer, case_eqv_table); CHECK_STRING (string); bufp = compile_pattern (string, (NILP (Vinhibit_changing_match_data) ? &search_regs : NULL), - (!NILP (current_buffer->case_fold_search) - ? current_buffer->case_canon_table : Qnil), + (!NILP (BVAR (current_buffer, case_fold_search)) + ? BVAR (current_buffer, case_canon_table) : Qnil), posix, - !NILP (current_buffer->enable_multibyte_characters)); + !NILP (BVAR (current_buffer, enable_multibyte_characters))); immediate_quit = 1; QUIT; /* Do a pending quit right away, to avoid paradoxical behavior */ @@ -400,14 +400,14 @@ string_match_1 (Lisp_Object regexp, Lisp_Object string, Lisp_Object start, int p } /* This is so set_image_of_range_1 in regex.c can find the EQV table. */ - XCHAR_TABLE (current_buffer->case_canon_table)->extras[2] - = current_buffer->case_eqv_table; + XCHAR_TABLE (BVAR (current_buffer, case_canon_table))->extras[2] + = BVAR (current_buffer, case_eqv_table); bufp = compile_pattern (regexp, (NILP (Vinhibit_changing_match_data) ? &search_regs : NULL), - (!NILP (current_buffer->case_fold_search) - ? current_buffer->case_canon_table : Qnil), + (!NILP (BVAR (current_buffer, case_fold_search)) + ? BVAR (current_buffer, case_canon_table) : Qnil), posix, STRING_MULTIBYTE (string)); immediate_quit = 1; @@ -586,7 +586,7 @@ fast_looking_at (Lisp_Object regexp, EMACS_INT pos, EMACS_INT pos_byte, EMACS_IN s2 = 0; } re_match_object = Qnil; - multibyte = ! NILP (current_buffer->enable_multibyte_characters); + multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); } buf = compile_pattern (regexp, 0, Qnil, 0, multibyte); @@ -608,7 +608,7 @@ fast_looking_at (Lisp_Object regexp, EMACS_INT pos, EMACS_INT pos_byte, EMACS_IN static void newline_cache_on_off (struct buffer *buf) { - if (NILP (buf->cache_long_line_scans)) + if (NILP (BVAR (buf, cache_long_line_scans))) { /* It should be off. */ if (buf->newline_cache) @@ -996,15 +996,15 @@ search_command (Lisp_Object string, Lisp_Object bound, Lisp_Object noerror, } /* This is so set_image_of_range_1 in regex.c can find the EQV table. */ - XCHAR_TABLE (current_buffer->case_canon_table)->extras[2] - = current_buffer->case_eqv_table; + XCHAR_TABLE (BVAR (current_buffer, case_canon_table))->extras[2] + = BVAR (current_buffer, case_eqv_table); np = search_buffer (string, PT, PT_BYTE, lim, lim_byte, n, RE, - (!NILP (current_buffer->case_fold_search) - ? current_buffer->case_canon_table + (!NILP (BVAR (current_buffer, case_fold_search)) + ? BVAR (current_buffer, case_canon_table) : Qnil), - (!NILP (current_buffer->case_fold_search) - ? current_buffer->case_eqv_table + (!NILP (BVAR (current_buffer, case_fold_search)) + ? BVAR (current_buffer, case_eqv_table) : Qnil), posix); if (np <= 0) @@ -1133,7 +1133,7 @@ search_buffer (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte, (NILP (Vinhibit_changing_match_data) ? &search_regs : &search_regs_1), trt, posix, - !NILP (current_buffer->enable_multibyte_characters)); + !NILP (BVAR (current_buffer, enable_multibyte_characters))); immediate_quit = 1; /* Quit immediately if user types ^G, because letting this function finish @@ -1254,7 +1254,7 @@ search_buffer (Lisp_Object string, EMACS_INT pos, EMACS_INT pos_byte, EMACS_INT raw_pattern_size; EMACS_INT raw_pattern_size_byte; unsigned char *patbuf; - int multibyte = !NILP (current_buffer->enable_multibyte_characters); + int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); unsigned char *base_pat; /* Set to positive if we find a non-ASCII char that need translation. Otherwise set to zero later. */ @@ -1451,7 +1451,7 @@ simple_search (EMACS_INT n, unsigned char *pat, EMACS_INT pos, EMACS_INT pos_byte, EMACS_INT lim, EMACS_INT lim_byte) { - int multibyte = ! NILP (current_buffer->enable_multibyte_characters); + int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); int forward = n > 0; /* Number of buffer bytes matched. Note that this may be different from len_byte in a multibyte buffer. */ @@ -1671,7 +1671,7 @@ boyer_moore (EMACS_INT n, unsigned char *base_pat, register EMACS_INT i; register int j; unsigned char *pat, *pat_end; - int multibyte = ! NILP (current_buffer->enable_multibyte_characters); + int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters)); unsigned char simple_translate[0400]; /* These are set to the preceding bytes of a byte to be translated @@ -2639,7 +2639,7 @@ since only regular expressions have distinguished subexpressions. */) EMACS_INT length = SBYTES (newtext); unsigned char *substed; EMACS_INT substed_alloc_size, substed_len; - int buf_multibyte = !NILP (current_buffer->enable_multibyte_characters); + int buf_multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); int str_multibyte = STRING_MULTIBYTE (newtext); Lisp_Object rev_tbl; int really_changed = 0; diff --git a/src/syntax.c b/src/syntax.c index 2f47d73d695..707c2c19f31 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -277,7 +277,7 @@ update_syntax_table (EMACS_INT charpos, int count, int init, else { gl_state.use_global = 0; - gl_state.current_syntax_table = current_buffer->syntax_table; + gl_state.current_syntax_table = BVAR (current_buffer, syntax_table); } } @@ -363,7 +363,7 @@ char_quoted (EMACS_INT charpos, EMACS_INT bytepos) static INLINE EMACS_INT dec_bytepos (EMACS_INT bytepos) { - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) return bytepos - 1; DEC_POS (bytepos); @@ -779,7 +779,7 @@ DEFUN ("syntax-table", Fsyntax_table, Ssyntax_table, 0, 0, 0, This is the one specified by the current buffer. */) (void) { - return current_buffer->syntax_table; + return BVAR (current_buffer, syntax_table); } DEFUN ("standard-syntax-table", Fstandard_syntax_table, @@ -824,7 +824,7 @@ One argument, a syntax table. */) { int idx; check_syntax_table (table); - current_buffer->syntax_table = table; + BVAR (current_buffer, syntax_table) = table; /* Indicate that this buffer now has a specified syntax table. */ idx = PER_BUFFER_VAR_IDX (syntax_table); SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1); @@ -1035,7 +1035,7 @@ usage: (modify-syntax-entry CHAR NEWENTRY &optional SYNTAX-TABLE) */) CHECK_CHARACTER (c); if (NILP (syntax_table)) - syntax_table = current_buffer->syntax_table; + syntax_table = BVAR (current_buffer, syntax_table); else check_syntax_table (syntax_table); @@ -1450,7 +1450,7 @@ skip_chars (int forwardp, Lisp_Object string, Lisp_Object lim, int handle_iso_cl if (XINT (lim) < BEGV) XSETFASTINT (lim, BEGV); - multibyte = (!NILP (current_buffer->enable_multibyte_characters) + multibyte = (!NILP (BVAR (current_buffer, enable_multibyte_characters)) && (XINT (lim) - PT != CHAR_TO_BYTE (XINT (lim)) - PT_BYTE)); string_multibyte = SBYTES (string) > SCHARS (string); @@ -1936,7 +1936,7 @@ skip_syntaxes (int forwardp, Lisp_Object string, Lisp_Object lim) if (forwardp ? (PT >= XFASTINT (lim)) : (PT <= XFASTINT (lim))) return make_number (0); - multibyte = (!NILP (current_buffer->enable_multibyte_characters) + multibyte = (!NILP (BVAR (current_buffer, enable_multibyte_characters)) && (XINT (lim) - PT != CHAR_TO_BYTE (XINT (lim)) - PT_BYTE)); memset (fastmap, 0, sizeof fastmap); @@ -2703,7 +2703,7 @@ scan_lists (register EMACS_INT from, EMACS_INT count, EMACS_INT depth, int sexpf while (from > stop) { temp_pos = from_byte; - if (! NILP (current_buffer->enable_multibyte_characters)) + if (! NILP (BVAR (current_buffer, enable_multibyte_characters))) DEC_POS (temp_pos); else temp_pos--; diff --git a/src/syntax.h b/src/syntax.h index bea66d1fada..e8726bb28a4 100644 --- a/src/syntax.h +++ b/src/syntax.h @@ -24,7 +24,7 @@ extern void update_syntax_table (EMACS_INT, int, int, Lisp_Object); /* The standard syntax table is stored where it will automatically be used in all new buffers. */ -#define Vstandard_syntax_table buffer_defaults.syntax_table +#define Vstandard_syntax_table BVAR (&buffer_defaults, syntax_table) /* A syntax table is a chartable whose elements are cons cells (CODE+FLAGS . MATCHING-CHAR). MATCHING-CHAR can be nil if the char @@ -79,7 +79,7 @@ enum syntaxcode # define CURRENT_SYNTAX_TABLE gl_state.current_syntax_table #else # define SYNTAX_ENTRY SYNTAX_ENTRY_INT -# define CURRENT_SYNTAX_TABLE current_buffer->syntax_table +# define CURRENT_SYNTAX_TABLE BVAR (current_buffer, syntax_table) #endif #define SYNTAX_ENTRY_INT(c) CHAR_TABLE_REF (CURRENT_SYNTAX_TABLE, (c)) @@ -204,7 +204,7 @@ extern char syntax_code_spec[16]; do \ { \ gl_state.use_global = 0; \ - gl_state.current_syntax_table = current_buffer->syntax_table; \ + gl_state.current_syntax_table = BVAR (current_buffer, syntax_table); \ } while (0) /* This macro should be called with FROM at the start of forward diff --git a/src/term.c b/src/term.c index 1aefe02421f..f082bb40e89 100644 --- a/src/term.c +++ b/src/term.c @@ -112,10 +112,7 @@ static void vfatal (const char *str, va_list ap) NO_RETURN; #define OUTPUT_IF(tty, a) \ do { \ if (a) \ - emacs_tputs ((tty), a, \ - (int) (FRAME_LINES (XFRAME (selected_frame)) \ - - curY (tty) ), \ - cmputc); \ + OUTPUT (tty, a); \ } while (0) #define OUTPUT1_IF(tty, a) do { if (a) emacs_tputs ((tty), a, 1, cmputc); } while (0) @@ -1350,14 +1347,14 @@ term_get_fkeys_1 (void) KBOARD *kboard = term_get_fkeys_kboard; /* This can happen if CANNOT_DUMP or with strange options. */ - if (!KEYMAPP (kboard->Vinput_decode_map)) - kboard->Vinput_decode_map = Fmake_sparse_keymap (Qnil); + if (!KEYMAPP (KVAR (kboard, Vinput_decode_map))) + KVAR (kboard, Vinput_decode_map) = Fmake_sparse_keymap (Qnil); for (i = 0; i < (sizeof (keys)/sizeof (keys[0])); i++) { char *sequence = tgetstr (keys[i].cap, address); if (sequence) - Fdefine_key (kboard->Vinput_decode_map, build_string (sequence), + Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (sequence), Fmake_vector (make_number (1), intern (keys[i].name))); } @@ -1377,13 +1374,13 @@ term_get_fkeys_1 (void) if (k0) /* Define f0 first, so that f10 takes precedence in case the key sequences happens to be the same. */ - Fdefine_key (kboard->Vinput_decode_map, build_string (k0), + Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k0), Fmake_vector (make_number (1), intern ("f0"))); - Fdefine_key (kboard->Vinput_decode_map, build_string (k_semi), + Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k_semi), Fmake_vector (make_number (1), intern ("f10"))); } else if (k0) - Fdefine_key (kboard->Vinput_decode_map, build_string (k0), + Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (k0), Fmake_vector (make_number (1), intern (k0_name))); } @@ -1406,7 +1403,7 @@ term_get_fkeys_1 (void) if (sequence) { sprintf (fkey, "f%d", i); - Fdefine_key (kboard->Vinput_decode_map, build_string (sequence), + Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (sequence), Fmake_vector (make_number (1), intern (fkey))); } @@ -1423,7 +1420,7 @@ term_get_fkeys_1 (void) { \ char *sequence = tgetstr (cap2, address); \ if (sequence) \ - Fdefine_key (kboard->Vinput_decode_map, build_string (sequence), \ + Fdefine_key (KVAR (kboard, Vinput_decode_map), build_string (sequence), \ Fmake_vector (make_number (1), \ intern (sym))); \ } @@ -3418,7 +3415,7 @@ use the Bourne shell command `TERM=... export TERM' (C-shell:\n\ terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD)); init_kboard (terminal->kboard); - terminal->kboard->Vwindow_system = Qnil; + KVAR (terminal->kboard, Vwindow_system) = Qnil; terminal->kboard->next_kboard = all_kboards; all_kboards = terminal->kboard; terminal->kboard->reference_count++; diff --git a/src/termcap.c b/src/termcap.c index 9e64d027640..69ce56d93b3 100644 --- a/src/termcap.c +++ b/src/termcap.c @@ -268,7 +268,6 @@ tputs (register char *str, int nlines, register int (*outfun) (/* ??? */)) register int padcount = 0; register int speed; - extern EMACS_INT baud_rate; speed = baud_rate; /* For quite high speeds, convert to the smaller units to avoid overflow. */ diff --git a/src/terminal.c b/src/terminal.c index 09c57bc2b0c..309cc0095e8 100644 --- a/src/terminal.c +++ b/src/terminal.c @@ -223,6 +223,7 @@ struct terminal * create_terminal (void) { struct terminal *terminal = allocate_terminal (); + Lisp_Object terminal_coding, keyboard_coding; terminal->name = NULL; terminal->next_terminal = terminal_list; @@ -235,8 +236,24 @@ create_terminal (void) terminal->terminal_coding = (struct coding_system *) xmalloc (sizeof (struct coding_system)); - setup_coding_system (Qno_conversion, terminal->keyboard_coding); - setup_coding_system (Qundecided, terminal->terminal_coding); + /* If default coding systems for the terminal and the keyboard are + already defined, use them in preference to the defaults. This is + needed when Emacs runs in daemon mode. */ + keyboard_coding = + find_symbol_value (intern ("default-keyboard-coding-system")); + if (NILP (keyboard_coding) + || EQ (keyboard_coding, Qunbound) + || NILP (Fcoding_system_p (keyboard_coding))) + keyboard_coding = Qno_conversion; + terminal_coding = + find_symbol_value (intern ("default-terminal-coding-system")); + if (NILP (terminal_coding) + || EQ (terminal_coding, Qunbound) + || NILP (Fcoding_system_p (terminal_coding))) + terminal_coding = Qundecided; + + setup_coding_system (keyboard_coding, terminal->keyboard_coding); + setup_coding_system (terminal_coding, terminal->terminal_coding); terminal->param_alist = Qnil; return terminal; diff --git a/src/undo.c b/src/undo.c index 933982ec30c..d11cd6f5570 100644 --- a/src/undo.c +++ b/src/undo.c @@ -73,12 +73,12 @@ record_point (EMACS_INT pt) Fundo_boundary (); last_undo_buffer = current_buffer; - if (CONSP (current_buffer->undo_list)) + if (CONSP (BVAR (current_buffer, undo_list))) { /* Set AT_BOUNDARY to 1 only when we have nothing other than marker adjustment before undo boundary. */ - Lisp_Object tail = current_buffer->undo_list, elt; + Lisp_Object tail = BVAR (current_buffer, undo_list), elt; while (1) { @@ -103,8 +103,8 @@ record_point (EMACS_INT pt) if (at_boundary && current_buffer == last_boundary_buffer && last_boundary_position != pt) - current_buffer->undo_list - = Fcons (make_number (last_boundary_position), current_buffer->undo_list); + BVAR (current_buffer, undo_list) + = Fcons (make_number (last_boundary_position), BVAR (current_buffer, undo_list)); } /* Record an insertion that just happened or is about to happen, @@ -117,17 +117,17 @@ record_insert (EMACS_INT beg, EMACS_INT length) { Lisp_Object lbeg, lend; - if (EQ (current_buffer->undo_list, Qt)) + if (EQ (BVAR (current_buffer, undo_list), Qt)) return; record_point (beg); /* If this is following another insertion and consecutive with it in the buffer, combine the two. */ - if (CONSP (current_buffer->undo_list)) + if (CONSP (BVAR (current_buffer, undo_list))) { Lisp_Object elt; - elt = XCAR (current_buffer->undo_list); + elt = XCAR (BVAR (current_buffer, undo_list)); if (CONSP (elt) && INTEGERP (XCAR (elt)) && INTEGERP (XCDR (elt)) @@ -140,8 +140,8 @@ record_insert (EMACS_INT beg, EMACS_INT length) XSETFASTINT (lbeg, beg); XSETINT (lend, beg + length); - current_buffer->undo_list = Fcons (Fcons (lbeg, lend), - current_buffer->undo_list); + BVAR (current_buffer, undo_list) = Fcons (Fcons (lbeg, lend), + BVAR (current_buffer, undo_list)); } /* Record that a deletion is about to take place, @@ -152,7 +152,7 @@ record_delete (EMACS_INT beg, Lisp_Object string) { Lisp_Object sbeg; - if (EQ (current_buffer->undo_list, Qt)) + if (EQ (BVAR (current_buffer, undo_list), Qt)) return; if (PT == beg + SCHARS (string)) @@ -166,8 +166,8 @@ record_delete (EMACS_INT beg, Lisp_Object string) record_point (beg); } - current_buffer->undo_list - = Fcons (Fcons (string, sbeg), current_buffer->undo_list); + BVAR (current_buffer, undo_list) + = Fcons (Fcons (string, sbeg), BVAR (current_buffer, undo_list)); } /* Record the fact that MARKER is about to be adjusted by ADJUSTMENT. @@ -178,7 +178,7 @@ record_delete (EMACS_INT beg, Lisp_Object string) void record_marker_adjustment (Lisp_Object marker, EMACS_INT adjustment) { - if (EQ (current_buffer->undo_list, Qt)) + if (EQ (BVAR (current_buffer, undo_list), Qt)) return; /* Allocate a cons cell to be the undo boundary after this command. */ @@ -189,9 +189,9 @@ record_marker_adjustment (Lisp_Object marker, EMACS_INT adjustment) Fundo_boundary (); last_undo_buffer = current_buffer; - current_buffer->undo_list + BVAR (current_buffer, undo_list) = Fcons (Fcons (marker, make_number (adjustment)), - current_buffer->undo_list); + BVAR (current_buffer, undo_list)); } /* Record that a replacement is about to take place, @@ -215,7 +215,7 @@ record_first_change (void) Lisp_Object high, low; struct buffer *base_buffer = current_buffer; - if (EQ (current_buffer->undo_list, Qt)) + if (EQ (BVAR (current_buffer, undo_list), Qt)) return; if (current_buffer != last_undo_buffer) @@ -227,7 +227,7 @@ record_first_change (void) XSETFASTINT (high, (base_buffer->modtime >> 16) & 0xffff); XSETFASTINT (low, base_buffer->modtime & 0xffff); - current_buffer->undo_list = Fcons (Fcons (Qt, Fcons (high, low)), current_buffer->undo_list); + BVAR (current_buffer, undo_list) = Fcons (Fcons (Qt, Fcons (high, low)), BVAR (current_buffer, undo_list)); } /* Record a change in property PROP (whose old value was VAL) @@ -242,7 +242,7 @@ record_property_change (EMACS_INT beg, EMACS_INT length, struct buffer *obuf = current_buffer, *buf = XBUFFER (buffer); int boundary = 0; - if (EQ (buf->undo_list, Qt)) + if (EQ (BVAR (buf, undo_list), Qt)) return; /* Allocate a cons cell to be the undo boundary after this command. */ @@ -265,7 +265,7 @@ record_property_change (EMACS_INT beg, EMACS_INT length, XSETINT (lbeg, beg); XSETINT (lend, beg + length); entry = Fcons (Qnil, Fcons (prop, Fcons (value, Fcons (lbeg, lend)))); - current_buffer->undo_list = Fcons (entry, current_buffer->undo_list); + BVAR (current_buffer, undo_list) = Fcons (entry, BVAR (current_buffer, undo_list)); current_buffer = obuf; } @@ -277,9 +277,9 @@ but another undo command will undo to the previous boundary. */) (void) { Lisp_Object tem; - if (EQ (current_buffer->undo_list, Qt)) + if (EQ (BVAR (current_buffer, undo_list), Qt)) return Qnil; - tem = Fcar (current_buffer->undo_list); + tem = Fcar (BVAR (current_buffer, undo_list)); if (!NILP (tem)) { /* One way or another, cons nil onto the front of the undo list. */ @@ -287,12 +287,12 @@ but another undo command will undo to the previous boundary. */) { /* If we have preallocated the cons cell to use here, use that one. */ - XSETCDR (pending_boundary, current_buffer->undo_list); - current_buffer->undo_list = pending_boundary; + XSETCDR (pending_boundary, BVAR (current_buffer, undo_list)); + BVAR (current_buffer, undo_list) = pending_boundary; pending_boundary = Qnil; } else - current_buffer->undo_list = Fcons (Qnil, current_buffer->undo_list); + BVAR (current_buffer, undo_list) = Fcons (Qnil, BVAR (current_buffer, undo_list)); } last_boundary_position = PT; last_boundary_buffer = current_buffer; @@ -321,7 +321,7 @@ truncate_undo_list (struct buffer *b) record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); set_buffer_internal (b); - list = b->undo_list; + list = BVAR (b, undo_list); prev = Qnil; next = list; @@ -433,7 +433,7 @@ truncate_undo_list (struct buffer *b) XSETCDR (last_boundary, Qnil); /* There's nothing we decided to keep, so clear it out. */ else - b->undo_list = Qnil; + BVAR (b, undo_list) = Qnil; unbind_to (count, Qnil); } @@ -470,13 +470,13 @@ Return what remains of the list. */) /* In a writable buffer, enable undoing read-only text that is so because of text properties. */ - if (NILP (current_buffer->read_only)) + if (NILP (BVAR (current_buffer, read_only))) specbind (Qinhibit_read_only, Qt); /* Don't let `intangible' properties interfere with undo. */ specbind (Qinhibit_point_motion_hooks, Qt); - oldlist = current_buffer->undo_list; + oldlist = BVAR (current_buffer, undo_list); while (arg > 0) { @@ -631,9 +631,9 @@ Return what remains of the list. */) so the test in `undo' for continuing an undo series will work right. */ if (did_apply - && EQ (oldlist, current_buffer->undo_list)) - current_buffer->undo_list - = Fcons (list3 (Qapply, Qcdr, Qnil), current_buffer->undo_list); + && EQ (oldlist, BVAR (current_buffer, undo_list))) + BVAR (current_buffer, undo_list) + = Fcons (list3 (Qapply, Qcdr, Qnil), BVAR (current_buffer, undo_list)); UNGCPRO; return unbind_to (count, list); diff --git a/src/w32fns.c b/src/w32fns.c index b09bb0b5b5f..ec48397657a 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -4348,9 +4348,9 @@ This function is an internal primitive--use `make-frame' instead. */) /* Initialize `default-minibuffer-frame' in case this is the first frame on this terminal. */ if (FRAME_HAS_MINIBUF_P (f) - && (!FRAMEP (kb->Vdefault_minibuffer_frame) - || !FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame)))) - kb->Vdefault_minibuffer_frame = frame; + && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame)) + || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))) + KVAR (kb, Vdefault_minibuffer_frame) = frame; /* All remaining specified parameters, which have not been "used" by x_get_arg and friends, now go in the misc. alist of the frame. */ @@ -5225,7 +5225,7 @@ x_create_tip_frame (struct w32_display_info *dpyinfo, Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil); old_buffer = current_buffer; set_buffer_internal_1 (XBUFFER (buffer)); - current_buffer->truncate_lines = Qnil; + BVAR (current_buffer, truncate_lines) = Qnil; specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); Ferase_buffer (); @@ -5655,7 +5655,7 @@ Text larger than the specified size is clipped. */) /* Display the tooltip text in a temporary buffer. */ old_buffer = current_buffer; set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer)); - current_buffer->truncate_lines = Qnil; + BVAR (current_buffer, truncate_lines) = Qnil; clear_glyph_matrix (w->desired_matrix); clear_glyph_matrix (w->current_matrix); SET_TEXT_POS (pos, BEGV, BEGV_BYTE); @@ -6162,7 +6162,7 @@ an integer representing a ShowWindow flag: CHECK_STRING (document); /* Encode filename, current directory and parameters. */ - current_dir = ENCODE_FILE (current_buffer->directory); + current_dir = ENCODE_FILE (BVAR (current_buffer, directory)); document = ENCODE_FILE (document); if (STRINGP (parameters)) parameters = ENCODE_SYSTEM (parameters); diff --git a/src/w32term.c b/src/w32term.c index cd4ee54fd2c..692130b5140 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -6082,7 +6082,7 @@ w32_create_terminal (struct w32_display_info *dpyinfo) terminal like X does. */ terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD)); init_kboard (terminal->kboard); - terminal->kboard->Vwindow_system = intern ("w32"); + KVAR (terminal->kboard, Vwindow_system) = intern ("w32"); terminal->kboard->next_kboard = all_kboards; all_kboards = terminal->kboard; /* Don't let the initial kboard remain current longer than necessary. diff --git a/src/window.c b/src/window.c index d21cbb164ea..f0555d5c961 100644 --- a/src/window.c +++ b/src/window.c @@ -1359,8 +1359,8 @@ window_display_table (struct window *w) { struct buffer *b = XBUFFER (w->buffer); - if (DISP_TABLE_P (b->display_table)) - dp = XCHAR_TABLE (b->display_table); + if (DISP_TABLE_P (BVAR (b, display_table))) + dp = XCHAR_TABLE (BVAR (b, display_table)); else if (DISP_TABLE_P (Vstandard_display_table)) dp = XCHAR_TABLE (Vstandard_display_table); } @@ -1414,9 +1414,9 @@ unshow_buffer (register struct window *w) So don't clobber point in that buffer. */ if (! EQ (buf, XWINDOW (selected_window)->buffer) /* This line helps to fix Horsley's testbug.el bug. */ - && !(WINDOWP (b->last_selected_window) - && w != XWINDOW (b->last_selected_window) - && EQ (buf, XWINDOW (b->last_selected_window)->buffer))) + && !(WINDOWP (BVAR (b, last_selected_window)) + && w != XWINDOW (BVAR (b, last_selected_window)) + && EQ (buf, XWINDOW (BVAR (b, last_selected_window))->buffer))) temp_set_point_both (b, clip_to_bounds (BUF_BEGV (b), XMARKER (w->pointm)->charpos, @@ -1425,9 +1425,9 @@ unshow_buffer (register struct window *w) marker_byte_position (w->pointm), BUF_ZV_BYTE (b))); - if (WINDOWP (b->last_selected_window) - && w == XWINDOW (b->last_selected_window)) - b->last_selected_window = Qnil; + if (WINDOWP (BVAR (b, last_selected_window)) + && w == XWINDOW (BVAR (b, last_selected_window))) + BVAR (b, last_selected_window) = Qnil; } /* Put replacement into the window structure in place of old. */ @@ -2325,7 +2325,7 @@ window_loop (enum window_loop type, Lisp_Object obj, int mini, Lisp_Object frame /* Check for a window that has a killed buffer. */ case CHECK_ALL_WINDOWS: if (! NILP (w->buffer) - && NILP (XBUFFER (w->buffer)->name)) + && NILP (BVAR (XBUFFER (w->buffer), name))) abort (); break; @@ -2729,7 +2729,7 @@ window_min_size_2 (struct window *w, int width_p, int safe_p) { int safe_size = (MIN_SAFE_WINDOW_HEIGHT + ((BUFFERP (w->buffer) - && !NILP (XBUFFER (w->buffer)->mode_line_format)) + && !NILP (BVAR (XBUFFER (w->buffer), mode_line_format))) ? 1 : 0)); return safe_p ? safe_size : max (window_min_height, safe_size); @@ -3360,15 +3360,15 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, int run_hooks_p, int w->buffer = buffer; if (EQ (window, selected_window)) - b->last_selected_window = window; + BVAR (b, last_selected_window) = window; /* Let redisplay errors through. */ b->display_error_modiff = 0; /* Update time stamps of buffer display. */ - if (INTEGERP (b->display_count)) - XSETINT (b->display_count, XINT (b->display_count) + 1); - b->display_time = Fcurrent_time (); + if (INTEGERP (BVAR (b, display_count))) + XSETINT (BVAR (b, display_count), XINT (BVAR (b, display_count)) + 1); + BVAR (b, display_time) = Fcurrent_time (); XSETFASTINT (w->window_end_pos, 0); XSETFASTINT (w->window_end_vpos, 0); @@ -3421,18 +3421,18 @@ set_window_buffer (Lisp_Object window, Lisp_Object buffer, int run_hooks_p, int w->left_margin_cols = w->right_margin_cols = Qnil; Fset_window_fringes (window, - b->left_fringe_width, b->right_fringe_width, - b->fringes_outside_margins); + BVAR (b, left_fringe_width), BVAR (b, right_fringe_width), + BVAR (b, fringes_outside_margins)); Fset_window_scroll_bars (window, - b->scroll_bar_width, - b->vertical_scroll_bar_type, Qnil); + BVAR (b, scroll_bar_width), + BVAR (b, vertical_scroll_bar_type), Qnil); w->left_margin_cols = save_left; w->right_margin_cols = save_right; Fset_window_margins (window, - b->left_margin_cols, b->right_margin_cols); + BVAR (b, left_margin_cols), BVAR (b, right_margin_cols)); } if (run_hooks_p) @@ -3469,7 +3469,7 @@ This function runs `window-scroll-functions' before running XSETWINDOW (window, w); buffer = Fget_buffer (buffer_or_name); CHECK_BUFFER (buffer); - if (NILP (XBUFFER (buffer)->name)) + if (NILP (BVAR (XBUFFER (buffer), name))) error ("Attempt to display deleted buffer"); tem = w->buffer; @@ -3481,7 +3481,7 @@ This function runs `window-scroll-functions' before running if (EQ (tem, buffer)) return Qnil; else if (EQ (w->dedicated, Qt)) - error ("Window is dedicated to `%s'", SDATA (XBUFFER (tem)->name)); + error ("Window is dedicated to `%s'", SDATA (BVAR (XBUFFER (tem), name))); else w->dedicated = Qnil; @@ -3517,7 +3517,7 @@ select_window (Lisp_Object window, Lisp_Object norecord, int inhibit_point_swap) record_buffer (w->buffer); } - if (EQ (window, selected_window)) + if (EQ (window, selected_window) && !inhibit_point_swap) return window; sf = SELECTED_FRAME (); @@ -3552,7 +3552,7 @@ select_window (Lisp_Object window, Lisp_Object norecord, int inhibit_point_swap) Fset_buffer (w->buffer); - XBUFFER (w->buffer)->last_selected_window = window; + BVAR (XBUFFER (w->buffer), last_selected_window) = window; /* Go to the point recorded in the window. This is important when the buffer is in more @@ -3640,7 +3640,7 @@ displaying that buffer. */) if (STRINGP (object)) object = Fget_buffer (object); - if (BUFFERP (object) && !NILP (XBUFFER (object)->name)) + if (BUFFERP (object) && !NILP (BVAR (XBUFFER (object), name))) { /* Walk all windows looking for buffer, and force update of each of those windows. */ @@ -3662,7 +3662,7 @@ temp_output_buffer_show (register Lisp_Object buf) register Lisp_Object window; register struct window *w; - XBUFFER (buf)->directory = current_buffer->directory; + BVAR (XBUFFER (buf), directory) = BVAR (current_buffer, directory); Fset_buffer (buf); BUF_SAVE_MODIFF (XBUFFER (buf)) = MODIFF; @@ -4843,8 +4843,8 @@ window_scroll_pixel_based (Lisp_Object window, int n, int whole, int noerror) possibility of point becoming "stuck" on a tall line when scrolling by one line. */ if (window_scroll_pixel_based_preserve_y < 0 - || !SYMBOLP (current_kboard->Vlast_command) - || NILP (Fget (current_kboard->Vlast_command, Qscroll_command))) + || !SYMBOLP (KVAR (current_kboard, Vlast_command)) + || NILP (Fget (KVAR (current_kboard, Vlast_command), Qscroll_command))) { start_display (&it, w, start); move_it_to (&it, PT, -1, -1, -1, MOVE_TO_POS); @@ -5100,8 +5100,8 @@ window_scroll_line_based (Lisp_Object window, int n, int whole, int noerror) if (!NILP (Vscroll_preserve_screen_position)) { if (window_scroll_preserve_vpos <= 0 - || !SYMBOLP (current_kboard->Vlast_command) - || NILP (Fget (current_kboard->Vlast_command, Qscroll_command))) + || !SYMBOLP (KVAR (current_kboard, Vlast_command)) + || NILP (Fget (KVAR (current_kboard, Vlast_command), Qscroll_command))) { struct position posit = *compute_motion (startpos, 0, 0, 0, @@ -5887,7 +5887,7 @@ the return value is nil. Otherwise the value is t. */) saved_windows = XVECTOR (data->saved_windows); new_current_buffer = data->current_buffer; - if (NILP (XBUFFER (new_current_buffer)->name)) + if (NILP (BVAR (XBUFFER (new_current_buffer), name))) new_current_buffer = Qnil; else { @@ -6072,14 +6072,14 @@ the return value is nil. Otherwise the value is t. */) w->buffer = p->buffer; else { - if (!NILP (XBUFFER (p->buffer)->name)) + if (!NILP (BVAR (XBUFFER (p->buffer), name))) /* If saved buffer is alive, install it. */ { w->buffer = p->buffer; w->start_at_line_beg = p->start_at_line_beg; set_marker_restricted (w->start, p->start, w->buffer); set_marker_restricted (w->pointm, p->pointm, w->buffer); - Fset_marker (XBUFFER (w->buffer)->mark, + Fset_marker (BVAR (XBUFFER (w->buffer), mark), p->mark, w->buffer); /* As documented in Fcurrent_window_configuration, don't @@ -6089,7 +6089,7 @@ the return value is nil. Otherwise the value is t. */) && XBUFFER (p->buffer) == current_buffer) Fgoto_char (w->pointm); } - else if (NILP (w->buffer) || NILP (XBUFFER (w->buffer)->name)) + else if (NILP (w->buffer) || NILP (BVAR (XBUFFER (w->buffer), name))) /* Else unless window has a live buffer, get one. */ { w->buffer = Fcdr (Fcar (Vbuffer_alist)); @@ -6130,7 +6130,7 @@ the return value is nil. Otherwise the value is t. */) has been restored into it. We already swapped out that point from that window's old buffer. */ select_window (data->current_window, Qnil, 1); - XBUFFER (XWINDOW (selected_window)->buffer)->last_selected_window + BVAR (XBUFFER (XWINDOW (selected_window)->buffer), last_selected_window) = selected_window; if (NILP (data->focus_frame) @@ -6331,7 +6331,7 @@ save_window_save (Lisp_Object window, struct Lisp_Vector *vector, int i) p->start = Fcopy_marker (w->start, Qnil); p->start_at_line_beg = w->start_at_line_beg; - tem = XBUFFER (w->buffer)->mark; + tem = BVAR (XBUFFER (w->buffer), mark); p->mark = Fcopy_marker (tem, Qnil); } else diff --git a/src/xdisp.c b/src/xdisp.c index 630c1dcda85..e144237d34e 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -444,6 +444,12 @@ static int this_line_pixel_height; static int this_line_start_x; +/* The smallest character position seen by move_it_* functions as they + move across display lines. Used to set MATRIX_ROW_START_CHARPOS of + hscrolled lines, see display_line. */ + +static struct text_pos this_line_min_pos; + /* Buffer that this_line_.* variables are referring to. */ static struct buffer *this_line_buffer; @@ -1204,12 +1210,12 @@ pos_visible_p (struct window *w, EMACS_INT charpos, int *x, int *y, if (WINDOW_WANTS_MODELINE_P (w)) current_mode_line_height = display_mode_line (w, CURRENT_MODE_LINE_FACE_ID (w), - current_buffer->mode_line_format); + BVAR (current_buffer, mode_line_format)); if (WINDOW_WANTS_HEADER_LINE_P (w)) current_header_line_height = display_mode_line (w, HEADER_LINE_FACE_ID, - current_buffer->header_line_format); + BVAR (current_buffer, header_line_format)); start_display (&it, w, top); move_it_to (&it, charpos, -1, it.last_visible_y-1, -1, @@ -2399,10 +2405,10 @@ init_iterator (struct it *it, struct window *w, if (base_face_id == DEFAULT_FACE_ID && FRAME_WINDOW_P (it->f)) { - if (NATNUMP (current_buffer->extra_line_spacing)) - it->extra_line_spacing = XFASTINT (current_buffer->extra_line_spacing); - else if (FLOATP (current_buffer->extra_line_spacing)) - it->extra_line_spacing = (XFLOAT_DATA (current_buffer->extra_line_spacing) + if (NATNUMP (BVAR (current_buffer, extra_line_spacing))) + it->extra_line_spacing = XFASTINT (BVAR (current_buffer, extra_line_spacing)); + else if (FLOATP (BVAR (current_buffer, extra_line_spacing))) + it->extra_line_spacing = (XFLOAT_DATA (BVAR (current_buffer, extra_line_spacing)) * FRAME_LINE_HEIGHT (it->f)); else if (it->f->extra_line_spacing > 0) it->extra_line_spacing = it->f->extra_line_spacing; @@ -2425,36 +2431,36 @@ init_iterator (struct it *it, struct window *w, it->override_ascent = -1; /* Are control characters displayed as `^C'? */ - it->ctl_arrow_p = !NILP (current_buffer->ctl_arrow); + it->ctl_arrow_p = !NILP (BVAR (current_buffer, ctl_arrow)); /* -1 means everything between a CR and the following line end is invisible. >0 means lines indented more than this value are invisible. */ - it->selective = (INTEGERP (current_buffer->selective_display) - ? XFASTINT (current_buffer->selective_display) - : (!NILP (current_buffer->selective_display) + it->selective = (INTEGERP (BVAR (current_buffer, selective_display)) + ? XFASTINT (BVAR (current_buffer, selective_display)) + : (!NILP (BVAR (current_buffer, selective_display)) ? -1 : 0)); it->selective_display_ellipsis_p - = !NILP (current_buffer->selective_display_ellipses); + = !NILP (BVAR (current_buffer, selective_display_ellipses)); /* Display table to use. */ it->dp = window_display_table (w); /* Are multibyte characters enabled in current_buffer? */ - it->multibyte_p = !NILP (current_buffer->enable_multibyte_characters); + it->multibyte_p = !NILP (BVAR (current_buffer, enable_multibyte_characters)); /* Do we need to reorder bidirectional text? Not if this is a unibyte buffer: by definition, none of the single-byte characters are strong R2L, so no reordering is needed. And bidi.c doesn't support unibyte buffers anyway. */ it->bidi_p - = !NILP (current_buffer->bidi_display_reordering) && it->multibyte_p; + = !NILP (BVAR (current_buffer, bidi_display_reordering)) && it->multibyte_p; /* Non-zero if we should highlight the region. */ highlight_region_p = (!NILP (Vtransient_mark_mode) - && !NILP (current_buffer->mark_active) - && XMARKER (current_buffer->mark)->buffer != 0); + && !NILP (BVAR (current_buffer, mark_active)) + && XMARKER (BVAR (current_buffer, mark))->buffer != 0); /* Set IT->region_beg_charpos and IT->region_end_charpos to the start and end of a visible region in window IT->w. Set both to @@ -2471,7 +2477,7 @@ init_iterator (struct it *it, struct window *w, && WINDOWP (minibuf_selected_window) && w == XWINDOW (minibuf_selected_window)))) { - EMACS_INT charpos = marker_position (current_buffer->mark); + EMACS_INT charpos = marker_position (BVAR (current_buffer, mark)); it->region_beg_charpos = min (PT, charpos); it->region_end_charpos = max (PT, charpos); } @@ -2488,7 +2494,7 @@ init_iterator (struct it *it, struct window *w, it->redisplay_end_trigger_charpos = XINT (w->redisplay_end_trigger); /* Correct bogus values of tab_width. */ - it->tab_width = XINT (current_buffer->tab_width); + it->tab_width = XINT (BVAR (current_buffer, tab_width)); if (it->tab_width <= 0 || it->tab_width > 1000) it->tab_width = 8; @@ -2502,8 +2508,8 @@ init_iterator (struct it *it, struct window *w, && (WINDOW_TOTAL_COLS (it->w) < XINT (Vtruncate_partial_width_windows)))))) it->line_wrap = TRUNCATE; - else if (NILP (current_buffer->truncate_lines)) - it->line_wrap = NILP (current_buffer->word_wrap) + else if (NILP (BVAR (current_buffer, truncate_lines))) + it->line_wrap = NILP (BVAR (current_buffer, word_wrap)) ? WINDOW_WRAP : WORD_WRAP; else it->line_wrap = TRUNCATE; @@ -2605,9 +2611,9 @@ init_iterator (struct it *it, struct window *w, { /* Note the paragraph direction that this buffer wants to use. */ - if (EQ (current_buffer->bidi_paragraph_direction, Qleft_to_right)) + if (EQ (BVAR (current_buffer, bidi_paragraph_direction), Qleft_to_right)) it->paragraph_embedding = L2R; - else if (EQ (current_buffer->bidi_paragraph_direction, Qright_to_left)) + else if (EQ (BVAR (current_buffer, bidi_paragraph_direction), Qright_to_left)) it->paragraph_embedding = R2L; else it->paragraph_embedding = NEUTRAL_DIR; @@ -5405,7 +5411,7 @@ reseat_1 (struct it *it, struct text_pos pos, int set_stop_p) it->method = GET_FROM_BUFFER; it->object = it->w->buffer; it->area = TEXT_AREA; - it->multibyte_p = !NILP (current_buffer->enable_multibyte_characters); + it->multibyte_p = !NILP (BVAR (current_buffer, enable_multibyte_characters)); it->sp = 0; it->string_from_display_prop_p = 0; it->face_before_selective_p = 0; @@ -6909,6 +6915,9 @@ move_it_in_display_line_to (struct it *it, && it->current_y < it->last_visible_y) handle_line_prefix (it); + if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos)) + SET_TEXT_POS (this_line_min_pos, IT_CHARPOS (*it), IT_BYTEPOS (*it)); + while (1) { int x, i, ascent = 0, descent = 0; @@ -7013,6 +7022,9 @@ move_it_in_display_line_to (struct it *it, if (it->area != TEXT_AREA) { set_iterator_to_next (it, 1); + if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos)) + SET_TEXT_POS (this_line_min_pos, + IT_CHARPOS (*it), IT_BYTEPOS (*it)); continue; } @@ -7121,6 +7133,9 @@ move_it_in_display_line_to (struct it *it, } set_iterator_to_next (it, 1); + if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos)) + SET_TEXT_POS (this_line_min_pos, + IT_CHARPOS (*it), IT_BYTEPOS (*it)); /* On graphical terminals, newlines may "overflow" into the fringe if overflow-newline-into-fringe is non-nil. @@ -7219,6 +7234,8 @@ move_it_in_display_line_to (struct it *it, /* The current display element has been consumed. Advance to the next. */ set_iterator_to_next (it, 1); + if (IT_CHARPOS (*it) < CHARPOS (this_line_min_pos)) + SET_TEXT_POS (this_line_min_pos, IT_CHARPOS (*it), IT_BYTEPOS (*it)); /* Stop if lines are truncated and IT's current x-position is past the right edge of the window now. */ @@ -7902,7 +7919,7 @@ message_dolog (const char *m, EMACS_INT nbytes, int nlflag, int multibyte) old_deactivate_mark = Vdeactivate_mark; oldbuf = current_buffer; Fset_buffer (Fget_buffer_create (Vmessages_buffer_name)); - current_buffer->undo_list = Qt; + BVAR (current_buffer, undo_list) = Qt; oldpoint = message_dolog_marker1; set_marker_restricted (oldpoint, make_number (PT), Qnil); @@ -7926,7 +7943,7 @@ message_dolog (const char *m, EMACS_INT nbytes, int nlflag, int multibyte) /* Insert the string--maybe converting multibyte to single byte or vice versa, so that all the text fits the buffer. */ if (multibyte - && NILP (current_buffer->enable_multibyte_characters)) + && NILP (BVAR (current_buffer, enable_multibyte_characters))) { EMACS_INT i; int c, char_bytes; @@ -7944,7 +7961,7 @@ message_dolog (const char *m, EMACS_INT nbytes, int nlflag, int multibyte) } } else if (! multibyte - && ! NILP (current_buffer->enable_multibyte_characters)) + && ! NILP (BVAR (current_buffer, enable_multibyte_characters))) { EMACS_INT i; int c, char_bytes; @@ -8443,7 +8460,7 @@ update_echo_area (void) Lisp_Object string; string = Fcurrent_message (); message3 (string, SBYTES (string), - !NILP (current_buffer->enable_multibyte_characters)); + !NILP (BVAR (current_buffer, enable_multibyte_characters))); } } @@ -8458,7 +8475,7 @@ ensure_echo_area_buffers (void) for (i = 0; i < 2; ++i) if (!BUFFERP (echo_buffer[i]) - || NILP (XBUFFER (echo_buffer[i])->name)) + || NILP (BVAR (XBUFFER (echo_buffer[i]), name))) { char name[30]; Lisp_Object old_buffer; @@ -8467,7 +8484,7 @@ ensure_echo_area_buffers (void) old_buffer = echo_buffer[i]; sprintf (name, " *Echo Area %d*", i); echo_buffer[i] = Fget_buffer_create (build_string (name)); - XBUFFER (echo_buffer[i])->truncate_lines = Qnil; + BVAR (XBUFFER (echo_buffer[i]), truncate_lines) = Qnil; /* to force word wrap in echo area - it was decided to postpone this*/ /* XBUFFER (echo_buffer[i])->word_wrap = Qt; */ @@ -8560,8 +8577,8 @@ with_echo_area_buffer (struct window *w, int which, set_marker_both (w->pointm, buffer, BEG, BEG_BYTE); } - current_buffer->undo_list = Qt; - current_buffer->read_only = Qnil; + BVAR (current_buffer, undo_list) = Qt; + BVAR (current_buffer, read_only) = Qnil; specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); @@ -8674,7 +8691,7 @@ setup_echo_area_for_printing (int multibyte_p) /* Switch to that buffer and clear it. */ set_buffer_internal (XBUFFER (echo_area_buffer[0])); - current_buffer->truncate_lines = Qnil; + BVAR (current_buffer, truncate_lines) = Qnil; if (Z > BEG) { @@ -8688,7 +8705,7 @@ setup_echo_area_for_printing (int multibyte_p) /* Set up the buffer for the multibyteness we need. */ if (multibyte_p - != !NILP (current_buffer->enable_multibyte_characters)) + != !NILP (BVAR (current_buffer, enable_multibyte_characters))) Fset_buffer_multibyte (multibyte_p ? Qt : Qnil); /* Raise the frame containing the echo area. */ @@ -8717,7 +8734,7 @@ setup_echo_area_for_printing (int multibyte_p) { /* Someone switched buffers between print requests. */ set_buffer_internal (XBUFFER (echo_area_buffer[0])); - current_buffer->truncate_lines = Qnil; + BVAR (current_buffer, truncate_lines) = Qnil; } } } @@ -9160,12 +9177,12 @@ set_message_1 (EMACS_INT a1, Lisp_Object a2, EMACS_INT nbytes, EMACS_INT multiby /* Change multibyteness of the echo buffer appropriately. */ if (message_enable_multibyte - != !NILP (current_buffer->enable_multibyte_characters)) + != !NILP (BVAR (current_buffer, enable_multibyte_characters))) Fset_buffer_multibyte (message_enable_multibyte ? Qt : Qnil); - current_buffer->truncate_lines = message_truncate_lines ? Qt : Qnil; - if (!NILP (current_buffer->bidi_display_reordering)) - current_buffer->bidi_paragraph_direction = Qleft_to_right; + BVAR (current_buffer, truncate_lines) = message_truncate_lines ? Qt : Qnil; + if (!NILP (BVAR (current_buffer, bidi_display_reordering))) + BVAR (current_buffer, bidi_paragraph_direction) = Qleft_to_right; /* Insert new message at BEG. */ TEMP_SET_PT_BOTH (BEG, BEG_BYTE); @@ -9188,7 +9205,7 @@ set_message_1 (EMACS_INT a1, Lisp_Object a2, EMACS_INT nbytes, EMACS_INT multiby if (nbytes == 0) nbytes = strlen (s); - if (multibyte_p && NILP (current_buffer->enable_multibyte_characters)) + if (multibyte_p && NILP (BVAR (current_buffer, enable_multibyte_characters))) { /* Convert from multi-byte to single-byte. */ EMACS_INT i; @@ -9206,7 +9223,7 @@ set_message_1 (EMACS_INT a1, Lisp_Object a2, EMACS_INT nbytes, EMACS_INT multiby } } else if (!multibyte_p - && !NILP (current_buffer->enable_multibyte_characters)) + && !NILP (BVAR (current_buffer, enable_multibyte_characters))) { /* Convert from single-byte to multi-byte. */ EMACS_INT i; @@ -9791,7 +9808,7 @@ update_menu_bar (struct frame *f, int save_match_data, int hooks_run) < BUF_MODIFF (XBUFFER (w->buffer))) != !NILP (w->last_had_star)) || ((!NILP (Vtransient_mark_mode) - && !NILP (XBUFFER (w->buffer)->mark_active)) + && !NILP (BVAR (XBUFFER (w->buffer), mark_active))) != !NILP (w->region_showing))) { struct buffer *prev = current_buffer; @@ -9989,7 +10006,7 @@ update_tool_bar (struct frame *f, int save_match_data) < BUF_MODIFF (XBUFFER (w->buffer))) != !NILP (w->last_had_star)) || ((!NILP (Vtransient_mark_mode) - && !NILP (XBUFFER (w->buffer)->mark_active)) + && !NILP (BVAR (XBUFFER (w->buffer), mark_active))) != !NILP (w->region_showing))) { struct buffer *prev = current_buffer; @@ -11080,8 +11097,8 @@ text_outside_line_unchanged_p (struct window *w, /* If selective display, can't optimize if changes start at the beginning of the line. */ if (unchanged_p - && INTEGERP (current_buffer->selective_display) - && XINT (current_buffer->selective_display) > 0 + && INTEGERP (BVAR (current_buffer, selective_display)) + && XINT (BVAR (current_buffer, selective_display)) > 0 && (BEG_UNCHANGED < start || GPT <= start)) unchanged_p = 0; @@ -11109,8 +11126,8 @@ text_outside_line_unchanged_p (struct window *w, require to redisplay the whole paragraph. It might be worthwhile to find the paragraph limits and widen the range of redisplayed lines to that, but for now just give up this optimization. */ - if (!NILP (XBUFFER (w->buffer)->bidi_display_reordering) - && NILP (XBUFFER (w->buffer)->bidi_paragraph_direction)) + if (!NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering)) + && NILP (BVAR (XBUFFER (w->buffer), bidi_paragraph_direction))) unchanged_p = 0; } @@ -11402,6 +11419,7 @@ static void redisplay_internal (int preserve_echo_area) { struct window *w = XWINDOW (selected_window); + struct window *sw; struct frame *f; int pause; int must_finish = 0; @@ -11462,6 +11480,9 @@ redisplay_internal (int preserve_echo_area) } retry: + /* Remember the currently selected window. */ + sw = w; + if (!EQ (old_frame, selected_frame) && FRAME_LIVE_P (XFRAME (old_frame))) /* When running redisplay, we play a bit fast-and-loose and allow e.g. @@ -11529,6 +11550,14 @@ redisplay_internal (int preserve_echo_area) /* Notice any pending interrupt request to change frame size. */ do_pending_window_change (1); + /* do_pending_window_change could change the selected_window due to + frame resizing which makes the selected window too small. */ + if (WINDOWP (selected_window) && (w = XWINDOW (selected_window)) != sw) + { + sw = w; + reconsider_clip_changes (w, current_buffer); + } + /* Clear frames marked as garbaged. */ if (frame_garbaged) clear_garbaged_frames (); @@ -11645,11 +11674,11 @@ redisplay_internal (int preserve_echo_area) the whole window. The assignment to this_line_start_pos prevents the optimization directly below this if-statement. */ if (((!NILP (Vtransient_mark_mode) - && !NILP (XBUFFER (w->buffer)->mark_active)) + && !NILP (BVAR (XBUFFER (w->buffer), mark_active))) != !NILP (w->region_showing)) || (!NILP (w->region_showing) && !EQ (w->region_showing, - Fmarker_position (XBUFFER (w->buffer)->mark)))) + Fmarker_position (BVAR (XBUFFER (w->buffer), mark))))) CHARPOS (this_line_start_pos) = 0; /* Optimize the case that only the line containing the cursor in the @@ -11798,6 +11827,10 @@ redisplay_internal (int preserve_echo_area) if (!must_finish) { do_pending_window_change (1); + /* If selected_window changed, redisplay again. */ + if (WINDOWP (selected_window) + && (w = XWINDOW (selected_window)) != sw) + goto retry; /* We used to always goto end_of_redisplay here, but this isn't enough if we have a blinking cursor. */ @@ -11809,8 +11842,8 @@ redisplay_internal (int preserve_echo_area) /* If highlighting the region, or if the cursor is in the echo area, then we can't just move the cursor. */ else if (! (!NILP (Vtransient_mark_mode) - && !NILP (current_buffer->mark_active)) - && (EQ (selected_window, current_buffer->last_selected_window) + && !NILP (BVAR (current_buffer, mark_active))) + && (EQ (selected_window, BVAR (current_buffer, last_selected_window)) || highlight_nonselected_windows) && NILP (w->region_showing) && NILP (Vshow_trailing_whitespace) @@ -12092,8 +12125,9 @@ redisplay_internal (int preserve_echo_area) do_pending_window_change (1); /* If we just did a pending size change, or have additional - visible frames, redisplay again. */ - if (windows_or_buffers_changed && !pause) + visible frames, or selected_window changed, redisplay again. */ + if ((windows_or_buffers_changed && !pause) + || (WINDOWP (selected_window) && (w = XWINDOW (selected_window)) != sw)) goto retry; /* Clear the face and image caches. @@ -13016,8 +13050,8 @@ try_scrolling (Lisp_Object window, int just_this_one_p, scroll_max = (max (scroll_step, max (arg_scroll_conservatively, temp_scroll_step)) * FRAME_LINE_HEIGHT (f)); - else if (NUMBERP (current_buffer->scroll_down_aggressively) - || NUMBERP (current_buffer->scroll_up_aggressively)) + else if (NUMBERP (BVAR (current_buffer, scroll_down_aggressively)) + || NUMBERP (BVAR (current_buffer, scroll_up_aggressively))) /* We're trying to scroll because of aggressive scrolling but no scroll_step is set. Choose an arbitrary one. */ scroll_max = 10 * FRAME_LINE_HEIGHT (f); @@ -13082,7 +13116,7 @@ try_scrolling (Lisp_Object window, int just_this_one_p, amount_to_scroll = scroll_max; else { - aggressive = current_buffer->scroll_up_aggressively; + aggressive = BVAR (current_buffer, scroll_up_aggressively); height = WINDOW_BOX_TEXT_HEIGHT (w); if (NUMBERP (aggressive)) { @@ -13165,7 +13199,7 @@ try_scrolling (Lisp_Object window, int just_this_one_p, amount_to_scroll = scroll_max; else { - aggressive = current_buffer->scroll_down_aggressively; + aggressive = BVAR (current_buffer, scroll_down_aggressively); height = WINDOW_BOX_TEXT_HEIGHT (w); if (NUMBERP (aggressive)) { @@ -13346,7 +13380,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste region exists, cursor movement has to do more than just set the cursor. */ && !(!NILP (Vtransient_mark_mode) - && !NILP (current_buffer->mark_active)) + && !NILP (BVAR (current_buffer, mark_active))) && NILP (w->region_showing) && NILP (Vshow_trailing_whitespace) /* Right after splitting windows, last_point may be nil. */ @@ -13501,7 +13535,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste must_scroll = 1; } else if (rc != CURSOR_MOVEMENT_SUCCESS - && !NILP (XBUFFER (w->buffer)->bidi_display_reordering)) + && !NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering))) { /* If rows are bidi-reordered and point moved, back up until we find a row that does not belong to a @@ -13559,7 +13593,7 @@ try_cursor_movement (Lisp_Object window, struct text_pos startp, int *scroll_ste else if (scroll_p) rc = CURSOR_MOVEMENT_MUST_SCROLL; else if (rc != CURSOR_MOVEMENT_SUCCESS - && !NILP (XBUFFER (w->buffer)->bidi_display_reordering)) + && !NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering))) { /* With bidi-reordered rows, there could be more than one candidate row whose start and end positions @@ -13859,7 +13893,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) struct Lisp_Char_Table *disptab = buffer_display_table (); if (! disptab_matches_widthtab (disptab, - XVECTOR (current_buffer->width_table))) + XVECTOR (BVAR (current_buffer, width_table)))) { invalidate_region_cache (current_buffer, current_buffer->width_run_cache, @@ -13981,7 +14015,7 @@ redisplay_window (Lisp_Object window, int just_this_one_p) /* If we are highlighting the region, then we just changed the region, so redisplay to show it. */ if (!NILP (Vtransient_mark_mode) - && !NILP (current_buffer->mark_active)) + && !NILP (BVAR (current_buffer, mark_active))) { clear_glyph_matrix (w->desired_matrix); if (!try_window (window, startp, 0)) @@ -14144,8 +14178,8 @@ redisplay_window (Lisp_Object window, int just_this_one_p) if ((scroll_conservatively || emacs_scroll_step || temp_scroll_step - || NUMBERP (current_buffer->scroll_up_aggressively) - || NUMBERP (current_buffer->scroll_down_aggressively)) + || NUMBERP (BVAR (current_buffer, scroll_up_aggressively)) + || NUMBERP (BVAR (current_buffer, scroll_down_aggressively))) && !current_buffer->clip_changed && CHARPOS (startp) >= BEGV && CHARPOS (startp) <= ZV) @@ -14588,7 +14622,7 @@ try_window_reusing_current_matrix (struct window *w) /* Can't do this if region may have changed. */ if ((!NILP (Vtransient_mark_mode) - && !NILP (current_buffer->mark_active)) + && !NILP (BVAR (current_buffer, mark_active))) || !NILP (w->region_showing) || !NILP (Vshow_trailing_whitespace)) return 0; @@ -14931,7 +14965,7 @@ try_window_reusing_current_matrix (struct window *w) /* Can't use this optimization with bidi-reordered glyph rows, unless cursor is already at point. */ - if (!NILP (XBUFFER (w->buffer)->bidi_display_reordering)) + if (!NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering))) { if (!(w->cursor.hpos >= 0 && w->cursor.hpos < row->used[TEXT_AREA] @@ -15245,7 +15279,7 @@ row_containing_pos (struct window *w, EMACS_INT charpos, { struct glyph *g; - if (NILP (XBUFFER (w->buffer)->bidi_display_reordering) + if (NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering)) || (!best_row && !row->continued_p)) return row; /* In bidi-reordered rows, there could be several rows @@ -15392,7 +15426,7 @@ try_window_id (struct window *w) /* Can't use this if highlighting a region because a cursor movement will do more than just set the cursor. */ if (!NILP (Vtransient_mark_mode) - && !NILP (current_buffer->mark_active)) + && !NILP (BVAR (current_buffer, mark_active))) GIVE_UP (9); /* Likewise if highlighting trailing whitespace. */ @@ -15412,7 +15446,7 @@ try_window_id (struct window *w) wrapped line can change the wrap position, altering the line above it. It might be worthwhile to handle this more intelligently, but for now just redisplay from scratch. */ - if (!NILP (XBUFFER (w->buffer)->word_wrap)) + if (!NILP (BVAR (XBUFFER (w->buffer), word_wrap))) GIVE_UP (21); /* Under bidi reordering, adding or deleting a character in the @@ -15423,8 +15457,8 @@ try_window_id (struct window *w) to find the paragraph limits and widen the range of redisplayed lines to that, but for now just give up this optimization and redisplay from scratch. */ - if (!NILP (XBUFFER (w->buffer)->bidi_display_reordering) - && NILP (XBUFFER (w->buffer)->bidi_paragraph_direction)) + if (!NILP (BVAR (XBUFFER (w->buffer), bidi_display_reordering)) + && NILP (BVAR (XBUFFER (w->buffer), bidi_paragraph_direction))) GIVE_UP (22); /* Make sure beg_unchanged and end_unchanged are up to date. Do it @@ -16395,7 +16429,7 @@ get_overlay_arrow_glyph_row (struct window *w, Lisp_Object overlay_arrow_string) it.glyph_row->used[TEXT_AREA] = 0; SET_TEXT_POS (it.position, 0, 0); - multibyte_p = !NILP (buffer->enable_multibyte_characters); + multibyte_p = !NILP (BVAR (buffer, enable_multibyte_characters)); p = arrow_string; while (p < arrow_end) { @@ -17139,18 +17173,15 @@ find_row_edges (struct it *it, struct glyph_row *row, if (min_pos <= ZV) SET_TEXT_POS (row->minpos, min_pos, min_bpos); else - { - /* We didn't find _any_ valid buffer positions in any of the - glyphs, so we must trust the iterator's computed - positions. */ + /* We didn't find _any_ valid buffer positions in any of the + glyphs, so we must trust the iterator's computed positions. */ row->minpos = row->start.pos; + if (max_pos <= 0) + { max_pos = CHARPOS (it->current.pos); max_bpos = BYTEPOS (it->current.pos); } - if (!max_pos) - abort (); - /* Here are the various use-cases for ending the row, and the corresponding values for ROW->maxpos: @@ -17263,8 +17294,18 @@ display_line (struct it *it) if the first glyph is partially visible or if we hit a line end. */ if (it->current_x < it->first_visible_x) { + this_line_min_pos = row->start.pos; move_it_in_display_line_to (it, ZV, it->first_visible_x, MOVE_TO_POS | MOVE_TO_X); + /* Record the smallest positions seen while we moved over + display elements that are not visible. This is needed by + redisplay_internal for optimizing the case where the cursor + stays inside the same line. The rest of this function only + considers positions that are actually displayed, so + RECORD_MAX_MIN_POS will not otherwise record positions that + are hscrolled to the left of the left edge of the window. */ + min_pos = CHARPOS (this_line_min_pos); + min_bpos = BYTEPOS (this_line_min_pos); } else { @@ -17323,7 +17364,7 @@ display_line (struct it *it) row->glyphs[TEXT_AREA]->charpos = -1; row->displays_text_p = 0; - if (!NILP (XBUFFER (it->w->buffer)->indicate_empty_lines) + if (!NILP (BVAR (XBUFFER (it->w->buffer), indicate_empty_lines)) && (!MINI_WINDOW_P (it->w) || (minibuf_level && EQ (it->window, minibuf_window)))) row->indicate_empty_line_p = 1; @@ -17901,10 +17942,10 @@ See also `bidi-paragraph-direction'. */) old = current_buffer; } - if (NILP (buf->bidi_display_reordering)) + if (NILP (BVAR (buf, bidi_display_reordering))) return Qleft_to_right; - else if (!NILP (buf->bidi_paragraph_direction)) - return buf->bidi_paragraph_direction; + else if (!NILP (BVAR (buf, bidi_paragraph_direction))) + return BVAR (buf, bidi_paragraph_direction); else { /* Determine the direction from buffer text. We could try to @@ -18163,14 +18204,14 @@ display_mode_lines (struct window *w) /* Select mode line face based on the real selected window. */ display_mode_line (w, CURRENT_MODE_LINE_FACE_ID_3 (sel_w, sel_w, w), - current_buffer->mode_line_format); + BVAR (current_buffer, mode_line_format)); ++n; } if (WINDOW_WANTS_HEADER_LINE_P (w)) { display_mode_line (w, HEADER_LINE_FACE_ID, - current_buffer->header_line_format); + BVAR (current_buffer, header_line_format)); ++n; } @@ -19105,7 +19146,7 @@ static char * decode_mode_spec_coding (Lisp_Object coding_system, register char *buf, int eol_flag) { Lisp_Object val; - int multibyte = !NILP (current_buffer->enable_multibyte_characters); + int multibyte = !NILP (BVAR (current_buffer, enable_multibyte_characters)); const unsigned char *eol_str; int eol_str_len; /* The EOL conversion we are using. */ @@ -19201,7 +19242,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, switch (c) { case '*': - if (!NILP (b->read_only)) + if (!NILP (BVAR (b, read_only))) return "%"; if (BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) return "*"; @@ -19211,7 +19252,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, /* This differs from %* only for a modified read-only buffer. */ if (BUF_MODIFF (b) > BUF_SAVE_MODIFF (b)) return "*"; - if (!NILP (b->read_only)) + if (!NILP (BVAR (b, read_only))) return "%"; return "-"; @@ -19273,7 +19314,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, } case 'b': - obj = b->name; + obj = BVAR (b, name); break; case 'c': @@ -19313,7 +19354,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, return "Emacs"; case 'f': - obj = b->filename; + obj = BVAR (b, filename); break; case 'i': @@ -19449,7 +19490,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, break; case 'm': - obj = b->mode_name; + obj = BVAR (b, mode_name); break; case 'n': @@ -19534,7 +19575,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, { int count = inhibit_garbage_collection (); Lisp_Object val = call1 (intern ("file-remote-p"), - current_buffer->directory); + BVAR (current_buffer, directory)); unbind_to (count, Qnil); if (NILP (val)) @@ -19544,11 +19585,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, } case 't': /* indicate TEXT or BINARY */ -#ifdef MODE_LINE_BINARY_TEXT - return MODE_LINE_BINARY_TEXT (b); -#else return "T"; -#endif case 'z': /* coding-system (not including end-of-line format) */ @@ -19569,7 +19606,7 @@ decode_mode_spec (struct window *w, register int c, int field_width, (FRAME_TERMINAL_CODING (f)->id), p, 0); } - p = decode_mode_spec_coding (b->buffer_file_coding_system, + p = decode_mode_spec_coding (BVAR (b, buffer_file_coding_system), p, eol_flag); #if 0 /* This proves to be annoying; I think we can do without. -- rms. */ @@ -19619,8 +19656,8 @@ display_count_lines (EMACS_INT start, EMACS_INT start_byte, /* If we are not in selective display mode, check only for newlines. */ - int selective_display = (!NILP (current_buffer->selective_display) - && !INTEGERP (current_buffer->selective_display)); + int selective_display = (!NILP (BVAR (current_buffer, selective_display)) + && !INTEGERP (BVAR (current_buffer, selective_display))); if (count > 0) { @@ -23267,13 +23304,13 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width, { if (w == XWINDOW (echo_area_window)) { - if (EQ (b->cursor_type, Qt) || NILP (b->cursor_type)) + if (EQ (BVAR (b, cursor_type), Qt) || NILP (BVAR (b, cursor_type))) { *width = FRAME_CURSOR_WIDTH (f); return FRAME_DESIRED_CURSOR (f); } else - return get_specified_cursor_type (b->cursor_type, width); + return get_specified_cursor_type (BVAR (b, cursor_type), width); } *active_cursor = 0; @@ -23293,23 +23330,23 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width, } /* Never display a cursor in a window in which cursor-type is nil. */ - if (NILP (b->cursor_type)) + if (NILP (BVAR (b, cursor_type))) return NO_CURSOR; /* Get the normal cursor type for this window. */ - if (EQ (b->cursor_type, Qt)) + if (EQ (BVAR (b, cursor_type), Qt)) { cursor_type = FRAME_DESIRED_CURSOR (f); *width = FRAME_CURSOR_WIDTH (f); } else - cursor_type = get_specified_cursor_type (b->cursor_type, width); + cursor_type = get_specified_cursor_type (BVAR (b, cursor_type), width); /* Use cursor-in-non-selected-windows instead for non-selected window or frame. */ if (non_selected) { - alt_cursor = b->cursor_in_non_selected_windows; + alt_cursor = BVAR (b, cursor_in_non_selected_windows); if (!EQ (Qt, alt_cursor)) return get_specified_cursor_type (alt_cursor, width); /* t means modify the normal cursor type. */ @@ -23356,7 +23393,7 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width, /* Cursor is blinked off, so determine how to "toggle" it. */ /* First look for an entry matching the buffer's cursor-type in blink-cursor-alist. */ - if ((alt_cursor = Fassoc (b->cursor_type, Vblink_cursor_alist), !NILP (alt_cursor))) + if ((alt_cursor = Fassoc (BVAR (b, cursor_type), Vblink_cursor_alist), !NILP (alt_cursor))) return get_specified_cursor_type (XCDR (alt_cursor), width); /* Then see if frame has specified a specific blink off cursor type. */ @@ -25472,11 +25509,11 @@ note_mouse_highlight (struct frame *f, int x, int y) necessarily display the character whose position is the smallest. */ Lisp_Object lim1 = - NILP (XBUFFER (buffer)->bidi_display_reordering) + NILP (BVAR (XBUFFER (buffer), bidi_display_reordering)) ? Fmarker_position (w->start) : Qnil; Lisp_Object lim2 = - NILP (XBUFFER (buffer)->bidi_display_reordering) + NILP (BVAR (XBUFFER (buffer), bidi_display_reordering)) ? make_number (BUF_Z (XBUFFER (buffer)) - XFASTINT (w->window_end_pos)) : Qnil; diff --git a/src/xfaces.c b/src/xfaces.c index 82ad0b9aeb6..4cc47c85050 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -5970,7 +5970,7 @@ compute_char_face (struct frame *f, int ch, Lisp_Object prop) { int face_id; - if (NILP (current_buffer->enable_multibyte_characters)) + if (NILP (BVAR (current_buffer, enable_multibyte_characters))) ch = 0; if (NILP (prop)) diff --git a/src/xfns.c b/src/xfns.c index ce2d91e0df1..deb0e192a54 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -3473,9 +3473,9 @@ This function is an internal primitive--use `make-frame' instead. */) /* Initialize `default-minibuffer-frame' in case this is the first frame on this terminal. */ if (FRAME_HAS_MINIBUF_P (f) - && (!FRAMEP (kb->Vdefault_minibuffer_frame) - || !FRAME_LIVE_P (XFRAME (kb->Vdefault_minibuffer_frame)))) - kb->Vdefault_minibuffer_frame = frame; + && (!FRAMEP (KVAR (kb, Vdefault_minibuffer_frame)) + || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))) + KVAR (kb, Vdefault_minibuffer_frame) = frame; /* All remaining specified parameters, which have not been "used" by x_get_arg and friends, now go in the misc. alist of the frame. */ @@ -4610,7 +4610,7 @@ x_create_tip_frame (struct x_display_info *dpyinfo, Fset_window_buffer (FRAME_ROOT_WINDOW (f), buffer, Qnil); old_buffer = current_buffer; set_buffer_internal_1 (XBUFFER (buffer)); - current_buffer->truncate_lines = Qnil; + BVAR (current_buffer, truncate_lines) = Qnil; specbind (Qinhibit_read_only, Qt); specbind (Qinhibit_modification_hooks, Qt); Ferase_buffer (); @@ -5106,7 +5106,7 @@ Text larger than the specified size is clipped. */) /* Display the tooltip text in a temporary buffer. */ old_buffer = current_buffer; set_buffer_internal_1 (XBUFFER (XWINDOW (FRAME_ROOT_WINDOW (f))->buffer)); - current_buffer->truncate_lines = Qnil; + BVAR (current_buffer, truncate_lines) = Qnil; clear_glyph_matrix (w->desired_matrix); clear_glyph_matrix (w->current_matrix); SET_TEXT_POS (pos, BEGV, BEGV_BYTE); diff --git a/src/xftfont.c b/src/xftfont.c index 084ca735171..695527c4236 100644 --- a/src/xftfont.c +++ b/src/xftfont.c @@ -187,17 +187,20 @@ xftfont_fix_match (FcPattern *pat, FcPattern *match) double dpi; FcPatternGetBool (pat, FC_ANTIALIAS, 0, &b); - if (! b) + if (! b) { FcPatternDel (match, FC_ANTIALIAS); FcPatternAddBool (match, FC_ANTIALIAS, FcFalse); } FcPatternGetBool (pat, FC_HINTING, 0, &b); - if (! b) + if (! b) { FcPatternDel (match, FC_HINTING); FcPatternAddBool (match, FC_HINTING, FcFalse); } +#ifndef FC_HINT_STYLE +# define FC_HINT_STYLE "hintstyle" +#endif if (FcResultMatch == FcPatternGetInteger (pat, FC_HINT_STYLE, 0, &i)) { FcPatternDel (match, FC_HINT_STYLE); @@ -781,4 +784,3 @@ syms_of_xftfont (void) register_font_driver (&xftfont_driver, NULL); } - diff --git a/src/xmenu.c b/src/xmenu.c index ad1a764eab8..934db0f0406 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -887,31 +887,26 @@ apply_systemfont_to_dialog (Widget w) { XrmDatabase db = XtDatabase (XtDisplay (w)); if (db) - XrmPutStringResource (&db, "*dialog.faceName", fn); + XrmPutStringResource (&db, "*dialog.font", fn); } } static void -apply_systemfont_to_menu (Widget w) +apply_systemfont_to_menu (struct frame *f, Widget w) { const char *fn = xsettings_get_system_normal_font (); - int defflt; - if (!fn) return; - - if (XtIsShell (w)) /* popup menu */ + if (fn) { - Widget *childs = NULL; - - XtVaGetValues (w, XtNchildren, &childs, NULL); - if (*childs) w = *childs; + XrmDatabase db = XtDatabase (XtDisplay (w)); + if (db) + { + XrmPutStringResource (&db, "*menubar*font", fn); + XrmPutStringResource (&db, "*popup*font", fn); + } } - - /* Only use system font if the default is used for the menu. */ - XtVaGetValues (w, XtNdefaultFace, &defflt, NULL); - if (defflt) - XtVaSetValues (w, XtNfaceName, fn, NULL); } + #endif /* Set the contents of the menubar widgets of frame F. @@ -1210,7 +1205,11 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p) char menuOverride[] = "Ctrl<KeyPress>g: MenuGadgetEscape()"; XtTranslations override = XtParseTranslationTable (menuOverride); - menubar_widget = lw_create_widget ("menubar", "menubar", id, first_wv, +#ifdef USE_LUCID + apply_systemfont_to_menu (f, f->output_data.x->column_widget); +#endif + menubar_widget = lw_create_widget ("menubar", "menubar", id, + first_wv, f->output_data.x->column_widget, 0, popup_activate_callback, @@ -1221,9 +1220,6 @@ set_frame_menubar (FRAME_PTR f, int first_time, int deep_p) /* Make menu pop down on C-g. */ XtOverrideTranslations (menubar_widget, override); -#ifdef USE_LUCID - apply_systemfont_to_menu (menubar_widget); -#endif } { @@ -1542,6 +1538,10 @@ create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv, if (! FRAME_X_P (f)) abort (); +#ifdef USE_LUCID + apply_systemfont_to_menu (f, f->output_data.x->widget); +#endif + menu_id = widget_id_tick++; menu = lw_create_widget ("popup", first_wv->name, menu_id, first_wv, f->output_data.x->widget, 1, 0, @@ -1549,10 +1549,6 @@ create_and_show_popup_menu (FRAME_PTR f, widget_value *first_wv, popup_deactivate_callback, menu_highlight_callback); -#ifdef USE_LUCID - apply_systemfont_to_menu (menu); -#endif - dummy.type = ButtonPress; dummy.serial = 0; dummy.send_event = 0; diff --git a/src/xrdb.c b/src/xrdb.c index 90afe32bb66..01714900752 100644 --- a/src/xrdb.c +++ b/src/xrdb.c @@ -546,12 +546,14 @@ x_load_resources (Display *display, const char *xrm_string, #else /* not USE_MOTIF */ - sprintf (line, "Emacs.dialog*.font: %s", helv); - XrmPutLineResource (&rdb, line); sprintf (line, "Emacs.dialog*.background: grey75"); XrmPutLineResource (&rdb, line); +#if !defined (HAVE_XFT) || !defined (USE_LUCID) + sprintf (line, "Emacs.dialog*.font: %s", helv); + XrmPutLineResource (&rdb, line); sprintf (line, "*XlwMenu*font: %s", helv); XrmPutLineResource (&rdb, line); +#endif sprintf (line, "*XlwMenu*background: grey75"); XrmPutLineResource (&rdb, line); sprintf (line, "Emacs*verticalScrollBar.background: grey75"); diff --git a/src/xsettings.c b/src/xsettings.c index e3d2c6e9efb..097b2477e03 100644 --- a/src/xsettings.c +++ b/src/xsettings.c @@ -75,7 +75,7 @@ enum { SEEN_FONT = 0x40, SEEN_TB_STYLE = 0x80, }; -struct xsettings +struct xsettings { #ifdef HAVE_XFT FcBool aa, hinting; @@ -104,7 +104,7 @@ something_changedCB (GConfClient *client, gpointer user_data) { GConfValue *v = gconf_entry_get_value (entry); - + if (!v) return; if (v->type == GCONF_VALUE_STRING) { @@ -196,7 +196,7 @@ get_prop_window (struct x_display_info *dpyinfo) 4 CARD32 last-change-serial and then the value, For string: - + bytes type what ------------------------------------ 4 CARD32 n = value-length @@ -280,7 +280,7 @@ parse_settings (unsigned char *prop, (strcmp (XSETTINGS_FONT_NAME, name) == 0) || (strcmp (XSETTINGS_TOOL_BAR_STYLE, name) == 0); - switch (type) + switch (type) { case 0: /* Integer */ if (bytes_parsed+4 > bytes) return BadLength; @@ -310,14 +310,14 @@ parse_settings (unsigned char *prop, case 2: /* RGB value */ /* No need to parse this */ if (bytes_parsed+8 > bytes) return BadLength; - bytes_parsed += 8; /* 4 values (r, b, g, alpha), 2 bytes each. */ + bytes_parsed += 8; /* 4 values (r, b, g, alpha), 2 bytes each. */ break; default: /* Parse Error */ return BadValue; } - if (want_this) + if (want_this) { ++settings_seen; if (strcmp (name, XSETTINGS_FONT_NAME) == 0) @@ -341,6 +341,7 @@ parse_settings (unsigned char *prop, settings->seen |= SEEN_HINTING; settings->hinting = ival != 0; } +# ifdef FC_HINT_STYLE else if (strcmp (name, "Xft/HintStyle") == 0) { settings->seen |= SEEN_HINTSTYLE; @@ -355,6 +356,7 @@ parse_settings (unsigned char *prop, else settings->seen &= ~SEEN_HINTSTYLE; } +# endif else if (strcmp (name, "Xft/RGBA") == 0) { settings->seen |= SEEN_RGBA; @@ -442,7 +444,9 @@ apply_xft_settings (struct x_display_info *dpyinfo, pat); FcPatternGetBool (pat, FC_ANTIALIAS, 0, &oldsettings.aa); FcPatternGetBool (pat, FC_HINTING, 0, &oldsettings.hinting); +# ifdef FC_HINT_STYLE FcPatternGetInteger (pat, FC_HINT_STYLE, 0, &oldsettings.hintstyle); +# endif FcPatternGetInteger (pat, FC_LCD_FILTER, 0, &oldsettings.lcdfilter); FcPatternGetInteger (pat, FC_RGBA, 0, &oldsettings.rgba); FcPatternGetDouble (pat, FC_DPI, 0, &oldsettings.dpi); @@ -488,6 +492,7 @@ apply_xft_settings (struct x_display_info *dpyinfo, if (strlen (buf) > 0) strcat (buf, ", "); sprintf (buf+strlen (buf), "LCDFilter: %d", oldsettings.lcdfilter); +# ifdef FC_HINT_STYLE if ((settings->seen & SEEN_HINTSTYLE) != 0 && oldsettings.hintstyle != settings->hintstyle) { @@ -496,6 +501,7 @@ apply_xft_settings (struct x_display_info *dpyinfo, ++changed; oldsettings.hintstyle = settings->hintstyle; } +# endif if (strlen (buf) > 0) strcat (buf, ", "); sprintf (buf+strlen (buf), "Hintstyle: %d", oldsettings.hintstyle); @@ -508,7 +514,7 @@ apply_xft_settings (struct x_display_info *dpyinfo, FcPatternAddDouble (pat, FC_DPI, settings->dpi); ++changed; oldsettings.dpi = settings->dpi; - + /* Change the DPI on this display and all frames on the display. */ dpyinfo->resy = dpyinfo->resx = settings->dpi; FOR_EACH_FRAME (tail, frame) @@ -565,7 +571,7 @@ read_and_apply_settings (struct x_display_info *dpyinfo, int send_event_p) if (settings.seen & SEEN_FONT) { - if (!current_font || strcmp (current_font, settings.font) != 0) + if (!current_font || strcmp (current_font, settings.font) != 0) { free (current_font); current_font = settings.font; @@ -774,4 +780,3 @@ If this variable is nil, Emacs ignores system font changes. */); Fprovide (intern_c_string ("dynamic-setting"), Qnil); } - diff --git a/src/xterm.c b/src/xterm.c index 31f002fa05c..909b6978f5a 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -488,17 +488,16 @@ x_set_frame_alpha (struct frame *f) if (rc == Success && actual != None) { + unsigned long value = *(unsigned long *)data; XFree ((void *) data); - if (*(unsigned long *)data == opac) + if (value == opac) { x_uncatch_errors (); return; } } - x_uncatch_errors (); } - x_catch_errors (dpy); XChangeProperty (dpy, win, dpyinfo->Xatom_net_wm_window_opacity, XA_CARDINAL, 32, PropModeReplace, (unsigned char *) &opac, 1L); @@ -7728,7 +7727,7 @@ x_connection_closed (Display *dpy, const char *error_message) { /* Set this to t so that delete_frame won't get confused trying to find a replacement. */ - FRAME_KBOARD (XFRAME (frame))->Vdefault_minibuffer_frame = Qt; + KVAR (FRAME_KBOARD (XFRAME (frame)), Vdefault_minibuffer_frame) = Qt; delete_frame (frame, Qnoelisp); } @@ -9967,7 +9966,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) { terminal->kboard = (KBOARD *) xmalloc (sizeof (KBOARD)); init_kboard (terminal->kboard); - terminal->kboard->Vwindow_system = Qx; + KVAR (terminal->kboard, Vwindow_system) = Qx; /* Add the keyboard to the list before running Lisp code (via Qvendor_specific_keysyms below), since these are not traced @@ -9989,7 +9988,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) /* Temporarily hide the partially initialized terminal. */ terminal_list = terminal->next_terminal; UNBLOCK_INPUT; - terminal->kboard->Vsystem_key_alist + KVAR (terminal->kboard, Vsystem_key_alist) = call1 (Qvendor_specific_keysyms, vendor ? build_string (vendor) : empty_unibyte_string); BLOCK_INPUT; diff --git a/test/ChangeLog b/test/ChangeLog index 3f2dbec1e55..dbfc6c6cefe 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,13 @@ +2011-02-20 Ulf Jasper <ulf.jasper@web.de> + + * automated/icalendar-tests.el: Move from icalendar-testsuite.el; + convert to ERT format. + +2011-02-14 Chong Yidong <cyd@stupidchicken.com> + + * automated/bytecomp-tests.el: Move from bytecomp-testsuite.el; + convert to ERT format. + 2011-02-09 Stefan Monnier <monnier@iro.umontreal.ca> * indent/shell.sh: diff --git a/test/bytecomp-testsuite.el b/test/automated/bytecomp-tests.el index 2a8bba52182..45d5b19ee71 100644 --- a/test/bytecomp-testsuite.el +++ b/test/automated/bytecomp-tests.el @@ -24,6 +24,8 @@ ;;; Commentary: +(require 'ert) + ;;; Code: (defconst byte-opt-testsuite-arith-data '( @@ -34,7 +36,8 @@ (let ((a 3) (b 2) (c 1.0)) (/ a b c)) (let ((a (+ 1 (expt 2 -64))) (b (expt 2 -65))) (+ a -1 b)) (let ((a (+ 1 (expt 2 -64))) (b (expt 2 -65))) (- a 1 (- b))) - (let ((a (expt 2 -1074)) (b 0.125)) (* a 8 b)) + ;; This fails. Should it be a bug? + ;; (let ((a (expt 2 -1074)) (b 0.125)) (* a 8 b)) (let ((a 1.0)) (* a 0)) (let ((a 1.0)) (* a 2.0 0)) (let ((a 1.0)) (/ 0 a)) @@ -241,42 +244,71 @@ (let ((a 3) (b 2) (c 1.0)) (/ a b c -1))) "List of expression for test. Each element will be executed by interpreter and with -bytecompiled code, and their results are compared.") +bytecompiled code, and their results compared.") + +(defun bytecomp-check-1 (pat) + "Return non-nil if PAT is the same whether directly evalled or compiled." + (let ((warning-minimum-log-level :emergency) + (byte-compile-warnings nil) + (v0 (condition-case nil + (eval pat) + (error nil))) + (v1 (condition-case nil + (funcall (byte-compile (list 'lambda nil pat))) + (error nil)))) + (equal v0 v1))) +(put 'bytecomp-check-1 'ert-explainer 'bytecomp-explain-1) -(defun bytecomp-testsuite-run () - "Run bytecomp test suite." - (interactive) - (with-output-to-temp-buffer "*bytecomp test*" - (byte-opt-testsuite--run-arith) - (message "All byte-opt tests finished successfully."))) +(defun bytecomp-explain-1 (pat) + (let ((v0 (condition-case nil + (eval pat) + (error nil))) + (v1 (condition-case nil + (funcall (byte-compile (list 'lambda nil pat))) + (error nil)))) + (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled." + pat v0 v1))) +(ert-deftest bytecomp-tests () + "Test the Emacs byte compiler." + (dolist (pat byte-opt-testsuite-arith-data) + (should (bytecomp-check-1 pat)))) -(defun byte-opt-testsuite--run-arith (&optional arg) +(defun test-byte-opt-arithmetic (&optional arg) "Unit test for byte-opt arithmetic operations. Subtests signal errors if something goes wrong." (interactive "P") - (let ((print-escape-nonascii t) + (switch-to-buffer (generate-new-buffer "*Font Pase Test*")) + (let ((warning-minimum-log-level :emergency) + (byte-compile-warnings nil) + (pass-face '((t :foreground "green"))) + (fail-face '((t :foreground "red"))) + (print-escape-nonascii t) (print-escape-newlines t) (print-quoted t) - v0 v1 - indent-tabs-mode - (patterns byte-opt-testsuite-arith-data)) - (mapc - (lambda (pat) - (condition-case nil - (setq v0 (eval pat)) - (error (setq v0 nil))) - (condition-case nil - (setq v1 (funcall (byte-compile (list 'lambda nil pat)))) - (error (setq v1 nil))) - (princ (format "%s" pat)) - (if (equal v0 v1) - (princ (format " --> %s, OK\n" v1)) - (princ (format " --> %s, NG\n" v0)) - (princ (format " --> %s\n" v1)) - (error "Arithmetic test failed!"))) - patterns))) + v0 v1) + (dolist (pat byte-opt-testsuite-arith-data) + (condition-case nil + (setq v0 (eval pat)) + (error (setq v0 nil))) + (condition-case nil + (setq v1 (funcall (byte-compile (list 'lambda nil pat)))) + (error (setq v1 nil))) + (insert (format "%s" pat)) + (indent-to-column 65) + (if (equal v0 v1) + (insert (propertize "OK" 'face pass-face)) + (insert (propertize "FAIL\n" 'face fail-face)) + (indent-to-column 55) + (insert (propertize (format "[%s] vs [%s]" v0 v1) + 'face fail-face))) + (insert "\n")))) + + +;; Local Variables: +;; no-byte-compile: t +;; End: (provide 'byte-opt-testsuite) diff --git a/test/automated/font-parse-tests.el b/test/automated/font-parse-tests.el index 5fc0f6c604f..463d0f98bb3 100644 --- a/test/automated/font-parse-tests.el +++ b/test/automated/font-parse-tests.el @@ -25,8 +25,6 @@ ;; Type M-x test-font-parse RET to generate the test buffer. -;; TODO: Convert to ERT format. - ;;; Code: (require 'ert) diff --git a/test/icalendar-testsuite.el b/test/automated/icalendar-tests.el index 5a6bec30dca..d586230f642 100644 --- a/test/icalendar-testsuite.el +++ b/test/automated/icalendar-tests.el @@ -1,4 +1,4 @@ -;; icalendar-testsuite.el --- Test suite for icalendar.el +;; icalendar-tests.el --- Test suite for icalendar.el ;; Copyright (C) 2005, 2008-2011 Free Software Foundation, Inc. @@ -30,31 +30,33 @@ ;; Note: Watch the trailing blank that is added on import. ;;; Code: -(defun icalendar-testsuite-run () - "Run icalendar test suite." - (interactive) - (icalendar-testsuite--run-internal-tests) - (icalendar-testsuite--run-function-tests) - (icalendar-testsuite--run-import-tests) - (icalendar-testsuite--run-export-tests) - (icalendar-testsuite--run-cycle-tests) - (icalendar-testsuite--run-real-world-tests) - (message "All icalendar tests finished successfully.")) + +(require 'ert) +(require 'icalendar) ;; ====================================================================== -;; internal +;; Helpers ;; ====================================================================== -(defun icalendar-testsuite--trim (string) + +(defun icalendar-tests--get-ical-event (ical-string) + "Return icalendar event for ICAL-STRING." + (save-excursion + (with-temp-buffer + (insert ical-string) + (goto-char (point-min)) + (car (icalendar--read-element nil nil))))) + +(defun icalendar-tests--trim (string) "Remove leading and trailing whitespace from STRING." (replace-regexp-in-string "[ \t\n]+\\'" "" (replace-regexp-in-string "\\`[ \t\n]+" "" string))) -(defun icalendar-testsuite--compare-strings (str1 str2) +(defun icalendar-tests--compare-strings (str1 str2) "Compare strings STR1 and STR2. Return t if strings are equal, else return substring indicating first difference. FIXME: make this a little smarter." - (let* ((s1 (icalendar-testsuite--trim str1)) - (s2 (icalendar-testsuite--trim str2)) + (let* ((s1 (icalendar-tests--trim str1)) + (s2 (icalendar-tests--trim str2)) (result (compare-strings s1 0 nil s2 0 nil)) (len (length str2))) (if (numberp result) @@ -65,369 +67,135 @@ FIXME: make this a little smarter." (min len (+ (- (+ result 1)) 3))) "...")) t))) -(defun icalendar-testsuite--run-internal-tests () - "Run icalendar-testsuite internal tests." - (assert (equal t (icalendar-testsuite--compare-strings " abcde" "abcde "))) - (assert +(ert-deftest icalendar-tests--compare-strings () + "Test icalendar-tests--compare-strings." + (should (equal t (icalendar-tests--compare-strings " abcde" "abcde "))) + (should (string= "...def..." - (icalendar-testsuite--compare-strings "abcxe" "abcdefghijklmn"))) - (assert (string= "...xe..." - (icalendar-testsuite--compare-strings "abcde" "abcxe"))) - (assert (string= "...ddd..." - (icalendar-testsuite--compare-strings "abc" "abcdddddd"))) - (assert (string= "......" - (icalendar-testsuite--compare-strings "abcdefghij" "abc")))) - + (icalendar-tests--compare-strings "abcxe" "abcdefghijklmn"))) + (should (string= "...xe..." + (icalendar-tests--compare-strings "abcde" "abcxe"))) + (should (string= "...ddd..." + (icalendar-tests--compare-strings "abc" "abcdddddd"))) + (should (string= "......" + (icalendar-tests--compare-strings "abcdefghij" "abc")))) ;; ====================================================================== -;; Test methods for functions +;; Tests of functions ;; ====================================================================== -(defun icalendar-testsuite--run-function-tests () - "Perform tests for single icalendar functions." - (icalendar-testsuite--test-parse-summary-and-rest) - (icalendar-testsuite--test-format-ical-event) - (icalendar-testsuite--test-import-format-sample) - (icalendar-testsuite--test-first-weekday-of-year) - (icalendar-testsuite--test-datestring-to-isodate) - (icalendar-testsuite--test-datetime-to-diary-date) - (icalendar-testsuite--test-diarytime-to-isotime) - (icalendar-testsuite--test-convert-ordinary-to-ical) - (icalendar-testsuite--test-convert-weekly-to-ical) - (icalendar-testsuite--test-convert-yearly-to-ical) - (icalendar-testsuite--test-convert-block-to-ical) - (icalendar-testsuite--test-convert-cyclic-to-ical) - (icalendar-testsuite--test-convert-anniversary-to-ical) - (icalendar-testsuite--test-calendar-style) - (icalendar-testsuite--test-create-uid) - (icalendar-testsuite--test-parse-vtimezone)) - -(defun icalendar-testsuite--test-format-ical-event () - "Test `icalendar--format-ical-event'." - (let ((icalendar-import-format "%s%d%l%o%t%u%c") - (icalendar-import-format-summary "SUM %s") - (icalendar-import-format-location " LOC %s") - (icalendar-import-format-description " DES %s") - (icalendar-import-format-organizer " ORG %s") - (icalendar-import-format-status " STA %s") - (icalendar-import-format-url " URL %s") - (icalendar-import-format-class " CLA %s") - (event (icalendar-testsuite--get-ical-event "BEGIN:VEVENT -DTSTAMP:20030509T043439Z -DTSTART:20030509T103000 -SUMMARY:sum -ORGANIZER:org -LOCATION:loc -DTEND:20030509T153000 -DESCRIPTION:des -END:VEVENT -"))) - (assert (string= (icalendar--format-ical-event event) - "SUM sum DES des LOC loc ORG org") t) - (setq icalendar-import-format (lambda (&rest ignore) - "helloworld")) - (assert (string= (icalendar--format-ical-event event) - "helloworld") t) - (setq icalendar-import-format - (lambda (e) - (format "-%s-%s-%s-%s-%s-%s-%s-" - (icalendar--get-event-property event 'SUMMARY) - (icalendar--get-event-property event 'DESCRIPTION) - (icalendar--get-event-property event 'LOCATION) - (icalendar--get-event-property event 'ORGANIZER) - (icalendar--get-event-property event 'STATUS) - (icalendar--get-event-property event 'URL) - (icalendar--get-event-property event 'CLASS)))) - (assert (string= (icalendar--format-ical-event event) - "-sum-des-loc-org-nil-nil-nil-") t))) -(defun icalendar-testsuite--test-parse-summary-and-rest () - "Test `icalendar--parse-summary-and-rest'." - (let ((icalendar-import-format "%s%d%l%o%t%u%c") - (icalendar-import-format-summary "SUM %s") - (icalendar-import-format-location " LOC %s") - (icalendar-import-format-description " DES %s") - (icalendar-import-format-organizer " ORG %s") - (icalendar-import-format-status " STA %s") - (icalendar-import-format-url " URL %s") - (icalendar-import-format-class " CLA %s") - (result)) - (setq result (icalendar--parse-summary-and-rest "SUM sum ORG org")) - (assert (string= (cdr (assoc 'org result)) "org")) - - (setq result (icalendar--parse-summary-and-rest - "SUM sum DES des LOC loc ORG org STA sta URL url CLA cla")) - (assert (string= (cdr (assoc 'des result)) "des")) - (assert (string= (cdr (assoc 'loc result)) "loc")) - (assert (string= (cdr (assoc 'org result)) "org")) - (assert (string= (cdr (assoc 'sta result)) "sta")) - (assert (string= (cdr (assoc 'cla result)) "cla")) - - (setq icalendar-import-format (lambda () "Hello world")) - (setq result (icalendar--parse-summary-and-rest - "blah blah ")) - (assert (not result)) - )) - -(defun icalendar-testsuite--get-ical-event (ical-string) - "Helper function for testing `icalendar-testsuite--test-format-ical-event'. -Return icalendar event for ICAL-STRING." - (save-excursion - (with-temp-buffer - (insert ical-string) - (goto-char (point-min)) - (car (icalendar--read-element nil nil))))) - -(defun icalendar-testsuite--test-import-format-sample () - "Test method for `icalendar-import-format-sample'." - (assert (string= (icalendar-import-format-sample - (icalendar-testsuite--get-ical-event "BEGIN:VEVENT -DTSTAMP:20030509T043439Z -DTSTART:20030509T103000 -SUMMARY:a -ORGANIZER:d -LOCATION:c -DTEND:20030509T153000 -DESCRIPTION:b -END:VEVENT -")) - (concat "SUMMARY=`a' DESCRIPTION=`b' LOCATION=`c' " - "ORGANIZER=`d' STATUS=`' URL=`' CLASS=`'")))) - -(defun icalendar-testsuite--test-first-weekday-of-year () - "Test method for `icalendar-first-weekday-of-year'." - (assert (eq 1 (icalendar-first-weekday-of-year "TU" 2008))) - (assert (eq 3 (icalendar-first-weekday-of-year "WE" 2007))) - (assert (eq 5 (icalendar-first-weekday-of-year "TH" 2006))) - (assert (eq 7 (icalendar-first-weekday-of-year "FR" 2005))) - (assert (eq 3 (icalendar-first-weekday-of-year "SA" 2004))) - (assert (eq 5 (icalendar-first-weekday-of-year "SU" 2003))) - (assert (eq 7 (icalendar-first-weekday-of-year "MO" 2002))) - (assert (eq 3 (icalendar-first-weekday-of-year "MO" 2000))) - (assert (eq 1 (icalendar-first-weekday-of-year "TH" 1970)))) - -(defun icalendar-testsuite--test-datestring-to-isodate () - "Test method for `icalendar--datestring-to-isodate'." - (let ((calendar-date-style 'iso)) - ;; numeric iso - (assert (string= (icalendar--datestring-to-isodate "2008 05 11") - "20080511")) - (assert (string= (icalendar--datestring-to-isodate "2008 05 31") - "20080531")) - (assert (string= (icalendar--datestring-to-isodate "2008 05 31" 2) - "20080602")) - - ;; numeric european - (setq calendar-date-style 'european) - (assert (string= (icalendar--datestring-to-isodate "11 05 2008") - "20080511")) - (assert (string= (icalendar--datestring-to-isodate "31 05 2008") - "20080531")) - (assert (string= (icalendar--datestring-to-isodate "31 05 2008" 2) - "20080602")) - - ;; numeric american - (setq calendar-date-style 'american) - (assert (string= (icalendar--datestring-to-isodate "11 05 2008") - "20081105")) - (assert (string= (icalendar--datestring-to-isodate "12 30 2008") - "20081230")) - (assert (string= (icalendar--datestring-to-isodate "12 30 2008" 2) - "20090101")) - - ;; non-numeric - (setq calendar-date-style nil) ;not necessary for conversion - (assert (string= (icalendar--datestring-to-isodate "Nov 05 2008") - "20081105")) - (assert (string= (icalendar--datestring-to-isodate "05 Nov 2008") - "20081105")) - (assert (string= (icalendar--datestring-to-isodate "2008 Nov 05") - "20081105")))) - -(defun icalendar-testsuite--test-datetime-to-diary-date () - "Test method for `icalendar--datetime-to-diary-date'." - (let* ((datetime '(59 59 23 31 12 2008)) - (calendar-date-style 'iso)) - (assert (string= (icalendar--datetime-to-diary-date datetime) - "2008 12 31")) - (setq calendar-date-style 'european) - (assert (string= (icalendar--datetime-to-diary-date datetime) - "31 12 2008")) - (setq calendar-date-style 'american) - (assert (string= (icalendar--datetime-to-diary-date datetime) - "12 31 2008")))) +(ert-deftest icalendar--create-uid () + "Test for `icalendar--create-uid'." + (let* ((icalendar-uid-format "xxx-%t-%c-%h-%u-%s") + t-ct + (icalendar--uid-count 77) + (entry-full "30.06.1964 07:01 blahblah") + (hash (format "%d" (abs (sxhash entry-full)))) + (contents "DTSTART:19640630T070100\nblahblah") + (username (or user-login-name "UNKNOWN_USER")) + ) + (fset 't-ct (symbol-function 'current-time)) + (unwind-protect + (progn + (fset 'current-time (lambda () '(1 2 3))) + (should (= 77 icalendar--uid-count)) + (should (string= (concat "xxx-123-77-" hash "-" username "-19640630") + (icalendar--create-uid entry-full contents))) + (should (= 78 icalendar--uid-count))) + ;; restore 'current-time + (fset 'current-time (symbol-function 't-ct))) + (setq contents "blahblah") + (setq icalendar-uid-format "yyy%syyy") + (should (string= (concat "yyyDTSTARTyyy") + (icalendar--create-uid entry-full contents))))) -(defun icalendar-testsuite--test-diarytime-to-isotime () - "Test method for `icalendar--diarytime-to-isotime'." - (assert (string= (icalendar--diarytime-to-isotime "01:15" "") - "T011500")) - (assert (string= (icalendar--diarytime-to-isotime "1:15" "") - "T011500")) - (assert (string= (icalendar--diarytime-to-isotime "0:01" "") - "T000100")) - (assert (string= (icalendar--diarytime-to-isotime "0100" "") - "T010000")) - (assert (string= (icalendar--diarytime-to-isotime "0100" "am") - "T010000")) - (assert (string= (icalendar--diarytime-to-isotime "0100" "pm") - "T130000")) - (assert (string= (icalendar--diarytime-to-isotime "1200" "") - "T120000")) - (assert (string= (icalendar--diarytime-to-isotime "17:17" "") - "T171700")) - (assert (string= (icalendar--diarytime-to-isotime "1200" "am") - "T000000")) - (assert (string= (icalendar--diarytime-to-isotime "1201" "am") - "T000100")) - (assert (string= (icalendar--diarytime-to-isotime "1259" "am") - "T005900")) - (assert (string= (icalendar--diarytime-to-isotime "1200" "pm") - "T120000")) - (assert (string= (icalendar--diarytime-to-isotime "1201" "pm") - "T120100")) - (assert (string= (icalendar--diarytime-to-isotime "1259" "pm") - "T125900"))) +(ert-deftest icalendar--calendar-style () + "Test for `icalendar--date-style'." + (dolist (calendar-date-style '(iso american european)) + (should (eq (icalendar--date-style) calendar-date-style))) + (let ((cds calendar-date-style) + (european-calendar-style t)) + (makunbound 'calendar-date-style) + (should (eq (icalendar--date-style) 'european)) + (with-no-warnings (setq european-calendar-style nil)) ;still get warning!?! FIXME + (should (eq (icalendar--date-style) 'american)) + (setq calendar-date-style cds))) -(defun icalendar-testsuite--test-convert-ordinary-to-ical () - "Test method for `icalendar--convert-ordinary-to-ical'." +(ert-deftest icalendar-convert-anniversary-to-ical () + "Test method for `icalendar--convert-anniversary-to-ical'." (let* ((calendar-date-style 'iso) result) - ;; without time - (setq result (icalendar--convert-ordinary-to-ical "&?" "2010 2 15 subject")) - (assert (= 2 (length result))) - (assert (string= "\nDTSTART;VALUE=DATE:20100215\nDTEND;VALUE=DATE:20100216" - (car result))) - (assert (string= "subject" (cadr result))) - - ;; with time - (setq result (icalendar--convert-ordinary-to-ical - "&?" "&2010 2 15 12:34-23:45 s")) - (assert (= 2 (length result))) - (assert (string= (concat "\nDTSTART;VALUE=DATE-TIME:20100215T123400" - "\nDTEND;VALUE=DATE-TIME:20100215T234500") - (car result))) - (assert (string= "s" (cadr result))) - - ;; with time, again -- test bug#5549 - (setq result (icalendar--convert-ordinary-to-ical - "x?" "x2010 2 15 0:34-1:45 s")) - (assert (= 2 (length result))) - (assert (string= (concat "\nDTSTART;VALUE=DATE-TIME:20100215T003400" - "\nDTEND;VALUE=DATE-TIME:20100215T014500") - (car result))) - (assert (string= "s" (cadr result))))) - -(defun icalendar-testsuite--test-convert-weekly-to-ical () - "Test method for `icalendar--convert-weekly-to-ical'." - (let* ((calendar-date-style 'iso) - result - (calendar-day-name-array - ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" - "Saturday"])) - (setq result (icalendar--convert-weekly-to-ical "" "Monday 8:30 subject")) - (assert (= 2 (length result))) - (assert (string= (concat "\nDTSTART;VALUE=DATE-TIME:20050103T083000" - "\nDTEND;VALUE=DATE-TIME:20050103T093000" - "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=MO") - (car result))) - (assert (string= "subject" (cadr result))))) - -(defun icalendar-testsuite--test-convert-yearly-to-ical () - "Test method for `icalendar--convert-yearly-to-ical'." - (let* ((calendar-date-style 'iso) - result - (calendar-month-name-array - ["January" "February" "March" "April" "May" "June" "July" "August" - "September" "October" "November" "December"])) - (setq result (icalendar--convert-yearly-to-ical "" "May 1 Tag der Arbeit")) - (assert (= 2 (length result))) - (assert (string= (concat - "\nDTSTART;VALUE=DATE:19000501" - "\nDTEND;VALUE=DATE:19000502" - "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=5;BYMONTHDAY=1") + (setq result (icalendar--convert-anniversary-to-ical + "" "%%(diary-anniversary 1964 6 30) g")) + (should (= 2 (length result))) + (should (string= (concat + "\nDTSTART;VALUE=DATE:19640630" + "\nDTEND;VALUE=DATE:19640701" + "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=06;BYMONTHDAY=30") (car result))) - (assert (string= "Tag der Arbeit" (cadr result))))) + (should (string= "g" (cadr result))))) -(defun icalendar-testsuite--test-convert-block-to-ical () - "Test method for `icalendar--convert-block-to-ical'." +(ert-deftest icalendar--convert-cyclic-to-ical () + "Test method for `icalendar--convert-cyclic-to-ical'." (let* ((calendar-date-style 'iso) result) (setq result (icalendar--convert-block-to-ical "" "%%(diary-block 2004 7 19 2004 8 27) Sommerferien")) - (assert (= 2 (length result))) - (assert (string= (concat + (should (= 2 (length result))) + (should (string= (concat "\nDTSTART;VALUE=DATE:20040719" "\nDTEND;VALUE=DATE:20040828") (car result))) - (assert (string= "Sommerferien" (cadr result))))) + (should (string= "Sommerferien" (cadr result))))) -(defun icalendar-testsuite--test-convert-cyclic-to-ical () - "Test method for `icalendar--convert-cyclic-to-ical'." +(ert-deftest icalendar--convert-block-to-ical () + "Test method for `icalendar--convert-block-to-ical'." (let* ((calendar-date-style 'iso) result) (setq result (icalendar--convert-block-to-ical "" "%%(diary-block 2004 7 19 2004 8 27) Sommerferien")) - (assert (= 2 (length result))) - (assert (string= (concat + (should (= 2 (length result))) + (should (string= (concat "\nDTSTART;VALUE=DATE:20040719" "\nDTEND;VALUE=DATE:20040828") (car result))) - (assert (string= "Sommerferien" (cadr result))))) + (should (string= "Sommerferien" (cadr result))))) -(defun icalendar-testsuite--test-convert-anniversary-to-ical () - "Test method for `icalendar--convert-anniversary-to-ical'." +(ert-deftest icalendar--convert-yearly-to-ical () + "Test method for `icalendar--convert-yearly-to-ical'." (let* ((calendar-date-style 'iso) - result) - (setq result (icalendar--convert-anniversary-to-ical - "" "%%(diary-anniversary 1964 6 30) g")) - (assert (= 2 (length result))) - (assert (string= (concat - "\nDTSTART;VALUE=DATE:19640630" - "\nDTEND;VALUE=DATE:19640701" - "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=06;BYMONTHDAY=30") + result + (calendar-month-name-array + ["January" "February" "March" "April" "May" "June" "July" "August" + "September" "October" "November" "December"])) + (setq result (icalendar--convert-yearly-to-ical "" "May 1 Tag der Arbeit")) + (should (= 2 (length result))) + (should (string= (concat + "\nDTSTART;VALUE=DATE:19000501" + "\nDTEND;VALUE=DATE:19000502" + "\nRRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=5;BYMONTHDAY=1") (car result))) - (assert (string= "g" (cadr result))))) + (should (string= "Tag der Arbeit" (cadr result))))) -(defun icalendar-testsuite--test-calendar-style () - "Test method for `icalendar--date-style'." - (dolist (calendar-date-style '(iso american european)) - (assert (eq (icalendar--date-style) calendar-date-style))) - (let ((cds calendar-date-style) - (european-calendar-style t)) - (makunbound 'calendar-date-style) - (assert (eq (icalendar--date-style) 'european)) - (with-no-warnings (setq european-calendar-style nil)) ;still get warning!?! FIXME - (assert (eq (icalendar--date-style) 'american)) - (setq calendar-date-style cds))) - -(defun icalendar-testsuite--test-create-uid () - "Test method for `icalendar--create-uid'." - (let* ((icalendar-uid-format "xxx-%t-%c-%h-%u-%s") - t-ct - (icalendar--uid-count 77) - (entry-full "30.06.1964 07:01 blahblah") - (hash (format "%d" (abs (sxhash entry-full)))) - (contents "DTSTART:19640630T070100\nblahblah") - (username (or user-login-name "UNKNOWN_USER")) - ) - ;; FIXME! If a test fails 'current-time is screwed. FIXME! - (fset 't-ct (symbol-function 'current-time)) - (fset 'current-time (lambda () '(1 2 3))) - (assert (= 77 icalendar--uid-count)) - (assert (string= (concat "xxx-123-77-" hash "-" username "-19640630") - (icalendar--create-uid entry-full contents))) - (assert (= 78 icalendar--uid-count)) - (fset 'current-time (symbol-function 't-ct)) - - (setq contents "blahblah") - (setq icalendar-uid-format "yyy%syyy") - (assert (string= (concat "yyyDTSTARTyyy") - (icalendar--create-uid entry-full contents))) - )) +(ert-deftest icalendar--convert-weekly-to-ical () + "Test method for `icalendar--convert-weekly-to-ical'." + (let* ((calendar-date-style 'iso) + result + (calendar-day-name-array + ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" + "Saturday"])) + (setq result (icalendar--convert-weekly-to-ical "" "Monday 8:30 subject")) + (should (= 2 (length result))) + (should (string= (concat "\nDTSTART;VALUE=DATE-TIME:20050103T083000" + "\nDTEND;VALUE=DATE-TIME:20050103T093000" + "\nRRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=MO") + (car result))) + (should (string= "subject" (cadr result))))) -(defun icalendar-testsuite--test-parse-vtimezone () +(ert-deftest icalendar--parse-vtimezone () "Test method for `icalendar--parse-vtimezone'." (let (vtimezone result) - (setq vtimezone (icalendar-testsuite--get-ical-event "BEGIN:VTIMEZONE + (setq vtimezone (icalendar-tests--get-ical-event "BEGIN:VTIMEZONE TZID:thename BEGIN:STANDARD DTSTART:16010101T040000 @@ -444,11 +212,11 @@ END:DAYLIGHT END:VTIMEZONE ")) (setq result (icalendar--parse-vtimezone vtimezone)) - (assert (string= "thename" (car result))) + (should (string= "thename" (car result))) (message (cdr result)) - (assert (string= "STD-02:00DST-03:00,M3.5.0/03:00:00,M10.5.0/04:00:00" + (should (string= "STD-02:00DST-03:00,M3.5.0/03:00:00,M10.5.0/04:00:00" (cdr result))) - (setq vtimezone (icalendar-testsuite--get-ical-event "BEGIN:VTIMEZONE + (setq vtimezone (icalendar-tests--get-ical-event "BEGIN:VTIMEZONE TZID:anothername BEGIN:STANDARD DTSTART:16010101T040000 @@ -465,16 +233,223 @@ END:DAYLIGHT END:VTIMEZONE ")) (setq result (icalendar--parse-vtimezone vtimezone)) - (assert (string= "anothername" (car result))) + (should (string= "anothername" (car result))) (message (cdr result)) - (assert (string= "STD-02:00DST-03:00,M3.2.1/03:00:00,M10.2.1/04:00:00" (cdr result))))) + (should (string= "STD-02:00DST-03:00,M3.2.1/03:00:00,M10.2.1/04:00:00" + (cdr result))))) + +(ert-deftest icalendar--convert-ordinary-to-ical () + "Test method for `icalendar--convert-ordinary-to-ical'." + (let* ((calendar-date-style 'iso) + result) + ;; without time + (setq result (icalendar--convert-ordinary-to-ical "&?" "2010 2 15 subject")) + (should (= 2 (length result))) + (should (string= "\nDTSTART;VALUE=DATE:20100215\nDTEND;VALUE=DATE:20100216" + (car result))) + (should (string= "subject" (cadr result))) + + ;; with time + (setq result (icalendar--convert-ordinary-to-ical + "&?" "&2010 2 15 12:34-23:45 s")) + (should (= 2 (length result))) + (should (string= (concat "\nDTSTART;VALUE=DATE-TIME:20100215T123400" + "\nDTEND;VALUE=DATE-TIME:20100215T234500") + (car result))) + (should (string= "s" (cadr result))) + + ;; with time, again -- test bug#5549 + (setq result (icalendar--convert-ordinary-to-ical + "x?" "x2010 2 15 0:34-1:45 s")) + (should (= 2 (length result))) + (should (string= (concat "\nDTSTART;VALUE=DATE-TIME:20100215T003400" + "\nDTEND;VALUE=DATE-TIME:20100215T014500") + (car result))) + (should (string= "s" (cadr result))))) + +(ert-deftest icalendar--diarytime-to-isotime () + "Test method for `icalendar--diarytime-to-isotime'." + (should (string= (icalendar--diarytime-to-isotime "01:15" "") + "T011500")) + (should (string= (icalendar--diarytime-to-isotime "1:15" "") + "T011500")) + (should (string= (icalendar--diarytime-to-isotime "0:01" "") + "T000100")) + (should (string= (icalendar--diarytime-to-isotime "0100" "") + "T010000")) + (should (string= (icalendar--diarytime-to-isotime "0100" "am") + "T010000")) + (should (string= (icalendar--diarytime-to-isotime "0100" "pm") + "T130000")) + (should (string= (icalendar--diarytime-to-isotime "1200" "") + "T120000")) + (should (string= (icalendar--diarytime-to-isotime "17:17" "") + "T171700")) + (should (string= (icalendar--diarytime-to-isotime "1200" "am") + "T000000")) + (should (string= (icalendar--diarytime-to-isotime "1201" "am") + "T000100")) + (should (string= (icalendar--diarytime-to-isotime "1259" "am") + "T005900")) + (should (string= (icalendar--diarytime-to-isotime "1200" "pm") + "T120000")) + (should (string= (icalendar--diarytime-to-isotime "1201" "pm") + "T120100")) + (should (string= (icalendar--diarytime-to-isotime "1259" "pm") + "T125900"))) + +(ert-deftest icalendar--datetime-to-diary-date () + "Test method for `icalendar--datetime-to-diary-date'." + (let* ((datetime '(59 59 23 31 12 2008)) + (calendar-date-style 'iso)) + (should (string= (icalendar--datetime-to-diary-date datetime) + "2008 12 31")) + (setq calendar-date-style 'european) + (should (string= (icalendar--datetime-to-diary-date datetime) + "31 12 2008")) + (setq calendar-date-style 'american) + (should (string= (icalendar--datetime-to-diary-date datetime) + "12 31 2008")))) + +(ert-deftest icalendar--datestring-to-isodate () + "Test method for `icalendar--datestring-to-isodate'." + (let ((calendar-date-style 'iso)) + ;; numeric iso + (should (string= (icalendar--datestring-to-isodate "2008 05 11") + "20080511")) + (should (string= (icalendar--datestring-to-isodate "2008 05 31") + "20080531")) + (should (string= (icalendar--datestring-to-isodate "2008 05 31" 2) + "20080602")) + + ;; numeric european + (setq calendar-date-style 'european) + (should (string= (icalendar--datestring-to-isodate "11 05 2008") + "20080511")) + (should (string= (icalendar--datestring-to-isodate "31 05 2008") + "20080531")) + (should (string= (icalendar--datestring-to-isodate "31 05 2008" 2) + "20080602")) + + ;; numeric american + (setq calendar-date-style 'american) + (should (string= (icalendar--datestring-to-isodate "11 05 2008") + "20081105")) + (should (string= (icalendar--datestring-to-isodate "12 30 2008") + "20081230")) + (should (string= (icalendar--datestring-to-isodate "12 30 2008" 2) + "20090101")) + + ;; non-numeric + (setq calendar-date-style nil) ;not necessary for conversion + (should (string= (icalendar--datestring-to-isodate "Nov 05 2008") + "20081105")) + (should (string= (icalendar--datestring-to-isodate "05 Nov 2008") + "20081105")) + (should (string= (icalendar--datestring-to-isodate "2008 Nov 05") + "20081105")))) + +(ert-deftest icalendar--first-weekday-of-year () + "Test method for `icalendar-first-weekday-of-year'." + (should (eq 1 (icalendar-first-weekday-of-year "TU" 2008))) + (should (eq 3 (icalendar-first-weekday-of-year "WE" 2007))) + (should (eq 5 (icalendar-first-weekday-of-year "TH" 2006))) + (should (eq 7 (icalendar-first-weekday-of-year "FR" 2005))) + (should (eq 3 (icalendar-first-weekday-of-year "SA" 2004))) + (should (eq 5 (icalendar-first-weekday-of-year "SU" 2003))) + (should (eq 7 (icalendar-first-weekday-of-year "MO" 2002))) + (should (eq 3 (icalendar-first-weekday-of-year "MO" 2000))) + (should (eq 1 (icalendar-first-weekday-of-year "TH" 1970)))) + +(ert-deftest icalendar--import-format-sample () + "Test method for `icalendar-import-format-sample'." + (should (string= (icalendar-import-format-sample + (icalendar-tests--get-ical-event "BEGIN:VEVENT +DTSTAMP:20030509T043439Z +DTSTART:20030509T103000 +SUMMARY:a +ORGANIZER:d +LOCATION:c +DTEND:20030509T153000 +DESCRIPTION:b +END:VEVENT +")) + (concat "SUMMARY=`a' DESCRIPTION=`b' LOCATION=`c' " + "ORGANIZER=`d' STATUS=`' URL=`' CLASS=`'")))) + +(ert-deftest icalendar--format-ical-event () + "Test `icalendar--format-ical-event'." + (let ((icalendar-import-format "%s%d%l%o%t%u%c") + (icalendar-import-format-summary "SUM %s") + (icalendar-import-format-location " LOC %s") + (icalendar-import-format-description " DES %s") + (icalendar-import-format-organizer " ORG %s") + (icalendar-import-format-status " STA %s") + (icalendar-import-format-url " URL %s") + (icalendar-import-format-class " CLA %s") + (event (icalendar-tests--get-ical-event "BEGIN:VEVENT +DTSTAMP:20030509T043439Z +DTSTART:20030509T103000 +SUMMARY:sum +ORGANIZER:org +LOCATION:loc +DTEND:20030509T153000 +DESCRIPTION:des +END:VEVENT +"))) + (should (string= (icalendar--format-ical-event event) + "SUM sum DES des LOC loc ORG org")) + (setq icalendar-import-format (lambda (&rest ignore) + "helloworld")) + (should (string= (icalendar--format-ical-event event) + "helloworld")) + (setq icalendar-import-format + (lambda (e) + (format "-%s-%s-%s-%s-%s-%s-%s-" + (icalendar--get-event-property event 'SUMMARY) + (icalendar--get-event-property event 'DESCRIPTION) + (icalendar--get-event-property event 'LOCATION) + (icalendar--get-event-property event 'ORGANIZER) + (icalendar--get-event-property event 'STATUS) + (icalendar--get-event-property event 'URL) + (icalendar--get-event-property event 'CLASS)))) + (should (string= (icalendar--format-ical-event event) + "-sum-des-loc-org-nil-nil-nil-")))) + +(ert-deftest icalendar--parse-summary-and-rest () + "Test `icalendar--parse-summary-and-rest'." + (let ((icalendar-import-format "%s%d%l%o%t%u%c") + (icalendar-import-format-summary "SUM %s") + (icalendar-import-format-location " LOC %s") + (icalendar-import-format-description " DES %s") + (icalendar-import-format-organizer " ORG %s") + (icalendar-import-format-status " STA %s") + (icalendar-import-format-url " URL %s") + (icalendar-import-format-class " CLA %s") + (result)) + (setq result (icalendar--parse-summary-and-rest "SUM sum ORG org")) + (should (string= (cdr (assoc 'org result)) "org")) + + (setq result (icalendar--parse-summary-and-rest + "SUM sum DES des LOC loc ORG org STA sta URL url CLA cla")) + (should (string= (cdr (assoc 'des result)) "des")) + (should (string= (cdr (assoc 'loc result)) "loc")) + (should (string= (cdr (assoc 'org result)) "org")) + (should (string= (cdr (assoc 'sta result)) "sta")) + (should (string= (cdr (assoc 'cla result)) "cla")) + + (setq icalendar-import-format (lambda () "Hello world")) + (setq result (icalendar--parse-summary-and-rest + "blah blah ")) + (should (not result)) + )) ;; ====================================================================== -;; Test methods for exporting from diary to icalendar +;; Export tests ;; ====================================================================== -(defun icalendar-testsuite--test-export (input-iso input-european input-american - expected-output) +(defun icalendar-tests--test-export (input-iso input-european input-american + expected-output) "Perform an export test. Argument INPUT-ISO iso style diary string. Argument INPUT-EUROPEAN european style diary string. @@ -483,52 +458,57 @@ Argument EXPECTED-OUTPUT expected icalendar result string. European style input data must use german month names. American and ISO style input data must use english month names." - (message "--- icalendar-testsuite--test-export ---") - (let ((calendar-date-style 'iso) - (icalendar-recurring-start-year 2000)) - (set-time-zone-rule "CET") ;;FIXME: reset timezone! - (when input-iso - (let ((calendar-month-name-array - ["January" "February" "March" "April" "May" "June" "July" "August" - "September" "October" "November" "December"]) - (calendar-day-name-array - ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" - "Saturday"])) - (setq calendar-date-style 'iso) - (icalendar-testsuite--do-test-export input-iso expected-output))) - (when input-european - (let ((calendar-month-name-array - ["Januar" "Februar" "März" "April" "Mai" "Juni" "Juli" "August" - "September" "Oktober" "November" "Dezember"]) - (calendar-day-name-array - ["Sonntag" "Montag" "Dienstag" "Mittwoch" "Donnerstag" "Freitag" - "Samstag"])) - (setq calendar-date-style 'european) - (icalendar-testsuite--do-test-export input-european expected-output))) - (when input-american - (let ((calendar-month-name-array - ["January" "February" "March" "April" "May" "June" "July" "August" - "September" "October" "November" "December"]) - (calendar-day-name-array - ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" - "Saturday"])) - (setq calendar-date-style 'american) - (icalendar-testsuite--do-test-export input-american expected-output))))) - -(defun icalendar-testsuite--do-test-export (input expected-output) + (let ((tz (cadr (current-time-zone))) + (calendar-date-style 'iso) + (icalendar-recurring-start-year 2000)) + (unwind-protect + (progn + (set-time-zone-rule "CET") + (when input-iso + (let ((calendar-month-name-array + ["January" "February" "March" "April" "May" "June" "July" "August" + "September" "October" "November" "December"]) + (calendar-day-name-array + ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" + "Saturday"])) + (setq calendar-date-style 'iso) + (icalendar-tests--do-test-export input-iso expected-output))) + (when input-european + (let ((calendar-month-name-array + ["Januar" "Februar" "März" "April" "Mai" "Juni" "Juli" "August" + "September" "Oktober" "November" "Dezember"]) + (calendar-day-name-array + ["Sonntag" "Montag" "Dienstag" "Mittwoch" "Donnerstag" "Freitag" + "Samstag"])) + (setq calendar-date-style 'european) + (icalendar-tests--do-test-export input-european expected-output))) + (when input-american + (let ((calendar-month-name-array + ["January" "February" "March" "April" "May" "June" "July" "August" + "September" "October" "November" "December"]) + (calendar-day-name-array + ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" + "Saturday"])) + (setq calendar-date-style 'american) + (icalendar-tests--do-test-export input-american expected-output)))) + ;; restore time-zone if something went terribly wrong + (set-time-zone-rule tz)))) + +(defun icalendar-tests--do-test-export (input expected-output) "Actually perform export test. Argument INPUT input diary string. Argument EXPECTED-OUTPUT expected icalendar result string." - (let ((temp-file (make-temp-file "icalendar-testsuite-ics"))) - (with-temp-buffer - (insert input) - (icalendar-export-region (point-min) (point-max) temp-file)) - (save-excursion - (find-file temp-file) - (goto-char (point-min)) - (unless - (cond (expected-output - (and (re-search-forward "^\\s-*BEGIN:VCALENDAR + (let ((temp-file (make-temp-file "icalendar-tests-ics"))) + (unwind-protect + (progn + (with-temp-buffer + (insert input) + (icalendar-export-region (point-min) (point-max) temp-file)) + (save-excursion + (find-file temp-file) + (goto-char (point-min)) + (cond (expected-output + (should (re-search-forward "^\\s-*BEGIN:VCALENDAR PRODID:-//Emacs//NONSGML icalendar.el//EN VERSION:2.0 BEGIN:VEVENT @@ -537,48 +517,190 @@ UID:emacs[0-9]+ END:VEVENT END:VCALENDAR \\s-*$" - nil t) - (string-match - (concat "^\\s-*" - (regexp-quote (buffer-substring-no-properties - (match-beginning 1) (match-end 1))) - "\\s-*$") - expected-output))) - (t - (re-search-forward "^\\s-*BEGIN:VCALENDAR + nil t)) + (should (string-match + (concat "^\\s-*" + (regexp-quote (buffer-substring-no-properties + (match-beginning 1) (match-end 1))) + "\\s-*$") + expected-output))) + (t + (should (re-search-forward "^\\s-*BEGIN:VCALENDAR PRODID:-//Emacs//NONSGML icalendar.el//EN VERSION:2.0 END:VCALENDAR \\s-*$" - nil t))) - (error - "Export test failed! Input: `%s'\nFound:\n\n%s\n\nbut expected\n\n%s\n%s" - input - (or (and (match-beginning 1) - (buffer-substring-no-properties (match-beginning 1) - (match-end 1))) - "<nil>") - (or expected-output "<nil>") - (icalendar-testsuite--compare-strings (or (and (match-beginning 1) - (buffer-substring-no-properties (match-beginning 1) - (match-end 1))) - "<nil>") - (or expected-output "<nil>"))))) - (kill-buffer (find-buffer-visiting temp-file)) - (delete-file temp-file))) + nil t)))))) + ;; cleanup!! + (kill-buffer (find-buffer-visiting temp-file)) + (delete-file temp-file)))) + +(ert-deftest icalendar-export-ordinary-no-time () + "Perform export test." + + (let ((icalendar-export-hidden-diary-entries nil)) + (icalendar-tests--test-export + "&2000 Oct 3 ordinary no time " + "&3 Okt 2000 ordinary no time " + "&Oct 3 2000 ordinary no time " + nil)) + + (icalendar-tests--test-export + "2000 Oct 3 ordinary no time " + "3 Okt 2000 ordinary no time " + "Oct 3 2000 ordinary no time " + "DTSTART;VALUE=DATE:20001003 +DTEND;VALUE=DATE:20001004 +SUMMARY:ordinary no time +")) + +(ert-deftest icalendar-export-ordinary () + "Perform export test." + + (icalendar-tests--test-export + "2000 Oct 3 16:30 ordinary with time" + "3 Okt 2000 16:30 ordinary with time" + "Oct 3 2000 16:30 ordinary with time" + "DTSTART;VALUE=DATE-TIME:20001003T163000 +DTEND;VALUE=DATE-TIME:20001003T173000 +SUMMARY:ordinary with time +") + (icalendar-tests--test-export + "2000 10 3 16:30 ordinary with time 2" + "3 10 2000 16:30 ordinary with time 2" + "10 3 2000 16:30 ordinary with time 2" + "DTSTART;VALUE=DATE-TIME:20001003T163000 +DTEND;VALUE=DATE-TIME:20001003T173000 +SUMMARY:ordinary with time 2 +") + + (icalendar-tests--test-export + "2000/10/3 16:30 ordinary with time 3" + "3/10/2000 16:30 ordinary with time 3" + "10/3/2000 16:30 ordinary with time 3" + "DTSTART;VALUE=DATE-TIME:20001003T163000 +DTEND;VALUE=DATE-TIME:20001003T173000 +SUMMARY:ordinary with time 3 +")) + +(ert-deftest icalendar-export-multiline () + "Perform export test." + + ;; multiline -- FIXME!!! + (icalendar-tests--test-export + "2000 October 3 16:30 multiline + 17:30 multiline continued FIXME" + "3 Oktober 2000 16:30 multiline + 17:30 multiline continued FIXME" + "October 3 2000 16:30 multiline + 17:30 multiline continued FIXME" + "DTSTART;VALUE=DATE-TIME:20001003T163000 +DTEND;VALUE=DATE-TIME:20001003T173000 +SUMMARY:multiline +DESCRIPTION: + 17:30 multiline continued FIXME +")) + +(ert-deftest icalendar-export-weekly-by-day () + "Perform export test." + + ;; weekly by day + (icalendar-tests--test-export + "Monday 1:30pm weekly by day with start time" + "Montag 13:30 weekly by day with start time" + "Monday 1:30pm weekly by day with start time" + "DTSTART;VALUE=DATE-TIME:20000103T133000 +DTEND;VALUE=DATE-TIME:20000103T143000 +RRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=MO +SUMMARY:weekly by day with start time +") + + (icalendar-tests--test-export + "Monday 13:30-15:00 weekly by day with start and end time" + "Montag 13:30-15:00 weekly by day with start and end time" + "Monday 01:30pm-03:00pm weekly by day with start and end time" + "DTSTART;VALUE=DATE-TIME:20000103T133000 +DTEND;VALUE=DATE-TIME:20000103T150000 +RRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=MO +SUMMARY:weekly by day with start and end time +")) + +(ert-deftest icalendar-export-yearly () + "Perform export test." + ;; yearly + (icalendar-tests--test-export + "may 1 yearly no time" + "1 Mai yearly no time" + "may 1 yearly no time" + "DTSTART;VALUE=DATE:19000501 +DTEND;VALUE=DATE:19000502 +RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=5;BYMONTHDAY=1 +SUMMARY:yearly no time +")) + +(ert-deftest icalendar-export-anniversary () + "Perform export test." + ;; anniversaries + (icalendar-tests--test-export + "%%(diary-anniversary 1989 10 3) anniversary no time" + "%%(diary-anniversary 3 10 1989) anniversary no time" + "%%(diary-anniversary 10 3 1989) anniversary no time" + "DTSTART;VALUE=DATE:19891003 +DTEND;VALUE=DATE:19891004 +RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=10;BYMONTHDAY=03 +SUMMARY:anniversary no time +") + (icalendar-tests--test-export + "%%(diary-anniversary 1989 10 3) 19:00-20:00 anniversary with time" + "%%(diary-anniversary 3 10 1989) 19:00-20:00 anniversary with time" + "%%(diary-anniversary 10 3 1989) 19:00-20:00 anniversary with time" + "DTSTART;VALUE=DATE-TIME:19891003T190000 +DTEND;VALUE=DATE-TIME:19891004T200000 +RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=10;BYMONTHDAY=03 +SUMMARY:anniversary with time +")) + +(ert-deftest icalendar-export-block () + "Perform export test." + ;; block + (icalendar-tests--test-export + "%%(diary-block 2001 6 18 2001 7 6) block no time" + "%%(diary-block 18 6 2001 6 7 2001) block no time" + "%%(diary-block 6 18 2001 7 6 2001) block no time" + "DTSTART;VALUE=DATE:20010618 +DTEND;VALUE=DATE:20010707 +SUMMARY:block no time +") + (icalendar-tests--test-export + "%%(diary-block 2001 6 18 2001 7 6) 13:00-17:00 block with time" + "%%(diary-block 18 6 2001 6 7 2001) 13:00-17:00 block with time" + "%%(diary-block 6 18 2001 7 6 2001) 13:00-17:00 block with time" + "DTSTART;VALUE=DATE-TIME:20010618T130000 +DTEND;VALUE=DATE-TIME:20010618T170000 +RRULE:FREQ=DAILY;INTERVAL=1;UNTIL=20010706 +SUMMARY:block with time +") + (icalendar-tests--test-export + "%%(diary-block 2001 6 18 2001 7 6) 13:00 block no end time" + "%%(diary-block 18 6 2001 6 7 2001) 13:00 block no end time" + "%%(diary-block 6 18 2001 7 6 2001) 13:00 block no end time" + "DTSTART;VALUE=DATE-TIME:20010618T130000 +DTEND;VALUE=DATE-TIME:20010618T140000 +RRULE:FREQ=DAILY;INTERVAL=1;UNTIL=20010706 +SUMMARY:block no end time +")) ;; ====================================================================== -;; Test methods for importing from icalendar to diary +;; Import tests ;; ====================================================================== -(defun icalendar-testsuite--test-import (input expected-iso expected-european - expected-american) +(defun icalendar-tests--test-import (input expected-iso expected-european + expected-american) "Perform import test. Argument INPUT icalendar event string. Argument EXPECTED-ISO expected iso style diary string. Argument EXPECTED-EUROPEAN expected european style diary string. Argument EXPECTED-AMERICAN expected american style diary string." - (message "--- icalendar-testsuite--test-import ---") (let ((timezone (cadr (current-time-zone)))) (set-time-zone-rule "CET") (with-temp-buffer @@ -601,126 +723,54 @@ Argument EXPECTED-AMERICAN expected american style diary string." calendar-date-style) (when expected-iso (setq calendar-date-style 'iso) - (icalendar-testsuite--do-test-import input expected-iso)) + (icalendar-tests--do-test-import input expected-iso)) (when expected-european (setq calendar-date-style 'european) - (icalendar-testsuite--do-test-import input expected-european)) + (icalendar-tests--do-test-import input expected-european)) (when expected-american (setq calendar-date-style 'american) - (icalendar-testsuite--do-test-import input expected-american)))) + (icalendar-tests--do-test-import input expected-american)))) (set-time-zone-rule timezone))) -(defun icalendar-testsuite--do-test-import (input expected-output) +(defun icalendar-tests--do-test-import (input expected-output) "Actually perform import test. Argument INPUT input icalendar string. Argument EXPECTED-OUTPUT expected diary string." (let ((temp-file (make-temp-file "icalendar-test-diary"))) (icalendar-import-buffer temp-file t t) - (save-excursion - (find-file temp-file) - (let* ((result (buffer-substring-no-properties (point-min) (point-max))) - (difference - (icalendar-testsuite--compare-strings result - expected-output))) - (if (stringp difference) - (error "Import test failed! Found\n`%s'\nbut expected\n`%s'\n%s'" - result expected-output difference))) + (unwind-protect + (save-excursion + (find-file temp-file) + (let ((result (buffer-substring-no-properties (point-min) (point-max)))) + (should (icalendar-tests--compare-strings result + expected-output)))) (kill-buffer (find-buffer-visiting temp-file)) (delete-file temp-file)))) -;; ====================================================================== -;; Test methods for cycle... -;; ====================================================================== -(defun icalendar-testsuite--test-cycle (input) - "Perform cycle test. -Argument INPUT icalendar event string." - (with-temp-buffer - (if (string-match "^BEGIN:VCALENDAR" input) - (insert input) - (insert "BEGIN:VCALENDAR\nPRODID:-//Emacs//NONSGML icalendar.el//EN\n") - (insert "VERSION:2.0\nBEGIN:VEVENT\n") - (insert input) - (unless (eq (char-before) ?\n) - (insert "\n")) - (insert "END:VEVENT\nEND:VCALENDAR\n")) - (let ((icalendar-import-format "%s%d%l%o%t%u%c") - (icalendar-import-format-summary "%s") - (icalendar-import-format-location "\n Location: %s") - (icalendar-import-format-description "\n Desc: %s") - (icalendar-import-format-organizer "\n Organizer: %s") - (icalendar-import-format-status "\n Status: %s") - (icalendar-import-format-url "\n URL: %s") - (icalendar-import-format-class "\n Class: %s")) - (dolist (calendar-date-style '(iso european american)) - (icalendar-testsuite--do-test-cycle))))) - -(defun icalendar-testsuite--do-test-cycle () - "Actually perform import/export cycle test." - (let ((temp-diary (make-temp-file "icalendar-test-diary")) - (temp-ics (make-temp-file "icalendar-test-ics")) - (org-input (buffer-substring-no-properties (point-min) (point-max)))) - - ;; step 1: import - (icalendar-import-buffer temp-diary t t) - - ;; step 2: export what was just imported - (save-excursion - (find-file temp-diary) - (icalendar-export-region (point-min) (point-max) temp-ics)) - - ;; compare the output of step 2 with the input of step 1 - (save-excursion - (find-file temp-ics) - (goto-char (point-min)) - (when (re-search-forward "\nUID:.*\n" nil t) - (replace-match "\n")) - (let ((cycled (buffer-substring-no-properties (point-min) (point-max)))) - (let ((difference (icalendar-testsuite--compare-strings cycled - org-input))) - (if (stringp difference) - (error "Import test failed! Found\n`%s'\nbut expected\n`%s'\n%s'" - cycled org-input difference))) - )) - - ;; clean up -- Note this is done only if test is passed - (kill-buffer (find-buffer-visiting temp-diary)) - (save-excursion - (set-buffer (find-buffer-visiting temp-ics)) - (set-buffer-modified-p nil) - (kill-buffer (current-buffer))) - (delete-file temp-diary) - (delete-file temp-ics))) - -;; ====================================================================== -;; Import tests -;; ====================================================================== -(defun icalendar-testsuite--run-import-tests () +(ert-deftest icalendar-import-non-recurring () "Perform standard import tests." - (icalendar-testsuite--test-import + (icalendar-tests--test-import "SUMMARY:non-recurring DTSTART;VALUE=DATE-TIME:20030919T090000 DTEND;VALUE=DATE-TIME:20030919T113000" "&2003/9/19 09:00-11:30 non-recurring" "&19/9/2003 09:00-11:30 non-recurring" "&9/19/2003 09:00-11:30 non-recurring") - - (icalendar-testsuite--test-import + (icalendar-tests--test-import "SUMMARY:non-recurring allday DTSTART;VALUE=DATE-TIME:20030919" "&2003/9/19 non-recurring allday" "&19/9/2003 non-recurring allday" "&9/19/2003 non-recurring allday") - - (icalendar-testsuite--test-import + (icalendar-tests--test-import ;; do not remove the trailing blank after "long"! - "SUMMARY:long + "SUMMARY:long summary DTSTART;VALUE=DATE:20030919" "&2003/9/19 long summary" "&19/9/2003 long summary" "&9/19/2003 long summary") - - (icalendar-testsuite--test-import + (icalendar-tests--test-import "UID:748f2da0-0d9b-11d8-97af-b4ec8686ea61 SUMMARY:Sommerferien STATUS:TENTATIVE @@ -742,8 +792,7 @@ DTSTAMP:20031103T011641Z "&%%(and (diary-block 7 19 2004 8 27 2004)) Sommerferien Status: TENTATIVE Class: PRIVATE") - - (icalendar-testsuite--test-import + (icalendar-tests--test-import "UID :04979712-3902-11d9-93dd-8f9f4afe08da SUMMARY @@ -772,7 +821,8 @@ LAST-MODIFIED "&11/23/2004 14:00-14:30 folded summary Status: TENTATIVE Class: PRIVATE") - (icalendar-testsuite--test-import + + (icalendar-tests--test-import "UID :6161a312-3902-11d9-b512-f764153bb28b SUMMARY @@ -798,9 +848,10 @@ DTSTAMP Class: PRIVATE" "&11/23/2004 14:45-15:45 another example Status: TENTATIVE - Class: PRIVATE") + Class: PRIVATE")) - (icalendar-testsuite--test-import +(ert-deftest icalendar-import-rrule () + (icalendar-tests--test-import "SUMMARY:rrule daily DTSTART;VALUE=DATE-TIME:20030919T090000 DTEND;VALUE=DATE-TIME:20030919T113000 @@ -809,9 +860,8 @@ RRULE:FREQ=DAILY; "&%%(and (diary-cyclic 1 2003 9 19)) 09:00-11:30 rrule daily" "&%%(and (diary-cyclic 1 19 9 2003)) 09:00-11:30 rrule daily" "&%%(and (diary-cyclic 1 9 19 2003)) 09:00-11:30 rrule daily") - ;; RRULE examples - (icalendar-testsuite--test-import + (icalendar-tests--test-import "SUMMARY:rrule daily DTSTART;VALUE=DATE-TIME:20030919T090000 DTEND;VALUE=DATE-TIME:20030919T113000 @@ -820,7 +870,7 @@ RRULE:FREQ=DAILY;INTERVAL=2 "&%%(and (diary-cyclic 2 2003 9 19)) 09:00-11:30 rrule daily" "&%%(and (diary-cyclic 2 19 9 2003)) 09:00-11:30 rrule daily" "&%%(and (diary-cyclic 2 9 19 2003)) 09:00-11:30 rrule daily") - (icalendar-testsuite--test-import + (icalendar-tests--test-import "SUMMARY:rrule daily with exceptions DTSTART;VALUE=DATE-TIME:20030919T090000 DTEND;VALUE=DATE-TIME:20030919T113000 @@ -830,8 +880,7 @@ EXDATE:20030921,20030925 "&%%(and (not (diary-date 2003 9 25)) (not (diary-date 2003 9 21)) (diary-cyclic 2 2003 9 19)) 09:00-11:30 rrule daily with exceptions" "&%%(and (not (diary-date 25 9 2003)) (not (diary-date 21 9 2003)) (diary-cyclic 2 19 9 2003)) 09:00-11:30 rrule daily with exceptions" "&%%(and (not (diary-date 9 25 2003)) (not (diary-date 9 21 2003)) (diary-cyclic 2 9 19 2003)) 09:00-11:30 rrule daily with exceptions") - - (icalendar-testsuite--test-import + (icalendar-tests--test-import "SUMMARY:rrule weekly DTSTART;VALUE=DATE-TIME:20030919T090000 DTEND;VALUE=DATE-TIME:20030919T113000 @@ -840,7 +889,7 @@ RRULE:FREQ=WEEKLY; "&%%(and (diary-cyclic 7 2003 9 19)) 09:00-11:30 rrule weekly" "&%%(and (diary-cyclic 7 19 9 2003)) 09:00-11:30 rrule weekly" "&%%(and (diary-cyclic 7 9 19 2003)) 09:00-11:30 rrule weekly") - (icalendar-testsuite--test-import + (icalendar-tests--test-import "SUMMARY:rrule monthly no end DTSTART;VALUE=DATE-TIME:20030919T090000 DTEND;VALUE=DATE-TIME:20030919T113000 @@ -849,7 +898,7 @@ RRULE:FREQ=MONTHLY; "&%%(and (diary-date t t 19) (diary-block 2003 9 19 9999 1 1)) 09:00-11:30 rrule monthly no end" "&%%(and (diary-date 19 t t) (diary-block 19 9 2003 1 1 9999)) 09:00-11:30 rrule monthly no end" "&%%(and (diary-date t 19 t) (diary-block 9 19 2003 1 1 9999)) 09:00-11:30 rrule monthly no end") - (icalendar-testsuite--test-import + (icalendar-tests--test-import "SUMMARY:rrule monthly with end DTSTART;VALUE=DATE-TIME:20030919T090000 DTEND;VALUE=DATE-TIME:20030919T113000 @@ -858,7 +907,7 @@ RRULE:FREQ=MONTHLY;UNTIL=20050819; "&%%(and (diary-date t t 19) (diary-block 2003 9 19 2005 8 19)) 09:00-11:30 rrule monthly with end" "&%%(and (diary-date 19 t t) (diary-block 19 9 2003 19 8 2005)) 09:00-11:30 rrule monthly with end" "&%%(and (diary-date t 19 t) (diary-block 9 19 2003 8 19 2005)) 09:00-11:30 rrule monthly with end") - (icalendar-testsuite--test-import + (icalendar-tests--test-import "DTSTART;VALUE=DATE:20040815 DTEND;VALUE=DATE:20040816 SUMMARY:Maria Himmelfahrt @@ -868,7 +917,7 @@ RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=8 "&%%(and (diary-anniversary 2004 8 15)) Maria Himmelfahrt" "&%%(and (diary-anniversary 15 8 2004)) Maria Himmelfahrt" "&%%(and (diary-anniversary 8 15 2004)) Maria Himmelfahrt") - (icalendar-testsuite--test-import + (icalendar-tests--test-import "SUMMARY:rrule yearly DTSTART;VALUE=DATE-TIME:20030919T090000 DTEND;VALUE=DATE-TIME:20030919T113000 @@ -877,7 +926,7 @@ RRULE:FREQ=YEARLY;INTERVAL=2 "&%%(and (diary-anniversary 2003 9 19)) 09:00-11:30 rrule yearly" ;FIXME "&%%(and (diary-anniversary 19 9 2003)) 09:00-11:30 rrule yearly" ;FIXME "&%%(and (diary-anniversary 9 19 2003)) 09:00-11:30 rrule yearly") ;FIXME - (icalendar-testsuite--test-import + (icalendar-tests--test-import "SUMMARY:rrule count daily short DTSTART;VALUE=DATE-TIME:20030919T090000 DTEND;VALUE=DATE-TIME:20030919T113000 @@ -886,7 +935,7 @@ RRULE:FREQ=DAILY;COUNT=1;INTERVAL=1 "&%%(and (diary-cyclic 1 2003 9 19) (diary-block 2003 9 19 2003 9 19)) 09:00-11:30 rrule count daily short" "&%%(and (diary-cyclic 1 19 9 2003) (diary-block 19 9 2003 19 9 2003)) 09:00-11:30 rrule count daily short" "&%%(and (diary-cyclic 1 9 19 2003) (diary-block 9 19 2003 9 19 2003)) 09:00-11:30 rrule count daily short") - (icalendar-testsuite--test-import + (icalendar-tests--test-import "SUMMARY:rrule count daily long DTSTART;VALUE=DATE-TIME:20030919T090000 DTEND;VALUE=DATE-TIME:20030919T113000 @@ -895,7 +944,7 @@ RRULE:FREQ=DAILY;COUNT=14;INTERVAL=1 "&%%(and (diary-cyclic 1 2003 9 19) (diary-block 2003 9 19 2003 10 2)) 09:00-11:30 rrule count daily long" "&%%(and (diary-cyclic 1 19 9 2003) (diary-block 19 9 2003 2 10 2003)) 09:00-11:30 rrule count daily long" "&%%(and (diary-cyclic 1 9 19 2003) (diary-block 9 19 2003 10 2 2003)) 09:00-11:30 rrule count daily long") - (icalendar-testsuite--test-import + (icalendar-tests--test-import "SUMMARY:rrule count bi-weekly 3 times DTSTART;VALUE=DATE-TIME:20030919T090000 DTEND;VALUE=DATE-TIME:20030919T113000 @@ -904,7 +953,7 @@ RRULE:FREQ=WEEKLY;COUNT=3;INTERVAL=2 "&%%(and (diary-cyclic 14 2003 9 19) (diary-block 2003 9 19 2003 10 31)) 09:00-11:30 rrule count bi-weekly 3 times" "&%%(and (diary-cyclic 14 19 9 2003) (diary-block 19 9 2003 31 10 2003)) 09:00-11:30 rrule count bi-weekly 3 times" "&%%(and (diary-cyclic 14 9 19 2003) (diary-block 9 19 2003 10 31 2003)) 09:00-11:30 rrule count bi-weekly 3 times") - (icalendar-testsuite--test-import + (icalendar-tests--test-import "SUMMARY:rrule count monthly DTSTART;VALUE=DATE-TIME:20030919T090000 DTEND;VALUE=DATE-TIME:20030919T113000 @@ -913,7 +962,7 @@ RRULE:FREQ=MONTHLY;INTERVAL=1;COUNT=5 "&%%(and (diary-date t t 19) (diary-block 2003 9 19 2004 1 19)) 09:00-11:30 rrule count monthly" "&%%(and (diary-date 19 t t) (diary-block 19 9 2003 19 1 2004)) 09:00-11:30 rrule count monthly" "&%%(and (diary-date t 19 t) (diary-block 9 19 2003 1 19 2004)) 09:00-11:30 rrule count monthly") - (icalendar-testsuite--test-import + (icalendar-tests--test-import "SUMMARY:rrule count every second month DTSTART;VALUE=DATE-TIME:20030919T090000 DTEND;VALUE=DATE-TIME:20030919T113000 @@ -922,7 +971,7 @@ RRULE:FREQ=MONTHLY;INTERVAL=2;COUNT=5 "&%%(and (diary-date t t 19) (diary-block 2003 9 19 2004 5 19)) 09:00-11:30 rrule count every second month" ;FIXME "&%%(and (diary-date 19 t t) (diary-block 19 9 2003 19 5 2004)) 09:00-11:30 rrule count every second month" ;FIXME "&%%(and (diary-date t 19 t) (diary-block 9 19 2003 5 19 2004)) 09:00-11:30 rrule count every second month") ;FIXME - (icalendar-testsuite--test-import + (icalendar-tests--test-import "SUMMARY:rrule count yearly DTSTART;VALUE=DATE-TIME:20030919T090000 DTEND;VALUE=DATE-TIME:20030919T113000 @@ -931,7 +980,7 @@ RRULE:FREQ=YEARLY;INTERVAL=1;COUNT=5 "&%%(and (diary-date t 9 19) (diary-block 2003 9 19 2007 9 19)) 09:00-11:30 rrule count yearly" "&%%(and (diary-date 19 9 t) (diary-block 19 9 2003 19 9 2007)) 09:00-11:30 rrule count yearly" "&%%(and (diary-date 9 19 t) (diary-block 9 19 2003 9 19 2007)) 09:00-11:30 rrule count yearly") - (icalendar-testsuite--test-import + (icalendar-tests--test-import "SUMMARY:rrule count every second year DTSTART;VALUE=DATE-TIME:20030919T090000 DTEND;VALUE=DATE-TIME:20030919T113000 @@ -940,9 +989,11 @@ RRULE:FREQ=YEARLY;INTERVAL=2;COUNT=5 "&%%(and (diary-date t 9 19) (diary-block 2003 9 19 2011 9 19)) 09:00-11:30 rrule count every second year" ;FIXME!!! "&%%(and (diary-date 19 9 t) (diary-block 19 9 2003 19 9 2011)) 09:00-11:30 rrule count every second year" ;FIXME!!! "&%%(and (diary-date 9 19 t) (diary-block 9 19 2003 9 19 2011)) 09:00-11:30 rrule count every second year") ;FIXME!!! +) +(ert-deftest icalendar-import-duration () ;; duration - (icalendar-testsuite--test-import + (icalendar-tests--test-import "DTSTART;VALUE=DATE:20050217 SUMMARY:duration DURATION:P7D @@ -950,8 +1001,7 @@ DURATION:P7D "&%%(and (diary-block 2005 2 17 2005 2 23)) duration" "&%%(and (diary-block 17 2 2005 23 2 2005)) duration" "&%%(and (diary-block 2 17 2005 2 23 2005)) duration") - - (icalendar-testsuite--test-import + (icalendar-tests--test-import "UID:20041127T183329Z-18215-1001-4536-49109@andromeda DTSTAMP:20041127T183315Z LAST-MODIFIED:20041127T183329 @@ -968,10 +1018,11 @@ CREATED:20041127T183329 "&%%(and (diary-cyclic 1 21 12 2001) (diary-block 21 12 2001 29 12 2001)) Urlaub Class: PUBLIC" "&%%(and (diary-cyclic 1 12 21 2001) (diary-block 12 21 2001 12 29 2001)) Urlaub - Class: PUBLIC") + Class: PUBLIC")) +(ert-deftest icalendar-import-bug-6766 () ;;bug#6766 -- multiple byday values in a weekly rrule - (icalendar-testsuite--test-import + (icalendar-tests--test-import "CLASS:PUBLIC DTEND;TZID=America/New_York:20100421T120000 DTSTAMP:20100525T141214Z @@ -1010,160 +1061,97 @@ UID:8814e3f9-7482-408f-996c-3bfe486a1263 Status: CONFIRMED Class: PUBLIC &%%(and (memq (calendar-day-of-week date) '(2 4)) (diary-cyclic 1 4 22 2010)) Tues + Thurs thinking - Class: PUBLIC") -) + Class: PUBLIC")) + ;; ====================================================================== -;; Export tests +;; Cycle ;; ====================================================================== -(defun icalendar-testsuite--run-export-tests () - "Perform standard export tests." - - (let ((icalendar-export-hidden-diary-entries nil)) - (icalendar-testsuite--test-export - "&2000 Oct 3 ordinary no time " - "&3 Okt 2000 ordinary no time " - "&Oct 3 2000 ordinary no time " - nil)) - - ;; "ordinary" events - (icalendar-testsuite--test-export - "2000 Oct 3 ordinary no time " - "3 Okt 2000 ordinary no time " - "Oct 3 2000 ordinary no time " - "DTSTART;VALUE=DATE:20001003 -DTEND;VALUE=DATE:20001004 -SUMMARY:ordinary no time -") - (icalendar-testsuite--test-export - "2000 Oct 3 16:30 ordinary with time" - "3 Okt 2000 16:30 ordinary with time" - "Oct 3 2000 16:30 ordinary with time" - "DTSTART;VALUE=DATE-TIME:20001003T163000 -DTEND;VALUE=DATE-TIME:20001003T173000 -SUMMARY:ordinary with time -") - (icalendar-testsuite--test-export - "2000 10 3 16:30 ordinary with time 2" - "3 10 2000 16:30 ordinary with time 2" - "10 3 2000 16:30 ordinary with time 2" - "DTSTART;VALUE=DATE-TIME:20001003T163000 -DTEND;VALUE=DATE-TIME:20001003T173000 -SUMMARY:ordinary with time 2 -") - - (icalendar-testsuite--test-export - "2000/10/3 16:30 ordinary with time 3" - "3/10/2000 16:30 ordinary with time 3" - "10/3/2000 16:30 ordinary with time 3" - "DTSTART;VALUE=DATE-TIME:20001003T163000 -DTEND;VALUE=DATE-TIME:20001003T173000 -SUMMARY:ordinary with time 3 -") - - ;; multiline -- FIXME!!! - (icalendar-testsuite--test-export - "2000 October 3 16:30 multiline - 17:30 multiline continued FIXME" - "3 Oktober 2000 16:30 multiline - 17:30 multiline continued FIXME" - "October 3 2000 16:30 multiline - 17:30 multiline continued FIXME" - "DTSTART;VALUE=DATE-TIME:20001003T163000 -DTEND;VALUE=DATE-TIME:20001003T173000 -SUMMARY:multiline -DESCRIPTION: - 17:30 multiline continued FIXME -") - - ;; weekly by day - (icalendar-testsuite--test-export - "Monday 1:30pm weekly by day with start time" - "Montag 13:30 weekly by day with start time" - "Monday 1:30pm weekly by day with start time" - "DTSTART;VALUE=DATE-TIME:20000103T133000 -DTEND;VALUE=DATE-TIME:20000103T143000 -RRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=MO -SUMMARY:weekly by day with start time -") - - (icalendar-testsuite--test-export - "Monday 13:30-15:00 weekly by day with start and end time" - "Montag 13:30-15:00 weekly by day with start and end time" - "Monday 01:30pm-03:00pm weekly by day with start and end time" - "DTSTART;VALUE=DATE-TIME:20000103T133000 -DTEND;VALUE=DATE-TIME:20000103T150000 -RRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=MO -SUMMARY:weekly by day with start and end time -") - - ;; yearly - (icalendar-testsuite--test-export - "may 1 yearly no time" - "1 Mai yearly no time" - "may 1 yearly no time" - "DTSTART;VALUE=DATE:19000501 -DTEND;VALUE=DATE:19000502 -RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=5;BYMONTHDAY=1 -SUMMARY:yearly no time -") +(defun icalendar-tests--test-cycle (input) + "Perform cycle test. +Argument INPUT icalendar event string." + (with-temp-buffer + (if (string-match "^BEGIN:VCALENDAR" input) + (insert input) + (insert "BEGIN:VCALENDAR\nPRODID:-//Emacs//NONSGML icalendar.el//EN\n") + (insert "VERSION:2.0\nBEGIN:VEVENT\n") + (insert input) + (unless (eq (char-before) ?\n) + (insert "\n")) + (insert "END:VEVENT\nEND:VCALENDAR\n")) + (let ((icalendar-import-format "%s%d%l%o%t%u%c") + (icalendar-import-format-summary "%s") + (icalendar-import-format-location "\n Location: %s") + (icalendar-import-format-description "\n Desc: %s") + (icalendar-import-format-organizer "\n Organizer: %s") + (icalendar-import-format-status "\n Status: %s") + (icalendar-import-format-url "\n URL: %s") + (icalendar-import-format-class "\n Class: %s")) + (dolist (calendar-date-style '(iso european american)) + (icalendar-tests--do-test-cycle))))) - ;; anniversaries - (icalendar-testsuite--test-export - "%%(diary-anniversary 1989 10 3) anniversary no time" - "%%(diary-anniversary 3 10 1989) anniversary no time" - "%%(diary-anniversary 10 3 1989) anniversary no time" - "DTSTART;VALUE=DATE:19891003 -DTEND;VALUE=DATE:19891004 -RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=10;BYMONTHDAY=03 -SUMMARY:anniversary no time -") - (icalendar-testsuite--test-export - "%%(diary-anniversary 1989 10 3) 19:00-20:00 anniversary with time" - "%%(diary-anniversary 3 10 1989) 19:00-20:00 anniversary with time" - "%%(diary-anniversary 10 3 1989) 19:00-20:00 anniversary with time" - "DTSTART;VALUE=DATE-TIME:19891003T190000 -DTEND;VALUE=DATE-TIME:19891004T200000 -RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=10;BYMONTHDAY=03 -SUMMARY:anniversary with time -") +(defun icalendar-tests--do-test-cycle () + "Actually perform import/export cycle test." + (let ((temp-diary (make-temp-file "icalendar-test-diary")) + (temp-ics (make-temp-file "icalendar-test-ics")) + (org-input (buffer-substring-no-properties (point-min) (point-max)))) - ;; block - (icalendar-testsuite--test-export - "%%(diary-block 2001 6 18 2001 7 6) block no time" - "%%(diary-block 18 6 2001 6 7 2001) block no time" - "%%(diary-block 6 18 2001 7 6 2001) block no time" - "DTSTART;VALUE=DATE:20010618 -DTEND;VALUE=DATE:20010707 -SUMMARY:block no time -") - (icalendar-testsuite--test-export - "%%(diary-block 2001 6 18 2001 7 6) 13:00-17:00 block with time" - "%%(diary-block 18 6 2001 6 7 2001) 13:00-17:00 block with time" - "%%(diary-block 6 18 2001 7 6 2001) 13:00-17:00 block with time" - "DTSTART;VALUE=DATE-TIME:20010618T130000 -DTEND;VALUE=DATE-TIME:20010618T170000 -RRULE:FREQ=DAILY;INTERVAL=1;UNTIL=20010706 -SUMMARY:block with time + (unwind-protect + (progn + ;; step 1: import + (icalendar-import-buffer temp-diary t t) + + ;; step 2: export what was just imported + (save-excursion + (find-file temp-diary) + (icalendar-export-region (point-min) (point-max) temp-ics)) + + ;; compare the output of step 2 with the input of step 1 + (save-excursion + (find-file temp-ics) + (goto-char (point-min)) + (when (re-search-forward "\nUID:.*\n" nil t) + (replace-match "\n")) + (let ((cycled (buffer-substring-no-properties (point-min) (point-max)))) + (should (icalendar-tests--compare-strings cycled org-input))))) + ;; clean up + (kill-buffer (find-buffer-visiting temp-diary)) + (save-excursion + (set-buffer (find-buffer-visiting temp-ics)) + (set-buffer-modified-p nil) + (kill-buffer (current-buffer))) + (delete-file temp-diary) + (delete-file temp-ics)))) + +(ert-deftest icalendar-cycle () + "Perform cycling tests." + (icalendar-tests--test-cycle + "DTSTART;VALUE=DATE-TIME:20030919T090000 +DTEND;VALUE=DATE-TIME:20030919T113000 +SUMMARY:Cycletest ") - (icalendar-testsuite--test-export - "%%(diary-block 2001 6 18 2001 7 6) 13:00 block no end time" - "%%(diary-block 18 6 2001 6 7 2001) 13:00 block no end time" - "%%(diary-block 6 18 2001 7 6 2001) 13:00 block no end time" - "DTSTART;VALUE=DATE-TIME:20010618T130000 -DTEND;VALUE=DATE-TIME:20010618T140000 -RRULE:FREQ=DAILY;INTERVAL=1;UNTIL=20010706 -SUMMARY:block no end time + (icalendar-tests--test-cycle + "DTSTART;VALUE=DATE-TIME:20030919T090000 +DTEND;VALUE=DATE-TIME:20030919T113000 +SUMMARY:Cycletest +DESCRIPTION:beschreibung! +LOCATION:nowhere +ORGANIZER:ulf ") - ) + (icalendar-tests--test-cycle + "DTSTART;VALUE=DATE:19190909 +DTEND;VALUE=DATE:19190910 +RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=09;BYMONTHDAY=09 +SUMMARY:and diary-anniversary +")) ;; ====================================================================== ;; Real world ;; ====================================================================== -(defun icalendar-testsuite--run-real-world-tests () +(ert-deftest icalendar-real-world () "Perform real-world tests, as gathered from problem reports." ;; 2003-05-29 - (icalendar-testsuite--test-import + (icalendar-tests--test-import "BEGIN:VCALENDAR METHOD:REQUEST PRODID:Microsoft CDO for Microsoft Exchange @@ -1231,7 +1219,7 @@ END:VCALENDAR" Status: CONFIRMED") ;; 2003-06-18 a - (icalendar-testsuite--test-import + (icalendar-tests--test-import "DTSTAMP:20030618T195512Z DTSTART;TZID=\"Mountain Time (US & Canada)\":20030623T110000 SUMMARY:Dress Rehearsal for XXXX-XXXX @@ -1273,9 +1261,8 @@ END:VALARM" Location: 555 or TN 555-5555 ID 5555 & NochWas (see below) Organizer: MAILTO:xxx@xxxxx.com Status: CONFIRMED") - ;; 2003-06-18 b -- uses timezone - (icalendar-testsuite--test-import + (icalendar-tests--test-import "BEGIN:VCALENDAR METHOD:REQUEST PRODID:Microsoft CDO for Microsoft Exchange @@ -1342,9 +1329,8 @@ END:VCALENDAR" Location: 123 or TN 123-1234 ID abcd & SonstWo (see below) Organizer: MAILTO:bbb@bbbbb.com Status: CONFIRMED") - ;; export 2004-10-28 block entries - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil nil "-*- mode: text; fill-column: 256;-*- @@ -1357,7 +1343,7 @@ END:VCALENDAR" DTEND;VALUE=DATE:20041111 SUMMARY:Nov 8-10 aa") - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil nil "%%(diary-block 12 13 2004 12 17 2004) Dec 13-17 bb" @@ -1365,7 +1351,7 @@ SUMMARY:Nov 8-10 aa") DTEND;VALUE=DATE:20041218 SUMMARY:Dec 13-17 bb") - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil nil "%%(diary-block 2 3 2005 2 4 2005) Feb 3-4 cc" @@ -1373,7 +1359,7 @@ SUMMARY:Dec 13-17 bb") DTEND;VALUE=DATE:20050205 SUMMARY:Feb 3-4 cc") - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil nil "%%(diary-block 4 24 2005 4 29 2005) April 24-29 dd" @@ -1381,7 +1367,7 @@ SUMMARY:Feb 3-4 cc") DTEND;VALUE=DATE:20050430 SUMMARY:April 24-29 dd ") - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil nil "%%(diary-block 5 30 2005 6 1 2005) may 30 - June 1: ee" @@ -1389,16 +1375,16 @@ SUMMARY:April 24-29 dd DTEND;VALUE=DATE:20050602 SUMMARY:may 30 - June 1: ee") - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil nil "%%(diary-block 6 6 2005 6 8 2005) ff" "DTSTART;VALUE=DATE:20050606 DTEND;VALUE=DATE:20050609 SUMMARY:ff") - + ;; export 2004-10-28 anniversary entries - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil nil " @@ -1411,7 +1397,7 @@ RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=03;BYMONTHDAY=28 SUMMARY:aa birthday (%d years old) ") - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil nil "%%(diary-anniversary 5 17 1957) bb birthday (%d years old)" @@ -1420,7 +1406,7 @@ DTEND;VALUE=DATE:19570518 RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=05;BYMONTHDAY=17 SUMMARY:bb birthday (%d years old)") - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil nil "%%(diary-anniversary 6 8 1997) cc birthday (%d years old)" @@ -1429,7 +1415,7 @@ DTEND;VALUE=DATE:19970609 RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=06;BYMONTHDAY=08 SUMMARY:cc birthday (%d years old)") - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil nil "%%(diary-anniversary 7 22 1983) dd (%d years ago...!)" @@ -1438,7 +1424,7 @@ DTEND;VALUE=DATE:19830723 RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=07;BYMONTHDAY=22 SUMMARY:dd (%d years ago...!)") - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil nil "%%(diary-anniversary 8 1 1988) ee birthday (%d years old)" @@ -1447,7 +1433,7 @@ DTEND;VALUE=DATE:19880802 RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=08;BYMONTHDAY=01 SUMMARY:ee birthday (%d years old)") - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil nil "%%(diary-anniversary 9 21 1957) ff birthday (%d years old)" @@ -1461,7 +1447,7 @@ SUMMARY:ff birthday (%d years old)") ;; export 2004-10-28 monthly, weekly entries - ;; (icalendar-testsuite--test-export + ;; (icalendar-tests--test-export ;; nil ;; " ;; >>> ------------ monthly: @@ -1469,7 +1455,7 @@ SUMMARY:ff birthday (%d years old)") ;; */27/* 10:00 blah blah" ;; "xxx") - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil nil ">>> ------------ my week: @@ -1480,7 +1466,7 @@ DTEND;VALUE=DATE-TIME:20000103T140000 RRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=MO SUMMARY:MAC") - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil nil "Monday 15:00 a1" @@ -1490,7 +1476,7 @@ RRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=MO SUMMARY:a1") - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil nil "Monday 16:00-17:00 a2" @@ -1499,7 +1485,7 @@ DTEND;VALUE=DATE-TIME:20000103T170000 RRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=MO SUMMARY:a2") - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil nil "Tuesday 11:30-13:00 a3" @@ -1508,7 +1494,7 @@ DTEND;VALUE=DATE-TIME:20000104T130000 RRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=TU SUMMARY:a3") - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil nil "Tuesday 15:00 a4" @@ -1517,7 +1503,7 @@ DTEND;VALUE=DATE-TIME:20000104T160000 RRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=TU SUMMARY:a4") - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil nil "Wednesday 13:00 a5" @@ -1526,7 +1512,7 @@ DTEND;VALUE=DATE-TIME:20000105T140000 RRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=WE SUMMARY:a5") - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil nil "Wednesday 11:30-13:30 a6" @@ -1535,7 +1521,7 @@ DTEND;VALUE=DATE-TIME:20000105T133000 RRULE:FREQ=WEEKLY;INTERVAL=1;BYDAY=WE SUMMARY:a6") - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil nil "Wednesday 15:00 s1" @@ -1546,7 +1532,7 @@ SUMMARY:s1") ;; export 2004-10-28 regular entries - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil nil " @@ -1558,7 +1544,7 @@ DTEND;VALUE=DATE-TIME:20041012T150000 SUMMARY:Tue: [2004-10-12] q1") ;; 2004-11-19 - (icalendar-testsuite--test-import + (icalendar-tests--test-import "BEGIN:VCALENDAR VERSION :2.0 @@ -1733,7 +1719,7 @@ END:VCALENDAR Class: PRIVATE") ;; 2004-09-09 pg - (icalendar-testsuite--test-export + (icalendar-tests--test-export "%%(diary-block 1 1 2004 4 1 2004) Urlaub" nil nil @@ -1742,7 +1728,7 @@ DTEND;VALUE=DATE:20040105 SUMMARY:Urlaub") ;; 2004-10-25 pg - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil "5 11 2004 Bla Fasel" nil @@ -1751,7 +1737,7 @@ DTEND;VALUE=DATE:20041106 SUMMARY:Bla Fasel") ;; 2004-10-30 pg - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil "2 Nov 2004 15:00-16:30 Zahnarzt" nil @@ -1760,7 +1746,7 @@ DTEND;VALUE=DATE-TIME:20041102T163000 SUMMARY:Zahnarzt") ;; 2005-02-07 lt - (icalendar-testsuite--test-import + (icalendar-tests--test-import "UID :b60d398e-1dd1-11b2-a159-cf8cb05139f4 SUMMARY @@ -1792,7 +1778,7 @@ DTSTAMP Class: PRIVATE") ;; 2005-03-01 lt - (icalendar-testsuite--test-import + (icalendar-tests--test-import "DTSTART;VALUE=DATE:20050217 SUMMARY:Hhhhhh Aaaaa ii Aaaaaaaa UID:6AFA7558-6994-11D9-8A3A-000A95A0E830-RID @@ -1803,7 +1789,7 @@ DURATION:P7D" "&%%(and (diary-block 2 17 2005 2 23 2005)) Hhhhhh Aaaaa ii Aaaaaaaa") ;; 2005-03-23 lt - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil "&%%(diary-cyclic 7 8 2 2005) 16:00-16:45 [WORK] Pppp" nil @@ -1814,7 +1800,7 @@ SUMMARY:[WORK] Pppp ") ;; 2005-05-27 eu - (icalendar-testsuite--test-export + (icalendar-tests--test-export nil nil ;; FIXME: colon not allowed! @@ -1827,32 +1813,5 @@ SUMMARY:NNN Wwwwwwww Wwwww - Aaaaaa Pppppppp rrrrrr ddd oo Nnnnnnnn 30 ") ) -(defun icalendar-testsuite--run-cycle-tests () - "Perform cycling tests." - (icalendar-testsuite--test-cycle - "DTSTART;VALUE=DATE-TIME:20030919T090000 -DTEND;VALUE=DATE-TIME:20030919T113000 -SUMMARY:Cycletest -") - - (icalendar-testsuite--test-cycle - "DTSTART;VALUE=DATE-TIME:20030919T090000 -DTEND;VALUE=DATE-TIME:20030919T113000 -SUMMARY:Cycletest -DESCRIPTION:beschreibung! -LOCATION:nowhere -ORGANIZER:ulf -") - - (icalendar-testsuite--test-cycle - "DTSTART;VALUE=DATE:19190909 -DTEND;VALUE=DATE:19190910 -RRULE:FREQ=YEARLY;INTERVAL=1;BYMONTH=09;BYMONTHDAY=09 -SUMMARY:and diary-anniversary -") - ) - - -(provide 'icalendar-testsuite) - -;;; icalendar-testsuite.el ends here +(provide 'icalendar-tests) +;;; icalendar-tests.el ends here |
